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