//ang.bcpl
//new analyzer for sil files

// last modified by E. McCreight, November 23, 1977 3:25 PM

get "sysdefs.d"
get "ana.defs"

static
[
outcount //count of edge,cable,or ic pins which have been output to the .nl file for this signame

sigcnt //count of number of signames encountered in this net (>1 is error)
]

// R E M O V E O V E R L A P P I N G L I N E S

let FixOverlap() be
[
//Horizontal lines first
let ptr = Hlines
until ptr eq 0 do
[
let xmin = (@ptr)>>lend.x //this is because of the way AddLE built the list
let xmax = ptr>>lend.x
let y = ptr>>lend.y

let tptr = ptr //look forward through the list,
//trying to remove overlapping node pairs
until @(@tptr) eq 0 do
[
let nptr = tptr
tptr = @(@tptr) //tptr now points to the candidate for death

let txmin = (@tptr)>>lend.x
let txmax = tptr>>lend.x
let ty = tptr>>lend.y

if ty ne y then loop //overlapping Hlines must MATCH in y
if (txmin gr xmax)%(txmax ls xmin) then loop

//remove the candidate line from the list
Errxy(xmin,y,"Coalesced overlapping horizontal lines")
xmin = xmin ls txmin?xmin,txmin
xmax = xmax gr txmax?xmax,txmax
ptr>>lend.x = xmax //update original line with new coordinates
(@ptr)>>lend.x = xmin

@(@nptr)=@(@tptr)
tptr = nptr
]

ptr = @(@ptr)
]

let ptr = Vlines //now do vertical lines
until ptr eq 0 do
[
let ymin = (@ptr)>>lend.y //this is because of the way AddLE built the list
let ymax = ptr>>lend.y
let x = ptr>>lend.x

let tptr = ptr //look forward through the list,
//trying to remove overlapping node pairs
until @(@tptr) eq 0 do
[
let nptr = tptr
tptr = @(@tptr) //tptr now points to the candidate for death

let tymin = (@tptr)>>lend.y
let tymax = tptr>>lend.y
let tx = tptr>>lend.x

if tx ne x then loop //overlapping Vlines must MATCH in x
if (tymin gr ymax)%(tymax ls ymin) then loop

//remove the candidate line from the list
Errxy(x,ymin,"Coalesced overlapping vertical lines")
ymin = ymin ls tymin?ymin,tymin
ymax = ymax gr tymax?ymax,tymax
ptr>>lend.y = ymax //update original line with new coordinates
(@ptr)>>lend.y = ymin

@(@nptr)=@(@tptr)
tptr = nptr
]

ptr = @(@ptr)
]
]


and ConnectVlines() be
[
let xptr = Vlines
until xptr eq 0 do
[
let ptr = xptr; xptr = @xptr
if ptr>>lend.cp↑1 ne 0 then loop //line end used
let vx = ptr>>lend.x
let vy = ptr>>lend.y
//try to find the simplest situation, which is an "L",
//i.e. the distance between this endpoint and the
//endpoint of a free orthogonal line is =<2

if FindSimpleLine(Hlines,vx,vy,ptr) then loop

//the more complex situation is that our line
//will form a "T" with an orthogonal line
//We must find a point which has y = vy+-3
//and which is connected to another endpoint
//which also has y = vy+-3. The two endpoints
//must then satisfy x1<vx<x2 or x2<vx<x1. When
//such a point is found, our line is connected
//by pointer splicing

unless FindTeePair(Hlines,ptr,vx,vy,true) then
FindTeePair(Vlines,ptr,vx,vy,true)

]
]
and ConnectHlines() be
[
let xptr = Hlines
until xptr eq 0 do
[
let ptr = xptr; xptr = @xptr
if ptr>>lend.cp↑1 ne 0 then loop //line end used
let vx = ptr>>lend.x
let vy = ptr>>lend.y
//try to find the simplest situation, which is an "L",
//i.e. the distance between this endpoint and the
//endpoint of a free orthogonal line is =<2

if FindSimpleLine(Vlines,vx,vy,ptr) then loop

//the more complex situation is that our line
//will form a "T" with an orthogonal line

unless FindTeePair(Vlines,ptr,vx,vy,false) then
FindTeePair(Hlines,ptr,vx,vy,false)
]
]

and FindSimpleLine(list,x,y,optr) =valof
[
//look for the situation in which a line end is completely
//free and x,y is +-2 points from it. Return the line
//if one is found, else 0

until list eq 0 do
[
let ptr = list; list = @list
if ptr>>lend.cp↑1 ne 0 then loop //endpoint used
let ly = ptr>>lend.y
if (ly gr y?ly-y,y-ly) gr 2 then loop
let lx = ptr>>lend.x
if (lx gr x?lx-x,x-lx) gr 2 then loop

//got the line
ptr>>lend.cp↑1 = optr
optr>>lend.cp↑1 = ptr
resultis true
]
resultis false
]

and FindTeePair(list,candnode,x,y,vert) = valof
[
//look through list trying to find a pair of endpoints which form a ’T’
//with the point x,y. Do not consider candnode in this process.
until list eq 0 do
[
let tptr = list; list = @list
if tptr eq candnode then loop
let tx = tptr>>lend.x
let ty = tptr>>lend.y
test vert
ifso //y coord must match
[
let dely = ty gr y?ty-y,y-ty
if dely gr 3 then loop //out of range
]
ifnot //x coord must match
[
let delx = tx gr x?tx-x,x-tx
if delx gr 3 then loop
]

//check the coords of lines connected to this one

for i = 0 to 2 do
[
let optr = tptr>>lend.cp↑i
if (optr eq 0)%(optr eq -1) then loop //not a line
if optr>>node.type ne btLend then loop
let ox = optr>>lend.x
let oy = optr>>lend.y
test vert
ifso //y must match and ox and tx must bracket x
[
let dely = y gr oy?y-oy,oy-y
if dely gr 3 then loop
if (((ox ls x)&(tx ls x))%((ox gr x)&(tx gr x))) then loop
]
ifnot //x must matcy and oy and ty must bracket y
[
let delx =x gr ox?x-ox,ox-x
if delx gr 3 then loop
if (((oy ls y)&(ty ls y))%((oy gr y)&(ty gr y))) then loop
]
//if we get here, we have the two endpoints we are seeking (tptr and optr)
candnode>>lend.cp↑1 = tptr
candnode>>lend.cp↑2 = optr
tptr>>lend.cp↑i = candnode
let np = 0
while optr>>lend.cp↑np ne tptr do np = np+1
optr>>lend.cp↑np = candnode
resultis true
]
]
resultis false
]





//D O O U T P U T

and DoOutput() be
[
SendICs(Comps)
Output(Strings) //output starting at signal names
Output(Schars) //output starting at grounds and pseuds
OutLines(Vlines) //output nameless nets starting on Vlines
OutLines(Hlines) //output nameless nets starting on Hlines
CheckUsed(Strings,"Unused string")
CheckUsed(Numbers,"Unused number")
CheckUsed(Locgroups,"Unused bloc/group")
CheckUsed(Schars,0) //message is determined by the procedure for schars

SendPins() //build sil format file for pinnumbers
]

and ChkConn(ptr) be //check that at least one pin was output for a net
//with a signal name, 2 pins for nets with no name
[
if outcount gr 1 then return //enough pins in any case
if outcount eq 0 then
[
Errxy(ptr>>lend.x,ptr>>lend.y,"Line with no associated component or edge pin")
return
]
//one pin output
if sigcnt eq 0 then
Errxy(ptr>>lend.x,ptr>>lend.y,"Line with no name has only one pin")
]

and CheckUsed(nodeptr,message) be
[
until nodeptr eq 0 do
[
let xmessage = nil
if nodeptr>>node.used ne 0 then [ nodeptr = @nodeptr; loop ]
//in all cases except schars, message fully determines what to print
if message eq 0 then xmessage = selecton nodeptr>>node.val into
[
case chEpin: "Unused Epin"
case chCpin: "Unused Cpin"
case chGnd: "Unused ground"
case chPseud: "Unused pseudonet point"
case chBlob: "Unused blob"
]
Errxy(nodeptr>>node.x,nodeptr>>node.y,message eq 0?xmessage,message)
nodeptr = @nodeptr
]
]


and SendICs(list) be
[
until list eq 0 do
[
let ptr = list;list = @list
let v = vec 50;v!0 = 0
if ptr>>comp.blout ne 0 then loop //already put out type for
//this component (while doing another group
let compb= ptr>>comp.conpoints
if compb eq 0 then loop
let bloc = compb>>compblock.boardloc
AppendC($*n,v)
AppendS((bloc eq 0? "?", lv bloc>>strec.st),v)
AppendS(": ",v)
let cname = compb>>compblock.comptype
test cname eq 0
ifso
[
Errxy(ptr>>comp.xmin,ptr>>comp.ymin,"Can’t find or default type name for component")

AppendS("no type specified ;",v)
]

ifnot
[
AppendS(lv(cname>>strec.st),v)
AppendS(" (",v)
AppendS(lv((cname>>strec.rname)>>strec.st),v)
AppendS(") ;",v)
let bptr = Comps //dig out all the groups for this
//boardtype
if bloc ne 0 then until bptr eq 0 do
[
let tp = bptr;bptr = @bptr
let xp = tp>>comp.conpoints
if xp eq 0 then loop
if xp>>compblock.boardloc eq bloc then
[
AppendC((xp>>compblock.group)+$a-1,v)
tp>>comp.blout = 1
]
]
]
Wss(OutFile,v)
]
Wss(OutFile,"*n@")
]


and Output(list) be
[
until list eq 0 do
[
let ptr = list; list = @list
outcount = false //true when item has been output
sigcnt = 0 //count of number of signals in this net
let btype = ptr>>node.type
let assoc = ptr>>node.assoc
if (assoc eq 0)%(assoc>>node.type ne btLend) then loop
let val = ptr>>node.val
if (btype eq btString) & (val>>strec.type eq stSig) then
//signal name
[
OutName(lv(val>>strec.st))
OutTrace(assoc)
ChkConn(assoc)
]

if btype eq btSchar then
[
switchon val into
[
case chGnd: OutName("GND")
OutTrace(assoc); endcase

case chPseud: OutName("+")
OutTrace(assoc); endcase
]
ChkConn(assoc)
]
]
]

and OutName(str) be
[
Puts(OutFile,$*n)
Wss(OutFile,str)
Wss(OutFile,": ")
]


and OutTrace(ptr) be
[
if ptr>>lend.marked ne 0 then return
ptr>>lend.marked = 1
if ptr>>lend.hassig ne 0 then sigcnt = sigcnt+1
if sigcnt gr 1 then Errxy(ptr>>lend.x,ptr>>lend.y,"Net has multiple names")

for i = 0 to 2 do //for all the cp’s in this endpoint
[
let nptr = ptr>>lend.cp↑i
if (nptr eq 0)%(nptr eq -1) then loop

switchon nptr>>node.type into
[
case btLend: OutTrace(nptr); loop

case btSchar: OutSchar(nptr); loop //epin,cpin

case btComp: OutComp(nptr,ptr); loop // ic pin
]
]


]

and OutSchar(nptr) be
[
switchon nptr>>node.val into //only do something for cpins,epins
[
case chCpin: OutPin($C,nptr>>node.assoc);return
case chEpin: OutPin($E,nptr>>node.assoc);return
]
]

and OutPin(char,ptr) be //output "En" or "Cn"
[
if ptr eq 0 then return //no pin for edge pin
let outv = vec 20; outv!0 =0
let pinno = ptr>>node.val //the pin number
if outcount gr 0 then AppendS(", ",outv)
AppendC(char,outv)
AppendN(pinno,outv)
Wss(OutFile,outv)
outcount = outcount+1
]

and OutComp(compptr,lineptr) be
[
let compb = compptr>>comp.conpoints //find the conpoint which points
//to lineptr
if compb eq 0 then return
let cpi = 1
until compb>>compblock.conn↑cpi eq lineptr do cpi = cpi+1
let outv = vec 20; outv!0 = 0
if outcount gr 0 then AppendS(", ",outv)
//print bloc,pin
let bloc = compb>>compblock.boardloc
AppendS((bloc eq 0? "?", lv bloc>>strec.st), outv)
AppendC($.,outv)
AppendN(compb>>compblock.pin↑cpi,outv)
AppendC(selecton compb>>compblock.cpt↑cpi into
[
case cptLeft: $i
case cptTop: $i
case cptBot: $i
case cptRight: $o
] ,outv)

Wss(OutFile,outv)
outcount = outcount+1
]


// Output unnamed traces

and OutLines(lptr) be
[
until lptr eq 0 do
[
let tptr = lptr; lptr = @lptr
if tptr>>lend.marked ne 0 then loop // net already sent
let str=vec 60
test GenNameCount eq 0 then str=" " or
[
MoveBlock(str, GenNameString, 60)
AppendC($+, str)
AppendN(GenNameCount, str)
GenNameCount = GenNameCount+1
]
OutName(str)
outcount = 0
sigcnt = 0
OutTrace(tptr)
ChkConn(tptr)
]
]

and SendPins() be //generate .pn file
[
let PnFile = 0
let v = vec 10 //build the block here
let nloc=lv (v>>item.string)
v>>item.link = -1
v>>item.state = 0 //active
v>>item.font = 2 //really user font 1

let ptr=Comps; until ptr eq 0 do
[
let compb = ptr>>comp.conpoints
if compb eq 0 then [ ptr = @ptr; loop ]
for i = 1 to compb>>compblock.numcpoints do
[
if compb>>compblock.defd↑i ne 0 then loop //used specd
nloc!0=0
AppendN(compb>>compblock.pin↑i,nloc)
let sl = nloc>>str.length
let sl5=sl*5
let dx=0;let dy=0
switchon compb>>compblock.cpt↑i into
[
//offset of point from conpoint
case cptTop: dx=-(2+sl5);dy=-7; if sl gr 1 then dx=dx+1;endcase

case cptLeft: dx=-(2+sl5);dy=-7; if sl gr 1 then dx=dx+1; endcase

case cptBot: dx=-(2+sl5);dy=-2; if sl gr 1 then dx=dx+1; endcase

case cptRight: dx=0;dy=-7; if sl gr 1 then dx=dx-1; endcase
]

dy = dy+(compb>>compblock.y↑i)
dx = dx+(compb>>compblock.x↑i)
v>>item.ymin = dy; v>>item.ymax=dy+8
//Fudge -- ANALYZE cares
v>>item.xmin = dx; v>>item.xmax=dx+sl5
v>>item.color = ptr>>comp.color

test (dx ls 0) % (dy ls 0)
ifnot
[
if not PnFile then PnFile = OpenPnFile()//we need the .pn file
for i = 0 to ((offset item.string)/16)+sl/2 do Puts(PnFile,v!i)
]
ifso Errxy(dx ls 0? 0,dx,dy ls 0? 0,dy, "Pin number skipped (it would be off the ’.PN’ page)", " - ’.NL’ file is OK",warning)
]
ptr = @ptr
]
test PnFile
ifso Closes(PnFile)//Only close if opened
ifnot DelFile(FileName,".pn") //delete if not applicable
]

and OpenPnFile() =valof //generate .pn file
[
let S = GetFile(FileName,".pn",0) //now open .pn file
Puts(S,#34562)
resultis S
]

and DelFile(fname,ext) be
[
let v=vec 128
MakeFileName(v, fname, ext)
DeleteFile(v,0,0,SilZone)
]