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