-- ListUsing.mesa
-- modified by Bruce, August 28, 1979 8:51 AM
-- modified by Sweet, May 16, 1980 9:37 AM
DIRECTORY
AltoDefs USING [PageSize],
CommanderDefs USING [AddCommand, CommandBlockHandle],
FSPDefs,
IODefs USING [SP, CR, NUL, WriteLine, WriteString],
ListerDefs USING [
IncorrectVersion, Load, MultipleModules, NoCode, NoFGT, NoSymbols,
SetRoutineSymbols, WriteFileID],
OutputDefs USING [
CloseOutput, OpenOutput, PutChar, PutCR, PutString, PutSubString, outStream],
SegmentDefs USING [
DeleteFileSegment, FileHandle, FileNameError, FileSegmentHandle, SwapError,
DestroyFile, SetFileAccess, Read, Write, Append, LockFile, UnlockFile],
StreamDefs USING [
NewByteStream, Read, StreamHandle, CreateByteStream, StreamError],
String USING [
AppendChar, AppendString, EquivalentSubStrings, SubString,
SubStringDescriptor, UpperCase, WordsForString],
Symbols USING [BTIndex, CTXIndex, HTIndex, ISEIndex, ISENull, MDIndex, SENull],
SymbolTable USING [Acquire, Base, Release, TableForSegment],
Storage USING [Pages, FreePages];
ListUsing: PROGRAM
IMPORTS
CommanderDefs, FSPDefs, IODefs, ListerDefs, OutputDefs, SegmentDefs,
StreamDefs, String, SymbolTable, Storage
EXPORTS ListerDefs =
BEGIN OPEN ListerDefs, OutputDefs, Symbols;
FileHandle: TYPE = SegmentDefs.FileHandle;
symbols: SymbolTable.Base;
myHeap: FSPDefs.ZonePointer ← NIL;
Alloc: PROCEDURE [nwords: CARDINAL] RETURNS [p: POINTER] =
BEGIN OPEN AltoDefs, Storage, FSPDefs;
p ← FSPDefs.MakeNode[
myHeap, nwords !
NoRoomInZone =>
BEGIN AddToNewZone[myHeap, Pages[1], PageSize, FreePages]; RESUME END]
END;
Free: PROCEDURE [p: POINTER] = BEGIN FSPDefs.FreeNode[myHeap, p] END;
AllocString: PROCEDURE [nchars: CARDINAL] RETURNS [s: STRING] =
BEGIN
s ← Alloc[String.WordsForString[nchars]];
s↑ ← [length: 0, maxlength: nchars, text:];
END;
FreeString: PROCEDURE [s: STRING] = LOOPHOLE[Free];
InitHeap: PROCEDURE =
BEGIN OPEN Storage;
IF myHeap # NIL THEN RETURN;
myHeap ← FSPDefs.MakeNewZone[Pages[5], 5*AltoDefs.PageSize, FreePages];
END;
EraseHeap: PROCEDURE = BEGIN FSPDefs.DestroyZone[myHeap]; myHeap ← NIL; END;
StringCompare: PROCEDURE [s1, s2: STRING] RETURNS [INTEGER] =
BEGIN
i: CARDINAL;
c1, c2: CHARACTER;
FOR i IN [0..MIN[s1.length, s2.length]) DO
c1 ← String.UpperCase[s1[i]];
c2 ← String.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]
END;
CompareNames: PROCEDURE [n1, n2: String.SubString] RETURNS [INTEGER] =
BEGIN
i: CARDINAL;
c1, c2: CHARACTER;
FOR i IN [0..MIN[n1.length, n2.length]) DO
c1 ← String.UpperCase[n1.base[n1.offset + i]];
c2 ← String.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];
END;
SortNames: PROCEDURE [na: DESCRIPTOR FOR ARRAY OF String.SubStringDescriptor] =
BEGIN
i: CARDINAL;
j: INTEGER;
key: String.SubStringDescriptor;
FOR i IN [1..LENGTH[na]) DO
key ← na[i];
j ← i - 1;
WHILE j >= 0 AND CompareNames[@na[j], @key] > 0 DO
na[j + 1] ← na[j]; j ← j - 1; ENDLOOP;
na[j + 1] ← key;
ENDLOOP;
END;
GenCtx: PROCEDURE [ctx: Symbols.CTXIndex, p: PROCEDURE [Symbols.ISEIndex]] =
BEGIN OPEN symbols;
sei: Symbols.ISEIndex;
FOR sei ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = SENull DO p[sei]; ENDLOOP;
END;
PrintUsing: PROCEDURE =
BEGIN OPEN Symbols, symbols;
bti: BTIndex;
ctx: CTXIndex;
sei: ISEIndex;
hti: HTIndex;
mdi: MDIndex;
i, n, idir, ndir: CARDINAL;
first: BOOLEAN ← TRUE;
desc: String.SubStringDescriptor;
modname: String.SubString = @desc;
desc2: String.SubStringDescriptor;
filename: String.SubString = @desc2;
mname: String.SubString;
DirRec: TYPE = RECORD [dirname: String.SubStringDescriptor, dirsei: ISEIndex];
da: DESCRIPTOR FOR ARRAY OF DirRec;
na: DESCRIPTOR FOR ARRAY OF String.SubStringDescriptor;
firstCopiedHash: Symbols.HTIndex;
countids: PROCEDURE [sei: ISEIndex] =
BEGIN IF seb[sei].hash < firstCopiedHash THEN n ← n + 1; END;
insertid: PROCEDURE [sei: ISEIndex] =
BEGIN OPEN symbols;
IF seb[sei].hash < firstCopiedHash THEN
BEGIN SubStringForHash[@na[i], seb[sei].hash]; i ← i + 1; END;
END;
PutCR[];
FOR hti IN (0..LENGTH[ht]) DO
IF ht[hti].ssIndex = ht[hti - 1].ssIndex THEN
BEGIN firstCopiedHash ← hti; EXIT END;
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
BEGIN
i: INTEGER ← ndir - 1;
SubStringForHash[modname, seb[sei].hash];
WHILE i >= 0 AND CompareNames[@da[i].dirname, modname] > 0 DO
da[i + 1] ← da[i]; i ← i - 1; ENDLOOP;
da[i + 1] ← [modname↑, sei];
ndir ← ndir + 1;
END;
ENDLOOP;
FOR idir IN [0..ndir) DO
mname ← @da[idir].dirname;
sei ← da[idir].dirsei;
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;
n ← 0;
GenCtx[ctx, countids];
WITH ctxb[ctx] SELECT FROM
included => mdi ← module;
imported =>
BEGIN
mdi ← ctxb[includeLink].module;
GenCtx[includeLink, countids];
END;
ENDCASE => LOOP; -- main body
IF n > 0 THEN na ← DESCRIPTOR[Alloc[SIZE[String.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 PutString["DIRECTORY"] ELSE PutChar[',];
PutCR[];
first ← FALSE;
PutString[" "];
PutSubString[mname];
SubStringForHash[filename, mdb[mdi].fileId];
FOR j: CARDINAL IN [0..filename.length) DO
IF filename.base[filename.offset + j] = '. THEN
BEGIN filename.length ← j; EXIT END;
ENDLOOP;
IF ~String.EquivalentSubStrings[mname, filename] THEN
BEGIN PutString[": FROM """]; PutSubString[filename]; PutChar['"]; END;
PutString[" USING ["];
IF n > 0 THEN
BEGIN
SortNames[na];
PutSubString[@na[0]];
FOR i IN (0..LENGTH[na]) DO
PutString[", "]; PutSubString[@na[i]]; ENDLOOP;
Free[BASE[na]];
END;
PutChar[']];
ENDLOOP;
Free[BASE[da]];
PutChar[';];
PutCR[];
PutCR[];
PutCR[];
RETURN
END;
Item: TYPE = RECORD [
link: POINTER TO Item, value: STRING, sublink: POINTER TO Item];
Head: POINTER TO Item ← NIL;
CopyString: PROCEDURE [old: STRING] RETURNS [copy: STRING] =
BEGIN
IF old = NIL THEN RETURN[NIL];
copy ← AllocString[old.length];
String.AppendString[copy, old];
END;
MakeItem: PROCEDURE [value: STRING, link: POINTER TO Item]
RETURNS [item: POINTER TO Item] =
BEGIN
item ← Alloc[SIZE[Item]];
item↑ ← [link: link, value: value, sublink: NIL];
END;
AddItem: PROCEDURE [
value: STRING, list: POINTER TO POINTER TO Item, copyString: BOOLEAN ← TRUE]
RETURNS [item: POINTER TO Item] =
BEGIN
prev: POINTER TO Item ← NIL;
FOR item ← list↑, item.link UNTIL item = NIL DO
SELECT StringCompare[
item.value, value] FROM
0 => EXIT;
1 =>
BEGIN
item ← MakeItem[IF copyString THEN CopyString[value] ELSE value, item];
IF prev = NIL THEN list↑ ← item ELSE prev.link ← item;
EXIT
END;
ENDCASE;
prev ← item;
REPEAT
FINISHED =>
BEGIN
item ← MakeItem[IF copyString THEN CopyString[value] ELSE value, NIL];
IF prev = NIL THEN list↑ ← item ELSE prev.link ← item;
END;
ENDLOOP;
END;
GetToken: PROCEDURE [in: StreamDefs.StreamHandle, s: STRING]
RETURNS [term: CHARACTER] =
BEGIN
ENABLE StreamDefs.StreamError => GOTO eof;
s.length ← 0;
WHILE (term ← in.get[in]) <= IODefs.SP DO NULL ENDLOOP;
WHILE term IN ['a..'z] OR term IN ['A..'Z] OR term IN ['0..'9] DO
String.AppendChar[s, term]; term ← in.get[in] ENDLOOP;
EXITS eof => term ← IODefs.NUL;
END;
compressing: BOOLEAN ← FALSE;
list: BOOLEAN ← FALSE;
Compress: PROCEDURE [file: STRING] =
BEGIN OPEN SegmentDefs;
fh: FileHandle;
dh: StreamDefs.StreamHandle;
compressing ← TRUE;
InitHeap[];
OpenOutput[file, ".ul$"L];
WITH d: outStream SELECT FROM Disk => fh ← d.file; ENDCASE => ERROR;
IODefs.WriteLine["UsingList:"L];
UsingList[file];
LockFile[fh];
CloseOutput[];
SetFileAccess[fh, Read + Write + Append];
dh ← StreamDefs.CreateByteStream[fh, Read];
OpenOutput[file, ".ul"L];
IODefs.WriteLine["Compressing:"L];
CompressIt[dh];
CloseOutput[];
dh.destroy[dh];
UnlockFile[fh];
DestroyFile[fh];
EraseHeap[];
Head ← NIL;
compressing ← FALSE;
END;
UsingList: PROCEDURE [cmd: STRING] =
BEGIN OPEN String, StreamDefs;
s: STRING ← [50];
ch: CHARACTER;
cs: StreamHandle ← NewByteStream[cmd, Read];
list ← TRUE;
IF ~compressing THEN InitHeap[];
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
IF compressing THEN IODefs.WriteString[" "L];
IODefs.WriteLine[s];
Using[s];
END;
ENDLOOP;
cs.destroy[cs];
IF ~compressing THEN EraseHeap[];
list ← FALSE;
END;
Using: PROCEDURE [root: STRING] =
BEGIN OPEN String, SegmentDefs;
i: CARDINAL;
defs: BOOLEAN ← FALSE;
bcdFile: STRING ← [40];
sseg, cseg: FileSegmentHandle;
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"];
ENDLOOP;
BEGIN
[code: cseg, symbols: sseg] ← Load[
bcdFile ! NoFGT => RESUME ; NoCode => BEGIN defs ← TRUE; RESUME END;
NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
SegmentDefs.FileNameError => GOTO badname];
symbols ← SymbolTable.Acquire[SymbolTable.TableForSegment[sseg]];
IF ~defs THEN
SegmentDefs.DeleteFileSegment[cseg ! SegmentDefs.SwapError => CONTINUE];
ListerDefs.SetRoutineSymbols[symbols];
IF ~compressing THEN OpenOutput[root, ".ul"];
WriteFileID[];
IF symbols.sourceFile # NIL THEN
BEGIN PutString[" Source: "]; PutString[symbols.sourceFile]; PutCR[]; END;
PrintUsing[];
SymbolTable.Release[symbols];
SegmentDefs.DeleteFileSegment[sseg ! SegmentDefs.SwapError => CONTINUE];
IF ~compressing THEN CloseOutput[];
IF ~list AND ~compressing THEN EraseHeap[];
EXITS
badformat => IODefs.WriteString["Bad Format!"];
badname => IODefs.WriteString["File Not Found!"];
END;
END;
CompressIt: PROCEDURE [input: StreamDefs.StreamHandle] =
BEGIN OPEN IODefs;
term: CHARACTER;
user: STRING ← [40];
userCopy: STRING;
interface: STRING ← [40];
used: STRING ← [40];
int: POINTER TO Item;
DO
userCopy ← NIL;
IF (term ← GetToken[input, user]) = NUL THEN EXIT;
IODefs.WriteString[" "L];
IODefs.WriteLine[user];
UNTIL term = '; OR term = CR AND StringCompare[interface, "DIRECTORY"] = 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
BEGIN
intitem: POINTER TO Item ← AddItem[interface, @Head];
item: 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];
END;
ENDLOOP;
ENDLOOP;
FOR int ← Head, int.link UNTIL int = NIL DO
BEGIN
item, user: POINTER TO Item;
c: CHARACTER;
IF int.sublink = NIL THEN LOOP;
PutString[int.value];
PutCR[];
FOR item ← int.sublink, item.link UNTIL item = NIL DO
PutString[" "L];
PutString[item.value];
PutChar[SP];
c ← '(;
FOR user ← item.sublink, user.link UNTIL user = NIL DO
PutChar[c]; c ← SP; PutString[user.value]; ENDLOOP;
PutChar[')];
PutCR[];
ENDLOOP;
PutCR[];
END
ENDLOOP;
END;
command: CommanderDefs.CommandBlockHandle;
command ← CommanderDefs.AddCommand["Using", LOOPHOLE[Using], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderDefs.AddCommand["UsingList", LOOPHOLE[UsingList], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderDefs.AddCommand["CompressUsing", LOOPHOLE[Compress], 1];
command.params[0] ← [type: string, prompt: "Filename"];
END...