-- PackDebugImpl.mesa
-- last edited by JGS on 17-Sep-82 14:09:18
-- last edited by Satterthwaite, January 12, 1983 11:31 am
DIRECTORY
Alloc USING [AddNotify, DropNotify, Handle, Notifier],
BcdDefs USING [
CTIndex, CTNull, CTRecord, EVIndex, EVNull, FTIndex, FTNull, FTRecord, FTSelf,
LFNull, MTIndex, MTRecord, Namee, NameRecord, NTIndex, NTRecord, NullName,
SGIndex, VersionID, VersionStamp],
BcdOps USING [CTHandle, MTHandle, NameString, SGHandle],
CodePackProcs USING [ModuleIndex],
CharIO USING [
NumberFormat, PutChar, PutDecimal, PutNumber, PutOctal, PutString],
HashOps USING [HTIndex, htNull, SubStringForHash],
PackDebug,
PackagerDefs USING [globalData, packsttype, packtreetype],
ProcessingOrder USING [Enumerate],
SemanticEntry USING [STIndex],
SourceBcd USING [
bcdBases, bcdHeader, bcdLimits, BcdTableLoc, CTreeIndex, nullCTreeIndex,
EnumerateSons, Index, Kind, Link, Name, Prev, SharedProtoName,
EnumerateModules, EnumerateModulesInConfig, EnumerateConfigs],
String USING [SubString, SubStringDescriptor],
Table USING [Base, Limit],
Time USING [Append, Packed, Unpack],
Tree: FROM "PackTree" USING [Index, Link, NodeName, Scan, nullIndex],
TreeOps: FROM "PackTreeOps" USING [ScanSons];
PackDebugImpl: PROGRAM
IMPORTS
Alloc, CharIO, HashOps, PackagerDefs, SourceBcd, Time,
TreeOps, ProcessingOrder
EXPORTS PackDebug =
BEGIN OPEN PackagerDefs;
SubString: TYPE = String.SubString;
table: Alloc.Handle ← NIL;
stb, tb: Table.Base;
UpdateBases: Alloc.Notifier = {
tb ← base[PackagerDefs.packtreetype]; -- parse tree table
stb ← base[PackagerDefs.packsttype]}; -- semantic entry table
-- Initialization and Finalization
Initialize: PUBLIC PROC = {
table ← PackagerDefs.globalData.ownTable;
table.AddNotify[UpdateBases]};
Finalize: PUBLIC PROC = {
table.DropNotify[UpdateBases];
table ← NIL};
-- Utility Writes
WriteChar: PROC [c: CHARACTER] = {CharIO.PutChar[globalData.errorStream, c]};
WriteString: PROC [s: STRING] = {CharIO.PutString[globalData.errorStream, s]};
WriteSubString: PROC [ss: SubString] = {
FOR i: CARDINAL IN [ss.offset..ss.offset+ss.length) DO
WriteChar[ss.base[i]];
ENDLOOP};
WriteTime: PROC [t: Time.Packed] = {
s: STRING ← [20];
Time.Append[s, Time.Unpack[t]];
WriteString[s]};
Indent: PROC [n: CARDINAL] = {
THROUGH [1..n/8] DO WriteChar['\t] ENDLOOP;
THROUGH [1..n MOD 8] DO WriteChar[' ] ENDLOOP};
Tab: PROC [n: CARDINAL] = {WriteChar['\n]; Indent[n]};
-- Annotated printing
WriteDecimal: PROC [id: STRING, n: INTEGER] = {
IF id # NIL THEN WriteString[id];
CharIO.PutDecimal[PackagerDefs.globalData.errorStream, n]};
WriteOctal: PROC [id: STRING, n: UNSPECIFIED] = {
IF id # NIL THEN WriteString[id];
CharIO.PutOctal[PackagerDefs.globalData.errorStream, n]};
WriteIndex: PROC [id: STRING, index: UNSPECIFIED] = {
IF id # NIL THEN WriteString[id];
PrintIndex[index]};
-- Utility Prints
PrintMachine: PROC [stamp: BcdDefs.VersionStamp] = {
octal: CharIO.NumberFormat = [8,FALSE,FALSE,1];
CharIO.PutNumber[PackagerDefs.globalData.errorStream, stamp.net, octal];
WriteChar['#];
CharIO.PutNumber[PackagerDefs.globalData.errorStream, stamp.host, octal];
WriteChar['#]};
PrintFileName: PROC [fti: BcdDefs.FTIndex] = {
SELECT fti FROM
BcdDefs.FTNull => WriteString["(null)"L];
BcdDefs.FTSelf => WriteString["(self)"L];
ENDCASE => WriteName[SourceBcd.bcdBases.ftb[fti].name]};
PrintFileVersion: PROC [fti: BcdDefs.FTIndex] = {
OPEN SourceBcd.bcdBases.ftb[fti];
WriteChar['(];
IF version.time = 0 THEN WriteString ["Null Version"L]
ELSE
BEGIN
WriteTime[LOOPHOLE[version.time]];
WriteChar[' ]; PrintMachine[version];
END;
WriteChar[')]};
PrintIndex: PROC [index: UNSPECIFIED] = {
WriteChar['[];
IF index = Table.Limit-1
THEN WriteString["Null"L]
ELSE CharIO.PutDecimal[PackagerDefs.globalData.errorStream, index];
WriteChar[']]};
PrintNamee: PROC [n: BcdDefs.Namee] = {
WriteChar['[];
WITH n SELECT FROM
config => {
WriteString["cti: "L];
CharIO.PutDecimal[PackagerDefs.globalData.errorStream, LOOPHOLE[cti]]};
module => {
WriteString["mti: "L];
CharIO.PutDecimal[PackagerDefs.globalData.errorStream, LOOPHOLE[mti]]};
import => {
WriteString["impi: "L];
CharIO.PutDecimal[PackagerDefs.globalData.errorStream, LOOPHOLE[impi]]};
export => {
WriteString["expi: "L];
CharIO.PutDecimal[PackagerDefs.globalData.errorStream, LOOPHOLE[expi]]};
ENDCASE;
WriteChar[']]};
WriteNameFromTable: PROC [n: BcdDefs.Namee] = {
OPEN BcdDefs;
nti: NTIndex ← FIRST[NTIndex];
UNTIL nti = SourceBcd.bcdLimits.nt DO
IF SourceBcd.bcdBases.ntb[nti].item = n THEN {
WriteName[SourceBcd.bcdBases.ntb[nti].name]; EXIT};
nti ← nti + SIZE[NTRecord];
ENDLOOP};
-- ********************** Parse Tree Printing **********************
PrintTree: PUBLIC PROC = {
WriteString["\n\n--Parse Tree--\n"L];
PrintSubTree[PackagerDefs.globalData.root, 0]; WriteChar['\n]; WriteChar['\n]};
PrintSubTree: PROC [t: Tree.Link, nBlanks: CARDINAL] = {
OPEN Tree;
Printer: Tree.Scan = {
node: Tree.Index;
Tab[nBlanks];
WITH s: t SELECT FROM
hash => WriteHTI[s.index];
symbol => WriteSymbol[s.index];
literal => WriteCodePackProcs[s.index];
subtree => {
node ← s.index;
IF node = Tree.nullIndex THEN WriteString["<empty>"L]
ELSE {
OPEN tb[node];
WriteNodeName[name]; PrintIndex[node];
WriteOctal[", source["L, info]; WriteChar[']];
SELECT name FROM
allComp, compItems, exceptItems, exceptPacks,
itemsExceptPacks, exceptPacksItems,
mainOfPL, evOfPL, catchOfPL => {
WriteString[", cp"L]; PrintIndex[cp];
WriteString[", seg"L]; PrintIndex[seg]};
ENDCASE;
IF attrs[$exceptMAIN] THEN SELECT name FROM
codePack, unnamedCodePack, discardCodePack =>
WriteString[", except MAIN"L];
ENDCASE;
IF attrs[$exceptEV] THEN SELECT name FROM
codePack, unnamedCodePack, discardCodePack =>
WriteString[", except ENTRY VECTOR"L];
ENDCASE;
IF attrs[$exceptCatch] THEN SELECT name FROM
codePack, unnamedCodePack, discardCodePack =>
WriteString[", except CATCH CODE"L];
ENDCASE;
IF attrs[$superceded] THEN SELECT name FROM
codeSeg, codePack, unnamedCodePack, merge, mergeFP,
discardCodePack =>
WriteString[", superceded"L];
ENDCASE;
IF attrs[$placed] THEN SELECT name FROM
codeSeg, codePack, unnamedCodePack, merge, mergeFP,
discardCodePack =>
WriteString[", placed"L];
ENDCASE;
nBlanks ← nBlanks + 2;
TreeOps.ScanSons[s, Printer];
nBlanks ← nBlanks - 2}};
ENDCASE};
[] ← Printer[t]};
WriteHTI: PROC [hti: HashOps.HTIndex] =
BEGIN
ss: String.SubString = @desc;
desc: String.SubStringDescriptor;
IF hti = HashOps.htNull
THEN WriteString["(anonymous)"L]
ELSE {HashOps.SubStringForHash[ss, hti]; WriteSubString[ss]};
END;
WriteNodeName: PROC [n: Tree.NodeName] =
BEGIN
NodePrintName: ARRAY Tree.NodeName OF STRING = [
"list"L,
"code segment"L,
"code pack"L, "unnamed code pack"L, "discard code pack"L,
"frame pack"L,
"merge segment"L, "merge frame pack"L,
"allComp"L, "compItems"L, "exceptItems"L, "exceptPacks"L,
"itemsExceptPacks"L, "exceptPacks&Items"L,
"MAIN of pl"L, "EV of pl"L, "CATCH CODE of pl"L,
"component"L, "MAIN"L, "ENTRY VECTOR"L, "CATCH CODE"L,
"none"L];
WriteString[NodePrintName[n]];
END;
WriteSymbol: PROC [sym: SemanticEntry.STIndex] =
BEGIN
WriteIndex["symbol"L, sym];
WriteChar[' ]; WriteHTI[stb[sym].hti];
WriteIndex[", parse tree"L, stb[sym].treeNode];
WITH stb[sym] SELECT FROM
unknown => WriteString[" <unknown>"L];
config =>
BEGIN
WriteIndex[", config: cti"L, cti];
WriteIndex[", cNode"L, cNode];
END;
module =>
BEGIN
WriteIndex[", module: mti"L, mti];
WriteIndex[", mNode"L, mNode];
END;
segment =>
WriteString[", segment"L];
codePack =>
WriteString[", code pack"L];
framePack =>
WriteString[", frame pack"L];
ENDCASE;
END;
WriteCodePackProcs: PROC [mi: CodePackProcs.ModuleIndex] =
BEGIN
WriteIndex["code pack procs"L, mi];
END;
-- ********************** Source Bcd Table Printing **********************
PrintSourceBcd: PUBLIC PROC =
BEGIN
WriteString["\n\n--Source Bcd--\n"L];
PrintHeader[];
WriteString["Configurations:"L];
SourceBcd.EnumerateConfigs[PrintConfig];
WriteString["\n\nModules:"L];
SourceBcd.EnumerateModules[PrintModule];
WriteChar['\n];
PrintFiles[];
END;
PrintHeader: PROC =
BEGIN OPEN bcd: SourceBcd.bcdHeader;
WriteString[" Configured "L]; WriteTime[LOOPHOLE[bcd.version.time]];
IF bcd.source # BcdDefs.NullName THEN {
WriteString[" from "L]; WriteName[bcd.source]};
WriteString[" by "L]; PrintMachine[bcd.version];
IF bcd.versionIdent # BcdDefs.VersionID THEN
WriteDecimal[" Obsolete VersionID = "L, bcd.versionIdent];
WriteString["\n Configured by "L]; WriteTime[LOOPHOLE[bcd.creator.time]];
WriteChar[' ]; PrintMachine[bcd.creator];
WriteString["\n "L];
IF ~bcd.definitions THEN WriteChar['~];
WriteString["definitions, "L];
IF ~bcd.repackaged THEN WriteChar['~];
WriteString["repackaged, "L];
IF ~bcd.tableCompiled THEN WriteChar['~];
WriteString["tableCompiled"L];
WriteDecimal["\n\n Configurations: "L, bcd.nConfigs];
WriteDecimal[", Modules: "L, bcd.nModules];
WriteDecimal[", Imports: "L, bcd.nImports];
WriteDecimal[", Exports: "L, bcd.nExports];
WriteDecimal[", Dummy: "L, bcd.firstdummy];
WriteDecimal[", #Dummies: "L, bcd.nDummies];
WriteChar['\n]; WriteChar['\n];
END;
PrintConfig: PROC [cti: BcdDefs.CTIndex] RETURNS [stop: BOOLEAN] = {
OPEN BcdDefs;
config: BcdOps.CTHandle = @SourceBcd.bcdBases.ctb[cti];
Tab[2];
WriteName[config.name]; PrintIndex[cti];
IF config.namedInstance THEN {
WriteString[", instance: "L]; WriteNameFromTable[[config[cti]]]};
WriteString[", file: "L]; PrintFileName[config.file];
PrintIndex[config.file];
IF config.config # CTNull THEN {
WriteString[", parent: "L];
WriteName[SourceBcd.bcdBases.ctb[config.config].name];
PrintIndex[config.config]};
IF config.nControls # 0 THEN {
WriteString[", controls:"L];
FOR i: CARDINAL IN [0..config.nControls) DO
IF i MOD 6 = 0 THEN Tab[6] ELSE WriteChar[' ];
WriteNameFromTable[config.controls[i]];
PrintNamee[config.controls[i]];
IF i+1 # config.nControls THEN WriteChar[',];
ENDLOOP};
RETURN[FALSE]};
PrintModule: PROC [mti: BcdDefs.MTIndex] RETURNS [stop: BOOLEAN] = {
OPEN BcdDefs;
module: BcdOps.MTHandle = @SourceBcd.bcdBases.mtb[mti];
Tab[2];
WriteName[module.name]; PrintIndex[mti];
IF module.namedInstance THEN
{WriteString[", instance: "L]; WriteNameFromTable[[module[mti]]]};
WriteString[", file: "L];
PrintFileName[module.file]; PrintIndex[module.file];
IF module.config # CTNull THEN {
WriteString[", config: "L];
WriteName[SourceBcd.bcdBases.ctb[module.config].name];
PrintIndex[module.config]};
Tab[4];
WriteDecimal["framesize: "L, module.framesize];
WriteDecimal[", gfi: "L, module.gfi];
WriteDecimal[", ngfi: "L, module.ngfi];
WriteString[", links: "L];
WriteString[
(SELECT module.linkLoc FROM
frame => "frame"L,
code => "code"L,
ENDCASE => "dontcare"L)];
Tab[4];
WriteString["code: "L]; PrintSegment[module.code.sgi];
WriteOctal[", offset: "L, module.code.offset];
WriteOctal[", length: "L, module.code.length];
IF module.code.linkspace THEN WriteString [", space available for links"L];
Tab[4];
WriteString["symbols: "L]; PrintSegment[module.sseg];
IF module.variables # EVNull THEN {
Tab[4]; WriteIndex["variables: "L, module.variables]};
Tab[4];
WriteDecimal[
"number of links: "L,
(IF module.links = LFNull THEN 0
ELSE SourceBcd.bcdBases.lfb[module.links].length)];
Tab[4];
IF ~module.packageable THEN WriteChar['~];
WriteString["packageable, "L];
IF ~module.tableCompiled THEN WriteChar['~];
WriteString["tableCompiled, "L];
IF ~module.residentFrame THEN WriteChar['~];
WriteString["residentFrame"L];
RETURN[FALSE]};
PrintSegment: PROC [sgi: BcdDefs.SGIndex] = {
sd: BcdOps.SGHandle = @SourceBcd.bcdBases.sgb[sgi];
PrintFileName[sd.file]; PrintIndex[sgi];
WriteDecimal[", [base: "L, sd.base]; WriteDecimal[", pages: "L, sd.pages];
IF sd.extraPages # 0 THEN WriteDecimal["+"L, sd.extraPages];
WriteChar[']]};
PrintFiles: PROC = {
OPEN BcdDefs;
fti: FTIndex ← FIRST[FTIndex];
WriteString["\nFiles:"L];
UNTIL fti = SourceBcd.bcdLimits.ft DO
PrintFile[fti];
fti ← fti + SIZE[FTRecord]
ENDLOOP;
WriteChar['\n]};
PrintFile: PROC [fti: BcdDefs.FTIndex] = {
OPEN SourceBcd.bcdBases.ftb[fti];
Tab[2];
SELECT fti FROM
BcdDefs.FTNull => WriteString["(null)"L];
BcdDefs.FTSelf => WriteString["(self)"L];
ENDCASE => {
WriteName[name]; PrintIndex[fti];
WriteString[", version: "L]; PrintFileVersion[fti]}};
WriteName: PROC [n: BcdDefs.NameRecord] = {
ssd: String.SubStringDescriptor ← [
base: @SourceBcd.bcdBases.ssb.string,
offset: n,
length: SourceBcd.bcdBases.ssb.size[n]];
WriteSubString[@ssd]};
-- ********************** Configuration Tree Printing **********************
PrintConfigTree: PUBLIC PROC [root: SourceBcd.CTreeIndex] = {
WriteString["\n\n--Configuration Tree--\n"L];
IF root = SourceBcd.nullCTreeIndex THEN WriteString[" <Empty>"L]
ELSE {
nBlanks: CARDINAL ← 1;
WriteSubConfigTree: PROC [node: SourceBcd.CTreeIndex] RETURNS [BOOL←FALSE] = {
index: SourceBcd.BcdTableLoc = node.Index;
Tab[nBlanks];
IF node.Kind = $instance THEN {WriteName[node.Name[$instance]]; WriteChar[':]};
WriteName[node.Name[$prototype]]; PrintIndex[node];
WriteChar[' ];
IF ~node.SharedProtoName THEN WriteChar['~];
WriteString["pNameTwice"L];
WITH index SELECT FROM
module => WriteIndex[", module"L, mti];
config => WriteIndex[", config"L, cti];
ENDCASE;
WriteIndex[", Link: i"L, node.Link[$instance]];
WriteIndex[", p"L, node.Link[$prototype]];
WriteIndex[", Prev: i"L, node.Prev[$instance]];
WriteIndex[", p"L, node.Prev[$prototype]];
nBlanks ← nBlanks+2;
node.EnumerateSons[WriteSubConfigTree];
nBlanks ← nBlanks-2};
[] ← WriteSubConfigTree[root]; WriteChar['\n]};
WriteChar['\n]};
-- ******************** Processing Order Printing ********************
PrintProcessingOrder: PUBLIC PROC [root: SourceBcd.CTreeIndex] =
BEGIN
WriteString["\n\n--Processing Order--\n"L];
SourceBcd.EnumerateModulesInConfig[
kind: prototype,
configTreeNode: root,
userProc: PrintOneModulesOrder];
WriteChar['\n];
END;
PrintOneModulesOrder: PROC [mti: BcdDefs.MTIndex] RETURNS [stop: BOOLEAN] =
BEGIN
printCount: CARDINAL ← 0;
PrintOneCDNode: PROC [cdNode: Tree.Index] RETURNS [stop: BOOLEAN] =
BEGIN -- print one component description node to be processed for mti
IF (printCount ← printCount+1) > 10 THEN
{WriteString["\n "L]; printCount ← 1}
ELSE WriteString[" "L];
PrintIndex[cdNode];
RETURN[FALSE];
END;
Tab[0];
WriteName[SourceBcd.bcdBases.mtb[mti].name];
PrintIndex[mti]; WriteString[": "L];
ProcessingOrder.Enumerate[mti, PrintOneCDNode];
RETURN[FALSE];
END;
END.