[Openmcl-cvs-notifications] r16259 - in /trunk/source/compiler: X86/X8632/x8632-vinsns.lisp X86/X8664/x8664-vinsns.lisp X86/x86-asm.lisp X86/x862.lisp acode-rewrite.lisp nxenv.lisp

gb at clozure.com gb at clozure.com
Sat Sep 27 00:39:19 UTC 2014


Author: gb
Date: Sat Sep 27 00:39:19 2014
New Revision: 16259

Log:
Inline simple arithmetic (+,-,*) on complex floats.
(Only enabled on X86 so far.)

Modified:
    trunk/source/compiler/X86/X8632/x8632-vinsns.lisp
    trunk/source/compiler/X86/X8664/x8664-vinsns.lisp
    trunk/source/compiler/X86/x86-asm.lisp
    trunk/source/compiler/X86/x862.lisp
    trunk/source/compiler/acode-rewrite.lisp
    trunk/source/compiler/nxenv.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	Sat Sep 27 00:39:19 2=
014
@@ -1478,6 +1478,59 @@
    (movsd (:%xmm x) (:%xmm result)))
   (divsd (:%xmm y) (:%xmm result)))
 =

+
+(define-x8632-vinsn complex-double-float+-2 (((result :complex-double-floa=
t))
+                                             ((x :complex-double-float)
+                                              (y :complex-double-float)))
+  ((:pred =3D
+          (:apply %hard-regspec-value result)
+          (:apply %hard-regspec-value x))
+   (addpd (:%xmm y) (:%xmm result)))
+  ((:and (:not (:pred =3D
+                      (:apply %hard-regspec-value result)
+                      (:apply %hard-regspec-value x)))
+         (:pred =3D
+                (:apply %hard-regspec-value result)
+                (:apply %hard-regspec-value y)))
+   (addpd (:%xmm x) (:%xmm result)))
+  ((:and (:not (:pred =3D
+                      (:apply %hard-regspec-value result)
+                      (:apply %hard-regspec-value x)))
+         (:not (:pred =3D
+                      (:apply %hard-regspec-value result)
+                      (:apply %hard-regspec-value y))))
+   (movapd (:%xmm x) (:%xmm result))
+   (addpd (:%xmm y) (:%xmm result))))
+
+;;; Caller guarantees (not (eq y result))
+(define-x8632-vinsn complex-double-float--2 (((result :complex-double-floa=
t))
+				     ((x :complex-double-float)
+				      (y :complex-double-float)))
+  ((:not (:pred =3D (:apply %hard-regspec-value result)
+                (:apply %hard-regspec-value x)))
+   (movapd (:%xmm x) (:%xmm result)))
+  (subpd (:%xmm y) (:%xmm result)))
+
+(define-x8632-vinsn complex-double-float*-2 (((result :complex-double-floa=
t))
+                                             ((x :complex-double-float)
+                                              (y :complex-double-float))
+                                             ((b :double-float)
+                                              (ix :double-float)
+                                              (iy :double-float)))
+  (movapd (:%xmm x) (:%xmm ix))
+  (shufpd (:$ub 1) (:%xmm x8632::fpzero) (:%xmm ix))
+  (movapd (:%xmm y) (:%xmm iy))
+  (shufpd (:$ub 1) (:%xmm x8632::fpzero) (:%xmm iy))
+  (movsd (:%xmm y) (:%xmm result))
+  (mulsd (:%xmm x) (:%xmm result))
+  (movsd (:%xmm iy) (:%xmm b))
+  (mulsd (:%xmm ix) (:%xmm b))
+  (subsd (:%xmm b) (:%xmm result))
+  (mulsd (:%xmm x) (:%xmm iy))
+  (mulsd (:%xmm y) (:%xmm ix))
+  (addsd (:%xmm ix) (:%xmm iy))
+  (shufpd (:$ub 0) (:%xmm iy) (:%xmm result)))
+
 (define-x8632-vinsn single-float+-2 (((result :single-float))
 				     ((x :single-float)
 				      (y :single-float)))
@@ -1541,6 +1594,58 @@
                 (:apply %hard-regspec-value x)))
    (movss (:%xmm x) (:%xmm result)))
   (divss (:%xmm y) (:%xmm result)))
+
+(define-x8632-vinsn complex-single-float+-2 (((result :complex-single-floa=
t))
+                                             ((x :complex-single-float)
+                                              (y :complex-single-float)))
+  ((:pred =3D
+          (:apply %hard-regspec-value result)
+          (:apply %hard-regspec-value x))
+   (addps (:%xmm y) (:%xmm result)))
+  ((:and (:not (:pred =3D
+                      (:apply %hard-regspec-value result)
+                      (:apply %hard-regspec-value x)))
+         (:pred =3D
+                (:apply %hard-regspec-value result)
+                (:apply %hard-regspec-value y)))
+   (addps (:%xmm x) (:%xmm result)))
+  ((:and (:not (:pred =3D
+                      (:apply %hard-regspec-value result)
+                      (:apply %hard-regspec-value x)))
+         (:not (:pred =3D
+                      (:apply %hard-regspec-value result)
+                      (:apply %hard-regspec-value y))))
+   (movq (:%xmm x) (:%xmm result))
+   (addps (:%xmm y) (:%xmm result))))
+
+;;; Caller guarantees (not (eq y result))
+(define-x8632-vinsn complex-single-float--2 (((result :complex-single-floa=
t))
+				     ((x :complex-single-float)
+				      (y :complex-single-float)))
+  ((:not (:pred =3D (:apply %hard-regspec-value result)
+                (:apply %hard-regspec-value x)))
+   (movq (:%xmm x) (:%xmm result)))
+  (subps (:%xmm y) (:%xmm result)))
+
+(define-x8632-vinsn complex-single-float*-2 (((result :complex-single-floa=
t))
+                                             ((x :complex-single-float)
+                                              (y :complex-single-float))
+                                             ((b :single-float)
+                                              (ix :single-float)
+                                              (iy :single-float)))
+  (movq (:%xmm x) (:%xmm ix))
+  (psrlq (:$ub 32) (:%xmm ix))
+  (movq (:%xmm y) (:%xmm iy))
+  (psrlq (:$ub 32)  (:%xmm iy))
+  (movss(:%xmm y) (:%xmm result))
+  (mulss (:%xmm x) (:%xmm result))
+  (movss (:%xmm iy) (:%xmm b))
+  (mulss (:%xmm ix) (:%xmm b))
+  (subss (:%xmm b) (:%xmm result))
+  (mulss (:%xmm x) (:%xmm iy))
+  (mulss (:%xmm y) (:%xmm ix))
+  (addss (:%xmm ix) (:%xmm iy))
+  (unpcklps (:%xmm iy) (:%xmm result)))
 =

 (define-x8632-vinsn get-single (((result :single-float))
                                 ((source :lisp)))

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	Sat Sep 27 00:39:19 2=
014
@@ -1648,6 +1648,64 @@
    (movsd (:%xmm x) (:%xmm result)))
   (divsd (:%xmm y) (:%xmm result)))
 =

+
+(define-x8664-vinsn complex-double-float+-2 (((result :complex-double-floa=
t))
+                                             ((x :complex-double-float)
+                                              (y :complex-double-float)))
+  ((:pred =3D
+          (:apply %hard-regspec-value result)
+          (:apply %hard-regspec-value x))
+   (addpd (:%xmm y) (:%xmm result)))
+  ((:and (:not (:pred =3D
+                      (:apply %hard-regspec-value result)
+                      (:apply %hard-regspec-value x)))
+         (:pred =3D
+                (:apply %hard-regspec-value result)
+                (:apply %hard-regspec-value y)))
+   (addpd (:%xmm x) (:%xmm result)))
+  ((:and (:not (:pred =3D
+                      (:apply %hard-regspec-value result)
+                      (:apply %hard-regspec-value x)))
+         (:not (:pred =3D
+                      (:apply %hard-regspec-value result)
+                      (:apply %hard-regspec-value y))))
+   (movapd (:%xmm x) (:%xmm result))
+   (addpd (:%xmm y) (:%xmm result))))
+
+;;; Caller guarantees (not (eq y result))
+(define-x8664-vinsn complex-double-float--2 (((result :complex-double-floa=
t))
+				     ((x :complex-double-float)
+				      (y :complex-double-float)))
+  ((:not (:pred =3D (:apply %hard-regspec-value result)
+                (:apply %hard-regspec-value x)))
+   (movapd (:%xmm x) (:%xmm result)))
+  (subpd (:%xmm y) (:%xmm result)))
+
+(define-x8664-vinsn complex-double-float*-2 (((result :complex-double-floa=
t))
+                                             ((x :complex-double-float)
+                                              (y :complex-double-float))
+                                             ((b :double-float)
+                                              (ix :double-float)
+                                              (iy :double-float)))
+  (movapd (:%xmm x) (:%xmm ix))
+  (shufpd (:$ub 1) (:%xmm x8664::fpzero) (:%xmm ix))
+  (movapd (:%xmm y) (:%xmm iy))
+  (shufpd (:$ub 1) (:%xmm x8664::fpzero) (:%xmm iy))
+  (movsd (:%xmm y) (:%xmm result))
+  (mulsd (:%xmm x) (:%xmm result))
+  (movsd (:%xmm iy) (:%xmm b))
+  (mulsd (:%xmm ix) (:%xmm b))
+  (subsd (:%xmm b) (:%xmm result))
+  (mulsd (:%xmm x) (:%xmm iy))
+  (mulsd (:%xmm y) (:%xmm ix))
+  (addsd (:%xmm ix) (:%xmm iy))
+  (shufpd (:$ub 0) (:%xmm iy) (:%xmm result)))
+         =

+  =

+                                             =

+  =

+
+
 (define-x8664-vinsn single-float+-2 (((result :single-float))
 				     ((x :single-float)
 				      (y :single-float)))
@@ -1711,6 +1769,58 @@
                 (:apply %hard-regspec-value x)))
    (movss (:%xmm x) (:%xmm result)))
   (divss (:%xmm y) (:%xmm result)))
+
+(define-x8664-vinsn complex-single-float+-2 (((result :complex-single-floa=
t))
+                                             ((x :complex-single-float)
+                                              (y :complex-single-float)))
+  ((:pred =3D
+          (:apply %hard-regspec-value result)
+          (:apply %hard-regspec-value x))
+   (addps (:%xmm y) (:%xmm result)))
+  ((:and (:not (:pred =3D
+                      (:apply %hard-regspec-value result)
+                      (:apply %hard-regspec-value x)))
+         (:pred =3D
+                (:apply %hard-regspec-value result)
+                (:apply %hard-regspec-value y)))
+   (addps (:%xmm x) (:%xmm result)))
+  ((:and (:not (:pred =3D
+                      (:apply %hard-regspec-value result)
+                      (:apply %hard-regspec-value x)))
+         (:not (:pred =3D
+                      (:apply %hard-regspec-value result)
+                      (:apply %hard-regspec-value y))))
+   (movq (:%xmm x) (:%xmm result))
+   (addps (:%xmm y) (:%xmm result))))
+
+;;; Caller guarantees (not (eq y result))
+(define-x8664-vinsn complex-single-float--2 (((result :complex-single-floa=
t))
+				     ((x :complex-single-float)
+				      (y :complex-single-float)))
+  ((:not (:pred =3D (:apply %hard-regspec-value result)
+                (:apply %hard-regspec-value x)))
+   (movq (:%xmm x) (:%xmm result)))
+  (subps (:%xmm y) (:%xmm result)))
+
+(define-x8664-vinsn complex-single-float*-2 (((result :complex-single-floa=
t))
+                                             ((x :complex-single-float)
+                                              (y :complex-single-float))
+                                             ((b :single-float)
+                                              (ix :single-float)
+                                              (iy :single-float)))
+  (movq (:%xmm x) (:%xmm ix))
+  (psrlq (:$ub 32) (:%xmm ix))
+  (movq (:%xmm y) (:%xmm iy))
+  (psrlq (:$ub 32)  (:%xmm iy))
+  (movss(:%xmm y) (:%xmm result))
+  (mulss (:%xmm x) (:%xmm result))
+  (movss (:%xmm iy) (:%xmm b))
+  (mulss (:%xmm ix) (:%xmm b))
+  (subss (:%xmm b) (:%xmm result))
+  (mulss (:%xmm x) (:%xmm iy))
+  (mulss (:%xmm y) (:%xmm ix))
+  (addss (:%xmm ix) (:%xmm iy))
+  (unpcklps (:%xmm iy) (:%xmm result)))
 =

 (define-x8664-vinsn get-single (((result :single-float))
                                 ((source :lisp)))

Modified: trunk/source/compiler/X86/x86-asm.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/x86-asm.lisp	(original)
+++ trunk/source/compiler/X86/x86-asm.lisp	Sat Sep 27 00:39:19 2014
@@ -3151,7 +3151,22 @@
    (def-x86-opcode movss ((:regxmm :insert-xmm-reg) (:anymem :insert-memor=
y))
      #x0f11 #o000 #x0 #xf3)
 =

+   ;; addpd
+   (def-x86-opcode addpd ((:regxmm :insert-xmm-rm) (:regxmm :insert-xmm-re=
g))
+     #x0f58 #o300 #x0 #x66)
+
+   ;; addps
+   (def-x86-opcode addps ((:regxmm :insert-xmm-rm) (:regxmm :insert-xmm-re=
g))
+     #x0f58 #o300 #x0)
    =

+   ;; subpd
+   (def-x86-opcode subpd ((:regxmm :insert-xmm-rm) (:regxmm :insert-xmm-re=
g))
+     #x0f5c #o300 #x0 #x66)
+
+   ;; subps
+   (def-x86-opcode subps ((:regxmm :insert-xmm-rm) (:regxmm :insert-xmm-re=
g))
+     #x0f5c #o300 #x0)
+
 ;;; cvtsd2si.  This does rounding (as opposed to truncation).
    (def-x86-opcode (cvtsd2siq :cpu64) ((:regxmm :insert-xmm-rm) (:reg64 :i=
nsert-modrm-reg))
      #x0f2d #o300 #x48 #xf2)

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	Sat Sep 27 00:39:19 2014
@@ -9007,6 +9007,97 @@
 (defx862-sf-op x862-%short-float*-2 %short-float*-2 single-float*-2)
 (defx862-sf-op x862-%short-float/-2 %short-float/-2 single-float/-2)
 =

+(defx862 x862-%complex-double-float+-2  %complex-double-float+-2 (seg vreg=
 xfer x y)
+  (let* ((*available-backend-fp-temps* *available-backend-fp-temps*)
+         (target (if (and vreg (eql (hard-regspec-class vreg) hard-reg-cla=
ss-fpr)
+                          (eql (get-regspec-mode vreg) hard-reg-class-fpr-=
mode-complex-double-float))
+                   vreg
+                   (available-fp-temp  *available-backend-fp-temps* :compl=
ex-double-float))))
+    (with-fp-target () (r1 :complex-double-float)
+      (with-fp-target (r1) (r2 :complex-double-float)
+        (multiple-value-bind (r1 r2) (x862-two-untargeted-reg-forms seg x =
r1 y r2)
+          (! complex-double-float+-2 target r1 r2)
+          (unless (eq target vreg)
+            (ensuring-node-target (node vreg)
+              (x862-copy-register seg node target))))))
+    (^)))
+
+(defx862 x862-%complex-double-float--2  %complex-double-float--2 (seg vreg=
 xfer x y)
+  (let* ((*available-backend-fp-temps* *available-backend-fp-temps*)
+         (target (if (and vreg (eql (hard-regspec-class vreg) hard-reg-cla=
ss-fpr)
+                          (eql (get-regspec-mode vreg) hard-reg-class-fpr-=
mode-complex-double-float))
+                   vreg
+                   (available-fp-temp  *available-backend-fp-temps* :compl=
ex-double-float))))
+    (with-fp-target () (r1 :complex-double-float)
+      (with-fp-target (r1 target) (r2 :complex-double-float)
+        (multiple-value-bind (r1 r2) (x862-two-untargeted-reg-forms seg x =
r1 y r2)
+          (! complex-double-float--2 target r1 r2)
+          (unless (eq target vreg)
+            (ensuring-node-target (node vreg)
+              (x862-copy-register seg node target))))))
+    (^)))
+
+(defx862 x862-%complex-double-float*-2  %complex-double-float*-2 (seg vreg=
 xfer x y)
+  (let* ((*available-backend-fp-temps* *available-backend-fp-temps*)
+         (target (if (and vreg (eql (hard-regspec-class vreg) hard-reg-cla=
ss-fpr)
+                          (eql (get-regspec-mode vreg) hard-reg-class-fpr-=
mode-complex-double-float))
+                   vreg
+                   (available-fp-temp  *available-backend-fp-temps* :compl=
ex-double-float))))
+    (with-fp-target (target) (r1 :complex-double-float)
+      (with-fp-target (r1 target) (r2 :complex-double-float)
+        (multiple-value-bind (r1 r2) (x862-two-untargeted-reg-forms seg x =
r1 y r2)
+          (! complex-double-float*-2 target r1 r2)
+          (unless (eq target vreg)
+            (ensuring-node-target (node vreg)
+              (x862-copy-register seg node target))))))
+    (^)))
+
+(defx862 x862-%complex-single-float+-2  %complex-single-float+-2 (seg vreg=
 xfer x y)
+  (let* ((*available-backend-fp-temps* *available-backend-fp-temps*)
+         (target (if (and vreg (eql (hard-regspec-class vreg) hard-reg-cla=
ss-fpr)
+                          (eql (get-regspec-mode vreg) hard-reg-class-fpr-=
mode-complex-single-float))
+                   vreg
+                   (available-fp-temp  *available-backend-fp-temps* :compl=
ex-single-float))))
+    (with-fp-target () (r1 :complex-single-float)
+      (with-fp-target (r1) (r2 :complex-single-float)
+        (multiple-value-bind (r1 r2) (x862-two-untargeted-reg-forms seg x =
r1 y r2)
+          (! complex-single-float+-2 target r1 r2)
+          (unless (eq target vreg)
+            (ensuring-node-target (node vreg)
+              (x862-copy-register seg node target))))))
+    (^)))
+
+(defx862 x862-%complex-single-float--2  %complex-single-float--2 (seg vreg=
 xfer x y)
+  (let* ((*available-backend-fp-temps* *available-backend-fp-temps*)
+         (target (if (and vreg (eql (hard-regspec-class vreg) hard-reg-cla=
ss-fpr)
+                          (eql (get-regspec-mode vreg) hard-reg-class-fpr-=
mode-complex-single-float))
+                   vreg
+                   (available-fp-temp  *available-backend-fp-temps* :compl=
ex-single-float))))
+    (with-fp-target () (r1 :complex-single-float)
+      (with-fp-target (r1) (r2 :complex-single-float)
+        (multiple-value-bind (r1 r2) (x862-two-untargeted-reg-forms seg x =
r1 y r2)
+          (! complex-single-float--2 target r1 r2)
+          (unless (eq target vreg)
+            (ensuring-node-target (node vreg)
+              (x862-copy-register seg node target))))))
+    (^)))
+
+(defx862 x862-%complex-single-float*-2  %complex-single-float*-2 (seg vreg=
 xfer x y)
+  (let* ((*available-backend-fp-temps* *available-backend-fp-temps*)
+         (target (if (and vreg (eql (hard-regspec-class vreg) hard-reg-cla=
ss-fpr)
+                          (eql (get-regspec-mode vreg) hard-reg-class-fpr-=
mode-complex-single-float))
+                   vreg
+                   (available-fp-temp  *available-backend-fp-temps* :compl=
ex-single-float))))
+    (with-fp-target (target) (r1 :complex-single-float)
+      (with-fp-target (r1 target) (r2 :complex-single-float)
+        (multiple-value-bind (r1 r2) (x862-two-untargeted-reg-forms seg x =
r1 y r2)
+          (! complex-single-float*-2 target r1 r2)
+          (unless (eq target vreg)
+            (ensuring-node-target (node vreg)
+              (x862-copy-register seg node target))))))
+    (^)))
+                   =

+
 (defun x862-get-float (seg vreg xfer ptr offset double-p fp-reg)
   (with-x86-local-vinsn-macros (seg vreg xfer)
     (cond ((null vreg)

Modified: trunk/source/compiler/acode-rewrite.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/acode-rewrite.lisp	(original)
+++ trunk/source/compiler/acode-rewrite.lisp	Sat Sep 27 00:39:19 2014
@@ -219,7 +219,16 @@
                                   (subtypep t2 'single-float))
                              (setq newtype 'single-float)
                              (%nx1-operator %short-float+-2))
-
+                            ((and (target-arch-case ((:x8664 :x8632) t))
+                                  (subtypep t1 '(complex double-float))
+                                  (subtypep t2 '(complex double-float)))
+                             (setq newtype '(complex double-float))
+                             (%nx1-operator %complex-double-float+-2))
+                            ((and (target-arch-case ((:x8664 :x8632) t))
+                                  (subtypep t1 '(complex single-float))
+                                  (subtypep t2 '(complex single-float)))
+                             (setq newtype '(complex single-float))
+                             (%nx1-operator %complex-single-float+-2))
                             ((and (subtypep t1 target-fixnum-type)
                                   (subtypep t2 target-fixnum-type))
                              (setq newtype (or (ctype-specifier (bounded-i=
nteger-type-for-addition t1 t2)) 'integer))
@@ -256,7 +265,16 @@
                                   (subtypep t2 'single-float))
                              (setq newtype 'single-float)
                              (%nx1-operator %short-float--2))
-
+                            ((and (target-arch-case ((:x8664 :x8632) t))
+                                  (subtypep t1 '(complex double-float))
+                                  (subtypep t2 '(complex double-float)))
+                             (setq newtype '(complex double-float))
+                             (%nx1-operator %complex-double-float--2))
+                            ((and (target-arch-case ((:x8664 :x8632) t))
+                                  (subtypep t1 '(complex single-float))
+                                  (subtypep t2 '(complex single-float)))
+                             (setq newtype '(complex single-float))
+                             (%nx1-operator %complex-single-float--2))
                             ((and (subtypep t1 target-fixnum-type)
                                   (subtypep t2 target-fixnum-type))
                              (if (or (subtypep (setq newtype
@@ -319,6 +337,16 @@
                                            (subtypep t2 'single-float))
                                       (setq newtype 'single-float)
                                       (%nx1-operator %short-float*-2))
+                                     ((and (target-arch-case ((:x8664 :x86=
32) t))
+                                           (subtypep t1 '(complex double-f=
loat))
+                                           (subtypep t2 '(complex double-f=
loat)))
+                                      (setq newtype '(complex double-float=
))
+                                      (%nx1-operator %complex-double-float=
*-2))
+                                     ((and (target-arch-case ((:x8664 :x86=
32) t))
+                                           (subtypep t1 '(complex single-f=
loat))
+                                           (subtypep t2 '(complex single-f=
loat)))
+                                      (setq newtype '(complex single-float=
))
+                                      (%nx1-operator %complex-single-float=
*-2))
                                      ((let* ((multype (bounded-integer-typ=
e-for-multiplication t1 t2))
                                              (target-fixnum-type *nx-targe=
t-fixnum-type*))
                                         (and multype (subtypep (setq newty=
pe

Modified: trunk/source/compiler/nxenv.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/nxenv.lisp	(original)
+++ trunk/source/compiler/nxenv.lisp	Sat Sep 27 00:39:19 2014
@@ -205,7 +205,7 @@
      (complex #.(logior operator-single-valued-mask operator-assignment-fr=
ee-mask operator-acode-subforms-mask operator-side-effect-free-mask) :infer)
      (%function  #.operator-single-valued-mask function)
      (%valid-code-char  #.(logior operator-single-valued-mask operator-aco=
de-subforms-mask operator-side-effect-free-mask) character)
-     ()
+     (%complex-double-float+-2  #.(logior operator-single-valued-mask oper=
ator-side-effect-free-mask operator-acode-subforms-mask) complex-double-flo=
at)
      (uvsize  #.(logior operator-single-valued-mask operator-acode-subform=
s-mask) index)
      (endp  #.(logior operator-single-valued-mask operator-acode-subforms-=
mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
      (sequence-type  #.(logior operator-single-valued-mask operator-acode-=
subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) b=
oolean)
@@ -217,7 +217,7 @@
      (%new-ptr  #.operator-acode-subforms-mask macptr)
      (%schar  #.(logior operator-single-valued-mask operator-acode-subform=
s-mask operator-side-effect-free-mask) character)
      (%set-schar  #.(logior operator-single-valued-mask operator-acode-sub=
forms-mask) character)	;??
-     ()
+     (%complex-double-float--2  #.(logior operator-single-valued-mask oper=
ator-side-effect-free-mask operator-acode-subforms-mask) complex-double-flo=
at)
      (lambda-bind  0 :infer)
      (general-aset3  #.(logior operator-acode-subforms-mask operator-singl=
e-valued-mask) :infer)
      (simple-typed-aref3  #.(logior operator-acode-subforms-mask operator-=
assignment-free-mask operator-single-valued-mask) :infer)
@@ -235,11 +235,11 @@
 					; for dynamic-extent, forward refs, etc.
      (labels  0 :infer)			; removes 75% of LABELS bogosity
      (lexical-function-call  0 :infer)	; most of other 25%
-     ()
+     (%complex-double-float*-2  #.(logior operator-single-valued-mask oper=
ator-side-effect-free-mask operator-acode-subforms-mask) complex-double-flo=
at)
      (self-call  0 :infer)
      (inherited-arg  #.operator-single-valued-mask :infer)     =

      (ff-call  0 :infer)
-     ()
+     (%complex-double-float/-2  #.(logior operator-single-valued-mask oper=
ator-side-effect-free-mask operator-acode-subforms-mask) complex-double-flo=
at)
      (%immediate-set-xxx  #.(logior operator-acode-subforms-mask) :infer)
      (symbol-name  #.(logior operator-assignment-free-mask operator-acode-=
subforms-mask operator-side-effect-free-mask) simple-base-string)
      (memq  #.(logior operator-assignment-free-mask operator-acode-subform=
s-mask operator-side-effect-free-mask) list)
@@ -247,7 +247,7 @@
      (simple-typed-aset2  #.(logior operator-acode-subforms-mask operator-=
single-valued-mask) :infer)
      (consp  #.(logior operator-cc-invertable-mask operator-assignment-fre=
e-mask operator-acode-subforms-mask operator-side-effect-free-mask operator=
-boolean-mask) boolean)
      (aset1  #.(logior operator-acode-subforms-mask) :infer)
-     ()
+     (%complex-single-float+-2  #.(logior operator-single-valued-mask oper=
ator-side-effect-free-mask operator-acode-subforms-mask) complex-single-flo=
at)
      (car  #.(logior operator-assignment-free-mask operator-single-valued-=
mask operator-acode-subforms-mask operator-side-effect-free-mask) :infer)
      (cdr  #.(logior operator-assignment-free-mask operator-single-valued-=
mask operator-acode-subforms-mask operator-side-effect-free-mask) :infer)
      (length  #.(logior operator-assignment-free-mask operator-single-valu=
ed-mask operator-acode-subforms-mask operator-side-effect-free-mask) fixnum)
@@ -286,8 +286,8 @@
      (fixnum-sub-overflow  #.(logior operator-assignment-free-mask operato=
r-single-valued-mask operator-acode-subforms-mask operator-side-effect-free=
-mask) integer)
      (int>0-p  #.(logior operator-assignment-free-mask operator-single-val=
ued-mask operator-acode-subforms-mask operator-side-effect-free-mask operat=
or-cc-invertable-mask) boolean)
      (gvector-typecode-p  #.(logior operator-assignment-free-mask operator=
-single-valued-mask  operator-side-effect-free-mask operator-acode-subforms=
-mask) fixnum)
-     ()
-     ()
+     (%complex-single-float--2  #.(logior operator-single-valued-mask oper=
ator-side-effect-free-mask operator-acode-subforms-mask) complex-single-flo=
at)
+     (%complex-single-float*-2  #.(logior operator-single-valued-mask oper=
ator-side-effect-free-mask operator-acode-subforms-mask) complex-single-flo=
at)
      (istruct-typep  #.(logior operator-single-valued-mask operator-assign=
ment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask =
operator-cc-invertable-mask) boolean)
      (%ilogxor2  #.(logior operator-assignment-free-mask operator-single-v=
alued-mask operator-acode-subforms-mask operator-side-effect-free-mask) fix=
num)
      (%err-disp  0 nil)
@@ -297,7 +297,7 @@
      (%i*  #.(logior operator-assignment-free-mask operator-single-valued-=
mask operator-acode-subforms-mask operator-side-effect-free-mask) fixnum)
      (logbitp  #.(logior operator-single-valued-mask operator-assignment-f=
ree-mask operator-acode-subforms-mask operator-side-effect-free-mask operat=
or-boolean-mask) boolean)
      (%sbchar  0 character)
-     ()
+     (%complex-single-float/-2  #.(logior operator-single-valued-mask oper=
ator-side-effect-free-mask operator-acode-subforms-mask) complex-single-flo=
at)
      (%set-sbchar  #.(logior operator-single-valued-mask operator-acode-su=
bforms-mask) character)
      (%scharcode  #.(logior operator-single-valued-mask operator-acode-sub=
forms-mask operator-side-effect-free-mask) (mod #.char-code-limit))
      (%set-scharcode  #.(logior operator-single-valued-mask operator-acode=
-subforms-mask) (mod #.char-code-limit))



More information about the Openmcl-cvs-notifications mailing list