-- ListPackageInfo.mesa
-- Last modified by Sweet on September 16, 1980 9:13 AM
-- Last modified by Lewis on 15-Jan-81 17:36:18
-- Last modified by Satterthwaite on May 10, 1983 12:56 pm
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.