/[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.31 by ram, Fri Nov 15 13:53:48 1991 UTC revision 1.32 by ram, Sat Nov 16 13:16:37 1991 UTC
# Line 729  Line 729 
729  ;;;  ;;;
730  (defun maybe-terminate-block (call ir1-p)  (defun maybe-terminate-block (call ir1-p)
731    (declare (type basic-combination call))    (declare (type basic-combination call))
732    (let ((block (node-block call))    (let* ((block (node-block call))
733          (cont (node-cont call)))           (cont (node-cont call))
734      (when (or (and (eq (continuation-asserted-type cont) *empty-type*)           (tail (component-tail (block-component block)))
735                     (not (or ir1-p (eq (continuation-kind cont) :deleted))))           (succ (first (block-succ block))))
736                (eq (node-derived-type call) *empty-type*))      (unless (or (and (eq call (block-last block)) (eq succ tail))
737        (cond (ir1-p                  (block-delete-p block))
738               (delete-continuation-use call)        (when (or (and (eq (continuation-asserted-type cont) *empty-type*)
739               (cond                       (not (or ir1-p (eq (continuation-kind cont) :deleted))))
740                ((block-last block)                  (eq (node-derived-type call) *empty-type*))
741                 (assert (and (eq (block-last block) call)          (cond (ir1-p
742                              (eq (continuation-kind cont) :block-start))))                 (delete-continuation-use call)
743                   (cond
744                    ((block-last block)
745                     (assert (and (eq (block-last block) call)
746                                  (eq (continuation-kind cont) :block-start))))
747                    (t
748                     (setf (block-last block) call)
749                     (link-blocks block (continuation-starts-block cont)))))
750                (t                (t
751                 (setf (block-last block) call)                 (node-ends-block call)
752                 (link-blocks block (continuation-starts-block cont)))))                 (delete-continuation-use call)
753              (t                 (if (eq (continuation-kind cont) :unused)
754               (node-ends-block call)                     (delete-continuation cont)
755               (delete-continuation-use call)                     (reoptimize-continuation cont))))
756               (if (eq (continuation-kind cont) :unused)  
757                   (delete-continuation cont)          (unlink-blocks block (first (block-succ block)))
758                   (reoptimize-continuation cont))))          (assert (not (block-succ block)))
759            (link-blocks block tail)
760        (unlink-blocks block (first (block-succ block)))          (add-continuation-use call (make-continuation))
761        (assert (not (block-succ block)))          t))))
       (link-blocks block (component-tail (block-component block)))  
       (add-continuation-use call (make-continuation))  
       t)))  
762    
763    
764  ;;; Recognize-Known-Call  --  Interface  ;;; Recognize-Known-Call  --  Interface
# Line 1275  Line 1279 
1279    
1280  ;;; IR1-OPTIMIZE-MV-COMBINATION  --  Internal  ;;; IR1-OPTIMIZE-MV-COMBINATION  --  Internal
1281  ;;;  ;;;
1282  ;;;    Do stuff to notice a change to a MV combination node.  ;;;    Do stuff to notice a change to a MV combination node.  There are two
1283    ;;; main branches here:
1284    ;;;  -- If the call is local, then it is already a MV let, or should become one.
1285    ;;;     Note that although all :LOCAL MV calls must eventually be converted to
1286    ;;;     :MV-LETs, there can be a window when the call is local, but has not
1287    ;;;     been let converted yet.  This is because the entry-point lambdas may
1288    ;;;     have stray references (in other entry points) that have not been
1289    ;;;     deleted yet.
1290    ;;;  -- The call is full.  This case is somewhat similar to the non-MV
1291    ;;;     combination optimization: we propagate return type information and
1292    ;;;     notice non-returning calls.  We also have an optimization
1293    ;;;     which tries to convert MV-CALLs into MV-binds.
1294  ;;;  ;;;
1295  (defun ir1-optimize-mv-combination (node)  (defun ir1-optimize-mv-combination (node)
1296    (cond    (cond
# Line 1285  Line 1300 
1300          (setf (continuation-reoptimize fun) nil)          (setf (continuation-reoptimize fun) nil)
1301          (maybe-let-convert (combination-lambda node))))          (maybe-let-convert (combination-lambda node))))
1302      (setf (continuation-reoptimize (first (basic-combination-args node))) nil)      (setf (continuation-reoptimize (first (basic-combination-args node))) nil)
1303      (unless (convert-mv-bind-to-let node)      (when (eq (functional-kind (combination-lambda node)) :mv-let)
1304        (ir1-optimize-mv-bind node)))        (unless (convert-mv-bind-to-let node)
1305            (ir1-optimize-mv-bind node))))
1306     (t     (t
1307      (let* ((fun (basic-combination-fun node))      (let* ((fun (basic-combination-fun node))
1308             (fun-changed (continuation-reoptimize fun))             (fun-changed (continuation-reoptimize fun))

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

  ViewVC Help
Powered by ViewVC 1.1.5