//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: [(635)\f1 577f0 5f1 length byte char^1,255 bytel4268\f1 ] structure strec: [\f1 link word type byte npins byte value word st @strl4268\f1 ] let Main() be [\f1 @#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 [l4268\f1 let filestring = libvec + (25*filecount) namevec!filecount = filestring unless ReadNext(comcm,filestring) then break filecount = filecount+1l5538\f1 ] 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 [l4268\f1 CallSwat("Can't find all your files") finishl5538\f1 ] //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)l4268\f1 ] and InitAna(arg) be [ \f1 //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 [l4268(1270)\f1 let link = hashtab!i until link eq 0 do [l5538\f1 if link>>strec.type eq UnkSig do [l8078\f1 WSS(output,FORMATN("*n//TEST CLIP ? -> ()",lv link>>strec.st)) errors = errors+1 l9348\f1 ] if pst do PrintSymbol(link,output) link = @linkl8078\f1 ]l5538\f1 ] TruncateDiskStream(output) Closes(output) CounterJunta(SpeakVersion)l4268(635)\f1 ] l4268(1270)\f1 and SpeakVersion() be [(635)\f1 external Ws Ws(FORMATN("*n*n*n*n ERRORS", errors)) finishl4269\f1 ] and MakeSpace(amount,firstword) = valof [\f1 if amount eq 0 then resultis 0 let base = @#335 @#335 = @#335+amount+1 Zero(base,amount+1) base!0 = firstword resultis basel4269\f1 ] and ReadNext(stream,string) = valof [\f1 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 [l4268\f1 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 = sll5538\f1 ] repeat resultis truel4268\f1 ] and FileIn(xi) be [\f1 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 [l4269\f1 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 [l5539\f1 let stp =DefineSymbol(namestr,IntSig,pinno) stp>>strec.npins = tpinl6809\f1 ]l5539\f1 ] repeatuntil Endofs(ins) l4269\f1 ] and StringToPin(string,lvepinflag) = valof [\f1 let ch = string>>str.char^1 if (ch eq $C)%(ch eq $E) then [l4269\f1 @lvepinflag = true string>>str.char^1 = $0 resultis CSN(string) + (ch eq $C?1000,0)l5539\f1 ] 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)+numbl4269\f1 ] and ReadLine(stream,string) be [\f1 let index = 1; let ch = 0 [l4269\f1 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+1l5539\f1 ] repeat l4269\f1 ] and GetFile(fname,ext,byteword) = valof //1 for bytes,0 for words [\f1 let v = vec 128 let j = 0 until j eq fname>>str.length do //remove the original extension if there is one [l4268\f1 let ch = fname>>str.char^(j+1) if ch eq $. then break j = j+1 v>>str.char^j = chl5538\f1 ] 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 streaml4268\f1 ] and ReadTo(src,stopchar,lvIndex,dest ; numargs na) = valof [\f1 let max = src>>str.length [l4269\f1 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)l5539\f1 ] repeatl4269\f1 ] and Preprocess() be [\f1 //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 [l4269\f1 let char = Gets(input) (StateVec!state)(char)l5539\f1 ]l4269\f1 ] and fnIdle(char) be [\f1 if char eq ${ then [ namebuf!0=0; state = GettingName;return ] if char eq $/ then state = GotSlash Puts(output,char)l4269\f1 ] and fnGotSlash(char) be [\f1 if char eq ${ then [ namebuf!0=0; state = GettingName; return ] if char eq $/ then state = DoingComment Puts(output,char)l4269\f1 ] and fnDoingComment(char)be [\f1 switchon char into [l4269\f1 case ${: state =DoingBusName; namebuf!0=0;endcase case $*n: case $;: state = Idle; endcase;l5539\f1 ] Puts(output,char)l4269\f1 ] and fnDoingBusName(char) be [\f1 switchon char into [l4269\f1 case $:: state = DoingBusPinName; nbpins = 0; name2buf!0=0; endcase; case $}: state = DoingComment; endcase default: AppendC(char,namebuf); endcasel5539\f1 ]l4269\f1 Puts(output,char)l4269\f1 ] and fnDoingBusPinName(char) be [\f1 switchon char into [l4269\f1 case $,: [l5539\f1 //look up the pin name and add it to the bus descriptor AddBusPin() name2buf!0=0 //clear buffer ] endcase case $}: [l5539\f1 AddBusPin() DoBusDeclaration() state = DoingCommentl6809\f1 ] endcase case $*s: case $*t: endcase //skip space,tab default: AppendC(char,name2buf); endcasel5539\f1 ]l4269\f1 Puts(output,char)l4269\f1 ] \f1 and fnGettingName(char)be [\f1 switchon char into [l4269\f1 case $*s: case $*t: return case $}: state = HaveName; return default: AppendC(char,namebuf)l5539\f1 ] l4269\f1 ] and fnHaveName(char) be [\f1 switchon char into [l4269\f1 case $*s: case $*t: return case $=: linebuf!0=0; state = GetRHS;squeezespaces=true; return; default: EmitTesterRead(); state = Idle; Puts(output,char)l5539\f1 ]l4269\f1 ] \f1 and fnGetRHS(char) be [\f1 switchon char into [l4269\f1 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 = falsel5539\f1 ]l4269\f1 ] and fnRHSname(char)be [\f1 switchon char into [l4269\f1 case $*n: case $*s: case $*t: return case $}: [l5539\f1 let rstr = vec 128 rstr!0=0 FormatRead(name2buf,rstr) AppendS(rstr,linebuf) state=GetRHS;return;l5539\f1 ] default: AppendC(char,name2buf)l5539\f1 ]l4269\f1 ] and AddBusPin() be [\f1 let pnamestp = Lookup(name2buf) if pnamestp eq 0 then pnamestp = DefineSymbol(name2buf,UnkSig,0) if pnamestp>>strec.type eq BusName then [l4269\f1 WSS(output,FORMATN("*nERROR-Name is already defined as a bus name: *n",name2buf)) errors = errors+1 returnl5539\f1 ] NewItem!nbpins = pnamestp nbpins = nbpins+1l4269\f1 ] and DoBusDeclaration() be [\f1 let bnamestp = Lookup(namebuf) if bnamestp ne 0 then //used before for something [l4269\f1 WSS(output,FORMATN("*nERROR-Bus name already used: *n",namebuf)) errors = errors+1 returnl5539\f1 ] let tni = NewItem NewItem = NewItem+nbpins // these locations have stp's to the pins let stp = DefineSymbol(namebuf,BusName,tni,nbpins) l4269\f1 ] and EmitTesterRead()be [\f1 let rstr = vec 128 rstr!0=0 FormatRead(namebuf,rstr) WSS(output,rstr)l4269\f1 ] \f1 and EmitTesterWrite()be [\f1 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 [l4269\f1 case BusName: [l5539\f1 let nbpins = stp>>strec.npins let valp = stp>>strec.value WSS(output,FORMATN(" SetBus(",vs,nbpins)) for i = 0 to nbpins-1 do [l6809\f1 let pintype = (valp!i)>>strec.type if pintype ne ExtSig then [l8079\f1 WSS(output,FORMATN("*nERROR-Cannot drive non-edge pin: *n",lv (valp!i)>>strec.st)) errors = errors+1 loopl9349\f1 ] let pinno=(valp!i)>>strec.value WSS(output,FORMATN(",",pintab!pinno))l8079\f1 ] if linebuf!0 ne 0 do [ WSS(output,",") WSS(output,linebuf) ] WSS(output,")")l6809\f1 ] endcase case UnkSig: case IntSig: WSS(output,FORMATN("*nERROR-Cannot drive non-edge pin: *n",lv stp>>strec.st)) errors = errors+1;return; case ExtSig: WSS(output,FORMATN(" SetPin(",vs,pintab!(stp>>strec.value))) if linebuf!0 ne 0 do [ WSS(output,",") WSS(output,linebuf) ] WSS(output,")")l5539\f1 ]l4269\f1 ] \f1 and FormatRead(name,outs)be [\f1 let stp = Lookup(name) if stp eq 0 then stp = DefineSymbol(name,UnkSig,0) let stype = stp>>strec.type switchon stype into [l4269\f1 case BusName: [l5539\f1 let valp = stp>>strec.value //pointer to block of pin pointers let nbpins = stp>>strec.npins AppendS(FORMATN("GetBusValue(",nbpins),outs) for i = 0 to nbpins-1 do [l6809\f1 let pintype = (valp!i)>>strec.type switchon pintype into [l8079\f1 case ExtSig: //pin number is the value AppendS(FORMATN(",",pintab!((valp!i)>>strec.value)),outs) loop case UnkSig: case IntSig: //pin number is npins AppendS(FORMATN(",",pintab!(200+(valp!i)>>strec.npins)),outs) loopl9349\f1 ]l8079\f1 ] AppendC($),outs)l6809\f1 ] endcase; case UnkSig: case IntSig: AppendS(FORMATN("GetPinValue()",pintab!(200+(stp>>strec.npins))),outs) return case ExtSig: AppendS(FORMATN("GetPinValue()",pintab!(stp>>strec.value)),outs) return l5539\f1 ]l4269\f1 ] 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//~~: type = ~~npins= value=",lv stp>>strec.st,typex,stp>>strec.npins,stp>>strec.value)) ] \f1~~~~