|
|
@@ -22,6 +22,35 @@ VAR
|
|
|
strTexts : ARRAY [0 .. 255] OF ARRAY [0 .. 255] OF CHAR;
|
|
|
withTop : CARDINAL;
|
|
|
withSt : ARRAY [0 .. 7] OF QVal;
|
|
|
+ noEmit : BOOLEAN; (* TRUE while parsing nested procedures in 4.1:
|
|
|
+ SymTab tracks, QbeGen suppresses output *)
|
|
|
+ inFunc : BOOLEAN; (* TRUE inside an emitted function body *)
|
|
|
+ useStack : BOOLEAN;(* TRUE: NewHeap allocates stack slots *)
|
|
|
+ funcRes : CHAR; (* current function result class *)
|
|
|
+ nLoc : CARDINAL; (* function-local name table entries *)
|
|
|
+ locNames : ARRAY [0 .. 63] OF SymTab.Name;
|
|
|
+ locTag : ARRAY [0 .. 63] OF INTEGER; (* 0 slot, 1 data, 2 addr *)
|
|
|
+ locRep : ARRAY [0 .. 63] OF QVal; (* slot temp / mangled / addr *)
|
|
|
+ locCls : ARRAY [0 .. 63] OF CHAR;
|
|
|
+ locTyp : ARRAY [0 .. 63] OF INTEGER;
|
|
|
+ nPar : CARDINAL; (* recorded formal params for the header *)
|
|
|
+ parCls : ARRAY [0 .. 63] OF CHAR;
|
|
|
+ parTmp : ARRAY [0 .. 63] OF QVal;
|
|
|
+ parNam : ARRAY [0 .. 63] OF SymTab.Name;
|
|
|
+ parVar : ARRAY [0 .. 63] OF BOOLEAN;
|
|
|
+ parTyp : ARRAY [0 .. 63] OF INTEGER;
|
|
|
+ argBuf : ARRAY [0 .. 4095] OF CHAR; (* accumulated call args *)
|
|
|
+ hbuf : ARRAY [0 .. 2047] OF CHAR; (* buffered function header *)
|
|
|
+ nArg : CARDINAL;
|
|
|
+ callDepth : CARDINAL; (* nested-call stack *)
|
|
|
+ stkName : ARRAY [0 .. 15] OF QVal;
|
|
|
+ stkRes : ARRAY [0 .. 15] OF CHAR;
|
|
|
+ stkArg : ARRAY [0 .. 15] OF ARRAY [0 .. 1023] OF CHAR;
|
|
|
+ stkN : ARRAY [0 .. 15] OF CARDINAL;
|
|
|
+ funcName : QVal; (* current function / call target *)
|
|
|
+ nVal : ARRAY [0 .. 255] OF QVal; (* VAR-actual note keys *)
|
|
|
+ nAddr : ARRAY [0 .. 255] OF QVal; (* VAR-actual note addresses *)
|
|
|
+ nn : CARDINAL;
|
|
|
|
|
|
(* ---------------- small string utilities ---------------- *)
|
|
|
|
|
|
@@ -57,15 +86,26 @@ PROCEDURE App (VAR d: ARRAY OF CHAR; s: ARRAY OF CHAR);
|
|
|
|
|
|
PROCEDURE W (s: ARRAY OF CHAR);
|
|
|
BEGIN
|
|
|
- IF opened THEN FileIO.WriteString(out, s) END
|
|
|
+ IF opened & ~noEmit THEN FileIO.WriteString(out, s) END
|
|
|
END W;
|
|
|
|
|
|
PROCEDURE WL (s: ARRAY OF CHAR);
|
|
|
BEGIN
|
|
|
W(s);
|
|
|
- IF opened THEN FileIO.WriteLn(out) END
|
|
|
+ IF opened & ~noEmit THEN FileIO.WriteLn(out) END
|
|
|
END WL;
|
|
|
|
|
|
+PROCEDURE SetNoEmit (b: BOOLEAN);
|
|
|
+ BEGIN
|
|
|
+ noEmit := b
|
|
|
+ END SetNoEmit;
|
|
|
+
|
|
|
+PROCEDURE Wc (c: CHAR);
|
|
|
+(* Writes a single class character (w/d/l). *)
|
|
|
+ BEGIN
|
|
|
+ IF opened & ~noEmit THEN FileIO.Write(out, c) END
|
|
|
+ END Wc;
|
|
|
+
|
|
|
PROCEDURE AppNum (VAR d: ARRAY OF CHAR; v: CARDINAL);
|
|
|
(* Appends v in decimal to d. *)
|
|
|
VAR buf : ARRAY [0 .. 15] OF CHAR;
|
|
|
@@ -91,10 +131,46 @@ PROCEDURE CopyOp (s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);
|
|
|
Cpy(d, s)
|
|
|
END CopyOp;
|
|
|
|
|
|
+PROCEDURE NoteAddr (val: ARRAY OF CHAR; addr: ARRAY OF CHAR);
|
|
|
+(* Records value-temp → address mapping for VAR actuals. Ring of
|
|
|
+ 256: safe because SSA temps are never reused (stale entries can
|
|
|
+ never false-match, only age out on pathological expressions). *)
|
|
|
+ BEGIN
|
|
|
+ Cpy(nVal[nn], val);
|
|
|
+ Cpy(nAddr[nn], addr);
|
|
|
+ nn := nn + 1;
|
|
|
+ IF nn > HIGH(nVal) THEN nn := 0 END
|
|
|
+ END NoteAddr;
|
|
|
+
|
|
|
+PROCEDURE AddrOfVal (val: ARRAY OF CHAR; VAR addr: QVal): BOOLEAN;
|
|
|
+ VAR i : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE i <= HIGH(nVal) DO
|
|
|
+ IF SymTab.Equal(nVal[i], val) THEN
|
|
|
+ Cpy(addr, nAddr[i]);
|
|
|
+ RETURN TRUE
|
|
|
+ END;
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ RETURN FALSE
|
|
|
+ END AddrOfVal;
|
|
|
+
|
|
|
PROCEDURE AddrOf (name: ARRAY OF CHAR; VAR q: QVal);
|
|
|
+ VAR idx : INTEGER;
|
|
|
BEGIN
|
|
|
- Cpy(q, "$");
|
|
|
- App(q, name)
|
|
|
+ idx := LocFind(name);
|
|
|
+ IF idx = -1 THEN
|
|
|
+ Cpy(q, "$");
|
|
|
+ App(q, name);
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+ IF locTag[idx] = 1 THEN
|
|
|
+ Cpy(q, "$");
|
|
|
+ App(q, locRep[idx])
|
|
|
+ ELSE
|
|
|
+ Cpy(q, locRep[idx])
|
|
|
+ END
|
|
|
END AddrOf;
|
|
|
|
|
|
PROCEDURE IntStr (v: INTEGER; VAR s: QVal);
|
|
|
@@ -246,6 +322,8 @@ PROCEDURE OpenModule (name: ARRAY OF CHAR);
|
|
|
dead := FALSE;
|
|
|
nTemp := 0; nLab := 0; loopTop := 0; nR := 0; nStr := 0;
|
|
|
withTop := 0;
|
|
|
+ noEmit := FALSE; inFunc := FALSE; useStack := FALSE;
|
|
|
+ nLoc := 0; nPar := 0; nArg := 0; nn := 0; callDepth := 0;
|
|
|
WL("# QBE IR generated by the V3 step-1 backend");
|
|
|
WL("")
|
|
|
END OpenModule;
|
|
|
@@ -269,8 +347,17 @@ PROCEDURE DataLineL (name: ARRAY OF CHAR; init: ARRAY OF CHAR);
|
|
|
WL(" }")
|
|
|
END DataLineL;
|
|
|
|
|
|
+PROCEDURE DeclLocal (name: ARRAY OF CHAR; t: INTEGER);
|
|
|
+(* Function-local variable: stack slot + static init, recorded. *)
|
|
|
+ VAR slot : QVal;
|
|
|
+ BEGIN
|
|
|
+ AllocLocal(t, slot);
|
|
|
+ LocAdd(name, 0, slot, ResClass(t), t)
|
|
|
+ END DeclLocal;
|
|
|
+
|
|
|
PROCEDURE DeclVar (name: ARRAY OF CHAR; t: INTEGER);
|
|
|
BEGIN
|
|
|
+ IF inFunc THEN DeclLocal(name, t); RETURN END;
|
|
|
IF SymTab.ClassOf(t) = SymTab.ClReal THEN DataLine(name, TRUE, "0")
|
|
|
ELSIF SymTab.ClassOf(t) = SymTab.ClArray THEN DeclArr(name, t)
|
|
|
ELSIF SymTab.ClassOf(t) = SymTab.ClSet THEN DeclSet(name, t)
|
|
|
@@ -308,19 +395,26 @@ PROCEDURE IsZeroReal (val: ARRAY OF CHAR): BOOLEAN;
|
|
|
|
|
|
PROCEDURE DeclConst (name: ARRAY OF CHAR; val: ARRAY OF CHAR; t: INTEGER);
|
|
|
VAR cls : INTEGER;
|
|
|
+ mang : QVal;
|
|
|
BEGIN
|
|
|
cls := SymTab.ClassOf(t);
|
|
|
+ IF inFunc THEN
|
|
|
+ Cpy(mang, funcName); App(mang, "_"); App(mang, name);
|
|
|
+ LocAdd(name, 1, mang, ResClass(t), t)
|
|
|
+ ELSE
|
|
|
+ Cpy(mang, name)
|
|
|
+ END;
|
|
|
IF (cls = SymTab.ClStr) OR ~IsImm(val) THEN
|
|
|
- DataLine(name, FALSE, "0"); RETURN
|
|
|
+ DataLine(mang, FALSE, "0"); RETURN
|
|
|
END;
|
|
|
IF cls = SymTab.ClReal THEN
|
|
|
(* This qbe accepts only integer/zero literals in "data":
|
|
|
non-zero REALs flush at BeginBody. *)
|
|
|
- DataLine(name, TRUE, "0");
|
|
|
+ DataLine(mang, TRUE, "0");
|
|
|
IF ~IsZeroReal(val) & (nR <= HIGH(rNames)) THEN
|
|
|
- Cpy(rNames[nR], name); Cpy(rVals[nR], val); INC(nR)
|
|
|
+ Cpy(rNames[nR], mang); Cpy(rVals[nR], val); INC(nR)
|
|
|
END
|
|
|
- ELSE DataLine(name, FALSE, val)
|
|
|
+ ELSE DataLine(mang, FALSE, val)
|
|
|
END
|
|
|
END DeclConst;
|
|
|
|
|
|
@@ -370,6 +464,300 @@ PROCEDURE EndModule;
|
|
|
opened := FALSE
|
|
|
END EndModule;
|
|
|
|
|
|
+(* ---------------- functions and calls (step 4.1) ---------------- *)
|
|
|
+(* Module-level procedures only (nested → NoEmit until 4.2).
|
|
|
+ Value params arrive as SSA values and are copied to slots;
|
|
|
+ composite value params arrive as addresses and are copied;
|
|
|
+ VAR params stay addresses. Locals live in stack slots. *)
|
|
|
+
|
|
|
+PROCEDURE LocFind (name: ARRAY OF CHAR): INTEGER;
|
|
|
+ VAR i : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE i < nLoc DO
|
|
|
+ IF SymTab.Equal(locNames[i], name) THEN RETURN VAL(INTEGER, i) END;
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ RETURN -1
|
|
|
+ END LocFind;
|
|
|
+
|
|
|
+PROCEDURE LocAdd (name: ARRAY OF CHAR; tag: INTEGER; rep: ARRAY OF CHAR;
|
|
|
+ cls: CHAR; typ: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ IF noEmit THEN RETURN END;
|
|
|
+ IF nLoc > HIGH(locNames) THEN RETURN END;
|
|
|
+ Cpy(locNames[nLoc], name);
|
|
|
+ locTag[nLoc] := tag;
|
|
|
+ Cpy(locRep[nLoc], rep);
|
|
|
+ locCls[nLoc] := cls;
|
|
|
+ locTyp[nLoc] := typ;
|
|
|
+ INC(nLoc)
|
|
|
+ END LocAdd;
|
|
|
+
|
|
|
+PROCEDURE ResClass (t: INTEGER): CHAR;
|
|
|
+ VAR cls : INTEGER;
|
|
|
+ BEGIN
|
|
|
+ cls := SymTab.ClassOf(t);
|
|
|
+ IF cls = SymTab.ClReal THEN RETURN "d" END;
|
|
|
+ IF (cls = SymTab.ClArray) OR (cls = SymTab.ClSet)
|
|
|
+ OR (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass)
|
|
|
+ OR (cls = SymTab.ClPtr) THEN
|
|
|
+ RETURN "l"
|
|
|
+ END;
|
|
|
+ RETURN "w"
|
|
|
+ END ResClass;
|
|
|
+
|
|
|
+PROCEDURE Mangled (pname: ARRAY OF CHAR; uid: CARDINAL; VAR q: QVal);
|
|
|
+ BEGIN
|
|
|
+ Cpy(q, pname);
|
|
|
+ App(q, "_");
|
|
|
+ AppNum(q, uid)
|
|
|
+ END Mangled;
|
|
|
+
|
|
|
+PROCEDURE AllocLocal (t: INTEGER; VAR slot: QVal);
|
|
|
+(* Stack slot sized for t's inline footprint; arrays/records get
|
|
|
+ full objects + static init. Scalar/pointer/set slots are
|
|
|
+ zero-initialized: QBE rejects reads of never-stored slots, and
|
|
|
+ the frontend emits a dead load for assignment targets (Test2
|
|
|
+ heritage, harmless for zero-initialized globals). Locals match
|
|
|
+ the globals' zero-init convention. *)
|
|
|
+ VAR cls : INTEGER;
|
|
|
+ nb : QVal;
|
|
|
+ BEGIN
|
|
|
+ cls := SymTab.ClassOf(t);
|
|
|
+ NewTemp(slot);
|
|
|
+ Revive;
|
|
|
+ W(" "); W(slot);
|
|
|
+ IF (cls = SymTab.ClArray) THEN
|
|
|
+ IntStr(VAL(INTEGER, HeapSize(t)), nb);
|
|
|
+ W(" =l alloc8 "); WL(nb);
|
|
|
+ InitStack(slot, t)
|
|
|
+ ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
|
|
|
+ IntStr(VAL(INTEGER, SymTab.TypeSize(t)), nb);
|
|
|
+ W(" =l alloc8 "); WL(nb);
|
|
|
+ InitStack(slot, t)
|
|
|
+ ELSIF cls = SymTab.ClSet THEN
|
|
|
+ IntStr(VAL(INTEGER, SymTab.SetWords(t) * 4), nb);
|
|
|
+ W(" =l alloc8 "); WL(nb);
|
|
|
+ SetZero(slot, SymTab.SetWords(t))
|
|
|
+ ELSIF cls = SymTab.ClReal THEN
|
|
|
+ W(" =l alloc8 8"); WL("");
|
|
|
+ W(" stored d_0.0, "); WL(slot)
|
|
|
+ ELSIF cls = SymTab.ClPtr THEN
|
|
|
+ W(" =l alloc8 8"); WL("");
|
|
|
+ W(" storel 0, "); WL(slot)
|
|
|
+ ELSE
|
|
|
+ W(" =l alloc4 4"); WL("");
|
|
|
+ W(" storew 0, "); WL(slot)
|
|
|
+ END
|
|
|
+ END AllocLocal;
|
|
|
+
|
|
|
+PROCEDURE BeginFunc (mangled: ARRAY OF CHAR);
|
|
|
+(* Opens function context; the header is buffered until
|
|
|
+ EndFuncHeader (FORWARD/DefUnit paths discard via AbortFunc). *)
|
|
|
+ BEGIN
|
|
|
+ inFunc := TRUE;
|
|
|
+ nLoc := 0;
|
|
|
+ nPar := 0;
|
|
|
+ funcRes := "w";
|
|
|
+ Cpy(funcName, mangled);
|
|
|
+ hbuf[0] := 0C
|
|
|
+ END BeginFunc;
|
|
|
+
|
|
|
+PROCEDURE SetFuncRes (t: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ funcRes := ResClass(t)
|
|
|
+ END SetFuncRes;
|
|
|
+
|
|
|
+PROCEDURE HApp (s: ARRAY OF CHAR);
|
|
|
+(* Appends to the header buffer (bounded: FormalParams cap it). *)
|
|
|
+ VAR i, j : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE (i <= HIGH(hbuf)) & (hbuf[i] # 0C) DO INC(i) END;
|
|
|
+ j := 0;
|
|
|
+ WHILE (i < HIGH(hbuf)) & (j <= HIGH(s)) & (s[j] # 0C) DO
|
|
|
+ hbuf[i] := s[j]; INC(i); INC(j)
|
|
|
+ END;
|
|
|
+ IF i <= HIGH(hbuf) THEN hbuf[i] := 0C END
|
|
|
+ END HApp;
|
|
|
+
|
|
|
+PROCEDURE FuncParam (name: ARRAY OF CHAR; isVar: BOOLEAN;
|
|
|
+ t: INTEGER): BOOLEAN;
|
|
|
+ VAR c : CHAR;
|
|
|
+ tmp : QVal;
|
|
|
+ buf : ARRAY [0 .. 71] OF CHAR;
|
|
|
+ BEGIN
|
|
|
+ IF noEmit THEN RETURN TRUE END;
|
|
|
+ IF nPar > HIGH(parCls) THEN RETURN FALSE END;
|
|
|
+ IF isVar THEN c := "l" ELSE c := ResClass(t) END;
|
|
|
+ parCls[nPar] := c;
|
|
|
+ NewTemp(tmp);
|
|
|
+ Cpy(parTmp[nPar], tmp);
|
|
|
+ Cpy(parNam[nPar], name);
|
|
|
+ parVar[nPar] := isVar;
|
|
|
+ parTyp[nPar] := t;
|
|
|
+ IF nPar > 0 THEN HApp(", ") END;
|
|
|
+ buf[0] := c; buf[1] := " "; buf[2] := 0C;
|
|
|
+ App(buf, tmp);
|
|
|
+ HApp(buf);
|
|
|
+ INC(nPar);
|
|
|
+ RETURN TRUE
|
|
|
+ END FuncParam;
|
|
|
+
|
|
|
+PROCEDURE EndFuncHeader;
|
|
|
+(* Flushes the buffered header + body label + entry copies. *)
|
|
|
+ VAR i : CARDINAL;
|
|
|
+ slot, nb : QVal;
|
|
|
+ cls : INTEGER;
|
|
|
+ BEGIN
|
|
|
+ W("export function "); Wc(funcRes); W(" $"); W(funcName); W("(");
|
|
|
+ W(hbuf);
|
|
|
+ WL(") {");
|
|
|
+ WL("@start");
|
|
|
+ inBody := TRUE;
|
|
|
+ i := 0;
|
|
|
+ WHILE i < nPar DO
|
|
|
+ cls := SymTab.ClassOf(parTyp[i]);
|
|
|
+ IF parVar[i] THEN
|
|
|
+ LocAdd(parNam[i], 2, parTmp[i], parCls[i], parTyp[i])
|
|
|
+ ELSE
|
|
|
+ AllocLocal(parTyp[i], slot);
|
|
|
+ LocAdd(parNam[i], 0, slot, parCls[i], parTyp[i]);
|
|
|
+ IF cls = SymTab.ClArray THEN
|
|
|
+ CopyArray(slot, parTmp[i], parTyp[i])
|
|
|
+ ELSIF cls = SymTab.ClSet THEN
|
|
|
+ CopySet(slot, parTmp[i],
|
|
|
+ SymTab.SetWords(parTyp[i]), SymTab.SetWords(parTyp[i]))
|
|
|
+ ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
|
|
|
+ CopyRecord(slot, parTmp[i], parTyp[i])
|
|
|
+ ELSIF cls = SymTab.ClReal THEN
|
|
|
+ Revive;
|
|
|
+ W(" stored "); W(parTmp[i]); W(", "); WL(slot)
|
|
|
+ ELSIF cls = SymTab.ClPtr THEN
|
|
|
+ Revive;
|
|
|
+ W(" storel "); W(parTmp[i]); W(", "); WL(slot)
|
|
|
+ ELSE
|
|
|
+ Revive;
|
|
|
+ W(" storew "); W(parTmp[i]); W(", "); WL(slot)
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ INC(i)
|
|
|
+ END
|
|
|
+ END EndFuncHeader;
|
|
|
+
|
|
|
+PROCEDURE AbortFunc;
|
|
|
+(* Discards function context without emitting (DefUnit headings,
|
|
|
+ FORWARD, methods, nested-in-4.1): resets inFunc and params. *)
|
|
|
+ BEGIN
|
|
|
+ inFunc := FALSE;
|
|
|
+ inBody := FALSE;
|
|
|
+ nPar := 0;
|
|
|
+ nLoc := 0
|
|
|
+ END AbortFunc;
|
|
|
+
|
|
|
+PROCEDURE EndFunc (resT: INTEGER);
|
|
|
+ VAR rc : CHAR;
|
|
|
+ BEGIN
|
|
|
+ rc := ResClass(resT);
|
|
|
+ Revive;
|
|
|
+ IF rc = "d" THEN WL(" ret d_0.0")
|
|
|
+ ELSIF rc = "l" THEN WL(" ret 0")
|
|
|
+ ELSE WL(" ret 0")
|
|
|
+ END;
|
|
|
+ WL("}");
|
|
|
+ inFunc := FALSE;
|
|
|
+ inBody := FALSE
|
|
|
+ END EndFunc;
|
|
|
+
|
|
|
+PROCEDURE EmitRet (q: ARRAY OF CHAR; hasVal: BOOLEAN);
|
|
|
+ BEGIN
|
|
|
+ Revive;
|
|
|
+ IF hasVal THEN W(" ret "); WL(q)
|
|
|
+ ELSE WL(" ret 0")
|
|
|
+ END;
|
|
|
+ dead := TRUE
|
|
|
+ END EmitRet;
|
|
|
+
|
|
|
+PROCEDURE CallBegin (mangled: ARRAY OF CHAR; resT: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ IF callDepth <= HIGH(stkName) THEN
|
|
|
+ Cpy(stkName[callDepth], mangled);
|
|
|
+ stkRes[callDepth] := ResClass(resT);
|
|
|
+ stkArg[callDepth][0] := 0C;
|
|
|
+ stkN[callDepth] := 0;
|
|
|
+ INC(callDepth)
|
|
|
+ END
|
|
|
+ END CallBegin;
|
|
|
+
|
|
|
+PROCEDURE CallArg (q: ARRAY OF CHAR; cls: CHAR): BOOLEAN;
|
|
|
+(* Appends "c operand, " to the current level. FALSE when full. *)
|
|
|
+ VAR need, have, i, j, d : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ d := callDepth - 1;
|
|
|
+ IF callDepth = 0 THEN RETURN FALSE END;
|
|
|
+ IF d > HIGH(stkArg) THEN d := HIGH(stkArg) END;
|
|
|
+ need := Len(q) + 5;
|
|
|
+ have := Len(stkArg[d]);
|
|
|
+ IF (stkN[d] >= 64) OR (have + need > HIGH(stkArg[d])) THEN
|
|
|
+ RETURN FALSE
|
|
|
+ END;
|
|
|
+ i := have; j := 0;
|
|
|
+ stkArg[d][i] := cls; INC(i);
|
|
|
+ stkArg[d][i] := " "; INC(i);
|
|
|
+ WHILE q[j] # 0C DO
|
|
|
+ stkArg[d][i] := q[j]; INC(i); INC(j)
|
|
|
+ END;
|
|
|
+ stkArg[d][i] := ","; INC(i);
|
|
|
+ stkArg[d][i] := " "; INC(i);
|
|
|
+ stkArg[d][i] := 0C;
|
|
|
+ INC(stkN[d]);
|
|
|
+ RETURN TRUE
|
|
|
+ END CallArg;
|
|
|
+
|
|
|
+PROCEDURE CallEnd (wantRes: BOOLEAN; VAR q: QVal);
|
|
|
+ VAR i, d : CARDINAL;
|
|
|
+ rc : CHAR;
|
|
|
+ body : ARRAY [0 .. 1023] OF CHAR;
|
|
|
+ BEGIN
|
|
|
+ IF callDepth = 0 THEN Cpy(q, "0"); RETURN END;
|
|
|
+ DEC(callDepth);
|
|
|
+ d := callDepth;
|
|
|
+ IF d > HIGH(stkArg) THEN d := HIGH(stkArg) END;
|
|
|
+ Cpy(funcName, stkName[d]);
|
|
|
+ rc := stkRes[d];
|
|
|
+ i := 0;
|
|
|
+ WHILE (stkArg[d][i] # 0C) & (i < HIGH(body)) DO
|
|
|
+ body[i] := stkArg[d][i]; INC(i)
|
|
|
+ END;
|
|
|
+ IF (i >= 2) & (body[i-2] = ",") THEN
|
|
|
+ body[i-2] := 0C
|
|
|
+ ELSE
|
|
|
+ body[i] := 0C
|
|
|
+ END;
|
|
|
+ Revive;
|
|
|
+ IF wantRes THEN
|
|
|
+ NewTemp(q);
|
|
|
+ W(" "); W(q); W(" ="); Wc(rc)
|
|
|
+ ELSE
|
|
|
+ W(" ")
|
|
|
+ END;
|
|
|
+ W(" call $"); W(funcName); W("("); W(body); WL(")")
|
|
|
+ END CallEnd;
|
|
|
+
|
|
|
+PROCEDURE InitStack (addr: ARRAY OF CHAR; t: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ useStack := TRUE;
|
|
|
+ InitHeap(addr, t);
|
|
|
+ useStack := FALSE
|
|
|
+ END InitStack;
|
|
|
+
|
|
|
+PROCEDURE ArgClass (t: INTEGER): CHAR;
|
|
|
+(* Formal/actual class for call emission. *)
|
|
|
+ BEGIN
|
|
|
+ RETURN ResClass(t)
|
|
|
+ END ArgClass;
|
|
|
+
|
|
|
(* ---------------- temporaries and operators ---------------- *)
|
|
|
|
|
|
PROCEDURE NewTemp (VAR t: QVal);
|
|
|
@@ -379,34 +767,95 @@ PROCEDURE NewTemp (VAR t: QVal);
|
|
|
INC(nTemp)
|
|
|
END NewTemp;
|
|
|
|
|
|
-PROCEDURE LoadVar (name: ARRAY OF CHAR; isReal: BOOLEAN; VAR q: QVal);
|
|
|
+PROCEDURE LocLoad (idx: INTEGER; long: BOOLEAN; VAR q: QVal);
|
|
|
+(* Loads a local entry: slots/data by class (or long for pointers),
|
|
|
+ addr entries via ElemLoad. *)
|
|
|
BEGIN
|
|
|
+ IF locTag[idx] = 2 THEN
|
|
|
+ ElemLoad(locRep[idx], locTyp[idx], q);
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
NewTemp(q);
|
|
|
Revive;
|
|
|
W(" "); W(q);
|
|
|
- IF isReal THEN W(" =d loadd $") ELSE W(" =w loadw $") END;
|
|
|
- WL(name)
|
|
|
+ IF long THEN W(" =l loadl ")
|
|
|
+ ELSIF locCls[idx] = "d" THEN W(" =d loadd ")
|
|
|
+ ELSE W(" =w loadw ")
|
|
|
+ END;
|
|
|
+ IF locTag[idx] = 1 THEN W("$") END;
|
|
|
+ WL(locRep[idx])
|
|
|
+ END LocLoad;
|
|
|
+
|
|
|
+PROCEDURE LocStore (idx: INTEGER; q: ARRAY OF CHAR; long: BOOLEAN);
|
|
|
+(* Stores a local entry: slots/data by class (or long), addr via
|
|
|
+ ElemStore. Data stores are grammar-unreachable (consts). *)
|
|
|
+ BEGIN
|
|
|
+ IF locTag[idx] = 2 THEN
|
|
|
+ ElemStore(locRep[idx], q, locTyp[idx]);
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+ Revive;
|
|
|
+ IF long THEN W(" storel ")
|
|
|
+ ELSIF locCls[idx] = "d" THEN W(" stored ")
|
|
|
+ ELSE W(" storew ")
|
|
|
+ END;
|
|
|
+ W(q); W(", ");
|
|
|
+ IF locTag[idx] = 1 THEN W("$") END;
|
|
|
+ WL(locRep[idx])
|
|
|
+ END LocStore;
|
|
|
+
|
|
|
+PROCEDURE LoadVar (name: ARRAY OF CHAR; isReal: BOOLEAN; VAR q: QVal);
|
|
|
+ VAR idx : INTEGER;
|
|
|
+ BEGIN
|
|
|
+ idx := LocFind(name);
|
|
|
+ IF idx = -1 THEN
|
|
|
+ NewTemp(q);
|
|
|
+ Revive;
|
|
|
+ W(" "); W(q);
|
|
|
+ IF isReal THEN W(" =d loadd $") ELSE W(" =w loadw $") END;
|
|
|
+ WL(name);
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+ LocLoad(idx, FALSE, q)
|
|
|
END LoadVar;
|
|
|
|
|
|
PROCEDURE LoadPtr (name: ARRAY OF CHAR; VAR q: QVal);
|
|
|
+ VAR idx : INTEGER;
|
|
|
BEGIN
|
|
|
- NewTemp(q);
|
|
|
- Revive;
|
|
|
- W(" "); W(q); W(" =l loadl $");
|
|
|
- WL(name)
|
|
|
+ idx := LocFind(name);
|
|
|
+ IF idx = -1 THEN
|
|
|
+ NewTemp(q);
|
|
|
+ Revive;
|
|
|
+ W(" "); W(q); W(" =l loadl $");
|
|
|
+ WL(name);
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+ LocLoad(idx, TRUE, q)
|
|
|
END LoadPtr;
|
|
|
|
|
|
PROCEDURE StoreVar (name: ARRAY OF CHAR; q: ARRAY OF CHAR; isReal: BOOLEAN);
|
|
|
+ VAR idx : INTEGER;
|
|
|
BEGIN
|
|
|
- Revive;
|
|
|
- IF isReal THEN W(" stored ") ELSE W(" storew ") END;
|
|
|
- W(q); W(", $"); WL(name)
|
|
|
+ idx := LocFind(name);
|
|
|
+ IF idx = -1 THEN
|
|
|
+ Revive;
|
|
|
+ IF isReal THEN W(" stored ") ELSE W(" storew ") END;
|
|
|
+ W(q); W(", $"); WL(name);
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+ LocStore(idx, q, FALSE)
|
|
|
END StoreVar;
|
|
|
|
|
|
PROCEDURE StorePtr (name: ARRAY OF CHAR; q: ARRAY OF CHAR);
|
|
|
+ VAR idx : INTEGER;
|
|
|
BEGIN
|
|
|
- Revive;
|
|
|
- W(" storel "); W(q); W(", $"); WL(name)
|
|
|
+ idx := LocFind(name);
|
|
|
+ IF idx = -1 THEN
|
|
|
+ Revive;
|
|
|
+ W(" storel "); W(q); W(", $"); WL(name);
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+ LocStore(idx, q, TRUE)
|
|
|
END StorePtr;
|
|
|
|
|
|
PROCEDURE Op3 (mn: ARRAY OF CHAR; res, l, r: ARRAY OF CHAR;
|
|
|
@@ -1327,7 +1776,10 @@ PROCEDURE NewHeap (t: SymTab.TypeIndex; VAR q: QVal);
|
|
|
NewTemp(q);
|
|
|
Revive;
|
|
|
IntStr(VAL(INTEGER, HeapSize(t)), nb);
|
|
|
- W(" "); W(q); W(" =l call $malloc(l "); W(nb); WL(")")
|
|
|
+ W(" "); W(q);
|
|
|
+ IF useStack THEN W(" =l alloc8 "); W(nb); WL("")
|
|
|
+ ELSE W(" =l call $malloc(l "); W(nb); WL(")")
|
|
|
+ END
|
|
|
END NewHeap;
|
|
|
|
|
|
PROCEDURE FreeHeap (v: ARRAY OF CHAR);
|
|
|
@@ -1393,5 +1845,7 @@ BEGIN
|
|
|
inBody := FALSE;
|
|
|
dead := FALSE;
|
|
|
nTemp := 0; nLab := 0; loopTop := 0; nR := 0; nStr := 0;
|
|
|
- withTop := 0
|
|
|
+ withTop := 0;
|
|
|
+ noEmit := FALSE; inFunc := FALSE; useStack := FALSE;
|
|
|
+ nLoc := 0; nPar := 0; nArg := 0; nn := 0; callDepth := 0
|
|
|
END QbeGen.
|
