-- 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...