// DLSBackground.bcpl -- Background processes for DLS control
// Last modified May 17, 1982 1:55 PM by Taft
// Last modified November 14, 1983 11:17 AM by Diebert
get "DLSDriver.decl"
get "Pup.decl"
get "DLSControl.decl"
get "AltoDefs.d"
external
[
// Procedures defined herein
DLSBackground; AltoCommand; StatusBackground; DspPuts; WizardMode
// Procedures defined elsewhere
GetString; Confirm; Error; Disconnect; DLSOutputEmpty;
UpdateCarrierOn; CounterJunta; HangUp
Enqueue; Unqueue; SetTimer; TimerHasExpired; Dismiss; Block;
PutTemplate; Gets; Puts; Endofs; Closes; Ws; Wss; Wns;
Allocate; Free; Zero; SetBlock; Noop;
SimpleDspResetLine; SimpleDspSetLinePos; GetNumber; ControlOut
CloseBSPSocket; BSPForceOutput
// Statics defined herein
//savedDCBHead; stDis; displayTimeout; keyDsp;
postedNotice
// Statics defined elsewhere
sysZone
mainCtx // Pointer to Q of non-interrupt contexts
ctxTable // Table of contexts, indexed by line #
@lbTable // DLS line block table
dsp
logstream
crlf
nPBI
dlsInputOverflows
]
static
[
//stDis // Status display stream
//displayTimeout // Timeout for turning off display
//savedDCBHead // Place to save head of DCB chain
//keyDsp // Special Alto keyboard/display stream
postedNotice
]
// ---------------------------------------------------------------------------
let WizardMode(ctx, tstr) be
// ---------------------------------------------------------------------------
// Task to process commands from the network
[
let dlb = ctx>>CTX.dlb
Wss(tstr, "*n*l? Broadcast, Display status, Post Notice, Quit, Remove Notice, ShutDown*n*l")
[ // repeat
Wss(tstr, "W>") // Prompt
let char = Gets(tstr)
switchon char into
[
case $Q: case $q:
Wss(tstr, "Quit out of wizard mode [confirm] ")
if Confirm(tstr) then return
endcase
case $S: case $s:
Wss(tstr, "Shutdown DLS [confirm] ")
if Confirm(tstr) then ShutDown(ctx, tstr)
endcase
case $B: case $b:
[
Wss(tstr, "Broadcast message")
let string = GetMessage(tstr)
if string ne 0 then [ BroadcastMessage(tstr, string); Free(sysZone, string) ]
Wss(tstr, crlf)
endcase
]
case $D: case $d:
[
Wss(tstr, "Display Status*n*l")
PutTemplate(tstr,
"Number of PBI's = $D*n*lNumber of Input Buffer Overflows = $UD*n*l*n*l",
nPBI, dlsInputOverflows)
Wss(tstr, " 0 1 2 3 4 5 6 7*n*l")
for i = 0 to numLines - 1 by 8 do
[
PutTemplate(tstr, " $D ", i/8)
for j = 0 to 7 do
[
let ctx = ctxTable!(i + j)
let dlb = lbTable!(i + j)
test dlb>>LBH.lineType eq ltLog
ifso Wss(tstr, " Log")
ifnot Wss(tstr, (dlb>>LBH.lineType ls ltData? " -- ",
selecton ctx>>CTX.lineState into
[
case lineStateOff: " Off"
case lineStateOn: " On "
case lineStateActive: " Act"
case lineStateRemote: " Rem"
case lineStateDialOut: " Out"
]))
]
Wss(tstr, "*n*l")
]
Wss(tstr, "*n*l Line Name*n*l")
for i = 0 to numLines - 1 do
[
let ctx = ctxTable!i
if ctx ne 0 then
if ctx>>CTX.name ne 0 then
PutTemplate(tstr, " $3O $S*n*l", ctx>>CTX.dlb>>DLB.line, ctx>>CTX.name)
]
endcase
]
case $P: case $p:
[
Wss(tstr, "Post signon message")
let string = GetMessage(tstr)
if string ne 0 then
[
if postedNotice ne 0 then Free(sysZone, postedNotice)
postedNotice = string
]
endcase
]
case $R: case $r:
Wss(tstr, "Remove posted notice [confirm]")
if Confirm(tstr) & postedNotice ne 0 then
[ Free(sysZone, postedNotice); postedNotice = 0 ]
endcase
case $?:
Wss(tstr, "? Broadcast, Display status, Post Notice, Quit, Remove Notice, ShutDown*n*l")
endcase
case $*n:
Wss(tstr, crlf)
endcase
default:
Error(tstr, " ?*n*l", char)
endcase
]
] repeat
]
//// ---------------------------------------------------------------------------
//and AltoCommand() be
//// ---------------------------------------------------------------------------
//// Task to process commands from Alto keyboard
//[
//Ws("*n**") // Prompt
//let char = nil
// [ char = Gets(keyDsp); Puts(keyDsp, $*l) ] repeatwhile char eq $*s
//
//switchon char into
// [
// case $Q: case $q:
// Ws("Quit [confirm]")
// if Confirm(keyDsp) then ShutDown(0, keyDsp)
// endcase
//
// case $B: case $b:
// [
// Ws("Broadcast message")
// let string = GetMessage(keyDsp)
// if string ne 0 then [ BroadcastMessage(keyDsp, string); Free(sysZone, string) ]
// endcase
// ]
//
// case $P: case $p:
// [
// Ws("Post signon message")
// let string = GetMessage(keyDsp)
// if string ne 0 then
// [
// if postedNotice ne 0 then Free(sysZone, postedNotice)
// postedNotice = string
// ]
// endcase
// ]
//
// case $R: case $r:
// Ws("Remove posted notice [confirm]")
// if Confirm(keyDsp) & postedNotice ne 0 then
// [ Free(sysZone, postedNotice); postedNotice = 0 ]
// endcase
//
// case $?:
// Ws("? Broadcast, Post, Quit, Remove")
// endcase
//
// case $*n:
// endcase
//
// default:
// Error(keyDsp, " ?*n*l", char)
// endcase
// ]
//] repeat
//
// ---------------------------------------------------------------------------
and GetMessage(strm) = valof
// ---------------------------------------------------------------------------
[
unless Confirm(strm) resultis 0
Wss(strm, "[end with CR, abort with DEL]*n*l")
let string = Allocate(sysZone, 51)
test GetString(strm, string, 100) & string>>String.length gr 0
ifso resultis string
ifnot [ Free(sysZone, string); resultis 0 ]
]
// ---------------------------------------------------------------------------
and BroadcastMessage(strm, string) be
// ---------------------------------------------------------------------------
[
Wss(strm, "*n*lSending to line: ")
for i = 0 to numLines-1 do
[
let ctx, dlb = ctxTable!i, lbTable!i
if dlb>>LBH.lineType ge ltData &
(ctx>>CTX.lineState eq lineStateActive %
ctx>>CTX.lineState eq lineStateRemote) then
[
Unqueue(mainCtx, ctx) // Shut off other sources of output
if ctx>>CTX.auxCtx ne 0 then Unqueue(mainCtx, ctx>>CTX.auxCtx)
Wss(dlb, "*n*l***********007*n*l> ")
Wss(dlb, string)
Wss(dlb, "*n*l***********007*n*l")
Enqueue(mainCtx, ctx)
if ctx>>CTX.auxCtx ne 0 then Enqueue(mainCtx, ctx>>CTX.auxCtx)
Wns(strm, i, 3, 8)
]
]
]
// ---------------------------------------------------------------------------
and ShutDown(ctxIn, strm) be
// ---------------------------------------------------------------------------
[
Wss(strm, "*nBroadcasting shutdown message...")
BSPForceOutput(lv ctxIn>>CTX.socket)
BroadcastMessage(strm, "DLS going down now...Goodbye!")
Wss(strm, "*nClosing connections...")
for i = 0 to numLines-1 do
if (lbTable!i)>>LBH.lineType gr ltData then
[
let ctx = ctxTable!i
if ctx ne ctxIn do
[
Unqueue(mainCtx, ctx)
if ctx>>CTX.auxCtx ne 0 then Unqueue(mainCtx, ctx>>CTX.auxCtx)
if ctx>>CTX.socketOpen then Disconnect(ctx, 500)
]
]
Dismiss(10) // 100 ms for last character to go out
// Turn off all control signals and set all data lines to marking.
SetBlock(dlsOutBase, 1, numLines)
if ctxIn ne 0 then
if ctxIn>>CTX.socketOpen then
[ Wss(strm, "Bye!!*n*l"); CloseBSPSocket(lv ctxIn>>CTX.socket, 500) ]
@displayListHead = 0
finish
]
//// ---------------------------------------------------------------------------
//and DspPuts(str, char) be
//// ---------------------------------------------------------------------------
//[
//@displayListHead = savedDCBHead // Ensure display is on
//SetTimer(lv displayTimeout, 120*100) // Reset activity timer
//unless char eq $*l do Puts(dsp, char)
//]
//
//// ---------------------------------------------------------------------------
//and StatusBackground() be
//// ---------------------------------------------------------------------------
//// Periodically updates the terminal status display.
//// Also turns off display if no keyboard activity for a long time
//[
//if @displayListHead ne 0 then // Do this only if display is on
// [
// for i = 1 to stDisLines-1 do
// [
// SimpleDspSetLinePos(stDis, i)
// SimpleDspResetLine(stDis)
// let group = (i-1)*8
// Wns(stDis, group, 2, 8)
// for line = group to group+7 do
// [
// Block()
// let ctx = ctxTable!line
// let dlb = lbTable!line
// test dlb>>LBH.lineType eq ltLog
// ifso Wss(stDis, " Log")
// ifnot Wss(stDis, (dlb>>LBH.lineType ls ltData? " -- ",
// selecton ctx>>CTX.lineState into
// [
// case lineStateOff: " Off"
// case lineStateOn: " On "
// case lineStateActive: " Act"
// case lineStateRemote: " Rem"
// case lineStateDialOut: " Out"
// ]))
// ]
// Dismiss(1) // Don't hog the machine
// ]
// if TimerHasExpired(lv displayTimeout) then @displayListHead = 0
// ]
//Dismiss(400) // Do this every 4 seconds
//] repeat
//
// ---------------------------------------------------------------------------
and DLSBackground() be
// ---------------------------------------------------------------------------
// This is an independent task that does any necessary periodic
// background processing
[
UpdateCarrierOn(Noop) // Look for lines that have hung up
Dismiss(100) // Wait one second, then repeat
] repeat