DIRECTORY
Ascii: TYPE USING [SP],
BcdDefs: TYPE USING [Base, MTIndex],
BcdOps: TYPE USING [BcdBase, MTHandle],
CommanderOps: TYPE USING [AddCommand, CommandBlockHandle],
FileSegment: TYPE USING [Pages],
Format: TYPE USING [NumberFormat],
Heap: TYPE USING [systemZone],
ListerDefs:
TYPE
USING [
IncorrectVersion, Load, MapPages, MultipleModules, NoCode, NoFGT, NoFile,
NoSymbols, PrintSei, SetRoutineSymbols, WriteFileID, WriteString],
OutputDefs:
TYPE
USING [
CloseOutput, OpenOutput, PutChar, PutCR, PutDecimal, PutNumber, PutOctal,
PutLongString, PutString],
PrincOps: TYPE USING [CSegPrefix],
Space: TYPE USING [Handle, Delete, LongPointer],
Strings: TYPE USING [AppendString],
Symbols: TYPE USING [BTIndex, BTNull],
SymbolTable: TYPE USING [Acquire, Base, Release, SetCacheSize];
ListFGT:
PROGRAM
IMPORTS
CommanderOps, Heap, ListerDefs, OutputDefs, Space, Strings, SymbolTable =
BEGIN OPEN ListerDefs, OutputDefs, Symbols;
SP: CHARACTER = ' ;
symbols: SymbolTable.Base;
code: LONG POINTER TO PrincOps.CSegPrefix;
BodyData: TYPE = RECORD [firstFG, lastFG: CARDINAL, bti: Symbols.BTIndex];
BodyList: TYPE = RECORD [SEQUENCE length: NAT OF BodyData];
SortByFirstFG:
PROC [na:
LONG
POINTER
TO BodyList] =
BEGIN
j: INTEGER;
key: BodyData;
FOR i:
NAT
IN [1..na.length)
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:
PROC [p:
PROC [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:
PROC [
PrintOne: PROC [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;
lastSource, lastObject, bodyObject: CARDINAL;
PrintFGT:
PROC =
BEGIN OPEN Symbols, symbols;
cbti: BTIndex;
i, n, cfirst, clast: CARDINAL;
na: LONG POINTER TO BodyList;
countBti:
PROC [bti: BTIndex] =
BEGIN
WITH bb[bti] SELECT FROM Callable => IF inline THEN RETURN; ENDCASE;
n ← n + 1;
END;
insertBti:
PROC [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:
PROC [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:
PROC [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:
PROC [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[Ascii.SP];
END
ELSE
BEGIN
PutString["object:"L];
PutNumber[ff.delta, octal5];
PutChar['B];
END;
IF ~lastOnLine THEN THROUGH [17..34) DO PutChar[Ascii.SP]; ENDLOOP;
END;
ENDCASE;
END;
AbsFGTEntry: TYPE = RECORD [object, source: CARDINAL];
AbsFGTList: TYPE = RECORD [SEQUENCE length: NAT OF AbsFGTEntry];
absFGT: LONG POINTER TO AbsFGTList;
GenAbsFGT:
PROC =
BEGIN OPEN s: symbols;
i: CARDINAL;
absFGT ← (Heap.systemZone).NEW[AbsFGTList[(clast - cfirst + 1)]];
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 ← (Heap.systemZone).NEW[BodyList[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];
(Heap.systemZone).FREE[@absFGT];
PutCR[];
END;
ENDCASE => ERROR;
ENDLOOP;
(Heap.systemZone).FREE[@na];
END;
octal3: Format.NumberFormat =
[base: 8, columns: 3, zerofill: FALSE, unsigned: TRUE];
decimal3: Format.NumberFormat =
[base: 10, columns: 3, zerofill: FALSE, unsigned: TRUE];
octal4: Format.NumberFormat =
[base: 8, columns: 4, zerofill: FALSE, unsigned: TRUE];
octal5: Format.NumberFormat =
[base: 8, columns: 5, zerofill: FALSE, unsigned: TRUE];
decimal5: Format.NumberFormat =
[base: 10, columns: 5, zerofill: FALSE, unsigned: TRUE];
octal6: Format.NumberFormat =
[base: 8, columns: 6, zerofill: FALSE, unsigned: TRUE];
PrintFGEntry:
PROC [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[Ascii.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[Ascii.SP]; ENDLOOP;
END;
ENDCASE;
END;
FGTable:
PROC [root:
STRING] =
BEGIN
defs: BOOLEAN ← FALSE;
bcdFile: STRING ← [40];
bcdseg, sseg, cseg: FileSegment.Pages;
bcdSpace, codeSpace: Space.Handle;
bcd: BcdOps.BcdBase;
mth: BcdOps.MTHandle;
Strings.AppendString[bcdFile, root];
FOR i:
CARDINAL
IN [0..bcdFile.length)
DO
IF bcdFile[i] = '. THEN EXIT;
REPEAT FINISHED => Strings.AppendString[bcdFile, ".bcd"];
ENDLOOP;
BEGIN
[bcd: bcdseg, code: cseg, symbols: sseg] ← Load[
bcdFile ! NoFGT => GOTO badformat; NoCode => GO TO defsFile;
NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
NoFile => GOTO badname];
bcdSpace ← ListerDefs.MapPages[bcdseg];
bcd ← bcdSpace.LongPointer;
mth ← @LOOPHOLE[bcd + bcd.mtOffset, BcdDefs.Base][FIRST[BcdDefs.MTIndex]];
codeSpace ← ListerDefs.MapPages[cseg];
code ← codeSpace.LongPointer + mth.code.offset;
Space.Delete[bcdSpace];
SymbolTable.SetCacheSize[0];
symbols ← SymbolTable.Acquire[sseg];
ListerDefs.SetRoutineSymbols[symbols];
OpenOutput[root, ".fl"];
WriteFileID[];
IF symbols.sourceFile #
NIL
THEN
BEGIN PutString[" Source: "]; PutLongString[symbols.sourceFile]; PutCR[]; END;
PrintFGT[];
SymbolTable.Release[symbols];
Space.Delete[codeSpace];
CloseOutput[];
EXITS
defsFile => ListerDefs.WriteString["Definitions File!"];
badformat => ListerDefs.WriteString["Bad Format!"];
badname => ListerDefs.WriteString["File Not Found!"];
END;
END;
command: CommanderOps.CommandBlockHandle;
command ← CommanderOps.AddCommand["FGTable", LOOPHOLE[FGTable], 1];
command.params[0] ← [type: string, prompt: "Filename"];
END...