Changeset 16736


Ignore:
Timestamp:
May 17, 2016, 2:43:05 PM (5 years ago)
Author:
gb
Message:

Still no user-visible changes, but several internal ones.

File:
1 edited

Legend:

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

    r16734 r16736  
    10591059  (begin 0)
    10601060  (end 0)
    1061   (regtype 0)
    1062   (preg nll)
     1061  (regtype 0)  (preg nll)
    10631062  (avail 0 :type fixnum)                             ; available regs before we assigned preg
    10641063  idx
     
    10761075  (conflicts-with () :type list)
    10771076  (alive t)
    1078   peer
     1077  extension
    10791078)
    10801079
     
    20001999                (setf (interval-conflicts other) (delete i (interval-conflicts other)))
    20012000                )
     2001              ;;(break)
    20022002              (resolve-interval-conflict i nil)
    20032003              ))))))))
     
    20252025              (declare (fixnum avail))
    20262026              (do* (( i 16 (1- i)))
    2027                    ((< i 0) (linear-scan-bailout 'pressure))
     2027                   ((< i 0) (break "???")(linear-scan-bailout 'pressure))
    20282028                (declare (fixnum i))
    20292029                (let* ((preg (1- i)))
     
    20312031                  (when (and (logbitp preg avail)
    20322032                             (not (find-conflicting-intervals interval preg)))
    2033                     (when t
    2034                       (setf (lreg-value lreg) preg
    2035                             (interval-preg interval) preg)
    2036                       (use-preg-in-interval preg interval)
    2037                       (return-from resolve preg))))))))))))
    2038 
    2039 (defun resolvable-interval-conflict-p (interval reg)
     2033                    (setf (lreg-value lreg) preg
     2034                          (interval-preg interval) preg)
     2035                    (use-preg-in-interval preg interval)
     2036                    (return-from resolve preg)))))))))))
     2037
     2038(defun resolvable-interval-conflict-p (interval reg src)
    20402039  (let* ((lreg (interval-lreg interval))
    2041          (tdef (interval-trivial-def interval)))
     2040         (tdef (interval-trivial-def interval))
     2041         (srci (lreg-interval src)))
     2042    (declare (ignorable srci))
    20422043    (if (fixed-lreg-p lreg)
    2043       (and tdef (eq reg (trivial-copy-source-operand tdef)))
    2044       nil)))
     2044      (and tdef (eq reg (trivial-copy-source-operand tdef)))
     2045      (let* ((win t))
     2046        (unless (or (fixed-lreg-p src) (interval-trivial-def srci))
     2047          ;;(pushnew interval (interval-conflicts-with srci))
     2048          ;(setq win nil)
     2049          ;;(break)
     2050          )
     2051          win)
     2052      )))
    20452053
    20462054(defparameter *break-seqs* () ) ; for debugging
    20472055                                           
    20482056(defun nullify-trivial-copy (vinsn resolve)
    2049   (when (vinsn-attribute-p vinsn :trivial-copy)
    2050     (let* ((vp (vinsn-variable-parts vinsn))
    2051            (dest (svref vp 0))
    2052            (src (svref vp 1)))
    2053       (when (and (typep src 'lreg)
    2054                  (typep dest 'lreg))
    2055         ;; if both src and dest are lregs, dest
    2056         ;; is not fixed, and doing so would not
    2057         ;; introduce any conflicts throughout
    2058         ;; the lifetime of dest, make the copy
    2059         ;; a nop and change uses of dest to use
    2060         ;; src directly
    2061         ;; we are considering changing uses
    2062         ;; of "dest" to use the same preg
    2063         ;; as "src" does.  some other interval(s)
    2064         ;; which did not conflict with "dest"
    2065         ;; during register allocation may do
    2066         ;; so now (if we back out of the copy)
    2067         ;; if we find any such conflicting
    2068         ;; intervals (which try to use the preg
    2069         ;; from the src interval. change the
    2070         ;; conflicting interval to use another
    2071         ;; preg if we can.
     2057  (let* ((win nil)
     2058         (rebuild nil))
     2059    (when (vinsn-attribute-p vinsn :trivial-copy)
     2060      (let* ((vp (vinsn-variable-parts vinsn))
     2061             (dest (svref vp 0))
     2062             (src (svref vp 1)))
     2063        (when (and (typep src 'lreg)
     2064                   (typep dest 'lreg))
     2065          ;; if both src and dest are lregs, dest
     2066          ;; is not fixed, and doing so would not
     2067          ;; introduce any conflicts throughout
     2068          ;; the lifetime of dest, make the copy
     2069          ;; a nop and change uses of dest to use
     2070          ;; src directly
     2071          ;; we are considering changing uses
     2072          ;; of "dest" to use the same preg
     2073          ;; as "src" does.  some other interval(s)
     2074          ;; which did not conflict with "dest"
     2075          ;; during register allocation may do
     2076          ;; so now (if we back out of the copy)
     2077          ;; if we find any such conflicting
     2078          ;; intervals (which try to use the preg
     2079          ;; from the src interval. change the
     2080          ;; conflicting interval to use another
     2081          ;; preg if we can.
    20722082     
    20732083       
    20742084       
    20752085       
    2076         (let* ((src-interval (lreg-interval src))
    2077                (dest-interval (lreg-interval dest))
    2078                (src-preg (interval-preg src-interval))
    2079                (dest-preg (interval-preg dest-interval)))
    2080           (declare (type (unsigned-byte 4) src-preg dest-preg))
    2081           (when (and (typep src 'lreg)
    2082                      (typep dest 'lreg)
    2083                      (dolist (def (cdr (lreg-defs dest)) t)
    2084                        (unless (vinsn-attribute-p def :trivial-copy)
    2085                          (let* ((dseq (vinsn-sequence def)))
    2086                            (declare (fixnum dseq))
    2087                            (unless (dolist (ref (lreg-refs dest) t)
    2088                                      (when (and (> (the fixnum (vinsn-sequence ref)) dseq)
    2089                                                 (not (vinsn-attribute-p ref :trivial-copy)))
    2090                                        (ls-break "???")
     2086          (let* ((src-interval (lreg-interval src))
     2087                 (dest-interval (lreg-interval dest))
     2088                 (src-preg (interval-preg src-interval))
     2089                 (dest-preg (interval-preg dest-interval))
     2090                 )
     2091            (declare (type (unsigned-byte 4) src-preg dest-preg))
     2092            ;;copying the register may be necessary to avoid cases
     2093            ;; where we would otherwise destructively modify it and
     2094            ;; reference the modified register after doing so.  E.g.
     2095            ;; (prog1 (1+ x) ,,,) should not change X.
     2096            ;; Will need to re-think this to handle more general control
     2097            ;; flow (loops).
     2098         
     2099            (when (dolist (def (cdr (lreg-defs dest)) t)
     2100                    (unless (vinsn-attribute-p def :trivial-copy)
     2101                      (let* ((dseq (vinsn-sequence def)))
     2102                        (declare (fixnum dseq))
     2103                        (unless (dolist (ref (lreg-refs dest) t)
     2104                                  (when (and (> (the fixnum (vinsn-sequence ref)) dseq)
     2105                                             (not (vinsn-attribute-p ref :trivial-copy)))
     2106                                    ;;(ls-break "???")
    20912107                                                                                 
    2092                                        (return nil)))
    2093                              (return nil))))))
     2108                                    (return nil)))
     2109                          (return nil)))))
     2110             
    20942111                                                       
    20952112
    2096             (when (memq (vinsn-sequence vinsn) *break-seqs*) (break))
    2097             (when (and resolve
    2098                        (interval-conflicts dest-interval)
    2099                        (getf (vinsn-annotation vinsn) :resolvable))
     2113              (when (memq (vinsn-sequence vinsn) *break-seqs*) (break))
     2114              (when (and resolve
     2115                         (interval-conflicts dest-interval)
     2116                         (getf (vinsn-annotation vinsn) :resolvable))
    21002117
    21012118           
    2102               (dolist (conflict (interval-conflicts dest-interval) )
    2103                 ;;(break)
    2104                 ;;(resolve-interval-conflict conflict dest)
    2105                 (setf (interval-conflicts-with conflict) nil)))
    2106             (when (eql src-preg dest-preg)
    2107               (setf (getf (vinsn-annotation vinsn) :resolvable) t))
    2108             (unless (or (eql src-preg dest-preg)
    2109                         (fixed-lreg-p dest)
    2110                         )
    2111 
    2112               (when (not resolve)
    2113                 (dolist (i (find-conflicting-intervals dest-interval src-preg))
     2119                (dolist (conflict (interval-conflicts dest-interval) )
     2120                  ;;(break)
     2121                  ;;(resolve-interval-conflict conflict dest)
     2122                  (setf (interval-conflicts-with conflict) nil)))
     2123              (when (eql src-preg dest-preg)
     2124                (setf (getf (vinsn-annotation vinsn) :resolvable) t))
     2125              (unless (or (eql src-preg dest-preg)
     2126                          (fixed-lreg-p dest)
     2127                          )
     2128
     2129                (when (not resolve)
     2130                  (dolist (i (find-conflicting-intervals dest-interval src-preg))
    21142131                 
    2115                   ;; the conflicting interval was defined by a trivial-copy, but
    2116                   ;; we might nullify that definition.
    2117                   (unless (or (eq i src-interval) #|(interval-trivial-def i)|#)
    2118                     (push dest-interval (interval-conflicts-with i))
    2119                     (push i (interval-conflicts  dest-interval))))
    2120 
    2121                 (when (dolist (i (interval-conflicts  dest-interval) t)
    2122                         (unless (resolvable-interval-conflict-p  i dest)
     2132                    ;; the conflicting interval was defined by a trivial-copy, but
     2133                    ;; we might nullify that definition.
     2134                    (unless (or (eq i src-interval) #|(interval-trivial-def i)|#)
     2135                      (push dest-interval (interval-conflicts-with i))
     2136                      (push i (interval-conflicts  dest-interval))))
     2137
     2138                  (when (dolist (i (interval-conflicts  dest-interval) t)
     2139                          (unless (resolvable-interval-conflict-p  i dest src)
    21232140                       
    2124                           (return nil)))
     2141                            (return nil)))
    21252142               
    2126                   (setf (getf (vinsn-annotation vinsn) :resolvable) t))))
    2127 
    2128 
    2129             (when (or (getf (vinsn-annotation vinsn) :resolvable) (eql src-preg dest-preg))
    2130 
    2131               (if resolve
    2132                 (unless (fixed-lreg-p dest)
    2133                   (setf (lreg-value dest) src-preg
    2134                        ))
    2135                 (progn
    2136                   (unless (eql src-preg dest-preg)
    2137                     (unuse-preg-in-interval dest-preg dest-interval))   
    2138                   (setf (interval-preg dest-interval)src-preg
    2139                         ;;(interval-lreg dest-interval) nil
    2140                         ;;(lreg-interval dest) src-interval
    2141                         )
     2143                    (setf (getf (vinsn-annotation vinsn) :resolvable) t))))
     2144
     2145
     2146              (when (or (getf (vinsn-annotation vinsn) :resolvable) (eql src-preg dest-preg))
     2147
     2148                (if resolve
     2149                  (unless (fixed-lreg-p dest)
     2150                    (setf (lreg-value dest) src-preg
     2151                          ))
     2152                  (progn
     2153                    (unless (eql src-preg dest-preg)
     2154                      (unuse-preg-in-interval dest-preg dest-interval))   
     2155                    (setf (interval-preg dest-interval)src-preg
     2156                          ;;(interval-lreg dest-interval) nil
     2157                          ;;(lreg-interval dest) src-interval
     2158                          )
    21422159               
    21432160
    2144                   ))
     2161                    ))
    21452162           
    21462163                   
    21472164
    21482165           
    2149 
    2150               t))))
    2151 
    2152       )))
     2166             
     2167                (setq win t)
     2168                )
     2169              (when (and resolve (not (logbitp (interval-preg dest-interval)
     2170                                               (interval-avail dest-interval))))
     2171                (unless (getf (vinsn-annotation vinsn) :resolvable)
     2172                  (dolist (other (interval-active-before dest-interval)) (pushnew other (interval-conflicts-with dest-interval)))
     2173                  (resolve-interval-conflict dest-interval nil)
     2174                  (break "~&funky at ~s" vinsn))))
     2175         
     2176            )
     2177
     2178          )))
     2179    (values  rebuild win)))
     2180 
    21532181
    21542182
     
    21922220        (do-tail-dll-nodes (v block)
    21932221          (when (vinsn-attribute-p v :trivial-copy)
     2222
    21942223            (nullify-trivial-copy v t))))
    21952224      (when *linear-scan-verbose*
Note: See TracChangeset for help on using the changeset viewer.