diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp index 4e7513842355d50e2a650ab756dd346200a72ea0..cfa100e45cc635668e620e95d819394dd2d6eb89 100644 --- a/compiler/x86/float.lisp +++ b/compiler/x86/float.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.lisp,v 1.53 2008/01/03 11:41:52 cshapiro Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.54 2008/01/27 19:43:23 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1020,8 +1020,8 @@ (unless (zerop (tn-offset r)) (inst fxch r)) (when (policy node (or (= debug 3) (> safety speed))) - (note-next-instruction vop :internal-error) - (inst wait))) + (note-next-instruction vop :internal-error) + (inst wait))) ;; y and r are the same register. ((and (sc-is y single-reg) (location= y r)) (cond ((zerop (tn-offset r)) @@ -1055,8 +1055,8 @@ (unless (zerop (tn-offset r)) (inst fxch r)) (when (policy node (or (= debug 3) (> safety speed))) - (note-next-instruction vop :internal-error) - (inst wait))) + (note-next-instruction vop :internal-error) + (inst wait))) ;; The default case (t ;; Get the result to ST0. @@ -1877,11 +1877,40 @@ (with-empty-tn@fp-top(y) (note-this-location vop :internal-error) (inst fild x)))))))) + #+(or) (frob %single-float/signed %single-float single-reg single-float) (frob %double-float/signed %double-float double-reg double-float) #+long-float (frob %long-float/signed %long-float long-reg long-float)) +(define-vop (%single-float/signed) + (:args (x :scs (signed-stack signed-reg) :target temp)) + (:temporary (:sc signed-stack) temp) + (:temporary (:sc single-stack) sf-temp) + (:results (y :scs (single-reg))) + (:arg-types signed-num) + (:result-types single-float) + (:policy :fast-safe) + (:note "inline float coercion") + (:translate %single-float) + (:vop-var vop) + (:save-p :compute-only) + (:generator 5 + (sc-case x + (signed-reg + (inst mov temp x) + (with-empty-tn@fp-top(y) + (note-this-location vop :internal-error) + (inst fild temp) + (inst fstp sf-temp) + (inst fld sf-temp))) + (signed-stack + (with-empty-tn@fp-top(y) + (note-this-location vop :internal-error) + (inst fild x) + (inst fstp sf-temp) + (inst fld sf-temp)))))) + (macrolet ((frob (name translate to-sc to-type) `(define-vop (,name) (:args (x :scs (unsigned-reg))) @@ -1905,6 +1934,27 @@ #+long-float (frob %long-float/unsigned %long-float long-reg long-float)) +#+(or) +(define-vop (%single-float/unsigned) + (:args (x :scs (unsigned-reg))) + (:results (y :scs (single-reg))) + (:arg-types unsigned-num) + (:result-types single-float) + (:policy :fast-safe) + (:note "inline float coercion") + (:translate %single-float) + (:vop-var vop) + (:save-p :compute-only) + (:generator 6 + (inst push 0) + (inst push x) + (with-empty-tn@fp-top(y) + (note-this-location vop :internal-error) + (inst fildl (make-ea :dword :base esp-tn)) + (inst fstp (make-ea :dword :base esp-tn)) + (inst fld (make-ea :dword :base esp-tn))) + (inst add esp-tn 8))) + ;;; These should be no-ops but the compiler might want to move ;;; some things around (macrolet ((frob (name translate from-sc from-type to-sc to-type) @@ -1935,6 +1985,7 @@ (inst fst y) (inst fxch x)))))))) + #+(or) (frob %single-float/double-float %single-float double-reg double-float single-reg single-float) #+long-float @@ -1952,7 +2003,54 @@ (frob %long-float/double-float %long-float double-reg double-float long-reg long-float)) +(define-vop (%single-float/double-float) + (:args (x :scs (double-reg) :target y)) + (:results (y :scs (single-reg))) + (:arg-types double-float) + (:result-types single-float) + (:policy :fast-safe) + (:note "inline float coercion") + (:translate %single-float) + (:temporary (:sc single-stack) sf-temp) + (:vop-var vop) + (:save-p :compute-only) + (:generator 2 + (note-this-location vop :internal-error) + (cond + ((zerop (tn-offset x)) + (cond + ((zerop (tn-offset y)) + ;; x is in ST0, y is also in ST0 + (inst fstp sf-temp) + (inst fld sf-temp)) + (t + ;; x is in ST0, y is in another reg. not ST0 + ;; Save st0 (x) to memory, swap, reload, then swap back. + (inst fst sf-temp) + (inst fxch y) + (fp-pop) + (inst fld sf-temp) + (inst fxch y)))) + ((zerop (tn-offset y)) + ;; y is in ST0, x is in another reg. not ST0 + ;; Swap, save x to memory, reload, swap back + (inst fxch x) + (inst fstp sf-temp) + (inst fld sf-temp) + (inst fxch x)) + (t + ;; Neither x or y are in ST0, and they are not in + ;; the same reg. + ;; Get x to st0. Store it away. Swap back. Get y to st0, + ;; load. Swap back. + (inst fxch x) + (inst fst sf-temp) + (inst fxch x) + (inst fxch y) + (fp-pop) + (inst fld sf-temp) + (inst fxch y)))))) (macrolet ((frob (trans from-sc from-type round-p) `(define-vop (,(symbolicate trans "/" from-type))