//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:
[

length byte
char↑1,255 byte

]
structure bytes:
[

bite↑0,256byte

]

structure strec:
[

link word
type byte
npins byte
value word
st @str

]



let CSN(stx) = valof
[

let num = 0
for i = 1 to stx>>str.length do

[

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-$0

]

resultis num

]
and StEq(s1,s2) = valof //string compare
[

for i = 0 to s1>>str.length do
if s1>>bytes.bite↑i ne s2>>bytes.bite↑i then resultis false
resultis true

]

and WSS(stream,string) be
[

for i = 1 to string>>str.length do Puts(stream,string>>str.char↑i)

]

and AppendC(char,string) be
[

let st = string>>str.length +1
string>>str.char↑st = char
string>>str.length = st

]
and AppendS(sts,std) be //copy from source to destination
[

let dl = std>>str.length
for i = 1 to sts>>str.length do
[

dl = dl+1
std>>str.char↑dl = sts>>str.char↑i

]
std>>str.length = dl

]

// 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
[

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 @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 CheckFit(wrds) be
[

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

CallSwat("Space Exhausted")
finish

]

]

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 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

]