Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/compiler/x86-64 float.lisp,1.2.8.3,1.2.8.4 insts.lisp,1.1.8.2,1.1.8.3
|
From: Juho S. <js...@us...> - 2004-11-02 21:32:02
|
Update of /cvsroot/sbcl/sbcl/src/compiler/x86-64 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6662/src/compiler/x86-64 Modified Files: Tag: x86-64-again-branch float.lisp insts.lisp Log Message: 0.8.15.14.x86-64-again-branch.1: Float fixes needed for not crashing in MAKE-HASH-TABLE / REHASH / %PUTHASH ... rex-prefix byte must come after legacy prefix byte (that's why they call it the prefix byte...) ... movq is #xf3 #0xf #x7e, not #xf3 #0xf #x73 ... make (add|sub|mul|div)(s|d) use (dst src) argument order for the sake of consistency ... use scalar (instead of packed) xmm ops in %foo-float/signed ... fix comparison vop translations / policy ... cargo-cult handling of vops that overwrite one source register Index: float.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/float.lisp,v retrieving revision 1.2.8.3 retrieving revision 1.2.8.4 diff -u -d -r1.2.8.3 -r1.2.8.4 --- float.lisp 20 Oct 2004 20:21:05 -0000 1.2.8.3 +++ float.lisp 2 Nov 2004 21:31:50 -0000 1.2.8.4 @@ -440,18 +440,20 @@ `(progn (define-vop (,sname single-float-op) (:translate ,op) - (:results (r :scs (single-reg))) ; FIXME I'm guessing + ;; XXX :from (:argument 0) cargo-culted from x86 vops + ;; that also overwrite one source. Seems to work, but + ;; I might be misunderstanding it's purpose. --JES + (:results (r :scs (single-reg) :from (:argument 0))) (:generator ,scost - (inst ,sinst x y) - (unless (location= r x) - (inst movq r x)))) + (inst movss r x) + (inst ,sinst r y))) (define-vop (,dname double-float-op) (:translate ,op) - (:results (r :scs (double-reg))) ; and again + ;; ibid + (:results (r :scs (double-reg) :from (:argument 0))) (:generator ,dcost - (inst ,dinst x y) - (unless (location= r x) - (inst movq r x))))))) + (inst movsd r x) + (inst ,dinst r y)))))) (frob + addss +/single-float 2 addsd +/double-float 2) (frob - subss -/single-float 2 subsd -/double-float 2) (frob * mulss */single-float 4 mulsd */double-float 5) @@ -524,11 +526,11 @@ ;;; could (should, indeed) extend these to cope with descriptor args ;;; and stack args -(define-vop (single-float-compare) +(define-vop (single-float-compare float-compare) (:args (x :scs (single-reg)) (y :scs (single-reg))) (:conditional) (:arg-types single-float single-float)) -(define-vop (double-float-compare) +(define-vop (double-float-compare float-compare) (:args (x :scs (double-reg)) (y :scs (double-reg))) (:conditional) (:arg-types double-float double-float)) @@ -583,14 +585,14 @@ (inst jmp (if not-p :nc :c) target))) (define-vop (>double-float double-float-compare) - (:translate <) + (:translate >) (:info target not-p) (:generator 2 (inst comisd x y) (inst jmp (if not-p :na :a) target))) (define-vop (>single-float single-float-compare) - (:translate <) + (:translate >) (:info target not-p) (:generator 2 (inst comiss x y) @@ -621,9 +623,10 @@ (signed-stack (note-this-location vop :internal-error) (inst ,inst y x))))))) - (frob %single-float/signed %single-float cvtdq2ps single-reg single-float) - (frob %double-float/signed %double-float cvtdq2pd double-reg double-float)) + (frob %single-float/signed %single-float cvtsi2ss single-reg single-float) + (frob %double-float/signed %double-float cvtsi2sd double-reg double-float)) +#+nil (macrolet ((frob (name translate inst to-sc to-type) `(define-vop (,name) (:args (x :scs (unsigned-reg))) Index: insts.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/insts.lisp,v retrieving revision 1.1.8.2 retrieving revision 1.1.8.3 diff -u -d -r1.1.8.2 -r1.1.8.3 --- insts.lisp 20 Oct 2004 10:52:53 -0000 1.1.8.2 +++ insts.lisp 2 Nov 2004 21:31:52 -0000 1.1.8.3 @@ -2882,14 +2882,14 @@ (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter (cond ((typep src 'tn) - (maybe-emit-rex-for-ea segment dst src) (emit-byte segment #xf2) + (maybe-emit-rex-for-ea segment dst src) (emit-byte segment #x0f) (emit-byte segment #x11) (emit-ea segment dst (reg-tn-encoding src))) (t - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf2) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x10) (emit-ea segment src (reg-tn-encoding dst)))))) @@ -2897,15 +2897,15 @@ (define-instruction movss (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (cond ((tn-p src) - (maybe-emit-rex-for-ea segment dst src) + (cond ((tn-p src) (emit-byte segment #xf3) + (maybe-emit-rex-for-ea segment dst src) (emit-byte segment #x0f) (emit-byte segment #x11) (emit-ea segment dst (reg-tn-encoding src))) (t - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf3) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x10) (emit-ea segment src (reg-tn-encoding dst)))))) @@ -2913,8 +2913,8 @@ (define-instruction andpd (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x66) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x54) (emit-ea segment src (reg-tn-encoding dst)))) @@ -2922,8 +2922,8 @@ (define-instruction comisd (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x66) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x2f) (emit-ea segment src (reg-tn-encoding dst)))) @@ -2943,14 +2943,14 @@ (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter (cond ((typep dst 'tn) - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x66) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x6e) (emit-ea segment src (reg-tn-encoding dst))) (t - (maybe-emit-rex-for-ea segment dst src) (emit-byte segment #x66) + (maybe-emit-rex-for-ea segment dst src) (emit-byte segment #x0f) (emit-byte segment #x7e) (emit-ea segment dst (reg-tn-encoding src)))))) @@ -2959,14 +2959,14 @@ (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter (cond ((typep dst 'tn) - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf3) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) - (emit-byte segment #x73) + (emit-byte segment #x7e) (emit-ea segment src (reg-tn-encoding dst))) (t - (maybe-emit-rex-for-ea segment dst src) (emit-byte segment #x66) + (maybe-emit-rex-for-ea segment dst src) (emit-byte segment #x0f) (emit-byte segment #xd6) (emit-ea segment dst (reg-tn-encoding src)))))) @@ -2974,8 +2974,8 @@ (define-instruction xorpd (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x66) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x57) (emit-ea segment src (reg-tn-encoding dst)))) @@ -2991,8 +2991,8 @@ (define-instruction cvtsd2si (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf2) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x2d) (emit-ea segment src (reg-tn-encoding dst)))) @@ -3000,8 +3000,8 @@ (define-instruction cvtsd2ss (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf2) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x5a) (emit-ea segment src (reg-tn-encoding dst)))) @@ -3009,8 +3009,8 @@ (define-instruction cvtss2si (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf3) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x2d) (emit-ea segment src (reg-tn-encoding dst)))) @@ -3018,8 +3018,8 @@ (define-instruction cvtss2sd (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf3) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x5a) (emit-ea segment src (reg-tn-encoding dst)))) @@ -3027,8 +3027,8 @@ (define-instruction cvtsi2ss (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf3) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x2a) (emit-ea segment src (reg-tn-encoding dst)))) @@ -3036,8 +3036,8 @@ (define-instruction cvtsi2sd (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf2) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x2a) (emit-ea segment src (reg-tn-encoding dst)))) @@ -3045,8 +3045,8 @@ (define-instruction cvtdq2pd (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf3) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #xe6) (emit-ea segment src (reg-tn-encoding dst)))) @@ -3064,8 +3064,8 @@ (define-instruction cvttsd2si (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf2) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x2c) (emit-ea segment src (reg-tn-encoding dst)))) @@ -3073,80 +3073,80 @@ (define-instruction cvttss2si (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf3) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x2c) (emit-ea segment src (reg-tn-encoding dst)))) -(define-instruction addsd (segment src dst) +(define-instruction addsd (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf2) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x58) (emit-ea segment src (reg-tn-encoding dst)))) -(define-instruction addss (segment src dst) +(define-instruction addss (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf3) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x58) (emit-ea segment src (reg-tn-encoding dst)))) -(define-instruction divsd (segment src dst) +(define-instruction divsd (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf2) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x5e) (emit-ea segment src (reg-tn-encoding dst)))) -(define-instruction divss (segment src dst) +(define-instruction divss (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf3) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x5e) (emit-ea segment src (reg-tn-encoding dst)))) -(define-instruction mulsd (segment src dst) +(define-instruction mulsd (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf2) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x59) (emit-ea segment src (reg-tn-encoding dst)))) -(define-instruction mulss (segment src dst) +(define-instruction mulss (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf3) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x59) (emit-ea segment src (reg-tn-encoding dst)))) -(define-instruction subsd (segment src dst) +(define-instruction subsd (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf2) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x5c) (emit-ea segment src (reg-tn-encoding dst)))) -(define-instruction subss (segment src dst) +(define-instruction subss (segment dst src) (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #xf3) + (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #x0f) (emit-byte segment #x5c) (emit-ea segment src (reg-tn-encoding dst)))) |