1.0.24.48: Do explicit sign-extension of small signed alien return values

[sbcl.git] / src / compiler / ir1opt.lisp

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 548c1c9..d1d9e68 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -758,6 +758,14 @@
 
   (values))
 
+(defun xep-tail-combination-p (node)
+  (and (combination-p node)
+       (let* ((lvar (combination-lvar node))
+              (dest (when (lvar-p lvar) (lvar-dest lvar)))
+              (lambda (when (return-p dest) (return-lambda dest))))
+         (and (lambda-p lambda)
+              (eq :external (lambda-kind lambda))))))
+
 ;;; If NODE doesn't return (i.e. return type is NIL), then terminate
 ;;; the block there, and link it to the component tail.
 ;;;
@@ -783,7 +791,10 @@
     (declare (ignore lvar))
     (unless (or (and (eq node (block-last block)) (eq succ tail))
                 (block-delete-p block))
-      (when (eq (node-derived-type node) *empty-type*)
+      ;; Even if the combination will never return, don't terminate if this
+      ;; is the tail call of a XEP: doing that would inhibit TCO.
+      (when (and (eq (node-derived-type node) *empty-type*)
+                 (not (xep-tail-combination-p node)))
         (cond (ir1-converting-not-optimizing-p
                (cond
                  ((block-last block)
@@ -849,14 +860,18 @@
              ((nil :maybe-inline) (policy call (zerop space))))
            (defined-fun-p leaf)
            (defined-fun-inline-expansion leaf)
-           (let ((fun (defined-fun-functional leaf)))
-             (or (not fun)
-                 (and (eq inlinep :inline) (functional-kind fun))))
            (inline-expansion-ok call))
-      (flet (;; FIXME: Is this what the old CMU CL internal documentation
-             ;; called semi-inlining? A more descriptive name would
-             ;; be nice. -- WHN 2002-01-07
-             (frob ()
+      ;; Inline: if the function has already been converted at another call
+      ;; site in this component, we point this REF to the functional. If not,
+      ;; we convert the expansion.
+      ;;
+      ;; For :INLINE case local call analysis will copy the expansion later,
+      ;; but for :MAYBE-INLINE and NIL cases we only get one copy of the
+      ;; expansion per component.
+      ;;
+      ;; FIXME: We also convert in :INLINE & FUNCTIONAL-KIND case below. What
+      ;; is it for?
+      (flet ((frob ()
                (let* ((name (leaf-source-name leaf))
                       (res (ir1-convert-inline-expansion
                             name
@@ -864,18 +879,23 @@
                             leaf
                             inlinep
                             (info :function :info name))))
-                 ;; allow backward references to this function from
-                 ;; following top level forms
-                 (setf (defined-fun-functional leaf) res)
+                 ;; Allow backward references to this function from following
+                 ;; forms. (Reused only if policy matches.)
+                 (push res (defined-fun-functionals leaf))
                  (change-ref-leaf ref res))))
-        (if ir1-converting-not-optimizing-p
-            (frob)
-            (with-ir1-environment-from-node call
-              (frob)
-              (locall-analyze-component *current-component*))))
-
-      (values (ref-leaf (lvar-uses (basic-combination-fun call)))
-              nil))
+        (let ((fun (defined-fun-functional leaf)))
+          (if (or (not fun)
+                  (and (eq inlinep :inline) (functional-kind fun)))
+              ;; Convert.
+              (if ir1-converting-not-optimizing-p
+                  (frob)
+                  (with-ir1-environment-from-node call
+                    (frob)
+                    (locall-analyze-component *current-component*)))
+              ;; If we've already converted, change ref to the converted
+              ;; functional.
+              (change-ref-leaf ref fun))))
+      (values (ref-leaf ref) nil))
      (t
       (let ((info (info :function :info (leaf-source-name leaf))))
         (if info
@@ -892,12 +912,22 @@
 ;;; syntax check, arg/result type processing, but still call
 ;;; RECOGNIZE-KNOWN-CALL, since the call might be to a known lambda,
 ;;; and that checking is done by local call analysis.
-(defun validate-call-type (call type ir1-converting-not-optimizing-p)
+(defun validate-call-type (call type defined-type ir1-converting-not-optimizing-p)
   (declare (type combination call) (type ctype type))
   (cond ((not (fun-type-p type))
          (aver (multiple-value-bind (val win)
                    (csubtypep type (specifier-type 'function))
                  (or val (not win))))
+         ;; In the commonish case where the function has been defined
+         ;; in another file, we only get FUNCTION for the type; but we
+         ;; can check whether the current call is valid for the
+         ;; existing definition, even if only to STYLE-WARN about it.
+         (when defined-type
+           (valid-fun-use call defined-type
+                          :argument-test #'always-subtypep
+                          :result-test nil
+                          :lossage-fun #'compiler-style-warn
+                          :unwinnage-fun #'compiler-notify))
          (recognize-known-call call ir1-converting-not-optimizing-p))
         ((valid-fun-use call type
                         :argument-test #'always-subtypep
@@ -947,7 +977,7 @@
            (derive-node-type call (tail-set-type (lambda-tail-set fun))))))
       (:full
        (multiple-value-bind (leaf info)
-           (validate-call-type call (lvar-type fun-lvar) nil)
+           (validate-call-type call (lvar-type fun-lvar) nil nil)
          (cond ((functional-p leaf)
                 (convert-call-if-possible
                  (lvar-uses (basic-combination-fun call))