DIRECTORY
Ascii USING [CR],
BcdDefs,
BcdOps,
CommanderOps USING [AddCommand, CommandBlockHandle],
FileSegment: TYPE USING [Pages],
FileStream: TYPE USING [Create, EndOf],
Format,
GSort USING [CompareProcType, Port, PutProcType, Sort, SortItemPort, SortStarter, SortStopper],
Heap: TYPE USING [systemZone],
ListerDefs
USING [
IncorrectVersion, Load, MapPages, MultipleModules, NoCode, NoFGT, NoFile,
NoSymbols, SetRoutineSymbols, WriteChar, WriteLine, WriteString],
LongString
USING [
AppendChar, AppendString, AppendSubString, CompareStrings, EquivalentString,
SubString, SubStringDescriptor, WordsForString],
Mopcodes
USING [
zEFC0, zEFC15, zEFCB, zJ2, zJIW, zLADRB, zLFC1, zLFC16, zLFCB, zLLB, zNOOP, zSFC],
OpTableDefs USING [InstAligned, InstLength],
OSMiscOps: TYPE USING [FileError, FindFile],
OutputDefs USING [CloseOutput, OpenOutput, PutCR, PutLongString, PutString],
PrincOps USING [CSegPrefix, FrameHandle],
Space: TYPE USING [Handle, Delete, LongPointer],
Stream: TYPE USING [Delete, GetChar, Handle],
Symbols
USING [
BitAddress, BTIndex, BTNull, CTXIndex, HTIndex, ISEIndex, ISENull, SENull],
SymbolTable USING [Acquire, Base, Release];
ListXref:
PROGRAM
IMPORTS
CommanderOps, FileStream, GSort, Heap, ListerDefs, Strings: LongString,
OpTableDefs, OSMiscOps, OutputDefs, Space, Stream, SymbolTable =
BEGIN OPEN ListerDefs, OutputDefs;
FrameHandle: TYPE = PrincOps.FrameHandle;
NumberFormat: TYPE = Format.NumberFormat;
BYTE: TYPE = [0..256);
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];
offset: CARDINAL;
codebase: LONG POINTER;
codepages: CARDINAL;
symbols: SymbolTable.Base;
Tinst, Tbytes, Pinst, Pbytes: CARDINAL ← 0;
dStar: BOOLEAN ← FALSE;
KeyBase: TYPE = LONG BASE POINTER TO SortKey;
SortKey:
TYPE =
RECORD [
callee: KeyBase RELATIVE POINTER TO StringBody, caller: StringBody];
buffer: KeyBase;
callerName: STRING ← [80];
moduleName: STRING ← [40];
RecordLocal:
PROCEDURE [ep:
CARDINAL] =
BEGIN OPEN Strings;
desc: SubStringDescriptor;
buffer^ ← [callee: NULL, caller: [length: 0, maxlength: 100, text:]];
AppendString[@buffer.caller, callerName];
buffer.callee ← LOOPHOLE[WordsForString[buffer.caller.length] + 1];
buffer[buffer.callee] ← [length: 0, maxlength: 100, text:];
IF epMap = NIL THEN ERROR;
symbols.SubStringForName[@desc, epMap[ep]];
AppendSubString[@buffer[buffer.callee], @desc];
AppendString[@buffer[buffer.callee], moduleName];
buffer ← OutToSort[
WordsForString[buffer.caller.length] + WordsForString[
buffer[buffer.callee].length] + 1];
END;
RecordExternal:
PROCEDURE [link:
CARDINAL] =
BEGIN OPEN Strings;
desc: SubStringDescriptor;
offset: CARDINAL;
buffer^ ← [callee: NULL, caller: [length: 0, maxlength: 100, text:]];
AppendString[@buffer.caller, callerName];
buffer.callee ← LOOPHOLE[WordsForString[buffer.caller.length] + 1];
buffer[buffer.callee] ← [length: 0, maxlength: 100, text:];
IF linkMap = NIL THEN ERROR;
symbols.SubStringForName[@desc, linkMap[link].hti];
AppendSubString[@buffer[buffer.callee], @desc];
AppendChar[@buffer[buffer.callee], '[];
offset ← linkMap[link].ssd.offset;
FOR i:
CARDINAL
IN [0 .. linkMap[link].ssd.length)
DO
AppendChar[@buffer[buffer.callee], linkMap[link].ssd.base[offset+i]]
ENDLOOP;
AppendChar[@buffer[buffer.callee], ']];
buffer ← OutToSort[
WordsForString[buffer.caller.length] + WordsForString[
buffer[buffer.callee].length] + 1];
END;
RecordUnknown:
PROCEDURE =
BEGIN OPEN Strings;
buffer^ ← [callee: NULL, caller: [length: 0, maxlength: 100, text:]];
AppendString[@buffer.caller, callerName];
buffer.callee ← LOOPHOLE[WordsForString[buffer.caller.length] + 1];
buffer[buffer.callee] ← [length: 1, maxlength: 100, text:];
buffer[buffer.callee].text[0] ← '*;
buffer ← OutToSort[WordsForString[buffer.caller.length] + 3 + 1];
END;
CompareCallers:
PROCEDURE [p1, p2:
LONG
POINTER]
RETURNS [i:
INTEGER] =
BEGIN
k1: KeyBase = p1;
k2: KeyBase = p2;
i ← Strings.CompareStrings[@k1.caller, @k2.caller];
IF i = 0 THEN i ← Strings.CompareStrings[@k1[k1.callee], @k2[k2.callee]];
END;
CompareCallees:
PROCEDURE [p1, p2:
LONG
POINTER]
RETURNS [i:
INTEGER] =
BEGIN
k1: KeyBase = p1;
k2: KeyBase = p2;
i ← Strings.CompareStrings[@k1[k1.callee], @k2[k2.callee]];
IF i = 0 THEN i ← Strings.CompareStrings[@k1.caller, @k2.caller];
END;
lastMajor: STRING ← [80];
lastMinor: STRING ← [80];
onThisLine: CARDINAL ← 0;
MaxOnLine: CARDINAL ← 80;
first: BOOLEAN ← TRUE;
NextItem:
PROCEDURE [major, minor:
LONG
STRING] =
BEGIN OPEN OutputDefs;
IF ~Strings.EquivalentString[major, lastMajor]
THEN
BEGIN
PutCR[];
PutCR[];
PutLongString[major];
PutCR[];
PutString[" "L];
onThisLine ← 4;
first ← TRUE;
lastMajor.length ← 0;
Strings.AppendString[lastMajor, major];
END;
IF ~first
THEN
BEGIN
IF Strings.EquivalentString[minor, lastMinor] THEN RETURN;
PutString[", "L];
onThisLine ← onThisLine + 2;
IF onThisLine + minor.length > MaxOnLine
THEN
{PutCR[]; PutString[" "L]; onThisLine ← 4};
END;
PutLongString[minor];
onThisLine ← onThisLine + minor.length;
lastMinor.length ← 0;
Strings.AppendString[lastMinor, minor];
first ← FALSE;
END;
PutByCaller:
PROCEDURE [p:
LONG
POINTER, len:
CARDINAL] =
BEGIN
key: KeyBase = p;
NextItem[major: @key.caller, minor: @key[key.callee]];
END;
PutByCallee:
PROCEDURE [p:
LONG
POINTER, len:
CARDINAL] =
BEGIN
key: KeyBase = p;
NextItem[major: @key[key.callee], minor: @key.caller];
END;
EPList: TYPE = RECORD [SEQUENCE length: NAT OF Symbols.HTIndex];
epMap: LONG POINTER TO EPList ← NIL;
CreateEpMap:
PROCEDURE =
BEGIN
n: CARDINAL ← 0;
Count:
PROCEDURE [bti: Symbols.BTIndex]
RETURNS [stop:
BOOLEAN] =
BEGIN
stop ← FALSE;
WITH b: symbols.bb[bti]
SELECT
FROM
Callable => IF ~b.inline THEN n ← MAX[b.entryIndex, n];
ENDCASE;
END;
Enter:
PROCEDURE [bti: Symbols.BTIndex]
RETURNS [stop:
BOOLEAN] =
BEGIN
stop ← FALSE;
WITH b: symbols.bb[bti]
SELECT
FROM
Callable =>
IF ~b.inline THEN epMap[b.entryIndex] ← symbols.NameForSe[b.id];
ENDCASE;
END;
[] ← symbols.EnumerateBodies[FIRST[Symbols.BTIndex], Count];
epMap ← (Heap.systemZone).NEW[EPList[n+1]];
[] ← symbols.EnumerateBodies[FIRST[Symbols.BTIndex], Enter];
END;
LinkMapItem:
TYPE =
RECORD [
hti: Symbols.HTIndex,
ssd: Strings.SubStringDescriptor];
LinkList: TYPE = RECORD [SEQUENCE length: NAT OF LinkMapItem];
linkMap: LONG POINTER TO LinkList ← NIL;
CreateLinkMap:
PROCEDURE =
BEGIN
m: CARDINAL ← 0;
FindMax:
PROCEDURE [sei: Symbols.ISEIndex, mname: Strings.SubString] =
BEGIN OPEN symbols;
IF seb[sei].linkSpace
AND ~seb[sei].constant
AND ~seb[sei].extended
THEN
BEGIN a: Symbols.BitAddress = seb[sei].idValue; m ← MAX[m, a.wd]; END;
END;
Insert:
PROCEDURE [sei: Symbols.ISEIndex, mname: Strings.SubString] =
BEGIN OPEN symbols;
IF seb[sei].linkSpace
AND ~seb[sei].constant
AND ~seb[sei].extended
THEN
BEGIN
a: Symbols.BitAddress = seb[sei].idValue;
linkMap[a.wd] ← [symbols.NameForSe[sei], mname^];
END;
END;
GenImports[FindMax];
linkMap ← (Heap.systemZone).NEW[LinkList[m + 1]];
GenImports[Insert];
END;
GenCtx:
PROCEDURE [ctx: Symbols.CTXIndex, p:
PROCEDURE [Symbols.ISEIndex]] =
BEGIN OPEN Symbols, symbols;
sei: ISEIndex;
FOR sei ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = SENull DO p[sei]; ENDLOOP;
END;
GenImports:
PROCEDURE [
action: PROC [sei: Symbols.ISEIndex, mname: Strings.SubString]] =
BEGIN OPEN Symbols, symbols;
sei: ISEIndex;
ctx: CTXIndex;
modnameSS: Strings.SubStringDescriptor;
DoAction: PROCEDURE [sei: ISEIndex] = BEGIN action[sei, @modnameSS]; END;
FOR sei ← FirstCtxSe[stHandle.importCtx], NextSe[sei]
UNTIL sei = ISENull
DO
SubStringForName[@modnameSS, seb[sei].hash];
WITH seb[UnderType[seb[sei].idType]]
SELECT
FROM
definition =>
BEGIN
isei: ISEIndex;
ctx ← defCtx;
FOR isei ← FirstCtxSe[stHandle.importCtx], NextSe[isei]
UNTIL isei =
ISENull DO
WITH seb[UnderType[seb[isei].idType]]
SELECT
FROM
definition =>
WITH ctxb[defCtx]
SELECT
FROM
imported =>
IF includeLink = ctx THEN BEGIN ctx ← defCtx; EXIT END;
ENDCASE;
ENDCASE;
ENDLOOP;
END;
ENDCASE;
GenCtx[ctx, DoAction];
WITH ctxb[ctx]
SELECT
FROM
included => NULL;
imported => GenCtx[includeLink, DoAction];
ENDCASE => LOOP; -- main body
ENDLOOP;
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
w: LONG POINTER TO InstWord;
w ← codebase + pc/2;
b ←
IF pc MOD 2 = 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;
getword:
PROCEDURE [pc:
CARDINAL]
RETURNS [
WORD] =
pc is a word address
BEGIN RETURN[(codebase + pc)^]; END;
ExamineCode:
PROCEDURE [startcode, endcode:
CARDINAL] =
BEGIN -- list opcodes for indicated segment of code
OPEN Mopcodes;
inst, byte, lastInst: BYTE;
il: [0..3];
lastInst ← zNOOP;
FOR offset
IN [startcode..endcode)
DO
lastInst ← inst;
inst ← getbyte[offset];
il ← OpTableDefs.InstLength[inst];
IF ~dStar
AND OpTableDefs.InstAligned[inst]
AND (offset + il)
MOD 2 # 0
THEN
[] ← getbyte[offset ← offset + 1];
SELECT il
FROM
0, 1 =>
SELECT inst
FROM
IN [zLFC1..zLFC16] => RecordLocal[inst - zLFC1 + 1];
IN [zEFC0..zEFC15] => RecordExternal[inst - zEFC0];
zSFC => IF ~(lastInst = zLADRB OR (lastInst = zLLB AND byte = 2)) THEN RecordUnknown[];
ENDCASE;
2 =>
BEGIN
byte ← getbyte[(offset ← offset + 1)];
SELECT inst
FROM
zLFCB => RecordLocal[byte];
zEFCB => RecordExternal[byte];
ENDCASE;
END;
3 =>
BEGIN
[] ← getbyte[(offset ← offset + 1)];
[] ← getbyte[(offset ← offset + 1)];
END;
ENDCASE;
ENDLOOP;
END;
ProcessFile:
PROCEDURE [root:
STRING] =
BEGIN OPEN Strings, symbols, Symbols;
i: CARDINAL;
cseg, sseg, bcdseg: FileSegment.Pages;
codeSpace, bcdSpace: Space.Handle;
bcd: BcdOps.BcdBase;
mth: BcdOps.MTHandle;
bcdFile: STRING ← [40];
cspp: LONG POINTER TO PrincOps.CSegPrefix;
prevBti: BTIndex ← BTNull;
desc: SubStringDescriptor;
SearchBody:
PROCEDURE [bti: BTIndex]
RETURNS [stop:
BOOLEAN] =
BEGIN
ipc: CARDINAL;
WITH b: symbols.bb[bti]
SELECT
FROM
Callable =>
IF ~b.inline
THEN
BEGIN
desc: SubStringDescriptor;
hti: HTIndex = symbols.NameForSe[b.id];
symbols.SubStringForName[@desc, hti];
callerName.length ← 0;
AppendSubString[callerName, @desc];
AppendString[callerName, moduleName];
ipc ← cspp.entry[b.entryIndex].initialpc*2;
WITH bi: b.info
SELECT
FROM
External => IF bi.bytes # 0 THEN ExamineCode[ipc, ipc + bi.bytes];
ENDCASE => ERROR;
END;
ENDCASE;
RETURN[FALSE]
END;
AppendString[bcdFile, root];
FOR i
IN [0..root.length)
DO
IF root[i] = '. THEN {bcdFile.length ← i; EXIT}; ENDLOOP;
AppendString[bcdFile, ".bcd"L];
BEGIN OPEN ListerDefs;
[cseg, sseg, bcdseg] ← Load[bcdFile !
NoFGT => RESUME ; NoCode => GO TO badformat;
NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
NoFile => GOTO badname];
bcdSpace ← MapPages[bcdseg];
bcd ← bcdSpace.LongPointer;
mth ← @LOOPHOLE[bcd + bcd.mtOffset, BcdDefs.Base][FIRST[BcdDefs.MTIndex]];
codeSpace ← MapPages[cseg];
codebase ← codeSpace.LongPointer + mth.code.offset;
codepages ← cseg.span.pages;
cspp ← codebase;
dStar ← ~cspp.header.info.altoCode;
symbols ← SymbolTable.Acquire[sseg];
Space.Delete[bcdSpace];
ListerDefs.SetRoutineSymbols[symbols];
BEGIN OPEN s: symbols;
main: BTIndex = FIRST[BTIndex];
hti: HTIndex;
CreateEpMap[];
CreateLinkMap[];
WITH b: s.bb[main]
SELECT
FROM
Callable => hti ← s.NameForSe[b.id];
ENDCASE => ERROR;
moduleName.length ← 0;
AppendChar[moduleName, '[];
s.SubStringForName[@desc, hti];
AppendSubString[moduleName, @desc];
AppendChar[moduleName, ']];
[] ← s.EnumerateBodies[FIRST[BTIndex], SearchBody];
END;
SymbolTable.Release[symbols];
Space.Delete[codeSpace];
IF epMap # NIL THEN (Heap.systemZone).FREE[@epMap];
IF linkMap # NIL THEN (Heap.systemZone).FREE[@linkMap];
EXITS
badformat => WriteString["--ignored (defs or config?)"L];
badname => WriteString["--not found"L];
END;
END;
OutToSort: GSort.SortItemPort;
DoXref:
PROCEDURE [
fileList: STRING, Compare: GSort.CompareProcType,
Put: GSort.PutProcType, ext: STRING] =
BEGIN OPEN Strings;
s: STRING ← [50];
ch: CHARACTER;
open list of names
cs: Stream.Handle ← FileStream.Create[
OSMiscOps.FindFile[fileList, ! OSMiscOps.FileError => GO TO notFound]];
crank up the sort package
LOOPHOLE[OutToSort, GSort.Port].out ← GSort.Sort;
buffer ←
LOOPHOLE[OutToSort, GSort.SortStarter][
nextItem: @OutToSort, put: Put,
compare: Compare, expectedItemSize: 40, maxItemSize: 70, pagesInHeap: 90];
go through list of names, calling OutToSort
UNTIL FileStream.EndOf[cs]
DO
s.length ← 0;
WHILE ~FileStream.EndOf[cs]
AND (ch ← cs.GetChar[]) # '
DO
AppendChar[s, ch]; ENDLOOP;
IF s.length > 0
THEN
BEGIN
WriteString[" "L];
WriteString[s];
ProcessFile[s];
WriteChar[Ascii.CR];
END;
ENDLOOP;
Stream.Delete[cs];
get ready to write output
OutputDefs.OpenOutput[fileList, ext];
lastMajor.length ← 0;
lastMinor.length ← 0;
shut down the sort package (and call Put many times)
LOOPHOLE[OutToSort, GSort.SortStopper][];
OutputDefs.PutCR[];
OutputDefs.CloseOutput[];
EXITS notFound => WriteLine[" Command file not found"L];
END;
XrefByCaller:
PROCEDURE [fileList:
STRING] =
BEGIN DoXref[fileList, CompareCallers, PutByCaller, ".xlr"L]; END;
XrefByCallee:
PROCEDURE [fileList:
STRING] =
BEGIN DoXref[fileList, CompareCallees, PutByCallee, ".xle"L]; END;
Init:
PROCEDURE =
BEGIN
command: CommanderOps.CommandBlockHandle;
command ← CommanderOps.AddCommand["XrefByCaller", LOOPHOLE[XrefByCaller], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderOps.AddCommand["XrefByCallee", LOOPHOLE[XrefByCallee], 1];
command.params[0] ← [type: string, prompt: "Filename"];
END;
Init[];
END.