Просмотр исходного кода

lower L4: builtins, CASE, WITH

- Builtins (Fact/AssOrCall): ABS CAP CHR ORD SIZE/TSIZE MIN/MAX SHIFT
  ROTATE ADR, statement forms INC/DEC INCL/EXCL NEW/DISPOSE; dispatched
  by callee name before user calls.
- CASE: compare-chain lowering mirroring CaseStat/CaseAlt/CaseLabel
  (value and lo..hi range labels, ELSE arm).
- WITH: a with-scope stack (withRec/withTop) shared by the CanLower gate
  and the walk; bare field idents resolve via WithField + QbeGen.TopWith.

Tests t_lower4 (builtins/sets/pointers), t_lower4case, t_lower4with all
byte-match.  Suite 188/188; FIXPOINT OK (stage2 == stage3, 3,279,781
bytes).
Eric Streit 1 неделя назад
Родитель
Сommit
53a1d15649

+ 3 - 0
compiler/run_tests.sh

@@ -469,6 +469,9 @@ lower_ok t_arith.mod
 lower_ok t_lower1.mod
 lower_ok t_lower2.mod
 lower_ok t_lower3.mod
+lower_ok t_lower4.mod
+lower_ok t_lower4case.mod
+lower_ok t_lower4with.mod
 lower_ok t_lower5.mod
 
 # --- step 7 gate: compiler sources free of gm2-only imports.

+ 365 - 9
compiler/src/Lower.mod

@@ -32,6 +32,8 @@ VAR
   parVar   : ARRAY [0 .. MaxProc * MaxPar - 1] OF BOOLEAN;
   parName  : ARRAY [0 .. MaxProc * MaxPar * 64 - 1] OF CHAR;
   nProcs   : CARDINAL;
+  withRec  : ARRAY [0 .. 15] OF SymTab.TypeIndex;
+  withTop  : CARDINAL;
 
 PROCEDURE CopyN (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR);
   VAR i: CARDINAL;
@@ -171,6 +173,28 @@ PROCEDURE ParamInfo (nm: ARRAY OF CHAR; i: CARDINAL;
     RETURN TRUE
   END ParamInfo;
 
+PROCEDURE WithField (nm: ARRAY OF CHAR; VAR k: INTEGER;
+                     VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal): BOOLEAN;
+(* Resolves a bare ident as a field of an open WITH record (innermost
+   first), leaving the field address in q and k=KindField. *)
+  VAR wt: CARDINAL; fo: INTEGER; qb: QbeGen.QVal;
+  BEGIN
+    wt := withTop;
+    WHILE wt > 0 DO
+      DEC(wt);
+      IF SymTab.FieldExists(withRec[wt], nm) THEN
+        t := SymTab.FieldType(withRec[wt], nm);
+        fo := SymTab.FieldOffset(withRec[wt], nm);
+        k := SymTab.KindField;
+        IF QbeGen.TopWith(qb) THEN QbeGen.FieldAddr(qb, fo, q)
+        ELSE QbeGen.CopyOp("0", q)
+        END;
+        RETURN TRUE
+      END
+    END;
+    RETURN FALSE
+  END WithField;
+
 PROCEDURE Name (n: AST.Node; VAR s: ARRAY OF CHAR);
   BEGIN
     IF n = AST.NoNode THEN s[0] := CHR(0)
@@ -279,6 +303,46 @@ PROCEDURE CanType (t: SymTab.TypeIndex): BOOLEAN;
         OR (cls = SymTab.ClPtr)
   END CanType;
 
+PROCEDURE CanWithField (nm: ARRAY OF CHAR; VAR t: SymTab.TypeIndex): BOOLEAN;
+  VAR wt: CARDINAL;
+  BEGIN
+    wt := withTop;
+    WHILE wt > 0 DO
+      DEC(wt);
+      IF SymTab.FieldExists(withRec[wt], nm) THEN
+        t := SymTab.FieldType(withRec[wt], nm); RETURN TRUE
+      END
+    END;
+    RETURN FALSE
+  END CanWithField;
+
+PROCEDURE DesignTypeOf (n: AST.Node): SymTab.TypeIndex;
+(* Static type of a designator (no emit); used to push WITH scopes. *)
+  VAR nm, fn: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex;
+      i: CARDINAL; sel: AST.Node;
+  BEGIN
+    IF (n = AST.NoNode) OR (AST.Kind(n) # AST.NkDesignator) THEN
+      RETURN SymTab.InvalidType
+    END;
+    Name(AST.Child(n, 0), nm);
+    IF NOT Resolve(nm, k, t) THEN
+      IF NOT CanWithField(nm, t) THEN RETURN SymTab.InvalidType END
+    END;
+    i := 1;
+    WHILE i < AST.NChild(n) DO
+      sel := AST.Child(n, i);
+      IF AST.Op(sel) = AST.SelField THEN
+        Name(AST.Child(sel, 0), fn); t := SymTab.FieldType(t, fn)
+      ELSIF AST.Op(sel) = AST.SelIndex THEN
+        t := SymTab.ArrayElem(t)
+      ELSIF AST.Op(sel) = AST.SelDeref THEN
+        t := SymTab.PtrBase(t)
+      END;
+      INC(i)
+    END;
+    RETURN t
+  END DesignTypeOf;
+
 PROCEDURE CanDesign (n: AST.Node): BOOLEAN;
   VAR nm, fn: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex;
       i: CARDINAL; sel: AST.Node;
@@ -286,9 +350,14 @@ PROCEDURE CanDesign (n: AST.Node): BOOLEAN;
     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 NOT Resolve(nm, k, t) THEN
+      IF NOT CanWithField(nm, t) THEN RETURN FALSE END;
+      k := SymTab.KindField
+    END;
     IF (k # SymTab.KindVar) AND (k # SymTab.KindParam)
-       AND (k # SymTab.KindConst) THEN RETURN FALSE END;
+       AND (k # SymTab.KindConst) AND (k # SymTab.KindField) THEN
+      RETURN FALSE
+    END;
     IF NOT CanType(t) THEN RETURN FALSE END;
     i := 1;
     WHILE i < AST.NChild(n) DO
@@ -319,13 +388,36 @@ PROCEDURE CanDesign (n: AST.Node): BOOLEAN;
     RETURN TRUE
   END CanDesign;
 
+PROCEDURE CanBuiltin (n: AST.Node): BOOLEAN;
+  VAR i: CARDINAL;
+  BEGIN
+    i := 1;
+    WHILE i < AST.NChild(n) DO
+      IF NOT CanExpr(AST.Child(n, i)) THEN RETURN FALSE END;
+      INC(i)
+    END;
+    RETURN TRUE
+  END CanBuiltin;
+
+PROCEDURE CanCaseLabel (lab: AST.Node): BOOLEAN;
+  BEGIN
+    IF AST.Kind(lab) = AST.NkSubrange THEN
+      RETURN CanExpr(AST.Child(lab, 0)) AND CanExpr(AST.Child(lab, 1))
+    END;
+    RETURN CanExpr(lab)
+  END CanCaseLabel;
+
 PROCEDURE CanExpr (n: AST.Node): BOOLEAN;
-  VAR op: INTEGER;
+  VAR op: INTEGER; nm: SymTab.Name;
   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 CanDesign(n) END;
-    IF AST.Kind(n) = AST.NkCall THEN RETURN IsCall(n) AND CanCallArgs(n) END;
+    IF AST.Kind(n) = AST.NkCall THEN
+      CalleeName(n, nm);
+      IF IsBuiltin(nm) THEN RETURN CanBuiltin(n) END;
+      RETURN IsCall(n) AND CanCallArgs(n)
+    END;
     IF AST.Kind(n) = AST.NkUnary THEN
       op := AST.Op(n);
       IF (op # AST.OpSub) AND (op # AST.OpNot) THEN RETURN FALSE END;
@@ -342,7 +434,8 @@ PROCEDURE CanExpr (n: AST.Node): BOOLEAN;
   END CanExpr;
 
 PROCEDURE CanStmt (n: AST.Node): BOOLEAN;
-  VAR i: CARDINAL; k: INTEGER; by: AST.Node;
+  VAR i: CARDINAL; k: INTEGER; by: AST.Node; nm: SymTab.Name;
+      arm: AST.Node; j: CARDINAL; withSave: CARDINAL; ok: BOOLEAN;
   BEGIN
     IF n = AST.NoNode THEN RETURN TRUE END;
     k := AST.Kind(n);
@@ -377,6 +470,43 @@ PROCEDURE CanStmt (n: AST.Node): BOOLEAN;
              AND CanExpr(AST.Child(n, 1)) AND CanExpr(AST.Child(n, 2))
              AND CanStmt(AST.Child(n, 4))
     END;
+    IF k = AST.NkWith THEN
+      withSave := withTop;
+      j := 0;
+      WHILE j + 1 < AST.NChild(n) DO
+        IF NOT CanDesign(AST.Child(n, j)) THEN
+          withTop := withSave; RETURN FALSE
+        END;
+        IF withTop <= HIGH(withRec) THEN
+          withRec[withTop] := DesignTypeOf(AST.Child(n, j)); INC(withTop)
+        END;
+        INC(j)
+      END;
+      ok := CanStmt(AST.Child(n, AST.NChild(n) - 1));
+      withTop := withSave;
+      RETURN ok
+    END;
+    IF k = AST.NkCase THEN
+      IF NOT CanExpr(AST.Child(n, 0)) THEN RETURN FALSE END;
+      i := 1;
+      WHILE i < AST.NChild(n) DO
+        arm := AST.Child(n, i);
+        IF AST.Op(arm) = 1 THEN
+          IF NOT CanStmt(AST.Child(arm, 0)) THEN RETURN FALSE END
+        ELSE
+          j := 0;
+          WHILE j + 1 < AST.NChild(arm) DO
+            IF NOT CanCaseLabel(AST.Child(arm, j)) THEN RETURN FALSE END;
+            INC(j)
+          END;
+          IF NOT CanStmt(AST.Child(arm, AST.NChild(arm) - 1)) THEN
+            RETURN FALSE
+          END
+        END;
+        INC(i)
+      END;
+      RETURN TRUE
+    END;
     IF k = AST.NkHalt THEN
       IF AST.Child(n, 0) = AST.NoNode THEN RETURN TRUE END;
       RETURN CanExpr(AST.Child(n, 0))
@@ -385,7 +515,11 @@ PROCEDURE CanStmt (n: AST.Node): BOOLEAN;
       IF AST.Child(n, 0) = AST.NoNode THEN RETURN TRUE END;
       RETURN CanExpr(AST.Child(n, 0))
     END;
-    IF k = AST.NkCall THEN RETURN IsCall(n) AND CanCallArgs(n) END;
+    IF k = AST.NkCall THEN
+      CalleeName(n, nm);
+      IF IsBuiltin(nm) THEN RETURN CanBuiltin(n) END;
+      RETURN IsCall(n) AND CanCallArgs(n)
+    END;
     RETURN FALSE
   END CanStmt;
 
@@ -431,6 +565,7 @@ PROCEDURE CanDecls (seq: AST.Node): BOOLEAN;
 
 PROCEDURE CanLower (unit: AST.Node): BOOLEAN;
   BEGIN
+    withTop := 0;
     IF AST.Kind(unit) # AST.NkUnit THEN RETURN FALSE END;
     IF AST.Kind(AST.Child(unit, 0)) # AST.NkIdent THEN RETURN FALSE END;
     IF AST.Child(unit, 3) # AST.NoNode THEN RETURN FALSE END;
@@ -483,7 +618,10 @@ PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
     QbeGen.CopyOp(nm, qn);
     sfx := FALSE;
     IF NOT Resolve(nm, k, t) THEN
-      t := SymTab.InvalidType; k := -1; QbeGen.CopyOp("0", q); RETURN
+      IF NOT WithField(nm, k, t, q) THEN
+        t := SymTab.InvalidType; k := -1; QbeGen.CopyOp("0", q); RETURN
+      END;
+      sfx := TRUE
     END;
     IF k = SymTab.KindConst THEN
       IF SymTab.Equal(nm, "TRUE") THEN
@@ -508,6 +646,8 @@ PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
         QbeGen.LoadLong(nm, q)
       ELSE QbeGen.AddrOf(nm, q)
       END
+    ELSIF k = SymTab.KindField THEN
+      (* q already holds the field address (WithField) *)
     ELSE QbeGen.CopyOp("0", q)
     END;
     i := 1;
@@ -602,6 +742,213 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
     END
   END LowerCall;
 
+PROCEDURE IsBuiltin (nm: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    RETURN SymTab.Equal(nm, "ABS") OR SymTab.Equal(nm, "CAP")
+        OR SymTab.Equal(nm, "CHR") OR SymTab.Equal(nm, "ORD")
+        OR SymTab.Equal(nm, "SIZE") OR SymTab.Equal(nm, "TSIZE")
+        OR SymTab.Equal(nm, "MIN") OR SymTab.Equal(nm, "MAX")
+        OR SymTab.Equal(nm, "SHIFT") OR SymTab.Equal(nm, "ROTATE")
+        OR SymTab.Equal(nm, "ADR")
+        OR SymTab.Equal(nm, "INC") OR SymTab.Equal(nm, "DEC")
+        OR SymTab.Equal(nm, "INCL") OR SymTab.Equal(nm, "EXCL")
+        OR SymTab.Equal(nm, "NEW") OR SymTab.Equal(nm, "DISPOSE")
+  END IsBuiltin;
+
+PROCEDURE LowerBuiltinExpr (n: AST.Node; nm: SymTab.Name;
+                            VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
+(* Value builtins (Fact). *)
+  VAR et, et2, dt: SymTab.TypeIndex; qa, qt, q2, qd: QbeGen.QVal;
+      k, lo, hi: INTEGER; qn: SymTab.Name; sfx: BOOLEAN; isMax: BOOLEAN;
+  BEGIN
+    IF SymTab.Equal(nm, "ABS") THEN
+      LowerExpr(AST.Child(n, 1), et, q);
+      QbeGen.AbsQ(q, qa, SymTab.ClassOf(et) = SymTab.ClReal);
+      QbeGen.CopyOp(qa, q); t := et
+    ELSIF SymTab.Equal(nm, "CAP") THEN
+      LowerExpr(AST.Child(n, 1), et, q);
+      QbeGen.CapQ(q, qa); QbeGen.CopyOp(qa, q); t := SymTab.CharType()
+    ELSIF SymTab.Equal(nm, "CHR") THEN
+      LowerExpr(AST.Child(n, 1), et, q); t := SymTab.CharType()
+    ELSIF SymTab.Equal(nm, "ORD") THEN
+      LowerExpr(AST.Child(n, 1), et, q); t := SymTab.IntType()
+    ELSIF SymTab.Equal(nm, "SIZE") THEN
+      LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
+      QbeGen.IntStr(VAL(INTEGER, SymTab.ObjectSize(dt)), q);
+      t := SymTab.IntType()
+    ELSIF SymTab.Equal(nm, "MIN") OR SymTab.Equal(nm, "MAX") THEN
+      isMax := SymTab.Equal(nm, "MAX");
+      LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
+      IF SymTab.ClassOf(dt) = SymTab.ClReal THEN
+        IF isMax THEN QbeGen.NormReal("3.402823e38", q)
+        ELSE QbeGen.NormReal("-3.402823e38", q) END;
+        t := SymTab.RealType()
+      ELSIF SymTab.ClassOf(dt) = SymTab.ClLong THEN
+        IF isMax THEN QbeGen.CopyOp("9223372036854775807", q)
+        ELSE QbeGen.CopyOp("-9223372036854775808", q) END;
+        t := SymTab.LongType()
+      ELSIF SymTab.TypeBounds(dt, lo, hi) THEN
+        IF isMax THEN QbeGen.IntStr(hi, q) ELSE QbeGen.IntStr(lo, q) END;
+        t := SymTab.IntType()
+      ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
+      END
+    ELSIF SymTab.Equal(nm, "SHIFT") OR SymTab.Equal(nm, "ROTATE") THEN
+      LowerExpr(AST.Child(n, 1), et, q);
+      LowerExpr(AST.Child(n, 2), et2, q2);
+      QbeGen.SetShift(q, q2, SymTab.SetWords(et), SymTab.SetCount(et),
+                      SymTab.Equal(nm, "ROTATE"), qt);
+      t := et; QbeGen.CopyOp(qt, q)
+    ELSIF SymTab.Equal(nm, "ADR") THEN
+      LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
+      IF sfx THEN QbeGen.CopyOp(qd, q)
+      ELSIF (k = SymTab.KindVar) OR (k = SymTab.KindParam) THEN
+        QbeGen.AddrOf(qn, q)
+      ELSE QbeGen.CopyOp("0", q)
+      END;
+      t := SymTab.AddrType()
+    ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
+    END
+  END LowerBuiltinExpr;
+
+PROCEDURE LowerBuiltinStmt (n: AST.Node; nm: SymTab.Name);
+(* Statement builtins (AssOrCall): INC/DEC, INCL/EXCL, NEW/DISPOSE. *)
+  VAR dt, at, et2, bt: SymTab.TypeIndex; dk: INTEGER;
+      qd, qv, qe, qn2, qstep, qm: QbeGen.QVal;
+      qn: SymTab.Name; sfx, isInc: BOOLEAN;
+  BEGIN
+    IF SymTab.Equal(nm, "INC") OR SymTab.Equal(nm, "DEC") THEN
+      isInc := SymTab.Equal(nm, "INC");
+      QbeGen.CopyOp("1", qstep);
+      LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
+      IF AST.NChild(n) > 2 THEN LowerExpr(AST.Child(n, 2), et2, qstep) END;
+      IF dt = SymTab.InvalidType THEN
+      ELSE
+        IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemLoad(qd, dt, qv)
+        ELSE QbeGen.LoadVar(qn, FALSE, qv)
+        END;
+        QbeGen.NewTemp(qn2);
+        IF isInc THEN QbeGen.Op3("add", qn2, qv, qstep, FALSE)
+        ELSE QbeGen.Op3("sub", qn2, qv, qstep, FALSE)
+        END;
+        IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, qn2, dt)
+        ELSE QbeGen.StoreVar(qn, qn2, FALSE)
+        END
+      END
+    ELSIF SymTab.Equal(nm, "INCL") OR SymTab.Equal(nm, "EXCL") THEN
+      isInc := SymTab.Equal(nm, "INCL");
+      LowerDesign(AST.Child(n, 1), at, dk, qd, qn, sfx);
+      LowerExpr(AST.Child(n, 2), et2, qe);
+      IF at = SymTab.InvalidType THEN
+      ELSIF SymTab.ClassOf(at) # SymTab.ClSet THEN
+      ELSE
+        IF isInc THEN QbeGen.SetBit(qd, qe, SymTab.SetBaseLo(at), SymTab.SetCount(at))
+        ELSE QbeGen.SetClearBit(qd, qe, SymTab.SetBaseLo(at), SymTab.SetCount(at))
+        END
+      END
+    ELSIF SymTab.Equal(nm, "NEW") THEN
+      LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
+      IF dt = SymTab.InvalidType THEN
+      ELSIF SymTab.ClassOf(dt) # SymTab.ClPtr THEN
+      ELSE
+        bt := SymTab.PtrBase(dt);
+        IF bt # SymTab.InvalidType THEN
+          QbeGen.NewHeap(bt, qm); QbeGen.InitHeap(qm, bt);
+          IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, qm, dt)
+          ELSE QbeGen.StorePtr(qn, qm)
+          END
+        END
+      END
+    ELSIF SymTab.Equal(nm, "DISPOSE") THEN
+      LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
+      IF dt = SymTab.InvalidType THEN
+      ELSIF SymTab.ClassOf(dt) # SymTab.ClPtr THEN
+      ELSE
+        IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemLoad(qd, dt, qv)
+        ELSE QbeGen.LoadPtr(qn, qv)
+        END;
+        QbeGen.FreeHeap(qv);
+        IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, "0", dt)
+        ELSE QbeGen.StorePtr(qn, "0")
+        END
+      END
+    END
+  END LowerBuiltinStmt;
+
+PROCEDURE LowerCase (n: AST.Node);
+(* CASE as a compare-chain (mirrors CaseStat/CaseAlt/CaseLabel). *)
+  VAR i, j: CARDINAL; arm, lab: AST.Node; tsel, t2, t3: SymTab.TypeIndex;
+      qsel, q2, q3, qc, qd, qe, lEnd, lBody, lAfter, lNext: QbeGen.QVal;
+  BEGIN
+    LowerExpr(AST.Child(n, 0), tsel, qsel);
+    QbeGen.NewLabel(lEnd);
+    i := 1;
+    WHILE i < AST.NChild(n) DO
+      arm := AST.Child(n, i);
+      IF AST.Op(arm) = 1 THEN
+        (* ELSE arm: emitted after the alternatives *)
+      ELSE
+        QbeGen.NewLabel(lBody); QbeGen.NewLabel(lAfter);
+        j := 0;
+        WHILE j + 1 < AST.NChild(arm) DO
+          lab := AST.Child(arm, j);
+          IF AST.Kind(lab) = AST.NkSubrange THEN
+            LowerExpr(AST.Child(lab, 0), t2, q2);
+            QbeGen.NewLabel(lNext);
+            QbeGen.Cmp(SymTab.OpEq, qsel, q2, qc, FALSE);
+            QbeGen.Jnz(qc, lBody, lNext);
+            QbeGen.EmitLabel(lNext);
+            LowerExpr(AST.Child(lab, 1), t3, q3);
+            QbeGen.Cmp(SymTab.OpGe, qsel, q2, qc, FALSE);
+            QbeGen.Cmp(SymTab.OpLe, qsel, q3, qd, FALSE);
+            QbeGen.NewTemp(qe);
+            QbeGen.Op3("and", qe, qc, qd, FALSE);
+            QbeGen.NewLabel(lNext);
+            QbeGen.Jnz(qe, lBody, lNext);
+            QbeGen.EmitLabel(lNext)
+          ELSE
+            LowerExpr(lab, t2, q2);
+            QbeGen.NewLabel(lNext);
+            QbeGen.Cmp(SymTab.OpEq, qsel, q2, qc, FALSE);
+            QbeGen.Jnz(qc, lBody, lNext);
+            QbeGen.EmitLabel(lNext)
+          END;
+          INC(j)
+        END;
+        QbeGen.Jmp(lAfter);
+        QbeGen.EmitLabel(lBody);
+        LowerStmt(AST.Child(arm, AST.NChild(arm) - 1));
+        QbeGen.Jmp(lEnd);
+        QbeGen.EmitLabel(lAfter)
+      END;
+      INC(i)
+    END;
+    i := 1;
+    WHILE i < AST.NChild(n) DO
+      arm := AST.Child(n, i);
+      IF AST.Op(arm) = 1 THEN LowerStmt(AST.Child(arm, 0)) END;
+      INC(i)
+    END;
+    QbeGen.EmitLabel(lEnd)
+  END LowerCase;
+
+PROCEDURE LowerWith (n: AST.Node);
+(* WITH: push each record's base address, lower the body, pop. *)
+  VAR i: CARDINAL; dt: SymTab.TypeIndex; dk: INTEGER; qd: QbeGen.QVal;
+      qn: SymTab.Name; sfx: BOOLEAN;
+  BEGIN
+    i := 0;
+    WHILE i + 1 < AST.NChild(n) DO
+      LowerDesign(AST.Child(n, i), dt, dk, qd, qn, sfx);
+      QbeGen.PushWith(qd);
+      IF withTop <= HIGH(withRec) THEN
+        withRec[withTop] := dt; INC(withTop)
+      END;
+      INC(i)
+    END;
+    LowerStmt(AST.Child(n, AST.NChild(n) - 1));
+    WHILE withTop > 0 DO DEC(withTop); QbeGen.PopWith END
+  END LowerWith;
+
 PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex;
                          VAR q: QbeGen.QVal; VAR k: INTEGER;
                          VAR qn: SymTab.Name; VAR sfx: BOOLEAN;
@@ -622,7 +969,10 @@ PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex;
     ELSIF AST.Kind(n) = AST.NkDesignator THEN
       LowerDesign(n, t, k, q, qn, sfx)
     ELSIF AST.Kind(n) = AST.NkCall THEN
-      LowerCall(n, t, q, TRUE)
+      CalleeName(n, qn);
+      IF IsBuiltin(qn) THEN LowerBuiltinExpr(n, qn, t, q)
+      ELSE LowerCall(n, t, q, TRUE)
+      END
     ELSIF AST.Kind(n) = AST.NkUnary THEN
       LowerExpr(AST.Child(n, 0), t, q);
       IF AST.Op(n) = AST.OpSub THEN
@@ -856,8 +1206,13 @@ PROCEDURE LowerStmt (seq: AST.Node);
         ELSE QbeGen.EmitRet(q, TRUE)
         END
       END
+    ELSIF k = AST.NkCase THEN LowerCase(seq)
+    ELSIF k = AST.NkWith THEN LowerWith(seq)
     ELSIF k = AST.NkCall THEN
-      LowerCall(seq, t, q, FALSE)
+      CalleeName(seq, qn);
+      IF IsBuiltin(qn) THEN LowerBuiltinStmt(seq, qn)
+      ELSE LowerCall(seq, t, q, FALSE)
+      END
     END
   END LowerStmt;
 
@@ -908,6 +1263,7 @@ PROCEDURE LowerDecls (seq: AST.Node);
 PROCEDURE LowerUnit (unit: AST.Node);
   VAR nm: SymTab.Name; out: ARRAY [0 .. 255] OF CHAR; i: CARDINAL;
   BEGIN
+    withTop := 0;
     Name(AST.Child(unit, 0), nm);
     i := 0;
     WHILE (i <= 254) AND (i <= HIGH(nm)) AND (nm[i] # CHR(0)) DO

+ 27 - 0
compiler/tests/t_lower4.mod

@@ -0,0 +1,27 @@
+MODULE TLower4;
+(* Lower slice L4: builtins (ABS/CAP/CHR/ORD/INC/DEC/INCL/EXCL/NEW/DISPOSE)
+   over records, arrays, sets and pointers.  Exit 42. *)
+TYPE
+  Rec = RECORD a, b: INTEGER; END;
+VAR
+  x, i, ExitCode : INTEGER;
+  c : CHAR;
+  v : ARRAY [0..3] OF INTEGER;
+  s : SET OF [0..7];
+  p : POINTER TO Rec;
+BEGIN
+  x := ABS(-40);
+  c := CHR(97);
+  c := CAP(c);
+  i := ORD(c) + 1;
+  v[0] := i;
+  INC(v[0]);
+  DEC(x, 1);
+  INCL(s, 1);
+  EXCL(s, 1);
+  NEW(p);
+  p^.a := 2;
+  x := x + p^.a;
+  DISPOSE(p);
+  ExitCode := x + v[0] - 66
+END TLower4.

+ 14 - 0
compiler/tests/t_lower4case.mod

@@ -0,0 +1,14 @@
+MODULE TLower4Case;
+(* Lower slice L4: CASE (value and range labels, ELSE).  Exit 42. *)
+VAR
+  x, i, ExitCode : INTEGER;
+BEGIN
+  i := 4;
+  CASE i OF
+    1: x := 10
+  | 2: x := 20
+  | 3..5: x := 42
+  ELSE x := 0
+  END;
+  ExitCode := x
+END TLower4Case.

+ 15 - 0
compiler/tests/t_lower4with.mod

@@ -0,0 +1,15 @@
+MODULE TLower4With;
+(* Lower slice L4: WITH (record field scope).  Exit 42. *)
+TYPE
+  Rec = RECORD a, b: INTEGER; END;
+VAR
+  r : Rec;
+  x, ExitCode : INTEGER;
+BEGIN
+  r.a := 40;
+  r.b := 2;
+  WITH r DO
+    x := a + b
+  END;
+  ExitCode := x
+END TLower4With.