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

Diff of /src/compiler/ir1opt.lisp

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

revision 1.28 by ram, Thu Oct 3 18:30:28 1991 UTC revision 1.29 by ram, Sat Nov 9 22:10:37 1991 UTC
# Line 153  Line 153 
153  ;;;  ;;;
154  (defun reoptimize-continuation (cont)  (defun reoptimize-continuation (cont)
155    (declare (type continuation cont))    (declare (type continuation cont))
156    (unless (eq (continuation-kind cont) :deleted)    (unless (member (continuation-kind cont) '(:deleted :unused))
157      (setf (continuation-%derived-type cont) nil)      (setf (continuation-%derived-type cont) nil)
158      (let ((dest (continuation-dest cont)))      (let ((dest (continuation-dest cont)))
159        (when dest        (when dest
# Line 332  Line 332 
332           (when (dolist (arg (basic-combination-args node) nil)           (when (dolist (arg (basic-combination-args node) nil)
333                   (when (and arg (continuation-reoptimize arg))                   (when (and arg (continuation-reoptimize arg))
334                     (return t)))                     (return t)))
335             (ir1-optimize-combination node)))             (ir1-optimize-combination node))
336             (unless (node-deleted node)
337               (maybe-terminate-block node)))
338          (cif          (cif
339           (ir1-optimize-if node))           (ir1-optimize-if node))
340          (creturn          (creturn
# Line 708  Line 710 
710    (undefined-value))    (undefined-value))
711    
712    
713    ;;; MAYBE-TERMINATE-BLOCK  --  Interface
714    ;;;
715    ;;;    If Call is to a function that doesn't return (type NIL), then terminate
716    ;;; the block there, and link it to the component tail.  We also change the
717    ;;; call's CONT to be a dummy continuation to prevent the use from confusing
718    ;;; things.  This is also called during IR1 conversion, hence the BLOCK-LAST
719    ;;; test.
720    ;;;
721    (defun maybe-terminate-block (call)
722      (declare (type basic-combination call))
723      (let ((block (node-block call))
724            (cont (node-cont call)))
725        (when (or (eq (continuation-derived-type cont) *empty-type*)
726                  (eq (node-derived-type call) *empty-type*))
727          (cond ((block-last block)
728                 (node-ends-block call)
729                 (delete-continuation-use call))
730                (t
731                 (setf (block-last block) call)
732                 (delete-continuation-use call)
733                 (link-blocks block (continuation-starts-block cont))))
734          (unlink-blocks block (first (block-succ block)))
735          (assert (not (block-succ block)))
736          (link-blocks block (component-tail (block-component block)))
737          (reoptimize-continuation cont)
738          (add-continuation-use call (make-continuation))
739          t)))
740    
741    
742  ;;; Recognize-Known-Call  --  Interface  ;;; Recognize-Known-Call  --  Interface
743  ;;;  ;;;
744  ;;;    If Call is a call to a known function, mark it as such by setting the  ;;;    If Call is a call to a known function, mark it as such by setting the
# Line 1239  Line 1270 
1270               (args (basic-combination-args node)))               (args (basic-combination-args node)))
1271          (when fun-changed          (when fun-changed
1272            (setf (continuation-reoptimize fun) nil)            (setf (continuation-reoptimize fun) nil)
1273              (let ((type (continuation-type fun)))
1274                (when (function-type-p type)
1275                  (derive-node-type node (function-type-returns type))))
1276              (maybe-terminate-block node)
1277            (let ((use (continuation-use fun)))            (let ((use (continuation-use fun)))
1278              (when (and (ref-p use) (functional-p (ref-leaf use))              (when (and (ref-p use) (functional-p (ref-leaf use))
1279                         (not (eq (ref-inlinep use) :notinline)))                         (not (eq (ref-inlinep use) :notinline)))

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

  ViewVC Help
Powered by ViewVC 1.1.5