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: 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 POINTER TO CSegPrefix]
RETURNS [myFGT: FGHandle _ NIL] = {
bti, prev: BTIndex;

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 = 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: 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].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: 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 [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] = {
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];
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;
};


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: 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].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;
};


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.



ͺCodeListerImpl.mesa
Copyright c 1984, 1985 by Xerox Corporation.  All rights reserved.
Russ Atkinson, March 7, 1985 4:11:01 am PST
Sweet October 10, 1985 5:28:09 pm PDT
Round up to an even number
pc is a byte address
pc is a word address
given a jump operator and its argument, return its target address
list opcodes for indicated segment of code
loginst[inst];
Executable part of ListCode.
Executable part of ListFGT.
Κ>˜
codeš
œ™Kšœ
Οm
œ7™BKš
œ+™+K™%—K˜š
Οk	˜	Kšœžœžœžœ˜Kšœ
žœžœ˜,Kšœžœžœ˜1Kšœžœ˜Kšœžœ&˜9Kšžœ
žœ-˜5Kšžœ
žœFžœ˜VKšœžœ`˜qKšœ	žœ˜Kšœžœžœ˜"Kšœ
žœžœ˜Kšœžœb˜oKšœžœ˜Kšœžœ˜K˜—šœž˜Kšžœ#žœ!˜QKšžœ˜Kšœž˜K˜Kšžœžœžœ
˜Kšœ
žœ˜"šœ	žœ˜ Kš
œ!˜!—Kšžœžœ
žœ
˜Kšœ
žœ˜"Kšœžœ˜'Kšœ
žœ˜(Kšœ
žœ˜)šœ	žœ˜ Kš
œ!˜!—šœ
žœ˜"Kš
œ$˜$—Kšœ	žœ˜ Kšœ
žœ˜"Kšœžœžœ
žœ
˜Kšœžœžœ
˜Kšœžœžœ
žœ
˜Kšœ
žœžœ
˜!Kšœ
žœžœ
˜!Kšžœžœžœ
˜šœ	žœ˜ Kš
œ!˜!—Kšœ
žœ˜"Kšžœžœžœ
žœ
˜Kšœžœ˜*Kšœžœ˜)K˜Kšœžœ!˜-K˜šœžœžœ˜Kšœžœ˜*Kšœžœ
˜
Kšœ	žœ
˜K˜—šžœžœžœ˜Kšœžœ
˜Kšœžœžœ
žœ˜0—Kšœ
žœžœ
žœ
˜K˜—šΟn	œž˜Kšœžœ
žœ
žœ˜8Kšžœžœ˜#K˜K˜šŸ
œžœ˜Kš	œžœžœžœ
žœ˜Bšžœžœ˜K˜K˜)Kšœžœ
žœ
˜šžœ
žœ
ž˜šžœžœ
žœž˜&Kšœžœ
˜——Kš
œ˜—˜
Kšœ9žœ˜H—K˜K˜—šŸ
œžœ˜,Kšœžœ2˜EKšœžœ'˜HKšœžœ*˜:Kšœžœ˜*Kšœžœ
˜!šžœžœ
žœž˜/K˜šžœžœ
ž˜˜K˜&K˜&K˜4—˜Kšžœžœ ˜7Kšžœ!˜%—Kšžœ
˜—Kšžœ
˜—Kšœ4žœ˜:Kš
œ˜—šŸœžœ
žœ
žœ
žœžœžœ˜IKšžœ!žœ
žœžœ˜6Kšžœ!žœ
žœ˜?Kšžœžœ˜Kš
œ˜—šŸœžœ
žœ
žœ
žœžœžœ˜EKšžœžœ
žœžœ˜$Kšžœžœ
žœžœ˜%Kšžœžœ
žœžœ˜"Kšžœžœ
žœžœ˜!Kšžœ#˜)Kš
œ˜—šŸœžœ˜Kšœžœ
˜Kš
œ	žœ
žœ
žœ
žœžœžœ˜IKšœžœ
˜K˜K˜šŸœžœžœ˜!Kšœžœ
˜K˜ š
ž˜K˜Kšžœžœ
žœ
˜Kšžœžœ%žœ	˜>Kšžœžœ
žœ
˜(K˜K˜Kšžœ
˜—K˜K˜—Kš
žœž
œ
žœ
žœžœ
˜6šžœž
œ
žœž˜K˜
K˜K˜K˜Kšžœ˜	K˜——Kšœžœ˜Kšœžœžœ˜/Kšœžœ
žœ
˜Kšœžœ
˜šžœžœ
˜$K˜9—š
ž˜šžœ
žœ
ž˜Kšœžœ	žœžœ˜6Kšžœ
˜—šžœ˜ Kšžœ˜šžœ
ž˜K˜K˜Kšžœžœ
žœ
žœ˜ Kšžœ#žœ
žœ
˜/Kšžœ
˜——Kšžœ	žœ
˜Kšžœ
˜—K˜š	žœžœ
ž
œ
žœž˜+Kšžœ#žœ
žœ
˜/šžœ.˜0šžœ˜K˜-K˜/K˜
—Kšžœ0˜4—Kšžœ
˜—K˜K˜K˜—šŸœžœ
ž˜Kšœžœ.žœ˜LK˜Kšœžœ
˜Kšœžœ
˜Kšœ
žœ
žœ
˜Kšœžœ
˜Kšœžœ˜+K˜Kšœžœžœ
˜K˜šŸœžœ
žœ	žœ˜,Kšœ
žœ
˜Kšœžœ
˜Kšžœ
žœ
žœ
žœ
˜šžœžœž˜3Kšžœ˜Kšžœ
žœžœ
žœ
˜&Kšžœ
˜—Kšžœžœ
žœžœ
˜8Kšžœ˜šžœž˜Kšœžœžœžœ˜7K˜Kšžœ˜Kšžœ
˜—Kšžœžœ
žœ˜,Kš
œ˜—šŸœžœ˜Kšœžœ(˜8Kšœžœ˜.Kšœžœ
˜š
œB˜BKšœžœžœ
žœ˜'—šœ
žœ5˜DKšœžœ
žœžœ
žœ
žœ˜4—Kšœ	žœ ˜+Kšžœ˜K˜—šŸœžœ˜Kšžœ
žœ
žœ
žœ˜&Kš
œ˜—šŸ
œžœžœžœžœ
žœ˜Cšžœžœ
žœ˜Kšœžœ˜K˜K˜
Kš
œ˜Kš
žœžœ$žœ
žœžœ˜JKš
œ˜Kšžœ6žœ˜DKš
œ˜—Kš
œ˜—šŸ
œžœ˜/šžœ
žœ
žœ˜K˜K˜
šžœžœ$žœ˜EKš
œ*˜*K˜$Kšžœ˜K˜—K˜—K˜—šŸœžœžœžœžœžœ˜:Kš
œ™Kšžœžœ˜Kš
œ˜—š
Ÿœžœžœžœžœ˜0Kš
œ™Kšœžœ
žœ
žœ%˜7Kš
žœžœžœžœžœ˜8Kš
œ˜—š
Ÿœžœžœžœžœ˜3Kš
œ™Kšžœžœžœ˜-Kš
œ˜—š
Ÿœžœžœžœžœ˜DKš
œA™Ašžœž˜!˜šžœž˜Kšžœ>˜@KšžœD˜FKšžœD˜FKšžœžœ
˜——˜Kš
žœžœžœžœžœ˜GK˜—šžœ˜
Kš
œ˜——Kšžœžœžœ˜*Kš
œ˜—šŸœžœžœ˜2K˜šžœžœ
žœ"ž˜7Kšœžœ˜KšžœI˜KKšžœ
˜—Kš
œ˜—šŸœžœžœ˜2K˜$šžœžœ
žœ&ž˜;Kšœžœ˜KšžœI˜KKšžœ
˜—Kš
œ˜—šŸœžœžœ˜"Kšœžœ˜Kšœžœžœ˜Kšžœžœžœ
žœ˜,Kšžœ2˜4K˜—šŸ	œžœ˜Kšœžœ˜!Kš
œ*™*Kšœžœ
˜šžœžœž˜%Kšœžœ˜K˜$Kš
œ™K˜Kšžœ(˜*Kš
žœžœžœžœžœ	˜=Kšžœ>˜@Kšžœ
žœ
žœ˜)Kšžœ$˜&šžœž˜˜	K˜šžœž˜KšžœG˜Išžœ˜Kšžœ˜Kšžœ2˜4Kšžœ˜—Kšžœ
˜—Kš
œ˜—˜Kšœžœ"˜,K˜Kšžœ˜šžœž˜Kš
œθ
˜θ
Kšžœžœ"˜/—šžœž˜Kš
œ%˜%šžœ˜Kšžœ˜Kšžœ5˜7Kšžœ˜—Kšžœ
˜—Kš
œ˜—˜Kšœžœžœ˜!K˜K˜*K˜+Kšžœ˜šžœž˜š
œ[˜[Kšžœ&˜(Kšžœ˜K˜—šžœ˜Kšœžœžœžœ˜%Kšœžœžœžœ˜#Kšžœ˜!šžœž˜Kš
œ+˜+Kš
œ+˜+Kš
œ#˜#Kšžœ
žœ6˜EKšžœ˜
————Kšžœ
˜—Kšžœ˜Kšžœ
˜—Kš
œ˜—šŸ
œžœ˜šžœ˜Kš
œ'˜'Kš
œ6˜6—K˜K˜
K˜K˜K˜K˜—Kš
œ™K˜Kšœžœ˜#K˜Kš
œ;˜;Kš
œD˜DKšœ
žœ˜$Kšœžœ˜$Kšœžœ˜'Kš
œB˜Bšœžœžœ
žœ˜$Kšœžœžœ
˜Kšœžœ
žœ
žœ˜*Kš
œ˜Kš
œ˜K˜Kšžœ
žœ
žœ ˜6Kšžœ&˜(Kšžœ ˜"Kšžœ˜K˜Kš
œ!˜!Kš
œ˜šžœžœ
žœž˜'K˜šžœžœ˜Kšžœžœžœ˜0K˜%—šžœžœž˜-Kšžœ žœ
žœ˜;Kšžœ)˜-—šžœžœ˜Kšœžœ˜)Kšœžœ
žœ
žœ,˜@Kšœžœ)˜8šžœžœ˜K˜Kšžœ˜Kšžœ"˜$Kšžœ˜Kšžœ#˜%Kšžœ˜Kšžœ˜——šžœžœ˜Kšžœ
žœ#˜6Kšžœ˜—K˜Kšžœ
˜—Kšžœžœžœ˜0šžœ˜Kš
œ-˜-Kš
œ6˜6—Kšžœ˜K˜—K˜Kšžœžœ
žœ˜$K˜Kš
œ<˜<K˜K˜—šŸœžœ
ž˜Kšœžœ(˜=K˜Kšœžœ
˜Kšœžœ
˜!K˜Kš	œ
žœžœ
žœ
žœ˜;Kšœžœžœžœ	žœ
žœ˜@Kšœžœ˜K˜Kšœžœ
žœ
žœ˜*K˜Kšœ
žœžœžœ˜JKšœ
žœžœžœ	žœ
žœ˜;K˜šŸ
œžœžœ˜*Kšœžœ
˜K˜šžœžœ
žœž˜K˜K˜
šžœžœž˜/Kš
œ˜Kš
œ
˜
Kšžœ
˜—K˜Kšžœ
˜—Kš
œ˜K˜—šŸœžœžœ˜#Kšœžœ
˜$š
ž˜K˜šžœ˜ Kšžœ˜šžœ
ž˜K˜Kš
œ˜Kšžœžœ
žœ
˜Kšžœ"žœ
žœ
˜.Kšžœ
˜——Kšžœ
˜—Kš
œ˜K˜—šŸœžœ˜K˜Kšœžœ
˜Kšœžœ
˜K˜šœ
žœ˜!Kšžœ
žœ
žœ
žœžœ
žœžœ
˜HK˜
Kš
œ˜K˜—šœžœ˜"Kšžœ
žœ
žœ
žœžœ
žœžœ
˜Hšžœžœ
ž˜!K˜DKšžœ
˜—K˜
Kš
œ˜K˜—šŸ
œžœ	žœ˜)Kšœ
žœ
˜Kšœžœ
˜K˜
K˜Kšžœžœ
žœžœ
˜5Kšžœ"žœžœ˜?KšžœB˜Dšžœžœ
ž˜ š
œ
˜
K˜<K˜K˜Kš
œ˜—K˜,Kšžœ
˜—šžœžœ
ž˜%š
œ˜KšžœN˜P—Kšžœ
˜—Kšžœ@˜Bšžœžœ
ž˜ Kšœžœ2˜@Kšœ	žœ3˜>Kšžœ
˜—Kšžœ˜K˜
Kš
œ˜K˜—šŸœžœ	žœ˜*Kšœžœ˜ K˜šžœžœž˜*Kš
œ˜Kšžœ
˜—Kš
œ˜K˜—šŸœžœžœ˜'Kšžœ'˜)šžœžœ
ž˜&š
œ˜KšžœP˜Ršžœ˜K˜)K˜)K˜5K˜—Kš
œ˜—š
œ	˜	šžœ˜Kšžœ
žœ4˜;Kšžœ
žœ5˜<—Kš
œ˜—Kšžœ
˜—Kš
œ˜K˜—šŸ	œžœ˜Kšœ	žœ#˜/šžœžœ
žœž˜%šžœžœ
ž˜#š
œ˜K˜)K˜)Kš
œ˜—˜šžœ˜Kšžœ#˜'Kšžœ$˜(——Kšžœ
˜—K˜>Kšžœ
˜—Kš
œ˜K˜—K˜K˜Kšœžœ˜K˜K˜K˜K˜šžœž˜K˜šžœžœ
ž˜!˜šžœžœ˜K˜&Kšžœ˜K˜K˜šžœžœ
žœž˜%Kš
œ˜Kšžœ˜Kšžœ
˜—Kšžœ˜Kš
œ˜——Kšžœžœ
˜—Kšžœ
˜—Kš
œ˜K˜—Kš
œ™K˜Kšœžœ˜#K˜Kš
œ;˜;Kš
œD˜DKšœ
žœ˜$Kšœžœ˜$Kšœžœ˜'Kš
œB˜Bšœžœžœ
žœ˜$Kšœžœžœ
˜Kšœžœ˜#Kšžœ
žœ
žœ ˜6Kš
œ˜Kšžœ˜K˜—K˜Kš
œ<˜<K˜K˜—šžœ
˜K˜—K˜—…—E¬_”