M2compiler-V3/tools/m2make/M2make.mod

MODULE M2make;
(* M2make: build-order front-end for the M2 and GNU Modula-2 compilers.
   Usage: M2make [-n] [-v] [-c m2|gm2] [-I dir] [-o out]
                 [--m2bin path] [--shim path] main.mod
   Follows IMPORT/FROM imports from main.mod transitively, sorts the
   modules topologically, skips the build when the output is newer
   than every source, otherwise invokes the selected compiler.
   Exits 0 on success (or nothing to do), 1 on build failure,
   2 on usage errors.
   Portable source: compiles with gm2 -fiso and with the V3 M2
   driver.  Only FileIO (console) and M2makeOS (files/time/exec)
   are imported; all string handling is NUL-based and local, since
   the two compilers' FileIO string helpers differ. *)

IMPORT FileIO, M2makeOS;

CONST
  MaxMods = 256;
  MaxDeps = 64;
  MaxDirs = 16;
  MaxArgs = 64;
  StackCap = 264;
  NameStride = 64;
  PathStride = 256;

TYPE
  Name = ARRAY [0..63] OF CHAR;
  Path = ARRAY [0..255] OF CHAR;
  Line = ARRAY [0..2047] OF CHAR;
  Cmd = ARRAY [0..2047] OF CHAR;

VAR
  nMods: CARDINAL;
  (* Flat 1D pools: every table is a single indexed array (a style
     choice -- both compilers handle nested arrays now). *)
  namePool: ARRAY [0..16383] OF CHAR;
  srcPool: ARRAY [0..65535] OF CHAR;
  defPool: ARRAY [0..65535] OF CHAR;
  dirPool: ARRAY [0..4095] OF CHAR;
  modScanned: ARRAY [0..255] OF BOOLEAN;
  modExternal: ARRAY [0..255] OF BOOLEAN;
  modIsMain: ARRAY [0..255] OF BOOLEAN;
  nDep: ARRAY [0..255] OF CARDINAL;
  depTab: ARRAY [0..16383] OF INTEGER;
  state: ARRAY [0..255] OF CARDINAL;
  childPos: ARRAY [0..255] OF CARDINAL;
  order: ARRAY [0..255] OF CARDINAL;
  nOrder: CARDINAL;
  dryRun, verbose, useGm2, separate: BOOLEAN;
  outGiven: BOOLEAN;
  mainPath, outName, m2bin, shimPath: Path;
  m2Flags: Cmd;
  dialect: Name;
  extraC: Path;  (* extra C file linked in m2 mode (may be empty) *)
  nDirs: CARDINAL;
  progName: Name;
  wantProg: BOOLEAN;
  mainIdx: INTEGER;
  inComment: CARDINAL;
  gPendingFrom, gInImport, gSawHead, gWantName, gFromSeen: BOOLEAN;
  tmpA, tmpB: Path;
  tmpN: Name;
  tmpP, tmpQ: Path;
  tmpCmd: Cmd;
  segA: Cmd;

(* ---------------- zeroed (NUL) string utilities ---------------- *)

PROCEDURE Len(s: ARRAY OF CHAR): CARDINAL;
(* NUL scan.  Both compilers short-circuit AND/OR now, so the index
   guard protects the access; the bound is the string's HIGH + 1
   (V3 sting literals carry no NUL padding, fixed buffers do). *)
VAR i: CARDINAL;
BEGIN
  i := 0;
  WHILE (i <= HIGH(s)) AND (s[i] # CHR(0)) DO INC(i) END;
  RETURN i
END Len;

PROCEDURE Zero(VAR s: ARRAY OF CHAR);
VAR i: CARDINAL;
BEGIN
  i := 0;
  WHILE i <= HIGH(s) DO s[i] := CHR(0); INC(i) END
END Zero;

PROCEDURE Copy(src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR);
VAR i, n: CARDINAL;
BEGIN
  Zero(dst);
  n := Len(src);
  IF n > HIGH(dst) THEN n := HIGH(dst) END;
  i := 0;
  WHILE i < n DO dst[i] := src[i]; INC(i) END
END Copy;

PROCEDURE Cmp(a, b: ARRAY OF CHAR): INTEGER;
(* Length-aware comparison: also correct when one side is a string
   literal (no NUL padding under V3). *)
VAR i, na, nb: CARDINAL;
BEGIN
  na := Len(a);
  nb := Len(b);
  i := 0;
  WHILE (i < na) AND (i < nb) DO
    IF a[i] # b[i] THEN
      IF a[i] < b[i] THEN RETURN -1 ELSE RETURN 1 END
    END;
    INC(i)
  END;
  IF na < nb THEN RETURN -1 END;
  IF na > nb THEN RETURN 1 END;
  RETURN 0
END Cmp;

PROCEDURE Cat(a, b: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR);
(* dst := a + b (NUL-terminated).  Short-circuit AND keeps the index
   guard ahead of every access. *)
VAR i, k: CARDINAL;
BEGIN
  Zero(dst);
  k := 0; i := 0;
  WHILE (i <= HIGH(a)) AND (k <= HIGH(dst)) AND (a[i] # CHR(0)) DO
    dst[k] := a[i]; INC(k); INC(i)
  END;
  i := 0;
  WHILE (i <= HIGH(b)) AND (k <= HIGH(dst)) AND (b[i] # CHR(0)) DO
    dst[k] := b[i]; INC(k); INC(i)
  END
END Cat;

PROCEDURE Sub(src: ARRAY OF CHAR; start, count: CARDINAL;
              VAR dst: ARRAY OF CHAR);
VAR j: CARDINAL;
BEGIN
  Zero(dst);
  j := 0;
  WHILE (j < count) AND (start + j <= HIGH(src)) AND (j <= HIGH(dst))
    AND (src[start + j] # CHR(0)) DO
    dst[j] := src[start + j]; INC(j)
  END
END Sub;

PROCEDURE Lower(src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR);
VAR i: CARDINAL; ch: CHAR;
BEGIN
  Zero(dst);
  i := 0;
  WHILE (i <= HIGH(src)) AND (i <= HIGH(dst)) AND (src[i] # CHR(0)) DO
    ch := src[i];
    IF (ch >= "A") AND (ch <= "Z") THEN
      ch := CHR(ORD(ch) - ORD("A") + ORD("a"))
    END;
    dst[i] := ch; INC(i)
  END
END Lower;

PROCEDURE IsLetter(ch: CHAR): BOOLEAN;
BEGIN
  RETURN ((ch >= "A") AND (ch <= "Z"))
      OR ((ch >= "a") AND (ch <= "z"))
END IsLetter;

PROCEDURE IsDig(ch: CHAR): BOOLEAN;
BEGIN
  RETURN (ch >= "0") AND (ch <= "9")
END IsDig;

(* ---------------- flat-pool accessors ---------------- *)
(* Single-indexed pool traffic only (see VAR comment). *)

PROCEDURE GetName(m: CARDINAL; VAR dst: Name);
VAR k: CARDINAL;
BEGIN
  k := 0;
  WHILE k <= HIGH(dst) DO
    dst[k] := namePool[m * NameStride + k];
    INC(k)
  END
END GetName;

PROCEDURE PutName(m: CARDINAL; src: Name);
VAR k: CARDINAL;
BEGIN
  k := 0;
  WHILE k <= HIGH(src) DO
    namePool[m * NameStride + k] := src[k];
    INC(k)
  END
END PutName;

PROCEDURE GetSrc(m: CARDINAL; VAR dst: Path);
VAR k: CARDINAL;
BEGIN
  k := 0;
  WHILE k <= HIGH(dst) DO
    dst[k] := srcPool[m * PathStride + k];
    INC(k)
  END
END GetSrc;

PROCEDURE PutSrc(m: CARDINAL; src: Path);
VAR k: CARDINAL;
BEGIN
  k := 0;
  WHILE k <= HIGH(src) DO
    srcPool[m * PathStride + k] := src[k];
    INC(k)
  END
END PutSrc;

PROCEDURE GetDef(m: CARDINAL; VAR dst: Path);
VAR k: CARDINAL;
BEGIN
  k := 0;
  WHILE k <= HIGH(dst) DO
    dst[k] := defPool[m * PathStride + k];
    INC(k)
  END
END GetDef;

PROCEDURE PutDef(m: CARDINAL; src: Path);
VAR k: CARDINAL;
BEGIN
  k := 0;
  WHILE k <= HIGH(src) DO
    defPool[m * PathStride + k] := src[k];
    INC(k)
  END
END PutDef;

PROCEDURE GetDir(m: CARDINAL; VAR dst: Path);
VAR k: CARDINAL;
BEGIN
  k := 0;
  WHILE k <= HIGH(dst) DO
    dst[k] := dirPool[m * PathStride + k];
    INC(k)
  END
END GetDir;

PROCEDURE PutDir(m: CARDINAL; src: Path);
VAR k: CARDINAL;
BEGIN
  k := 0;
  WHILE k <= HIGH(src) DO
    dirPool[m * PathStride + k] := src[k];
    INC(k)
  END
END PutDir;

(* ---------------- console output ---------------- *)

PROCEDURE Out(s: ARRAY OF CHAR);
(* Character by character: V3 FileIO.WriteString emits the whole
   descriptor capacity (including NUL padding), so loop instead. *)
VAR i, n: CARDINAL;
BEGIN
  n := Len(s);
  i := 0;
  WHILE i < n DO
    FileIO.Write(FileIO.StdOut, s[i]);
    INC(i)
  END
END Out;

PROCEDURE OutLn;
BEGIN
  FileIO.WriteLn(FileIO.StdOut)
END OutLn;

PROCEDURE OutInt(i: INTEGER);
BEGIN
  FileIO.WriteInt(FileIO.StdOut, i, 0)
END OutInt;

PROCEDURE Die(s: ARRAY OF CHAR; code: INTEGER);
BEGIN
  Out(s); OutLn;
  M2makeOS.ExitNow(code)
END Die;

PROCEDURE Usage;
BEGIN
  Out("Usage: M2make [-n] [-v] [-c m2|gm2] [-I dir] [-o out]"); OutLn;
  Out("       [--m2bin path] [--shim path] [--extra path]
       [--m2flag flag] [--dialect pim|iso|gm2] [--separate] main.mod"); OutLn
END Usage;

(* ---------------- module table ---------------- *)

PROCEDURE FindMod(n: ARRAY OF CHAR): INTEGER;
VAR i: CARDINAL;
BEGIN
  i := 0;
  WHILE i < nMods DO
    GetName(i, tmpN);
    IF Cmp(tmpN, n) = 0 THEN RETURN VAL(INTEGER, i) END;
    INC(i)
  END;
  RETURN -1
END FindMod;

PROCEDURE AddMod(n: ARRAY OF CHAR): INTEGER;
BEGIN
  IF FindMod(n) >= 0 THEN RETURN FindMod(n) END;
  IF nMods >= MaxMods THEN Die("M2make: too many modules", 1) END;
  Copy(n, tmpN);
  PutName(nMods, tmpN);
  Zero(tmpP);
  PutSrc(nMods, tmpP);
  PutDef(nMods, tmpP);
  modScanned[nMods] := FALSE;
  modExternal[nMods] := FALSE;
  modIsMain[nMods] := FALSE;
  nDep[nMods] := 0;
  INC(nMods);
  RETURN VAL(INTEGER, nMods - 1)
END AddMod;

PROCEDURE AddDep(m, d: INTEGER);
VAR mc: CARDINAL; k: CARDINAL;
BEGIN
  IF (m < 0) OR (d < 0) OR (m = d) THEN RETURN END;
  mc := VAL(CARDINAL, m);
  k := 0;
  WHILE k < nDep[mc] DO
    IF depTab[mc * MaxDeps + k] = d THEN RETURN END;
    INC(k)
  END;
  IF nDep[mc] >= MaxDeps THEN Die("M2make: too many imports", 1) END;
  depTab[mc * MaxDeps + nDep[mc]] := d;
  INC(nDep[mc])
END AddDep;

PROCEDURE AddDepName(midx: INTEGER; n: ARRAY OF CHAR);
VAR d: INTEGER;
BEGIN
  d := AddMod(n);
  AddDep(midx, d)
END AddDepName;

(* ---------------- path handling ---------------- *)

PROCEDURE DirOf(p: ARRAY OF CHAR; VAR dir: ARRAY OF CHAR);
VAR i, n, k: CARDINAL;
BEGIN
  Zero(dir);
  n := Len(p);
  k := 0;
  i := 0;
  WHILE i < n DO
    IF p[i] = "/" THEN k := i + 1 END;
    INC(i)
  END;
  i := 0;
  WHILE (i < k) AND (i <= HIGH(dir)) DO
    dir[i] := p[i]; INC(i)
  END
END DirOf;

PROCEDURE TryVariant(dir, base, ext: ARRAY OF CHAR;
                     VAR out: ARRAY OF CHAR);
VAR full: Path;
BEGIN
  Zero(out);
  IF Len(dir) = 0 THEN
    Cat(base, ext, full)
  ELSE
    IF Len(dir) + 1 + Len(base) + Len(ext) > HIGH(full) THEN RETURN END;
    IF dir[Len(dir) - 1] = "/" THEN
      Cat(dir, base, tmpA);
      Cat(tmpA, ext, full)
    ELSE
      Cat(dir, "/", tmpA);
      Cat(tmpA, base, tmpB);
      Cat(tmpB, ext, full)
    END
  END;
  IF M2makeOS.FileExists(full) THEN Copy(full, out) END
END TryVariant;

PROCEDURE ResolveModule(n: ARRAY OF CHAR; VAR dp, mp: Path): BOOLEAN;
VAR di: CARDINAL; low: Name; cand: Path; found: BOOLEAN;
BEGIN
  Zero(dp);
  Zero(mp);
  Lower(n, low);
  found := FALSE;
  di := 0;
  WHILE di < nDirs DO
    GetDir(di, tmpQ);
    TryVariant(tmpQ, n, ".def", cand);
    IF (Len(dp) = 0) AND (Len(cand) > 0) THEN
      Copy(cand, dp); found := TRUE
    END;
    TryVariant(tmpQ, n, ".mod", cand);
    IF (Len(mp) = 0) AND (Len(cand) > 0) THEN
      Copy(cand, mp); found := TRUE
    END;
    TryVariant(tmpQ, low, ".def", cand);
    IF (Len(dp) = 0) AND (Len(cand) > 0) THEN
      Copy(cand, dp); found := TRUE
    END;
    TryVariant(tmpQ, low, ".mod", cand);
    IF (Len(mp) = 0) AND (Len(cand) > 0) THEN
      Copy(cand, mp); found := TRUE
    END;
    INC(di)
  END;
  RETURN found
END ResolveModule;

(* ---------------- import scanner ---------------- *)

PROCEDURE HandleTok(tok: ARRAY OF CHAR; midx: INTEGER);
BEGIN
  IF Cmp(tok, "FROM") = 0 THEN
    gPendingFrom := TRUE;
    gInImport := FALSE;
    gSawHead := FALSE;
    gWantName := FALSE;
    gFromSeen := FALSE;
    RETURN
  END;
  IF Cmp(tok, "IMPORT") = 0 THEN
    IF gPendingFrom OR gFromSeen THEN
      (* FROM M IMPORT ... : following names are items, not modules *)
      gPendingFrom := FALSE;
      gFromSeen := FALSE
    ELSE gInImport := TRUE
    END;
    gSawHead := FALSE;
    gWantName := FALSE;
    RETURN
  END;
  IF Cmp(tok, "DEFINITION") = 0 THEN
    gSawHead := TRUE;
    gPendingFrom := FALSE;
    gInImport := FALSE;
    gWantName := FALSE;
    gFromSeen := FALSE;
    RETURN
  END;
  IF Cmp(tok, "IMPLEMENTATION") = 0 THEN
    gSawHead := TRUE;
    gPendingFrom := FALSE;
    gInImport := FALSE;
    gWantName := FALSE;
    gFromSeen := FALSE;
    RETURN
  END;
  IF Cmp(tok, "MODULE") = 0 THEN
    IF gSawHead THEN gWantName := FALSE
    ELSE gWantName := TRUE
    END;
    gSawHead := FALSE;
    gPendingFrom := FALSE;
    gInImport := FALSE;
    gFromSeen := FALSE;
    RETURN
  END;
  IF gPendingFrom THEN
    AddDepName(midx, tok);
    gPendingFrom := FALSE;
    gFromSeen := TRUE;
    gSawHead := FALSE;
    RETURN
  END;
  IF gInImport THEN
    AddDepName(midx, tok);
    gSawHead := FALSE;
    gFromSeen := FALSE;
    RETURN
  END;
  IF gWantName THEN
    gWantName := FALSE;
    IF wantProg AND (midx = mainIdx) THEN
      Copy(tok, progName);
      wantProg := FALSE
    END;
    gSawHead := FALSE;
    gFromSeen := FALSE;
    RETURN
  END;
  gSawHead := FALSE;
  gFromSeen := FALSE
END HandleTok;

PROCEDURE ScanLine(line: ARRAY OF CHAR; midx: INTEGER);
VAR i, n, k: CARDINAL; ch, qc: CHAR;
    inStr: BOOLEAN; tok: Name;
BEGIN
  n := Len(line);
  i := 0;
  inStr := FALSE;
  qc := CHR(0);
  WHILE i < n DO
    ch := line[i];
    IF inStr THEN
      IF ch = qc THEN
        IF (i + 1 < n) AND (line[i + 1] = qc) THEN i := i + 2
        ELSE inStr := FALSE; INC(i)
        END
      ELSE INC(i)
      END
    ELSIF inComment > 0 THEN
      IF (ch = "(") AND (i + 1 < n) AND (line[i + 1] = "*") THEN
        INC(inComment); i := i + 2
      ELSIF (ch = "*") AND (i + 1 < n) AND (line[i + 1] = ")") THEN
        DEC(inComment); i := i + 2
      ELSE INC(i)
      END
    ELSE
      IF (ch = "(") AND (i + 1 < n) AND (line[i + 1] = "*") THEN
        INC(inComment); i := i + 2
      ELSIF (ch = "/") AND (i + 1 < n) AND (line[i + 1] = "/") THEN
        i := n
      ELSIF (ch = "'") OR (ch = '"') THEN
        inStr := TRUE; qc := ch; INC(i)
      ELSIF ch = ";" THEN
        gPendingFrom := FALSE;
        gInImport := FALSE;
        gSawHead := FALSE;
        gWantName := FALSE;
        gFromSeen := FALSE;
        INC(i)
      ELSIF IsLetter(ch) THEN
        k := i;
        WHILE (k < n) AND (IsLetter(line[k]) OR IsDig(line[k])) DO
          INC(k)
        END;
        Sub(line, i, k - i, tok);
        i := k;
        HandleTok(tok, midx)
      ELSE INC(i)
      END
    END
  END
END ScanLine;

PROCEDURE ScanFile(path: ARRAY OF CHAR; midx: INTEGER);
VAR h: M2makeOS.RdFile; line: Line; ok: BOOLEAN;
BEGIN
  h := M2makeOS.OpenRead(path);
  IF h = NIL THEN
    Cat("M2make: cannot open ", path, tmpCmd);
    Die(tmpCmd, 1)
  END;
  LOOP
    Zero(line);
    ok := M2makeOS.ReadLine(h, line, HIGH(line) + 1);
    IF NOT ok THEN EXIT END;
    ScanLine(line, midx)
  END;
  M2makeOS.CloseRead(h)
END ScanFile;

PROCEDURE ScanModule(m: CARDINAL);
VAR dp, mp: Path;
BEGIN
  IF NOT modIsMain[m] THEN
    Zero(dp);
    Zero(mp);
    GetName(m, tmpN);
    IF NOT ResolveModule(tmpN, dp, mp) THEN
      modExternal[m] := TRUE;
      modScanned[m] := TRUE;
      IF verbose THEN
        Out("M2make: external module ");
        Out(tmpN);
        OutLn
      END;
      RETURN
    END;
    Copy(dp, tmpP);
    PutDef(m, tmpP);
    Copy(mp, tmpP);
    PutSrc(m, tmpP)
  END;
  inComment := 0;
  gPendingFrom := FALSE;
  gInImport := FALSE;
  gSawHead := FALSE;
  gWantName := FALSE;
  gFromSeen := FALSE;
  GetDef(m, tmpP);
  IF Len(tmpP) > 0 THEN ScanFile(tmpP, VAL(INTEGER, m)) END;
  GetSrc(m, tmpP);
  IF Len(tmpP) > 0 THEN ScanFile(tmpP, VAL(INTEGER, m)) END;
  modScanned[m] := TRUE
END ScanModule;

PROCEDURE ResolveAll;
VAR i: CARDINAL;
BEGIN
  i := 0;
  WHILE i < nMods DO
    IF NOT modScanned[i] THEN ScanModule(i) END;
    INC(i)
  END
END ResolveAll;

(* ---------------- topological sort (iterative DFS) ---------------- *)

PROCEDURE TopoSort;
VAR stack: ARRAY [0..263] OF CARDINAL;
    top, cur: CARDINAL; d: INTEGER; dd: CARDINAL; i: CARDINAL;
BEGIN
  i := 0;
  WHILE i < nMods DO
    state[i] := 0; childPos[i] := 0; INC(i)
  END;
  nOrder := 0;
  top := 0;
  stack[0] := VAL(CARDINAL, mainIdx);
  state[VAL(CARDINAL, mainIdx)] := 1;
  LOOP
    cur := stack[top];
    IF childPos[cur] < nDep[cur] THEN
      d := depTab[cur * MaxDeps + childPos[cur]];
      INC(childPos[cur]);
      IF d < 0 THEN Die("M2make: bad dependency", 1) END;
      dd := VAL(CARDINAL, d);
      IF NOT modExternal[dd] THEN
        IF state[dd] = 0 THEN
          state[dd] := 1;
          INC(top);
          IF top > HIGH(stack) THEN Die("M2make: stack overflow", 1) END;
          stack[top] := dd
        ELSIF state[dd] = 1 THEN
          GetName(dd, tmpN);
          Out("M2make: cyclic import involving ");
          Out(tmpN);
          OutLn;
          M2makeOS.ExitNow(1)
        END
      END
    ELSE
      state[cur] := 2;
      order[nOrder] := cur;
      INC(nOrder);
      IF top = 0 THEN EXIT END;
      DEC(top)
    END
  END
END TopoSort;

(* ---------------- staleness ---------------- *)

PROCEDURE SrcNewer(src: ARRAY OF CHAR; outT: LONGINT): BOOLEAN;
VAR t: LONGINT;
BEGIN
  IF Len(src) = 0 THEN RETURN FALSE END;
  IF NOT M2makeOS.FileMTime(src, t) THEN RETURN TRUE END;
  RETURN t > outT
END SrcNewer;

PROCEDURE NeedBuild(out: ARRAY OF CHAR; VAR missing: BOOLEAN): BOOLEAN;
VAR outT: LONGINT; k: CARDINAL; m: CARDINAL;
BEGIN
  missing := FALSE;
  IF NOT M2makeOS.FileExists(out) THEN
    missing := TRUE;
    RETURN TRUE
  END;
  IF NOT M2makeOS.FileMTime(out, outT) THEN RETURN TRUE END;
  k := 0;
  WHILE k < nOrder DO
    m := order[k];
    GetDef(m, tmpP);
    IF SrcNewer(tmpP, outT) THEN RETURN TRUE END;
    GetSrc(m, tmpP);
    IF SrcNewer(tmpP, outT) THEN RETURN TRUE END;
    INC(k)
  END;
  RETURN FALSE
END NeedBuild;

(* ---------------- command construction ---------------- *)

PROCEDURE AppendTok(VAR cmd: ARRAY OF CHAR; tok: ARRAY OF CHAR);
BEGIN
  IF Len(cmd) > 0 THEN
    Cat(cmd, " ", segA);
    Copy(segA, cmd)
  END;
  Cat(cmd, tok, segA);
  Copy(segA, cmd)
END AppendTok;

PROCEDURE IFlags(VAR flags: ARRAY OF CHAR);
VAR di: CARDINAL;
BEGIN
  Zero(flags);
  di := 0;
  WHILE di < nDirs DO
    GetDir(di, tmpP);
    IF Len(tmpP) > 0 THEN
      AppendTok(flags, "-I");
      AppendTok(flags, tmpP)
    END;
    INC(di)
  END
END IFlags;

PROCEDURE AppendCh(VAR s: ARRAY OF CHAR; ch: CHAR);
VAR n: CARDINAL;
BEGIN
  n := Len(s);
  IF n <= HIGH(s) THEN
    s[n] := ch;
    IF n + 1 <= HIGH(s) THEN s[n + 1] := CHR(0) END
  END
END AppendCh;

PROCEDURE BaseObj(src: ARRAY OF CHAR; VAR obj: ARRAY OF CHAR);
(* "some/dir/Calc.mod" -> "Calc.o" (gm2 -c drops objects in the cwd). *)
VAR i, n, slash, dot, k: CARDINAL;
BEGIN
  Zero(obj);
  n := Len(src);
  slash := 0;
  i := 0;
  WHILE i < n DO
    IF src[i] = "/" THEN slash := i + 1 END;
    INC(i)
  END;
  dot := n;
  i := slash;
  WHILE i < n DO
    IF src[i] = "." THEN dot := i END;
    INC(i)
  END;
  IF dot <= slash THEN dot := n END;
  k := 0;
  i := slash;
  WHILE (i < dot) AND (k <= HIGH(obj)) DO
    obj[k] := src[i]; INC(k); INC(i)
  END;
  Cat(obj, ".o", tmpA);
  Copy(tmpA, obj)
END BaseObj;

PROCEDURE ObjStale(m: CARDINAL; obj: ARRAY OF CHAR): BOOLEAN;
VAR ot: LONGINT;
BEGIN
  IF NOT M2makeOS.FileExists(obj) THEN RETURN TRUE END;
  IF NOT M2makeOS.FileMTime(obj, ot) THEN RETURN TRUE END;
  GetDef(m, tmpP);
  IF SrcNewer(tmpP, ot) THEN RETURN TRUE END;
  GetSrc(m, tmpP);
  IF SrcNewer(tmpP, ot) THEN RETURN TRUE END;
  RETURN FALSE
END ObjStale;

PROCEDURE ObjNewerThan(obj, out: ARRAY OF CHAR;
                       outT: LONGINT): BOOLEAN;
VAR t: LONGINT;
BEGIN
  IF Len(obj) = 0 THEN RETURN FALSE END;
  IF NOT M2makeOS.FileMTime(obj, t) THEN RETURN TRUE END;
  RETURN t > outT
END ObjNewerThan;

PROCEDURE CheckLen(cmd: ARRAY OF CHAR);
BEGIN
  IF Len(cmd) + 32 > HIGH(cmd) THEN
    Die("M2make: command too long", 1)
  END
END CheckLen;

PROCEDURE AppendCmd(VAR cmd: ARRAY OF CHAR; seg: ARRAY OF CHAR);
BEGIN
  IF Len(cmd) > 0 THEN
    Cat(cmd, " && ", segA);
    Copy(segA, cmd)
  END;
  Cat(cmd, seg, segA);
  Copy(segA, cmd)
END AppendCmd;

PROCEDURE AppendSeg(VAR cmd: ARRAY OF CHAR; seg: ARRAY OF CHAR);
(* Direct concatenation (segments carry their own spacing).
   segA is the dedicated Cmd-sized scratch: always distinct from
   cmd and seg, and big enough for whole command lines. *)
BEGIN
  Cat(cmd, seg, segA);
  Copy(segA, cmd)
END AppendSeg;

PROCEDURE BuildM2(out: ARRAY OF CHAR);
VAR cmd: Cmd; k: CARDINAL; m: CARDINAL; rc: INTEGER;
BEGIN
  Zero(cmd);
  AppendSeg(cmd, "mkdir -p gen_ssa && ");
  AppendSeg(cmd, m2bin);
  IF Len(m2Flags) > 0 THEN
    AppendSeg(cmd, " ");
    AppendSeg(cmd, m2Flags)
  END;
  k := 0;
  WHILE k < nOrder DO
    m := order[k];
    GetDef(m, tmpP);
    IF Len(tmpP) > 0 THEN AppendTok(cmd, tmpP) END;
    GetSrc(m, tmpP);
    IF Len(tmpP) > 0 THEN AppendTok(cmd, tmpP) END;
    INC(k)
  END;
  AppendSeg(cmd, " 2>&1 | tee m2make.log | grep -q 'Parsed correctly'");
  AppendSeg(cmd, " && qbe -o gen_ssa/");
  AppendSeg(cmd, progName);
  AppendSeg(cmd, ".s gen_ssa/");
  AppendSeg(cmd, progName);
  AppendSeg(cmd, ".ssa");
  AppendSeg(cmd, " && cc gen_ssa/");
  AppendSeg(cmd, progName);
  AppendSeg(cmd, ".s ");
  AppendTok(cmd, shimPath);
  IF Len(extraC) > 0 THEN AppendTok(cmd, extraC) END;
  AppendSeg(cmd, " -o ");
  AppendTok(cmd, out);
  AppendSeg(cmd, " -lm");
  CheckLen(cmd);
  Out(cmd);
  OutLn;
  IF dryRun THEN RETURN END;
  rc := M2makeOS.ExecCmd(cmd);
  IF rc # 0 THEN
    Out("M2make: build failed");
    OutLn;
    M2makeOS.ExitNow(1)
  END
END BuildM2;

PROCEDURE SepObjName(m: CARDINAL; VAR obj: Path);
(* One object per module in gen_ssa/, keyed by module name. *)
BEGIN
  Zero(obj);
  GetName(m, tmpN);
  Cat("gen_ssa/", tmpN, tmpA);
  Cat(tmpA, ".o", obj)
END SepObjName;

PROCEDURE SepObjStale (m: CARDINAL; obj: ARRAY OF CHAR): BOOLEAN;
(* Separate mode is conservative: any interface change rebuilds the
   object.  This also covers transitive .def type-layout changes, at the
   cost of rebuilding more than strictly necessary. *)
VAR ot, ct: LONGINT; k: CARDINAL;
BEGIN
  IF NOT M2makeOS.FileExists(obj) THEN RETURN TRUE END;
  IF NOT M2makeOS.FileMTime(obj, ot) THEN RETURN TRUE END;
  (* A compiler rebuild is an ABI event; conservative but cheap. *)
  IF M2makeOS.FileMTime(m2bin, ct) AND (ct > ot) THEN RETURN TRUE END;
  GetDef(m, tmpP);
  IF SrcNewer(tmpP, ot) THEN RETURN TRUE END;
  GetSrc(m, tmpP);
  IF SrcNewer(tmpP, ot) THEN RETURN TRUE END;
  k := 0;
  WHILE k < nOrder DO
    GetDef(order[k], tmpP);
    IF SrcNewer(tmpP, ot) THEN RETURN TRUE END;
    INC(k)
  END;
  RETURN FALSE
END SepObjStale;

PROCEDURE BuildM2Separate(out: ARRAY OF CHAR);
(* Compile stale modules to their own QBE objects, then link.  The
   program module is last in the topological order and is the only
   object with main; every module object exports <mod>_init. *)
VAR cmd: Cmd; k, m: CARDINAL; rc: INTEGER;
    obj, src, ssafile, sfile, flags: Path;
    outT: LONGINT; compiledAny, linkNeeded: BOOLEAN;
BEGIN
  Zero(cmd);
  compiledAny := FALSE;
  k := 0;
  WHILE k < nOrder DO
    m := order[k];
    GetSrc(m, src);
    IF Len(src) > 0 THEN
      IF modIsMain[m] THEN Copy(progName, tmpN) ELSE GetName(m, tmpN) END;
      Zero(obj); Cat("gen_ssa/", tmpN, tmpA); Cat(tmpA, ".o", obj);
      IF SepObjStale(m, obj) THEN
        CpyPath(ssafile, "gen_ssa/"); Cat(ssafile, tmpN, tmpA); Cat(tmpA, ".ssa", ssafile);
        CpyPath(sfile, "gen_ssa/"); Cat(sfile, tmpN, tmpA); Cat(tmpA, ".s", sfile);
        Zero(tmpCmd);
        AppendSeg(tmpCmd, "mkdir -p gen_ssa && ");
        AppendSeg(tmpCmd, m2bin);
        AppendSeg(tmpCmd, " -c");
        IF Len(m2Flags) > 0 THEN
          AppendSeg(tmpCmd, " ");
          AppendSeg(tmpCmd, m2Flags)
        END;
        (* M2 resolves the target .def and all imported .defs from -I. *)
        IFlags(flags);
        IF Len(flags) > 0 THEN
          AppendSeg(tmpCmd, " ");
          AppendSeg(tmpCmd, flags)
        END;
        AppendTok(tmpCmd, src);
        AppendSeg(tmpCmd, " 2>&1 | tee m2make.log | grep -q 'Parsed correctly'");
        AppendSeg(tmpCmd, " && qbe -o ");
        AppendTok(tmpCmd, sfile);
        AppendSeg(tmpCmd, " ");
        AppendTok(tmpCmd, ssafile);
        AppendSeg(tmpCmd, " && cc -c ");
        AppendTok(tmpCmd, sfile);
        AppendSeg(tmpCmd, " -o ");
        AppendTok(tmpCmd, obj);
        CheckLen(tmpCmd);
        Out(tmpCmd);
        OutLn;
        IF NOT dryRun THEN
          rc := M2makeOS.ExecCmd(tmpCmd);
          IF rc # 0 THEN
            Out("M2make: separate compile failed");
            OutLn;
            M2makeOS.ExitNow(1)
          END
        END;
        compiledAny := TRUE
      END
    END;
    INC(k)
  END;
  linkNeeded := compiledAny;
  IF NOT linkNeeded THEN
    IF NOT M2makeOS.FileExists(out) THEN linkNeeded := TRUE
    ELSIF NOT M2makeOS.FileMTime(out, outT) THEN linkNeeded := TRUE
    ELSE
      k := 0;
      WHILE k < nOrder DO
        m := order[k];
        GetSrc(m, src);
        IF Len(src) > 0 THEN
          IF modIsMain[m] THEN Copy(progName, tmpN) ELSE GetName(m, tmpN) END;
          Zero(obj); Cat("gen_ssa/", tmpN, tmpA); Cat(tmpA, ".o", obj);
          IF ObjNewerThan(obj, out, outT) THEN linkNeeded := TRUE END
        END;
        INC(k)
      END;
      IF SrcNewer(shimPath, outT) THEN linkNeeded := TRUE END;
      IF Len(extraC) > 0 THEN
        IF SrcNewer(extraC, outT) THEN linkNeeded := TRUE END
      END
    END
  END;
  IF NOT linkNeeded THEN
    Out("M2make: "); Out(out); Out(" up to date"); OutLn;
    RETURN
  END;
  (* link: one object per module, target object (main) last *)
  Zero(tmpCmd);
  AppendSeg(tmpCmd, "cc ");
  k := 0;
  WHILE k < nOrder DO
    m := order[k];
    GetSrc(m, src);
    IF Len(src) > 0 THEN
      IF modIsMain[m] THEN Copy(progName, tmpN) ELSE GetName(m, tmpN) END;
      Zero(obj); Cat("gen_ssa/", tmpN, tmpA); Cat(tmpA, ".o", obj);
      AppendTok(tmpCmd, obj)
    END;
    INC(k)
  END;
  AppendTok(tmpCmd, shimPath);
  IF Len(extraC) > 0 THEN AppendTok(tmpCmd, extraC) END;
  AppendSeg(tmpCmd, " -o ");
  AppendTok(tmpCmd, out);
  AppendSeg(tmpCmd, " -lm");
  CheckLen(tmpCmd);
  Out(tmpCmd);
  OutLn;
  IF dryRun THEN RETURN END;
  rc := M2makeOS.ExecCmd(tmpCmd);
  IF rc # 0 THEN
    Out("M2make: separate build failed");
    OutLn;
    M2makeOS.ExitNow(1)
  END
END BuildM2Separate;

PROCEDURE CpyPath(VAR dst: Path; src: ARRAY OF CHAR);
BEGIN
  Copy(src, dst)
END CpyPath;

PROCEDURE BuildGm2(out: ARRAY OF CHAR);
VAR cmd, seg: Cmd; flags: Path; obj: Path;
    k, m: CARDINAL; rc: INTEGER; outT: LONGINT;
    compiledAny, linkNeeded: BOOLEAN;
BEGIN
  Zero(cmd);
  IFlags(flags);
  compiledAny := FALSE;
  k := 0;
  WHILE k < nOrder DO
    m := order[k];
    GetSrc(m, tmpP);
    IF (NOT modIsMain[m]) AND (Len(tmpP) > 0) THEN
      BaseObj(tmpP, obj);
      IF ObjStale(m, obj) THEN
        Zero(seg);
        Cat("gm2 -fiso ", flags, seg);
        IF Len(flags) > 0 THEN
          Cat(seg, " ", segA);
          Copy(segA, seg)
        END;
        Cat(seg, "-c ", segA);
        Copy(segA, seg);
        Cat(seg, tmpP, segA);
        Copy(segA, seg);
        AppendCmd(cmd, seg);
        compiledAny := TRUE
      END
    END;
    INC(k)
  END;
  linkNeeded := compiledAny;
  IF NOT linkNeeded THEN
    IF NOT M2makeOS.FileExists(out) THEN linkNeeded := TRUE
    ELSIF NOT M2makeOS.FileMTime(out, outT) THEN linkNeeded := TRUE
    ELSE
      k := 0;
      WHILE k < nOrder DO
        m := order[k];
        GetSrc(m, tmpP);
        IF (NOT modIsMain[m]) AND (Len(tmpP) > 0) THEN
          BaseObj(tmpP, obj);
          IF ObjNewerThan(obj, out, outT) THEN linkNeeded := TRUE END
        END;
        INC(k)
      END
    END
  END;
  IF linkNeeded THEN
    Zero(seg);
    Cat("gm2 -fiso ", flags, seg);
    IF Len(flags) > 0 THEN
      Cat(seg, " ", segA);
      Copy(segA, seg)
    END;
    Cat(seg, "-o ", segA);
    Copy(segA, seg);
    Cat(seg, out, segA);
    Copy(segA, seg);
    Cat(seg, " ", segA);
    Copy(segA, seg);
    GetSrc(VAL(CARDINAL, mainIdx), tmpP);
    Cat(seg, tmpP, segA);
    Copy(segA, seg);
    k := 0;
    WHILE k < nOrder DO
      m := order[k];
      GetSrc(m, tmpP);
      IF (NOT modIsMain[m]) AND (Len(tmpP) > 0) THEN
        BaseObj(tmpP, obj);
        Cat(seg, " ", segA);
        Copy(segA, seg);
        Cat(seg, obj, segA);
        Copy(segA, seg)
      END;
      INC(k)
    END;
    AppendCmd(cmd, seg)
  END;
  IF Len(cmd) = 0 THEN
    Out("M2make: ");
    Out(out);
    Out(" up to date");
    OutLn;
    RETURN
  END;
  CheckLen(cmd);
  Out(cmd);
  OutLn;
  IF dryRun THEN RETURN END;
  rc := M2makeOS.ExecCmd(cmd);
  IF rc # 0 THEN
    Out("M2make: build failed");
    OutLn;
    M2makeOS.ExitNow(1)
  END
END BuildGm2;

PROCEDURE PrintOrder;
VAR k: CARDINAL; m: CARDINAL;
BEGIN
  Out("M2make: build order");
  OutLn;
  k := 0;
  WHILE k < nOrder DO
    m := order[k];
    Out("  ");
    GetName(m, tmpN);
    Out(tmpN);
    GetDef(m, tmpP);
    IF Len(tmpP) > 0 THEN
      Out(" : ");
      Out(tmpP)
    END;
    GetSrc(m, tmpP);
    IF Len(tmpP) > 0 THEN
      GetDef(m, tmpQ);
      IF Len(tmpQ) > 0 THEN Out(" ") ELSE Out(" : ") END;
      Out(tmpP)
    END;
    OutLn;
    INC(k)
  END
END PrintOrder;

(* ---------------- argument handling ---------------- *)

PROCEDURE ParseArgs;
VAR na: CARDINAL; s: Path; ok: BOOLEAN;
BEGIN
  dryRun := FALSE;
  verbose := FALSE;
  useGm2 := FALSE;
  separate := FALSE;
  outGiven := FALSE;
  Zero(mainPath);
  Zero(outName);
  Copy("M2", m2bin);
  Copy("shim.c", shimPath);
  Zero(m2Flags);
  dialect[0] := CHR(0);
  nDirs := 0;
  na := 0;
  LOOP
    IF na >= MaxArgs THEN Die("M2make: too many arguments", 2) END;
    ok := M2makeOS.GetArg(na, s, HIGH(s) + 1);
    IF NOT ok THEN EXIT END;
    INC(na);
    IF Cmp(s, "-n") = 0 THEN dryRun := TRUE
    ELSIF Cmp(s, "-v") = 0 THEN verbose := TRUE
    ELSIF Cmp(s, "--separate") = 0 THEN separate := TRUE
    ELSIF Cmp(s, "-c") = 0 THEN
      ok := M2makeOS.GetArg(na, s, HIGH(s) + 1);
      IF NOT ok THEN
        Out("M2make: -c expects m2 or gm2"); OutLn;
        M2makeOS.ExitNow(2)
      END;
      INC(na);
      IF Cmp(s, "gm2") = 0 THEN useGm2 := TRUE
      ELSIF Cmp(s, "m2") = 0 THEN useGm2 := FALSE
      ELSE
        Out("M2make: -c expects m2 or gm2"); OutLn;
        M2makeOS.ExitNow(2)
      END
    ELSIF Cmp(s, "-I") = 0 THEN
      ok := M2makeOS.GetArg(na, s, HIGH(s) + 1);
      IF NOT ok THEN
        Out("M2make: -I expects a directory"); OutLn;
        M2makeOS.ExitNow(2)
      END;
      INC(na);
      IF nDirs >= MaxDirs THEN Die("M2make: too many -I dirs", 2) END;
      Copy(s, tmpP);
      PutDir(nDirs, tmpP);
      INC(nDirs)
    ELSIF Cmp(s, "-o") = 0 THEN
      ok := M2makeOS.GetArg(na, s, HIGH(s) + 1);
      IF NOT ok THEN
        Out("M2make: -o expects a name"); OutLn;
        M2makeOS.ExitNow(2)
      END;
      INC(na);
      Copy(s, outName);
      outGiven := TRUE
    ELSIF Cmp(s, "--m2bin") = 0 THEN
      ok := M2makeOS.GetArg(na, s, HIGH(s) + 1);
      IF NOT ok THEN
        Out("M2make: --m2bin expects a path"); OutLn;
        M2makeOS.ExitNow(2)
      END;
      INC(na);
      Copy(s, m2bin)
    ELSIF Cmp(s, "--shim") = 0 THEN
      ok := M2makeOS.GetArg(na, s, HIGH(s) + 1);
      IF NOT ok THEN
        Out("M2make: --shim expects a path"); OutLn;
        M2makeOS.ExitNow(2)
      END;
      INC(na);
      Copy(s, shimPath)
    ELSIF Cmp(s, "--dialect") = 0 THEN
      ok := M2makeOS.GetArg(na, s, HIGH(s) + 1);
      IF NOT ok THEN
        Out("M2make: --dialect expects pim, iso or gm2"); OutLn;
        M2makeOS.ExitNow(2)
      END;
      INC(na);
      IF (Cmp(s, "pim") # 0) AND (Cmp(s, "iso") # 0)
         AND (Cmp(s, "gm2") # 0) THEN
        Out("M2make: --dialect expects pim, iso or gm2"); OutLn;
        M2makeOS.ExitNow(2)
      END;
      Copy(s, dialect)
    ELSIF Cmp(s, "--m2flag") = 0 THEN
      ok := M2makeOS.GetArg(na, s, HIGH(s) + 1);
      IF NOT ok THEN
        Out("M2make: --m2flag expects an argument"); OutLn;
        M2makeOS.ExitNow(2)
      END;
      INC(na);
      Copy(s, m2Flags)
    ELSIF Cmp(s, "--extra") = 0 THEN
      ok := M2makeOS.GetArg(na, s, HIGH(s) + 1);
      IF NOT ok THEN
        Out("M2make: --extra expects a path"); OutLn;
        M2makeOS.ExitNow(2)
      END;
      INC(na);
      Copy(s, extraC)
    ELSIF (Cmp(s, "-h") = 0) OR (Cmp(s, "--help") = 0) THEN
      Usage;
      M2makeOS.ExitNow(0)
    ELSIF s[0] = "-" THEN
      Out("M2make: unknown option ");
      Out(s);
      OutLn;
      Usage;
      M2makeOS.ExitNow(2)
    ELSE
      IF Len(mainPath) > 0 THEN
        Out("M2make: only one main file"); OutLn;
        Usage;
        M2makeOS.ExitNow(2)
      END;
      Copy(s, mainPath)
    END
  END;
  IF Len(mainPath) = 0 THEN
    Usage;
    M2makeOS.ExitNow(2)
  END
END ParseArgs;

(* ---------------- main ---------------- *)

VAR
  missing: BOOLEAN;
  rebuild: BOOLEAN;

BEGIN
  nMods := 0;
  nOrder := 0;
  wantProg := TRUE;
  Zero(progName);
  ParseArgs;
  IF Len(dialect) > 0 THEN
    IF nDirs + 4 > MaxDirs THEN Die("M2make: too many -I dirs", 2) END;
    Copy("lib/", tmpP); AppendSeg(tmpP, dialect); Copy(tmpP, tmpQ);
    PutDir(nDirs, tmpQ); INC(nDirs);
    Copy("lib/common", tmpQ); PutDir(nDirs, tmpQ); INC(nDirs);
    Copy("lib/gm2", tmpQ); PutDir(nDirs, tmpQ); INC(nDirs);
    Copy("runtime/syslib", tmpQ); PutDir(nDirs, tmpQ); INC(nDirs)
  END;
  IF NOT M2makeOS.FileExists(mainPath) THEN
    Cat("M2make: main file not found ", mainPath, tmpCmd);
    Die(tmpCmd, 2)
  END;
  DirOf(mainPath, tmpA);
  IF nDirs = 0 THEN
    Copy(tmpA, tmpP);
    PutDir(0, tmpP);
    nDirs := 1
  ELSE
    (* main dir becomes an extra search dir when -I was given *)
    IF nDirs >= MaxDirs THEN Die("M2make: too many -I dirs", 2) END;
    Copy(tmpA, tmpP);
    PutDir(nDirs, tmpP);
    INC(nDirs)
  END;
  mainIdx := AddMod("M2makeMain");
  modIsMain[VAL(CARDINAL, mainIdx)] := TRUE;
  Copy(mainPath, tmpP);
  PutSrc(VAL(CARDINAL, mainIdx), tmpP);
  ResolveAll;
  IF Len(progName) = 0 THEN
    Die("M2make: no MODULE declaration in main file", 1)
  END;
  IF NOT outGiven THEN Copy(progName, outName) END;
  TopoSort;
  IF verbose OR dryRun THEN PrintOrder END;
  rebuild := NeedBuild(outName, missing);
  IF NOT rebuild THEN
    Out("M2make: ");
    Out(outName);
    Out(" up to date");
    OutLn
  ELSE
    IF useGm2 THEN BuildGm2(outName)
    ELSIF separate THEN BuildM2Separate(outName)
    ELSE BuildM2(outName)
    END
  END
END M2make.