-- ListerRoutines.mesa;
-- edited by Sandman; October 14, 1980 11:06 AM
-- edited by Sweet; 3-Sep-80 16:12:54
DIRECTORY
AltoDefs USING [PageCount],
BcdDefs,
BcdOps,
CommanderDefs USING [InitCommander, WaitCommands],
ControlDefs USING [CSegPrefix],
ImageDefs USING [BcdTime],
InlineDefs USING [LowHalf],
IODefs USING [NumberFormat, TAB],
ListerDefs: FROM "listerdefs",
OutputDefs USING [PutChar, PutCR, PutNumber, PutString, PutTime],
SegmentDefs USING [
DefaultVersion, DeleteFileSegment, FileHandle, FileSegmentAddress,
FileSegmentHandle, MoveFileSegment, NewFile, NewFileSegment, Read, SwapIn,
Unlock],
String,
Symbols USING [
bodyType, ctxType, HTIndex, HTNull, htType, ISEIndex, mdType, SENull, seType,
ssType],
SymbolSegment USING [extType, ltType, treeType],
SymbolTable USING [Base],
Storage USING [Node, Free],
Table USING [Base, Index, Notifier, Selector],
TimeDefs USING [AppendDayTime, UnpackDT],
Tree USING [Node];
ListerRoutines: PROGRAM
IMPORTS
BcdOps, CommanderDefs, OutputDefs, ImageDefs, SegmentDefs, String, Storage,
InlineDefs, TimeDefs
EXPORTS ListerDefs, Table
SHARES SymbolTable =PUBLIC
BEGIN OPEN OutputDefs;
NumberFormat: TYPE = IODefs.NumberFormat;
PageCount: TYPE = AltoDefs.PageCount;
IncorrectVersion: SIGNAL = CODE;
NoFGT: SIGNAL = CODE;
NoCode: SIGNAL = CODE;
NoSymbols: SIGNAL = CODE;
MultipleModules: SIGNAL = CODE;
version, creator, source: BcdDefs.VersionStamp;
Dstar: BOOLEAN;
filename: STRING;
symbols: SymbolTable.Base;
bases: PRIVATE ARRAY [0..16) OF Table.Base;
SetRoutineSymbols: PROCEDURE [s: SymbolTable.Base] =
BEGIN OPEN s.stHandle;
symbase: Table.Base ← InlineDefs.LowHalf[s.stHandle];
symbols ← s;
bases[SymbolSegment.treeType] ← symbase + treeBlock.offset;
bases[Symbols.seType] ← symbase + seBlock.offset;
bases[Symbols.htType] ← symbase + htBlock.offset;
bases[Symbols.ssType] ← symbase + ssBlock.offset;
bases[Symbols.ctxType] ← symbase + ctxBlock.offset;
bases[Symbols.mdType] ← symbase + mdBlock.offset;
bases[Symbols.bodyType] ← symbase + bodyBlock.offset;
bases[SymbolSegment.ltType] ← symbase + litBlock.offset;
bases[SymbolSegment.extType] ← symbase + extBlock.offset;
UpdateBases[];
END;
-- Tree
NotifyNode: TYPE = RECORD [
notifier: Table.Notifier, link: POINTER TO NotifyNode];
notifyList: POINTER TO NotifyNode ← NIL;
AddNotify: PUBLIC PROCEDURE [proc: Table.Notifier] =
BEGIN
p: POINTER TO NotifyNode = Storage.Node[SIZE[NotifyNode]];
p↑ ← [notifier: proc, link: notifyList];
notifyList ← p;
proc[DESCRIPTOR[bases]];
RETURN
END;
DropNotify: PUBLIC PROCEDURE [proc: Table.Notifier] =
BEGIN
p, q: POINTER TO NotifyNode;
IF notifyList = NIL THEN RETURN;
p ← notifyList;
IF p.notifier = proc THEN notifyList ← p.link
ELSE
BEGIN
DO
q ← p;
p ← p.link;
IF p = NIL THEN RETURN;
IF p.notifier = proc THEN EXIT
ENDLOOP;
q.link ← p.link;
END;
Storage.Free[p];
RETURN
END;
UpdateBases: PROCEDURE =
BEGIN
p: POINTER TO NotifyNode;
FOR p ← notifyList, p.link UNTIL p = NIL DO
p.notifier[DESCRIPTOR[bases]] ENDLOOP;
RETURN
END;
-- to make TreeInit happy
GetChunk: PROCEDURE [size: CARDINAL] RETURNS [Table.Index] =
BEGIN
IF size # SIZE[Tree.Node] THEN ERROR; -- called to reserve empty
RETURN[LOOPHOLE[0]];
END;
-- to make LiteralPack.Initialize happy
Bounds: PROCEDURE [table: Table.Selector]
RETURNS [base: Table.Base, size: CARDINAL] =
BEGIN OPEN symbols.stHandle;
SELECT table FROM
SymbolSegment.treeType => RETURN[bases[table], treeBlock.size];
Symbols.seType => RETURN[bases[table], seBlock.size];
Symbols.htType => RETURN[bases[table], htBlock.size];
Symbols.ssType => RETURN[bases[table], ssBlock.size];
Symbols.ctxType => RETURN[bases[table], ctxBlock.size];
Symbols.mdType => RETURN[bases[table], mdBlock.size];
Symbols.bodyType => RETURN[bases[table], bodyBlock.size];
SymbolSegment.ltType => RETURN[bases[table], litBlock.size];
SymbolSegment.extType => RETURN[bases[table], extBlock.size];
ENDCASE => ERROR;
END;
LoadFromConfig: PROCEDURE [
configName, moduleName: STRING, saveBcdSeg: BOOLEAN ← FALSE]
RETURNS [
code, symbols, bcdseg: SegmentDefs.FileSegmentHandle,
mti: BcdDefs.MTIndex] =
BEGIN OPEN BcdDefs, SegmentDefs;
bcd: POINTER TO BcdDefs.BCD;
sgb, mtb, ftb: BcdDefs.Base;
ssb: BcdOps.NameString;
pages: AltoDefs.PageCount;
configFile, codeFile, symsFile: FileHandle;
codeFileName: STRING ← [40];
symsFileName: STRING ← [40];
mh: BcdOps.MTHandle;
sfi, cfi: BcdDefs.FTIndex;
ss1, ss2: String.SubStringDescriptor;
CheckModule: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS [BOOLEAN] =
BEGIN
ss2.offset ← mth.name;
ss2.length ← ssb.size[mth.name];
RETURN[String.EquivalentSubStrings[@ss1, @ss2]];
END;
ss1 ← [base: moduleName, offset: 0, length: moduleName.length];
code ← symbols ← NIL;
Dstar ← FALSE;
filename ← configName;
codeFile ← symsFile ← configFile ← NewFile[configName, Read, DefaultVersion];
bcdseg ← NewFileSegment[configFile, 1, 1, Read];
SwapIn[bcdseg];
bcd ← FileSegmentAddress[bcdseg];
IF (pages ← bcd.nPages) # 1 THEN
BEGIN
Unlock[bcdseg];
MoveFileSegment[bcdseg, 1, pages];
SwapIn[bcdseg];
bcd ← FileSegmentAddress[bcdseg];
END;
BEGIN
ENABLE UNWIND => BEGIN Unlock[bcdseg]; DeleteFileSegment[bcdseg] END;
IF bcd.versionIdent # BcdDefs.VersionID THEN SIGNAL IncorrectVersion;
version ← bcd.version;
creator ← bcd.creator;
source ← bcd.sourceVersion;
sgb ← LOOPHOLE[bcd + bcd.sgOffset];
mtb ← LOOPHOLE[bcd + bcd.mtOffset];
ssb ← LOOPHOLE[bcd + bcd.ssOffset];
ftb ← LOOPHOLE[bcd + bcd.ftOffset];
ss2.base ← @ssb.string;
mti ← BcdOps.ProcessModules[bcd, CheckModule].mti;
IF mti = MTNull THEN SIGNAL NoCode
ELSE
BEGIN
mh ← @mtb[mti];
cfi ← sgb[mh.code.sgi].file;
IF cfi # FTSelf THEN
BEGIN
fileVersion: BcdDefs.VersionStamp;
cfilebase: POINTER TO BcdDefs.BCD;
ss2.offset ← ftb[cfi].name;
ss2.length ← ssb.size[ftb[cfi].name];
String.AppendSubString[codeFileName, @ss2];
FOR i: CARDINAL IN [0..codeFileName.length) DO
IF codeFileName[i] = '. THEN EXIT;
REPEAT FINISHED => String.AppendString[codeFileName, ".bcd"L];
ENDLOOP;
codeFile ← NewFile[codeFileName, SegmentDefs.Read];
code ← NewFileSegment[codeFile, 1, 1, SegmentDefs.Read];
SwapIn[code];
cfilebase ← FileSegmentAddress[code];
fileVersion ← cfilebase.version;
Unlock[code];
IF fileVersion # ftb[cfi].version THEN
SIGNAL NoSymbols[ ! UNWIND => DeleteFileSegment[code]];
MoveFileSegment[code, sgb[mh.code.sgi].base, sgb[mh.code.sgi].pages];
END
ELSE
code ← NewFileSegment[
codeFile, sgb[mh.code.sgi].base, sgb[mh.code.sgi].pages,
SegmentDefs.Read];
code.class ← code;
END;
IF mti = MTNull OR sgb[mh.sseg].pages = 0 THEN SIGNAL NoSymbols
ELSE
BEGIN
sfi ← sgb[mh.sseg].file;
IF sfi # FTSelf THEN
BEGIN
ss2.offset ← ftb[sfi].name;
ss2.length ← ssb.size[ftb[sfi].name];
String.AppendSubString[symsFileName, @ss2];
FOR i: CARDINAL IN [0..symsFileName.length) DO
IF symsFileName[i] = '. THEN EXIT;
REPEAT FINISHED => String.AppendString[symsFileName, ".bcd"L];
ENDLOOP;
symsFile ← NewFile[symsFileName, SegmentDefs.Read];
END;
IF sgb[mh.sseg].extraPages = 0 THEN SIGNAL NoFGT;
IF sfi # FTSelf THEN
BEGIN
sfilebase: POINTER TO BcdDefs.BCD;
fileVersion: BcdDefs.VersionStamp;
symbols ← NewFileSegment[symsFile, 1, 1, SegmentDefs.Read];
SwapIn[symbols];
sfilebase ← FileSegmentAddress[symbols];
fileVersion ← sfilebase.version;
Unlock[symbols];
IF fileVersion # ftb[sfi].version THEN
SIGNAL NoSymbols[ ! UNWIND => DeleteFileSegment[symbols]];
MoveFileSegment[
symbols, sgb[mh.sseg].base,
sgb[mh.sseg].pages + sgb[mh.sseg].extraPages];
END
ELSE
symbols ← NewFileSegment[
symsFile, sgb[mh.sseg].base,
sgb[mh.sseg].pages + sgb[mh.sseg].extraPages, Read];
END;
END;
IF code # NIL THEN
BEGIN
p: POINTER TO ControlDefs.CSegPrefix;
SwapIn[code];
p ← FileSegmentAddress[code];
Dstar ← ~p.header.info.altoCode;
Unlock[code];
END;
Unlock[bcdseg];
IF saveBcdSeg THEN RETURN;
DeleteFileSegment[bcdseg];
bcdseg ← NIL;
RETURN
END;
Load: PROCEDURE [name: STRING, saveBcdSeg: BOOLEAN ← FALSE]
RETURNS [code, symbols, bcdseg: SegmentDefs.FileSegmentHandle] =
BEGIN OPEN SegmentDefs;
bcd: POINTER TO BcdDefs.BCD;
sgb: BcdDefs.Base;
pages: AltoDefs.PageCount;
codefile: FileHandle;
mh: BcdOps.MTHandle;
code ← symbols ← NIL;
Dstar ← FALSE;
filename ← name;
codefile ← NewFile[name, Read, DefaultVersion];
bcdseg ← NewFileSegment[codefile, 1, 1, Read];
SwapIn[bcdseg];
bcd ← FileSegmentAddress[bcdseg];
IF (pages ← bcd.nPages) # 1 THEN
BEGIN
Unlock[bcdseg];
MoveFileSegment[bcdseg, 1, pages];
SwapIn[bcdseg];
bcd ← FileSegmentAddress[bcdseg];
END;
BEGIN
ENABLE UNWIND => BEGIN Unlock[bcdseg]; DeleteFileSegment[bcdseg] END;
IF bcd.versionIdent # BcdDefs.VersionID THEN SIGNAL IncorrectVersion;
version ← bcd.version;
creator ← bcd.creator;
source ← bcd.sourceVersion;
mh ← @LOOPHOLE[bcd + bcd.mtOffset, BcdDefs.Base][FIRST[BcdDefs.MTIndex]];
sgb ← LOOPHOLE[bcd + bcd.sgOffset];
IF bcd.nModules # 1 THEN SIGNAL MultipleModules;
IF bcd.definitions THEN SIGNAL NoCode
ELSE
BEGIN
code ← NewFileSegment[
codefile, sgb[mh.code.sgi].base, sgb[mh.code.sgi].pages, Read];
code.class ← code;
END;
IF sgb[mh.sseg].pages = 0 THEN SIGNAL NoSymbols
ELSE
BEGIN
IF sgb[mh.sseg].extraPages = 0 THEN SIGNAL NoFGT;
symbols ← NewFileSegment[
codefile, sgb[mh.sseg].base, sgb[mh.sseg].pages + sgb[mh.sseg].extraPages,
Read];
END;
END;
IF code # NIL THEN
BEGIN
p: POINTER TO ControlDefs.CSegPrefix;
SwapIn[code];
p ← FileSegmentAddress[code];
Dstar ← ~p.header.info.altoCode;
Unlock[code];
END;
Unlock[bcdseg];
IF saveBcdSeg THEN RETURN;
DeleteFileSegment[bcdseg];
bcdseg ← NIL;
RETURN
END;
WriteOneVersion: PROCEDURE [
version: POINTER TO BcdDefs.VersionStamp, tag: STRING] =
BEGIN OPEN OutputDefs;
IF version = NIL THEN RETURN;
PutString[tag];
PutTime[LOOPHOLE[version.time]];
PutString[" on "L];
PrintMachine[version↑];
PutCR[];
END;
WriteVersions: PROCEDURE [
version, creator, source: POINTER TO BcdDefs.VersionStamp ← NIL] =
BEGIN
WriteOneVersion[version, " created "L];
WriteOneVersion[creator, " creator "L];
WriteOneVersion[source, " source "L];
OutputDefs.PutCR[];
RETURN
END;
PrintMachine: PROCEDURE [stamp: BcdDefs.VersionStamp] =
BEGIN
octal: NumberFormat = [8, FALSE, FALSE, 1];
PutNumber[stamp.net, octal];
PutChar['#];
PutNumber[stamp.host, octal];
PutChar['#];
RETURN
END;
WriteFileID: PROCEDURE =
BEGIN
PutString[filename];
IF Dstar THEN PutString[" (/-A)"L];
Dstar ← FALSE;
WriteVersions[@version, @creator, @source];
RETURN
END;
PrintHti: PROCEDURE [hti: Symbols.HTIndex] =
BEGIN
desc: String.SubStringDescriptor;
s: String.SubString = @desc;
IF hti = Symbols.HTNull THEN PutString["(anonymous)"]
ELSE BEGIN symbols.SubStringForHash[s, hti]; PutSubString[s]; END;
RETURN
END;
PrintSei: PROCEDURE [sei: Symbols.ISEIndex] =
BEGIN
PrintHti[
IF sei = Symbols.SENull THEN Symbols.HTNull ELSE symbols.seb[sei].hash];
RETURN
END;
Indent: PROCEDURE [n: CARDINAL] =
BEGIN
PutCR[];
THROUGH [1..n/8] DO PutChar[IODefs.TAB] ENDLOOP;
THROUGH [1..n MOD 8] DO PutChar[' ] ENDLOOP;
RETURN
END;
PutSubString: PROCEDURE [ss: String.SubString] =
BEGIN
i: CARDINAL;
FOR i IN [ss.offset..ss.offset + ss.length) DO PutChar[ss.base[i]] ENDLOOP;
RETURN
END;
herald: STRING ← [50];
LoadLister: PROCEDURE =
BEGIN OPEN TimeDefs;
CommanderDefs.InitCommander[herald];
String.AppendString[to: herald, from: "Alto/Mesa Lister 6.0 of "L];
AppendDayTime[herald, UnpackDT[ImageDefs.BcdTime[]]];
herald.length ← herald.length - 3;
END;
LoadLister[];
CommanderDefs.WaitCommands[];
END..