[Openmcl-cvs-notifications] r14943 - in /trunk/source/compiler/X86: X8632/x8632-vinsns.lisp X8664/x8664-vinsns.lisp x862.lisp
gb at clozure.com
gb at clozure.com
Wed Aug 17 00:35:00 CDT 2011
Author: gb
Date: Wed Aug 17 00:35:00 2011
New Revision: 14943
Log:
%FIXNUM-{REF|SET}-DOUBLE-FLOAT support in x86 backends.
Modified:
trunk/source/compiler/X86/X8632/x8632-vinsns.lisp
trunk/source/compiler/X86/X8664/x8664-vinsns.lisp
trunk/source/compiler/X86/x862.lisp
Modified: trunk/source/compiler/X86/X8632/x8632-vinsns.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/X86/X8632/x8632-vinsns.lisp (original)
+++ trunk/source/compiler/X86/X8632/x8632-vinsns.lisp Wed Aug 17 00:35:00 2=
011
@@ -4156,6 +4156,28 @@
:const
(:long #x80000000))
=
+(define-x8632-vinsn fixnum-ref-c-double-float (((dest :double-float))
+ ((base :imm)
+ (idx :u32const)))
+ (movsd (:@ (:apply ash idx 3) (:%l base)) (:%xmm dest)))
+
+(define-x8632-vinsn fixnum-ref-double-float (((dest :double-float))
+ ((base :imm)
+ (idx :imm)))
+ (movsd (:@ (:%l base) (:%l idx) 2) (:%xmm dest)))
+
+(define-x8632-vinsn fixnum-set-c-double-float (()
+ ((base :imm)
+ (idx :u32const)
+ (val :double-float)))
+ (movsd (:%xmm val) (:@ (:apply ash idx 3) (:%l base))))
+
+(define-x8632-vinsn fixnum-set-double-float (()
+ ((base :imm)
+ (idx :imm)
+ (val :double-float)))
+ (movsd (:%xmm val) (:@ (:%l base) (:%l idx) 2)))
+
(queue-fixup
(fixup-x86-vinsn-templates
*x8632-vinsn-templates*
Modified: trunk/source/compiler/X86/X8664/x8664-vinsns.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/X86/X8664/x8664-vinsns.lisp (original)
+++ trunk/source/compiler/X86/X8664/x8664-vinsns.lisp Wed Aug 17 00:35:00 2=
011
@@ -4575,6 +4575,28 @@
:const
(:long #x80000000))
=
+(define-x8664-vinsn fixnum-ref-c-double-float (((dest :double-float))
+ ((base :imm)
+ (idx :u32const)))
+ (movsd (:@ (:apply ash idx 3) (:%q base)) (:%xmm dest)))
+
+(define-x8664-vinsn fixnum-ref-double-float (((dest :double-float))
+ ((base :imm)
+ (idx :imm)))
+ (movsd (:@ (:%q base) (:%q idx)) (:%xmm dest)))
+
+(define-x8664-vinsn fixnum-set-c-double-float (()
+ ((base :imm)
+ (idx :u32const)
+ (val :double-float)))
+ (movsd (:%xmm val) (:@ (:apply ash idx 3) (:%q base))))
+
+(define-x8664-vinsn fixnum-set-double-float (()
+ ((base :imm)
+ (idx :imm)
+ (val :double-float)))
+ (movsd (:%xmm val) (:@ (:%q base) (:%q idx))))
+
(queue-fixup
(fixup-x86-vinsn-templates
*x8664-vinsn-templates*
Modified: trunk/source/compiler/X86/x862.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/X86/x862.lisp (original)
+++ trunk/source/compiler/X86/x862.lisp Wed Aug 17 00:35:00 2011
@@ -10321,6 +10321,67 @@
(list nil (list clear-p size))
nil))
=
+(defx862 x862-fixnum-ref-double-float %fixnum-ref-double-float (seg vreg x=
fer base index)
+ (if (null vreg)
+ (progn
+ (x862-form base seg nil nil)
+ (x862-form index seg nil xfer))
+ (let* ((fix (acode-fixnum-form-p index)))
+ (unless (typep fix '(unsigned-byte 28))
+ (setq fix nil))
+ (if (and (=3D (hard-regspec-class vreg) hard-reg-class-fpr)
+ (=3D (get-regspec-mode vreg) hard-reg-class-fpr-mode-double=
) )
+ (cond (fix
+ (! fixnum-ref-c-double-float vreg (x862-one-untargeted-reg-=
form seg base *x862-arg-z*) fix))
+ (t
+ (multiple-value-bind (rbase rindex) (x862-two-untargeted-re=
g-forms seg base *x862-arg-y* index *x862-arg-z*)
+ (! fixnum-ref-double-float vreg rbase rindex))))
+ (with-fp-target () (target :double-float)
+ (cond (fix
+ (! fixnum-ref-c-double-float target (x862-one-untargeted-re=
g-form seg base *x862-arg-z*) fix))
+ (t
+ (multiple-value-bind (rbase rindex) (x862-two-untargeted-re=
g-forms seg base *x862-arg-y* index *x862-arg-z*)
+ (! fixnum-ref-double-float target rbase rindex))))
+ (<- target)))
+ (^))))
+
+(defx862 x862-fixnum-set-double-float %fixnum-set-double-float (seg vreg x=
fer base index val)
+ (let* ((fix (acode-fixnum-form-p index)))
+ (unless (typep fix '(unsigned-byte 28))
+ (setq fix nil))
+ (cond ((or (null vreg)
+ (and (=3D (hard-regspec-class vreg) hard-reg-class-fpr)
+ (=3D (get-regspec-mode vreg) hard-reg-class-fpr-mode-d=
ouble)))
+ (let* ((fhint (or vreg ($ *x862-fp1* :class :fpr :mode :double-=
float))))
+ (if fix
+ (multiple-value-bind (rbase rval)
+ (x862-two-untargeted-reg-forms seg base ($ *x862-arg-z*=
) val fhint)
+ (! fixnum-set-c-double-float rbase fix rval)
+ (<- rval))
+ (multiple-value-bind (rbase rindex rval)
+ (x862-three-untargeted-reg-forms seg base (target-word-=
size-case
+ (32 ($ x8632=
::temp0))
+ (64 ($ x8664=
::arg_x))) index ($ *x862-arg-z*) val fhint)
+ (! fixnum-set-double-float rbase rindex rval)
+ (<- rval)))))
+ (t
+ (if fix
+ (multiple-value-bind (rbase rboxed)
+ (x862-two-untargeted-reg-forms seg base ($ *x862-arg-y*) =
val ($ *x862-arg-z*))
+ (with-fp-target () (rval :double-float)
+ (x862-copy-register seg rval rboxed)
+ (! fixnum-set-c-double-float rbase fix rval))
+ (<- rboxed))
+ (multiple-value-bind (rbase rindex rboxed)
+ (x862-three-untargeted-reg-forms seg base (target-word-si=
ze-case
+ (32 ($ x8632=
::temp0))
+ (64 ($ x8664=
::arg_x))) index ($ *x862-arg-y*) val ($ *x862-arg-z*))
+ (with-fp-target () (rval :double-float)
+ (x862-copy-register seg rval rboxed)
+ (! fixnum-set-double-float rbase rindex rval))
+ (<- rboxed)))))
+ (^)))
+
=
=
=
More information about the Openmcl-cvs-notifications
mailing list