DIRECTORY
BcdDefs: TYPE USING [Base, MTIndex],
BcdOps: TYPE USING [BcdBase, MTHandle],
CatchFormat:
TYPE
USING [
CatchEV, CatchEVBody, CatchEVHandle, Codebase, EnableHandle, EnableTableBody],
CharIO: TYPE USING [PutChar, PutNumber, PutString, PutSubString],
Environment: TYPE USING [Byte, PageCount],
ESCAlpha: TYPE USING [alpha],
ESCAlphaSDDefsNames: TYPE USING [],
FileSegment: TYPE USING [Pages, nullPages],
FileStream: TYPE USING [Create, EndOf, SetIndex],
Format: TYPE USING [NumberFormat],
Heap: TYPE USING [systemZone],
Inline: TYPE USING [BITOR],
ListerOps: TYPE USING [CodeOptions],
ListerUtil:
TYPE
USING [
CreateStream, LoadBcd, LoadModule, MapPages, Message,
SetFileName, SetRoutineSymbols, PutFileID, UnknownModule],
Mopcodes:
TYPE
USING [
zESC, zESCL, zJ2, zJ4, zJ6, zJ8, zJEBB, zJEP, zJIB, zJIW,
zJNEBB, zJNEP, zJNZ3, zJNZ4, zJZ3, zJZ4, zKFCB,
zLI0, zLI10, zLIB, zLID0, zLIW, zPS0F, zPSF, zPSLF,
zR0F, zRF, zRGILP, zRGIP, zRL0F, zRLDILP, zRLDIP, zRLF,
zRLILP, zRLILPF, zRLIP, zRLIPF,
zW0F, zWLDILP, zWLF, zWLILP, zWLIP, zWF, zWS0F],
OpTableDefs: TYPE USING [InstLength, InstName],
OSMiscOps: TYPE USING [FileError, FindFile],
PrincOps: TYPE USING [InstWord],
Runtime: TYPE USING [GetTableBase],
Space: TYPE USING [Handle, LongPointer, Delete],
Stream: TYPE USING [Delete, GetChar, Handle],
Strings: TYPE USING [String, SubStringDescriptor, EqualSubStrings],
Symbols:
TYPE
USING [
Name, ISEIndex, BodyInfo, BTIndex, BTNull, CBTIndex,
nullName, SENull],
SymbolSegment: TYPE USING [FGTEntry],
SymbolTable: TYPE USING [Base, Acquire, Release, SetCacheSize];
nullSource: CARDINAL ~ CARDINAL.LAST; -- if lastSource, causes to EOF
myFGT: FGHandle;
DigestFGT:
PROC ~ {
OPEN s~~symbols;
bti, prev: Symbols.BTIndex;
cspp: CatchFormat.Codebase ~ codebase;
catchEV: CatchFormat.CatchEV ~ LOOPHOLE[cspp.entry[cspp.header.nEntries]/2];
catchEntry: CatchFormat.CatchEVHandle ~ @cspp[catchEV];
AddMyEntry:
PROC [
source: CARDINAL←nullSource, object: CARDINAL, procEnd: BOOL←FALSE] ~ {
IF n = myFGTSize
THEN {
oldFGT: FGHandle ← myFGT;
myFGTSize ← myFGTSize + 10;
SetupMyFGT[];
FOR i:
NAT
IN [0..oldFGT.maxLength)
DO
myFGT[i] ← oldFGT[i] ENDLOOP;
(Heap.systemZone).FREE[@oldFGT]};
myFGT[n] ←
[firstSource~source, pc~object, procEnd~procEnd, bti~LOOPHOLE[bti]];
myFGT.length ← n ← n + 1};
AddBodyFGT:
PROC [bti: Symbols.CBTIndex] ~ {
OPEN s~~symbols;
procstart:
CARDINAL ~
WITH body~~s.bb[bti]
SELECT
FROM
Catch => catchEntry[body.index],
ENDCASE => cspp.entry[body.entryIndex].pc;
info: Symbols.BodyInfo.External ~ NARROW[s.bb[bti].info, Symbols.BodyInfo.External];
fgLast: CARDINAL ~ info.startIndex + info.indexLength - 1;
lastSource: CARDINAL ← s.bb[bti].sourceIndex;
lastObject: CARDINAL ← procstart;
FOR i:
CARDINAL
IN [info.startIndex..fgLast]
DO
f: SymbolSegment.FGTEntry ~ s.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]};
SetupMyFGT:
PROC ~
INLINE {
myFGT ← (Heap.systemZone).NEW[FGT[myFGTSize] ← [length~0, info~TRASH]]};
BySource:
PROC [r1, r2:
LONG
POINTER
TO FineGrainInfo]
RETURNS [
BOOL] ~ {
RETURN [
IF r1.firstSource > r2.firstSource THEN TRUE
ELSE IF r1.firstSource = r2.firstSource THEN r1.pc > r2.pc
ELSE FALSE]};
ByPC:
PROC [r1, r2:
LONG
POINTER
TO FineGrainInfo]
RETURNS [
BOOL] ~ {
RETURN [
IF r1.pc > r2.pc THEN TRUE
ELSE IF r1.pc < r2.pc THEN FALSE
ELSE IF r1.procEnd THEN FALSE
ELSE IF r2.procEnd THEN TRUE
ELSE 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*s.fgTable.LENGTH)/2;
SetupMyFGT[];
bti ← Symbols.BTIndex.FIRST;
IF s.bb[bti].sourceIndex # 0
THEN
AddMyEntry[source~0, object~cspp.entry[0].pc];
DO
WITH s.bb[bti]
SELECT
FROM
Callable => IF ~inline THEN AddBodyFGT[LOOPHOLE[bti]];
ENDCASE;
IF s.bb[bti].firstSon # Symbols.BTNull THEN bti ← s.bb[bti].firstSon
ELSE
DO
prev ← bti;
bti ← s.bb[bti].link.index;
IF bti = Symbols.BTNull THEN GO TO Done;
IF s.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]};
offset: CARDINAL;
codebase: LONG POINTER;
codepages: PageCount;
symbols: SymbolTable.Base;
Tinst, Tbytes, Pinst, Pbytes: CARDINAL ← 0;
number formats (initialized by Octify)
decimal: NumberFormat ~ [base~10, columns~1, zerofill~FALSE, unsigned~TRUE];
decimal3: NumberFormat ~ [base~10, columns~3, zerofill~FALSE, unsigned~TRUE];
hoctal0: NumberFormat;
hoctal1: NumberFormat;
hoctal3: NumberFormat;
hoctal3z: NumberFormat;
hoctal5: NumberFormat;
hoctal6: NumberFormat;
set base for listings
Hexify:
PROC ~ {
hoctal0 ← [base~16, columns~0, zerofill~FALSE, unsigned~TRUE];
hoctal1 ← [base~16, columns~1, zerofill~FALSE, unsigned~TRUE];
hoctal3 ← [base~16, columns~3, zerofill~FALSE, unsigned~TRUE];
hoctal3z ← [base~16, columns~3, zerofill~FALSE, unsigned~TRUE];
hoctal5 ← [base~16, columns~5, zerofill~FALSE, unsigned~TRUE];
hoctal6 ← [base~16, columns~6, zerofill~FALSE, unsigned~TRUE]};
Octify:
PROC ~ {
hoctal0 ← [base~8, columns~0, zerofill~FALSE, unsigned~TRUE];
hoctal1 ← [base~8, columns~1, zerofill~FALSE, unsigned~TRUE];
hoctal3 ← [base~8, columns~3, zerofill~FALSE, unsigned~TRUE];
hoctal3z ← [base~8, columns~3, zerofill~TRUE, unsigned~TRUE];
hoctal5 ← [base~8, columns~5, zerofill~FALSE, unsigned~TRUE];
hoctal6 ← [base~8, columns~6, zerofill~FALSE, unsigned~TRUE]};
source file procedures
source: Stream.Handle;
sourceAvailable: BOOL;
out: Stream.Handle ← NIL;
OpenOutput:
PROC [root: Strings.String] ~ {
outName: STRING ← [40];
ListerUtil.SetFileName[outName, root, "cl"L];
out ← ListerUtil.CreateStream[outName]};
CloseOutput:
PROC ~ {
Stream.Delete[out]; out ← NIL};
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 [
WORD] ~
INLINE {
pc is a word address
RETURN [(codebase + pc)^]};
JumpAddress:
PROC [jop: OpCode, arg:
INTEGER]
RETURNS [
CARDINAL] ~ {
given a jump operator and its argument, return its target address
OPEN Mopcodes;
SELECT OpTableDefs.InstLength[jop]
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 ← Inline.BITOR[arg, 177400B];
arg ← arg - 1;
END;
ENDCASE => {
SELECT jop
FROM
zJEBB, zJNEBB => IF arg > 177B THEN arg ← Inline.BITOR[arg, 177400B];
ENDCASE;
arg ← arg - 2};
RETURN [INTEGER[offset] + arg]};
OutWJTab:
PROC [tabstart, tablength:
CARDINAL, options: CodeOptions] ~ {
Pbytes ← Pbytes + tablength*2;
FOR pc:
CARDINAL
IN [tabstart..tabstart + tablength)
DO
w: INTEGER ~ GetWord[pc];
CharIO.PutString[out, "\n\t\t"L];
IF options.stripped THEN {CharIO.PutNumber[out, w, hoctal5]; LOOP};
IF options.full THEN CharIO.PutString[out, "\t\t"L];
CharIO.PutString[out, " ("L];
CharIO.PutNumber[out, JumpAddress[Mopcodes.zJIW, w], hoctal5];
CharIO.PutChar[out, ')];
ENDLOOP};
OutBJTab:
PROC [tabstart, tablength:
CARDINAL, options: CodeOptions] ~ {
Pbytes ← Pbytes + EvenUp[tablength];
FOR pc:
CARDINAL
IN [tabstart*2..tabstart*2 + tablength)
DO
b: BYTE ~ GetByte[pc];
CharIO.PutString[out, "\n\t\t"L];
IF options.stripped THEN {CharIO.PutNumber[out, b, hoctal5]; LOOP};
IF options.full THEN CharIO.PutString[out, "\t\t"L];
CharIO.PutString[out, " ("L];
CharIO.PutNumber[out, JumpAddress[Mopcodes.zJIB, b], hoctal5];
CharIO.PutChar[out, ')];
ENDLOOP};
PutPair:
PROC [byte:
CARDINAL] ~ {
a: CARDINAL ~ byte/16;
b: CARDINAL ~ byte MOD 16;
IF a < 8 AND b < 8 THEN CharIO.PutChar[out, ' ];
CharIO.PutChar[out, '[];
CharIO.PutNumber[out, a, hoctal1];
CharIO.PutChar[out, ',];
CharIO.PutNumber[out, b, hoctal1];
CharIO.PutChar[out, ']]};
PrintCode:
PROC [
startCode, endCode: CARDINAL, wideCatch: BOOL, options: CodeOptions] ~ {
list opcodes for indicated segment of code
OPEN Mopcodes;
lastConstant: INTEGER;
FOR offset
IN [startCode..endCode)
DO
inst: BYTE ~ GetByte[offset];
il: [0..3] ~ OpTableDefs.InstLength[inst];
loginst[inst];
Pinst ← Pinst + 1;
CharIO.PutChar[out, '\t];
IF ~options.stripped
THEN {
IF options.full
THEN {
CharIO.PutNumber[out, offset/2, hoctal5];
CharIO.PutString[out, (IF offset MOD 2 = 0 THEN ",E "L ELSE ",O "L)]};
CharIO.PutNumber[out, offset, hoctal5];
CharIO.PutChar[out, ':]};
IF options.full
THEN {
CharIO.PutString[out, "\t["L]; CharIO.PutNumber[out, inst, hoctal3z]; CharIO.PutChar[out, ']]};
CharIO.PutChar[out, '\t];
IF wideCatch
AND offset = startCode+1
THEN {
CharIO.PutNumber[out, inst, hoctal1];
CharIO.PutChar[out, '\t];
LOOP};
CharIO.PutString[out, OpTableDefs.InstName[inst]];
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
AND ~options.stripped
THEN {
CharIO.PutString[out, "\t ("L];
CharIO.PutNumber[out, JumpAddress[inst, 0], hoctal1];
CharIO.PutChar[out, ')]}};
2 => {
byte: BYTE ~ GetByte[(offset ← offset + 1)];
Pbytes ← Pbytes + 2;
CharIO.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 => {
IF options.full THEN CharIO.PutNumber[out, byte, hoctal6];
EscName[byte]};
zKFCB => {
IF options.full THEN CharIO.PutNumber[out, byte, hoctal6];
SddName[byte]};
ENDCASE => CharIO.PutNumber[out, byte, hoctal6];
IF inst = zLIB THEN lastConstant ← byte
ELSE
IF inst
IN JumpOp
AND ~options.stripped
THEN {
CharIO.PutString[out, " ("L];
CharIO.PutNumber[out, JumpAddress[inst, byte], hoctal1];
CharIO.PutChar[out, ')]}};
3 => {
ab: RECORD [first, second: BYTE];
Pbytes ← Pbytes + 3;
ab.first ← GetByte[(offset ← offset + 1)];
ab.second ← GetByte[(offset ← offset + 1)];
CharIO.PutChar[out, '\t];
SELECT inst
FROM
zRF, zWF, zRLF, zWLF, zPSF, zPSLF => {
CharIO.PutNumber[out, ab.first, hoctal6];
CharIO.PutString[out, ", "L];
PutPair[ab.second]};
ENDCASE => {
v: INTEGER;
SELECT inst
FROM
zRLIPF, zRLILPF => {
PutPair[ab.first];
CharIO.PutString[out, ", "L];
PutPair[ab.second]};
zJEBB, zJNEBB => {
CharIO.PutNumber[out, ab.first, hoctal6];
CharIO.PutString[out, ", "L];
CharIO.PutNumber[out, ab.second, hoctal6];
v ← ab.second};
zESCL => {
IF options.full THEN CharIO.PutNumber[out, ab.first, hoctal3];
EscName[ab.first];
CharIO.PutNumber[out, ab.second, hoctal6]};
ENDCASE => CharIO.PutNumber[out, (v ← ab.first*256 + ab.second), hoctal6];
SELECT inst
FROM
zJIB => OutBJTab[v, lastConstant, options];
zJIW => OutWJTab[v, lastConstant, options];
zLIW => lastConstant ← v;
IN JumpOp =>
IF ~options.stripped
THEN {
CharIO.PutString[out, " ("L];
CharIO.PutNumber[out, JumpAddress[inst, v], hoctal1];
CharIO.PutChar[out, ')]};
ENDCASE}};
ENDCASE;
CharIO.PutChar[out, '\n];
ENDLOOP};
CompStrDesc: TYPE ~ RECORD [offset, length: CARDINAL];
CompStrRecord:
TYPE ~
RECORD [
stringOffset: CSRptr RELATIVE POINTER TO StringBody,
ESCAlphaNames: ARRAY ESCAlpha.alpha OF CompStrDesc,
SDDefsNames: ARRAY Environment.Byte OF CompStrDesc];
CSRptr: TYPE ~ LONG BASE POINTER TO CompStrRecord;
SddName:
PROC [op:
BYTE] ~ {
ss: Strings.SubStringDescriptor;
ss.base ← @csrP[csrP.stringOffset];
ss.offset ← csrP.SDDefsNames[op].offset;
ss.length ← csrP.SDDefsNames[op].length;
IF ss.length < 8 THEN PutBlanks[8-ss.length] ELSE PutBlanks[1];
CharIO.PutSubString[out, @ss]};
PutBlanks:
PROC [n:
CARDINAL] ~ {
THROUGH [1..n] DO CharIO.PutChar[out, ' ] ENDLOOP};
ListModule:
PROC [
file, module, proc: Strings.String, output: Strings.String, options: CodeOptions] ~ {
bcdFile: Strings.String ← [100];
bcdSeg, cSeg, sSeg: FileSegment.Pages;
mti: BcdDefs.MTIndex;
ListerUtil.SetFileName[bcdFile, file, "bcd"L];
bcdSeg ← ListerUtil.LoadBcd[bcdFile];
IF bcdSeg = FileSegment.nullPages THEN GO TO NoFile;
[mti, cSeg, sSeg] ← ListerUtil.LoadModule[bcdSeg, module
! ListerUtil.UnknownModule => {GO TO NoModule}];
DoCodeListing[cSeg, sSeg, bcdSeg, mti, proc, output, options]
EXITS
NoFile => ListerUtil.Message["File cannot be opened"L];
NoModule => {
ListerUtil.Message["File does not contain module "L];
ListerUtil.Message[module]}};
ShowTotals:
PROC ~ {
CharIO.PutString[out, "Instructions: "L];
CharIO.PutNumber[out, Pinst, decimal];
CharIO.PutString[out, ", Bytes: "L];
CharIO.PutNumber[out, Pbytes ← EvenUp[Pbytes], decimal];
CharIO.PutString[out, "\n\n"L];
Tinst ← Tinst + Pinst;
Pinst ← 0;
Tbytes ← Tbytes + Pbytes;
Pbytes ← 0};
DoCodeListing:
PROC [
cseg, sseg, bcdseg: FileSegment.Pages,
mti: MTIndex, proc: Strings.String,
output: Strings.String, options: CodeOptions] ~ {
OPEN BcdDefs, Symbols;
codeSpace: Space.Handle;
crossJumped: BOOL;
codeOffset, frameSize: CARDINAL;
prevBti: BTIndex ← BTNull;
BEGIN
bcdSpace: Space.Handle ← ListerUtil.MapPages[bcdseg];
bcd: BcdOps.BcdBase ← bcdSpace.LongPointer;
mth: BcdOps.MTHandle ← @LOOPHOLE[bcd + bcd.mtOffset, Base][mti];
codeOffset ← mth.code.offset;
frameSize ← mth.framesize;
crossJumped ← mth.crossJumped;
Space.Delete[bcdSpace];
END;
IF cseg = FileSegment.nullPages
THEN
ListerUtil.Message["Code not available"L]
ELSE
IF sseg = FileSegment.nullPages
THEN
ListerUtil.Message["Symbols not available"L]
ELSE {
print: BOOL ← FALSE;
procFirst: CARDINAL ← 0;
codeSpace ← ListerUtil.MapPages[cseg];
codebase ← codeSpace.LongPointer + codeOffset;
codepages ← cseg.span.pages;
SymbolTable.SetCacheSize[0]; -- clear cache
symbols ← SymbolTable.Acquire[sseg];
IF symbols.fgTable =
NIL
THEN {
ListerUtil.Message["Bad bcd format"L]; GO TO Fail};
ListerUtil.SetRoutineSymbols[symbols];
SetUpSource[];
OpenOutput[output];
ListerUtil.PutFileID[out];
IF crossJumped THEN CharIO.PutString[out, "Cross jumped\n"L];
CharIO.PutString[out, "Global frame size: "L];
CharIO.PutNumber[out, frameSize, decimal];
CharIO.PutString[out, "\n\n"L];
IF options.radix = $hex THEN Hexify[] ELSE Octify[];
IF proc = NIL THEN ShowEntryVectors[];
IF proc = NIL THEN ShowEnableTable[];
Tbytes ← Tinst ← 0;
DigestFGT[];
FOR i:
CARDINAL
IN [0..myFGT.length)
DO
ff: FineGrainInfo ~ myFGT[i];
wideCatch: BOOL ← FALSE;
IF ff.bti # prevBti
THEN {
IF prevBti # BTNull AND print THEN ShowTotals[];
print ← FilterBody[ff.bti, proc]};
IF ff.firstSource # nullSource
AND print
THEN
IF ff.lastSource = ff.firstSource THEN CharIO.PutChar[out, '\n]
ELSE OutCheck[ff.firstSource, ff.lastSource];
IF ff.bti # prevBti
THEN {
WITH brc~~symbols.bb[ff.bti]
SELECT
FROM
Catch => {
fsi: CARDINAL ← 1;
IF GetByte[ff.pc] = Mopcodes.zJ2
THEN {
fsi ← GetByte[ff.pc+1];
wideCatch ← TRUE}; -- display second byte in octal (as fsi)
IF print
THEN {
IF ~sourceAvailable THEN CharIO.PutChar[out, '\n];
CharIO.PutString[out, " Catch entry point: "L];
CharIO.PutNumber[out, brc.index, decimal];
CharIO.PutString[out, ", frame size index: "L];
CharIO.PutNumber[out, fsi, decimal];
CharIO.PutChar[out, '\n]}};
ENDCASE => {
ep: CARDINAL ~ symbols.bb[ff.bti].entryIndex;
IF print
THEN {
PrintBodyName[ff.bti];
IF options.full THEN CharIO.PutChar[out, '\t];
CharIO.PutString[out, " Entry point: "L];
CharIO.PutNumber[out, ep, decimal];
CharIO.PutString[out, ", Frame size index: "L];
CharIO.PutNumber[out, GetByte[ff.pc], decimal];
CharIO.PutChar[out, '\n]};
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, options]};
CharIO.PutChar[out, '\n]};
prevBti ← ff.bti;
ENDLOOP;
IF prevBti # Symbols.BTNull AND print THEN ShowTotals[];
(Heap.systemZone).FREE[@myFGT];
SymbolTable.Release[symbols];
Space.Delete[codeSpace];
CloseSource[];
CharIO.PutChar[out, '\n];
IF proc =
NIL
THEN {
IF options.full THEN CharIO.PutChar[out, '\t];
CharIO.PutString[out, "Total instructions: "L];
CharIO.PutNumber[out, Tinst, decimal];
CharIO.PutString[out, ", Bytes: "L];
CharIO.PutNumber[out, Tbytes, decimal];
CharIO.PutChar[out, '\n]};
CloseOutput[]
EXITS
Fail => {SymbolTable.Release[symbols]; Space.Delete[codeSpace]}}};
ShowEntryVectors:
PROC ~ {
cspp: CatchFormat.Codebase ~ codebase;
first word after EV is rel. byte ptr to catch ev
catchEV: CatchFormat.CatchEV ~ LOOPHOLE[cspp.entry[cspp.header.nEntries]/2];
catchEntry: CatchFormat.CatchEVHandle ~ @cspp[catchEV];
CharIO.PutString[out, "Entry Vector: evi [bytePC]"L];
CharIO.PutChar[out, '\n];
FOR evi:
CARDINAL
IN [0..cspp.header.nEntries)
DO
CharIO.PutString[out, " "L];
CharIO.PutNumber[out, evi, decimal];
CharIO.PutString[out, " ["L];
CharIO.PutNumber[out, cspp.entry[evi], hoctal0];
CharIO.PutString[out, "]\n"L];
ENDLOOP;
CharIO.PutString[out, "\nCatch Entry Vector: cevi [bytePC]\n"L];
IF catchEV = LOOPHOLE[0] THEN CharIO.PutString[out, " None"L]
ELSE
FOR cevi:
CARDINAL
IN [0..catchEntry.count)
DO
CharIO.PutString[out, " "L];
CharIO.PutNumber[out, cevi, decimal];
CharIO.PutString[out, " ["L];
CharIO.PutNumber[out, catchEntry[cevi], hoctal0];
CharIO.PutString[out, "]\n"L];
ENDLOOP;
CharIO.PutString[out, "\n\n"L]};
ShowEnableTable:
PROC ~ {
cspp: CatchFormat.Codebase ~ codebase;
first word after EV is rel. byte ptr to catch ev
catchEV: CatchFormat.CatchEV ~ LOOPHOLE[cspp.entry[cspp.header.nEntries]/2];
catchEntry: CatchFormat.CatchEVHandle ~ @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
CharIO.PutString[out, " "L];
ENDLOOP;
CharIO.PutChar[out, '[];
CharIO.PutNumber[out, start, hoctal0];
CharIO.PutString[out, ".."L];
CharIO.PutNumber[out, end, hoctal0];
CharIO.PutString[out, "] "L];
CharIO.PutNumber[out, et[i].index, decimal];
CharIO.PutChar[out, '\n];
IF et[i].alsoNested
THEN
PrintEnableEntries[firstPC~start, lastPC~end, level~(level+1)]};
ENDLOOP};
IF catchEV = LOOPHOLE[0] THEN RETURN;
CharIO.PutString[out, "Enable Items: [firstPC..lastPC] catchIndex\n"L];
PrintEnableEntries[firstPC~0, lastPC~NAT.LAST, level~0];
CharIO.PutChar[out, '\n]};