Test for broken copy-more-arg harder

* It takes 17 fixed arguments for (threaded) PPC to fail.  Test
  for up to 33 arguments now.

* Also, add some comments to explain why SP shouldn't be set to its
  final value eagerly when the stack frame is smaller than the fixed
  arguments: accessing slots past SP is a bad idea when interrupts
  could hit and overwrite these values.  In such cases, leave SP
  pointing to the end of the source vector, and only move it back to
  the end of the destination vector after the copy loop.

diff --git a/src/compiler/x86-64/call.lisp b/src/compiler/x86-64/call.lisp
index c1fa08e..4c4fdab 100644 (file)
--- a/src/compiler/x86-64/call.lisp
+++ b/src/compiler/x86-64/call.lisp
@@ -1132,7 +1132,10 @@
 
     ;; Allocate the space on the stack.
     ;; stack = rbp + sp->fp-offset - (max 3 frame-size) - (nargs - fixed)
-    ;; if we'd move SP backward, swap the meaning of rsp and source
+    ;; if we'd move SP backward, swap the meaning of rsp and source;
+    ;; otherwise, we'd be accessing values below SP, and that's no good
+    ;; if a signal interrupts this code sequence.  In that case, store
+    ;; the final value in rsp after the stack-stack memmove loop.
     (inst lea (if (<= fixed (max 3 (sb-allocated-size 'stack)))
                   rsp-tn
                   source)

diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp
index 58100b7..b0bbd96 100644 (file)
--- a/src/compiler/x86/call.lisp
+++ b/src/compiler/x86/call.lisp
@@ -1202,7 +1202,10 @@
     ;; Problem: this might leave some &more args outside esp, so
     ;; clamp the movement for now.  If fixed > frame-size, reset
     ;; esp to the end of the current &more args (which *should*
-    ;; be a noop?)
+    ;; be a noop?), and only set esp to its final value after the
+    ;; stack-stack memmove loop.  Otherwise, an unlucky signal
+    ;; could end up overwriting the &more arguments before they're
+    ;; moved in their final place.
     (inst lea ebx-tn
           (make-ea :dword :base ebp-tn
                           :disp (* n-word-bytes

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index ee6905e..c61786e 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4843,19 +4843,20 @@
   ;; Fixed on x86oids only, but other platforms still start
   ;; their stack frames at 8 slots, so this is less likely
   ;; to happen.
-  (labels ((iota (n)
-             (loop for i below n collect i))
-           (test-function (function skip)
-             ;; function should just be (subseq x skip)
-             (loop for i from skip below (+ skip 16) do
-               (let* ((values (iota i))
-                      (f (apply function values))
-                      (subseq (subseq values skip)))
-                 (assert (equal f subseq)))))
-           (make-function (n)
-             (let ((gensyms (loop for i below n collect (gensym))))
-               (compile nil `(lambda (,@gensyms &rest rest)
-                               (declare (ignore ,@gensyms))
-                               rest)))))
-    (dotimes (i 16)
-      (test-function (make-function i) i))))
+  (let ((limit 33))
+    (labels ((iota (n)
+               (loop for i below n collect i))
+             (test-function (function skip)
+               ;; function should just be (subseq x skip)
+               (loop for i from skip below (+ skip limit) do
+                 (let* ((values (iota i))
+                        (f (apply function values))
+                        (subseq (subseq values skip)))
+                   (assert (equal f subseq)))))
+             (make-function (n)
+               (let ((gensyms (loop for i below n collect (gensym))))
+                 (compile nil `(lambda (,@gensyms &rest rest)
+                                 (declare (ignore ,@gensyms))
+                                 rest)))))
+      (dotimes (i limit)
+        (test-function (make-function i) i)))))