Fix automatic &rest to &more conversion in unsafe code

 Applying &rest lists to known/typed functions can lead to a
 :fixed values call to %more-arg-values.  In that case, unroll
 it into several %more-arg of constant indices.

 Reported, with test case, by Lutz Euler (lp#826459).

diff --git a/NEWS b/NEWS
index 66637d2..a0816bb 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -46,6 +46,8 @@ changes relative to sbcl-1.0.50:
   * bug fix: bound propagation involving conversion of large bignums to
     floats no longer signals a SIMPLE-TYPE-ERROR, reported by Lutz Euler.
     (lp#819269)
+  * bug fix: &REST to &MORE conversion still works in unsafe call to known
+    functions; reported by Lutz Euler (lp#826459).
 
 changes in sbcl-1.0.50 relative to sbcl-1.0.49:
   * enhancement: errors from FD handlers now provide a restart to remove

diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index a4fda56..1674834 100644 (file)
--- a/src/compiler/ir2tran.lisp
+++ b/src/compiler/ir2tran.lisp
@@ -1482,7 +1482,17 @@
   (binding* ((lvar (node-lvar node) :exit-if-null)
              (2lvar (lvar-info lvar)))
     (ecase (ir2-lvar-kind 2lvar)
-      (:fixed (ir2-convert-full-call node block))
+      (:fixed
+       ;; KLUDGE: this is very much unsafe, and can leak random stack values.
+       ;; OTOH, I think the :FIXED case can only happen with (safety 0) in the
+       ;; first place.
+       ;;  -PK
+       (loop for loc in (ir2-lvar-locs 2lvar)
+             for idx upfrom 0
+             do (vop sb!vm::more-arg node block
+                     (lvar-tn node block context)
+                     (make-constant-tn (find-constant idx))
+                     loc)))
       (:unknown
        (let ((locs (ir2-lvar-locs 2lvar)))
          (vop* %more-arg-values node block

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 0e271e1..5f24fbe 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3967,3 +3967,9 @@
                   (compile nil `(lambda (i)
                                   (declare (unsigned-byte i))
                                   (cos (expt 10 (+ 4096 i)))))))))
+
+(with-test (:name :fixed-%more-arg-values)
+  (let ((fun (compile nil `(lambda (&rest rest)
+                             (declare (optimize (safety 0)))
+                             (apply #'cons rest)))))
+    (assert (equal '(car . cdr) (funcall fun 'car 'cdr)))))