Преглед изворни кода

step8: VAR tails — a[i], p^, fields as VAR actuals; 127/127 tests green

Eric Streit пре 3 недеља
родитељ
комит
49e825319d
34 измењених фајлова са 720 додато и 305 уклоњено
  1. BIN
      M2c
  2. 32 10
      M2c.atg
  3. 297 275
      M2c.lst
  4. 32 10
      M2cP.mod
  5. BIN
      M2cP.o
  6. 8 0
      MGen.def
  7. 59 7
      MGen.mod
  8. BIN
      MGen.o
  9. BIN
      VBadByte.MC4
  10. BIN
      VBadVar.MC4
  11. BIN
      VBadWith.MC4
  12. BIN
      VDeref.MC4
  13. BIN
      VField.MC4
  14. BIN
      VIdx.MC4
  15. BIN
      VRec.MC4
  16. BIN
      VRow.MC4
  17. 50 0
      docs/summary_step8.md
  18. 11 0
      run_tests.sh
  19. 18 0
      tests/v_bad_byte.LST
  20. 11 0
      tests/v_bad_byte.mod
  21. 2 2
      tests/v_bad_var.LST
  22. 1 1
      tests/v_bad_var.mod
  23. 19 0
      tests/v_bad_with.LST
  24. 12 0
      tests/v_bad_with.mod
  25. 20 0
      tests/v_deref.LST
  26. 14 0
      tests/v_deref.mod
  27. 21 0
      tests/v_field.LST
  28. 15 0
      tests/v_field.mod
  29. 18 0
      tests/v_idx.LST
  30. 12 0
      tests/v_idx.mod
  31. 20 0
      tests/v_rec.LST
  32. 14 0
      tests/v_rec.mod
  33. 20 0
      tests/v_row.LST
  34. 14 0
      tests/v_row.mod

+ 32 - 10
M2c.atg

@@ -1681,7 +1681,7 @@ PRODUCTIONS
                                              vn2: SymTab.Name;
                                              r: BOOLEAN; .)
     = SimExpr<t, lx, v, vn> [ Rel<op> SimExpr<t2, lx2, v2, vn2>
-      (. lx[0] := 0C; v := FALSE;
+      (. lx[0] := 0C; v := FALSE; MGen.ClrStash();
          IF op = SymTab.OpIn THEN
            IF SymTab.InCheck(t, t2) THEN
              t := SymTab.BoolType();
@@ -1769,6 +1769,7 @@ PRODUCTIONS
       [ "+" | "-"                       (. neg := TRUE; .) ]
       Term<t, lx, v, vn>                (. IF neg THEN
                                            v := FALSE;
+                                           MGen.ClrStash();
                                            IF MGen.IsLit(lx) THEN
                                              MGen.NegFold(lx, lx)
                                            ELSE lx[0] := 0C
@@ -1780,7 +1781,7 @@ PRODUCTIONS
                                            END
                                          END; .)
       { AddOp<op> Term<t2, lx2, v2, vn2>
-      (. lx[0] := 0C; v := FALSE;
+      (. lx[0] := 0C; v := FALSE; MGen.ClrStash();
          IF op = SymTab.OpOr THEN
            IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
              t := SymTab.BoolType()
@@ -1822,7 +1823,7 @@ PRODUCTIONS
                                              isR: BOOLEAN;
                                              mt: INTEGER; .)
     = Fact<t, lx, v, vn> { MulOp<op> Fact<t2, lx2, v2, vn2>
-      (. lx[0] := 0C; v := FALSE;
+      (. lx[0] := 0C; v := FALSE; MGen.ClrStash();
          IF op = SymTab.OpAnd THEN
            IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
              t := SymTab.BoolType()
@@ -1875,7 +1876,7 @@ PRODUCTIONS
                                              okF: BOOLEAN; .)
     = integer                         (. LexString(s);
                                          MGen.CopyName(s, lx);
-                                         v := FALSE;
+                                         v := FALSE; MGen.ClrStash();
                                          IF MGen.ParseInt(s, vi) THEN
                                            MGen.PushInt(vi)
                                          ELSIF MGen.ParseCard(s, c) THEN
@@ -1886,14 +1887,14 @@ PRODUCTIONS
                                          t := SymTab.IntType(); .)
     | real                            (. LexString(s);
                                          MGen.CopyName(s, lx);
-                                         v := FALSE;
+                                         v := FALSE; MGen.ClrStash();
                                          IF MGen.ParseReal(s, b) THEN
                                            MGen.PushBits(b)
                                          ELSE MGen.PushBits(0H)
                                          END;
                                          t := SymTab.RealType(); .)
     | string                          (. LexString(s);
-                                         v := FALSE;
+                                         v := FALSE; MGen.ClrStash();
                                          IF SymTab.StrLen(s) <= 3 THEN
                                            t := SymTab.CharType();
                                            MGen.CopyName(s, lx);
@@ -1906,7 +1907,7 @@ PRODUCTIONS
     | "HIGH"
       "(" DesignHead<dt, dk, bnF, FALSE, lxD>
           DesignTail<dt, dk, bnF, FALSE, lxD, sfxF>
-      ")"                               (. lx[0] := 0C; v := FALSE;
+      ")"                               (. lx[0] := 0C; v := FALSE; MGen.ClrStash();
                                            IF dt = SymTab.InvalidType THEN
                                              IF sfxF THEN MGen.Drop END;
                                              MGen.PushInt(0);
@@ -1951,6 +1952,24 @@ PRODUCTIONS
       DesignTail<dt, dk, bnF, TRUE, lxD, sfxF>
                                         (. t := dt;
                                            MGen.CopyName(lxD, lx);
+                                           IF sfxF
+                                              & (t # SymTab.InvalidType)
+                                              & MGen.ActIsVarNext()
+                                              & ((dk = SymTab.KindVar)
+                                                 OR (dk
+                                                     = SymTab.KindParam)
+                                                 OR (dk
+                                                     = SymTab.KindVarPar)
+                                                 OR (dk
+                                                     = SymTab.KindField))
+                                              & (SymTab.SymKind(bnF)
+                                                 # SymTab.KindModule)
+                                              & (SymTab.ClassOf(t)
+                                                 # SymTab.ClChar)
+                                              & (SymTab.ClassOf(t)
+                                                 # SymTab.ClBool) THEN
+                                             MGen.StashAddr()
+                                           END;
                                            IF sfxF
                                               & (t # SymTab.InvalidType)
                                               & (SymTab.ClassOf(t)
@@ -1990,17 +2009,18 @@ PRODUCTIONS
                                              END
                                            ELSE t := SymTab.InvalidType
                                            END;
-                                           lx[0] := 0C; v := FALSE; .) ]
+                                           lx[0] := 0C; v := FALSE;
+                                           MGen.ClrStash(); .) ]
     | "("
       Expr<et, lx, v, vn> ")"         (. t := et; .)
     | ( "NOT" | "~" )
-      Fact<t2, lx2, v2, vn2>          (. lx[0] := 0C; v := FALSE;
+      Fact<t2, lx2, v2, vn2>          (. lx[0] := 0C; v := FALSE; MGen.ClrStash();
                                          IF SymTab.BoolCheck(t2) THEN
                                            t := SymTab.BoolType()
                                          ELSE SemError(212);
                                            t := SymTab.InvalidType END;
                                          MGen.Not; .)
-    | SetLit<st>                      (. lx[0] := 0C; v := FALSE;
+    | SetLit<st>                      (. lx[0] := 0C; v := FALSE; MGen.ClrStash();
                                          t := st; .) .
   SetLit <VAR t: SymTab.TypeIndex>
                                         (. VAR first, et: SymTab.TypeIndex;
@@ -2013,6 +2033,7 @@ PRODUCTIONS
                                    t := SymTab.SetFor(SymTab.IntType()); .)
       [ Elem<et, lxE, lxE2, hasR>   (. first := et;
                                        t := SymTab.SetFor(et);
+                                       MGen.ClrStash();
                                        IF hasR THEN
                                          MGen.PushInt(1); MGen.Add;
                                          MGen.FieldMask
@@ -2021,6 +2042,7 @@ PRODUCTIONS
         { ","
           Elem<et, lxE, lxE2, hasR> (. IF ~SymTab.SetElemCheck(first, et) THEN
                                        SemError(222) END;
+                                       MGen.ClrStash();
                                        IF hasR THEN
                                          MGen.PushInt(1); MGen.Add;
                                          MGen.FieldMask

+ 297 - 275
M2c.lst

@@ -1703,7 +1703,7 @@ Listing:
  1681                                               vn2: SymTab.Name;
  1682                                               r: BOOLEAN; .)
  1683      = SimExpr<t, lx, v, vn> [ Rel<op> SimExpr<t2, lx2, v2, vn2>
- 1684        (. lx[0] := 0C; v := FALSE;
+ 1684        (. lx[0] := 0C; v := FALSE; MGen.ClrStash();
  1685           IF op = SymTab.OpIn THEN
  1686             IF SymTab.InCheck(t, t2) THEN
  1687               t := SymTab.BoolType();
@@ -1791,280 +1791,302 @@ Listing:
  1769        [ "+" | "-"                       (. neg := TRUE; .) ]
  1770        Term<t, lx, v, vn>                (. IF neg THEN
  1771                                             v := FALSE;
- 1772                                             IF MGen.IsLit(lx) THEN
- 1773                                               MGen.NegFold(lx, lx)
- 1774                                             ELSE lx[0] := 0C
- 1775                                             END;
- 1776                                             IF SymTab.ClassOf(t)
- 1777                                                = SymTab.ClReal THEN
- 1778                                               MGen.NegReal
- 1779                                             ELSE MGen.NegInt
- 1780                                             END
- 1781                                           END; .)
- 1782        { AddOp<op> Term<t2, lx2, v2, vn2>
- 1783        (. lx[0] := 0C; v := FALSE;
- 1784           IF op = SymTab.OpOr THEN
- 1785             IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
- 1786               t := SymTab.BoolType()
- 1787             ELSE SemError(212); t := SymTab.InvalidType END;
- 1788             MGen.Or
- 1789           ELSIF (t # SymTab.InvalidType)
- 1790              & (t2 # SymTab.InvalidType)
- 1791              & (SymTab.ClassOf(t) = SymTab.ClSet)
- 1792              & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
- 1793             IF op = SymTab.OpAdd THEN
- 1794               MGen.Or
- 1795             ELSE
- 1796               MGen.PushBits(0FFFFFFFFFFFFFFFFH);
- 1797               MGen.BitXor;
- 1798               MGen.And
- 1799             END
- 1800           ELSE
- 1801             IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2
- 1802             ELSE SemError(211); t := SymTab.InvalidType END;
- 1803             isR := (t # SymTab.InvalidType)
- 1804                    & (SymTab.ClassOf(t) = SymTab.ClReal);
- 1805             IF op = SymTab.OpAdd THEN
- 1806               IF isR THEN MGen.RealAdd ELSE MGen.Add END
- 1807             ELSE
- 1808               IF isR THEN MGen.RealSub ELSE MGen.Sub END
- 1809             END
- 1810           END; .) } .
- 1811    AddOp <VAR op: INTEGER>
- 1812      = "+"                     (. op := SymTab.OpAdd; .)
- 1813      | "-"                     (. op := SymTab.OpSub; .)
- 1814      | "OR"                    (. op := SymTab.OpOr; .) .
- 1815    Term <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
- 1816          VAR v: BOOLEAN; VAR vn: SymTab.Name>
- 1817                                          (. VAR t2, res2: SymTab.TypeIndex;
- 1818                                               op: INTEGER;
- 1819                                               lx2: MGen.LitStr;
- 1820                                               v2: BOOLEAN;
- 1821                                               vn2: SymTab.Name;
- 1822                                               isR: BOOLEAN;
- 1823                                               mt: INTEGER; .)
- 1824      = Fact<t, lx, v, vn> { MulOp<op> Fact<t2, lx2, v2, vn2>
- 1825        (. lx[0] := 0C; v := FALSE;
- 1826           IF op = SymTab.OpAnd THEN
- 1827             IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
- 1828               t := SymTab.BoolType()
- 1829             ELSE SemError(212); t := SymTab.InvalidType END;
- 1830             MGen.And
- 1831           ELSIF (op = SymTab.OpTimes)
- 1832              & (t # SymTab.InvalidType)
- 1833              & (t2 # SymTab.InvalidType)
- 1834              & (SymTab.ClassOf(t) = SymTab.ClSet)
- 1835              & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
- 1836             MGen.And
- 1837           ELSE
- 1838             IF SymTab.ArithCheck(t, t2,
- 1839                  (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
- 1840                  res2) THEN t := res2
- 1841             ELSE SemError(211); t := SymTab.InvalidType END;
- 1842             isR := (t # SymTab.InvalidType)
- 1843                    & (SymTab.ClassOf(t) = SymTab.ClReal);
- 1844             IF op = SymTab.OpTimes THEN
- 1845               IF isR THEN MGen.RealMul ELSE MGen.MulU END
- 1846             ELSIF op = SymTab.OpSlash THEN
- 1847               IF isR THEN MGen.RealDiv ELSE MGen.DivI END
- 1848             ELSIF op = SymTab.OpDiv THEN
- 1849               MGen.DivI
- 1850             ELSE
- 1851               mt := MGen.TempGlobal();
- 1852               MGen.ModI(mt)
- 1853             END
- 1854           END; .) } .
- 1855    MulOp <VAR op: INTEGER>
- 1856      = "*"                     (. op := SymTab.OpTimes; .)
- 1857      | "/"                     (. op := SymTab.OpSlash; .)
- 1858      | "DIV"                   (. op := SymTab.OpDiv; .)
- 1859      | "MOD"                   (. op := SymTab.OpMod; .)
- 1860      | "AND"                   (. op := SymTab.OpAnd; .)
- 1861      | "&"                     (. op := SymTab.OpAnd; .) .
- 1862    Fact <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
- 1863          VAR v: BOOLEAN; VAR vn: SymTab.Name>
- 1864                                          (. VAR s: ARRAY [0 .. 255] OF CHAR;
- 1865                                               t2, et, dt, st: SymTab.TypeIndex;
- 1866                                               dk: INTEGER;
- 1867                                               bnF: SymTab.Name;
- 1868                                               lxD, lx2: MGen.LitStr;
- 1869                                               v2: BOOLEAN;
- 1870                                               vn2: SymTab.Name;
- 1871                                               vi: INTEGER;
- 1872                                               c: CARDINAL;
- 1873                                               b: LONGCARD;
- 1874                                               sfxF: BOOLEAN;
- 1875                                               okF: BOOLEAN; .)
- 1876      = integer                         (. LexString(s);
- 1877                                           MGen.CopyName(s, lx);
- 1878                                           v := FALSE;
- 1879                                           IF MGen.ParseInt(s, vi) THEN
- 1880                                             MGen.PushInt(vi)
- 1881                                           ELSIF MGen.ParseCard(s, c) THEN
- 1882                                             MGen.PushBits(
- 1883                                               VAL(LONGCARD, c))
- 1884                                           ELSE MGen.PushInt(0)
- 1885                                           END;
- 1886                                           t := SymTab.IntType(); .)
- 1887      | real                            (. LexString(s);
- 1888                                           MGen.CopyName(s, lx);
- 1889                                           v := FALSE;
- 1890                                           IF MGen.ParseReal(s, b) THEN
- 1891                                             MGen.PushBits(b)
- 1892                                           ELSE MGen.PushBits(0H)
- 1893                                           END;
- 1894                                           t := SymTab.RealType(); .)
- 1895      | string                          (. LexString(s);
- 1896                                           v := FALSE;
- 1897                                           IF SymTab.StrLen(s) <= 3 THEN
- 1898                                             t := SymTab.CharType();
- 1899                                             MGen.CopyName(s, lx);
- 1900                                             MGen.PushInt(
- 1901                                               MGen.CharOrd(s))
- 1902                                           ELSE t := SymTab.NewStr();
- 1903                                             MGen.CopyName(s, lx);
- 1904                                             MGen.EmitString(s)
- 1905                                           END; .)
- 1906      | "HIGH"
- 1907        "(" DesignHead<dt, dk, bnF, FALSE, lxD>
- 1908            DesignTail<dt, dk, bnF, FALSE, lxD, sfxF>
- 1909        ")"                               (. lx[0] := 0C; v := FALSE;
- 1910                                             IF dt = SymTab.InvalidType THEN
- 1911                                               IF sfxF THEN MGen.Drop END;
- 1912                                               MGen.PushInt(0);
- 1913                                               t := SymTab.InvalidType
- 1914                                             ELSIF SymTab.ClassOf(dt)
- 1915                                                    # SymTab.ClArray THEN
- 1916                                               SemError(217);
- 1917                                               IF sfxF THEN MGen.Drop END;
- 1918                                               MGen.PushInt(0);
- 1919                                               t := SymTab.InvalidType
- 1920                                             ELSIF SymTab.IsOpen(dt) THEN
- 1921                                               IF sfxF THEN MGen.Drop END;
- 1922                                               IF (dk = SymTab.KindParam)
- 1923                                                  OR (dk
- 1924                                                   = SymTab.KindVarPar) THEN
- 1925                                                 IF SymTab.CurDepth()
- 1926                                                    = SymTab.SymDepth(bnF) THEN
- 1927                                                   MGen.LoadLocal(
- 1928                                                     SymTab.SymSlot(bnF) + 1)
- 1929                                                 ELSE
- 1930                                                   MGen.FrameAddr(
- 1931                                                     SymTab.SymSlot(bnF) + 1,
- 1932                                                     VAL(CARDINAL,
- 1933                                                       SymTab.CurDepth() - 1
- 1934                                                       - SymTab.SymDepth(bnF)));
- 1935                                                   MGen.LoadIndir
- 1936                                                 END;
- 1937                                                 MGen.PushInt(1);
- 1938                                                 MGen.Sub;
- 1939                                                 t := SymTab.IntType()
- 1940                                               ELSE
- 1941                                                 MGen.PushInt(0);
- 1942                                                 t := SymTab.InvalidType
- 1943                                               END
- 1944                                             ELSE
- 1945                                               IF sfxF THEN MGen.Drop END;
- 1946                                               MGen.PushInt(
- 1947                                                 SymTab.ArrayHi(dt));
- 1948                                               t := SymTab.IntType()
- 1949                                             END; .)
- 1950      | DesignHead<dt, dk, bnF, TRUE, lxD>
- 1951        DesignTail<dt, dk, bnF, TRUE, lxD, sfxF>
- 1952                                          (. t := dt;
- 1953                                             MGen.CopyName(lxD, lx);
- 1954                                             IF sfxF
- 1955                                                & (t # SymTab.InvalidType)
- 1956                                                & (SymTab.ClassOf(t)
- 1957                                                   # SymTab.ClArray)
- 1958                                                & (SymTab.ClassOf(t)
- 1959                                                   # SymTab.ClRecord) THEN
- 1960                                               IF (SymTab.ClassOf(t)
- 1961                                                  = SymTab.ClChar)
- 1962                                                  OR (SymTab.ClassOf(t)
- 1963                                                     = SymTab.ClBool) THEN
- 1964                                                 MGen.LoadByte
- 1965                                               ELSE MGen.LoadIndir
- 1966                                               END
- 1967                                             END;
- 1968                                             v := ~sfxF
- 1969                                                  & ((dk = SymTab.KindVar)
- 1970                                                  OR (dk = SymTab.KindParam)
- 1971                                                  OR (dk
- 1972                                                      = SymTab.KindVarPar));
- 1973                                             MGen.CopyName(bnF, vn); .)
- 1974        [ CallTail<bnF, lxD, sfxF, TRUE, okF, TRUE>
- 1975                                          (. IF okF THEN
- 1976                                               IF SymTab.SymKind(bnF)
- 1977                                                  = SymTab.KindProc THEN
- 1978                                                 t := SymTab.ProcRet(bnF)
- 1979                                               ELSIF (SymTab.SymKind(bnF)
- 1980                                                         = SymTab.KindModule)
- 1981                                                  & sfxF
- 1982                                                  & (SymTab.StrLen(lxD) > 0)
- 1983                                                  & (SymTab.ExpProc(bnF,
- 1984                                                       lxD) >= 0) THEN
- 1985                                                 t := SymTab.ProcRetByNum(
- 1986                                                        SymTab.ExpProc(bnF,
- 1987                                                          lxD))
- 1988                                               ELSE
- 1989                                                 t := SymTab.InvalidType
- 1990                                               END
- 1991                                             ELSE t := SymTab.InvalidType
- 1992                                             END;
- 1993                                             lx[0] := 0C; v := FALSE; .) ]
- 1994      | "("
- 1995        Expr<et, lx, v, vn> ")"         (. t := et; .)
- 1996      | ( "NOT" | "~" )
- 1997        Fact<t2, lx2, v2, vn2>          (. lx[0] := 0C; v := FALSE;
- 1998                                           IF SymTab.BoolCheck(t2) THEN
- 1999                                             t := SymTab.BoolType()
- 2000                                           ELSE SemError(212);
- 2001                                             t := SymTab.InvalidType END;
- 2002                                           MGen.Not; .)
- 2003      | SetLit<st>                      (. lx[0] := 0C; v := FALSE;
- 2004                                           t := st; .) .
- 2005    SetLit <VAR t: SymTab.TypeIndex>
- 2006                                          (. VAR first, et: SymTab.TypeIndex;
- 2007                                               lxE, lxE2: MGen.LitStr;
- 2008                                               vE, vE2: BOOLEAN;
- 2009                                               vnE, vnE2: SymTab.Name;
- 2010                                               hasR: BOOLEAN; .)
- 2011      = "{"
- 2012                                  (. MGen.PushInt(0);
- 2013                                     t := SymTab.SetFor(SymTab.IntType()); .)
- 2014        [ Elem<et, lxE, lxE2, hasR>   (. first := et;
- 2015                                         t := SymTab.SetFor(et);
- 2016                                         IF hasR THEN
- 2017                                           MGen.PushInt(1); MGen.Add;
- 2018                                           MGen.FieldMask
- 2019                                         ELSE MGen.Power2 END;
- 2020                                         MGen.Or; .)
- 2021          { ","
- 2022            Elem<et, lxE, lxE2, hasR> (. IF ~SymTab.SetElemCheck(first, et) THEN
- 2023                                         SemError(222) END;
- 2024                                         IF hasR THEN
- 2025                                           MGen.PushInt(1); MGen.Add;
- 2026                                           MGen.FieldMask
- 2027                                         ELSE MGen.Power2 END;
- 2028                                         MGen.Or; .) } ]
- 2029        "}" .
- 2030    Elem <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
- 2031          VAR lx2: MGen.LitStr; VAR hasR: BOOLEAN>
- 2032                                          (. VAR t2: SymTab.TypeIndex;
- 2033                                               vD, vD2: BOOLEAN;
- 2034                                               vnD, vnD2: SymTab.Name; .)
- 2035      = Expr<t, lx, vD, vnD>              (. hasR := FALSE;
- 2036                                             lx2[0] := 0C; .)
- 2037        [ ".."
- 2038          Expr<t2, lx2, vD2, vnD2>        (. IF ~SymTab.SetElemCheck(t, t2) THEN
- 2039                                             SemError(222) END;
- 2040                                             hasR := TRUE; .) ] .
- 2041  
- 2042    GetIdent <VAR n: SymTab.Name>
- 2043      = ident                           (. LexName(n); .) .
- 2044  
- 2045  END M2c.
+ 1772                                             MGen.ClrStash();
+ 1773                                             IF MGen.IsLit(lx) THEN
+ 1774                                               MGen.NegFold(lx, lx)
+ 1775                                             ELSE lx[0] := 0C
+ 1776                                             END;
+ 1777                                             IF SymTab.ClassOf(t)
+ 1778                                                = SymTab.ClReal THEN
+ 1779                                               MGen.NegReal
+ 1780                                             ELSE MGen.NegInt
+ 1781                                             END
+ 1782                                           END; .)
+ 1783        { AddOp<op> Term<t2, lx2, v2, vn2>
+ 1784        (. lx[0] := 0C; v := FALSE; MGen.ClrStash();
+ 1785           IF op = SymTab.OpOr THEN
+ 1786             IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
+ 1787               t := SymTab.BoolType()
+ 1788             ELSE SemError(212); t := SymTab.InvalidType END;
+ 1789             MGen.Or
+ 1790           ELSIF (t # SymTab.InvalidType)
+ 1791              & (t2 # SymTab.InvalidType)
+ 1792              & (SymTab.ClassOf(t) = SymTab.ClSet)
+ 1793              & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
+ 1794             IF op = SymTab.OpAdd THEN
+ 1795               MGen.Or
+ 1796             ELSE
+ 1797               MGen.PushBits(0FFFFFFFFFFFFFFFFH);
+ 1798               MGen.BitXor;
+ 1799               MGen.And
+ 1800             END
+ 1801           ELSE
+ 1802             IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2
+ 1803             ELSE SemError(211); t := SymTab.InvalidType END;
+ 1804             isR := (t # SymTab.InvalidType)
+ 1805                    & (SymTab.ClassOf(t) = SymTab.ClReal);
+ 1806             IF op = SymTab.OpAdd THEN
+ 1807               IF isR THEN MGen.RealAdd ELSE MGen.Add END
+ 1808             ELSE
+ 1809               IF isR THEN MGen.RealSub ELSE MGen.Sub END
+ 1810             END
+ 1811           END; .) } .
+ 1812    AddOp <VAR op: INTEGER>
+ 1813      = "+"                     (. op := SymTab.OpAdd; .)
+ 1814      | "-"                     (. op := SymTab.OpSub; .)
+ 1815      | "OR"                    (. op := SymTab.OpOr; .) .
+ 1816    Term <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
+ 1817          VAR v: BOOLEAN; VAR vn: SymTab.Name>
+ 1818                                          (. VAR t2, res2: SymTab.TypeIndex;
+ 1819                                               op: INTEGER;
+ 1820                                               lx2: MGen.LitStr;
+ 1821                                               v2: BOOLEAN;
+ 1822                                               vn2: SymTab.Name;
+ 1823                                               isR: BOOLEAN;
+ 1824                                               mt: INTEGER; .)
+ 1825      = Fact<t, lx, v, vn> { MulOp<op> Fact<t2, lx2, v2, vn2>
+ 1826        (. lx[0] := 0C; v := FALSE; MGen.ClrStash();
+ 1827           IF op = SymTab.OpAnd THEN
+ 1828             IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
+ 1829               t := SymTab.BoolType()
+ 1830             ELSE SemError(212); t := SymTab.InvalidType END;
+ 1831             MGen.And
+ 1832           ELSIF (op = SymTab.OpTimes)
+ 1833              & (t # SymTab.InvalidType)
+ 1834              & (t2 # SymTab.InvalidType)
+ 1835              & (SymTab.ClassOf(t) = SymTab.ClSet)
+ 1836              & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
+ 1837             MGen.And
+ 1838           ELSE
+ 1839             IF SymTab.ArithCheck(t, t2,
+ 1840                  (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
+ 1841                  res2) THEN t := res2
+ 1842             ELSE SemError(211); t := SymTab.InvalidType END;
+ 1843             isR := (t # SymTab.InvalidType)
+ 1844                    & (SymTab.ClassOf(t) = SymTab.ClReal);
+ 1845             IF op = SymTab.OpTimes THEN
+ 1846               IF isR THEN MGen.RealMul ELSE MGen.MulU END
+ 1847             ELSIF op = SymTab.OpSlash THEN
+ 1848               IF isR THEN MGen.RealDiv ELSE MGen.DivI END
+ 1849             ELSIF op = SymTab.OpDiv THEN
+ 1850               MGen.DivI
+ 1851             ELSE
+ 1852               mt := MGen.TempGlobal();
+ 1853               MGen.ModI(mt)
+ 1854             END
+ 1855           END; .) } .
+ 1856    MulOp <VAR op: INTEGER>
+ 1857      = "*"                     (. op := SymTab.OpTimes; .)
+ 1858      | "/"                     (. op := SymTab.OpSlash; .)
+ 1859      | "DIV"                   (. op := SymTab.OpDiv; .)
+ 1860      | "MOD"                   (. op := SymTab.OpMod; .)
+ 1861      | "AND"                   (. op := SymTab.OpAnd; .)
+ 1862      | "&"                     (. op := SymTab.OpAnd; .) .
+ 1863    Fact <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
+ 1864          VAR v: BOOLEAN; VAR vn: SymTab.Name>
+ 1865                                          (. VAR s: ARRAY [0 .. 255] OF CHAR;
+ 1866                                               t2, et, dt, st: SymTab.TypeIndex;
+ 1867                                               dk: INTEGER;
+ 1868                                               bnF: SymTab.Name;
+ 1869                                               lxD, lx2: MGen.LitStr;
+ 1870                                               v2: BOOLEAN;
+ 1871                                               vn2: SymTab.Name;
+ 1872                                               vi: INTEGER;
+ 1873                                               c: CARDINAL;
+ 1874                                               b: LONGCARD;
+ 1875                                               sfxF: BOOLEAN;
+ 1876                                               okF: BOOLEAN; .)
+ 1877      = integer                         (. LexString(s);
+ 1878                                           MGen.CopyName(s, lx);
+ 1879                                           v := FALSE; MGen.ClrStash();
+ 1880                                           IF MGen.ParseInt(s, vi) THEN
+ 1881                                             MGen.PushInt(vi)
+ 1882                                           ELSIF MGen.ParseCard(s, c) THEN
+ 1883                                             MGen.PushBits(
+ 1884                                               VAL(LONGCARD, c))
+ 1885                                           ELSE MGen.PushInt(0)
+ 1886                                           END;
+ 1887                                           t := SymTab.IntType(); .)
+ 1888      | real                            (. LexString(s);
+ 1889                                           MGen.CopyName(s, lx);
+ 1890                                           v := FALSE; MGen.ClrStash();
+ 1891                                           IF MGen.ParseReal(s, b) THEN
+ 1892                                             MGen.PushBits(b)
+ 1893                                           ELSE MGen.PushBits(0H)
+ 1894                                           END;
+ 1895                                           t := SymTab.RealType(); .)
+ 1896      | string                          (. LexString(s);
+ 1897                                           v := FALSE; MGen.ClrStash();
+ 1898                                           IF SymTab.StrLen(s) <= 3 THEN
+ 1899                                             t := SymTab.CharType();
+ 1900                                             MGen.CopyName(s, lx);
+ 1901                                             MGen.PushInt(
+ 1902                                               MGen.CharOrd(s))
+ 1903                                           ELSE t := SymTab.NewStr();
+ 1904                                             MGen.CopyName(s, lx);
+ 1905                                             MGen.EmitString(s)
+ 1906                                           END; .)
+ 1907      | "HIGH"
+ 1908        "(" DesignHead<dt, dk, bnF, FALSE, lxD>
+ 1909            DesignTail<dt, dk, bnF, FALSE, lxD, sfxF>
+ 1910        ")"                               (. lx[0] := 0C; v := FALSE; MGen.ClrStash();
+ 1911                                             IF dt = SymTab.InvalidType THEN
+ 1912                                               IF sfxF THEN MGen.Drop END;
+ 1913                                               MGen.PushInt(0);
+ 1914                                               t := SymTab.InvalidType
+ 1915                                             ELSIF SymTab.ClassOf(dt)
+ 1916                                                    # SymTab.ClArray THEN
+ 1917                                               SemError(217);
+ 1918                                               IF sfxF THEN MGen.Drop END;
+ 1919                                               MGen.PushInt(0);
+ 1920                                               t := SymTab.InvalidType
+ 1921                                             ELSIF SymTab.IsOpen(dt) THEN
+ 1922                                               IF sfxF THEN MGen.Drop END;
+ 1923                                               IF (dk = SymTab.KindParam)
+ 1924                                                  OR (dk
+ 1925                                                   = SymTab.KindVarPar) THEN
+ 1926                                                 IF SymTab.CurDepth()
+ 1927                                                    = SymTab.SymDepth(bnF) THEN
+ 1928                                                   MGen.LoadLocal(
+ 1929                                                     SymTab.SymSlot(bnF) + 1)
+ 1930                                                 ELSE
+ 1931                                                   MGen.FrameAddr(
+ 1932                                                     SymTab.SymSlot(bnF) + 1,
+ 1933                                                     VAL(CARDINAL,
+ 1934                                                       SymTab.CurDepth() - 1
+ 1935                                                       - SymTab.SymDepth(bnF)));
+ 1936                                                   MGen.LoadIndir
+ 1937                                                 END;
+ 1938                                                 MGen.PushInt(1);
+ 1939                                                 MGen.Sub;
+ 1940                                                 t := SymTab.IntType()
+ 1941                                               ELSE
+ 1942                                                 MGen.PushInt(0);
+ 1943                                                 t := SymTab.InvalidType
+ 1944                                               END
+ 1945                                             ELSE
+ 1946                                               IF sfxF THEN MGen.Drop END;
+ 1947                                               MGen.PushInt(
+ 1948                                                 SymTab.ArrayHi(dt));
+ 1949                                               t := SymTab.IntType()
+ 1950                                             END; .)
+ 1951      | DesignHead<dt, dk, bnF, TRUE, lxD>
+ 1952        DesignTail<dt, dk, bnF, TRUE, lxD, sfxF>
+ 1953                                          (. t := dt;
+ 1954                                             MGen.CopyName(lxD, lx);
+ 1955                                             IF sfxF
+ 1956                                                & (t # SymTab.InvalidType)
+ 1957                                                & MGen.ActIsVarNext()
+ 1958                                                & ((dk = SymTab.KindVar)
+ 1959                                                   OR (dk
+ 1960                                                       = SymTab.KindParam)
+ 1961                                                   OR (dk
+ 1962                                                       = SymTab.KindVarPar)
+ 1963                                                   OR (dk
+ 1964                                                       = SymTab.KindField))
+ 1965                                                & (SymTab.SymKind(bnF)
+ 1966                                                   # SymTab.KindModule)
+ 1967                                                & (SymTab.ClassOf(t)
+ 1968                                                   # SymTab.ClChar)
+ 1969                                                & (SymTab.ClassOf(t)
+ 1970                                                   # SymTab.ClBool) THEN
+ 1971                                               MGen.StashAddr()
+ 1972                                             END;
+ 1973                                             IF sfxF
+ 1974                                                & (t # SymTab.InvalidType)
+ 1975                                                & (SymTab.ClassOf(t)
+ 1976                                                   # SymTab.ClArray)
+ 1977                                                & (SymTab.ClassOf(t)
+ 1978                                                   # SymTab.ClRecord) THEN
+ 1979                                               IF (SymTab.ClassOf(t)
+ 1980                                                  = SymTab.ClChar)
+ 1981                                                  OR (SymTab.ClassOf(t)
+ 1982                                                     = SymTab.ClBool) THEN
+ 1983                                                 MGen.LoadByte
+ 1984                                               ELSE MGen.LoadIndir
+ 1985                                               END
+ 1986                                             END;
+ 1987                                             v := ~sfxF
+ 1988                                                  & ((dk = SymTab.KindVar)
+ 1989                                                  OR (dk = SymTab.KindParam)
+ 1990                                                  OR (dk
+ 1991                                                      = SymTab.KindVarPar));
+ 1992                                             MGen.CopyName(bnF, vn); .)
+ 1993        [ CallTail<bnF, lxD, sfxF, TRUE, okF, TRUE>
+ 1994                                          (. IF okF THEN
+ 1995                                               IF SymTab.SymKind(bnF)
+ 1996                                                  = SymTab.KindProc THEN
+ 1997                                                 t := SymTab.ProcRet(bnF)
+ 1998                                               ELSIF (SymTab.SymKind(bnF)
+ 1999                                                         = SymTab.KindModule)
+ 2000                                                  & sfxF
+ 2001                                                  & (SymTab.StrLen(lxD) > 0)
+ 2002                                                  & (SymTab.ExpProc(bnF,
+ 2003                                                       lxD) >= 0) THEN
+ 2004                                                 t := SymTab.ProcRetByNum(
+ 2005                                                        SymTab.ExpProc(bnF,
+ 2006                                                          lxD))
+ 2007                                               ELSE
+ 2008                                                 t := SymTab.InvalidType
+ 2009                                               END
+ 2010                                             ELSE t := SymTab.InvalidType
+ 2011                                             END;
+ 2012                                             lx[0] := 0C; v := FALSE;
+ 2013                                             MGen.ClrStash(); .) ]
+ 2014      | "("
+ 2015        Expr<et, lx, v, vn> ")"         (. t := et; .)
+ 2016      | ( "NOT" | "~" )
+ 2017        Fact<t2, lx2, v2, vn2>          (. lx[0] := 0C; v := FALSE; MGen.ClrStash();
+ 2018                                           IF SymTab.BoolCheck(t2) THEN
+ 2019                                             t := SymTab.BoolType()
+ 2020                                           ELSE SemError(212);
+ 2021                                             t := SymTab.InvalidType END;
+ 2022                                           MGen.Not; .)
+ 2023      | SetLit<st>                      (. lx[0] := 0C; v := FALSE; MGen.ClrStash();
+ 2024                                           t := st; .) .
+ 2025    SetLit <VAR t: SymTab.TypeIndex>
+ 2026                                          (. VAR first, et: SymTab.TypeIndex;
+ 2027                                               lxE, lxE2: MGen.LitStr;
+ 2028                                               vE, vE2: BOOLEAN;
+ 2029                                               vnE, vnE2: SymTab.Name;
+ 2030                                               hasR: BOOLEAN; .)
+ 2031      = "{"
+ 2032                                  (. MGen.PushInt(0);
+ 2033                                     t := SymTab.SetFor(SymTab.IntType()); .)
+ 2034        [ Elem<et, lxE, lxE2, hasR>   (. first := et;
+ 2035                                         t := SymTab.SetFor(et);
+ 2036                                         MGen.ClrStash();
+ 2037                                         IF hasR THEN
+ 2038                                           MGen.PushInt(1); MGen.Add;
+ 2039                                           MGen.FieldMask
+ 2040                                         ELSE MGen.Power2 END;
+ 2041                                         MGen.Or; .)
+ 2042          { ","
+ 2043            Elem<et, lxE, lxE2, hasR> (. IF ~SymTab.SetElemCheck(first, et) THEN
+ 2044                                         SemError(222) END;
+ 2045                                         MGen.ClrStash();
+ 2046                                         IF hasR THEN
+ 2047                                           MGen.PushInt(1); MGen.Add;
+ 2048                                           MGen.FieldMask
+ 2049                                         ELSE MGen.Power2 END;
+ 2050                                         MGen.Or; .) } ]
+ 2051        "}" .
+ 2052    Elem <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
+ 2053          VAR lx2: MGen.LitStr; VAR hasR: BOOLEAN>
+ 2054                                          (. VAR t2: SymTab.TypeIndex;
+ 2055                                               vD, vD2: BOOLEAN;
+ 2056                                               vnD, vnD2: SymTab.Name; .)
+ 2057      = Expr<t, lx, vD, vnD>              (. hasR := FALSE;
+ 2058                                             lx2[0] := 0C; .)
+ 2059        [ ".."
+ 2060          Expr<t2, lx2, vD2, vnD2>        (. IF ~SymTab.SetElemCheck(t, t2) THEN
+ 2061                                             SemError(222) END;
+ 2062                                             hasR := TRUE; .) ] .
+ 2063  
+ 2064    GetIdent <VAR n: SymTab.Name>
+ 2065      = ident                           (. LexName(n); .) .
+ 2066  
+ 2067  END M2c.
 
     0 errors
 

+ 32 - 10
M2cP.mod

@@ -216,6 +216,7 @@ PROCEDURE SetLit (VAR t: SymTab.TypeIndex);
       Elem(et, lxE, lxE2, hasR);
       first := et;
       t := SymTab.SetFor(et);
+      MGen.ClrStash();
       IF hasR THEN
         MGen.PushInt(1); MGen.Add;
         MGen.FieldMask
@@ -226,6 +227,7 @@ PROCEDURE SetLit (VAR t: SymTab.TypeIndex);
         Elem(et, lxE, lxE2, hasR);
         IF ~SymTab.SetElemCheck(first, et) THEN
         SemError(222) END;
+        MGen.ClrStash();
         IF hasR THEN
           MGen.PushInt(1); MGen.Add;
           MGen.FieldMask
@@ -281,7 +283,7 @@ PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
         Get;
         LexString(s);
         MGen.CopyName(s, lx);
-        v := FALSE;
+        v := FALSE; MGen.ClrStash();
         IF MGen.ParseInt(s, vi) THEN
           MGen.PushInt(vi)
         ELSIF MGen.ParseCard(s, c) THEN
@@ -294,7 +296,7 @@ PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
         Get;
         LexString(s);
         MGen.CopyName(s, lx);
-        v := FALSE;
+        v := FALSE; MGen.ClrStash();
         IF MGen.ParseReal(s, b) THEN
           MGen.PushBits(b)
         ELSE MGen.PushBits(0H)
@@ -303,7 +305,7 @@ PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
     | 4 :
         Get;
         LexString(s);
-        v := FALSE;
+        v := FALSE; MGen.ClrStash();
         IF SymTab.StrLen(s) <= 3 THEN
           t := SymTab.CharType();
           MGen.CopyName(s, lx);
@@ -319,7 +321,7 @@ PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
         DesignHead(dt, dk, bnF, FALSE, lxD);
         DesignTail(dt, dk, bnF, FALSE, lxD, sfxF);
         Expect(20);
-        lx[0] := 0C; v := FALSE;
+        lx[0] := 0C; v := FALSE; MGen.ClrStash();
         IF dt = SymTab.InvalidType THEN
           IF sfxF THEN MGen.Drop END;
           MGen.PushInt(0);
@@ -365,6 +367,24 @@ PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
         DesignTail(dt, dk, bnF, TRUE, lxD, sfxF);
         t := dt;
         MGen.CopyName(lxD, lx);
+        IF sfxF
+           & (t # SymTab.InvalidType)
+           & MGen.ActIsVarNext()
+           & ((dk = SymTab.KindVar)
+              OR (dk
+                  = SymTab.KindParam)
+              OR (dk
+                  = SymTab.KindVarPar)
+              OR (dk
+                  = SymTab.KindField))
+           & (SymTab.SymKind(bnF)
+              # SymTab.KindModule)
+           & (SymTab.ClassOf(t)
+              # SymTab.ClChar)
+           & (SymTab.ClassOf(t)
+              # SymTab.ClBool) THEN
+          MGen.StashAddr()
+        END;
         IF sfxF
            & (t # SymTab.InvalidType)
            & (SymTab.ClassOf(t)
@@ -405,7 +425,8 @@ PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
             END
           ELSE t := SymTab.InvalidType
           END;
-          lx[0] := 0C; v := FALSE;;
+          lx[0] := 0C; v := FALSE;
+          MGen.ClrStash();;
         END;
     | 19 :
         Get;
@@ -419,7 +440,7 @@ PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
           Get;
         END;
         Fact(t2, lx2, v2, vn2);
-        lx[0] := 0C; v := FALSE;
+        lx[0] := 0C; v := FALSE; MGen.ClrStash();
         IF SymTab.BoolCheck(t2) THEN
           t := SymTab.BoolType()
         ELSE SemError(212);
@@ -427,7 +448,7 @@ PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
         MGen.Not;;
     | 73 :
         SetLit(st);
-        lx[0] := 0C; v := FALSE;
+        lx[0] := 0C; v := FALSE; MGen.ClrStash();
         t := st;;
     ELSE SynError(77);
     END;
@@ -462,7 +483,7 @@ PROCEDURE Term (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
     WHILE In(symSet[2], sym) DO
       MulOp(op);
       Fact(t2, lx2, v2, vn2);
-      lx[0] := 0C; v := FALSE;
+      lx[0] := 0C; v := FALSE; MGen.ClrStash();
       IF op = SymTab.OpAnd THEN
         IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
           t := SymTab.BoolType()
@@ -547,6 +568,7 @@ PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
     Term(t, lx, v, vn);
     IF neg THEN
     v := FALSE;
+    MGen.ClrStash();
     IF MGen.IsLit(lx) THEN
       MGen.NegFold(lx, lx)
     ELSE lx[0] := 0C
@@ -560,7 +582,7 @@ PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
     WHILE (sym = 47) OR (sym = 62) OR (sym = 63) DO
       AddOp(op);
       Term(t2, lx2, v2, vn2);
-      lx[0] := 0C; v := FALSE;
+      lx[0] := 0C; v := FALSE; MGen.ClrStash();
       IF op = SymTab.OpOr THEN
         IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
           t := SymTab.BoolType()
@@ -2307,7 +2329,7 @@ PROCEDURE Expr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
     IF In(symSet[5], sym) THEN
       Rel(op);
       SimExpr(t2, lx2, v2, vn2);
-      lx[0] := 0C; v := FALSE;
+      lx[0] := 0C; v := FALSE; MGen.ClrStash();
       IF op = SymTab.OpIn THEN
         IF SymTab.InCheck(t, t2) THEN
           t := SymTab.BoolType();


+ 8 - 0
MGen.def

@@ -286,6 +286,14 @@ PROCEDURE ActIsVarNext (): BOOLEAN;
    (known callee, in range). Used to keep addresses (not values)
    for VAR a[i] actuals. *)
 
+PROCEDURE StashAddr;
+(* Duplicates the address on top of stack into a per-actual temp of
+   the current call frame (VAR actuals with tails). *)
+
+PROCEDURE ClrStash;
+(* Invalidates the stashed address of the current actual (a
+   value-combining operator followed). *)
+
 PROCEDURE NoteSfx (b: BOOLEAN);
 (* Records tails-present for the current actual (top frame). *)
 

+ 59 - 7
MGen.mod

@@ -68,6 +68,7 @@ TYPE
     n : CARDINAL;
     tmps : ARRAY [0 .. MaxActN] OF INTEGER;
     lens : ARRAY [0 .. MaxActN] OF INTEGER;
+    addrs : ARRAY [0 .. MaxActN] OF INTEGER;
     sfxs : ARRAY [0 .. MaxActN] OF BOOLEAN;
     idxs : ARRAY [0 .. MaxActN] OF BOOLEAN;
     known : BOOLEAN;
@@ -658,6 +659,7 @@ PROCEDURE ActBegin (pn: ARRAY OF CHAR);
     k := 0;
     WHILE k <= MaxActN DO
       actSt[fr].lens[k] := -1;
+      actSt[fr].addrs[k] := -1;
       actSt[fr].sfxs[k] := FALSE;
       actSt[fr].idxs[k] := TRUE;
       INC(k)
@@ -686,6 +688,7 @@ PROCEDURE ActBeginNum (num: INTEGER);
     k := 0;
     WHILE k <= MaxActN DO
       actSt[fr].lens[k] := -1;
+      actSt[fr].addrs[k] := -1;
       actSt[fr].sfxs[k] := FALSE;
       actSt[fr].idxs[k] := TRUE;
       INC(k)
@@ -717,6 +720,36 @@ PROCEDURE ActFormalIsVar (fr, i: CARDINAL): BOOLEAN;
     END
   END ActFormalIsVar;
 
+PROCEDURE StashAddr;
+(* Duplicates the address on top of stack into a per-actual temp of
+   the current call frame (for VAR actuals with tails: a[i], p^,
+   fields). The ATG calls this at the Fact tail, when the address is
+   complete but not yet loaded. Recorded as -1 when unused. *)
+  VAR fr, i : CARDINAL;
+    tmp : INTEGER;
+  BEGIN
+    IF actTop = 0 THEN RETURN END;
+    fr := ActFrameIdx();
+    i := actSt[fr].n;
+    IF i > MaxActN THEN RETURN END;
+    tmp := TempGlobal();
+    actSt[fr].addrs[i] := tmp;
+    EmitOp(OPdup);
+    StoreTemp(tmp)
+  END StashAddr;
+
+PROCEDURE ClrStash;
+(* Invalidates the stashed address of the current actual: a
+   value-combining operator followed, so the address no longer
+   denotes the actual. Conservative no-op outside calls. *)
+  VAR fr, i : CARDINAL;
+  BEGIN
+    IF actTop = 0 THEN RETURN END;
+    fr := ActFrameIdx();
+    i := actSt[fr].n;
+    IF i <= MaxActN THEN actSt[fr].addrs[i] := -1 END
+  END ClrStash;
+
 PROCEDURE ActValue (t: INTEGER; v: BOOLEAN;
                     vn: ARRAY OF CHAR): INTEGER;
   VAR fr : CARDINAL;
@@ -744,7 +777,7 @@ PROCEDURE ActValue (t: INTEGER; v: BOOLEAN;
         ELSIF ~SymTab.SameType(SymTab.ArrayElem(t),
                                SymTab.ArrayElem(ftyp)) THEN
           err := 1
-        ELSIF fv & ~v THEN
+        ELSIF fv & ~v & (actSt[fr].addrs[i] < 0) THEN
           err := 1
         END;
         IF (t # SymTab.InvalidType)
@@ -757,15 +790,34 @@ PROCEDURE ActValue (t: INTEGER; v: BOOLEAN;
         actSt[fr].lens[i] := TempGlobal();
         StoreTemp(actSt[fr].lens[i]);
         IF fv THEN
+          IF (err = 0) & (actSt[fr].addrs[i] >= 0) THEN
+            (* tailed array actual: its address is already on top *)
+          ELSE
+            EmitOp(OPext); EmitOp(SUBdrop);
+            PushAddr(vn)
+          END
+        END
+      ELSIF fv THEN
+        IF actSt[fr].addrs[i] >= 0 THEN
+          IF (t # SymTab.InvalidType)
+             & ((SymTab.ClassOf(t) = SymTab.ClArray)
+                OR (SymTab.ClassOf(t) = SymTab.ClRecord)) THEN
+            (* tailed composite actual: address already on top *)
+          ELSIF SymTab.SameType(t, ftyp) THEN
+            EmitOp(OPext); EmitOp(SUBdrop);
+            LoadTemp(actSt[fr].addrs[i])
+          ELSE
+            err := 1;
+            EmitOp(OPext); EmitOp(SUBdrop);
+            PushAddr(vn)
+          END
+        ELSE
+          IF ~v THEN err := 1
+          ELSIF ~SymTab.SameType(t, ftyp) THEN err := 1
+          END;
           EmitOp(OPext); EmitOp(SUBdrop);
           PushAddr(vn)
         END
-      ELSIF fv THEN
-        IF ~v THEN err := 1
-        ELSIF ~SymTab.SameType(t, ftyp) THEN err := 1
-        END;
-        EmitOp(OPext); EmitOp(SUBdrop);
-        PushAddr(vn)
       ELSE
         IF ~SymTab.Assignable(t, ftyp) THEN err := 1
         ELSIF SymTab.IsIntFamily(t)










+ 50 - 0
docs/summary_step8.md

@@ -0,0 +1,50 @@
+# Step 8 — VAR actuals with tails (uncommitted)
+
+127/127 tests green (120 + 5 run + 2 rejection; `v_bad_var` repurposed),
+mc64 boot + example green, Showcase still 157.
+
+## Goal
+
+Accept `a[i]`, `p^` and record fields as `VAR` actuals (error 233 since
+step 4), using the dormant scaffolding (`ActIsVarNext`, per-actual frame
+slots). Keep every old suite green with zero behavior change outside
+`VAR`-want position.
+
+## What was built
+
+- `MGen`: `ActFrame.addrs[]` (per-actual stashed address temp, -1 when
+  unused); `StashAddr` (DUP + temp-store at the Fact tail, where the
+  address is complete but not yet loaded — uniform for `[]`, `^` and
+  `.` tails); `ClrStash` (invalidates on any value-combining action);
+  `ActValue` takes the stashed address for `VAR` formals (address already
+  on top for whole array/record actuals, else drop value + reload stash).
+- `M2c.atg`: Fact tail stashes when tailed + `ActIsVarNext()` + head is
+  `Var/Param/VarPar/Field` + head is not a module + final type is not
+  `CHAR`/`BOOLEAN`; `ClrStash()` at every combining site (Rel/AddOp/MulOp
+  actions, unary neg, `NOT`, literals, `HIGH`, call results, set elements).
+- `run_tests.sh`: step-8 sections added.
+
+## Tests — 127/127 (120 + 5 + 2)
+
+5 run: `v_idx` 35 (`a[2]`, `a[4]`), `v_deref` 105 (`p^.val`),
+`v_field` 1031 (`r.b.v`), `v_rec` 16 (whole `r.b` to `VAR` record formal),
+`v_row` 21 (matrix rows to `VAR` open-array formal). 3 rejections, each
+exactly one error: `v_bad_var` 233 (repurposed: `P(a[i]+1)` — operators
+defeat the stash), `v_bad_byte` 233 (`CHAR` elements are byte-packed, no
+valid slot address), `v_bad_with` 233 (`WITH`-field actuals).
+Bonus finding: row-to-`VAR`-open works, free of charge.
+
+## Bugs found and fixed
+
+1. Stale-stash accept: `P(a[i]+1)` first compiled (stash from `a[i]`)
+   because nothing invalidated the address when `+1` followed. Every
+   value-combining action now calls `ClrStash()`; direction of error is
+   safe (a missed site would only cause a loud 233, and the audit covered
+   all `Fact` alternatives, all operator loops, `NOT`, `HIGH`, call
+   results and set elements; parens stay transparent).
+
+## Known limits (deferred)
+
+`WITH`-field `VAR` actuals (233), `CHAR`/`BOOLEAN` elements or fields as
+`VAR` actuals (233, byte-packing), module vars as `VAR` actuals (233),
+type exports, `DEFINITION`/`IMPLEMENTATION` split, module `BEGIN` bodies.

+ 11 - 0
run_tests.sh

@@ -248,5 +248,16 @@ expect_fail m_bad_mvar.mod "invalid procedure call"
 expect_fail m_bad_mfunc.mod "invalid procedure call"
 expect_fail m_bad_nope.mod "undeclared identifier"
 
+echo "=== Step-8 run tests (VAR tails) ==="
+expect_run v_idx.mod 35
+expect_run v_deref.mod 105
+expect_run v_field.mod 1031
+expect_run v_rec.mod 16
+expect_run v_row.mod 21
+
+echo "=== Step-8 rejection tests ==="
+expect_fail v_bad_byte.mod "invalid procedure call"
+expect_fail v_bad_with.mod "invalid procedure call"
+
 echo "=== $pass passed, $fail failed ==="
 test "$fail" = 0

+ 18 - 0
tests/v_bad_byte.LST

@@ -0,0 +1,18 @@
+Listing:
+
+    1  MODULE VBadByte;
+    2  VAR c : ARRAY [1 .. 5] OF CHAR; ExitCode : INTEGER;
+    3  PROCEDURE Bump(VAR x : CHAR);
+    4  BEGIN
+    5    x := "z"
+    6  END Bump;
+    7  BEGIN
+    8    c[1] := "a";
+    9    Bump(c[1]);
+*****            ^ invalid procedure call
+   10    ExitCode := 0
+   11  END VBadByte.
+
+    1 error
+
+

+ 11 - 0
tests/v_bad_byte.mod

@@ -0,0 +1,11 @@
+MODULE VBadByte;
+VAR c : ARRAY [1 .. 5] OF CHAR; ExitCode : INTEGER;
+PROCEDURE Bump(VAR x : CHAR);
+BEGIN
+  x := "z"
+END Bump;
+BEGIN
+  c[1] := "a";
+  Bump(c[1]);
+  ExitCode := 0
+END VBadByte.

+ 2 - 2
tests/v_bad_var.LST

@@ -6,8 +6,8 @@ Listing:
     4  BEGIN
     5  END P;
     6  BEGIN
-    7    P(a[1])
-*****         ^ invalid procedure call
+    7    P(a[1] + 1)
+*****             ^ invalid procedure call
     8  END VBadVar.
 
     1 error

+ 1 - 1
tests/v_bad_var.mod

@@ -4,5 +4,5 @@ PROCEDURE P(VAR x : INTEGER);
 BEGIN
 END P;
 BEGIN
-  P(a[1])
+  P(a[1] + 1)
 END VBadVar.

+ 19 - 0
tests/v_bad_with.LST

@@ -0,0 +1,19 @@
+Listing:
+
+    1  MODULE VBadWith;
+    2  TYPE Rec = RECORD a, b : INTEGER END;
+    3  VAR r : Rec; ExitCode : INTEGER;
+    4  PROCEDURE Bump(VAR x : INTEGER);
+    5  BEGIN
+    6    x := x + 1
+    7  END Bump;
+    8  BEGIN
+    9    r.a := 1; r.b := 2;
+   10    WITH r DO Bump(a) END;
+*****                   ^ invalid procedure call
+   11    ExitCode := 0
+   12  END VBadWith.
+
+    1 error
+
+

+ 12 - 0
tests/v_bad_with.mod

@@ -0,0 +1,12 @@
+MODULE VBadWith;
+TYPE Rec = RECORD a, b : INTEGER END;
+VAR r : Rec; ExitCode : INTEGER;
+PROCEDURE Bump(VAR x : INTEGER);
+BEGIN
+  x := x + 1
+END Bump;
+BEGIN
+  r.a := 1; r.b := 2;
+  WITH r DO Bump(a) END;
+  ExitCode := 0
+END VBadWith.

+ 20 - 0
tests/v_deref.LST

@@ -0,0 +1,20 @@
+Listing:
+
+    1  MODULE VDeref;
+    2  TYPE Node = RECORD val : INTEGER; next : POINTER TO Node END;
+    3  TYPE PNode = POINTER TO Node;
+    4  VAR p : PNode; ExitCode : INTEGER;
+    5  PROCEDURE Bump(VAR x : INTEGER);
+    6  BEGIN
+    7    x := x + 100
+    8  END Bump;
+    9  BEGIN
+   10    NEW(p);
+   11    p^.val := 5;
+   12    Bump(p^.val);
+   13    ExitCode := p^.val
+   14  END VDeref.
+
+    0 errors
+
+

+ 14 - 0
tests/v_deref.mod

@@ -0,0 +1,14 @@
+MODULE VDeref;
+TYPE Node = RECORD val : INTEGER; next : POINTER TO Node END;
+TYPE PNode = POINTER TO Node;
+VAR p : PNode; ExitCode : INTEGER;
+PROCEDURE Bump(VAR x : INTEGER);
+BEGIN
+  x := x + 100
+END Bump;
+BEGIN
+  NEW(p);
+  p^.val := 5;
+  Bump(p^.val);
+  ExitCode := p^.val
+END VDeref.

+ 21 - 0
tests/v_field.LST

@@ -0,0 +1,21 @@
+Listing:
+
+    1  MODULE VField;
+    2  TYPE Inner = RECORD u, v : INTEGER END;
+    3  TYPE Outer = RECORD a : INTEGER; b : Inner END;
+    4  VAR r : Outer; ExitCode : INTEGER;
+    5  PROCEDURE Bump(VAR x : INTEGER);
+    6  BEGIN
+    7    x := x + 1000
+    8  END Bump;
+    9  BEGIN
+   10    r.a := 1;
+   11    r.b.u := 10;
+   12    r.b.v := 20;
+   13    Bump(r.b.v);
+   14    ExitCode := r.a + r.b.u + r.b.v
+   15  END VField.
+
+    0 errors
+
+

+ 15 - 0
tests/v_field.mod

@@ -0,0 +1,15 @@
+MODULE VField;
+TYPE Inner = RECORD u, v : INTEGER END;
+TYPE Outer = RECORD a : INTEGER; b : Inner END;
+VAR r : Outer; ExitCode : INTEGER;
+PROCEDURE Bump(VAR x : INTEGER);
+BEGIN
+  x := x + 1000
+END Bump;
+BEGIN
+  r.a := 1;
+  r.b.u := 10;
+  r.b.v := 20;
+  Bump(r.b.v);
+  ExitCode := r.a + r.b.u + r.b.v
+END VField.

+ 18 - 0
tests/v_idx.LST

@@ -0,0 +1,18 @@
+Listing:
+
+    1  MODULE VIdx;
+    2  VAR a : ARRAY [1 .. 5] OF INTEGER; ExitCode : INTEGER;
+    3  PROCEDURE Bump(VAR x : INTEGER);
+    4  BEGIN
+    5    x := x + 10
+    6  END Bump;
+    7  BEGIN
+    8    a[1] := 1; a[2] := 2; a[3] := 3; a[4] := 4; a[5] := 5;
+    9    Bump(a[2]);
+   10    Bump(a[4]);
+   11    ExitCode := a[1] + a[2] + a[3] + a[4] + a[5]
+   12  END VIdx.
+
+    0 errors
+
+

+ 12 - 0
tests/v_idx.mod

@@ -0,0 +1,12 @@
+MODULE VIdx;
+VAR a : ARRAY [1 .. 5] OF INTEGER; ExitCode : INTEGER;
+PROCEDURE Bump(VAR x : INTEGER);
+BEGIN
+  x := x + 10
+END Bump;
+BEGIN
+  a[1] := 1; a[2] := 2; a[3] := 3; a[4] := 4; a[5] := 5;
+  Bump(a[2]);
+  Bump(a[4]);
+  ExitCode := a[1] + a[2] + a[3] + a[4] + a[5]
+END VIdx.

+ 20 - 0
tests/v_rec.LST

@@ -0,0 +1,20 @@
+Listing:
+
+    1  MODULE VRec;
+    2  TYPE Inner = RECORD u, v : INTEGER END;
+    3  TYPE Outer = RECORD a : INTEGER; b : Inner END;
+    4  VAR r : Outer; ExitCode : INTEGER;
+    5  PROCEDURE SetZ(VAR q : Inner);
+    6  BEGIN
+    7    q.u := 7;
+    8    q.v := 8
+    9  END SetZ;
+   10  BEGIN
+   11    r.a := 1;
+   12    SetZ(r.b);
+   13    ExitCode := r.a + r.b.u + r.b.v
+   14  END VRec.
+
+    0 errors
+
+

+ 14 - 0
tests/v_rec.mod

@@ -0,0 +1,14 @@
+MODULE VRec;
+TYPE Inner = RECORD u, v : INTEGER END;
+TYPE Outer = RECORD a : INTEGER; b : Inner END;
+VAR r : Outer; ExitCode : INTEGER;
+PROCEDURE SetZ(VAR q : Inner);
+BEGIN
+  q.u := 7;
+  q.v := 8
+END SetZ;
+BEGIN
+  r.a := 1;
+  SetZ(r.b);
+  ExitCode := r.a + r.b.u + r.b.v
+END VRec.

+ 20 - 0
tests/v_row.LST

@@ -0,0 +1,20 @@
+Listing:
+
+    1  MODULE VRow;
+    2  VAR m : ARRAY [1 .. 2], [1 .. 3] OF INTEGER; ExitCode : INTEGER;
+    3  PROCEDURE Sum(VAR x : ARRAY OF INTEGER) : INTEGER;
+    4  VAR i, s : INTEGER;
+    5  BEGIN
+    6    s := 0;
+    7    FOR i := 0 TO HIGH(x) DO s := s + x[i] END;
+    8    RETURN s
+    9  END Sum;
+   10  BEGIN
+   11    m[1,1] := 1; m[1,2] := 2; m[1,3] := 3;
+   12    m[2,1] := 4; m[2,2] := 5; m[2,3] := 6;
+   13    ExitCode := Sum(m[1]) + Sum(m[2])
+   14  END VRow.
+
+    0 errors
+
+

+ 14 - 0
tests/v_row.mod

@@ -0,0 +1,14 @@
+MODULE VRow;
+VAR m : ARRAY [1 .. 2], [1 .. 3] OF INTEGER; ExitCode : INTEGER;
+PROCEDURE Sum(VAR x : ARRAY OF INTEGER) : INTEGER;
+VAR i, s : INTEGER;
+BEGIN
+  s := 0;
+  FOR i := 0 TO HIGH(x) DO s := s + x[i] END;
+  RETURN s
+END Sum;
+BEGIN
+  m[1,1] := 1; m[1,2] := 2; m[1,3] := 3;
+  m[2,1] := 4; m[2,2] := 5; m[2,3] := 6;
+  ExitCode := Sum(m[1]) + Sum(m[2])
+END VRow.