Changeset 16434


Ignore:
Timestamp:
Jun 23, 2015, 5:49:11 PM (4 years ago)
Author:
gb
Message:

Don't spill/split intervals that have already been spilled/split.
revive the old conflict-resolution code, which broke when splitting
was introduced.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/lscan/source/compiler/vinsn.lisp

    r16430 r16434  
    55;;;   This file is part of Clozure CL. 
    66;;;
    7 ;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
     7;;;   clozure CL is licensed under the terms of the Lisp Lesser GNU Public
    88;;;   License , known as the LLGPL and distributed with Clozure CL as the
    99;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
     
    969969    (format stream "~d: ~s ~s/~s ~s (~s)" (interval-idx i)  (interval-lreg i) (interval-begin i) (interval-end i) (interval-regtype i) (interval-preg i))))
    970970
     971(defun check-interval-lregs (seg)
     972  (dovector (x (vinsn-list-intervals seg))
     973    (let* ((lreg (interval-lreg x)))
     974      (when lreg (or (lreg-refs lreg) (lreg-defs lreg)
     975                     (break))))))
     976                   
    971977(defun remove-trivial-copies (header)
    972978  (do-dll-nodes (vinsn header)
     
    975981             (dest (svref vp 0))
    976982             (src (svref vp 1)))
     983        (unless (typep dest 'lreg)
     984          (setf (svref vp 0) (setq dest (make-wired-lreg  dest))))
     985        (unless (typep src 'lreg)
     986          (setf (svref vp 1) (setq src (make-wired-lreg src))))
    977987
    978988        ;; This is probably not the only case where we can't
    979989        ;; avoid removing a COPY instruction.
    980         (unless (lreg-wired dest)
    981                     ;(logbitp lreg-spill-bit (lreg-flags src))
    982                     ;(logbitp lreg-spill-bit (lreg-flags dest)))
     990        (when (or (not (lreg-wired dest))
     991                  (let* ((srcval (lreg-value src))
     992                         (destval (lreg-value dest)))
     993                    (and srcval (eql srcval destval))))
     994                       
     995                   
    983996          (setf (lreg-defs dest) nil)
    984997          (dolist (ref (lreg-refs dest) (setf (lreg-refs dest) nil))
     
    10431056              (dotimes (i (integer-length mask))
    10441057                (when (logbitp i mask)
    1045                   (vector-push-extend (make-interval  nil low high class i ) list))))))))
     1058                  (vector-push-extend (make-interval  nil high high class i ) list))))))))
    10461059             
    10471060               
     
    10501063    (dovector (lreg (vinsn-list-lregs seg))
    10511064             
    1052               (let* ((max -1)
    1053                      (min (vinsn-list-max-seq seg))
    1054                      (all (append (lreg-defs lreg) (lreg-refs lreg))))
    1055                 (when all
    1056                   (dolist (p all)
    1057                     (let* ((seq (vinsn-sequence p)))
    1058                       (if (< seq min)
    1059                         (setq min seq))
    1060                       (if (> seq max)
    1061                         (setq max seq))))
    1062                   (let* ((class (lreg-class lreg))
    1063                          (regtype (cond ((eql class hard-reg-class-fpr)
    1064                                          interval-regtype-float)
    1065                                         ((eql class hard-reg-class-crf)
    1066                                          interval-regtype-cr)
    1067                                         ((eql class hard-reg-class-gpr)
    1068                                          (if (eql (lreg-mode lreg) hard-reg-class-gpr-mode-node)
    1069                                            interval-regtype-node
    1070                                            interval-regtype-imm)))))
    1071                     (let* ((interval (make-interval lreg min max regtype nil)))
    1072                       (when (logbitp lreg-pre-spill-bit (lreg-flags lreg))
    1073                         (process-pre-spilled-interval seg interval lreg (lreg-spill-offset lreg)))
    1074                       (vector-push-extend
    1075                        interval
    1076                        list))))))
    1077                
     1065      (let* ((max -1)
     1066             (min (vinsn-list-max-seq seg))
     1067             (all (append (lreg-defs lreg) (lreg-refs lreg))))
     1068        (when all
     1069          (dolist (p all)
     1070            (let* ((seq (vinsn-sequence p)))
     1071              (if (< seq min)
     1072                (setq min seq))
     1073              (if (> seq max)
     1074                (setq max seq))))
     1075          (let* ((class (lreg-class lreg))
     1076                 (regtype (cond ((eql class hard-reg-class-fpr)
     1077                                 interval-regtype-float)
     1078                                ((eql class hard-reg-class-crf)
     1079                                 interval-regtype-cr)
     1080                                ((eql class hard-reg-class-gpr)
     1081                                 (if (eql (lreg-mode lreg) hard-reg-class-gpr-mode-node)
     1082                                   interval-regtype-node
     1083                                   interval-regtype-imm)))))
     1084           
     1085            (let* ((interval (make-interval lreg min max regtype nil)))
     1086              (setf (lreg-interval lreg) interval)
     1087              (when (logbitp lreg-pre-spill-bit (lreg-flags lreg))
     1088                (process-pre-spilled-interval seg interval lreg (lreg-spill-offset lreg)))
     1089              (vector-push-extend
     1090               interval
     1091               list))))))
     1092
     1093    (let* ((max (vinsn-list-max-seq seg)))
     1094      (vector-push-extend (make-interval  nil max max -1 -1) list))
    10781095                   
    10791096                   
    10801097                   
    1081                    
    10821098
    10831099                         
    1084                     (setf (vinsn-list-intervals seg)
    1085 
    1086                           (sort list (lambda (x y)
    1087                                        (let* ((beginx (interval-begin x))
    1088                                               (beginy (interval-begin y)))
    1089                                          (or (< beginx beginy)
    1090                                              (and (= beginx beginy)
    1091                                                   (or (null (interval-lreg x))
    1092                                                       (lreg-local-p (interval-lreg x)))))))))))
     1100    (setf (vinsn-list-intervals seg)
     1101
     1102          (sort list (lambda (x y)
     1103                       (let* ((beginx (interval-begin x))
     1104                              (beginy (interval-begin y)))
     1105                         (or (< beginx beginy)
     1106                             (and (= beginx beginy)
     1107                                  (or (null (interval-lreg x))
     1108                                      (lreg-local-p (interval-lreg x)))))))))))
    10931109
    10941110
     
    11581174     
    11591175(defun spill-and-split-interval (seg parent new-end vector list)
     1176  (check-interval-lregs seg)
     1177
    11601178  (let* ((lreg (interval-lreg parent)))
    11611179    (unless lreg (break "no lreg for interval ~s" parent))
     1180   
    11621181    (let* ((used (vinsn-list-spill-area-used seg))
    11631182           (base (vinsn-list-spill-base seg))
     1183           (parent-is-child (not (null (interval-parent parent))))
    11641184           (templates (backend-p2-vinsn-templates *target-backend*)))
    11651185      (declare (simple-bit-vector used)
     
    11921212              (dolist (ref (lreg-refs lreg))
    11931213                (let*  ((seq (vinsn-sequence ref)))
    1194                     (when (> seq new-end)
    1195                       (if (< seq min) (setq min seq))
    1196                     (let* ((reload-vinsn (select-vinsn (reload-vinsn-for-interval parent) templates (list lreg offset))))
    1197 
    1198                       (insert-vinsn-before reload-vinsn ref)
     1214                  (format t "seq = ~s, new-end = ~a" seq new-end)
     1215                  (when (> seq new-end)
     1216                   
     1217                    (if (< seq min) (setq min seq))
     1218                    (unless parent-is-child
     1219                      (let* ((reload-vinsn (select-vinsn (reload-vinsn-for-interval parent) templates (list lreg offset))))
     1220
     1221                        (insert-vinsn-before reload-vinsn ref)
    11991222                 
    1200                       (push reload-vinsn (lreg-defs lreg))))))
     1223                        (push reload-vinsn (lreg-defs lreg)))()))))
    12011224              (dolist (def (lreg-defs lreg))
    12021225                (let*  ((seq (vinsn-sequence def)))
    1203                   (when (> seq new-end)
    1204                     (if (< seq min) (setq min seq)))))
    1205               (when (eql min (vinsn-list-max-seq seg)) (compiler-bug "empty interval"))
     1226 
     1227                      (when (> seq new-end)
     1228                        (if (< seq min) (setq min seq)))))
     1229              (when (eql min (vinsn-list-max-seq seg)) (break "refs - ~s, defs =  ~s, new-end = ~s" (lreg-refs lreg) (lreg-defs lreg) new-end) (compiler-bug "empty interval"))
    12061230              (let* ((child (make-interval  lreg min (interval-end parent) (interval-regtype parent) nil  )))
    1207                 (setf (interval-parent child) parent
    1208                       (interval-spill-offset child) offset)
    1209                 (do-dll-nodes (r list)
    1210                   (when (> (interval-begin r) min)
    1211                     (insert-dll-node-before child r)
    1212                     (return)))
    1213                 (let* ((idx (length vector)))
    1214                   (setf (interval-idx child) idx)
    1215                   (vector-push-extend child vector))
    1216 
    1217                 ;; Ready to expire
    1218                 (setf (interval-end parent) new-end)))))))))
    1219 
    1220 
     1231                    (setf (interval-parent child) parent
     1232                          (interval-spill-offset child) offset)
     1233                    (do-dll-nodes (r list (error "no next interval"))
     1234                      (when (> (interval-begin r) min)
     1235                        (insert-dll-node-before child r)
     1236                        (rebuild-interval-vector vector  child r)   
     1237                        (return)))
     1238               
     1239
     1240
     1241                    ;; Ready to expire
     1242                    (setf (interval-end parent) (1-  new-end))))))))))
     1243
     1244
     1245(defun rebuild-interval-vector (vector new-element succ)
     1246  (declare (type (vector t) vector))
     1247  (let* ((idx (interval-idx succ)))
     1248    (declare (fixnum idx))
     1249    (let* ((n (length vector)))
     1250      (declare (Fixnum n))
     1251      (vector-push-extend nil vector)   ; make room
     1252      (do* ((j n (1- j))
     1253            (i (1- j) (1- i)))
     1254           ((= j idx)
     1255            (setf (interval-idx new-element) idx)
     1256            (aref vector idx) new-element)
     1257        (declare (fixnum i j))
     1258                               
     1259        (setf (aref vector j) (aref vector i))))))
     1260           
    12211261
    12221262(defun replace-vinsn-operands (vinsn old new start end)
     
    12241264  (let* ((seq (vinsn-sequence vinsn)))
    12251265    (declare (fixnum seq))
     1266    (when (= seq 2500) (break))
    12261267    (unless (or (< seq start) (> seq end))
    12271268      (let* ((v (vinsn-variable-parts vinsn)))
     
    12311272            (setf (svref v i) new)))))))
    12321273
    1233 (defun expire-interval (seg interval)
    1234   (let* ((lreg (interval-lreg interval))
    1235          (avail (vinsn-list-available-physical-registers seg))
     1274(defun expire-interval (seg interval expired)
     1275  (let* ((avail (vinsn-list-available-physical-registers seg))
    12361276         (used (vinsn-list-spill-area-used seg))
    1237          (preg (interval-preg interval))
    1238          (start (interval-begin interval))
    1239          (end (interval-end interval)))
    1240    
    1241     (declare (simple-vector avail) (simple-bit-vector used) (ignorable used)(fixnum start end))
     1277         (preg (interval-preg interval)))
     1278    (declare (simple-vector avail) (simple-bit-vector used) (ignorable used))
    12421279    (flet ((unuse-reg (regno type)
    1243              (format t "~&unuse ~d/~d for ~s" regno type interval)
     1280             ;;(format t "~&unuse ~d/~d for ~s" regno type interval)
    12441281             (setf (svref avail type)
    12451282                   (logior (svref avail type) (ash 1 regno)))
    12461283))
    1247       (when (and lreg preg)
    1248         (dolist (def (lreg-defs lreg))
    1249           (replace-vinsn-operands def lreg preg start end))
    1250         (dolist (ref (lreg-refs lreg))
    1251           (replace-vinsn-operands ref lreg preg start end)))
     1284
    12521285      (when preg
    12531286        (unuse-reg preg (interval-regtype interval))))
    12541287    ;; we have to retain the (shared) spill slot until the last
    12551288    ;; child expires.
    1256     ))
     1289    )
     1290  (remove-dll-node interval)
     1291  (append-dll-node interval expired))
    12571292       
    1258                  
     1293(defun postprocess-interval (interval)
     1294  (let*  ((lreg (interval-lreg interval))
     1295          (preg (interval-preg interval))
     1296          (start (interval-begin interval))
     1297          (end (interval-end interval)))
     1298    (when (and lreg preg)
     1299      (dolist (def (lreg-defs lreg))
     1300        (replace-vinsn-operands def lreg preg start end))
     1301      (dolist (ref (lreg-refs lreg))
     1302        (replace-vinsn-operands ref lreg preg start end)))))
    12591303
    12601304                       
     
    12631307
    12641308
     1309
    12651310(defun linear-scan (seg )
     1311  (check-interval-lregs seg)
    12661312  (let* ((avail (vinsn-list-available-physical-registers seg)))
    12671313    (flet ((use-reg (regno type i)
    12681314             (declare (ignorable i))
    1269              ;(format t "~& using ~s/~d in ~s" regno type i)
     1315             ;;(format t "~& using ~s/~d in ~s" regno type i)
    12701316             (setf (svref avail type)
    12711317                   (logandc2 (svref avail type) (ash 1 regno))))
    12721318
    12731319           (select-available-register (mask)
     1320             (declare (type (unsigned-byte 16) mask))
     1321             (unless (eql 0 mask)
     1322               (do* ((i 0 (1+ i)))
     1323                    ((> i 15))
     1324                 (when (logbitp i mask) (return i)))))
     1325           (select-available-register-high (mask)
    12741326             (declare (type (unsigned-byte 16) mask))
    12751327             (unless (eql 0 mask)
     
    12771329                    ((< i 0))
    12781330                 (when (logbitp i mask) (return i))))))
     1331     
    12791332      (let* ((intervals (vinsn-list-intervals seg)))
    12801333        (declare (type (vector t) intervals))
    12811334        (let* ((active (make-dll-header))
    12821335               (unhandled (make-dll-header))
     1336               (expired (make-dll-header))
    12831337               (limit (vinsn-list-max-seq seg)))
    12841338          (dotimes (i (length intervals))
     
    12881342          (do* ((i (pop-dll-node unhandled) (pop-dll-node unhandled))
    12891343                (begin (if i (interval-begin I) limit) (if i (interval-begin I) limit)))
    1290                ((= begin limit) (do-dll-nodes (a active  t) (expire-interval seg a)))
     1344               ((= begin limit) (progn (do-dll-nodes (a active ) (expire-interval seg a expired))   (do-dll-nodes (x expired t) (postprocess-interval x))))
     1345           
     1346           
     1347            (do-dll-nodes (other active)
     1348
     1349              (let* ((other-end (interval-end other)))
     1350                (when (< other-end begin)
     1351                  (expire-interval seg other expired))))
     1352           
    12911353            (let* ((regtype (interval-regtype i))
    1292                    (mask (svref avail regtype)))
     1354                   (mask (svref avail regtype))
     1355                   (idx (interval-idx i)))
    12931356              (setf (interval-avail i) mask)
    1294               (when (eql 0 mask)
     1357              (when (and nil (eql 0 mask))
    12951358                (do-dll-nodes (victim active)
    12961359                  (when (and (eql regtype (interval-regtype victim))
     1360                             (interval-lreg victim)
    12971361                             (> (interval-end victim) begin))
    12981362                    (when (eq i victim) (dbg))
    1299                     (return (spill-and-split-interval   seg victim (interval-begin victim) intervals unhandled)))))
     1363                    (return (spill-and-split-interval   seg victim begin intervals unhandled)))))
    13001364                                 
    13011365
    1302               (do-dll-nodes (other active)
    1303            
    1304                 (let* ((other-end (interval-end other)))
    1305                   (when (< other-end begin)
    1306 
    1307                        
    1308                     (expire-interval seg other)
    1309                     (remove-dll-node other))))
     1366
    13101367              (let* ((lreg (interval-lreg i))
    13111368                     (regtype (interval-regtype i))
    13121369                     (mask (svref avail regtype)))
    1313 
    1314                    
    13151370                (let* ((fixed (interval-preg i))
    13161371                       (targeted (and lreg (or (lreg-wired lreg) (lreg-local-p lreg)) (lreg-value lreg)))
    13171372                       (preg (or fixed (if (and targeted (logbitp targeted mask))
    13181373                                         targeted
    1319                                          (select-available-register mask)))))
    1320                  
     1374                                         (select-available-register-high mask)))))
     1375
     1376
    13211377
    13221378                  (when (and fixed (not (logbitp fixed mask)))
    13231379                    (let* ((other (do-dll-nodes (x active (error "can't find interval with ~d" fixed))
    13241380                                    (when (and (eql regtype (interval-regtype x))
    1325                                                (eql fixed (interval-preg x)))
     1381                                               (eql fixed (interval-preg x))
     1382                                               (interval-lreg x))
     1383                                     
    13261384                                      (return x)))))
    13271385                      (spill-and-split-interval seg other begin intervals unhandled)))
    13281386
    13291387                  (when (and targeted (not (eql targeted preg)))
     1388
    13301389                    (let*  ((rival (do-dll-nodes (other active (error "can't find rival on active-list"))
    13311390                                     (when (and (eql (interval-preg other) targeted)
    1332                                                 (eql (interval-regtype other) regtype))
     1391                                                (eql (interval-regtype other) regtype)
     1392                                                )
    13331393                                       (return other))))
    13341394                            (rival-lreg (and rival (interval-lreg rival)))
    13351395                            )
    1336                       (break "want to use reg ~d, for ~s in use by ~s. ~d may be free" targeted lreg rival-lreg preg)
     1396
     1397                                       
     1398
     1399                        (break "want to use reg ~d, for ~s in use by ~s. ~d may be free" targeted lreg rival-lreg preg)
    13371400                      (cond ((null rival-lreg) (break "no lreg for conflicting interval ~s" rival))
    13381401                            ((or (lreg-wired rival-lreg) (lreg-local-p rival-lreg))
    1339                              (if (eql (interval-end rival) begin)
     1402                             (if (or (eql (interval-end rival) begin)
     1403                                     (null (lreg-refs rival-lreg))
     1404                                     (null (lreg-refs lreg)))
    13401405                               (setq preg targeted)
    13411406                               (error "conflicting intervals overlap")))
    1342                             (t
    1343                              ;; We can't easily revert he earlier decision to
    1344                              ;; assign the conflicting preg to the rival interval;
    1345                              ;; that decision affected later decisionsa, and the
    1346                              ;; affected intervals may no longer be on the active
    1347                              ;; list.  An older, hairier scheme tried to review
    1348                              ;; intervening decisions, but interval-splitting
    1349                              ;; complicated that.
    1350 
    1351                              ;; the rival interval is still active.  we want
    1352                              ;; to replace any uses of the rival lreg that occur
    1353                              ;; before this point with the "old" preg, insert
    1354                              ;; a copy instruction here, and change the rival'a
    1355                              ;; preg so that aubsequent uses will use the new preg
    1356                              (let* ((copy (select-vinsn 'copy-gpr (backend-p2-vinsn-templates *target-backend*) (list preg targeted))))
    1357                                (insert-vinsn-before copy (find-vinsn seg begin))
    1358                                (dolist (use (append (lreg-defs rival-lreg)
    1359                                                     (lreg-refs rival-lreg)))
    1360                                         ; fencepost ?
    1361                                  (replace-vinsn-operands use rival-lreg targeted (interval-begin rival) (vinsn-sequence copy)))))
    1362                             (setf (interval-preg rival) preg)
    1363                             (use-reg preg)
    1364                             (setq preg targeted))))
    1365                            
    1366                              
    1367                  
    1368                 (use-reg preg regtype i)
    1369                 (setf (interval-preg i) preg)
    1370                 (append-dll-node i active))))))))))
    1371 
     1407                                                 
     1408                            (rival
     1409                             (do* ((rival-idx (interval-idx rival) (1+ rival-idx))
     1410                                   (q rival (aref intervals rival-idx))
     1411                                   (rival-avail (interval-avail q) (logand rival-avail (if (eql regtype (interval-regtype q)) (interval-avail q) -1))))
     1412                                  ((= rival-idx idx)
     1413                                   (if (eql rival-avail 0)
     1414                                     (break)
     1415                                     (let*  ((other-preg (select-available-register-high rival-avail)))
     1416                                       ;;(format t "should have used ~d" other-preg)
     1417                                       (use-reg other-preg regtype rival)
     1418                                     
     1419                                       (setf (interval-preg rival) other-preg)
     1420                                       (do* ((qidx (1+ (interval-idx rival)) (1+ qidx)))
     1421                                            ((= qidx idx)
     1422                                             (setf (svref avail regtype)
     1423                                                   (logior (svref avail regtype)
     1424                                                           (ash 1 targeted))))
     1425                                         (let* ((q (aref intervals qidx)))
     1426                                           (when (eql (interval-regtype q) regtype)
     1427                                             (setf (interval-avail q)
     1428                                                   (logandc2 (interval-avail q)
     1429                                                             (ash 1 other-preg)))))))))
     1430                               (setq preg targeted))))))
     1431
     1432
     1433                  (use-reg preg regtype i)
     1434                  (setf (interval-preg i) preg)
     1435                  (append-dll-node i active))))))))))
     1436
     1437
     1438
     1439(defun linear-scan-bailout (&optional (reason "generic failure"))
     1440  (format *error-output* "~%~%bailing-out of linear-scan:~s~&~&" reason)
     1441  (signal 'liear-scan-bailout))
    13721442
    13731443(defun optimize-vinsns (header)
     
    15121582   
    15131583(defun last-vinsn-unless-label (seg)
    1514  ;; Look at the last element(s) of seg. If a vinsn-note,
    1515  ;; keep looking. If a vinsn, return it; if a vinsn-label,
    1516  ;; return nil
    1517  (do* ((element (dll-header-last seg) (dll-node-pred element)))
    1518     ((eq element seg))
    1519   (etypecase element
    1520    (vinsn (return element))
    1521    (vinsn-label (if (typep (vinsn-label-id element) 'fixnum)
    1522            (return nil))))))
     1584  ;; Look at the last element(s) of seg. If a vinsn-note,
     1585  ;; keep looking. If a vinsn, return it; if a vinsn-label,
     1586  ;; return nil
     1587  (do* ((element (dll-header-last seg) (dll-node-pred element)))
     1588       ((eq element seg))
     1589    (etypecase element
     1590      (vinsn (return element))
     1591      (vinsn-label (if (typep (vinsn-label-id element) 'fixnum)
     1592                     (return nil))))))
    15231593   
    15241594
Note: See TracChangeset for help on using the changeset viewer.