Jelajahi Sumber

compiler: parameter LIST on the proc symbol (string value params, step 2)

Still behaviour-preserving: every accepted parameter is a 2-byte scalar, so
nothing observable moves (matrix 67/67, ladder unchanged at ERR 102 10350,
56/56 executed under qemu and Exec86).

  - SymEntry.parmFirst/parmCount point at the procedure's parameter symbols.
    ProcFunc records them after the slot layout; a definition that reads no
    list (a FORWARD's `function Expression;' definition repeating only the
    name) does NOT clobber the forward's list.
  - ParmSlot (idx, k) is argument k's slot size from that list (2 when out of
    range, preserving the old assumption rather than inventing an arity error).
  - Both call sites (ParseCallArgs, ParseCall) size each argument via ParmSlot,
    and EmCallMost now cleans up the SUM of slot sizes instead of 2*n.
  - A slot wider than 2 is a LOUD ENoLib: step 3 is what pushes a string's
    whole slot, and pushing two bytes of a 71-byte argument would be a silent
    miscompile.

run_all.sh: ALL PASS - matrix 67/67, ladder 1/1 at ERR 102 10350, 58 linked,
56 executed under qemu and Exec86.
Eric Streit 2 hari lalu
induk
melakukan
6b8617572e
2 mengubah file dengan 67 tambahan dan 15 penghapusan
  1. 9 6
      CALC-COMPILE.md
  2. 58 9
      shell/Compiler.mod

+ 9 - 6
CALC-COMPILE.md

@@ -521,12 +521,15 @@ and green after, an execution proof where the image fits, and a commit.
    general `off := 8 + frameTotal − off − slot`, which reduces exactly to the
    general `off := 8 + frameTotal − off − slot`, which reduces exactly to the
    old `parmOff + 2 − off` while every slot is 2.  Nothing observable moved
    old `parmOff + 2 − off` while every slot is 2.  Nothing observable moved
    (matrix 67/67, ladder unchanged, framedisp PASS, 56/56 executed).
    (matrix 67/67, ladder unchanged, framedisp PASS, 56/56 executed).
-   **Next:** (2) store the parameter list on the procedure symbol so a call
-   site can size each argument; (3) push a string's whole slot (`SUB SP,size /
-   MOV DI,SP / MOV SI,src / MOV CX,size / CLD / REP MOVSB`, or a `TU_PushStr`
-   entry) and allow `size > 2` for string parameters; (4) a fixture where the
-   callee **mutates** `S` and the caller's variable is unchanged — the value
-   semantics TP3 promises.  `var` parameters proper are item 6.
+   **Next:** (3) push a string's whole slot (`SUB SP,size / MOV DI,SP / MOV
+   SI,src / MOV CX,size / CLD / REP MOVSB`, or a `TU_PushStr` entry) and allow
+   `size > 2` for string parameters; (4) a fixture where the callee **mutates**
+   `S` and the caller's variable is unchanged — the value semantics TP3
+   promises.  `var` parameters proper are item 6.
+   **Step 2 is DONE too:** the procedure symbol carries `parmFirst`/`parmCount`,
+   `ParmSlot (idx, k)` sizes each argument from it, and `EmCallMost` cleans up
+   the sum of slot sizes.  Still behaviour-identical (every slot 2), and a
+   slot > 2 is a loud `ENoLib` until step 3 pushes it.
 2. **The rest of the declaration part**, if the rung is still there: local
 2. **The rest of the declaration part**, if the rung is still there: local
    `type`/`const`/`var` inside a nested function (`CALC.INC:767-778`, the
    `type`/`const`/`var` inside a nested function (`CALC.INC:767-778`, the
    enum-indexed array of strings), `Succ`/`Pred`/`Ord`/`Chr`.
    enum-indexed array of strings), `Succ`/`Pred`/`Ord`/`Chr`.

+ 58 - 9
shell/Compiler.mod

@@ -170,6 +170,8 @@ TYPE
          fldFirst, fldLast : CARDINAL ;  (* a RECORD type's field range in the
          fldFirst, fldLast : CARDINAL ;  (* a RECORD type's field range in the
                                        field table (0,0 when not a record) *)
                                        field table (0,0 when not a record) *)
          arrIdx : CARDINAL ;        (* an ARRAY type's shape in ArrRec (0 = no) *)
          arrIdx : CARDINAL ;        (* an ARRAY type's shape in ArrRec (0 = no) *)
+         parmFirst, parmCount : CARDINAL ;  (* a PROCEDURE/FUNCTION's parameters:
+                                       symtab indices, in declaration order *)
          level  : CARDINAL ;
          level  : CARDINAL ;
          local  : BOOLEAN ;
          local  : BOOLEAN ;
          resvar : CARDINAL ;
          resvar : CARDINAL ;
@@ -1474,6 +1476,8 @@ BEGIN
    e.fldFirst := 0 ;
    e.fldFirst := 0 ;
    e.fldLast := 0 ;
    e.fldLast := 0 ;
    e.arrIdx := 0 ;
    e.arrIdx := 0 ;
+   e.parmFirst := 0 ;
+   e.parmCount := 0 ;
    e.level := lexnest ;
    e.level := lexnest ;
    e.local := local ;
    e.local := local ;
    e.resvar := 0 ;
    e.resvar := 0 ;
@@ -2062,7 +2066,8 @@ PROCEDURE ParseType (VAR cls, size, elem : CARDINAL) ; FORWARD ;
 PROCEDURE Statmnt () ; FORWARD ;
 PROCEDURE Statmnt () ; FORWARD ;
 PROCEDURE ParseCall (idx : CARDINAL) ; FORWARD ;
 PROCEDURE ParseCall (idx : CARDINAL) ; FORWARD ;
 PROCEDURE ParseCallArgs (idx : CARDINAL) ; FORWARD ;
 PROCEDURE ParseCallArgs (idx : CARDINAL) ; FORWARD ;
-PROCEDURE EmCallMost (idx, nk : CARDINAL) ; FORWARD ;
+PROCEDURE EmCallMost (idx, cleanup : CARDINAL) ; FORWARD ;
+PROCEDURE SlotSize (cls, size : CARDINAL) : CARDINAL ; FORWARD ;
 
 
 (* ---------------------------------------------------------------- *)
 (* ---------------------------------------------------------------- *)
 (*  expressions  (TPSRC9)                                           *)
 (*  expressions  (TPSRC9)                                           *)
@@ -3203,8 +3208,24 @@ BEGIN
    END
    END
 END AddPend ;
 END AddPend ;
 
 
-PROCEDURE EmCallMost (idx, nk : CARDINAL) ;
-(* emit the call to sym 'idx' and clean up nk value arguments *)
+PROCEDURE ParmSlot (idx, k : CARDINAL) : CARDINAL ;
+(* The stack slot of argument k (0-based) of procedure/function idx, from the
+   parameter list recorded on the symbol.  Out of range means the source passed
+   more arguments than there are parameters: keep the old two-byte assumption
+   rather than inventing an arity error here. *)
+VAR pi : CARDINAL ;
+BEGIN
+   IF (symtab [idx].parmCount = 0) OR (k >= symtab [idx].parmCount) THEN
+      RETURN 2
+   END ;
+   pi := symtab [idx].parmFirst + k ;
+   RETURN SlotSize (symtab [pi].cls, symtab [pi].size)
+END ParmSlot ;
+
+PROCEDURE EmCallMost (idx, cleanup : CARDINAL) ;
+(* emit the call to sym 'idx' and clean up `cleanup' bytes of arguments, which
+   is the SUM of their slot sizes - not 2 per argument once a slot can be
+   larger than a word. *)
 VAR p : CARDINAL ;
 VAR p : CARDINAL ;
 BEGIN
 BEGIN
    IF symtab [idx].defnd THEN
    IF symtab [idx].defnd THEN
@@ -3213,8 +3234,8 @@ BEGIN
       p := EmCall (0) ;
       p := EmCall (0) ;
       AddPend (1, idx, p)
       AddPend (1, idx, p)
    END ;
    END ;
-   IF nk > 0 THEN
-      EmAddSp (2 * nk)
+   IF cleanup > 0 THEN
+      EmAddSp (cleanup)
    END
    END
 END EmCallMost ;
 END EmCallMost ;
 
 
@@ -3231,9 +3252,10 @@ PROCEDURE ParseCallArgs (idx : CARDINAL) ;
    first argument goes on first and so ends up farthest from BP, and the LAST
    first argument goes on first and so ends up farthest from BP, and the LAST
    declared parameter is the one at BP+4 (RESUME-TP3.md 3.11). *)
    declared parameter is the one at BP+4 (RESUME-TP3.md 3.11). *)
 VAR arg : ERes ;
 VAR arg : ERes ;
-    nArgs : CARDINAL ;
+    nArgs, cleanup, slot : CARDINAL ;
 BEGIN
 BEGIN
    nArgs := 0 ;
    nArgs := 0 ;
+   cleanup := 0 ;
    IF CurCh () = ')' THEN
    IF CurCh () = ')' THEN
       DropCh (GetCh ())
       DropCh (GetCh ())
    ELSE
    ELSE
@@ -3243,8 +3265,18 @@ BEGIN
             EXIT
             EXIT
          END ;
          END ;
          ParseExpr (arg) ;
          ParseExpr (arg) ;
+         slot := ParmSlot (idx, nArgs) ;
+         IF slot > 2 THEN
+            (* A value parameter wider than a word (a string): its whole slot
+               must be pushed, which is step 3 of the calling-convention work.
+               Loud, because pushing two bytes of a 71-byte argument would be
+               a silent miscompile. *)
+            Err (ENoLib) ;
+            EXIT
+         END ;
          LoadAtom (arg) ;
          LoadAtom (arg) ;
          EmPushAx () ;
          EmPushAx () ;
+         cleanup := cleanup + slot ;
          INC (nArgs) ;
          INC (nArgs) ;
          IF NOT MatchDelim (',') THEN
          IF NOT MatchDelim (',') THEN
             EXIT
             EXIT
@@ -3252,16 +3284,17 @@ BEGIN
       END ;
       END ;
       ExpectDelim (')', ENoSemi)
       ExpectDelim (')', ENoSemi)
    END ;
    END ;
-   EmCallMost (idx, nArgs)
+   EmCallMost (idx, cleanup)
 END ParseCallArgs ;
 END ParseCallArgs ;
 
 
 PROCEDURE ParseCall (idx : CARDINAL) ;
 PROCEDURE ParseCall (idx : CARDINAL) ;
 (* procedure/function call; '(' optional - same parse-then-push as above,
 (* procedure/function call; '(' optional - same parse-then-push as above,
    reached from ParseAtom when a FUNCTION is called in an expression *)
    reached from ParseAtom when a FUNCTION is called in an expression *)
 VAR arg : ERes ;
 VAR arg : ERes ;
-    nArgs : CARDINAL ;
+    nArgs, cleanup, slot : CARDINAL ;
 BEGIN
 BEGIN
    nArgs := 0 ;
    nArgs := 0 ;
+   cleanup := 0 ;
    IF MatchDelim ('(') THEN
    IF MatchDelim ('(') THEN
       IF CurCh () # ')' THEN
       IF CurCh () # ')' THEN
          LOOP
          LOOP
@@ -3270,8 +3303,15 @@ BEGIN
                EXIT
                EXIT
             END ;
             END ;
             ParseExpr (arg) ;
             ParseExpr (arg) ;
+            slot := ParmSlot (idx, nArgs) ;
+            IF slot > 2 THEN
+               (* see ParseCallArgs: a string slot needs its whole width *)
+               Err (ENoLib) ;
+               EXIT
+            END ;
             LoadAtom (arg) ;
             LoadAtom (arg) ;
             EmPushAx () ;
             EmPushAx () ;
+            cleanup := cleanup + slot ;
             INC (nArgs) ;
             INC (nArgs) ;
             IF NOT MatchDelim (',') THEN
             IF NOT MatchDelim (',') THEN
                EXIT
                EXIT
@@ -3282,7 +3322,7 @@ BEGIN
          DropCh (GetCh ())
          DropCh (GetCh ())
       END
       END
    END ;
    END ;
-   EmCallMost (idx, nArgs)
+   EmCallMost (idx, cleanup)
 END ParseCall ;
 END ParseCall ;
 
 
 PROCEDURE ParseExpr (VAR r : ERes) ;
 PROCEDURE ParseExpr (VAR r : ERes) ;
@@ -4749,6 +4789,15 @@ BEGIN
                         - SlotSize (symtab [i].cls, symtab [i].size) ;
                         - SlotSize (symtab [i].cls, symtab [i].size) ;
       INC (i)
       INC (i)
    END ;
    END ;
+   (* Record the parameter list on the procedure symbol: a call site has to
+      know each argument's SLOT size to push and clean up the right number of
+      bytes.  Only when this definition actually read a list - a FORWARD's
+      list is kept, and the later `function Expression;' that repeats only the
+      name must not wipe it. *)
+   IF symTop > nestMark THEN
+      symtab [old].parmFirst := nestMark ;
+      symtab [old].parmCount := symTop - nestMark
+   END ;
    IF isFunc THEN
    IF isFunc THEN
       IF MatchDelim (':') THEN
       IF MatchDelim (':') THEN
          ParseType (cls, size, elem)
          ParseType (cls, size, elem)