Explorar el Código

lower L5 (core): records, arrays, field/index designators, aggregate copies

Unified the expression/designator walk (LowerExprFull with an address
mode) so selectors are handled once:
- LowerDesign walks base + .field / [i] / ^ (mirrors the grammar's
  Design), leaving an address with sfx=TRUE for selectors.
- FinalLoad applies Fact's trailing scalar/pointer load; aggregates keep
  the address.
- Assignment store covers aggregate targets: CopyRecord, CopyArray,
  CopySet, ElemStore/StoreVar, pointer stores, long/real conversions.

CanLower now accepts TYPE declarations and aggregate VAR types
(CanType/CanDesign); t_lower5 exercises records, arrays, array-of-records
and record/array copies, byte-matching the legacy image.

Suite 185/185; FIXPOINT OK (stage2 == stage3, 3,218,893 bytes).
Eric Streit hace 6 días
padre
commit
ab507e2452
Se han modificado 3 ficheros con 227 adiciones y 13 borrados
  1. 1 0
      compiler/run_tests.sh
  2. 201 13
      compiler/src/Lower.mod
  3. 25 0
      compiler/tests/t_lower5.mod

+ 1 - 0
compiler/run_tests.sh

@@ -469,6 +469,7 @@ lower_ok t_arith.mod
 lower_ok t_lower1.mod
 lower_ok t_lower2.mod
 lower_ok t_lower3.mod
+lower_ok t_lower5.mod
 
 # --- step 7 gate: compiler sources free of gm2-only imports.
 #     FileIO is the last module to port (see docs/summary_step7.md);

+ 201 - 13
compiler/src/Lower.mod

@@ -266,12 +266,65 @@ PROCEDURE CanCallArgs (n: AST.Node): BOOLEAN;
     RETURN TRUE
   END CanCallArgs;
 
+PROCEDURE CanType (t: SymTab.TypeIndex): BOOLEAN;
+  VAR cls: INTEGER;
+  BEGIN
+    IF t = SymTab.InvalidType THEN RETURN FALSE END;
+    cls := SymTab.ClassOf(t);
+    RETURN (cls = SymTab.ClInt) OR (cls = SymTab.ClBool)
+        OR (cls = SymTab.ClChar) OR (cls = SymTab.ClUChar)
+        OR (cls = SymTab.ClEnum) OR (cls = SymTab.ClReal)
+        OR (cls = SymTab.ClLong) OR (cls = SymTab.ClArray)
+        OR (cls = SymTab.ClSet) OR (cls = SymTab.ClRecord)
+        OR (cls = SymTab.ClPtr)
+  END CanType;
+
+PROCEDURE CanDesign (n: AST.Node): BOOLEAN;
+  VAR nm, fn: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex;
+      i: CARDINAL; sel: AST.Node;
+  BEGIN
+    IF AST.Kind(n) # AST.NkDesignator THEN RETURN FALSE END;
+    IF AST.Kind(AST.Child(n, 0)) # AST.NkIdent THEN RETURN FALSE END;
+    Name(AST.Child(n, 0), nm);
+    IF NOT Resolve(nm, k, t) THEN RETURN FALSE END;
+    IF (k # SymTab.KindVar) AND (k # SymTab.KindParam)
+       AND (k # SymTab.KindConst) THEN RETURN FALSE END;
+    IF NOT CanType(t) THEN RETURN FALSE END;
+    i := 1;
+    WHILE i < AST.NChild(n) DO
+      sel := AST.Child(n, i);
+      IF AST.Op(sel) = AST.SelField THEN
+        IF (t = SymTab.InvalidType)
+           OR ((SymTab.ClassOf(t) # SymTab.ClRecord)
+               AND (SymTab.ClassOf(t) # SymTab.ClClass)) THEN
+          RETURN FALSE
+        END;
+        Name(AST.Child(sel, 0), fn);
+        IF NOT SymTab.FieldExists(t, fn) THEN RETURN FALSE END;
+        t := SymTab.FieldType(t, fn)
+      ELSIF AST.Op(sel) = AST.SelIndex THEN
+        IF (t = SymTab.InvalidType)
+           OR (SymTab.ClassOf(t) # SymTab.ClArray) THEN RETURN FALSE END;
+        IF NOT CanExpr(AST.Child(sel, 0)) THEN RETURN FALSE END;
+        t := SymTab.ArrayElem(t)
+      ELSIF AST.Op(sel) = AST.SelDeref THEN
+        IF (t = SymTab.InvalidType)
+           OR (SymTab.ClassOf(t) # SymTab.ClPtr) THEN RETURN FALSE END;
+        t := SymTab.PtrBase(t)
+      ELSE RETURN FALSE
+      END;
+      IF NOT CanType(t) THEN RETURN FALSE END;
+      INC(i)
+    END;
+    RETURN TRUE
+  END CanDesign;
+
 PROCEDURE CanExpr (n: AST.Node): BOOLEAN;
   VAR op: INTEGER;
   BEGIN
     IF n = AST.NoNode THEN RETURN FALSE END;
     IF AST.Kind(n) = AST.NkIntLit THEN RETURN TRUE END;
-    IF AST.Kind(n) = AST.NkDesignator THEN RETURN IsSimpleScalar(n) END;
+    IF AST.Kind(n) = AST.NkDesignator THEN RETURN CanDesign(n) END;
     IF AST.Kind(n) = AST.NkCall THEN RETURN IsCall(n) AND CanCallArgs(n) END;
     IF AST.Kind(n) = AST.NkUnary THEN
       op := AST.Op(n);
@@ -302,7 +355,7 @@ PROCEDURE CanStmt (n: AST.Node): BOOLEAN;
       RETURN TRUE
     END;
     IF k = AST.NkAssign THEN
-      RETURN IsSimpleScalar(AST.Child(n, 0)) AND CanExpr(AST.Child(n, 1))
+      RETURN CanDesign(AST.Child(n, 0)) AND CanExpr(AST.Child(n, 1))
     END;
     IF k = AST.NkIf THEN
       RETURN CanExpr(AST.Child(n, 0)) AND CanStmt(AST.Child(n, 1))
@@ -339,8 +392,9 @@ PROCEDURE CanStmt (n: AST.Node): BOOLEAN;
 PROCEDURE CanDecl (c: AST.Node): BOOLEAN;
   VAR i: CARDINAL;
   BEGIN
+    IF AST.Kind(c) = AST.NkTypeDecl THEN RETURN TRUE END;
     IF AST.Kind(c) = AST.NkVarDecl THEN
-      IF NOT IsScalarClass(SymTab.ClassOf(AST.Ty(c))) THEN RETURN FALSE END;
+      IF NOT CanType(AST.Ty(c)) THEN RETURN FALSE END;
       IF AST.NChild(c) < 1 THEN RETURN FALSE END;
       i := 0;
       WHILE i < AST.NChild(c) DO
@@ -401,10 +455,29 @@ PROCEDURE CanProc (proc: AST.Node): BOOLEAN;
     END;
     RETURN CanDecls(AST.Child(proc, 2)) AND CanStmt(AST.Child(proc, 1))
   END CanProc;
+PROCEDURE FinalLoad (t: SymTab.TypeIndex; sfx: BOOLEAN; VAR q: QbeGen.QVal);
+(* Fact's final load after a designator/result suffix: scalars/pointers
+   are loaded from their address; aggregates keep the address. *)
+  VAR cls: INTEGER; q2: QbeGen.QVal;
+  BEGIN
+    IF NOT sfx THEN RETURN END;
+    IF t = SymTab.InvalidType THEN QbeGen.CopyOp("0", q); RETURN END;
+    cls := SymTab.ClassOf(t);
+    IF (cls # SymTab.ClRecord) AND (cls # SymTab.ClSet)
+       AND (cls # SymTab.ClArray) AND (cls # SymTab.ClClass) THEN
+      QbeGen.ElemLoad(q, t, q2); QbeGen.CopyOp(q2, q)
+    END
+  END FinalLoad;
+
 PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
                        VAR q: QbeGen.QVal; VAR qn: SymTab.Name;
                        VAR sfx: BOOLEAN);
-  VAR nm: SymTab.Name; cv: QbeGen.QVal; cls: INTEGER;
+(* Base ident then selectors (mirrors the grammar's Design).  Leaves the
+   address in q with sfx=TRUE for selectors; base vars/consts load. *)
+  VAR nm, fn: SymTab.Name; cv: QbeGen.QVal; cls, op: INTEGER;
+      i: CARDINAL; sel: AST.Node; eT, it: SymTab.TypeIndex;
+      iq, ql, qlo, qhi, qe: QbeGen.QVal;
+      lo, hi, fo: INTEGER; isOpen: BOOLEAN;
   BEGIN
     Name(AST.Child(n, 0), nm);
     QbeGen.CopyOp(nm, qn);
@@ -417,14 +490,78 @@ PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
         t := SymTab.BoolType(); QbeGen.CopyOp("1", q)
       ELSIF SymTab.Equal(nm, "FALSE") THEN
         t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
+      ELSIF SymTab.Equal(nm, "NIL") THEN
+        QbeGen.CopyOp("0", q)
       ELSIF SymTab.GetSymVal(nm, cv) AND QbeGen.IsImm(cv) THEN
         QbeGen.CopyOp(cv, q)
       ELSE QbeGen.CopyOp("0", q)
       END
     ELSIF (k = SymTab.KindVar) OR (k = SymTab.KindParam) THEN
       cls := SymTab.ClassOf(t);
-      QbeGen.LoadVar(nm, cls = SymTab.ClReal, q)
+      IF (cls = SymTab.ClInt) OR (cls = SymTab.ClBool)
+         OR (cls = SymTab.ClChar) OR (cls = SymTab.ClUChar)
+         OR (cls = SymTab.ClEnum) OR (cls = SymTab.ClReal) THEN
+        QbeGen.LoadVar(nm, cls = SymTab.ClReal, q)
+      ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc) THEN
+        QbeGen.LoadPtr(nm, q)
+      ELSIF cls = SymTab.ClLong THEN
+        QbeGen.LoadLong(nm, q)
+      ELSE QbeGen.AddrOf(nm, q)
+      END
     ELSE QbeGen.CopyOp("0", q)
+    END;
+    i := 1;
+    WHILE i < AST.NChild(n) DO
+      sel := AST.Child(n, i);
+      op := AST.Op(sel);
+      IF op = AST.SelField THEN
+        Name(AST.Child(sel, 0), fn);
+        IF t = SymTab.InvalidType THEN
+        ELSIF NOT SymTab.FieldExists(t, fn) THEN t := SymTab.InvalidType
+        ELSE
+          fo := SymTab.FieldOffset(t, fn);
+          t := SymTab.FieldType(t, fn);
+          QbeGen.FieldAddr(q, fo, qe);
+          QbeGen.CopyOp(qe, q);
+          sfx := TRUE
+        END
+      ELSIF op = AST.SelIndex THEN
+        LowerExpr(AST.Child(sel, 0), it, iq);
+        IF t = SymTab.InvalidType THEN
+        ELSE
+          QbeGen.WidenIndex(iq, ql);
+          isOpen := SymTab.IsOpenArray(t);
+          IF isOpen THEN
+            QbeGen.CopyOp("0", qlo);
+            IF SymTab.IsCharArray(t) OR SymTab.IsUCharArray(t) THEN
+              QbeGen.OpenHiChar(q, qhi)
+            ELSE QbeGen.OpenHi(q, qhi)
+            END
+          ELSE
+            lo := SymTab.ArrayLo(t); hi := SymTab.ArrayHi(t);
+            IF SymTab.IsCharArray(t) OR SymTab.IsUCharArray(t) THEN
+              hi := hi + 1
+            END;
+            QbeGen.IntStr(lo, qlo); QbeGen.IntStr(hi, qhi)
+          END;
+          QbeGen.CheckRange(ql, qlo, qhi);
+          eT := SymTab.ArrayElem(t);
+          QbeGen.ElemAddr(q, ql, qlo, t, qe);
+          IF SymTab.ClassOf(eT) = SymTab.ClArray THEN
+            QbeGen.ElemLoad(qe, eT, q)
+          ELSE QbeGen.CopyOp(qe, q)
+          END;
+          t := eT; sfx := TRUE
+        END
+      ELSIF op = AST.SelDeref THEN
+        IF t = SymTab.InvalidType THEN
+        ELSIF SymTab.ClassOf(t) # SymTab.ClPtr THEN t := SymTab.InvalidType
+        ELSE
+          IF sfx THEN QbeGen.ElemLoad(q, t, qe); QbeGen.CopyOp(qe, q) END;
+          t := SymTab.PtrBase(t); sfx := TRUE
+        END
+      END;
+      INC(i)
     END
   END LowerDesign;
 
@@ -465,13 +602,21 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
     END
   END LowerCall;
 
-PROCEDURE LowerExpr (n: AST.Node; VAR t: SymTab.TypeIndex;
-                     VAR q: QbeGen.QVal);
+PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex;
+                         VAR q: QbeGen.QVal; VAR k: INTEGER;
+                         VAR qn: SymTab.Name; VAR sfx: BOOLEAN;
+                         asAddr: BOOLEAN);
   VAR t2: SymTab.TypeIndex; q2, qt, qf, qs, qr: QbeGen.QVal;
       lNext, lFalse, lTrue, lDone: QbeGen.QVal;
-      kind, op, k, rop: INTEGER; qn: SymTab.Name; sfx: BOOLEAN;
+      kind, op, rop: INTEGER;
       folded, isR: BOOLEAN;
   BEGIN
+    IF AST.Kind(n) = AST.NkDesignator THEN
+      LowerDesign(n, t, k, q, qn, sfx);
+      IF NOT asAddr THEN FinalLoad(t, sfx, q) END;
+      RETURN
+    END;
+    k := -1; qn[0] := CHR(0); sfx := FALSE;
     IF AST.Kind(n) = AST.NkIntLit THEN
       Name(n, qn); QbeGen.NormInt(qn, q); t := SymTab.IntType()
     ELSIF AST.Kind(n) = AST.NkDesignator THEN
@@ -562,17 +707,24 @@ PROCEDURE LowerExpr (n: AST.Node; VAR t: SymTab.TypeIndex;
         t := SymTab.IntType()
       END
     END
+  END LowerExprFull;
+
+PROCEDURE LowerExpr (n: AST.Node; VAR t: SymTab.TypeIndex;
+                     VAR q: QbeGen.QVal);
+  VAR k: INTEGER; qn: SymTab.Name; sfx: BOOLEAN;
+  BEGIN
+    LowerExprFull(n, t, q, k, qn, sfx, FALSE)
   END LowerExpr;
 
 PROCEDURE LowerStmt (seq: AST.Node);
   VAR i: CARDINAL; c, els, by: AST.Node; k: INTEGER;
       t, t2, dt, et: SymTab.TypeIndex;
       q, q2, qt, qf, qd, qe: QbeGen.QVal;
-      qlo, qhi, qk, qb: QbeGen.QVal;
+      qlo, qhi, qk, qb, ql: QbeGen.QVal;
       lTop, lBody, lEnd, lThen, lElse, lNext, lFalse, lDone, lx: QbeGen.QVal;
       qn, lv: SymTab.Name;
       kind, op, rop, cls: INTEGER;
-      sfx, folded, isR, conv, hasElse: BOOLEAN;
+      sfx, folded, isR, conv, wconv, hasElse: BOOLEAN;
   BEGIN
     IF seq = AST.NoNode THEN RETURN END;
     k := AST.Kind(seq);
@@ -587,9 +739,45 @@ PROCEDURE LowerStmt (seq: AST.Node);
       LowerExpr(AST.Child(seq, 1), et, qe);
       isR := (dt # SymTab.InvalidType) AND (SymTab.ClassOf(dt) = SymTab.ClReal);
       conv := isR AND SymTab.IsIntFamily(et);
-      IF (cls = SymTab.KindVar) OR (cls = SymTab.KindParam) THEN
-        IF SymTab.IsLongFamily(dt) THEN QbeGen.StoreLong(qn, qe)
-        ELSIF conv THEN QbeGen.ConvIR(qe, qd); QbeGen.StoreVar(qn, qd, TRUE)
+      wconv := (dt # SymTab.InvalidType) AND SymTab.IsLongFamily(dt)
+               AND SymTab.IsIntFamily(et);
+      IF sfx OR (cls = SymTab.KindField) THEN
+        IF SymTab.ClassOf(dt) = SymTab.ClArray THEN
+          IF (et # SymTab.InvalidType) AND (SymTab.ClassOf(et) = SymTab.ClUStr)
+             AND SymTab.IsUCharArray(dt) THEN QbeGen.UAssign(qd, qe)
+          ELSIF SymTab.StrCompat(dt, et) THEN QbeGen.StrAssign(qd, qe)
+          ELSE QbeGen.CopyArray(qd, qe, dt)
+          END
+        ELSIF SymTab.ClassOf(dt) = SymTab.ClSet THEN
+          QbeGen.CopySet(qd, qe, SymTab.SetWords(dt), SymTab.SetWords(et))
+        ELSIF SymTab.ClassOf(dt) = SymTab.ClRecord THEN
+          QbeGen.CopyRecord(qd, qe, dt)
+        ELSIF SymTab.IsLongFamily(dt) THEN
+          IF wconv THEN QbeGen.WidenLong(qe, ql); QbeGen.ElemStore(qd, ql, dt)
+          ELSE QbeGen.ElemStore(qd, qe, dt)
+          END
+        ELSIF conv THEN QbeGen.ConvIR(qe, qt); QbeGen.ElemStore(qd, qt, dt)
+        ELSE QbeGen.ElemStore(qd, qe, dt)
+        END
+      ELSE
+        IF SymTab.ClassOf(dt) = SymTab.ClArray THEN
+          IF (et # SymTab.InvalidType) AND (SymTab.ClassOf(et) = SymTab.ClUStr)
+             AND SymTab.IsUCharArray(dt) THEN QbeGen.UAssign(qd, qe)
+          ELSIF SymTab.StrCompat(dt, et) THEN QbeGen.StrAssign(qd, qe)
+          ELSE QbeGen.CopyArray(qd, qe, dt)
+          END
+        ELSIF SymTab.ClassOf(dt) = SymTab.ClSet THEN
+          QbeGen.CopySet(qd, qe, SymTab.SetWords(dt), SymTab.SetWords(et))
+        ELSIF SymTab.ClassOf(dt) = SymTab.ClRecord THEN
+          QbeGen.CopyRecord(qd, qe, dt)
+        ELSIF (SymTab.ClassOf(dt) = SymTab.ClPtr)
+           OR (SymTab.ClassOf(dt) = SymTab.ClProc) THEN
+          QbeGen.StorePtr(qn, qe)
+        ELSIF SymTab.IsLongFamily(dt) THEN
+          IF wconv THEN QbeGen.WidenLong(qe, ql); QbeGen.StoreLong(qn, ql)
+          ELSE QbeGen.StoreLong(qn, qe)
+          END
+        ELSIF conv THEN QbeGen.ConvIR(qe, qt); QbeGen.StoreVar(qn, qt, TRUE)
         ELSE QbeGen.StoreVar(qn, qe, isR)
         END
       END

+ 25 - 0
compiler/tests/t_lower5.mod

@@ -0,0 +1,25 @@
+MODULE TLower5;
+(* Lower slice L5: records, arrays, field/index designators, aggregate
+   copies (record/array), array-of-records.  Exit 44. *)
+TYPE
+  Rec  = RECORD a, b: INTEGER; END;
+  Vec  = ARRAY [0..3] OF INTEGER;
+  Recs = ARRAY [0..2] OF Rec;
+VAR
+  r, r2 : Rec;
+  v, w  : Vec;
+  m     : Recs;
+  i     : INTEGER;
+  ExitCode : INTEGER;
+BEGIN
+  r.a := 40;
+  r.b := 2;
+  r2 := r;
+  v[0] := 1;
+  v[1] := 2;
+  w := v;
+  m[1].a := 5;
+  m[1].b := 6;
+  i := r2.a + r2.b + w[0] + w[1] + m[1].a + m[1].b - 12;
+  ExitCode := i
+END TLower5.