/[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.30 by ram, Tue Jun 2 18:48:09 1992 UTC revision 1.31 by ram, Thu Jun 4 17:42:35 1992 UTC
# Line 24  Line 24 
24  ;;;  ;;;
25  ;;; Written by Rob MacLachlan  ;;; Written by Rob MacLachlan
26  ;;;  ;;;
27  (in-package 'c)  (in-package :c)
28    
29    
30  ;;; Propagate-To-Args  --  Interface  ;;; Propagate-To-Args  --  Interface
# Line 56  Line 56 
56    (undefined-value))    (undefined-value))
57    
58    
59    ;;; Merge-Tail-Sets  --  Interface
60    ;;;
61    ;;;    This function handles merging the tail sets if Call is potentially
62    ;;; tail-recursive, and is a call to a function with a different TAIL-SET than
63    ;;; Call's Fun.  This must be called whenever we alter IR1 so as to place a
64    ;;; local call in what might be a TR context.  Note that any call which returns
65    ;;; its value to a RETURN is considered potentially TR, since any implicit
66    ;;; MV-PROG1 might be optimized away.
67    ;;;
68    ;;; We destructively modify the set for the calling function to represent both,
69    ;;; and then change all the functions in callee's set to reference the first.
70    ;;; If we do merge, we reoptimize the RETURN-RESULT continuation to cause
71    ;;; IR1-OPTIMIZE-RETURN to recompute the tail set type.
72    ;;;
73    (defun merge-tail-sets (call)
74      (declare (type basic-combination call))
75      (let ((return (continuation-dest (node-cont call))))
76        (when (return-p return)
77          (let ((call-set (lambda-tail-set (node-home-lambda call)))
78                (fun-set (lambda-tail-set (combination-lambda call))))
79            (unless (eq call-set fun-set)
80              (let ((funs (tail-set-functions fun-set)))
81                (dolist (fun funs)
82                  (setf (lambda-tail-set fun) call-set))
83                (setf (tail-set-functions call-set)
84                      (nconc (tail-set-functions call-set) funs)))
85              (reoptimize-continuation (return-result return))
86              t)))))
87    
88    
89  ;;; Convert-Call  --  Internal  ;;; Convert-Call  --  Internal
90  ;;;  ;;;
91  ;;;    Convert a combination into a local call.  We Propagate-To-Args, set the  ;;;    Convert a combination into a local call.  We PROPAGATE-TO-ARGS, set the
92  ;;; combination kind to :Local, add Fun to the Calls of the function that the  ;;; combination kind to :Local, add Fun to the Calls of the function that the
93  ;;; call is in, then replace the function in the Ref node with the new  ;;; call is in, replace the function in the Ref node with the new function,
94  ;;; function.  ;;; then MERGE-TAIL-SETS.
95  ;;;  ;;;
96  ;;;    We change the Ref last, since changing the reference can trigger let  ;;;    We change the Ref last, since changing the reference can trigger let
97  ;;; conversion of the new function, but will only do so if the call is local.  ;;; conversion of the new function, but will only do so if the call is local.
# Line 72  Line 102 
102    (setf (basic-combination-kind call) :local)    (setf (basic-combination-kind call) :local)
103    (pushnew fun (lambda-calls (node-home-lambda call)))    (pushnew fun (lambda-calls (node-home-lambda call)))
104    (change-ref-leaf ref fun)    (change-ref-leaf ref fun)
105      (merge-tail-sets call)
106    (undefined-value))    (undefined-value))
107    
108    
# Line 345  Line 376 
376        (setf (basic-combination-kind call) :local)        (setf (basic-combination-kind call) :local)
377        (pushnew ep (lambda-calls (node-home-lambda call)))        (pushnew ep (lambda-calls (node-home-lambda call)))
378        (change-ref-leaf ref ep)        (change-ref-leaf ref ep)
379          (merge-tail-sets call)
380    
381        (assert-continuation-type        (assert-continuation-type
382         (first (basic-combination-args call))         (first (basic-combination-args call))
383         (make-values-type :optional (mapcar #'leaf-type (lambda-vars ep))         (make-values-type :optional (mapcar #'leaf-type (lambda-vars ep))
# Line 708  Line 740 
740  ;;;    We are converting Fun to be a let when the call is in a non-tail  ;;;    We are converting Fun to be a let when the call is in a non-tail
741  ;;; position.  Any previously tail calls in Fun are no longer tail calls, and  ;;; position.  Any previously tail calls in Fun are no longer tail calls, and
742  ;;; must be restored to normal calls which transfer to Next-Block (Fun's  ;;; must be restored to normal calls which transfer to Next-Block (Fun's
743  ;;; return point.)  ;;; return point.)  We can't do this by DO-USES on the RETURN-RESULT, because
744    ;;; the return might have been deleted (if all calls were TR.)
745  ;;;  ;;;
746  ;;;    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
747  ;;; currently converting that function.  In steady-state, assignments never  ;;; currently converting that function.  In steady-state, assignments never
# Line 865  Line 898 
898    
899  ;;; MAYBE-CONVERT-TAIL-LOCAL-CALL  --  Interface  ;;; MAYBE-CONVERT-TAIL-LOCAL-CALL  --  Interface
900  ;;;  ;;;
901  ;;;    If possible, convert a tail-local call to jump directly to the called  ;;;    If a potentially TR local call really is TR, then convert it to jump
902  ;;; function.  We also call MAYBE-CONVERT-TO-ASSIGNMENT.  We can switch the  ;;; directly to the called function.  We also call MAYBE-CONVERT-TO-ASSIGNMENT.
903  ;;; succesor (potentially deleting the RETURN node) unless:  ;;; We can switch the succesor (potentially deleting the RETURN node) unless:
904    ;;; -- The call has already been converted.
905    ;;; -- The call isn't TR (random implicit MV PROG1.)
906  ;;; -- The call is in an XEP (thus we might decide to make it non-tail so that  ;;; -- The call is in an XEP (thus we might decide to make it non-tail so that
907  ;;;    we can use known return inside the component.)  ;;;    we can use known return inside the component.)
908  ;;; -- There is a change in the cleanup between the call in the return, so we  ;;; -- There is a change in the cleanup between the call in the return, so we
# Line 878  Line 913 
913    (let ((return (continuation-dest (node-cont call))))    (let ((return (continuation-dest (node-cont call))))
914      (assert (return-p return))      (assert (return-p return))
915      (when (and (not (node-tail-p call))      (when (and (not (node-tail-p call))
916                   (immediately-used-p (return-result return) call)
917                 (not (eq (functional-kind (node-home-lambda call))                 (not (eq (functional-kind (node-home-lambda call))
918                          :external))                          :external))
919                 (only-harmless-cleanups (node-block call)                 (only-harmless-cleanups (node-block call)

Legend:
Removed from v.1.30  
changed lines
  Added in v.1.31

  ViewVC Help
Powered by ViewVC 1.1.5