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

(* File: Module.m3                                             *)
(* Last modified on Tue Jun 26 08:09:05 1990 by muller         *)
(*      modified on Tue Feb 27 09:46:25 1990 by kalsow         *)




UNSAFE MODULE Module;

IMPORT Value, ValueRep,  String, Scope, Stmt, Error, Exceptionz, Delay;
IMPORT Variable, Type, Constant, Procedure, Ident, Void, Wr, Temp, Text;
IMPORT Host, Expr, Emit, IntTable, Rd, Token, Tipe, Scanner, Revelation;
IMPORT Coverage, Decl;

FROM Scanner IMPORT GetToken, Fail, Match, MatchID, cur;

REVEAL
  T = Value.T BRANDED "Module.T" OBJECT 
        safe        : BOOLEAN;
        interface   : BOOLEAN;
        exports     : List;
        imports     : List;
        importObjs  : ObjList;
        syms        : Scope.T;
	revelations : Revelation.Set;
        body        : Stmt.T;
        depth       : INTEGER;
      METHODS
        bind        := Bind;
        typeCheck   := TypeCheckMethod;
	class       := MyClass;
        fingerprint := FPrinter;
        load        := ValueRep.NoLoader;
        write       := ValueRep.NoWriter;
        select      := ValueRep.NoDuplicates;
        declare0    := ValueRep.Never;
        declare1    := ObjCompile;
        needsDecl   := ValueRep.Never;
	toExpr      := ValueRep.NoExpr;
	toType      := ValueRep.NoType;
      END;

TYPE
  List    = UNTRACED REF RECORD next: List;     module: T;     END;
  ObjList = UNTRACED REF RECORD next: ObjList;  obj: Value.T;  END;

TYPE
  TK = Token.T;

VAR
  defns: IntTable.T := IntTable.New ();
  curModule: T := NIL;

PROCEDURE Create (name: String.T): T =
  VAR t: T;
  BEGIN
    t := NEW (T);
    ValueRep.Init (t, name);
    t.type        := Void.T;
    t.readonly    := TRUE;
    t.safe        := TRUE;
    t.interface   := TRUE;
    t.exports     := NIL;
    t.imports     := NIL;
    t.importObjs  := NIL;
    t.syms        := NIL;
    t.body        := NIL;
    t.revelations := Revelation.PushNew ();
    t.depth       := depth;
    RETURN t;
  END Create;

PROCEDURE NewDefn (name: Text.T;  safe: BOOLEAN): T =
  VAR t: T;
  BEGIN
    t := Create (String.Add (name));
    t.safe := safe;
    Scope.Push (Scope.Initial);
      t.syms := Scope.PushNew (TRUE, t.name);
      Scope.PopNew ();
    Scope.Pop ();
    Revelation.Pop ();
    RecordInterface (t);
    RETURN t;
  END NewDefn;

PROCEDURE Parse (interfaceOnly : BOOLEAN := FALSE): T =
  CONST
    Empty       = Token.Set {};
    TailStart   = Token.Set {Token.T.tEND, Token.T.tEOF};
    ImportStart = Token.Set {Token.T.tIMPORT, Token.T.tFROM};
    TIDStart    = Token.Set {Token.T.tSEMI, Token.T.tBEGIN}
                     + TailStart + ImportStart + Token.DeclStart;
  VAR t, save: T;  id: String.T;  n: INTEGER;
  BEGIN
    INC (depth);
    t := Create (NIL);
    save := curModule;
    curModule := t;

    IF (cur.token = TK.tUNSAFE) THEN
      t.safe := FALSE;
      GetToken ();
    END;

    t.interface := (cur.token = TK.tINTERFACE);
    IF interfaceOnly THEN
      IF (cur.token = TK.tINTERFACE)
        THEN GetToken ();
        ELSE Fail ("missing INTERFACE keyword", 
	 	   Token.Set {TK.tIDENT, TK.tEXPORTS} + TIDStart); END;
      t.interface := TRUE;
    ELSIF (cur.token = TK.tINTERFACE) OR (cur.token = TK.tMODULE) THEN
      GetToken ();
    ELSE Fail ("missing INTERFACE or MODULE keyword",
                   Token.Set {TK.tIDENT, TK.tEXPORTS} + TIDStart);
    END;

    id := MatchID (Token.Set {TK.tEXPORTS}, TIDStart);
    t.name := id;

    IF (t.interface) THEN RecordInterface (t) END;

    IF (cur.token = TK.tEXPORTS) THEN
      IF (t.interface) THEN
        Error.Msg ("EXPORTS clause not allowed in an interface");
        t.interface := FALSE;
      END;
      GetToken ();
      n := Ident.ParseList (TIDStart);
      FOR i := 0 TO n - 1 DO
        ParseExport (t, Ident.stack[Ident.top - n + i]);
      END;
      DEC (Ident.top, n);
    ELSIF ( NOT t.interface) THEN
      ParseExport (t, t.name);
    END;

    Match (TK.tSEMI, Empty, TIDStart);

    (* parse the imports *)
    LOOP
      IF (cur.token = TK.tIMPORT) THEN
        ParseImport (t, Token.Set {TK.tBEGIN} + TailStart + ImportStart
                     + Token.DeclStart);
      ELSIF (cur.token = TK.tFROM) THEN
        ParseFromImport (t, Token.Set {TK.tBEGIN} + TailStart + ImportStart
                         + Token.DeclStart);
      ELSE
        EXIT;
      END;
    END;

    (* build my scope and fill it! *)
    t.syms := Scope.PushNew (TRUE, id);
        (* this scope must be created after the imports & exports are
           parsed so that their module scopes aren't nested inside this one. *)

    (* include any external symbols in my scope *)
    PortExternalSymbols (t);

    WHILE (cur.token IN Token.DeclStart) DO
      Decl.Parse (Token.Set {TK.tBEGIN} + TailStart + Token.DeclStart,
                  t.interface, TRUE);
    END;

    IF ( NOT t.interface) THEN
      Match (TK.tBEGIN, TailStart + Token.StmtStart, Empty);
      t.body := Stmt.Parse (TailStart + Token.StmtStart);
    END;

    Match (TK.tEND, Empty, Token.Set{TK.tIDENT, TK.tDOT, TK.tEOF});

    id := MatchID (Token.Set {TK.tDOT, TK.tEOF}, Empty);
    IF (t.name # id) THEN
      Error.Str (id, "Initial module name doesn\'t match final name");
    END;

    Match (TK.tDOT, Token.Set {TK.tEOF}, Empty);

    IF (cur.token # TK.tEOF) THEN
      Fail ("extra tokens ignored", Token.Set {TK.tEOF});
    END;

    Revelation.Pop ();
    Scope.PopNew ();
    curModule := save;
    DEC (depth);
    RETURN t;
  END Parse;

PROCEDURE ParseExport (t: T;  name: String.T) =
  VAR ex: T; x: List;
  BEGIN
    ex := LookUp (name);
    IF (ex = NIL) THEN RETURN  END;

    (* check for a duplicate export *)
    x := t.exports;
    LOOP
      IF (x = NIL) THEN
        (* no match! *)
        t.exports := Push (ex, t.exports);
        EXIT;
      END;
      IF (x.module = ex) THEN
        (* a duplicate => ignore it *)
        RETURN ;
      END;
      x := x.next;
    END;
  END ParseExport;

PROCEDURE ParseImport (t: T;  READONLY fail: Token.Set) =
  VAR id: String.T;  im: T;  j, n: INTEGER;
  BEGIN
    Match (TK.tIMPORT, fail, Token.Set {TK.tIDENT, TK.tSEMI});
    n := Ident.ParseList (fail + Token.Set {TK.tSEMI});
    Match (TK.tSEMI, fail, Token.Set {});

    j := Ident.top - n;
    FOR i := 0 TO n - 1 DO
      id := Ident.stack[j + i];
      im := LookUp (id);
      IF (im # NIL) THEN
        IF ImportObj (t, im) THEN t.imports := Push (im, t.imports); END;
      END;
    END;
    DEC (Ident.top, n);
  END ParseImport;

PROCEDURE ParseFromImport (t: T;  READONLY fail: Token.Set) =
  CONST Markers = Token.Set {TK.tIMPORT, TK.tIDENT, TK.tSEMI};
  VAR id: String.T;  im: T;  o: Value.T;  j, n: INTEGER;
  BEGIN
    Match (TK.tFROM, fail, Markers);
    id := MatchID (fail, Markers);
    Match (TK.tIMPORT, fail, Markers);
    n := Ident.ParseList (fail + Token.Set {TK.tSEMI});
    Match (TK.tSEMI, fail, Token.Set {});

    im := LookUp (id);
    IF (im = NIL) THEN DEC (Ident.top, n); RETURN  END;
    t.imports := Push (im, t.imports);

    j := Ident.top - n;
    FOR i := 0 TO n - 1 DO
      id := Ident.stack[j + i];
      o := Scope.LookUpInScope (im.syms, id);
      IF (o = NIL)
        THEN Error.Str (id, "symbol not exported")
        ELSE EVAL ImportObj (t, o);
      END;
    END;
    DEC (Ident.top, n);
  END ParseFromImport;


PROCEDURE Push (t: T;  l: List): List =
  VAR x: List;
  BEGIN
    IF (t # NIL) THEN
      x := NEW (List);
      x.next   := l;
      x.module := t;
      RETURN x;
    ELSE
      RETURN l;
    END;
  END Push;

PROCEDURE ImportObj (t: T;  o: Value.T): BOOLEAN =
  VAR x: ObjList;
  BEGIN
    IF (t # NIL) THEN
      IF NOT o.imported THEN
        Error.Str (o.name, "Circular imports");
        RETURN FALSE;
      ELSE
        x := NEW (ObjList);
        x.next := t.importObjs;
        x.obj  := o;
        t.importObjs := x;
      END;
    END;
  RETURN TRUE;
  END ImportObj;

PROCEDURE PortExternalSymbols (t: T) =
  VAR
    x    : List;
    m    : T;
    n    : INTEGER;
    objs : Scope.ValueList;
    y    : ObjList;
    v    : Value.T;
  BEGIN
    (* import the exported symbols *)
    x := t.exports;
    WHILE (x # NIL) DO
      m := x.module;
      Scope.ToList (m.syms, objs, n);
      FOR i := 0 TO n - 1 DO
        v := objs[i];
        <* ASSERT v.imported *>
	IF (Value.ClassOf (v) # Value.Class.Module) THEN
          Scope.Insert (v);
	END;
      END;
      Revelation.Inherit (m.revelations);
      x := x.next;
    END;

    (* get the imported type identifications *)
    x := t.imports;
    WHILE (x # NIL) DO
      m := x.module;
      Revelation.Inherit (m.revelations);
      x := x.next;
    END;

    (* import the imported symbols *)
    y := t.importObjs;
    WHILE (y # NIL) DO
      v := y.obj;
      <* ASSERT v.imported *>
      Scope.Insert (v);
      y := y.next;
    END;
  END PortExternalSymbols;

TYPE
  RefT = REF T;

PROCEDURE LookUp (name: String.T): T =
  (* find and return the named interface module *)
  VAR r: RefT; key: INTEGER; rd: Rd.T; t: T; ref: REFANY; filename: String.T;
  BEGIN
    key := LOOPHOLE (name, INTEGER);
    IF IntTable.Get (defns, key, ref) THEN
      r := NARROW (ref, RefT);
      t := r^;
    ELSE
      (* open the external file & parse the interface*)
      rd := Host.OpenInterface (name, filename);
      Scanner.Push (filename, rd);
      t := Parse (TRUE);
      Scanner.Pop ();
      Host.CloseFile (rd);
      (* make sure we got what we wanted *)
      IF (t = NIL) THEN
        Error.Str (name, "imported object is not an interface");
        RETURN NIL;
      END;
      IF (t.name # name) THEN
        Error.Str (name, "imported module has wrong name");
        RETURN NIL;
      END;
      IF (NOT t.interface) THEN
        Error.Str (name, "imported module is not an interface");
        RETURN NIL;
      END;
      RecordInterface (t);
      Bind (t);
    END;
    IF (curModule # NIL) AND (curModule.safe) AND (NOT t.safe) THEN
      Error.Str (name, "cannot import an unsafe interface in a safe module");
    END;
    RETURN t;
  END LookUp;

PROCEDURE RecordInterface (t: T) =
  VAR r: RefT;
  BEGIN
    IF (t = NIL) OR (t.name = NIL) THEN RETURN END;
    r := NEW (RefT);
    r^ := t;
    EVAL IntTable.Put (defns, LOOPHOLE (t.name, INTEGER), r);
  END RecordInterface;

PROCEDURE Bind (t: T) =
  VAR l: List;  o: ObjList; saveDepth: INTEGER;
  BEGIN
    IF (t.bound) THEN RETURN END;
    t.bound := TRUE;

    l := t.exports;
    WHILE (l # NIL) DO Value.Bind (l.module); l := l.next END;
    l := t.imports;
    WHILE (l # NIL) DO Value.Bind (l.module); l := l.next END;
    saveDepth := depth;
    depth := t.depth;

    o := t.importObjs;
    WHILE (o # NIL) DO Value.Bind (o.obj); o := o.next END;

    
    Revelation.Push (t.revelations);
    Scope.Push (t.syms);
      Scope.Seal (t.syms); (* allws LookUps to be done *)
      Revelation.Bind (t.revelations);
      Scope.Bind (t.syms, TRUE);
      IF NOT t.interface THEN
        Stmt.Bind (t.body);
        IF Delay.pending THEN Delay.FinishUp () END;
      END;
    Scope.Pop ();
    Revelation.Pop ();
    depth := saveDepth;
  END Bind;

PROCEDURE TypeCheckMethod (t: T) =
  BEGIN
    TypeCheck (t, FALSE);
  END TypeCheckMethod;

PROCEDURE TypeCheck (t: T;  main: BOOLEAN) =
  VAR save: T;  a, b: List;  l: List;  o: ObjList;
  BEGIN
    (* check my externals *)
    l := t.exports;
    WHILE (l # NIL) DO Value.TypeCheck (l.module); l := l.next; END;
    l := t.imports;
    WHILE (l # NIL) DO Value.TypeCheck (l.module); l := l.next; END;
    o := t.importObjs;
    WHILE (o # NIL) DO Value.TypeCheck (o.obj); o := o.next; END;

    (* check my self *)
    save := curModule;
    curModule := t;
    Revelation.Push (t.revelations);
    Scope.Push (t.syms);

    (* make sure that in import and export lists are disjoint *)
(*
    a := t.exports;
    WHILE (a # NIL) DO
      b := t.imports;
      WHILE (b # NIL) DO
        IF (b.module = a.module) THEN
          Error.Str (a.module.name, "module is imported and exported");
        END;
        b := b.next;
      END;
      a := a.next;
    END;
*)

    Revelation.TypeCheck (t.revelations);
    Scope.TypeCheck (t.syms, TRUE);
    IF (NOT t.interface) THEN
      Stmt.TypeCheck (t.body);
      IF Delay.pending THEN Delay.FinishUp () END;
    END;

    IF (main) THEN Scope.WarnUnused (t.syms) END;
    Scope.Pop ();
    Revelation.Pop ();
    curModule := save;
  END TypeCheck;

PROCEDURE IsSafe (): BOOLEAN =
  BEGIN
    RETURN (curModule = NIL) OR (curModule.safe);
  END IsSafe;

PROCEDURE IsInterface (): BOOLEAN =
  BEGIN
    RETURN (curModule = NIL) OR (curModule.interface);
  END IsInterface;

PROCEDURE ExportScope (t: T): Scope.T =
  BEGIN
    IF (t = NIL)
      THEN RETURN NIL;
      ELSE RETURN t.syms;
    END;
  END ExportScope;

PROCEDURE ObjCompile (<*UNUSED*> t: T) =
  BEGIN
  END ObjCompile;

PROCEDURE MyClass (<*UNUSED*> t: T): Value.Class =
  BEGIN
    RETURN Value.Class.Module;
  END MyClass;

PROCEDURE Compile (t: T) =
  VAR save: T;
  BEGIN
    save := curModule;
    curModule := t;
    Scanner.offset := t.origin;
    Revelation.Push (t.revelations);
    Scope.Push (t.syms);
      Type.GenDeclarations ();
       IF (t.interface)
        THEN CompileInterface (t);
        ELSE CompileModule (t);
      END;
    Scope.Pop ();
    Revelation.Pop ();
    curModule := save;
  END Compile;

PROCEDURE CompileInterface (t: T) =
  VAR n: INTEGER;  objs: Scope.ValueList;  v: Value.T;
  BEGIN
    (* make sure my items are marked for export *)
    Scope.ToList (t.syms, objs, n);
    FOR i := 0 TO n - 1 DO
      v := objs[i];
      CASE Value.ClassOf (v) OF
      | Value.Class.Module,
        Value.Class.Error =>
          (* no change of import/export status *)
      | Value.Class.Expr,
        Value.Class.Var,
        Value.Class.Type,
        Value.Class.Exception =>
          IF (NOT v.imported) THEN v.exported := TRUE END;
      | Value.Class.Procedure =>
          IF (NOT v.imported) THEN
	    v.used     := TRUE; (* force a version stamp *)
            v.exported := Procedure.HasBody (v) OR v.external;
            v.imported := NOT v.exported;
          END;
      | Value.Class.Field,
        Value.Class.Method,
	Value.Class.Formal =>
          <* ASSERT FALSE *>
      END;
    END;

    (* declare the modules that I import & export *)
    GenInitLinks (t.imports);
    GenInitLink (t, TRUE);

    (* declare my imports *)
    GenInterfaces (t.imports);

    (* declare my exports *)
    GenInterfaceRecord (t);
    Variable.GenGlobalMap (t.name, TRUE, t.syms);

    (* declare any visible revelations *)
    Revelation.Declare (t.revelations);

    (* generate my init flag *)
    Emit.Op ("\nPRIVATE int init_done = -1;\n");

    (* generate my initialization procedure *)
    Emit.Push ();
    Temp.PushSet ();
    Emit.OpS ("\nPRIVATE void\n@__initProc (g) int g;\n", t.name);
    Emit.Op ("{\n\001");
    EVAL Emit.Switch (1);
    Emit.Op ("if (init_done >= g) return;\ninit_done = g;\n");
    GenInitCalls (t.imports);
    Scope.Generate (t.syms); 
    EVAL Emit.Switch (Emit.MaxStream);
    Emit.Op ("\002};\n\n");
    Temp.PopSet ();
    Emit.Pop ();

    Scanner.offset := 0;  (* we don't care about line numbers any more *)

    Type.GenInitProcs ();
    Type.GenMapProcs ();

    (* generate my init link *)
    Emit.OpS("\nPRIVATE INITLINK me = {(INITLINK*)NIL, 1, @__initProc };\n",
              t.name);

    (* reference all imported version stamps *)
    ImportVersionStamps (t);

    (* link proc *)
    Emit.Push ();
    Temp.PushSet ();
    Emit.OpS ("\nvoid @__ILink (phase) int phase;\n", t.name);
    Emit.Op ("{\n\001");
    Emit.Op ("switch (phase) {\001\n");
      (* Phase 0 link proc: build interfaces & type registrations *)
      Emit.Op ("case 0: {\001\n");
        (* register my "main" body *)
        Emit.OpS ("me.link = @__init;\n", t.name);
        Emit.OpS ("@__init = & me;\n", t.name);
        (* build my interface record *)
        GenExports (t);
        (* register all types *)
        Type.GenRegistrations ();
        Emit.Op ("break; \002};\n");
      (* Phase 1 link proc: finish registrations & variable inits *)
      Emit.Op ("case 1: {\001\n");
        (* finalize the type registrations *)
        Type.FinishRegistrations ();
        Revelation.GenIdentifications ();
        (* initialize my exported variables *)
        InitExports (t);
        Emit.Op ("break; \002};\n");
      (* Phase 2 link proc: check subtype revelations *)
      Emit.Op ("case 2: {\001\n");
        Revelation.GenSubtypeChecks ();
        Emit.Op ("break; \002\002}; };\n");
    Emit.Op ("\002};\n");
    Temp.PopSet ();
    Emit.Pop ();

  END CompileInterface;

PROCEDURE CompileModule (t: T) =
  VAR
    i, n  : INTEGER;
    x     : List;
    objs  : Scope.ValueList;
    v     : Value.T;
    oc    : Stmt.Outcomes;
  BEGIN
    (* make sure my items are marked for export *)
    Scope.ToList (t.syms, objs, n);
    FOR i := 0 TO n - 1 DO
      v := objs[i];
      CASE Value.ClassOf (v) OF
      | Value.Class.Expr,
        Value.Class.Module,
	Value.Class.Error,
	Value.Class.Var,
        Value.Class.Type,
        Value.Class.Exception =>
          (* no change of import/export status *)
      | Value.Class.Procedure =>
          IF (v.imported) THEN
            v.exported := Procedure.HasBody (v);
            v.imported := NOT v.exported;
          END;
      | Value.Class.Field,
        Value.Class.Method,
	Value.Class.Formal =>
          <* ASSERT FALSE *>
      END;
    END;

    (* declare the modules that I import & export *)
    GenInitLinks (t.imports);
    GenInitLinks (t.exports);

    (* declare my imports *)
    GenInterfaces (t.imports);

    (* declare my exports *)
    GenInterfaceRecord (t);

    (* declare any visible revelations *)
    Revelation.Declare (t.revelations);

    (* generate the frame types *)
    Scope.GenFrameTypes ();

    (* declare any internal procedures *)
    Procedure.GenHeaders ();

    (* declare my private global variables *)
    Variable.GenGlobalMap (t.name, FALSE, t.syms);

    (* generate the tables for coverage *)
    Coverage.GenerateTables ();

    (* generate any internal procedures *)
    Procedure.GenBodies ();

    (* restore my environment *)
    Scope.Push (t.syms);

    IF Host.toCompile = NIL THEN
      (* generate my init flag *)
      Emit.Op ("\nPRIVATE int init_done = -1;\n");
  
      (* generate my initialization procedure *)
      Stmt.Precompile (t.body);
      Emit.Push ();
      Temp.PushSet ();
      Emit.OpS ("\nPRIVATE void\n@__initProc (g) int g;\n", t.name);
      Emit.Op ("{\n");
      i := Emit.Switch (1);
      Emit.Op ("if (init_done >= g) return;\ninit_done = g;\n");
      GenInitCalls (t.exports);
      GenInitCalls (t.imports);
      Scope.Generate (t.syms);
      oc := Stmt.Compile (t.body);
      IF (Stmt.Outcome.FallThrough IN oc) THEN Emit.Op ("return;\n") END;
      i := Emit.Switch (Emit.MaxStream);
      Emit.Op ("};\n\n");
      Temp.PopSet ();
      Emit.Pop ();
    END;

    Type.GenInitProcs ();
    Type.GenMapProcs ();
  
    (* generate my init links *)
    IF Host.toCompile = NIL THEN
      i := 0;
      x := t.exports;
      WHILE (x # NIL) DO
        Emit.OpIS (
          "\nPRIVATE INITLINK me_@ ={(INITLINK*)NIL, 0, @__initProc};\n",
           i, t.name);
        x := x.next;
        INC (i);
      END;
    END;

    Scanner.offset := 0;  (* we don't care about line numbers any more *)

    (* reference all imported version stamps *)
    ImportVersionStamps (t);

    (* link proc *)
    IF Host.toCompile = NIL THEN
      Emit.Push ();
      Temp.PushSet ();
      IF Host.incrementalVersion = 0 THEN
        Emit.OpS ("\nEXPORT void (*@_MLink_relay) () = 0;\n", t.name);
      ELSIF Host.incrementalVersion > 0 THEN
        Emit.OpS ("\nIMPORT void (*@_MLink_relay) ();\n", t.name);
        Emit.Op  ("PRIVATE ");
      ELSE
        Emit.Op ("\n");
      END;
      Emit.OpS ("void @__MLink (phase) int phase;\n", t.name);
      Emit.Op ("{\n\001");
      IF Host.incrementalVersion = 0 THEN
        Emit.OpSS ("if (@_MLink_relay) {@_MLink_relay (phase); return;};\n",
                   t.name, t.name);
      END;
      Emit.Op ("switch (phase) {\001\n");
        (* Phase 0 link proc: build interfaces & type registrations *)
        Emit.Op ("case 0: {\001\n");
          (* register my "main" body *)
          i := 0;
          x := t.exports;
          WHILE (x # NIL) DO
            Emit.OpIS ("me_@.link = @__init;\n", i, x.module.name);
            Emit.OpSI ("@__init = & me_@;\n", x.module.name, i);
            x := x.next;
            INC (i);
          END;
          (* build my interface record *)
          x := t.exports;
          WHILE (x # NIL) DO GenExports (x.module); x := x.next;  END;
          (* register all types *)
          Type.GenRegistrations ();
          Emit.Op ("break; \002};\n");
        (* Phase 1 link proc: finish registrations & variable inits *)
        Emit.Op ("case 1: {\001\n");
          (* finalize the type registrations *)
          Type.FinishRegistrations ();
          Revelation.GenIdentifications ();
          (* initialize my exported variables *)
          x := t.exports;
          WHILE (x # NIL) DO InitExports (x.module); x := x.next;  END;
          Emit.Op ("break; \002};\n");
        (* Phase 2 link proc: check subtype revelations *)
        Emit.Op ("case 2: {\001\n");
          Revelation.GenSubtypeChecks ();
          Emit.Op ("break; \002\002}; };\n");
      Emit.Op ("\002};\n");
      Temp.PopSet ();
      Emit.Pop ();
    END;

    (* generate the relay procedure *)
    IF Host.incrementalVersion > 0 THEN
      Emit.Push ();
      Temp.PushSet ();
      Emit.OpSI ("\nvoid @_relay_@ ()\n", t.name, Host.incrementalVersion);
      Emit.Op ("{\n\001");
        FOR i := 0 TO n - 1 DO
          v := objs [i];
          CASE Value.ClassOf (v) OF 
          | Value.Class.Procedure =>
            IF (v.exported) 
               AND (Host.toCompile = NIL OR Host.toCompile = v.name) THEN
              Emit.OpN ("@_relay = ", v);
              Emit.OpN ("@;\n", v);
            END;
          | ELSE (* do nothing *)
          END;
        END;
        IF (Host.toCompile = NIL) THEN
          Emit.OpSS ("@_MLink_relay = @__MLink;\n", t.name, t.name);
        END;
      Emit.Op ("\002};\n");
      Temp.PopSet ();
      Emit.Pop ();
   END;

  END CompileModule;

PROCEDURE GenExports (interface: T) =
  VAR
    name : String.T;
    objs : Scope.ValueList;
    n    : INTEGER;
    o1   : Value.T;
  BEGIN
    name := interface.name;
    Scope.ToList (interface.syms, objs, n);
    FOR i := 0 TO n - 1 DO
      o1 := objs[i];
      IF (Value.ClassOf (o1) = Value.Class.Type) THEN
        Tipe.InitializeExport (o1, name);
      END;
    END;
  END GenExports;

PROCEDURE InitExports (interface: T) =
  VAR
    name : String.T;
    objs : Scope.ValueList;
    n    : INTEGER;
    o    : Value.T;
  BEGIN
    name := interface.name;
    Scope.ToList (interface.syms, objs, n);
    FOR i := 0 TO n - 1 DO
      o := objs[i];
      CASE Value.ClassOf (o) OF
      | Value.Class.Var =>
          IF (o.exported) THEN
            Variable.InitGlobal (name, o);
          END;
      ELSE
          (* nothing to initialize *)
      END;
    END;
  END InitExports;

PROCEDURE GenInitCalls (l: List) =
  VAR x, y: List;
  BEGIN
    x := l;
    WHILE (x # NIL) DO
      y := l;
      LOOP
        IF (x = y) THEN
          Emit.OpS ("INITIALIZE (& @__init);\n", x.module.name);
          EXIT;
        END;
        IF (x.module = y.module) THEN EXIT END;
        y := y.next;
      END;
      x := x.next;
    END;
  END GenInitCalls;

PROCEDURE GenInitLinks (l: List) =
  VAR x, y: List;
  BEGIN
    x := l;
    WHILE (x # NIL) DO
      y := l;
      LOOP
        IF (x = y) THEN GenInitLink (x.module, FALSE); EXIT; END;
        IF (x.module = y.module) THEN EXIT END;
        y := y.next;
      END;
      x := x.next;
    END;
  END GenInitLinks;

PROCEDURE GenInitLink (t: T; exported: BOOLEAN) =
  BEGIN
    IF (exported)
      THEN Emit.OpS ("EXPORT INITLINK* @__init = (INITLINK*) 0;\n", t.name);
      ELSE Emit.OpS ("IMPORT INITLINK* @__init;\n", t.name);
    END;
  END GenInitLink;

PROCEDURE GenInterfaces (l: List) =
  VAR x, y: List;
  BEGIN
    x := l;
    WHILE (x # NIL) DO
      y := l;
      LOOP
        IF (x = y) THEN GenInterfaceRecord (x.module); EXIT END;
        IF (x.module = y.module) THEN EXIT END;
        y := y.next;
      END;
      x := x.next;
    END;
  END GenInterfaces;

PROCEDURE GenInterfaceRecord (t: T) =
  VAR n: INTEGER; elts: Scope.ValueList;
  BEGIN
    Emit.Op ("\n");
    Scope.ToList (t.syms, elts, n);
    FOR i := 0 TO n - 1 DO  Value.Declare0 (elts[i]);  END;
    Emit.Op ("\n");
  END GenInterfaceRecord;

PROCEDURE ImportVersionStamps (t: T) =
  BEGIN
    IF Host.versionStamps THEN
      Emit.Op ("static char* VSimports[] = {\001\n");
      RefVersionStamps (t.imports);
      RefVersionStampsInModule (t);
      Emit.Op ("NIL\n\002};\n");
    END;
  END ImportVersionStamps;

PROCEDURE RefVersionStamps (l: List) =
  VAR x, y: List;
  BEGIN
    x := l;
    WHILE (x # NIL) DO
      y := l;
      LOOP
        IF (x = y) THEN RefVersionStampsInModule (x.module); EXIT END;
        IF (x.module = y.module) THEN EXIT END;
        y := y.next;
      END;
      x := x.next;
    END;
  END RefVersionStamps;

PROCEDURE RefVersionStampsInModule (t: T) =
  VAR n: INTEGER;  elts: Scope.ValueList;
  BEGIN
    Scope.ToList (t.syms, elts, n);
    FOR i := 0 TO n - 1 DO  Value.NoteUse (elts[i]);  END;
  END RefVersionStampsInModule;

PROCEDURE FPrinter (t: T;  <*UNUSED*> map: Type.Map;  wr: Wr.T) =
  BEGIN
    String.Put (wr, t.name);
    Wr.PutText (wr, ".");
  END FPrinter;

PROCEDURE CurrentName (): String.T =
  BEGIN
    IF curModule = NIL THEN RETURN NIL; END;
    RETURN curModule.name;
  END CurrentName;

BEGIN
END Module.