-- ListCode.mesa; edited by Sandman; September 29, 1980 9:21 AM
-- edited by Sandman; September 29, 1980 9:21 AM
-- edited by Sweet; 27-Oct-80 14:07:14
DIRECTORY
AltoDefs USING [BYTE, PageCount],
BcdDefs USING [Base, MTIndex],
BcdOps USING [BcdBase, MTHandle],
CommanderDefs USING [AddCommand, CommandBlockHandle],
ControlDefs USING [CSegPrefix, EntryVectorItem, FrameHandle, FrameVec],
InlineDefs USING [BITAND, BITOR, BITXOR, COPY],
IODefs USING [ControlZ, CR, NumberFormat, SP, WriteString],
ListerDefs,
Mopcodes USING [
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],
OpTableDefs USING [instaligned, instlength, InstName, popstack, pushstack],
OutputDefs USING [
CloseOutput, OpenOutput, PutChar, PutCR, PutNumber, PutString, PutSubString,
PutTab],
SegmentDefs USING [
DefaultVersion, DeleteFileSegment, FileNameError, FileSegmentAddress, NewFile,
Read, SwapError, SwapIn, Unlock],
StreamDefs USING [
CreateByteStream, SetIndex, StreamError, StreamHandle, StreamIndex],
String USING [AppendString, SubStringDescriptor],
Symbols USING [
BodyInfo, BodyRecord, BTIndex, BTNull, CBTIndex, HTIndex, HTNull, ISEIndex,
SENull],
SymbolSegment USING [FGTEntry],
SymbolTable USING [Acquire, Base, Release, TableForSegment],
Storage USING [Free, Node];
ListCode: PROGRAM
IMPORTS
CommanderDefs, InlineDefs, IODefs, ListerDefs, OpTableDefs, OutputDefs,
SegmentDefs, StreamDefs, Storage, String, SymbolTable
EXPORTS ListerDefs
SHARES SymbolTable =
BEGIN OPEN AltoDefs, OutputDefs;
MTIndex: TYPE = BcdDefs.MTIndex;
FileSegmentHandle: TYPE = ListerDefs.FileSegmentHandle;
FrameHandle: TYPE = ControlDefs.FrameHandle;
NumberFormat: TYPE = IODefs.NumberFormat;
opcode: TYPE = BYTE;
JumpOp: TYPE = [Mopcodes.zJ2..Mopcodes.zJIW];
InstWord: TYPE = MACHINE DEPENDENT RECORD [
SELECT COMPUTED BOOLEAN FROM
FALSE => [oddbyte, evenbyte: BYTE],
TRUE => [evenbyte, oddbyte: BYTE],
ENDCASE];
FineGrainInfo: TYPE = RECORD [
firstSource, lastSource: CARDINAL ← NullSource,
pc: CARDINAL,
procEnd: BOOLEAN,
bti: Symbols.CBTIndex];
NullSource: CARDINAL = LAST[CARDINAL]; -- if lastSource, causes to EOF
myFGT: DESCRIPTOR FOR ARRAY OF FineGrainInfo;
DigestFGT: PROCEDURE =
BEGIN OPEN s: symbols;
i, n: CARDINAL;
bti, prev: Symbols.BTIndex;
cspp: POINTER TO ControlDefs.CSegPrefix = codebase;
AddMyEntry: PROCEDURE [
source: CARDINAL ← NullSource, object: CARDINAL, procEnd: BOOLEAN ← FALSE] =
BEGIN
IF n = myFGTSize THEN
BEGIN
oldFGT: DESCRIPTOR FOR ARRAY OF FineGrainInfo = myFGT;
myFGTSize ← myFGTSize + 10;
SetupMyFGT[];
InlineDefs.COPY[
from: BASE[oldFGT], to: BASE[myFGT], nwords: n*SIZE[FineGrainInfo]];
Storage.Free[BASE[oldFGT]];
END;
myFGT[n] ←
[firstSource: source, pc: object, procEnd: procEnd, bti: LOOPHOLE[bti]];
n ← n + 1;
END;
AddBodyFGT: PROCEDURE [bti: Symbols.CBTIndex] =
BEGIN OPEN s: symbols;
body: POINTER TO Callable Symbols.BodyRecord = @s.bb[bti];
evi: POINTER TO ControlDefs.EntryVectorItem = @cspp.entry[body.entryIndex];
procstart: CARDINAL = evi.initialpc*2;
info: External Symbols.BodyInfo;
i, fgLast, lastSource, lastObject: CARDINAL;
f: SymbolSegment.FGTEntry;
WITH bi: body.info SELECT FROM External => info ← bi; ENDCASE => ERROR;
fgLast ← info.startIndex + info.indexLength - 1;
lastSource ← s.bb[bti].sourceIndex;
lastObject ← procstart;
FOR i IN [info.startIndex..fgLast] DO
f ← s.fgTable[i];
WITH f SELECT FROM
normal =>
BEGIN
lastSource ← lastSource + deltaSource;
lastObject ← lastObject + deltaObject;
AddMyEntry[source: lastSource, object: lastObject];
END;
step =>
IF which = source THEN lastSource ← lastSource + delta
ELSE lastObject ← lastObject + delta;
ENDCASE;
ENDLOOP;
AddMyEntry[object: procstart + info.bytes, procEnd: TRUE];
END;
SetupMyFGT: PROCEDURE =
BEGIN
myFGT ← DESCRIPTOR[Storage.Node[myFGTSize*SIZE[FineGrainInfo]], myFGTSize];
END;
BySource: PROCEDURE [r1, r2: POINTER TO FineGrainInfo] RETURNS [BOOLEAN] =
BEGIN
IF r1.firstSource > r2.firstSource THEN RETURN[TRUE];
IF r1.firstSource = r2.firstSource THEN RETURN[r1.pc > r2.pc];
RETURN[FALSE];
END;
ByPC: PROCEDURE [r1, r2: POINTER TO FineGrainInfo] RETURNS [BOOLEAN] =
BEGIN
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];
END;
Sort: PROCEDURE [
greater: PROCEDURE [r1, r2: POINTER TO FineGrainInfo] RETURNS [BOOLEAN]] =
BEGIN
i: CARDINAL;
temp: FineGrainInfo;
SiftUp: PROC [l, u: CARDINAL] =
BEGIN
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;
END;
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;
END;
myFGTSize: CARDINAL ← (3*LENGTH[s.fgTable])/2;
SetupMyFGT[];
n ← 0;
bti ← LOOPHOLE[0];
IF s.bb[bti].sourceIndex # 0 THEN
BEGIN
bti ← Symbols.BTNull;
AddMyEntry[source: 0, object: cspp.entry[0].initialpc*2];
bti ← LOOPHOLE[0];
END;
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;
myFGT ← DESCRIPTOR[BASE[myFGT], n]; -- set length correctly
Sort[BySource];
FOR i IN [0..n - 1) DO
IF myFGT[i].firstSource = NullSource THEN EXIT;
myFGT[i].lastSource ← myFGT[i + 1].firstSource; -- may be same
ENDLOOP;
Sort[ByPC];
END;
offset: CARDINAL;
codebase: POINTER;
codepages: PageCount;
symbols: SymbolTable.Base;
Tinst, Tbytes, Pinst, Pbytes: CARDINAL ← 0;
freqing: BOOLEAN ← FALSE;
absolute: BOOLEAN ← FALSE;
dStar: BOOLEAN ← FALSE;
-- number formats
decimal: NumberFormat = NumberFormat[
base: 10, columns: 1, zerofill: FALSE, unsigned: TRUE];
decimal3: NumberFormat = NumberFormat[
base: 10, columns: 3, zerofill: FALSE, unsigned: TRUE];
hoctal3: NumberFormat ← NumberFormat[
base: 8, columns: 3, zerofill: FALSE, unsigned: TRUE];
hoctal3z: NumberFormat ← NumberFormat[
base: 8, columns: 3, zerofill: TRUE, unsigned: TRUE];
hoctal5: NumberFormat ← NumberFormat[
base: 8, columns: 5, zerofill: FALSE, unsigned: TRUE];
hoctal6: NumberFormat ← NumberFormat[
base: 8, columns: 6, zerofill: FALSE, unsigned: TRUE];
hoctal1: NumberFormat ← NumberFormat[
base: 8, columns: 1, zerofill: FALSE, unsigned: TRUE];
-- set base for listings
Hexify: PROCEDURE =
BEGIN
hoctal3 ← NumberFormat[base: 16, columns: 3, zerofill: FALSE, unsigned: TRUE];
hoctal3z ← NumberFormat[
base: 16, columns: 3, zerofill: FALSE, unsigned: TRUE];
hoctal5 ← NumberFormat[base: 16, columns: 5, zerofill: FALSE, unsigned: TRUE];
hoctal6 ← NumberFormat[base: 16, columns: 6, zerofill: FALSE, unsigned: TRUE];
hoctal1 ← NumberFormat[base: 16, columns: 1, zerofill: FALSE, unsigned: TRUE];
END;
Octify: PROCEDURE =
BEGIN
hoctal3 ← NumberFormat[base: 8, columns: 3, zerofill: FALSE, unsigned: TRUE];
hoctal3z ← NumberFormat[base: 8, columns: 3, zerofill: TRUE, unsigned: TRUE];
hoctal5 ← NumberFormat[base: 8, columns: 5, zerofill: FALSE, unsigned: TRUE];
hoctal6 ← NumberFormat[base: 8, columns: 6, zerofill: FALSE, unsigned: TRUE];
hoctal1 ← NumberFormat[base: 8, columns: 1, zerofill: FALSE, unsigned: TRUE];
END;
-- generate list of opcode lengths
OpcodeLengths: PROCEDURE [root: STRING] =
BEGIN OPEN OpTableDefs;
i: opcode;
digit: STRING = "0123456789"L;
OpenOutput[root, ".list"L];
PutString[" OpcodeLengths: PACKED ARRAY [0..255] OF [0..3] = ["L];
FOR i IN opcode DO
IF i MOD 32 = 0 THEN {PutCR[]; PutString[" "L]};
PutChar[digit[instlength[i]]];
IF i # LAST[opcode] THEN PutChar[',];
ENDLOOP;
PutString["];"];
PutCR[];
CloseOutput[];
END;
-- generate list of opcodes
OpcodeList: PROCEDURE [root: STRING] =
BEGIN OPEN OpTableDefs;
op: STRING;
length: [0..3];
i: opcode;
digit: STRING = "0123456789"L;
OpenOutput[root, ".list"L];
PutString[
"-- Mesa Opcodes
-- Format: name hoctal(decimal)push,pop,length,aligned
"L];
FOR i IN opcode DO
op ← InstName[i];
IF (length ← instlength[i]) = 0 THEN op.length ← 0;
PutString[op];
THROUGH (op.length..8] DO PutChar[' ] ENDLOOP;
PutNumber[i, hoctal3];
PutChar['(];
PutNumber[i, decimal3];
PutChar[')];
PutChar[digit[pushstack[i]]];
PutChar[',];
PutChar[digit[popstack[i]]];
PutChar[',];
PutChar[digit[length]];
PutChar[',];
PutChar[IF instaligned[i] THEN 'T ELSE 'F];
IF i MOD 4 = 3 THEN BEGIN PutChar[';]; PutCR[] END ELSE PutString["; "L];
ENDLOOP;
CloseOutput[];
END;
-- source file procedures
SourceStream: StreamDefs.StreamHandle;
sourceavailable: BOOLEAN;
outcheck: PROCEDURE [xfirst: CARDINAL, xlast: CARDINAL] =
BEGIN OPEN StreamDefs;
nextchar: CHARACTER;
lastcr: CARDINAL;
IF ~sourceavailable THEN RETURN;
FOR lastcr ← xfirst, lastcr - 1 UNTIL lastcr = 0 DO
SetIndex[SourceStream, [0, lastcr]];
IF SourceStream.get[SourceStream] = IODefs.CR THEN EXIT;
ENDLOOP;
THROUGH (lastcr..xfirst) DO PutChar[IODefs.SP] ENDLOOP;
SetIndex[SourceStream, StreamIndex[0, xfirst]];
WHILE xfirst # xlast DO
nextchar ← SourceStream.get[SourceStream ! StreamError => GOTO eof];
xfirst ← xfirst + 1;
IF nextchar = IODefs.ControlZ THEN
WHILE nextchar # IODefs.CR DO
nextchar ← SourceStream.get[SourceStream ! StreamError => GOTO eof];
xfirst ← xfirst + 1;
ENDLOOP;
PutChar[nextchar];
REPEAT eof => NULL;
ENDLOOP;
IF nextchar # IODefs.CR THEN PutChar[IODefs.CR];
END;
setupsource: PROCEDURE =
BEGIN OPEN SegmentDefs;
sourceavailable ← TRUE;
SourceStream ← StreamDefs.CreateByteStream[
NewFile[
symbols.sourceFile, Read, DefaultVersion !
FileNameError => BEGIN sourceavailable ← FALSE; CONTINUE END], Read];
END;
closesource: PROCEDURE =
BEGIN IF sourceavailable THEN SourceStream.destroy[SourceStream] END;
PrintBodyName: PROCEDURE [bti: Symbols.BTIndex] =
BEGIN OPEN String, Symbols, symbols;
sei: ISEIndex;
hti: HTIndex;
ss: SubStringDescriptor;
IF sourceavailable THEN RETURN;
WITH bb[bti] SELECT FROM
Callable =>
IF (sei ← id) = SENull OR (hti ← seb[sei].hash) = HTNull THEN RETURN;
ENDCASE => RETURN;
SubStringForHash[@ss, hti];
PutSubString[@ss];
PutChar[':];
PutCR[];
END;
EvenUp: PROCEDURE [n: CARDINAL] RETURNS [CARDINAL] =
-- Round up to an even number
BEGIN RETURN[n + n MOD 2]; END;
getbyte: PROCEDURE [pc: CARDINAL] RETURNS [b: BYTE] =
-- pc is a byte address
BEGIN OPEN InlineDefs;
w: POINTER TO InstWord;
IF absolute THEN
BEGIN
w ← LOOPHOLE[pc/2];
b ←
IF BITAND[pc, 1] = 0 THEN
(WITH w SELECT dStar FROM
FALSE => evenbyte,
TRUE => evenbyte,
ENDCASE => 0)
ELSE
(WITH w SELECT dStar FROM
FALSE => oddbyte,
TRUE => oddbyte,
ENDCASE => 0);
END
ELSE
BEGIN
w ← codebase + pc/2;
b ←
IF BITAND[pc, 1] = 0 THEN
(WITH w SELECT dStar FROM
FALSE => evenbyte,
TRUE => evenbyte,
ENDCASE => 0)
ELSE
(WITH w SELECT dStar FROM
FALSE => oddbyte,
TRUE => oddbyte,
ENDCASE => 0);
END;
END;
getword: PROCEDURE [pc: CARDINAL] RETURNS [WORD] =
-- pc is a word address
BEGIN
IF absolute THEN RETURN[LOOPHOLE[pc, POINTER]↑];
RETURN[(codebase + pc)↑];
END;
jumpaddress: PROCEDURE [jop: opcode, arg: INTEGER] RETURNS [CARDINAL] =
BEGIN -- given a jump operator and its argument, return
-- its target address
OPEN Mopcodes;
SELECT OpTableDefs.instlength[
jop] FROM
1 =>
SELECT jop FROM
IN [zJ2..zJ9] => arg ← jop - zJ2 + 2;
IN [zJEQ2..zJEQ9] => arg ← jop - zJEQ2 + 2;
IN [zJNE2..zJNE9] => arg ← jop - zJNE2 + 2;
ENDCASE => ERROR;
2 =>
BEGIN
IF arg > 177B THEN arg ← InlineDefs.BITOR[arg, 177400B];
IF dStar THEN arg ← arg - 1;
END;
ENDCASE => IF dStar THEN arg ← arg - 2;
RETURN[INTEGER[offset] + arg]
END;
outwjtab: PROCEDURE [
tabstart, tablength: CARDINAL, octal: BOOLEAN, stripped: BOOLEAN] =
BEGIN
w: INTEGER;
pc: CARDINAL;
Pbytes ← Pbytes + tablength*2;
FOR pc IN [tabstart..tabstart + tablength) DO
w ← getword[pc];
PutCR[];
PutTab[];
PutTab[];
IF stripped THEN BEGIN PutNumber[w, hoctal5]; LOOP END;
IF octal THEN BEGIN PutTab[]; PutTab[]; END;
PutString[" ("L];
PutNumber[jumpaddress[Mopcodes.zJIW, w], hoctal5];
PutChar[')];
ENDLOOP;
END;
outbjtab: PROCEDURE [
tabstart, tablength: CARDINAL, octal: BOOLEAN, stripped: BOOLEAN] =
BEGIN
b: BYTE;
pc: CARDINAL;
Pbytes ← Pbytes + EvenUp[tablength];
FOR pc IN [tabstart*2..tabstart*2 + tablength) DO
b ← getbyte[IF dStar THEN pc ELSE InlineDefs.BITXOR[pc, 1]];
-- bytes "backwards"
PutCR[];
PutTab[];
PutTab[];
IF stripped THEN BEGIN PutNumber[b, hoctal5]; LOOP END;
IF octal THEN BEGIN PutTab[]; PutTab[]; END;
PutString[" ("L];
PutNumber[jumpaddress[Mopcodes.zJIB, b], hoctal5];
PutChar[')];
ENDLOOP;
END;
PutPair: PROCEDURE [byte: CARDINAL] =
BEGIN
a: CARDINAL = byte/16;
b: CARDINAL = byte MOD 16;
IF a < 8 AND b < 8 THEN PutChar[IODefs.SP];
PutChar['[];
PutNumber[a, hoctal1];
PutChar[',];
PutNumber[b, hoctal1];
PutChar[']];
RETURN
END;
printcode: PROCEDURE [
startcode, endcode: CARDINAL, octal: BOOLEAN, stripped: BOOLEAN] =
BEGIN -- list opcodes for indicated segment of code
OPEN InlineDefs, Mopcodes;
inst, byte: BYTE;
lastconstant, v: INTEGER;
il: [0..3];
FOR offset IN [startcode..endcode) DO
inst ← getbyte[offset];
-- loginst[inst];
Pinst ← Pinst + 1;
PutTab[];
IF ~stripped THEN
BEGIN
IF octal THEN
BEGIN
PutNumber[offset/2, hoctal5];
PutString[(IF offset MOD 2 = 0 THEN ",E " ELSE ",O ")];
END;
PutNumber[offset, hoctal5];
PutChar[':];
END;
IF octal THEN
BEGIN PutTab[]; PutChar['[]; PutNumber[inst, hoctal3z]; PutChar[']]; END;
PutTab[];
PutString[OpTableDefs.InstName[inst]];
il ← OpTableDefs.instlength[inst];
IF ~dStar AND OpTableDefs.instaligned[inst] AND il # 2 AND
(offset + il) MOD 2 # 0 THEN
BEGIN
byte ← getbyte[offset ← offset + 1];
IF byte = 377B THEN PutChar['*]
ELSE BEGIN PutString[" <"L]; PutNumber[byte, hoctal3]; PutChar['>]; END;
Pbytes ← Pbytes + 1;
END;
SELECT il FROM
0, 1 =>
BEGIN
Pbytes ← Pbytes + 1;
IF inst IN [zLI0..zLI6] THEN lastconstant ← inst - zLI0
ELSE
IF inst IN JumpOp AND ~stripped THEN
BEGIN
PutTab[];
PutString[" ("L];
PutNumber[jumpaddress[inst, 0], hoctal1];
PutChar[')];
END;
END;
2 =>
BEGIN
Pbytes ← Pbytes + 2;
byte ← getbyte[(offset ← offset + 1)];
PutTab[];
SELECT inst FROM
zRILP, zWILP, zRXLP, zWXLP, zRIGP, zRXLPL, zWXLPL, zRXGPL, zWXGPL,
zRILPL, zWILPL, zRIGPL, zWIGPL => PutPair[byte];
ENDCASE => PutNumber[byte, hoctal6];
IF inst = zLIB THEN lastconstant ← byte
ELSE
IF inst IN JumpOp AND ~stripped THEN
BEGIN
PutString[" ("L];
PutNumber[jumpaddress[inst, byte], hoctal1];
PutChar[')];
END;
END;
3 =>
BEGIN
ab: RECORD [first, second: BYTE];
Pbytes ← Pbytes + 3;
IF dStar THEN
BEGIN
ab.first ← getbyte[(offset ← offset + 1)];
ab.second ← getbyte[(offset ← offset + 1)];
END
ELSE
BEGIN
ab.second ← getbyte[(offset ← offset + 1)];
ab.first ← getbyte[(offset ← offset + 1)];
END;
PutTab[];
SELECT inst FROM
zRF, zWF, zWSF, zRFC, zRFL, zWFL =>
BEGIN
PutNumber[ab.first, hoctal6];
PutString[", "L];
PutPair[ab.second];
END;
ENDCASE =>
BEGIN
PutNumber[(v ← ab.first*256 + ab.second), hoctal6];
SELECT inst FROM
zJIB => outbjtab[v, lastconstant, octal, stripped];
zJIW => outwjtab[v, lastconstant, octal, stripped];
zLIW => lastconstant ← v;
IN JumpOp =>
IF ~stripped THEN
BEGIN
PutString[" ("L];
PutNumber[jumpaddress[inst, v], hoctal1];
PutChar[')];
END;
ENDCASE;
END;
END;
ENDCASE;
PutCR[];
ENDLOOP;
END;
ListFile: PROCEDURE [root: STRING, octal, stripped: BOOLEAN] =
BEGIN OPEN String, SegmentDefs, symbols, Symbols;
i: CARDINAL;
cseg, sseg, bcdseg: FileSegmentHandle;
bcdFile: STRING ← [40];
AppendString[bcdFile, root];
FOR i IN [0..root.length) DO
IF root[i] = '. THEN EXIT;
REPEAT FINISHED => AppendString[bcdFile, ".bcd"L];
ENDLOOP;
[cseg, sseg, bcdseg] ← ListerDefs.Load[bcdFile, TRUE];
DoCodeListing[root, cseg, sseg, bcdseg, FIRST[MTIndex], octal, stripped];
END;
ListModInConfig: PROCEDURE [config, module: STRING, octal, stripped: BOOLEAN] =
BEGIN OPEN String, SegmentDefs, symbols, Symbols;
i: CARDINAL;
cseg, sseg, bcdseg: FileSegmentHandle;
bcdFile: STRING ← [40];
mti: BcdDefs.MTIndex;
AppendString[bcdFile, config];
FOR i IN [0..config.length) DO
IF config[i] = '. THEN EXIT;
REPEAT FINISHED => AppendString[bcdFile, ".bcd"L];
ENDLOOP;
[cseg, sseg, bcdseg, mti] ← ListerDefs.LoadFromConfig[bcdFile, module, TRUE];
DoCodeListing[module, cseg, sseg, bcdseg, mti, octal, stripped];
END;
ShowTotals: PROCEDURE =
BEGIN OPEN String, SegmentDefs, symbols, Symbols;
PutString["Instructions: "L];
PutNumber[Pinst, decimal];
PutString[", Bytes: "L];
PutNumber[Pbytes ← EvenUp[Pbytes], decimal];
PutCR[];
PutCR[];
Tinst ← Tinst + Pinst;
Pinst ← 0;
Tbytes ← Tbytes + Pbytes;
Pbytes ← 0;
END;
DoCodeListing: PROC [
root: STRING, cseg, sseg, bcdseg: FileSegmentHandle, mti: MTIndex,
octal, stripped: BOOLEAN] =
BEGIN OPEN BcdDefs, Symbols, SegmentDefs;
i: CARDINAL;
cspp: POINTER TO ControlDefs.CSegPrefix;
ff: FineGrainInfo;
bcd: BcdOps.BcdBase;
mth: BcdOps.MTHandle;
prevBti: BTIndex ← BTNull;
SwapIn[bcdseg];
bcd ← FileSegmentAddress[bcdseg];
mth ← @LOOPHOLE[bcd + bcd.mtOffset, Base][mti];
SwapIn[cseg];
codebase ← FileSegmentAddress[cseg] + mth.code.offset;
codepages ← cseg.pages;
cspp ← codebase;
dStar ← ~cspp.header.info.altoCode;
symbols ← SymbolTable.Acquire[SymbolTable.TableForSegment[sseg]];
ListerDefs.SetRoutineSymbols[symbols];
setupsource[];
OpenOutput[root, ".cl"L];
ListerDefs.WriteFileID[];
IF dStar THEN BEGIN PutCR[]; PutString["D* Format"L]; PutCR[]; END;
IF mth.crossJumped THEN
BEGIN PutCR[]; PutString["Cross Jumped"L]; PutCR[]; END;
PutString["Global frame size: "L];
PutNumber[mth.framesize, decimal];
PutCR[];
PutCR[];
Unlock[bcdseg];
DeleteFileSegment[bcdseg];
Tbytes ← Tinst ← 0;
DigestFGT[];
FOR i IN [0..LENGTH[myFGT]) DO
ff ← myFGT[i];
IF ff.bti # prevBti AND prevBti # BTNull THEN ShowTotals[];
IF ff.firstSource # NullSource THEN
IF ff.lastSource = ff.firstSource THEN PutCR[]
ELSE outcheck[ff.firstSource, ff.lastSource];
IF ff.bti # prevBti THEN
BEGIN
ep: CARDINAL = symbols.bb[ff.bti].entryIndex;
evi: POINTER TO ControlDefs.EntryVectorItem = @cspp.entry[ep];
fsize: CARDINAL = ControlDefs.FrameVec[evi.info.framesize];
PrintBodyName[ff.bti];
IF octal THEN PutTab[];
PutString[" Entry point: "L];
PutNumber[ep, decimal];
PutString[", Frame size: "L];
PutNumber[fsize, decimal];
PutCR[];
END;
IF ~ff.procEnd THEN printcode[ff.pc, myFGT[i + 1].pc, octal, stripped];
PutCR[];
prevBti ← ff.bti;
ENDLOOP;
IF prevBti # Symbols.BTNull THEN ShowTotals[];
Storage.Free[BASE[myFGT]];
SymbolTable.Release[symbols];
DeleteFileSegment[sseg ! SwapError => CONTINUE];
Unlock[cseg];
DeleteFileSegment[cseg ! SwapError => CONTINUE];
closesource[];
PutCR[];
IF octal THEN PutTab[];
PutString["Total instructions: "L];
PutNumber[Tinst, decimal];
PutString[", Bytes: "L];
PutNumber[Tbytes, decimal];
PutCR[];
CloseOutput[];
END;
LCode: PROCEDURE [name: STRING, octal, stripped: BOOLEAN] =
BEGIN OPEN ListerDefs;
ListFile[
name, octal, stripped !
NoCode => BEGIN IODefs.WriteString["Code not available"L]; CONTINUE END;
NoSymbols =>
BEGIN IODefs.WriteString["Symbols not available"L]; CONTINUE END;
NoFGT, IncorrectVersion =>
BEGIN IODefs.WriteString["Bad format"L]; CONTINUE END;
SegmentDefs.FileNameError =>
BEGIN IODefs.WriteString["File not found"L]; CONTINUE END];
END;
Code: PROCEDURE [name: STRING] = BEGIN LCode[name, FALSE, FALSE]; END;
OctalCode: PROCEDURE [name: STRING] = BEGIN LCode[name, TRUE, FALSE]; END;
StrippedCode: PROCEDURE [name: STRING] = BEGIN LCode[name, FALSE, TRUE]; END;
LCodeInConfig: PROCEDURE [config, name: STRING, octal, stripped: BOOLEAN] =
BEGIN OPEN ListerDefs;
ListModInConfig[
config, name, octal, stripped !
NoCode => BEGIN IODefs.WriteString["Code not available"L]; CONTINUE END;
NoSymbols =>
BEGIN IODefs.WriteString["Symbols not available"L]; CONTINUE END;
NoFGT, IncorrectVersion =>
BEGIN IODefs.WriteString["Bad format"L]; CONTINUE END;
SegmentDefs.FileNameError =>
BEGIN IODefs.WriteString["File not found"L]; CONTINUE END];
END;
CodeInConfig: PROCEDURE [config, name: STRING] =
BEGIN LCodeInConfig[config, name, FALSE, FALSE]; END;
OctalCodeInConfig: PROCEDURE [config, name: STRING] =
BEGIN LCodeInConfig[config, name, TRUE, FALSE]; END;
StrippedCodeInConfig: PROCEDURE [config, name: STRING] =
BEGIN LCodeInConfig[config, name, FALSE, TRUE]; END;
Init: PROCEDURE =
BEGIN
command: CommanderDefs.CommandBlockHandle;
command ← CommanderDefs.AddCommand["Hexify", LOOPHOLE[Hexify], 0];
command ← CommanderDefs.AddCommand["Octify", LOOPHOLE[Octify], 0];
command ←
CommanderDefs.AddCommand["OpcodeLengths", LOOPHOLE[OpcodeLengths], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderDefs.AddCommand["OpcodeList", LOOPHOLE[OpcodeList], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderDefs.AddCommand["OctalCode", LOOPHOLE[OctalCode], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderDefs.AddCommand["Code", LOOPHOLE[Code], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderDefs.AddCommand["StrippedCode", LOOPHOLE[StrippedCode], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderDefs.AddCommand[
"OctalCodeInConfig", LOOPHOLE[OctalCodeInConfig], 2];
command.params[0] ← [type: string, prompt: "ConfigName"];
command.params[1] ← [type: string, prompt: "ModName"];
command ← CommanderDefs.AddCommand["CodeInConfig", LOOPHOLE[CodeInConfig], 2];
command.params[0] ← [type: string, prompt: "ConfigName"];
command.params[1] ← [type: string, prompt: "ModName"];
command ← CommanderDefs.AddCommand[
"StrippedCodeInConfig", LOOPHOLE[StrippedCodeInConfig], 2];
command.params[0] ← [type: string, prompt: "ConfigName"];
command.params[1] ← [type: string, prompt: "ModName"];
END;
Init[];
END. of listcode