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