X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1opt.lisp;h=b538652ed0d60021d48a9254a26dd1af0216d401;hb=beccf6c476f5cf2ef0bd839866527a46ec88d626;hp=9bf0a584ccaf103e1958d4d269680100599b6433;hpb=15e14ef1ccd3ab6f4711632435a40493dc4cdd9d;p=sbcl.git

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 9bf0a58..b538652 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -337,7 +337,11 @@
               (not (eq (block-home-lambda block)
                        (block-home-lambda next)))
               ;; Stack analysis phase wants ENTRY to start a block.
-              (entry-p (block-start-node next)))
+              (entry-p (block-start-node next))
+              (let ((last (block-last block)))
+                (and (valued-node-p last)
+                     (awhen (node-lvar last)
+                       (consp (lvar-uses it))))))
              nil)
             (t
              (join-blocks block next)
@@ -905,7 +909,9 @@
 		 (lvar-uses (basic-combination-fun call))
 		 call))
 	       ((not leaf))
-	       ((and (leaf-has-source-name-p leaf)
+	       ((and (global-var-p leaf)
+                     (eq (global-var-kind leaf) :global-function)
+                     (leaf-has-source-name-p leaf)
                      (or (info :function :source-transform (leaf-source-name leaf))
                          (and info
                               (ir1-attributep (fun-info-attributes info)
@@ -971,7 +977,7 @@
 	       (:aborted
 		(setf (combination-kind node) :error)
 		(when args
-		  (apply #'compiler-warn args))
+		  (apply #'warn args))
 		(remhash node table)
 		nil)
 	       (:failure
@@ -1078,10 +1084,9 @@
                                 (block-next (node-block call)))
       (let ((new-fun (ir1-convert-inline-lambda
 		      res
-		      :debug-name (debug-namify "LAMBDA-inlined ~A"
-						(as-debug-name
-						 source-name
-						 "<unknown function>"))))
+		      :debug-name (debug-namify "LAMBDA-inlined " 
+						source-name 
+						"<unknown function>")))
 	    (ref (lvar-use (combination-fun call))))
 	(change-ref-leaf ref new-fun)
 	(setf (combination-kind call) :full)
@@ -1746,7 +1751,9 @@
                   (unless next-block
                     (when ctran (ensure-block-start ctran))
                     (setq next-block (first (block-succ (node-block cast))))
-                    (ensure-block-start (node-prev cast)))
+                    (ensure-block-start (node-prev cast))
+                    (reoptimize-lvar lvar)
+                    (setf (lvar-%derived-type value) nil))
                   (%delete-lvar-use use)
                   (add-lvar-use use lvar)
                   (unlink-blocks (node-block use) (node-block cast))
@@ -1767,7 +1774,9 @@
           ;; FIXME: Do it in one step.
           (filter-lvar
            value
-           `(multiple-value-call #'list 'dummy))
+           (if (cast-single-value-p cast)
+               `(list 'dummy)
+               `(multiple-value-call #'list 'dummy)))
           (filter-lvar
            (cast-value cast)
            ;; FIXME: Derived type.