|
|
@@ -3307,6 +3307,98 @@ PROCEDURE ElemAddr (base, idx, lo: ARRAY OF CHAR; elemT: INTEGER;
|
|
|
Op3L("add", q, tb, t2)
|
|
|
END ElemAddr;
|
|
|
|
|
|
+PROCEDURE ViewField (view: ARRAY OF CHAR; off: CARDINAL; VAR q: QVal);
|
|
|
+(* q := loadl(view + off), off one of 0,8,16,24,32. *)
|
|
|
+ VAR a, s: QVal;
|
|
|
+ BEGIN
|
|
|
+ NewTemp(a);
|
|
|
+ IntStr(VAL(INTEGER, off), s);
|
|
|
+ Op3L("add", a, view, s);
|
|
|
+ NewTemp(q);
|
|
|
+ Revive;
|
|
|
+ W(" "); W(q); W(" =l loadl "); WL(a)
|
|
|
+ END ViewField;
|
|
|
+
|
|
|
+PROCEDURE ViewIndex (view, idx, lo: ARRAY OF CHAR;
|
|
|
+ nextIsArray: BOOLEAN; VAR q: QVal);
|
|
|
+ VAR t1, stride, off, base, addr, nv, next, tmp: QVal;
|
|
|
+ BEGIN
|
|
|
+ NewTemp(t1);
|
|
|
+ Op3L("sub", t1, idx, lo);
|
|
|
+ ViewField(view, 16, stride);
|
|
|
+ NewTemp(off);
|
|
|
+ Op3L("mul", off, t1, stride);
|
|
|
+ ViewField(view, 24, base);
|
|
|
+ NewTemp(addr);
|
|
|
+ Op3L("add", addr, base, off);
|
|
|
+ IF NOT nextIsArray THEN
|
|
|
+ CopyOp(addr, q)
|
|
|
+ ELSE
|
|
|
+ ViewField(view, 32, next);
|
|
|
+ NewTemp(nv);
|
|
|
+ Revive;
|
|
|
+ W(" "); W(nv); WL(" =l alloc8 40");
|
|
|
+ (* copy count, elemBytes, stride and next from the template *)
|
|
|
+ ViewField(next, 0, tmp);
|
|
|
+ Revive; W(" storel "); W(tmp); W(", "); WL(nv);
|
|
|
+ IntStr(8, off);
|
|
|
+ NewTemp(t1); Op3L("add", t1, nv, off);
|
|
|
+ ViewField(next, 8, tmp);
|
|
|
+ Revive; W(" storel "); W(tmp); W(", "); WL(t1);
|
|
|
+ IntStr(16, off);
|
|
|
+ NewTemp(t1); Op3L("add", t1, nv, off);
|
|
|
+ ViewField(next, 16, tmp);
|
|
|
+ Revive; W(" storel "); W(tmp); W(", "); WL(t1);
|
|
|
+ IntStr(32, off);
|
|
|
+ NewTemp(t1); Op3L("add", t1, nv, off);
|
|
|
+ ViewField(next, 32, tmp);
|
|
|
+ Revive; W(" storel "); W(tmp); W(", "); WL(t1);
|
|
|
+ IntStr(24, off);
|
|
|
+ NewTemp(t1); Op3L("add", t1, nv, off);
|
|
|
+ Revive; W(" storel "); W(addr); W(", "); WL(t1);
|
|
|
+ CopyOp(nv, q)
|
|
|
+ END
|
|
|
+ END ViewIndex;
|
|
|
+
|
|
|
+PROCEDURE ViewToOpen1D (view: ARRAY OF CHAR; ft: INTEGER;
|
|
|
+ VAR q, base, nbytes: QVal);
|
|
|
+ VAR count, elem, total, n, desc, p: QVal;
|
|
|
+ cls: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ ViewField(view, 0, count);
|
|
|
+ ViewField(view, 8, elem);
|
|
|
+ NewTemp(total);
|
|
|
+ Op3L("mul", total, count, elem);
|
|
|
+ cls := SymTab.ClassOf(SymTab.ArrayElem(ft));
|
|
|
+ IF (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte) THEN
|
|
|
+ CopyOp(total, count)
|
|
|
+ END;
|
|
|
+ NewTemp(n);
|
|
|
+ Op3L("add", n, total, "8");
|
|
|
+ NewTemp(desc);
|
|
|
+ W(" "); W(desc); W(" =l call $malloc(l "); W(n); WL(")");
|
|
|
+ Revive;
|
|
|
+ W(" storel "); W(count); W(", "); WL(desc);
|
|
|
+ ViewField(view, 24, base);
|
|
|
+ CopyOp(total, nbytes);
|
|
|
+ NewTemp(p);
|
|
|
+ Op3L("add", p, desc, "8");
|
|
|
+ Revive;
|
|
|
+ W(" "); W(n); W(" =l call $memcpy(l ");
|
|
|
+ W(p); W(", l "); W(base); W(", l "); W(total); WL(")");
|
|
|
+ CopyOp(desc, q)
|
|
|
+ END ViewToOpen1D;
|
|
|
+
|
|
|
+PROCEDURE ViewCopyBack (desc, base, nbytes: ARRAY OF CHAR);
|
|
|
+ VAR p, r: QVal;
|
|
|
+ BEGIN
|
|
|
+ NewTemp(p);
|
|
|
+ Op3L("add", p, desc, "8");
|
|
|
+ NewTemp(r);
|
|
|
+ W(" "); W(r); W(" =l call $memcpy(l ");
|
|
|
+ W(base); W(", l "); W(p); W(", l "); W(nbytes); WL(")")
|
|
|
+ END ViewCopyBack;
|
|
|
+
|
|
|
PROCEDURE ElemLoad (addr: ARRAY OF CHAR; t: INTEGER; VAR q: QVal);
|
|
|
(* Loads one element of (element-)type t. Nested/pointer elements
|
|
|
are addresses (loadl). *)
|
|
|
@@ -3363,6 +3455,45 @@ PROCEDURE ElemStore (addr, v: ARRAY OF CHAR; t: INTEGER);
|
|
|
W(v); W(", "); WL(addr)
|
|
|
END ElemStore;
|
|
|
|
|
|
+PROCEDURE CopyOldNestedToView (dst, src: ARRAY OF CHAR;
|
|
|
+ t: INTEGER; rank: CARDINAL);
|
|
|
+(* Adapt an old nested-descriptor constructor (e.g. names{"Thu","Fri"})
|
|
|
+ into a flat multi-dimensional view payload. Only static constructor
|
|
|
+ sources use this path. *)
|
|
|
+ VAR count, base, esz, row, a, off, off2, child, i, c: QVal;
|
|
|
+ ltop, lbody, lend: QVal;
|
|
|
+ BEGIN
|
|
|
+ IF rank <= 1 THEN
|
|
|
+ ViewField(dst, 24, base);
|
|
|
+ ViewField(dst, 0, count);
|
|
|
+ ViewField(dst, 8, esz);
|
|
|
+ NewTemp(a);
|
|
|
+ Op3L("mul", a, count, esz);
|
|
|
+ NewTemp(off); Op3L("add", off, src, "8");
|
|
|
+ NewTemp(c);
|
|
|
+ W(" "); W(c); W(" =l call $memcpy(l ");
|
|
|
+ W(base); W(", l "); W(off); W(", l "); W(a); WL(")")
|
|
|
+ ELSE
|
|
|
+ ViewField(dst, 0, count);
|
|
|
+ NewTemp(i);
|
|
|
+ W(" "); W(i); W(" =l copy 0"); WL("");
|
|
|
+ NewLabel(ltop); NewLabel(lbody); NewLabel(lend);
|
|
|
+ EmitLabel(ltop);
|
|
|
+ NewTemp(c); Op3("csltl", c, i, count, FALSE);
|
|
|
+ Jnz(c, lbody, lend);
|
|
|
+ EmitLabel(lbody);
|
|
|
+ ViewIndex(dst, i, "0", TRUE, row);
|
|
|
+ NewTemp(off); Op3L("mul", off, i, "8");
|
|
|
+ NewTemp(a); Op3L("add", a, src, "8");
|
|
|
+ NewTemp(off2); Op3L("add", off2, a, off);
|
|
|
+ NewTemp(child); W(" "); W(child); W(" =l loadl "); WL(off2);
|
|
|
+ CopyOldNestedToView(row, child, SymTab.ArrayElem(t), rank - 1);
|
|
|
+ Op3L("add", i, i, "1");
|
|
|
+ Jmp(ltop);
|
|
|
+ EmitLabel(lend)
|
|
|
+ END
|
|
|
+ END CopyOldNestedToView;
|
|
|
+
|
|
|
PROCEDURE CopyArray (dst: ARRAY OF CHAR; src: ARRAY OF CHAR;
|
|
|
t: INTEGER);
|
|
|
(* Whole-array copy with runtime count check + blit. Nested levels
|
|
|
@@ -3377,6 +3508,24 @@ PROCEDURE CopyArray (dst: ARRAY OF CHAR; src: ARRAY OF CHAR;
|
|
|
i, c, de, se, di, si, dd0, doff, sd0, soff: QVal;
|
|
|
ltop, lbody, lend: QVal;
|
|
|
BEGIN
|
|
|
+ IF SymTab.IsMultiArray(t) THEN
|
|
|
+ IF (src[0] = "$") AND (src[1] = "c") AND (src[2] = "t")
|
|
|
+ AND (src[3] = "o") THEN
|
|
|
+ CopyOldNestedToView(dst, src, t, SymTab.ArrayDepth(t))
|
|
|
+ ELSE
|
|
|
+ (* src/dst are ArrayView pointers; copy the flat payload only. *)
|
|
|
+ ViewField(dst, 24, da);
|
|
|
+ ViewField(src, 24, sa);
|
|
|
+ ViewField(dst, 0, n);
|
|
|
+ ViewField(dst, 8, sb);
|
|
|
+ NewTemp(qr);
|
|
|
+ Op3L("mul", qr, n, sb);
|
|
|
+ NewTemp(n);
|
|
|
+ W(" "); W(n); W(" =l call $memcpy(l ");
|
|
|
+ W(da); W(", l "); W(sa); W(", l "); W(qr); WL(")")
|
|
|
+ END;
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
NewTemp(dc);
|
|
|
Revive;
|
|
|
W(" "); W(dc); W(" =l loadl "); WL(dst);
|
|
|
@@ -3427,6 +3576,40 @@ PROCEDURE CopyArray (dst: ARRAY OF CHAR; src: ARRAY OF CHAR;
|
|
|
END
|
|
|
END CopyArray;
|
|
|
|
|
|
+PROCEDURE CopyArrayEx (dst: ARRAY OF CHAR; src: ARRAY OF CHAR;
|
|
|
+ t: INTEGER; dstIsView, srcIsView: BOOLEAN);
|
|
|
+ VAR db, dc, de, sb, sc, se, total, srcData, dstData, r: QVal;
|
|
|
+ BEGIN
|
|
|
+ IF SymTab.IsMultiArray(t) THEN
|
|
|
+ CopyArray(dst, src, t); RETURN
|
|
|
+ END;
|
|
|
+ IF dstIsView THEN
|
|
|
+ ViewField(dst, 24, db);
|
|
|
+ ViewField(dst, 0, dc);
|
|
|
+ ViewField(dst, 8, de);
|
|
|
+ NewTemp(total); Op3L("mul", total, dc, de);
|
|
|
+ IF srcIsView THEN
|
|
|
+ ViewField(src, 24, sb)
|
|
|
+ ELSE
|
|
|
+ NewTemp(srcData); Op3L("add", srcData, src, "8"); CopyOp(srcData, sb)
|
|
|
+ END;
|
|
|
+ NewTemp(r);
|
|
|
+ W(" "); W(r); W(" =l call $memcpy(l ");
|
|
|
+ W(db); W(", l "); W(sb); W(", l "); W(total); WL(")")
|
|
|
+ ELSIF srcIsView THEN
|
|
|
+ ViewField(src, 24, sb);
|
|
|
+ ViewField(src, 0, sc);
|
|
|
+ ViewField(src, 8, se);
|
|
|
+ NewTemp(total); Op3L("mul", total, sc, se);
|
|
|
+ NewTemp(dstData); Op3L("add", dstData, dst, "8");
|
|
|
+ NewTemp(r);
|
|
|
+ W(" "); W(r); W(" =l call $memcpy(l ");
|
|
|
+ W(dstData); W(", l "); W(sb); W(", l "); W(total); WL(")")
|
|
|
+ ELSE
|
|
|
+ CopyArray(dst, src, t)
|
|
|
+ END
|
|
|
+ END CopyArrayEx;
|
|
|
+
|
|
|
PROCEDURE DeclStr (text: ARRAY OF CHAR; VAR q: QVal);
|
|
|
(* Records a quoted literal for top-level emission at EndModule and
|
|
|
returns its address operand ($strN). Data definitions may only
|
|
|
@@ -3646,12 +3829,59 @@ PROCEDURE FlushStrings;
|
|
|
END
|
|
|
END FlushStrings;
|
|
|
|
|
|
+PROCEDURE DeclMultiArr (name: ARRAY OF CHAR; t: INTEGER);
|
|
|
+(* Static fixed multi-dimensional array: a chain of view descriptors
|
|
|
+ plus one contiguous payload block. One-dimensional arrays still use
|
|
|
+ ArrData. *)
|
|
|
+ VAR rank, k, count, stride, payload: CARDINAL;
|
|
|
+ cur: SymTab.TypeIndex;
|
|
|
+ lab, base, nxt, bv, sv, pv: QVal;
|
|
|
+ BEGIN
|
|
|
+ IF NOT opened THEN RETURN END;
|
|
|
+ rank := SymTab.ArrayDepth(t);
|
|
|
+ IF rank < 2 THEN ArrData(name, t); RETURN END;
|
|
|
+ payload := SymTab.ArrayPayloadSize(t);
|
|
|
+ cur := t;
|
|
|
+ k := 0;
|
|
|
+ WHILE k < rank DO
|
|
|
+ count := SymTab.ArrayLen(cur);
|
|
|
+ stride := SymTab.ArrayStride(t, k);
|
|
|
+ Cpy(lab, name);
|
|
|
+ IF k > 0 THEN
|
|
|
+ App(lab, "_t"); IntStr(VAL(INTEGER, k), bv); App(lab, bv)
|
|
|
+ END;
|
|
|
+ IF k = 0 THEN
|
|
|
+ Cpy(base, "$"); App(base, name); App(base, "_data")
|
|
|
+ ELSE
|
|
|
+ Cpy(base, "0")
|
|
|
+ END;
|
|
|
+ IF k + 1 < rank THEN
|
|
|
+ Cpy(nxt, "$"); App(nxt, name); App(nxt, "_t");
|
|
|
+ IntStr(VAL(INTEGER, k + 1), bv); App(nxt, bv)
|
|
|
+ ELSE
|
|
|
+ Cpy(nxt, "0")
|
|
|
+ END;
|
|
|
+ W("data $"); W(lab); W(" = { l ");
|
|
|
+ IntStr(VAL(INTEGER, count), bv); W(bv);
|
|
|
+ W(", l "); IntStr(VAL(INTEGER, stride), sv); W(sv);
|
|
|
+ W(", l "); W(sv);
|
|
|
+ W(", l "); W(base);
|
|
|
+ W(", l "); W(nxt); WL(" }");
|
|
|
+ cur := SymTab.ArrayElem(cur);
|
|
|
+ INC(k)
|
|
|
+ END;
|
|
|
+ W("data $"); W(name); W("_data = { z ");
|
|
|
+ IntStr(VAL(INTEGER, payload), pv); W(pv); WL(" }")
|
|
|
+ END DeclMultiArr;
|
|
|
+
|
|
|
PROCEDURE DeclArr (name: ARRAY OF CHAR; t: INTEGER);
|
|
|
BEGIN
|
|
|
IF SymTab.IsOpenArray(t) OR (SymTab.ArrayDepth(t) = 0) THEN
|
|
|
DataLine(name, FALSE, "0"); RETURN
|
|
|
END;
|
|
|
- ArrData(name, t)
|
|
|
+ IF SymTab.IsMultiArray(t) THEN DeclMultiArr(name, t)
|
|
|
+ ELSE ArrData(name, t)
|
|
|
+ END
|
|
|
END DeclArr;
|
|
|
|
|
|
(* ---------------- array constructors (step: `T{...}`) ---------------- *)
|
|
|
@@ -4171,7 +4401,9 @@ PROCEDURE HeapSize (t: INTEGER): CARDINAL;
|
|
|
n: CARDINAL;
|
|
|
BEGIN
|
|
|
cls := SymTab.ClassOf(t);
|
|
|
- IF cls = SymTab.ClArray THEN
|
|
|
+ IF (cls = SymTab.ClArray) AND SymTab.IsMultiArray(t) THEN
|
|
|
+ RETURN SymTab.ArrayDepth(t) * 40 + SymTab.ArrayPayloadSize(t)
|
|
|
+ ELSIF cls = SymTab.ClArray THEN
|
|
|
n := SymTab.ArrayLen(t) * ElemSize(t);
|
|
|
IF SymTab.IsCharArray(t) THEN n := n + 1 END;
|
|
|
IF SymTab.IsUCharArray(t) THEN n := n + 4 END;
|
|
|
@@ -4198,6 +4430,56 @@ PROCEDURE FreeHeap (v: ARRAY OF CHAR);
|
|
|
W(" call $free(l "); W(v); WL(")")
|
|
|
END FreeHeap;
|
|
|
|
|
|
+PROCEDURE InitMultiHeap (addr: ARRAY OF CHAR; t: SymTab.TypeIndex);
|
|
|
+(* Initialise the per-level view chain and zero the flat payload. *)
|
|
|
+ VAR rank, k, count, stride, payload: CARDINAL;
|
|
|
+ cur: SymTab.TypeIndex;
|
|
|
+ v, a, nb, off, pay: QVal;
|
|
|
+ BEGIN
|
|
|
+ rank := SymTab.ArrayDepth(t);
|
|
|
+ payload := SymTab.ArrayPayloadSize(t);
|
|
|
+ cur := t;
|
|
|
+ k := 0;
|
|
|
+ WHILE k < rank DO
|
|
|
+ IntStr(VAL(INTEGER, k * 40), off);
|
|
|
+ NewTemp(v); Op3L("add", v, addr, off);
|
|
|
+ count := SymTab.ArrayLen(cur);
|
|
|
+ IntStr(VAL(INTEGER, count), nb);
|
|
|
+ Revive; W(" storel "); W(nb); W(", "); WL(v);
|
|
|
+ stride := SymTab.ArrayStride(t, k);
|
|
|
+ IntStr(VAL(INTEGER, stride), nb);
|
|
|
+ NewTemp(a); Op3L("add", a, v, "8");
|
|
|
+ Revive; W(" storel "); W(nb); W(", "); WL(a);
|
|
|
+ NewTemp(a); Op3L("add", a, v, "16");
|
|
|
+ Revive; W(" storel "); W(nb); W(", "); WL(a);
|
|
|
+ IF k = 0 THEN
|
|
|
+ IntStr(VAL(INTEGER, rank * 40), off);
|
|
|
+ NewTemp(pay); Op3L("add", pay, addr, off);
|
|
|
+ NewTemp(a); Op3L("add", a, v, "24");
|
|
|
+ Revive; W(" storel "); W(pay); W(", "); WL(a)
|
|
|
+ ELSE
|
|
|
+ NewTemp(a); Op3L("add", a, v, "24");
|
|
|
+ Revive; W(" storel 0, "); WL(a)
|
|
|
+ END;
|
|
|
+ IF k + 1 < rank THEN
|
|
|
+ IntStr(VAL(INTEGER, (k + 1) * 40), off);
|
|
|
+ NewTemp(a); Op3L("add", a, addr, off);
|
|
|
+ NewTemp(nb); Op3L("add", nb, v, "32");
|
|
|
+ Revive; W(" storel "); W(a); W(", "); WL(nb)
|
|
|
+ ELSE
|
|
|
+ NewTemp(a); Op3L("add", a, v, "32");
|
|
|
+ Revive; W(" storel 0, "); WL(a)
|
|
|
+ END;
|
|
|
+ cur := SymTab.ArrayElem(cur);
|
|
|
+ INC(k)
|
|
|
+ END;
|
|
|
+ IntStr(VAL(INTEGER, rank * 40), off);
|
|
|
+ NewTemp(pay); Op3L("add", pay, addr, off);
|
|
|
+ IntStr(VAL(INTEGER, payload), nb);
|
|
|
+ NewTemp(a); W(" "); W(a); W(" =l call $memset(l ");
|
|
|
+ W(pay); W(", w 0, l "); W(nb); WL(")")
|
|
|
+ END InitMultiHeap;
|
|
|
+
|
|
|
PROCEDURE InitHeap (addr: ARRAY OF CHAR; t: SymTab.TypeIndex);
|
|
|
VAR cls, ecls: INTEGER;
|
|
|
n, i: CARDINAL;
|
|
|
@@ -4215,7 +4497,9 @@ PROCEDURE InitHeap (addr: ARRAY OF CHAR; t: SymTab.TypeIndex);
|
|
|
Revive;
|
|
|
W(" storel "); W(eb); W(", "); WL(ea)
|
|
|
END;
|
|
|
- IF cls = SymTab.ClArray THEN
|
|
|
+ IF (cls = SymTab.ClArray) AND SymTab.IsMultiArray(t) THEN
|
|
|
+ InitMultiHeap(addr, t)
|
|
|
+ ELSIF cls = SymTab.ClArray THEN
|
|
|
IntStr(VAL(INTEGER, SymTab.ArrayLen(t)), nb);
|
|
|
Revive;
|
|
|
W(" storel "); W(nb); W(", "); WL(addr);
|
