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

Diff of /src/compiler/life.lisp

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

revision 1.4 by ram, Mon Mar 5 12:15:53 1990 UTC revision 1.5 by ram, Mon Mar 5 13:21:47 1990 UTC
# Line 548  Line 548 
548    
549  ;;; Compute-Save-Set  --  Internal  ;;; Compute-Save-Set  --  Internal
550  ;;;  ;;;
551  ;;;    Compute a list of the TNs live after VOP that aren't results.  ;;;    Compute a bit vector of the TNs live after VOP that aren't results.
552  ;;;  ;;;
553  (defun compute-save-set (vop block live-list)  (defun compute-save-set (vop block live-bits)
554    (declare (type vop vop) (type ir2-block block) (type (or tn null) live-list))    (declare (type vop vop) (type ir2-block block)
555    (collect ((save))             (type local-tn-bit-vector live-list))
556      (let ((results (vop-results vop)))    (let ((live (bit-vector-copy live-bits)))
557        (do ((live live-list (tn-next* live)))      (do ((r (vop-results vop) (tn-ref-across r)))
558            ((null live))          ((null r))
559          (unless (find-in #'tn-ref-across live results :key #'tn-ref-tn)        (setf (sbit live (tn-local-number (tn-ref-tn r))) 0))
560            (save live))))      live))
     (do ((conf (ir2-block-global-tns block) (global-conflicts-next conf)))  
         ((null conf))  
       (when (eq (global-conflicts-kind conf) :live)  
         (save (global-conflicts-tn conf))))  
     (save)))  
561    
562    
563  ;;; Compute-Initial-Conflicts  --  Internal  ;;; Compute-Initial-Conflicts  --  Internal
# Line 642  Line 637 
637    
638          (let ((save-p (vop-info-save-p (vop-info vop))))          (let ((save-p (vop-info-save-p (vop-info vop))))
639            (when save-p            (when save-p
640              (setf (vop-save-set vop) (bit-vector-copy live-bits))              (let ((ss (compute-save-set vop block live-bits)))
641              (when (eq save-p :force-to-stack)                (setf (vop-save-set vop) ss)
642                (dolist (tn (compute-save-set vop block live-list))                (when (eq save-p :force-to-stack)
643                  (force-tn-to-stack tn)                  (do-live-tns (tn ss block)
644                  (convert-to-environment-tn tn)))))                    (force-tn-to-stack tn)
645                      (convert-to-environment-tn tn))))))
646    
647          (do ((ref (vop-refs vop) (tn-ref-next-ref ref)))          (do ((ref (vop-refs vop) (tn-ref-next-ref ref)))
648              ((null ref))              ((null ref))

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

  ViewVC Help
Powered by ViewVC 1.1.5