//tc.bcpl
//preprocessor for tester programs
//load: tc preprocb pintab mdi format
//last modified October 18, 1977 by C. Thacker
get "sysdefs.d"
manifest
[
Nfiles = 5
htsize = 64
DirPreambleSize=6
ksTypeReadOnly=1
ksTypeWriteOnly=2
ksTypeReadWrite=3
verLatestCreate=#40000+2
//states of the input
Idle = 0
GotSlash = 1
DoingComment = 2
DoingBusName = 3
DoingBusPinName = 4
GettingName = 5
HaveName = 6
GetRHS = 7
RHSname = 8
//signal types
BusName=0
ExtSig=1 //signal hooked to an edgepin
IntSig=2 //signal in bp file, with clip number
UnkSig = 3 //signal not known to program
]
external
[
SetUpPinTab
pintab
CSN //defined in preprocb
SpaceTop
DefineSymbol
hashtab
Lookup
NewItem
StEq
WSS
AppendC
AppendS
TruncateDiskStream
Resets
OpenFileFromFp
fpUserCm
fpSysDir
fpComCm
fpRemCm
Usc
InitializeZone
OpenFile
Puts
Closes
MoveBlock
Gets
Zero
CallSwat
Endofs
keys
Junta
CounterJunta
LookupEntries
FORMATN
]
static
[
pst = false //print symbol table
L
R
squeezespaces = false
pintab
errors = 0
input //stream
output //stream
state //for automaton
namebuf //buffer for names
name2buf //another one
linebuf // buffer for line after "="
nbpins //number of pins in bus declaration
Lprvec
filecount
outopen = false
NullName = 0
Epins
Cans = 0
Boardvec
hashtab
SilZone
NewItem
Space//size of object space
SpaceBase //base of space
SpaceTop
]
structure str:
[
length byte
char↑1,255 byte
]
structure strec:
[
link word
type byte
npins byte
value word
st @str
]
let Main() be
[
@#420 = 0 //turn off display for speed
let comcm = OpenFile("COM.CM",ksTypeReadOnly,1,0,fpComCm,0) //bytes
if comcm eq 0 then CallSwat("Can’t open COM.CM")
let fn = vec 128
ReadNext(comcm,fn) //throw away name
let fnl = fn>>str.length
Lprvec = @#335
@#335 = (@#335)+ Nfiles*DirPreambleSize
SilZone = @#335
@#335 = (@#335)+ 2000
SilZone = InitializeZone(SilZone,2000)
let namevec = vec Nfiles
let libvec = vec 25*Nfiles //25 word name vectors
Zero (libvec, 25*Nfiles)
filecount = 0
while filecount le Nfiles-1 do
[
let filestring = libvec + (25*filecount)
namevec!filecount = filestring
unless ReadNext(comcm,filestring) then break
filecount = filecount+1
]
Closes(comcm)
let q = OpenFileFromFp(fpSysDir)
if q eq 0 then CallSwat("Can’t Open SysDir")
let nfound = LookupEntries(q,namevec,Lprvec,filecount,true)
Closes(q)
if nfound gr 0 then
[
CallSwat("Can’t find all your files")
finish
]
//Lprvec now contains fp’s for all the input files
//Open the output and error files
output = GetFile(namevec!0,".tbcpl",1) //can count
Junta(levKeyboard,InitAna)
]
and InitAna(arg) be
[
//init symbol table
hashtab = MakeSpace(htsize,0)
//use remaining space for the objects
Space = ((lv arg) - @#335)-3000 //leave 3000 words for the stack
if Usc(Space,2000) ls 0 then CallSwat("Insufficient Object Storage")
SpaceBase = MakeSpace(Space,0)
SpaceTop = (@#335)-128 //leave margin for error
NewItem = SpaceBase
FileIn(1) //file 1 is the backpanel file --fill in the symbol table
input =OpenFile(0,ksTypeReadOnly,1,0,Lprvec+1,0,SilZone)
if input eq 0 then CallSwat("*nCan’t open source file") //file 0
SetUpPinTab()
Preprocess()
WSS(output,"*n*n//UNKNOWN SIGNALS REQUIRED:")
for i = 0 to htsize-1 do
[
let link = hashtab!i
until link eq 0 do
[
if link>>strec.type eq UnkSig do
[
WSS(output,FORMATN("*n//TEST CLIP ? -> (<S>)",lv link>>strec.st))
errors = errors+1
]
if pst do PrintSymbol(link,output)
link = @link
]
]
TruncateDiskStream(output)
Closes(output)
CounterJunta(SpeakVersion)
]
and SpeakVersion() be
[
external Ws
Ws(FORMATN("*n*n*n*n <D> ERRORS", errors))
finish
]
and MakeSpace(amount,firstword) = valof
[
if amount eq 0 then resultis 0
let base = @#335
@#335 = @#335+amount+1
Zero(base,amount+1)
base!0 = firstword
resultis base
]
and ReadNext(stream,string) = valof
[
let ch = $*s
if Endofs(stream) then resultis false
until (Endofs(stream)%(ch gr $*s))do ch = Gets(stream)
if ch le $*s then resultis false
string>>str.length = 1
string>>str.char↑1 = ch
[
if Endofs(stream) then break
ch = Gets(stream)
if ch le $*s then break
let sl = string>>str.length+1
string>>str.char↑sl = ch
string>>str.length = sl
] repeat
resultis true
]
and FileIn(xi) be
[
let ins = OpenFile(0,ksTypeReadOnly,1,0,Lprvec+DirPreambleSize*xi+1,0,SilZone)
if ins eq 0 then CallSwat("*nCan’t open input file")
let line = vec 128
let namestr = vec 128 //place for signal name
let pinstr = vec 30 //place for pin string
let tpstr = vec 30
let gotepin = false
let index = nil
let tpin = nil //tester pin for internal signal
let pinno = 0
[
ReadLine(ins,line)
index= 1
if line>>str.length eq 0 then loop
namestr!0=0
ReadTo(line,$:,lv index,namestr) //get signal name
pinstr!0=0
let nocomma = ReadTo(line,$,,lv index,pinstr) //get can id if not epin
unless nocomma do [ tpstr!0=0;ReadTo(line,$*n,lv index, tpstr); tpin = CSN(tpstr) ]
pinno = StringToPin(pinstr,lv gotepin)
test gotepin
ifso DefineSymbol(namestr,ExtSig,pinno)
ifnot
[
let stp =DefineSymbol(namestr,IntSig,pinno)
stp>>strec.npins = tpin
]
] repeatuntil Endofs(ins)
]
and StringToPin(string,lvepinflag) = valof
[
let ch = string>>str.char↑1
if (ch eq $C)%(ch eq $E) then
[
@lvepinflag = true
string>>str.char↑1 = $0
resultis CSN(string) + (ch eq $C?1000,0)
]
let index = 2 //string is of the form letternumber.number; tear it apart
let pinlet = string>>str.char↑1
let nvec = vec 5;nvec!0=0
ReadTo(string,$.,lv index,nvec)
let numa = CSN(nvec)
nvec!0=0
ReadTo(string,$X,lv index,nvec)
let numb = CSN(nvec)
@lvepinflag =false
resultis ((pinlet-$a) lshift 11)+(numa lshift 5)+numb
]
and ReadLine(stream,string) be
[
let index = 1; let ch = 0
[
if Endofs(stream) then [ if index eq 1 then string!0=0; return ]
let ch = Gets(stream)
if ch eq $*n then [ string>>str.length = index-1;return ]
string>>str.char↑index = ch
index = index+1
] repeat
]
and GetFile(fname,ext,byteword) = valof //1 for bytes,0 for words
[
let v = vec 128
let j = 0
until j eq fname>>str.length do //remove the original extension if there is one
[
let ch = fname>>str.char↑(j+1)
if ch eq $. then break
j = j+1
v>>str.char↑j = ch
]
v>>str.length = j
AppendS(ext,v) //add the extension
let stream = OpenFile(v,ksTypeReadWrite,byteword,0,0,0,SilZone)
if stream eq 0 then CallSwat("Can’t Open ",v)
resultis stream
]
and ReadTo(src,stopchar,lvIndex,dest ; numargs na) = valof
[
let max = src>>str.length
[
if @lvIndex gr max then resultis true
let ch = src>>str.char↑(@lvIndex) //read char
@lvIndex = @lvIndex+1
if ch eq $*s then loop //strip leading spaces
if ch eq $*t then loop //and tabs
if ch eq stopchar then resultis false
if na gr 3 then AppendC(ch,dest)
] repeat
]
and Preprocess() be
[
//set up dispatch vector
let StateVec = vec 20
StateVec!Idle = fnIdle
StateVec!GotSlash = fnGotSlash
StateVec!DoingComment = fnDoingComment
StateVec!DoingBusName = fnDoingBusName
StateVec!DoingBusPinName = fnDoingBusPinName
StateVec!GettingName = fnGettingName
StateVec!HaveName = fnHaveName
StateVec!GetRHS = fnGetRHS
StateVec!RHSname = fnRHSname
let xx = vec 128; namebuf = xx //buffer for names
let xx = vec 128; name2buf = xx //another one
let xx = vec 128; linebuf = xx //buffer for line after "="
state = Idle
until Endofs(input) do
[
let char = Gets(input)
(StateVec!state)(char)
]
]
and fnIdle(char) be
[
if char eq ${ then
[ namebuf!0=0; state = GettingName;return ]
if char eq $/ then state = GotSlash
Puts(output,char)
]
and fnGotSlash(char) be
[
if char eq ${ then [ namebuf!0=0; state = GettingName; return ]
if char eq $/ then state = DoingComment
Puts(output,char)
]
and fnDoingComment(char)be
[
switchon char into
[
case ${: state =DoingBusName; namebuf!0=0;endcase
case $*n:
case $;: state = Idle; endcase;
]
Puts(output,char)
]
and fnDoingBusName(char) be
[
switchon char into
[
case $:: state = DoingBusPinName; nbpins = 0; name2buf!0=0; endcase;
case $}: state = DoingComment; endcase
default: AppendC(char,namebuf); endcase
]
Puts(output,char)
]
and fnDoingBusPinName(char) be
[
switchon char into
[
case $,:
[
//look up the pin name and add it to the bus descriptor
AddBusPin()
name2buf!0=0 //clear buffer
]
endcase
case $}:
[
AddBusPin()
DoBusDeclaration()
state = DoingComment
]
endcase
case $*s:
case $*t: endcase //skip space,tab
default: AppendC(char,name2buf); endcase
]
Puts(output,char)
]
and fnGettingName(char)be
[
switchon char into
[
case $*s:
case $*t: return
case $}: state = HaveName; return
default: AppendC(char,namebuf)
]
]
and fnHaveName(char) be
[
switchon char into
[
case $*s:
case $*t: return
case $=: linebuf!0=0; state = GetRHS;squeezespaces=true; return;
default: EmitTesterRead(); state = Idle; Puts(output,char)
]
]
and fnGetRHS(char) be
[
switchon char into
[
case $*n:
case $;: EmitTesterWrite(); state = Idle; Puts(output,char); return;
case ${: state = RHSname;name2buf!0=0; return;
case $*s: if squeezespaces then return
default: AppendC(char,linebuf); squeezespaces = false
]
]
and fnRHSname(char)be
[
switchon char into
[
case $*n:
case $*s:
case $*t: return
case $}:
[
let rstr = vec 128
rstr!0=0
FormatRead(name2buf,rstr)
AppendS(rstr,linebuf)
state=GetRHS;return;
]
default: AppendC(char,name2buf)
]
]
and AddBusPin() be
[
let pnamestp = Lookup(name2buf)
if pnamestp eq 0 then pnamestp = DefineSymbol(name2buf,UnkSig,0)
if pnamestp>>strec.type eq BusName then
[
WSS(output,FORMATN("*nERROR-Name is already defined as a bus name: <S>*n",name2buf))
errors = errors+1
return
]
NewItem!nbpins = pnamestp
nbpins = nbpins+1
]
and DoBusDeclaration() be
[
let bnamestp = Lookup(namebuf)
if bnamestp ne 0 then //used before for something
[
WSS(output,FORMATN("*nERROR-Bus name already used: <S>*n",namebuf))
errors = errors+1
return
]
let tni = NewItem
NewItem = NewItem+nbpins // these locations have stp’s to the pins
let stp = DefineSymbol(namebuf,BusName,tni,nbpins)
]
and EmitTesterRead()be
[
let rstr = vec 128
rstr!0=0
FormatRead(namebuf,rstr)
WSS(output,rstr)
]
and EmitTesterWrite()be
[
let stp = Lookup(namebuf)
if stp eq 0 then stp = DefineSymbol(namebuf,UnkSig,0)
let vs = nil
test StEq(linebuf,"###") ifso //check for open pin command
[
vs = "Open"
linebuf!0=0
]
ifnot vs = "Value"
let stype = stp>>strec.type
switchon stype into
[
case BusName:
[
let nbpins = stp>>strec.npins
let valp = stp>>strec.value
WSS(output,FORMATN(" SetBus<S>(<D>",vs,nbpins))
for i = 0 to nbpins-1 do
[
let pintype = (valp!i)>>strec.type
if pintype ne ExtSig then
[
WSS(output,FORMATN("*nERROR-Cannot drive non-edge pin: <S>*n",lv (valp!i)>>strec.st))
errors = errors+1
loop
]
let pinno=(valp!i)>>strec.value
WSS(output,FORMATN(",<D>",pintab!pinno))
]
if linebuf!0 ne 0 do
[
WSS(output,",")
WSS(output,linebuf)
]
WSS(output,")")
]
endcase
case UnkSig:
case IntSig:
WSS(output,FORMATN("*nERROR-Cannot drive non-edge pin: <S>*n",lv stp>>strec.st))
errors = errors+1;return;
case ExtSig: WSS(output,FORMATN(" SetPin<S>(<D>",vs,pintab!(stp>>strec.value)))
if linebuf!0 ne 0 do
[
WSS(output,",")
WSS(output,linebuf)
]
WSS(output,")")
]
]
and FormatRead(name,outs)be
[
let stp = Lookup(name)
if stp eq 0 then stp = DefineSymbol(name,UnkSig,0)
let stype = stp>>strec.type
switchon stype into
[
case BusName:
[
let valp = stp>>strec.value //pointer to block of pin pointers
let nbpins = stp>>strec.npins
AppendS(FORMATN("GetBusValue(<D>",nbpins),outs)
for i = 0 to nbpins-1 do
[
let pintype = (valp!i)>>strec.type
switchon pintype into
[
case ExtSig: //pin number is the value
AppendS(FORMATN(",<D>",pintab!((valp!i)>>strec.value)),outs)
loop
case UnkSig:
case IntSig: //pin number is npins
AppendS(FORMATN(",<D>",pintab!(200+(valp!i)>>strec.npins)),outs)
loop
]
]
AppendC($),outs)
]
endcase;
case UnkSig:
case IntSig:
AppendS(FORMATN("GetPinValue(<D>)",pintab!(200+(stp>>strec.npins))),outs)
return
case ExtSig:
AppendS(FORMATN("GetPinValue(<D>)",pintab!(stp>>strec.value)),outs)
return
]
]
and PrintSymbol(stp,out) be
[
let typex = selecton stp>>strec.type into
[
case BusName: "BusName"
case ExtSig: "ExtSig"
case IntSig: "IntSig"
case UnkSig: "UnkSig"
default: "ERROR"
]
WSS(out,FORMATN("*n//<S>: type =<S> npins=<D> value=<D>",lv stp>>strec.st,typex,stp>>strec.npins,stp>>strec.value))
]