<> <> <> <> DIRECTORY Basics USING [BITOR, BYTE], BasicTime USING [FromPupTime, GMT, nullGMT], BcdDefs USING [BCD, MTIndex, MTRecord, SGRecord], CatchFormat, CodeLister USING [], ConvertUnsafe USING [SubString, SubStringToRope, ToRope], FS USING [Error, Open, OpenFile, StreamFromOpenFile], IO USING [Close, EndOfStream, GetChar, PutChar, PutF, PutRope, SetIndex, STREAM], ListerUtils USING [GetOpCodeArray, OpCodeArray, PrintSei, PrintSubString, ReadMtr, ReadSgr, RefBCD, WithSegment], PrincOps, Rope, RuntimeError USING [UNCAUGHT], Symbols USING [Base, BodyInfo, BTIndex, BTNull, CBTIndex, HTIndex, HTNull, ISEIndex, ISENull, SEIndex, SENull], SymbolSegment USING [FGTEntry], SymbolTable USING [Base]; CodeListerImpl: PROGRAM IMPORTS Basics, BasicTime, ConvertUnsafe, FS, IO, ListerUtils, Rope, RuntimeError EXPORTS CodeLister = BEGIN OPEN PrincOps; BCD: TYPE = BcdDefs.BCD; BodyInfo: TYPE = Symbols.BodyInfo; BTIndex: TYPE = Symbols.BTIndex; BTNull: BTIndex = Symbols.BTNull; BYTE: TYPE = Basics.BYTE; CBTIndex: TYPE = Symbols.CBTIndex; CSegPrefix: TYPE = PrincOps.CSegPrefix; FGTEntry: TYPE = SymbolSegment.FGTEntry; HTIndex: TYPE = Symbols.HTIndex; HTNull: HTIndex = Symbols.HTNull; ISEIndex: TYPE = Symbols.ISEIndex; ISENull: ISEIndex = Symbols.ISENull; MTIndex: TYPE = BcdDefs.MTIndex; MTRecord: TYPE = BcdDefs.MTRecord; nullSource: INT = INT.LAST; OpCode: TYPE = BYTE; RefBCD: TYPE = REF BCD; RefMTRecord: TYPE = REF MTRecord; RefSGRecord: TYPE = REF SGRecord; ROPE: TYPE = Rope.ROPE; SEIndex: TYPE = Symbols.SEIndex; SENull: SEIndex = Symbols.SENull; SGRecord: TYPE = BcdDefs.SGRecord; STREAM: TYPE = IO.STREAM; SubString: TYPE = ConvertUnsafe.SubString; SymbolTableBase: TYPE = SymbolTable.Base; JumpOp: TYPE = [PrincOps.zJ2..PrincOps.zJIW]; FineGrainInfo: TYPE = RECORD [ firstSource, lastSource: INT _ nullSource, pc: CARDINAL, procEnd: BOOL, bti: Symbols.CBTIndex]; FGT: TYPE = RECORD [ length: NAT, info: SEQUENCE maxLength: NAT OF FineGrainInfo]; FGHandle: TYPE = REF FGT; DigestFGT: PROC [stb: SymbolTableBase, cspp: LONG BASE POINTER TO CSegPrefix] RETURNS [myFGT: FGHandle _ NIL] = { bti, prev: BTIndex; catchEV: CatchFormat.CatchEV ~ LOOPHOLE[cspp.entry[cspp.header.nEntries]/2]; catchEntry: CatchFormat.CatchEVHandle ~ @cspp[catchEV]; AddMyEntry: PROC [ source: INT_nullSource, object: CARDINAL, procEnd: BOOL_FALSE] = { IF n = myFGTSize THEN { oldFGT: FGHandle _ myFGT; myFGTSize _ myFGTSize + myFGTSize/2 + 16; myFGT _ NEW[FGT[myFGTSize]]; IF oldFGT # NIL THEN FOR i: NAT IN [0..oldFGT.maxLength) DO myFGT[i] _ oldFGT[i] ENDLOOP; }; myFGT[n] _ [firstSource: source, pc: object, procEnd: procEnd, bti: LOOPHOLE[bti]]; myFGT.length _ n _ n + 1; }; AddBodyFGT: PROC [bti: Symbols.CBTIndex] = { procstart: CARDINAL ~ WITH body~~stb.bb[bti] SELECT FROM Catch => catchEntry[body.index], ENDCASE => cspp.entry[body.entryIndex].pc; info: BodyInfo[External] = NARROW[stb.bb[bti].info, BodyInfo[External]]; fgLast: CARDINAL = info.startIndex + info.indexLength - 1; lastSource: INT _ stb.bb[bti].sourceIndex; lastObject: CARDINAL _ procstart; FOR i: CARDINAL IN [info.startIndex..fgLast] DO f: FGTEntry = stb.fgTable[i]; WITH f SELECT FROM normal => { lastSource _ lastSource + deltaSource; lastObject _ lastObject + deltaObject; AddMyEntry[source: lastSource, object: lastObject]}; step => IF which = $source THEN lastSource _ lastSource + delta ELSE lastObject _ lastObject + delta; ENDCASE; ENDLOOP; AddMyEntry[object: procstart + info.bytes, procEnd: TRUE]; }; BySource: PROC [r1, r2: LONG POINTER TO FineGrainInfo] RETURNS [BOOL] = { IF r1.firstSource > r2.firstSource THEN RETURN [TRUE]; IF r1.firstSource = r2.firstSource THEN RETURN [r1.pc > r2.pc]; RETURN [FALSE]; }; ByPC: PROC [r1, r2: LONG POINTER TO FineGrainInfo] RETURNS [BOOL] = { IF r1.pc > r2.pc THEN RETURN [TRUE]; IF r1.pc < r2.pc THEN RETURN [FALSE]; IF r1.procEnd THEN RETURN [FALSE]; IF r2.procEnd THEN RETURN [TRUE]; RETURN [r1.firstSource > r2.firstSource]; }; Sort: PROC [ n: CARDINAL, greater: PROC [r1, r2: LONG POINTER TO FineGrainInfo] RETURNS [BOOL]] = { i: CARDINAL; temp: FineGrainInfo; SiftUp: PROC [l, u: CARDINAL] = { s: CARDINAL; key: FineGrainInfo _ myFGT[l-1]; DO s _ l*2; IF s > u THEN EXIT; IF s < u AND greater[@myFGT[s+1-1], @myFGT[s-1]] THEN s _ s+1; IF greater[@key, @myFGT[s-1]] THEN EXIT; myFGT[l-1] _ myFGT[s-1]; l _ s; ENDLOOP; myFGT[l-1] _ key}; FOR i DECREASING IN [2..n/2] DO SiftUp[i, n]; ENDLOOP; FOR i DECREASING IN [2..n] DO SiftUp[1, i]; temp _ myFGT[1-1]; myFGT[1-1] _ myFGT[i-1]; myFGT[i-1] _ temp; ENDLOOP}; n: CARDINAL _ 0; myFGTSize: CARDINAL _ (3*stb.fgTable.LENGTH)/2; myFGT _ NEW[FGT[myFGTSize]]; bti _ BTIndex.FIRST; IF stb.bb[bti].sourceIndex # 0 THEN AddMyEntry[source: 0, object: cspp.entry[0].pc]; DO WITH stb.bb[bti] SELECT FROM Callable => IF ~inline THEN AddBodyFGT[LOOPHOLE[bti]]; ENDCASE; IF stb.bb[bti].firstSon # BTNull THEN bti _ stb.bb[bti].firstSon ELSE DO prev _ bti; bti _ stb.bb[bti].link.index; IF bti = BTNull THEN GO TO Done; IF stb.bb[prev].link.which # $parent THEN EXIT; ENDLOOP; REPEAT Done => NULL; ENDLOOP; Sort[n, BySource]; FOR i: CARDINAL DECREASING IN [0..n - 1) DO IF myFGT[i].firstSource = nullSource THEN LOOP; IF myFGT[i].firstSource = myFGT[i+1].firstSource THEN { myFGT[i].lastSource _ myFGT[i+1].lastSource; myFGT[i+1].firstSource _ myFGT[i+1].lastSource; } ELSE myFGT[i].lastSource _ myFGT[i + 1].firstSource; ENDLOOP; Sort[n, ByPC]; }; ListCode: PUBLIC PROC [out,inStream: STREAM, stb: SymbolTableBase, bcd: RefBCD, pattern: ROPE] = { myFGT: FGHandle _ NIL; offset: CARDINAL; codebase: LONG POINTER; codepages: CARDINAL; Tinst, Tbytes, Pinst, Pbytes: CARDINAL _ 0; source: STREAM _ NIL; EscName: PROC [b: BYTE] RETURNS [ROPE] = {RETURN [NIL]}; SddName: PROC [b: BYTE] RETURNS [ROPE] = {RETURN [NIL]}; OutCheck: PROC [xfirst: INT, xlast: INT] = { nextchar: CHAR; lastcr: INT; IF source = NIL THEN RETURN; FOR lastcr _ xfirst, lastcr - 1 UNTIL lastcr = 0 DO IO.SetIndex[source, lastcr]; IF IO.GetChar[source] = '\n THEN EXIT; ENDLOOP; THROUGH (lastcr..xfirst) DO IO.PutChar[out, ' ] ENDLOOP; IO.SetIndex[source, xfirst]; WHILE xfirst # xlast DO nextchar _ IO.GetChar[source ! IO.EndOfStream => EXIT]; xfirst _ xfirst + 1; IO.PutChar[out, nextchar]; ENDLOOP; IF nextchar # '\n THEN IO.PutChar[out, '\n]; }; SetUpSource: PROC = { sourceName: ROPE _ ConvertUnsafe.ToRope[stb.sourceFile]; sourceTime: BasicTime.GMT _ BasicTime.nullGMT; sourceFile: FS.OpenFile; sourceTime _ BasicTime.FromPupTime[stb.stHandle.sourceVersion.time ! RuntimeError.UNCAUGHT => GO TO nope]; sourceFile _ FS.Open[name: sourceName, wantedCreatedTime: sourceTime ! FS.Error => IF error.group # bug THEN GO TO nope]; source _ FS.StreamFromOpenFile[sourceFile]; EXITS nope => {}; }; CloseSource: PROC = { IF source # NIL THEN IO.Close[source]; }; FilterBody: PROC [bti: CBTIndex, key: ROPE] RETURNS [BOOL_TRUE] = { IF key # NIL THEN { flat: ROPE = Rope.Flatten[key]; sei: ISEIndex = stb.bb[bti].id; hti: HTIndex; d1: SubString; IF sei = SENull OR (hti _ stb.seb[sei].hash) = HTNull THEN RETURN [FALSE]; d1 _ stb.SubStringForName[hti]; RETURN [Rope.Match[flat, ConvertUnsafe.SubStringToRope[d1], FALSE]]; }; }; PrintBodyName: PROC [bti: Symbols.CBTIndex] = { IF source = NIL THEN { sei: ISEIndex = stb.bb[bti].id; hti: HTIndex; IF sei # Symbols.SENull AND (hti _ stb.seb[sei].hash) # HTNull THEN { ss: SubString = stb.SubStringForName[hti]; ListerUtils.PrintSubString[ss, out]; IO.PutRope[out, ":\n"]; }; }; }; EvenUp: PROC [n: CARDINAL] RETURNS [CARDINAL] = INLINE { <> RETURN [n + n MOD 2]; }; GetByte: PROC [pc: CARDINAL] RETURNS [BYTE] = { <> w: LONG POINTER TO PrincOps.InstWord = codebase + pc/2; RETURN [IF pc MOD 2 = 0 THEN w.evenbyte ELSE w.oddbyte]; }; GetWord: PROC [pc: CARDINAL] RETURNS [INTEGER] = { <> RETURN [LOOPHOLE[(codebase + pc)^, INTEGER]]; }; JumpAddress: PROC [jop: OpCode, arg: INTEGER] RETURNS [CARDINAL] = { <> SELECT instArray[jop].length FROM 1 => SELECT jop FROM IN [zJ2..zJ4] => arg _ jop - zJ2 + 2; zJ6 => arg _ 6; zJ8 => arg _ 8; IN [zJZ3..zJZ4] => arg _ jop - zJZ3 + 3; IN [zJNZ3..zJNZ4] => arg _ jop - zJNZ3 + 3; ENDCASE => ERROR; 2 => SELECT jop FROM zJEP, zJNEP => arg _ arg MOD 16 + 4 - 1; ENDCASE => BEGIN IF arg > 177B THEN arg _ Basics.BITOR[arg, 177400B]; arg _ arg - 1; END; ENDCASE => { SELECT jop FROM zJEBB, zJNEBB => IF arg > 177B THEN arg _ Basics.BITOR[arg, 177400B]; ENDCASE; arg _ arg - 2}; RETURN [offset + LOOPHOLE[arg, CARDINAL]]; }; OutWJTab: PROC [tabstart, tablength: CARDINAL] = { Pbytes _ Pbytes + tablength*2; FOR pc: CARDINAL IN [tabstart..tabstart + tablength) DO w: INTEGER = GetWord[pc]; IO.PutF[out, "\n\t\t\t\t (%b)", [cardinal[JumpAddress[PrincOps.zJIW, w]]]]; ENDLOOP; }; OutBJTab: PROC [tabstart, tablength: CARDINAL] = { Pbytes _ Pbytes + EvenUp[tablength]; FOR pc: CARDINAL IN [tabstart*2..tabstart*2 + tablength) DO b: BYTE = GetByte[pc]; IO.PutF[out, "\n\t\t\t\t (%b)", [cardinal[JumpAddress[PrincOps.zJIB, b]]]]; ENDLOOP; }; PutPair: PROC [byte: CARDINAL] = { a: CARDINAL = byte/16; b: CARDINAL = byte MOD 16; IF a < 8 AND b < 8 THEN IO.PutChar[out, ' ]; IO.PutF[out, "[%b,%b]",[cardinal[a]],[cardinal[b]]]; }; PrintCode: PROC [ startcode, endcode: CARDINAL, wideCatch: BOOL] = { <> lastConstant: INTEGER; FOR offset IN [startcode..endcode) DO inst: BYTE = GetByte[offset]; il: [0..3] = instArray[inst].length; <> Pinst _ Pinst + 1; IO.PutF[out, "\t%b", [integer[offset/2]]]; IO.PutRope[out, (IF offset MOD 2 = 0 THEN ",E " ELSE ",O ")]; IO.PutF[out, "%b:\t[%b]\t", [integer[offset]], [integer[inst]]]; IF inst < 100B THEN IO.PutChar[out, '\t]; IF wideCatch AND offset = startcode+1 THEN { IO.PutF[out, "%b\t", [integer[inst]]]; LOOP}; IO.PutRope[out, instArray[inst].name]; SELECT il FROM 0, 1 => { Pbytes _ Pbytes + 1; IF inst IN [zLI0..zLI10] THEN lastConstant _ inst - zLI0 ELSE IF inst = zLID0 THEN lastConstant _ 0 ELSE IF inst IN JumpOp THEN IO.PutF[out, "\t (%b)", [integer[JumpAddress[inst, 0]]]]; }; 2 => { byte: BYTE ~ GetByte[(offset _ offset + 1)]; Pbytes _ Pbytes + 2; IO.PutChar[out, '\t]; SELECT inst FROM zRLIP, zRLILP, zRLDIP, zRLDILP, zRGIP, zRGILP, zWLIP, zWLILP, zWLDILP, zR0F, zRL0F, zW0F, zWS0F, zPS0F, zJEP, zJNEP => PutPair[byte]; zESC => IO.PutF[out, "%b\t%g", [cardinal[byte]], [rope[EscName[byte]]]]; zKFCB => IO.PutF[out, "%b\t%g", [cardinal[byte]], [rope[SddName[byte]]]]; ENDCASE => IO.PutF[out, "%b", [cardinal[byte]]]; SELECT inst FROM zLIB => lastConstant _ byte; IN JumpOp => IO.PutF[out, " (%b)", [integer[JumpAddress[inst, byte]]]]; ENDCASE; }; 3 => { ab: RECORD [first, second: BYTE]; Pbytes _ Pbytes + 3; ab.first _ GetByte[(offset _ offset + 1)]; ab.second _ GetByte[(offset _ offset + 1)]; IO.PutChar[out, '\t]; SELECT inst FROM zRF, zWF, zRLF, zWLF, zPSF, zPSLF => { IO.PutF[out, "%b, ", [integer[ab.first]]]; PutPair[ab.second]}; ENDCASE => { v: INTEGER; SELECT inst FROM zRLIPF, zRLILPF => { PutPair[ab.first]; IO.PutRope[out, ", "]; PutPair[ab.second]}; zJEBB, zJNEBB => { IO.PutF[out, "%b, %b", [integer[ab.first]], [integer[ab.second]]]; v _ ab.second}; zESCL => IO.PutF[ out, "%b\t%g", [integer[ab.first]], [rope[EscName[ab.second]]]]; ENDCASE => IO.PutF[out, "%b", [integer[v _ ab.first*256 + ab.second]]]; SELECT inst FROM zJIB => OutBJTab[v, lastConstant]; zJIW => OutWJTab[v, lastConstant]; zLIW => lastConstant _ v; IN JumpOp => IO.PutF[out, " (%b)", [integer[JumpAddress[inst, v]]]]; ENDCASE}}; ENDCASE; IO.PutChar[out, '\n]; ENDLOOP; }; ShowEntryVectors: PROC ~ { cspp: CatchFormat.Codebase ~ codebase; <> <> <> <> catchEV: CARDINAL = LOOPHOLE[cspp.entry[cspp.header.nEntries]/2]; catchEntry: CatchFormat.CatchEVHandle = LOOPHOLE[cspp + catchEV]; IO.PutRope[out, "Entry Vector: evi [bytePC]\n"]; FOR evi: CARDINAL IN [0..cspp.header.nEntries) DO IO.PutF[out, " %d [%b]\n", [integer[evi]], [integer[cspp.entry[evi]]]]; ENDLOOP; IO.PutRope[out, "\nCatch Entry Vector: cevi [bytePC]\n"]; IF catchEV = 0 THEN IO.PutRope[out, " None"] ELSE FOR cevi: CARDINAL IN [0..catchEntry.count) DO IO.PutF[out, " %d [%b]\n", [integer[cevi]], [integer[catchEntry[cevi]]]]; ENDLOOP; IO.PutRope[out, "\n\n"]}; ShowEnableTable: PROC ~ { cspp: CatchFormat.Codebase ~ codebase; <> <> <> <> catchEV: CARDINAL = LOOPHOLE[cspp.entry[cspp.header.nEntries]/2]; catchEntry: CatchFormat.CatchEVHandle = LOOPHOLE[cspp + catchEV]; <> outerET: CatchFormat.EnableHandle ~ LOOPHOLE[catchEntry + CatchFormat.CatchEVBody[catchEntry.count].SIZE]; PrintEnableEntries: PROC [firstPC, lastPC, level: CARDINAL] ~ { et: CatchFormat.EnableHandle _ outerET; i: CARDINAL; FOR i IN [0..level) DO et _ et + CatchFormat.EnableTableBody[et.count].SIZE; ENDLOOP; FOR i IN [0..et.count) DO start: CARDINAL ~ et[i].start; end: CARDINAL ~ (et[i].start + et[i].length - 1); IF firstPC <= start AND end <= lastPC THEN { FOR j: CARDINAL IN [0..level] DO IO.PutRope[out, " "]; ENDLOOP; IO.PutF[out, "[%b..%b] %d\n", [integer[start]], [integer[end]], [integer[et[i].index]]]; IF et[i].alsoNested THEN PrintEnableEntries[firstPC~start, lastPC~end, level~(level+1)]}; ENDLOOP}; IF catchEV = 0 THEN RETURN; IO.PutRope[out, "Enable Items: [firstPC..lastPC] catchIndex\n"]; PrintEnableEntries[firstPC~0, lastPC~NAT.LAST, level~0]; IO.PutChar[out, '\n]}; ShowTotals: PROC = { IO.PutF[ out, "Instructions: %g, Bytes: %g\n\n", [integer[Pinst]], [integer[Pbytes _ EvenUp[Pbytes]]]]; Tinst _ Tinst + Pinst; Pinst _ 0; Tbytes _ Tbytes + Pbytes; Pbytes _ 0; }; <> mti: BcdDefs.MTIndex _ LOOPHOLE[0]; prevBti: BTIndex _ BTNull; mtr: RefMTRecord = ListerUtils.ReadMtr[inStream, bcd, mti]; sgr: RefSGRecord = ListerUtils.ReadSgr[inStream, bcd, mtr.code.sgi]; crossJumped: BOOL = mtr.crossJumped; framesize: CARDINAL = mtr.framesize; codeOffset: CARDINAL = mtr.code.offset; instArray: ListerUtils.OpCodeArray = ListerUtils.GetOpCodeArray[]; inner: PROC [base: LONG POINTER] = { print: BOOL _ FALSE; procFirst: CARDINAL _ 0; cspp: LONG POINTER TO PrincOps.CSegPrefix; wideCatch: BOOL _ FALSE; codebase _ base + codeOffset; codepages _ sgr.pages; cspp _ codebase; IF crossJumped THEN IO.PutRope[out, "Cross jumped\n"]; IO.PutF[out, "Global frame size: %g\n\n", [integer[framesize]]]; IF ~Rope.Equal[pattern, "*"] THEN {ShowEntryVectors[]; ShowEnableTable[]}; Tbytes _ Tinst _ 0; myFGT _ DigestFGT[stb, codebase]; SetUpSource[]; FOR i: CARDINAL IN [0..myFGT.length) DO ff: FineGrainInfo = myFGT[i]; IF ff.bti # prevBti THEN { IF prevBti # BTNull AND print THEN ShowTotals[]; print _ FilterBody[ff.bti, pattern]}; IF ff.firstSource # nullSource AND print THEN IF ff.lastSource = ff.firstSource THEN IO.PutChar[out, '\n] ELSE OutCheck[ff.firstSource, ff.lastSource]; IF ff.bti # prevBti THEN { wideCatch _ FALSE; WITH brc~~stb.bb[ff.bti] SELECT FROM Catch => { fsi: CARDINAL _ 1; IF GetByte[ff.pc] = PrincOps.zJ2 THEN { fsi _ GetByte[ff.pc+1]; wideCatch _ TRUE}; -- display second byte in octal (as fsi) IF print THEN { IO.PutF[out, "\n Catch entry point: %d, frame size index: %d\n", [integer[brc.index]], [integer[fsi]]]} }; ENDCASE => { ep: CARDINAL ~ stb.bb[ff.bti].entryIndex; IF print THEN { PrintBodyName[ff.bti]; IO.PutF[ out, "\t Entry point: %d, Frame size index: %d\n", [integer[ep]], [integer[GetByte[ff.pc]]]]}; procFirst _ ff.pc} }; IF print THEN { IF ~ff.procEnd THEN { first: CARDINAL _ ff.pc; IF first = procFirst THEN first _ first + 1; PrintCode[first, myFGT[i + 1].pc, wideCatch]}; IO.PutChar[out, '\n]}; prevBti _ ff.bti; ENDLOOP; IF prevBti # BTNull AND print THEN ShowTotals[]; IO.PutF[ out, "Total instructions: %g, Bytes: %g\n\n", [integer[Tinst]], [integer[Tbytes _ Tbytes]]]; IO.PutChar[out, '\n]; }; IF pattern = NIL THEN pattern _ "*"; ListerUtils.WithSegment[inStream, bcd, mtr.code.sgi, inner]; }; ListFGT: PUBLIC PROC [out,inStream: STREAM, stb: SymbolTableBase, bcd: RefBCD] = { lastSource: INT; lastObject, bodyObject: CARDINAL; AbsFGTEntry: TYPE = RECORD [object: CARDINAL, source: INT]; AbsFGTList: TYPE = RECORD [SEQUENCE length: NAT OF AbsFGTEntry]; absFGT: REF AbsFGTList; code: LONG POINTER TO PrincOps.CSegPrefix; BodyData: TYPE = RECORD [firstFG, lastFG: CARDINAL, bti: Symbols.BTIndex]; BodyList: TYPE = RECORD [SEQUENCE length: NAT OF BodyData]; SortByFirstFG: PROC [na: REF BodyList] = { j: INTEGER; key: BodyData; FOR i: NAT IN [1..na.length) DO key _ na[i]; j _ i - 1; WHILE j >= 0 AND na[j].firstFG > key.firstFG DO na[j + 1] _ na[j]; j _ j - 1; ENDLOOP; na[j + 1] _ key; ENDLOOP; }; GenBT: PROC [p: PROC [BTIndex]] = { bti, prev: BTIndex _ FIRST[BTIndex]; DO p[bti]; IF stb.bb[bti].firstSon # BTNull THEN bti _ stb.bb[bti].firstSon ELSE DO prev _ bti; bti _ stb.bb[bti].link.index; IF bti = BTNull THEN RETURN; IF stb.bb[prev].link.which # parent THEN EXIT; ENDLOOP; ENDLOOP; }; PrintFGT: PROC = { cbti: BTIndex; i, n, cfirst, clast: CARDINAL; na: REF BodyList; countBti: PROC [bti: BTIndex] = { WITH stb.bb[bti] SELECT FROM Callable => IF inline THEN RETURN; ENDCASE; n _ n + 1; }; insertBti: PROC [bti: BTIndex] = { WITH stb.bb[bti] SELECT FROM Callable => IF inline THEN RETURN; ENDCASE; WITH stb.bb[bti].info SELECT FROM External => na[i] _ [startIndex, startIndex + indexLength - 1, bti]; ENDCASE; i _ i + 1; }; PrintBodyLine: PROC [depth: CARDINAL] = { first, last: INT; origin: CARDINAL; bti: BTIndex; [first, last, bti] _ na[i]; THROUGH [1..depth] DO IO.PutRope[out, " "]; ENDLOOP; IO.PutF[out, "[%g] fg: ", [cardinal[LOOPHOLE[bti, CARDINAL]]]]; IO.PutF[out, "[%g..%g], pc: ", [cardinal[first]], [cardinal[last]]]; WITH br: stb.bb[bti] SELECT FROM Callable => { bodyObject _ origin _ code.entry[br.entryIndex].pc; lastObject _ 0; lastSource _ br.sourceIndex; }; Other => origin _ bodyObject + br.relOffset; ENDCASE; WITH bi: stb.bb[bti].info SELECT FROM External => IO.PutF[out, "[%b..%b]", [cardinal[origin]], [cardinal[origin + bi.bytes - 1]]]; ENDCASE; IO.PutF[out, ", source: %g", [cardinal[stb.bb[bti].sourceIndex]]]; WITH br: stb.bb[bti] SELECT FROM Callable => IO.PutF[out, ", ep: %g", [cardinal[br.entryIndex]]]; Other => IO.PutF[out, ", relO: %b", [cardinal[br.relOffset]]]; ENDCASE; IO.PutRope[out, "\n"]; i _ i + 1; }; PrintBodyStuff: PROC [depth: CARDINAL] = { myLast: CARDINAL = na[i].lastFG; PrintBodyLine[depth]; WHILE i < n AND na[i].firstFG <= myLast DO PrintBodyStuff[depth + 1]; ENDLOOP; }; PrintFGEntry: PROC [item: CARDINAL] = { IO.PutF[out, " %g: ", [cardinal[item]]]; WITH ff: stb.fgTable[item] SELECT FROM normal => { IO.PutF[out, "%b, %g = ", [cardinal[ff.deltaObject]], [cardinal[ff.deltaSource]]]; IO.PutF[out, "%b, %g (%b)", [cardinal[absFGT[item - cfirst].object]], [cardinal[absFGT[item - cfirst].source]], [cardinal[absFGT[item - cfirst].object + bodyObject]] ]; }; step => { IF ff.which = source THEN IO.PutF[out, "Step source: %g ", [cardinal[ff.delta]]] ELSE IO.PutF[out, "Step object: %b ", [cardinal[ff.delta]]]; }; ENDCASE; }; GenAbsFGT: PROC = { absFGT _ NEW[AbsFGTList[(clast - cfirst + 1)]]; FOR i: CARDINAL IN [cfirst..clast] DO WITH ff: stb.fgTable[i] SELECT FROM normal => { lastSource _ lastSource + ff.deltaSource; lastObject _ lastObject + ff.deltaObject; }; step => IF ff.which = source THEN lastSource _ lastSource + ff.delta ELSE lastObject _ lastObject + ff.delta; ENDCASE; absFGT[i - cfirst] _ [source: lastSource, object: lastObject]; ENDLOOP; }; n _ 0; GenBT[countBti]; na _ NEW[BodyList[n]]; i _ 0; GenBT[insertBti]; SortByFirstFG[na]; i _ 0; WHILE i < n DO [cfirst, clast, cbti] _ na[i]; WITH br: stb.bb[cbti] SELECT FROM Callable => IF ~br.inline THEN { ListerUtils.PrintSei[br.id, out, stb]; IO.PutRope[out, "\n"]; PrintBodyStuff[0]; GenAbsFGT[]; FOR i: CARDINAL IN [cfirst..clast] DO PrintFGEntry[i]; IO.PutRope[out, "\n"]; ENDLOOP; IO.PutRope[out, "\n"]; }; ENDCASE => ERROR; ENDLOOP; }; <> mti: BcdDefs.MTIndex _ LOOPHOLE[0]; prevBti: BTIndex _ BTNull; mtr: RefMTRecord = ListerUtils.ReadMtr[inStream, bcd, mti]; sgr: RefSGRecord = ListerUtils.ReadSgr[inStream, bcd, mtr.code.sgi]; crossJumped: BOOL = mtr.crossJumped; framesize: CARDINAL = mtr.framesize; codeOffset: CARDINAL = mtr.code.offset; instArray: ListerUtils.OpCodeArray = ListerUtils.GetOpCodeArray[]; inner: PROC [base: LONG POINTER] = { print: BOOL _ FALSE; code _ LOOPHOLE[base + codeOffset]; IF crossJumped THEN IO.PutRope[out, "Cross jumped\n"]; PrintFGT[]; IO.PutChar[out, '\n]; }; ListerUtils.WithSegment[inStream, bcd, mtr.code.sgi, inner]; }; END.