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