make TRIVIAL-LAMBDA-VAR-REF-P false for XEPs

  Also clean up TRIVIAL-LAMBDA-VAR-REF-LVAR.

  Fixes lp#803508.

diff --git a/NEWS b/NEWS
index 2eab9df..f1498bf 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -72,6 +72,8 @@ changes relative to sbcl-1.0.54:
     errors on debugger entry.
   * bug fix: build ignored --dynamic-space-size=<size> argument to make.sh
     (regression since 1.0.53)
+  * bug fix: attempts to stack allocate a required argument to a function with
+    an external entry point caused compiler-errors.
 
 changes in sbcl-1.0.54 relative to sbcl-1.0.53:
   * minor incompatible changes:

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 33a8d3d..5959b9f 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -550,8 +550,9 @@
                     (neq :indefinite (lambda-var-extent var)))
            (let ((home (lambda-var-home var))
                  (refs (lambda-var-refs var)))
-             ;; bound by a system lambda, no other REFS
+             ;; bound by a non-XEP system lambda, no other REFS
              (when (and (lambda-system-lambda-p home)
+                        (neq :external (lambda-kind home))
                         (eq use (car refs)) (not (cdr refs)))
                ;; the LAMBDA this var is bound by has only a single REF, going
                ;; to a combination
@@ -563,16 +564,15 @@
 
 (defun trivial-lambda-var-ref-lvar (use)
   (let* ((this (ref-leaf use))
-         (home (lambda-var-home this)))
-    (multiple-value-bind (fun vars)
-        (values home (lambda-vars home))
-      (let* ((combination (lvar-dest (ref-lvar (car (lambda-refs fun)))))
-             (args (combination-args combination)))
-        (assert (= (length vars) (length args)))
-        (loop for var in vars
-              for arg in args
-              when (eq var this)
-              return arg)))))
+         (fun (lambda-var-home this))
+         (vars (lambda-vars fun))
+         (combination (lvar-dest (ref-lvar (car (lambda-refs fun)))))
+         (args (combination-args combination)))
+    (aver (= (length vars) (length args)))
+    (loop for var in vars
+          for arg in args
+          when (eq var this)
+          return arg)))
 
 ;;; This needs to play nice with LVAR-GOOD-FOR-DX-P and friends.
 (defun handle-nested-dynamic-extent-lvars (dx lvar &optional recheck-component)

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 72da1a6..9ef4a21 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4139,3 +4139,17 @@
     (assert (not (search "GENERIC"
                          (with-output-to-string (s)
                            (disassemble fun :stream s)))))))
+
+(with-test (:name :bug-803508)
+  (compile nil `(lambda ()
+                  (print
+                   (lambda (bar)
+                     (declare (dynamic-extent bar))
+                     (foo bar))))))
+
+(with-test (:name :bug-803508-b)
+  (compile nil `(lambda ()
+                  (list
+                   (lambda (bar)
+                     (declare (dynamic-extent bar))
+                     (foo bar))))))