DIRECTORY
Ascii: TYPE USING [CR],
BcdDefs: TYPE,
BcdOps: TYPE USING [BcdBase, NameString],
CommanderOps: TYPE USING [AddCommand, CommandBlockHandle],
FileStream: TYPE USING [Create, EndOf],
FileSegment: TYPE USING [Pages, nullPages],
GSort: TYPE USING [
CompareProcType, Port, PutProcType, SortItemPort, SortStarter, SortStopper, Sort],
ListerDefs: TYPE,
LongString: TYPE,
OSMiscOps: TYPE USING [FileError, FindFile],
OutputDefs: TYPE,
Space: TYPE USING [Handle, Delete, LongPointer],
Stream: TYPE USING [Delete, GetChar, Handle],
Symbols: TYPE,
SymbolTable: TYPE USING [Acquire, Base, Release];

ListImpl: PROGRAM
IMPORTS
CommanderOps, FileStream, GSort, ListerDefs, LongString, OSMiscOps,
OutputDefs, Space, Stream, SymbolTable =
BEGIN OPEN OutputDefs, BcdDefs;

bcd: BcdOps.BcdBase;

tb: Base;
ssb: BcdOps.NameString;
evb: Base;
spb: Base;
ctb: Base;
mtb: Base;
itb: Base;
etb: Base;
sgb: Base;
ftb: Base;
ntb: Base;
typb: Base;

InstallBcd: PROCEDURE [seg: FileSegment.Pages] RETURNS [space: Space.Handle] =
BEGIN
DO
size: CARDINAL;
space _ ListerDefs.MapPages[seg];
bcd _ space.LongPointer;
IF (size _ bcd.nPages) = seg.span.pages THEN EXIT;
seg.span.pages _ size;
Space.Delete[space];
ENDLOOP;
tb _ LOOPHOLE[bcd];
ssb _ LOOPHOLE[bcd + bcd.ssOffset];
ctb _ tb + bcd.ctOffset;
mtb _ tb + bcd.mtOffset;
itb _ tb + bcd.impOffset;
etb _ tb + bcd.expOffset;
sgb _ tb + bcd.sgOffset;
ftb _ tb + bcd.ftOffset;
ntb _ tb + bcd.ntOffset;
evb _ tb + bcd.evOffset;
spb _ tb + bcd.spOffset;
typb _ tb + bcd.typOffset;
RETURN
END;

UnstallBcd: PROCEDURE [space: Space.Handle] =
BEGIN
Space.Delete[space];
RETURN
END;

ScanExports: PROCEDURE [action: PROC[EXPIndex]] =
BEGIN
eti: EXPIndex _ FIRST[EXPIndex];
UNTIL eti = bcd.expLimit DO
action[eti !
ListerDefs.NoFile =>
BEGIN OPEN etb[eti];
ListerDefs.WriteString["Can't find "L];
WriteName[ftb[file].name];
ListerDefs.WriteChar[Ascii.CR];
CONTINUE
END;
ListerDefs.MultipleModules =>
BEGIN OPEN etb[eti];
ListerDefs.WriteString["Bad format for "L];
WriteName[ftb[file].name];
ListerDefs.WriteChar[Ascii.CR];
CONTINUE
END;
ListerDefs.NoSymbols =>
BEGIN OPEN etb[eti];
ListerDefs.WriteString["No symbols for "L];
WriteName[ftb[file].name];
ListerDefs.WriteChar[Ascii.CR];
CONTINUE
END;
ListerDefs.IncorrectVersion =>
BEGIN OPEN etb[eti];
ListerDefs.WriteString["Wrong version: "L];
WriteName[ftb[file].name];
ListerDefs.WriteChar[Ascii.CR];
CONTINUE
END];
UnloadSymbols[];
eti _ eti + etb[eti].size + SIZE[EXPRecord];
IF LOOPHOLE[eti, CARDINAL] > LOOPHOLE[bcd.expLimit, CARDINAL] THEN
GO TO Bogus;
REPEAT Bogus => PrintGarbage[];
ENDLOOP;
RETURN
END;

ExportsToSort: PROC [eti: EXPIndex] =
BEGIN OPEN etb[eti];
i: CARDINAL;
n: CARDINAL _ 0;
link: BcdDefs.Link;
sei: Symbols.ISEIndex;
interfaceName.length _ 0;
AppendName[interfaceName, name];
FOR i IN [0..size) DO
link _ links[i];
IF link # BcdDefs.NullLink THEN
BEGIN
IF ~loaded THEN LoadSymbols[file];
sei _ SeiForItem[i];
IF sei = Symbols.ISENull THEN LOOP;
RecordExport[sei, TRUE];
END;
ENDLOOP;
RETURN
END;

SeiForItem: PROCEDURE [item: CARDINAL] RETURNS [sei: Symbols.ISEIndex] =
BEGIN OPEN symbols;
FOR sei _ FirstCtxSe[stHandle.outerCtx], NextSe[sei] UNTIL sei =
Symbols.ISENull DO
IF seb[sei].idValue = item THEN
SELECT LinkMode[
sei] FROM
val => IF seb[sei].extended THEN RETURN[Symbols.ISENull] ELSE RETURN;
ref => RETURN[sei];
manifest => LOOP; -- constant

ENDCASE => RETURN[Symbols.ISENull];
ENDLOOP;
ERROR;
END;

AddInterface: PROC =
BEGIN OPEN Symbols, symbols;
interfaceName.length _ 0;
LongString.AppendString[interfaceName, moduleName];
LoadSymbolsName[moduleName !
ListerDefs.NoFile =>
BEGIN
ListerDefs.WriteString["Can't find "L];
ListerDefs.WriteString[moduleName];
ListerDefs.WriteChar[Ascii.CR];
GO TO cant;
END];
FOR sei: ISEIndex _ FirstCtxSe[stHandle.outerCtx],
NextSe[sei] UNTIL sei = ISENull DO
SELECT LinkMode[sei] FROM
val, ref => RecordExport[sei, FALSE];
ENDCASE;
ENDLOOP;
UnloadSymbols[];
EXITS
cant => NULL;
END;


symbols: SymbolTable.Base _ NIL;
sseg: FileSegment.Pages _ FileSegment.nullPages;

loaded: BOOLEAN _ FALSE;

LoadSymbols: PROCEDURE [file: FTIndex] =
BEGIN OPEN ListerDefs;
s: STRING _ [60];
IF file = FTNull OR file = FTSelf
OR symbols # NIL OR sseg # FileSegment.nullPages THEN ERROR;
GetBcdName[s, ftb[file].name];
LoadSymbolsName[s];
IF ftb[file].version # symbols.stHandle.version THEN
SIGNAL ListerDefs.IncorrectVersion;
END;

LoadSymbolsName: PROCEDURE [s: STRING] =
BEGIN OPEN ListerDefs;
cseg: FileSegment.Pages;
bs: STRING _ [50];
LongString.AppendString[bs, s];
FOR i: CARDINAL IN [0..bs.length) DO
IF bs[i] = '. THEN EXIT;
REPEAT
FINISHED => LongString.AppendString[bs, ".bcd"L];
ENDLOOP;
[code: cseg, symbols: sseg] _ Load[bs ! NoCode, NoFGT => RESUME ];
symbols _ SymbolTable.Acquire[sseg];
SetRoutineSymbols[symbols];
loaded _ TRUE;
END;

UnloadSymbols: PROCEDURE =
BEGIN
IF symbols # NIL THEN SymbolTable.Release[symbols];
symbols _ NIL;
sseg _ FileSegment.nullPages;
loaded _ FALSE;
END;



PrintGarbage: PROCEDURE =
BEGIN
PutString["? looks like garbage to me ..."L];
PutCR[];
RETURN
END;

GetBcdName: PUBLIC PROCEDURE [s: STRING, n: NameRecord] =
BEGIN
i: CARDINAL;
ssd: LongString.SubStringDescriptor _
[base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
s.length _ 0;
LongString.AppendSubString[s, @ssd];
FOR i IN [0..s.length) DO IF s[i] = '. THEN RETURN ENDLOOP;
LongString.AppendString[s, ".bcd"L];
RETURN
END;



PutName: PUBLIC PROCEDURE [n: NameRecord] =
BEGIN
ssd: LongString.SubStringDescriptor _
[base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
PutLongSubString[@ssd];
RETURN
END;

AppendName: PUBLIC PROCEDURE [s: STRING, n: NameRecord] =
BEGIN
ssd: LongString.SubStringDescriptor _
[base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
LongString.AppendSubString[s, @ssd];
RETURN
END;

WriteName: PUBLIC PROCEDURE [n: NameRecord] =
BEGIN
s: LONG STRING = @ssb.string;
last: CARDINAL = MIN[ssb.size[n], 100];
FOR i: CARDINAL _ n, i + 1 UNTIL i >= n + last DO
ListerDefs.WriteChar[s[i]];
ENDLOOP;
RETURN
END;

RecordExport: PROC [item: Symbols.ISEIndex, present: BOOLEAN] =
BEGIN OPEN LongString;
desc: SubStringDescriptor;
sortLength: CARDINAL;
buffer^ _ [
interface: NULL, 
module: NULL, 
item: [length: 0, maxlength: 100, text:]];
symbols.SubStringForName[LOOPHOLE[@desc], symbols.NameForSe[item]];
AppendSubString[@buffer.item, @desc];
buffer.interface _  
LOOPHOLE[sortLength _ WordsForString[buffer.item.length] + 2];
buffer[buffer.interface] _ [length: 0, maxlength: 100, text:];
AppendString[@buffer[buffer.interface], interfaceName];
sortLength _ sortLength + WordsForString[interfaceName.length];
IF ~present THEN buffer.module _ NullString
ELSE
BEGIN
buffer.module _ LOOPHOLE[sortLength];
buffer[buffer.module] _ [length: 0, maxlength: 100, text:];
AppendString[@buffer[buffer.module], moduleName];
sortLength _ sortLength + WordsForString[moduleName.length];
END;
buffer _ OutToSort[sortLength];
END;

Compare: PROCEDURE [p1, p2: LONG POINTER] RETURNS [i: INTEGER] =
BEGIN OPEN LongString;
k1: KeyBase = p1;
k2: KeyBase = p2;
i _ CompareStrings[@k1[k1.interface], @k2[k2.interface]];
IF i = 0 THEN i _ CompareStrings[@k1.item, @k2.item];
IF i = 0 THEN i _ CompareStrings[@k1[k1.module], @k2[k2.module]];
END;

lastInterface: STRING _ [60];
lastItem: STRING _ [60];
first: BOOLEAN _ TRUE;

Put: PROC [p: LONG POINTER, len: CARDINAL] =
BEGIN
key: KeyBase = p;
NextItem[
interface: @key[key.interface],
item: @key.item,
module: IF key.module = NullString THEN NIL ELSE @key[key.module]];
END;

NextItem: PROCEDURE [interface, item, module: LONG STRING] =
BEGIN OPEN OutputDefs;
IF ~LongString.EqualString[interface, lastInterface] THEN
BEGIN
IF ~first THEN PutChar[')];
first _ TRUE;
PutCR[];
PutCR[];
PutLongString[interface];
lastInterface.length _ 0;
LongString.AppendString[lastInterface, interface];
lastItem.length _ 0;
END;
IF ~LongString.EqualString[item, lastItem] THEN
{IF ~first THEN PutChar[')];
PutCR[]; PutString["    "L]; PutLongString[item]; 
lastItem.length _ 0; LongString.AppendString[lastItem, item];
first _ TRUE};
IF module # NIL THEN
BEGIN
IF first THEN {PutString["  ("L]; first _ FALSE}
ELSE PutString[", "L];
PutLongString[module];
END;
END;

KeyBase: TYPE = LONG BASE POINTER TO SortKey;
SortKey: TYPE = RECORD [
interface, module: KeyBase RELATIVE POINTER TO StringBody,
item: StringBody];
NullString: KeyBase RELATIVE POINTER TO StringBody = LOOPHOLE[0];
buffer: KeyBase;
interfaceName: STRING _ [60];
moduleName: STRING _ [40];


OutToSort: GSort.SortItemPort;
onLine: CARDINAL;
firstFile: BOOLEAN _ TRUE;

Implementors: PROCEDURE [fileList: STRING] =
BEGIN OPEN OutputDefs;
s: STRING _ [50];
ch: CHARACTER;
cs: Stream.Handle _ FileStream.Create[
OSMiscOps.FindFile[fileList ! OSMiscOps.FileError => GO TO notFound]];
LOOPHOLE[OutToSort, GSort.Port].out _ GSort.Sort;
buffer _ LOOPHOLE[OutToSort, GSort.SortStarter][
nextItem: @OutToSort, put: Put,
compare: Compare, expectedItemSize: 40, maxItemSize: 70];
OutputDefs.OpenOutput[fileList, ".iml"L];
PutString["Interface items implemented by:"L];
PutCR[]; onLine _ 0;
UNTIL FileStream.EndOf[cs] DO
s.length _ 0;
WHILE ~FileStream.EndOf[cs] AND (ch _ cs.GetChar[]) # '  DO
LongString.AppendChar[s, ch] ENDLOOP;
IF s.length > 0 THEN
BEGIN OPEN ListerDefs;
WriteChar[Ascii.CR];
WriteString["    "L];
WriteString[s];
ProcessFile[s];
END;
ENDLOOP;
ListerDefs.WriteChar[Ascii.CR];
Stream.Delete[cs];
PutCR[];
lastInterface.length _ 0;
lastItem.length _ 0;
LOOPHOLE[OutToSort, GSort.SortStopper][];
IF ~first THEN PutChar[')];
OutputDefs.PutCR[];
OutputDefs.CloseOutput[];
EXITS notFound => ListerDefs.WriteLine["  Command file not found"L];
END;

ProcessFile: PROCEDURE [root: STRING] =
BEGIN
i: CARDINAL;
bcdfile: STRING _ [40];
file: STRING _ [40];
seg: FileSegment.Pages;
BEGIN
FOR i IN [0..root.length) DO
IF root[i] = '. THEN EXIT;
LongString.AppendChar[bcdfile, root[i]];
ENDLOOP;
LongString.AppendString[file, bcdfile];
LongString.AppendString[bcdfile, ".bcd"];
END;
BEGIN
bcdSpace: Space.Handle;
seg _ [
file: OSMiscOps.FindFile[bcdfile, ! OSMiscOps.FileError => GO TO NoFile],
span: [1, 1]];
bcdSpace _ InstallBcd[seg];
BEGIN
name: BcdDefs.NameRecord = mtb[FIRST[BcdDefs.MTIndex]].name;
moduleName.length _ 0; AppendName[moduleName, name];
IF firstFile THEN firstFile _ FALSE ELSE PutChar[',];
IF onLine + file.length > 70 THEN {PutCR[]; onLine _ 0}
ELSE {PutChar[' ]; onLine _ onLine + 2}; -- 1 for the comma
PutString[file]; onLine _ onLine + file.length;
IF bcd.definitions THEN AddInterface[]
ELSE ScanExports[ExportsToSort];
END;
UnstallBcd[bcdSpace];
EXITS NoFile => ListerDefs.WriteString[" File not found"L];
END;
RETURN
END;

Init: PROCEDURE =
BEGIN
command: CommanderOps.CommandBlockHandle;
command _ CommanderOps.AddCommand[
"Implementors", LOOPHOLE[Implementors], 1];
command.params[0] _ [type: string, prompt: "fileList"];
END;

Init[];

END....


€ListImpl.Mesa  
Edited by Bruce on  13-Jan-81 11:01:26
Edited by Sweet on  20-Mar-81 14:10:24
Edited by Lewis on  14-Jan-81 15:59:40
Edited by Satterthwaite on May 10, 1983 12:56 pm
Utility Prints
Utility Puts
open list of names
crank up the sort package
go through list of names, calling OutToSort
get ready to write output
shut down the sort package (and call Put many times)
�Ê”˜Jš
œ™Jš
œ&™&Jš
œ&™&Jš
œ&™&Jš
œ0™0J˜š
Ïk	˜	Jšœ�œ
�œ�œ˜Jšœ	�œ
˜Jšœ�œ
�œ˜)Jšœ�œ
�œ"˜:Jšœ�œ
�œ˜'Jšœ
�œ
�œ˜+šœ�œ
�œ˜J˜R—Jšœ�œ
˜Jšœ�œ
˜Jšœ�œ
�œ˜,Jšœ�œ
˜Jšœ�œ
�œ˜0Jšœ�œ
�œ˜-Jšœ	�œ
˜Jšœ
�œ
�œ˜1J˜—šœ
�˜š
�˜J˜CJ˜(—Jš�œ
�œ˜J˜J˜J˜J˜	J˜J˜
J˜
J˜
J˜
J˜
J˜
J˜
J˜
J˜
J˜J˜šÏn
œ�	œ�œ˜NJš
�˜š
�˜Jšœ�œ
˜J˜!J˜Jš�œ&�œ
�œ
˜2J˜J˜Jš�œ
˜—Jšœ�œ˜Jšœ�œ˜#J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜Jš
�˜Jš�œ
˜J˜—šž
œ�	œ˜-Jš
�˜J˜Jš
�˜Jš�œ
˜J˜—šžœ�	œ
�œ
˜1Jš
�˜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šœ�œ˜,š�œ
�œ�œ�œ�œ�˜BJš�œ
�œ˜—Jš�œ˜Jš�œ
˜—Jš
�˜Jš�œ
˜J˜—šž
œ�œ˜%Jš�œ
�œ
˜Jšœ�œ
˜Jšœ�œ˜J˜J˜J˜J˜ š�œ�œ�˜J˜š�œ�˜Jš
�˜Jš�œ	�œ˜"J˜Jš�œ�œ
�œ
˜#Jšœ�œ˜Jš�œ
˜—Jš�œ
˜—Jš
�˜Jš�œ
˜J˜—šž
œ�	œ�œ�œ˜HJš�œ
�œ	˜š�œ2�œ˜@Jšœ�˜š�œ�˜š�œ
˜Jšœ�˜	Jšœ�œ�œ
�œ�œ
�œ
˜EJšœ�œ˜Jšœ�œÏc˜J˜Jš�œ�œ˜#——Jš�œ
˜—Jš�œ
˜Jš�œ
˜J˜—šžœ�œ˜Jš�œ
�œ˜J˜J˜3˜˜Jš
�˜J˜'J˜#Jšœ�œ˜Jš�œ
�œ˜Jš�œ˜——š�œ/˜2Jšœ�œ�˜"š�œ�˜Jšœ�œ˜%Jš�œ
˜—Jš�œ
˜—J˜š
�˜Jšœ�œ
˜
—Jš�œ
˜J˜J˜—Jšœ�œ
˜ J˜0J˜Jšœ�œ�œ
˜J˜šžœ�	œ˜(Jš�œ
�œ˜Jšœ�œ˜š�œ�œ˜!Jš
�œ�œ
�œ�œ
�œ
˜<—J˜J˜š�œ.�˜4Jš�œ˜#—Jš�œ
˜J˜—šžœ�	œ�œ˜(Jš�œ
�œ˜J˜Jšœ�œ˜J˜š�œ�œ
�œ�˜$Jš�œ�œ
�œ
˜š
�˜Jš�œ)˜1—Jš�œ
˜—Jšœ9�œ˜BJ˜$J˜Jšœ	�œ
˜Jš�œ
˜J˜—šž
œ�	œ˜Jš
�˜Jš�œ�œ
�œ˜3Jšœ
�œ
˜J˜Jšœ	�œ
˜Jš�œ
˜J˜—Jš
œ™J˜J˜šžœ�	œ˜Jš
�˜J˜-J˜Jš
�˜Jš�œ
˜J˜—šž
œ�œ
�	œ�œ˜9Jš
�˜Jšœ�œ
˜˜%Jšœ'�œ˜>—J˜
J˜$Jš�œ�œ�œ
�œ�œ
�œ
�œ
˜;J˜$Jš
�˜Jš�œ
˜J˜—Jš
œ™J˜J˜šžœ�œ
�	œ˜+Jš
�˜˜%Jšœ'�œ˜>—J˜Jš
�˜Jš�œ
˜J˜—šž
œ�œ
�	œ�œ˜9Jš
�˜˜%Jšœ'�œ˜>—J˜$Jš
�˜Jš�œ
˜J˜—šž	œ�œ
�	œ˜-Jš
�˜Jšœ�œ
�œ˜Jšœ�œ�œ˜'š�œ�œ�œ�˜1J˜Jš�œ
˜—Jš
�˜Jš�œ
˜J˜—šžœ�œ#�œ˜?Jš�œ
�œ˜J˜Jšœ�œ
˜˜Jšœ�œ˜Jšœ�œ˜J˜*—Jšœ�œ"˜CJ˜%˜Jš�œ6˜>—J˜>J˜7J˜?Jš�œ
�œ˜+š
�˜Jš
�˜Jšœ�œ
˜%J˜;J˜1J˜<Jš�œ
˜—J˜Jš�œ
˜J˜—šžœ�	œ
�œ
�œ�œ�œ˜@Jš�œ
�œ˜J˜J˜J˜9Jš�œ�œ(˜5Jš�œ�œ4˜AJš�œ
˜J˜—Jšœ�œ˜Jšœ
�œ˜Jšœ�œ�œ
˜J˜š
žœ�œ�œ
�œ�œ˜,Jš
�˜J˜˜	J˜J˜Jš	œ�œ�œ
�œ
�œ˜C—Jš�œ
˜J˜—šžœ�	œ�œ
�œ˜<Jš�œ
�œ˜š�œ3�˜9Jš
�˜Jš�œ�œ
˜Jšœ�œ
˜
J˜J˜J˜J˜J˜2J˜Jš�œ
˜—š�œ)�˜/Jšœ
�œ�œ
˜J˜2J˜=Jšœ�œ˜—š�œ
�œ
�˜Jš
�˜Jš�œ�œ�œ
˜0Jš�œ˜J˜Jš�œ
˜—Jš�œ
˜J˜—Jšœ	�œ�œ
�œ
�œ
�œ	˜-šœ	�œ�œ˜Jšœ�œ
�œ
�œ˜:J˜—Jš	œ�œ
�œ
�œ�œ˜AJ˜Jšœ�œ˜Jšœ�œ˜J˜J˜˜Jšœ�œ
˜Jšœ�œ�œ
˜J˜—šžœ�	œ�œ˜,Jš�œ
�œ˜Jšœ�œ˜Jšœ�	œ
˜Jš
œ™˜&Jšœ5�œ
�œ˜F—Jš
œ™Jš�œ)˜1šœ	�œ˜0J˜J˜9—J˜)J˜.J˜Jš
œ+™+š�œ�˜J˜
š�œ�œ�˜;Jšœ�œ
˜%—š�œ�˜Jš�œ
�œ˜Jšœ�œ˜J˜J˜J˜Jš�œ
˜—Jš�œ
˜—Jšœ�œ˜J˜J˜Jš
œ™J˜J˜Jš
œ4™4Jš�œ!˜)Jš�œ�œ
˜J˜J˜Jš�œ?˜DJš�œ
˜J˜—šžœ�	œ�œ˜'Jš
�˜Jšœ�œ
˜Jšœ	�œ˜Jšœ�œ˜J˜Jš
�˜š�œ�œ�˜Jš�œ�œ
�œ
˜J˜(Jš�œ
˜—J˜'J˜)Jš�œ
˜Jš
�˜J˜˜Jšœ;�œ
�œ	˜IJ˜—J˜š
�˜Jšœ�œ˜<J˜4Jš�œ�œ
�œ
�œ
˜5š�œ�œ˜7Jš�œ%Ÿ˜;J˜/—Jš�œ�œ˜&Jš�œ˜ Jš�œ
˜—J˜Jš�œ6˜;Jš�œ
˜Jš
�˜Jš�œ
˜J˜—šžœ�	œ˜Jš
�˜J˜)˜"Jšœ�œ˜+—J˜7Jš�œ
˜J˜—J˜J˜Jš�œ˜J˜——…—*h:|