MicroSymbolsImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Willie-sue, October 29, 1987 1:46:56 pm PST
Dave Rumph, April 20, 1988 11:13:12 am PDT
taken from MicSym.bcpl and (distantly) MicSA.bcpl
DIRECTORY
Atom USING [EmptyAtom, GetPName, MakeAtom],
Basics USING [LongNumber],
FS USING [ComponentPositions, Error, ExpandName, StreamOpen],
RefTab USING [Ref, Val, Create, Delete, Fetch, Store],
RefText USING [line, TrustTextAsRope],
IO,
Rope,
MicroDefs,
MicroGlobalVars,
MicroOps,
MicroUtils;
MicroSymbolsImpl: CEDAR PROGRAM
IMPORTS
Atom, FS, IO, RefTab, RefText, Rope,
MicroDefs, MicroGlobalVars, MicroOps, MicroUtils
EXPORTS
MicroOps, MicroUtils
= BEGIN OPEN MicroDefs, MicroGlobalVars, MicroUtils;
ROPE: TYPE = Rope.ROPE;
symbolIndexBase: INTEGER = 256;
SymbolIndexSeq: TYPE = REF SymbolIndexSeqRec;
SymbolIndexSeqRec: TYPE =
RECORD[sym: SEQUENCE max: [symbolIndexBase .. 4256] OF MicroDefs.SymbolObj];
symbolTable: RefTab.Ref;
symbolTableSize: NAT = 2047;
symbolIndexSeq: SymbolIndexSeq;
nextSymbolIndex: INTEGER ← symbolIndexBase;
nullSymObj: SymbolObj;
lastStIndexPlus1: INTEGER ← 256;
line: REF TEXTNEW[TEXT[RefText.line]];
symbolsTimeStamp: ROPENIL;
symbolsVersionStamp: ROPE = "March 3, 1986 12:43:59 pm PST";
LookupSymbol: PUBLIC PROC[ePtr: LONG POINTER TO WORD, len: INTEGER]
  RETURNS[symIndex: INTEGER, symb: ATOM] = {
found: BOOL;
val: RefTab.Val;
symb ← MicroUtils.AtomAtPointer[ePtr, len];
[found, val] ← RefTab.Fetch[symbolTable, symb];
IF found THEN {
sym: SymbolObj ← NARROW[val];
IF sym.symIndex < symbolIndexBase THEN
 MicroDefs.Error[" Bad symIndex: LookupSymbol"];
RETURN[sym.symIndex, symb]
};
RETURN[0, symb];
};
GetSymbol: PUBLIC PROC[symIndex: INTEGER] RETURNS[symbolRec: SymbolObj] = {
IF symIndex >= nextSymbolIndex THEN RETURN[NIL];
IF symIndex = 0 THEN RETURN[nullSymObj];
IF symIndex < symbolIndexBase THEN MicroDefs.Error[" Bad symIndex: GetSymbol"];
RETURN[symbolIndexSeq[symIndex]];
};
NewDef: PUBLIC PROC[symIndex: INTEGER] RETURNS[newObj: SymbolObj] = {
If symIndex is new, do nothing; if symIndex is old, make a new symbol for its name and return the new index; the new symbolObj gets stored in BOTH the old and new places in the symbolTable
sym: SymbolObj;
newIndex: INTEGER;
IF symIndex >= lastStIndexPlus1 THEN RETURN[GetSymbol[symIndex]];
sym ← symbolIndexSeq[symIndex];  -- old symbol
IF sym.redef # NIL AND sym.symIndex >= lastStIndexPlus1 THEN RETURN[sym];
[newIndex, newObj] ← PutInSymbol[sym.symb, nullType];
newObj.redef ← sym;  -- link to old symbol via its symbolObj
symbolIndexSeq[symIndex] ← newObj;
[] ← RefTab.Store[symbolTable, sym.symb, newObj]; -- replace old object in symbolTable
};
PutInSymbol: PUBLIC PROC[symb: ATOM, type: SymbolType]
RETURNS[symIndex: INTEGER, sObj: SymbolObj] = {
really: ATOM = IF symb = NIL THEN Atom.EmptyAtom[] ELSE symb;
IF nextSymbolIndex < symbolIndexBase THEN MicroDefs.Error[" Bad symIndex: PutInSymbol"];
sObj ← NEW[SymbolRec ← [really, Atom.GetPName[really], type, nextSymbolIndex] ];
[] ← RefTab.Store[symbolTable, really, sObj];
symbolIndexSeq[symIndex ← nextSymbolIndex] ← sObj;
nextSymbolIndex ← nextSymbolIndex + 1;
};
LookupAtom: PUBLIC PROC[symb: ATOM] RETURNS[symIndex: INTEGER] = {
found: BOOL;
val: RefTab.Val;
[found, val] ← RefTab.Fetch[symbolTable, symb];
IF found THEN {
sym: SymbolObj ← NARROW[val];
IF sym.symIndex < symbolIndexBase THEN MicroDefs.Error[" Bad symIndex: LookupAtom"];
RETURN[sym.symIndex]
};
RETURN[0];
};
InitSymbolTable: PUBLIC PROC = {
symbolTable ← RefTab.Create[symbolTableSize];  -- easiest
IF symbolIndexSeq = NIL THEN symbolIndexSeq ← NEW[SymbolIndexSeqRec[4000]]
ELSE
FOR i: INTEGER IN [400 .. nextSymbolIndex) DO symbolIndexSeq[i] ← NIL;
ENDLOOP;
lastStIndexPlus1 ← nextSymbolIndex ← symbolIndexBase;
nullSymObj ← PutInSymbol[NIL, nullType].sObj;  -- 0 and 1 are not valid symbol indices
[] ← PutInSymbol[NIL, nullType];
};
prefixRope: ROPE = "*prefix*";
symbolRope: ROPE = "*symbol*";
memoryRope: ROPE = "*memory*";
macroRope: ROPE = "*macros*";
RecoverSymbols: PUBLIC PROC[fromFile: ROPE, recoverOld: BOOLFALSE]
  RETURNS[success: BOOL] = {
StripDirectory: PROC [in: ROPE] RETURNS [rope: ROPE] ~ {
fullFName: ROPE;
cp: FS.ComponentPositions;
[fullFName, cp, ] ← FS.ExpandName[in];
RETURN [Rope.Substr[base: fullFName, start: cp.base.start, len: cp.base.length+cp.ext.length+1]];
};
strm: STREAM;
currentNextSymbolIndex: INTEGER ← nextSymbolIndex;
newNextSymbolIndex: INTEGER;
ropeIn, versionOnFile: ROPE;
sameSymbols: BOOLFALSE;
success ← FALSE;
strm ← FS.StreamOpen[fromFile ! FS.Error => {
reportStrm.PutRope[error.explanation]; GOTO cant}
];
strm.SetIndex[0];
ropeIn ← strm.GetLineRope[];  -- *prefix*
IF ~ropeIn.Equal[prefixRope] THEN RETURN[FALSE];
ropeIn ← StripDirectory[strm.GetLineRope[]];  -- fileName
IF ~ropeIn.Equal[StripDirectory[fromFile], FALSE] THEN RETURN[FALSE];
versionOnFile ← strm.GetLineRope[];  -- versionStamp as rope
IF ~versionOnFile.Equal[symbolsVersionStamp] THEN
MicroDefs.Error[IO.PutFR[
"Symbols versionStamp on file (%g) is different than program's (%g)",
IO.rope[versionOnFile], IO.rope[symbolsVersionStamp] ]];
ropeIn ← strm.GetLineRope[];  -- timeStamp as rope
sameSymbols ← ropeIn.Equal[symbolsTimeStamp];
read the rest of the prefix
commentChar ← strm.GetChar[];
[] ← strm.GetChar[];
mbExtn ← strm.GetLineRope[];
newNextSymbolIndex ← nextSymbolIndex ← lastStIndexPlus1 ← strm.GetInt[];
lastMemNum ← strm.GetInt[];
targetSym ← strm.GetInt[];
nextMacroIndex ← strm.GetInt[];
traceCalls ← strm.GetBool[];
ignore ← strm.GetBool[];
traceSyms ← strm.GetBool[];
[] ← strm.GetChar[];  -- '\n
IF sameSymbols THEN {
clean out any symbols with index >= nextSymbolIndex;
FOR i: INTEGER IN [nextSymbolIndex .. currentNextSymbolIndex) DO
sObj: SymbolObj = symbolIndexSeq[i];
symbolIndexSeq[i] ← NIL;  -- release storage as well
IF sObj.redef = NIL OR sObj.redef.symIndex >= nextSymbolIndex THEN {
[] ← RefTab.Delete[symbolTable, sObj.symb];
LOOP;
};
put old SymbolObj back into symbol table
[] ← RefTab.Store[symbolTable, sObj.symb, sObj.redef];
symbolIndexSeq[sObj.redef.symIndex] ← sObj.redef;
ENDLOOP;
}
ELSE {
InitSymbolTable[];
nextSymbolIndex ← newNextSymbolIndex;
};
DO
line ← strm.GetLine[line];
IF ~symbolRope.Equal[RefText.TrustTextAsRope[line]] THEN EXIT;
RecoverOneSymbol[strm, sameSymbols];
ENDLOOP;
IF ~macroRope.Equal[RefText.TrustTextAsRope[line]] THEN
ERROR MicroDefs.Error[];
IF ~sameSymbols THEN TRUSTED {
macIndex: INT = nextMacroIndex;
MicroOps.InitMacroOps[];  -- make sure there is macro storage
[] ← strm.UnsafeGetBlock[[LOOPHOLE[macroStorageStart], 0, 2*macIndex]];
nextMacroIndex ← macIndex;
};
lastStIndexPlus1 ← nextSymbolIndex;
symbolsTimeStamp ← ropeIn;
RETURN[TRUE];
EXITS cant => RETURN[FALSE];
};
RecoverOneSymbol: PROC[strm: STREAM, sameSymbols: BOOL] = {
sObj: SymbolObj;
IF sameSymbols THEN {
symb: ATOM = Atom.MakeAtom[strm.GetLineRope[]];
sObj ← GetSymbol[LookupAtom[symb]];
IF sObj = NIL THEN MicroDefs.Error[
IO.PutFR["%g not found in symbols table", IO.atom[symb]]];
}
ELSE {
sObj ← NEW[SymbolRec];
sObj.name ← strm.GetLineRope[];
sObj.symb ← Atom.MakeAtom[sObj.name];
};
sObj.sType ← LOOPHOLE[LOOPHOLE[strm.GetInt[], Basics.LongNumber].lo, SymbolType];
sObj.symIndex ← strm.GetInt[];
sObj.sMisc ← strm.GetInt[];
sObj.sVal ← LOOPHOLE[strm.GetCard[], Basics.LongNumber].lo;
[] ← strm.GetChar[];  -- \n following number
SELECT sObj.sType FROM
macroType => {
mDef: INT ← strm.GetInt[];
[] ← strm.GetChar[];
sObj.sData ← NEW[INT ← mDef];
};
memoryType => {
memNum: INTEGER ← strm.GetInt[];
[] ← strm.GetChar[];
IF memNum # -1 THEN RecoverOneMemory[strm, sObj, memNum]
};
bitTableType => {
bitTabSize: INTEGER ← strm.GetInt[];
[] ← strm.GetChar[];
IF bitTabSize # 0 THEN {
bt: BitTableObj ← NEW[BitTableRec ← [btSize: bitTabSize]];
bt.btBits ← NEW[WordSeqRec[bitTabSize]];
FOR j: INTEGER IN [0..bitTabSize) DO
bt.btBits[j] ← GetWord[strm];
ENDLOOP;
sObj.sData ← bt;
};
};
ENDCASE => NULL;
[] ← RefTab.Store[symbolTable, sObj.symb, sObj];
symbolIndexSeq[sObj.symIndex] ← sObj;
};
RecoverOneMemory: PROC[strm: STREAM, sObj: SymbolObj, memNum: INTEGER] = {
mem: Memory ← NARROW[sObj.sData];
accWord, listFields: INTEGER;
line ← strm.GetLine[line];  -- should be *memory*
IF ~memoryRope.Equal[RefText.TrustTextAsRope[line]] THEN
ERROR MicroDefs.Error[];
IF mem = NIL THEN sObj.sData ← mem ← NEW[MemoryRec];
mem.symIndex ← sObj.symIndex;
mem.memoryNum ← memNum;
mem.widthInBits ← strm.GetInt[];
mem.widthInWords ← strm.GetInt[];
mem.size ← strm.GetInt[];
mem.sourceIndex ← strm.GetInt[];
mem.sinkIndex ← strm.GetInt[];
mem.listOptions ← strm.GetInt[];
mem.lTag ← strm.GetInt[];
mem.memSymPost ← strm.GetInt[];
mem.tagMacro ← strm.GetInt[];
MicroUtils.SetMemoryFromNum[memNum, mem];
accWord ← strm.GetInt[]; [] ← strm.GetChar[];
IF accWord = 0 THEN mem.accumWord ← NIL ELSE {
len: NAT = accWord;
mem.accumWord ← NEW[WordSeqRec[len]];
FOR j: NAT IN [0 .. len) DO mem.accumWord[j] ← GetWord[strm]; ENDLOOP;
[] ← strm.GetChar[];
};
listFields ← strm.GetInt[]; [] ← strm.GetChar[];
IF listFields = 0 THEN mem.listFields ← NIL ELSE {
len: NAT = listFields;
mem.listFields ← NEW[WordSeqRec[len]];
FOR j: NAT IN [0 .. len) DO mem.listFields[j] ← GetWord[strm]; ENDLOOP;
[] ← strm.GetChar[];
};
};
DumpSymbols: PUBLIC PROC[toFileRec: MicroDefs.OutputFile]
RETURNS[success: BOOL, oldLastStIndexPlus1: INTEGER] = {
strm: STREAM;
success ← FALSE;
oldLastStIndexPlus1 ← lastStIndexPlus1;
IF toFileRec.strm = NIL THEN MicroUtils.OpenOutputStream[toFileRec];
strm ← toFileRec.strm;
strm.PutRope[prefixRope]; strm.PutChar['\n];
strm.PutRope[toFileRec.fullName];
strm.PutF["\n%g", IO.rope[symbolsVersionStamp] ];  -- versionStamp
strm.PutF["\n%g\n",
IO.rope[symbolsTimeStamp ← IO.PutFR[NIL, IO.time[]]] ];  -- timestamp
strm.PutChar[commentChar]; strm.PutChar[' ];
strm.PutRope[mbExtn];
strm.PutF["\n%g %g %g %g\n", IO.int[nextSymbolIndex], IO.int[lastMemNum],
IO.int[targetSym], IO.int[nextMacroIndex]];
strm.PutF["%g %g %g\n", IO.bool[traceCalls], IO.bool[ignore], IO.bool[traceSyms]];
this ends the prefix information
dump the symbols; do not dump symbolIndexBase & symbolIndexBase+1, but rather start with symbolIndexBase+2
FOR i: INTEGER IN [symbolIndexBase+2 .. nextSymbolIndex) DO
sObj: SymbolObj = GetSymbol[i];
strm.PutRope[symbolRope]; strm.PutChar['\n];
strm.PutF["%g\n%g %g %g %g\n",
IO.rope[sObj.name], IO.int[LOOPHOLE[sObj.sType, INTEGER]],
IO.int[sObj.symIndex], IO.int[sObj.sMisc], IO.card[sObj.sVal] ];
SELECT sObj.sType FROM
macroType => {
mDef: REF INT = NARROW[sObj.sData];
strm.PutF["%g\n", IO.int[mDef^]];
};
memoryType =>
IF sObj.sData = NIL THEN strm.PutRope["-1\n"] ELSE {
mem: Memory = NARROW[sObj.sData];
strm.PutF["%g\n", IO.int[mem.memoryNum]];
strm.PutRope[memoryRope]; strm.PutChar['\n];
strm.PutF["%g %g %g %g\n", IO.int[mem.widthInBits], IO.int[mem.widthInWords],
IO.int[mem.size], IO.int[mem.sourceIndex]];
strm.PutF["%g %g %g %g %g\n", IO.int[mem.sinkIndex], IO.int[mem.listOptions],
IO.int[mem.lTag], IO.int[mem.memSymPost], IO.int[mem.tagMacro]];
IF mem.accumWord = NIL THEN strm.PutF["0\n"] ELSE {
strm.PutF["%g\n", IO.int[mem.accumWord.length]];
FOR j: NAT IN [0..mem.accumWord.length) DO
MicroUtils.PutWord[strm, mem.accumWord[j]];
ENDLOOP;
strm.PutChar['\n];
};
IF mem.listFields = NIL THEN strm.PutF["0\n"] ELSE {
strm.PutF["%g\n", IO.int[mem.listFields.length]];
FOR j: NAT IN [0..mem.listFields.length) DO
PutWord[strm, mem.listFields[j]];
ENDLOOP;
strm.PutChar['\n];
};
};
bitTableType => {
IF sObj.sData = NIL THEN strm.PutRope["0\n"] ELSE {
bt: BitTableObj = NARROW[sObj.sData];
strm.PutF["%g\n", IO.int[bt.btSize]];
FOR j: INTEGER IN [0..bt.btSize) DO
PutWord[strm, bt.btBits[j]];
ENDLOOP;
strm.PutChar['\n];
};
};
ENDCASE => NULL;
ENDLOOP;
strm.Flush[];
dump macro storage
strm.PutRope[macroRope]; strm.PutChar['\n];
strm.UnsafePutBlock[[base: LOOPHOLE[macroStorageStart], startIndex: 0, count: 2*nextMacroIndex]];
strm.Flush[];
lastStIndexPlus1 ← nextSymbolIndex;
success ← TRUE;
};
FilterSyms: PUBLIC PROC[typ: SymbolType, startIndex: INTEGER ← -1]
RETURNS[lSyms: LIST OF MicroDefs.SymbolObj] = {
Collect all symbols whose sType = typ and are new since a RestoreSymbols was done, if newSinceStFile is -1, else startLooking at startIndex
lowestIndex: INTEGER = IF startIndex = -1 THEN lastStIndexPlus1 ELSE startIndex;
symIndex: INTEGER ← nextSymbolIndex;
dontDumpList: LIST OF INTEGERNIL;
MaybeAddToSeq: PROC[so: SymbolObj] = {
sI: INTEGER = so.symIndex;
reDefSym: SymbolObj = so.redef;
IF reDefSym # NIL AND reDefSym.symIndex >= lowestIndex THEN dontDumpList ← CONS[reDefSym.symIndex, dontDumpList]
ELSE IF dontDumpList # NIL THEN {  -- see if this sI should NOT be dumped
FOR iL: LIST OF INTEGER ← dontDumpList, iL.rest UNTIL iL=NIL DO
IF iL.first = sI THEN RETURN;
ENDLOOP;
};
lSyms ← CONS[so, lSyms];
};
DO
sObj: SymbolObj;
IF (symIndex ← symIndex - 1) < lowestIndex THEN EXIT;
sObj ← MicroOps.GetSymbol[symIndex];
IF sObj.sType = typ THEN MaybeAddToSeq[sObj];
ENDLOOP;
};
nullSymObj ←
NEW[SymbolRec ← [Atom.EmptyAtom[], Atom.GetPName[Atom.EmptyAtom[]], nullType, 0] ];
END.