CodeListerImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Russ Atkinson, March 7, 1985 4:11:01 am PST
Sweet December 17, 1985 1:39:10 pm PST
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 {
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 [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] = {
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];
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;
first word after EV is rel. byte ptr to catch ev
These used to work, but cspp now points to a sequence
catchEV: CatchFormat.CatchEV ~ LOOPHOLE[cspp.entry[cspp.header.nEntries]/2];
catchEntry: CatchFormat.CatchEVHandle ~ @cspp[catchEV];
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;
first word after EV is rel. byte ptr to catch ev
These used to work, but cspp now points to a sequence
catchEV: CatchFormat.CatchEV ~ LOOPHOLE[cspp.entry[cspp.header.nEntries]/2];
catchEntry: CatchFormat.CatchEVHandle ~ @cspp[catchEV];
catchEV: CARDINAL = LOOPHOLE[cspp.entry[cspp.header.nEntries]/2];
catchEntry: CatchFormat.CatchEVHandle = LOOPHOLE[cspp + catchEV];
the (outermost, level 0) enable table follows the catch entry vector
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;
};
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;
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;
};
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];
};