[Openmcl-cvs-notifications] r14942 - in /trunk/source/compiler/PPC: PPC32/ppc32-vinsns.lisp PPC64/ppc64-vinsns.lisp ppc2.lisp
gb at clozure.com
gb at clozure.com
Wed Aug 17 00:33:30 CDT 2011
Author: gb
Date: Wed Aug 17 00:33:30 2011
New Revision: 14942
Log:
%FIXNUM-{REF|SET}-DOUBLE-FLOAT support in PPC backends.
Modified:
trunk/source/compiler/PPC/PPC32/ppc32-vinsns.lisp
trunk/source/compiler/PPC/PPC64/ppc64-vinsns.lisp
trunk/source/compiler/PPC/ppc2.lisp
Modified: trunk/source/compiler/PPC/PPC32/ppc32-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/PPC/PPC32/ppc32-vinsns.lisp (original)
+++ trunk/source/compiler/PPC/PPC32/ppc32-vinsns.lisp Wed Aug 17 00:33:30 2=
011
@@ -4041,6 +4041,33 @@
((src :single-float)))
(fneg dest src))
=
+(define-ppc32-vinsn fixnum-ref-c-double-float (((dest :double-float))
+ ((base :imm)
+ (idx :u16const)))
+ (lfd dest (:apply ash idx 3) base))
+
+(define-ppc32-vinsn fixnum-ref-double-float (((dest :double-float))
+ ((base :imm)
+ (idx :imm))
+ ((temp :imm)))
+ (add temp idx idx)
+ (lfdx dest base temp))
+
+
+(define-ppc32-vinsn fixnum-set-c-double-float (()
+ ((base :imm)
+ (idx :u16const)
+ (val :double-float)))
+ (stfd val (:apply ash idx 3) base))
+
+(define-ppc32-vinsn fixnum-set-c-double-float (()
+ ((base :imm)
+ (idx :imm)
+ (val :double-float))
+ ((temp :imm)))
+ (add temp idx idx)
+ (stfdx val base temp))
+
;;; In case ppc32::*ppc-opcodes* was changed since this file was compiled.
(queue-fixup
(fixup-vinsn-templates *ppc32-vinsn-templates* ppc::*ppc-opcode-numbers*))
Modified: trunk/source/compiler/PPC/PPC64/ppc64-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/PPC/PPC64/ppc64-vinsns.lisp (original)
+++ trunk/source/compiler/PPC/PPC64/ppc64-vinsns.lisp Wed Aug 17 00:33:30 2=
011
@@ -4032,7 +4032,29 @@
=
(define-ppc64-vinsn single-float-negate (((dest :single-float))
((src :single-float)))
- (fneg dest src))
+ (fneg dest src))
+(define-ppc64-vinsn fixnum-ref-c-double-float (((dest :double-float))
+ ((base :imm)
+ (idx :u16const)))
+ (lfd dest (:apply ash idx 3) base))
+
+(define-ppc64-vinsn fixnum-ref-double-float (((dest :double-float))
+ ((base :imm)
+ (idx :imm)))
+ (lfdx dest base idx))
+
+
+(define-ppc64-vinsn fixnum-set-c-double-float (()
+ ((base :imm)
+ (idx :u16const)
+ (val :double-float)))
+ (stfd val (:apply ash idx 3) base))
+
+(define-ppc64-vinsn fixnum-set-c-double-float (()
+ ((base :imm)
+ (idx :imm)
+ (val :double-float)))
+ (stfdx val base idx))
=
;;; In case ppc64::*ppc-opcodes* was changed since this file was compiled.
(queue-fixup
Modified: trunk/source/compiler/PPC/ppc2.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/PPC/ppc2.lisp (original)
+++ trunk/source/compiler/PPC/ppc2.lisp Wed Aug 17 00:33:30 2011
@@ -9242,3 +9242,59 @@
(list nil (list clear-p size))
nil))
=
+(defppc2 ppc2-fixnum-ref-double-float %fixnum-ref-double-float (seg vreg x=
fer base index)
+ (if (null vreg)
+ (progn
+ (ppc2-form base seg nil nil)
+ (ppc2-form index seg nil xfer))
+ (let* ((fix (acode-fixnum-form-p index)))
+ (unless (typep fix '(unsigned-byte 12))
+ (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 (ppc2-one-untargeted-reg-=
form seg base ppc::arg_z) fix))
+ (t
+ (multiple-value-bind (rbase rindex) (ppc2-two-untargeted-re=
g-forms seg base ppc::arg_y index ppc::arg_z)
+ (! fixnum-ref-double-float vreg rbase rindex))))
+ (with-fp-target () (target :double-float)
+ (cond (fix
+ (! fixnum-ref-c-double-float target (ppc2-one-untargeted-=
reg-form seg base ppc::arg_z) fix))
+ (t
+ (multiple-value-bind (rbase rindex) (ppc2-two-untargeted-=
reg-forms seg base ppc::arg_y index ppc::arg_z)
+ (! fixnum-ref-double-float target rbase rindex))))
+ (<- target)))
+ (^))))
+
+(defppc2 ppc2-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 12))
+ (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 ($ ppc::fp1 :class :fpr :mode :double-fl=
oat))))
+ (if fix
+ (multiple-value-bind (rbase rval)
+ (ppc2-two-untargeted-reg-forms seg base ($ ppc::arg_z) =
val fhint)
+ (! fixnum-set-c-double-float rbase fix rval)
+ (<- rval))
+ (multiple-value-bind (rbase rindex rval)
+ (ppc2-three-untargeted-reg-forms seg base ($ ppc::arg_y=
) index ($ ppc::arg_z) val fhint)
+ (! fixnum-set-double-float rbase rindex rval)
+ (<- rval)))))
+ (t
+ (if fix
+ (multiple-value-bind (rbase rboxed)
+ (ppc2-two-untargeted-reg-forms seg base ($ ppc::arg_y) va=
l ($ ppc::arg_z))
+ (with-fp-target () (rval :double-float)
+ (ppc2-copy-register seg rval rboxed)
+ (! fixnum-set-c-double-float rbase fix rval))
+ (<- rboxed))
+ (multiple-value-bind (rbase rindex rboxed)
+ (ppc2-three-untargeted-reg-forms seg base ($ ppc::arg_x) =
index ($ ppc::arg_y) val ($ ppc::arg_z))
+ (with-fp-target () (rval :double-float)
+ (ppc2-copy-register seg rval rboxed)
+ (! fixnum-set-double-float rbase rindex rval))
+ (<- rboxed)))))
+ (^)))
More information about the Openmcl-cvs-notifications
mailing list