CodeListerImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Russ Atkinson, July 9, 1984 8:07:04 pm PDT
DIRECTORY
Basics USING [BITOR, BYTE],
BasicTime USING [FromPupTime, GMT, nullGMT],
BcdDefs USING [BCD, MTIndex, MTRecord, SGRecord],
CodeLister USING [],
ConvertUnsafe USING [SubString, SubStringToRope, ToRope],
FS USING [Error, Open, OpenFile, StreamFromOpenFile],
IO USING [Close, EndOfStream, GetChar, Put, PutChar, PutF, PutRope, SetIndex, STREAM],
ListerUtils
USING
[GetOpCodeArray, OpCodeArray, PrintSei, PrintSubString, ReadMtr, ReadSgr, RefBCD, WithSegment],
PrincOps
USING
[CSegPrefix, EntryVectorItem, FrameHandle, FrameVec, InstWord, zJ2, zJ9, zJEQ2, zJEQ9, zJIB, zJIW, zJNE2, zJNE9, zLI0, zLI6, zLIB, zLIW, zRF, zRFC, zRFL, zRIGP, zRIGPL, zRILP, zRILPL, zRXGPL, zRXLP, zRXLPL, zWF, zWFL, zWIGPL, zWILP, zWILPL, zWSF, zWXGPL, zWXLP, zWXLPL],
Rope USING [Flatten, Match, 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
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;
FrameHandle: TYPE = PrincOps.FrameHandle;
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: CARDINAL = CARDINAL.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: CARDINAL ← 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 POINTER TO CSegPrefix]
RETURNS [myFGT: FGHandle ← NIL] = {
bti, prev: BTIndex;
AddMyEntry:
PROC [
source: CARDINAL←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 = cspp.entry[stb.bb[bti].entryIndex].initialpc*2;
info: BodyInfo[External] = NARROW[stb.bb[bti].info, BodyInfo[External]];
fgLast: CARDINAL = info.startIndex + info.indexLength - 1;
lastSource: CARDINAL ← 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].initialpc*2];
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;
OutCheck:
PROC [xfirst:
CARDINAL, xlast:
CARDINAL] = {
nextchar: CHAR;
lastcr: CARDINAL;
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 {
Round up to an even number
RETURN [n + n MOD 2];
};
GetByte:
PROC [pc:
CARDINAL]
RETURNS [
BYTE] = {
pc is a byte address
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] = {
pc is a word address
RETURN [LOOPHOLE[(codebase + pc)^, INTEGER]];
};
JumpAddress:
PROC [jop: OpCode, arg:
INTEGER]
RETURNS [
CARDINAL] = {
given a jump operator and its argument, return its target address
SELECT instArray[jop].length
FROM
1 =>
SELECT jop
FROM
IN [PrincOps.zJ2..PrincOps.zJ9] => arg ← jop - PrincOps.zJ2 + 2;
IN [PrincOps.zJEQ2..PrincOps.zJEQ9] => arg ← jop - PrincOps.zJEQ2 + 2;
IN [PrincOps.zJNE2..PrincOps.zJNE9] => arg ← jop - PrincOps.zJNE2 + 2;
ENDCASE => ERROR;
2 => {
IF arg > 177B THEN arg ← LOOPHOLE[Basics.BITOR[arg, 177400B], INTEGER];
arg ← arg - 1};
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] = {
list opcodes for indicated segment of code
lastconstant: INTEGER;
FOR offset
IN [startcode..endcode)
DO
inst: BYTE = GetByte[offset];
il: [0..3] = instArray[inst].length;
loginst[inst];
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];
IO.PutRope[out, instArray[inst].name];
SELECT il
FROM
0, 1 => {
Pbytes ← Pbytes + 1;
SELECT inst
FROM
IN [PrincOps.zLI0..PrincOps.zLI6] => lastconstant ← inst - PrincOps.zLI0;
IN JumpOp => {
IO.PutRope[out, "\t ("];
IO.PutF[out, "%b", [integer[JumpAddress[inst, 0]]]];
IO.PutChar[out, ')]};
ENDCASE;
};
2 => {
byte: BYTE = GetByte[(offset ← offset + 1)];
Pbytes ← Pbytes + 2;
IO.PutChar[out, '\t];
SELECT inst
FROM
PrincOps.zRILP, PrincOps.zWILP, PrincOps.zRXLP, PrincOps.zWXLP, PrincOps.zRIGP, PrincOps.zRXLPL, PrincOps.zWXLPL, PrincOps.zRXGPL, PrincOps.zWXGPL, PrincOps.zRILPL, PrincOps.zWILPL, PrincOps.zRIGPL, PrincOps.zWIGPL => PutPair[byte];
ENDCASE => IO.PutF[out, "%b", [integer[byte]]];
SELECT inst
FROM
PrincOps.zLIB => lastconstant ← byte;
IN JumpOp => {
IO.PutRope[out, " ("];
IO.PutF[out, "%b", [integer[JumpAddress[inst, byte]]]];
IO.PutChar[out, ')]};
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
PrincOps.zRF, PrincOps.zWF, PrincOps.zWSF, PrincOps.zRFC, PrincOps.zRFL, PrincOps.zWFL => {
IO.PutF[out, "%b", [integer[ab.first]]];
IO.PutRope[out, ", "];
PutPair[ab.second]};
ENDCASE => {
v: CARDINAL = LOOPHOLE[ab, CARDINAL];
vi: INTEGER = LOOPHOLE[v, INTEGER];
IO.PutF[out, "%b", [integer[v]]];
SELECT inst
FROM
PrincOps.zJIB => OutBJTab[v, lastconstant];
PrincOps.zJIW => OutWJTab[v, lastconstant];
PrincOps.zLIW => lastconstant ← vi;
IN JumpOp => IO.PutF[out, " (%b)", [integer[JumpAddress[inst, vi]]]];
ENDCASE}};
ENDCASE;
IO.PutChar[out, '\n];
ENDLOOP;
};
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;
};
Executable part of ListCode.
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;
cspp: LONG POINTER TO PrincOps.CSegPrefix;
codebase ← base + codeOffset;
codepages ← sgr.pages;
cspp ← codebase;
IF crossJumped THEN IO.PutRope[out, "Cross jumped\n"];
IO.PutRope[out, "Global frame size: "];
IO.Put[out, [integer[framesize]]];
IO.PutRope[out, "\n\n"];
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 {
ep: CARDINAL = stb.bb[ff.bti].entryIndex;
evi: LONG POINTER TO PrincOps.EntryVectorItem = @cspp.entry[ep];
fsize: CARDINAL = PrincOps.FrameVec[evi.info.framesize];
IF print
THEN {
PrintBodyName[ff.bti];
IO.PutChar[out, '\t];
IO.PutRope[out, " Entry point: "];
IO.Put[out, [integer[ep]]];
IO.PutRope[out, ", Frame size: "];
IO.Put[out, [integer[fsize]]];
IO.PutChar[out, '\n]}};
IF print
THEN {
IF ~ff.procEnd THEN PrintCode[ff.pc, myFGT[i + 1].pc];
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 ← EvenUp[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, lastObject, bodyObject: CARDINAL;
AbsFGTEntry: TYPE = RECORD [object, source: CARDINAL];
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, 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].initialpc*2;
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;
};
Executable part of ListFGT.
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];
};