(sb!disassem:dstate-put-inst-prop dstate 'operand-size-8))
value)
+;;; This prefilter is used solely for its side effect, namely to put
+;;; the property OPERAND-SIZE-16 into the DSTATE.
+(defun prefilter-x66 (value dstate)
+ (declare (type (eql #x66) value)
+ (ignore value)
+ (type sb!disassem:disassem-state dstate))
+ (sb!disassem:dstate-put-inst-prop dstate 'operand-size-16))
+
;;; A register field that can be extended by REX.R.
(defun prefilter-reg-r (value dstate)
(declare (type reg value)
index-reg))
(ash 1 index-scale))))))
((and (= mod #b00) (= r/m #b101))
- (list 'rip (sb!disassem:read-signed-suffix 32 dstate)) )
+ (list 'rip (sb!disassem:read-signed-suffix 32 dstate)))
((= mod #b00)
(list full-reg))
((= mod #b01)
(princ (schar (symbol-name (inst-operand-size dstate)) 0)
stream)))
+;;; Used to capture the effect of the #x66 operand size override prefix.
+(sb!disassem:define-arg-type x66
+ :prefilter #'prefilter-x66)
+
(sb!disassem:define-arg-type displacement
:sign-extend t
:use-label #'offset-next
:printer #'print-sized-xmmreg/mem)
-;;; added by jrd
-(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
-(defun print-fp-reg (value stream dstate)
- (declare (ignore dstate))
- (format stream "FR~D" value))
-(defun prefilter-fp-reg (value dstate)
- ;; just return it
- (declare (ignore dstate))
- value)
-) ; EVAL-WHEN
-(sb!disassem:define-arg-type fp-reg
- :prefilter #'prefilter-fp-reg
- :printer #'print-fp-reg)
-
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *conditions*
'((:o . 0)
:default-printer '(:name :tab reg))
(reg :type 'reg-b-default-qword))
-(sb!disassem:define-instruction-format (modrm-reg-no-width 24
- :default-printer '(:name :tab reg))
- (rex :field (byte 4 4) :value #b0100)
- (wrxb :field (byte 4 0) :type 'wrxb)
- (ff :field (byte 8 8) :value #b11111111)
- (mod :field (byte 2 22))
- (modrm-reg :field (byte 3 19))
- (reg :field (byte 3 16) :type 'reg-b)
- ;; optional fields
- (accum :type 'accum)
- (imm))
-
;;; Adds a width field to reg-no-width. Note that we can't use
;;; :INCLUDE 'REG-NO-WIDTH here to save typing because that would put
;;; the WIDTH field last, but the prefilter for WIDTH must run before
(op :field (byte 6 10))
(dir :field (byte 1 9)))
+(sb!disassem:define-instruction-format (x66-reg-reg/mem-dir 24
+ :default-printer
+ `(:name
+ :tab
+ ,(swap-if 'dir 'reg/mem ", " 'reg)))
+ (x66 :field (byte 8 0) :type 'x66 :value #x66)
+ (op :field (byte 6 10))
+ (dir :field (byte 1 9))
+ (width :field (byte 1 8) :type 'width)
+ (reg/mem :fields (list (byte 2 22) (byte 3 16))
+ :type 'reg/mem)
+ (reg :field (byte 3 19) :type 'reg))
+
+(sb!disassem:define-instruction-format (x66-rex-reg-reg/mem-dir 32
+ :default-printer
+ `(:name
+ :tab
+ ,(swap-if 'dir 'reg/mem ", " 'reg)))
+ (x66 :field (byte 8 0) :type 'x66 :value #x66)
+ (rex :field (byte 4 12) :value #b0100)
+ (wrxb :field (byte 4 8) :type 'wrxb)
+ (op :field (byte 6 18))
+ (dir :field (byte 1 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))
+
;;; Same as reg-reg/mem, but uses the reg field as a second op code.
(sb!disassem:define-instruction-format (reg/mem 16
:default-printer '(:name :tab reg/mem))
:type 'sized-xmmreg/mem)
(reg :field (byte 3 35) :type 'reg))
-;;;; This section was added by jrd, for fp instructions.
-
-;;; regular fp inst to/from registers/memory
-(sb!disassem:define-instruction-format (floating-point 16
- :default-printer
- `(:name :tab reg/mem))
- (prefix :field (byte 5 3) :value #b11011)
- (op :fields (list (byte 3 0) (byte 3 11)))
- (reg/mem :fields (list (byte 2 14) (byte 3 8)) :type 'reg/mem))
-
-;;; fp insn to/from fp reg
-(sb!disassem:define-instruction-format (floating-point-fp 16
- :default-printer `(:name :tab fp-reg))
- (prefix :field (byte 5 3) :value #b11011)
- (suffix :field (byte 2 14) :value #b11)
- (op :fields (list (byte 3 0) (byte 3 11)))
- (fp-reg :field (byte 3 8) :type 'fp-reg))
-
-;;; fp insn to/from fp reg, with the reversed source/destination flag.
-(sb!disassem:define-instruction-format
- (floating-point-fp-d 16
- :default-printer `(:name :tab ,(swap-if 'd "ST0" ", " 'fp-reg)))
- (prefix :field (byte 5 3) :value #b11011)
- (suffix :field (byte 2 14) :value #b11)
- (op :fields (list (byte 2 0) (byte 3 11)))
- (d :field (byte 1 2))
- (fp-reg :field (byte 3 8) :type 'fp-reg))
-
-
-;;; (added by (?) pfw)
-;;; fp no operand isns
-(sb!disassem:define-instruction-format (floating-point-no 16
- :default-printer '(:name))
- (prefix :field (byte 8 0) :value #b11011001)
- (suffix :field (byte 3 13) :value #b111)
- (op :field (byte 5 8)))
-
-(sb!disassem:define-instruction-format (floating-point-3 16
- :default-printer '(:name))
- (prefix :field (byte 5 3) :value #b11011)
- (suffix :field (byte 2 14) :value #b11)
- (op :fields (list (byte 3 0) (byte 6 8))))
-
-(sb!disassem:define-instruction-format (floating-point-5 16
- :default-printer '(:name))
- (prefix :field (byte 8 0) :value #b11011011)
- (suffix :field (byte 3 13) :value #b111)
- (op :field (byte 5 8)))
-
-(sb!disassem:define-instruction-format (floating-point-st 16
- :default-printer '(:name))
- (prefix :field (byte 8 0) :value #b11011111)
- (suffix :field (byte 3 13) :value #b111)
- (op :field (byte 5 8)))
-
(sb!disassem:define-instruction-format (string-op 8
:include 'simple
:default-printer '(:name width)))
(define-bitfield-emitter emit-dword 32
(byte 32 0))
+;;; Most uses of dwords are as displacements or as immediate values in
+;;; 64-bit operations. In these cases they are sign-extended to 64 bits.
+;;; EMIT-DWORD is unsuitable there because it accepts values of type
+;;; (OR (SIGNED-BYTE 32) (UNSIGNED-BYTE 32)), so we provide a more
+;;; restricted emitter here.
+(defun emit-signed-dword (segment value)
+ (declare (type segment segment)
+ (type (signed-byte 32) value))
+ (declare (inline emit-dword))
+ (emit-dword segment value))
+
(define-bitfield-emitter emit-qword 64
(byte 64 0))
0))
other-pointer-lowtag)))
(if quad-p
- (emit-qword segment val )
- (emit-dword segment val )))))
+ (emit-qword segment val)
+ (emit-signed-dword segment val)))))
(if quad-p
(emit-qword segment (or offset 0))
- (emit-dword segment (or offset 0))))))
+ (emit-signed-dword segment (or offset 0))))))
(defun emit-relative-fixup (segment fixup)
(note-fixup segment :relative fixup)
- (emit-dword segment (or (fixup-offset fixup) 0)))
+ (emit-signed-dword segment (or (fixup-offset fixup) 0)))
\f
;;;; the effective-address (ea) structure
(lambda (segment posn)
;; The addressing is relative to end of instruction,
;; i.e. the end of this dword. Hence the + 4.
- (emit-dword segment (+ 4 (- (+ offset posn)))))))
+ (emit-signed-dword segment
+ (+ 4 (- (+ offset posn)))))))
(values))
(defun emit-label-rip (segment fixup reg)
(emit-back-patch segment
4
(lambda (segment posn)
- (emit-dword segment (- (label-position label)
- (+ posn 4))))))
+ (emit-signed-dword segment (- (label-position label)
+ (+ posn 4))))))
(values))
(defun emit-ea (segment thing reg &optional allow-constants)
(stack
;; Convert stack tns into an index off RBP.
(let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes))))
- (cond ((< -128 disp 127)
+ (cond ((<= -128 disp 127)
(emit-mod-reg-r/m-byte segment #b01 reg #b101)
(emit-byte segment disp))
(t
(emit-mod-reg-r/m-byte segment #b10 reg #b101)
- (emit-dword segment disp)))))
+ (emit-signed-dword segment disp)))))
(constant
(unless allow-constants
;; Why?
((or (= mod #b10) (null base))
(if (fixup-p disp)
(emit-absolute-fixup segment disp)
- (emit-dword segment disp))))))
+ (emit-signed-dword segment disp))))))
(fixup
(typecase (fixup-offset thing)
(label
(emit-sib-byte segment 0 #b100 #b101)
(emit-absolute-fixup segment thing))))))
-;;; like the above, but for fp-instructions--jrd
-(defun emit-fp-op (segment thing op)
- (if (fp-reg-tn-p thing)
- (emit-byte segment (dpb op (byte 3 3) (dpb (tn-offset thing)
- (byte 3 0)
- #b11000000)))
- (emit-ea segment thing op)))
-
(defun byte-reg-p (thing)
(and (tn-p thing)
(eq (sb-name (sc-sb (tn-sc thing))) 'registers)
src-size
(error "can't tell the size of either ~S or ~S" dst src)))))
-(defun emit-sized-immediate (segment size value &optional quad-p)
+;;; Except in a very few cases (MOV instructions A1, A3 and B8 - BF)
+;;; we expect dword data bytes even when 64 bit work is being done.
+;;; But A1 and A3 are currently unused and B8 - BF use EMIT-QWORD
+;;; directly, so we emit all quad constants as dwords, additionally
+;;; making sure that they survive the sign-extension to 64 bits
+;;; unchanged.
+(defun emit-sized-immediate (segment size value)
(ecase size
(:byte
(emit-byte segment value))
(:word
(emit-word segment value))
- ((:dword :qword)
- ;; except in a very few cases (MOV instructions A1,A3,B8) we expect
- ;; dword data bytes even when 64 bit work is being done. So, mostly
- ;; we treat quad constants as dwords.
- (if (and quad-p (eq size :qword))
- (emit-qword segment value)
- (emit-dword segment value)))))
+ (:dword
+ (emit-dword segment value))
+ (:qword
+ (emit-signed-dword segment value))))
\f
;;;; general data transfer
+;;; This is the part of the MOV instruction emitter that does moving
+;;; of an immediate value into a qword register. We go to some length
+;;; to achieve the shortest possible encoding.
+(defun emit-immediate-move-to-qword-register (segment dst src)
+ (declare (type integer src))
+ (cond ((typep src '(unsigned-byte 32))
+ ;; We use the B8 - BF encoding with an operand size of 32 bits
+ ;; here and let the implicit zero-extension fill the upper half
+ ;; of the 64-bit destination register. Instruction size: five
+ ;; or six bytes. (A REX prefix will be emitted only if the
+ ;; destination is an extended register.)
+ (maybe-emit-rex-prefix segment :dword nil nil dst)
+ (emit-byte-with-reg segment #b10111 (reg-tn-encoding dst))
+ (emit-dword segment src))
+ (t
+ (maybe-emit-rex-prefix segment :qword nil nil dst)
+ (cond ((typep src '(signed-byte 32))
+ ;; Use the C7 encoding that takes a 32-bit immediate and
+ ;; sign-extends it to 64 bits. Instruction size: seven
+ ;; bytes.
+ (emit-byte segment #b11000111)
+ (emit-mod-reg-r/m-byte segment #b11 #b000
+ (reg-tn-encoding dst))
+ (emit-signed-dword segment src))
+ ((<= (- (expt 2 64) (expt 2 31))
+ src
+ (1- (expt 2 64)))
+ ;; This triggers on positive integers of 64 bits length
+ ;; with the most significant 33 bits being 1. We use the
+ ;; same encoding as in the previous clause.
+ (emit-byte segment #b11000111)
+ (emit-mod-reg-r/m-byte segment #b11 #b000
+ (reg-tn-encoding dst))
+ (emit-signed-dword segment (- src (expt 2 64))))
+ (t
+ ;; We need a full 64-bit immediate. Instruction size:
+ ;; ten bytes.
+ (emit-byte-with-reg segment #b10111 (reg-tn-encoding dst))
+ (emit-qword segment src))))))
+
(define-instruction mov (segment dst src)
;; immediate to register
(:printer reg ((op #b1011) (imm nil :type 'signed-imm-data))
;; register to/from register/memory
(:printer reg-reg/mem-dir ((op #b100010)))
(:printer rex-reg-reg/mem-dir ((op #b100010)))
+ (:printer x66-reg-reg/mem-dir ((op #b100010)))
+ (:printer x66-rex-reg-reg/mem-dir ((op #b100010)))
;; immediate to register/memory
(:printer reg/mem-imm ((op '(#b1100011 #b000))))
(:printer rex-reg/mem-imm ((op '(#b1100011 #b000))))
(maybe-emit-operand-size-prefix segment size)
(cond ((register-p dst)
(cond ((integerp src)
- (maybe-emit-rex-prefix segment size nil nil dst)
- (cond ((and (eq size :qword)
- (typep src '(signed-byte 31)))
- ;; When loading small immediates to a qword register
- ;; using B8 wastes 3 bytes compared to C7.
- (emit-byte segment #b11000111)
- (emit-mod-reg-r/m-byte segment #b11
- #b000
- (reg-tn-encoding dst))
- (emit-sized-immediate segment :dword src nil))
+ (cond ((eq size :qword)
+ (emit-immediate-move-to-qword-register segment
+ dst src))
(t
+ (maybe-emit-rex-prefix segment size nil nil dst)
(emit-byte-with-reg segment
(if (eq size :byte)
#b10110
#b10111)
(reg-tn-encoding dst))
- (emit-sized-immediate segment size src
- (eq size :qword)))))
+ (emit-sized-immediate segment size src))))
(t
(maybe-emit-rex-for-ea segment src dst)
(emit-byte segment
#b10001011))
(emit-ea segment src (reg-tn-encoding dst) t))))
((integerp src)
- ;; C7 only deals with 32 bit immediates even if register is
- ;; 64 bit: only b8-bf use 64 bit immediates
+ ;; C7 only deals with 32 bit immediates even if the
+ ;; destination is a 64-bit location. The value is
+ ;; sign-extended in this case.
(maybe-emit-rex-for-ea segment dst nil)
- (cond ((typep src '(or (signed-byte 32) (unsigned-byte 32)))
- (emit-byte segment
- (if (eq size :byte) #b11000110 #b11000111))
- (emit-ea segment dst #b000)
- (emit-sized-immediate segment
- (case size (:qword :dword) (t size))
- src))
- (t
- (aver nil))))
+ (emit-byte segment (if (eq size :byte) #b11000110 #b11000111))
+ (emit-ea segment dst #b000)
+ (emit-sized-immediate segment size src))
((register-p src)
(maybe-emit-rex-for-ea segment dst src)
(emit-byte segment (if (eq size :byte) #b10001000 #b10001001))
;; defaults to 64 bits. The size of the immediate is 32
;; bits and it is sign-extended.
(emit-byte segment #b01101000)
- (emit-dword segment src))))
+ (emit-signed-dword segment src))))
(t
(let ((size (operand-size src)))
- (aver (not (eq size :byte)))
+ (aver (or (eq size :qword) (eq size :word)))
(maybe-emit-operand-size-prefix segment size)
(maybe-emit-rex-for-ea segment src nil :operand-size :do-not-set)
(cond ((register-p src)
(:printer rex-reg/mem-default-qword ((op '(#b10001111 #b000))))
(:emitter
(let ((size (operand-size dst)))
- (aver (not (eq size :byte)))
+ (aver (or (eq size :qword) (eq size :word)))
(maybe-emit-operand-size-prefix segment size)
(maybe-emit-rex-for-ea segment dst nil :operand-size :do-not-set)
(cond ((register-p dst)
(:printer-list (arith-inst-printer-list #b111))
(:emitter (emit-random-arith-inst "CMP" segment dst src #b111 t)))
+;;; The one-byte encodings for INC and DEC are used as REX prefixes
+;;; in 64-bit mode so we always use the two-byte form.
(define-instruction inc (segment dst)
- ;; Register
- (:printer modrm-reg-no-width ((modrm-reg #b000)))
- ;; Register/Memory
- ;; (:printer rex-reg/mem ((op '(#b11111111 #b001))))
(:printer reg/mem ((op '(#b1111111 #b000))))
+ (:printer rex-reg/mem ((op '(#b1111111 #b000))))
(:emitter
(let ((size (operand-size dst)))
(maybe-emit-operand-size-prefix segment size)
- (cond #+nil ; these opcodes become REX prefixes in x86-64
- ((and (not (eq size :byte)) (register-p dst))
- (emit-byte-with-reg segment #b01000 (reg-tn-encoding dst)))
- (t
- (maybe-emit-rex-for-ea segment dst nil)
- (emit-byte segment (if (eq size :byte) #b11111110 #b11111111))
- (emit-ea segment dst #b000))))))
+ (maybe-emit-rex-for-ea segment dst nil)
+ (emit-byte segment (if (eq size :byte) #b11111110 #b11111111))
+ (emit-ea segment dst #b000))))
(define-instruction dec (segment dst)
- ;; Register.
- (:printer modrm-reg-no-width ((modrm-reg #b001)))
- ;; Register/Memory
(:printer reg/mem ((op '(#b1111111 #b001))))
+ (:printer rex-reg/mem ((op '(#b1111111 #b001))))
(:emitter
(let ((size (operand-size dst)))
(maybe-emit-operand-size-prefix segment size)
- (cond #+nil
- ((and (not (eq size :byte)) (register-p dst))
- (emit-byte-with-reg segment #b01001 (reg-tn-encoding dst)))
- (t
- (maybe-emit-rex-for-ea segment dst nil)
- (emit-byte segment (if (eq size :byte) #b11111110 #b11111111))
- (emit-ea segment dst #b001))))))
+ (maybe-emit-rex-for-ea segment dst nil)
+ (emit-byte segment (if (eq size :byte) #b11111110 #b11111111))
+ (emit-ea segment dst #b001))))
(define-instruction neg (segment dst)
(:printer reg/mem ((op '(#b1111011 #b011))))
(emit-back-patch segment
4
(lambda (segment posn)
- (emit-dword segment
- (- (label-position where)
- (+ posn 4))))))
+ (emit-signed-dword segment
+ (- (label-position where)
+ (+ posn 4))))))
(fixup
(emit-byte segment #b11101000)
(emit-relative-fixup segment where))
(:printer near-cond-jump () '('j cc :tab label))
;; unconditional jumps
(:printer short-jump ((op #b1011)))
- (:printer near-jump ((op #b11101001)) )
+ (:printer near-jump ((op #b11101001)))
(:printer reg/mem-default-qword ((op '(#b11111111 #b100))))
(:printer rex-reg/mem-default-qword ((op '(#b11111111 #b100))))
(:emitter
(dpb (conditional-opcode cond)
(byte 4 0)
#b10000000))
- (emit-dword segment disp)))))
+ (emit-signed-dword segment disp)))))
((label-p (setq where cond))
(emit-chooser
segment 5 0
(lambda (segment posn)
(let ((disp (- (label-position where) (+ posn 5))))
(emit-byte segment #b11101001)
- (emit-dword segment disp)))))
+ (emit-signed-dword segment disp)))))
((fixup-p where)
(emit-byte segment #b11101001)
(emit-relative-fixup segment where))
(t
(unless (or (ea-p where) (tn-p where))
- (error "don't know what to do with ~A" where))
+ (error "don't know what to do with ~A" where))
;; near jump defaults to 64 bit
;; w-bit in rex prefix is unnecessary
(maybe-emit-rex-for-ea segment where nil :operand-size :do-not-set)
(:emitter
(aver (register-p dst))
(let ((size (matching-operand-size dst src)))
- (aver (or (eq size :word) (eq size :dword) (eq size :qword) ))
+ (aver (or (eq size :word) (eq size :dword) (eq size :qword)))
(maybe-emit-operand-size-prefix segment size))
(maybe-emit-rex-for-ea segment src dst)
(emit-byte segment #b00001111)
(#.halt-trap
(nt "halt trap"))
(#.fun-end-breakpoint-trap
- (nt "function end breakpoint trap")))))
+ (nt "function end breakpoint trap"))
+ (#.single-step-around-trap
+ (nt "single-step trap (around)"))
+ (#.single-step-before-trap
+ (nt "single-step trap (before)")))))
(define-instruction break (segment code)
(:declare (type (unsigned-byte 8) code))
(emit-byte segment #b11001101)
(emit-byte segment number)))))
-(define-instruction into (segment)
- (:printer byte ((op #b11001110)))
- (:emitter
- (emit-byte segment #b11001110)))
-
-(define-instruction bound (segment reg bounds)
- (:emitter
- (let ((size (matching-operand-size reg bounds)))
- (when (eq size :byte)
- (error "can't bounds-test bytes: ~S" reg))
- (maybe-emit-operand-size-prefix segment size)
- (maybe-emit-rex-for-ea segment bounds reg)
- (emit-byte segment #b01100010)
- (emit-ea segment bounds (reg-tn-encoding reg)))))
-
(define-instruction iret (segment)
(:printer byte ((op #b11001111)))
(:emitter
(:emitter
(emit-header-data segment return-pc-header-widetag)))
\f
-;;;; fp instructions
-;;;;
-;;;; Note: We treat the single-precision and double-precision variants
-;;;; as separate instructions.
-
-;;; Load single to st(0).
-(define-instruction fld (segment source)
- (:printer floating-point ((op '(#b001 #b000))))
- (:emitter
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011001)
- (emit-fp-op segment source #b000)))
-
-;;; Load double to st(0).
-(define-instruction fldd (segment source)
- (:printer floating-point ((op '(#b101 #b000))))
- (:printer floating-point-fp ((op '(#b001 #b000))))
- (:emitter
- (if (fp-reg-tn-p source)
- (emit-byte segment #b11011001)
- (progn
- (maybe-emit-rex-for-ea segment source nil)
- (emit-byte segment #b11011101)))
- (emit-fp-op segment source #b000)))
-
-;;; Load long to st(0).
-(define-instruction fldl (segment source)
- (:printer floating-point ((op '(#b011 #b101))))
- (:emitter
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011011)
- (emit-fp-op segment source #b101)))
-
-;;; Store single from st(0).
-(define-instruction fst (segment dest)
- (:printer floating-point ((op '(#b001 #b010))))
- (:emitter
- (cond ((fp-reg-tn-p dest)
- (emit-byte segment #b11011101)
- (emit-fp-op segment dest #b010))
- (t
- (maybe-emit-rex-for-ea segment dest nil)
- (emit-byte segment #b11011001)
- (emit-fp-op segment dest #b010)))))
-
-;;; Store double from st(0).
-(define-instruction fstd (segment dest)
- (:printer floating-point ((op '(#b101 #b010))))
- (:printer floating-point-fp ((op '(#b101 #b010))))
- (:emitter
- (cond ((fp-reg-tn-p dest)
- (emit-byte segment #b11011101)
- (emit-fp-op segment dest #b010))
- (t
- (maybe-emit-rex-for-ea segment dest nil)
- (emit-byte segment #b11011101)
- (emit-fp-op segment dest #b010)))))
-
-;;; Arithmetic ops are all done with at least one operand at top of
-;;; stack. The other operand is is another register or a 32/64 bit
-;;; memory loc.
-
-;;; dtc: I've tried to follow the Intel ASM386 conventions, but note
-;;; that these conflict with the Gdb conventions for binops. To reduce
-;;; the confusion I've added comments showing the mathamatical
-;;; operation and the two syntaxes. By the ASM386 convention the
-;;; instruction syntax is:
-;;;
-;;; Fop Source
-;;; or Fop Destination, Source
-;;;
-;;; If only one operand is given then it is the source and the
-;;; destination is ST(0). There are reversed forms of the fsub and
-;;; fdiv instructions inducated by an 'R' suffix.
-;;;
-;;; The mathematical operation for the non-reverse form is always:
-;;; destination = destination op source
-;;;
-;;; For the reversed form it is:
-;;; destination = source op destination
-;;;
-;;; The instructions below only accept one operand at present which is
-;;; usually the source. I've hack in extra instructions to implement
-;;; the fops with a ST(i) destination, these have a -sti suffix and
-;;; the operand is the destination with the source being ST(0).
-
-;;; Add single:
-;;; st(0) = st(0) + memory or st(i).
-(define-instruction fadd (segment source)
- (:printer floating-point ((op '(#b000 #b000))))
- (:emitter
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011000)
- (emit-fp-op segment source #b000)))
-
-;;; Add double:
-;;; st(0) = st(0) + memory or st(i).
-(define-instruction faddd (segment source)
- (:printer floating-point ((op '(#b100 #b000))))
- (:printer floating-point-fp ((op '(#b000 #b000))))
- (:emitter
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (if (fp-reg-tn-p source)
- (emit-byte segment #b11011000)
- (emit-byte segment #b11011100))
- (emit-fp-op segment source #b000)))
-
-;;; Add double destination st(i):
-;;; st(i) = st(0) + st(i).
-(define-instruction fadd-sti (segment destination)
- (:printer floating-point-fp ((op '(#b100 #b000))))
- (:emitter
- (aver (fp-reg-tn-p destination))
- (emit-byte segment #b11011100)
- (emit-fp-op segment destination #b000)))
-;;; with pop
-(define-instruction faddp-sti (segment destination)
- (:printer floating-point-fp ((op '(#b110 #b000))))
- (:emitter
- (aver (fp-reg-tn-p destination))
- (emit-byte segment #b11011110)
- (emit-fp-op segment destination #b000)))
-
-;;; Subtract single:
-;;; st(0) = st(0) - memory or st(i).
-(define-instruction fsub (segment source)
- (:printer floating-point ((op '(#b000 #b100))))
- (:emitter
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011000)
- (emit-fp-op segment source #b100)))
-
-;;; Subtract single, reverse:
-;;; st(0) = memory or st(i) - st(0).
-(define-instruction fsubr (segment source)
- (:printer floating-point ((op '(#b000 #b101))))
- (:emitter
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011000)
- (emit-fp-op segment source #b101)))
-
-;;; Subtract double:
-;;; st(0) = st(0) - memory or st(i).
-(define-instruction fsubd (segment source)
- (:printer floating-point ((op '(#b100 #b100))))
- (:printer floating-point-fp ((op '(#b000 #b100))))
- (:emitter
- (if (fp-reg-tn-p source)
- (emit-byte segment #b11011000)
- (progn
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011100)))
- (emit-fp-op segment source #b100)))
-
-;;; Subtract double, reverse:
-;;; st(0) = memory or st(i) - st(0).
-(define-instruction fsubrd (segment source)
- (:printer floating-point ((op '(#b100 #b101))))
- (:printer floating-point-fp ((op '(#b000 #b101))))
- (:emitter
- (if (fp-reg-tn-p source)
- (emit-byte segment #b11011000)
- (progn
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011100)))
- (emit-fp-op segment source #b101)))
-
-;;; Subtract double, destination st(i):
-;;; st(i) = st(i) - st(0).
-;;;
-;;; ASM386 syntax: FSUB ST(i), ST
-;;; Gdb syntax: fsubr %st,%st(i)
-(define-instruction fsub-sti (segment destination)
- (:printer floating-point-fp ((op '(#b100 #b101))))
- (:emitter
- (aver (fp-reg-tn-p destination))
- (emit-byte segment #b11011100)
- (emit-fp-op segment destination #b101)))
-;;; with a pop
-(define-instruction fsubp-sti (segment destination)
- (:printer floating-point-fp ((op '(#b110 #b101))))
- (:emitter
- (aver (fp-reg-tn-p destination))
- (emit-byte segment #b11011110)
- (emit-fp-op segment destination #b101)))
-
-;;; Subtract double, reverse, destination st(i):
-;;; st(i) = st(0) - st(i).
-;;;
-;;; ASM386 syntax: FSUBR ST(i), ST
-;;; Gdb syntax: fsub %st,%st(i)
-(define-instruction fsubr-sti (segment destination)
- (:printer floating-point-fp ((op '(#b100 #b100))))
- (:emitter
- (aver (fp-reg-tn-p destination))
- (emit-byte segment #b11011100)
- (emit-fp-op segment destination #b100)))
-;;; with a pop
-(define-instruction fsubrp-sti (segment destination)
- (:printer floating-point-fp ((op '(#b110 #b100))))
- (:emitter
- (aver (fp-reg-tn-p destination))
- (emit-byte segment #b11011110)
- (emit-fp-op segment destination #b100)))
-
-;;; Multiply single:
-;;; st(0) = st(0) * memory or st(i).
-(define-instruction fmul (segment source)
- (:printer floating-point ((op '(#b000 #b001))))
- (:emitter
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011000)
- (emit-fp-op segment source #b001)))
-
-;;; Multiply double:
-;;; st(0) = st(0) * memory or st(i).
-(define-instruction fmuld (segment source)
- (:printer floating-point ((op '(#b100 #b001))))
- (:printer floating-point-fp ((op '(#b000 #b001))))
- (:emitter
- (if (fp-reg-tn-p source)
- (emit-byte segment #b11011000)
- (progn
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011100)))
- (emit-fp-op segment source #b001)))
-
-;;; Multiply double, destination st(i):
-;;; st(i) = st(i) * st(0).
-(define-instruction fmul-sti (segment destination)
- (:printer floating-point-fp ((op '(#b100 #b001))))
- (:emitter
- (aver (fp-reg-tn-p destination))
- (emit-byte segment #b11011100)
- (emit-fp-op segment destination #b001)))
-
-;;; Divide single:
-;;; st(0) = st(0) / memory or st(i).
-(define-instruction fdiv (segment source)
- (:printer floating-point ((op '(#b000 #b110))))
- (:emitter
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011000)
- (emit-fp-op segment source #b110)))
-
-;;; Divide single, reverse:
-;;; st(0) = memory or st(i) / st(0).
-(define-instruction fdivr (segment source)
- (:printer floating-point ((op '(#b000 #b111))))
- (:emitter
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011000)
- (emit-fp-op segment source #b111)))
-
-;;; Divide double:
-;;; st(0) = st(0) / memory or st(i).
-(define-instruction fdivd (segment source)
- (:printer floating-point ((op '(#b100 #b110))))
- (:printer floating-point-fp ((op '(#b000 #b110))))
- (:emitter
- (if (fp-reg-tn-p source)
- (emit-byte segment #b11011000)
- (progn
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011100)))
- (emit-fp-op segment source #b110)))
-
-;;; Divide double, reverse:
-;;; st(0) = memory or st(i) / st(0).
-(define-instruction fdivrd (segment source)
- (:printer floating-point ((op '(#b100 #b111))))
- (:printer floating-point-fp ((op '(#b000 #b111))))
- (:emitter
- (if (fp-reg-tn-p source)
- (emit-byte segment #b11011000)
- (progn
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011100)))
- (emit-fp-op segment source #b111)))
-
-;;; Divide double, destination st(i):
-;;; st(i) = st(i) / st(0).
-;;;
-;;; ASM386 syntax: FDIV ST(i), ST
-;;; Gdb syntax: fdivr %st,%st(i)
-(define-instruction fdiv-sti (segment destination)
- (:printer floating-point-fp ((op '(#b100 #b111))))
- (:emitter
- (aver (fp-reg-tn-p destination))
- (emit-byte segment #b11011100)
- (emit-fp-op segment destination #b111)))
-
-;;; Divide double, reverse, destination st(i):
-;;; st(i) = st(0) / st(i).
-;;;
-;;; ASM386 syntax: FDIVR ST(i), ST
-;;; Gdb syntax: fdiv %st,%st(i)
-(define-instruction fdivr-sti (segment destination)
- (:printer floating-point-fp ((op '(#b100 #b110))))
- (:emitter
- (aver (fp-reg-tn-p destination))
- (emit-byte segment #b11011100)
- (emit-fp-op segment destination #b110)))
-
-;;; Exchange fr0 with fr(n). (There is no double precision variant.)
-(define-instruction fxch (segment source)
- (:printer floating-point-fp ((op '(#b001 #b001))))
- (:emitter
- (unless (and (tn-p source)
- (eq (sb-name (sc-sb (tn-sc source))) 'float-registers))
- (cl:break))
- (emit-byte segment #b11011001)
- (emit-fp-op segment source #b001)))
-
-;;; Push 32-bit integer to st0.
-(define-instruction fild (segment source)
- (:printer floating-point ((op '(#b011 #b000))))
- (:emitter
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011011)
- (emit-fp-op segment source #b000)))
-
-;;; Push 64-bit integer to st0.
-(define-instruction fildl (segment source)
- (:printer floating-point ((op '(#b111 #b101))))
- (:emitter
- (and (not (fp-reg-tn-p source))
- (maybe-emit-rex-for-ea segment source nil))
- (emit-byte segment #b11011111)
- (emit-fp-op segment source #b101)))
-
-;;; Store 32-bit integer.
-(define-instruction fist (segment dest)
- (:printer floating-point ((op '(#b011 #b010))))
- (:emitter
- (and (not (fp-reg-tn-p dest))
- (maybe-emit-rex-for-ea segment dest nil))
- (emit-byte segment #b11011011)
- (emit-fp-op segment dest #b010)))
-
-;;; Store and pop 32-bit integer.
-(define-instruction fistp (segment dest)
- (:printer floating-point ((op '(#b011 #b011))))
- (:emitter
- (and (not (fp-reg-tn-p dest))
- (maybe-emit-rex-for-ea segment dest nil))
- (emit-byte segment #b11011011)
- (emit-fp-op segment dest #b011)))
-
-;;; Store and pop 64-bit integer.
-(define-instruction fistpl (segment dest)
- (:printer floating-point ((op '(#b111 #b111))))
- (:emitter
- (and (not (fp-reg-tn-p dest))
- (maybe-emit-rex-for-ea segment dest nil))
- (emit-byte segment #b11011111)
- (emit-fp-op segment dest #b111)))
-
-;;; Store single from st(0) and pop.
-(define-instruction fstp (segment dest)
- (:printer floating-point ((op '(#b001 #b011))))
- (:emitter
- (cond ((fp-reg-tn-p dest)
- (emit-byte segment #b11011101)
- (emit-fp-op segment dest #b011))
- (t
- (maybe-emit-rex-for-ea segment dest nil)
- (emit-byte segment #b11011001)
- (emit-fp-op segment dest #b011)))))
-
-;;; Store double from st(0) and pop.
-(define-instruction fstpd (segment dest)
- (:printer floating-point ((op '(#b101 #b011))))
- (:printer floating-point-fp ((op '(#b101 #b011))))
- (:emitter
- (cond ((fp-reg-tn-p dest)
- (emit-byte segment #b11011101)
- (emit-fp-op segment dest #b011))
- (t
- (maybe-emit-rex-for-ea segment dest nil)
- (emit-byte segment #b11011101)
- (emit-fp-op segment dest #b011)))))
-
-;;; Store long from st(0) and pop.
-(define-instruction fstpl (segment dest)
- (:printer floating-point ((op '(#b011 #b111))))
- (:emitter
- (and (not (fp-reg-tn-p dest))
- (maybe-emit-rex-for-ea segment dest nil))
- (emit-byte segment #b11011011)
- (emit-fp-op segment dest #b111)))
-
-;;; Decrement stack-top pointer.
-(define-instruction fdecstp (segment)
- (:printer floating-point-no ((op #b10110)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11110110)))
-
-;;; Increment stack-top pointer.
-(define-instruction fincstp (segment)
- (:printer floating-point-no ((op #b10111)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11110111)))
-
-;;; Free fp register.
-(define-instruction ffree (segment dest)
- (:printer floating-point-fp ((op '(#b101 #b000))))
- (:emitter
- (and (not (fp-reg-tn-p dest))
- (maybe-emit-rex-for-ea segment dest nil))
- (emit-byte segment #b11011101)
- (emit-fp-op segment dest #b000)))
-
-(define-instruction fabs (segment)
- (:printer floating-point-no ((op #b00001)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11100001)))
-
-(define-instruction fchs (segment)
- (:printer floating-point-no ((op #b00000)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11100000)))
-
-(define-instruction frndint(segment)
- (:printer floating-point-no ((op #b11100)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11111100)))
-
-;;; Initialize NPX.
-(define-instruction fninit(segment)
- (:printer floating-point-5 ((op #b00011)))
- (:emitter
- (emit-byte segment #b11011011)
- (emit-byte segment #b11100011)))
-
-;;; Store Status Word to AX.
-(define-instruction fnstsw(segment)
- (:printer floating-point-st ((op #b00000)))
- (:emitter
- (emit-byte segment #b11011111)
- (emit-byte segment #b11100000)))
-
-;;; Load Control Word.
-;;;
-;;; src must be a memory location
-(define-instruction fldcw(segment src)
- (:printer floating-point ((op '(#b001 #b101))))
- (:emitter
- (and (not (fp-reg-tn-p src))
- (maybe-emit-rex-for-ea segment src nil))
- (emit-byte segment #b11011001)
- (emit-fp-op segment src #b101)))
-
-;;; Store Control Word.
-(define-instruction fnstcw(segment dst)
- (:printer floating-point ((op '(#b001 #b111))))
- (:emitter
- (and (not (fp-reg-tn-p dst))
- (maybe-emit-rex-for-ea segment dst nil))
- (emit-byte segment #b11011001)
- (emit-fp-op segment dst #b111)))
-
-;;; Store FP Environment.
-(define-instruction fstenv(segment dst)
- (:printer floating-point ((op '(#b001 #b110))))
- (:emitter
- (and (not (fp-reg-tn-p dst))
- (maybe-emit-rex-for-ea segment dst nil))
- (emit-byte segment #b11011001)
- (emit-fp-op segment dst #b110)))
-
-;;; Restore FP Environment.
-(define-instruction fldenv(segment src)
- (:printer floating-point ((op '(#b001 #b100))))
- (:emitter
- (and (not (fp-reg-tn-p src))
- (maybe-emit-rex-for-ea segment src nil))
- (emit-byte segment #b11011001)
- (emit-fp-op segment src #b100)))
-
-;;; Save FP State.
-(define-instruction fsave(segment dst)
- (:printer floating-point ((op '(#b101 #b110))))
- (:emitter
- (and (not (fp-reg-tn-p dst))
- (maybe-emit-rex-for-ea segment dst nil))
- (emit-byte segment #b11011101)
- (emit-fp-op segment dst #b110)))
-
-;;; Restore FP State.
-(define-instruction frstor(segment src)
- (:printer floating-point ((op '(#b101 #b100))))
- (:emitter
- (and (not (fp-reg-tn-p src))
- (maybe-emit-rex-for-ea segment src nil))
- (emit-byte segment #b11011101)
- (emit-fp-op segment src #b100)))
-
-;;; Clear exceptions.
-(define-instruction fnclex(segment)
- (:printer floating-point-5 ((op #b00010)))
- (:emitter
- (emit-byte segment #b11011011)
- (emit-byte segment #b11100010)))
-
-;;; comparison
-(define-instruction fcom (segment src)
- (:printer floating-point ((op '(#b000 #b010))))
- (:emitter
- (and (not (fp-reg-tn-p src))
- (maybe-emit-rex-for-ea segment src nil))
- (emit-byte segment #b11011000)
- (emit-fp-op segment src #b010)))
-
-(define-instruction fcomd (segment src)
- (:printer floating-point ((op '(#b100 #b010))))
- (:printer floating-point-fp ((op '(#b000 #b010))))
- (:emitter
- (if (fp-reg-tn-p src)
- (emit-byte segment #b11011000)
- (progn
- (maybe-emit-rex-for-ea segment src nil)
- (emit-byte segment #b11011100)))
- (emit-fp-op segment src #b010)))
-
-;;; Compare ST1 to ST0, popping the stack twice.
-(define-instruction fcompp (segment)
- (:printer floating-point-3 ((op '(#b110 #b011001))))
- (:emitter
- (emit-byte segment #b11011110)
- (emit-byte segment #b11011001)))
-
-;;; unordered comparison
-(define-instruction fucom (segment src)
- (:printer floating-point-fp ((op '(#b101 #b100))))
- (:emitter
- (aver (fp-reg-tn-p src))
- (emit-byte segment #b11011101)
- (emit-fp-op segment src #b100)))
-
-(define-instruction ftst (segment)
- (:printer floating-point-no ((op #b00100)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11100100)))
-
-;;;; 80387 specials
-
-(define-instruction fsqrt(segment)
- (:printer floating-point-no ((op #b11010)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11111010)))
-
-(define-instruction fscale(segment)
- (:printer floating-point-no ((op #b11101)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11111101)))
-
-(define-instruction fxtract(segment)
- (:printer floating-point-no ((op #b10100)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11110100)))
-
-(define-instruction fsin(segment)
- (:printer floating-point-no ((op #b11110)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11111110)))
-
-(define-instruction fcos(segment)
- (:printer floating-point-no ((op #b11111)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11111111)))
-
-(define-instruction fprem1(segment)
- (:printer floating-point-no ((op #b10101)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11110101)))
-
-(define-instruction fprem(segment)
- (:printer floating-point-no ((op #b11000)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11111000)))
-
-(define-instruction fxam (segment)
- (:printer floating-point-no ((op #b00101)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11100101)))
-
-;;; These do push/pop to stack and need special handling
-;;; in any VOPs that use them. See the book.
-
-;;; st0 <- st1*log2(st0)
-(define-instruction fyl2x(segment) ; pops stack
- (:printer floating-point-no ((op #b10001)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11110001)))
-
-(define-instruction fyl2xp1(segment)
- (:printer floating-point-no ((op #b11001)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11111001)))
-
-(define-instruction f2xm1(segment)
- (:printer floating-point-no ((op #b10000)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11110000)))
-
-(define-instruction fptan(segment) ; st(0) <- 1; st(1) <- tan
- (:printer floating-point-no ((op #b10010)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11110010)))
-
-(define-instruction fpatan(segment) ; POPS STACK
- (:printer floating-point-no ((op #b10011)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11110011)))
-
-;;;; loading constants
-
-(define-instruction fldz(segment)
- (:printer floating-point-no ((op #b01110)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11101110)))
-
-(define-instruction fld1(segment)
- (:printer floating-point-no ((op #b01000)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11101000)))
-
-(define-instruction fldpi(segment)
- (:printer floating-point-no ((op #b01011)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11101011)))
-
-(define-instruction fldl2t(segment)
- (:printer floating-point-no ((op #b01001)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11101001)))
-
-(define-instruction fldl2e(segment)
- (:printer floating-point-no ((op #b01010)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11101010)))
-
-(define-instruction fldlg2(segment)
- (:printer floating-point-no ((op #b01100)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11101100)))
-
-(define-instruction fldln2(segment)
- (:printer floating-point-no ((op #b01101)))
- (:emitter
- (emit-byte segment #b11011001)
- (emit-byte segment #b11101101)))
-
;;;; Instructions required to do floating point operations using SSE
(defun emit-sse-inst (segment dst src prefix opcode &key operand-size)
(define-regular-sse-inst mulss #xf3 #x59)
(define-regular-sse-inst subsd #xf2 #x5c)
(define-regular-sse-inst subss #xf3 #x5c)
+ (define-regular-sse-inst sqrtsd #xf2 #x51)
+ (define-regular-sse-inst sqrtss #xf3 #x51)
;; conversion
(define-regular-sse-inst cvtsd2ss #xf2 #x5a)
(define-regular-sse-inst cvtss2sd #xf3 #x5a)
projects / sbcl.git / blobdiff