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

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

// D O A L L P I N C H E C K I N G A N D A S S I G N M E N T

static TypeVec = 0
static EndofDict = 0
static lastChar = 0

structure compdef: //for definitions read in from dictionary
[
link word
used word
pinname word //stp for pin name
legalpins↑0,3 word
]

manifest
[
compdsize = (size compdef)/16
]

//the pin checking and assignment procedure consists of reading
//a dictionary until a (group of ic types) which is used in the picture
//is detected. A (temporary) list of compdefs is then built,
//for all the possible groups (A-Z) in the ic type (one compdef per pin)
//The program then goes over all components of the present type(s),
//checking or assigning all pins
//It notes wheather all components have been checked and returns true
//if all is done otherwise false.

let PinCheck(dictcnt) =valof //check or assign all pins
[
if Comps eq 0 then resultis true //no components to look up in dictionaries
let newfpDict = Dprvec + dictcnt*(lCFA+1)+1
unless newfpDict!-1 gr 0 then resultis false //nothing in this dict to check
if newfpDict ne fpDict then
[
if dict ne 0 then Closes(dict)
fpDict = newfpDict
dict = OpenFile(0,ksTypeReadOnly,1,0,fpDict,0,SilZone)
]
if not dict then CallSwat("File problem - dict stream eq 0")
JumpToFa(dict,lv fpDict>>CFA.fa)
EndofDict = false
let CompsToDo = fpDict!-1

//on entry, the dictionary is poised immediately after
//the @ which follows the header

let TypeVecx = vec 20*21 //vector for 20 typename strings
TypeVec = TypeVecx
let type,TypeCnt = nil,nil
let groupdef = vec 32 //vector of pointers to lists of
//compdefs for each pin, indexed by group number

let FoundEntry = true
[ //do for all type names

if FoundEntry eq true then [ type=TypeVec; TypeCnt=0 ; FoundEntry=false ]

let tc = ReadObj(type,dict,true) //get typename- clears type!0 on eof

if EndofDict then break// end of dictionary file

if (type!0)eq 0 then
[ unless ((tc eq $*n) % (tc eq $@)) then FlushLine(dict); loop; ] //comment

if tc eq $, then
[
test TypeCnt le 19
ifso [ TypeCnt = TypeCnt+1; type = type + 20 ]
ifnot Err2("*nTo Many Component names for same pin assignments; name lost: ",type)
loop
]

FoundEntry = true
if tc ne $*n then FlushLine(dict) //suck out comments

let typeStpVec = vec 20
let typestp = 0
for i = 0 to TypeCnt do
[
typeStpVec!i = Lookup(TypeVec + 20*i)
if typeStpVec!i ne 0 then test (typeStpVec!i)>>strec.pinsdn eq 0
ifso [ CompsToDo = CompsToDo-1; (typeStpVec!i)>>strec.pinsdn = 1 ]
ifnot typeStpVec!i = 0 //multiple definition of comp type
if (typestp eq 0) & (typeStpVec!i ne 0) then typestp = typeStpVec!i
]

if typestp eq 0 then [ FlushDef(dict); loop ] //read past the whole block

//typestp points to the first comp name defined on the drawing
//try to read the definitions for all groups
Zero(groupdef,32)
unless BuildCompdef(groupdef,lv(typestp>>strec.st)) then
[ FlushDef(dict); loop ]

//apply the definition to all components with type =typestp
let done = true
let ptr = Comps
until ptr eq 0 do
[
let tp = ptr; ptr = @ptr
for i = 0 to TypeCnt do
[
if ((tp>>comp.conpoints)>>compblock.comptype) eq typeStpVec!i then
[
//undefined group will heve comptype eq 0
//so don’t AssignPins, but mark as done anyway
if typeStpVec!i ne 0 then AssignPins(tp,groupdef)
tp>>comp.pinsdone = true
]
]
if tp>>comp.pinsdone eq false then done = false
]
if done then resultis true
if CompsToDo le 0 then resultis false
] repeat //until end of dictionary
resultis false

]

and FlushLine(s) = valof //returns true on EOF, false on cr
[
if Endofs(s) then resultis true
if Gets(s) eq $*n then resultis false
] repeat
and FlushDef(s) be //reads to the next @ or EOF
[
if Endofs(s) % Gets(s) eq $@ then return
] repeat

and ReadObj(string,stream,EndEnable) = valof
[
string!0 = 0
[
if Endofs(stream) then [ EndofDict = true; string!0 = 0; resultis true ]

let c = Gets(stream)
switchon c into
[
case $#: if (not EndEnable) % (string>>str.length gr 0) then endcase
[ EndofDict = true; string!0 = 0; resultis true ]
case $@:
case $,:
case $|:
//Vertical bar prefaces lines in "new" format
case $;: resultis c
case #32: resultis $; //simulate comment on bravo format info

case $/:
case $↑: //simulate carrage return
case $>: if not EndEnable then endcase
case $*n: resultis $*n
case $*s: loop
]
if (c gr $!)&(c le $z) then [ AppendC(c,string); loop ]
resultis c
] repeat
]

and BuildCompdef(groupdef,compname) = valof
[
//build the compdefs at NewItem
if debugswitch then Err2("*nTrying to read compdef for ",compname)
let tNewItem = NewItem
[
//read all lines in the dictionary having to do with
//this component

let stv = vec 128 //vector for things read
let tc = ReadObj(stv,dict,true) //get group (1 letter, a-y)
switchon tc into
[
case $,: endcase //expected this value

case true:
case $@: resultis true //finished with this component

case $*n: loop //blank line

case $|:
//line in "new" format
case $;: unless FlushLine(dict) then loop //comment line
//fall through on EOF

default: resultis ErrC("*nDictionary has strange entry in type ",compname,stv)
]

let glet = stv>>str.char↑1
if ((stv>>str.length ne 1)%(glet ls $a)%(glet gr $y)) then
[
if StEq(stv,"POWER") then [ FlushLine(dict); loop ]//POWER line
resultis ErrC("*nDictionary has groupname #a-y in type ",compname,stv)
]
//groupname appears ok
if debugswitch then [ Puts(ErFile,$*n);Err2(stv,": ") ]
tc = ReadObj(stv,dict,false) //read pinname
if tc ne $, then resultis ErrC("*nDictionary has strange pinname in type ",compname,stv)

if debugswitch then Wss(ErFile,stv)
let pinstp = Lookup(stv) //see if we have the pinname
if (pinstp eq 0)%(pinstp>>strec.type ne stPin) then
[
//Make dummy string for it so error message will print
CheckFit(tNewItem-NewItem+10)
MoveBlock(tNewItem, stv, 10)
pinstp=tNewItem-(offset strec.st/16)
tNewItem=tNewItem+10
]

//see if another compdef will fit
CheckFit(tNewItem-NewItem+compdsize)
tc=$,; Zero(tNewItem,compdsize)
until tc ne $, do //get all the possible pinnumbers for this pinname
[
tc = ReadObj(stv,dict,true) //supposed to be a number
if stv>>str.length eq 0 then resultis
ErrC("*nDictionary has bad pinnumber in type ",compname,stv)

let pn = 0
for i = 1 to stv>>str.length do
[
let ch = stv>>str.char↑i
if (ch ls $0)%(ch gr $9) then resultis
ErrC("*n Dictionary has nonnumeric pin in type ",compname,stv)

pn = pn*10+(ch-$0)
]

if pn gr 63 then resultis
ErrC("*nDictionary has pinnumber >63 in type",compname,stv)
if debugswitch then [ Puts(ErFile,$*s);Wss(ErFile,stv) ]
//add a bit to the compdef for this pin
SetBit(lv(tNewItem>>compdef.legalpins↑0),pn)
]

if tc ne $*n then FlushLine(dict)
//add this compdef to the appropriate list for this group
tNewItem>>compdef.pinname = pinstp //pin name
let gno = glet - $a +1
tNewItem>>compdef.link = groupdef!gno
groupdef!gno = tNewItem
tNewItem = tNewItem+compdsize
] repeat //for all lines in the definition
]



and ErrC(s1,s2,s3) = valof
[
Err(s1)
Err(s2)
Err(": ’")
Err(s3)
Err("’")
resultis false
]



and AssignPins(compptr,groupdefs) be
[
//We have a pointer to a component with typename equal to the one
//we are working on, and a vector containing list headers for
//the compdefs for that component (indexed by group). Do some
//work.

let upv = vec 4; Zero(upv,4) //used pin vector (bits set when pins are used)
let ppv = vec 4; Zero(ppv,4) //preassigned pin vector(these pins won’t be assigned)

let compb = compptr>>comp.conpoints //pointer to the real stuff for this component
if compb eq 0 then return
let group = compb>>compblock.group
let grptr = groupdefs!group
if grptr eq 0 do
[
Errxy(compptr>>comp.xmin,compptr>>comp.ymin,"Group shown for this component is not in dictionary")
return
]
let g=grptr
//Mark all pins in definition unused
while g do [ g>>compdef.used=false; g=g>>compdef.link ]

//fill in the preassigned pin vector
for i = 1 to compb>>compblock.numcpoints do
if compb>>compblock.defd↑i ne 0 then SetBit(ppv,compb>>compblock.pin↑i)

//for each connection point in the group, find the corresponding
//compdef; If a pinnumber is preassigned, check that it is a valid
//assignment. If not, assign the next available valid pin
let x1,y1=nil,nil
for i = 1 to compb>>compblock.numcpoints do
[
x1=compb>>compblock.x↑i
y1=compb>>compblock.y↑i
let pname = compb>>compblock.pinname↑i
let vpv = Findvpv(grptr,pname) //returns pointer to vpv for the pinname
if vpv eq 0 do
[
Errxy(x1,y1,"Pin name is not in dictionary",lv pname>>strec.st)
loop
]

//is the pin preassigned?
let apn=nil
test compb>>compblock.defd↑i
ifso
[
//check that the assignment is valid

apn = compb>>compblock.pin↑i
let ppb = #100000 rshift (apn & #17)
if (vpv!(apn/16) & ppb) eq 0 then
[
Errxy(x1,y1,"Preassigned pin is not a valid choice")
loop
]
]

ifnot
[
//assign the next pin which is valid and not preassigned and not used
apn = Getvpin(ppv,upv,vpv)
if apn eq 0 then
[
Errxy(x1,y1,"Can’t find pin to assign",lv pname>>strec.st)
loop
]

//assign the pin and mark it used
compb>>compblock.pin↑i = apn
]
//Assign bit for pin
SetBit(upv,apn)
let ptr=vpv-(offset compdef.legalpins↑0)/16
ptr>>compdef.used=true
]
g=grptr
while g ne 0 do
[
if g>>compdef.used eq false then
Errxy(x1,y1,"Unused pin in section near this point, named ",
lv (g>>compdef.pinname)>>strec.st)
g=g>>compdef.link
]
]

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

and Getvpin(ppv,upv,vpv) = valof
[
//find a pin which is not preassigned, not used, and valid
for i = 0 to 3 do
[
let cand = (not((ppv!i)%(upv!i))) & (vpv!i)
if cand eq 0 then loop
for j = 0 to 15 do
[
if cand ls 0 then resultis 16*i + j
cand = cand lshift 1
]
]
resultis 0
]

and Findvpv(list,pinname) = valof
[
until list eq 0 do
[
let ptr = list;list = @list
if ptr>>compdef.pinname ne pinname then loop
resultis lv (ptr>>compdef.legalpins↑0)
]
resultis 0
]
and DefaultTypeNames() be
[
//the primary purpose is to default the type name in groups
//which have none. We also check that all groups at a given
//board location have the same type name, if one is specified at all

let ptr = Comps; until ptr eq 0 do
[
let tptr = ptr; ptr = @ptr
if tptr>>comp.blout ne 0 then loop //have already checked this component
tptr>>comp.blout = 1
let cpp = tptr>>comp.conpoints
let ctype = cpp>>compblock.comptype
if ctype eq 0 then loop //no definition in this group

//have a definition- check of default the type of all components
//at the same board location
let cloc = cpp>>compblock.boardloc
if cloc eq 0 then loop //no group specified in theis component
let nptr = Comps
until nptr eq 0 do
[
let xptr = nptr; nptr = @nptr
let xpp = xptr>>comp.conpoints
if xpp eq 0 then loop
if xpp>>compblock.boardloc ne cloc then loop //some other board location
//check or assign typename
test xpp>>compblock.comptype eq 0
ifso //default
[
xpp>>compblock.comptype = ctype
xptr>>comp.blout = 1 //mark group used
]
ifnot if xpp>>compblock.comptype ne ctype then
Errxy(xptr>>comp.xmin,xptr>>comp.ymin,"Multiple type names for components at this board location")
]
]
//clear all blout bits
ptr = Comps; until ptr eq 0 do [ ptr>>comp.blout = 0; ptr = @ptr ]
]