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