Ver Fonte

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 há 2 dias atrás
pai
commit
6b8617572e
2 ficheiros alterados com 67 adições e 15 exclusões
  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
    old `parmOff + 2 − off` while every slot is 2.  Nothing observable moved
    (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
    `type`/`const`/`var` inside a nested function (`CALC.INC:767-778`, the
    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
                                        field table (0,0 when not a record) *)
          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 ;
          local  : BOOLEAN ;
          resvar : CARDINAL ;
@@ -1474,6 +1476,8 @@ BEGIN
    e.fldFirst := 0 ;
    e.fldLast := 0 ;
    e.arrIdx := 0 ;
+   e.parmFirst := 0 ;
+   e.parmCount := 0 ;
    e.level := lexnest ;
    e.local := local ;
    e.resvar := 0 ;
@@ -2062,7 +2066,8 @@ PROCEDURE ParseType (VAR cls, size, elem : CARDINAL) ; FORWARD ;
 PROCEDURE Statmnt () ; FORWARD ;
 PROCEDURE ParseCall (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)                                           *)
@@ -3203,8 +3208,24 @@ BEGIN
    END
 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 ;
 BEGIN
    IF symtab [idx].defnd THEN
@@ -3213,8 +3234,8 @@ BEGIN
       p := EmCall (0) ;
       AddPend (1, idx, p)
    END ;
-   IF nk > 0 THEN
-      EmAddSp (2 * nk)
+   IF cleanup > 0 THEN
+      EmAddSp (cleanup)
    END
 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
    declared parameter is the one at BP+4 (RESUME-TP3.md 3.11). *)
 VAR arg : ERes ;
-    nArgs : CARDINAL ;
+    nArgs, cleanup, slot : CARDINAL ;
 BEGIN
    nArgs := 0 ;
+   cleanup := 0 ;
    IF CurCh () = ')' THEN
       DropCh (GetCh ())
    ELSE
@@ -3243,8 +3265,18 @@ BEGIN
             EXIT
          END ;
          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) ;
          EmPushAx () ;
+         cleanup := cleanup + slot ;
          INC (nArgs) ;
          IF NOT MatchDelim (',') THEN
             EXIT
@@ -3252,16 +3284,17 @@ BEGIN
       END ;
       ExpectDelim (')', ENoSemi)
    END ;
-   EmCallMost (idx, nArgs)
+   EmCallMost (idx, cleanup)
 END ParseCallArgs ;
 
 PROCEDURE ParseCall (idx : CARDINAL) ;
 (* procedure/function call; '(' optional - same parse-then-push as above,
    reached from ParseAtom when a FUNCTION is called in an expression *)
 VAR arg : ERes ;
-    nArgs : CARDINAL ;
+    nArgs, cleanup, slot : CARDINAL ;
 BEGIN
    nArgs := 0 ;
+   cleanup := 0 ;
    IF MatchDelim ('(') THEN
       IF CurCh () # ')' THEN
          LOOP
@@ -3270,8 +3303,15 @@ BEGIN
                EXIT
             END ;
             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) ;
             EmPushAx () ;
+            cleanup := cleanup + slot ;
             INC (nArgs) ;
             IF NOT MatchDelim (',') THEN
                EXIT
@@ -3282,7 +3322,7 @@ BEGIN
          DropCh (GetCh ())
       END
    END ;
-   EmCallMost (idx, nArgs)
+   EmCallMost (idx, cleanup)
 END ParseCall ;
 
 PROCEDURE ParseExpr (VAR r : ERes) ;
@@ -4749,6 +4789,15 @@ BEGIN
                         - SlotSize (symtab [i].cls, symtab [i].size) ;
       INC (i)
    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 MatchDelim (':') THEN
          ParseType (cls, size, elem)