// DLSControl.bcpl -- Control program for Alto DLS

// Last modified July 11, 1983  12:02 PM by Taft
// Last modified January 17, 1985  10:02 AM by Diebert

get "DLSDriver.decl"
get "Pup.decl"
get "DLSControl.decl"
get "AltoDefs.d"

external
[
// outgoing procedures
DLSAfterJunta; DLSControl; DLSTop; Disconnect; HangUp; LeaveRemoteMode;
OpenPortForCtx; CheckConnection; DLSCommand; DLSRemoteError; DLSReturnFrom
DLSTopAbort; DLSCommandError

// Procedures defined in other parts of the DLS control program
DLSBeforeJuntaInit; DLSAfterJuntaInit; DialOutTop; Set7BitProcs; 
GetNumber; OtherPupProc; TerminalToNet

// Procedures defined in DLSUtil
GetString; Echo; Confirm; Error; Ws; Wss; Wns; TimeCallStop; Login; TimeCallStart


// Procedures defined in DLS driver
DLSResetOutput; DLSOutputEmpty; DLSInputIdle; ControlOut; ControlIn;
DetermineDLSLineSpeed; UpdateCarrierOn; WaitForBitTimes
DLSInput; DLSInput7; DLSOutput; DLSOutput7; DLSOutputTI
DLSResetInput

// Procedures defined in other packages
OpenLevel1Socket; CloseLevel1Socket; ReleasePBI; OpenRTPSocket; CloseRTPSocket;
CreateBSPStream; CloseBSPSocket; BSPForceOutput;
BSPGetMark; BSPPutMark; BSPPutInterrupt; GetPartner; ExchangePorts; CompletePup
InitializeContext; CallContextList; Block; Enqueue; Dequeue; Unqueue;
SetTimer; TimerHasExpired; Dismiss; PutTemplate; PutNum; WriteRingBuffer

// Procedures defined in operating system
Gets; Puts; Endofs; Resets; Allocate; Free; AddToZone; Zero;
CallSwat; MyFrame; GotoFrame; ReturnFrom; Noop; DefaultArgs

// outgoing statics
endInit; mainCtx; ctxTable; nPBI; iPBI; versionText; crlf
dlsName; dlsRegistry; dlsOutList; dlsInList; dlsWizardList; logstream; dcb
// incoming statics
@lbTable	// DLS line block table
CtxRunning; sysZone; lenPBI; pbiFreeQ; ndbQ; keyDsp; postedNotice; socketSequence
loginServerCB;
]

static
[
endInit		// End of initialization code
mainCtx		// Pointer to Q of non-interrupt contexts
ctxTable	// Table of contexts, indexed by line #
nPBI		// Total number of PBIs allocated
iPBI		// PBIs allocated by initialization
dcb = 0
dlsName = 0
dlsRegistry = 0
dlsOutList = 0
dlsInList = 0
dlsWizardList = 0
logstream
versionText; crlf
loginServerCB = 0
]

// ---------------------------------------------------------------------------
let DLSControl() be DLSBeforeJuntaInit()
// ---------------------------------------------------------------------------

// ---------------------------------------------------------------------------
and DLSAfterJunta() be
// ---------------------------------------------------------------------------
[
versionText = "DLSControl of January 17, 1985"
crlf = "*n*l"

DLSAfterJuntaInit()

// Throw away initialization code and stack, add its space to zone,
// and create remaining PBIs
AddToZone(sysZone, DLSBeforeJuntaInit, endInit-DLSBeforeJuntaInit)
let freeBegin = @endCode
@endCode = MyFrame()-100
AddToZone(sysZone, freeBegin, @endCode-freeBegin)
for i = 1 to nPBI-iPBI do
   Enqueue(pbiFreeQ, Allocate(sysZone, lenPBI))

// Now everything is set up.
// Run all contexts forever...
CallContextList(mainCtx!0) repeat
]

// ---------------------------------------------------------------------------
and DLSTop(ctx) be
// ---------------------------------------------------------------------------
// This is the top-level procedure for each line's context.
[
let dlb = ctx>>CTX.dlb
if dlb>>DLB.carrierOff then ctx>>CTX.lineState = lineStateOff
dlb>>DLB.timeout = -1

// Wait for somebody to connect (no-op if not a dialup line)
while (dlb>>DLB.carrierOff % ctx>>CTX.dialOutOnly) &
 ctx>>CTX.lineState ne lineStateDialOut do
   Dismiss(1)
dlb>>DLB.noPad = ctx>>CTX.noPad
dlb>>DLB.eightBit = ctx>>CTX.eightBit
dlb>>DLB.flowControl = false
Set7BitProcs(dlb)
ctx>>CTX.callTimed = 0
ctx>>CTX.callInProgress = 0
ctx>>CTX.escapeTime = 0
ctx>>CTX.escapeDisabled = 0

test ctx>>CTX.lineState eq lineStateDialOut
   ifso
      [  // Dial-out Telnet connection
      ctx>>CTX.escapeChar = dialOutEscape
      DialOutTop(ctx)
      ]
   ifnot
      [  // Hardwired or dial-in connection
      ctx>>CTX.lineState = lineStateOn
      ctx>>CTX.escapeChar = dialInEscape

      // Unless this is a constant-speed line,
      // determine line speed from the first character typed in.
      unless ctx>>CTX.constantBaud do
         [
         let char = DetermineDLSLineSpeed(dlb,
            table [ 6; 2400; 1200; 600; 300; 150; 110 ],  // Possible speeds
            table [ 4; 3; $E; $e; $*n ],  // Characters to accept
            DLSTopAbort)
         if char eq 0 loop  // Back to top if not found or user hung up
         if char eq 3 then WriteRingBuffer(lv dlb>>DLB.iRBD, char)
         ]

      // Give greeting message and line number
      PutTemplate(dlb, "$S*n*l$S Line #$O Baud rate = $D, Escape key = ", dlsName, 
         ( selecton dlb>>DLB.lineType into 
            [
            case ltHardwired: "Hardwired"
            case ltDataSet: "Dial In"
            case ltTelenet: "Telenet"
            default: "?"
            ]),
         dlb>>DLB.line, dlb>>DLB.baud)
      Echo(dlb, ctx>>CTX.escapeChar)
      Wss(dlb, crlf)

      if postedNotice ne 0 then
         PutTemplate(dlb, "*007****** $S*n*l", postedNotice)
      let ok = false
      for i = 1 to 5 do
         [ ok = Login(ctx, dlb, dlsInList, "Dial In Login")
         if ok eq true then break
         ]
      test ok
         ifso
            [
            // Call main command loop -- returns upon carrierOff or timeout
            TimeCallStart(ctx)
            DLSCommand(ctx)
            while dlb>>DLB.outActive do Block()
            TimeCallStop(ctx)
            ]
         ifnot [ Wss(dlb, "Valid login required.*n*l"); Dismiss(500); Disconnect(ctx) ]
      ]

// If we get here and a name is allocated Free it
TimeCallStop(ctx) // Just in case we got here due to an error.
if ctx>>CTX.name ne 0 do [ Free(sysZone, ctx>>CTX.name); ctx>>CTX.name = 0 ]
if ctx>>CTX.password ne 0 do [ Free(sysZone, ctx>>CTX.password); ctx>>CTX.password = 0 ]
if dlb>>DLB.lineType ge ltDataSet do
   [
   ctx>>CTX.terminalType = 0
   ctx>>CTX.terminalLength = 0
   ctx>>CTX.terminalWidth = 0
   ]
ctx>>CTX.escapeTime = 0
ctx>>CTX.escapeDisabled = 0

// If we get here and a connection is open, close it
dlb>>DLB.error = Noop  // Disable DLS error handling
Disconnect(ctx, 500)  // Short timeout (5 seconds)
HangUp(dlb, true)  // Hang up the modem (if implemented)
ctx>>CTX.status = 0  // Clear status word (including socketOpen and lineState)
] repeat

// ---------------------------------------------------------------------------
and DLSRemoteError(dlb, ec) be
// ---------------------------------------------------------------------------
[
Set7BitProcs(dlb)
DLSReturnFrom(dlb, TerminalToNet)
]

// ---------------------------------------------------------------------------
and LeaveRemoteMode(ctx) be
// ---------------------------------------------------------------------------
[
DLSResetInput(ctx>>CTX.dlb)
DLSResetOutput(ctx>>CTX.dlb)
test ctx eq CtxRunning
   ifso  // We are running in the main context
      GotoFrame(ctx>>CTX.returnFrame)
   ifnot  // We are running in the auxiliary context
      [  // Cause TerminalToNet to be returned from in main context
      let frame = ctx>>CTX.returnFrame
      frame!1 = frame!1+1  // Duplicate what Block() does
      ctx>>CTX.stack = frame
      Block() repeat  // We expect to be killed off
      ]
]

// ---------------------------------------------------------------------------
and DLSReturnFrom(dlb, Proc) be
// ---------------------------------------------------------------------------
[
if CtxRunning eq ctxTable!(dlb>>DLB.line) then
   [  // In main context, just blast out
   ReturnFrom(Proc)
   CallSwat()
   ]
]

// ---------------------------------------------------------------------------
and DLSTopAbort(dlb) = (ctxTable!(dlb>>DLB.line))>>CTX.lineState eq lineStateDialOut
// ---------------------------------------------------------------------------

// ---------------------------------------------------------------------------
and DLSCommandError(dlb, ec) be
// ---------------------------------------------------------------------------
// If ec = ecCarrierOff, simply abort the entire session.
// If ec = ecDLSGetsTimeout, check the state of the connection and retry
// once per second so long as the connection stays open.  If no connection
// is open, abort the session after a 2-minute timeout.
[
let ctx = ctxTable!(dlb>>DLB.line)
Set7BitProcs(dlb)
if ec eq ecDLSGetsTimeout then
   test dlb>>DLB.timeout eq 12000
      ifso PutTemplate(dlb, "*n*l> [Timeout, goodbye]*n*l")
      ifnot
         [
         unless CheckConnection(ctx) % ctx>>CTX.socketOpen do
            dlb>>DLB.timeout = 12000  // 2 minutes
         return
         ]
DLSReturnFrom(dlb, DLSCommand)
]