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;
SubStringForName[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;
SubStringForName[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];
SubStringForName[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"];
}.