/[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.24 by ram, Sun Feb 23 17:43:10 1992 UTC revision 1.25 by ram, Thu Apr 9 20:09:58 1992 UTC
# Line 698  Line 698 
698    (undefined-value))    (undefined-value))
699    
700    
701    ;;; Unconvert-Tail-Calls  --  Internal
702    ;;;
703    ;;;    We are converting Fun to be a let when the call is in a non-tail
704    ;;; position.  Any previously tail calls in Fun are no longer tail calls, and
705    ;;; must be restored to normal calls which transfer to Next-Block (Fun's
706    ;;; return point.)
707    ;;;
708    (defun unconvert-tail-calls (fun call next-block)
709      (dolist (called (lambda-calls fun))
710        (dolist (ref (leaf-refs called))
711          (let ((this-call (continuation-dest (node-cont ref))))
712            (when (and (node-tail-p this-call)
713                       (eq (node-home-lambda this-call) fun))
714              (assert (member (functional-kind called) '(nil :cleanup :optional)))
715              (setf (node-tail-p this-call) nil)
716              (let ((block (node-block this-call)))
717                (unlink-blocks block (first (block-succ block)))
718                (link-blocks block next-block)
719                (delete-continuation-use this-call)
720                (add-continuation-use this-call (node-cont call)))))))
721      (undefined-value))
722    
723    
724  ;;; MOVE-RETURN-STUFF  --  Internal  ;;; MOVE-RETURN-STUFF  --  Internal
725  ;;;  ;;;
726  ;;;    Deal with returning from a let or assignment that we are converting.  ;;;    Deal with returning from a let or assignment that we are converting.
# Line 712  Line 735 
735  ;;;    delete the callee's return, move its uses to the call's result  ;;;    delete the callee's return, move its uses to the call's result
736  ;;;    continuation, and transfer control to the appropriate return point.  ;;;    continuation, and transfer control to the appropriate return point.
737  ;;; -- If the callee has a return, but the caller doesn't, then we move the  ;;; -- If the callee has a return, but the caller doesn't, then we move the
738  ;;;    return to the caller.  [Note: here CALL is always TR.]  ;;;    return to the caller.
739  ;;;  ;;;
740  (defun move-return-stuff (fun call next-block)  (defun move-return-stuff (fun call next-block)
741    (declare (type clambda fun) (type basic-combination call)    (declare (type clambda fun) (type basic-combination call)
742             (type (or cblock null) next-block))             (type (or cblock null) next-block))
743      (when next-block
744        (unconvert-tail-calls fun call next-block))
745    (let* ((return (lambda-return fun))    (let* ((return (lambda-return fun))
746           (call-fun (node-home-lambda call))           (call-fun (node-home-lambda call))
747           (call-return (lambda-return call-fun)))           (call-return (lambda-return call-fun)))
748      (when return      (cond ((not return))
749        (cond ((or next-block call-return)            ((or next-block call-return)
750               (unless (block-delete-p (node-block return))             (unless (block-delete-p (node-block return))
751                 (move-return-uses fun call               (move-return-uses fun call
752                                   (or next-block (node-block call-return)))))                                 (or next-block (node-block call-return)))))
753              (t            (t
754               (setf (lambda-return call-fun) return)             (assert (node-tail-p call))
755               (setf (return-lambda return) call-fun))))   (break "Yow!")
756      (move-let-call-cont fun))             (setf (lambda-return call-fun) return)
757               (setf (return-lambda return) call-fun))))
758      (move-let-call-cont fun)
759    (undefined-value))    (undefined-value))
760    
761    
# Line 746  Line 773 
773    (let ((next-block (if (node-tail-p call)    (let ((next-block (if (node-tail-p call)
774                          nil                          nil
775                          (insert-let-body fun call))))                          (insert-let-body fun call))))
776      (merge-lets fun call)      (move-return-stuff fun call next-block)
777      (move-return-stuff fun call next-block))      (merge-lets fun call))
778    
779    (maybe-remove-free-function fun)    (maybe-remove-free-function fun)
780    (dolist (arg (basic-combination-args call))    (dolist (arg (basic-combination-args call))
# Line 849  Line 876 
876  ;;; MAYBE-CONVERT-TO-ASSIGNMENT  --  Interface  ;;; MAYBE-CONVERT-TO-ASSIGNMENT  --  Interface
877  ;;;  ;;;
878  ;;;    Called when we believe it might make sense to convert Fun to an  ;;;    Called when we believe it might make sense to convert Fun to an
879  ;;; assignment.  We can convert when:  ;;; assignment.  All this function really does is determine when a function
880    ;;; with more than one call can still be combined with the calling function's
881    ;;; environment.  We can convert when:
882  ;;; -- The function is a normal, non-entry function, and  ;;; -- The function is a normal, non-entry function, and
883  ;;; -- There is at most one non-tail call (which must not be recursive), and  ;;; -- Except for one call, all calls must be tail recursive calls in the
884  ;;; -- All calls are self-recursive or appear in at most one other function (so  ;;;    called function (i.e. are self-recursive tail calls)
885  ;;;    we can be sure that we can merge all the code into a single  ;;;
886  ;;;    environment.)  ;;;    There may be one outside call, and it need not be tail-recursive.  Since
887  ;;;  ;;; all tail local calls have already been converted to direct transfers, the
888  ;;; If there is one non-tail call, then we convert exactly like a let.  If  ;;; only control semantics needed are to splice in the body at the non-tail
889  ;;; there are no non-tail calls, then we merge the environments and deal with  ;;; call.  If there is no non-tail call, then we need only merge the
890  ;;; the return.  ;;; environments.  Both cases are handled by LET-CONVERT.
891    ;;;
892    ;;; ### It would actually be possible to allow any number of outside calls as
893    ;;; long as they all return to the same place (i.e. have the same conceptual
894    ;;; continuation.)  A special case of this would be when all of the outside
895    ;;; calls are tail recursive.
896  ;;;  ;;;
897  (defun maybe-convert-to-assignment (fun)  (defun maybe-convert-to-assignment (fun)
898    (declare (type clambda fun))    (declare (type clambda fun))

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.25

  ViewVC Help
Powered by ViewVC 1.1.5