//diagnostic for the d0 tester.
//to load: bldr d0t format
//The keyboard keys 1 2 3 4 5 6 7 8 9 0 - = \ LF DEL (which are
//the top row on an altoI) complement a 15 bit register which
//may be sent to the tester on utilout by typing "S" (strobe)
//or "C" (continuous strobe).  Whenever any of the utilin bits
//change, they are displayed.

//other commands are "E (xamine pin)", which puts a square wave
//on the pin of your choice,
//"R" which tests the ram address register,
//"D", which tests ram data,
//and "P", which tests that all 256 pins can be driven and read.
//In any test, type q to get back to the top level.

//last modified 1/15/77 by C. Thacker

manifest
[
//bits and addresses for the tester
strobe=100000b
utilout = #177016
utilin = #177030

//states for an output pin
high = #7000
low = #6000
off = #2000
]

external
[
keys
dsp
FORMATN
Endofs
Puts
Gets
Ws
ResetLine
]

static
[
examinedpin
proceedonerror
pass
datum=0
ddatum=0
update=true
oldutilin=0
newutilin = 0
cont = false

]

let main() be
[
(635)

unless Endofs(keys) do
[
l4269
let ch = Gets(keys)
switchon (ch & #177) into
l5539
[
case $!:
case $1: ddatum = 40000b; endcase;

case $@:
case $2: ddatum = 20000b; endcase;

case $#:
case $3:  ddatum = 10000b; endcase;

case $$:
case $4: ddatum = 4000b; endcase;

case $%:
case $5: ddatum = 2000b; endcase;

case $~:
case $6: ddatum = 1000b; endcase;

case $&:
case $7: ddatum = 400b; endcase;

case $**:
case $8: ddatum = 200b; endcase;

case $(:
case $9: ddatum = 100b; endcase;

case $):
case $0: ddatum = 40b; endcase;

case $`:
case $-: ddatum = 20b; endcase;

case $+:
case $=: ddatum = 10b; endcase;

case $|:
case $\: ddatum =4; endcase;

case $*l: ddatum = 2; endcase;

case 177b: ddatum = 1; endcase;

case $s:
case $S: [ @utilout = datum; @utilout = datum xor strobe; @utilout = datum ] ; endcase

case $c:
case $C: cont = not cont; update = true; endcase

case $p:
case $P:  pass = 0; TestPins(); Ws(FORMATN("*nStopped in pass <UD>*n",pass)); update = true; endcase;

case $a:
case $A: pass = 0;Ws("*nRam Address Test, type any character to quit"); TestRamAddress(); Ws(FORMATN("*nStopped in pass <UD>*n",pass)); update = true; endcase;

case $d:
case $D: pass = 0;Ws("*nRam Data Test, type any character to quit"); TestRamData(); Ws(FORMATN("*nStopped in pass <UD>*n",pass)); update = true; endcase;

case $E:
case $e:  examinedpin = 0;ExaminePin();update = true;endcase;
l5539
]
l5539
]

if ddatum ne 0 do
l4269
[
datum = datum xor ddatum; ddatum = 0
update = true
]
l4269

if cont do
[ @utilout = datum; @utilout = datum xor strobe; @utilout = datum ]
l4269
newutilin = @utilin & #176000
if newutilin ne oldutilin do
[
oldutilin = newutilin
update = true
]
l4269
if update do
[
ResetLine(dsp);
Ws(FORMATN("datum: <BIN #3 $0>  <BIN #14 $0> <S>  Nibble: <BIN #4 $0> A: <BIN #1 $0> Pin: <BIN #1 $0> ",datum rshift 12, datum & #7777,(cont?"Strobe","Idle "), (newutilin rshift 12), (newutilin rshift 11) & 1, (newutilin rshift 10) &1))
update = false
]
l4269
] repeat

and TestPins() be
[

let newline = true
pass = pass+1
for i = 0 to 255 do
[
l4269
unless Endofs(keys) then return
if newline then Ws(FORMATN("*nPass <UD>, Testing Pin: ",pass))
Ws(FORMATN("  <OCT>",i))
SetPin(i,high) //drive high
if ReadPin(i) ne 1 then 
[l5539
Err("*nCouldnt set pin <OCT> to 1",i)
newline = true
loopl6809
]

RattleOther(i)
if ReadPin(i) ne 1 then 
[l5539
Err("*nPin <OCT> was disturbed to 0 while 1",i)
newline = true
loopl6809
]



SetPin(i,low) //drive low
if ReadPin(i) ne 0 then 
[l5539
Err("*nCouldnt set pin <OCT> to 0",i)
newline = true
loopl6809
]

RattleOther(i)
if ReadPin(i) ne 0 then 
[l5539
Err("*nPin <OCT> was disturbed to 1 while 0",i)
newline = true
loopl6809
]
newline = (i rem 8) eq 0l5539
]

l4269
] repeat

and Err(st,x) be
[
Ws(FORMATN(st,x))
Ws("*nType any character to proceed")
while Endofs(keys) do [ ] 
Gets(keys)l4269
]

and SetPin(pinno,value) be
[

let pindatum = pinno+value
@utilout = pindatum
@utilout = pindatum % strobe
@utilout = pindatum
l4269
]


and ReadPin(pinno) = valof
[

let outpin = pinno % #400
@utilout = outpin
@utilout = outpin % strobe
@utilout = outpin
resultis (@utilin rshift 11) & 1l4269

]

and RattleOther(j) be
[
for i = 0 to 255 do
[l4269
if i eq j then loop
SetPin(i,high)
SetPin(i,low)
SetPin(i,high)
SetPin(i,low)
SetPin(i,off)l5539
]l4269
]

and ExaminePin() be
[
Ws("*nExamine Pin: ")
let noinputyet = true

[l4269
while Endofs(keys) do loop
let ch = Gets(keys)

switchon ch into
[

case $0: 
case $1:
case $2:
case $3:
case $4:
case $5:
case $6:
case $7:
case $8:
case $9:  if noinputyet then examinedpin = 0;examinedpin = examinedpin*10 + ch -$0;noinputyet = false; endcase;
case $*l: 
[
test noinputyet
ifso [ examinedpin = examinedpin+1; noinputyet = false; Ws(FORMATN("<UD>*n",examinedpin)); break ] 
ifnot loop
]

case $*n: break
case $q: return
default: loop
]

Puts(dsp,ch)l5539
] repeat

if (noinputyet % (examinedpin gr 255)) then [ Ws(" ?*n") ;examinedpin = 0; loop ] 
let pinval = 0

while Endofs(keys) do
[
SetPin(examinedpin,pinval?high,low)
pinval = pinval xor 1
]


l4269
] repeat

and TestRamAddress() be
[
for i = 0 to 1023 do
[l4269
LoadRamAddress(i)
let data = ReadRamAddress()
if data ne i do Ws(FORMATN("*nRamAddress should have been <OCT> but was <OCT>",i,data))
if not Endofs(keys) then returnl5539
]
Ws("A"); pass = pass+1
l4269
] repeat

and TestRamData() be
[
//cycled 1's test
let spat = 1
until spat eq 0 do
[l4269
let tpat = spat
for i = 0 to 1023 do
[l5539
LoadRamData(i,tpat)
tpat = lcyc(tpat)l6809
]

tpat = spat
for i = 0 to 1023 do
[l5539
let data = ReadRamData(i)
if data ne tpat do
Ws(FORMATN("*nAddr <OCT>: data should be <OCT>, but was <OCT>",i,tpat,data))
tpat = lcyc(tpat)
if not Endofs(keys) then returnl6809
]
spat = spat lshift 1
l5539
]
//cycled 0's test
let spat = -2
until spat eq -1 do
[l4269
let tpat = spat
for i = 0 to 1023 do
[l5539
LoadRamData(i,tpat)
tpat = lcyc1(tpat)l6809
]

tpat = spat
for i = 0 to 1023 do
[l5539
let data = ReadRamData(i)
if data ne tpat do
Ws(FORMATN("*nAddr <OCT>: data should be <OCT>, but was <OCT>",i,tpat,data))
tpat = lcyc1(tpat)
if not Endofs(keys) then returnl6809
]
spat = (spat lshift 1) % 1l5539
]
Ws("D"); pass = pass+1l4269
l5539
] repeat

and lcyc(d) = valof
[
d = d lshift 1
if d eq 0 then resultis 1
resultis dl4269
]

and lcyc1(d) = valof
[
d = (d lshift 1) % 1
if d eq -1 then resultis -2
resultis dl4269
]

and LoadRamAddress(addr) be
[
let val = #20000+addr
@utilout = val
@utilout = val % strobe
@utilout = vall4269
]

and ReadRamAddress() = valof
[
let data = 0
for i = 0 to 2 do
[l4269
@utilout = i + #52000
data = data % (((@utilin) & #170000) rshift (4*(i+1)))l5539
]
resultis datal4269
]

and LoadRamData(addr,data) be
[
LoadRamAddress(addr)
let val = (data & #377)% #32000
@utilout = val
@utilout = val%strobe
@utilout = val
val = (data rshift 8) % #34000
@utilout = val
@utilout = val % strobe
@utilout = val
l4269
]

and ReadRamData(addr) = valof
[
LoadRamAddress(addr)
let data = 0
for i = 0 to 3 do
[l4269
@utilout = #51000+i
data = data % (((@utilin) & #170000) rshift (4*i))l5539
]
resultis datal4269
]