// 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 ] ]