/[cmucl]/src/compiler/locall.lisp
ViewVC logotype

Diff of /src/compiler/locall.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.54 by gerd, Tue Aug 5 14:04:52 2003 UTC revision 1.55 by gerd, Thu Oct 2 19:23:11 2003 UTC
# Line 102  Line 102 
102    (declare (type ref ref) (type combination call) (type clambda fun))    (declare (type ref ref) (type combination call) (type clambda fun))
103    (propagate-to-args call fun)    (propagate-to-args call fun)
104    (setf (basic-combination-kind call) :local)    (setf (basic-combination-kind call) :local)
105    (pushnew fun (lambda-calls (node-home-lambda call)))    (note-dfo-dependency call fun)
106    (merge-tail-sets call fun)    (merge-tail-sets call fun)
107    (change-ref-leaf ref fun)    (change-ref-leaf ref fun)
108    (undefined-value))    (undefined-value))
# Line 432  Line 432 
432               (= (length (basic-combination-args call)) 1))               (= (length (basic-combination-args call)) 1))
433      (let ((ep (car (last (optional-dispatch-entry-points fun)))))      (let ((ep (car (last (optional-dispatch-entry-points fun)))))
434        (setf (basic-combination-kind call) :local)        (setf (basic-combination-kind call) :local)
435        (pushnew ep (lambda-calls (node-home-lambda call)))        (note-dfo-dependency call ep)
436        (merge-tail-sets call ep)        (merge-tail-sets call ep)
437        (change-ref-leaf ref ep)        (change-ref-leaf ref ep)
438    
# Line 758  Line 758 
758    
759      ;; HOME no longer calls FUN, and owns all of FUN's old DFO      ;; HOME no longer calls FUN, and owns all of FUN's old DFO
760      ;; dependencies      ;; dependencies
761      (setf (lambda-calls home)      (setf (lambda-dfo-dependencies home)
762            (delete fun (nunion (lambda-calls fun) (lambda-calls home))))            (delete fun (nunion (lambda-dfo-dependencies fun)
763                                  (lambda-dfo-dependencies home))))
764      ;; FUN no longer has an independent existence as an entity      ;; FUN no longer has an independent existence as an entity
765      ;; which calls things or has DFO dependencies.      ;; which calls things or has DFO dependencies.
766      (setf (lambda-calls fun) ())      (setf (lambda-dfo-dependencies fun) ())
767    
768      ;; All of FUN's ENTRIES belong to HOME now.      ;; All of FUN's ENTRIES belong to HOME now.
769      (setf (lambda-entries home)      (setf (lambda-entries home)
# Line 837  Line 838 
838  ;;;  ;;;
839  ;;;    The called function might be an assignment in the case where we are  ;;;    The called function might be an assignment in the case where we are
840  ;;; currently converting that function.  In steady-state, assignments never  ;;; currently converting that function.  In steady-state, assignments never
841  ;;; appear in the lambda-calls.  ;;; appear in the lambda-dfo-dependencies.
842  ;;;  ;;;
843  (defun unconvert-tail-calls (fun call next-block)  (defun unconvert-tail-calls (fun call next-block)
844    (dolist (called (lambda-calls fun))    (dolist (called (lambda-dfo-dependencies fun))
845      (dolist (ref (leaf-refs called))      (when (lambda-p called)
846        (let ((this-call (continuation-dest (node-cont ref))))        (dolist (ref (leaf-refs called))
847          (when (and (node-tail-p this-call)          (let ((this-call (continuation-dest (node-cont ref))))
848                     (eq (node-home-lambda this-call) fun))            (when (and (node-tail-p this-call)
849            (setf (node-tail-p this-call) nil)                       (eq (node-home-lambda this-call) fun))
850            (ecase (functional-kind called)              (setf (node-tail-p this-call) nil)
851              ((nil :cleanup :optional)              (ecase (functional-kind called)
852               (let ((block (node-block this-call))                ((nil :cleanup :optional)
853                     (cont (node-cont call)))                 (let ((block (node-block this-call))
854                 (ensure-block-start cont)                       (cont (node-cont call)))
855                 (unlink-blocks block (first (block-succ block)))                   (ensure-block-start cont)
856                 (link-blocks block next-block)                   (unlink-blocks block (first (block-succ block)))
857                 (delete-continuation-use this-call)                   (link-blocks block next-block)
858                 (add-continuation-use this-call cont)))                   (delete-continuation-use this-call)
859              (:deleted)                   (add-continuation-use this-call cont)))
860              (:assignment                (:deleted)
861               (assert (eq called fun))))))))                (:assignment
862    (undefined-value))                 (assert (eq called fun)))))))))
863      (values))
864    
865    
866  ;;; MOVE-RETURN-STUFF  --  Internal  ;;; MOVE-RETURN-STUFF  --  Internal

Legend:
Removed from v.1.54  
changed lines
  Added in v.1.55

  ViewVC Help
Powered by ViewVC 1.1.5