//goba.bcpl
// replace F-family by N-family
// correction of VCC & GND pickup for D7, D11, D14
// last modified by S Tom Chang, February 10, 1979 4:40 PM

get "sysdefs.d"
get "gob.defs"
manifest
[
Nfiles = 75 //maximum number of .NL files

]
external
[
TruncateDiskStream
LookUpEntries
]

static
[
Correcting = false
Gndvec //space for SVolt source pin vectors
Vccvec
Veevec
Vttvec
Vddvec

BoardType
Lprvec
filecount
termstp
outopen = false
NullName = 0
Epins
Boardvec
hashtab
ADFile
BpFile
ErFile
OldWlFile
OutFile

SilZone
NewItem
Space
//size of object space
SpaceBase //base of space
SpaceTop
]


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
BoardType= fn>>str.char↑fnl; let nlc = fn>>str.char↑(fnl-1)
if (nlc ne $/)&(nlc ne $\) then [ CallSwat("No board type switch?"); finish ]
if nlc eq $\ then Correcting = true
if BoardType ge $a then BoardType = BoardType- ($a-$A) //capitalize smalls
SetUpBoardType(BoardType) //plug board specific functions into statics (gobc.bcpl)
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)
StandardMetric = ManhattanDistFn
filecount = 0
while filecount le Nfiles-1 do
[
let filestring = libvec + (25*filecount)
namevec!filecount = filestring
unless ReadNext(comcm,filestring) then break
unless IsFunnyParameter(filestring) do 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 ne 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
let outext=".wl"
if Correcting then
[
outext=".wlNew"
OldWlFile = GetFile(namevec!0,".wl",1)
//For comparison
ADFile = GetFile(namevec!0,".ad",1) //add delete list
]
OutFile = GetFile(namevec!0,outext,1) //wire list
ErFile = GetFile(namevec!0,".ge",1) //gobble errors
BpFile = GetFile(namevec!0,".bp",1) //backpanel list
Junta(levKeyboard,InitAna)
]


and InitAna(arg) be
[

//init symbol table
hashtab = MakeSpace(htsize,0)

//init boardvec
let maxcomps = 26*(maxn+1) //size of boardvec
Boardvec = MakeSpace(maxcomps,0)

//SetUpBoardType provided a vector containing the amount of space
//required for the SVolt source pins GND,VCC,VEE,VTT,VDD. Make the space:
Gndvec = MakeSpace(SVoltReq!0,-3)
Vccvec = MakeSpace(SVoltReq!1,-4)
Veevec = MakeSpace(SVoltReq!2,-5)
Vttvec = MakeSpace(SVoltReq!3,-6)
Vddvec = MakeSpace(SVoltReq!4,-7)

Puts(OutFile,BoardType); Puts(OutFile, $*n)

//init epin vec
Epins = MakeSpace(2*MaxEpins,-2)

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

//now do the real work on all the files
termstp = DefineSymbol("Terminator-8pin")
for i = 0 to filecount-1 do FileIn(i) //read the input file
if Correcting do //
[
if Gets(OldWlFile) ne BoardType then [ CallSwat("Board type differs from original"); finish ]
WSS(ADFile,"*n*n@")
WSS(ADFile,TableZeroString)
]
AddPotentialTerms()
Output()
TruncateDiskStream(OutFile)
Closes(OutFile)
TruncateDiskStream(ErFile)
Closes(ErFile)
TruncateDiskStream(BpFile)
Closes(BpFile)
if Correcting then [ TruncateDiskStream(ADFile);Closes(ADFile) ]
CounterJunta(SpeakVersion)
]

and SpeakVersion() be
[
external Ws
Ws("*n*n*n*n*nGOBBLE February 10, 1979")
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 IsFunnyParameter(string) = valof
[
let lastSlashPos = 0
for i=1 to string>>str.length do
if string>>str.char↑i eq $/ then lastSlashPos = i

if lastSlashPos eq 0 then resultis false

string>>str.length = lastSlashPos-1
switchon string>>str.char↑(lastSlashPos+1) into
[ case $h:
case $H:
heuristicWork = CSN(string)
endcase

case $m:
case $M:
StandardMetric = selecton string>>str.char↑1 into
[ case $M:
case $m:ManhattanDistFn

case $E:
case $e:EuclideanDistFn

default:ManhattanDistFn
]
endcase

case $E:
case $e:
exhaustThresh = CSN(string)
endcase

default:
]

resultis true
]


and FileIn(xi) be
[
let printv = vec 20; printv!0=0
AppendS("*nReading file ",printv)
AppendN(xi+1,printv)
WSS(ErFile,printv)
let ins = OpenFile(0,ksTypeReadOnly,1,0,Lprvec+DirPreambleSize*xi+1,0,SilZone)
if ins eq 0 then
[
CallSwat("Can’t Open Input File")
finish
]

let erv = vec 50
//Read components and board locations
[
let boardloc = ReadBloc(ins)
if boardloc eq -1 then break
let typev = vec 3
ReadType(ins,typev) //v!0=stp for name, v!1=npins, v!2 = family
let boardptr = Boardvec!boardloc

//check legality of the board position called for
if not LegalBloc(boardloc) then
[
erv!0=0
AppendS("*nIllegal board position specified: ",erv)
AppendBL(boardloc,erv)
WSS(ErFile,erv)
loop
]

test boardptr eq 0 //this position used yet?
ifso //no
[
//make a board location descriptor for this component
//first check that the maximum number of pins required
//by the IC is not greater than the number available at
//the specified position
let pospins = GetBoardPins(boardloc)
if pospins ls typev!1 then
[
erv!0=0
AppendS("*nIC at board position ",erv)
AppendBL(boardloc,erv)
AppendS(" has more pins than available on the board",erv)
WSS(ErFile,erv)
loop
]

AssignIC(typev!1,typev!2,typev!0,boardloc)

]
ifnot //yes
[
//check that the type is equal to that previously defined for this position
let typestp = boardptr>>icdesc.stp
if typestp ne typev!0 then
[
erv!0 = 0
AppendS("*nBoard location ",erv)
AppendBL(boardloc,erv)
AppendS(" has multiple IC types assigned",erv)
WSS(ErFile,erv)
loop
]
]
] repeat //until all components have been read

Gets(ins) //read over cr following @

//read signal names and nodes
[
let snv = vec 128; snv!0 = 0
if Endofs(ins) then break
let ch = Gets(ins)
if ch eq $; % ch eq $| then [ CopyLine(ins, ch); loop ]
[
if ch eq $: then break
AppendC(ch,snv)
ch = Gets(ins)
] repeat //until signal name read

if (snv>>str.length eq 1)&(snv>>str.char↑1 eq $*s) then //assign a name to the signal
[
snv!0 = 0
AppendS("XXX",snv)
AppendFN(NullName,snv)
NullName = NullName+1
]
let svnet = NetHasSVolt(snv) //returns net ID character if special, else 0

let nameptr = 0
if svnet eq 0 then nameptr=lv((DefineSymbol(snv))>>strec.list)

//read all the nodes associated with this name
[
if GetNode(ins, nameptr,svnet) then break
] repeat //until all nodes read
] repeat //until all signal names done

Closes(ins)

]

// Used to copy comment and special lines from .NL to .WL & .AD files:

and CopyLine(inStream, ch) be
[
Puts(OutFile,ch)
if Correcting then Puts(ADFile, ch)
if ch eq $*n then break
if Endofs(inStream) then break
ch=Gets(inStream)
] repeat

and AssignIC(npins,ictype,icstp,bl) be
[

//must assign as many pin
//slots in the descriptor as there are pin positions on the BOARD, not
//the chip, since from now on we will convert chip pin numbers
//into board pin numbers
let nbpins = GetBoardPins(bl)

let icbl = icdsize+nbpins+1
CheckFit(icbl)
Zero(NewItem,icbl) //clear all fields
NewItem>>icdesc.npins = npins
NewItem>>icdesc.ictype= ictype
NewItem>>icdesc.stp = icstp
NewItem>>icdesc.bl = bl

NewItem>>icdesc.mark = -1
Boardvec!bl = NewItem
NewItem= NewItem+icbl
]

and AppendFN(num,str) be
[
let rtab = table [ 10000; 1000; 100;10; 1; ]
for i = 0 to 4 do
[
let radp = rtab!i
if radp gr num then
[
AppendC($0,str)
loop
]

//number ge radp
let ch = $0
until num ls radp do
[
ch = ch+1
num = num-radp
]
AppendC(ch,str)
]

]


and AppendBL(bl,vect) be
[
AppendC((bl rem 26)+$a,vect)
AppendN(bl/26,vect,2)
]

and StEq(s1,s2) = valof //string compare
[
for i = 0 to s1>>str.length do
if s1>>bytes.bite↑i ne s2>>bytes.bite↑i then resultis false
resultis true
]


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 ReadBloc(stream) = valof
[
//first character is a letter, last char(s) are number.
let ch = Gets(stream)
if ch eq $@ then resultis -1
if ch eq $*n then loop
if ch eq $; % ch eq $| then [ CopyLine(stream, ch); loop ]
let blet = ch-$a
let boardloc = 0
[
ch = Gets(stream); if ch eq $: then break
boardloc = boardloc*10+(ch-$0)
] repeat //until all board location read
resultis boardloc*26 + blet
] repeat

and ReadType(str,typev) be
[
let ch = 0
until ch eq $( do ch = Gets(str) //read up to left paren
let typen = vec 50; typen!0= 0
[
ch = Gets(str)
if (ch eq $/) %(ch eq $)) then break
AppendC(ch,typen)
] repeat
if ch eq $) then
[
WSS(ErFile, "*nmissing REAL NAME")
Closes(ErFile)
finish
]
let npins =0
[
ch = Gets(str)
if ch eq $/ then break
npins = npins*10 + (ch-$0)
] repeat

let family = Gets(str) //single letter
if family eq $F then family = $N
until ch eq $*n do ch = Gets(str) //discard rest of line

let tstp = DefineSymbol(typen)
typev!0 = tstp
typev!1 = npins
typev!2 = family-$A
]

and GetNode(st,chain,svnet) = valof
[
let node = vec 10;node!0 = 0;
let ch = $*n
[
if Endofs(st) then break
ch = Gets(st)
if (ch eq $*n)%(ch eq $,) then break
if ch eq $*s then loop
AppendC(ch,node)
] repeat

if node>>str.length gr 0 then //real node - do work
[
//nodes are of the form Cn or En or letter/number.pinnumber/letter
let ev = vec 50
let blet =node>>str.char↑1
test blet ge $a
ifnot //cpin or epin
[
if svnet ne 0 then //no special voltage nets allowed on edge pins
[
ev!0 = 0
AppendS("Edge/Cable pin in special voltage net",ev)
WSS(ErFile,ev)
if ch eq $*n then resultis true
resultis false
]
let pinno = 0
for i = 2 to node>>str.length do pinno = pinno*10+(node>>str.char↑i) - $0
let xpinno = pinno
if blet eq $C then xpinno = pinno+MaxEpins //epins and cpins are together
//check for edge/cable pin used
test Epins!xpinno eq 0
ifso AddNode(lv (Epins!xpinno),chain)
ifnot
[
ev!0 = 0
AppendS(blet eq $C? "*nCable pin ","*nEdge pin ",ev)
AppendN(pinno,ev)
AppendS(" has multiple signal names",ev)
WSS(ErFile,ev)
]

]
ifso //board coordinate, etc.
[
let j = 1
let c = 0
let bnum = 0
[
j=j+1
c = node>>str.char↑j
if c eq $. then break
bnum = bnum*10 + c - $0
] repeat

let pnum = 0
[
j = j+1
c = node>>str.char↑j
if (c ls $0)%(c gr $9) then break
pnum = pnum*10+c-$0
] repeat
bnum = bnum*26 + blet -$a
let icp = Boardvec!bnum
test icp eq 0
ifso
[
ev!0=0
AppendS("*nIC does not exist: ",ev)
AppendBL(bnum,ev)
AppendC($.,ev)
AppendN(pnum,ev)
WSS(ErFile,ev)
]
ifnot
[
let cpnum = ChiptoPinPos(bnum,pnum) //converts chip pin
//numbers to board positions if they are different shapes
//e.g. 14 pin cans in 16 pin slots

if c eq $o then SetBit(lv (icp>>icdesc.outbits↑0),cpnum) //indicate that this node is an output pin (analyze found right hand conpoint)

//check that this pin is not already used
test icp>>icdesc.pinptr↑cpnum eq 0
ifso
[
test svnet eq 0
ifso AddNode( lv (icp>>icdesc.pinptr↑cpnum),chain)
ifnot AddSVoltNode(svnet,bnum,cpnum)
]

ifnot
[
//error - multiply defined ic pin
ev!0 = 0
AppendS("*nPin ",ev)
AppendN(pnum,ev)
AppendS(" of IC ",ev)
AppendBL(bnum,ev)
AppendS(" has multiple signal names",ev)
WSS(ErFile,ev)
]
]
]
]
if ch eq $*n then resultis true
resultis false
]

and SetBit(vect,nbit) be
[
vect!(nbit rshift 4) = vect!(nbit rshift 4) % (#100000 rshift (nbit & #17))
]

and AddNode(node,chain) be
[
@node = @chain
@chain = node
]

and AddSVoltNode(pinchar,bl,cpnum) be
[
let svoltindex = GetSVindex(pinchar,bl,cpnum)
let svnetname = nil
let svvec = nil
switchon pinchar into
[
case $G: svnetname = "GNDxxxx"; svvec = Gndvec; endcase
case $D: svnetname = "Vddxxxx"; svvec = Vddvec; endcase
case $T: svnetname = "Vttxxxx"; svvec = Vttvec; endcase
case $F: svnetname = "Vccxxxx"; svvec = Vccvec; endcase
case $M: svnetname = "Veexxxx"; svvec = Veevec; endcase
]
svnetname>>str.length = 3 //make a net name
AppendN(svoltindex,svnetname,3)
let netstp = DefineSymbol(svnetname)
//add the svolt source pin if it is not already in the net
if svvec!svoltindex eq 0 then AddNode( lv(svvec!svoltindex), lv(netstp>>strec.list))

//add the original pin to the net
AddNode( lv((Boardvec!bl)>>icdesc.pinptr↑cpnum), lv(netstp>>strec.list))
]