/[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.20 by ram, Thu Aug 29 18:38:54 1991 UTC revision 1.21 by ram, Fri Aug 14 15:20:19 1992 UTC
# Line 307  Line 307 
307  ;;; more operand and as any other operand to the same VOP.  ;;; more operand and as any other operand to the same VOP.
308  ;;;  ;;;
309  ;;;     We don't have to worry about getting the correct conflict kind, since  ;;;     We don't have to worry about getting the correct conflict kind, since
310  ;;; Init-Global-Conflict-Kind will fix things up.  ;;; Init-Global-Conflict-Kind will fix things up.  Similarly,
311    ;;; FIND-LOCAL-REFERENCES will set the local conflict bit corresponding to this
312    ;;; call.
313  ;;;  ;;;
314  ;;;     We also set the Local and Local-Number slots in each TN.  It is  ;;;     We also set the Local and Local-Number slots in each TN.  It is
315  ;;; possible that there are no operands in any given call to this function, but  ;;; possible that there are no operands in any given call to this function, but
# Line 407  Line 409 
409                                           (vop-info-arg-types info))                                           (vop-info-arg-types info))
410                (coalesce-more-ltn-numbers new (vop-results lose)                (coalesce-more-ltn-numbers new (vop-results lose)
411                                           (vop-info-result-types info))                                           (vop-info-result-types info))
412                (assert (not (find-local-references new)))                (let ((lose (find-local-references new)))
413                    (assert (not lose)))
414                (init-global-conflict-kind new))))))))                (init-global-conflict-kind new))))))))
415    
416    (undefined-value))    (undefined-value))
# Line 772  Line 775 
775  ;;; referenced by a big more arg.  We have to treat these TNs specially, since  ;;; referenced by a big more arg.  We have to treat these TNs specially, since
776  ;;; when we set or clear the bit in the live TNs, the represents a change in  ;;; when we set or clear the bit in the live TNs, the represents a change in
777  ;;; the liveness of all the more TNs.  If we iterated as normal, the next more  ;;; the liveness of all the more TNs.  If we iterated as normal, the next more
778  ;;; ref would be thought to be not live when it was, etc.  We return true if  ;;; ref would be thought to be not live when it was, etc.  We update Ref to be
779  ;;; there where more TNs.  ;;; the last :more ref we scanned, so that the main loop will step to the next
780    ;;; non-more ref.
781  ;;;  ;;;
782  (defmacro frob-more-tns (action)  (defmacro frob-more-tns (action)
783    `(when (eq (svref ltns num) :more)    `(when (eq (svref ltns num) :more)
784       (do ((mref (tn-ref-next-ref ref) (tn-ref-next-ref mref)))       (let ((prev ref))
785           ((null mref))         (do ((mref (tn-ref-next-ref ref) (tn-ref-next-ref mref)))
786         (let ((mtn (tn-ref-tn mref)))             ((null mref))
787           (unless (eql (tn-local-number mtn) num)           (let ((mtn (tn-ref-tn mref)))
788             (return))             (unless (eql (tn-local-number mtn) num)
789           ,action))               (return))
790       t))             ,action)
791             (setq prev mref))
792           (setq ref prev))))
793    
794    
795  ;;; SCAN-VOP-REFS  --  Internal  ;;; SCAN-VOP-REFS  --  Internal
796  ;;;  ;;;
# Line 801  Line 808 
808           (when (tn-ref-write-p ref)           (when (tn-ref-write-p ref)
809             (setf (sbit live-bits num) 0)             (setf (sbit live-bits num) 0)
810             (deletef-in tn-next* live-list tn)             (deletef-in tn-next* live-list tn)
811             (when (frob-more-tns (deletef-in tn-next* live-list mtn))             (frob-more-tns (deletef-in tn-next* live-list mtn))))
              (return))))  
812          (t          (t
813           (assert (not (tn-ref-write-p ref)))           (assert (not (tn-ref-write-p ref)))
814           (note-conflicts live-bits live-list tn num)           (note-conflicts live-bits live-list tn num)
815           (frob-more-tns (note-conflicts live-bits live-list mtn num))           (frob-more-tns (note-conflicts live-bits live-list mtn num))
816           (setf (sbit live-bits num) 1)           (setf (sbit live-bits num) 1)
817           (push-in tn-next* tn live-list)           (push-in tn-next* tn live-list)
818           (when (frob-more-tns (push-in tn-next* mtn live-list))           (frob-more-tns (push-in tn-next* mtn live-list)))))))
819             (return)))))))  
820    
821  ;;; ENSURE-RESULTS-LIVE  --  Internal  ;;; ENSURE-RESULTS-LIVE  --  Internal
822  ;;;  ;;;

Legend:
Removed from v.1.20  
changed lines
  Added in v.1.21

  ViewVC Help
Powered by ViewVC 1.1.5