// SwatSymB.bcpl -- symbol table -- companion file is SwatSymA.asm
// Copyright Xerox Corporation 1979, 1980, 1982
// Last modified May 9, 1982  11:36 AM by Taft

// All you do is just...09/05/73   (ALB)

get "Swat.decl"
get "Streams.d"
get "AltoFileSys.d"
get "SwatSym.decl"

external
[
// outgoing Procedures
SymToAddr; AddrToSym; MapSym; ReadSymsFile
SymPrint; SymRead; SymReset; StaticValue; SymBank
SymSysOut; SymSysIn; SymSwapIn; ResetSymCache

// incoming procedures from Swat
VMFetch; VMCache; ReadString; Confirm; DisplayState
Fail; ReportFail; SetFailPt; UnSetFailPt; ReportBug
ScanSymBuffer; FindSym; ClosestPL; ClosestV

// incoming procedures from OS
OpenFile; CreateDiskStream; ReadLeaderPage
InitScanStream; GetScanStreamBuffer; FinishScanStream
GetCurrentFa; JumpToFa; GetCompleteFa
ReadBlock; WriteBlock; FilePos; SetFilePos
Closes; Endofs; Gets; Puts; PutTemplate; Ws; Wss
Zero; MoveBlock; SetBlock; DoubleAdd; Allocate; Free; Noop
Dequeue; Enqueue; Unqueue; QueueLength; DefaultArgs
ExtractSubstring; ConcatenateStrings; StringCompare; CopyString

// outgoing statics
cfaSym; symFileName; writeDate; faSymStrings
stfQ; userStrings; builtInStrings
s; a; p

// incoming statics
sysZone; dsp; xmFlag
]

static
[
stfQ			// -> queue of STFs
builtInStrings		// -> queue of built-in names
userStrings		// -> queue of cached names
symCacheHits		// # of hits in the user symbol cache
symCacheMisses		// # of misses in the user symbol cache

cfaSym			// -> cfa of start of .Syms file
symFileName		// -> file name of .Syms file
writeDate		// -> write date of .Syms file
faSymStrings		// -> fa of string area of .Syms file

s; a; p			// MapSym temporaries
]

//Each static has a Sym structure in an STF structure on stfQ.
//Strings for built-in statics are kept in CE structures on the
// builtInStrings queue.  Sym.builtIn is true for these.
//Strings for recently referenced user statics are cached in CE structures
// on the userStrings queue.  Sym.inCache is true for these.
//If the static is built-in or cached, then Sym.namePos -> the CE
// containing the name, which is either on the builtInStrings queue
// or the userStrings queue.  Otherwise Sym.namePos is the word offset
// in the string area of the .SYMS file for the string.
//SysOut appends a copy of the .SYMS file to the SysOut file.
//SysIn sets up all of the FPs and FAs so that it can treat that segment
// of the file as if it were simply a .SYMS file.

structure FSS:		// File Scan State
[
buffer word		// -> current buffer (0 => hit end-of-file)
pos word		// word position in buffer of current sym name
endPos word		// word position of first word not in buffer
basePos word		// offset of buffer base relative to faSymStrings
stopPos word		// length of string area = limit value of basePos
ssd word		// -> Scan Stream Descriptor
]

//----------------------------------------------------------------------------
let SymToAddr(symbol) = valof
//----------------------------------------------------------------------------
[
// Hack: the value of a symbol that begins with ^ is its address
let forceAddr, fixedSymbol = false, vec 127
if symbol>>String.char^1 eq $^ then
   [
   for i = 2 to symbol>>String.length do
      fixedSymbol>>String.char^(i-1) = symbol>>String.char^i
   fixedSymbol>>String.length = symbol>>String.length-1
   symbol = fixedSymbol
   forceAddr = true
   ]

// Search the built-in string queue
let ce = builtInStrings!0; while ce ne 0 do
   [
   if StringCompare(ce>>CE.string, symbol) eq 0 then
      resultis StaticValue(ce>>CE.sym, forceAddr)
   ce = ce>>CE.link
   ]

// Search the user string cache
ce = userStrings!0; while ce ne 0 do
   [
   if StringCompare(ce>>CE.string, symbol) eq 0 then
      [
      Unqueue(userStrings, ce)
      Enqueue(userStrings, ce)  //make it most recently referenced
      symCacheHits = symCacheHits +1
      resultis StaticValue(ce>>CE.sym, forceAddr)
      ]
   ce = ce>>CE.link
   ]

// Search string area in .Syms file
let stream = CreateDiskStream(lv cfaSym>>CFA.fp, ksTypeReadOnly, wordItem)
if stream ne 0 then
   [
   JumpToFa(stream, faSymStrings)
   let numChars = symbol>>String.length
   fixedSymbol>>String.length = numChars
   for i = 1 to numChars do
      fixedSymbol>>String.char^i = symbol>>String.char^i & 337b
   if (numChars & 1) eq 0 then
      fixedSymbol>>String.char^(numChars+1) = 0

   // The following must be declared in the order defined in the FSS structure
   let buffer, pos, endPos, basePos, stopPos, ssd = 0, nil, 0, nil, nil, nil
   let fss = lv buffer
   pos = ((faSymStrings>>FA.charPos+2) rshift 1) & 377b
   basePos = 1 - pos
   stopPos = Gets(stream)
   manifest nBufs = 2
   let bufTable = vec nBufs
   for i = 0 to nBufs-1 do bufTable!i = Allocate(sysZone, 256)
   ssd = InitScanStream(stream, bufTable, nBufs)
   AdvanceBuffer(fss)
   s = 0

   // SymToAddr (cont'd)

   while buffer ne 0 & pos ls endPos do
      [
      // Advance the pointer to the first "interesting" symbol.
      // The call to ScanSymBuffer accelerates the search, but if the call is
      //  omitted the search still works, only more slowly.
      pos = ScanSymBuffer(buffer+pos, buffer+endPos, fixedSymbol) - buffer

      // Now inpect the entry carefully.
      p = basePos + pos
      let thisSymbol, tempSymbol = buffer+pos, vec 128  //NOT 127!
      let len = thisSymbol>>String.length rshift 1 +1
      MoveBlock(tempSymbol, thisSymbol, len)
      pos = pos + len; if pos ge endPos then
         [ AdvanceBuffer(fss); MoveBlock(tempSymbol+len-pos, buffer, pos) ]
      tempSymbol!len = 0  //stop ScanSymBuffer
      unless ScanSymBuffer(tempSymbol, tempSymbol+len+1, fixedSymbol) eq tempSymbol loop

      // Found it
      MapSym(FindSym, FindSym, FindSym)
      if s ne 0 then AddToSymCache(tempSymbol, s)
      break
      ]

   FinishScanStream(ssd)
   for i = 0 to nBufs-1 do Free(sysZone, bufTable!i)
   Closes(stream)
   if s ne 0 resultis StaticValue(s, forceAddr)
   ]

PutTemplate(dsp, "$S not found*n", symbol)
Fail()
]

//----------------------------------------------------------------------------
and AdvanceBuffer(fss) be
//----------------------------------------------------------------------------
[
fss>>FSS.basePos = fss>>FSS.basePos + fss>>FSS.endPos
test fss>>FSS.basePos ge fss>>FSS.stopPos
   ifso
      [
      fss>>FSS.buffer = 0
      fss>>FSS.pos = 0
      fss>>FSS.endPos = 0
      ]
    ifnot
      [
      fss>>FSS.buffer = GetScanStreamBuffer(fss>>FSS.ssd)
      fss>>FSS.pos = fss>>FSS.pos - fss>>FSS.endPos
      fss>>FSS.endPos = fss>>FSS.ssd>>SSD.numChars rshift 1
      if fss>>FSS.basePos + fss>>FSS.endPos gr fss>>FSS.stopPos then
         fss>>FSS.endPos = fss>>FSS.stopPos - fss>>FSS.basePos
      ]
]

//----------------------------------------------------------------------------
// and FindSym(sym) be  //asm coded for speed
//----------------------------------------------------------------------------
//    if sym>>Sym.builtIn eq 0 & sym>>Sym.inCache eq 0 &
//     sym>>Sym.namePos eq p then s = sym

//----------------------------------------------------------------------------
// and ScanSymBuffer(ptr, endPtr, symbol) = valof  //asm coded for speed
//----------------------------------------------------------------------------
// [
// let len = ptr>>String.length rshift 1 +1
// if ptr+len uge endPtr resultis ptr
// if StringCompare(ptr, symbol) eq 0 resultis ptr
// ptr = ptr + len
// ] repeat

//----------------------------------------------------------------------------
and AddrToSym(stream, addr, bank, epsilon; numargs na) be
//----------------------------------------------------------------------------
[
DefaultArgs(lv na, -2, 0, 0)
let dummySym = vec lenSym; Zero(dummySym, lenSym)
dummySym>>Sym.bank = bank
s, a = dummySym, addr
MapSym(ClosestPL, ClosestPL, ClosestV)
test s>>Sym.inCache ne 0
   ifso symCacheHits = symCacheHits +1
   ifnot if s>>Sym.builtIn eq 0 then  //Aw shit
      unless s eq dummySym do  //skip if no symbol close to this addr
         [
         let sym = CreateDiskStream(lv cfaSym>>CFA.fp,
          ksTypeReadOnly, wordItem)
         JumpToFa(sym, faSymStrings)
         let fPos = vec 1; FilePos(sym, fPos)
         SymSetPos(sym, fPos, s>>Sym.namePos)
         let string = vec 127
         string!0 = Gets(sym)
         for i = 1 to string>>String.length rshift 1 do string!i = Gets(sym)
         Closes(sym)
         AddToSymCache(string, s)
         ]
let string = s>>Sym.namePos>>CE.string
let value = StaticValue(s, false)
test s ne dummySym & addr-value uls 2000B
   ifso test addr-value ule epsilon
      ifso Wss(stream, string)  // exact match
      ifnot PutTemplate(stream, "$S+$O", string, addr-value)  // close
   ifnot test bank eq 0  // too far away
      ifso PutTemplate(stream, "$UO", addr)
      ifnot PutTemplate(stream, "$O.$UO", bank, addr)
]

//----------------------------------------------------------------------------
// and ClosestPL(sym) be  //asm coded for speed
//----------------------------------------------------------------------------
//    if s>>Sym.value uls sym>>Sym.value & sym>>Sym.value ule a &
//     s>>Sym.bank eq sym>>Sym.bank then s = sym

//----------------------------------------------------------------------------
// and ClosestV(sym) be if sym>>Sym.addr eq a then s = sym  //asm coded
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and SymRead() be	//^Y command
//----------------------------------------------------------------------------
[
let fn = ReadString("Symbol file name: "); if fn eq 0 return
let stream = OpenFile(fn, ksTypeReadOnly, wordItem)
if stream eq 0 then
   [
   fn = ConcatenateStrings(fn, ".syms", true)
   stream = OpenFile(fn, ksTypeReadOnly, wordItem)
   if stream eq 0 then [ Free(sysZone, fn); ReportFail("File not found") ]
   ]
SetFailPt(sr)
ReadSymsFile(stream, fn)
UnSetFailPt()
sr:Closes(stream)
Free(sysZone, fn)
]

//----------------------------------------------------------------------------
and SymSysIn(sysIn, name) be
//----------------------------------------------------------------------------
[
SymReset()
let length = Endofs(sysIn)? 0, Gets(sysIn)
if length ne 0 then  //a .syms file follows
   [
   let fPos = vec 1; FilePos(sysIn, fPos)
   SetFailPt(ssi)
   ReadSymsFile(sysIn, name)
   UnSetFailPt()
   ssi: SymSetPos(sysIn, fPos, length)
   ]
]

//----------------------------------------------------------------------------
and SymSysOut(sysOut) be
//----------------------------------------------------------------------------
[
let sym = CreateDiskStream(lv cfaSym>>CFA.fp, ksTypeReadOnly, wordItem)
test sym eq 0
   ifso Puts(sysOut, 0)
   ifnot  //append .syms file to sysout file
      [
      let buf, bufLen = 0, 77777b
      SetFailPt(sso)
      buf = Allocate(sysZone, bufLen, lv bufLen) repeatuntil buf ne 0
      JumpToFa(sym, lv cfaSym>>CFA.fa)
      ReadBlock(sym, buf, 16)
      JumpToFa(sym, lv cfaSym>>CFA.fa)
      Puts(sysOut, buf>>SymHead.fileLength)
      until Endofs(sym) do
         WriteBlock(sysOut, buf, ReadBlock(sym, buf, bufLen))
      UnSetFailPt()

      sso:
      if buf ne 0 then Free(sysZone, buf)
      Closes(sym)
      ]
]

//----------------------------------------------------------------------------
and ReadSymsFile(stream, fn) be
//----------------------------------------------------------------------------
[
VMCache(vmFlush); SymReset()

// Remember some things about .Syms file to make subsequent accesses faster
//  and to detect if file has changed so that this info can be recomputed.
GetCompleteFa(stream, cfaSym)
symFileName = ExtractSubstring(fn)
let fPos = vec 1; FilePos(stream, fPos)
let ld = Allocate(sysZone, 256)
ReadLeaderPage(stream, ld)
MoveBlock(writeDate, lv ld>>LD.written, 2)
Free(sysZone, ld)
JumpToFa(stream, lv cfaSym>>CFA.fa)
let freeSlop = Allocate(sysZone, 1000)
let header, numUserSyms = vec 16, nil
SetFailPt(rsf)

// read file header
ReadBlock(stream, header, 16)
if (header>>SymHead.version & 177400b) ne 1000b then  //major vers = 2
   unless Confirm("Are you sure this is a symbol file?") do Fail()

// save FA of string area
SymSetPos(stream, fPos, header>>SymHead.namesAddr)
GetCurrentFa(stream, faSymStrings)

// build user symbol table
SymSetPos(stream, fPos, header>>SymHead.symsAddr)
numUserSyms = Gets(stream)
// There seems to be a bug in Bldr that causes the number of user symbols
//  for Sys.syms to be 1 too big (not surprising: Sys.syms is special).
while header>>SymHead.symsAddr+lenSym*numUserSyms+1 gr
 header>>SymHead.brFilesAddr do numUserSyms = numUserSyms -1

while numUserSyms ne 0 do
   [
   let stf, symsInThisSTF = nil, numUserSyms
      [
      let maxSize = nil
      stf = Allocate(sysZone, lenSTFHeader+symsInThisSTF*lenSym, lv maxSize)
      if stf eq 0 then
         [
         if maxSize ls 100 then Fail("Your symbol table is too big!*N")
         symsInThisSTF = (maxSize-lenSTFHeader)/lenSym
         ]
      ] repeatuntil stf ne 0

   // install user's symbols
   ReadBlock(stream, lv stf>>STF.firstSym, symsInThisSTF*lenSym)
   stf>>STF.builtIn = false
   stf>>STF.numSyms = symsInThisSTF
   let sym = lv stf>>STF.firstSym
   for i = 1 to symsInThisSTF do
      [
      sym>>Sym.builtIn = false
      sym>>Sym.inCache = false
      sym = sym + lenSym
      ]
   Enqueue(stfQ, stf)
   numUserSyms = numUserSyms - symsInThisSTF
   ]
Free(sysZone, freeSlop)

BindAllSyms()
DisplayState()
UnSetFailPt()
return

rsf: SymReset()
Free(sysZone, freeSlop)
]

//----------------------------------------------------------------------------
and BindAllSyms() be MapSym(BindSym, BindSym, Noop)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and BindSym(sym) be
//----------------------------------------------------------------------------
[
sym>>Sym.bank = 0
test sym>>Sym.reloc
   ifso UpdateReloc(sym)
   ifnot sym>>Sym.value = VMFetch(sym>>Sym.addr)
]

//----------------------------------------------------------------------------
and StaticValue(sym, forceAddr) =
//----------------------------------------------------------------------------
   ((sym>>Sym.type eq variable) % forceAddr)? sym>>Sym.addr, sym>>Sym.value

//----------------------------------------------------------------------------
and SymBank(sym, forceAddr) = sym>>Sym.bank
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and MapSym(Procedure, Label, Variable) be
//----------------------------------------------------------------------------
[
let stf = stfQ!0; while stf ne 0 do
   [
   let sym = lv stf>>STF.firstSym
   for i = 1 to stf>>STF.numSyms do
      [
      (selecton sym>>Sym.type into
         [
         case procedure: Procedure
         case label: Label
         case variable: Variable
         default: Noop
         ])(sym)
      sym = sym + lenSym
      ]
   stf = stf>>STF.link
   ]
]

//----------------------------------------------------------------------------
and SymSetPos(stream, pos, inc) be
//----------------------------------------------------------------------------
[
let byteInc = vec 1
byteInc!0 = inc rshift 15
byteInc!1 = inc lshift 1
DoubleAdd(byteInc, pos)
SetFilePos(stream, byteInc)
]

//----------------------------------------------------------------------------
and SymSwapIn() be
//----------------------------------------------------------------------------
[
if symFileName ne 0 then  //We may have a symbol file...
   [
   let stream = OpenFile(symFileName, ksTypeReadOnly, wordItem, 0,
    lv cfaSym>>CFA.fp)
   test stream eq 0
      ifso SymReset()  //Nope, it disappeared; forget about it.
      ifnot
         [
         let ld = vec 256
         SetFailPt(ssi1)
         ReadLeaderPage(stream, ld)
         if writeDate>>TIME.h ne ld>>LD.written.h %
          writeDate>>TIME.l ne ld>>LD.written.l then
            [
            let fn = symFileName; symFileName = 0
            ReadSymsFile(stream, fn)  //It changed. Reinstall it.
            ]
         UnSetFailPt()
         ssi1: Closes(stream)
         ]
   ]
MapSym(UpdateReloc, UpdateReloc, Noop)
]

//----------------------------------------------------------------------------
and UpdateReloc(sym) be
//----------------------------------------------------------------------------
[
if sym>>Sym.reloc then
   [
   let value = VMFetch(sym>>Sym.addr)
   if xmFlag then
      [
      let firstWord = VMFetch(value)
      if (firstWord & xJmpInstMask) eq xJmp0 then
         [
         sym>>Sym.bank = firstWord & xJmpBankMask
         value = VMFetch(value+1)  //i.e. xPC
         ]
      ]
   sym>>Sym.value = value
   ]
]

//----------------------------------------------------------------------------
and SymReset() be
//----------------------------------------------------------------------------
[
ResetSymCache()
// reset user symbols to empty but keep built-in symbols
let stf = stfQ!0; while stf ne 0 do
   [
   let nextSTF = stf>>STF.link
   if stf>>STF.builtIn eq 0 then
      [ Unqueue(stfQ, stf); Free(sysZone, stf) ]
   stf = nextSTF
   ]
symCacheHits, symCacheMisses = 0, 0
if symFileName ne 0 then Free(sysZone, symFileName); symFileName = 0
SetBlock(cfaSym, 125252b, lCFA)
]

//----------------------------------------------------------------------------
and AddToSymCache(string, sym) be
//----------------------------------------------------------------------------
[
if QueueLength(userStrings) gr maxCacheLength then RemoveFromSymCache()
let ce = Allocate(sysZone, lenCE+string>>String.length rshift 1 +1, true)
if ce eq 0 return
ce>>CE.string = ce+lenCE
CopyString(ce>>CE.string, string)
ce>>CE.sym = sym
ce>>CE.namePos = sym>>Sym.namePos
sym>>Sym.namePos = ce
sym>>Sym.inCache = true
Enqueue(userStrings, ce)
symCacheMisses = symCacheMisses +1
]

//----------------------------------------------------------------------------
and RemoveFromSymCache() be
//----------------------------------------------------------------------------
[
let ce = Dequeue(userStrings)
ce>>CE.sym>>Sym.namePos = ce>>CE.namePos
ce>>CE.sym>>Sym.inCache = false
Free(sysZone, ce)
]

//----------------------------------------------------------------------------
and ResetSymCache() be while userStrings!0 ne 0 do RemoveFromSymCache()
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and SymPrint(stream, verbose) be
//----------------------------------------------------------------------------
[
if symFileName eq 0 then [ Wss(stream, "No symbol file"); return ]
PutTemplate(stream, "Symbol file: $S", symFileName)
if verbose then
   [
   PutTemplate(stream, ", hits: $UD misses: $UD*N*N",
    symCacheHits, symCacheMisses)
   let ce = userStrings!0; while ce ne 0 do
      [
      PutTemplate(stream, "$S*N", ce>>CE.string)
      ce = ce>>CE.link
      ]
   ]
]