diff --git a/code/exports.lisp b/code/exports.lisp index 9f1043a7a1a50db919f064e6acf86246f732d6c3..be5306bc1e66d854b85364e1f2d08fc91dc946fe 100644 --- a/code/exports.lisp +++ b/code/exports.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.271.4.1 2008/10/10 18:36:48 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.271.4.2 2008/10/16 22:00:46 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2222,7 +2222,11 @@ "SIMPLE-UNDEFINED-FUNCTION" "SIMPLE-PARSE-ERROR" "SIMPLE-STREAM-ERROR" "BYTE-FUNCTION-TYPE" "SLOT-CLASS-PRINT-FUNCTION" "REDEFINE-LAYOUT-WARNING" "SLOT-CLASS" "INSURED-FIND-CLASS" - "CONDITION-FUNCTION-NAME") + "CONDITION-FUNCTION-NAME" + + "%COMPLEX-SINGLE-FLOAT" + "%COMPLEX-DOUBLE-FLOAT" + "%COMPLEX-DOUBLE-DOUBLE-FLOAT") #+heap-overflow-check (:export "DYNAMIC-SPACE-OVERFLOW-WARNING-HIT" "DYNAMIC-SPACE-OVERFLOW-ERROR-HIT" diff --git a/compiler/sparc/float.lisp b/compiler/sparc/float.lisp index 25010de17ba17cacda9b4fddec69826c4afe2bb9..d33dabd0480a005a25998b966233dd7b9a80bc90 100644 --- a/compiler/sparc/float.lisp +++ b/compiler/sparc/float.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.58 2008/07/10 21:31:34 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.58.4.1 2008/10/16 22:00:47 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2694,6 +2694,22 @@ (frob single fcmps) (frob double fcmpd)) + +;; Instead of providing vops, we just transform these to the obvious +;; implementation. There are probably a few unnecessary moves. + +(macrolet + ((cvt (name prototype) + `(progn + (deftransform ,name ((n) (real) * :when :both) + '(complex (float n ,prototype))) + (deftransform ,name ((n) (complex) * :when :both) + '(complex (float (realpart n) ,prototype) + (float (imagpart n) ,prototype)))))) + (cvt %complex-single-float 1f0) + (cvt %complex-double-float 1d0)) + + ) ; end progn complex-fp-vops #+sparc-v9 diff --git a/compiler/x86/float-sse2.lisp b/compiler/x86/float-sse2.lisp index 1b5b8e717a38360d454f8ff9cdedc8222de525dc..7cd6d0f7f7970095be434f6aacfe66150ff04035 100644 --- a/compiler/x86/float-sse2.lisp +++ b/compiler/x86/float-sse2.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.1.2.8.2.16 2008/10/16 15:37:57 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.1.2.8.2.17 2008/10/16 22:00:47 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1763,6 +1763,59 @@ (negate-complex single pslld xorps 31) (negate-complex double psllq xorpd 63)) +;; Convert various number types to complex double-floats +(macrolet + ((convert-complex (trans op to from) + (let ((name (symbolicate to "/" from)) + (from-sc (symbolicate from "-REG")) + (from-type (symbolicate from "-FLOAT")) + (to-sc (symbolicate to "-REG")) + (to-type (symbolicate to "-FLOAT"))) + `(define-vop (,name) + (:translate ,trans) + (:args (x :scs (,from-sc) :target r)) + (:arg-types ,from-type) + (:results (r :scs (,to-sc))) + (:result-types ,to-type) + (:policy :fast-safe) + (:generator 1 + ;; NOTE: We don't have 128-bit aligned objects, so we + ;; can't use the stack or descriptors here. + (inst ,op r x)))))) + (convert-complex %complex-double-float cvtps2pd complex-double complex-single) + (convert-complex %complex-single-float cvtpd2ps complex-single complex-double)) + +(macrolet + ((convert-complex (trans op base-ea to from) + (let ((name (symbolicate to "/" from)) + (from-sc (symbolicate from "-REG")) + (from-sc-stack (symbolicate from "-STACK")) + (from-type (symbolicate from "-FLOAT")) + (to-sc (symbolicate to "-REG")) + (to-type (symbolicate to "-FLOAT"))) + `(define-vop (,name) + (:translate ,trans) + (:args (x :scs (,from-sc ,from-sc-stack descriptor-reg) + :target r)) + (:arg-types ,from-type) + (:results (r :scs (,to-sc))) + (:result-types ,to-type) + (:policy :fast-safe) + (:generator 1 + (sc-case x + (,from-sc + ;; Need to make sure the imaginary part is zero + (inst xorps r r) + (inst ,op r x)) + (,from-sc-stack + (inst xorps r r) + (inst ,op r (,(symbolicate "EA-FOR-" base-ea "-STACK") x))) + (descriptor-reg + (inst xorps r r) + (inst ,op r (,(symbolicate "EA-FOR-" base-ea "-DESC") x))))))))) + (convert-complex %complex-double-float cvtss2sd sf complex-double single) + (convert-complex %complex-single-float cvtsd2ss df complex-single double)) + ;; Add and subtract for two complex arguments (macrolet ((generate (movinst opinst commutative) @@ -1827,14 +1880,15 @@ (ea-stack (symbolicate "EA-FOR-" base-ea "-STACK")) (ea-desc (symbolicate "EA-FOR-" base-ea "-DESC"))) `(define-vop (,vop-name) - (:args (x :scs (,complex-reg)) - (y :scs (,real-reg ,r-stack descriptor-reg))) + (:args (x :scs (,complex-reg)) + (y :scs (,real-reg ,r-stack descriptor-reg))) (:results (r :scs (,complex-reg))) (:arg-types ,c-type ,r-type) (:result-types ,c-type) (:policy :fast-safe) (:note "inline complex float/float arithmetic") (:translate ,op) + (:temporary (:sc ,complex-reg) tmp) (:generator ,cost (sc-case y (,real-reg diff --git a/compiler/x86/insts.lisp b/compiler/x86/insts.lisp index aa5cdebd5e9ab7599f5ec6bf3a79218f11ae1b4d..e696637998bbc25b515b2a58f6e65bd3266ade1f 100644 --- a/compiler/x86/insts.lisp +++ b/compiler/x86/insts.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/insts.lisp,v 1.32.6.2.2.10 2008/10/12 04:09:48 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/insts.lisp,v 1.32.6.2.2.11 2008/10/16 22:00:47 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -3163,7 +3163,9 @@ ;; conversion (define-regular-sse-inst cvtsd2ss #xf2 #x5a) + (define-regular-sse-inst cvtpd2ps #x66 #x5a) (define-regular-sse-inst cvtss2sd #xf3 #x5a) + (define-regular-sse-inst cvtps2pd nil #x5a) (define-regular-sse-inst cvtdq2pd #xf3 #xe6) (define-regular-sse-inst cvtdq2ps nil #x5b)