CocoR/Test2/QbeGen.mod

IMPLEMENTATION MODULE QbeGen;

IMPORT FileIO, SymTab;

VAR
  out     : FileIO.File;
  opened  : BOOLEAN;
  inBody  : BOOLEAN;
  nTemp   : CARDINAL;
  nLab    : CARDINAL;
  loopTop : CARDINAL;
  loopSt  : ARRAY [0 .. 15] OF QVal;
  noqbe   : CARDINAL;
  nR      : CARDINAL;
  rNames  : ARRAY [0 .. 31] OF QVal;
  rVals   : ARRAY [0 .. 31] OF QVal;

(* ---------------- small string utilities ---------------- *)

PROCEDURE Len (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 Len;

PROCEDURE Cpy (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 Cpy;

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

PROCEDURE W (s: ARRAY OF CHAR);
  BEGIN
    IF opened THEN FileIO.WriteString(out, s) END
  END W;

PROCEDURE WL (s: ARRAY OF CHAR);
  BEGIN
    W(s);
    IF opened THEN FileIO.WriteLn(out) END
  END WL;

PROCEDURE AppNum (VAR d: ARRAY OF CHAR; v: CARDINAL);
(* Appends v in decimal to d. *)
  VAR buf : ARRAY [0 .. 15] OF CHAR;
    n, i, L : CARDINAL;
  BEGIN
    n := 0;
    IF v = 0 THEN buf[0] := "0"; n := 1 END;
    WHILE (v > 0) & (n <= HIGH(buf)) DO
      buf[n] := CHR(ORD("0") + v MOD 10); v := v DIV 10; INC(n)
    END;
    i := n;
    WHILE i > 0 DO
      DEC(i);
      L := Len(d);
      IF L < HIGH(d) THEN d[L] := buf[i]; d[L + 1] := 0C END
    END
  END AppNum;

(* ---------------- exported helpers ---------------- *)

PROCEDURE CopyOp (s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);
  BEGIN
    Cpy(d, s)
  END CopyOp;

PROCEDURE IntStr (v: INTEGER; VAR s: QVal);
  VAR neg : BOOLEAN;
    mag : CARDINAL;
    buf : ARRAY [0 .. 15] OF CHAR;
    n, i, L : CARDINAL;
    t : CHAR;
  BEGIN
    neg := v < 0;
    IF neg THEN mag := VAL(CARDINAL, -v) ELSE mag := VAL(CARDINAL, v) END;
    n := 0;
    IF mag = 0 THEN buf[0] := "0"; n := 1 END;
    WHILE (mag > 0) & (n < HIGH(buf)) DO
      buf[n] := CHR(ORD("0") + mag MOD 10); mag := mag DIV 10; INC(n)
    END;
    i := 0;
    WHILE i < n DIV 2 DO
      t := buf[i]; buf[i] := buf[n - 1 - i]; buf[n - 1 - i] := t; INC(i)
    END;
    s[0] := 0C;
    IF neg THEN App(s, "-") END;
    i := 0;
    WHILE i < n DO
      L := Len(s);
      IF L < HIGH(s) THEN s[L] := buf[i]; s[L + 1] := 0C END;
      INC(i)
    END
  END IntStr;

PROCEDURE HexVal (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 0
  END HexVal;

PROCEDURE NormInt (s: ARRAY OF CHAR; VAR d: QVal);
(* "0FFH" -> "255", plain decimals are copied through. *)
  VAR n, i : CARDINAL;
    v : INTEGER;
  BEGIN
    n := Len(s);
    IF (n > 0) & ((s[n - 1] = "H") OR (s[n - 1] = "h")) THEN
      v := 0; i := 0;
      WHILE i < n - 1 DO v := v * 16 + HexVal(s[i]); INC(i) END;
      IntStr(v, d)
    ELSE
      Cpy(d, s)
    END
  END NormInt;

PROCEDURE NormReal (s: ARRAY OF CHAR; VAR d: QVal);
  BEGIN
    Cpy(d, "d_");
    App(d, s)
  END NormReal;

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

PROCEDURE NegFold (a: ARRAY OF CHAR; VAR q: QVal);
(* Safe for a and q being the same variable. *)
  VAR i, j, L : CARDINAL;
    tmp : QVal;
  BEGIN
    Cpy(tmp, a);
    IF Len(tmp) = 0 THEN Cpy(q, "0"); 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
    ELSIF (tmp[0] = "d") & (Len(tmp) > 1) & (tmp[1] = "_") THEN
      Cpy(q, "d_-");
      i := 2;
      WHILE tmp[i] # 0C DO
        L := Len(q);
        IF L < HIGH(q) THEN q[L] := tmp[i]; q[L + 1] := 0C END;
        INC(i)
      END
    ELSE
      Cpy(q, "-");
      App(q, tmp)
    END
  END NegFold;

PROCEDURE IsImm (s: ARRAY OF CHAR): BOOLEAN;
  VAR c : CHAR;
  BEGIN
    IF Len(s) = 0 THEN RETURN FALSE END;
    c := s[0];
    RETURN ((c >= "0") & (c <= "9")) OR (c = "-") OR (c = "d")
  END IsImm;

PROCEDURE IsNeg (s: ARRAY OF CHAR): BOOLEAN;
  BEGIN
    RETURN (Len(s) > 0) & (s[0] = "-")
  END IsNeg;

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

PROCEDURE OpenModule (name: ARRAY OF CHAR);
  VAR fname : ARRAY [0 .. 127] OF CHAR;
  BEGIN
    fname[0] := 0C;
    App(fname, "gen_qbe/");
    App(fname, name);
    App(fname, ".ssa");
    FileIO.Open(out, fname, TRUE);
    opened := FileIO.Okay;
    inBody := FALSE;
    nTemp := 0; nLab := 0; loopTop := 0; noqbe := 0; nR := 0;
    WL("# QBE IR generated by the SimpleQ backend");
    WL("")
  END OpenModule;

PROCEDURE DataLine (name: ARRAY OF CHAR; isReal: BOOLEAN; init: ARRAY OF CHAR);
  BEGIN
    IF ~opened THEN RETURN END;
    W("data $"); W(name);
    IF isReal THEN W(" = { d ") ELSE W(" = { w ") END;
    W(init);
    WL(" }")
  END DataLine;

PROCEDURE DeclVar (name: ARRAY OF CHAR; t: INTEGER);
  BEGIN
    IF SymTab.ClassOf(t) = SymTab.ClReal THEN DataLine(name, TRUE, "0")
    ELSE DataLine(name, FALSE, "0")
    END
  END DeclVar;

PROCEDURE IsZeroReal (val: ARRAY OF CHAR): BOOLEAN;
(* TRUE when the "d_..." literal denotes zero (checked textually). *)
  VAR i : CARDINAL;
    seen : BOOLEAN;
    ch : CHAR;
  BEGIN
    i := 0;
    IF (Len(val) > 1) & (val[0] = "d") & (val[1] = "_") THEN i := 2 END;
    seen := FALSE;
    WHILE val[i] # 0C DO
      ch := val[i];
      IF (ch >= "0") & (ch <= "9") THEN
        seen := TRUE;
        IF ch # "0" THEN RETURN FALSE END
      ELSIF (ch # ".") & (ch # "E") & (ch # "e")
            & (ch # "+") & (ch # "-") THEN
        RETURN FALSE
      END;
      INC(i)
    END;
    RETURN seen
  END IsZeroReal;

PROCEDURE DeclConst (name: ARRAY OF CHAR; val: ARRAY OF CHAR; t: INTEGER);
  VAR cls : INTEGER;
    init : QVal;
  BEGIN
    cls := SymTab.ClassOf(t);
    IF (cls = SymTab.ClStr) OR ~IsImm(val) THEN
      DeclVar(name, t); RETURN
    END;
    IF cls = SymTab.ClReal THEN
      IF IsZeroReal(val) THEN DataLine(name, TRUE, "0")
      ELSE
        DataLine(name, TRUE, "0");
        IF nR <= HIGH(rNames) THEN
          Cpy(rNames[nR], name); Cpy(rVals[nR], val); INC(nR)
        END
      END
    ELSE DataLine(name, FALSE, val)
    END
  END DeclConst;

(* ---------------- function body ---------------- *)

PROCEDURE BeginBody;
  VAR i : CARDINAL;
    t : QVal;
  BEGIN
    IF ~opened OR inBody THEN RETURN END;
    WL("");
    WL("export function w $main() {");
    WL("@start");
    inBody := TRUE;
    i := 0;
    WHILE i < nR DO
      NewTemp(t);
      W("  "); W(t); W(" =d copy "); WL(rVals[i]);
      StoreVar(rNames[i], t, TRUE);
      INC(i)
    END
  END BeginBody;

PROCEDURE EndModule;
  BEGIN
    IF ~opened THEN RETURN END;
    IF ~inBody THEN BeginBody END;
    IF SymTab.Lookup("ExitCode")
       & (SymTab.SymKind("ExitCode") = SymTab.KindVar)
       & SymTab.IsIntFamily(SymTab.SymType("ExitCode")) THEN
      WL("  %ec =w loadw $ExitCode");
      WL("  ret %ec")
    ELSE
      WL("  ret 0")
    END;
    WL("}");
    FileIO.Close(out);
    opened := FALSE
  END EndModule;

(* ---------------- temporaries, labels, jumps ---------------- *)

PROCEDURE NewTemp (VAR t: QVal);
  BEGIN
    Cpy(t, "%t");
    AppNum(t, nTemp);
    INC(nTemp)
  END NewTemp;

PROCEDURE NewLabel (VAR l: QVal);
  BEGIN
    Cpy(l, "@L");
    AppNum(l, nLab);
    INC(nLab)
  END NewLabel;

PROCEDURE EmitLabel (l: ARRAY OF CHAR);
  BEGIN
    WL(l)
  END EmitLabel;

PROCEDURE Jmp (l: ARRAY OF CHAR);
  BEGIN
    W("  jmp "); WL(l)
  END Jmp;

PROCEDURE Jnz (c, t, f: ARRAY OF CHAR);
  BEGIN
    W("  jnz "); W(c); W(", "); W(t); W(", "); WL(f)
  END Jnz;

(* ---------------- data movement and operators ---------------- *)

PROCEDURE LoadVar (name: ARRAY OF CHAR; isReal: BOOLEAN; VAR q: QVal);
  BEGIN
    NewTemp(q);
    W("  "); W(q);
    IF isReal THEN W(" =d loadd $") ELSE W(" =w loadw $") END;
    WL(name)
  END LoadVar;

PROCEDURE StoreVar (name: ARRAY OF CHAR; q: ARRAY OF CHAR; isReal: BOOLEAN);
  BEGIN
    IF isReal THEN W("  stored ") ELSE W("  storew ") END;
    W(q); W(", $"); WL(name)
  END StoreVar;

PROCEDURE Op3 (mn: ARRAY OF CHAR; res, l, r: ARRAY OF CHAR;
               isReal: BOOLEAN);
  BEGIN
    W("  "); W(res);
    IF isReal THEN W(" =d ") ELSE W(" =w ") END;
    W(mn); W(" "); W(l); W(", "); WL(r)
  END Op3;

PROCEDURE Cmp (op: INTEGER; l, r: ARRAY OF CHAR; VAR q: QVal;
               isReal: BOOLEAN);
  VAR mn : ARRAY [0 .. 7] OF CHAR;
  BEGIN
    mn[0] := 0C;
    IF isReal THEN
      IF op = SymTab.OpEq THEN Cpy(mn, "ceqd")
      ELSIF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN Cpy(mn, "cned")
      ELSIF op = SymTab.OpLt THEN Cpy(mn, "cltd")
      ELSIF op = SymTab.OpLe THEN Cpy(mn, "cled")
      ELSIF op = SymTab.OpGt THEN Cpy(mn, "cgtd")
      ELSE Cpy(mn, "cged")
      END
    ELSE
      IF op = SymTab.OpEq THEN Cpy(mn, "ceqw")
      ELSIF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN Cpy(mn, "cnew")
      ELSIF op = SymTab.OpLt THEN Cpy(mn, "csltw")
      ELSIF op = SymTab.OpLe THEN Cpy(mn, "cslew")
      ELSIF op = SymTab.OpGt THEN Cpy(mn, "csgtw")
      ELSE Cpy(mn, "csgew")
      END
    END;
    NewTemp(q);
    Op3(mn, q, l, r, FALSE)
  END Cmp;

PROCEDURE NegQ (a: ARRAY OF CHAR; VAR q: QVal; isReal: BOOLEAN);
  BEGIN
    NewTemp(q);
    IF isReal THEN Op3("sub", q, "d_0.0", a, TRUE)
    ELSE Op3("sub", q, "0", a, FALSE)
    END
  END NegQ;

PROCEDURE NotQ (a: ARRAY OF CHAR; VAR q: QVal);
  BEGIN
    NewTemp(q);
    Op3("xor", q, "1", a, FALSE)
  END NotQ;

PROCEDURE ConvIR (a: ARRAY OF CHAR; VAR q: QVal);
  BEGIN
    NewTemp(q);
    W("  "); W(q); W(" =d swtof "); WL(a)
  END ConvIR;

(* ---------------- loop stack and 230 guard ---------------- *)

PROCEDURE PushLoop (exit: ARRAY OF CHAR);
  BEGIN
    IF loopTop <= HIGH(loopSt) THEN
      Cpy(loopSt[loopTop], exit); INC(loopTop)
    END
  END PushLoop;

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

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

PROCEDURE NoQbeEnter;
  BEGIN
    INC(noqbe)
  END NoQbeEnter;

PROCEDURE NoQbeExit;
  BEGIN
    IF noqbe > 0 THEN DEC(noqbe) END
  END NoQbeExit;

PROCEDURE NoQbe (): BOOLEAN;
  BEGIN
    RETURN noqbe > 0
  END NoQbe;

PROCEDURE Remark (s: ARRAY OF CHAR);
  BEGIN
    W("# "); WL(s)
  END Remark;

BEGIN
  opened := FALSE;
  inBody := FALSE;
  nTemp := 0; nLab := 0; loopTop := 0; noqbe := 0; nR := 0
END QbeGen.