// 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)
test Login(ctx, dlb, dlsInList, "Dial In Login")
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, "Can't let you on. Bye!!*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)
]