-- ListXref.mesa; edited by Sweet; September 9, 1980 2:21 PM
DIRECTORY
AltoDefs USING [BYTE, PageCount],
CommanderDefs USING [AddCommand, CommandBlockHandle],
ControlDefs USING [CSegPrefix, FrameHandle],
GPsortDefs USING [CompareProcType, GetProcType, PutProcType, Sort],
InlineDefs USING [BITAND],
IODefs USING [CR, NumberFormat, WriteChar, WriteString, WriteLine],
ListerDefs USING [
FileSegmentHandle, IncorrectVersion, Load, MultipleModules, NoCode, NoFGT,
NoSymbols, SetRoutineSymbols],
Mopcodes USING [
zEFC0, zEFC15, zEFCB, zJ2, zJIW, zLADRB, zLFC1, zLFC16, zLFCB, zNOOP, zSFC],
OpTableDefs USING [instaligned, instlength],
OutputDefs USING [CloseOutput, OpenOutput, PutCR, PutString],
SegmentDefs USING [
DeleteFileSegment, FileNameError, FileSegmentAddress, FileSegmentHandle,
SwapError, SwapIn, SwapOut, Unlock],
StreamDefs USING [NewByteStream, Read, StreamHandle],
String USING [
AppendChar, AppendString, AppendSubString, CompareStrings, EquivalentString,
SubString, SubStringDescriptor, WordsForString],
Symbols USING [
BitAddress, BTIndex, BTNull, CTXIndex, HTIndex, ISEIndex, ISENull, SENull],
SymbolTable USING [Acquire, Base, Release, TableForSegment],
Storage USING [Node, Free];
ListXref: PROGRAM
IMPORTS
CommanderDefs, GPsortDefs, InlineDefs, IODefs, ListerDefs, OpTableDefs,
OutputDefs, SegmentDefs, StreamDefs, Storage, String, SymbolTable
EXPORTS ListerDefs
SHARES SymbolTable =
BEGIN OPEN AltoDefs, OutputDefs;
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];
offset: CARDINAL;
codebase: POINTER;
codepages: PageCount;
symbols: SymbolTable.Base;
Tinst, Tbytes, Pinst, Pbytes: CARDINAL ← 0;
dStar: BOOLEAN ← FALSE;
KeyBase: TYPE = 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 String;
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.SubStringForHash[@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 String;
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 linkMap = NIL THEN ERROR;
symbols.SubStringForHash[@desc, linkMap[link].hti];
AppendSubString[@buffer[buffer.callee], @desc];
AppendChar[@buffer[buffer.callee], '[];
AppendSubString[@buffer[buffer.callee], @linkMap[link].ssd];
AppendChar[@buffer[buffer.callee], ']];
buffer ← OutToSort[
WordsForString[buffer.caller.length] + WordsForString[
buffer[buffer.callee].length] + 1];
END;
RecordUnknown: PROCEDURE =
BEGIN OPEN String;
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: POINTER] RETURNS [i: INTEGER] =
BEGIN
k1: KeyBase = p1;
k2: KeyBase = p2;
i ← String.CompareStrings[@k1.caller, @k2.caller];
IF i = 0 THEN i ← String.CompareStrings[@k1[k1.callee], @k2[k2.callee]];
END;
CompareCallees: PROCEDURE [p1, p2: POINTER] RETURNS [i: INTEGER] =
BEGIN
k1: KeyBase = p1;
k2: KeyBase = p2;
i ← String.CompareStrings[@k1[k1.callee], @k2[k2.callee]];
IF i = 0 THEN i ← String.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: STRING] =
BEGIN OPEN OutputDefs;
IF ~String.EquivalentString[major, lastMajor] THEN
BEGIN
PutCR[];
PutCR[];
PutString[major];
PutCR[];
PutString[" "L];
onThisLine ← 4;
first ← TRUE;
lastMajor.length ← 0;
String.AppendString[lastMajor, major];
END;
IF ~first THEN
BEGIN
IF String.EquivalentString[minor, lastMinor] THEN RETURN;
PutString[", "L];
onThisLine ← onThisLine + 2;
IF onThisLine + minor.length > MaxOnLine THEN
{PutCR[]; PutString[" "L]; onThisLine ← 4};
END;
PutString[minor];
onThisLine ← onThisLine + minor.length;
lastMinor.length ← 0;
String.AppendString[lastMinor, minor];
first ← FALSE;
END;
PutByCaller: PROCEDURE [p: POINTER, len: CARDINAL] =
BEGIN
key: KeyBase = p;
NextItem[major: @key.caller, minor: @key[key.callee]];
END;
PutByCallee: PROCEDURE [p: POINTER, len: CARDINAL] =
BEGIN
key: KeyBase = p;
NextItem[major: @key[key.callee], minor: @key.caller];
END;
epMap: POINTER TO ARRAY [0..0) OF Symbols.HTIndex ← 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.HashForSe[b.id];
ENDCASE;
END;
[] ← symbols.EnumerateBodies[FIRST[Symbols.BTIndex], Count];
epMap ← Storage.Node[n + 1];
[] ← symbols.EnumerateBodies[FIRST[Symbols.BTIndex], Enter];
END;
LinkMapItem: TYPE = RECORD [
hti: Symbols.HTIndex, ssd: String.SubStringDescriptor];
linkMap: POINTER TO ARRAY [0..0) OF LinkMapItem ← NIL;
CreateLinkMap: PROCEDURE =
BEGIN
m: CARDINAL ← 0;
FindMax: PROCEDURE [sei: Symbols.ISEIndex, mname: String.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: String.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.HashForSe[sei], mname↑];
END;
END;
GenImports[FindMax];
linkMap ← Storage.Node[(m + 1)*SIZE[LinkMapItem]];
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: String.SubString]] =
BEGIN OPEN Symbols, symbols;
sei: ISEIndex;
ctx: CTXIndex;
bti: BTIndex;
modnameSS: String.SubStringDescriptor;
DoAction: PROCEDURE [sei: ISEIndex] = BEGIN action[sei, @modnameSS]; END;
FOR sei ← FirstCtxSe[stHandle.directoryCtx], NextSe[sei] UNTIL sei = ISENull
DO
SubStringForHash[@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;
transfer => BEGIN bti ← seb[sei].idInfo; ctx ← bb[bti].localCtx; END;
ENDCASE => ERROR;
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 OPEN InlineDefs;
w: POINTER TO InstWord;
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;
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 InlineDefs, 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
byte ← 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 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 String, SegmentDefs, symbols, Symbols;
i: CARDINAL;
cseg, sseg: FileSegmentHandle;
bcdFile: STRING ← [40];
cspp: POINTER TO ControlDefs.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.HashForSe[b.id];
symbols.SubStringForHash[@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] ← Load[
bcdFile, FALSE ! NoFGT => RESUME ; NoCode => GO TO badformat;
NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
SegmentDefs.FileNameError => GOTO badname];
SwapIn[cseg];
codebase ← FileSegmentAddress[cseg];
codepages ← cseg.pages;
cspp ← codebase;
dStar ← ~cspp.header.info.altoCode;
symbols ← SymbolTable.Acquire[SymbolTable.TableForSegment[sseg]];
SetRoutineSymbols[symbols];
BEGIN OPEN s: symbols;
main: BTIndex = FIRST[BTIndex];
hti: HTIndex;
CreateEpMap[];
CreateLinkMap[];
WITH b: s.bb[main] SELECT FROM
Callable => hti ← s.HashForSe[b.id];
ENDCASE => ERROR;
moduleName.length ← 0;
AppendChar[moduleName, '[];
s.SubStringForHash[@desc, hti];
AppendSubString[moduleName, @desc];
AppendChar[moduleName, ']];
[] ← s.EnumerateBodies[FIRST[BTIndex], SearchBody];
END;
SymbolTable.Release[symbols];
DeleteFileSegment[sseg ! SwapError => CONTINUE];
Unlock[cseg];
SwapOut[cseg];
DeleteFileSegment[cseg ! SwapError => CONTINUE];
IF epMap # NIL THEN {Storage.Free[epMap]; epMap ← NIL};
IF linkMap # NIL THEN {Storage.Free[linkMap]; linkMap ← NIL};
EXITS
badformat => IODefs.WriteString["--ignored (defs?)"L];
badname => IODefs.WriteString["--not found"L];
END;
END;
port: TYPE = MACHINE DEPENDENT RECORD [in, out: UNSPECIFIED];
OutToSort: PORT [len: CARDINAL] RETURNS [POINTER];
SortStarter: TYPE = PORT [
get: GPsortDefs.GetProcType, put: GPsortDefs.PutProcType,
compare: GPsortDefs.CompareProcType, expectedItemSize: CARDINAL,
maxItemSize: CARDINAL, reservedPages: CARDINAL] RETURNS [POINTER];
SortStopper: TYPE = PORT [len: CARDINAL ← 0];
DoXref: PROCEDURE [
fileList: STRING, Compare: GPsortDefs.CompareProcType,
Put: GPsortDefs.PutProcType, ext: STRING] =
BEGIN OPEN String, StreamDefs;
s: STRING ← [50];
ch: CHARACTER;
-- open list of names
cs: StreamHandle ← NewByteStream[
fileList, Read ! SegmentDefs.FileNameError => GO TO notFound];
-- crank up the sort package
LOOPHOLE[OutToSort, port].out ← GPsortDefs.Sort;
buffer ← LOOPHOLE[OutToSort, SortStarter][
get: LOOPHOLE[@OutToSort, GPsortDefs.GetProcType], put: Put,
compare: Compare, expectedItemSize: 40, maxItemSize: 70, reservedPages: 90];
-- go through list of names, calling OutToSort
UNTIL cs.endof[cs] DO
s.length ← 0;
WHILE ~cs.endof[cs] AND (ch ← cs.get[cs]) # ' DO
AppendChar[s, ch]; ENDLOOP;
IF s.length > 0 THEN
BEGIN OPEN IODefs;
WriteString[" "L];
WriteString[s];
ProcessFile[s];
WriteChar[CR];
END;
ENDLOOP;
cs.destroy[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, SortStopper][];
OutputDefs.PutCR[];
OutputDefs.CloseOutput[];
EXITS notFound => IODefs.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: CommanderDefs.CommandBlockHandle;
command ← CommanderDefs.AddCommand["XrefByCaller", LOOPHOLE[XrefByCaller], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderDefs.AddCommand["XrefByCallee", LOOPHOLE[XrefByCallee], 1];
command.params[0] ← [type: string, prompt: "Filename"];
END;
Init[];
END.