-- ListPackageInfo.mesa; modified by Sweet, September 16, 1980 9:13 AM
DIRECTORY
BcdDefs,
BcdOps,
CommanderDefs USING [AddCommand, CommandBlockHandle],
ControlDefs USING [CSegPrefix],
Inline USING [LowHalf],
IODefs USING [NumberFormat, SP, WriteString],
ListerDefs USING [
FileSegmentHandle, IncorrectVersion, Load, LoadFromConfig, MultipleModules, NoCode, NoFGT,
NoSymbols, PrintHti, SetRoutineSymbols, WriteFileID],
OutputDefs USING [
CloseOutput, NumberFormat, OpenOutput, PutChar, PutCR, PutDecimal, PutNumber,
PutOctal, PutString],
PackageSymbols USING [
ConstRecord, InnerPackRecord, IPIndex, IPNull, OPIndex, OuterPackRecord],
SegmentDefs USING [
DeleteFileSegment, FileNameError, FileSegmentAddress, FileSegmentHandle,
SwapError, SwapIn, Unlock],
String USING [AppendString],
Symbols USING [BTIndex, HTIndex],
SymbolTable USING [Acquire, Base, Release, TableForSegment],
Storage USING [Node, Free];
ListPackageInfo: PROGRAM
IMPORTS
CommanderDefs, Inline, IODefs, ListerDefs, OutputDefs, SegmentDefs,
String, SymbolTable, Storage
EXPORTS ListerDefs =
BEGIN OPEN ListerDefs, OutputDefs, Symbols, PackageSymbols;
symbols: SymbolTable.Base;
Decimal3: IODefs.NumberFormat =
[base: 10, unsigned: TRUE, zerofill: FALSE, columns: 3];
Decimal5: IODefs.NumberFormat =
[base: 10, unsigned: TRUE, zerofill: FALSE, columns: 5];
Octal5: IODefs.NumberFormat =
[base: 8, unsigned: TRUE, zerofill: FALSE, columns: 5];
epMap: 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.HashForSe[b.id];
ENDCASE;
END;
[] ← symbols.EnumerateBodies[FIRST[BTIndex], Count];
epMap ← Storage.Node[max + 1];
[] ← symbols.EnumerateBodies[FIRST[BTIndex], Enter];
END;
PrintOuterPackTable: PROCEDURE =
BEGIN OPEN s: symbols;
i: OPIndex;
opb: DESCRIPTOR FOR ARRAY OF OuterPackRecord ← DESCRIPTOR[
Inline.LowHalf[s.stHandle] + s.stHandle.outerPackBlock.offset,
s.stHandle.outerPackBlock.size/SIZE[OuterPackRecord]];
opr: OuterPackRecord;
PutString["OuterPackTable"];
PutCR[];
PutCR[];
FOR i 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[];
RETURN
END;
PrintInnerPackTable: PROCEDURE =
BEGIN OPEN s: symbols;
i: IPIndex;
ipb: DESCRIPTOR FOR ARRAY OF InnerPackRecord ← DESCRIPTOR[
Inline.LowHalf[s.stHandle] + s.stHandle.innerPackBlock.offset,
s.stHandle.innerPackBlock.size/SIZE[InnerPackRecord]];
ipr: InnerPackRecord;
PutString["InnerPackTable"];
PutCR[];
PutCR[];
FOR i 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[];
RETURN
END;
PrintConstantTable: PROCEDURE =
BEGIN OPEN s: symbols;
cstb: DESCRIPTOR FOR ARRAY OF ConstRecord ← DESCRIPTOR[
Inline.LowHalf[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[];
RETURN
END;
PrintByColumns: PROCEDURE [
PrintOne: PROCEDURE [i: CARDINAL], 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[j];
IF ~last THEN THROUGH [0..spaceBetween) DO PutChar[IODefs.SP]; ENDLOOP;
ENDLOOP;
PutCR[];
ENDLOOP;
END;
cspp: POINTER TO ControlDefs.CSegPrefix;
PackInfo: PROCEDURE [root: STRING] =
BEGIN OPEN String, SegmentDefs;
i: CARDINAL;
bcdFile: STRING ← [40];
cseg, sseg: FileSegmentHandle;
AppendString[bcdFile, root];
FOR i IN [0..bcdFile.length) DO
IF bcdFile[i] = '. THEN {bcdFile.length ← i; EXIT}; ENDLOOP;
AppendString[bcdFile, ".bcd"];
BEGIN
[symbols: sseg, code: cseg] ← Load[
bcdFile ! NoFGT => RESUME ; NoCode => GO TO badformat;
NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
SegmentDefs.FileNameError => GOTO badname];
symbols ← SymbolTable.Acquire[SymbolTable.TableForSegment[sseg]];
ListerDefs.SetRoutineSymbols[symbols];
SwapIn[cseg];
cspp ← FileSegmentAddress[cseg];
IF cspp.header.info.altoCode THEN IODefs.WriteString["Not D*"L]
ELSE
BEGIN
CreateEpMap[];
OpenOutput[root, ".pl"];
WriteFileID[];
PrintOuterPackTable[];
PrintInnerPackTable[];
PrintConstantTable[];
CloseOutput[];
Storage.Free[epMap];
END;
SymbolTable.Release[symbols];
SegmentDefs.DeleteFileSegment[sseg ! SegmentDefs.SwapError => CONTINUE];
Unlock[cseg];
DeleteFileSegment[cseg ! SwapError => CONTINUE];
EXITS
badformat => IODefs.WriteString["Bad Format!"];
badname => IODefs.WriteString["File Not Found!"];
END;
END;
PackInfoInConfig: PROCEDURE [config, module: STRING] =
BEGIN OPEN String, SegmentDefs;
i: CARDINAL;
bcdFile: STRING ← [40];
mti: BcdDefs.MTIndex;
mth: BcdOps.MTHandle;
bcd: BcdOps.BcdBase;
cseg, sseg, bcdseg: FileSegmentHandle;
AppendString[bcdFile, config];
FOR i IN [0..bcdFile.length) DO
IF bcdFile[i] = '. THEN {bcdFile.length ← i; EXIT}; ENDLOOP;
AppendString[bcdFile, ".bcd"];
BEGIN
[symbols: sseg, code: cseg, bcdseg: bcdseg, mti: mti] ← LoadFromConfig[
bcdFile, module, TRUE ! NoFGT => RESUME ; NoCode => GO TO badformat;
NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
SegmentDefs.FileNameError => GOTO badname];
symbols ← SymbolTable.Acquire[SymbolTable.TableForSegment[sseg]];
ListerDefs.SetRoutineSymbols[symbols];
SwapIn[cseg];
bcd ← FileSegmentAddress[bcdseg];
mth ← @LOOPHOLE[bcd + bcd.mtOffset, BcdDefs.Base][mti];
cspp ← FileSegmentAddress[cseg] + mth.code.offset;
IF cspp.header.info.altoCode THEN IODefs.WriteString["Not D*"L]
ELSE
BEGIN
CreateEpMap[];
OpenOutput[module, ".pl"];
WriteFileID[];
PrintOuterPackTable[];
PrintInnerPackTable[];
PrintConstantTable[];
CloseOutput[];
Storage.Free[epMap];
END;
SymbolTable.Release[symbols];
SegmentDefs.DeleteFileSegment[sseg ! SegmentDefs.SwapError => CONTINUE];
Unlock[bcdseg];
DeleteFileSegment[bcdseg];
Unlock[cseg];
DeleteFileSegment[cseg ! SwapError => CONTINUE];
EXITS
badformat => IODefs.WriteString["Bad Format!"];
badname => IODefs.WriteString["File Not Found!"];
END;
END;
command: CommanderDefs.CommandBlockHandle;
command ← CommanderDefs.AddCommand["PackInfo", LOOPHOLE[PackInfo], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderDefs.AddCommand[
"PackInfoInConfig", LOOPHOLE[PackInfoInConfig], 2];
command.params[0] ← [type: string, prompt: "ConfigName"];
command.params[1] ← [type: string, prompt: "ModName"];
END...