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

// last modified by E. McCreight November 23, 1977 9:33 AM

get "SysDefs.d"
get "AltoFileSys.d"
get "Ana.defs"

// S Y M B O L T A B L E S T U F F

let DefineSymbol(str,type) = valof //returns pointer to strec
[

let stp = Lookup(str)
if stp ne 0 do
[

if stp>>strec.type ne type then
Err2("*nMultiple definition for symbol: ",str)
stp>>strec.ucnt = stp>>strec.ucnt + 1
resultis stp

]

let h = Hash(str) //place in symbol table for this string

let l = str>>str.length
let sz = (offset strec.st)/16 + l/2 +1
CheckFit(sz) //see if there is enough room

NewItem>>strec.link = @h
@h = NewItem

NewItem>>strec.type = type
NewItem>>strec.rname = 0
NewItem>>strec.ucnt = 1
NewItem>>strec.pinsdn = 0
NewItem>>strec.st.length = l
for i = 1 to l do NewItem>>strec.st.char↑i = str>>str.char↑i
NewItem= NewItem+sz
resultis @h

]

and Lookup(str) = valof //returns stp if defined, else 0
[

let link = Hash(str)
until link eq 0 do
[

if StEq(str,lv(link>>strec.st)) then resultis link
link = link>>strec.link

]
resultis 0

]

and Hash(str) = valof
[

let r = 0
for i = 1 to str>>str.length do r = r+(str>>str.char↑i)
resultis hashtab + (r rem htsize)

]

and StEq(s1,s2,ulEqual; numargs na) = valof //string compare
[

if s1>>str.length ne s2>>str.length then resultis false
ulEqual=(na ne 2)? 177737b,-1
for i = 1 to s1>>str.length do
if ((s1>>str.char↑i xor s2>>str.char↑i)&ulEqual) ne 0 then resultis false
resultis true

]

and AppendB(num, str) be//octal number, no zero suppression
[

for i = 15 to 0 by -3 do
AppendC(((num rshift i)&7)+$0,str)

]


// P R O C E S S V A R I O U S I N P U T B L O C K S

and Dorectangle(obj,x,y) be
[

let delx = obj>>item.xmax-obj>>item.xmin
let dely = obj>>item.ymax-obj>>item.ymin
let list = 0
if delx eq 1 then list = lv Vlines
if dely eq 1 then list = lv Hlines
if list eq 0 then return //reject linewidths # 1
AddLE(list,x+obj>>item.xmin,y+obj>>item.ymin,NewItem+blLend,0,0)
AddLE(list,x+obj>>item.xmax,y+obj>>item.ymax,NewItem-blLend,0,0)

]

and AddLE(list,x,y,cp0,cp1,cp2) be //add block for line endpoint
[

CheckFit(blLend) //punt if not enough space

NewItem>>lend.link = @list
@list = NewItem

NewItem>>lend.type = btLend
NewItem>>lend.x = x
NewItem>>lend.y = y
NewItem>>lend.marked = 0
NewItem>>lend.hassig = 0
NewItem>>lend.cp↑0 = cp0
NewItem>>lend.cp↑1 = cp1
NewItem>>lend.cp↑2 = cp2

NewItem = NewItem+blLend

]

and Dofont1string(obj,x,y) be
[

let sl = obj>>item.string.length
let sp = lv(obj>>item.string)
let boardloc = 0
let gotnum = true

//try to interpret the string as a number
for i = 1 to sl do
[

let ch = sp>>str.char↑i
if (ch ls $0)%(ch gr $9) then
[

gotnum = false
break

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

]

if gotnum then [ AddNode(lv Numbers,obj,x,y,btNum,boardloc); return ]

boardloc = 0
//try to interpret the string as a boardloc/group of the form lnl (small letters
//and numbers). If the final letter (the group letter) is absent, it is defaulted
//to ’a’, which is used when an ic consists of only one group. Any string
//beginning with "#" is also defined as a boardloc, in which case the final
//character, if alphabetic, is taken as the group.

if (sl gr 1) then while true do
[

let boardlocstr = vec 130
for i=1 to sl do boardlocstr>>str.char↑i = sp>>str.char↑i
let len = sl
let group = 1 // default = group "a"
if len gr 1 then
[

let finalchar = boardlocstr>>str.char↑len
if LetVal(finalchar) ge 0 then
[

group = LetVal(finalchar)
len = len-1

]

]

if sp>>str.char↑1 ne $# then
[

if LetVal(sp>>str.char↑1) ls 0 then break
let i=2
while (NumVal(sp>>str.char↑i) ge 0)&(i le len) do i=i+1
if (i eq 2)%(i le len) then break

while len ls 3 do
[ // force at least two digits by adding leading zeros

for i=len to 2 do
boardlocstr>>str.char↑(i+1) = boardlocstr>>str.char↑i
boardlocstr>>str.char↑2 = $0
len = len+1

]
if len gr 3 then break // not legal board position

]

boardlocstr>>str.length = len
AddNode(lv Locgroups,obj,x,y,btLocgroups,DefineSymbol(boardlocstr,
stBrdloc),group)
return

]

//we have a text string. put it in the symbol table with type
//signal name, although it may later be changed to an ic type name

AddNode(lv Strings,obj,x,y,btString,DefineSymbol(sp,stSig)) //add a node for it

]

and LetVal(arg)= valof
[

if (arg ls $a)%(arg gr $z) then resultis -1
resultis (arg-$a+1)

]

and NumVal(arg)= valof
[

if (arg ls $0)%(arg gr $9) then resultis -1
resultis (arg-$0)

]

and Dofont3string(obj,x,y) be
[

//check for single special character
if obj>>item.string.length eq 1 then
[

let ch = obj>>item.string.char↑1
if selecton ch into
[

case chBlob:
case chEpin:
case chCpin:
case chGnd:
case chPseud: true
default: false

]
then

[

if ch eq chBlob then x=x+1 //fuge so center of blob is correct
AddNode(lv Schars,obj,x,y,btSchar,ch)
return

]

]

//try to make the string into a number
let v0 = 0
for i = 1 to obj>>item.string.length do
[

let n = obj>>item.string.char↑i - $0
if (n ls 0) % (n gr 9) do
[

AddBadItem(x+(obj>>item.xmin),y+(obj>>item.ymin),3)
return

]
v0 = (v0*10)+n

]
AddNode(lv Numbers,obj,x,y,btNum,v0)

]

and AddNode(list,obj,x,y,btype,val,val2; numargs na) be
[

let nodeLen = (na gr 6)?blFullNode,blBasicNode

CheckFit(nodeLen)

NewItem>>node.link = @list
@list = NewItem

NewItem>>node.type = btype
NewItem>>node.used = 0
NewItem>>node.assoc = 0 //not used or connected to anything yet
NewItem>>node.val = val
if na gr 6 then NewItem>>node.val2 = val2

let h = (obj>>item.ymax - obj>>item.ymin)/2
let w = (obj>>item.xmax - obj>>item.xmin)/2

NewItem>>node.x = obj>>item.xmin+x+w
NewItem>>node.y = obj>>item.ymin+y+h

NewItem=NewItem+nodeLen

]

and AddBadItem(x,y,type) be
[

CheckFit(blBasicNode)

NewItem>>node.link = BadItems
BadItems = NewItem

NewItem>>node.type = type
NewItem>>node.x = x
NewItem>>node.y = y
NewItem=NewItem+blBasicNode

]

and CheckFit(wrds) be
[

let l = NewItem+wrds
if Usc(l,SpaceTop) gr 0 then
[

CallSwat("Space Exhausted")
finish

]

]


and Docomponent(obj,x,y) be //we have a library macro call
[

//it must be exactly one character long
if obj>>item.string.length ne 1 then
[

AddBadItem(x+(obj>>item.xmin),y+(obj>>item.ymin),5)
return

]

let mindex = ((obj>>item.font)-8)*128 + obj>>item.string.char↑1

Mact!mindex = -1 //indicate a need for the definition

//add the first half of the component descriptor to the list

CheckFit(blComp)

NewItem>>comp.link = Comps
Comps = NewItem

NewItem>>comp.type = btComp
NewItem>>comp.xmin = x+obj>>item.xmin
NewItem>>comp.ymin = y+obj>>item.ymin
NewItem>>comp.xmax = x+obj>>item.xmax
NewItem>>comp.ymax = y+obj>>item.ymax
NewItem>>comp.color = obj>>item.color
NewItem>>comp.mindex = mindex
NewItem>>comp.pinsdone = 0 //used to know when to stop reading dictionary
NewItem>>comp.blout = 0 //used to avoid sending type name for each group during output
NewItem>>comp.conpoints = 0 //no connection points yet

NewItem = NewItem+blComp

]




and LibUpdate(font,s) = valof //read from libraries referenced in infile
[

let mbase = ((font-8)*128) + Mact //starting loc in Mact for this font
let need = false
for i = 0 to 127 do if (mbase!i) eq -1 then need = true
unless need then //this font did’nt have any undefined macros
[ if s ne 0 then Closes(s); resultis false ]

if s eq 0 then
[
s = OpenFile(0,ksTypeReadOnly,0,0,Lprvec+DirPreambleSize*(font-9)+1,0,SilZone)
if s eq 0 then
[

let msg = "Can’t Open Library number N?"
msg>>str.char↑(msg>>str.length) = font-4+$0
CallSwat(msg)

]
]

let pw = Gets(s); if (pw ne #34562) & (pw ne #34563) then
[
let msg = "Bad Password in file Sil.lb?"; msg>>str.char↑(msg>>str.length) = font-4+$0
CallSwat(msg)
]

let tvec = vec 128
until Endofs(s) do
[

let mname = Gets(s)
if mname eq -1 then break //past the macro definitions = done
for i = 1 to 4 do tvec!i = Gets(s)
let fnt = tvec>>item.font
if fnt ne 14 then //read the string
[

tvec!5 = Gets(s)
let sl = (tvec!5) rshift 8
if sl gr 1 then for i=1 to sl/2 do tvec!(5+i) = Gets(s)

]
//we will use this macro only if (a) mbase!mname is nonzero
//i.e. we want this definition, and (b)
//the object is a font 1 string or a single character
//font 3 string which is a connection point.
//if we want the definition, we add a node to mbase!mname

if mbase!mname eq 0 then loop //don’t want this def

if (fnt eq 2)&(tvec>>item.italic eq 0) then //add font 1 strings to list
[

let stp = Lookup(lv tvec>>item.string)
test stp eq 0

ifso stp = DefineSymbol(lv tvec>>item.string,stPin)

ifnot stp>>strec.type = stPin //change symbol type to pin

//add to list
AddNode(lv (mbase!mname),tvec,0,0,btString,stp)
loop

]

if (fnt eq 6)&(tvec>>item.italic eq 0) then //add an schar if the string font 3
[

if tvec>>item.string.length ne 1 then loop
let ch = tvec>>item.string.char↑1
if selecton ch into
[

case chTcon:
case chBcon:
case chLcon:
case chRcon: true
default: false

] then AddNode(lv (mbase!mname),tvec,0,0,btSchar,ch)

]

]
Closes(s)

]

and FindDictLibraries(DictName) be //get fp’s for SIL.LB5 to SIL.LB9
[

let L = 5*DirPreambleSize + 10*(lCFA+1)
Lprvec = Allocate(SilZone, L); Zero(Lprvec,L)
Dprvec = Lprvec + 5*DirPreambleSize

//first get the library file pointers from Sil.fps
let S = OpenFile("Sil.fps",ksTypeReadOnly)
if S eq 0 do CallSwat("Can’t get Library file pointers!!! - please run Sil/I.")

for i = 0 to 4*DirPreambleSize-1 do Gets(S)//read past the font fp’s
for i = 0 to 5*DirPreambleSize-1 do Lprvec!i = Gets(S)// read the Library fp’s
Closes(S)

//entries not found will generate appropriate errors later if the libraries were needed

//now get the first dictionary name by looking in user.cm
S = OpenFile("User.cm",ksTypeReadOnly,1,0,fpUserCm,0,SilZone) //open for bytes
if S eq 0 then CallSwat("Can’t open User.cm")

let str = vec 128
let gotsil,gotA = false,false
[

switchon ReadUserCmItem(S,str) into
[

case $N: gotsil = StEq(str,"SIL",nil)
endcase

case $L:
unless gotsil then endcase
if str>>str.length gr 1 then endcase
if str>>str.char↑1 eq $A then gotA = true //found Analyse entry
if str>>str.char↑1 eq $a then gotA = true //found Analyse entry
endcase

case $P: if gotA eq 0 then endcase
case $E: Closes(S);break //end of stream or done

]

] repeat


DictName!0 = 0
if (gotA eq false) % (str>>str.length le 2) do
[ AppendS("Dict.Analyze",DictName); return ]
for i = 1 to str>>str.length do
[
let c = str>>str.char↑i
if c le $*s then break
AppendC(c,DictName)
]

]