-- ListUsing.mesa
-- modified by Bruce, 13-Jan-81 11:05:04
-- modified by Sweet, May 16, 1980 9:37 AM
-- modified by Satterthwaite, September 20, 1982 1:41 pm
DIRECTORY
Ascii: TYPE USING [SP, CR, NUL],
CommanderOps: TYPE USING [AddCommand, CommandBlockHandle],
File: TYPE USING [Capability],
FileSegment: TYPE USING [Pages],
FileStream: TYPE USING [Create, EndOf, GetCapability],
Heap: TYPE USING [
Create, Delete, Error, Expand, FreeNode, FreeString, Handle, MakeNode, MakeString],
ListerDefs: TYPE USING [
IncorrectVersion, Load, MultipleModules, NoCode, NoFGT, NoFile,
NoSymbols, SetRoutineSymbols, WriteFileID, WriteLine, WriteString],
LongString: TYPE USING [
AppendChar, AppendString, EquivalentSubStrings, SubString, SubStringDescriptor, UpperCase],
OSMiscOps: TYPE USING [FindFile],
OutputDefs: TYPE USING [
CloseOutput, OpenOutput, PutChar, PutCR, PutLongString, PutLongSubString, outStream],
Stream: TYPE USING [Delete, GetChar, Handle],
Symbols: TYPE USING [BTIndex, CTXIndex, HTIndex, ISEIndex, ISENull, MDIndex, SENull],
SymbolTable: TYPE USING [Acquire, Base, Release];
ListUsing: PROGRAM
IMPORTS
CommanderOps, FileStream, Heap, ListerDefs, LongString, OutputDefs,
OSMiscOps, Stream, SymbolTable = {
OPEN ListerDefs, OutputDefs, Symbols;
symbols: SymbolTable.Base;
myHeap: Heap.Handle ← NIL;
LongSubString: TYPE = LONG POINTER TO LongString.SubStringDescriptor;
Alloc: PROC [nwords: CARDINAL] RETURNS [p: LONG POINTER] = {
OPEN Heap;
p ← MakeNode[
myHeap, nwords
! Error => IF type = insufficientSpace THEN {Expand[myHeap, 1]; RETRY}]};
Free: PROC [p: LONG POINTER] = {Heap.FreeNode[myHeap, p]};
AllocString: PROC [nchars: CARDINAL] RETURNS [s: LONG STRING] = {
OPEN Heap;
s ← MakeString[
myHeap, nchars
! Error => IF type = insufficientSpace THEN {Expand[myHeap, 1]; RETRY}]};
FreeString: PROC [s: LONG STRING] = {Heap.FreeString[myHeap, s]};
InitHeap: PROC = {IF myHeap = NIL THEN myHeap ← Heap.Create[5]};
EraseHeap: PROC = {Heap.Delete[myHeap]; myHeap ← NIL};
PutVeryLongSubString: PROC [s: LongSubString] = {
ss: LongString.SubStringDescriptor ← s↑;
PutLongSubString[@ss]};
StringCompare: PROC [s1, s2: LONG STRING] RETURNS [INTEGER] = {
c1, c2: CHAR;
FOR i: CARDINAL IN [0..MIN[s1.length, s2.length]) DO
c1 ← LongString.UpperCase[s1[i]];
c2 ← LongString.UpperCase[s2[i]];
IF c1 < c2 THEN RETURN[-1];
IF c1 > c2 THEN RETURN[1];
ENDLOOP;
RETURN[
SELECT TRUE FROM
s1.length < s2.length => -1,
s1.length > s2.length => 1,
ENDCASE => 0]};
CompareNames: PROC [n1, n2: LongSubString] RETURNS [INTEGER] = {
c1, c2: CHAR;
FOR i: CARDINAL IN [0..MIN[n1.length, n2.length]) DO
c1 ← LongString.UpperCase[n1.base[n1.offset + i]];
c2 ← LongString.UpperCase[n2.base[n2.offset + i]];
SELECT c1 - c2 FROM < 0 => RETURN[-1]; > 0 => RETURN[1]; ENDCASE;
ENDLOOP;
SELECT INTEGER[
n1.length - n2.length] FROM
< 0 => RETURN[-1];
> 0 => RETURN[1];
ENDCASE => RETURN[0]};
SortNames: PROC [na: LONG DESCRIPTOR FOR ARRAY OF LongString.SubStringDescriptor] = {
j: INTEGER;
key: LongString.SubStringDescriptor;
FOR i: CARDINAL IN [1..LENGTH[na]) DO
key ← na[i];
j ← i - 1;
WHILE j >= 0 AND CompareNames[@na[j], @key] > 0 DO
temp: CARDINAL = j + 1;
na[temp] ← na[j];
j ← j - 1;
ENDLOOP;
j ← j + 1;
na[j] ← key;
ENDLOOP};
GenCtx: PROC [ctx: Symbols.CTXIndex, p: PROC [Symbols.ISEIndex]] = {
OPEN symbols;
sei: Symbols.ISEIndex;
FOR sei ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = SENull DO p[sei]; ENDLOOP};
PrintUsing: PROC = {
OPEN Symbols, symbols;
bti: BTIndex;
ctx: CTXIndex;
sei: ISEIndex;
hti: HTIndex;
mdi: MDIndex;
i, n, idir, ndir: CARDINAL;
first: BOOL ← TRUE;
desc: LongString.SubStringDescriptor;
modname: LongString.SubString = @desc;
desc2: LongString.SubStringDescriptor;
filename: LongString.SubString = @desc2;
mname: LongSubString;
DirRec: TYPE = RECORD [dirname: LongString.SubStringDescriptor, dirsei: ISEIndex];
da: LONG DESCRIPTOR FOR ARRAY OF DirRec;
na: LONG DESCRIPTOR FOR ARRAY OF LongString.SubStringDescriptor;
firstCopiedHash: Symbols.HTIndex;
countids: PROC [sei: ISEIndex] = {
IF seb[sei].hash < firstCopiedHash THEN n ← n + 1};
insertid: PROC [sei: ISEIndex] = {
OPEN symbols;
IF seb[sei].hash < firstCopiedHash THEN {
ss: LongString.SubStringDescriptor;
SubStringForHash[LOOPHOLE[@ss], seb[sei].hash];
na[i] ← ss;
i ← i + 1}};
PutCR[];
FOR hti IN (0..LENGTH[ht]) DO
IF ht[hti].ssIndex = ht[hti - 1].ssIndex THEN {
firstCopiedHash ← hti; EXIT};
REPEAT FINISHED => firstCopiedHash ← LENGTH[ht];
ENDLOOP;
ndir ← 0;
FOR sei ← FirstCtxSe[stHandle.directoryCtx], NextSe[sei] UNTIL sei = ISENull
DO ndir ← ndir + 1; ENDLOOP;
IF ndir = 0 THEN RETURN;
da ← DESCRIPTOR[Alloc[SIZE[DirRec]*ndir], ndir];
ndir ← 0;
FOR sei ← FirstCtxSe[stHandle.directoryCtx], NextSe[sei] UNTIL sei = ISENull
DO
i: INTEGER ← ndir - 1;
SubStringForHash[LOOPHOLE[modname], seb[sei].hash];
WHILE i >= 0 AND CompareNames[@da[i].dirname, modname] > 0 DO
da[i + 1] ← da[i]; i ← i - 1; ENDLOOP;
i ← i + 1; -- for compiler
da[i] ← [modname↑, sei];
ndir ← ndir + 1;
ENDLOOP;
FOR idir IN [0..ndir) DO
mname ← @da[idir].dirname;
sei ← da[idir].dirsei;
WITH seb[UnderType[seb[sei].idType]] SELECT FROM
definition => {
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 {ctx ← defCtx; EXIT};
ENDCASE;
ENDCASE;
ENDLOOP};
transfer => {bti ← seb[sei].idInfo; ctx ← bb[bti].localCtx};
ENDCASE => ERROR;
n ← 0;
GenCtx[ctx, countids];
WITH ctxb[ctx] SELECT FROM
included => mdi ← module;
imported => {
mdi ← ctxb[includeLink].module;
GenCtx[includeLink, countids]};
ENDCASE => LOOP; -- main body
IF n > 0 THEN na ← DESCRIPTOR[Alloc[SIZE[LongString.SubStringDescriptor]*n], n];
IF n = 0 AND ~mdb[mdi].exported THEN LOOP;
i ← 0;
GenCtx[ctx, insertid];
WITH ctxb[ctx] SELECT FROM
imported => GenCtx[includeLink, insertid];
ENDCASE;
IF first THEN PutLongString["DIRECTORY"L] ELSE PutChar[',];
PutCR[];
first ← FALSE;
PutLongString[" "L];
PutVeryLongSubString[mname];
SubStringForHash[LOOPHOLE[filename], mdb[mdi].fileId];
FOR j: CARDINAL IN [0..filename.length) DO
IF filename.base[filename.offset + j] = '. THEN {
filename.length ← j; EXIT};
ENDLOOP;
IF ~Equivalent[mname, filename] THEN {
PutLongString[": FROM """L]; PutLongSubString[filename]; PutChar['"]}
ELSE PutLongString[": TYPE"L];
PutLongString[" USING ["L];
IF n > 0 THEN {
SortNames[na];
PutVeryLongSubString[@na[0]];
FOR i IN (0..LENGTH[na]) DO
PutLongString[", "L]; PutVeryLongSubString[@na[i]]; ENDLOOP;
Free[BASE[na]]};
PutChar[']];
ENDLOOP;
Free[BASE[da]];
PutChar[';];
PutCR[];
PutCR[];
PutCR[];
RETURN};
Equivalent: PROC [s1, s2: LongSubString] RETURNS [BOOL] = {
ss1: LongString.SubStringDescriptor ← s1↑;
ss2: LongString.SubStringDescriptor ← s2↑;
RETURN [LongString.EquivalentSubStrings[@ss1, @ss2]]};
Item: TYPE = RECORD [
link: LONG POINTER TO Item, value: LONG STRING, sublink: LONG POINTER TO Item];
Head: LONG POINTER TO Item ← NIL;
CopyString: PROC [old: LONG STRING] RETURNS [copy: LONG STRING] = {
IF old = NIL THEN RETURN[NIL];
copy ← AllocString[old.length];
LongString.AppendString[copy, old]};
MakeItem: PROC [value: LONG STRING, link: LONG POINTER TO Item]
RETURNS [item: LONG POINTER TO Item] = {
item ← Alloc[SIZE[Item]];
item↑ ← [link: link, value: value, sublink: NIL]};
AddItem: PROC [
value: LONG STRING, list: LONG POINTER TO LONG POINTER TO Item, copyString: BOOL ← TRUE]
RETURNS [item: LONG POINTER TO Item] = {
prev: LONG POINTER TO Item ← NIL;
FOR item ← list↑, item.link UNTIL item = NIL DO
SELECT StringCompare[
item.value, value] FROM
0 => EXIT;
1 => {
item ← MakeItem[IF copyString THEN CopyString[value] ELSE value, item];
IF prev = NIL THEN list↑ ← item ELSE prev.link ← item;
EXIT};
ENDCASE;
prev ← item;
REPEAT
FINISHED => {
item ← MakeItem[IF copyString THEN CopyString[value] ELSE value, NIL];
IF prev = NIL THEN list↑ ← item ELSE prev.link ← item};
ENDLOOP};
GetToken: PROC [in: Stream.Handle, s: LONG STRING]
RETURNS [term: CHAR] = {
s.length ← 0;
DO
IF FileStream.EndOf[in] THEN GOTO eof;
IF (term ← in.GetChar[]) > Ascii.SP THEN EXIT;
ENDLOOP;
WHILE term IN ['a..'z] OR term IN ['A..'Z] OR term IN ['0..'9] DO
LongString.AppendChar[s, term];
IF FileStream.EndOf[in] THEN GOTO eof;
term ← in.GetChar[];
ENDLOOP;
EXITS eof => term ← Ascii.NUL};
compressing: BOOL ← FALSE;
list: BOOL ← FALSE;
Compress: PROC [file: STRING] = {
fh: File.Capability;
dh: Stream.Handle;
compressing ← TRUE;
InitHeap[];
OpenOutput[file, ".ul$"L];
fh ← FileStream.GetCapability[outStream];
ListerDefs.WriteLine["UsingList:"L];
UsingList[file];
CloseOutput[];
-- SetFileAccess[fh, Read + Write + Append];
dh ← FileStream.Create[fh];
OpenOutput[file, ".ul"L];
ListerDefs.WriteLine["Compressing:"L];
CompressIt[dh];
CloseOutput[];
Stream.Delete[dh];
EraseHeap[];
Head ← NIL;
compressing ← FALSE};
UsingList: PROC [cmd: STRING] = {
s: STRING ← [100];
ch: CHAR;
cs: Stream.Handle ← FileStream.Create[OSMiscOps.FindFile[cmd]];
list ← TRUE;
IF ~compressing THEN InitHeap[];
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 {
IF compressing THEN ListerDefs.WriteString[" "L];
ListerDefs.WriteLine[s];
Using[s]};
ENDLOOP;
Stream.Delete[cs];
IF ~compressing THEN EraseHeap[];
list ← FALSE};
Using: PROC [root: STRING] = {
OPEN LongString;
i: CARDINAL;
defs: BOOL ← FALSE;
bcdFile: STRING ← [100];
sseg: FileSegment.Pages;
IF ~list AND ~compressing THEN InitHeap[];
AppendString[bcdFile, root];
FOR i IN [0..bcdFile.length) DO
IF bcdFile[i] = '. THEN EXIT;
REPEAT FINISHED => AppendString[bcdFile, ".bcd"L];
ENDLOOP;
BEGIN
[symbols: sseg] ← Load[
bcdFile ! NoFGT => RESUME; NoCode => {defs ← TRUE; RESUME};
NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
NoFile => GOTO badname];
symbols ← SymbolTable.Acquire[sseg];
ListerDefs.SetRoutineSymbols[symbols];
IF ~compressing THEN OpenOutput[root, ".ul"L];
WriteFileID[];
IF symbols.sourceFile # NIL THEN {
PutLongString[" Source: "L]; PutLongString[symbols.sourceFile]; PutCR[]};
PrintUsing[];
SymbolTable.Release[symbols];
IF ~compressing THEN CloseOutput[];
IF ~list AND ~compressing THEN EraseHeap[];
EXITS
badformat => ListerDefs.WriteString["Bad Format!"L];
badname => ListerDefs.WriteString["File Not Found!"L];
END};
CompressIt: PROC [input: Stream.Handle] = {
OPEN Ascii;
term: CHAR;
user: STRING ← [40];
userCopy: LONG STRING;
interface: STRING ← [40];
used: STRING ← [40];
int: LONG POINTER TO Item;
DO
userCopy ← NIL;
IF (term ← GetToken[input, user]) = NUL THEN EXIT;
ListerDefs.WriteString[" "L];
ListerDefs.WriteLine[user];
UNTIL term = '; OR term = CR AND StringCompare[interface, "DIRECTORY"L] = 0
DO term ← GetToken[input, interface] ENDLOOP;
IF term = '; THEN LOOP;
UNTIL term = '; DO
term ← GetToken[input, interface];
UNTIL term = ', OR term = '[ OR term = '; DO
term ← GetToken[input, used] ENDLOOP;
IF term = '; THEN EXIT;
IF term = '[ THEN {
intitem: LONG POINTER TO Item ← AddItem[interface, @Head];
item: LONG POINTER TO Item;
IF userCopy = NIL THEN userCopy ← CopyString[user];
DO
term ← GetToken[input, used];
item ← AddItem[used, @intitem.sublink];
[] ← AddItem[userCopy, @item.sublink, FALSE];
IF term = '] THEN EXIT;
ENDLOOP;
term ← GetToken[input, used]};
ENDLOOP;
ENDLOOP;
FOR int ← Head, int.link UNTIL int = NIL DO
item, user: LONG POINTER TO Item;
c: CHAR;
IF int.sublink = NIL THEN LOOP;
PutLongString[int.value];
PutCR[];
FOR item ← int.sublink, item.link UNTIL item = NIL DO
PutLongString[" "L];
PutLongString[item.value];
PutChar[SP];
c ← '(;
FOR user ← item.sublink, user.link UNTIL user = NIL DO
PutChar[c]; c ← SP; PutLongString[user.value]; ENDLOOP;
PutChar[')];
PutCR[];
ENDLOOP;
PutCR[];
ENDLOOP};
command: CommanderOps.CommandBlockHandle;
command ← CommanderOps.AddCommand["Using", LOOPHOLE[Using], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderOps.AddCommand["UsingList", LOOPHOLE[UsingList], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderOps.AddCommand["CompressUsing", LOOPHOLE[Compress], 1];
command.params[0] ← [type: string, prompt: "Filename"];
}.