X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir2tran.lisp;h=a1ac4dc8f541763f2470fb5f5bab57255c6d571f;hb=02f7f85a6554b1ec233e9a515c4c511fe092565e;hp=146e8ec4ff9e6b3ce6c7b08e51e5cf28497572c9;hpb=175fc9f1e9ec03b80cbc6e7f84c5295e45c2e52c;p=sbcl.git

diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index 146e8ec..a1ac4dc 100644
--- a/src/compiler/ir2tran.lisp
+++ b/src/compiler/ir2tran.lisp
@@ -1795,9 +1795,6 @@
 
 (defoptimizer (mask-signed-field ir2-convert) ((width x) node block)
   (block nil
-    (when (template-p (basic-combination-info node))
-      (ir2-convert-template node block)
-      (return))
     (when (constant-lvar-p width)
       (case (lvar-value width)
         (#.(- sb!vm:n-word-bits sb!vm:n-fixnum-tag-bits)
@@ -1834,7 +1831,9 @@
                   temp (first results))
              (move-lvar-result node block results lvar)
              (return))))))
-    (ir2-convert-full-call node block)))
+    (if (template-p (basic-combination-info node))
+        (ir2-convert-template node block)
+        (ir2-convert-full-call node block))))
 
 ;;; Convert the code in a component into VOPs.
 (defun ir2-convert (component)
@@ -1898,9 +1897,13 @@
 
 ;;; If necessary, emit a terminal unconditional branch to go to the
 ;;; successor block. If the successor is the component tail, then
-;;; there isn't really any successor, but if the end is an unknown,
-;;; non-tail call, then we emit an error trap just in case the
-;;; function really does return.
+;;; there isn't really any successor, but if the end is a non-tail
+;;; call to a function that's not *known* to never return, then we
+;;; emit an error trap just in case the function really does return.
+;;;
+;;; Trapping after known calls makes it easier to understand type
+;;; derivation bugs at runtime: they show up as nil-fun-returned-error,
+;;; rather than the execution of arbitrary code or error traps.
 (defun finish-ir2-block (block)
   (declare (type cblock block))
   (let* ((2block (block-info block))
@@ -1911,15 +1914,20 @@
       (let ((target (first succ)))
         (cond ((eq target (component-tail (block-component block)))
                (when (and (basic-combination-p last)
-                          (eq (basic-combination-kind last) :full))
+                          (or (eq (basic-combination-kind last) :full)
+                              (and (eq (basic-combination-kind last) :known)
+                                   (eq (basic-combination-info last) :full))))
                  (let* ((fun (basic-combination-fun last))
                         (use (lvar-uses fun))
                         (name (and (ref-p use)
                                    (leaf-has-source-name-p (ref-leaf use))
-                                   (leaf-source-name (ref-leaf use)))))
+                                   (leaf-source-name (ref-leaf use))))
+                        (ftype (and (info :function :info name) ; only use the FTYPE if
+                                    (info :function :type name)))) ; NAME was DEFKNOWN
                    (unless (or (node-tail-p last)
-                               (info :function :info name)
-                               (policy last (zerop safety)))
+                               (policy last (zerop safety))
+                               (and (fun-type-p ftype)
+                                    (eq *empty-type* (fun-type-returns ftype))))
                      (vop nil-fun-returned-error last 2block
                           (if name
                               (emit-constant name)