cm3/src/Builder.m3


 Copyright 1996-2000 Critical Mass, Inc. All rights reserved.    
 See file COPYRIGHT-CMASS for details. 

MODULE Builder;

IMPORT Text, Wr, Stdio, IntIntTbl AS IntSet;
IMPORT OSError, Fmt, IntRefTbl;
IMPORT FS, File, Time, Fingerprint;
IMPORT Thread, ETimer, Dirs;
IMPORT M3File, M3ID, M3CG, M3Timers, M3Front, Target, WebFile;
IMPORT Mx, MxMerge, MxCheck, MxGen, MxIn, MxOut, MxVS;
IMPORT Msg, Arg, Utils, M3Path, M3Backend, M3Compiler;
IMPORT Quake, QMachine, QValue, QVal, QVSeq;
IMPORT M3Loc, M3Unit, M3Options, MxConfig AS M3Config;

TYPE
  UK = M3Unit.Kind;
------------------------------------------------- external entry points ---

PROCEDURE BuildPgm (prog: TEXT;  READONLY units: M3Unit.Set;
                    sys_libs: Arg.List;  shared: BOOLEAN;  m: Quake.Machine) =
  VAR s := CompileUnits (prog, units, sys_libs, UK.PGMX, m);
  BEGIN
    IF s.bootstrap_mode
      THEN BuildBootProgram (s);
      ELSE BuildProgram (s, shared);
    END;
    IF s.compile_failed THEN M3Options.exit_code := 1; END;
  END BuildPgm;

PROCEDURE BuildLib (lib: TEXT;  READONLY units: M3Unit.Set;
                    sys_libs: Arg.List;  shared: BOOLEAN;  m: Quake.Machine) =
  VAR s := CompileUnits (lib, units, sys_libs, UK.LIBX, m);
  BEGIN
    IF s.bootstrap_mode
      THEN BuildBootLibrary (s);
      ELSE BuildLibrary (s, shared);
    END;
    IF s.compile_failed THEN M3Options.exit_code := 1; END;
  END BuildLib;

PROCEDURE JustCompile (READONLY units: M3Unit.Set;
                       sys_libs: Arg.List;  m: Quake.Machine) =
  VAR s := CompileUnits ("noname", units, sys_libs, UK.PGMX, m);
  BEGIN
    IF s.compile_failed THEN M3Options.exit_code := 1; END;
  END JustCompile;

PROCEDURE BuildCPgm (prog: TEXT;  READONLY units: M3Unit.Set;
                     sys_libs: Arg.List;  shared: BOOLEAN;  m: Quake.Machine) =
  VAR s := CompileUnits (prog, units, sys_libs, UK.PGMX, m);
  BEGIN
    BuildCProgram (s, shared);
    IF s.compile_failed THEN M3Options.exit_code := 1; END;
  END BuildCPgm;

VAR current_state: State := NIL;

PROCEDURE CleanUp () =
  VAR s := current_state;
  BEGIN
    current_state := NIL;
    IF (s # NIL) THEN
      DumpLinkInfo (s);
      WebFile.Dump ();
    END;
  END CleanUp;

PROCEDURE EmitPkgImports (READONLY units: M3Unit.Set) =
  VAR src := units.head;
  BEGIN
    WHILE (src # NIL) DO
      IF (src.imported) AND (src.kind = UK.M3LIB) THEN
        WITH name = M3ID.ToText(src.loc.pkg) DO
          Msg.Out (" ", name);
        END;
      END;
      src := src.next;
    END;
    Msg.Out (Wr.EOL);
  END EmitPkgImports;
-------------------------------------------------- general compilation --- The global variables of a compilation are passed around in a State.

TYPE
  State = REF RECORD
    result_name   : TEXT;               (* base of program or library name *)
    info_name     : TEXT;               (* name of the version stamp file *)
    config_file   : TEXT;               (* name of the current config file *)
    sys_libs      : Arg.List;           (* linker args for system libraries *)
    machine       : Quake.Machine;      (* to access configuration procs *)
    units         : M3Unit.Set;         (* initial source pool *)
    link_base     : Mx.LinkSet := NIL;  (* accumulated version stamps  *)
    magic         : IntRefTbl.T;        (* type name -> info *)
    ast_cache     : IntRefTbl.T;        (* interface name -> AST *)
    include_path  : Arg.List;           (* -I include path for C compiler *)
    pending_impls : M3Unit.TList;       (* deferred implementation modules *)
    main          : M3ID.T;             (* "Main" *)
    m3env         : Env;                (* the compiler's environment closure *)
    target        : TEXT;               (* target machine *)
    host_os       : M3Path.OSKind;      (* host system *)
    target_os     : M3Path.OSKind;      (* target os *)
    m3backend_mode: [0..3];             (* tells how to turn M3CG -> object *)
    m3backend     : ConfigProc;         (* translate M3CG -> ASM or OBJ *)
    c_compiler    : ConfigProc;         (* compile C code *)
    assembler     : ConfigProc;         (* assemble  *)
    librarian     : ConfigProc;         (* make libraries *)
    skip_lib      : ConfigProc;         (* don't make libraries *)
    linker        : ConfigProc;         (* link programs *)
    skip_linker   : ConfigProc;         (* don't link programs *)
    keep_files    : BOOLEAN;            (* delete temporary files *)
    compile_failed: BOOLEAN;            (* did anything fail? *)
    new_link_info : BOOLEAN;            (* did we generate any new version stamps?*)
    bootstrap_mode: BOOLEAN;            (* stop compiling at assembly code *)
    compile_once  : BOOLEAN;            (* don't recompile for better code *)
    has_loader    : BOOLEAN;            (* gen loader info file *)
    skip_link     : BOOLEAN;            (* don't bother linking final exe *)
    keep_resolved : BOOLEAN;            (* pass resolved library names to linker *)
    m3main_in_c   : BOOLEAN;            (* generate a C main program *)
    gui           : BOOLEAN;            (* generate a Windows GUI subsystem prog *)
    do_coverage   : BOOLEAN;            (* compile and link for coverage *)
    broken_linker : BOOLEAN;            (* linker can't do build_standalone() *)
    Rpath_flag    : TEXT;               (* linker needs -R switches too... *)
    link_coverage : TEXT;               (* coverage library *)
    m3_front_flags: Arg.List;           (* configuration options for the front *)
    m3_options    : Arg.List;           (* misc. user options for the frontend *)
  END;

TYPE
  ConfigProc = RECORD
    name    : TEXT;
    n_args  : INTEGER;
    binding : QValue.Binding;
  END;

PROCEDURE CompileUnits (main     : TEXT;
               READONLY units    : M3Unit.Set;
                        sys_libs : Arg.List;
                        info_kind: UK;
                        mach     : Quake.Machine): State =
  VAR s := NEW (State);  nm := M3Path.Parse (main, host := TRUE);
  BEGIN
    DumpUnits (units);
    ETimer.ResetAll ();

    s.result_name   := main;
    s.info_name     := M3Path.Join (NIL, nm.base, info_kind, host := TRUE);
    s.config_file   := M3Config.FindFile ();
    s.sys_libs      := sys_libs;
    s.machine       := mach;
    s.units         := units;
    s.link_base     := NIL;
    s.magic         := NEW (IntRefTbl.Default).init (100);
    s.ast_cache     := NEW (IntRefTbl.Default).init (100);
    s.include_path  := Arg.NewList ();
    s.pending_impls := NIL;
    s.main          := M3ID.Add ("Main");
    s.m3env         := NEW (Env);
    s.m3env.globals := s;

    s.target := GetConfigItem (s, "TARGET");
    IF NOT Target.Init (s.target) THEN
      Msg.FatalError (NIL, "unrecognized target machine: TARGET = ", s.target);
    END;

    s.host_os := GetOSType (s, "NAMING_CONVENTIONS");
    IF (GetDefn (s, "TARGET_NAMING") = NIL)
      THEN s.target_os := s.host_os;
      ELSE s.target_os := GetOSType (s, "TARGET_NAMING");
    END;
    M3Path.SetOS (s.host_os, host := TRUE);
    M3Path.SetOS (s.target_os, host := FALSE);

    s.m3backend_mode := MAX (0, MIN (GetConfigInt (s, "M3_BACKEND_MODE"), 3));

    s.m3backend   := GetConfigProc (s, "m3_backend", 4);
    s.c_compiler  := GetConfigProc (s, "compile_c", 5);
    s.assembler   := GetConfigProc (s, "assemble", 2);
    s.librarian   := GetConfigProc (s, "make_lib", 5);
    s.skip_lib    := GetConfigProc (s, "skip_lib", 2);
    s.linker      := GetConfigProc (s, "m3_link", 5);
    s.skip_linker := GetConfigProc (s, "skip_link", 2);

    s.compile_failed := FALSE;
    s.new_link_info  := FALSE;
    s.keep_files     := GetConfigBool (s, "M3_KEEP_FILES");
    s.bootstrap_mode := GetConfigBool (s, "M3_BOOTSTRAP");
    s.compile_once   := GetConfigBool (s, "M3_COMPILE_ONCE");
    s.has_loader     := GetConfigBool (s, "SYS_HAS_LOADER");
    s.skip_link      := GetConfigBool (s, "M3_SKIP_LINK");
    s.keep_resolved  := NOT GetConfigBool (s, "M3_SPLIT_LIBNAMES");
    s.m3main_in_c    := GetConfigBool (s, "M3_MAIN_IN_C");
    s.gui            := GetConfigBool (s, "M3_WINDOWS_GUI");
    s.do_coverage    := GetConfigBool (s, "M3_COVERAGE");
    s.broken_linker  := GetConfigBool (s, "M3_NEED_STANDALONE_LINKS");
    s.Rpath_flag     := GetConfigText (s, "M3_SHARED_LIB_ARG");
    s.link_coverage  := GetConfigText (s, "M3_COVERAGE_LIB");
    s.m3_front_flags := GetConfigArray (s, "M3_FRONT_FLAGS");
    s.m3_options     := GetConfigArray (s, "M3_OPTIONS");

    ETimer.Push (M3Timers.localobj);
      Utils.NoteLocalFileTimes ();
    ETimer.Pop ();
    BuildSearchPaths (s);
    InhaleLinkInfo (s);
    BuildLibraryPool (s);

    current_state := s;
      CompileEverything (s, SortUnits (s));
      CleanUp ();
    current_state := NIL;

    RETURN s;
  END CompileUnits;

PROCEDURE GetOSType (s: State;  sym: TEXT): M3Path.OSKind =
  VAR val := GetConfigItem (s, sym);
  BEGIN
    IF    Text.Equal (val, "0")   THEN RETURN M3Path.OSKind.Unix;
    ELSIF Text.Equal (val, "1")   THEN RETURN M3Path.OSKind.GrumpyUnix;
    ELSIF Text.Equal (val, "2")   THEN RETURN M3Path.OSKind.Win32;
    END;
    ConfigErr (s, sym, "unrecognized naming convention: " & val);
    RETURN M3Path.OSKind.Unix;
  END GetOSType;

PROCEDURE GetConfigItem (s: State;  symbol: TEXT): TEXT =
  VAR bind := GetDefn (s, symbol);
  BEGIN
    IF (bind = NIL) THEN ConfigErr (s, symbol, "not defined"); END;
    TRY
      RETURN QVal.ToText (s.machine, bind.value);
    EXCEPT Quake.Error (msg) =>
      ConfigErr (s, symbol, msg);
    END;
    RETURN NIL;
  END GetConfigItem;

PROCEDURE GetConfigProc (s: State;  symbol: TEXT;
                         n_args: INTEGER): ConfigProc =
  VAR x: ConfigProc;
  BEGIN
    x.name    := symbol;
    x.n_args  := n_args;
    x.binding := GetDefn (s, symbol);
    RETURN x;
  END GetConfigProc;

PROCEDURE GetConfigInt (s: State;  symbol: TEXT): INTEGER =
  VAR bind := GetDefn (s, symbol);
  BEGIN
    IF (bind = NIL) THEN ConfigErr (s, symbol, "not defined"); END;
    TRY
      RETURN QVal.ToInt (s.machine, bind.value);
    EXCEPT Quake.Error (msg) =>
      ConfigErr (s, symbol, msg);
    END;
    RETURN 0;
  END GetConfigInt;

PROCEDURE GetConfigBool (s: State;  symbol: TEXT): BOOLEAN =
  VAR bind := GetDefn (s, symbol);
  BEGIN
    IF (bind = NIL) THEN RETURN FALSE; END;
    TRY
      RETURN QVal.ToBool (s.machine, bind.value);
    EXCEPT Quake.Error (msg) =>
      ConfigErr (s, symbol, msg);
      RETURN FALSE;
    END;
  END GetConfigBool;

PROCEDURE GetConfigText (s: State;  symbol: TEXT): TEXT =
  VAR bind := GetDefn (s, symbol);
  BEGIN
    IF (bind = NIL) THEN RETURN NIL; END;
    TRY
      RETURN QVal.ToText (s.machine, bind.value);
    EXCEPT Quake.Error (msg) =>
      ConfigErr (s, symbol, msg);
      RETURN NIL;
    END;
  END GetConfigText;

PROCEDURE GetConfigArray (s: State;  symbol: TEXT): Arg.List =
  VAR
    bind := GetDefn (s, symbol);
    args := Arg.NewList ();
    arr: QVSeq.T;
  BEGIN
    IF (bind = NIL) THEN RETURN args; END;
    TRY
      arr := QVal.ToArray (s.machine, bind.value);
    EXCEPT Quake.Error (msg) =>
      ConfigErr (s, symbol, msg);
      RETURN args;
    END;

    FOR i := 0 TO arr.size() - 1 DO
      TRY
        Arg.Append (args, QVal.ToText (s.machine, arr.get (i)));
      EXCEPT Quake.Error (msg) =>
        ConfigErr (s, symbol, "array element not a text string: " & msg);
      END;
    END;

    RETURN args;
  END GetConfigArray;

PROCEDURE GetDefn (s: State;  symbol: TEXT): QValue.Binding =
  BEGIN
    RETURN s.machine.lookup (M3ID.Add (symbol));
  END GetDefn;

PROCEDURE ConfigErr (s: State;  symbol, msg: TEXT) =
  BEGIN
    Msg.FatalError (NIL, "Unable to use definition of \"" & symbol
                     & "\" from configuration file \"" & s.config_file
                     & "\": " & msg);
  END ConfigErr;

PROCEDURE DumpUnits (READONLY units: M3Unit.Set) =
  VAR cnt := 0;  u := units.head;
  BEGIN
    IF (Msg.level < Msg.Level.Debug) THEN RETURN END;
    Msg.Debug (Wr.EOL);
    Msg.Debug ("incoming units:", Wr.EOL);
    WHILE (u # NIL) DO
      Msg.Debug (" ", M3Unit.FileName (u));
      u := u.next;  INC (cnt);
    END;
    Msg.Debug (Wr.EOL);
    Msg.Debug ("  (list size = ", Fmt.Int (cnt), ")");
    Msg.Debug ("  (map size = ", Fmt.Int (units.map.size()), ")", Wr.EOL);
    Msg.Debug (Wr.EOL);
  END DumpUnits;
-------------------------------------------------------- C search paths ---

PROCEDURE BuildSearchPaths (s: State) =
  (* find the directories containing C source and include files and
     find the newest include file... *)
  VAR u := s.units.head;  seen := NEW (IntRefTbl.Default).init ();
  BEGIN
    WHILE (u # NIL) DO
      IF (u.kind = UK.C) OR (u.kind = UK.H) THEN
        IF NOT seen.put (M3ID.Add (u.loc.path), NIL) THEN
          Arg.Append (s.include_path, "-I" & u.loc.path);
        END;
      END;
      u := u.next;
    END;
  END BuildSearchPaths;
------------------------------------------------------- local link info ---

PROCEDURE InhaleLinkInfo (s: State) =
  VAR ux: Mx.UnitList;
  BEGIN
    ETimer.Push (M3Timers.inhale);
    Msg.Commands ("inhale ", s.info_name);
    ux := GetLinkUnits (s.info_name, NIL, imported := FALSE);
    IF (ux = NIL) THEN
      Msg.Debug ("no local link info", Wr.EOL);
    ELSE
      Msg.Debug ("adding units: ");
      WHILE (ux # NIL) DO
        EVAL MatchLocalUnit (s, ux.unit, FALSE);
        ux := ux.next;
      END;
      Msg.Debug (Wr.EOL);
    END;

    FindLocalExporters (s);

    s.new_link_info := FALSE;
    ETimer.Pop ();
  END InhaleLinkInfo;

PROCEDURE MatchLocalUnit (s: State;  uu: Mx.Unit;  imported: BOOLEAN): M3Unit.T =
  CONST KMap = ARRAY BOOLEAN OF UK { UK.M3, UK.I3 };
  VAR unit: M3Unit.T;
  BEGIN
    IF (uu = NIL) THEN RETURN NIL; END;

    unit := M3Unit.Get (s.units, uu.name, KMap [uu.interface]);
    IF (unit = NIL) THEN
      (* no source to match this unit (=> probably M3_BUILTIN.i3) *)
      IF (uu.interface AND Text.Equal (M3ID.ToText (uu.name), "M3_BUILTIN")) THEN
        unit := M3Unit.Get (s.units, M3ID.Add ("RTBuiltin"), UK.PGMX);
      END;
      IF (unit = NIL) THEN
        IF imported THEN
          unit := M3Unit.New (uu.name,  KMap[uu.interface],
                              M3Loc.New (M3Loc.noPkg, M3ID.Add ("."), "."),
                              hidden := TRUE, imported := imported);
          M3Unit.Add (s.units, unit);
          Msg.Verbose ("no source to match imported link unit ", UnitPath (unit));
        ELSE
          Msg.Verbose ("no source to match local link unit ", M3ID.ToText (uu.name));
          RETURN NIL;
        END;
      END;
    END;

    IF (unit.link_info # NIL) THEN
      BadFile ("duplicate link info", unit);
    END;
    unit.link_info := uu;
    IF (uu.file # NIL) AND (uu.file.name = NIL) THEN
      uu.file.name := UnitPath (unit);
    END;

    RETURN unit;
  END MatchLocalUnit;

PROCEDURE DumpLinkInfo (s: State) =
  VAR src := s.units.head;  units: Mx.UnitList := NIL;  wr: Wr.T;
  BEGIN
    IF NOT s.new_link_info THEN RETURN END;
    s.new_link_info := FALSE;  (* in case we die writing the info *)
    ETimer.Push (M3Timers.exhale);

    (* build a list of the local units *)
    WHILE (src # NIL) DO
      IF (NOT src.imported) AND (src.link_info # NIL) THEN
        units := NEW (Mx.UnitList, unit := src.link_info, next := units);
      END;
      src := src.next;
    END;

    (* and write them *)
    Msg.Commands ("exhale ", s.info_name);
    wr := Utils.OpenWriter (s.info_name, fatal := TRUE);
    MxOut.WriteUnits (units, wr);
    Utils.CloseWriter (wr, s.info_name);

    ETimer.Pop ();
  END DumpLinkInfo;
---------------------------------------------------------- library pool ---

PROCEDURE BuildLibraryPool (s: State) =
  VAR src := s.units.head;  ux: Mx.UnitList;
  BEGIN
    WHILE (src # NIL) DO
      IF (src.imported) AND (src.kind = UK.M3LIB) THEN
        (* Msg.Explain ("imported package ", M3ID.ToText(src.name)); *)
        ETimer.Push (M3Timers.inhale);
        Msg.Commands ("inhale ", UnitPath (src));
        ux := GetUnitLinkInfo (src, imported := TRUE);
        IF (ux = NIL) THEN
          Msg.Debug ("no link info for ", UnitPath (src), Wr.EOL);
        ELSE
          Msg.Debug ("adding units: ");
          WHILE (ux # NIL) DO
            AddLibraryUnit (s, ux.unit, src);
            ux := ux.next;
          END;
          Msg.Debug (Wr.EOL);
        END;
        ETimer.Pop ();
      END;
      src := src.next;
    END;
  END BuildLibraryPool;

PROCEDURE AddLibraryUnit (s: State;  uu: Mx.Unit;  lib: M3Unit.T) =
  CONST suffix = ARRAY BOOLEAN OF TEXT {".m3", ".i3"};
  VAR u: M3Unit.T;
  BEGIN
    Msg.Debug (" ", M3ID.ToText (uu.name), suffix[uu.interface]);
    u := MatchLocalUnit (s, uu, TRUE);
    IF (u # NIL) THEN
      u.library := lib;
      IF (NOT uu.interface) THEN
        WITH z = uu.exported_units DO
          FOR i := z.start TO z.start + z.cnt - 1 DO
            AddExportHook (s, uu.info [i], u);
          END;
        END;
      END;
    END;
  END AddLibraryUnit;
------------------------------------------- interface -> exporter links ---

PROCEDURE FindLocalExporters (s: State) =
  (* Build the initial set of export links for the local modules. *)
  VAR u: M3Unit.T;
  BEGIN
    (* scan the .M3 files for export information *)
    u := s.units.head;
    WHILE (u # NIL) DO
      IF (NOT u.imported) AND (u.kind = UK.M3) THEN
        IF (u.link_info # NIL) THEN
          (* we already know something about this guy *)
          WITH z = u.link_info.exported_units DO
            FOR i := z.start TO z.start + z.cnt - 1 DO
              AddExportHook (s, u.link_info.info[i], u);
            END;
          END;
        ELSE
          (* guess that he exports an interface with the same name! *)
          AddExportGuess (s, u);
        END;
      END;
      u := u.next;
    END;
  END FindLocalExporters;

PROCEDURE AddExportHook (s: State;  intf_name: M3ID.T;  impl: M3Unit.T) =
  VAR intf: M3Unit.T;
  BEGIN
    intf := M3Unit.Get (s.units, intf_name, UK.I3);
    IF (intf = NIL) THEN
      s.compile_failed := TRUE;
      Msg.Error (NIL, "missing interface: ", M3ID.ToText (intf_name), ".i3");
    ELSIF (intf.name = s.main) THEN
      (* Ignore "EXPORTS Main".  The linker is responsible for finding and
         explicitly initializing modules that claim to be the main program.  *)
    ELSIF (intf.imported # impl.imported) AND (intf.name # s.main) THEN
      s.compile_failed := TRUE;
      BadExport (intf, impl);
    ELSE
      intf.exporters := NEW (M3Unit.Exporter,
                             next     := intf.exporters,
                             name     := impl.name,
                             unit     := impl,
                             used     := FALSE,
                             verified := TRUE );
    END;
  END AddExportHook;

PROCEDURE AddExportGuess (s: State;  impl: M3Unit.T) =
  (* Guess that module "M" exports interface "M". *)
  VAR intf: M3Unit.T;
  BEGIN
    intf := M3Unit.Get (s.units, impl.name, UK.I3);
    IF (intf = NIL) THEN
      (* No such interface.  The guess must be no good. *)
    ELSIF (intf.name = s.main) THEN
      (* Ignore "EXPORTS Main".  The linker is responsible for finding and
         explicitly initializing modules that claim to be the main program.  *)
    ELSIF (intf.imported # impl.imported) THEN
      (* Nope.  We don't allow exports to cross library boundaries. *)
    ELSE
      intf.exporters := NEW (M3Unit.Exporter,
                             next     := intf.exporters,
                             name     := impl.name,
                             unit     := impl,
                             used     := FALSE,
                             verified := FALSE );
    END;
  END AddExportGuess;

PROCEDURE BadExport (intf, impl: M3Unit.T) =
  CONST X0 = ARRAY BOOLEAN OF TEXT { "local", "library" };
  BEGIN
    Msg.Error (NIL,
        X0[impl.imported] & " module (" & M3Unit.FileName (impl) & ")"
      & " cannot export "
      & X0[intf.imported] & " interface (" & M3Unit.FileName (intf) & ")");
  END BadExport;

PROCEDURE ResetExports (s: State;  u: M3Unit.T) =
  (* Forget any export information we may have for "u" because
     we're about the recompile it. *)
  VAR ex := u.exporters;
  BEGIN
    (* for interfaces, mark all the exporters "unused" *)
    WHILE (ex # NIL) DO  ex.used := FALSE;  ex := ex.next; END;

    (* for implementations, mark all the exporters "unverified" *)
    IF (u.kind =  UK.M3) AND (u.link_info # NIL) THEN
      WITH z = u.link_info.exported_units DO
        FOR i := z.start TO z.start + z.cnt - 1 DO
          ForgetExport (s, u.link_info.info[i], u);
        END;
      END;
    END;
  END ResetExports;

PROCEDURE ForgetExport (s: State;  intf_name: M3ID.T;  impl: M3Unit.T) =
  VAR intf: M3Unit.T;  ex: M3Unit.Exporter;
  BEGIN
    intf := M3Unit.Get (s.units, intf_name, UK.I3);
    IF (intf # NIL) THEN
      ex := intf.exporters;
      WHILE (ex # NIL) DO
        IF (ex.unit = impl) THEN ex.verified := FALSE; END;
        ex := ex.next;
      END;
    END;
  END ForgetExport;

PROCEDURE GetExporters (intf: M3Unit.T): M3Compiler.ImplList =
  VAR ex: M3Unit.Exporter;  xx: M3Compiler.ImplList := NIL;
  BEGIN
    ex := intf.exporters;
    WHILE (ex # NIL) DO
      xx := NEW (M3Compiler.ImplList, impl := ex.name, next := xx);
      ex.used := TRUE;
      ex := ex.next;
    END;
    RETURN xx;
  END GetExporters;

PROCEDURE MarkExportsUsed (intf: M3Unit.T) =
  (* Even though we're not going to compile "intf", pretend that
     we did using any verified exporters on its current export list. *)
  VAR ex := intf.exporters;
  BEGIN
    WHILE (ex # NIL) DO
      IF (ex.verified) THEN ex.used := TRUE; END;
      ex := ex.next;
    END;
  END MarkExportsUsed;

PROCEDURE UsedBogusExportList (intf: M3Unit.T): BOOLEAN =
  CONST U = ARRAY BOOLEAN OF TEXT { " not used,", " used," };
  CONST V = ARRAY BOOLEAN OF TEXT { " not verified", " verified" };
  VAR ex := intf.exporters;
  BEGIN
    WHILE (ex # NIL) DO
      IF (ex.used # ex.verified) THEN
        VerboseF ("new exporters ", intf);
        Msg.Verbose (" -> export ", M3ID.ToText (ex.name),
                     U[ex.used], V[ex.verified]);
        RETURN TRUE;
      END;
      ex := ex.next;
    END;
    RETURN FALSE;
  END UsedBogusExportList;

PROCEDURE NoteExporter (s: State;  intf_name: M3ID.T;  impl: M3Unit.T) =
  VAR intf: M3Unit.T;  ex: M3Unit.Exporter;
  BEGIN
    IF (impl = NIL) OR (impl.kind # UK.M3) THEN RETURN; END;
    intf := M3Unit.Get (s.units, intf_name, UK.I3);
    IF (intf = NIL) THEN
      s.compile_failed := TRUE;
      Msg.Error (NIL, "missing interface: ", M3ID.ToText (intf_name), ".i3");
    ELSIF (intf.name = s.main) THEN
      (* Ignore "EXPORTS Main".  The linker is responsible for finding and
         explicitly initializing modules that claim to be the main program.  *)
    ELSIF (intf.imported # impl.imported) AND (intf.name # s.main) THEN
      s.compile_failed := TRUE;
      BadExport (intf, impl);
    ELSE
      ex := intf.exporters;
      WHILE (ex # NIL) DO
        IF (ex.unit = impl) THEN ex.verified := TRUE; RETURN; END;
        ex := ex.next;
      END;
      (* no match was found => build a new exporter *)
      intf.exporters := NEW (M3Unit.Exporter,
                             next     := intf.exporters,
                             name     := impl.name,
                             unit     := impl,
                             used     := FALSE,
                             verified := TRUE );
    END;
  END NoteExporter;
----------------------------------------- determine the compilation order--

TYPE SourceList = REF ARRAY OF M3Unit.T;

CONST
  OrderMatters = ARRAY UK OF BOOLEAN {
    FALSE (*Unknown*),
     TRUE (*I3*),     TRUE (*IC*),   TRUE (*IS*),    TRUE (*IO*),
     TRUE (*M3*),     TRUE (*MC*),   TRUE (*MS*),    TRUE (*MO*),
    FALSE (*IG*),    FALSE (*MG*),
    FALSE (*C*),     FALSE (*H*),   FALSE (*S*),    FALSE (*O*),
    FALSE (*M3LIB*), FALSE (*LIB*),  TRUE (*LIBX*), FALSE (*PGM*),
     TRUE (*PGMX*),  FALSE (*TMPL*) };

TYPE
  SCCState = RECORD
    s          : State;
    next_class : INTEGER;
    tos        : INTEGER;
    stack      : SourceList;
    n_sched    : INTEGER;
    schedule   : SourceList;
  END;

CONST
  Ignore_class = 0;
  Phase0_class = 1;

PROCEDURE SortUnits (s: State): SourceList =
  VAR
    n_units: INTEGER;  u: M3Unit.T;
    units: SourceList;
    scc: SCCState;
  BEGIN
    (* first, count the local source units *)
    u := s.units.head;  n_units := 0;
    WHILE (u # NIL) DO
      IF NOT u.imported THEN INC (n_units); END;
      u := u.next;
    END;

    (* allocate space for the result and initialize it *)
    units := NEW (SourceList, n_units);
    scc.s          := s;
    scc.next_class := Phase0_class + 1;
    scc.tos        := 0;
    scc.stack      := NEW (SourceList, n_units + n_units);
    scc.n_sched    := 0;
    scc.schedule   := NEW (SourceList, n_units);

    u := s.units.head;  n_units := 0;
    WHILE (u # NIL) DO
      IF u.imported THEN
        u.class := Ignore_class;
      ELSIF OrderMatters [u.kind] THEN
        scc.schedule [scc.n_sched] := u;  INC (scc.n_sched);
        u.class := Ignore_class;
      ELSE
        units [n_units] := u;  INC (n_units);
        u.class    := Phase0_class;
        u.low_link := -1;
      END;
      u := u.next;
    END;

    (* find strongly-connected components in a bottom-up order
       and schedule them. *)
    FOR i := 0 TO n_units-1 DO VisitSCC (scc, Phase0_class, units[i]);  END;

    RETURN scc.schedule;
  END SortUnits;

PROCEDURE VisitSCC (VAR scc: SCCState;  cur_class: INTEGER;  u: M3Unit.T) =
  (* This procedure is adapted from the algorithm, SEARHC, given in
     "The Design and Analysis of Computer Algorithms" by Aho, Hopcroft,
     and Ullman for finding strongly connected components. *)
  VAR my_link := scc.tos;
  BEGIN
    IF (u.class # cur_class) THEN RETURN; END;

    (* push "u" on the stack *)
    u.low_link := my_link;
    scc.stack[scc.tos] := u;  INC (scc.tos);

    (* visit its imports *)
    IF u.link_info # NIL THEN
      VisitImports (scc, cur_class, u, u.link_info.imported_units,  UK.I3);
      VisitImports (scc, cur_class, u, u.link_info.exported_units,  UK.I3);
      IF (cur_class = Phase0_class) THEN
        VisitImports (scc, cur_class, u, u.link_info.used_interfaces, UK.I3);
        VisitImports (scc, cur_class, u, u.link_info.used_modules,    UK.M3);
      END;
    END;

    IF (u.low_link # my_link) THEN RETURN; END;
    (* Otherwise, "u" is the root of a strongly connected component *)
    (* => "pop" the component off the stack *)

    IF (cur_class = Phase0_class) THEN
      (* given an SCC using all the edges, refine that set
         using just the strict IMPORT/EXPORT edges. *)
      VAR class := scc.next_class; BEGIN
        INC (scc.next_class);
        (* reset the current set for the recursive visit *)
        FOR i := my_link TO scc.tos-1 DO
          u := scc.stack[i];
          u.class := class;
          u.low_link := -1;
        END;
        (* form the finer partition *)
        FOR i := my_link TO scc.tos-1 DO
          VisitSCC (scc, class, scc.stack[i]);
        END;
      END;
    ELSE
      (* SCCs found during the nested traversal can be scheduled *)
      FOR i := my_link TO scc.tos-1 DO
        scc.schedule[scc.n_sched] := scc.stack[i];
        INC (scc.n_sched);
      END;
    END;

    (* finally, pop the stack *)
    scc.tos := my_link;
  END VisitSCC;

PROCEDURE VisitImports (VAR scc: SCCState;  class: INTEGER;  u: M3Unit.T;
                        READONLY z: Mx.InfoList;  kind: UK) =
  VAR unit: M3Unit.T;
  BEGIN
    FOR i := z.start TO z.start + z.cnt - 1 DO
      unit := M3Unit.Get (scc.s.units, u.link_info.info[i], kind);
      IF (unit # NIL) THEN VisitProbe (scc, class, u, unit);  END;
    END;
  END VisitImports;

PROCEDURE VisitProbe (VAR scc: SCCState;  class: INTEGER;
                     source, dest: M3Unit.T) =
  BEGIN
    IF (dest.class # class) THEN
      (* ignore it *)
    ELSIF (dest.low_link < 0) THEN
      VisitSCC (scc, class, dest);
      source.low_link := MIN (source.low_link, dest.low_link);
    ELSE (* "dest" is already on the stack... *)
      source.low_link := MIN (source.low_link, dest.low_link);
    END;
  END VisitProbe;
------------------------------------------------------------ compilation --

PROCEDURE CompileEverything (s: State;  schedule: SourceList) =
  VAR u: M3Unit.T;
  BEGIN
    s.link_base := Mx.NewSet ();
    u := M3Unit.Get (s.units, M3ID.Add (Mx.BuiltinUnitName), UK.Unknown);
    IF (u # NIL) THEN CompileOne (s, u); END;

    (* compile all the sources using the initial schedule *)
    FOR i := 0 TO LAST (schedule^) DO
      CompileOne (s, schedule[i]);
    END;
    FlushPending (s);

    (* recompile any interfaces where we goofed on the exports *)
    u := s.units.head;
    WHILE (u # NIL) DO
      IF (NOT u.imported) AND (u.kind = UK.I3) AND UsedBogusExportList (u) THEN
        RecompileI3 (s, u);
      END;
      u := u.next;
    END;

    IF NOT s.compile_once THEN
      (* recompile those that could use the new opaque object information *)
      u := s.units.head;
      WHILE (u # NIL) DO
        IF (NOT u.imported) AND CouldBeImproved (s, u) THEN
          RecompileM3 (s, u);
        END;
        u := u.next;
      END;
    END;

    FlushPending (s);
  END CompileEverything;

PROCEDURE CompileOne (s: State;  u: M3Unit.T) =
  BEGIN
    IF (u.compiling) THEN RETURN; END;
    u.compiling := TRUE;
    VerboseF ("checking ", u);

    IF (u.kind = UK.LIBX) OR (u.kind = UK.PGMX) THEN
      FlushPending (s);
      CompileM3X (s, u);
    ELSIF (NOT u.imported) THEN
      FlushPending (s);
      u.object := ObjectName (s, u);
      CASE u.kind OF
      | UK.I3, UK.M3       => CompileM3 (s, u);
      | UK.IC, UK.MC, UK.C => CompileC (s, u);
      | UK.IS, UK.MS, UK.S => CompileS (s, u);
      | UK.IO, UK.MO, UK.O => CompileO (s, u);
      | UK.H               => CompileH (s, u);
      | UK.IG, UK.MG       => (*skip*)
      | UK.M3LIB, UK.LIB   => (*skip*)
      | UK.PGMX, UK.LIBX   => (*skip*)
      | UK.TMPL            => (*skip*)
      ELSE Msg.Verbose ("unrecognized unit type: ", FName (u), Wr.EOL);
      END;
    ELSIF (u.link_info # NIL) THEN
      IF (u.library = NIL) THEN
        BadFile ("non-library unit without source", u);
      END;
      IF (u.link_info.interface) THEN
        Merge (s, u);
      ELSE (* defer this guy as long as possible *)
        s.pending_impls := NEW (M3Unit.TList, head := u, tail := s.pending_impls);
      END;
    ELSE
      BadFile ("missing source file", u);
    END;

    IF u.imported THEN
      (* might as well inhale the exporting units now... *)
      VAR ex := u.exporters; BEGIN
        WHILE (ex # NIL) DO
          CompileOne (s, ex.unit);
          ex := ex.next;
        END;
      END;
    END;
  END CompileOne;

PROCEDURE FlushPending (s: State) =
  VAR u: M3Unit.T;
  BEGIN
    WHILE (s.pending_impls # NIL) DO
      u := s.pending_impls.head;
      s.pending_impls := s.pending_impls.tail;
      Merge (s, u);
    END;
  END FlushPending;

PROCEDURE CompileM3X (s: State;  u: M3Unit.T) =
  VAR units: Mx.UnitList;
  BEGIN
    IF (u.link_info = NIL) THEN
      DebugF ("reading link info from ", u);
      units := GetUnitLinkInfo (u, imported := FALSE);
      IF (units = NIL) THEN BadFile ("missing link info", u); END;
      u.link_info := units.unit;
      <*ASSERT units.next = NIL*>
    END;
    Merge (s, u);
  END CompileM3X;

PROCEDURE CompileO (s: State;  u: M3Unit.T) =
  BEGIN
    IF (u.kind # UK.O) THEN Merge (s, u) END;

    IF s.bootstrap_mode THEN
      Msg.Explain ("new object -> copying ", u.object);
      PullForBootstrap (u, text_file := FALSE);
    END;
    EVAL Utils.NoteModification (u.object);
  END CompileO;

PROCEDURE CompileS (s: State;  u: M3Unit.T) =
  BEGIN
    IF (u.kind # UK.S) THEN Merge (s, u) END;

    IF (u.object = NIL) OR Text.Equal (u.object, UnitPath (u)) THEN
      (* already done *)
      EVAL Utils.NoteModification (u.object);
    ELSIF NOT ObjectIsStale (u) THEN
      (* already done *)
    ELSIF s.bootstrap_mode THEN
      PullForBootstrap (u, text_file := TRUE);
      EVAL Utils.NoteModification (u.object);
    ELSIF (u.kind = UK.S) THEN
      RunCC (s, UnitPath (u), u.object, u.debug, u.optimize);
      Utils.NoteNewFile (u.object);
    ELSE (* UK.IS or UK.MS *)
      EVAL RunAsm (s, UnitPath (u), u.object);
      Utils.NoteNewFile (u.object);
    END;
  END CompileS;

PROCEDURE CompileC (s: State;  u: M3Unit.T) =
  VAR tmpS: TEXT;
  BEGIN
    IF (u.kind # UK.C) THEN Merge (s, u) END;

    IF (u.object = NIL) OR Text.Equal (u.object, UnitPath (u)) THEN
      (* already done *)
      EVAL Utils.NoteModification (u.object);
    ELSIF NOT ObjectIsStale (u) THEN
      (* already done *)
    ELSIF (u.kind = UK.C) THEN
      IF (s.bootstrap_mode)
        THEN PullForBootstrap (u, text_file := TRUE);
        ELSE RunCC (s, UnitPath (u), u.object, u.debug, u.optimize);
      END;
      Utils.NoteNewFile (u.object);
    ELSIF s.bootstrap_mode THEN
      CASE s.m3backend_mode OF
      | 0, 1 =>
          Msg.FatalError (NIL, "this compiler cannot compile .ic or .mc files");
      | 2, 3 =>
          EVAL RunM3Back (s, UnitPath (u), u.object, u.debug, u.optimize);
          Utils.NoteNewFile (u.object);
      END;
    ELSE (* UK.IC or UK.MC *)
      CASE s.m3backend_mode OF
      | 0, 1 =>
          Msg.FatalError (NIL, "this compiler cannot compile .ic or .mc files");
      | 2 =>
          EVAL RunM3Back (s, UnitPath (u), u.object, u.debug, u.optimize);
          Utils.NoteNewFile (u.object);
      | 3 =>
          tmpS := TempSName (s, u);
          IF (NOT s.keep_files) THEN Utils.NoteTempFile (tmpS) END;
          IF  RunM3Back (s, UnitPath (u), tmpS, u.debug, u.optimize)
          AND RunAsm (s, tmpS, u.object) THEN
          END;
          IF (NOT s.keep_files) THEN Utils.Remove (tmpS) END;
          Utils.NoteNewFile (u.object);
      END;
    END;
  END CompileC;

PROCEDURE CompileH (s: State;  u: M3Unit.T) =
  BEGIN
    IF NOT s.bootstrap_mode THEN
      (* already done *)
    ELSIF (u.object = NIL) OR Text.Equal (u.object, UnitPath (u)) THEN
      (* already done *)
      EVAL Utils.NoteModification (u.object);
    ELSIF NOT ObjectIsStale (u) THEN
      (* already done *)
    ELSE
      PullForBootstrap (u, text_file := TRUE);
      EVAL Utils.NoteModification (u.object);
    END;
  END CompileH;

PROCEDURE CompileM3 (s: State;  u: M3Unit.T) =
  BEGIN
    IF (u.library # NIL) THEN
      <*ASSERT u.link_info # NIL*>
      DebugF ("compile ", u, " -> from library");
      Merge (s, u);
    ELSIF (u.object = NIL) OR Text.Equal (u.object, UnitPath (u)) THEN
      (* already done *)
      EVAL Utils.NoteModification (u.object);
      MarkExportsUsed (u);
      DebugF ("compile ", u, " -> object = source");
      RETURN;
    ELSIF NOT M3isStale (s, u) THEN
      (* already done *)
      MarkExportsUsed (u);
      DebugF ("compile ", u, " -> not stale");
      RETURN;
    ELSIF PushOneM3 (s, u) THEN
      Merge (s, u);
    END;
  END CompileM3;

PROCEDURE PushOneM3 (s: State;  u: M3Unit.T): BOOLEAN =
  VAR
    tmpC, tmpS: TEXT;
    need_merge := FALSE;
    plan: [0..7] := s.m3backend_mode;
  BEGIN
    u.link_info := NIL;
    ResetExports (s, u);
    IF (s.bootstrap_mode) THEN INC (plan, 4) END;

    CASE plan OF
    | 0,    (* -bootstrap, -m3back, -asm *)
      4,    (* +bootstrap, -m3back, -asm *)
      5 =>  (* +bootstrap, -m3back, +asm *)
        IF RunM3 (s, u, u.object) THEN
          need_merge := TRUE;
        ELSE
          IF (NOT s.keep_files) THEN Utils.Remove (u.object) END;
        END;

    | 1 =>  (* -bootstrap, -m3back, +asm *)
        tmpS := TempSName (s, u);
        IF (NOT s.keep_files) THEN Utils.NoteTempFile (tmpS) END;
        IF RunM3 (s, u, tmpS) THEN
          EVAL RunAsm (s, tmpS, u.object);
          need_merge := TRUE;
        END;
        IF (NOT s.keep_files) THEN Utils.Remove (tmpS) END;

    | 2 =>  (* -bootstrap, +m3back, -asm *)
        tmpC := TempCName (s, u);
        IF (NOT s.keep_files) THEN Utils.NoteTempFile (tmpC) END;
        IF RunM3 (s, u, tmpC) THEN
          EVAL RunM3Back (s, tmpC, u.object, u.debug, u.optimize);
          need_merge := TRUE;
        END;
        IF (NOT s.keep_files) THEN Utils.Remove (tmpC) END;

    | 3 =>  (* -bootstrap, +m3back, +asm *)
        tmpC := TempCName (s, u);
        tmpS := TempSName (s, u);
        IF (NOT s.keep_files) THEN Utils.NoteTempFile (tmpC) END;
        IF (NOT s.keep_files) THEN Utils.NoteTempFile (tmpS) END;
        IF RunM3 (s, u, tmpC) THEN
          IF  RunM3Back (s, tmpC, tmpS, u.debug, u.optimize)
          AND RunAsm (s, tmpS, u.object) THEN
          END;
          need_merge := TRUE;
        END;
        IF (NOT s.keep_files) THEN Utils.Remove (tmpC) END;
        IF (NOT s.keep_files) THEN Utils.Remove (tmpS) END;

    | 6,    (* +bootstrap, +m3back, -asm *)
      7 =>  (* +bootstrap, +m3back, +asm *)
        tmpC := TempCName (s, u);
        IF (NOT s.keep_files) THEN Utils.NoteTempFile (tmpC) END;
        IF RunM3 (s, u, tmpC) THEN
          EVAL RunM3Back (s, tmpC, u.object, u.debug, u.optimize);
          need_merge := TRUE;
        END;
        IF (NOT s.keep_files) THEN Utils.Remove (tmpC) END;
    END; (* CASE plan *)
    Utils.NoteNewFile (u.object);

    RETURN need_merge;
  END PushOneM3;

PROCEDURE RecompileI3 (s: State;  u: M3Unit.T) =
  BEGIN
    ExplainF ("new exporters -> recompiling ", u);
    IF PushOneM3 (s, u) THEN Remerge (s, u) END;
  END RecompileI3;

PROCEDURE RecompileM3 (s: State;  u: M3Unit.T) =
  BEGIN
    IF PushOneM3 (s, u) THEN Remerge (s, u) END;
  END RecompileM3;

PROCEDURE CouldBeImproved (s: State;  u: M3Unit.T): BOOLEAN =
  VAR ref: REFANY;
  BEGIN
    IF (u.library # NIL) OR (u.link_info = NIL) THEN
      (* can't improve the code we didn't compile... *)
      RETURN FALSE;
    ELSIF (u.kind # UK.M3) THEN
      (* can only improve executable Modula-3... *)
      RETURN FALSE;
    ELSIF (u.object = NIL) OR Text.Equal (u.object, UnitPath (u)) THEN
      (* can't improve the code we didn't compile... *)
      RETURN FALSE;
    ELSE
      (* check for a wish that could be fulfilled. *)
      WITH z = u.link_info.wishes DO
        FOR i := z.start TO z.start + z.cnt - 1 DO
          IF s.magic.get (u.link_info.info[i], ref) THEN
            ExplainF ("new opaque info -> recompiling ", u);
            RETURN TRUE;
          END;
        END;
      END;
      RETURN FALSE;
    END;
  END CouldBeImproved;

PROCEDURE ObjectIsStale (u: M3Unit.T): BOOLEAN =
  VAR objTime: INTEGER;
  BEGIN
    ETimer.Push (M3Timers.staleobj);

    (* check if the source is newer than the object *)
    objTime := Utils.LocalModTime (u.object);

    (*********************************************************
      ---- too many people thought that "missing object" was
           an error, so we just won't distinguish a missing
           object from an old one.  I guess "new source" is
           a cheery, more positive message...  -----
    *********************************************************)

    IF (objTime = Utils.NO_TIME)
      OR (objTime < Utils.ModificationTime (UnitPath (u))) THEN
      IF (u.kind = UK.I3) OR (u.kind = UK.M3)
        THEN u.stale_src := TRUE; (* defer the message for a moment *)
        ELSE ExplainF ("new source -> compiling ", u);
      END;
      ETimer.Pop ();
      RETURN TRUE;
    END;

    (* object exists and is newer than the source... *)
    ETimer.Pop ();
    RETURN FALSE;
  END ObjectIsStale;

PROCEDURE M3isStale (s: State;  u: M3Unit.T): BOOLEAN =
  BEGIN
    IF ObjectIsStale (u) THEN RETURN TRUE END;

    ETimer.Push (M3Timers.stalem3);

    IF (u.link_info = NIL) THEN
      u.missing_info := TRUE; (* defer the message for a moment *)
      ETimer.Pop ();
      RETURN TRUE;
    END;

    (* check my imports first *)
    CheckImports (s, u.link_info);

    (* check for new generics *)
    IF NewGenerics (s, u) THEN
      ExplainF ("new generic source -> compiling ", u);
      ETimer.Pop ();
      RETURN TRUE;
    END;

    (* finally, add my self to the set *)
    DebugF ("merging initial link info for ", u);
    IF NOT MergeUnit (s, u.link_info, optional := TRUE) THEN
      ExplainF ("stale imports -> compiling ", u);
      ETimer.Pop ();
      RETURN TRUE;
    END;

    DebugF ("ok ", u);
    ETimer.Pop ();
    RETURN FALSE;
  END M3isStale;

PROCEDURE Merge (s: State;  u: M3Unit.T) =
  BEGIN
    ETimer.Push (M3Timers.merge);

    IF (u.link_info = NIL) THEN BadFile ("missing link info", u); END;

    CheckImports (s, u.link_info);

    DebugF ("merging final link info for ", u);
    EVAL MergeUnit (s, u.link_info, optional := FALSE);

    ETimer.Pop ();
  END Merge;

PROCEDURE Remerge (s: State;  u: M3Unit.T) =
  BEGIN
    ETimer.Push (M3Timers.merge);

    IF (u.link_info = NIL) THEN BadFile ("missing link info", u); END;

    DebugF ("adding new magic for ", u);
    AddMagic (s, u.link_info);

    ETimer.Pop ();
  END Remerge;

PROCEDURE CheckImports (s: State;  u: Mx.Unit) =
  BEGIN
    CheckImp (s, u, u.imported_units,  UK.I3);
    CheckImp (s, u, u.exported_units,  UK.I3);
    (****  not needed with the new sort order...
    CheckImp (s, u, u.used_interfaces, UK.I3);
    CheckImp (s, u, u.used_modules,    UK.M3);
    ****)
  END CheckImports;

PROCEDURE CheckImp (s: State;  u: Mx.Unit;  READONLY z: Mx.InfoList;  kind: UK) =
  VAR unit: M3Unit.T;
  BEGIN
    FOR i := z.start TO z.start + z.cnt - 1 DO
      unit := M3Unit.Get (s.units, u.info[i], kind);
      IF (unit # NIL) THEN CompileOne (s, unit) END;
    END;
  END CheckImp;

PROCEDURE NewGenerics (s: State;  u: M3Unit.T): BOOLEAN =
  VAR
    uu := u.link_info;
    obj_time: INTEGER;
    generic_time: INTEGER;
    nm: TEXT;
  BEGIN
    IF (uu.imported_generics.cnt <= 0) THEN RETURN FALSE END;
    obj_time := Utils.LocalModTime (u.object);

    WITH z = uu.imported_generics DO
      FOR i := z.start TO z.start + z.cnt - 1 DO
        nm := M3ID.ToText (uu.info[i]);
        generic_time := FindGeneric (s, nm, uu.interface);
        IF (obj_time < generic_time) THEN RETURN TRUE END;
      END;
    END;
    RETURN FALSE;
  END NewGenerics;

PROCEDURE FindGeneric (s: State;  name: TEXT;  interface: BOOLEAN): INTEGER =
  CONST Map = ARRAY BOOLEAN OF UK { UK.MG, UK.IG };
  VAR
    kind := Map [interface];
    unit := M3Unit.Get (s.units, M3ID.Add (name), kind);
  BEGIN
    IF (unit = NIL) THEN
      Msg.FatalError (NIL, "cannot find generic source: ",
                      M3Path.Join (NIL, name, kind, host := TRUE));
      RETURN Utils.NO_TIME;
    ELSE
      RETURN Utils.ModificationTime (UnitPath (unit));
    END;
  END FindGeneric;
------------------------------------------------------------ first pass ---

TYPE
  InfoList = RECORD
    cnt : INTEGER    := 0;
    info: Mx.InfoVec := NIL;
  END;

TYPE
  Env = M3Front.Environment OBJECT
    globals           : State;
    source_unit       : M3Unit.T;
    source            : TEXT;
    object            : TEXT;
    output            : Wr.T;
    cg                : M3CG.T;
    unit              : Mx.Unit;
    imports           : IntSet.T;
    exports           : IntSet.T;
    used_intfs        : IntSet.T;
    used_impls        : IntSet.T;
    wish_map          : IntSet.T;
    used_magic        : IntSet.T;
    exported_units    : InfoList; (* of M3ID.Ts *)
    imported_units    : InfoList; (* of M3ID.Ts *)
    imported_generics : InfoList; (* of M3ID.Ts *)
    used_interfaces   : InfoList; (* of M3ID.Ts *)
    used_modules      : InfoList; (* of M3ID.Ts *)
    import_def_syms   : InfoList; (* of MxVS.Ts *)
    import_use_syms   : InfoList; (* of MxVS.Ts *)
    export_def_syms   : InfoList; (* of MxVS.Ts *)
    export_use_syms   : InfoList; (* of MxVS.Ts *)
    imported_types    : InfoList; (* of TypeNames *)
    exported_types    : InfoList; (* of TypeNames *)
    wishes            : InfoList; (* of TypeNames *)
  OVERRIDES
    report_error       := Pass0_Error;
    find_source        := Pass0_Open;
    note_unit          := Pass0_NoteUnit;
    note_comment       := Pass0_Comment;
    note_interface_use := Pass0_NoteInterface;
    note_generic_use   := Pass0_NoteGeneric;
    note_version_stamp := Pass0_NoteVS;
    note_opaque        := Pass0_NoteOpaque;
    note_revelation    := Pass0_NoteRevelation;
    note_opaque_magic  := Pass0_AddMagic;
    find_opaque_magic  := Pass0_FindMagic;
    note_ast           := Pass0_NoteAST;
    find_ast           := Pass0_FindAST;
    note_type          := Pass0_NoteType;
    init_code_generator:= Pass0_InitCodeGenerator;
    note_webinfo       := Pass0_NoteWebInfo;
    get_implementations:= Pass0_GetImplementations;
  END;

PROCEDURE ResetEnv (s: State;  u: M3Unit.T;  source, object: TEXT) =
  VAR env := s.m3env;
  BEGIN
    env.globals               := s;
    env.source_unit           := u;
    env.source                := source;
    env.object                := object;
    env.output                := NIL;
    env.cg                    := NIL;
    env.unit                  := NIL;
    env.imports               := NIL;
    env.exports               := NIL;
    env.used_intfs            := NIL;
    env.used_impls            := NIL;
    env.wish_map              := NIL;
    env.used_magic            := NIL;
    env.exported_units.cnt    := 0;
    env.imported_units.cnt    := 0;
    env.imported_generics.cnt := 0;
    env.used_interfaces.cnt   := 0;
    env.used_modules.cnt      := 0;
    env.import_def_syms.cnt   := 0;
    env.import_use_syms.cnt   := 0;
    env.export_def_syms.cnt   := 0;
    env.export_use_syms.cnt   := 0;
    env.imported_types.cnt    := 0;
    env.exported_types.cnt    := 0;
    env.wishes.cnt            := 0;
  END ResetEnv;

PROCEDURE RunM3 (s: State;  u: M3Unit.T;  object: TEXT): BOOLEAN =
  VAR
    ok      : BOOLEAN;
    source  : M3Front.SourceFile;
    options : REF ARRAY OF TEXT;
    input   : File.T      := NIL;
  BEGIN
    ETimer.Push (M3Timers.pass_0);

    VAR xx := Arg.NewList ();  BEGIN
      Arg.AppendL (xx, s.m3_front_flags);
      Arg.AppendL (xx, s.m3_options);
      options := Arg.Flatten (xx, NIL);
    END;

    (* open the input file *)
    input  := Utils.OpenReader (UnitPath (u), fatal := FALSE);
    ok := (input # NIL);
    source.name := UnitPath (u);
    source.contents := input;

    IF (ok) AND ((u.stale_src) OR (u.missing_info)) THEN
      Pass0_CheckImports (s, source);
      FlushPending (s);
      (* finally, generate the deferred message *)
      IF (u.missing_info) THEN
        u.missing_info := FALSE;
        ExplainF ("missing version stamps -> compiling ", u);
      ELSE
        u.stale_src := FALSE;
        ExplainF ("new source -> compiling ", u);
      END;
    END;

    (* do the compilation *)
    IF (ok) THEN
      ResetEnv (s, u, UnitPath (u), object);
      Pass0_Trace (UnitPath (u), s.m3_front_flags, s.m3_options);
      ok := M3Front.Compile (source, s.m3env, options^);
    END;
    IF (ok) AND (s.m3env.unit # NIL) THEN
      s.new_link_info := TRUE;
      u.link_info := FinishUnitInfo (s.m3env);
    ELSE
      IF (u.link_info # NIL) THEN s.new_link_info := TRUE; END;
      u.link_info := NIL;
    END;

    (* dump the generated code *)
    IF (s.m3env.cg # NIL) THEN M3Backend.Close (s.m3env.cg); END;

    (* flush and close the files *)
    Utils.CloseReader (input, UnitPath (u));
    Utils.CloseWriter (s.m3env.output, s.m3env.object);
    ResetEnv (s, NIL, NIL, NIL);

    IF NOT ok THEN
      s.compile_failed := TRUE;
      IF (NOT s.keep_files) THEN Utils.Remove (object); END;
    END;

    ETimer.Pop ();
    RETURN ok;
  END RunM3;

PROCEDURE Pass0_InitCodeGenerator (env: Env): M3CG.T =
  BEGIN
    env.cg     := NIL;
    env.output := Utils.OpenWriter (env.object, fatal := FALSE);
    IF (env.output # NIL) THEN
      env.cg := M3Backend.Open (env.output, env.object);
    END;
    RETURN env.cg;
  END Pass0_InitCodeGenerator;

PROCEDURE Pass0_CheckImports (s: State;  VAR source: M3Front.SourceFile) =
  VAR ids: M3Front.IDList;  unit: M3Unit.T;
  BEGIN
    ResetEnv (s, NIL, source.name, NIL);
    ids := M3Front.ParseImports (source, s.m3env);
    WHILE (ids # NIL) DO
      unit := M3Unit.Get (s.units, ids.interface, UK.I3);
      IF (unit # NIL) THEN CompileOne (s, unit) END;
      ids := ids.next;
    END;
    Utils.RewindReader (source.contents, source.name);
  END Pass0_CheckImports;

PROCEDURE Pass0_Trace (source: TEXT;  config, user: Arg.List) =
  VAR x: Arg.T;
  BEGIN
    IF (Msg.level < Msg.Level.Commands) THEN RETURN END;

    Msg.Out ("m3front ", source);

    IF (Msg.level >= Msg.Level.Verbose) THEN
      x := config.head;
      WHILE (x # NIL) DO
        Msg.Out (" ", x.arg);
        x := x.next;
      END;
    END;

    x := user.head;
    WHILE (x # NIL) DO
      Msg.Out (" ", x.arg);
      x := x.next;
    END;
    Msg.Out (Wr.EOL);
  END Pass0_Trace;

PROCEDURE Pass0_Error (<*UNUSED*>env: Env;  file: TEXT;  line: INTEGER;
                       msg: TEXT) =
  BEGIN
    IF (file # NIL)
      THEN Msg.Out ("\"", file, "\", line ", Fmt.Int (line), ": ", msg,Wr.EOL);
      ELSE Msg.Out (msg, Wr.EOL);
    END;
  END Pass0_Error;

PROCEDURE Pass0_Open (env: Env;  name: M3ID.T;
                      interface, generic: BOOLEAN): M3Front.SourceFile =
  TYPE  GMap = ARRAY BOOLEAN OF UK;
  CONST KMap = ARRAY BOOLEAN OF GMap{ GMap{ UK.M3, UK.MG }, GMap{ UK.I3, UK.IG }};
  VAR
    file : M3Compiler.SourceFile;
    kind := KMap [interface][generic];
    unit := M3Unit.Get (env.globals.units, name, kind);
  BEGIN
    IF (unit # NIL) THEN
      file.name := UnitPath (unit);
      file.contents := Utils.OpenReader (file.name, fatal := TRUE);
    ELSE
      file.name := M3Path.Join (NIL, M3ID.ToText (name), kind, host := TRUE);
      file.contents := NIL;
    END;
    RETURN file;
  END Pass0_Open;

PROCEDURE Pass0_NoteUnit (env: Env;  name: M3ID.T;  interface: BOOLEAN) =
  BEGIN
    env.unit := NEW (Mx.Unit, name := name, interface := interface,
                     file := NEW (Mx.File, name := env.source));
    env.imports    := NEW (IntSet.Default).init ();
    env.exports    := NEW (IntSet.Default).init ();
    env.used_intfs := NEW (IntSet.Default).init ();
    env.used_impls := NEW (IntSet.Default).init ();
    env.wish_map   := NEW (IntSet.Default).init ();
    env.used_magic := NEW (IntSet.Default).init ();
  END Pass0_NoteUnit;

PROCEDURE Pass0_NoteInterface (env: Env;  name: M3ID.T;  imported: BOOLEAN) =
  BEGIN
    EVAL env.used_intfs.put (name, 0);
    IF imported THEN
      IF NOT env.imports.put (name, 0) THEN
        AddInfo (env.imported_units, name);
      END;
    ELSE
      IF NOT env.exports.put (name, 0) THEN
        AddInfo (env.exported_units, name);
        NoteExporter (env.globals, name, env.source_unit);
      END;
    END;
  END Pass0_NoteInterface;

PROCEDURE Pass0_NoteGeneric (env: Env;  name: M3ID.T) =
  BEGIN
    AddInfo (env.imported_generics, name);
  END Pass0_NoteGeneric;

PROCEDURE Pass0_NoteVS (env: Env;  intf, name: M3ID.T;
                        READONLY fp: Fingerprint.T;
                        imported, implemented: BOOLEAN) =
  VAR info: MxVS.Info;   vs: MxVS.T;
  BEGIN
    info.source := intf;
    info.symbol := name;
    info.stamp  := fp;
    vs := MxVS.Put (info);
    Pass0_NoteInterface (env, intf, imported);
    IF (imported) THEN
      IF (implemented)
        THEN AddInfo (env.import_def_syms, vs);
        ELSE AddInfo (env.import_use_syms, vs);
      END;
    ELSE (*exported*)
      IF (implemented)
        THEN AddInfo (env.export_def_syms, vs);
        ELSE AddInfo (env.export_use_syms, vs);
      END;
    END;
  END Pass0_NoteVS;

PROCEDURE Pass0_NoteRevelation (env: Env;  source: M3ID.T;  interface: BOOLEAN;
                          lhs, rhs: INTEGER;  full, imported: BOOLEAN) =
  VAR r := NEW (Mx.Revelation, source := source, lhs := lhs, rhs := rhs,
                partial := NOT full, export := NOT imported);
  BEGIN
    Pass0_AddUnit (env, source, interface);
    r.next := env.unit.revelations;
    env.unit.revelations := r;
  END Pass0_NoteRevelation;

PROCEDURE Pass0_Comment (<*UNUSED*> env: Env;  t: TEXT) =
  BEGIN
    Msg.Verbose (t);
  END Pass0_Comment;

PROCEDURE Pass0_NoteOpaque (env: Env;  type, super_type: INTEGER) =
  BEGIN
    env.unit.opaques := NEW (Mx.OpaqueType, type := type,
                             super_type := super_type,
                             next := env.unit.opaques);
  END Pass0_NoteOpaque;

PROCEDURE Pass0_AddUnit (env: Env;  nm: M3ID.T;  interface: BOOLEAN) =
  BEGIN
    IF (interface) THEN
      IF NOT env.used_intfs.put (nm, 0) THEN
        AddInfo (env.used_interfaces, nm);
      END;
    ELSE (*module*)
      IF NOT env.used_impls.put (nm, 0) THEN
        AddInfo (env.used_modules, nm);
      END;
    END;
  END Pass0_AddUnit;

PROCEDURE Pass0_AddMagic (env         : Env;
                          type        : INTEGER;
                          super_type  : INTEGER;
                          data_size   : INTEGER;
                          data_align  : INTEGER;
                          method_size : INTEGER) =
  VAR obj := Pass0_NoteObject (env, env.unit.name, env.unit.interface,
                               FALSE, type, super_type, data_size,
                               data_align, method_size);
  BEGIN
    EVAL env.used_magic.put (type, 0);
    EVAL env.globals.magic.put (type, obj);
  END Pass0_AddMagic;

PROCEDURE Pass0_FindMagic (env         : Env;
                           type        : INTEGER;
                VAR(*OUT*) super_type  : INTEGER;
                VAR(*OUT*) data_size   : INTEGER;
                VAR(*OUT*) data_align  : INTEGER;
                VAR(*OUT*) method_size : INTEGER): BOOLEAN =
  VAR ref: REFANY;  obj: Mx.ObjectType;
  BEGIN
    IF NOT env.globals.magic.get (type, ref) THEN
      IF NOT env.wish_map.put (type, 0) THEN
        AddInfo (env.wishes, type);
      END;
      RETURN FALSE;
    END;
    obj := ref;

    IF NOT env.used_magic.put (type, 0) THEN
      EVAL Pass0_NoteObject (env, obj.source, NOT obj.from_module, TRUE,
                             obj.type, obj.super_type, obj.data_size,
                             obj.data_align, obj.method_size);
    END;

    super_type  := obj.super_type;
    data_size   := obj.data_size;
    data_align  := obj.data_align;
    method_size := obj.method_size;
    RETURN TRUE;
  END Pass0_FindMagic;

PROCEDURE Pass0_NoteObject (env: Env;  source: M3ID.T;
                      interface, imported: BOOLEAN;
                      type, super_type: INTEGER;
                      data_size, data_align, method_size: INTEGER
                      ): Mx.ObjectType =
  VAR obj := NEW (Mx.ObjectType, source := source, type := type,
                  super_type := super_type, data_size := data_size,
                  data_align := data_align, method_size := method_size,
                  export := NOT imported, from_module := NOT interface);
  BEGIN
    IF (NOT imported) THEN
      obj.next := env.unit.exported_objects;
      env.unit.exported_objects := obj;
    ELSE
      Pass0_AddUnit (env, source, interface);
      obj.next := env.unit.imported_objects;
      env.unit.imported_objects := obj;
    END;
    RETURN obj;
  END Pass0_NoteObject;

PROCEDURE ExpandInfo (VAR x: InfoList) =
  VAR n := NUMBER (x.info^);  new := NEW (Mx.InfoVec, n + n);
  BEGIN
    SUBARRAY (new^, 0, n) := x.info^;
    x.info := new;
  END ExpandInfo;

PROCEDURE Pass0_NoteAST (env: Env;  intf: M3ID.T;  ast: REFANY) =
  BEGIN
    EVAL env.globals.ast_cache.put (intf, ast);
  END Pass0_NoteAST;

PROCEDURE Pass0_FindAST (env: Env;  intf: M3ID.T): REFANY =
  VAR ref: REFANY;
  BEGIN
    IF env.globals.ast_cache.get (intf, ref)
      THEN RETURN ref;
      ELSE RETURN NIL;
    END;
  END Pass0_FindAST;

PROCEDURE Pass0_NoteType (env: Env;  type: INTEGER;  imported: BOOLEAN) =
  BEGIN
    IF (imported)
      THEN AddInfo (env.imported_types, type);
      ELSE AddInfo (env.exported_types, type);
    END;
  END Pass0_NoteType;

PROCEDURE AddInfo (VAR x: InfoList;  i: INTEGER) =
  BEGIN
    IF (x.info = NIL) THEN
      x.info := NEW (Mx.InfoVec, 40);
    ELSIF (x.cnt >= NUMBER (x.info^)) THEN
      ExpandInfo (x);
    END;
    x.info [x.cnt] := i;
    INC (x.cnt);
  END AddInfo;

PROCEDURE FinishUnitInfo (env: Env): Mx.Unit =
  VAR n: INTEGER;  info: Mx.InfoVec;   u := env.unit;
  BEGIN
    n := env.exported_units.cnt + env.imported_units.cnt
       + env.imported_generics.cnt + env.used_interfaces.cnt
       + env.used_modules.cnt + env.import_def_syms.cnt
       + env.import_use_syms.cnt + env.export_def_syms.cnt
       + env.export_use_syms.cnt + env.imported_types.cnt
       + env.exported_types.cnt + env.wishes.cnt;

    info := NEW (Mx.InfoVec, n);
    n := FinishInfo (info, 0, env.exported_units,    u.exported_units);
    n := FinishInfo (info, n, env.imported_units,    u.imported_units);
    n := FinishInfo (info, n, env.imported_generics, u.imported_generics);
    n := FinishInfo (info, n, env.used_interfaces,   u.used_interfaces);
    n := FinishInfo (info, n, env.used_modules,      u.used_modules);
    n := FinishInfo (info, n, env.import_def_syms,   u.import_def_syms);
    n := FinishInfo (info, n, env.import_use_syms,   u.import_use_syms);
    n := FinishInfo (info, n, env.export_def_syms,   u.export_def_syms);
    n := FinishInfo (info, n, env.export_use_syms,   u.export_use_syms);
    n := FinishInfo (info, n, env.imported_types,    u.imported_types);
    n := FinishInfo (info, n, env.exported_types,    u.exported_types);
    n := FinishInfo (info, n, env.wishes,            u.wishes);

    u.info := info;
    RETURN u;
  END FinishUnitInfo;

PROCEDURE FinishInfo (info: Mx.InfoVec;  n: INTEGER;
                      READONLY x: InfoList;  VAR z: Mx.InfoList): INTEGER=
  BEGIN
    z.start := n;
    z.cnt := x.cnt;
    FOR i := 0 TO x.cnt - 1 DO
      info [n] := x.info[i];
      INC (n);
    END;
    RETURN n;
  END FinishInfo;

PROCEDURE Pass0_NoteWebInfo (env: Env;  info: TEXT) =
  BEGIN
    WebFile.Update (env.source, info);
  END Pass0_NoteWebInfo;

PROCEDURE Pass0_GetImplementations (env: Env;  intf: M3ID.T): M3Compiler.ImplList =
  BEGIN
    IF (env.source_unit = NIL) THEN RETURN NIL; END;
    IF (env.source_unit.kind # UK.I3) OR (env.source_unit.name # intf) THEN
      env.globals.compile_failed := TRUE;
      Msg.Error (NIL, "!!! UNEXPECTED GetImplementations(",
                 M3ID.ToText (intf), ")  unit = ",
                 M3Unit.FileName (env.source_unit));
      RETURN NIL;
    END;
    RETURN GetExporters (env.source_unit);
  END Pass0_GetImplementations;
------------------------------------------------ compilations and links ---

PROCEDURE RunCC (s: State;  source, object: TEXT;  debug, optimize: BOOLEAN) =
  BEGIN
    ETimer.Push (M3Timers.pass_1);
    StartCall (s, s.c_compiler);
    PushText  (s, source);
    PushText  (s, object);
    PushArray (s, s.include_path);
    PushBool  (s, optimize);
    PushBool  (s, debug);
    IF CallProc (s, s.c_compiler) THEN
      s.compile_failed := TRUE;
      Utils.Remove (object);
    END;
    ETimer.Pop ();
  END RunCC;

PROCEDURE RunM3Back (s: State;  source, object: TEXT;
                     debug, optimize: BOOLEAN): BOOLEAN =
  VAR failed: BOOLEAN;
  BEGIN
    ETimer.Push (M3Timers.pass_6);
    StartCall (s, s.m3backend);
    PushText (s, source);
    PushText (s, object);
    PushBool (s, optimize);
    PushBool (s, debug);
    failed := CallProc (s, s.m3backend);
    IF failed THEN
      s.compile_failed := TRUE;
      Utils.Remove (object);
    END;
    ETimer.Pop ();
    RETURN NOT failed;
  END RunM3Back;

PROCEDURE RunAsm (s: State;  source, object: TEXT): BOOLEAN =
  VAR failed: BOOLEAN;
  BEGIN
    ETimer.Push (M3Timers.pass_7);
    StartCall (s, s.assembler);
    PushText (s, source);
    PushText (s, object);
    failed := CallProc (s, s.assembler);
    IF failed THEN
      s.compile_failed := TRUE;
      Utils.Remove (object);
    END;
    ETimer.Pop ();
    RETURN NOT failed;
  END RunAsm;
---------------------------------------------------- _m3main generation ---

CONST
  M3Main = "_m3main";

PROCEDURE GenerateCMain (s: State;  Main_O: TEXT) =
  VAR
    Main_C   := M3Path.Join (NIL, M3Main, UK.C, host := FALSE);
    Main_XX  := M3Main & ".new";
    init_code: TEXT := NIL;
    time_O   : INTEGER;
    time_C   : INTEGER;
    wr       : Wr.T;
  BEGIN
    (* check for an up-to-date Main_O *)
    time_O := Utils.LocalModTime (Main_O);
    time_C := Utils.LocalModTime (Main_C);
    IF (time_O < time_C) OR (time_C = Utils.NO_TIME) THEN
      (* we must compile the linker generated code *)
      init_code := Main_C;
    ELSE
      init_code := Main_XX;
      Utils.NoteTempFile (Main_XX);
    END;

    (* produce the module init list *)
    ETimer.Push (M3Timers.genMain);
    Msg.Commands ("generate ", init_code);
    wr := Utils.OpenWriter (init_code, fatal := TRUE);
    MxGen.GenerateMain (s.link_base, wr, NIL, Msg.level >= Msg.Level.Debug,
                        s.gui AND (s.target_os = M3Path.OSKind.Win32));
    Utils.CloseWriter (wr, init_code);
    ETimer.Pop ();

    IF (init_code = Main_XX) AND Utils.IsEqual (Main_XX, Main_C) THEN
      (* we don't need to compile! *)
      Utils.Remove (Main_XX);
    ELSE
      IF (init_code = Main_XX) THEN
        Utils.Copy (Main_XX, Main_C);
        Utils.Remove (Main_XX);
      END;
      Msg.Debug ("compiling ", Main_C, " ...", Wr.EOL);
      RunCC (s, Main_C, Main_O, debug := TRUE, optimize := FALSE);
      IF (s.compile_failed) THEN
        Msg.FatalError (NIL, "cc ", Main_C, " failed!!");
      END;
      Utils.NoteNewFile (Main_O);
      Utils.NoteNewFile (Main_C);
    END;
  END GenerateCMain;

PROCEDURE GenerateCGMain (s: State;  Main_O: TEXT) =
  VAR
    Main_MC  := M3Path.Join (NIL, M3Main, UK.MC, host := FALSE);
    Main_MS  := M3Path.Join (NIL, M3Main, UK.MS, host := FALSE);
    Main_XX  := M3Main & ".new";
    init_code: TEXT := NIL;
    time_O   : INTEGER;
    time_MC  : INTEGER;
    plan     : [0..3] := 0;
  BEGIN
    CASE s.m3backend_mode OF
    | 0 =>  (* -m3back, -asm => cg produces object code *)
        GenCGMain (s, Main_O);
        Utils.NoteNewFile (Main_O);

    | 1 =>  (* -m3back, +asm => cg produces assembly code *)
        (* don't mess with a file comparison, just build the stupid thing... *)
        GenCGMain (s, Main_MS);
        ETimer.Pop ();

        Msg.Debug ("assembling ", Main_MC, " ...", Wr.EOL);
        EVAL RunAsm (s, Main_MS, Main_O);
        IF (NOT s.keep_files) THEN Utils.Remove (Main_MS); END;
        Utils.NoteNewFile (Main_O);

    | 2,    (* +m3back, -asm => cg produces il, m3back produces object *)
      3 =>  (* +m3back, +asm => cg produces il, m3back produces assembly *)
        (* check for an up-to-date Main_O *)
        time_O  := Utils.LocalModTime (Main_O);
        time_MC := Utils.LocalModTime (Main_MC);
        IF (time_O < time_MC) OR (time_MC = Utils.NO_TIME) THEN
          (* we must compile the linker generated code *)
          init_code := Main_MC;
        ELSE
          init_code := Main_XX;
          Utils.NoteTempFile (Main_XX);
        END;

        (* generate the intermediate code *)
        GenCGMain (s, init_code);

        IF (init_code = Main_XX) AND Utils.IsEqual (Main_XX, Main_MC) THEN
          (* we don't need to compile! *)
          Utils.Remove (Main_XX);
        ELSE
          IF (init_code = Main_XX) THEN
            Utils.Copy (Main_XX, Main_MC);
            Utils.Remove (Main_XX);
          END;
          Msg.Debug ("compiling ", Main_MC, " ...", Wr.EOL);
          IF (plan = 2) THEN
            EVAL RunM3Back (s, Main_MC, Main_O, debug := TRUE, optimize := FALSE);
          ELSE
            IF  RunM3Back (s, Main_MC, Main_MS, debug := TRUE, optimize := FALSE)
            AND RunAsm (s, Main_MS, Main_O) THEN
            END;
            IF (NOT s.keep_files) THEN Utils.Remove (Main_MS); END;
          END;
          Utils.NoteNewFile (Main_O);
          Utils.NoteNewFile (Main_MC);
        END;

    END; (* CASE plan *)
  END GenerateCGMain;

PROCEDURE GenCGMain (s: State;  object: TEXT) =
  VAR
    wr : Wr.T := NIL;
    cg : M3CG.T := NIL;
  BEGIN
    ETimer.Push (M3Timers.genMain);
    Msg.Commands ("generate ", object);
    wr := Utils.OpenWriter (object, fatal := TRUE);
    cg := M3Backend.Open (wr, object);
    IF (cg # NIL) THEN
      MxGen.GenerateMain (s.link_base, NIL, cg, Msg.level >= Msg.Level.Debug,
                          s.gui AND (s.target_os = M3Path.OSKind.Win32));
      M3Backend.Close(cg);
    ELSE
      IF (NOT s.keep_files) THEN Utils.Remove (object); END;
      Msg.FatalError (NIL, "couldn't generate ", object);
    END;
    Utils.CloseWriter (wr, object);
    ETimer.Pop ();
  END GenCGMain;
------------------------------------------------ compilations and links ---

PROCEDURE BuildCProgram (s: State;  shared: BOOLEAN) =
  VAR
    name        := M3Path.Parse (s.result_name, host := FALSE);
    pgm_file    := M3Path.ProgramName (name.base, host := FALSE);
    pgmTime     : INTEGER;
    pgmValid    : BOOLEAN;
    pgm_objects : Arg.List;
    import_libs : Arg.List;
  BEGIN
    IF (s.bootstrap_mode) THEN RETURN; END;

    IF (s.compile_failed) THEN
      DontLink (s, name.base, shared);
      Msg.Explain ("compilation failed => not building program \"",pgm_file,"\"");
      RETURN;
    END;

    pgmTime := Utils.LocalModTime (pgm_file);
    pgmValid := (pgmTime # Utils.NO_TIME);
    IF NOT pgmValid AND NOT s.skip_link THEN
      Msg.Explain (" -> linking ", pgm_file);
    END;

    IF s.skip_link
      THEN pgm_objects := GetObjects (s, pgmTime, pgmValid, NIL, NIL);
      ELSE pgm_objects := GetObjects (s, pgmTime, pgmValid, "linking ", pgm_file);
    END;

    IF (s.do_coverage) THEN
      Arg.Append (pgm_objects, s.link_coverage);
    END;

    IF s.skip_link
      THEN import_libs := GetLibraries (s, pgmTime, pgmValid, NIL, NIL, FALSE);
      ELSE import_libs := GetLibraries (s, pgmTime, pgmValid, "linking ", pgm_file,
                                        NOT shared AND s.broken_linker);
    END;

    IF pgmValid OR s.skip_link THEN
      DontLink (s, name.base, shared);
      RETURN;
    END;

    ETimer.Push (M3Timers.pass_2);
      StartCall (s, s.linker);
      PushText  (s, name.base);
      PushArray (s, Arg.NewList ());
      PushArray (s, pgm_objects);
      PushArray (s, import_libs);
      PushBool  (s, shared);
      IF CallProc (s, s.linker) THEN
        s.compile_failed := TRUE;
      END;
    ETimer.Pop ();
  END BuildCProgram;

PROCEDURE BuildProgram (s: State;  shared: BOOLEAN) =
  CONST Desc_file = ".M3LINK";
  VAR
    name        := M3Path.Parse (s.result_name, host := FALSE);
    pgm_file    := M3Path.ProgramName (name.base, host := FALSE);
    pgmTime     : INTEGER;
    pgmValid    : BOOLEAN;
    pgm_objects : Arg.List;
    import_libs : Arg.List;
    Main_O      := M3Path.Join (NIL, M3Main, UK.O, host := FALSE);
  BEGIN
    <*ASSERT NOT s.bootstrap_mode *>

    IF (s.compile_failed) THEN
      DontLink (s, name.base, shared);
      Msg.Explain ("compilation failed => not building program \"",pgm_file,"\"");
      IF s.has_loader THEN Utils.Remove (Desc_file); END;
      RETURN;
    END;

    pgmTime := Utils.LocalModTime (pgm_file);
    pgmValid := (pgmTime # Utils.NO_TIME);
    IF NOT pgmValid AND NOT s.skip_link THEN
      Msg.Explain (" -> linking ", pgm_file);
    END;

    IF s.skip_link
      THEN pgm_objects := GetObjects (s, pgmTime, pgmValid, NIL, NIL);
      ELSE pgm_objects := GetObjects (s, pgmTime, pgmValid, "linking ", pgm_file);
    END;
    Arg.Prepend (pgm_objects, Main_O);

    IF (s.do_coverage) THEN
      Arg.Append (pgm_objects, s.link_coverage);
    END;

    IF s.skip_link
      THEN import_libs := GetLibraries (s, pgmTime, pgmValid, NIL, NIL, FALSE);
      ELSE import_libs := GetLibraries (s, pgmTime, pgmValid, "linking ", pgm_file,
                                        NOT shared AND s.broken_linker);
    END;

    IF pgmValid THEN
      DontLink (s, name.base, shared);
      RETURN;
    END;

    ETimer.Push (M3Timers.chkpgm);
    IF NOT MxCheck.IsProgram (s.link_base, Stdio.stdout) THEN
      IF s.has_loader THEN Utils.Remove (Desc_file); END;
      Msg.FatalError (NIL, "incomplete program");
    END;
    ETimer.Pop ();

    (* produce the module init list & program entry point *)
    IF s.m3main_in_c
      THEN GenerateCMain (s, Main_O);
      ELSE GenerateCGMain (s, Main_O);
    END;

    IF s.has_loader THEN WriteProgramDesc (s, Desc_file, Main_O); END;

    IF s.skip_link THEN
      DontLink (s, name.base, shared);
      RETURN;
    END;

    ETimer.Push (M3Timers.pass_2);
      StartCall (s, s.linker);
      PushText  (s, name.base);
      PushArray (s, Arg.NewList ());
      PushArray (s, pgm_objects);
      PushArray (s, import_libs);
      PushBool  (s, shared);
      IF CallProc (s, s.linker) THEN
        s.compile_failed := TRUE;
      END;
    ETimer.Pop ();
  END BuildProgram;

PROCEDURE DontLink (s: State;  name: TEXT;  shared: BOOLEAN) =
  BEGIN
    StartCall (s, s.skip_linker);
    PushText  (s, name);
    PushBool  (s, shared);
    EVAL CallProc (s, s.skip_linker);
  END DontLink;

PROCEDURE GetObjects (s: State;  result_time: INTEGER;
                      VAR valid: BOOLEAN;  verb, result: TEXT): Arg.List =
  VAR u := s.units.head;  objs := Arg.NewList ();
  BEGIN
    WHILE (u # NIL) DO
      IF (u.object # NIL) THEN
        IF valid AND (Utils.LocalModTime (u.object) > result_time) THEN
          IF (verb # NIL) THEN
            Msg.Explain ("new \"",u.object,"\" -> ", verb & result);
          END;
          valid := FALSE;
        END;
        Arg.Append (objs, u.object);
      END;
      u := u.next;
    END;
    RETURN objs;
  END GetObjects;

PROCEDURE GetLibraries (s: State;  result_time: INTEGER;
                         VAR valid: BOOLEAN;  verb, result: TEXT;
                         use_links: BOOLEAN): Arg.List =
  VAR
    u := s.units.head;
    libs := Arg.NewList ();
    lib_file : TEXT;
    lib_link : TEXT;
    lib_path := NEW (IntRefTbl.Default).init();
    link_dir : TEXT := NIL;
  BEGIN
    (* NOTE: we build the m3 library list in reverse order since
       they're discovered in bottom-up order and Unix linkers prefer
       them in top-down order... *)
     WHILE (u # NIL) DO
      IF (u.imported AND u.kind = UK.M3LIB) OR (u.kind = UK.LIB) THEN
        lib_file := UnitPath (u);
        IF valid AND (Utils.ModificationTime (lib_file) > result_time) THEN
          IF (verb # NIL) THEN
            Msg.Explain ("new \"",lib_file,"\" -> ", verb & result);
          END;
          valid := FALSE;
        END;
        IF use_links THEN
          IF link_dir = NIL THEN
            link_dir := result & ".libs";
            IF NOT M3File.IsDirectory (link_dir) THEN
              Dirs.MkDir (link_dir);
            END;
          END;
          IF (u.loc.path # NIL) THEN
            lib_link := M3Path.New (link_dir, M3Unit.FileName (u));
            Utils.LinkFile (lib_file, lib_link);
          END;
          Arg.Prepend (libs, "-l" & M3ID.ToText (u.name));
        ELSIF (s.keep_resolved) THEN
          Arg.Prepend (libs, lib_file);
        ELSE
          Arg.Prepend (libs, "-l" & M3ID.ToText (u.name));
          IF (u.loc.path # NIL)
            AND NOT lib_path.put (M3ID.Add (u.loc.path), NIL) THEN
            Arg.Prepend (libs, "-L" & u.loc.path);
            IF (s.Rpath_flag # NIL) AND (Text.Length (s.Rpath_flag) > 0) THEN
              (* For shared libs, augment the run-time library search path. *)
              Arg.Prepend (libs, s.Rpath_flag & u.loc.path)
            END;
          END;
        END;
      END;
      u := u.next;
    END;
    IF link_dir # NIL THEN Arg.Prepend (libs, "-L" & link_dir); END;
    Arg.AppendL (libs, s.sys_libs);
    RETURN libs;
  END GetLibraries;

PROCEDURE WriteProgramDesc (s: State;  desc_file, main_o: TEXT) =
  VAR u: M3Unit.T;  lib_file: TEXT;

  PROCEDURE Emit (wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} =
    BEGIN
      IF (s.target_os = M3Path.OSKind.Win32) THEN
        Wr.PutText (wr, "-out:");
        Wr.PutText (wr, s.result_name);
        Wr.PutText (wr, ".exe");
        Wr.PutText (wr, Target.EOL);
        IF (s.gui)
          THEN Wr.PutText (wr, "-subsystem:windows");
          ELSE Wr.PutText (wr, "-subsystem:console");
        END;
        Wr.PutText (wr, Target.EOL);
      ELSE
        Wr.PutText (wr, "-o ");
        Wr.PutText (wr, s.result_name);
        Wr.PutText (wr, Target.EOL);
      END;

      (* write the library timestamps *)
      u := s.units.head;
      WHILE (u # NIL) DO
        IF (u.imported) AND ((u.kind = UK.M3LIB) OR (u.kind = UK.LIB)) THEN
          lib_file := UnitPath (u);
          Wr.PutText (wr, lib_file);
          Wr.PutChar (wr, ' ');
          Wr.PutText (wr, Fmt.Int (Utils.ModificationTime (lib_file)));
          Wr.PutText (wr, Target.EOL);
        END;
        u := u.next;
      END;

      IF (s.do_coverage) THEN
        Wr.PutText (wr, s.link_coverage);
        Wr.PutChar (wr, ' ');
        Wr.PutText (wr, Fmt.Int (Utils.ModificationTime (s.link_coverage)));
        Wr.PutText (wr, Target.EOL);
      END;

      (* write the object timestamps *)
      u := s.units.head;
      WHILE (u # NIL) DO
        IF (u.object # NIL) THEN
          Wr.PutText (wr, u.object);
          Wr.PutChar (wr, ' ');
          Wr.PutText (wr, Fmt.Int (Utils.LocalModTime (u.object)));
          Wr.PutText (wr, Target.EOL);
        END;
        u := u.next;
      END;

      (* add the linker generated main body *)
      Wr.PutText (wr, main_o);
      Wr.PutChar (wr, ' ');
      Wr.PutText (wr, Fmt.Int (Utils.LocalModTime (main_o)));
      Wr.PutText (wr, Target.EOL);
    END Emit;

  BEGIN
    ETimer.Push (M3Timers.genLink);
    Utils.WriteFile (desc_file, Emit, append := FALSE);
    ETimer.Pop ();
  END WriteProgramDesc;

PROCEDURE BuildBootProgram (s: State) =
  VAR Main_C: TEXT;  makefile := "make." & s.result_name;

  PROCEDURE Emit (wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} =
    BEGIN
      Wr.PutText (wr, "# objects for program " & s.result_name);
      Wr.PutText (wr, Target.EOL);
      Wr.PutText (wr, Target.EOL);
      GenObjectList (s, wr, M3Path.Join (NIL, "_m3main", UK.O, host := FALSE));
      Wr.PutText (wr, Target.EOL);

      Wr.PutText (wr, "# libraries for program " & s.result_name);
      Wr.PutText (wr, Target.EOL);
      Wr.PutText (wr, Target.EOL);
      GenLibraryList (s, wr);
      Wr.PutText (wr, Target.EOL);
    END Emit;

  PROCEDURE EmitMain (wr: Wr.T) RAISES {} =
    BEGIN
      MxGen.GenerateMain (s.link_base, wr, NIL, Msg.level >=Msg.Level.Debug,
                          s.gui AND (s.target_os = M3Path.OSKind.Win32));
    END EmitMain;

  BEGIN
    <*ASSERT s.bootstrap_mode *>

    IF (s.compile_failed) THEN
      Msg.Explain ("compilation failed => not building program \"",
                   s.result_name,"\"");
      Utils.Remove (makefile);
      RETURN;
    END;

    ETimer.Push (M3Timers.chkpgm);
    IF NOT MxCheck.IsProgram (s.link_base, Stdio.stdout) THEN
      Msg.FatalError (NIL, "incomplete program");
    END;
    ETimer.Pop ();

    (* produce the module init list *)
    ETimer.Push (M3Timers.genMain);
    Main_C := M3Path.Join (NIL, "_m3main", UK.C, host := FALSE);
    Msg.Commands ("generate ", Main_C);
    Utils.WriteFile (Main_C, EmitMain, append := FALSE);
    ETimer.Pop ();

    Msg.Explain ("building makefile -> ", makefile);
    Utils.WriteFile (makefile, Emit, append := FALSE);
  END BuildBootProgram;

PROCEDURE GenLibraryList (s: State;  wr: Wr.T)
  RAISES {Wr.Failure, Thread.Alerted} =
  VAR u: M3Unit.T;  x: Arg.T;
  BEGIN
    Wr.PutText (wr, s.result_name & "_LIBS = \134");
    Wr.PutText (wr, Target.EOL);

    (* emit the imported libraries *)
    u := s.units.head;
    WHILE (u # NIL) DO
      IF (u.imported) AND (u.kind = UK.M3LIB OR u.kind = UK.LIB) THEN
        Wr.PutText (wr, "  ");
        IF (u.loc.path = NIL) THEN
          Wr.PutText (wr, "-l" & M3ID.ToText (u.name));
        ELSE
          Wr.PutText (wr, M3Path.Escape (
                            M3Path.Convert (
                              M3Path.Join (u.loc.path, M3ID.ToText (u.name),
                                          u.kind, host := FALSE),
                              host := FALSE)));
        END;
        IF (u.next # NIL) OR (s.sys_libs.cnt > 0) THEN
          Wr.PutText (wr, "\134");
        END;
        Wr.PutText (wr, Target.EOL);
      END;
      u := u.next;
    END;

    (* emit the system library goo *)
    x := s.sys_libs.head;
    WHILE (x # NIL) DO
      Wr.PutText (wr, "  ");
      Wr.PutText (wr, x.arg);
      IF (x.next # NIL) THEN
        Wr.PutText (wr, "\134");
      END;
      Wr.PutText (wr, Target.EOL);
      x := x.next;
    END;

    Wr.PutText (wr, Target.EOL);
    Wr.PutText (wr, Target.EOL);
  END GenLibraryList;

PROCEDURE BuildLibrary (s: State;  shared: BOOLEAN) =
  VAR
    name        := M3Path.Parse (s.result_name, host := FALSE);
    lib_file    := M3Path.LibraryName (name.base, host := FALSE);
    lib_time    : INTEGER;
    libValid    : BOOLEAN;
    lib_objects : Arg.List;
    import_libs : Arg.List;
  BEGIN
    <*ASSERT NOT s.bootstrap_mode *>

    IF (s.compile_failed) THEN
      DontBuildLibrary (s, name.base, shared);
      Msg.Explain ("compilation failed => not building library \"",
                   lib_file, "\"");
      RETURN;
    END;

    lib_time := Utils.LocalModTime (lib_file);
    libValid := (lib_time # Utils.NO_TIME);
    IF (lib_time = Utils.NO_TIME) THEN
      Msg.Explain (" -> archiving ", lib_file);
      libValid := FALSE;
    END;

    lib_objects := GetObjects   (s, lib_time, libValid, "archiving ", lib_file);
    import_libs := GetLibraries (s, lib_time, libValid, "archiving ", lib_file,
                                 FALSE);

    IF libValid THEN
      DontBuildLibrary (s, name.base, shared);
      RETURN;
    END;

    ETimer.Push (M3Timers.chkpgm);
    IF NOT MxCheck.IsLibrary (s.link_base, Stdio.stdout) THEN
      Msg.FatalError (NIL, "incomplete library");
    END;
    ETimer.Pop ();

    Msg.Debug ("building the library...", Wr.EOL);
    Utils.Remove (lib_file);

    IF (s.target_os = M3Path.OSKind.Win32) THEN
      GenLibDef (name.base);
    END;

    ETimer.Push (M3Timers.pass_3);
      StartCall (s, s.librarian);
      PushText  (s, name.base);
      PushArray (s, Arg.NewList ());
      PushArray (s, lib_objects);
      PushArray (s, import_libs);
      PushBool  (s, shared);
      IF CallProc (s, s.librarian) THEN
        s.compile_failed := TRUE;
      END;
    ETimer.Pop ();
  END BuildLibrary;

PROCEDURE DontBuildLibrary (s: State;  name: TEXT;  shared: BOOLEAN) =
  BEGIN
    StartCall (s, s.skip_lib);
    PushText  (s, name);
    PushBool  (s, shared);
    EVAL CallProc (s, s.skip_lib);
  END DontBuildLibrary;

PROCEDURE BuildBootLibrary (s: State) =
  VAR makefile := "make." & s.result_name;

  PROCEDURE Emit (wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} =
    BEGIN
      Wr.PutText (wr, "% objects for Modula-3 library " & s.result_name);
      Wr.PutText (wr, Target.EOL);
      Wr.PutText (wr, Target.EOL);
      GenObjectList (s, wr, NIL);
      Wr.PutText (wr, Target.EOL);
      Wr.PutText (wr, Target.EOL);
    END Emit;

  BEGIN
    <*ASSERT s.bootstrap_mode *>

    IF (s.compile_failed) THEN
      Msg.Explain ("compilation failed => not building library \"",
                   s.result_name,"\"");
      Utils.Remove (makefile);
      RETURN;
    END;

    ETimer.Push (M3Timers.chkpgm);
    IF NOT MxCheck.IsLibrary (s.link_base, Stdio.stdout) THEN
      Msg.FatalError (NIL, "incomplete library");
    END;
    ETimer.Pop ();

    Msg.Explain ("building makefile -> ", makefile);
    Utils.WriteFile (makefile, Emit, append := FALSE);
  END BuildBootLibrary;

PROCEDURE GenLibDef (libname: TEXT) =

  PROCEDURE Emit (wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} =
    BEGIN
      Wr.PutText (wr, "LIBRARY ");
      Wr.PutText (wr, libname);
      Wr.PutText (wr, Target.EOL);
    END Emit;

  BEGIN
    Utils.WriteFile (libname & ".def", Emit, append := FALSE);
  END GenLibDef;

PROCEDURE GenObjectList (s: State;  wr: Wr.T;  extra: TEXT)
  RAISES {Wr.Failure, Thread.Alerted} =
  CONST MaxChunk = 30;
  VAR cnt := 0;  u: M3Unit.T;  n_chunks := 0;  width := 0;  subunit := 0;

  PROCEDURE Out (nm: TEXT) RAISES {Wr.Failure, Thread.Alerted} =
    BEGIN
      IF (width > 65) THEN
        Wr.PutText (wr, " \134");
        Wr.PutText (wr, Target.EOL);
        Wr.PutText (wr, "  ");
        width := 0;
      END;
      Wr.PutText (wr, " ");
      Wr.PutText (wr, nm);
      INC (width, Text.Length (nm));
    END Out;

  BEGIN
    (* see how many we got... *)
    u := s.units.head;
    WHILE (u # NIL) DO
      IF (u.object # NIL) THEN INC (cnt); END;
      u := u.next;
    END;
    IF (extra # NIL) THEN INC (cnt); END;

    IF (cnt < MaxChunk) THEN
      (* this is the easy case, there's just one list *)
      Wr.PutText (wr, s.result_name & "_OBJECTS = \134");
      Wr.PutText (wr, Target.EOL);
      Wr.PutText (wr, "  ");
      u := s.units.head;
      WHILE (u # NIL) DO
        IF (u.object # NIL) THEN Out (u.object); END;
        u := u.next;
      END;
      IF (extra # NIL) THEN Out (extra); END;
      Wr.PutText (wr, Target.EOL);
      Wr.PutText (wr, Target.EOL);
      RETURN;
    END;

    (* too many items => we need to build sublists *)
    n_chunks := (cnt + MaxChunk - 1) DIV MaxChunk;

    u := s.units.head;
    WHILE (u # NIL) DO
      Wr.PutText (wr, Target.EOL);
      Wr.PutText (wr, s.result_name & "_OBJ_" & Fmt.Int (subunit) & " = \134");
      Wr.PutText (wr, Target.EOL);
      Wr.PutText (wr, "  ");
      width := 0; cnt := 0;
      WHILE (cnt < MaxChunk) AND (u # NIL) DO
        IF (u.object # NIL) THEN Out (u.object); INC (cnt); END;
        u := u.next;
      END;
      Wr.PutText (wr, Target.EOL);
      Wr.PutText (wr, Target.EOL);
      INC (subunit);
    END;
    IF (extra # NIL) THEN Out (extra); END;
    Wr.PutText (wr, Target.EOL);
    Wr.PutText (wr, Target.EOL);

    width := 0;
    Wr.PutText (wr, Target.EOL);
    Wr.PutText (wr, s.result_name & "_OBJECTS = \134");
    Wr.PutText (wr, Target.EOL);
    Wr.PutText (wr, "  ");
    FOR i := 0 TO n_chunks-1 DO
      Out (s.result_name & "_OBJ_" & Fmt.Int (i));
    END;
    Wr.PutText (wr, Target.EOL);
    Wr.PutText (wr, Target.EOL);
    Wr.PutText (wr, Target.EOL);
  END GenObjectList;
--------------------------------------------------------- version stamps --

PROCEDURE GetUnitLinkInfo (u: M3Unit.T;  imported: BOOLEAN): Mx.UnitList =
  VAR info: TEXT;  kind := UK.LIBX;
  BEGIN
    CASE u.kind OF
    | UK.M3LIB, UK.LIBX =>  kind := UK.LIBX;
    | UK.PGM, UK.PGMX   =>  kind := UK.PGMX;
    ELSE Msg.FatalError (NIL, "Builder.GetUnitLinkInfo:  mysterious unit type");
    END;
    info := M3Path.Join (u.loc.path, M3ID.ToText (u.name), kind, host := TRUE);
    RETURN GetLinkUnits (info, UnitPath (u), imported);
  END GetUnitLinkInfo;

PROCEDURE GetLinkUnits (info, file: TEXT;  imported: BOOLEAN): Mx.UnitList =
  VAR
    rd: File.T;
    wr: Wr.T;
    units: Mx.UnitList;
    start, stop: INTEGER;
  BEGIN
    IF (Msg.level >= Msg.Level.Verbose) THEN start := ROUND (Time.Now ()) END;

    (* try to open file's link info file *)
    TRY
      rd := FS.OpenFileReadonly (info);
    EXCEPT OSError.E (args) =>
      Msg.Debug ("unable to open link info file: ",
                 info, Msg.OSErr (args), Wr.EOL);
      RETURN NIL;
    END;

    IF (Msg.level < Msg.Level.Verbose)
      THEN  wr := NIL;
      ELSE  wr := Stdio.stdout;
    END;

    (* try to read the file *)
    TRY
      units := MxIn.ReadUnits (rd, file, imported, wr);
    FINALLY
      Utils.CloseReader (rd, info);
    END;
    IF (units = NIL) THEN
      IF (imported)
        THEN Msg.FatalError (NIL, "bad link info file: ", info);
        ELSE Msg.Debug ("bad link info file: ", info, Wr.EOL);
      END;
      RETURN NIL;
    END;

    IF (Msg.level >= Msg.Level.Verbose) THEN
      stop := ROUND (Time.Now ());
      Msg.Verbose ("reading \"", info, "\": ", Fmt.Int(stop-start), " seconds");
    END;
    RETURN units;
  END GetLinkUnits;

PROCEDURE MergeUnit (s: State;  u: Mx.Unit;  optional := TRUE): BOOLEAN =
  CONST KMap = ARRAY BOOLEAN OF UK { UK.M3, UK.I3 };
  VAR
    wr := Stdio.stdout;
    bad, ux: Mx.UnitList;
    x: Mx.Unit;
    ok := TRUE;
    unit: M3Unit.T;
    kind: UK;
  BEGIN
    IF (u = NIL) THEN RETURN TRUE END;
    IF (optional) AND (Msg.level < Msg.Level.Debug) THEN wr := NIL END;

    bad := MxMerge.MergeUnit (u, s.link_base, wr);

    (* add u's magic info if it was ok *)
    ux := bad;
    LOOP
      IF (ux = NIL) THEN  AddMagic (s, u);  EXIT  END;
      IF (ux.unit = u) THEN EXIT END;
      ux := ux.next;
    END;

    IF (bad = NIL) THEN RETURN TRUE END;

    (* try to fix as many units as possible *)
    WHILE (bad # NIL) DO
      x := bad.unit;
      kind := KMap [x.interface];
      unit := M3Unit.Get (s.units, x.name, kind);
      IF (x # u) AND (unit # NIL) THEN
        CompileOne (s, unit);
      ELSE
        IF (NOT optional) THEN
          Msg.FatalError (NIL, "bad version stamps: ",
                          M3Path.Join (NIL, M3ID.ToText (x.name),
                                       kind, host := FALSE));
        END;
        ok := FALSE
      END;
      bad := bad.next;
    END;

    RETURN ok;
  END MergeUnit;

PROCEDURE AddMagic (s: State;  u: Mx.Unit) =
  VAR o := u.exported_objects;
  BEGIN
    WHILE (o # NIL) DO
      EVAL s.magic.put (o.type, o);
      o := o.next;
    END;
  END AddMagic;
----------------------------------------------------------- file names ---

PROCEDURE UnitPath (u: M3Unit.T): TEXT =
  VAR path := M3Unit.FullPath (u);
  BEGIN
    IF    M3Path.MakeRelative (path, Dirs.source,  Dirs.to_source ) THEN
    ELSIF M3Path.MakeRelative (path, Dirs.derived, ".") THEN
    ELSIF M3Path.MakeRelative (path, Dirs.package, Dirs.to_package) THEN
    END;
    RETURN path;
  END UnitPath;

PROCEDURE TempCName (s: State;  u: M3Unit.T): TEXT =
  VAR ext := u.kind;  base: TEXT;  shorten := FALSE;
  BEGIN
    CASE ext OF
    | UK.I3, UK.IC => ext := UK.IC;
    | UK.IS        => ext := UK.IS;  shorten := TRUE;
    | UK.M3, UK.MC => ext := UK.MC;
    | UK.MS        => ext := UK.MS;  shorten := TRUE;
    ELSE <* ASSERT FALSE *>
    END;
    base := M3ID.ToText (u.name);
    IF (shorten) AND (s.target_os = M3Path.OSKind.Win32) THEN
      base := ShortenName (M3ID.ToText (u.name));
    END;
    RETURN M3Path.Join (NIL, base, ext, host := FALSE);
  END TempCName;

PROCEDURE TempSName (s: State;  u: M3Unit.T): TEXT =
  VAR ext := u.kind;  base: TEXT;
  BEGIN
    CASE ext OF
    | UK.I3, UK.IC => ext := UK.IS;
    | UK.M3, UK.MC => ext := UK.MS;
    ELSE <* ASSERT FALSE *>
    END;
    base := M3ID.ToText (u.name);
    IF (s.target_os = M3Path.OSKind.Win32) THEN
      base := ShortenName (M3ID.ToText (u.name));
    END;
    RETURN M3Path.Join (NIL, base, ext, host := TRUE);
  END TempSName;

PROCEDURE ObjectName (s: State;  u: M3Unit.T): TEXT =
  VAR ext := u.kind;  base: TEXT;  shorten: BOOLEAN := FALSE;
  BEGIN
    IF NOT s.bootstrap_mode THEN
      (* produce object modules *)
      CASE ext OF
      | UK.I3, UK.IC, UK.IS =>  ext :=  UK.IO;
      | UK.M3, UK.MC, UK.MS =>  ext :=  UK.MO;
      | UK.C, UK.S          =>  ext :=  UK.O;
      | UK.IO, UK.MO, UK.O  =>  RETURN M3Unit.FileName (u);
      ELSE RETURN NIL;
      END;

    ELSIF (s.m3backend_mode = 1) OR (s.m3backend_mode = 3) THEN
      (* bootstrap with an assembler *)
      CASE ext OF
      | UK.I3, UK.IC, UK.IS =>  ext :=  UK.IS;  shorten := TRUE;
      | UK.M3, UK.MC, UK.MS =>  ext :=  UK.MS;  shorten := TRUE;
      | UK.C, UK.S, UK.H    =>  (* skip *)
      | UK.IO, UK.MO, UK.O  =>  (* skip *)
      ELSE RETURN NIL;
      END;

    ELSE
      (* bootstrap without an assembler *)
      CASE ext OF
      | UK.I3, UK.IC, UK.IS =>  ext :=  UK.IO;
      | UK.M3, UK.MC, UK.MS =>  ext :=  UK.MO;
      | UK.C, UK.S, UK.H    =>  (* skip *)
      | UK.IO, UK.MO, UK.O  =>  (* skip *)
      ELSE RETURN NIL;
      END;

    END;

    base := M3ID.ToText (u.name);
    IF (s.target_os = M3Path.OSKind.Win32) AND (shorten) THEN
      base := ShortenName (M3ID.ToText (u.name));
    END;
    RETURN M3Path.Join (NIL, base, ext, host := FALSE);
  END ObjectName;
--------------------------------------------------------------------------- HACK: Masm 5.1 on NT doesn't generate case sensitive labels if the file name is longer than 13+3 !!
TYPE
  TruncatedName = REF RECORD
    full, short : TEXT;
    next : TruncatedName;
  END;

VAR long_names: IntRefTbl.T := NIL;
PROCEDURE ShortenName (n: TEXT): TEXT =
  CONST MaxName = 8;
  VAR
    buf: ARRAY [0..MaxName-1] OF CHAR;
    short_id: M3ID.T;
    ref: REFANY;
    cnt: INTEGER;
    name_list, t: TruncatedName;
  BEGIN
    IF Text.Length (n) < MaxName THEN RETURN n; END;

    IF (long_names = NIL) THEN
      long_names := NEW (IntRefTbl.Default).init ();
    END;

    (* fetch the list of truncations *)
    Text.SetChars (buf, n);
    short_id := M3ID.FromStr (buf);
    IF long_names.get (short_id, ref)
      THEN name_list := ref;
      ELSE name_list := NIL;
    END;

    (* search for a match *)
    t := name_list;  cnt := 0;
    WHILE (t # NIL) DO
      IF Text.Equal (n, t.full) THEN RETURN t.short END;
      t := t.next;  INC (cnt);
    END;

    (* need to create a new name *)
    IF (cnt > 0) THEN
      VAR
        new := Fmt.Int (cnt);
        len := Text.Length (new);
        num : ARRAY [0..LAST(buf)] OF CHAR;
      BEGIN
        Text.SetChars (num, new);
        FOR i := 0 TO len - 1 DO
          buf[NUMBER(buf) - len + i] := num[i];
        END;
      END;
    END;
    t := NEW (TruncatedName, full := n, short := Text.FromChars (buf),
                next := name_list);
    EVAL long_names.put (short_id, t);
    Msg.Verbose ("long name: ", n, " -> ", t.short);
    RETURN t.short;
  END ShortenName;
------------------------------------------------------------------ misc ---

PROCEDURE PullForBootstrap (u: M3Unit.T;  text_file: BOOLEAN) =
  VAR path := UnitPath (u);
  BEGIN
    IF NOT Text.Equal (path, u.object) THEN
      Utils.Remove (u.object);
      IF text_file AND NOT Text.Equal (Wr.EOL, Target.EOL)
        THEN Utils.CopyText (path, u.object);
        ELSE Utils.Copy (path, u.object);
      END;
    END;
  END PullForBootstrap;
------------------------------------------------------- quake utilities ---

PROCEDURE StartCall (s: State;  READONLY p: ConfigProc) =
  BEGIN
    IF (p.binding = NIL) THEN
      Msg.FatalError (NIL, "procedure \"", p.name,
                      "\" was not defined in \"", s.config_file & "\"");
    END;
    TRY
      s.machine.start_call (p.binding.value);
    EXCEPT Quake.Error (msg) =>
      Msg.Out (msg, Wr.EOL);
      Msg.FatalError (NIL, "procedure \"", p.name,
                      "\" defined in \"" & s.config_file,
                      "\" failed.");
    END;
  END StartCall;

PROCEDURE CallProc (s: State;  READONLY p: ConfigProc): BOOLEAN =
  VAR v: QValue.T;  sav: BOOLEAN;  exit_code := 0;
  BEGIN
    TRY
      sav := s.machine.exec_echo (Msg.level >= Msg.Level.Commands);
      s.machine.call_proc (p.n_args, TRUE);
      s.machine.pop (v);
      EVAL s.machine.exec_echo (sav);
      exit_code := QVal.ToInt (s.machine, v);
    EXCEPT
    | Quake.Error (msg) =>
        Msg.Out (msg, Wr.EOL);
        Msg.FatalError (NIL, "procedure \"", p.name,
                        "\" defined in \"" & s.config_file,
                        "\" failed.");
    | Thread.Alerted =>
        Msg.FatalError (NIL, "interrupted while calling \"", p.name,
                        "\" defined in \"" & s.config_file, "\"");
    END;
    Msg.Verbose ("  ", p.name, " => ", Fmt.Int (exit_code));
    RETURN (exit_code # 0);
  END CallProc;

PROCEDURE PushBool (s: State;  bool: BOOLEAN) =
  BEGIN
    QMachine.PushBool (s.machine, bool);
  END PushBool;

PROCEDURE PushText (s: State;  txt: TEXT) =
  BEGIN
    QMachine.PushText (s.machine, txt);
  END PushText;

PROCEDURE PushArray (s: State;  args: Arg.List) =
  VAR v: QValue.T;  arr := NEW (QVSeq.T).init (args.cnt);  x := args.head;
  BEGIN
    v.kind := QValue.Kind.String;
    v.ref  := NIL;
    WHILE (x # NIL) DO
      v.int := M3ID.Add (x.arg);
      arr.addhi (v);
      x := x.next;
    END;
    v.kind := QValue.Kind.Array;
    v.int  := 0;
    v.ref  := arr;
    s.machine.push (v);
  END PushArray;
---------------------------------------------------------------- errors ---

PROCEDURE BadFile (msg: TEXT;  u: M3Unit.T) =
  BEGIN
    Msg.FatalError (NIL, msg, ": ", FName (u));
  END BadFile;

PROCEDURE DebugF (msg0: TEXT;  u: M3Unit.T;  msg1: TEXT := NIL) =
  BEGIN
    IF (Msg.level >= Msg.Level.Debug) THEN
      Msg.Debug (msg0, FName (u), msg1, Wr.EOL);
    END;
  END DebugF;

PROCEDURE ExplainF (msg: TEXT;  u: M3Unit.T) =
  BEGIN
    IF (Msg.level >= Msg.Level.Explain) THEN
      Msg.Explain (msg, M3Unit.FileName (u));
    END;
  END ExplainF;

PROCEDURE VerboseF (msg: TEXT;  u: M3Unit.T) =
  BEGIN
    IF (Msg.level >= Msg.Level.Verbose) THEN
      Msg.Verbose (msg, FName (u));
    END;
  END VerboseF;

PROCEDURE FName (u: M3Unit.T): TEXT =
  BEGIN
    IF (M3Unit.FileName (u) # NIL) AND (u.library # NIL) THEN
      RETURN M3Unit.FileName (u) & " in library " & M3Unit.FullPath (u.library);
    ELSIF (M3Unit.FileName (u) # NIL) THEN
      RETURN M3Unit.FileName (u);
    ELSIF (u.library # NIL) THEN
      RETURN M3Path.Join (u.loc.path, M3ID.ToText (u.name), u.kind, host := TRUE)
             & " in library " & M3Unit.FullPath (u.library);
    ELSIF (M3ID.ToText (u.name) # NIL) THEN
      RETURN M3Path.Join (u.loc.path, M3ID.ToText (u.name), u.kind, host := TRUE)
    ELSE
      RETURN "???";
    END;
  END FName;

BEGIN
END Builder.

interface Builder is in:


interface M3ID is in:


interface Msg is in: