```// Micro symbol table routines
// last edited December 26, 1979  8:42 AM
// Copyright Xerox Corporation 1979

get "micdecl.d"

external
[		// O.S.
SetBlock; Zero
Puts	// for tracing
// defined here for MICSLOW
@endhc; @hlast; @hprev; @sw0
]

structure
[	lhw bit 8		// Left half of word
rhw bit 8		// Right half of word
]
structure
[	blank bit 15
odd bit 1		// Least significant bit
]

compileif slink ne 0 then
[ SlinkNe0 = 0 ]	// *** Lookup assumes slink=0 ***

static [
// Storage for scinit, scnext, and nsnext
@scep		// Scanner current entry pointer
@schp		// Scanner hash chain pointer
@scwn		// Scanner word number
@scmask		// Scanner word mask
@scval		// Scanner value for which to scan
@sche		// Scanner hash chain end pointer
@scstop		// Scanner chain stop value
@nshp		// New symbol hash pointer
@nshe		// New symbol hash end pointer
@nsbp		// New symbol current block pointer
// Storage for lookup, putin, and newdef
@svec	// dummy vector for end of hash chains
@endhc	// ditto -sname
@symbase	// real address of hash vector
@hsize	// Hash table size
@hlast
@hprev
@saddr	// address of unpacked symbol
@scc	// length of unpacked symbol
@sw0	// first word of packed name
@nsbase	// real address of new symbol hash vector
@nsmask	// new symbol hash mask
// Statistics
// *** Assumes statics are allocated in order
zenter; zenter1	// # of putins
]

let lenname(ep) = valof
// Returns length of name of symbol table entry.  Names are
//	delimited by a zero in the left or right halfword.
[	let ptr = ep + sname
while ptr>>rhw ne 0 do
ptr = ptr + 1
resultis ((ptr-ep) lshift 1) + (ptr>>lhw ne 0 ? -1, -2)
]

and initsym(siz, nsiz; numargs na) be
// Initialize the symbol table
[	if na ne 0 then	// Allocating
[	symtab = alloc(siz) - fstop
symvec = alloc(1) - fstop
nstab = alloc(nsiz) - fstop
]
symbase = symtab + fstop
svec = symvec + fstop
endhc = svec-sname
hsize = bsize(symbase)
if na ne 0 then
SetBlock(symbase, endhc, hsize)
nsbase = nstab + fstop
nsmask = bsize(nsbase)-1
Zero(nsbase, nsmask+1)
]

and dumpsym() be
// Relativize the symbol table for dumping
[	scinit(0, 0, 0)
until schp eq sche do
[ let ep = schp
until ep eq scstop do
[ let ep1 = ep!slink
ep!slink = ep1 - fstop
ep = ep1
]
schp = schp+1
]
]

and recsym() be
// De-relativize the symbol table after dumping or reloading
[	scinit(0, 0, 0)
until schp eq sche do
[ let ep = schp
until ep eq scstop do
[ let ep1 = ep!slink + fstop
ep!slink = ep1
ep = ep1
]
schp = schp+1
]
]

and scinit(wn,mask,val) be
// Initialize for symbol table scan.  All entries in the symbol
//	table will have the word displaced from their ep
//	by wn words anded with mask.  If the resulting
//	value is val, they will be reported by scnext().
[	scwn, scmask, scval = wn, mask, val
schp = symbase-slink
sche = schp+hsize
scstop = endhc
scep = schp
nshp = nsbase
nshe = nshp+nsmask+1
nsbp = nshp
]

and scnext() = valof
// Traverse symbol table reporting all expressions that meet
//	the criteria described in scinit.  Major traversal is
//	through the array of hash chain heads, minor is through
//	the chains themselves.
[	 [ scep = scep!slink
if scep eq scstop then
[	schp = schp+1
if schp eq sche resultis 0
scep = schp
loop
]
if (scep!scwn & scmask) eq scval resultis scep
] repeat
]

and nsnext() = valof
// Traverse table of new (redefined since /R) symbols that meet
//   the criteria set by scinit.  Order is as in scnext.
[	[ nsbp = @nsbp
if nsbp eq 0 then
[ nshp = nshp+1
if nshp eq nshe resultis 0
nsbp = nshp
loop
]
let ep = nsbp!1
if (ep!scwn & scmask) eq scval resultis ep
] repeat
]

and lookup(paddr, pcc) = valof
// Just a dummy
[	lookup = fastlookup
resultis fastlookup(paddr, pcc)
]

and fastlookup(paddr, pcc) = valof
// Lookup symbol in symbol table.  If present, return ep;
//	if not, return zero and leave values around to
//	allow putin to work.
[	saddr, scc = paddr, pcc
let sw1, sw2, sw3, sw4, sw5, sw6, sw7 =
nil, nil, nil, nil, nil, nil, nil
let compare = nil
let chain = nil	// Faster branch if in local variable
let ptr = nil
switchon pcc into
[ case 15: compare = cw7; sw7 = paddr!14 lshift 8; goto p6
case 14: compare = cw7; sw7 = 0; goto p6
case 13: compare = cw6; sw6 = paddr!12 lshift 8; goto p5
case 12: compare = cw6; sw6 = 0; goto p5
case 11: compare = cw5; sw5 = paddr!10 lshift 8; goto p4
case 10: compare = cw5; sw5 = 0; goto p4
case 9: compare = cw4; sw4 = paddr!8 lshift 8; goto p3
case 8: compare = cw4; sw4 = 0; goto p3
case 7: compare = cw3; sw3 = paddr!6 lshift 8; goto p2
case 6: compare = cw3; sw3 = 0; goto p2
case 5: compare = cw2; sw2 = paddr!4 lshift 8; goto p1
case 4: compare = cw2; sw2 = 0; goto p1
case 3: compare = cw1; sw1 = paddr!2 lshift 8; goto p0
case 2:	// Special check for packed symbol
if paddr!1 ls 40b then
resultis (paddr!1 eq symc? @paddr+fstop, 0)
compare = cw1; sw1 = 0; goto p0
case 1: compare = cw0; sw0 = @paddr lshift 8; goto pn
case 0: compare = cw0; sw0 = 0; goto pn
]
// Long name
compare = complong
p7:	sw7 = (paddr!14 lshift 8) + paddr!15
p6:	sw6 = (paddr!12 lshift 8) + paddr!13
p5:	sw5 = (paddr!10 lshift 8) + paddr!11
p4:	sw4 = (paddr!8 lshift 8) + paddr!9
p3:	sw3 = (paddr!6 lshift 8) + paddr!7
p2:	sw2 = (paddr!4 lshift 8) + paddr!5
p1:	sw1 = (paddr!2 lshift 8) + paddr!3
p0:	sw0 = (@paddr lshift 8) + paddr!1
pn:	@svec = sw0
chain = schain
hlast = ((rv paddr + paddr!(pcc-1) + pcc) rem hsize) + symbase
ptr = hlast	// *** assumes slink eq 0
schain:	// Traverse through hash chain.
[ let ptr1 = @ptr
if sw0 eq ptr1!sname then
[ hprev = ptr
ptr = ptr1
if ptr ne endhc goto compare
resultis 0
]
ptr = @ptr1
if sw0 eq ptr!sname then
[ hprev = ptr1
if ptr ne endhc goto compare
resultis 0
]
] repeat
complong:		// Very long name, must use loop
[ let tptr = ptr+(sname+8)
let sptr = paddr+16
let tend = ptr+sname+(pcc rshift 1)
while tptr ne tend do
[ if (@sptr lshift 8 + sptr!1) ne @tptr goto chain
tptr, sptr = tptr+1, sptr+2
]
if @tptr ne (pcc<<odd eq 0? 0, @sptr lshift 8) goto chain
]
cw7:	if ptr!(sname+7) ne sw7 goto chain
cw6:	if ptr!(sname+6) ne sw6 goto chain
cw5:	if ptr!(sname+5) ne sw5 goto chain
cw4:	if ptr!(sname+4) ne sw4 goto chain
cw3:	if ptr!(sname+3) ne sw3 goto chain
cw2:	if ptr!(sname+2) ne sw2 goto chain
cw1:	if ptr!(sname+1) ne sw1 goto chain
cw0:
// Move symbol to head of chain
@hprev = @ptr
@ptr = @hlast
@hlast = ptr
resultis ptr
]

and putin(ptype) = valof
// Puts a symbol in the symbol table.  Depends on Lookup
//	having immediately preceded it.
[	if scc eq 0 then
errx("Can't define 0-length symbol", true)
if (scc eq 2) & (saddr!1 ls 40b) then
test saddr!1 eq symc
ifso error("Putin error")
ifnot errx("Attempt to define @V as symbol", true, @saddr)
let chp = saddr+scc
[ [ chp = chp-1
if (@chp gr \$7) % ((@chp ls \$0) & ((@chp ne \$-) % (chp ne saddr))) goto putok
] repeatwhile chp ne saddr
errx("Attempt to define @B as symbol", true, saddr, scc)
putok:	]
DoubleAdd1(lv zenter)
if tracesyms then [ Puts(erlchan, \$←) ]
let wc = scc rshift 1
let dsize =		// Size of dope
typesizes!(ptype ls 0? adrtype,
ptype gr maxtype? mactype,
ptype)
let bsize = wc + 2 + dsize
let badd = get1(bsize)
let ptr = badd + dsize
ptr!(wc+sname) = 0
pak(ptr+sname, saddr, scc)
// Link symbol onto beginning of chain
ptr!slink = @hlast
@hlast = ptr
ptr!stype = ptype
resultis ptr
]

and newdef(ep, add) = valof
// If add=false, return true iff ep is new since /R
// If add=true, mark ep as new since /R
[	if ep-fstop ls ofbot resultis true
let hp = (ep & nsmask) + nsbase
while @hp ne 0 do
[ if (@hp)!1 eq ep resultis true
hp = @hp
]
unless add resultis false
let bp = alloc(2)
@bp, bp!1 = 0, ep
@hp = bp
resultis true
]
```