Changeset 14943


Ignore:
Timestamp:
Aug 17, 2011, 5:35:00 AM (9 years ago)
Author:
gb
Message:

%FIXNUM-{REF|SET}-DOUBLE-FLOAT support in x86 backends.

Location:
trunk/source/compiler/X86
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/X8632/x8632-vinsns.lisp

    r14777 r14943  
    41574157  (:long #x80000000))
    41584158
     4159(define-x8632-vinsn fixnum-ref-c-double-float (((dest :double-float))
     4160                                               ((base :imm)
     4161                                                (idx :u32const)))
     4162  (movsd (:@ (:apply ash idx 3) (:%l base)) (:%xmm dest)))
     4163
     4164(define-x8632-vinsn fixnum-ref-double-float  (((dest :double-float))
     4165                                               ((base :imm)
     4166                                                (idx :imm)))
     4167  (movsd (:@ (:%l base) (:%l idx) 2) (:%xmm dest)))
     4168
     4169(define-x8632-vinsn fixnum-set-c-double-float (()
     4170                                               ((base :imm)
     4171                                                (idx :u32const)
     4172                                                (val :double-float)))
     4173  (movsd (:%xmm val) (:@ (:apply ash idx 3) (:%l base))))
     4174
     4175(define-x8632-vinsn fixnum-set-double-float  (()
     4176                                               ((base :imm)
     4177                                                (idx :imm)
     4178                                                (val :double-float)))
     4179  (movsd (:%xmm val) (:@ (:%l base) (:%l idx) 2)))
     4180
    41594181(queue-fixup
    41604182 (fixup-x86-vinsn-templates
  • trunk/source/compiler/X86/X8664/x8664-vinsns.lisp

    r14777 r14943  
    45764576  (:long #x80000000))
    45774577
     4578(define-x8664-vinsn fixnum-ref-c-double-float (((dest :double-float))
     4579                                               ((base :imm)
     4580                                                (idx :u32const)))
     4581  (movsd (:@ (:apply ash idx 3) (:%q base)) (:%xmm dest)))
     4582
     4583(define-x8664-vinsn fixnum-ref-double-float  (((dest :double-float))
     4584                                               ((base :imm)
     4585                                                (idx :imm)))
     4586  (movsd (:@ (:%q base) (:%q idx)) (:%xmm dest)))
     4587
     4588(define-x8664-vinsn fixnum-set-c-double-float (()
     4589                                               ((base :imm)
     4590                                                (idx :u32const)
     4591                                                (val :double-float)))
     4592  (movsd (:%xmm val) (:@ (:apply ash idx 3) (:%q base))))
     4593
     4594(define-x8664-vinsn fixnum-set-double-float  (()
     4595                                               ((base :imm)
     4596                                                (idx :imm)
     4597                                                (val :double-float)))
     4598  (movsd (:%xmm val) (:@ (:%q base) (:%q idx))))
     4599
    45784600(queue-fixup
    45794601 (fixup-x86-vinsn-templates
  • trunk/source/compiler/X86/x862.lisp

    r14822 r14943  
    1032210322                nil))
    1032310323
     10324(defx862 x862-fixnum-ref-double-float %fixnum-ref-double-float (seg vreg xfer base index)
     10325  (if (null vreg)
     10326    (progn
     10327      (x862-form base seg nil nil)
     10328      (x862-form index seg nil xfer))
     10329    (let* ((fix (acode-fixnum-form-p index)))
     10330      (unless (typep fix '(unsigned-byte 28))
     10331        (setq fix nil))
     10332      (if (and (= (hard-regspec-class vreg) hard-reg-class-fpr)
     10333               (= (get-regspec-mode vreg) hard-reg-class-fpr-mode-double) )
     10334        (cond (fix
     10335               (! fixnum-ref-c-double-float vreg (x862-one-untargeted-reg-form seg base *x862-arg-z*) fix))
     10336              (t
     10337               (multiple-value-bind (rbase rindex) (x862-two-untargeted-reg-forms seg base *x862-arg-y* index *x862-arg-z*)
     10338                 (! fixnum-ref-double-float vreg rbase rindex))))
     10339        (with-fp-target () (target :double-float)
     10340        (cond (fix
     10341               (! fixnum-ref-c-double-float target (x862-one-untargeted-reg-form seg base *x862-arg-z*) fix))
     10342              (t
     10343               (multiple-value-bind (rbase rindex) (x862-two-untargeted-reg-forms seg base *x862-arg-y* index *x862-arg-z*)
     10344                 (! fixnum-ref-double-float target rbase rindex))))
     10345        (<- target)))
     10346      (^))))
     10347
     10348(defx862 x862-fixnum-set-double-float %fixnum-set-double-float (seg vreg xfer base index val)
     10349  (let* ((fix (acode-fixnum-form-p index)))
     10350    (unless (typep fix '(unsigned-byte 28))
     10351      (setq fix nil))
     10352    (cond ((or (null vreg)
     10353               (and (= (hard-regspec-class vreg) hard-reg-class-fpr)
     10354                    (= (get-regspec-mode vreg) hard-reg-class-fpr-mode-double)))
     10355           (let* ((fhint (or vreg ($ *x862-fp1* :class :fpr :mode :double-float))))
     10356             (if fix
     10357               (multiple-value-bind (rbase rval)
     10358                   (x862-two-untargeted-reg-forms seg base ($ *x862-arg-z*) val fhint)
     10359                 (! fixnum-set-c-double-float rbase fix rval)
     10360                 (<- rval))
     10361               (multiple-value-bind (rbase rindex rval)
     10362                   (x862-three-untargeted-reg-forms seg base (target-word-size-case
     10363                                                              (32 ($ x8632::temp0))
     10364                                                              (64 ($ x8664::arg_x))) index ($ *x862-arg-z*) val fhint)
     10365                 (! fixnum-set-double-float rbase rindex rval)
     10366                 (<- rval)))))
     10367          (t
     10368           (if fix
     10369             (multiple-value-bind (rbase rboxed)
     10370                 (x862-two-untargeted-reg-forms seg base ($ *x862-arg-y*) val ($ *x862-arg-z*))
     10371               (with-fp-target () (rval :double-float)
     10372                 (x862-copy-register seg rval rboxed)
     10373                 (! fixnum-set-c-double-float rbase fix rval))
     10374               (<- rboxed))
     10375             (multiple-value-bind (rbase rindex rboxed)
     10376                 (x862-three-untargeted-reg-forms seg base (target-word-size-case
     10377                                                              (32 ($ x8632::temp0))
     10378                                                              (64 ($ x8664::arg_x))) index ($ *x862-arg-y*) val ($ *x862-arg-z*))
     10379               (with-fp-target () (rval :double-float)
     10380                 (x862-copy-register seg rval rboxed)
     10381                 (! fixnum-set-double-float rbase rindex rval))
     10382               (<- rboxed)))))
     10383    (^)))
     10384
    1032410385
    1032510386
Note: See TracChangeset for help on using the changeset viewer.