-- listFGT.mesa; modified by Sweet, July 8, 1980 9:31 AM
DIRECTORY
CommanderDefs USING [AddCommand, CommandBlockHandle],
IODefs USING [NumberFormat, SP, WriteString],
ListerDefs USING [
FileSegmentHandle, IncorrectVersion, Load, MultipleModules, NoCode, NoFGT,
NoSymbols, PrintSei, SetRoutineSymbols, WriteFileID],
OutputDefs USING [
CloseOutput, OpenOutput, PutChar, PutCR, PutDecimal, PutNumber, PutOctal,
PutString],
PrincOps USING [CSegPrefix],
SegmentDefs USING [
DeleteFileSegment, FileNameError, FileSegmentAddress, SwapError, SwapIn,
Unlock],
String USING [AppendString],
Symbols USING [BTIndex, BTNull],
SymbolTable USING [Acquire, Base, Release, TableForSegment],
Storage USING [Node, Free];
ListFGT: PROGRAM
IMPORTS
CommanderDefs, IODefs, ListerDefs, OutputDefs, SegmentDefs, String,
SymbolTable, Storage
EXPORTS ListerDefs =
BEGIN OPEN ListerDefs, OutputDefs, Symbols;
SP: CHARACTER = ' ;
symbols: SymbolTable.Base;
code: POINTER TO PrincOps.CSegPrefix;
SortByFirstFG: PROCEDURE [na: DESCRIPTOR FOR ARRAY OF BodyData] =
BEGIN
i: CARDINAL;
j: INTEGER;
key: BodyData;
FOR i IN [1..LENGTH[na]) DO
key ← na[i];
j ← i - 1;
WHILE j >= 0 AND na[j].firstFG > key.firstFG DO
na[j + 1] ← na[j]; j ← j - 1; ENDLOOP;
na[j + 1] ← key;
ENDLOOP;
END;
GenBT: PROCEDURE [p: PROCEDURE [Symbols.BTIndex]] =
BEGIN OPEN symbols;
bti, prev: BTIndex;
bti ← FIRST[BTIndex];
DO
p[bti];
IF bb[bti].firstSon # BTNull THEN bti ← bb[bti].firstSon
ELSE
DO
prev ← bti;
bti ← bb[bti].link.index;
IF bti = BTNull THEN GO TO Done;
IF bb[prev].link.which # parent THEN EXIT;
ENDLOOP;
REPEAT Done => NULL;
ENDLOOP;
END;
PrintByColumns: PROCEDURE [
PrintOne: PROCEDURE [item: CARDINAL, lastOnLine: BOOLEAN],
firstItem, nItems, nColumns, spaceBetween: CARDINAL] =
BEGIN
i, j, nc: CARDINAL;
delta: CARDINAL ← (nItems + nColumns - 1)/nColumns;
last: BOOLEAN;
FOR i IN [0..delta) DO
nc ← 0;
last ← FALSE;
FOR j ← i, j + delta WHILE ~last AND j < nItems DO
nc ← nc + 1;
last ← nc = nColumns;
PrintOne[firstItem + j, last];
IF ~last THEN THROUGH [0..spaceBetween) DO PutChar[SP]; ENDLOOP;
ENDLOOP;
PutCR[];
ENDLOOP;
END;
BodyData: TYPE = RECORD [firstFG, lastFG: CARDINAL, bti: Symbols.BTIndex];
lastSource, lastObject, bodyObject: CARDINAL;
PrintFGT: PROCEDURE =
BEGIN OPEN Symbols, symbols;
cbti: BTIndex;
i, n, cfirst, clast: CARDINAL;
na: DESCRIPTOR FOR ARRAY OF BodyData;
countBti: PROCEDURE [bti: BTIndex] =
BEGIN
WITH bb[bti] SELECT FROM Callable => IF inline THEN RETURN; ENDCASE;
n ← n + 1;
END;
insertBti: PROCEDURE [bti: BTIndex] =
BEGIN OPEN symbols;
WITH bb[bti] SELECT FROM Callable => IF inline THEN RETURN; ENDCASE;
WITH bb[bti].info SELECT FROM
External => na[i] ← [startIndex, startIndex + indexLength - 1, bti];
ENDCASE;
i ← i + 1;
END;
PrintBodyLine: PROCEDURE [depth: CARDINAL] =
BEGIN
first, last: CARDINAL;
origin: CARDINAL;
bti: BTIndex;
[first, last, bti] ← na[i];
THROUGH [0..depth*2) DO PutChar[SP]; ENDLOOP;
PutString[" ["L];
PutDecimal[LOOPHOLE[bti]];
PutString["] fg: ["L];
PutDecimal[first];
PutString[".."L];
PutDecimal[last];
PutString["], pc: ["L];
WITH br: bb[bti] SELECT FROM
Callable =>
BEGIN
bodyObject ← origin ← code.entry[br.entryIndex].initialpc*2;
lastObject ← 0;
lastSource ← br.sourceIndex;
END;
Other => origin ← bodyObject + br.relOffset;
ENDCASE;
WITH bi: bb[bti].info SELECT FROM
External =>
BEGIN
PutOctal[origin];
PutString[".."L];
PutOctal[origin + bi.bytes - 1];
PutChar[']];
END;
ENDCASE;
PutString[", source: "L];
PutDecimal[bb[bti].sourceIndex];
WITH br: bb[bti] SELECT FROM
Callable => BEGIN PutString[", ep: "L]; PutDecimal[br.entryIndex]; END;
Other => BEGIN PutString[", relO: "L]; PutOctal[br.relOffset]; END;
ENDCASE;
PutCR[];
i ← i + 1;
END;
PrintBodyStuff: PROCEDURE [depth: CARDINAL] =
BEGIN
myLast: CARDINAL = na[i].lastFG;
PrintBodyLine[depth];
WHILE i < n AND na[i].firstFG <= myLast DO
PrintBodyStuff[depth + 1]; ENDLOOP;
END;
PrintFGEntry: PROCEDURE [item: CARDINAL, lastOnLine: BOOLEAN] =
BEGIN OPEN symbols;
PutNumber[item, decimal5];
PutString[": "L];
WITH ff: fgTable[item] SELECT FROM
normal =>
BEGIN -- 34 chars wide?
PutNumber[ff.deltaObject, octal3];
PutString["B, "L];
PutNumber[ff.deltaSource, decimal3];
PutString[" = "L];
PutNumber[absFGT[item - cfirst].object, octal5];
PutString["B, "L];
PutNumber[absFGT[item - cfirst].source, decimal5];
PutString[" ("L];
PutNumber[absFGT[item - cfirst].object + bodyObject, octal6];
PutString["B)"];
END;
step =>
BEGIN
PutString["Step "];
IF ff.which = source THEN
BEGIN
PutString["source:"L];
PutNumber[ff.delta, decimal5];
PutChar[IODefs.SP];
END
ELSE
BEGIN
PutString["object:"L];
PutNumber[ff.delta, octal5];
PutChar['B];
END;
IF ~lastOnLine THEN THROUGH [17..34) DO PutChar[IODefs.SP]; ENDLOOP;
END;
ENDCASE;
END;
AbsFGTEntry: TYPE = RECORD [object, source: CARDINAL];
absFGT: POINTER TO ARRAY [0..0) OF AbsFGTEntry;
GenAbsFGT: PROCEDURE =
BEGIN OPEN s: symbols;
i: CARDINAL;
absFGT ← Storage.Node[(clast - cfirst + 1)*SIZE[AbsFGTEntry]];
FOR i IN [cfirst..clast] DO
WITH ff: s.fgTable[i] SELECT FROM
normal =>
BEGIN
lastSource ← lastSource + ff.deltaSource;
lastObject ← lastObject + ff.deltaObject;
END;
step =>
IF ff.which = source THEN lastSource ← lastSource + ff.delta
ELSE lastObject ← lastObject + ff.delta;
ENDCASE;
absFGT[i - cfirst] ← [source: lastSource, object: lastObject];
ENDLOOP;
END;
n ← 0;
GenBT[countBti];
na ← DESCRIPTOR[Storage.Node[SIZE[BodyData]*n], n];
i ← 0;
GenBT[insertBti];
SortByFirstFG[na];
i ← 0;
WHILE i < n DO
[cfirst, clast, cbti] ← na[i];
WITH br: bb[cbti] SELECT FROM
Callable =>
IF ~br.inline THEN
BEGIN
PrintSei[br.id];
PutCR[];
PrintBodyStuff[0];
GenAbsFGT[];
PrintByColumns[
PrintOne: PrintFGEntry, firstItem: cfirst,
nItems: clast - cfirst + 1, nColumns: 2, spaceBetween: 2];
Storage.Free[absFGT];
PutCR[];
END;
ENDCASE => ERROR;
ENDLOOP;
Storage.Free[BASE[na]];
RETURN
END;
octal3: IODefs.NumberFormat =
[base: 8, columns: 3, zerofill: FALSE, unsigned: TRUE];
decimal3: IODefs.NumberFormat =
[base: 10, columns: 3, zerofill: FALSE, unsigned: TRUE];
octal4: IODefs.NumberFormat =
[base: 8, columns: 4, zerofill: FALSE, unsigned: TRUE];
octal5: IODefs.NumberFormat =
[base: 8, columns: 5, zerofill: FALSE, unsigned: TRUE];
decimal5: IODefs.NumberFormat =
[base: 10, columns: 5, zerofill: FALSE, unsigned: TRUE];
octal6: IODefs.NumberFormat =
[base: 8, columns: 6, zerofill: FALSE, unsigned: TRUE];
PrintFGEntry: PROCEDURE [item: CARDINAL, lastOnLine: BOOLEAN] =
BEGIN OPEN symbols;
PutNumber[item, decimal5];
PutString[": "L];
WITH ff: fgTable[item] SELECT FROM
normal =>
BEGIN -- 34 chars wide?
PutNumber[ff.deltaObject, octal3];
PutString["B, "L];
PutNumber[ff.deltaSource, decimal3];
lastSource ← lastSource + ff.deltaSource;
lastObject ← lastObject + ff.deltaObject;
PutString[" = "L];
PutNumber[lastObject, octal5];
PutString["B, "L];
PutNumber[lastSource, decimal5];
PutString[" ("L];
PutNumber[lastObject + bodyObject, octal6];
PutString["B)"];
END;
step =>
BEGIN
PutString["Step "];
IF ff.which = source THEN
BEGIN
PutString["source:"L];
lastSource ← lastSource + ff.delta;
PutNumber[ff.delta, decimal5];
PutChar[IODefs.SP];
END
ELSE
BEGIN
PutString["object:"L];
lastObject ← lastObject + ff.delta;
PutNumber[ff.delta, octal5];
PutChar['B];
END;
IF ~lastOnLine THEN THROUGH [17..34) DO PutChar[IODefs.SP]; ENDLOOP;
END;
ENDCASE;
END;
FGTable: PROCEDURE [root: STRING] =
BEGIN OPEN String, SegmentDefs;
i: CARDINAL;
defs: BOOLEAN ← FALSE;
bcdFile: STRING ← [40];
sseg, cseg: FileSegmentHandle;
AppendString[bcdFile, root];
FOR i IN [0..bcdFile.length) DO
IF bcdFile[i] = '. THEN EXIT;
REPEAT FINISHED => AppendString[bcdFile, ".bcd"];
ENDLOOP;
BEGIN
[code: cseg, symbols: sseg] ← Load[
bcdFile ! NoFGT => GOTO badformat; NoCode => GO TO defsFile;
NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
SegmentDefs.FileNameError => GOTO badname];
symbols ← SymbolTable.Acquire[SymbolTable.TableForSegment[sseg]];
SegmentDefs.SwapIn[cseg];
code ← SegmentDefs.FileSegmentAddress[cseg];
ListerDefs.SetRoutineSymbols[symbols];
OpenOutput[root, ".fl"];
WriteFileID[];
IF symbols.sourceFile # NIL THEN
BEGIN PutString[" Source: "]; PutString[symbols.sourceFile]; PutCR[]; END;
PrintFGT[];
SegmentDefs.Unlock[cseg];
SymbolTable.Release[symbols];
SegmentDefs.DeleteFileSegment[sseg ! SegmentDefs.SwapError => CONTINUE];
SegmentDefs.DeleteFileSegment[cseg ! SegmentDefs.SwapError => CONTINUE];
CloseOutput[];
EXITS
defsFile => IODefs.WriteString["Definitions File!"];
badformat => IODefs.WriteString["Bad Format!"];
badname => IODefs.WriteString["File Not Found!"];
END;
END;
command: CommanderDefs.CommandBlockHandle;
command ← CommanderDefs.AddCommand["FGTable", LOOPHOLE[FGTable], 1];
command.params[0] ← [type: string, prompt: "Filename"];
END...