//gobb.bcpl
//new gobbler for sil files
// last modified by E. McCreight,
June 15, 1977 11:54 AM

get "sysdefs.d"
get "gob.defs"
manifest
[
cnl1 = 40 //one inch
cnl2 = 120 //three inches
]

static
[
outcount
eclnet
outnum
nterm
nnodes
epcount

L
CriticalNetLength=160
R

StandardMetric

debugReWork
]

external //defined with coordinate functions (FindBestTerm)
[
SendUsedICs
]

let Output() be
[
unless noroute do
[
RouteAllNets()
DetermineNetOrder()
]

let nsyms = 0
for i = 0 to htsize-1 do
[
let link = hashtab!i
until link eq 0 do
[
nsyms = nsyms+1
NewItem!nsyms = link
link = @link
]
]

SendUsedICs()
NewItem!0 = nsyms
Sort(NewItem,StCompFn)
for i = 1 to NewItem!0 do
[
let lp = NewItem!i
PrintNodes(lp,OutFile,true,lp>>strec.netnum)
if Correcting & ((lp>>strec.ordered) eq 0) & (@(lp>>strec.list) ne -1) then
[
PrintNodes(lp,ADFile,false,AddDeleteNetNum)
AddDeleteNetNum=AddDeleteNetNum+1
]
]
]
and DetermineNetOrder() be
[

let nnodes = 0
for i = 0 to htsize-1 do
[
let link = hashtab!i
until link eq 0 do
[
if @(link>>strec.list) ne -1 then //ignore components
[

nnodes = nnodes+1
NewItem!nnodes = link
]
link = @link
]
]

NewItem!0 = nnodes
Sort(NewItem,NLCompFn)
for i = 1 to nnodes do (NewItem!i)>>strec.netnum = i

]
and NLCompFn(stp1,stp2) = valof //sort function for net routing. We
//divide the nets into three categories, short, medium, and long. Short
//nets are wired first (i.e. are less than all other nets), then long nets
//are done, then medium nets are done to hold the long wires down.
[

let la = stp1>>strec.netlength
let lb = stp2>>strec.netlength
if la ls cnl1 then resultis la-lb

if la ls cnl2 then
[
if lb ge cnl2 then resultis 1 //la is medium length. All longer
//nets are made shorter

resultis la-lb //lb is either medium or short
]

if la ge cnl2 then
[
if (lb ge cnl1)&(lb ls cnl2 ) then resultis -1
resultis la-lb
]


]


and RouteAllNets() be
[
if Correcting do
[
let starting = true
NewItem!0 = 0 //count of number of nodes in the old net
let netlength = 0
let line = vec 128
let namestr = vec 50
let netno = 0
[ //read a line
if Endofs(OldWlFile) then break
let ch = Gets(OldWlFile); line!0 = 0
until (ch eq $*n) do //read a line
[
let sl = line>>str.length+1
line>>str.char↑sl = ch
line>>str.length = sl
if Endofs(OldWlFile) then break
ch = Gets(OldWlFile)
]
if debugReWork then
[
debugReWork=debugReWork-1
if debugReWork eq 0 then CallSwat("Debug")
]

if line>>str.length eq 0 then loop
test starting
ifso
[
netno = ReadNetName(line,namestr,lv netlength)
if netno eq 0 then loop
starting = false //have the first net name, number, and length
]
ifnot
[
if ProcessLine(line) then unless Endofs(OldWlFile) then loop //returns true
//if this line is a collection of nodes-read the next line
CorrectOldNet(namestr,netlength)
NewItem!0=0
netno = ReadNetName(line,namestr,lv netlength)
]
] repeat
]

SetUpTerms()
for i = 0 to htsize-1 do
[
let listp = hashtab!i
until listp eq 0 do
[
for j = 0 to 15 do #431 !j = not(#431!j)
RouteNodes(listp)
listp = @listp
]
]
]

and RouteNodes(stp) be
[
if stp>>strec.ordered eq 1 then return //net already done during correction
let xv = vec 50
let yv = vec 50
let permv = vec 50
let pointv = vec 50
let tpermv = vec 50
let btnl = nil
let tbtnl = nil
let sstr = lv (stp>>strec.st)
let noterm = ((sstr>>str.char↑(sstr>>str.length))eq $!)
outcount = 0
eclnet = false
outnum = 0
nterm = 0


let lp = stp>>strec.list
nnodes = 0
epcount = 0
until (@lp) eq -1 do
[
//set up argument vectors for the router
if nnodes gr 50 then
[
WSS(ErFile,"*nNet Routing Aborted - too many nodes: ")
WSS(ErFile, lv stp>>strec.st)
return
]
nnodes = nnodes+1

//determine the type of the current node
let cv = vec 2
let vindex = nil
let svlet = 0


let j = 1; let mark = 0
[
mark = @(lp-j)
if (mark % 7) eq -1 then break
j = j+1
] repeat
switchon mark into
[
case -1: //normal ic pin
[
vindex = epcount eq 0?nnodes+1,nnodes
let blp = (lp-j-(offset icdesc.mark)/16)
let bl = blp>>icdesc.bl //board location
if BitSet(lv (blp>>icdesc.outbits↑0),j) then
[
outcount = outcount+1
outnum = vindex
if (blp>>icdesc.ictype) eq ecltype then eclnet = true //a net
//is an ECL net only if it has at least one ECL output
]
GetICcoords(bl rem 26,bl/26,j,cv)


]
endcase
case -2: //Epin or cpin
[
vindex = epcount eq 0?1,nnodes //assign the first cpin or
//epin to the first position in the list
epcount = epcount+1
test j ge MaxEpins
ifso GetCpinCoords(j-MaxEpins,cv)
ifnot GetEpinCoords(j,cv)


]
endcase
case -3: //Gnd
svlet = $G; endcase

case -4: //Vcc
svlet = $F; endcase

case -5: //Vee
svlet = $M; endcase

case -6: //Vtt
svlet = $T; endcase

case -7: //Vdd
svlet = $D; endcase
]
if svlet ne 0 do
[
vindex = epcount eq 0? nnodes+1,nnodes
outcount = outcount+1 //an Svolt source pin is an output
GetSVCoords(svlet,j,cv)
]
pointv!vindex = lp
xv!vindex = cv!0
yv!vindex = cv!1
lp = @lp
]


if nnodes eq 0 then return //ic type name
if nnodes eq 1 then
[
WSS(ErFile,"*nSingle Node Net: ")
WSS(ErFile, lv stp>>strec.st)
return
]
if epcount eq 0 then
[
//move the last node to position 1 since it was reserved
//for an epin but not used
pointv!1 = pointv!(nnodes+1)
xv!1 = xv!(nnodes+1)
yv!1 = yv!(nnodes+1)
if outnum eq (nnodes+1) then outnum = 1 //if we moved an output node, change its index

]
if epcount gr 1 then
[
WSS(ErFile, "*nNet has more than one edge/cable pin: ")
WSS(ErFile,lv stp>>strec.st)
]

//for ECL nets, if outcount = 1, and epcount = 0 and nnodes gr 2,
//we route the net two ways, one with the output forced to the
//end of the net, once with it unconstrained. If the constrained
//length is less then 1.2x the unconstrained length, the constrained
//form of the net is used. This puts the output at the end of the net.

test (outcount eq 1)&(epcount eq 0)&(nnodes gr 2) & eclnet
ifso //try to force the single output to the end of the net.
[
if outnum ne 1 then //force the single output node to the head of the net
[
let tx = xv!outnum
let ty = yv!outnum
let tp = pointv!outnum
xv!outnum = xv!1
yv!outnum = yv!1
pointv!outnum = pointv!1
xv!1 = tx
yv!1 = ty
pointv!1=tp
outnum = 1
]

Route(nnodes,xv,yv,permv,false,StandardMetric)
btnl = bestTotalNetLength //router static

Route(nnodes,xv,yv,tpermv,true,StandardMetric)
tbtnl = bestTotalNetLength //router static
if tbtnl le (btnl+btnl/5) then
[
btnl = tbtnl
permv =tpermv
]
]
ifnot if nnodes gr 2 then //route the net as it stands
[
Route(nnodes,xv,yv,permv,epcount ne 0,StandardMetric)
btnl = bestTotalNetLength
]
if nnodes eq 2 then
[
btnl = StandardMetric(xv!1,yv!1,xv!2,yv!2)
permv!1=2; permv!2=1 //no need to route two node nets, but
//reverse it in case it contains an edge pin
]

//the net is now routed in the best way for its type


//reorder the list based on the permutation supplied by the router
stp>>strec.list = pointv!(permv!1) //list head
for j = 1 to nnodes-1 do @(pointv!(permv!j)) = pointv!(permv!(j+1))
@(pointv!(permv!nnodes)) = lv (stp>>strec.mark) //last node

//before starting, outnum contained the index of an output node
// (perhaps the only one). We are now interested in the location
//of that node:
let OutputIsFirst = (permv!1 eq outnum)
let OutputIsLast = (permv!nnodes eq outnum)


//do a little checking on the validity of the net
let incount = nnodes-outcount-epcount
if (incount eq 0)&(epcount eq 0) then
[
Err2("*nNet consists of outputs exclusively: ",lv stp>>strec.st)
]
if (outcount eq 0)&(epcount eq 0) then
[
Err2("*nNet consists of inputs exclusively: ",lv stp>>strec.st)
]
if (outcount eq 0)&(incount eq 0) then
[
Err2("*nNet consists of edge pins exclusively: ",lv stp>>strec.st)
]

let nterm = valof //determine the proper number of terminating
//resistors for the net
[
if (epcount ne 0)%(not eclnet)%noterm then resultis 0// don’t terminate
//nodes which include edge pins
if ((outcount gr 1)%((outcount eq 1)&(not(OutputIsFirst % OutputIsLast))))&(btnl gr CriticalNetLength) then resultis 2
//more than one output, or exactly one output but not at the end
//of the net
resultis 1
]

if nterm gr 0 then //assign one or two
//terminators to the net.
[


if (nterm eq 2)% OutputIsLast % (not (OutputIsFirst % OutputIsLast)) do //add a terminator to the head of the list
[
let xs = xv!(permv!1) ;let ys = yv!(permv!1)
let tptr = FindBestTerm(xs,ys)
//returns pointer to best terminator,distance in dts,x,y,in termx,termy
//there are two choices for the position of the terminator
//we just found. (a) at the end of the net, and (b) between
//the first and second nodes. We choose such that the net
//is minimally lengthened.

let x2 = xv!(permv!2)
let y2 = yv!(permv!2)
let dt2 = StandardMetric(x2,y2,termx,termy)
let ds2 = StandardMetric(xs,ys,x2,y2)
test dt2 ls ds2 //is terminator closer to node 2 then node 1 is?
ifso //put the term. between the first and second nodes
[
@tptr = @(stp>>strec.list)
@(stp>>strec.list) = tptr
btnl = btnl-ds2+dt2+dts
]
ifnot //put the term at the end of the net
[
@tptr = stp>>strec.list
stp>>strec.list = tptr
btnl = btnl+dts
]
]
if (nterm eq 2) % OutputIsFirst do //add a terminator at the far end of the net
[
let xs = xv!(permv!nnodes);let ys = yv!(permv!nnodes)
let tptr = FindBestTerm(xs,ys)
if tptr ne 0 do
[
let x2 = xv!(permv!(nnodes-1))
let y2 = yv!(permv!(nnodes-1))
let dt2 = StandardMetric(x2,y2,termx,termy)
let ds2 = StandardMetric(xs,ys,x2,y2)
test dt2 ls ds2
ifso //term goes between last and next-to-last node
[
@tptr=@(pointv!(permv!(nnodes-1)))
@(pointv!(permv!(nnodes-1))) = tptr
btnl = btnl-ds2+dt2+dts
]
ifnot //term goes after last node
[

@tptr = @(pointv!(permv!nnodes))
@(pointv!(permv!nnodes))= tptr
btnl = btnl+dts
]
]
]
]
stp>>strec.netlength = btnl

]




and StCompFn(stp1,stp2) = valof
[
let c1 = nil;let c2=nil;let comp = nil
let l1=stp1>>strec.st.length
let l2 = stp2>>strec.st.length
let lx = l1 ls l2?l1,l2
for k = 1 to lx do
[
c1= stp1>>strec.st.char↑k
c2= stp2>>strec.st.char↑k
if (c1 ge $a)&(c1 le $z) then c1 = c1+($A-$a)
if (c2 ge $a)&(c2 le $z) then c2 = c2+($A-$a)
comp = c1-c2
if comp ne 0 then break
]
if comp eq 0 then comp = l1-l2
resultis comp
]

and PrintNodes(stp,file,doback,netnum) be //print all nodes associated with stp
//doback = true if PrintN is to output edge pins to the backpanel file
[
let lp = stp>>strec.list
if @lp eq -1 then return //no nodes (this is a component name)
let namev = vec 50; namev!0 = 0
AppendS("*n*n",namev)
AppendS( lv stp>>strec.st,namev)
AppendC($:,namev)
unless noroute do
[

AppendS(" <",namev)
AppendN(netnum,namev)
AppendS("> (",namev)
AppendN(stp>>strec.netlength,namev)
AppendS(")",namev)
]
AppendC($*n,namev)
WSS(file,namev)
let outcount = 0
until @lp eq -1 do
[
if outcount gr 3 then
[ outcount = 0; WSS(file,"*n") ]
WSS(file,"*s*s*s*s")
PrintN(lp,file,(doback?stp,0))
outcount = outcount+1
lp = @lp
]
]


and PrintN(lp, file,stp) be //print a single node-stp=0 means no backpanel output
[
let outback = (stp ne 0) //send junk to bp file or not
let pnv = vec 20; pnv!0 = 0
let epv = vec 20; epv!0 = 0
let epn = 0
let cv = vec 2
let j = 1; let mark = 0
[
mark = @(lp-j)
if (mark % 7) eq -1 then break //mark = -1 to -10
j = j+1
] repeat
let svlet = 0
switchon mark into
[
case -1: //normal ic pin
[
let bdesc = lp-j-(offset icdesc.mark)/16
let bl = bdesc>>icdesc.bl
AppendBL(bl,pnv)
AppendC($.,pnv)
AppendN(j,pnv,2)
GetICcoords(bl rem 26,bl/26,j,cv)


]
endcase
case -2: //Epin or cpin
[
if outback do
[
AppendC($*n,epv)
AppendS(lv(stp>>strec.st),epv)
AppendS(": ",epv)
]

test j gr MaxEpins
ifso [ AppendC($C,pnv);epn = j-MaxEpins; AppendN(epn,pnv,3);GetCpinCoords(epn,cv);if outback then AppendC($C,epv) ]
ifnot [ AppendC($E,pnv);epn=j; AppendN(j,pnv,3);GetEpinCoords(j,cv);if outback then AppendC($E,epv) ]

]
if outback then
[
AppendN(epn,epv,3)
WSS(BpFile,epv)
]

endcase
case -3: //Gnd
svlet = $G; endcase

case -4: //Vcc
svlet = $F; endcase

case -5: //Vee
svlet = $M; endcase

case -6: //Vtt
svlet = $T; endcase

case -7: //Vdd
svlet = $D; endcase
]
if svlet ne 0 do
[
AppendC(svlet,pnv)
AppendN(j,pnv,3)
GetSVCoords(svlet,j,cv)
]

unless noroute do
[
AppendS(" {",pnv)
AppendN(cv!0,pnv,3)
AppendC($,,pnv)
AppendN(cv!1,pnv,3)
AppendC($},pnv)
]

WSS(file,pnv)
]

and Sort(sv,cfn) be
[
let rp = nil
L = ((sv!0)/2)+1
R = sv!0
[
test L gr 1
ifso
[
L = L-1
rp = sv!L
]
ifnot
[
rp = sv!R
sv!R = sv!1
R = R-1
if R eq 1 then
[
sv!1 = rp
return
]
]

let j = L
let i = nil
[
i = j
j = j+j
if j ls R then if cfn(sv!j,sv!(j+1)) ls 0 then j = j+1

if j le R do
[
if cfn(sv!j,rp) le 0 then break
sv!i = sv!j
loop
]
break
] repeat

sv!i = rp
] repeat
]

and BitSet(v,bitno) = valof
[
let w = v!(bitno rshift 4)
let m = #100000 rshift (bitno)
resultis (w & m)
]

and Err2(st1,st2) be
[
WSS(ErFile,st1)
WSS(ErFile,st2)
]