/[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.29 by ram, Mon Apr 27 19:47:24 1992 UTC revision 1.30 by ram, Tue Jun 2 18:48:09 1992 UTC
# Line 710  Line 710 
710  ;;; 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
711  ;;; return point.)  ;;; return point.)
712  ;;;  ;;;
713    ;;;    The called function might be an assignment in the case where we are
714    ;;; currently converting that function.  In steady-state, assignments never
715    ;;; appear in the lambda-calls.
716    ;;;
717  (defun unconvert-tail-calls (fun call next-block)  (defun unconvert-tail-calls (fun call next-block)
718    (dolist (called (lambda-calls fun))    (dolist (called (lambda-calls fun))
719      (dolist (ref (leaf-refs called))      (dolist (ref (leaf-refs called))
720        (let ((this-call (continuation-dest (node-cont ref))))        (let ((this-call (continuation-dest (node-cont ref))))
721          (when (and (node-tail-p this-call)          (when (and (node-tail-p this-call)
722                     (eq (node-home-lambda this-call) fun))                     (eq (node-home-lambda this-call) fun))
           (assert (member (functional-kind called) '(nil :cleanup :optional)))  
723            (setf (node-tail-p this-call) nil)            (setf (node-tail-p this-call) nil)
724            (let ((block (node-block this-call)))            (ecase (functional-kind called)
725              (unlink-blocks block (first (block-succ block)))              ((nil :cleanup :optional)
726              (link-blocks block next-block)               (let ((block (node-block this-call)))
727              (delete-continuation-use this-call)                 (unlink-blocks block (first (block-succ block)))
728              (add-continuation-use this-call (node-cont call)))))))                 (link-blocks block next-block)
729                   (delete-continuation-use this-call)
730                   (add-continuation-use this-call (node-cont call))))
731                (:assignment
732                 (assert (eq called fun))))))))
733    (undefined-value))    (undefined-value))
734    
735    
# Line 921  Line 928 
928                    (unless (node-tail-p dest)                    (unless (node-tail-p dest)
929                      (when (or non-tail (eq home fun)) (return nil))                      (when (or non-tail (eq home fun)) (return nil))
930                      (setq non-tail dest)))))                      (setq non-tail dest)))))
931            (setf (functional-kind fun) :assignment)
932          (let-convert fun (or non-tail          (let-convert fun (or non-tail
933                               (continuation-dest                               (continuation-dest
934                                (node-cont (first (leaf-refs fun))))))                                (node-cont (first (leaf-refs fun))))))
         (setf (functional-kind fun) :assignment)  
935          t))))          t))))

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

  ViewVC Help
Powered by ViewVC 1.1.5