-- BcdDebug.mesa -- Last edited by Satterthwaite on September 14, 1982 4:38 pm -- Last edited by Lewis on 19-Jan-81 17:28:21 DIRECTORY Alloc: TYPE USING [AddNotify, DropNotify, Notifier, Top], BcdBindDefs: TYPE USING [RelocHandle, RelocType], BcdComData: TYPE USING [errorStream, table], BcdControlDefs: TYPE USING [], BcdDefs: TYPE USING [ ControlItem, CTIndex, CTNull, CTRecord, cttype, cxtype, EVIndex, EVRecord, EVNull, evtype, EXPIndex, EXPRecord, exptype, fptype, FTIndex, FTNull, FTRecord, FTSelf, fttype, IMPIndex, IMPNull, IMPRecord, imptype, LFIndex, LFNull, lftype, Link, MTIndex, MTNull, MTRecord, mttype, Namee, NameRecord, NTIndex, NTRecord, nttype, RFIndex, RFNull, rftype, SGIndex, sgtype, SPIndex, SPRecord, sptype, sstype, sttype, TFIndex, TFNull, tftype, treetype, TMIndex, TMRecord, tmtype, TYPIndex, TYPRecord, typtype, VersionStamp], BcdOps: TYPE USING [NameString], CharIO: TYPE USING [PutChar, PutDecimal, PutOctal, PutString, PutSubString], Strings: TYPE USING [String, SubString, SubStringDescriptor], Symbols: TYPE USING [CXIndex, CXRecord, HTIndex, HTNull, STIndex, STNull], SymbolOps: TYPE USING [SubStringForHash], Table: TYPE USING [Base, Limit], Time: TYPE USING [Append, Unpack], Tree: TYPE USING [Index, Link, NodeName, NullIndex, Scan], TreeOps: TYPE USING [ScanSons]; BcdDebug: PROGRAM IMPORTS Alloc, CharIO, SymbolOps, Time, TreeOps, data: BcdComData EXPORTS BcdControlDefs = { OPEN BcdDefs; tb, cxb, stb, mtb, lfb, rfb, tfb: Table.Base; etb, evb, itb, ctb, sgb, ftb, typb, tmb, ntb, spb, fpb: Table.Base; ssb: BcdOps.NameString; DebugNotify: Alloc.Notifier ~ { tb ← base[treetype]; stb ← base[sttype]; cxb ← base[cxtype]; ctb ← base[cttype]; mtb ← base[mttype]; lfb ← base[lftype]; rfb ← base[rftype]; tfb ← base[tftype]; etb ← base[exptype]; evb ← base[evtype]; itb ← base[imptype]; sgb ← base[sgtype]; ftb ← base[fttype]; typb ← base[typtype]; tmb ← base[tmtype]; ntb ← base[nttype]; ssb ← base[sstype]; spb ← base[sptype]; fpb ← base[fptype]}; SubString: TYPE ~ Strings.SubString; desc: Strings.SubStringDescriptor; ss: SubString ~ @desc; -- Utility Writes WriteChar: PROC [c: CHAR] ~ {CharIO.PutChar[data.errorStream, c]}; WriteString: PROC [s: Strings.String] ~ {CharIO.PutString[data.errorStream, s]}; WriteSubString: PROC [ss: SubString] ~ {CharIO.PutSubString[data.errorStream, ss]}; WriteName: PUBLIC PROC [n: NameRecord] ~ { ssd: Strings.SubStringDescriptor ← [base~@ssb.string, offset~n, length~ssb.size[n]]; WriteSubString[@ssd]}; WriteTime: PUBLIC PROC [t: LONG CARDINAL] ~ { s: STRING ← [20]; Time.Append[s, Time.Unpack[LOOPHOLE[t]]]; CharIO.PutString[data.errorStream, s]}; WriteCR: PROC ~ INLINE {WriteChar['\n]}; Indent: PROC [n: CARDINAL] ~ { WriteCR[]; THROUGH [1..n/8] DO WriteChar['\t] ENDLOOP; THROUGH [1..n MOD 8] DO WriteChar[' ] ENDLOOP}; -- annotated printing WriteDecimal: PROC [id: STRING, n: INTEGER] ~ { IF id # NIL THEN CharIO.PutString[data.errorStream, id]; CharIO.PutDecimal[data.errorStream, n]}; WriteOctal: PROC [id: STRING, n: UNSPECIFIED] ~ { IF id # NIL THEN CharIO.PutString[data.errorStream, id]; CharIO.PutOctal[data.errorStream, n]}; WriteIndex: PROC [id: STRING, index: UNSPECIFIED] ~ { IF id # NIL THEN CharIO.PutString[data.errorStream, id]; PrintIndex[index]}; -- Parse tree printing WriteNodeName: PROC [n: Tree.NodeName] ~ { NodePrintName: ARRAY Tree.NodeName OF STRING ~ [ "list"L, "item"L, "source"L, "config"L, "module"L, "assign"L, "plus"L, "then"L, "dot"L, "slash"L, "null"L]; WriteString[NodePrintName[n]]}; PrintSubTree: PROC [t: Tree.Link, nBlanks: CARDINAL] ~ { OPEN Tree; Printer: Tree.Scan ~ { Indent[nBlanks]; WITH s~~t SELECT FROM hash => PrintHti[s.index]; symbol => {PrintHti[stb[s.index].hti]; PrintIndex[s.index]}; subtree => { node: Tree.Index ~ s.index; IF node = Tree.NullIndex THEN WriteString["<empty>"L] ELSE { OPEN tb[node]; WriteNodeName[name]; PrintIndex[node]; SELECT name FROM $config => IF attr2 THEN WriteString[" (EXPORTS ALL)"L]; $module => IF attr2 THEN WriteString[IF attr1 THEN " (Code Links)"L ELSE " (Frame Links)"L]; $item => IF attr1 THEN WriteString[" (Code Links)"L]; ENDCASE; WriteDecimal[" ["L, info]; WriteChar[']]; nBlanks ← nBlanks + 2; TreeOps.ScanSons[s, Printer]; nBlanks ← nBlanks - 2}}; ENDCASE}; Printer[t]}; PrintTree: PUBLIC PROC [t: Tree.Link] ~ { (data.table).AddNotify[DebugNotify]; PrintSubTree[t, 0]; WriteCR[]; WriteCR[]; (data.table).DropNotify[DebugNotify]}; PrintHti: PROC [hti: Symbols.HTIndex] ~ { desc: Strings.SubStringDescriptor; s: SubString ~ @desc; IF hti = Symbols.HTNull THEN WriteString["(anonymous)"L] ELSE {SymbolOps.SubStringForHash[s, hti]; WriteSubString[s]}}; -- Context and semantic entry printing PrintSemanticEntries: PUBLIC PROC ~ { OPEN Symbols; cxLimit: CXIndex ~ (data.table).Top[cxtype]; FOR cxi: CXIndex ← CXIndex.FIRST, cxi+CXRecord.SIZE UNTIL cxi = cxLimit DO PrintContext[cxi]; WriteCR[] ENDLOOP}; PrintContext: PROC [cxi: Symbols.CXIndex] ~ { OPEN BcdDefs, Symbols; (data.table).AddNotify[DebugNotify]; WriteDecimal["Context: "L, LOOPHOLE[cxi]]; FOR sti: STIndex ← cxb[cxi].link, stb[sti].link UNTIL sti = STNull DO OPEN stb[sti]; Indent[2]; PrintHti[hti]; PrintIndex[sti]; IF filename THEN WriteString[", filename"L]; IF assigned THEN WriteString[", assigned"L]; IF imported THEN { WriteString[", imported"L]; IF impi # IMPNull THEN PrintIndex[impi]}; IF exported THEN WriteString[", exported"L]; WITH s~~stb[sti] SELECT FROM external => { WriteString[", external["L]; WITH m~~s.map SELECT FROM config => WriteIndex["config"L, m.cti]; module => WriteIndex["module"L, m.mti]; interface => WriteIndex["interface"L, m.expi]; ENDCASE; WITH p~~s SELECT FROM file => WriteIndex[", file"L, p.fti]; instance => WriteIndex[", instance"L, p.sti]; ENDCASE; WriteChar[']]}; local => { WriteIndex[", local"L, s.info]; WITH m~~s.map SELECT FROM config => WriteIndex["config"L, m.cti]; ENDCASE; WriteIndex[", context"L, s.context]}; unknown => WriteString[", unknown[]"L]; ENDCASE; ENDLOOP; (data.table).DropNotify[DebugNotify]; WriteCR[]}; -- Bcd table printing PrintBcd: PUBLIC PROC ~ { PrintConfigs[]; PrintImports[]; PrintExports[]; PrintExpVars[]; PrintTypes[]; PrintTypeMap[]; PrintModules[]; PrintFiles[]}; PrintConfigs: PUBLIC PROC ~ { cti: CTIndex ← CTIndex.FIRST; ctLimit: CTIndex ~ (data.table).Top[cttype]; (data.table).AddNotify[DebugNotify]; WriteString["\nConfigurations:"L]; UNTIL cti = ctLimit DO PrintConfig[cti]; cti ← cti + (CTRecord.SIZE+ctb[cti].nControls*ControlItem.SIZE); ENDLOOP; WriteCR[]; (data.table).DropNotify[DebugNotify]}; PrintConfig: PUBLIC PROC [cti: CTIndex] ~ { OPEN ctb[cti]; (data.table).AddNotify[DebugNotify]; Indent[2]; WriteName[name]; PrintIndex[cti]; IF namedInstance THEN { WriteString[", instance: "L]; WriteNameFromTable[[config[cti]]]}; WriteString[", file: "L]; PrintFileName[file]; PrintIndex[file]; IF config # CTNull THEN { WriteString[", parent: "L]; WriteName[ctb[config].name]; PrintIndex[config]}; IF nControls # 0 THEN { WriteString[", controls: ["L]; FOR i: CARDINAL IN [0..nControls) DO WITH c~~controls[i] SELECT FROM module => WriteName[mtb[c.mti].name]; config => {WriteName[ctb[c.cti].name]; WriteChar['*]}; ENDCASE => ERROR; PrintIndex[controls[i]]; WriteString[IF i # nControls-1 THEN ", "L ELSE "]"L]; ENDLOOP}; (data.table).DropNotify[DebugNotify]}; PrintImports: PUBLIC PROC ~ { iti: IMPIndex ← IMPIndex.FIRST; impLimit: IMPIndex ~ (data.table).Top[imptype]; WriteString["\nImports:"L]; UNTIL iti = impLimit DO PrintImport[iti]; iti ← iti + IMPRecord.SIZE ENDLOOP; WriteCR[]}; PrintImport: PUBLIC PROC [iti: IMPIndex] ~ { OPEN itb[iti]; (data.table).AddNotify[DebugNotify]; Indent[2]; WriteName[name]; PrintIndex[iti]; SELECT port FROM $module => WriteString[" (module)"L]; ENDCASE; IF namedInstance THEN { WriteString[", instance: "L]; WriteNameFromTable[[import[iti]]]}; WriteString[", version: "L]; PrintFileVersion[file]; PrintIndex[file]; WriteDecimal[", gfi: "L, gfi]; WriteDecimal[", ngfi: "L, ngfi]; (data.table).DropNotify[DebugNotify]}; PrintExports: PUBLIC PROC ~ { eti: EXPIndex ← EXPIndex.FIRST; expLimit: EXPIndex ~ (data.table).Top[exptype]; WriteString["\nExports:"L]; UNTIL eti = expLimit DO PrintExport[eti]; eti ← eti + etb[eti].size+EXPRecord.SIZE ENDLOOP; WriteCR[]}; PrintExport: PUBLIC PROC [eti: EXPIndex] ~ { OPEN etb[eti]; (data.table).AddNotify[DebugNotify]; Indent[2]; WriteName[name]; PrintIndex[eti]; IF port = module THEN WriteString[" [module]"L]; IF namedInstance THEN { WriteString[", instance: "L]; WriteNameFromTable[[export[eti]]]}; WriteString[", file: "L]; PrintFileVersion[file]; PrintIndex[file]; WriteDecimal[", size: "L, size]; WriteString[", links:"L]; FOR i: CARDINAL IN [0..size) DO IF i MOD 8 = 0 THEN Indent[4] ELSE WriteChar[' ]; PrintControlLink[links[i]]; IF i+1 # size THEN WriteChar[',]; ENDLOOP; (data.table).DropNotify[DebugNotify]}; PrintExpVars: PUBLIC PROC ~ { evi: EVIndex ← EVIndex.FIRST; evLimit: EVIndex ~ (data.table).Top[evtype]; WriteString["\nExported variables:"L]; UNTIL evi = evLimit DO PrintExpVar[evi]; evi ← evi + evb[evi].length+EVRecord.SIZE ENDLOOP; WriteCR[]}; PrintExpVar: PUBLIC PROC [evi: EVIndex] ~ { OPEN evb[evi]; (data.table).AddNotify[DebugNotify]; Indent[2]; PrintIndex[evi]; WriteDecimal[", length: "L, length]; WriteString[", offsets:\n"L]; FOR i: CARDINAL IN [1..length] DO IF i MOD 8 = 1 THEN Indent[4] ELSE WriteChar[' ]; WriteOctal[NIL, offsets[i]]; IF i # length THEN WriteChar[',]; ENDLOOP; (data.table).DropNotify[DebugNotify]}; PrintTypes: PUBLIC PROC ~ { typi: TYPIndex ← TYPIndex.FIRST; typLimit: TYPIndex ~ (data.table).Top[typtype]; WriteString["\nExported types:"L]; UNTIL typi = typLimit DO PrintType[typi]; typi ← typi + TYPRecord.SIZE ENDLOOP; WriteCR[]}; PrintType: PUBLIC PROC [typi: TYPIndex] ~ { OPEN typb[typi]; (data.table).AddNotify[DebugNotify]; Indent[2]; PrintIndex[typi]; WriteDecimal[", id: "L, id]; WriteString[", from: "L]; PrintVersion[version]; (data.table).DropNotify[DebugNotify]}; PrintTypeMap: PUBLIC PROC ~ { tmi: TMIndex ← TMIndex.FIRST; tmLimit: TMIndex ~ (data.table).Top[tmtype]; WriteString["\nType map:"L]; UNTIL tmi = tmLimit DO PrintMapEntry[tmi]; tmi ← tmi + TMRecord.SIZE ENDLOOP; WriteCR[]}; PrintMapEntry: PUBLIC PROC [tmi: TMIndex] ~ { OPEN tmb[tmi]; (data.table).AddNotify[DebugNotify]; Indent[2]; PrintIndex[tmi]; WriteDecimal[", entry: "L, offset]; WriteString[", in: "L]; PrintVersion[version]; WriteIndex[", mapped to: "L, map]; (data.table).DropNotify[DebugNotify]}; PrintSpaces: PUBLIC PROC ~ { spi: SPIndex ← SPIndex.FIRST; spLimit: SPIndex ~ (data.table).Top[sptype]; WriteString["\nSpaces:"L]; UNTIL spi = spLimit DO PrintSpace[spi]; spi ← spi + spb[spi].length+SPRecord.SIZE ENDLOOP; WriteCR[]}; PrintSpace: PUBLIC PROC [spi: SPIndex] ~ { OPEN spb[spi]; (data.table).AddNotify[DebugNotify]; Indent[2]; PrintIndex[spi]; WriteIndex[", segment: "L, seg]; WriteDecimal[", length: "L, length]; FOR i: CARDINAL IN [0..length) DO Indent[4]; IF spaces[i].resident THEN WriteString[", resident"L]; WriteOctal[", offset: "L, spaces[i].offset]; WriteDecimal[", pages: "L, spaces[i].pages]; WriteCR[]; ENDLOOP; (data.table).DropNotify[DebugNotify]}; PrintModules: PUBLIC PROC ~ { mti: MTIndex ← MTIndex.FIRST; mtLimit: MTIndex ~ (data.table).Top[mttype]; WriteString["\nModules:"L]; UNTIL mti = mtLimit DO PrintModule[mti]; mti ← mti + (WITH m~~mtb[mti] SELECT FROM direct => MTRecord.direct.SIZE + m.length*Link.SIZE, indirect => MTRecord.indirect.SIZE, multiple => MTRecord.multiple.SIZE, ENDCASE => ERROR); ENDLOOP; WriteCR[]}; PrintModule: PUBLIC PROC [mti: MTIndex] ~ { OPEN mtb[mti]; (data.table).AddNotify[DebugNotify]; Indent[2]; WriteName[name]; PrintIndex[mti]; IF namedInstance THEN { WriteString["instance: "L]; WriteNameFromTable[[module[mti]]]}; WriteString[", file: "L]; PrintFileName[file]; WriteChar[' ]; PrintFileVersion[file]; PrintIndex[file]; IF config # CTNull THEN { WriteString[", config: "L]; WriteName[ctb[config].name]; PrintIndex[config]}; Indent[4]; WriteDecimal["framesize: "L, framesize]; WriteDecimal[", gfi: "L, gfi]; WriteDecimal[", ngfi: "L, ngfi]; WriteString[", links: "L]; WriteString[IF linkLoc=frame THEN "frame"L ELSE "code"L]; Indent[4]; WriteString["code: "L]; PrintSegment[code.sgi]; WriteOctal[", offset: "L, code.offset]; WriteOctal[", length: "L, code.length]; IF code.linkspace THEN WriteString[", space available for links"L]; Indent[4]; WriteString["symbols: "L]; PrintSegment[sseg]; IF variables # EVNull THEN {Indent[4]; WriteIndex["variables: "L, variables]}; WITH m~~mtb[mti] SELECT FROM direct => { Indent[4]; WriteDecimal["number of links (direct): "L, m.length]; WriteString[", control links:"L]; FOR i: CARDINAL IN [0..m.length) DO IF i MOD 8 = 0 THEN Indent[6] ELSE WriteChar[' ]; PrintControlLink[m.frag[i]]; IF i+1 # m.length THEN WriteChar[',]; ENDLOOP}; indirect => IF m.links # LFNull THEN PrintLinkFrag[m.links]; multiple => { IF m.links # LFNull THEN PrintLinkFrag[m.links]; IF m.refLiterals # RFNull THEN PrintRefLitFrag[m.refLiterals]; IF m.types # TFNull THEN PrintTypeFrag[m.types]}; ENDCASE; (data.table).DropNotify[DebugNotify]}; PrintLinkFrag: PROC [lfi: LFIndex] ~ { Indent[4]; WriteDecimal["number of links (indirect): "L, lfb[lfi].length]; WriteString[", control links:"L]; FOR i: CARDINAL IN [0..lfb[lfi].length) DO IF i MOD 8 = 0 THEN Indent[6] ELSE WriteChar[' ]; PrintControlLink[lfb[lfi].frag[i]]; IF i+1 # lfb[lfi].length THEN WriteChar[',]; ENDLOOP}; PrintRefLitFrag: PROC [rfi: RFIndex] ~ { Indent[4]; WriteDecimal["number of atoms: "L, rfb[rfi].length]; WriteString[", atom and REF literal links:"L]; FOR i: CARDINAL IN [0..rfb[rfi].length) DO IF i MOD 8 = 0 THEN Indent[6] ELSE WriteChar[' ]; WriteDecimal[NIL, rfb[rfi].frag[i]]; IF i+1 # rfb[rfi].length THEN WriteChar[',]; ENDLOOP}; PrintTypeFrag: PROC [tfi: TFIndex] ~ { Indent[4]; WriteDecimal["number of types: "L, tfb[tfi].length]; WriteString[", type codes:"L]; FOR i: CARDINAL IN [0..tfb[tfi].length) DO IF i MOD 8 = 0 THEN Indent[6] ELSE WriteChar[' ]; WriteDecimal[NIL, tfb[tfi].frag[i]]; IF i+1 # tfb[tfi].length THEN WriteChar[',]; ENDLOOP}; PrintSegment: PUBLIC PROC [sgi: SGIndex] ~ { OPEN sd~~sgb[sgi]; PrintFileName[sd.file]; WriteDecimal[" [base: "L, sd.base]; WriteDecimal[", pages: "L, sd.pages]; IF sd.extraPages # 0 THEN WriteDecimal["+"L, sd.extraPages]; WriteChar[']]}; PrintFiles: PUBLIC PROC ~ { fti: FTIndex ← FTIndex.FIRST; ftLimit: FTIndex ~ (data.table).Top[fttype]; WriteString["\nFiles:"L]; UNTIL fti = ftLimit DO PrintFile[fti]; fti ← fti + FTRecord.SIZE ENDLOOP; WriteCR[]}; PrintFile: PUBLIC PROC [fti: FTIndex] ~ { OPEN ftb[fti]; (data.table).AddNotify[DebugNotify]; Indent[2]; WriteName[name]; PrintIndex[fti]; WriteString[", version: "L]; PrintFileVersion[fti]; (data.table).DropNotify[DebugNotify]}; -- Utility Prints PrintControlLink: PROC [link: BcdDefs.Link] ~ { SELECT TRUE FROM link.proc => {WriteDecimal["proc["L, link.gfi]; WriteDecimal[","L, link.ep]}; link.type => {WriteString["type["L]; PrintIndex[link.typeID]}; ENDCASE => {WriteDecimal["var["L, link.vgfi]; WriteDecimal[","L, link.var]}; WriteChar[']]}; PrintFileName: PROC [fti: FTIndex] ~ { SELECT fti FROM FTNull => WriteString["(null)"L]; FTSelf => WriteString["(self)"L]; ENDCASE => WriteName[ftb[fti].name]}; PrintFileVersion: PROC [fti: FTIndex] ~ INLINE {PrintVersion[ftb[fti].version]}; PrintVersion: PROC [version: VersionStamp] ~ { WriteChar['(]; IF version.time = 0 THEN WriteString["<null version>"L] ELSE { StampWords: CARDINAL ~ VersionStamp.SIZE; str: PACKED ARRAY [0..4*StampWords) OF [0..16) ~ LOOPHOLE[version]; digit: STRING ~ "0123456789abcdef"L; WriteChar['"]; FOR i: NAT IN [0..4*StampWords) DO WriteChar[digit[str[i]]] ENDLOOP; WriteChar['"]}; WriteChar[')]}; PrintIndex: PROC [index: UNSPECIFIED] ~ { WriteChar['[]; IF index = Table.Limit-1 THEN WriteString["Null"L] ELSE CharIO.PutDecimal[data.errorStream, index]; WriteChar[']]}; WriteNameFromTable: PROC [n: Namee] ~ { ntLimit: NTIndex ~ (data.table).Top[nttype]; FOR nti: NTIndex ← NTIndex.FIRST, nti + NTRecord.SIZE UNTIL nti = ntLimit DO IF ntb[nti].item = n THEN {WriteName[ntb[nti].name]; EXIT}; ENDLOOP}; -- Relocation printing PrintRelocations: PUBLIC PROC [relHead: BcdBindDefs.RelocHandle] ~ { WriteString["\nRelocations:"L]; FOR rel: BcdBindDefs.RelocHandle ← relHead, rel.link UNTIL rel = NIL DO PrintRel[rel] ENDLOOP; WriteCR[]}; PrintRel: PUBLIC PROC [rel: BcdBindDefs.RelocHandle] ~ { RelType: ARRAY BcdBindDefs.RelocType OF STRING ~ [ outer:"outer"L, inner:"inner"L, file:"file "L]; mti: MTIndex; (data.table).AddNotify[DebugNotify]; Indent[2]; WriteString[RelType[rel.type]]; IF rel.import < CARDINAL[rel.importLimit-IMPIndex.FIRST] THEN { WriteDecimal[" imports: ["L, rel.import]; WriteDecimal[".."L, (rel.importLimit-IMPIndex.FIRST)-IMPRecord.SIZE]; WriteString["],"L]}; WriteDecimal[" context: "L, LOOPHOLE[rel.context]]; IF rel.type = file AND (mti ← rel.module+MTIndex.FIRST) # MTNull THEN { WriteString[", module: "L]; WriteName[mtb[mti].name]; PrintIndex[mti]}; WriteDecimal[", firstgfi: "L, LOOPHOLE[rel.firstgfi]]; WriteDecimal[", lastgfi: "L, LOOPHOLE[rel.lastgfi]]; WriteDecimal[", dummygfi: "L, LOOPHOLE[rel.dummygfi]]; WriteDecimal[", orig1stdummy: "L, LOOPHOLE[rel.originalfirstdummy]]; (data.table).DropNotify[DebugNotify]}; }.