DIRECTORY
Ascii USING [SP],
BcdDefs,
BcdOps,
CommanderOps USING [AddCommand, CommandBlockHandle],
FileSegment: TYPE USING [Pages],
ListerDefs
USING [
IncorrectVersion, Load, LoadFromConfig, MapPages, MultipleModules,
NoCode, NoFGT, NoFile, NoSymbols, PrintHti, SetRoutineSymbols,
WriteFileID, WriteString],
LongStorage USING [Node, Free],
OutputDefs
USING [
CloseOutput, NumberFormat, OpenOutput, PutChar, PutCR, PutDecimal, PutNumber,
PutOctal, PutString],
PackageSymbols
USING [
ConstRecord, InnerPackRecord, IPIndex, IPNull, OPIndex, OuterPackRecord],
PrincOps USING [CSegPrefix],
Space: TYPE USING [Handle, Delete, LongPointer],
Strings USING [AppendString],
Symbols USING [BTIndex, HTIndex],
SymbolTable USING [Acquire, Base, Release];
ListPackageInfo:
PROGRAM
IMPORTS
CommanderOps, ListerDefs, LongStorage, OutputDefs, Space,
Strings, SymbolTable =
BEGIN OPEN ListerDefs, OutputDefs, Symbols, PackageSymbols;
symbols: SymbolTable.Base;
Decimal3: OutputDefs.NumberFormat =
[base: 10, unsigned: TRUE, zerofill: FALSE, columns: 3];
Decimal5: OutputDefs.NumberFormat =
[base: 10, unsigned: TRUE, zerofill: FALSE, columns: 5];
Octal5: OutputDefs.NumberFormat =
[base: 8, unsigned: TRUE, zerofill: FALSE, columns: 5];
epMap: LONG POINTER TO ARRAY [0..0) OF HTIndex;
CreateEpMap:
PROCEDURE =
BEGIN
max: CARDINAL ← 0;
Count:
PROCEDURE [bti: BTIndex]
RETURNS [stop:
BOOLEAN] =
BEGIN
stop ← FALSE;
WITH b: symbols.bb[bti]
SELECT
FROM
Callable => IF ~b.inline THEN max ← MAX[b.entryIndex, max];
ENDCASE;
END;
Enter:
PROCEDURE [bti: BTIndex]
RETURNS [stop:
BOOLEAN] =
BEGIN
stop ← FALSE;
WITH b: symbols.bb[bti]
SELECT
FROM
Callable =>
IF ~b.inline THEN epMap[b.entryIndex] ← symbols.NameForSe[b.id];
ENDCASE;
END;
[] ← symbols.EnumerateBodies[FIRST[BTIndex], Count];
epMap ← LongStorage.Node[max + 1];
[] ← symbols.EnumerateBodies[FIRST[BTIndex], Enter];
END;
PrintOuterPackTable:
PROCEDURE =
BEGIN OPEN s: symbols;
opb:
LONG
DESCRIPTOR
FOR
ARRAY
OF OuterPackRecord ←
DESCRIPTOR[
(s.stHandle + s.stHandle.outerPackBlock.offset),
(s.stHandle.outerPackBlock.size / SIZE[OuterPackRecord])];
opr: OuterPackRecord;
PutString["OuterPackTable"];
PutCR[];
PutCR[];
FOR i: OPIndex
IN [0..
LENGTH[opb])
DO
opr ← opb[i];
PutNumber[i, Decimal3];
PutString[": hti:"L]; PutNumber[opr.hti, Decimal5];
PutString[" ("L]; PrintHti[opr.hti];
PutString["), ep: "]; PutOctal[opr.entryIndex];
PutString[" ("L]; PutOctal[cspp.entry[opr.entryIndex].initialpc*2];
PutString["), len: "]; PutOctal[opr.length];
IF opr.firstSon # IPNull THEN {PutString[", son: "L]; PutDecimal[opr.firstSon]};
IF opr.resident THEN PutString[", resident"L];
IF opr.placed THEN PutString[", placed"L];
IF opr.attr1 THEN PutString[", attr1"L];
IF opr.attr2 THEN PutString[", attr2"L];
PutCR[];
ENDLOOP;
PutCR[];
PutCR[];
END;
PrintInnerPackTable:
PROCEDURE =
BEGIN OPEN s: symbols;
ipb:
LONG
DESCRIPTOR
FOR
ARRAY
OF InnerPackRecord ←
DESCRIPTOR[
(s.stHandle + s.stHandle.innerPackBlock.offset),
(s.stHandle.innerPackBlock.size / SIZE[InnerPackRecord])];
ipr: InnerPackRecord;
PutString["InnerPackTable"];
PutCR[];
PutCR[];
FOR i: IPIndex
IN [0..
LENGTH[ipb])
DO
ipr ← ipb[i];
PutNumber[i, Decimal3];
PutString[": ("L]; PrintHti[epMap[ipr.entryIndex]];
PutString["), ep: "]; PutOctal[ipr.entryIndex];
PutString[" ("L]; PutOctal[cspp.entry[ipr.entryIndex].initialpc*2];
PutString["), len: "]; PutOctal[ipr.length];
IF ipr.lastSon THEN PutString[", lastSon"L];
PutCR[];
ENDLOOP;
PutCR[];
PutCR[];
END;
PrintConstantTable:
PROCEDURE =
BEGIN OPEN s: symbols;
cstb:
LONG
DESCRIPTOR
FOR
ARRAY
OF ConstRecord ←
DESCRIPTOR[
(s.stHandle + s.stHandle.constBlock.offset),
(s.stHandle.constBlock.size / SIZE[ConstRecord])];
PrintEntry:
PROCEDURE [i:
CARDINAL] =
BEGIN
cstr: ConstRecord = cstb[i];
PutNumber[cstr.offset, Octal5];
PutString["B, len:"]; PutNumber[cstr.length, Decimal3];
END;
PutString["ConstantTable"];
PutCR[];
PutCR[];
PrintByColumns[PrintEntry, LENGTH[cstb], 3, 4];
PutCR[];
PutCR[];
END;
PrintByColumns:
PROCEDURE [
PrintOne: PROCEDURE [i: CARDINAL], nItems, nColumns, spaceBetween: CARDINAL] =
BEGIN
nc: CARDINAL;
delta: CARDINAL ← (nItems + nColumns - 1)/nColumns;
last: BOOLEAN;
FOR i:
CARDINAL
IN [0..delta)
DO
nc ← 0;
last ← FALSE;
FOR j:
CARDINAL ← i, j + delta
WHILE ~last
AND j < nItems
DO
nc ← nc + 1;
last ← nc = nColumns;
PrintOne[j];
IF ~last THEN THROUGH [0..spaceBetween) DO PutChar[Ascii.SP]; ENDLOOP;
ENDLOOP;
PutCR[];
ENDLOOP;
END;
cspp: LONG POINTER TO PrincOps.CSegPrefix;
PackInfo:
PROCEDURE [root:
STRING] =
BEGIN
bcdFile: STRING ← [40];
cseg, sseg: FileSegment.Pages;
codeSpace: Space.Handle;
Strings.AppendString[bcdFile, root];
FOR i:
CARDINAL
IN [0..bcdFile.length)
DO
IF bcdFile[i] = '. THEN {bcdFile.length ← i; EXIT};
ENDLOOP;
Strings.AppendString[bcdFile, ".bcd"];
[symbols: sseg, code: cseg] ← Load[bcdFile
! NoFGT =>
RESUME;
NoCode => GO TO badformat;
NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
NoFile =>
BEGIN
ListerDefs.WriteString[" "L];
ListerDefs.WriteString[bcdFile];
ListerDefs.WriteString[" not found"L];
GOTO badname;
END];
symbols ← SymbolTable.Acquire[sseg];
ListerDefs.SetRoutineSymbols[symbols];
codeSpace ← ListerDefs.MapPages[cseg];
cspp ← codeSpace.LongPointer;
IF cspp.header.info.altoCode THEN ListerDefs.WriteString["Not Dstar"L]
ELSE
BEGIN
CreateEpMap[];
OutputDefs.OpenOutput[root, ".pl"];
WriteFileID[];
PrintOuterPackTable[];
PrintInnerPackTable[];
PrintConstantTable[];
OutputDefs.CloseOutput[];
LongStorage.Free[epMap];
END;
SymbolTable.Release[symbols];
Space.Delete[codeSpace];
EXITS
badformat => ListerDefs.WriteString["Bad Format!"];
badname => NULL;
END;
PackInfoInConfig:
PROCEDURE [config, module:
STRING] =
BEGIN
bcdFile: STRING ← [40];
mti: BcdDefs.MTIndex;
mth: BcdOps.MTHandle;
bcd: BcdOps.BcdBase;
cseg, sseg, bcdseg: FileSegment.Pages;
bcdSpace, codeSpace: Space.Handle;
Strings.AppendString[bcdFile, config];
FOR i:
CARDINAL
IN [0..bcdFile.length)
DO
IF bcdFile[i] = '. THEN {bcdFile.length ← i; EXIT};
ENDLOOP;
Strings.AppendString[bcdFile, ".bcd"];
[symbols: sseg, code: cseg, bcd: bcdseg, mti: mti] ← LoadFromConfig[
configName: bcdFile, moduleName: module !
NoFGT => RESUME;
NoCode => GO TO badformat;
NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
NoFile =>
BEGIN
ListerDefs.WriteString[" "L];
ListerDefs.WriteString[bcdFile];
ListerDefs.WriteString[" not found"L];
GOTO badname;
END];
symbols ← SymbolTable.Acquire[sseg];
ListerDefs.SetRoutineSymbols[symbols];
bcdSpace ← ListerDefs.MapPages[bcdseg];
bcd ← bcdSpace.LongPointer;
mth ← @LOOPHOLE[bcd + bcd.mtOffset, BcdDefs.Base][mti];
codeSpace ← ListerDefs.MapPages[cseg];
cspp ← codeSpace.LongPointer + mth.code.offset;
IF cspp.header.info.altoCode THEN ListerDefs.WriteString["Not Dstar"L]
ELSE
BEGIN
CreateEpMap[];
OutputDefs.OpenOutput[module, ".pl"];
WriteFileID[];
PrintOuterPackTable[];
PrintInnerPackTable[];
PrintConstantTable[];
OutputDefs.CloseOutput[];
LongStorage.Free[epMap];
END;
SymbolTable.Release[symbols];
Space.Delete[bcdSpace]; Space.Delete[codeSpace];
EXITS
badformat => ListerDefs.WriteString["Bad Format!"];
badname => NULL;
END;
command: CommanderOps.CommandBlockHandle;
command ← CommanderOps.AddCommand["PackInfo", LOOPHOLE[PackInfo], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderOps.AddCommand["PackInfoInConfig", LOOPHOLE[PackInfoInConfig], 2];
command.params[0] ← [type: string, prompt: "ConfigName"];
command.params[1] ← [type: string, prompt: "ModName"];
END.