[Openmcl-cvs-notifications] r14775 - in /trunk/source/compiler: PPC/PPC32/ppc32-vinsns.lisp PPC/PPC64/ppc64-vinsns.lisp PPC/ppc2.lisp nx2.lisp
gb at clozure.com
gb at clozure.com
Mon May 2 17:50:39 CDT 2011
Author: gb
Date: Mon May 2 17:50:39 2011
New Revision: 14775
Log:
Unary fp negation in the PPC backend, and in acode.
Modified:
trunk/source/compiler/PPC/PPC32/ppc32-vinsns.lisp
trunk/source/compiler/PPC/PPC64/ppc64-vinsns.lisp
trunk/source/compiler/PPC/ppc2.lisp
trunk/source/compiler/nx2.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 Mon May 2 17:50:39 2=
011
@@ -4033,6 +4033,14 @@
((src :imm)))
(subfic dest src (ash -1 ppc32::fixnumshift)))
=
+(define-ppc32-vinsn double-float-negate (((dest :double-float))
+ ((src :double-float)))
+ (fneg dest src))
+
+(define-ppc32-vinsn single-float-negate (((dest :single-float))
+ ((src :single-float)))
+ (fneg dest src))
+
;;; 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 Mon May 2 17:50:39 2=
011
@@ -4025,7 +4025,14 @@
(define-ppc64-vinsn %ilognot (((dest :imm))
((src :imm)))
(subfic dest src (ash -1 ppc64::fixnumshift)))
- =
+
+(define-ppc64-vinsn double-float-negate (((dest :double-float))
+ ((src :double-float)))
+ (fneg dest src))
+
+(define-ppc64-vinsn single-float-negate (((dest :single-float))
+ ((src :single-float)))
+ (fneg dest src))
=
;;; 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 Mon May 2 17:50:39 2011
@@ -6327,7 +6327,35 @@
(^))
=
(defppc2 ppc2-minus1 minus1 (seg vreg xfer form)
- (ppc2-unary-builtin seg vreg xfer '%negate form))
+ (or (acode-optimize-minus1 seg vreg xfer form *ppc2-trust-declarations*)
+ (ppc2-unary-builtin seg vreg xfer '%negate form)))
+
+(defppc2 ppc2-%double-float-negate %double-float-negate (seg vreg xfer for=
m)
+ (with-fp-target () (r1 :double-float)
+ (setq r1 (ppc2-one-untargeted-reg-form seg form r1))
+ (if (and vreg
+ (=3D (hard-regspec-class vreg) hard-reg-class-fpr)
+ (=3D (get-regspec-mode vreg) hard-reg-class-fpr-mode-double))
+ (! double-float-negate vreg r1)
+ (with-fp-target (r1) (r2 :double-float)
+ (! double-float-negate r2 r1)
+ (ensuring-node-target (target vreg)
+ (ppc2-copy-register seg target r2))))
+ (^)))
+ =
+
+(defppc2 ppc2-%single-float-negate %single-float-negate (seg vreg xfer for=
m)
+ (with-fp-target () (r1 :single-float)
+ (setq r1 (ppc2-one-untargeted-reg-form seg form r1))
+ (if (and vreg
+ (=3D (hard-regspec-class vreg) hard-reg-class-fpr)
+ (=3D (get-regspec-mode vreg) hard-reg-class-fpr-mode-single))
+ (! double-float-negate vreg r1)
+ (with-fp-target (r1) (r2 :single-float)
+ (! double-float-negate r2 r1)
+ (ensuring-node-target (target vreg)
+ (ppc2-copy-register seg target r2))))
+ (^)))
=
(defun ppc2-inline-add2 (seg vreg xfer form1 form2)
(with-ppc-local-vinsn-macros (seg vreg xfer)
Modified: trunk/source/compiler/nx2.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/nx2.lisp (original)
+++ trunk/source/compiler/nx2.lisp Mon May 2 17:50:39 2011
@@ -735,4 +735,17 @@
(acode-form-typep num2 'single-float trust-decls))
(backend-use-operator (%nx1-operator short-float-compare) seg vre=
g xfer cc num1 num2)
t)))
+
+(defun acode-optimize-minus1 (seg vreg xfer form trust-decls &optional (re=
sult-type 'number))
+ (declare (ignorable result-type))
+ (cond ((acode-form-typep form 'double-float trust-decls)
+ (backend-use-operator (%nx1-operator %double-float-negate) seg vr=
eg xfer form)
+ t)
+ ((acode-form-typep form 'single-float trust-decls)
+ (backend-use-operator (%nx1-operator %single-float-negate) seg vr=
eg xfer form)
+ t)
+ ((acode-form-typep form *nx-target-fixnum-type* trust-decls)
+ (backend-use-operator (%nx1-operator %ineg) seg vreg xfer form)
+ t)))
+
=
More information about the Openmcl-cvs-notifications
mailing list