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];

CLList: PROGRAM
IMPORTS
CharIO, FileStream, ESCAlphaSDDefsNames, Heap, Inline, ListerUtil, OpTableDefs,
OSMiscOps, Runtime, Space, Stream, Strings, SymbolTable
EXPORTS ListerOps = {

CodeOptions: TYPE ~ ListerOps.CodeOptions;

MTIndex: TYPE ~ BcdDefs.MTIndex;
NumberFormat: TYPE ~ Format.NumberFormat;
PageCount: TYPE ~ Environment.PageCount;
BYTE: TYPE ~ Environment.Byte;
OpCode: TYPE ~ BYTE;

JumpOp: TYPE ~ [Mopcodes.zJ2..Mopcodes.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 ~ LONG POINTER TO FGT;

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;


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;


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


OutCheck: PROC [xfirst: CARDINAL, xlast: CARDINAL] ~ {
nextchar: CHAR;
lastcr: CARDINAL;
IF ~sourceAvailable THEN RETURN;
FOR lastcr _ xfirst, lastcr - 1 UNTIL lastcr = 0 DO
FileStream.SetIndex[source, lastcr];
IF source.GetChar = '\n THEN EXIT;
ENDLOOP;
THROUGH (lastcr..xfirst) DO CharIO.PutChar[out, ' ] ENDLOOP;
FileStream.SetIndex[source, xfirst];
WHILE xfirst # xlast DO
IF FileStream.EndOf[source] THEN GOTO eof;
nextchar _ source.GetChar;
xfirst _ xfirst + 1;
IF nextchar = '\032 THEN	-- Bravo trailer
WHILE nextchar # '\n DO
IF FileStream.EndOf[source] THEN GOTO eof;
nextchar _ source.GetChar;
xfirst _ xfirst + 1;
ENDLOOP;
CharIO.PutChar[out, nextchar];
REPEAT eof => NULL;
ENDLOOP;
IF nextchar # '\n THEN CharIO.PutChar[out, '\n]};

SetUpSource: PROC ~ {
sourceAvailable _ TRUE;
source _ FileStream.Create[
OSMiscOps.FindFile[symbols.sourceFile
! OSMiscOps.FileError => {sourceAvailable _ FALSE; CONTINUE}]]};

CloseSource: PROC ~ {IF sourceAvailable THEN Stream.Delete[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 [WORD] ~ INLINE { 
RETURN [(codebase + pc)^]};

JumpAddress: PROC [jop: OpCode, arg: INTEGER] RETURNS [CARDINAL] ~ {
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] ~ {
OPEN Mopcodes;
lastConstant: INTEGER;
FOR offset IN [startCode..endCode) DO
inst: BYTE ~ GetByte[offset];
il: [0..3] ~ OpTableDefs.InstLength[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;

csrP: CSRptr ~ Runtime.GetTableBase[LOOPHOLE[ESCAlphaSDDefsNames]];

EscName: PROC [alpha: BYTE] ~ {
ss: Strings.SubStringDescriptor;
ss.base _ @csrP[csrP.stringOffset];
ss.offset _ csrP.ESCAlphaNames[alpha].offset;
ss.length _ csrP.ESCAlphaNames[alpha].length;
IF ss.length < 8 THEN PutBlanks[8-ss.length] ELSE PutBlanks[1];
CharIO.PutSubString[out, @ss]};

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;
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;
catchEV: CatchFormat.CatchEV ~ LOOPHOLE[cspp.entry[cspp.header.nEntries]/2];
catchEntry: CatchFormat.CatchEVHandle ~ @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
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]};


ListProc: PUBLIC PROC [
input, proc: Strings.String, output: Strings.String, options: CodeOptions] ~ {
ListModule[input, input, proc, output, options]};

ListCode: PUBLIC PROC [root: Strings.String, options: CodeOptions] ~ {
ListModule[root, root, NIL, root, options]};

ListCodeInConfig: PUBLIC PROC [config, name: Strings.String, options: CodeOptions] ~ {
ListModule[config, name, NIL, name, options]};

Octify[];

}.

@file tCLList.mesa 
last edited by Satterthwaite on May 12, 1983 8:52 am
Sweet December 5, 1985 12:32:28 pm PST
number formats (initialized by Octify)
set base for listings
source file procedures
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];
first word after EV is rel. byte ptr to catch ev
first word after EV is rel. byte ptr to catch ev
the (outermost, level 0) enable table follows the catch entry vector
initialization
Κ:˜Jš
œ™š
œ4™4Icode™&—J˜š
Οk	˜	Jšœ	œ
œ˜$Jšœœ
œ˜'šœ
œ
œ˜J˜N—Jšœœ
œ/˜AJšœ
œ
œ˜*Jšœ
œ
œ	˜Jšœœ
œ˜#Jšœ
œ
œ˜+Jšœœ
œ˜1Jšœœ
œ˜"Jšœœ
œ˜Jšœœ
œœ˜Jšœœ
œ˜$šœœ
œ˜J˜5J˜:—šœ
œ
œ˜J˜9J˜/J˜3J˜7J˜J˜0—Jšœ
œ
œ˜/Jšœœ
œ˜,Jšœ
œ
œ˜ Jšœ	œ
œ˜#Jšœœ
œ˜0Jšœœ
œ˜-Jšœ	œ
œ0˜Cšœ	œ
œ˜J˜4J˜—Jšœœ
œ˜%Jšœ
œ
œ(˜?—J˜šœ˜š
˜J˜OJ˜7—Jšœ˜J˜Jšœ
œ˜*J˜Jšœ	œ˜ Jšœœ˜)Jšœœ˜(Jšœœ˜Jšœœœ
˜J˜Jšœœ!˜-—˜šœœœ˜Jšœœ˜/Jšœœ
˜
Jšœ	œ
˜J˜—šœœœ˜Jšœœ
˜Jšœœœ
œ˜0—Jšœ
œœ
œ
œ
œ
˜%—˜Jšœœœ
œΟc˜EJ˜J˜J˜šΟn	œœ˜Jšœ˜J˜J˜&Jšœœ%˜LJ˜7J˜šŸ
œœ˜Jš	œœœœ
œ˜Gšœœ˜J˜J˜J˜
šœœ
œ˜&Jšœœ
˜—Jšœœ˜!—˜
Jšœ5œ˜D—J˜J˜—šŸ
œœ˜,Jšœ˜šœœœœ
˜6J˜ Jšœ#˜*—Jšœ"œ,˜TJšœœ*˜:Jšœœ˜-Jšœœ
˜!šœœ
œ˜/J˜)šœœ
˜˜J˜&J˜&J˜2—˜Jšœœ ˜6Jšœ!˜%—Jšœ
˜—Jšœ
˜—Jšœ0œ˜7J˜—šŸ
œœœ˜Jšœœ
œœ˜HJ˜—šŸœœ
œ
œ
œœœ˜Išœ˜Jšœ!œ
˜,Jšœ
œ!œ˜:Jšœ
œ˜
—J˜—šŸœœ
œ
œ
œœœ˜Ešœ˜Jšœœ
˜Jšœ
œœ
˜ Jšœ
œœ
˜Jšœ
œœ
˜Jšœ#˜'—J˜—šŸœœ˜Jšœœ
˜Jš
œ	œ
œ
œ
œœœ˜IJšœœ
˜J˜—˜šŸœœœ˜!Jšœœ
˜J˜ š
˜J˜Jšœœ
œ
˜Jšœœ%œ	˜>Jšœœ
œ
˜(J˜J˜Jšœ
˜—J˜—J˜Jš
œ
œ
œ
œœ
˜6šœ
œ
œ˜J˜
J˜J˜J˜Jšœ˜	——J˜Jšœœ˜Jšœœœ˜-J˜
Jšœœ
˜šœœ
˜"J˜.—š
˜šœœ
˜Jšœœ	œœ˜6Jšœ
˜—Jšœ%œ˜Dš
˜š
˜J˜J˜Jšœœ
œ
œ˜(Jšœ œ
œ
˜,Jšœ
˜——Jšœ	œ
˜Jšœ
˜—J˜š	œœ

œ
œ˜+Jšœ#œ
œ
˜/šœ/œ˜7J˜-J˜/—Jšœ0˜4Jšœ
˜—J˜—J˜Jšœœ
˜Jšœ
œ
œ
˜J˜J˜Jšœœ˜+J˜Jš
œ&™&J˜Jšœ6œœ˜LJšœ7œœ˜M—˜J˜J˜J˜J˜J˜J˜J˜Jš
œ™J˜šŸœœ˜Jšœ(œœ˜>Jšœ(œœ˜>Jšœ(œœ˜>Jšœ)œœ˜?Jšœ(œœ˜>Jšœ(œœ˜?J˜—šŸœœ˜Jšœ'œœ˜=Jšœ'œœ˜=Jšœ'œœ˜=Jšœ(œœ˜=Jšœ'œœ˜=Jšœ'œœ˜>J˜—Jš
œ™J˜J˜Jšœœ
˜J˜Jšœœ
˜J˜šŸ
œœ˜+Jšœ	œ˜J˜-J˜(J˜—šŸœœ˜Jšœœ˜ J˜——˜šŸœœ
œ	œ˜6Jšœ
œ
˜Jšœœ
˜Jšœœ
œ
˜ šœœ˜3J˜$Jšœœ
œ
˜"Jšœ
˜—Jšœœœ
˜<J˜$šœ˜Jšœœ
œ˜*J˜J˜šœœ
ž˜)šœ˜Jšœœ
œ˜*J˜J˜Jšœ
˜——J˜Jšœœ
˜Jšœ
˜—Jšœœ˜1J˜—šŸœœ˜Jšœœ
˜˜˜%Jšœ,œœ˜@——J˜—šŸœœœœ˜DJ˜——˜šŸ
œœœœœ
œ˜Cšœœ
œ˜Kšœœ˜K˜K˜
Kš
œ˜Kš
œœ$œ
œœ˜JKš
œ˜Kšœ6œ˜DKš
œ˜—Kš
œ˜—J˜šŸ
œœ˜/šœ
œ
œ˜K˜K˜
šœœ$œ˜EKš
œ*˜*K˜$Kšœ˜K˜—K˜—K˜—šŸœœœœœœ˜9Jš
œ™Jšœœ˜J˜—š
Ÿœœœœœ˜0Jš
œ™Jšœœ
œ
œ%˜7Jš
œœœœœ
˜9J˜—šŸœœœœœœ˜7Jš
œ™Jšœ˜J˜—š
Ÿœœœœœ˜DJš
œA™AJšœ
˜šœ˜'˜šœ˜Jšœ#˜%J˜J˜Jšœ&˜(Jšœ)˜+Jšœœ
˜——šœœ˜Jšœœ˜(šœ˜Jš
˜Jšœœœ˜4J˜Jšœ
˜——šœ˜šœ˜Jšœœœœ˜EJšœ
˜—J˜——Jšœœ˜ J˜—šŸœœœ˜HJ˜šœœ
œ"˜7Jšœœ˜J˜!Jšœœ%œ˜CJšœœ ˜4J˜J˜>J˜Jšœ˜	—J˜—šŸœœœ˜HJ˜$šœœ
œ&˜;Jšœœ˜J˜!Jšœœ%œ˜CJšœœ ˜4J˜J˜>J˜Jšœ˜	—J˜—šŸœœœ˜"Jšœœ˜Jšœœœ˜Jšœœœ˜0J˜J˜"J˜J˜"J˜J˜—šŸ	œœ˜Jšœœ
œ˜HJš
œ*™*Jšœ
˜Jšœœ
˜šœœ˜%Jšœœ˜J˜*Jš
œ™J˜J˜šœœ˜šœœ˜J˜)Jš	œœœœœ˜F—J˜'J˜—šœœ˜J˜_—J˜šœœœ˜,J˜%J˜Jšœ˜—J˜2šœ˜˜	J˜Jšœœœ˜8Jšœ
œœ˜*š
œ
œœœœ˜3J˜%J˜5J˜——˜Jšœœ"˜,J˜J˜šœ˜J˜/J˜+˜J˜—˜	Jšœœ&˜:J˜—˜
Jšœœ&˜:J˜—Jšœ)˜0—Jšœ
œ˜'š
œ
œœœœ˜3J˜J˜8J˜——˜Jšœœœ˜!J˜J˜*J˜+J˜šœ˜˜&J˜)J˜J˜—šœ˜Jšœœ
˜šœ˜˜J˜J˜J˜—˜J˜)J˜J˜*J˜—˜
Jšœœ*˜>J˜J˜+—JšœC˜J—šœ˜J˜+J˜+J˜šœ
˜šœœ˜J˜J˜5J˜——Jšœ˜
————Jšœ
˜—J˜Jšœ˜	—J˜—˜Jšœ
œœœ˜6šœœœ˜Jšœœ
œ
œ˜4Jšœœœ
˜3Jšœ
œœ˜4—Jšœœœ
œ
œ
œ˜2——˜Jšœ$œ˜CJ˜šŸœœ	œ˜J˜ J˜#J˜-J˜-Jšœœœ˜?J˜——˜šŸœœœ˜J˜ J˜#J˜(J˜(Jšœœœ˜?J˜—J˜šŸ	œœœ˜!Jšœœœ˜3J˜J˜—šŸ
œœ˜J˜UJ˜ J˜&J˜J˜.J˜%Jšœ œ
œ
œ˜4˜8Jšœœ
œ˜0—J˜=š
˜J˜7˜
J˜5J˜——J˜—šŸ
œœ˜J˜)J˜&J˜$J˜8J˜J˜J˜
J˜J˜J˜—šŸ
œœ˜J˜&J˜#J˜1Jšœ˜J˜Jšœ
œ
˜Jšœœ
˜ ˜Jš
˜J˜5J˜+Jšœœ ˜@J˜J˜J˜J˜Jšœ
˜—šœ˜$J˜)—šœ
œ˜)J˜,—šœ˜Jšœœœ
˜Jšœœ˜J˜&J˜.J˜Jšœž˜+J˜$šœœ
œ˜Jšœ'œ
œ˜3—J˜&J˜J˜J˜Jšœ
œ*˜=J˜/J˜*J˜Jšœœ
œ
˜4——˜Jšœœ
œ˜&Jšœœ
œ˜%J˜J˜J˜šœœ
œ˜'J˜Jšœœœ
˜šœœ˜Jšœœœ˜0J˜"—šœœ˜-Jšœ œ˜?Jšœ)˜-—šœœ˜šœœ
˜(˜
Jšœœ˜šœœ˜'J˜Jšœœž(˜<—šœœ˜Jšœœ˜2J˜1J˜*J˜0J˜$J˜——šœ˜Jšœœ!˜-šœœ˜J˜Jšœœ˜.J˜+J˜#J˜2J˜/J˜—J˜———šœœ˜šœ
œ˜Jšœœ	˜Jšœœ˜,J˜7—J˜—J˜Jšœ
˜—Jšœœœ˜8Jšœœ	˜J˜J˜J˜J˜šœœ
œ˜Jšœœ˜.J˜/J˜&J˜$J˜'J˜—J˜
š
˜J˜B——J˜—˜šŸœœ˜J˜&Jš
œ0™0Jšœœ%˜LJ˜7J˜6J˜šœœ
œ˜1J˜J˜$J˜J˜0J˜Jšœ
˜—J˜AJšœœœ!˜>š	œ
œœ
œ˜3J˜J˜%J˜J˜1J˜Jšœ
˜—J˜ J˜—šŸœœ˜J˜&Jš
œ0™0Jšœœ%˜LJ˜7Jš
œD™D˜$Jšœ8œ˜FJ˜—šŸœœœ˜?J˜'Jšœœ
˜šœœ˜Jšœ0œ
˜5Jšœ
˜—šœœ˜Jšœœ˜Jšœœ$˜1šœœœ˜,šœœ
œ˜ J˜Jšœ
˜—J˜J˜&J˜J˜$J˜J˜,J˜šœ˜J˜@——Jšœ˜	—J˜—Jšœœœ
œ
˜%J˜IJšœ%œ
œ˜8J˜——J˜˜šŸœœ
œ˜J˜N˜1J˜——šŸœœ
œ1˜FJšœœ˜,J˜—šŸœœ
œ9˜VJšœœ˜.J˜—š
œ™J˜	——˜J˜—J˜—…—Vμqf