0.pre7.117:

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

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index 5351b32..311c5cd 100644 (file)
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -175,10 +175,10 @@
 ;;;
 ;;; We set REANALYZE and REOPTIMIZE in the component, just in case we
 ;;; discover an XEP after the initial local call analyze pass.
-(defun make-external-entry-point (fun)
+(defun make-xep (fun)
   (declare (type functional fun))
   (aver (not (functional-entry-fun fun)))
-  (with-belated-ir1-environment (lambda-bind (main-entry fun))
+  (with-ir1-environment-from-node (lambda-bind (main-entry fun))
     (let ((res (ir1-convert-lambda (make-xep-lambda-expression fun)
                                   :debug-name (debug-namify
                                                "XEP for ~A"
@@ -190,7 +190,8 @@
            (component-reanalyze *current-component*) t
            (component-reoptimize *current-component*) t)
       (etypecase fun
-       (clambda (locall-analyze-fun-1 fun))
+       (clambda
+        (locall-analyze-fun-1 fun))
        (optional-dispatch
         (dolist (ep (optional-dispatch-entry-points fun))
           (locall-analyze-fun-1 ep))
@@ -207,10 +208,10 @@
 (defun reference-entry-point (ref)
   (declare (type ref ref))
   (let ((fun (ref-leaf ref)))
-    (unless (or (external-entry-point-p fun)
+    (unless (or (xep-p fun)
                (member (functional-kind fun) '(:escape :cleanup)))
       (change-ref-leaf ref (or (functional-entry-fun fun)
-                              (make-external-entry-point fun))))))
+                              (make-xep fun))))))
 \f
 ;;; Attempt to convert all references to FUN to local calls. The
 ;;; reference must be the function for a call, and the function
@@ -265,6 +266,7 @@
 ;;; NEW-FUNS, but we don't add lambdas to the LAMBDAS.
 (defun locall-analyze-component (component)
   (declare (type component component))
+  (aver-live-component component)
   (loop
     (let* ((new-fun (pop (component-new-funs component)))
           (fun (or new-fun (pop (component-reanalyze-funs component)))))
@@ -283,6 +285,12 @@
                      ;; FUN becomes part of COMPONENT-LAMBDAS now.
                      (aver (not (member fun (component-lambdas component))))
                      (push fun (component-lambdas component)))
+                    ;; FIXME: Maybe we don't need this clause?
+                    ;; The only time I really thought I needed it
+                    ;; was bug 138, and adding this clause didn't
+                    ;; fix bug 138 but instead caused all sorts
+                    ;; of other things to fail downstream...
+                    #|
                     ((eql (lambda-inlinep fun) :inline)
                      ;; FUNs marked :INLINE are sometimes in
                      ;; COMPONENT-LAMBDAS and sometimes not. I (WHN
@@ -296,6 +304,7 @@
                      ;; expansions of local functions might in
                      ;; COMPONENT-LAMBDAS?)
                      (values))
+                     |#
                     (t ; FUN is old.
                      ;; FUN should be in COMPONENT-LAMBDAS already.
                      (aver (member fun (component-lambdas component)))))
@@ -330,7 +339,7 @@
                   (and (>= speed space) (>= speed compilation-speed)))
           (not (eq (functional-kind (node-home-lambda call)) :external))
           (inline-expansion-ok call))
-      (with-belated-ir1-environment call
+      (with-ir1-environment-from-node call
        (let* ((*lexenv* (functional-lexenv fun))
               (won nil)
               (res (catch 'local-call-lossage
@@ -387,7 +396,7 @@
                              (node-block
                               (lambda-bind (main-entry original-fun))))
                             component))))
-      (let ((fun (if (external-entry-point-p original-fun)
+      (let ((fun (if (xep-p original-fun)
                     (functional-entry-fun original-fun)
                     original-fun))
            (*compiler-error-context* call))
@@ -523,12 +532,12 @@
   (declare (list vars ignores args) (type ref ref) (type combination call)
           (type clambda entry))
   (let ((new-fun
-        (with-belated-ir1-environment call
+        (with-ir1-environment-from-node call
           (ir1-convert-lambda
            `(lambda ,vars
               (declare (ignorable . ,ignores))
               (%funcall ,entry . ,args))
-           :debug-name (debug-namify "hairy fun entry ~S"
+           :debug-name (debug-namify "hairy function entry ~S"
                                      (continuation-fun-name
                                       (basic-combination-fun call)))))))
     (convert-call ref call new-fun)
@@ -681,11 +690,11 @@
   (let* ((call-block (node-block call))
         (bind-block (node-block (lambda-bind clambda)))
         (component (block-component call-block)))
+    (aver-live-component component)
     (let ((clambda-component (block-component bind-block)))
       (unless (eq clambda-component component)
        (aver (eq (component-kind component) :initial))
        (join-components component clambda-component)))
-
     (let ((*current-component* component))
       (node-ends-block call))
     ;; FIXME: Use PROPER-LIST-OF-LENGTH-P here, and look for other
@@ -759,7 +768,7 @@
 
   (declare (type clambda clambda) (type basic-combination call))
 
-  (let ((component (block-component (node-block call))))
+  (let ((component (node-component call)))
     (unlink-blocks (component-head component) (lambda-block clambda))
     (setf (component-lambdas component)
          (delete clambda (component-lambdas component)))