Changeset 16426


Ignore:
Timestamp:
Jun 15, 2015, 1:25:16 AM (4 years ago)
Author:
gb
Message:

Treat incoming stack-based arguments as if their intervals/logical registers
had been spilled in the caller.

Location:
branches/lscan/source/compiler
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/lscan/source/compiler/X86/x862.lisp

    r16425 r16426  
    13031303;;; Return a list of vars/nils for each argument register
    13041304;;;  (nil if vpushed, var if still in arg_reg).
    1305 (defun x862-argregs-entry (seg revargs &optional variable-args-entry)
     1305(defun x862-argregs-entry(seg revargs &optional variable-args-entry)
    13061306  (with-x86-local-vinsn-macros (seg)
    13071307    (let* ((nargs (length revargs))
     
    13511351      (unless *x862-reckless*
    13521352        (! check-exact-nargs nargs))
    1353       (x862-argregs-entry seg rev-fixed-args))))
     1353      (if *backend-use-linear-scan*
     1354        (progn
     1355
     1356        (let* ((args (reverse rev-fixed-args))
     1357               (frame-offset (- nargs 3)))
     1358          (if (>= frame-offset 0)
     1359            (! save-lisp-context-no-stack-args)
     1360            (! save-lisp-context-offset (* frame-offset *x862-target-node-size*)))
     1361
     1362          (!  reserve-spill-area)
     1363          (@ (setq *x862-fixed-self-tail-call-label* (backend-get-next-label)))
     1364
     1365          (do* ((offset 0 (1+ offset))
     1366                (nargs (length args) (1- nargs))
     1367                (nregargs (min nargs 3))
     1368                (regarg 0))
     1369               
     1370               
     1371               ((null args) ())
     1372            (let* ((var (pop args))
     1373                   (reg nil))
     1374             
     1375              (cond ((> nargs 3)
     1376                     (setq reg (?))
     1377                     (setf (lreg-spill-offset reg) offset
     1378                           (lreg-flags reg)
     1379                           (logior lreg-flag-spill lreg-flag-pre-spill)))
     1380                    ((= nargs 3)
     1381                     (setq reg ($ x8664::arg_x))
     1382                     (! incoming-register-arg reg regarg nregargs)
     1383                     (incf regarg))
     1384                    ((= nargs 2)
     1385                     (setq reg ($ x8664::arg_y))
     1386                     (! incoming-register-arg reg regarg  nregargs))
     1387                    ((= nargs 1)
     1388                     (setq reg ($ x8664::arg_z))
     1389                     (! incoming-register-arg reg regarg nregargs)))
     1390              (setf (var-lreg var) reg)))))
     1391             
     1392                 
     1393               
     1394               
     1395        (x862-argregs-entry seg rev-fixed-args)))))
    13541396
    13551397;;; No more &optional args than register args; all &optionals default
     
    1188211924      xlfun)))
    1188311925
    11884 (defun x8664-incoming-register-arg-number (i n)
     11926(defun x8664-incomingo-register-arg-number (i n)
    1188511927  (ecase (- n i)
    1188611928    (1 x8664::arg_z)
  • branches/lscan/source/compiler/vinsn.lisp

    r16425 r16426  
    961961  parent
    962962  (spill-offset nil)
     963 
    963964)
    964965
     
    10481049    (dovector (lreg (vinsn-list-lregs seg))
    10491050             
    1050       (let* ((max -1)
    1051              (min (vinsn-list-max-seq seg))
    1052              (all (append (lreg-defs lreg) (lreg-refs lreg))))
    1053         (when all
    1054           (dolist (p all)
    1055             (let* ((seq (vinsn-sequence p)))
    1056               (if (< seq min)
    1057                 (setq min seq))
    1058               (if (> seq max)
    1059                 (setq max seq))))
    1060           (let* ((class (lreg-class lreg))
    1061                  (regtype (cond ((eql class hard-reg-class-fpr)
    1062                                  interval-regtype-float)
    1063                                 ((eql class hard-reg-class-crf)
    1064                                  interval-regtype-cr)
    1065                                 ((eql class hard-reg-class-gpr)
    1066                                  (if (eql (lreg-mode lreg) hard-reg-class-gpr-mode-node)
    1067                                    interval-regtype-node
    1068                                    interval-regtype-imm)))))
    1069 
    1070             (vector-push-extend
    1071              (make-interval lreg min max regtype nil  )
    1072              list)))))
    1073     (setf (vinsn-list-intervals seg)
    1074 
    1075           (sort list (lambda (x y)
    1076                                   (let* ((beginx (interval-begin x))
    1077                                          (beginy (interval-begin y)))
    1078                                     (or (< beginx beginy)
    1079                                         (and (= beginx beginy)
    1080                                              (or (null (interval-lreg x))
    1081 
    1082                                            
    1083                                                  (lreg-local-p (interval-lreg x)))))))))))
     1051              (let* ((max -1)
     1052                     (min (vinsn-list-max-seq seg))
     1053                     (all (append (lreg-defs lreg) (lreg-refs lreg))))
     1054                (when all
     1055                  (dolist (p all)
     1056                    (let* ((seq (vinsn-sequence p)))
     1057                      (if (< seq min)
     1058                        (setq min seq))
     1059                      (if (> seq max)
     1060                        (setq max seq))))
     1061                  (let* ((class (lreg-class lreg))
     1062                         (regtype (cond ((eql class hard-reg-class-fpr)
     1063                                         interval-regtype-float)
     1064                                        ((eql class hard-reg-class-crf)
     1065                                         interval-regtype-cr)
     1066                                        ((eql class hard-reg-class-gpr)
     1067                                         (if (eql (lreg-mode lreg) hard-reg-class-gpr-mode-node)
     1068                                           interval-regtype-node
     1069                                           interval-regtype-imm)))))
     1070                    (let* ((interval (make-interval lreg min max regtype nil)))
     1071                      (when (logbitp lreg-pre-spill-bit (lreg-flags lreg))
     1072                        (process-pre-spilled-interval seg interval lreg (lreg-spill-offset lreg)))
     1073                      (vector-push-extend
     1074                       interval
     1075                       list))))))
     1076               
     1077                   
     1078                   
     1079                   
     1080                   
     1081
     1082                         
     1083                    (setf (vinsn-list-intervals seg)
     1084
     1085                          (sort list (lambda (x y)
     1086                                       (let* ((beginx (interval-begin x))
     1087                                              (beginy (interval-begin y)))
     1088                                         (or (< beginx beginy)
     1089                                             (and (= beginx beginy)
     1090                                                  (or (null (interval-lreg x))
     1091                                                      (lreg-local-p (interval-lreg x)))))))))))
    10841092
    10851093
     
    11241132        (setf (vinsn-sequence vinsn) pred-seq)))))
    11251133         
    1126  
     1134;;; treat incoming stack arguments as if they had
     1135;;; been spilled to the stack.
     1136(defun process-pre-spilled-interval (seg interval lreg offset)
     1137  (let* ((templates (backend-p2-vinsn-templates *target-backend*)))
     1138    (setf (interval-lreg interval) lreg
     1139          (interval-spill-offset interval) offset)
     1140    (let* ((next-offset (1+ offset)))
     1141      (when (> next-offset (vinsn-list-spill-base seg))
     1142        (setf (vinsn-list-spill-base seg) next-offset))
     1143   
     1144      (when (> next-offset (vinsn-list-spill-depth seg))
     1145        (setf (vinsn-list-spill-depth seg) next-offset))
     1146      (when (> next-offset (vinsn-list-max-spill-depth seg))
     1147        (setf (vinsn-list-max-spill-depth seg) next-offset)))
     1148
     1149    (dolist (ref (lreg-refs lreg))
     1150      (let* ((reload-vinsn (select-vinsn 'reload templates (list lreg offset))))
     1151        (push reload-vinsn (lreg-defs lreg))
     1152        (insert-vinsn-before reload-vinsn ref)
     1153        (let* ((reload-seq (vinsn-sequence reload-vinsn)))
     1154          (when (< reload-seq (interval-begin interval))
     1155            (setf (interval-begin interval) reload-seq))))))))
     1156     
     1157     
    11271158(defun spill-and-split-interval (seg parent new-end vector list)
    11281159  (let* ((lreg (interval-lreg parent)))
     
    12761307                                                        (when (logbitp i mask)
    12771308                                                          (return i)))))))
     1309                       
    12781310
    12791311                        (when (and targeted (not (eql targeted preg)))
     
    12811313                                           (when (and (eql (interval-preg other) targeted)
    12821314                                                      (eql (interval-regtype other) regtype))
    1283                                              (return other)))))
    1284                             (setf (interval-preg rival) preg)
    1285                             (use-reg preg regtype)
    1286                             (setq preg targeted)))
     1315                                             (return other))))
     1316                                  (rival-lreg (and rival (interval-lreg rival))))
     1317                            (cond ((null rival-lreg) (break "no lreg for conflicting interval ~s" rival))
     1318                                  ((or (lreg-wired rival-lreg) (lreg-local-p rival-lreg))
     1319                                   (if (eql (interval-end rival) begin)
     1320                                     (setq preg targeted)
     1321                                     (error "conflicting intervals overlap")))
     1322                                  (t
     1323                                   (setf (interval-preg rival) preg)
     1324                                   (use-reg preg regtype)
     1325                                   (setq preg targeted)))))
    12871326                        (use-reg preg regtype)
    12881327                        (setf (interval-preg i) preg)
  • branches/lscan/source/compiler/vreg.lisp

    r16397 r16426  
    4040  (flags 0 :type fixnum)                                ;
    4141  (spill-offset nil :type (or null fixnum))
     42  (interval nil)
    4243 
    4344)
     
    4546(defconstant lreg-spill-bit 0)
    4647(defconstant lreg-flag-spill (ash 1 lreg-spill-bit))
     48(defconstant lreg-pre-spill-bit 1) ; incoming arg
     49(defconstant lreg-flag-pre-spill (ash 1 lreg-pre-spill-bit))
    4750
    4851(defun spilled-lreg-p (x) (if (typep x 'lreg) (logbitp lreg-spill-bit (lreg-flags x))))
Note: See TracChangeset for help on using the changeset viewer.