X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flocall.lisp;h=1c6db26ec5390103b5c7821db9902f8dbb5d16ab;hb=c0578d9893429c9c0da80ea5920360e4621fddab;hp=fe1dea83f7ad075c6ab78c474e3a1441f7102778;hpb=6822034325136cde4e14773c83c3769b42721306;p=sbcl.git

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index fe1dea8..1c6db26 100644
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -58,9 +58,14 @@
                 (handle-nested-dynamic-extent-lvars dx (cast-value use)))
                (combination
                 (loop for arg in (combination-args use)
-                      when (lvar-good-for-dx-p arg dx)
-                      append (handle-nested-dynamic-extent-lvars dx arg))))))
-      (cons lvar
+                      ;; deleted args show up as NIL here
+                      when (and arg (lvar-good-for-dx-p arg dx))
+                      append (handle-nested-dynamic-extent-lvars dx arg)))
+               (ref
+                (let* ((other (trivial-lambda-var-ref-lvar use)))
+                  (unless (eq other lvar)
+                    (handle-nested-dynamic-extent-lvars dx other)))))))
+      (cons (cons dx lvar)
             (if (listp uses)
                 (loop for use in uses
                       when (use-good-for-dx-p use dx)
@@ -90,8 +95,8 @@
                           (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))
 
 ;;; This function handles merging the tail sets if CALL is potentially
@@ -205,9 +210,6 @@
                do (entries `((eql ,n-supplied ,n)
                              (%funcall ,(force ep) ,@(subseq temps 0 n)))))
          `(lambda (,n-supplied ,@temps)
-            ;; FIXME: Make sure that INDEX type distinguishes between
-            ;; target and host. (Probably just make the SB!XC:DEFTYPE
-            ;; different from CL:DEFTYPE.)
             (declare (type index ,n-supplied))
             (cond
              ,@(if more (butlast (entries)) (entries))
@@ -215,8 +217,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
@@ -240,7 +241,8 @@
   (with-ir1-environment-from-node (lambda-bind (main-entry fun))
     (let ((res (ir1-convert-lambda (make-xep-lambda-expression fun)
                                    :debug-name (debug-name
-                                                'xep (leaf-debug-name fun)))))
+                                                'xep (leaf-debug-name fun))
+                                   :system-lambda t)))
       (setf (functional-kind res) :external
             (leaf-ever-used res) t
             (functional-entry-fun res) fun
@@ -595,7 +597,8 @@
                (%funcall ,entry ,@args))
             :debug-name (debug-name 'hairy-function-entry
                                     (lvar-fun-debug-name
-                                     (basic-combination-fun call)))))))
+                                     (basic-combination-fun call)))
+            :system-lambda t))))
     (convert-call ref call new-fun)
     (dolist (ref (leaf-refs entry))
       (convert-call-if-possible ref (lvar-dest (node-lvar ref))))))
@@ -855,6 +858,8 @@
     (setf (lambda-physenv clambda) home-physenv)
 
     (when physenv
+      (unless home-physenv
+        (setf home-physenv (get-lambda-physenv home)))
       (setf (physenv-nlx-info home-physenv)
             (nconc (physenv-nlx-info physenv)
                    (physenv-nlx-info home-physenv))))