Changeset 16433


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

getting better.

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

Legend:

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

    r16429 r16433  
    1 ;;-*-Mode: LISP; Package: CCL -*-
     1;[;;-*-Mode: LISP; Package: CCL -*-
    22;;;
    33;;;   Copyright (C) 2005-2009 Clozure Associates
     
    77;;;   License , known as the LLGPL and distributed with Clozure CL as the
    88;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
    9 ;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
     9;;;   which is distributed with Clozure CL as thsfour-tae file "LGPL".  Where these
    1010;;;   conflict, the preamble takes precedence. 
    1111;;;
     
    4141(defparameter *x862-all-nfp-pushes* ())
    4242(defparameter *x862-nfp-vars* ())
    43 
     43(defparameter *x862-incoming-args-on-stack* most-positive-fixnum)
    4444
    4545(defun x862-max-nfp-depth ()
     
    616616    (let* ((*x862-cur-afunc* afunc)
    617617           (*backend-use-linear-scan* *backend-use-linear-scan*)
     618           (*x862-incoming-args-on-stack* most-positive-fixnum)
    618619           (*x862-returning-values* nil)
    619620           (*x86-current-context-annotation* nil)
     
    13271328            (! default-3-args min))))
    13281329      (!  reserve-spill-area)
     1330      (setq *x862-incoming-args-on-stack* (- max *x862-target-num-arg-regs*))
    13291331      (if fixed (@ (setq *x862-fixed-self-tail-call-label* (backend-get-next-label))))
    1330                          
    1331 
    13321332     
    13331333      (do* ((offset 0 (1+ offset))
     
    13441344                       (logior lreg-flag-spill lreg-flag-pre-spill)))
    13451345                ((= nargs 3)
    1346                  (! copy-incoming-register-arg reg ($ x8664::arg_x)))
     1346                 (! copy-gpr! reg ($ x8664::arg_x)))
    13471347
    13481348                ((= nargs 2)
    1349                  (! copy-incoming-register-arg reg ($ x8664::arg_y)))
     1349                 (! copy-gpr! reg ($ x8664::arg_y)))
    13501350
    13511351                ((= nargs 1)
    1352                  (! copy-incoming-register-arg reg ($ x8664::arg_z))))
     1352                 (! copy-gpr! reg ($ x8664::arg_z))))
    13531353            (setf (var-lreg var) reg)))
    13541354      ())))
     
    28452845                          (eql (hard-regspec-value val-reg) *x862-arg-z*))
    28462846               (compiler-bug "Bug: invalid register targeting for gvset: ~s" (list src unscaled-idx val-reg)))
    2847              (! call-subprim-3 val-reg (subprim-name->offset '.SPgvset) src unscaled-idx val-reg))
     2847             (! call-subprim-3 val-reg(subprim-name->offset '.SPgvset) src unscaled-idx val-reg))
    28482848            (is-node
    28492849             (if (and index-known-fixnum (<= index-known-fixnum
     
    36753675  (with-x86-local-vinsn-macros (seg) 
    36763676    (let* ((nregs (length revregargs))
    3677            (n nregs))
     3677           (n nregs)
     3678           (zreg ())
     3679           (yreg ())
     3680           (xreg ()))
     3681           
    36783682      (declare (fixnum n))
    36793683      (dolist (arg stkargs)
     
    36953699            (progn
    36963700              (target-arch-case (:x8632 (compiler-bug "3 reg args on x8632?")))
    3697               (x862-three-targeted-reg-forms seg xform ($ x8664::arg_x)
     3701              (multiple-value-setq (xreg yreg zreg) (x862-three-targeted-reg-forms seg xform ($ x8664::arg_x)
    36983702                                             yform ($ *x862-arg-y*)
    3699                                              zform ($ *x862-arg-z*)))
     3703                                             zform ($ *x862-arg-z*))))
    37003704            (if (eq 2 nregs)
    3701               (x862-two-targeted-reg-forms seg yform ($ *x862-arg-y*) zform ($ *x862-arg-z*))
    3702               (x862-one-targeted-reg-form seg zform ($ *x862-arg-z*))))))
    3703       n)))
     3705              (multiple-value-setq (yreg zreg) (x862-two-targeted-reg-forms seg yform ($ *x862-arg-y*) zform ($ *x862-arg-z*)))
     3706              (setq zreg (x862-one-targeted-reg-form seg zform ($ *x862-arg-z*)))))))
     3707      (values n zreg yreg xreg))))
    37043708
    37053709(defun x862-arglist (seg args &optional mv-label suppress-frame-reservation)
     
    40684072(defun x862-three-targeted-reg-forms (seg aform areg bform breg cform creg)
    40694073  (if *backend-use-linear-scan*
    4070   (with-x86-local-vinsn-macros (seg)
    4071     (let* ((atemp (x862-one-lreg-form Seg aform (?)))
    4072            (btemp (x862-one-lreg-form seg bform (?)))
    4073            (ctemp (x862-one-lreg-form seg cform (?))))
    4074       (when (or (lreg-wired atemp) (lreg-wired btemp) (lreg-wired ctemp))
    4075         (break))
    4076       (let* ((g0 (?))
    4077              (g1 (?)))       
    4078         (! copy-gpr! g0 atemp)
    4079         (! copy-gpr! g1 btemp)
     4074    (with-x86-local-vinsn-macros (seg)
     4075      (multiple-value-bind (atemp btemp ctemp)
     4076          (x862-three-untargeted-reg-forms seg aform areg bform breg cform creg)
     4077        (! copy-gpr! areg areg)
     4078        (! copy-gpr! breg breg)
    40804079        (! copy-gpr! creg ctemp)
    4081         (! copy-gpr! areg g0)
    4082         (! copy-gpr! breg g1))))
     4080        (! copy-gpr! areg atemp)
     4081        (! copy-gpr! breg btemp))
     4082      (values areg breg creg)    ) 
     4083
    40834084   
    4084   (let* ((bnode (nx2-node-gpr-p breg))
    4085          (cnode (nx2-node-gpr-p creg))
    4086          (atriv (or (null aform)
    4087                     (and (x862-trivial-p bform areg)
    4088                          (x862-trivial-p cform areg)
    4089                          bnode
    4090                          cnode)))
    4091          (btriv (or (null bform)
    4092                     (and (x862-trivial-p cform breg)
    4093                          cnode)))
    4094          (aconst (and (not atriv)
    4095                       (or (x86-side-effect-free-form-p aform)
    4096                           (let ((avar (nx2-lexical-reference-p aform)))
    4097                             (and avar
    4098                                  (nx2-var-not-set-by-form-p avar bform)
    4099                                  (nx2-var-not-set-by-form-p avar cform))))))
    4100          (bconst (and (not btriv)
    4101                       (or
    4102                        (x86-side-effect-free-form-p bform)
    4103                        (let ((bvar (nx2-lexical-reference-p bform)))
    4104                          (and bvar (nx2-var-not-set-by-form-p bvar cform))))))
    4105          (apushed nil)
    4106          (bpushed nil))
    4107     (if (and aform (not aconst))
    4108       (if atriv
    4109         (x862-one-targeted-reg-form seg aform areg)
    4110         (setq apushed (x862-push-reg-for-form seg aform areg t))))
    4111     (if (and bform (not bconst))
    4112       (if btriv
    4113         (x862-one-targeted-reg-form seg bform breg)
    4114         (setq bpushed (x862-push-reg-for-form seg bform breg t))))
    4115     (x862-one-targeted-reg-form seg cform creg)
    4116     (unless btriv
    4117       (if bconst
    4118         (x862-one-targeted-reg-form seg bform breg)
    4119         (x862-elide-pushes seg bpushed (x862-pop-register seg breg))))
    4120     (unless atriv
    4121       (if aconst
    4122         (x862-one-targeted-reg-form seg aform areg)
    4123         (x862-elide-pushes seg apushed (x862-pop-register seg areg))))
    4124     (values areg breg creg))))
     4085    (let* ((bnode (nx2-node-gpr-p breg))
     4086           (cnode (nx2-node-gpr-p creg))
     4087           (atriv (or (null aform)
     4088                      (and (x862-trivial-p bform areg)
     4089                           (x862-trivial-p cform areg)
     4090                           bnode
     4091                           cnode)))
     4092           (btriv (or (null bform)
     4093                      (and (x862-trivial-p cform breg)
     4094                           cnode)))
     4095           (aconst (and (not atriv)
     4096                        (or (x86-side-effect-free-form-p aform)
     4097                            (let ((avar (nx2-lexical-reference-p aform)))
     4098                              (and avar
     4099                                   (nx2-var-not-set-by-form-p avar bform)
     4100                                   (nx2-var-not-set-by-form-p avar cform))))))
     4101           (bconst (and (not btriv)
     4102                        (or
     4103                         (x86-side-effect-free-form-p bform)
     4104                         (let ((bvar (nx2-lexical-reference-p bform)))
     4105                           (and bvar (nx2-var-not-set-by-form-p bvar cform))))))
     4106           (apushed nil)
     4107           (bpushed nil))
     4108      (if (and aform (not aconst))
     4109        (if atriv
     4110          (x862-one-targeted-reg-form seg aform areg)
     4111          (setq apushed (x862-push-reg-for-form seg aform areg t))))
     4112      (if (and bform (not bconst))
     4113        (if btriv
     4114          (x862-one-targeted-reg-form seg bform breg)
     4115          (setq bpushed (x862-push-reg-for-form seg bform breg t))))
     4116      (x862-one-targeted-reg-form seg cform creg)
     4117      (unless btriv
     4118        (if bconst
     4119          (x862-one-targeted-reg-form seg bform breg)
     4120          (x862-elide-pushes seg bpushed (x862-pop-register seg breg))))
     4121      (unless atriv
     4122        (if aconst
     4123          (x862-one-targeted-reg-form seg aform areg)
     4124          (x862-elide-pushes seg apushed (x862-pop-register seg areg))))
     4125      (values areg breg creg))))
    41254126
    41264127(defun x862-four-targeted-reg-forms (seg aform areg bform breg cform creg dform dreg)
     
    41944195(defun x862-three-untargeted-reg-forms (seg aform areg bform breg cform creg &optional (restricted 0))
    41954196  (with-x86-local-vinsn-macros (seg)
    4196     (let* ((bnode (nx2-node-gpr-p breg))
    4197            (cnode (nx2-node-gpr-p creg))
    4198            (atriv (or (null aform)
    4199                       (and (x862-trivial-p bform areg)
    4200                            (x862-trivial-p cform areg)
    4201                            bnode
    4202                            cnode)))
    4203            (btriv (or (null bform)
    4204                       (and (x862-trivial-p cform breg)
    4205                            cnode)))
    4206            (aconst (and (not atriv)
    4207                         (or (x86-side-effect-free-form-p aform)
    4208                             (let ((avar (nx2-lexical-reference-p aform)))
    4209                               (and avar
    4210                                    (nx2-var-not-set-by-form-p avar bform)
    4211                                    (nx2-var-not-set-by-form-p avar cform))))))
    4212            (bconst (and (not btriv)
    4213                         (or
    4214                          (x86-side-effect-free-form-p bform)
    4215                          (let ((bvar (nx2-lexical-reference-p bform)))
    4216                            (and bvar (nx2-var-not-set-by-form-p bvar cform))))))
    4217            (adest nil)
    4218            (bdest nil)
    4219            (cdest nil)
    4220            (apushed nil)
    4221            (bpushed nil))
    4222       (when (and aform (not aconst))
    4223         (if atriv
    4224           (progn
    4225             (setq adest (x862-one-untargeted-reg-form seg aform ($ areg) restricted)
    4226                   restricted (x862-restrict-node-target adest restricted))
    4227             (when (same-x86-reg-p adest breg)
    4228               (setq breg areg))
    4229             (when (same-x86-reg-p adest creg)
    4230               (setq creg areg)))
    4231           (setq apushed (x862-push-reg-for-form seg aform areg))))
    4232       (when (and bform (not bconst))
    4233         (if btriv
    4234           (progn
    4235             (setq bdest (x862-one-untargeted-reg-form seg bform ($ breg) restricted)
    4236                   restricted (x862-restrict-node-target bdest restricted))
    4237             (unless adest
    4238               (when (same-x86-reg-p bdest areg)
    4239                 (setq areg breg)))
    4240             (when (same-x86-reg-p bdest creg)
    4241               (setq creg breg)))
    4242           (setq bpushed (x862-push-reg-for-form seg bform breg))))
    4243       (setq cdest (x862-one-untargeted-reg-form seg cform creg restricted)
    4244             restricted (x862-restrict-node-target cdest restricted))
    4245       (when (same-x86-reg-p cdest areg)
    4246         (setq areg creg))
    4247       (when (same-x86-reg-p cdest breg)
    4248         (setq breg creg))
    4249       (unless btriv
    4250         (if bconst
    4251           (setq bdest (x862-one-untargeted-reg-form seg bform breg restricted))
    4252           (x862-elide-pushes seg bpushed (x862-pop-register seg (setq bdest breg))))
    4253         (setq restricted (x862-restrict-node-target bdest restricted))
    4254         (when (same-x86-reg-p bdest areg)
    4255           (setq areg breg)))
    4256       (unless atriv
    4257         (if aconst
    4258           (setq adest (x862-one-untargeted-reg-form seg aform areg restricted))
    4259           (x862-elide-pushes seg apushed (x862-pop-register seg (setq adest areg)))))
    4260       (values adest bdest cdest))))
     4197    (if *backend-use-linear-scan*
     4198      (values (x862-one-lreg-form seg aform (ensure-unwired-lreg-like areg))
     4199              (x862-one-lreg-form seg bform (ensure-unwired-lreg-like breg))
     4200              (x862-one-lreg-form seg cform (ensure-unwired-lreg-like creg)))
     4201
     4202      (let* ((bnode (nx2-node-gpr-p breg))
     4203             (cnode (nx2-node-gpr-p creg))
     4204             (atriv (or (null aform)
     4205                        (and (x862-trivial-p bform areg)
     4206                             (x862-trivial-p cform areg)
     4207                             bnode
     4208                             cnode)))
     4209             (btriv (or (null bform)
     4210                        (and (x862-trivial-p cform breg)
     4211                             cnode)))
     4212             (aconst (and (not atriv)
     4213                          (or (x86-side-effect-free-form-p aform)
     4214                              (let ((avar (nx2-lexical-reference-p aform)))
     4215                                (and avar
     4216                                     (nx2-var-not-set-by-form-p avar bform)
     4217                                     (nx2-var-not-set-by-form-p avar cform))))))
     4218             (bconst (and (not btriv)
     4219                          (or
     4220                           (x86-side-effect-free-form-p bform)
     4221                           (let ((bvar (nx2-lexical-reference-p bform)))
     4222                             (and bvar (nx2-var-not-set-by-form-p bvar cform))))))
     4223             (adest nil)
     4224             (bdest nil)
     4225             (cdest nil)
     4226             (apushed nil)
     4227             (bpushed nil))
     4228        (when (and aform (not aconst))
     4229          (if atriv
     4230            (progn
     4231              (setq adest (x862-one-untargeted-reg-form seg aform ($ areg) restricted)
     4232                    restricted (x862-restrict-node-target adest restricted))
     4233              (when (same-x86-reg-p adest breg)
     4234                (setq breg areg))
     4235              (when (same-x86-reg-p adest creg)
     4236                (setq creg areg)))
     4237            (setq apushed (x862-push-reg-for-form seg aform areg))))
     4238        (when (and bform (not bconst))
     4239          (if btriv
     4240            (progn
     4241              (setq bdest (x862-one-untargeted-reg-form seg bform ($ breg) restricted)
     4242                    restricted (x862-restrict-node-target bdest restricted))
     4243              (unless adest
     4244                (when (same-x86-reg-p bdest areg)
     4245                  (setq areg breg)))
     4246              (when (same-x86-reg-p bdest creg)
     4247                (setq creg breg)))
     4248            (setq bpushed (x862-push-reg-for-form seg bform breg))))
     4249        (setq cdest (x862-one-untargeted-reg-form seg cform creg restricted)
     4250              restricted (x862-restrict-node-target cdest restricted))
     4251        (when (same-x86-reg-p cdest areg)
     4252          (setq areg creg))
     4253        (when (same-x86-reg-p cdest breg)
     4254          (setq breg creg))
     4255        (unless btriv
     4256          (if bconst
     4257            (setq bdest (x862-one-untargeted-reg-form seg bform breg restricted))
     4258            (x862-elide-pushes seg bpushed (x862-pop-register seg (setq bdest breg))))
     4259          (setq restricted (x862-restrict-node-target bdest restricted))
     4260          (when (same-x86-reg-p bdest areg)
     4261            (setq areg breg)))
     4262        (unless atriv
     4263          (if aconst
     4264            (setq adest (x862-one-untargeted-reg-form seg aform areg restricted))
     4265            (x862-elide-pushes seg apushed (x862-pop-register seg (setq adest areg)))))
     4266        (values adest bdest cdest)))))
    42614267
    42624268(defun x862-four-untargeted-reg-forms (seg aform areg bform breg cform creg dform dreg &optional (restricted 0))
     
    57195725        (when (or (%ilogbitp $vbitspecial bits) closed-p)
    57205726          (break "not yet special or closed variable ~s" var))
    5721         (setf (lreg-spill-offset reg) (ash vloc -3)
    5722                            (lreg-flags reg)
    5723                            (logior lreg-flag-spill lreg-flag-pre-spill))))
     5727        (let* ((offset (ash vloc -3)))
     5728          (when (< offset *x862-incoming-args-on-stack*)
     5729            (setf (lreg-spill-offset reg) offset
     5730                  (lreg-flags reg)
     5731                  (logior lreg-flag-spill lreg-flag-pre-spill))))))
    57245732    (if (%ilogbitp $vbitspecial bits)
    57255733      (progn
     
    61376145
    61386146
    6139 (defun x862-ref-symbol-value (seg vreg xfer sym check-boundp)
     6147i(defun x862-ref-symbol-value (seg vreg xfer sym check-boundp)
    61406148  (declare (ignorable check-boundp))
    61416149  (setq check-boundp (not *x862-reckless*))
     
    61466154          (ensuring-node-target (target vreg)
    61476155            (! ref-interrupt-level target))
    6148           (if *x862-open-code-inline*
     6156          (if (or *backend-use-linear-scan* *x862-open-code-inline*)
    61496157            (ensuring-node-target (target vreg)
    61506158              (with-node-target (target) src
     
    61986206
    61996207
     6208
    62006209(defun x862-misc-byte-count (subtag element-count)
    62016210  (funcall (arch::target-array-data-size-function
     
    62216230    (if (null vreg)
    62226231      (dolist (f initforms) (x862-form seg nil nil f))
    6223       (let* ((*x862-vstack* *x862-vstack*)
    6224              (arch (backend-target-arch *target-backend*))
    6225              (n (length initforms))
    6226              (vreg-val (hard-regspec-value vreg))
    6227              (nntriv (let* ((count 0))
    6228                        (declare (fixnum count))
    6229                        (dolist (f initforms count)
    6230                          (unless (and (x86-side-effect-free-form-p f)
    6231                                       (let* ((reg (x862-reg-for-form f vreg)))
    6232                                         (not (eql (if reg
    6233                                                     (hard-regspec-value reg))
    6234                                                   vreg-val))))
    6235                            (incf count)))))
    6236              (header (arch::make-vheader n subtag)))
    6237         (declare (fixnum n nntriv))
    6238         (cond ((or *x862-open-code-inline* (> nntriv 3))
    6239                (x862-formlist seg initforms nil)
    6240                (target-arch-case
    6241                 (:x8632
    6242                  (x862-lri seg *x862-imm0* header)
    6243                  (! setup-uvector-allocation *x862-imm0*)
    6244                  (x862-lri seg *x862-imm0* (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) x8632::fulltag-misc)))
    6245                 (:x8664
    6246                  (x862-lri seg *x862-imm0* header)
    6247                  (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) x8664::fulltag-misc))))
    6248                (! %allocate-uvector vreg)
    6249                (unless (eql n 0)
    6250                  (do* ((idx (1- n) (1- idx)))
    6251                       ((< idx 0))
    6252                    (! vpop-gvector-element vreg idx))))
    6253               (t
    6254                (let* ((pending ())
    6255                       (vec *x862-allocptr*))
    6256                  (dolist (form initforms)
    6257                    (if (x86-side-effect-free-form-p form)
    6258                      (push form pending)
    6259                      (progn
    6260                        (push nil pending)
    6261                        (x862-vpush-register seg (x862-one-untargeted-reg-form seg form *x862-arg-z*)))))
    6262                  (target-arch-case
    6263                   (:x8632
    6264                    (x862-lri seg *x862-imm0* header)
    6265                    (! setup-uvector-allocation *x862-imm0*)
    6266                    (x862-lri seg *x862-imm0* (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) x8632::fulltag-misc)))
    6267                   (:x8664
    6268                    (x862-lri seg *x862-imm0* header)
    6269                    (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) x8664::fulltag-misc))))
    6270                  (ensuring-node-target (target vreg)
    6271                    (! %allocate-uvector vec)
    6272                    (with-node-temps (vec) (nodetemp)
    6273                      (do* ((forms pending (cdr forms))
    6274                            (index (1- n) (1- index)))
    6275                           ((null forms))
    6276                        (declare (list forms))
    6277                        (let* ((form (car forms))
    6278                               (reg nodetemp))
    6279                          (if form
    6280                            (cond ((nx-null form)
    6281                                   (! misc-set-immediate-c-node (target-nil-value) vec index))
    6282                                  ((nx-t form)
    6283                                   (! misc-set-immediate-c-node (target-t-value) vec index))
    6284                                  (t (let* ((fixval (acode-fixnum-form-p form)))
    6285                                       (cond ((and fixval
    6286                                                   (typep (setq fixval (ash fixval *x862-target-fixnum-shift*)) '(signed-byte 32)))
    6287                                              (! misc-set-immediate-c-node fixval vec index))
    6288                                             (t
    6289                                              (setq reg (x862-one-untargeted-reg-form seg form nodetemp))
    6290                                              (! misc-set-c-node reg vec index))))))
    6291                            (progn
    6292                              (! vpop-gvector-element vec index)
    6293                              (x862-adjust-vstack (- *x862-target-node-size*))))
    6294                          )))
    6295                    (x862-copy-register seg target vec)))))))
    6296      (^)))
     6232      (if *backend-use-linear-scan*
     6233        (let* ((n (length initforms))
     6234               (npushed (- n 3))
     6235
     6236               (arch (backend-target-arch *target-backend*)))
     6237         
     6238          (ensuring-node-target (target vreg)
     6239            (multiple-value-bind (ignore zreg yreg xreg) (x862-formlist seg (butlast initforms 3) (reverse (last initforms 3)))
     6240              (declare (ignore ignore))
     6241              (let* ((vec ($ x8664::temp0))
     6242                     (header-value (arch::make-vheader n subtag))
     6243                     (header-reg ($ x8664::imm0 :mode :u64))
     6244                     (disp-value (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) x8664::fulltag-misc))
     6245                     (disp-reg ($ x8664::imm1 :mode :s64)))
     6246                (x862-lri seg header-reg header-value)
     6247                (x862-lri seg disp-reg disp-value)
     6248                (! %allocate-uvector vec)
     6249                (do* ((i (1- npushed) (1- i)))
     6250                     ((< i 0))
     6251                  (! vpop-gvector-element vec i))
     6252                (when xreg
     6253                  (! misc-set-c-node xreg vec npushed))
     6254                (when yreg
     6255                  (! misc-set-c-node yreg vec (1+ npushed)))
     6256                (when zreg
     6257                  (! misc-set-c-node zreg vec (1- n)))
     6258               
     6259
     6260             
     6261            (x862-copy-register seg target vec)))
     6262          ))
     6263               
     6264                             
     6265        (let* ((*x862-vstack* *x862-vstack*)
     6266               (arch (backend-target-arch *target-backend*))
     6267               (n (length initforms))
     6268               (vreg-val (hard-regspec-value vreg))
     6269               (nntriv (let* ((count 0))
     6270                         (declare (fixnum count))
     6271                         (dolist (f initforms count)
     6272                           (unless (and (x86-side-effect-free-form-p f)
     6273                                        (let* ((reg (x862-reg-for-form f vreg)))
     6274                                          (not (eql (if reg
     6275                                                      (hard-regspec-value reg))
     6276                                                    vreg-val))))
     6277                             (incf count)))))
     6278               (header (arch::make-vheader n subtag)))
     6279          (declare (fixnum n nntriv))
     6280          (cond ((or *x862-open-code-inline* (> nntriv 3))
     6281                 (x862-formlist seg initforms nil)
     6282                 (target-arch-case
     6283                  (:x8632
     6284                   (x862-lri seg *x862-imm0* header)
     6285                   (! setup-uvector-allocation *x862-imm0*)
     6286                   (x862-lri seg *x862-imm0* (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) x8632::fulltag-misc)))
     6287                  (:x8664
     6288                   (x862-lri seg *x862-imm0* header)
     6289                   (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) x8664::fulltag-misc))))
     6290                 (! %allocate-uvector vreg)
     6291                 (unless (eql n 0)
     6292                   (do* ((idx (1- n) (1- idx)))
     6293                        ((< idx 0))
     6294                     (! vpop-gvector-element vreg idx))))
     6295                (t
     6296                 (let* ((pending ())
     6297                        (vec *x862-allocptr*))
     6298                   (dolist (form initforms)
     6299                     (if (x86-side-effect-free-form-p form)
     6300                       (push form pending)
     6301                       (progn
     6302                         (push nil pending)
     6303                         (x862-vpush-register seg (x862-one-untargeted-reg-form seg form *x862-arg-z*)))))
     6304                   (target-arch-case
     6305                    (:x8632
     6306                     (x862-lri seg *x862-imm0* header)
     6307                     (! setup-uvector-allocation *x862-imm0*)
     6308                     (x862-lri seg *x862-imm0* (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) x8632::fulltag-misc)))
     6309                    (:x8664
     6310                     (x862-lri seg *x862-imm0* header)
     6311                     (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) x8664::fulltag-misc))))
     6312                   (ensuring-node-target (target vreg)
     6313                     (! %allocate-uvector vec)
     6314                     (with-node-temps (vec) (nodetemp)
     6315                       (do* ((forms pending (cdr forms))
     6316                             (index (1- n) (1- index)))
     6317                            ((null forms))
     6318                         (declare (list forms))
     6319                         (let* ((form (car forms))
     6320                                (reg nodetemp))
     6321                           (if form
     6322                             (cond ((nx-null form)
     6323                                    (! misc-set-immediate-c-node (target-nil-value) vec index))
     6324                                   ((nx-t form)
     6325                                    (! misc-set-immediate-c-node (target-t-value) vec index))
     6326                                   (t (let* ((fixval (acode-fixnum-form-p form)))
     6327                                        (cond ((and fixval
     6328                                                    (typep (setq fixval (ash fixval *x862-target-fixnum-shift*)) '(signed-byte 32)))
     6329                                               (! misc-set-immediate-c-node fixval vec index))
     6330                                              (t
     6331                                               (setq reg (x862-one-untargeted-reg-form seg form nodetemp))
     6332                                               (! misc-set-c-node reg vec index))))))
     6333                             (progn
     6334                               (! vpop-gvector-element vec index)
     6335                               (x862-adjust-vstack (- *x862-target-node-size*))))
     6336                           )))
     6337                     (x862-copy-register seg target vec))))))))
     6338    (^)))
    62976339
    62986340;;; Heap-allocated constants -might- need memoization: they might be newly-created,
     
    1197612018
    1197712019(defun x8664-target-spill-offset (lreg)
    11978   ;; return an rbp-relative offset for lreg's spill-offset
     12020  ;; return an rbp-relati_e offset for lreg's spill-offset
    1197912021  ;; could use rsp-relative  offset if rsp is known/fixed
    1198012022  (let* ((offset (lreg-spill-offset lreg)))
  • branches/lscan/source/compiler/backend.lisp

    r16423 r16433  
    369369
    370370(defun ensure-unwired-lreg-like (proto)
    371   (if (typep proto 'fixnum)
    372     (make-unwired-lreg nil
    373                        :class (hard-regspec-class proto)
    374                        :mode (get-regspec-mode proto))
    375     proto))
     371  (make-unwired-lreg nil
     372                     :class (hard-regspec-class proto)
     373                     :mode (get-regspec-mode proto)))
     374
    376375
    377376                       
Note: See TracChangeset for help on using the changeset viewer.