Changeset 16427


Ignore:
Timestamp:
Jun 18, 2015, 1:55:51 AM (4 years ago)
Author:
gb
Message:

Move (mostly) forward. should have full lambda support now, but still
issues with fixed intervals.

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

Legend:

Unmodified
Added
Removed
  • branches/lscan/source/compiler/X86/X8664/x8664-vinsns.lisp

    r16425 r16427  
    515515 
    516516
    517 (define-x8664-vinsn save-lisp-context-no-stack-args (()
     517(define-x8664-vinsn (save-lisp-context-no-stack-args uses-frame-pointer) (()
    518518                                                     ())
    519519  (pushq (:%q x8664::rbp))
     
    521521
    522522
    523 (define-x8664-vinsn save-lisp-context-offset (()
     523(define-x8664-vinsn (save-lisp-context-offset :uses-frame-pointer) (()
    524524                                              ((nbytes-pushed :s32const)))
    525525  (movq (:%q x8664::rbp) (:@ (:apply + nbytes-pushed x8664::node-size) (:%q x8664::rsp)))
  • branches/lscan/source/compiler/X86/x862.lisp

    r16426 r16427  
    12841284;;; Vpush register r, unless var gets a globally-assigned register.
    12851285;;; Return NIL if register was vpushed, else var.
    1286 (defun x862-vpush-arg-register (seg reg var &optional (i 0) (n 0))
     1286(defun x862-vpush-arg-register (seg reg var &rest ignore)
     1287  (declare (ignore ignore))
    12871288  (with-x86-local-vinsn-macros (seg)
    12881289    (when var
     
    12901291        var
    12911292        (progn
    1292           (if *backend-use-linear-scan*
    1293             (progn
    1294               (setf (var-lreg var) reg)
    1295               (! incoming-register-arg reg i n))
    1296             (x862-vpush-register seg reg))
     1293          (x862-vpush-register seg reg)
    12971294          nil)))))
    12981295
     1296;; arg oount has been checked, context has been saved, &optionals defaulted.
     1297
     1298(defun x862-simple-args-entry (seg rev-fixed-args min max)
     1299  (with-x86-local-vinsn-macros (seg)
     1300    (let* ((fixed (eql min max))
     1301           (nopt (- max min))
     1302           (args (reverse rev-fixed-args))
     1303           (nargs (length args)))
     1304      (if fixed
     1305        (unless *x862-reckless*
     1306          (! check-exact-nargs nargs))
     1307        (progn
     1308          (if (eql min 0)
     1309            (! check-max-args max)
     1310            (! check-min-max-nargs min max))))
     1311      (if fixed
     1312        (if (<= max  *x862-target-num-arg-regs*) ; caller didn't vpush anything
     1313          (! save-lisp-context-no-stack-args)
     1314          (let* ((offset (* (the fixnum (- max *x862-target-num-arg-regs*)) *x862-target-node-size*)))
     1315            (declare (fixnum offset))
     1316            (! save-lisp-context-offset offset)))
     1317        (if (> min *x862-target-num-arg-regs*)
     1318          (! save-lisp-context-in-frame)
     1319          (if (<= max *x862-target-num-arg-regs*)
     1320            (! save-lisp-context-no-stack-args)
     1321            (! save-lisp-context-variable-arg-count))))
     1322      (unless fixed
     1323        (if (= nopt 1)
     1324          (! default-1-arg min)
     1325          (if (= nopt 2)
     1326            (! default-2-args min)
     1327            (! default-3-args min))))
     1328      (!  reserve-spill-area)
     1329      (if fixed (@ (setq *x862-fixed-self-tail-call-label* (backend-get-next-label))))
     1330                         
     1331
     1332     
     1333      (do* ((offset 0 (1+ offset))
     1334            (nargs (length args) (1- nargs))
     1335            (nregargs (min nargs 3))
     1336            (regarg 0))
     1337           ((null args) ())
     1338        (declare (type (signed-byte 16) offset nargs nregargs regarg))
     1339        (let* ((var (pop args))
     1340               (reg nil))
     1341             
     1342          (cond ((> nargs 3)
     1343                 (setq reg (?))
     1344                 (setf (lreg-spill-offset reg) offset
     1345                       (lreg-flags reg)
     1346                       (logior lreg-flag-spill lreg-flag-pre-spill)))
     1347                ((= nargs 3)
     1348                 (setq reg ($ x8664::arg_x))
     1349                 (! incoming-register-arg reg regarg nregargs)
     1350                 (incf regarg))
     1351                ((= nargs 2)
     1352                 (setq reg ($ x8664::arg_y))
     1353                 (! incoming-register-arg reg regarg  nregargs)
     1354                 (incf regarg))
     1355                ((= nargs 1)
     1356                 (setq reg ($ x8664::arg_z))
     1357                 (! incoming-register-arg reg regarg nregargs)))
     1358            (setf (var-lreg var) reg)))
     1359      ())))
    12991360
    13001361;;; nargs has been validated, arguments defaulted and canonicalized.
     
    13291390       (:x8664
    13301391        (destructuring-bind (&optional zvar yvar xvar &rest stack-args) revargs
    1331           (let* ((nstackargs (length stack-args))
    1332                  (i -1))
    1333             (declare (fixnum i))
     1392          (let* ((nstackargs (length stack-args)))
    13341393            (x862-set-vstack (* nstackargs *x862-target-node-size*))
    13351394            (if (>= nargs 3)
    1336               (push (x862-vpush-arg-register seg ($ x8664::arg_x) xvar (incf i)3 ) reg-vars))
     1395              (push (x862-vpush-arg-register seg ($ x8664::arg_x) xvar ) reg-vars))
    13371396            (if (>= nargs 2)
    1338               (push (x862-vpush-arg-register seg ($ *x862-arg-y*) yvar (incf i) (if (= nargs 2) 2 3)) reg-vars))
     1397              (push (x862-vpush-arg-register seg ($ *x862-arg-y*) yvar ) reg-vars))
    13391398            (if (>= nargs 1)
    1340               (push (x862-vpush-arg-register seg ($ *x862-arg-z*) zvar (incf i) (min nargs 3)) reg-vars))))))
     1399              (push (x862-vpush-arg-register seg ($ *x862-arg-z*) zvar ) reg-vars))))))
    13411400      reg-vars)))
    13421401
     
    56855744                          (addr (x862-vloc-ea vloc)))
    56865745  (with-x86-local-vinsn-macros (seg)
     5746    (when *backend-use-linear-scan*
     5747      (let*  ((reg (or (var-lreg var) (let* ((r (?))) (setf (var-lreg var) r)))))
     5748        (when (or (%ilogbitp $vbitspecial bits) closed-p)
     5749          (break "not yet special or closed variable ~s" var))
     5750        (setf (lreg-spill-offset reg) (ash vloc -3)
     5751                           (lreg-flags reg)
     5752                           (logior lreg-flag-spill lreg-flag-pre-spill))))
    56875753    (if (%ilogbitp $vbitspecial bits)
    56885754      (progn
     
    73267392               (max-args (unless (or rest keys) (+ num-fixed num-opt))))
    73277393          (if (not (or opt rest keys))
    7328             (setq arg-regs (x862-req-nargs-entry seg rev-fixed))
     7394            ;;(setq arg-regs (x862-req-nargs-entry seg rev-fixed))
     7395            (if *backend-use-linear-scan*
     7396              (x862-simple-args-entry seg rev-fixed num-fixed num-fixed)
     7397              (setq arg-regs (x862-req-nargs-entry seg rev-fixed)))
    73297398            (if (and (not (or hardopt rest keys))
    73307399                     (<= num-opt *x862-target-num-arg-regs*))
    7331               (setq arg-regs (x862-simple-opt-entry seg rev-opt rev-fixed))
     7400              (if *backend-use-linear-scan*
     7401                (x862-simple-args-entry seg (append rev-opt rev-fixed) num-fixed max-args)
     7402                (setq arg-regs (x862-simple-opt-entry seg rev-opt rev-fixed)))
    73327403              (progn
     7404                ;; From now on, the runtime assumes that all
     7405                ;; incoming arguments are on the stack, either because
     7406                ;; we push them below or something in the runtime does
    73337407                ;; If the minumum acceptable number of args is
    73347408                ;; non-zero, ensure that at least that many were
     
    1193812012
    1193912013(defun x8664-spill-area-needed ()
    11940   (vinsn-list-max-spill-depth *vinsn-list*))
     12014  (let* ((vl *vinsn-list*))
     12015    (- (vinsn-list-max-spill-depth vl) (vinsn-list-spill-base vl))))
  • branches/lscan/source/compiler/vinsn.lisp

    r16426 r16427  
    286286    :ref                                ; references memory
    287287    :set                                ; sets memory
    288     :outgoing-argument                  ; e.g., pushed as an argument, not to avoid clobbering
    289     :xref                               ; makes some label externally visible
     288    :uses-frame-pointer                 ; uses frame pointer
     289    :needs=frame-pointer                ; needs to use frame pointer
    290290    :jump-unknown                       ; Jumps, but we don't know where ...
    291291    :constant-ref
     
    975975             (dest (svref vp 0))
    976976             (src (svref vp 1)))
     977
    977978        ;; This is probably not the only case where we can't
    978979        ;; avoid removing a COPY instruction.
    979980        (unless (or (lreg-wired dest)
    980                     (logbitp lreg-spill-bit (lreg-flags src))
    981                     (logbitp lreg-spill-bit (lreg-flags dest)))
     981                    ;(logbitp lreg-spill-bit (lreg-flags src))
     982                    ;(logbitp lreg-spill-bit (lreg-flags dest)))
    982983          (setf (lreg-defs dest) nil)
    983984          (dolist (ref (lreg-refs dest) (setf (lreg-refs dest) nil))
     
    11531154        (let* ((reload-seq (vinsn-sequence reload-vinsn)))
    11541155          (when (< reload-seq (interval-begin interval))
    1155             (setf (interval-begin interval) reload-seq))))))))
     1156            (setf (interval-begin interval) reload-seq)))))))
    11561157     
    11571158     
     
    12851286                      (when (and (eql regtype (interval-regtype victim))
    12861287                                 (> (interval-end victim) begin))
    1287                         (return (spill-and-split-interval   seg victim begin intervals unhandled)))))
     1288                        (when (eq i victim) (dbg))
     1289                        (return (spill-and-split-interval   seg victim (interval-begin victim) intervals unhandled)))))
    12881290                                 
    12891291
     
    13071309                                                        (when (logbitp i mask)
    13081310                                                          (return i)))))))
    1309                        
     1311
     1312                        (when (and fixed (not (logbitp fixed mask)))
     1313                          (let* ((other (do-dll-nodes (x active (error "can't find interval with ~d" fixed))
     1314                                          (when (and (eql regtype (interval-regtype x))
     1315                                                     (eql fixed (interval-preg x)))
     1316                                            (return x)))))
     1317                            (spill-and-split-interval seg other begin intervals unhandled)))
    13101318
    13111319                        (when (and targeted (not (eql targeted preg)))
Note: See TracChangeset for help on using the changeset viewer.