M2compiler-V1/MGen.mod

IMPLEMENTATION MODULE MGen;

IMPORT FileIO, SymTab;

CONST
  MaxCode = 8191;
  MaxImg  = 16383;
  MaxGlb  = 255;
  MaxInit = 255;
  MaxLab  = 255;
  MaxFix  = 2047;
  MaxLoop = 15;

  (* opcodes, see mc64-spec.md §11 *)
  OPdup = 20H;  OPswap = 21H;
  OPloadGlb = 2DH;  OPstoreGlb = 3DH;
  OPext = 40H;  SUBdrop = 00H;
  OPenter = 0D4H;  OPfctLeave = 85H;  OPprocCall = 0EDH;
  OPimmB = 8DH;  OPimmW = 8EH;  OPimm0 = 90H;
  OPadd = 0A6H;  OPsub = 0A7H;  OPumul = 0A8H;
  OPudiv = 0A9H;  OPumod = 0AAH;
  OPaeq0 = 0ABH;  OPinc = 0ACH;  OPdec = 0ADH;
  OPeq = 0A0H;  OPne = 0A1H;
  OPult = 0A2H;  OPugt = 0A3H;  OPule = 0A4H;  OPuge = 0A5H;
  OPilt = 0B2H;  OPigt = 0B3H;  OPile = 0B4H;  OPige = 0B5H;
  OPnot = 0B6H;
  OPimul = 0B8H;  OPidiv = 0B9H;
  OPintToLong = 0BDH;  OPlongToReal = 0BEH;
  OPrCmp = 0D5H;  OPrAdd = 0D6H;  OPrSub = 0D7H;
  OPrMul = 0D8H;  OPrDiv = 0D9H;
  OPor = 0E6H;  OPand = 0E8H;
  OPpower2 = 0EAH;  OPbitIn = 0E7H;
  OPjp = 0E0H;  OPjz = 0E1H;
  OPsys = 0C3H;  OPend = 50H;

  (* image layout *)
  HeadSize = 64;
  DName = 264;  DChecksum = 288;  DFlags = 292;
  DVarCount = 293;  DDepCount = 294;  DProcs = 296;
  DVarSizes = 304;

TYPE
  FixRec = RECORD
    pos : CARDINAL;
    lab : INTEGER;
  END;
  InitRec = RECORD
    idx  : CARDINAL;
    kind : INTEGER;  (* 0 = INTEGER value, 1 = raw 64-bit pattern *)
    ival : INTEGER;
    bits : LONGCARD;
  END;
  RealView = RECORD CASE : BOOLEAN OF
               | TRUE : r : REAL;
               | FALSE : w : LONGCARD;
             END;
           END;

VAR
  code : ARRAY [0 .. MaxCode] OF CHAR;
  nCode : CARDINAL;
  img : ARRAY [0 .. MaxImg] OF CHAR;
  modName : ARRAY [0 .. 63] OF CHAR;
  gNames : ARRAY [0 .. MaxGlb] OF ARRAY [0 .. 63] OF CHAR;
  nGlb : CARDINAL;
  inits : ARRAY [0 .. MaxInit] OF InitRec;
  nInit : CARDINAL;
  inBody : BOOLEAN;
  labs : ARRAY [0 .. MaxLab] OF INTEGER;
  nLab : CARDINAL;
  fixs : ARRAY [0 .. MaxFix] OF FixRec;
  nFix : CARDINAL;
  loopSt : ARRAY [0 .. MaxLoop] OF INTEGER;
  loopTop : CARDINAL;
  noSup : CARDINAL;
  noEmit : CARDINAL;

(* ---------------- byte helpers ---------------- *)

PROCEDURE StrLen (s: ARRAY OF CHAR): CARDINAL;
  VAR i : CARDINAL;
  BEGIN
    i := 0;
    WHILE (i < HIGH(s)) & (s[i] # 0C) DO INC(i) END;
    RETURN i
  END StrLen;

PROCEDURE StrCpy (VAR d: ARRAY OF CHAR; s: ARRAY OF CHAR);
  VAR i : CARDINAL;
  BEGIN
    i := 0;
    WHILE (i < HIGH(d)) & (i < HIGH(s)) & (s[i] # 0C) DO
      d[i] := s[i]; INC(i)
    END;
    IF i <= HIGH(d) THEN d[i] := 0C END
  END StrCpy;

PROCEDURE EmitByte (b: CARDINAL);
  BEGIN
    IF noEmit > 0 THEN RETURN END;
    IF nCode <= MaxCode THEN
      code[nCode] := CHR(b MOD 256); INC(nCode)
    END
  END EmitByte;

PROCEDURE EmitOp (o: CARDINAL);
  BEGIN
    EmitByte(o)
  END EmitOp;

PROCEDURE EmitOpB (o, b: CARDINAL);
  BEGIN
    EmitByte(o); EmitByte(b)
  END EmitOpB;

PROCEDURE EmitW64 (v: LONGCARD);
  VAR j : CARDINAL;
  BEGIN
    FOR j := 0 TO 7 DO
      EmitByte(VAL(CARDINAL, v MOD 256)); v := v DIV 256
    END
  END EmitW64;

PROCEDURE EmitS64 (rel: INTEGER);
(* Appends a signed 64-bit little-endian offset. *)
  VAR mag : CARDINAL;
  BEGIN
    IF rel >= 0 THEN EmitW64(VAL(LONGCARD, VAL(CARDINAL, rel)))
    ELSE
      IF rel = -2147483647 - 1 THEN mag := 80000000H
      ELSE mag := VAL(CARDINAL, -rel)
      END;
      EmitW64(0FFFFFFFFFFFFFFFFH - VAL(LONGCARD, mag) + 1H)
    END
  END EmitS64;

PROCEDURE WriteS64At (off: CARDINAL; rel: INTEGER);
(* Backpatches a signed offset into already-emitted code. *)
  VAR mag : CARDINAL;
    bits : LONGCARD;
    j : CARDINAL;
  BEGIN
    IF rel >= 0 THEN bits := VAL(LONGCARD, VAL(CARDINAL, rel))
    ELSE
      IF rel = -2147483647 - 1 THEN mag := 80000000H
      ELSE mag := VAL(CARDINAL, -rel)
      END;
      bits := 0FFFFFFFFFFFFFFFFH - VAL(LONGCARD, mag) + 1H
    END;
    FOR j := 0 TO 7 DO
      code[off + j] := CHR(VAL(CARDINAL, bits MOD 256));
      bits := bits DIV 256
    END
  END WriteS64At;

PROCEDURE FindVar (name: ARRAY OF CHAR): INTEGER;
  VAR i : CARDINAL;
  BEGIN
    i := 0;
    WHILE i < nGlb DO
      IF SymTab.Equal(gNames[i], name) THEN RETURN VAL(INTEGER, i) END;
      INC(i)
    END;
    RETURN -1
  END FindVar;

PROCEDURE AssignSlot (name: ARRAY OF CHAR): INTEGER;
  BEGIN
    IF nGlb > MaxGlb THEN RETURN -1 END;
    StrCpy(gNames[nGlb], name);
    INC(nGlb);
    RETURN VAL(INTEGER, nGlb - 1)
  END AssignSlot;

(* ---------------- module / data section ---------------- *)

PROCEDURE OpenModule (name: ARRAY OF CHAR);
  VAR i : CARDINAL;
    dummy : INTEGER;
  BEGIN
    StrCpy(modName, name);
    nCode := 0; nGlb := 0; nInit := 0;
    nLab := 0; nFix := 0; loopTop := 0; noSup := 0; noEmit := 0;
    inBody := FALSE;
    i := 0;
    WHILE i <= MaxGlb DO gNames[i][0] := 0C; INC(i) END;
    (* slots 0..3 belong to the print helper *)
    dummy := AssignSlot(""); dummy := AssignSlot("");
    dummy := AssignSlot(""); dummy := AssignSlot("")
  END OpenModule;

PROCEDURE DeclVar (name: ARRAY OF CHAR);
  VAR idx : INTEGER;
  BEGIN
    idx := AssignSlot(name);
    IF idx < 0 THEN RETURN END
  END DeclVar;

PROCEDURE BufInit (idx: INTEGER; kind: INTEGER; ival: INTEGER;
                   bits: LONGCARD);
  BEGIN
    IF nInit > MaxInit THEN RETURN END;
    inits[nInit].idx := VAL(CARDINAL, idx);
    inits[nInit].kind := kind;
    inits[nInit].ival := ival;
    inits[nInit].bits := bits;
    INC(nInit)
  END BufInit;

PROCEDURE DeclConst (name: ARRAY OF CHAR; lit: LitStr; t: INTEGER);
  VAR idx : INTEGER;
    cls : INTEGER;
    v : INTEGER;
    c : CARDINAL;
    b : LONGCARD;
  BEGIN
    idx := AssignSlot(name);
    IF idx < 0 THEN RETURN END;
    cls := SymTab.ClassOf(t);
    IF ~IsLit(lit) OR (cls = SymTab.ClStr) THEN
      BufInit(idx, 0, 0, 0H); RETURN
    END;
    IF cls = SymTab.ClReal THEN
      IF ParseReal(lit, b) THEN BufInit(idx, 1, 0, b)
      ELSE BufInit(idx, 1, 0, 0H)
      END
    ELSIF SymTab.Equal(lit, "TRUE") THEN BufInit(idx, 0, 1, 0H)
    ELSIF SymTab.Equal(lit, "FALSE") THEN BufInit(idx, 0, 0, 0H)
    ELSIF ParseInt(lit, v) THEN BufInit(idx, 0, v, 0H)
    ELSIF ParseCard(lit, c) THEN
      BufInit(idx, 1, 0, VAL(LONGCARD, c))
    ELSE BufInit(idx, 0, 0, 0H)
    END
  END DeclConst;

PROCEDURE DeclConstInt (name: ARRAY OF CHAR; v: INTEGER);
  VAR idx : INTEGER;
  BEGIN
    idx := AssignSlot(name);
    IF idx < 0 THEN RETURN END;
    BufInit(idx, 0, v, 0H)
  END DeclConstInt;

PROCEDURE PushValue (kind: INTEGER; ival: INTEGER; bits: LONGCARD);
  BEGIN
    IF kind = 0 THEN PushInt(ival) ELSE PushBits(bits) END
  END PushValue;

PROCEDURE BeginBody;
  VAR i : CARDINAL;
  BEGIN
    IF inBody THEN RETURN END;
    inBody := TRUE;
    i := 0;
    WHILE i < nInit DO
      PushValue(inits[i].kind, inits[i].ival, inits[i].bits);
      EmitOpB(OPstoreGlb, inits[i].idx);
      INC(i)
    END
  END BeginBody;

(* ---------------- loads, stores, pushes ---------------- *)

PROCEDURE LoadVar (name: ARRAY OF CHAR);
  VAR idx : INTEGER;
  BEGIN
    idx := FindVar(name);
    IF idx < 0 THEN EmitOp(OPimm0)
    ELSE EmitOpB(OPloadGlb, VAL(CARDINAL, idx))
    END
  END LoadVar;

PROCEDURE StoreVar (name: ARRAY OF CHAR);
  VAR idx : INTEGER;
  BEGIN
    idx := FindVar(name);
    IF idx < 0 THEN EmitOp(OPext); EmitOp(SUBdrop)
    ELSE EmitOpB(OPstoreGlb, VAL(CARDINAL, idx))
    END
  END StoreVar;

PROCEDURE LoadTemp (t: INTEGER);
  BEGIN
    EmitOpB(OPloadGlb, VAL(CARDINAL, t))
  END LoadTemp;

PROCEDURE StoreTemp (t: INTEGER);
  BEGIN
    EmitOpB(OPstoreGlb, VAL(CARDINAL, t))
  END StoreTemp;

PROCEDURE TempGlobal (): INTEGER;
  VAR idx : INTEGER;
  BEGIN
    idx := AssignSlot("");
    IF idx < 0 THEN RETURN 4 END;
    RETURN idx
  END TempGlobal;

PROCEDURE EmitMag (c: CARDINAL);
  BEGIN
    IF c <= 255 THEN EmitOpB(OPimmB, c)
    ELSE EmitOp(OPimmW); EmitW64(VAL(LONGCARD, c))
    END
  END EmitMag;

PROCEDURE PushInt (v: INTEGER);
  VAR mag : CARDINAL;
  BEGIN
    IF (v >= 0) & (v <= 15) THEN EmitOp(OPimm0 + VAL(CARDINAL, v))
    ELSIF v < 0 THEN
      IF v = -2147483647 - 1 THEN mag := 80000000H
      ELSE mag := VAL(CARDINAL, -v)
      END;
      EmitOp(OPimm0); EmitMag(mag); EmitOp(OPsub)
    ELSE EmitMag(VAL(CARDINAL, v))
    END
  END PushInt;

PROCEDURE PushBits (b: LONGCARD);
  BEGIN
    EmitOp(OPimmW); EmitW64(b)
  END PushBits;

(* ---------------- literal parsing ---------------- *)

PROCEDURE DigVal (ch: CHAR): INTEGER;
  BEGIN
    IF (ch >= "0") & (ch <= "9") THEN RETURN ORD(ch) - ORD("0") END;
    IF (ch >= "A") & (ch <= "F") THEN RETURN ORD(ch) - ORD("A") + 10 END;
    IF (ch >= "a") & (ch <= "f") THEN RETURN ORD(ch) - ORD("a") + 10 END;
    RETURN -1
  END DigVal;

PROCEDURE ParseCard (s: ARRAY OF CHAR; VAR v: CARDINAL): BOOLEAN;
  VAR i, n : CARDINAL;
    hex : BOOLEAN;
    d : INTEGER;
    acc : LONGCARD;
  BEGIN
    v := 0;
    n := StrLen(s);
    IF n = 0 THEN RETURN FALSE END;
    hex := (s[n - 1] = "H") OR (s[n - 1] = "h");
    IF hex THEN DEC(n) END;
    IF n = 0 THEN RETURN FALSE END;
    acc := 0H; i := 0;
    WHILE i < n DO
      d := DigVal(s[i]);
      IF hex THEN
        IF d < 0 THEN RETURN FALSE END;
        acc := acc * 16 + VAL(LONGCARD, VAL(CARDINAL, d))
      ELSE
        IF (d < 0) OR (d > 9) THEN RETURN FALSE END;
        acc := acc * 10 + VAL(LONGCARD, VAL(CARDINAL, d))
      END;
      IF acc > 0FFFFFFFFH THEN RETURN FALSE END;
      INC(i)
    END;
    v := VAL(CARDINAL, acc);
    RETURN TRUE
  END ParseCard;

PROCEDURE ParseInt (s: ARRAY OF CHAR; VAR v: INTEGER): BOOLEAN;
  VAR i : CARDINAL;
    neg : BOOLEAN;
    t : ARRAY [0 .. 63] OF CHAR;
    c : CARDINAL;
    lim : LONGCARD;
  BEGIN
    v := 0;
    IF (StrLen(s) = 0) THEN RETURN FALSE END;
    neg := s[0] = "-";
    IF neg THEN
      i := 1;
      WHILE s[i] # 0C DO
        IF i - 1 > HIGH(t) THEN RETURN FALSE END;
        t[i - 1] := s[i]; INC(i)
      END;
      IF i - 1 > HIGH(t) THEN RETURN FALSE END;
      t[i - 1] := 0C
    ELSE StrCpy(t, s)
    END;
    IF ~ParseCard(t, c) THEN RETURN FALSE END;
    IF neg THEN lim := 80000000H ELSE lim := 7FFFFFFFH END;
    IF VAL(LONGCARD, c) > lim THEN RETURN FALSE END;
    IF neg THEN
      IF VAL(LONGCARD, c) = 80000000H THEN v := -2147483647 - 1
      ELSE v := -VAL(INTEGER, c)
      END
    ELSE v := VAL(INTEGER, c)
    END;
    RETURN TRUE
  END ParseInt;

PROCEDURE ParseReal (s: ARRAY OF CHAR; VAR b: LONGCARD): BOOLEAN;
  VAR i : CARDINAL;
    neg, esign : BOOLEAN;
    m, scale : REAL;
    e, d : CARDINAL;
    rv : RealView;
  BEGIN
    b := 0H;
    i := 0; neg := FALSE;
    IF s[0] = "-" THEN neg := TRUE; INC(i) END;
    IF (s[i] < "0") OR (s[i] > "9") THEN RETURN FALSE END;
    m := 0.0;
    WHILE (s[i] >= "0") & (s[i] <= "9") DO
      m := m * 10.0 + VAL(REAL, VAL(CARDINAL, ORD(s[i]) - ORD("0")));
      INC(i)
    END;
    IF s[i] = "." THEN
      INC(i);
      IF (s[i] < "0") OR (s[i] > "9") THEN RETURN FALSE END;
      scale := 10.0;
      WHILE (s[i] >= "0") & (s[i] <= "9") DO
        m := m + VAL(REAL, VAL(CARDINAL, ORD(s[i]) - ORD("0"))) / scale;
        scale := scale * 10.0;
        INC(i)
      END
    END;
    IF (s[i] = "E") OR (s[i] = "e") THEN
      INC(i); esign := FALSE;
      IF s[i] = "+" THEN INC(i)
      ELSIF s[i] = "-" THEN esign := TRUE; INC(i)
      END;
      IF (s[i] < "0") OR (s[i] > "9") THEN RETURN FALSE END;
      e := 0;
      WHILE (s[i] >= "0") & (s[i] <= "9") DO
        d := VAL(CARDINAL, ORD(s[i]) - ORD("0"));
        IF e <= 9999 THEN e := e * 10 + d END;
        INC(i)
      END;
      WHILE e > 0 DO
        IF esign THEN m := m / 10.0 ELSE m := m * 10.0 END;
        DEC(e)
      END
    END;
    IF s[i] # 0C THEN RETURN FALSE END;
    IF neg THEN m := -m END;
    rv.r := m;
    b := rv.w;
    RETURN TRUE
  END ParseReal;

PROCEDURE CharOrd (s: ARRAY OF CHAR): INTEGER;
  BEGIN
    IF StrLen(s) >= 2 THEN RETURN ORD(s[1]) END;
    RETURN 0
  END CharOrd;

PROCEDURE NegFold (a: ARRAY OF CHAR; VAR q: LitStr);
(* Safe for a and q being the same variable. *)
  VAR tmp : LitStr;
    i, j : CARDINAL;
  BEGIN
    StrCpy(tmp, a);
    IF StrLen(tmp) = 0 THEN StrCpy(q, ""); RETURN END;
    IF tmp[0] = "-" THEN
      i := 1; j := 0;
      WHILE (tmp[i] # 0C) & (j < HIGH(q)) DO
        q[j] := tmp[i]; INC(i); INC(j)
      END;
      IF j <= HIGH(q) THEN q[j] := 0C END
    ELSE
      StrCpy(q, "-");
      i := 0; j := StrLen(q);
      WHILE (tmp[i] # 0C) & (j < HIGH(q)) DO
        q[j] := tmp[i]; INC(i); INC(j)
      END;
      IF j <= HIGH(q) THEN q[j] := 0C END
    END
  END NegFold;

PROCEDURE IsLit (s: ARRAY OF CHAR): BOOLEAN;
  BEGIN
    RETURN StrLen(s) > 0
  END IsLit;

(* ---------------- operators ---------------- *)

PROCEDURE Add;
  BEGIN EmitOp(OPadd) END Add;
PROCEDURE Sub;
  BEGIN EmitOp(OPsub) END Sub;
PROCEDURE MulU;
  BEGIN EmitOp(OPumul) END MulU;
PROCEDURE DivU;
  BEGIN EmitOp(OPudiv) END DivU;
PROCEDURE ModU;
  BEGIN EmitOp(OPumod) END ModU;
PROCEDURE MulI;
  BEGIN EmitOp(OPimul) END MulI;
PROCEDURE DivI;
  BEGIN EmitOp(OPidiv) END DivI;
PROCEDURE ModI (t: INTEGER);
(* [a b] -> a MOD b (truncation) via temp t. *)
  BEGIN
    StoreTemp(t);
    EmitOp(OPdup);
    LoadTemp(t);
    EmitOp(OPidiv);
    LoadTemp(t);
    EmitOp(OPimul);
    EmitOp(OPsub)
  END ModI;

PROCEDURE RealAdd;
  BEGIN EmitOp(OPrAdd) END RealAdd;
PROCEDURE RealSub;
  BEGIN EmitOp(OPrSub) END RealSub;
PROCEDURE RealMul;
  BEGIN EmitOp(OPrMul) END RealMul;
PROCEDURE RealDiv;
  BEGIN EmitOp(OPrDiv) END RealDiv;

PROCEDURE And;
  BEGIN EmitOp(OPand) END And;
PROCEDURE Or;
  BEGIN EmitOp(OPor) END Or;
PROCEDURE Not;
  BEGIN EmitOp(OPnot) END Not;

PROCEDURE Power2;
  BEGIN EmitOp(OPpower2) END Power2;

PROCEDURE FieldMask;
  BEGIN EmitOp(OPext); EmitOp(04H) END FieldMask;

PROCEDURE BitIn;
  BEGIN EmitOp(OPbitIn) END BitIn;

PROCEDURE Eq;
  BEGIN EmitOp(OPeq) END Eq;
PROCEDURE Neq;
  BEGIN EmitOp(OPne) END Neq;
PROCEDURE ULt;
  BEGIN EmitOp(OPult) END ULt;
PROCEDURE ULe;
  BEGIN EmitOp(OPule) END ULe;
PROCEDURE UGt;
  BEGIN EmitOp(OPugt) END UGt;
PROCEDURE UGe;
  BEGIN EmitOp(OPuge) END UGe;
PROCEDURE ILt;
  BEGIN EmitOp(OPilt) END ILt;
PROCEDURE ILe;
  BEGIN EmitOp(OPile) END ILe;
PROCEDURE IGt;
  BEGIN EmitOp(OPigt) END IGt;
PROCEDURE IGe;
  BEGIN EmitOp(OPige) END IGe;

PROCEDURE RealEq;
(* [r1 r2] -> (r1 = r2): cmp, or, not. *)
  BEGIN EmitOp(OPrCmp); EmitOp(OPor); EmitOp(OPnot) END RealEq;
PROCEDURE RealNe;
(* [r1 r2] -> (r1 # r2): cmp, or. *)
  BEGIN EmitOp(OPrCmp); EmitOp(OPor) END RealNe;
PROCEDURE RealLt;
(* [gt lt] -> lt: swap, drop. *)
  BEGIN EmitOp(OPswap); EmitOp(OPext); EmitOp(SUBdrop) END RealLt;
PROCEDURE RealLe;
(* [gt lt] -> NOT gt: drop, not. *)
  BEGIN EmitOp(OPext); EmitOp(SUBdrop); EmitOp(OPnot) END RealLe;
PROCEDURE RealGt;
(* [gt lt] -> gt: drop. *)
  BEGIN EmitOp(OPext); EmitOp(SUBdrop) END RealGt;
PROCEDURE RealGe;
(* [gt lt] -> NOT lt: swap, drop, not. *)
  BEGIN
    EmitOp(OPswap); EmitOp(OPext); EmitOp(SUBdrop); EmitOp(OPnot)
  END RealGe;

PROCEDURE NegInt;
  BEGIN EmitOp(OPimm0); EmitOp(OPswap); EmitOp(OPsub) END NegInt;
PROCEDURE NegReal;
  BEGIN
    EmitOp(OPimmW); EmitW64(0H);
    EmitOp(OPswap); EmitOp(OPrSub)
  END NegReal;
PROCEDURE IntToReal;
  BEGIN EmitOp(OPintToLong); EmitOp(OPlongToReal) END IntToReal;

PROCEDURE Dup;
  BEGIN EmitOp(OPdup) END Dup;
PROCEDURE Drop;
  BEGIN EmitOp(OPext); EmitOp(SUBdrop) END Drop;

(* ---------------- control flow ---------------- *)

PROCEDURE NewLabel (): INTEGER;
  BEGIN
    IF nLab > MaxLab THEN RETURN 0 END;
    labs[nLab] := -1;
    INC(nLab);
    RETURN VAL(INTEGER, nLab - 1)
  END NewLabel;

PROCEDURE DefLabel (id: INTEGER);
  VAR i : CARDINAL;
    rel : INTEGER;
  BEGIN
    IF (id < 0) OR (id >= VAL(INTEGER, nLab)) THEN RETURN END;
    labs[id] := VAL(INTEGER, nCode);
    i := 0;
    WHILE i < nFix DO
      IF fixs[i].lab = id THEN
        rel := labs[id] - VAL(INTEGER, fixs[i].pos + 9);
        WriteS64At(fixs[i].pos + 1, rel);
        fixs[i].lab := -1
      END;
      INC(i)
    END
  END DefLabel;

PROCEDURE Jump (op: CARDINAL; id: INTEGER);
  VAR pos : CARDINAL;
    j : CARDINAL;
  BEGIN
    pos := nCode;
    EmitOp(op);
    IF (id >= 0) & (id < VAL(INTEGER, nLab)) & (labs[id] >= 0) THEN
      EmitS64(labs[id] - VAL(INTEGER, pos + 9))
    ELSE
      FOR j := 0 TO 7 DO EmitByte(0) END;
      IF (nFix <= MaxFix) & (id >= 0) & (id < VAL(INTEGER, nLab)) THEN
        fixs[nFix].pos := pos; fixs[nFix].lab := id; INC(nFix)
      END
    END
  END Jump;

PROCEDURE Jmp (id: INTEGER);
  BEGIN
    Jump(OPjp, id)
  END Jmp;

PROCEDURE Jz (id: INTEGER);
  BEGIN
    Jump(OPjz, id)
  END Jz;

PROCEDURE PushLoop (exit: INTEGER);
  BEGIN
    IF loopTop <= MaxLoop THEN
      loopSt[loopTop] := exit; INC(loopTop)
    END
  END PushLoop;

PROCEDURE PopLoop;
  BEGIN
    IF loopTop > 0 THEN DEC(loopTop) END
  END PopLoop;

PROCEDURE TopLoop (VAR exit: INTEGER): BOOLEAN;
  BEGIN
    IF loopTop = 0 THEN RETURN FALSE END;
    exit := loopSt[loopTop - 1];
    RETURN TRUE
  END TopLoop;

PROCEDURE NoSupEnter;
  BEGIN
    INC(noSup)
  END NoSupEnter;

PROCEDURE NoSupExit;
  BEGIN
    IF noSup > 0 THEN DEC(noSup) END
  END NoSupExit;

PROCEDURE NoSup (): BOOLEAN;
  BEGIN
    RETURN noSup > 0
  END NoSup;

PROCEDURE CopyName (s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);
  VAR i : CARDINAL;
  BEGIN
    i := 0;
    WHILE (i < HIGH(d)) & (i < HIGH(s)) & (s[i] # 0C) DO
      d[i] := s[i]; INC(i)
    END;
    IF i <= HIGH(d) THEN d[i] := 0C END
  END CopyName;

PROCEDURE NoEmitEnter;
  BEGIN
    INC(noEmit)
  END NoEmitEnter;

PROCEDURE NoEmitExit;
  BEGIN
    IF noEmit > 0 THEN DEC(noEmit) END
  END NoEmitExit;

(* ---------------- image assembly ---------------- *)

PROCEDURE Put32At (off: CARDINAL; v: CARDINAL);
  BEGIN
    img[off] := CHR(v MOD 256);
    img[off + 1] := CHR((v DIV 256) MOD 256);
    img[off + 2] := CHR((v DIV 65536) MOD 256);
    img[off + 3] := CHR(v DIV 16777216)
  END Put32At;

PROCEDURE Put64At (off: CARDINAL; v: LONGCARD);
  VAR j : CARDINAL;
  BEGIN
    FOR j := 0 TO 7 DO
      img[off + j] := CHR(VAL(CARDINAL, v MOD 256));
      v := v DIV 256
    END
  END Put64At;

PROCEDURE EmitPrint;
(* proc1: prints the CARDINAL parameter as decimal + CRLF.
   Uses global temps 0..3 (buffer, count, index, char). *)
  VAR l1, l2 : INTEGER;
  BEGIN
    EmitOpB(OPenter, 250);
    EmitOpB(OPimmB, 16); EmitOp(0D2H); EmitOpB(OPstoreGlb, 0);
    EmitOp(OPimm0); EmitOp(OPimm0);
    EmitOpB(OPstoreGlb, 1); EmitOpB(OPstoreGlb, 2);
    EmitOp(03H);
    l1 := NewLabel(); DefLabel(l1);
    EmitOpB(OPloadGlb, 1); EmitOp(OPinc); EmitOpB(OPstoreGlb, 1);
    EmitOp(OPdup); EmitOpB(OPimmB, 10); EmitOp(OPumod);
    EmitOp(OPswap); EmitOpB(OPimmB, 10); EmitOp(OPudiv);
    EmitOp(OPdup); EmitOp(OPaeq0);
    Jz(l1);
    EmitOp(OPext); EmitOp(SUBdrop);
    l2 := NewLabel(); DefLabel(l2);
    EmitOpB(OPimmB, 48); EmitOp(OPadd); EmitOpB(OPstoreGlb, 3);
    EmitOpB(OPloadGlb, 0); EmitOpB(OPloadGlb, 2); EmitOp(OPadd);
    EmitOp(OPimm0); EmitOpB(OPloadGlb, 3); EmitOp(1DH);
    EmitOpB(OPloadGlb, 2); EmitOp(OPinc); EmitOpB(OPstoreGlb, 2);
    EmitOpB(OPloadGlb, 1); EmitOp(OPdec); EmitOpB(OPstoreGlb, 1);
    EmitOpB(OPloadGlb, 1); EmitOp(OPaeq0);
    Jz(l2);
    EmitOpB(OPloadGlb, 0); EmitOpB(OPloadGlb, 2); EmitOp(OPadd);
    EmitOp(OPimm0); EmitOp(OPimm0); EmitOp(1DH);
    EmitOpB(OPloadGlb, 0);
    EmitOpB(OPimmB, 1); EmitOp(OPsys);
    EmitOpB(OPimmB, 3); EmitOp(0D2H);
    EmitOp(OPdup); EmitOp(OPimm0); EmitOpB(OPimmB, 13); EmitOp(1DH);
    EmitOp(OPdup); EmitOpB(OPimmB, 1); EmitOpB(OPimmB, 10); EmitOp(1DH);
    EmitOp(OPdup); EmitOpB(OPimmB, 2); EmitOp(OPimm0); EmitOp(1DH);
    EmitOpB(OPimmB, 1); EmitOp(OPsys);
    EmitOpB(OPfctLeave, 0)
  END EmitPrint;

PROCEDURE EndModule;
  VAR i : CARDINAL;
    codeOff, p1, pt : CARDINAL;
    exitIdx : INTEGER;
    sum : CARDINAL;
    fname : ARRAY [0 .. 127] OF CHAR;
    f : FileIO.File;
    ch : CHAR;
  BEGIN
    (* epilogue: print ExitCode when the convention applies *)
    exitIdx := -1;
    IF SymTab.Lookup("ExitCode")
       & (SymTab.SymKind("ExitCode") = SymTab.KindVar)
       & SymTab.IsIntFamily(SymTab.SymType("ExitCode")) THEN
      exitIdx := FindVar("ExitCode")
    END;
    IF exitIdx >= 0 THEN
      EmitOpB(OPloadGlb, VAL(CARDINAL, exitIdx));
      EmitOpB(OPprocCall, 1);
      EmitOp(OPext); EmitOp(SUBdrop)
    END;
    EmitOp(OPend);
    p1 := nCode;
    EmitPrint;
    (* assemble the image *)
    i := 0;
    WHILE i <= MaxImg DO img[i] := 0C; INC(i) END;
    img[0] := "M"; img[1] := "C"; img[2] := "6"; img[3] := "4";
    i := 0;
    WHILE (i < 16) & (modName[i] # 0C) DO
      img[HeadSize + DName + i] := modName[i]; INC(i)
    END;
    img[HeadSize + DFlags] := CHR(4);
    img[HeadSize + DVarCount] := CHR(nGlb MOD 256);
    img[HeadSize + DDepCount] := 0C;
    codeOff := DVarSizes + nGlb * 8;
    i := 0;
    WHILE i < nCode DO
      img[HeadSize + codeOff + i] := code[i]; INC(i)
    END;
    pt := codeOff + nCode;
    Put64At(HeadSize + DProcs, VAL(LONGCARD, pt));
    Put64At(HeadSize + pt,
      VAL(LONGCARD, codeOff) - VAL(LONGCARD, pt));
    Put64At(HeadSize + pt + 8,
      VAL(LONGCARD, codeOff + p1) - VAL(LONGCARD, pt + 8));
    i := 0;
    WHILE i < nGlb DO
      Put64At(HeadSize + DVarSizes + i * 8, 8H);
      INC(i)
    END;
    sum := 0;
    i := HeadSize;
    WHILE i < HeadSize + pt + 16 DO
      IF ~((i >= 352) & (i <= 355)) THEN
        sum := sum + ORD(img[i])
      END;
      INC(i)
    END;
    Put32At(HeadSize + DChecksum, sum);
    fname[0] := 0C;
    StrCpy(fname, modName);
    i := StrLen(fname);
    fname[i] := "."; fname[i + 1] := "M"; fname[i + 2] := "C";
    fname[i + 3] := "D"; fname[i + 4] := 0C;
    FileIO.Open(f, fname, TRUE);
    IF FileIO.Okay THEN
      i := 0;
      WHILE i < HeadSize + pt + 16 DO
        ch := img[i];
        FileIO.Write(f, ch);
        INC(i)
      END;
      FileIO.Close(f)
    END
  END EndModule;

BEGIN
  nCode := 0; nGlb := 0; nInit := 0;
  nLab := 0; nFix := 0; loopTop := 0; noSup := 0; noEmit := 0;
  inBody := FALSE;
  modName[0] := 0C
END MGen.