(* Copyright (C) 1992, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* File: Unit.m3                                               *)
(* Last modified on Mon Jun 29 17:33:36 PDT 1992 by kalsow     *)
(*      modified on Sat Mar 16 01:44:52 1991 by muller         *)

UNSAFE MODULE Unit;

IMPORT String, Rd, Wr, M3toC, FileStream, Error, Text, TextRd, Unix;
IMPORT Host, Thread, TxtTxtTbl;

TYPE
  Node = REF RECORD
    next : Node;
    dir  : TEXT;
    map  : TxtTxtTbl.T;
 END;

VAR
  search_path: Node := NIL;

CONST suffix0 = ARRAY BOOLEAN OF TEXT { ".m", ".i" };
CONST suffix1 = ARRAY BOOLEAN OF TEXT { "3", "g" };
CONST head1   = ARRAY BOOLEAN OF TEXT { "", "GENERIC " };
CONST head2   = ARRAY BOOLEAN OF TEXT { "MODULE ", "INTERFACE " };
CONST body1   = ARRAY BOOLEAN OF TEXT { "; ", "(); " };
CONST body2   = ARRAY BOOLEAN OF TEXT { "BEGIN END ", "END " };

PROCEDURE PushDir (name : TEXT) =
  VAR n := NEW (Node, next := search_path, dir := name, map := NIL);
  BEGIN
    search_path := n;
  END PushDir;

PROCEDURE PushTable (name: TEXT) =
  VAR n := NEW (Node, next := search_path);
  BEGIN
    ReadTable (name, n.dir, n.map);
    search_path := n;
  END PushTable;

PROCEDURE Open (name      : String.T;
                interface : BOOLEAN;
                generic   : BOOLEAN;
     VAR(*OUT*) filename  : String.T): Rd.T=

  VAR file, fullname: TEXT;  rd: Rd.T;
  BEGIN
    file := String.ToText (name);
    rd := DoOpenFile (file & suffix0[interface] & suffix1[generic], fullname);

    IF (rd = NIL) THEN
      (* build a fake stub to minimize the downstream errors *)
      rd := TextRd.New (head1[generic] & head2[interface] & file &
                        body1[generic] & body2[interface] & file & "." );
    END;

    IF (fullname # NIL) THEN
      filename := String.Add (fullname);
      Error.Info ("importing from \"" & fullname & "\"");
    ELSE
      filename := name;
    END;

    RETURN rd;
  END Open;

(*-------------------------------------------------------------- internal ---*)

PROCEDURE ReadTable (file: TEXT;  VAR dirs: TEXT;  VAR map: TxtTxtTbl.T) =
  <*FATAL Rd.Failure, Rd.EndOfFile, Thread.Alerted*>
  VAR tbl := TxtTxtTbl.New (32);
  VAR rd: Rd.T;  dir, unit, other: TEXT;
  BEGIN
    TRY
      rd := FileStream.OpenRead (file);
    EXCEPT Rd.Failure =>
      Host.Die ("unable to open import table: ", file);
    END;

    dir := NIL;
    WHILE NOT Rd.EOF (rd) DO
      unit := Rd.GetLine (rd);
      IF Text.GetChar (unit, 0) = '@' THEN
        dir := Text.Sub (unit, 1, LAST (CARDINAL));
        IF (dirs = NIL)
          THEN dirs := dir;
          ELSE dirs := dirs & ":" & dir;
        END;
        dir := dir & "/";
      ELSIF tbl.in (unit, other) THEN
        Host.Die ("duplicate unit in import table: ", dir, "/", unit);
      ELSE
        EVAL tbl.put (unit, dir);
      END;
    END;
    Host.CloseRd (rd);

    map := tbl;
  END ReadTable;

PROCEDURE DoOpenFile (name: TEXT; VAR (*out*) filename: TEXT): Rd.T =
  <*FATAL Wr.Failure, Thread.Alerted*>
  VAR n: Node;  dir: TEXT;
  BEGIN
    filename := SearchPath (name);
    IF (filename = NIL) THEN
      Error.Msg ("missing file");
      Wr.PutText (Host.errors, "  no \"" & name & "\" on path \"");
      n := search_path;
      WHILE (n # NIL) DO
        IF (n # search_path) THEN Wr.PutText (Host.errors, ":") END;
        dir := n.dir;
        IF (n.map = NIL) THEN
          dir := Text.Sub (n.dir, 0, Text.Length (n.dir) - 1);
        END;
        Wr.PutText (Host.errors, dir);
        n := n.next;
      END;
      Wr.PutText (Host.errors, "\"\n");
      RETURN NIL;
    END;

    TRY
      RETURN FileStream.OpenRead (filename);
    EXCEPT Rd.Failure =>
      Error.Msg ("unable to open file");
      Wr.PutText (Host.errors, "  \"" & filename &"\": ??\n");
      RETURN NIL;
    END;
  END DoOpenFile;

PROCEDURE SearchPath (filename: TEXT): TEXT =
  VAR n: Node;  fullname, dir: TEXT;
  BEGIN
    IF Text.Empty (filename) THEN RETURN NIL END;

    IF Text.GetChar (filename, 0) = '/' THEN
      (* full path name specified... *)
      IF IsReadable (filename) THEN RETURN filename END;

    ELSE
      (* try the search path... *)
      n := search_path;
      WHILE (n # NIL) DO
        IF (n.map = NIL) THEN
	  fullname := n.dir & filename;
          IF IsReadable (fullname) THEN RETURN fullname END;
        ELSIF n.map.in (filename, dir) THEN
          IF (dir = NIL)
            THEN fullname := filename;
            ELSE fullname := dir & filename;
          END;
          IF IsReadable (fullname) THEN RETURN fullname END;
        END;
        n := n.next;
      END;
    END;

    (* failed *)
    RETURN NIL;
  END SearchPath;

PROCEDURE IsReadable (file: TEXT): BOOLEAN =
  BEGIN
    RETURN Unix.access (M3toC.TtoS (file), Unix.R_OK) = 0;
  END IsReadable;

BEGIN
END Unit.