X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flocall.lisp;h=ed3e34fabc6e5e2dad342ba0f3d291c7c9ec9f83;hb=d25e3478acccec70402ff32554669a982be8e281;hp=dffb4d0557a32c921c33585b8d2fe296c2d1f6bd;hpb=a160917364f85b38dc0826a5e3dcef87e3c4c62c;p=sbcl.git

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index dffb4d0..ed3e34f 100644
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -65,7 +65,7 @@
                 (let* ((other (trivial-lambda-var-ref-lvar use)))
                   (unless (eq other lvar)
                     (handle-nested-dynamic-extent-lvars dx other)))))))
-      (cons lvar
+      (cons (cons dx lvar)
             (if (listp uses)
                 (loop for use in uses
                       when (use-good-for-dx-p use dx)
@@ -95,10 +95,41 @@
                           (make-lexenv :default (node-lexenv call)
                                        :cleanup cleanup))
                     (push entry (lambda-entries (node-home-lambda entry)))
-                    (dolist (lvar dx-lvars)
-                      (setf (lvar-dynamic-extent lvar) cleanup)))))
+                    (dolist (cell dx-lvars)
+                      (setf (lvar-dynamic-extent (cdr cell)) cleanup)))))
   (values))
 
+;;; Called after a transform has been applied to CALL: if the call has a DX
+;;; result, propagate the DXness to the new functional as well.
+;;;
+;;; This is needed in case an earlier call to LOCALL-ANALYZE-COMPONENT
+;;; collected DX information before the transformation, in which case a later
+;;; call to LOCALL-ANALYZE-COMPONENT would not pick up the DX declaration
+;;; again, since the call has already been converted. (In other words, work
+;;; around the fact that optimization iterates, and locall analysis may have
+;;; already run by the time we are able to transform something.)
+(defun maybe-propagate-dynamic-extent (call fun)
+  (when (lambda-p fun)
+    (let* ((lvar (combination-lvar call))
+           (cleanup (or (and lvar (lvar-dynamic-extent lvar))
+                        (return-from maybe-propagate-dynamic-extent)))
+           (ret (lambda-return fun))
+           (res (if ret
+                    (return-result ret)
+                    (return-from maybe-propagate-dynamic-extent)))
+           (dx (car (rassoc lvar (cleanup-info cleanup) :test #'eq)))
+           (new-dx-lvars (if (and dx res)
+                             (handle-nested-dynamic-extent-lvars dx res)
+                             (return-from maybe-propagate-dynamic-extent))))
+      (when new-dx-lvars
+        ;; This builds on what RECOGNIZE-DYNAMIC-EXTENT-LVARS does above.
+        (aver (eq call (block-last (node-block call))))
+        (dolist (cell new-dx-lvars)
+          (let ((lvar (cdr cell)))
+            (aver (not (lvar-dynamic-extent lvar)))
+            (push cell (cleanup-info cleanup))
+            (setf (lvar-dynamic-extent (cdr cell)) cleanup)))))))
+
 ;;; This function handles merging the tail sets if CALL is potentially
 ;;; tail-recursive, and is a call to a function with a different
 ;;; TAIL-SET than CALL's FUN. This must be called whenever we alter
@@ -217,8 +248,7 @@
                  ;; KLUDGE: (NOT (< ...)) instead of >= avoids one round of
                  ;; deftransforms and lambda-conversion.
                  `((,(if (zerop min) t `(not (< ,n-supplied ,max)))
-                    ,(let ((n-context (gensym))
-                           (n-count (gensym)))
+                    ,(with-unique-names (n-context n-count)
                        `(multiple-value-bind (,n-context ,n-count)
                             (%more-arg-context ,n-supplied ,max)
                           (locally