[Sbcl-commits] master: Test for broken copy-more-arg harder

[Paul K. <pk...@us...>]

The branch "master" has been updated in SBCL:
       via  d7cbe5c40e93796d326937f3fb962fa4d7b1fa85 (commit)
      from  9b79c4c51954ffc46c631e56547ac865860e8855 (commit)

- Log -----------------------------------------------------------------
commit d7cbe5c40e93796d326937f3fb962fa4d7b1fa85
Author: Paul Khuong <pv...@pv...>
Date:   Sat Sep 21 21:05:14 2013 -0400

    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.
---
 src/compiler/x86-64/call.lisp |    5 ++++-
 src/compiler/x86/call.lisp    |    5 ++++-
 tests/compiler.pure.lisp      |   33 +++++++++++++++++----------------
 3 files changed, 25 insertions(+), 18 deletions(-)

diff --git a/src/compiler/x86-64/call.lisp b/src/compiler/x86-64/call.lisp
index c1fa08e..4c4fdab 100644
--- 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
--- 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
--- 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)))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL