|
|
@@ -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)
|