//prepocb.bcpl
//second module of tc

get "sysdefs.d"
manifest
[
Nfiles = 5
htsize = 64
DirPreambleSize=6
ksTypeReadOnly=1
ksTypeWriteOnly=2
ksTypeReadWrite=3
verLatestCreate=#40000+2

//states of the input
Idle = 0
GotSlash = 1
DoingComment = 2
DoingBusName = 3
DoingBusPinName = 4
GettingName = 5
HaveName = 6
GetRHS = 7
RHSname = 8

//signal types
BusName=1
ExtSig=2 //signal hooked to an edgepin
IntSigUsed=3
IntSigUnused = 4


]

static
[
L
R
]


external
[
Sort
StCompFn
SpaceTop
CSN //defined here
Usc
CallSwat
DefineSymbol
hashtab
Lookup
NewItem
StEq
WSS
AppendC
AppendS
Puts
]
structure str:
[(635)\f1
length byte
char^1,255 bytel4268\f1
]
structure bytes:
[\f1
bite^0,256	bytel4268\f1
]

structure strec:
[\f1
link word
type byte
npins byte
value word
st @strl4268\f1
]



let CSN(stx) = valof
[\f1
let num = 0
for i = 1 to stx>>str.length dol4269\f1
[l4269\f1
let ch = stx>>str.char^i
if ch eq $*s then loop
if ch eq $. then break //truncate decimals
if (ch ls $0)%(ch gr $9) then resultis -1
num = num*10 + ch-$0l5539\f1
]

resultis numl4269\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 WSS(stream,string) be
[\f1
for i = 1 to string>>str.length do Puts(stream,string>>str.char^i)l4268\f1
]

and AppendC(char,string) be
[\f1
let st = string>>str.length +1
string>>str.char^st = char
string>>str.length = st
l4268\f1
]
and AppendS(sts,std) be //copy from source to destination
[\f1
let dl = std>>str.length
for i = 1 to sts>>str.length do
[l4268\f1
dl = dl+1
std>>str.char^dl = sts>>str.char^il5538\f1
]
std>>str.length = dll4268\f1
]

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

and DefineSymbol(str,type,value,nbp; numargs na) = valof //returns pointer to strec
[\f1
let stp = Lookup(str)

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.value = value
NewItem>>strec.npins = (na gr 3?nbp,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 @hl4268\f1
]

and Lookup(str) = valof //returns stp if defined, else 0
[\f1
let link = Hash(str)
until link eq 0 do
[l4268\f1
if StEq(str,lv(link>>strec.st)) then resultis link
link = link>>strec.linkl5538\f1
]
resultis 0l4268\f1
]

and Hash(str) = valof
[\f1
let r = 0
for i = 1 to str>>str.length do r = r+(str>>str.char^i)
resultis hashtab + (r rem htsize)
l4268\f1
]

and CheckFit(wrds) be
[\f1
let l = NewItem+wrds
if Usc(l,SpaceTop) gr 0 then
[l4268\f1
CallSwat("Space Exhausted")
finishl5538\f1
]l4268\f1
]

and Sort(sv,cfn) be
[(1270)\f1
let rp = nil
L = ((sv!0)/2)+1
R = sv!0
[l4268\f1
test L gr 1
ifso
[l5538\f1
L = L-1
rp = sv!Ll6808\f1
]
ifnot
[l5538\f1
rp = sv!R
sv!R = sv!1
R = R-1
if R eq 1 then
[l6808\f1
sv!1 = rp
returnl8078\f1
]l6808\f1
]

let j = L
let i = nil
[l5538\f1
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
[l6808\f1
if cfn(sv!j,rp) le 0 then break
sv!i = sv!j
loopl8078\f1
]
breakl6808\f1
] repeat

sv!i = rp
l5538\f1
] repeatl4268\f1
]

and StCompFn(stp1,stp2) = valof
[\f1
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
[l4268\f1
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 breakl5538\f1
]
if comp eq 0 then comp = l1-l2
resultis compl4268\f1
]



(635)\f1