//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
[(635)\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
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 
[l4268\f1
let filestring  = libvec + (25*filecount)
namevec!filecount = filestring
unless ReadNext(comcm,filestring) then break
unless IsFunnyParameter(filestring) do 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 ne 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
let outext=".wl"
if Correcting then
[l4268\f1
outext=".wlNew"
OldWlFile = GetFile(namevec!0,".wl",1)		//For comparison
ADFile = GetFile(namevec!0,".ad",1) //add delete listl5538\f1
]
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)l4268\f1
]


and InitAna(arg) be
[
\f1

//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 //
[l4268\f1
if Gets(OldWlFile) ne BoardType then [ CallSwat("Board type differs from original"); finish ] 
WSS(ADFile,"*n*n@")
WSS(ADFile,TableZeroString)l5538\f1
]
AddPotentialTerms()
Output()
TruncateDiskStream(OutFile)
Closes(OutFile)
TruncateDiskStream(ErFile)
Closes(ErFile)
TruncateDiskStream(BpFile)
Closes(BpFile)
if Correcting then [ TruncateDiskStream(ADFile);Closes(ADFile) ] 
CounterJunta(SpeakVersion)l4268\f1
]

and SpeakVersion() be
[\f1
external Ws
Ws("*n*n*n*n*nGOBBLE February 10, 1979")
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 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
[\f1
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
[l4268\f1
CallSwat("Can't Open Input File")
finishl5538\f1
]

let erv = vec 50 
//Read components and board locations
[l4268\f1
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
[l5538\f1
erv!0=0
AppendS("*nIllegal board position specified: ",erv)
AppendBL(boardloc,erv)
WSS(ErFile,erv)
loopl6808\f1
]

test boardptr eq 0 //this position used yet?
ifso //no
[l5538\f1
//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
[l5538\f1
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)
loopl6808\f1
]

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

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

Gets(ins) //read over cr following @

//read signal names and nodes
[l4268\f1
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 ]
[l5538\f1
if ch eq $: then break
AppendC(ch,snv)
ch = Gets(ins)l6808\f1
] repeat //until signal name read

if (snv>>str.length eq 1)&(snv>>str.char^1 eq $*s) then //assign a name to the signal
[l5538\f1
snv!0 = 0
AppendS("XXX",snv)
AppendFN(NullName,snv)
NullName = NullName+1l6808\f1
]
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
[l5538\f1
if GetNode(ins, nameptr,svnet) then breakl6808\f1
] repeat //until all nodes readl5538\f1
] repeat //until all signal names donel4268\f1

Closes(ins)

]

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

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

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

//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+icbll4268\f1
]
\f1

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

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

]


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

and StEq(s1,s2) = valof //string compare
[\f1
for i = 0 to s1>>str.length do
if s1>>bytes.bite^i ne s2>>bytes.bite^i then resultis false
resultis truel4268\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 ReadBloc(stream) = valof
[\f1
//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
[l4268\f1
ch = Gets(stream); if ch eq $: then break
boardloc = boardloc*10+(ch-$0)
l5538\f1
] repeat //until all board location read
resultis boardloc*26 + bletl4268\f1
] repeat

and ReadType(str,typev) be
[\f1
let ch = 0
until ch eq $( do ch = Gets(str) //read up to left paren
let typen = vec 50; typen!0= 0
[l4268\f1
ch = Gets(str)
if (ch eq $/) %(ch eq $)) then break
AppendC(ch,typen)
l5538\f1
] repeat
if ch eq $) then
[l4268\f1
WSS(ErFile, "*nmissing REAL NAME")
Closes(ErFile)
finishl5538\f1
]
let npins =0
[l4268\f1
ch = Gets(str)
if ch eq $/ then break
npins = npins*10 + (ch-$0)
l5538\f1
] 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-$Al4268\f1
]

and GetNode(st,chain,svnet) = valof
[\f1
let node = vec 10;node!0 = 0; 
let ch = $*n
[l4268\f1
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)l5538\f1
] repeat

if node>>str.length gr 0 then //real node - do work
[l4268\f1
//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
[l5538\f1
if svnet ne 0 then //no special voltage nets allowed on edge pins
[l6808\f1
ev!0 = 0
AppendS("Edge/Cable pin in special voltage net",ev)
WSS(ErFile,ev)
if ch eq $*n then resultis true
resultis falsel8078\f1
]
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
[l6808\f1
ev!0 = 0
AppendS(blet eq $C? "*nCable pin ","*nEdge pin ",ev)
AppendN(pinno,ev)
AppendS(" has multiple signal names",ev)
WSS(ErFile,ev)l8078\f1
]l6808\f1

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

let pnum = 0
[l6808\f1
j = j+1
c = node>>str.char^j
if (c ls $0)%(c gr $9) then break
pnum = pnum*10+c-$0
l8078\f1
] repeat
bnum = bnum*26 + blet -$a
let icp = Boardvec!bnum
test icp eq 0
ifso
[l6808\f1
ev!0=0
AppendS("*nIC does not exist: ",ev)
AppendBL(bnum,ev)
AppendC($.,ev)
AppendN(pnum,ev)
WSS(ErFile,ev)l8078\f1
]
ifnot
[l6808\f1
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
[l8078\f1
test svnet eq 0
ifso AddNode( lv (icp>>icdesc.pinptr^cpnum),chain)
ifnot AddSVoltNode(svnet,bnum,cpnum)l9348\f1
]

ifnot
[l8078\f1
//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)l9348\f1
]l8078\f1
]
l6808\f1
]l5538\f1
]
if ch eq $*n then resultis true
resultis falsel4268\f1
]

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

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

and AddSVoltNode(pinchar,bl,cpnum) be
[\f1
let svoltindex = GetSVindex(pinchar,bl,cpnum)
let svnetname = nil
let svvec = nil
switchon pinchar into
[l4269\f1
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; endcasel5539\f1
]
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))
l4269\f1
]
\f1