1.0.18.22: DX arguments in non-let-converted local calls

 * When a non-let function has dynamic extent arguments, the
   combination must end its block, or stack analysis will miss the
   cleanup, and stack will be popped too soon.

diff --git a/NEWS b/NEWS
index 382cc2e..a0ee21d 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,8 @@
 changes in sbcl-1.0.19 relative to 1.0.18:
   * bug fix: compiler no longer makes erronous assumptions in the
     presense of non-foldable SATISFIES types.
+  * bug fix: stack analysis missed cleanups of dynamic-extent
+    arguments in non-let-converted calls to local functions.
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** interval arithmetic during type derivation used inexact integer
        to single-float coercions.

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index 31e8136..d6235cd 100644 (file)
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -76,6 +76,11 @@
                   (not (lvar-dynamic-extent arg)))
         append (handle-nested-dynamic-extent-lvars arg) into dx-lvars
         finally (when dx-lvars
+                  ;; A call to non-LET with DX args must end its block,
+                  ;; otherwise stack analysis will not see the combination and
+                  ;; the associated cleanup/entry.
+                  (unless (eq :let (functional-kind fun))
+                    (node-ends-block call))
                   (binding* ((before-ctran (node-prev call))
                              (nil (ensure-block-start before-ctran))
                              (block (ctran-block before-ctran))

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index da58dbf..4eb2db3 100644 (file)
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -534,4 +534,33 @@
         (declare (dynamic-extent #'mget #'mset))
         ((lambda (f g) (eval `(progn ,f ,g (values 4 5 6)))) #'mget #'mset)))))
 (assert (equal (bug419 42) '(1 2 3 4 5 6)))
+
+;;; Multiple DX arguments in a local function call
+(defun test-dx-flet-test (fun n f1 f2 f3)
+  (let ((res (with-output-to-string (s)
+               (assert (eql n (ignore-errors (funcall fun s)))))))
+    (multiple-value-bind (x pos) (read-from-string res nil)
+      (assert (equalp f1 x))
+      (multiple-value-bind (y pos2) (read-from-string res nil nil :start pos)
+        (assert (equalp f2 y))
+        (assert (equalp f3 (read-from-string res nil nil :start pos2))))))
+  (assert-no-consing (assert (eql n (funcall fun nil)))))
+(macrolet ((def (n f1 f2 f3)
+             (let ((name (sb-pcl::format-symbol :cl-user "DX-FLET-TEST.~A" n)))
+               `(progn
+                  (defun-with-dx ,name (s)
+                    (flet ((f (x)
+                             (declare (dynamic-extent x))
+                             (when s
+                               (print x s)
+                               (finish-output s))
+                             nil))
+                      (f ,f1)
+                      (f ,f2)
+                      (f ,f3)
+                      ,n))
+                  (test-dx-flet-test #',name ,n ,f1 ,f2 ,f3)))))
+  (def 0 (list :one) (list :two) (list :three))
+  (def 1 (make-array 128) (list 1 2 3 4 5 6 7 8) (list 'list))
+  (def 2 (list 1) (list 2 3) (list 4 5 6 7)))
 \f

diff --git a/version.lisp-expr b/version.lisp-expr
index d3d5033..05cf14a 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.18.21"
+"1.0.18.22"