Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/compiler/x86-64 float.lisp,1.2,1.2.8.1 insts.lisp,1.1,1.1.8.1 type-vops.lisp,1.1,1.1.8.1 vm.lisp,1.2,1.2.8.1
|
From: Daniel B. <da...@us...> - 2004-10-18 21:16:29
|
Update of /cvsroot/sbcl/sbcl/src/compiler/x86-64 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7256/src/compiler/x86-64 Modified Files: Tag: x86-64-again-branch float.lisp insts.lisp type-vops.lisp vm.lisp Log Message: "640 k should be enough for anyone" : resuscitating the AMD64 port Add necessary "128 bit media" instruction definitions to compile float.lisp Rename XMM register-related variables back to "float" Index: float.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/float.lisp,v retrieving revision 1.2 retrieving revision 1.2.8.1 diff -u -d -r1.2 -r1.2.8.1 --- float.lisp 27 Jun 2004 18:15:58 -0000 1.2 +++ float.lisp 18 Oct 2004 21:16:17 -0000 1.2.8.1 @@ -81,62 +81,18 @@ ((single-stack) (single-reg)) (inst movss y (ea-for-sf-stack x))) -;;; got this far 20040627 - (define-move-fun (store-single 2) (vop x y) ((single-reg) (single-stack)) - (cond ((zerop (tn-offset x)) - (inst fst (ea-for-sf-stack y))) - (t - (inst fxch x) [...2556 lines suppressed...] +#+nil (define-vop (realpart/complex-double-float complex-float-value) (:translate realpart) (:args (x :scs (complex-double-reg complex-double-stack descriptor-reg) @@ -2794,6 +1068,7 @@ (:note "complex float realpart") (:variant 0)) +#+nil (define-vop (imagpart/complex-single-float complex-float-value) (:translate imagpart) (:args (x :scs (complex-single-reg complex-single-stack descriptor-reg) @@ -2804,6 +1079,7 @@ (:note "complex float imagpart") (:variant 1)) +#+nil (define-vop (imagpart/complex-double-float complex-float-value) (:translate imagpart) (:args (x :scs (complex-double-reg complex-double-stack descriptor-reg) Index: insts.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/insts.lisp,v retrieving revision 1.1 retrieving revision 1.1.8.1 diff -u -d -r1.1 -r1.1.8.1 --- insts.lisp 26 Jun 2004 17:48:22 -0000 1.1 +++ insts.lisp 18 Oct 2004 21:16:17 -0000 1.1.8.1 @@ -480,6 +480,20 @@ ;; optional fields (imm)) +;;; Same as reg-reg/mem, but with a prefix of #xf2 0f +(sb!disassem:define-instruction-format (xmm-ext-reg-reg/mem 32 + :default-printer + `(:name :tab reg ", " reg/mem)) + (prefix :field (byte 8 0) :value #xf2) + (prefix2 :field (byte 8 8) :value #x0f) + (op :field (byte 7 17)) + (width :field (byte 1 16) :type 'width) + (reg/mem :fields (list (byte 2 30) (byte 3 24)) + :type 'reg/mem) + (reg :field (byte 3 27) :type 'reg) + ;; optional fields + (imm)) + ;;; reg-no-width with #x0f prefix (sb!disassem:define-instruction-format (ext-reg-no-width 16 :default-printer '(:name :tab reg)) @@ -2860,4 +2874,279 @@ (:emitter (emit-byte segment #b11011001) (emit-byte segment #b11101101))) - \ No newline at end of file + +;; new xmm insns required by sse float +;; movsd andpd comisd comiss + +(define-instruction movsd (segment dst src) + (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong + (:emitter + (cond ((typep src 'tn) + (maybe-emit-rex-for-ea segment src dst) + (emit-byte segment #xf2) + (emit-byte segment #x0f) + (emit-byte segment #x11) + (emit-ea segment src (reg-tn-encoding dst))) + (t + (maybe-emit-rex-for-ea segment dst src) + (emit-byte segment #xf2) + (emit-byte segment #x0f) + (emit-byte segment #x10) + (emit-ea segment dst (reg-tn-encoding src)))))) + +(define-instruction movss (segment dst src) + (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong + (:emitter + (cond ((typep src 'tn) + (maybe-emit-rex-for-ea segment src dst) + (emit-byte segment #xf3) + (emit-byte segment #x0f) + (emit-byte segment #x11) + (emit-ea segment src (reg-tn-encoding dst))) + (t + (maybe-emit-rex-for-ea segment dst src) + (emit-byte segment #xf3) + (emit-byte segment #x0f) + (emit-byte segment #x10) + (emit-ea segment dst (reg-tn-encoding src)))))) + +(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) + (emit-byte segment #x0f) + (emit-byte segment #x54) + (emit-ea segment src (reg-tn-encoding dst)))) + +(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) + (emit-byte segment #x0f) + (emit-byte segment #x2f) + (emit-ea segment src (reg-tn-encoding dst)))) + +(define-instruction comiss (segment dst src) + (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong + (:emitter + (maybe-emit-rex-for-ea segment src dst) + (emit-byte segment #x0f) + (emit-byte segment #x2f) + (emit-ea segment src (reg-tn-encoding dst)))) + +;; movd movq xorp xord + +;; we only do the xmm version of movd +(define-instruction movd (segment dst src) + (: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) + (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) + (emit-byte segment #x0f) + (emit-byte segment #x7e) + (emit-ea segment dst (reg-tn-encoding src)))))) + +(define-instruction movq (segment dst src) + (: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) + (emit-byte segment #x0f) + (emit-byte segment #x73) + (emit-ea segment src (reg-tn-encoding dst))) + (t + (maybe-emit-rex-for-ea segment dst src) + (emit-byte segment #x66) + (emit-byte segment #x0f) + (emit-byte segment #xd6) + (emit-ea segment dst (reg-tn-encoding src)))))) + +(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) + (emit-byte segment #x0f) + (emit-byte segment #x57) + (emit-ea segment src (reg-tn-encoding dst)))) + +(define-instruction xorps (segment dst src) + (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong + (:emitter + (maybe-emit-rex-for-ea segment src dst) + (emit-byte segment #x0f) + (emit-byte segment #x57) + (emit-ea segment src (reg-tn-encoding dst)))) + +(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) + (emit-byte segment #x0f) + (emit-byte segment #x2d) + (emit-ea segment src (reg-tn-encoding dst)))) + +(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) + (emit-byte segment #x0f) + (emit-byte segment #x5a) + (emit-ea segment src (reg-tn-encoding dst)))) + +(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) + (emit-byte segment #x0f) + (emit-byte segment #x2d) + (emit-ea segment src (reg-tn-encoding dst)))) + +(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) + (emit-byte segment #x0f) + (emit-byte segment #x5a) + (emit-ea segment src (reg-tn-encoding dst)))) + +(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) + (emit-byte segment #x0f) + (emit-byte segment #x2a) + (emit-ea segment src (reg-tn-encoding dst)))) + +(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) + (emit-byte segment #x0f) + (emit-byte segment #x2a) + (emit-ea segment src (reg-tn-encoding dst)))) + +(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) + (emit-byte segment #x0f) + (emit-byte segment #xe6) + (emit-ea segment src (reg-tn-encoding dst)))) + +(define-instruction cvtdq2ps (segment dst src) + (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong + (:emitter + (maybe-emit-rex-for-ea segment src dst) + (emit-byte segment #x0f) + (emit-byte segment #x5b) + (emit-ea segment src (reg-tn-encoding dst)))) + +;; CVTTSD2SI CVTTSS2SI + +(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) + (emit-byte segment #x0f) + (emit-byte segment #x2c) + (emit-ea segment src (reg-tn-encoding dst)))) + +(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) + (emit-byte segment #x0f) + (emit-byte segment #x2c) + (emit-ea segment src (reg-tn-encoding dst)))) + +(define-instruction addsd (segment src dst) + (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong + (:emitter + (maybe-emit-rex-for-ea segment src dst) + (emit-byte segment #xf2) + (emit-byte segment #x0f) + (emit-byte segment #x58) + (emit-ea segment src (reg-tn-encoding dst)))) + +(define-instruction addss (segment src dst) + (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong + (:emitter + (maybe-emit-rex-for-ea segment src dst) + (emit-byte segment #xf3) + (emit-byte segment #x0f) + (emit-byte segment #x58) + (emit-ea segment src (reg-tn-encoding dst)))) + +(define-instruction divsd (segment src dst) + (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong + (:emitter + (maybe-emit-rex-for-ea segment src dst) + (emit-byte segment #xf2) + (emit-byte segment #x0f) + (emit-byte segment #x5e) + (emit-ea segment src (reg-tn-encoding dst)))) + +(define-instruction divss (segment src dst) + (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong + (:emitter + (maybe-emit-rex-for-ea segment src dst) + (emit-byte segment #xf3) + (emit-byte segment #x0f) + (emit-byte segment #x5e) + (emit-ea segment src (reg-tn-encoding dst)))) + +(define-instruction mulsd (segment src dst) + (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong + (:emitter + (maybe-emit-rex-for-ea segment src dst) + (emit-byte segment #xf2) + (emit-byte segment #x0f) + (emit-byte segment #x59) + (emit-ea segment src (reg-tn-encoding dst)))) + +(define-instruction mulss (segment src dst) + (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong + (:emitter + (maybe-emit-rex-for-ea segment src dst) + (emit-byte segment #xf3) + (emit-byte segment #x0f) + (emit-byte segment #x59) + (emit-ea segment src (reg-tn-encoding dst)))) + +(define-instruction subsd (segment src dst) + (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong + (:emitter + (maybe-emit-rex-for-ea segment src dst) + (emit-byte segment #xf2) + (emit-byte segment #x0f) + (emit-byte segment #x5c) + (emit-ea segment src (reg-tn-encoding dst)))) + +(define-instruction subss (segment src dst) + (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong + (:emitter + (maybe-emit-rex-for-ea segment src dst) + (emit-byte segment #xf3) + (emit-byte segment #x0f) + (emit-byte segment #x5c) + (emit-ea segment src (reg-tn-encoding dst)))) Index: type-vops.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/type-vops.lisp,v retrieving revision 1.1 retrieving revision 1.1.8.1 diff -u -d -r1.1 -r1.1.8.1 --- type-vops.lisp 26 Jun 2004 17:48:22 -0000 1.1 +++ type-vops.lisp 18 Oct 2004 21:16:17 -0000 1.1.8.1 @@ -175,6 +175,7 @@ (inst shr tmp 61) (inst jmp (if not-p :nz :z) target))) +#+nil (define-vop (signed-byte-32-p type-predicate) (:translate signed-byte-32-p) (:generator 45 Index: vm.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/vm.lisp,v retrieving revision 1.2 retrieving revision 1.2.8.1 diff -u -d -r1.2 -r1.2.8.1 --- vm.lisp 27 Jun 2004 18:15:59 -0000 1.2 +++ vm.lisp 18 Oct 2004 21:16:18 -0000 1.2.8.1 @@ -22,7 +22,7 @@ (defvar *word-register-names* (make-array 16 :initial-element nil)) (defvar *dword-register-names* (make-array 16 :initial-element nil)) (defvar *qword-register-names* (make-array 32 :initial-element nil)) - (defvar *xmm-register-names* (make-array 16 :initial-element nil))) + (defvar *float-register-names* (make-array 16 :initial-element nil))) (macrolet ((defreg (name offset size) (let ((offset-sym (symbolicate name "-OFFSET")) @@ -102,24 +102,24 @@ r8 r9 r10 r11 #+nil r12 #+nil r13 r14 r15) ;; floating point registers - (defreg xmm0 0 :float) - (defreg xmm1 1 :float) - (defreg xmm2 2 :float) - (defreg xmm3 3 :float) - (defreg xmm4 4 :float) - (defreg xmm5 5 :float) - (defreg xmm6 6 :float) - (defreg xmm7 7 :float) - (defreg xmm8 8 :float) - (defreg xmm9 9 :float) - (defreg xmm10 10 :float) - (defreg xmm11 11 :float) - (defreg xmm12 12 :float) - (defreg xmm13 13 :float) - (defreg xmm14 14 :float) - (defreg xmm15 15 :float) - (defregset *xmm-regs* xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7 - xmm8 xmm9 xmm10 xmm11 xmm12 xmm13 xmm14 xmm15) + (defreg float0 0 :float) + (defreg float1 1 :float) + (defreg float2 2 :float) + (defreg float3 3 :float) + (defreg float4 4 :float) + (defreg float5 5 :float) + (defreg float6 6 :float) + (defreg float7 7 :float) + (defreg float8 8 :float) + (defreg float9 9 :float) + (defreg float10 10 :float) + (defreg float11 11 :float) + (defreg float12 12 :float) + (defreg float13 13 :float) + (defreg float14 14 :float) + (defreg float15 15 :float) + (defregset *float-regs* float0 float1 float2 float3 float4 float5 float6 float7 + float8 float9 float10 float11 float12 float13 float14 float15) ;; registers used to pass arguments ;; @@ -140,7 +140,7 @@ ;;; words in a dword register. (define-storage-base registers :finite :size 32) -(define-storage-base xmm-registers :finite :size 16) +(define-storage-base float-registers :finite :size 16) (define-storage-base stack :unbounded :size 8) (define-storage-base constant :non-packed) @@ -184,7 +184,7 @@ ;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess ;;; has my gratitude.) (FIXME: Maybe this should be me..) (eval-when (:compile-toplevel :load-toplevel :execute) - (def!constant kludge-nondeterministic-catch-block-size 6)) + (def!constant kludge-nondeterministic-catch-block-size 7)) (!define-storage-classes @@ -293,27 +293,27 @@ ;; that can go in the floating point registers ;; non-descriptor SINGLE-FLOATs - (single-reg xmm-registers + (single-reg float-registers :locations #.(loop for i from 0 to 15 collect i) - :constant-scs (fp-constant) + :constant-scs nil ; (fp-constant) :save-p t :alternate-scs (single-stack)) ;; non-descriptor DOUBLE-FLOATs - (double-reg xmm-registers + (double-reg float-registers :locations #.(loop for i from 0 to 15 collect i) - :constant-scs (fp-constant) + :constant-scs nil ; (fp-constant) :save-p t :alternate-scs (double-stack)) - (complex-single-reg xmm-registers + (complex-single-reg float-registers :locations #.(loop for i from 0 to 14 by 2 collect i) :element-size 2 :constant-scs () :save-p t :alternate-scs (complex-single-stack)) - (complex-double-reg xmm-registers + (complex-double-reg float-registers :locations #.(loop for i from 0 to 14 by 2 collect i) :element-size 2 :constant-scs () @@ -361,8 +361,8 @@ (def-misc-reg-tns word-reg ax bx cx dx bp sp di si) (def-misc-reg-tns byte-reg al ah bl bh cl ch dl dh) (def-misc-reg-tns single-reg - xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7 - xmm8 xmm9 xmm10 xmm11 xmm12 xmm13 xmm14 xmm15)) + float0 float1 float2 float3 float4 float5 float6 float7 + float8 float9 float10 float11 float12 float13 float14 float15)) ;;; TNs for registers used to pass arguments (defparameter *register-arg-tns* |