(print-xmmreg value stream dstate)
(print-mem-access value nil stream dstate)))
-;; Same as print-xmmreg/mem, but prints an explicit size indicator for
-;; memory references.
-(defun print-sized-xmmreg/mem (value stream dstate)
- (declare (type (or list xmmreg) value)
- (type stream stream)
- (type sb!disassem:disassem-state dstate))
- (if (typep value 'xmmreg)
- (print-xmmreg value stream dstate)
- (print-mem-access value (inst-operand-size dstate) stream dstate)))
-
;;; This prefilter is used solely for its side effects, namely to put
;;; the bits found in the REX prefix into the DSTATE for use by other
;;; prefilters and by printers.
:prefilter #'prefilter-reg/mem
:printer #'print-xmmreg/mem)
-(sb!disassem:define-arg-type sized-xmmreg/mem
- :prefilter #'prefilter-reg/mem
- :printer #'print-sized-xmmreg/mem)
-
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *conditions*
(reg :field (byte 3 35) :type 'xmmreg)
(imm))
+(sb!disassem:define-instruction-format (ext-2byte-xmm-xmm/mem 40
+ :default-printer
+ '(:name :tab reg ", " reg/mem))
+ (prefix :field (byte 8 0))
+ (x0f :field (byte 8 8) :value #x0f)
+ (op1 :field (byte 8 16)) ; #x38 or #x3a
+ (op2 :field (byte 8 24))
+ (reg/mem :fields (list (byte 2 38) (byte 3 32))
+ :type 'xmmreg/mem)
+ (reg :field (byte 3 35) :type 'xmmreg))
+
+(sb!disassem:define-instruction-format (ext-rex-2byte-xmm-xmm/mem 48
+ :default-printer
+ '(:name :tab reg ", " reg/mem))
+ (prefix :field (byte 8 0))
+ (rex :field (byte 4 12) :value #b0100)
+ (wrxb :field (byte 4 8) :type 'wrxb)
+ (x0f :field (byte 8 16) :value #x0f)
+ (op1 :field (byte 8 24)) ; #x38 or #x3a
+ (op2 :field (byte 8 32))
+ (reg/mem :fields (list (byte 2 46) (byte 3 40))
+ :type 'xmmreg/mem)
+ (reg :field (byte 3 43) :type 'xmmreg))
+
;;; Same as xmm-xmm/mem etc., but with direction bit.
(sb!disassem:define-instruction-format (ext-xmm-xmm/mem-dir 32
(x0f :field (byte 8 0) :value #x0f)
(op :field (byte 8 8))
(reg/mem :fields (list (byte 2 22) (byte 3 16))
- :type 'sized-xmmreg/mem)
+ :type 'xmmreg/mem)
(reg :field (byte 3 19) :type 'reg))
(sb!disassem:define-instruction-format (ext-reg-xmm/mem 32
(x0f :field (byte 8 8) :value #x0f)
(op :field (byte 8 16))
(reg/mem :fields (list (byte 2 30) (byte 3 24))
- :type 'sized-xmmreg/mem)
+ :type 'xmmreg/mem)
(reg :field (byte 3 27) :type 'reg))
(sb!disassem:define-instruction-format (ext-rex-reg-xmm/mem 40
(x0f :field (byte 8 16) :value #x0f)
(op :field (byte 8 24))
(reg/mem :fields (list (byte 2 38) (byte 3 32))
- :type 'sized-xmmreg/mem)
+ :type 'xmmreg/mem)
(reg :field (byte 3 35) :type 'reg))
;; XMM comparison instruction
(t
(error "bogus arguments to MOV: ~S ~S" dst src))))))
+;;; Emit a sign-extending (if SIGNED-P is true) or zero-extending move.
+;;; To achieve the shortest possible encoding zero extensions into a
+;;; 64-bit destination are assembled as a straight 32-bit MOV (if the
+;;; source size is 32 bits) or as MOVZX with a 32-bit destination (if
+;;; the source size is 8 or 16 bits). Due to the implicit zero extension
+;;; to 64 bits this has the same effect as a MOVZX with 64-bit
+;;; destination but often needs no REX prefix.
(defun emit-move-with-extension (segment dst src signed-p)
(aver (register-p dst))
(let ((dst-size (operand-size dst))
(src-size (operand-size src))
- (opcode (if signed-p #b10111110 #b10110110)))
- (ecase dst-size
- (:word
- (aver (eq src-size :byte))
- (maybe-emit-operand-size-prefix segment :word)
- ;; REX prefix is needed if SRC is SIL, DIL, SPL or BPL.
- (maybe-emit-rex-for-ea segment src dst :operand-size :word)
- (emit-byte segment #b00001111)
- (emit-byte segment opcode)
- (emit-ea segment src (reg-tn-encoding dst)))
- ((:dword :qword)
- (ecase src-size
- (:byte
- (maybe-emit-rex-for-ea segment src dst :operand-size dst-size)
- (emit-byte segment #b00001111)
- (emit-byte segment opcode)
- (emit-ea segment src (reg-tn-encoding dst)))
- (:word
- (maybe-emit-rex-for-ea segment src dst :operand-size dst-size)
- (emit-byte segment #b00001111)
- (emit-byte segment (logior opcode 1))
- (emit-ea segment src (reg-tn-encoding dst)))
- (:dword
- (aver (eq dst-size :qword))
- ;; dst is in reg, src is in modrm
- (let ((ea-p (ea-p src)))
- (maybe-emit-rex-prefix segment (if signed-p :qword :dword) dst
- (and ea-p (ea-index src))
- (cond (ea-p (ea-base src))
- ((tn-p src) src)
- (t nil)))
- (emit-byte segment (if signed-p #x63 #x8b)) ;movsxd or straight mov
- ;;(emit-byte segment opcode)
- (emit-ea segment src (reg-tn-encoding dst)))))))))
+ (opcode (if signed-p #b10111110 #b10110110)))
+ (macrolet ((emitter (operand-size &rest bytes)
+ `(progn
+ (maybe-emit-rex-for-ea segment src dst
+ :operand-size ,operand-size)
+ ,@(mapcar (lambda (byte)
+ `(emit-byte segment ,byte))
+ bytes)
+ (emit-ea segment src (reg-tn-encoding dst)))))
+ (ecase dst-size
+ (:word
+ (aver (eq src-size :byte))
+ (maybe-emit-operand-size-prefix segment :word)
+ (emitter :word #b00001111 opcode))
+ ((:dword :qword)
+ (unless signed-p
+ (setf dst-size :dword))
+ (ecase src-size
+ (:byte
+ (emitter dst-size #b00001111 opcode))
+ (:word
+ (emitter dst-size #b00001111 (logior opcode 1)))
+ (:dword
+ (aver (or (not signed-p) (eq dst-size :qword)))
+ (emitter dst-size
+ (if signed-p #x63 #x8b))))))))) ; movsxd or straight mov
(define-instruction movsx (segment dst src)
(:printer ext-reg-reg/mem-no-width
(define-instruction nop (segment)
(:printer byte ((op #b10010000)))
+ ;; multi-byte NOP
+ (:printer ext-reg/mem-no-width ((op '(#x1f 0))) '(:name))
(:emitter
(emit-byte segment #b10010000)))
+;;; Emit a sequence of single- or multi-byte NOPs to fill AMOUNT many
+;;; bytes with the smallest possible number of such instructions.
+(defun emit-long-nop (segment amount)
+ (declare (type segment segment)
+ (type index amount))
+ ;; Pack all instructions into one byte vector to save space.
+ (let* ((bytes #.(coerce #(#x90
+ #x66 #x90
+ #x0f #x1f #x00
+ #x0f #x1f #x40 #x00
+ #x0f #x1f #x44 #x00 #x00
+ #x66 #x0f #x1f #x44 #x00 #x00
+ #x0f #x1f #x80 #x00 #x00 #x00 #x00
+ #x0f #x1f #x84 #x00 #x00 #x00 #x00 #x00
+ #x66 #x0f #x1f #x84 #x00 #x00 #x00 #x00 #x00)
+ '(vector (unsigned-byte 8))))
+ (max-length (isqrt (* 2 (length bytes)))))
+ (loop
+ (let* ((count (min amount max-length))
+ (start (ash (* count (1- count)) -1)))
+ (dotimes (i count)
+ (emit-byte segment (aref bytes (+ start i)))))
+ (if (> amount max-length)
+ (decf amount max-length)
+ (return)))))
+
(define-instruction wait (segment)
(:printer byte ((op #b10011011)))
(:emitter
(mapcar (lambda (inst-format)
`(,inst-format ,fields ,@(when printer
(list printer))))
+ inst-formats)))
+ (defun 2byte-sse-inst-printer-list (inst-format-stem prefix op1 op2
+ &key more-fields printer)
+ (let ((fields `(,@(when prefix
+ `((prefix, prefix)))
+ (op1 ,op1)
+ (op2 ,op2)
+ ,@more-fields))
+ (inst-formats (if prefix
+ (list (symbolicate "EXT-" inst-format-stem)
+ (symbolicate "EXT-REX-" inst-format-stem))
+ (list inst-format-stem))))
+ (mapcar (lambda (inst-format)
+ `(,inst-format ,fields ,@(when printer
+ (list printer))))
inst-formats))))
(defun emit-sse-inst (segment dst src prefix opcode
(reg-tn-encoding dst/src)))
(emit-byte segment imm))
+(defun emit-sse-inst-2byte (segment dst src prefix op1 op2
+ &key operand-size (remaining-bytes 0))
+ (when prefix
+ (emit-byte segment prefix))
+ (if operand-size
+ (maybe-emit-rex-for-ea segment src dst :operand-size operand-size)
+ (maybe-emit-rex-for-ea segment src dst))
+ (emit-byte segment #x0f)
+ (emit-byte segment op1)
+ (emit-byte segment op2)
+ (emit-ea segment src (reg-tn-encoding dst) :remaining-bytes remaining-bytes))
+
(macrolet
((define-imm-sse-instruction (name opcode /i)
`(define-instruction ,name (segment dst/src imm)
:operand-size :do-not-set
:remaining-bytes remaining-bytes))
+(defun emit-regular-2byte-sse-inst (segment dst src prefix op1 op2
+ &key (remaining-bytes 0))
+ (aver (xmm-register-p dst))
+ (emit-sse-inst-2byte segment dst src prefix op1 op2
+ :operand-size :do-not-set
+ :remaining-bytes remaining-bytes))
+
;;; Instructions having an XMM register as the destination operand
;;; and an XMM register or a memory location as the source operand.
;;; The operand size is implicitly given by the instruction.
(define-gpr-destination-sse-inst movmskps nil #x50 :reg-only t)
(define-gpr-destination-sse-inst pmovmskb #x66 #xd7 :reg-only t))
+;;;; We call these "2byte" instructions due to their two opcode bytes.
+;;;; Intel and AMD call them three-byte instructions, as they count the
+;;;; 0x0f byte for determining the number of opcode bytes.
+
+;;; Instructions that take XMM-XMM/MEM and XMM-XMM/MEM-IMM arguments.
+
+(macrolet ((regular-2byte-sse-inst (name prefix op1 op2)
+ `(define-instruction ,name (segment dst src)
+ (:printer-list
+ ',(2byte-sse-inst-printer-list '2byte-xmm-xmm/mem prefix op1 op2))
+ (:emitter
+ (emit-regular-2byte-sse-inst segment dst src ,prefix ,op1 ,op2))))
+ (regular-2byte-sse-inst-imm (name prefix op1 op2)
+ `(define-instruction ,name (segment dst src imm)
+ (:printer-list
+ ',(2byte-sse-inst-printer-list '2byte-xmm-xmm/mem prefix op1 op2
+ :more-fields '((imm nil :type imm-byte))
+ :printer `(:name :tab reg ", " reg/mem ", " imm)))
+ (:emitter
+ (aver (typep imm '(unsigned-byte 8)))
+ (emit-regular-2byte-sse-inst segment dst src ,prefix ,op1 ,op2
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (regular-2byte-sse-inst pshufb #x66 #x38 #x00)
+ (regular-2byte-sse-inst phaddw #x66 #x38 #x01)
+ (regular-2byte-sse-inst phaddd #x66 #x38 #x02)
+ (regular-2byte-sse-inst phaddsw #x66 #x38 #x03)
+ (regular-2byte-sse-inst pmaddubsw #x66 #x38 #x04)
+ (regular-2byte-sse-inst phsubw #x66 #x38 #x05)
+ (regular-2byte-sse-inst phsubd #x66 #x38 #x06)
+ (regular-2byte-sse-inst phsubsw #x66 #x38 #x07)
+ (regular-2byte-sse-inst psignb #x66 #x38 #x08)
+ (regular-2byte-sse-inst psignw #x66 #x38 #x09)
+ (regular-2byte-sse-inst psignd #x66 #x38 #x0a)
+ (regular-2byte-sse-inst pmulhrsw #x66 #x38 #x0b)
+
+ (regular-2byte-sse-inst pblendvb #x66 #x38 #x10)
+ (regular-2byte-sse-inst blendvps #x66 #x38 #x14)
+ (regular-2byte-sse-inst blendvpd #x66 #x38 #x15)
+ (regular-2byte-sse-inst ptest #x66 #x38 #x17)
+ (regular-2byte-sse-inst pabsb #x66 #x38 #x1c)
+ (regular-2byte-sse-inst pabsw #x66 #x38 #x1d)
+ (regular-2byte-sse-inst pabsd #x66 #x38 #x1e)
+
+ (regular-2byte-sse-inst pmuldq #x66 #x38 #x28)
+ (regular-2byte-sse-inst pcmpeqq #x66 #x38 #x29)
+ (regular-2byte-sse-inst packusdw #x66 #x38 #x2b)
+
+ (regular-2byte-sse-inst pcmpgtq #x66 #x38 #x37)
+ (regular-2byte-sse-inst pminsb #x66 #x38 #x38)
+ (regular-2byte-sse-inst pminsd #x66 #x38 #x39)
+ (regular-2byte-sse-inst pminuw #x66 #x38 #x3a)
+ (regular-2byte-sse-inst pminud #x66 #x38 #x3b)
+ (regular-2byte-sse-inst pmaxsb #x66 #x38 #x3c)
+ (regular-2byte-sse-inst pmaxsd #x66 #x38 #x3d)
+ (regular-2byte-sse-inst pmaxuw #x66 #x38 #x3e)
+ (regular-2byte-sse-inst pmaxud #x66 #x38 #x3f)
+
+ (regular-2byte-sse-inst pmulld #x66 #x38 #x40)
+ (regular-2byte-sse-inst phminposuw #x66 #x38 #x41)
+
+ (regular-2byte-sse-inst aesimc #x66 #x38 #xdb)
+ (regular-2byte-sse-inst aesenc #x66 #x38 #xdc)
+ (regular-2byte-sse-inst aesenclast #x66 #x38 #xdd)
+ (regular-2byte-sse-inst aesdec #x66 #x38 #xde)
+ (regular-2byte-sse-inst aesdeclast #x66 #x38 #xdf)
+
+ (regular-2byte-sse-inst-imm roundps #x66 #x3a #x08)
+ (regular-2byte-sse-inst-imm roundpd #x66 #x3a #x09)
+ (regular-2byte-sse-inst-imm roundss #x66 #x3a #x0a)
+ (regular-2byte-sse-inst-imm roundsd #x66 #x3a #x0b)
+ (regular-2byte-sse-inst-imm blendps #x66 #x3a #x0c)
+ (regular-2byte-sse-inst-imm blendpd #x66 #x3a #x0d)
+ (regular-2byte-sse-inst-imm pblendw #x66 #x3a #x0e)
+ (regular-2byte-sse-inst-imm palignr #x66 #x3a #x0f)
+
+ (regular-2byte-sse-inst-imm mpsadbw #x66 #x3a #x42)
+ (regular-2byte-sse-inst-imm pclmulqdq #x66 #x3a #x44)
+
+ (regular-2byte-sse-inst-imm pcmpestrm #x66 #x3a #x60)
+ (regular-2byte-sse-inst-imm pcmpestri #x66 #x3a #x61)
+ (regular-2byte-sse-inst-imm pcmpistrm #x66 #x3a #x62)
+ (regular-2byte-sse-inst-imm pcmpistri #x66 #x3a #x63)
+
+ (regular-2byte-sse-inst-imm aeskeygenassist #x66 #x3a #xdf))
+
;;; Other SSE instructions
;; FIXME: is that right!?
(values label (make-ea size
:disp (make-fixup nil :code-object label)))))
-(defun emit-constant-segment-header (constants optimize)
+(defun emit-constant-segment-header (segment constants optimize)
(declare (ignore constants))
- (loop repeat (if optimize 64 16) do (inst byte #x90)))
+ (emit-long-nop segment (if optimize 64 16)))
(defun size-nbyte (size)
(ecase size
projects / sbcl.git / blobdiff