Changeset 16731


Ignore:
Timestamp:
Apr 25, 2016, 12:24:46 AM (4 years ago)
Author:
gb
Message:

Fix a bug which had caused a test suite failure when *remove-trivial-copies* is

See CL-TEST::RANDOM-TEST-DELETE.

Even if the fix is in place, we are using far too many temp registers, and very
nearly run out here.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/vinsn.lisp

    r16727 r16731  
    20272027                  (when (and (logbitp preg avail)
    20282028                             (not (find-conflicting-intervals interval preg)))
    2029                     (let* ((lreg (interval-lreg interval)))
    2030                       (setf (lreg-value lreg) preg
    2031                             (interval-preg interval) preg))
    2032                     (use-preg-in-interval preg interval)
    2033                     (return-from resolve preg)))))))))))
     2029                    (when (dolist (ref (lreg-refs lreg) t)
     2030                              (when (vinsn-attribute-p ref :trivial-copy)
     2031                                (return nil)))
     2032                        (setf (lreg-value lreg) preg
     2033                              (interval-preg interval) preg)
     2034                        (use-preg-in-interval preg interval)
     2035                        (return-from resolve preg))))))))))))
    20342036
    20352037(defun resolvable-interval-conflict-p (interval reg)
     
    20472049           (dest (svref vp 0))
    20482050           (src (svref vp 1)))
    2049       ;; if both src and dest are lregs, dest
    2050       ;; is not fixed, and doing so would not
    2051       ;; introduce any conflicts throughout
    2052       ;; the lifetime of dest, make the copy
    2053       ;; a nop and change uses of dest to use
    2054       ;; src directly
    2055       ;; we are considering changing uses
    2056       ;; of "dest" to use the same preg
    2057       ;; as "src" does.  some other interval(s)
    2058       ;; which did not conflict with "dest"
    2059       ;; during register allocation may do
    2060       ;; so now (if we back out of the copy)
    2061       ;; if we find any such conflicting
    2062       ;; intervals (which try to use the preg
    2063       ;; from the src interval. change the
    2064       ;; conflicting interval to use another
    2065       ;; preg if we can.
     2051      (when (and (typep src 'lreg)
     2052                 (typep dest 'lreg))
     2053        ;; if both src and dest are lregs, dest
     2054        ;; is not fixed, and doing so would not
     2055        ;; introduce any conflicts throughout
     2056        ;; the lifetime of dest, make the copy
     2057        ;; a nop and change uses of dest to use
     2058        ;; src directly
     2059        ;; we are considering changing uses
     2060        ;; of "dest" to use the same preg
     2061        ;; as "src" does.  some other interval(s)
     2062        ;; which did not conflict with "dest"
     2063        ;; during register allocation may do
     2064        ;; so now (if we back out of the copy)
     2065        ;; if we find any such conflicting
     2066        ;; intervals (which try to use the preg
     2067        ;; from the src interval. change the
     2068        ;; conflicting interval to use another
     2069        ;; preg if we can.
    20662070     
    20672071       
    20682072       
    20692073       
    2070       (let* ((src-interval (lreg-interval src))
    2071              (dest-interval (lreg-interval dest))
    2072              (src-preg (interval-preg src-interval))
    2073              (dest-preg (interval-preg dest-interval)))
    2074         (declare (type (unsigned-byte 4) src-preg dest-preg))
    2075         (when (and (typep src 'lreg)
    2076                    (typep dest 'lreg)
    2077                    (dolist (def (cdr (lreg-defs dest)) t)
    2078                      (unless (vinsn-attribute-p def :trivial-copy)
    2079                        (let* ((dseq (vinsn-sequence def)))
    2080                          (declare (fixnum dseq))
    2081                          (unless (dolist (ref (lreg-refs dest) t)
    2082                                    (when (and (> (the fixnum (vinsn-sequence ref)) dseq)
    2083                                               (not (vinsn-attribute-p ref :trivial-copy)))
    2084                                      (ls-break "???")
     2074        (let* ((src-interval (lreg-interval src))
     2075               (dest-interval (lreg-interval dest))
     2076               (src-preg (interval-preg src-interval))
     2077               (dest-preg (interval-preg dest-interval)))
     2078          (declare (type (unsigned-byte 4) src-preg dest-preg))
     2079          (when (and (typep src 'lreg)
     2080                     (typep dest 'lreg)
     2081                     (dolist (def (cdr (lreg-defs dest)) t)
     2082                       (unless (vinsn-attribute-p def :trivial-copy)
     2083                         (let* ((dseq (vinsn-sequence def)))
     2084                           (declare (fixnum dseq))
     2085                           (unless (dolist (ref (lreg-refs dest) t)
     2086                                     (when (and (> (the fixnum (vinsn-sequence ref)) dseq)
     2087                                                (not (vinsn-attribute-p ref :trivial-copy)))
     2088                                       (ls-break "???")
    20852089                                                                                 
    2086                                      (return nil)))
    2087                            (return nil))))))
     2090                                       (return nil)))
     2091                             (return nil))))))
    20882092                                                       
    20892093
    2090         (when (memq (vinsn-sequence vinsn) *break-seqs*) (break))
    2091         (when (and resolve
    2092                    (interval-conflicts dest-interval)
    2093                    (getf (vinsn-annotation vinsn) :resolvable))
     2094            (when (memq (vinsn-sequence vinsn) *break-seqs*) (break))
     2095            (when (and resolve
     2096                       (interval-conflicts dest-interval)
     2097                       (getf (vinsn-annotation vinsn) :resolvable))
    20942098
    20952099           
    2096           (dolist (conflict (interval-conflicts dest-interval) )
    2097             ;;(resolve-interval-conflict conflict dest)
    2098             (setf (interval-conflicts-with conflict) nil)))
    2099         (when (eql src-preg dest-preg)
    2100           (setf (getf (vinsn-annotation vinsn) :resolvable) t))
    2101         (unless (or (eql src-preg dest-preg)
    2102                     (fixed-lreg-p dest)
    2103                     )
    2104 
    2105           (when (not resolve)
    2106             (dolist (i (find-conflicting-intervals dest-interval src-preg))
     2100              (dolist (conflict (interval-conflicts dest-interval) )
     2101                ;;(resolve-interval-conflict conflict dest)
     2102                (setf (interval-conflicts-with conflict) nil)))
     2103            (when (eql src-preg dest-preg)
     2104              (setf (getf (vinsn-annotation vinsn) :resolvable) t))
     2105            (unless (or (eql src-preg dest-preg)
     2106                        (fixed-lreg-p dest)
     2107                        )
     2108
     2109              (when (not resolve)
     2110                (dolist (i (find-conflicting-intervals dest-interval src-preg))
    21072111                 
    2108               ;; the conflicting interval was defined by a trivial-copy, but
    2109               ;; we might nullify that definition.
    2110               (unless (or (eq i src-interval) #|(interval-trivial-def i)|#)
    2111                 (push dest-interval (interval-conflicts-with i))
    2112                 (push i (interval-conflicts  dest-interval))))
    2113 
    2114             (when (dolist (i (interval-conflicts  dest-interval) t)
    2115                     (unless (resolvable-interval-conflict-p  i dest)
     2112                  ;; the conflicting interval was defined by a trivial-copy, but
     2113                  ;; we might nullify that definition.
     2114                  (unless (or (eq i src-interval) #|(interval-trivial-def i)|#)
     2115                    (push dest-interval (interval-conflicts-with i))
     2116                    (push i (interval-conflicts  dest-interval))))
     2117
     2118                (when (dolist (i (interval-conflicts  dest-interval) t)
     2119                        (unless (resolvable-interval-conflict-p  i dest)
    21162120                       
    2117                       (return nil)))
     2121                          (return nil)))
    21182122               
    2119               (setf (getf (vinsn-annotation vinsn) :resolvable) t))))
    2120 
    2121 
    2122         (when (or (getf (vinsn-annotation vinsn) :resolvable) (eql src-preg dest-preg))
    2123 
    2124           (if resolve
    2125             (unless (fixed-lreg-p dest)
    2126               (setf (lreg-value dest) src-preg
    2127                     (svref vp 0) src))
    2128             (progn
    2129               (unless (eql src-preg dest-preg)
    2130                 (unuse-preg-in-interval dest-preg dest-interval))   
    2131               (setf (interval-preg dest-interval)src-preg
    2132                     ;;(interval-lreg dest-interval) nil
    2133                     (lreg-interval dest) src-interval)
     2123                  (setf (getf (vinsn-annotation vinsn) :resolvable) t))))
     2124
     2125
     2126            (when (or (getf (vinsn-annotation vinsn) :resolvable) (eql src-preg dest-preg))
     2127
     2128              (if resolve
     2129                (unless (fixed-lreg-p dest)
     2130                  (setf (lreg-value dest) src-preg
     2131                        (svref vp 0) src))
     2132                (progn
     2133                  (unless (eql src-preg dest-preg)
     2134                    (unuse-preg-in-interval dest-preg dest-interval))   
     2135                  (setf (interval-preg dest-interval)src-preg
     2136                        ;;(interval-lreg dest-interval) nil
     2137                        (lreg-interval dest) src-interval)
    21342138               
    21352139
    2136               ))
     2140                  ))
    21372141           
    21382142                   
     
    21402144           
    21412145
    2142           t)))
    2143 
    2144     )))
     2146              t))))
     2147
     2148      )))
    21452149
    21462150
Note: See TracChangeset for help on using the changeset viewer.