// DLSTest.bcpl -- Test for Alto DLS (hardware and software)
// Last modified May 2, 1982 1:32 PM by Taft
get "DLSDriver.decl"
get "DLSConfig.decl"
external
[
// Procedures defined herein
DLSTest
// Procedures defined elsewhere
InitializeDLS; LoadRam; TurnOnDLS; TurnOffDLS; DLSInput; DLSOutput;
DLSResetInput; DLSResetOutput; DLSInputEmpty; DLSOutputFull;
SetDLSLineSpeed; DetermineDLSLineSpeed; UpdateCarrierOn; ReadDLSConfig
InitializeContext; CallContextList; Block; Dismiss;
Gets; Puts; Endofs; Ws; Wss; PutTemplate;
AddToZone; Allocate; SetBlock; Zero;
Noop; Usc; CallSwat;
CreateDisplayStream; ShowDisplayStream; GetFixed; FixedLeft; SetEndCode
// Statics defined elsewhere
RamImage; @lbTable; keys; dsp; sysZone
]
manifest
[
lCtxRegion=200
]
static
[
mainCtx; ctxTable; pleaseStop
]
structure String: [ length byte; char↑1,1 byte ]
//----------------------------------------------------------------------------
let DLSTest() be
//----------------------------------------------------------------------------
[
let versionText = "DLSTest of May 2, 1982"
unless LoadRam(RamImage, true) eq 0 do
CallSwat("Failed to load DLS microcode")
(table [ 61010B; 1401B ])(nil, 20B) //jump into RAM emulator
SetEndCode(LoadRam)
let dlsConfig = vec lenDLSConfig
ReadDLSConfig(dlsConfig, sysZone)
let lct = vec lenLCT; Zero(lct, lenLCT)
for line = 0 to numLines-1 do
[
lct>>LCT↑line.lineType = dlsConfig>>DLSConfig.lc↑line.lineType
lct>>LCT↑line.otherLine = dlsConfig>>DLSConfig.lc↑line.otherLine
]
let lz = FixedLeft()-250
if lz ls 0 then lz = 77777B
AddToZone(sysZone, GetFixed(lz), lz)
InitializeDLS(sysZone, lct)
let v = vec 10000
dsp = CreateDisplayStream(25, v, 10000)
ShowDisplayStream(dsp, DSbelow)
let mainRegion = vec 500
mainCtx = InitializeContext(mainRegion, 500, DLSCmd)
@mainCtx = mainCtx
let v = vec numLines; ctxTable = v
for i = 0 to numLines-1 do
if (lbTable!i)>>LBH.lineType ge ltData then
ctxTable!i = Allocate(sysZone, lCtxRegion)
Ws(versionText)
CallContextList(mainCtx) // Never returns since MainCtx is a ring
]
//----------------------------------------------------------------------------
and DLSCmd() be
//----------------------------------------------------------------------------
[
let save420 = nil
Ws("*n**")
let char = nil
char = Gets(keys) repeatwhile char eq $*s
switchon char into
[
case $B: case $b:
Ws("Buffered input/echo test")
CreateMultipleContexts(BufferedTest)
until TimeToStop() do Dismiss(10)
DestroyMultipleContexts()
endcase
case $C: case $c:
Ws("Carrier on/off test")
UpdateCarrierOn(Noop)
until TimeToStop() do UpdateCarrierOn(CarrierProc)
endcase
case $D: case $d:
test @420B // Head of display list
ifso
[
Ws("Display off")
save420=@420B
@420B=0
]
ifnot
[
Ws("Display on")
@420B=save420
]
endcase
case $E: case $e:
Ws("Echo test")
InputTest(true)
endcase
case $F: case $f:
Ws("Find line speeds test")
pleaseStop = false
CreateMultipleContexts(FindLineSpeedsTest)
until TimeToStop() do [ UpdateCarrierOn(Noop); Dismiss(10) ]
pleaseStop = true
Dismiss(100) // give contexts time to put all lines back in good state
DestroyMultipleContexts()
endcase
case $I: case $i:
Ws("Input test")
InputTest(false)
endcase
case $M: case $m:
Ws("Mixed input/output test")
CreateMultipleContexts(MixedTest)
until TimeToStop() do Dismiss(10)
DestroyMultipleContexts()
endcase
case $O: case $o:
Ws("Output test")
CreateMultipleContexts(OutputTest)
until TimeToStop() do Dismiss(10)
DestroyMultipleContexts()
endcase
case $Q: case $q:
Ws("Quit")
finish
case $S: case $s:
[
Ws("Set speed of line: ")
let line = GetNumber(8)
if line ls 0 % line ge numLines then [ Ws(" ?"); endcase]
Ws(" to baud rate: ")
let baud = GetNumber(10)
if baud ls 110 % baud gr 2400 then [ Ws(" ?"); endcase]
SetDLSLineSpeed(lbTable!line, baud)
endcase
]
case $?:
Ws("?*nBuffered test, Carrier test, Display on/off, Echo test, Find speed,")
Ws("*nInput test, Mixed test, Output test, Quit, Set speed")
endcase
case $*n: case $*s:
endcase
default:
Puts(dsp,char)
Ws(" ?")
endcase
]
] repeat
//----------------------------------------------------------------------------
and InputTest(echoing) be
//----------------------------------------------------------------------------
until TimeToStop() do
for i = 0 to numLines-1 do
if (lbTable!i)>>LBH.lineType ge ltData then
unless DLSInputEmpty(lbTable!i) do
[
let char = DLSInput(lbTable!i)
if echoing then Puts(lbTable!i, char)
PutTemplate(dsp, "*NLine $2O Char $3F0O = $C", i, char, char&177B)
]
//----------------------------------------------------------------------------
and OutputTest(ctx, onceOnly; numargs na) be
//----------------------------------------------------------------------------
[
let dlb = ctx!3
test dlb>>DLB.carrierOff
ifso Dismiss(10)
ifnot
[
PutTemplate(dlb, "*N*L$2F0O: ", dlb>>DLB.line)
for char = 40B to 137B do Puts(dlb, char)
]
if na gr 1 & onceOnly then return
] repeat
//----------------------------------------------------------------------------
and MixedTest(ctx) be
//----------------------------------------------------------------------------
[
let dlb = ctx!3
let char = nil
[
while DLSInputEmpty(dlb) do OutputTest(ctx, true)
DLSResetOutput(dlb)
Wss(dlb, "*n*lEcho test (Escape to end): ")
char = 0
until char eq 33B do
[
char = DLSInput(dlb)
Puts(dlb, char)
PutTemplate(dsp, "*NLine $2O Char $3F0O = $C",
dlb>>DLB.line, char, char&177B)
]
] repeat
]
//----------------------------------------------------------------------------
and BufferedTest(ctx) be
//----------------------------------------------------------------------------
[
let dlb = ctx!3
let buffer = vec 80
Wss(dlb, "*n*lType text, end with Escape*n*l")
DLSResetInput(dlb)
let count = 0
while count ls 80 do
[
let char = Gets(dlb)
test char eq 33B
ifnot [ Puts(dlb, char); buffer!count = char; count = count+1]
ifso break
]
while Endofs(dlb) do for i = 0 to count-1 do Puts(dlb, buffer!i)
DLSResetOutput(dlb)
] repeat
//----------------------------------------------------------------------------
and FindLineSpeedsTest(ctx) be
//----------------------------------------------------------------------------
[
let dlb = ctx!3
while dlb>>DLB.carrierOff do Dismiss(10)
let char = DetermineDLSLineSpeed(dlb,
table [ 6; 2400; 1200; 600; 300; 150; 110 ],
table [ 4; 3; $E; $e; $*n ],
PleaseStop)
if PleaseStop() then Block() repeat
PutTemplate(dsp, "*nLine $2O: ", dlb>>DLB.line)
test char eq 0
ifso Ws("failed to discover speed")
ifnot PutTemplate(dsp, "char = $3F0O, speed = $D", char, dlb>>DLB.baud)
] repeat
//----------------------------------------------------------------------------
and PleaseStop() = pleaseStop
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and CarrierProc(dlb,newState) be
//----------------------------------------------------------------------------
PutTemplate(dsp, "*NLine $2O $S", dlb>>DLB.line, (newState? " On", " Off"))
//----------------------------------------------------------------------------
and GetNumber(radix) = valof
//----------------------------------------------------------------------------
[
let number = 0
[
let char = Gets(keys)
Puts(dsp, char)
if char ls $0 % char ge $0+radix then resultis number
number = radix*number+char-$0
] repeat
]
//----------------------------------------------------------------------------
and Wss(stream, string) be
//----------------------------------------------------------------------------
for i = 1 to string>>String.length do
Puts(stream, string>>String.char↑i)
//----------------------------------------------------------------------------
and Ws(string) be Wss(dsp, string)
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and CreateMultipleContexts(proc) be
//----------------------------------------------------------------------------
[
for i = 0 to numLines-1 do
if (lbTable!i)>>LBH.lineType ge ltData then
[
let ctx = InitializeContext(ctxTable!i, lCtxRegion, proc, 1)
ctx!3 = lbTable!i
ctx!0 = @mainCtx
@mainCtx = ctx
]
]
//----------------------------------------------------------------------------
and DestroyMultipleContexts() be
//----------------------------------------------------------------------------
[
@mainCtx=mainCtx
]
//----------------------------------------------------------------------------
and TimeToStop() = valof
//----------------------------------------------------------------------------
[
test Endofs(keys)
ifso resultis false
ifnot [ Gets(keys); resultis true ]
]