1 ;;;; that part of the description of the x86-64 instruction set
2 ;;;; which can live on the cross-compilation host
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
14 ;;; FIXME: SB!DISASSEM: prefixes are used so widely in this file that
15 ;;; I wonder whether the separation of the disassembler from the
16 ;;; virtual machine is valid or adds value.
18 ;;; Note: In CMU CL, this used to be a call to SET-DISASSEM-PARAMS.
19 (setf sb!disassem:*disassem-inst-alignment-bytes* 1)
21 ;;; This type is used mostly in disassembly and represents legacy
22 ;;; registers only. R8-R15 are handled separately.
23 (deftype reg () '(unsigned-byte 3))
25 ;;; This includes legacy registers and R8-R15.
26 (deftype full-reg () '(unsigned-byte 4))
28 ;;; Default word size for the chip: if the operand size /= :dword
29 ;;; we need to output #x66 (or REX) prefix
30 (def!constant +default-operand-size+ :dword)
32 ;;; The default address size for the chip. It could be overwritten
33 ;;; to :dword with a #x67 prefix, but this is never needed by SBCL
34 ;;; and thus not supported by this assembler/disassembler.
35 (def!constant +default-address-size+ :qword)
37 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
39 (defun offset-next (value dstate)
40 (declare (type integer value)
41 (type sb!disassem:disassem-state dstate))
42 (+ (sb!disassem:dstate-next-addr dstate) value))
44 (defparameter *byte-reg-names*
45 #(al cl dl bl spl bpl sil dil r8b r9b r10b r11b r12b r13b r14b r15b))
46 (defparameter *word-reg-names*
47 #(ax cx dx bx sp bp si di r8w r9w r10w r11w r12w r13w r14w r15w))
48 (defparameter *dword-reg-names*
49 #(eax ecx edx ebx esp ebp esi edi r8d r9d r10d r11d r12d r13d r14d r15d))
50 (defparameter *qword-reg-names*
51 #(rax rcx rdx rbx rsp rbp rsi rdi r8 r9 r10 r11 r12 r13 r14 r15))
53 ;;; The printers for registers, memory references and immediates need to
54 ;;; take into account the width bit in the instruction, whether a #x66
55 ;;; or a REX prefix was issued, and the contents of the REX prefix.
56 ;;; This is implemented using prefilters to put flags into the slot
57 ;;; INST-PROPERTIES of the DSTATE. These flags are the following
60 ;;; OPERAND-SIZE-8 The width bit was zero
61 ;;; OPERAND-SIZE-16 The "operand size override" prefix (#x66) was found
62 ;;; REX A REX prefix was found
63 ;;; REX-W A REX prefix with the "operand width" bit set was
65 ;;; REX-R A REX prefix with the "register" bit set was found
66 ;;; REX-X A REX prefix with the "index" bit set was found
67 ;;; REX-B A REX prefix with the "base" bit set was found
69 ;;; Return the operand size depending on the prefixes and width bit as
71 (defun inst-operand-size (dstate)
72 (declare (type sb!disassem:disassem-state dstate))
73 (cond ((sb!disassem:dstate-get-inst-prop dstate 'operand-size-8)
75 ((sb!disassem:dstate-get-inst-prop dstate 'rex-w)
77 ((sb!disassem:dstate-get-inst-prop dstate 'operand-size-16)
80 +default-operand-size+)))
82 ;;; The same as INST-OPERAND-SIZE, but for those instructions (e.g.
83 ;;; PUSH, JMP) that have a default operand size of :qword. It can only
84 ;;; be overwritten to :word.
85 (defun inst-operand-size-default-qword (dstate)
86 (declare (type sb!disassem:disassem-state dstate))
87 (if (sb!disassem:dstate-get-inst-prop dstate 'operand-size-16)
91 (defun print-reg-with-width (value width stream dstate)
92 (declare (type full-reg value)
95 (princ (aref (ecase width
96 (:byte *byte-reg-names*)
97 (:word *word-reg-names*)
98 (:dword *dword-reg-names*)
99 (:qword *qword-reg-names*))
102 ;; XXX plus should do some source-var notes
105 (defun print-reg (value stream dstate)
106 (declare (type full-reg value)
108 (type sb!disassem:disassem-state dstate))
109 (print-reg-with-width value
110 (inst-operand-size dstate)
114 (defun print-reg-default-qword (value stream dstate)
115 (declare (type full-reg value)
117 (type sb!disassem:disassem-state dstate))
118 (print-reg-with-width value
119 (inst-operand-size-default-qword dstate)
123 (defun print-byte-reg (value stream dstate)
124 (declare (type full-reg value)
126 (type sb!disassem:disassem-state dstate))
127 (print-reg-with-width value :byte stream dstate))
129 (defun print-addr-reg (value stream dstate)
130 (declare (type full-reg value)
132 (type sb!disassem:disassem-state dstate))
133 (print-reg-with-width value +default-address-size+ stream dstate))
135 ;;; Print a register or a memory reference of the given WIDTH.
136 ;;; If SIZED-P is true, add an explicit size indicator for memory
138 (defun print-reg/mem-with-width (value width sized-p stream dstate)
139 (declare (type (or list full-reg) value)
140 (type (member :byte :word :dword :qword) width)
141 (type boolean sized-p)
143 (type sb!disassem:disassem-state dstate))
144 (if (typep value 'full-reg)
145 (print-reg-with-width value width stream dstate)
146 (print-mem-access value (and sized-p width) stream dstate)))
148 ;;; Print a register or a memory reference. The width is determined by
149 ;;; calling INST-OPERAND-SIZE.
150 (defun print-reg/mem (value stream dstate)
151 (declare (type (or list full-reg) value)
153 (type sb!disassem:disassem-state dstate))
154 (print-reg/mem-with-width
155 value (inst-operand-size dstate) nil stream dstate))
157 ;; Same as print-reg/mem, but prints an explicit size indicator for
158 ;; memory references.
159 (defun print-sized-reg/mem (value stream dstate)
160 (declare (type (or list full-reg) value)
162 (type sb!disassem:disassem-state dstate))
163 (print-reg/mem-with-width
164 value (inst-operand-size dstate) t stream dstate))
166 ;;; Same as print-sized-reg/mem, but with a default operand size of
168 (defun print-sized-reg/mem-default-qword (value stream dstate)
169 (declare (type (or list full-reg) value)
171 (type sb!disassem:disassem-state dstate))
172 (print-reg/mem-with-width
173 value (inst-operand-size-default-qword dstate) t stream dstate))
175 (defun print-sized-byte-reg/mem (value stream dstate)
176 (declare (type (or list full-reg) value)
178 (type sb!disassem:disassem-state dstate))
179 (print-reg/mem-with-width value :byte t stream dstate))
181 (defun print-sized-word-reg/mem (value stream dstate)
182 (declare (type (or list full-reg) value)
184 (type sb!disassem:disassem-state dstate))
185 (print-reg/mem-with-width value :word t stream dstate))
187 (defun print-sized-dword-reg/mem (value stream dstate)
188 (declare (type (or list full-reg) value)
190 (type sb!disassem:disassem-state dstate))
191 (print-reg/mem-with-width value :dword t stream dstate))
193 (defun print-label (value stream dstate)
194 (declare (ignore dstate))
195 (sb!disassem:princ16 value stream))
197 ;;; This prefilter is used solely for its side effects, namely to put
198 ;;; the bits found in the REX prefix into the DSTATE for use by other
199 ;;; prefilters and by printers.
200 (defun prefilter-wrxb (value dstate)
201 (declare (type (unsigned-byte 4) value)
202 (type sb!disassem:disassem-state dstate))
203 (sb!disassem:dstate-put-inst-prop dstate 'rex)
204 (when (plusp (logand value #b1000))
205 (sb!disassem:dstate-put-inst-prop dstate 'rex-w))
206 (when (plusp (logand value #b0100))
207 (sb!disassem:dstate-put-inst-prop dstate 'rex-r))
208 (when (plusp (logand value #b0010))
209 (sb!disassem:dstate-put-inst-prop dstate 'rex-x))
210 (when (plusp (logand value #b0001))
211 (sb!disassem:dstate-put-inst-prop dstate 'rex-b))
214 ;;; This prefilter is used solely for its side effect, namely to put
215 ;;; the property OPERAND-SIZE-8 into the DSTATE if VALUE is 0.
216 (defun prefilter-width (value dstate)
217 (declare (type bit value)
218 (type sb!disassem:disassem-state dstate))
220 (sb!disassem:dstate-put-inst-prop dstate 'operand-size-8))
223 ;;; A register field that can be extended by REX.R.
224 (defun prefilter-reg-r (value dstate)
225 (declare (type reg value)
226 (type sb!disassem:disassem-state dstate))
227 (if (sb!disassem::dstate-get-inst-prop dstate 'rex-r)
231 ;;; A register field that can be extended by REX.B.
232 (defun prefilter-reg-b (value dstate)
233 (declare (type reg value)
234 (type sb!disassem:disassem-state dstate))
235 (if (sb!disassem::dstate-get-inst-prop dstate 'rex-b)
239 ;;; Returns either an integer, meaning a register, or a list of
240 ;;; (BASE-REG OFFSET INDEX-REG INDEX-SCALE), where any component
241 ;;; may be missing or nil to indicate that it's not used or has the
242 ;;; obvious default value (e.g., 1 for the index-scale). VALUE is a list
243 ;;; of the mod and r/m field of the ModRM byte of the instruction.
244 ;;; Depending on VALUE a SIB byte and/or an offset may be read. The
245 ;;; REX.B bit from DSTATE is used to extend the sole register or the
246 ;;; BASE-REG to a full register, the REX.X bit does the same for the
248 (defun prefilter-reg/mem (value dstate)
249 (declare (type list value)
250 (type sb!disassem:disassem-state dstate))
251 (let ((mod (first value))
252 (r/m (second value)))
253 (declare (type (unsigned-byte 2) mod)
254 (type (unsigned-byte 3) r/m))
255 (let ((full-reg (if (sb!disassem:dstate-get-inst-prop dstate 'rex-b)
258 (declare (type full-reg full-reg))
264 (let ((sib (sb!disassem:read-suffix 8 dstate)))
265 (declare (type (unsigned-byte 8) sib))
266 (let ((base-reg (ldb (byte 3 0) sib))
267 (index-reg (ldb (byte 3 3) sib))
268 (index-scale (ldb (byte 2 6) sib)))
269 (declare (type (unsigned-byte 3) base-reg index-reg)
270 (type (unsigned-byte 2) index-scale))
274 (if (= base-reg #b101)
275 (sb!disassem:read-signed-suffix 32 dstate)
278 (sb!disassem:read-signed-suffix 8 dstate))
280 (sb!disassem:read-signed-suffix 32 dstate)))))
281 (list (unless (and (= mod #b00) (= base-reg #b101))
282 (if (sb!disassem:dstate-get-inst-prop dstate 'rex-b)
286 (unless (= index-reg #b100)
287 (if (sb!disassem:dstate-get-inst-prop dstate 'rex-x)
290 (ash 1 index-scale))))))
291 ((and (= mod #b00) (= r/m #b101))
292 (list 'rip (sb!disassem:read-signed-suffix 32 dstate)) )
296 (list full-reg (sb!disassem:read-signed-suffix 8 dstate)))
298 (list full-reg (sb!disassem:read-signed-suffix 32 dstate)))))))
300 (defun read-address (value dstate)
301 (declare (ignore value)) ; always nil anyway
302 (sb!disassem:read-suffix (width-bits (inst-operand-size dstate)) dstate))
304 (defun width-bits (width)
315 ;;;; disassembler argument types
317 ;;; Used to capture the lower four bits of the REX prefix.
318 (sb!disassem:define-arg-type wrxb
319 :prefilter #'prefilter-wrxb)
321 (sb!disassem:define-arg-type width
322 :prefilter #'prefilter-width
323 :printer (lambda (value stream dstate)
324 (declare (ignore value))
325 (princ (schar (symbol-name (inst-operand-size dstate)) 0)
328 (sb!disassem:define-arg-type displacement
330 :use-label #'offset-next
331 :printer (lambda (value stream dstate)
332 (sb!disassem:maybe-note-assembler-routine value nil dstate)
333 (print-label value stream dstate)))
335 (sb!disassem:define-arg-type accum
336 :printer (lambda (value stream dstate)
337 (declare (ignore value)
339 (type sb!disassem:disassem-state dstate))
340 (print-reg 0 stream dstate)))
342 (sb!disassem:define-arg-type reg
343 :prefilter #'prefilter-reg-r
344 :printer #'print-reg)
346 (sb!disassem:define-arg-type reg-b
347 :prefilter #'prefilter-reg-b
348 :printer #'print-reg)
350 (sb!disassem:define-arg-type reg-b-default-qword
351 :prefilter #'prefilter-reg-b
352 :printer #'print-reg-default-qword)
354 (sb!disassem:define-arg-type imm-addr
355 :prefilter #'read-address
356 :printer #'print-label)
358 ;;; Normally, immediate values for an operand size of :qword are of size
359 ;;; :dword and are sign-extended to 64 bits. For an exception, see the
360 ;;; argument type definition following this one.
361 (sb!disassem:define-arg-type signed-imm-data
362 :prefilter (lambda (value dstate)
363 (declare (ignore value)) ; always nil anyway
364 (let ((width (width-bits (inst-operand-size dstate))))
367 (sb!disassem:read-signed-suffix width dstate))))
369 ;;; Used by the variant of the MOV instruction with opcode B8 which can
370 ;;; move immediates of all sizes (i.e. including :qword) into a
372 (sb!disassem:define-arg-type signed-imm-data-upto-qword
373 :prefilter (lambda (value dstate)
374 (declare (ignore value)) ; always nil anyway
375 (sb!disassem:read-signed-suffix
376 (width-bits (inst-operand-size dstate))
379 ;;; Used by those instructions that have a default operand size of
380 ;;; :qword. Nevertheless the immediate is at most of size :dword.
381 ;;; The only instruction of this kind having a variant with an immediate
382 ;;; argument is PUSH.
383 (sb!disassem:define-arg-type signed-imm-data-default-qword
384 :prefilter (lambda (value dstate)
385 (declare (ignore value)) ; always nil anyway
386 (let ((width (width-bits
387 (inst-operand-size-default-qword dstate))))
390 (sb!disassem:read-signed-suffix width dstate))))
392 (sb!disassem:define-arg-type signed-imm-byte
393 :prefilter (lambda (value dstate)
394 (declare (ignore value)) ; always nil anyway
395 (sb!disassem:read-signed-suffix 8 dstate)))
397 (sb!disassem:define-arg-type imm-byte
398 :prefilter (lambda (value dstate)
399 (declare (ignore value)) ; always nil anyway
400 (sb!disassem:read-suffix 8 dstate)))
402 ;;; needed for the ret imm16 instruction
403 (sb!disassem:define-arg-type imm-word-16
404 :prefilter (lambda (value dstate)
405 (declare (ignore value)) ; always nil anyway
406 (sb!disassem:read-suffix 16 dstate)))
408 (sb!disassem:define-arg-type reg/mem
409 :prefilter #'prefilter-reg/mem
410 :printer #'print-reg/mem)
411 (sb!disassem:define-arg-type sized-reg/mem
412 ;; Same as reg/mem, but prints an explicit size indicator for
413 ;; memory references.
414 :prefilter #'prefilter-reg/mem
415 :printer #'print-sized-reg/mem)
417 ;;; Arguments of type reg/mem with a fixed size.
418 (sb!disassem:define-arg-type sized-byte-reg/mem
419 :prefilter #'prefilter-reg/mem
420 :printer #'print-sized-byte-reg/mem)
421 (sb!disassem:define-arg-type sized-word-reg/mem
422 :prefilter #'prefilter-reg/mem
423 :printer #'print-sized-word-reg/mem)
424 (sb!disassem:define-arg-type sized-dword-reg/mem
425 :prefilter #'prefilter-reg/mem
426 :printer #'print-sized-dword-reg/mem)
428 ;;; Same as sized-reg/mem, but with a default operand size of :qword.
429 (sb!disassem:define-arg-type sized-reg/mem-default-qword
430 :prefilter #'prefilter-reg/mem
431 :printer #'print-sized-reg/mem-default-qword)
434 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
435 (defun print-fp-reg (value stream dstate)
436 (declare (ignore dstate))
437 (format stream "FR~D" value))
438 (defun prefilter-fp-reg (value dstate)
440 (declare (ignore dstate))
443 (sb!disassem:define-arg-type fp-reg
444 :prefilter #'prefilter-fp-reg
445 :printer #'print-fp-reg)
447 (eval-when (:compile-toplevel :load-toplevel :execute)
448 (defparameter *conditions*
451 (:b . 2) (:nae . 2) (:c . 2)
452 (:nb . 3) (:ae . 3) (:nc . 3)
453 (:eq . 4) (:e . 4) (:z . 4)
460 (:np . 11) (:po . 11)
461 (:l . 12) (:nge . 12)
462 (:nl . 13) (:ge . 13)
463 (:le . 14) (:ng . 14)
464 (:nle . 15) (:g . 15)))
465 (defparameter *condition-name-vec*
466 (let ((vec (make-array 16 :initial-element nil)))
467 (dolist (cond *conditions*)
468 (when (null (aref vec (cdr cond)))
469 (setf (aref vec (cdr cond)) (car cond))))
473 ;;; Set assembler parameters. (In CMU CL, this was done with
474 ;;; a call to a macro DEF-ASSEMBLER-PARAMS.)
475 (eval-when (:compile-toplevel :load-toplevel :execute)
476 (setf sb!assem:*assem-scheduler-p* nil))
478 (sb!disassem:define-arg-type condition-code
479 :printer *condition-name-vec*)
481 (defun conditional-opcode (condition)
482 (cdr (assoc condition *conditions* :test #'eq)))
484 ;;;; disassembler instruction formats
486 (eval-when (:compile-toplevel :execute)
487 (defun swap-if (direction field1 separator field2)
488 `(:if (,direction :constant 0)
489 (,field1 ,separator ,field2)
490 (,field2 ,separator ,field1))))
492 (sb!disassem:define-instruction-format (byte 8 :default-printer '(:name))
493 (op :field (byte 8 0))
498 ;;; A one-byte instruction with a #x66 prefix, used to indicate an
499 ;;; operand size of :word.
500 (sb!disassem:define-instruction-format (x66-byte 16
501 :default-printer '(:name))
502 (x66 :field (byte 8 0) :value #x66)
503 (op :field (byte 8 8)))
505 ;;; A one-byte instruction with a REX prefix, used to indicate an
506 ;;; operand size of :qword. REX.W must be 1, the other three bits are
508 (sb!disassem:define-instruction-format (rex-byte 16
509 :default-printer '(:name))
510 (rex :field (byte 5 3) :value #b01001)
511 (op :field (byte 8 8)))
513 (sb!disassem:define-instruction-format (simple 8)
514 (op :field (byte 7 1))
515 (width :field (byte 1 0) :type 'width)
520 (sb!disassem:define-instruction-format (rex-simple 16)
521 (rex :field (byte 4 4) :value #b0100)
522 (wrxb :field (byte 4 0) :type 'wrxb)
523 (op :field (byte 7 9))
524 (width :field (byte 1 8) :type 'width)
529 ;;; Same as simple, but with direction bit
530 (sb!disassem:define-instruction-format (simple-dir 8 :include 'simple)
531 (op :field (byte 6 2))
532 (dir :field (byte 1 1)))
534 ;;; Same as simple, but with the immediate value occurring by default,
535 ;;; and with an appropiate printer.
536 (sb!disassem:define-instruction-format (accum-imm 8
538 :default-printer '(:name
539 :tab accum ", " imm))
540 (imm :type 'signed-imm-data))
542 (sb!disassem:define-instruction-format (rex-accum-imm 16
544 :default-printer '(:name
545 :tab accum ", " imm))
546 (imm :type 'signed-imm-data))
548 (sb!disassem:define-instruction-format (reg-no-width 8
549 :default-printer '(:name :tab reg))
550 (op :field (byte 5 3))
551 (reg :field (byte 3 0) :type 'reg-b)
556 (sb!disassem:define-instruction-format (rex-reg-no-width 16
557 :default-printer '(:name :tab reg))
558 (rex :field (byte 4 4) :value #b0100)
559 (wrxb :field (byte 4 0) :type 'wrxb)
560 (op :field (byte 5 11))
561 (reg :field (byte 3 8) :type 'reg-b)
566 ;;; Same as reg-no-width, but with a default operand size of :qword.
567 (sb!disassem:define-instruction-format (reg-no-width-default-qword 8
568 :include 'reg-no-width
569 :default-printer '(:name :tab reg))
570 (reg :type 'reg-b-default-qword))
572 ;;; Same as rex-reg-no-width, but with a default operand size of :qword.
573 (sb!disassem:define-instruction-format (rex-reg-no-width-default-qword 16
574 :include 'rex-reg-no-width
575 :default-printer '(:name :tab reg))
576 (reg :type 'reg-b-default-qword))
578 (sb!disassem:define-instruction-format (modrm-reg-no-width 24
579 :default-printer '(:name :tab reg))
580 (rex :field (byte 4 4) :value #b0100)
581 (wrxb :field (byte 4 0) :type 'wrxb)
582 (ff :field (byte 8 8) :value #b11111111)
583 (mod :field (byte 2 22))
584 (modrm-reg :field (byte 3 19))
585 (reg :field (byte 3 16) :type 'reg-b)
590 ;;; Adds a width field to reg-no-width. Note that we can't use
591 ;;; :INCLUDE 'REG-NO-WIDTH here to save typing because that would put
592 ;;; the WIDTH field last, but the prefilter for WIDTH must run before
593 ;;; the one for IMM to be able to determine the correct size of IMM.
594 (sb!disassem:define-instruction-format (reg 8
595 :default-printer '(:name :tab reg))
596 (op :field (byte 4 4))
597 (width :field (byte 1 3) :type 'width)
598 (reg :field (byte 3 0) :type 'reg-b)
603 (sb!disassem:define-instruction-format (rex-reg 16
604 :default-printer '(:name :tab reg))
605 (rex :field (byte 4 4) :value #b0100)
606 (wrxb :field (byte 4 0) :type 'wrxb)
607 (width :field (byte 1 11) :type 'width)
608 (op :field (byte 4 12))
609 (reg :field (byte 3 8) :type 'reg-b)
614 (sb!disassem:define-instruction-format (two-bytes 16
615 :default-printer '(:name))
616 (op :fields (list (byte 8 0) (byte 8 8))))
618 (sb!disassem:define-instruction-format (reg-reg/mem 16
620 `(:name :tab reg ", " reg/mem))
621 (op :field (byte 7 1))
622 (width :field (byte 1 0) :type 'width)
623 (reg/mem :fields (list (byte 2 14) (byte 3 8))
625 (reg :field (byte 3 11) :type 'reg)
629 (sb!disassem:define-instruction-format (rex-reg-reg/mem 24
631 `(:name :tab reg ", " reg/mem))
632 (rex :field (byte 4 4) :value #b0100)
633 (wrxb :field (byte 4 0) :type 'wrxb)
634 (width :field (byte 1 8) :type 'width)
635 (op :field (byte 7 9))
636 (reg/mem :fields (list (byte 2 22) (byte 3 16))
638 (reg :field (byte 3 19) :type 'reg)
642 ;;; same as reg-reg/mem, but with direction bit
643 (sb!disassem:define-instruction-format (reg-reg/mem-dir 16
644 :include 'reg-reg/mem
648 ,(swap-if 'dir 'reg/mem ", " 'reg)))
649 (op :field (byte 6 2))
650 (dir :field (byte 1 1)))
652 (sb!disassem:define-instruction-format (rex-reg-reg/mem-dir 24
653 :include 'rex-reg-reg/mem
657 ,(swap-if 'dir 'reg/mem ", " 'reg)))
658 (op :field (byte 6 10))
659 (dir :field (byte 1 9)))
661 ;;; Same as reg-reg/mem, but uses the reg field as a second op code.
662 (sb!disassem:define-instruction-format (reg/mem 16
663 :default-printer '(:name :tab reg/mem))
664 (op :fields (list (byte 7 1) (byte 3 11)))
665 (width :field (byte 1 0) :type 'width)
666 (reg/mem :fields (list (byte 2 14) (byte 3 8))
667 :type 'sized-reg/mem)
671 (sb!disassem:define-instruction-format (rex-reg/mem 24
672 :default-printer '(:name :tab reg/mem))
673 (rex :field (byte 4 4) :value #b0100)
674 (wrxb :field (byte 4 0) :type 'wrxb)
675 (op :fields (list (byte 7 9) (byte 3 19)))
676 (width :field (byte 1 8) :type 'width)
677 (reg/mem :fields (list (byte 2 22) (byte 3 16))
678 :type 'sized-reg/mem)
682 ;;; Same as reg/mem, but without a width field and with a default
683 ;;; operand size of :qword.
684 (sb!disassem:define-instruction-format (reg/mem-default-qword 16
685 :default-printer '(:name :tab reg/mem))
686 (op :fields (list (byte 8 0) (byte 3 11)))
687 (reg/mem :fields (list (byte 2 14) (byte 3 8))
688 :type 'sized-reg/mem-default-qword))
690 (sb!disassem:define-instruction-format (rex-reg/mem-default-qword 24
691 :default-printer '(:name :tab reg/mem))
692 (rex :field (byte 4 4) :value #b0100)
693 (wrxb :field (byte 4 0) :type 'wrxb)
694 (op :fields (list (byte 8 8) (byte 3 19)))
695 (reg/mem :fields (list (byte 2 22) (byte 3 16))
696 :type 'sized-reg/mem-default-qword))
698 ;;; Same as reg/mem, but with the immediate value occurring by default,
699 ;;; and with an appropiate printer.
700 (sb!disassem:define-instruction-format (reg/mem-imm 16
703 '(:name :tab reg/mem ", " imm))
704 (reg/mem :type 'sized-reg/mem)
705 (imm :type 'signed-imm-data))
707 (sb!disassem:define-instruction-format (rex-reg/mem-imm 24
708 :include 'rex-reg/mem
710 '(:name :tab reg/mem ", " imm))
711 (reg/mem :type 'sized-reg/mem)
712 (imm :type 'signed-imm-data))
714 ;;; Same as reg/mem, but with using the accumulator in the default printer
715 (sb!disassem:define-instruction-format
717 :include 'reg/mem :default-printer '(:name :tab accum ", " reg/mem))
718 (reg/mem :type 'reg/mem) ; don't need a size
719 (accum :type 'accum))
721 (sb!disassem:define-instruction-format (rex-accum-reg/mem 24
722 :include 'rex-reg/mem
724 '(:name :tab accum ", " reg/mem))
725 (reg/mem :type 'reg/mem) ; don't need a size
726 (accum :type 'accum))
728 ;;; Same as reg-reg/mem, but with a prefix of #b00001111
729 (sb!disassem:define-instruction-format (ext-reg-reg/mem 24
731 `(:name :tab reg ", " reg/mem))
732 (prefix :field (byte 8 0) :value #b00001111)
733 (op :field (byte 7 9))
734 (width :field (byte 1 8) :type 'width)
735 (reg/mem :fields (list (byte 2 22) (byte 3 16))
737 (reg :field (byte 3 19) :type 'reg)
741 (sb!disassem:define-instruction-format (ext-reg-reg/mem-no-width 24
743 `(:name :tab reg ", " reg/mem))
744 (prefix :field (byte 8 0) :value #b00001111)
745 (op :field (byte 8 8))
746 (reg/mem :fields (list (byte 2 22) (byte 3 16))
748 (reg :field (byte 3 19) :type 'reg))
750 (sb!disassem:define-instruction-format (rex-ext-reg-reg/mem-no-width 32
752 `(:name :tab reg ", " reg/mem))
753 (rex :field (byte 4 4) :value #b0100)
754 (wrxb :field (byte 4 0) :type 'wrxb)
755 (prefix :field (byte 8 8) :value #b00001111)
756 (op :field (byte 8 16))
757 (reg/mem :fields (list (byte 2 30) (byte 3 24))
759 (reg :field (byte 3 27) :type 'reg))
761 ;;; Same as reg-reg/mem, but with a prefix of #xf2 0f
762 (sb!disassem:define-instruction-format (xmm-ext-reg-reg/mem 32
764 `(:name :tab reg ", " reg/mem))
765 (prefix :field (byte 8 0) :value #xf2)
766 (prefix2 :field (byte 8 8) :value #x0f)
767 (op :field (byte 7 17))
768 (width :field (byte 1 16) :type 'width)
769 (reg/mem :fields (list (byte 2 30) (byte 3 24))
771 (reg :field (byte 3 27) :type 'reg)
775 ;;; reg-no-width with #x0f prefix
776 (sb!disassem:define-instruction-format (ext-reg-no-width 16
777 :default-printer '(:name :tab reg))
778 (prefix :field (byte 8 0) :value #b00001111)
779 (op :field (byte 5 11))
780 (reg :field (byte 3 8) :type 'reg-b))
782 ;;; Same as reg/mem, but with a prefix of #b00001111
783 (sb!disassem:define-instruction-format (ext-reg/mem 24
784 :default-printer '(:name :tab reg/mem))
785 (prefix :field (byte 8 0) :value #b00001111)
786 (op :fields (list (byte 7 9) (byte 3 19)))
787 (width :field (byte 1 8) :type 'width)
788 (reg/mem :fields (list (byte 2 22) (byte 3 16))
789 :type 'sized-reg/mem)
793 (sb!disassem:define-instruction-format (ext-reg/mem-imm 24
794 :include 'ext-reg/mem
796 '(:name :tab reg/mem ", " imm))
797 (imm :type 'signed-imm-data))
799 ;;;; This section was added by jrd, for fp instructions.
801 ;;; regular fp inst to/from registers/memory
802 (sb!disassem:define-instruction-format (floating-point 16
804 `(:name :tab reg/mem))
805 (prefix :field (byte 5 3) :value #b11011)
806 (op :fields (list (byte 3 0) (byte 3 11)))
807 (reg/mem :fields (list (byte 2 14) (byte 3 8)) :type 'reg/mem))
809 ;;; fp insn to/from fp reg
810 (sb!disassem:define-instruction-format (floating-point-fp 16
811 :default-printer `(:name :tab fp-reg))
812 (prefix :field (byte 5 3) :value #b11011)
813 (suffix :field (byte 2 14) :value #b11)
814 (op :fields (list (byte 3 0) (byte 3 11)))
815 (fp-reg :field (byte 3 8) :type 'fp-reg))
817 ;;; fp insn to/from fp reg, with the reversed source/destination flag.
818 (sb!disassem:define-instruction-format
819 (floating-point-fp-d 16
820 :default-printer `(:name :tab ,(swap-if 'd "ST0" ", " 'fp-reg)))
821 (prefix :field (byte 5 3) :value #b11011)
822 (suffix :field (byte 2 14) :value #b11)
823 (op :fields (list (byte 2 0) (byte 3 11)))
824 (d :field (byte 1 2))
825 (fp-reg :field (byte 3 8) :type 'fp-reg))
828 ;;; (added by (?) pfw)
829 ;;; fp no operand isns
830 (sb!disassem:define-instruction-format (floating-point-no 16
831 :default-printer '(:name))
832 (prefix :field (byte 8 0) :value #b11011001)
833 (suffix :field (byte 3 13) :value #b111)
834 (op :field (byte 5 8)))
836 (sb!disassem:define-instruction-format (floating-point-3 16
837 :default-printer '(:name))
838 (prefix :field (byte 5 3) :value #b11011)
839 (suffix :field (byte 2 14) :value #b11)
840 (op :fields (list (byte 3 0) (byte 6 8))))
842 (sb!disassem:define-instruction-format (floating-point-5 16
843 :default-printer '(:name))
844 (prefix :field (byte 8 0) :value #b11011011)
845 (suffix :field (byte 3 13) :value #b111)
846 (op :field (byte 5 8)))
848 (sb!disassem:define-instruction-format (floating-point-st 16
849 :default-printer '(:name))
850 (prefix :field (byte 8 0) :value #b11011111)
851 (suffix :field (byte 3 13) :value #b111)
852 (op :field (byte 5 8)))
854 (sb!disassem:define-instruction-format (string-op 8
856 :default-printer '(:name width)))
858 (sb!disassem:define-instruction-format (rex-string-op 16
860 :default-printer '(:name width)))
862 (sb!disassem:define-instruction-format (short-cond-jump 16)
863 (op :field (byte 4 4))
864 (cc :field (byte 4 0) :type 'condition-code)
865 (label :field (byte 8 8) :type 'displacement))
867 (sb!disassem:define-instruction-format (short-jump 16
868 :default-printer '(:name :tab label))
869 (const :field (byte 4 4) :value #b1110)
870 (op :field (byte 4 0))
871 (label :field (byte 8 8) :type 'displacement))
873 (sb!disassem:define-instruction-format (near-cond-jump 16)
874 (op :fields (list (byte 8 0) (byte 4 12)) :value '(#b00001111 #b1000))
875 (cc :field (byte 4 8) :type 'condition-code)
876 ;; The disassembler currently doesn't let you have an instruction > 32 bits
877 ;; long, so we fake it by using a prefilter to read the offset.
878 (label :type 'displacement
879 :prefilter (lambda (value dstate)
880 (declare (ignore value)) ; always nil anyway
881 (sb!disassem:read-signed-suffix 32 dstate))))
883 (sb!disassem:define-instruction-format (near-jump 8
884 :default-printer '(:name :tab label))
885 (op :field (byte 8 0))
886 ;; The disassembler currently doesn't let you have an instruction > 32 bits
887 ;; long, so we fake it by using a prefilter to read the address.
888 (label :type 'displacement
889 :prefilter (lambda (value dstate)
890 (declare (ignore value)) ; always nil anyway
891 (sb!disassem:read-signed-suffix 32 dstate))))
894 (sb!disassem:define-instruction-format (cond-set 24
895 :default-printer '('set cc :tab reg/mem))
896 (prefix :field (byte 8 0) :value #b00001111)
897 (op :field (byte 4 12) :value #b1001)
898 (cc :field (byte 4 8) :type 'condition-code)
899 (reg/mem :fields (list (byte 2 22) (byte 3 16))
900 :type 'sized-byte-reg/mem)
901 (reg :field (byte 3 19) :value #b000))
903 (sb!disassem:define-instruction-format (cond-move 24
905 '('cmov cc :tab reg ", " reg/mem))
906 (prefix :field (byte 8 0) :value #b00001111)
907 (op :field (byte 4 12) :value #b0100)
908 (cc :field (byte 4 8) :type 'condition-code)
909 (reg/mem :fields (list (byte 2 22) (byte 3 16))
911 (reg :field (byte 3 19) :type 'reg))
913 (sb!disassem:define-instruction-format (rex-cond-move 32
915 '('cmov cc :tab reg ", " reg/mem))
916 (rex :field (byte 4 4) :value #b0100)
917 (wrxb :field (byte 4 0) :type 'wrxb)
918 (prefix :field (byte 8 8) :value #b00001111)
919 (op :field (byte 4 20) :value #b0100)
920 (cc :field (byte 4 16) :type 'condition-code)
921 (reg/mem :fields (list (byte 2 30) (byte 3 24))
923 (reg :field (byte 3 27) :type 'reg))
925 (sb!disassem:define-instruction-format (enter-format 32
926 :default-printer '(:name
928 (:unless (:constant 0)
930 (op :field (byte 8 0))
931 (disp :field (byte 16 8))
932 (level :field (byte 8 24)))
934 ;;; Single byte instruction with an immediate byte argument.
935 (sb!disassem:define-instruction-format (byte-imm 16
936 :default-printer '(:name :tab code))
937 (op :field (byte 8 0))
938 (code :field (byte 8 8)))
940 ;;;; primitive emitters
942 (define-bitfield-emitter emit-word 16
945 (define-bitfield-emitter emit-dword 32
948 (define-bitfield-emitter emit-qword 64
951 (define-bitfield-emitter emit-byte-with-reg 8
952 (byte 5 3) (byte 3 0))
954 (define-bitfield-emitter emit-mod-reg-r/m-byte 8
955 (byte 2 6) (byte 3 3) (byte 3 0))
957 (define-bitfield-emitter emit-sib-byte 8
958 (byte 2 6) (byte 3 3) (byte 3 0))
960 (define-bitfield-emitter emit-rex-byte 8
961 (byte 4 4) (byte 1 3) (byte 1 2) (byte 1 1) (byte 1 0))
967 (defun emit-absolute-fixup (segment fixup &optional quad-p)
968 (note-fixup segment (if quad-p :absolute64 :absolute) fixup)
969 (let ((offset (fixup-offset fixup)))
971 (emit-back-patch segment
973 (lambda (segment posn)
974 (declare (ignore posn))
975 (let ((val (- (+ (component-header-length)
976 (or (label-position offset)
978 other-pointer-lowtag)))
980 (emit-qword segment val )
981 (emit-dword segment val )))))
983 (emit-qword segment (or offset 0))
984 (emit-dword segment (or offset 0))))))
986 (defun emit-relative-fixup (segment fixup)
987 (note-fixup segment :relative fixup)
988 (emit-dword segment (or (fixup-offset fixup) 0)))
991 ;;;; the effective-address (ea) structure
993 (defun reg-tn-encoding (tn)
994 (declare (type tn tn))
995 (aver (member (sb-name (sc-sb (tn-sc tn))) '(registers float-registers)))
996 ;; ea only has space for three bits of register number: regs r8
997 ;; and up are selected by a REX prefix byte which caller is responsible
998 ;; for having emitted where necessary already
999 (cond ((fp-reg-tn-p tn)
1000 (mod (tn-offset tn) 8))
1002 (let ((offset (mod (tn-offset tn) 16)))
1003 (logior (ash (logand offset 1) 2)
1004 (ash offset -1))))))
1006 (defstruct (ea (:constructor make-ea (size &key base index scale disp))
1008 ;; note that we can represent an EA qith a QWORD size, but EMIT-EA
1009 ;; can't actually emit it on its own: caller also needs to emit REX
1011 (size nil :type (member :byte :word :dword :qword))
1012 (base nil :type (or tn null))
1013 (index nil :type (or tn null))
1014 (scale 1 :type (member 1 2 4 8))
1015 (disp 0 :type (or (unsigned-byte 32) (signed-byte 32) fixup)))
1016 (def!method print-object ((ea ea) stream)
1017 (cond ((or *print-escape* *print-readably*)
1018 (print-unreadable-object (ea stream :type t)
1020 "~S~@[ base=~S~]~@[ index=~S~]~@[ scale=~S~]~@[ disp=~S~]"
1024 (let ((scale (ea-scale ea)))
1025 (if (= scale 1) nil scale))
1028 (format stream "~A PTR [" (symbol-name (ea-size ea)))
1030 (write-string (sb!c::location-print-name (ea-base ea)) stream)
1032 (write-string "+" stream)))
1034 (write-string (sb!c::location-print-name (ea-index ea)) stream))
1035 (unless (= (ea-scale ea) 1)
1036 (format stream "*~A" (ea-scale ea)))
1037 (typecase (ea-disp ea)
1040 (format stream "~@D" (ea-disp ea)))
1042 (format stream "+~A" (ea-disp ea))))
1043 (write-char #\] stream))))
1045 (defun emit-constant-tn-rip (segment constant-tn reg)
1046 ;; AMD64 doesn't currently have a code object register to use as a
1047 ;; base register for constant access. Instead we use RIP-relative
1048 ;; addressing. The offset from the SIMPLE-FUN-HEADER to the instruction
1049 ;; is passed to the backpatch callback. In addition we need the offset
1050 ;; from the start of the function header to the slot in the CODE-HEADER
1051 ;; that stores the constant. Since we don't know where the code header
1052 ;; starts, instead count backwards from the function header.
1053 (let* ((2comp (component-info *component-being-compiled*))
1054 (constants (ir2-component-constants 2comp))
1055 (len (length constants))
1056 ;; Both CODE-HEADER and SIMPLE-FUN-HEADER are 16-byte aligned.
1057 ;; If there are an even amount of constants, there will be
1058 ;; an extra qword of padding before the function header, which
1059 ;; needs to be adjusted for. XXX: This will break if new slots
1060 ;; are added to the code header.
1061 (offset (* (- (+ len (if (evenp len)
1064 (tn-offset constant-tn))
1066 ;; RIP-relative addressing
1067 (emit-mod-reg-r/m-byte segment #b00 reg #b101)
1068 (emit-back-patch segment
1070 (lambda (segment posn)
1071 ;; The addressing is relative to end of instruction,
1072 ;; i.e. the end of this dword. Hence the + 4.
1073 (emit-dword segment (+ 4 (- (+ offset posn)))))))
1076 (defun emit-label-rip (segment fixup reg)
1077 (let ((label (fixup-offset fixup)))
1078 ;; RIP-relative addressing
1079 (emit-mod-reg-r/m-byte segment #b00 reg #b101)
1080 (emit-back-patch segment
1082 (lambda (segment posn)
1083 (emit-dword segment (- (label-position label)
1087 (defun emit-ea (segment thing reg &optional allow-constants)
1090 ;; this would be eleganter if we had a function that would create
1092 (ecase (sb-name (sc-sb (tn-sc thing)))
1093 ((registers float-registers)
1094 (emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing)))
1096 ;; Convert stack tns into an index off RBP.
1097 (let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes))))
1098 (cond ((< -128 disp 127)
1099 (emit-mod-reg-r/m-byte segment #b01 reg #b101)
1100 (emit-byte segment disp))
1102 (emit-mod-reg-r/m-byte segment #b10 reg #b101)
1103 (emit-dword segment disp)))))
1105 (unless allow-constants
1108 "Constant TNs can only be directly used in MOV, PUSH, and CMP."))
1109 (emit-constant-tn-rip segment thing reg))))
1111 (let* ((base (ea-base thing))
1112 (index (ea-index thing))
1113 (scale (ea-scale thing))
1114 (disp (ea-disp thing))
1115 (mod (cond ((or (null base)
1117 (not (= (reg-tn-encoding base) #b101))))
1119 ((and (fixnump disp) (<= -128 disp 127))
1123 (r/m (cond (index #b100)
1125 (t (reg-tn-encoding base)))))
1126 (when (and (= mod 0) (= r/m #b101))
1127 ;; this is rip-relative in amd64, so we'll use a sib instead
1128 (setf r/m #b100 scale 1))
1129 (emit-mod-reg-r/m-byte segment mod reg r/m)
1131 (let ((ss (1- (integer-length scale)))
1132 (index (if (null index)
1134 (let ((index (reg-tn-encoding index)))
1136 (error "can't index off of ESP")
1138 (base (if (null base)
1140 (reg-tn-encoding base))))
1141 (emit-sib-byte segment ss index base)))
1143 (emit-byte segment disp))
1144 ((or (= mod #b10) (null base))
1146 (emit-absolute-fixup segment disp)
1147 (emit-dword segment disp))))))
1149 (typecase (fixup-offset thing)
1151 (emit-label-rip segment thing reg))
1153 (emit-mod-reg-r/m-byte segment #b00 reg #b100)
1154 (emit-sib-byte segment 0 #b100 #b101)
1155 (emit-absolute-fixup segment thing))))))
1157 (defun fp-reg-tn-p (thing)
1159 (eq (sb-name (sc-sb (tn-sc thing))) 'float-registers)))
1161 ;;; like the above, but for fp-instructions--jrd
1162 (defun emit-fp-op (segment thing op)
1163 (if (fp-reg-tn-p thing)
1164 (emit-byte segment (dpb op (byte 3 3) (dpb (tn-offset thing)
1167 (emit-ea segment thing op)))
1169 (defun byte-reg-p (thing)
1171 (eq (sb-name (sc-sb (tn-sc thing))) 'registers)
1172 (member (sc-name (tn-sc thing)) *byte-sc-names*)
1175 (defun byte-ea-p (thing)
1177 (ea (eq (ea-size thing) :byte))
1179 (and (member (sc-name (tn-sc thing)) *byte-sc-names*) t))
1182 (defun word-reg-p (thing)
1184 (eq (sb-name (sc-sb (tn-sc thing))) 'registers)
1185 (member (sc-name (tn-sc thing)) *word-sc-names*)
1188 (defun word-ea-p (thing)
1190 (ea (eq (ea-size thing) :word))
1191 (tn (and (member (sc-name (tn-sc thing)) *word-sc-names*) t))
1194 (defun dword-reg-p (thing)
1196 (eq (sb-name (sc-sb (tn-sc thing))) 'registers)
1197 (member (sc-name (tn-sc thing)) *dword-sc-names*)
1200 (defun dword-ea-p (thing)
1202 (ea (eq (ea-size thing) :dword))
1204 (and (member (sc-name (tn-sc thing)) *dword-sc-names*) t))
1207 (defun qword-reg-p (thing)
1209 (eq (sb-name (sc-sb (tn-sc thing))) 'registers)
1210 (member (sc-name (tn-sc thing)) *qword-sc-names*)
1213 (defun qword-ea-p (thing)
1215 (ea (eq (ea-size thing) :qword))
1217 (and (member (sc-name (tn-sc thing)) *qword-sc-names*) t))
1220 (defun register-p (thing)
1222 (eq (sb-name (sc-sb (tn-sc thing))) 'registers)))
1224 (defun accumulator-p (thing)
1225 (and (register-p thing)
1226 (= (tn-offset thing) 0)))
1231 (def!constant +operand-size-prefix-byte+ #b01100110)
1233 (defun maybe-emit-operand-size-prefix (segment size)
1234 (unless (or (eq size :byte)
1235 (eq size :qword) ; REX prefix handles this
1236 (eq size +default-operand-size+))
1237 (emit-byte segment +operand-size-prefix-byte+)))
1239 (defun maybe-emit-rex-prefix (segment operand-size r x b)
1241 (if (and r (> (tn-offset r)
1242 ;; offset of r8 is 16, offset of xmm8 is 8
1248 (let ((rex-w (if (eq operand-size :qword) 1 0))
1252 (when (or (eq operand-size :byte) ;; REX needed to access SIL/DIL
1253 (not (zerop (logior rex-w rex-r rex-x rex-b))))
1254 (emit-rex-byte segment #b0100 rex-w rex-r rex-x rex-b)))))
1256 (defun maybe-emit-rex-for-ea (segment ea reg &key operand-size)
1257 (let ((ea-p (ea-p ea))) ;emit-ea can also be called with a tn
1258 (maybe-emit-rex-prefix segment
1259 (or operand-size (operand-size ea))
1261 (and ea-p (ea-index ea))
1262 (cond (ea-p (ea-base ea))
1264 (member (sb-name (sc-sb (tn-sc ea)))
1265 '(float-registers registers)))
1269 (defun operand-size (thing)
1272 ;; FIXME: might as well be COND instead of having to use #. readmacro
1273 ;; to hack up the code
1274 (case (sc-name (tn-sc thing))
1283 ;; added by jrd: float-registers is a separate size (?)
1286 (#.*double-sc-names*
1289 (error "can't tell the size of ~S ~S" thing (sc-name (tn-sc thing))))))
1293 ;; GNA. Guess who spelt "flavor" correctly first time round?
1294 ;; There's a strong argument in my mind to change all uses of
1295 ;; "flavor" to "kind": and similarly with some misguided uses of
1296 ;; "type" here and there. -- CSR, 2005-01-06.
1297 (case (fixup-flavor thing)
1298 ((:foreign-dataref) :qword)))
1302 (defun matching-operand-size (dst src)
1303 (let ((dst-size (operand-size dst))
1304 (src-size (operand-size src)))
1307 (if (eq dst-size src-size)
1309 (error "size mismatch: ~S is a ~S and ~S is a ~S."
1310 dst dst-size src src-size))
1314 (error "can't tell the size of either ~S or ~S" dst src)))))
1316 (defun emit-sized-immediate (segment size value &optional quad-p)
1319 (emit-byte segment value))
1321 (emit-word segment value))
1323 ;; except in a very few cases (MOV instructions A1,A3,B8) we expect
1324 ;; dword data bytes even when 64 bit work is being done. So, mostly
1325 ;; we treat quad constants as dwords.
1326 (if (and quad-p (eq size :qword))
1327 (emit-qword segment value)
1328 (emit-dword segment value)))))
1330 ;;;; general data transfer
1332 (define-instruction mov (segment dst src)
1333 ;; immediate to register
1334 (:printer reg ((op #b1011) (imm nil :type 'signed-imm-data))
1335 '(:name :tab reg ", " imm))
1336 (:printer rex-reg ((op #b1011) (imm nil :type 'signed-imm-data-upto-qword))
1337 '(:name :tab reg ", " imm))
1338 ;; absolute mem to/from accumulator
1339 (:printer simple-dir ((op #b101000) (imm nil :type 'imm-addr))
1340 `(:name :tab ,(swap-if 'dir 'accum ", " '("[" imm "]"))))
1341 ;; register to/from register/memory
1342 (:printer reg-reg/mem-dir ((op #b100010)))
1343 (:printer rex-reg-reg/mem-dir ((op #b100010)))
1344 ;; immediate to register/memory
1345 (:printer reg/mem-imm ((op '(#b1100011 #b000))))
1346 (:printer rex-reg/mem-imm ((op '(#b1100011 #b000))))
1349 (let ((size (matching-operand-size dst src)))
1350 (maybe-emit-operand-size-prefix segment size)
1351 (cond ((register-p dst)
1352 (cond ((integerp src)
1353 (maybe-emit-rex-prefix segment size nil nil dst)
1354 (emit-byte-with-reg segment
1358 (reg-tn-encoding dst))
1359 (emit-sized-immediate segment size src (eq size :qword)))
1361 (maybe-emit-rex-for-ea segment src dst)
1366 (emit-ea segment src (reg-tn-encoding dst) t))))
1368 ;; C7 only deals with 32 bit immediates even if register is
1369 ;; 64 bit: only b8-bf use 64 bit immediates
1370 (maybe-emit-rex-for-ea segment dst nil)
1371 (cond ((typep src '(or (signed-byte 32) (unsigned-byte 32)))
1373 (if (eq size :byte) #b11000110 #b11000111))
1374 (emit-ea segment dst #b000)
1375 (emit-sized-immediate segment
1376 (case size (:qword :dword) (t size))
1381 (maybe-emit-rex-for-ea segment dst src)
1382 (emit-byte segment (if (eq size :byte) #b10001000 #b10001001))
1383 (emit-ea segment dst (reg-tn-encoding src)))
1385 ;; Generally we can't MOV a fixupped value into an EA, since
1386 ;; MOV on non-registers can only take a 32-bit immediate arg.
1387 ;; Make an exception for :FOREIGN fixups (pretty much just
1388 ;; the runtime asm, since other foreign calls go through the
1389 ;; the linkage table) and for linkage table references, since
1390 ;; these should always end up in low memory.
1391 (aver (or (eq (fixup-flavor src) :foreign)
1392 (eq (fixup-flavor src) :foreign-dataref)
1393 (eq (ea-size dst) :dword)))
1394 (maybe-emit-rex-for-ea segment dst nil)
1395 (emit-byte segment #b11000111)
1396 (emit-ea segment dst #b000)
1397 (emit-absolute-fixup segment src))
1399 (error "bogus arguments to MOV: ~S ~S" dst src))))))
1401 (defun emit-move-with-extension (segment dst src signed-p)
1402 (aver (register-p dst))
1403 (let ((dst-size (operand-size dst))
1404 (src-size (operand-size src))
1405 (opcode (if signed-p #b10111110 #b10110110)))
1408 (aver (eq src-size :byte))
1409 (maybe-emit-operand-size-prefix segment :word)
1410 (emit-byte segment #b00001111)
1411 (emit-byte segment opcode)
1412 (emit-ea segment src (reg-tn-encoding dst)))
1416 (maybe-emit-operand-size-prefix segment :dword)
1417 (maybe-emit-rex-for-ea segment src dst
1418 :operand-size (operand-size dst))
1419 (emit-byte segment #b00001111)
1420 (emit-byte segment opcode)
1421 (emit-ea segment src (reg-tn-encoding dst)))
1423 (maybe-emit-rex-for-ea segment src dst
1424 :operand-size (operand-size dst))
1425 (emit-byte segment #b00001111)
1426 (emit-byte segment (logior opcode 1))
1427 (emit-ea segment src (reg-tn-encoding dst)))
1429 (aver (eq dst-size :qword))
1430 ;; dst is in reg, src is in modrm
1431 (let ((ea-p (ea-p src)))
1432 (maybe-emit-rex-prefix segment (if signed-p :qword :dword) dst
1433 (and ea-p (ea-index src))
1434 (cond (ea-p (ea-base src))
1437 (emit-byte segment #x63) ;movsxd
1438 ;;(emit-byte segment opcode)
1439 (emit-ea segment src (reg-tn-encoding dst)))))))))
1441 (define-instruction movsx (segment dst src)
1442 (:printer ext-reg-reg/mem-no-width
1443 ((op #b10111110) (reg/mem nil :type 'sized-byte-reg/mem)))
1444 (:printer rex-ext-reg-reg/mem-no-width
1445 ((op #b10111110) (reg/mem nil :type 'sized-byte-reg/mem)))
1446 (:printer ext-reg-reg/mem-no-width
1447 ((op #b10111111) (reg/mem nil :type 'sized-word-reg/mem)))
1448 (:printer rex-ext-reg-reg/mem-no-width
1449 ((op #b10111111) (reg/mem nil :type 'sized-word-reg/mem)))
1450 (:emitter (emit-move-with-extension segment dst src :signed)))
1452 (define-instruction movzx (segment dst src)
1453 (:printer ext-reg-reg/mem-no-width
1454 ((op #b10110110) (reg/mem nil :type 'sized-byte-reg/mem)))
1455 (:printer rex-ext-reg-reg/mem-no-width
1456 ((op #b10110110) (reg/mem nil :type 'sized-byte-reg/mem)))
1457 (:printer ext-reg-reg/mem-no-width
1458 ((op #b10110111) (reg/mem nil :type 'sized-word-reg/mem)))
1459 (:printer rex-ext-reg-reg/mem-no-width
1460 ((op #b10110111) (reg/mem nil :type 'sized-word-reg/mem)))
1461 (:emitter (emit-move-with-extension segment dst src nil)))
1463 ;;; The regular use of MOVSXD is with an operand size of :qword. This
1464 ;;; sign-extends the dword source into the qword destination register.
1465 ;;; If the operand size is :dword the instruction zero-extends the dword
1466 ;;; source into the qword destination register, i.e. it does the same as
1467 ;;; a dword MOV into a register.
1468 (define-instruction movsxd (segment dst src)
1469 (:printer reg-reg/mem ((op #b0110001) (width 1)
1470 (reg/mem nil :type 'sized-dword-reg/mem)))
1471 (:printer rex-reg-reg/mem ((op #b0110001) (width 1)
1472 (reg/mem nil :type 'sized-dword-reg/mem)))
1473 (:emitter (emit-move-with-extension segment dst src :signed)))
1475 ;;; this is not a real amd64 instruction, of course
1476 (define-instruction movzxd (segment dst src)
1477 ; (:printer reg-reg/mem ((op #x63) (reg nil :type 'reg)))
1478 (:emitter (emit-move-with-extension segment dst src nil)))
1480 (define-instruction push (segment src)
1482 (:printer reg-no-width-default-qword ((op #b01010)))
1483 (:printer rex-reg-no-width-default-qword ((op #b01010)))
1485 (:printer reg/mem-default-qword ((op '(#b11111111 #b110))))
1486 (:printer rex-reg/mem-default-qword ((op '(#b11111111 #b110))))
1488 (:printer byte ((op #b01101010) (imm nil :type 'signed-imm-byte))
1490 (:printer byte ((op #b01101000)
1491 (imm nil :type 'signed-imm-data-default-qword))
1493 ;; ### segment registers?
1496 (cond ((integerp src)
1497 (cond ((<= -128 src 127)
1498 (emit-byte segment #b01101010)
1499 (emit-byte segment src))
1501 ;; AMD64 manual says no REX needed but is unclear
1502 ;; whether it expects 32 or 64 bit immediate here
1503 (emit-byte segment #b01101000)
1504 (emit-dword segment src))))
1506 (let ((size (operand-size src)))
1507 (aver (not (eq size :byte)))
1508 (maybe-emit-operand-size-prefix segment size)
1509 (maybe-emit-rex-for-ea segment src nil)
1510 (cond ((register-p src)
1511 (emit-byte-with-reg segment #b01010 (reg-tn-encoding src)))
1513 (emit-byte segment #b11111111)
1514 (emit-ea segment src #b110 t))))))))
1516 (define-instruction pop (segment dst)
1517 (:printer reg-no-width-default-qword ((op #b01011)))
1518 (:printer rex-reg-no-width-default-qword ((op #b01011)))
1519 (:printer reg/mem-default-qword ((op '(#b10001111 #b000))))
1520 (:printer rex-reg/mem-default-qword ((op '(#b10001111 #b000))))
1522 (let ((size (operand-size dst)))
1523 (aver (not (eq size :byte)))
1524 (maybe-emit-operand-size-prefix segment size)
1525 (maybe-emit-rex-for-ea segment dst nil)
1526 (cond ((register-p dst)
1527 (emit-byte-with-reg segment #b01011 (reg-tn-encoding dst)))
1529 (emit-byte segment #b10001111)
1530 (emit-ea segment dst #b000))))))
1532 (define-instruction xchg (segment operand1 operand2)
1533 ;; Register with accumulator.
1534 (:printer reg-no-width ((op #b10010)) '(:name :tab accum ", " reg))
1535 ;; Register/Memory with Register.
1536 (:printer reg-reg/mem ((op #b1000011)))
1537 (:printer rex-reg-reg/mem ((op #b1000011)))
1539 (let ((size (matching-operand-size operand1 operand2)))
1540 (maybe-emit-operand-size-prefix segment size)
1541 (labels ((xchg-acc-with-something (acc something)
1542 (if (and (not (eq size :byte)) (register-p something))
1544 (maybe-emit-rex-for-ea segment acc something)
1545 (emit-byte-with-reg segment
1547 (reg-tn-encoding something)))
1548 (xchg-reg-with-something acc something)))
1549 (xchg-reg-with-something (reg something)
1550 (maybe-emit-rex-for-ea segment something reg)
1551 (emit-byte segment (if (eq size :byte) #b10000110 #b10000111))
1552 (emit-ea segment something (reg-tn-encoding reg))))
1553 (cond ((accumulator-p operand1)
1554 (xchg-acc-with-something operand1 operand2))
1555 ((accumulator-p operand2)
1556 (xchg-acc-with-something operand2 operand1))
1557 ((register-p operand1)
1558 (xchg-reg-with-something operand1 operand2))
1559 ((register-p operand2)
1560 (xchg-reg-with-something operand2 operand1))
1562 (error "bogus args to XCHG: ~S ~S" operand1 operand2)))))))
1564 (define-instruction lea (segment dst src)
1565 (:printer rex-reg-reg/mem ((op #b1000110)))
1566 (:printer reg-reg/mem ((op #b1000110) (width 1)))
1568 (aver (or (dword-reg-p dst) (qword-reg-p dst)))
1569 (maybe-emit-rex-for-ea segment src dst
1570 :operand-size :qword)
1571 (emit-byte segment #b10001101)
1572 (emit-ea segment src (reg-tn-encoding dst))))
1574 (define-instruction cmpxchg (segment dst src)
1575 ;; Register/Memory with Register.
1576 (:printer ext-reg-reg/mem ((op #b1011000)) '(:name :tab reg/mem ", " reg))
1578 (aver (register-p src))
1579 (let ((size (matching-operand-size src dst)))
1580 (maybe-emit-operand-size-prefix segment size)
1581 (maybe-emit-rex-for-ea segment dst src)
1582 (emit-byte segment #b00001111)
1583 (emit-byte segment (if (eq size :byte) #b10110000 #b10110001))
1584 (emit-ea segment dst (reg-tn-encoding src)))))
1588 (define-instruction fs-segment-prefix (segment)
1590 (emit-byte segment #x64)))
1592 ;;;; flag control instructions
1594 ;;; CLC -- Clear Carry Flag.
1595 (define-instruction clc (segment)
1596 (:printer byte ((op #b11111000)))
1598 (emit-byte segment #b11111000)))
1600 ;;; CLD -- Clear Direction Flag.
1601 (define-instruction cld (segment)
1602 (:printer byte ((op #b11111100)))
1604 (emit-byte segment #b11111100)))
1606 ;;; CLI -- Clear Iterrupt Enable Flag.
1607 (define-instruction cli (segment)
1608 (:printer byte ((op #b11111010)))
1610 (emit-byte segment #b11111010)))
1612 ;;; CMC -- Complement Carry Flag.
1613 (define-instruction cmc (segment)
1614 (:printer byte ((op #b11110101)))
1616 (emit-byte segment #b11110101)))
1618 ;;; LAHF -- Load AH into flags.
1619 (define-instruction lahf (segment)
1620 (:printer byte ((op #b10011111)))
1622 (emit-byte segment #b10011111)))
1624 ;;; POPF -- Pop flags.
1625 (define-instruction popf (segment)
1626 (:printer byte ((op #b10011101)))
1628 (emit-byte segment #b10011101)))
1630 ;;; PUSHF -- push flags.
1631 (define-instruction pushf (segment)
1632 (:printer byte ((op #b10011100)))
1634 (emit-byte segment #b10011100)))
1636 ;;; SAHF -- Store AH into flags.
1637 (define-instruction sahf (segment)
1638 (:printer byte ((op #b10011110)))
1640 (emit-byte segment #b10011110)))
1642 ;;; STC -- Set Carry Flag.
1643 (define-instruction stc (segment)
1644 (:printer byte ((op #b11111001)))
1646 (emit-byte segment #b11111001)))
1648 ;;; STD -- Set Direction Flag.
1649 (define-instruction std (segment)
1650 (:printer byte ((op #b11111101)))
1652 (emit-byte segment #b11111101)))
1654 ;;; STI -- Set Interrupt Enable Flag.
1655 (define-instruction sti (segment)
1656 (:printer byte ((op #b11111011)))
1658 (emit-byte segment #b11111011)))
1662 (defun emit-random-arith-inst (name segment dst src opcode
1663 &optional allow-constants)
1664 (let ((size (matching-operand-size dst src)))
1665 (maybe-emit-operand-size-prefix segment size)
1668 (cond ((and (not (eq size :byte)) (<= -128 src 127))
1669 (maybe-emit-rex-for-ea segment dst nil)
1670 (emit-byte segment #b10000011)
1671 (emit-ea segment dst opcode allow-constants)
1672 (emit-byte segment src))
1673 ((accumulator-p dst)
1674 (maybe-emit-rex-for-ea segment dst nil)
1681 (emit-sized-immediate segment size src))
1683 (maybe-emit-rex-for-ea segment dst nil)
1684 (emit-byte segment (if (eq size :byte) #b10000000 #b10000001))
1685 (emit-ea segment dst opcode allow-constants)
1686 (emit-sized-immediate segment size src))))
1688 (maybe-emit-rex-for-ea segment dst src)
1692 (if (eq size :byte) #b00000000 #b00000001)))
1693 (emit-ea segment dst (reg-tn-encoding src) allow-constants))
1695 (maybe-emit-rex-for-ea segment src dst)
1699 (if (eq size :byte) #b00000010 #b00000011)))
1700 (emit-ea segment src (reg-tn-encoding dst) allow-constants))
1702 (error "bogus operands to ~A" name)))))
1704 (eval-when (:compile-toplevel :execute)
1705 (defun arith-inst-printer-list (subop)
1706 `((accum-imm ((op ,(dpb subop (byte 3 2) #b0000010))))
1707 (rex-accum-imm ((op ,(dpb subop (byte 3 2) #b0000010))))
1708 (reg/mem-imm ((op (#b1000000 ,subop))))
1709 (rex-reg/mem-imm ((op (#b1000000 ,subop))))
1710 ;; The redundant encoding #x82 is invalid in 64-bit mode,
1711 ;; therefore we force WIDTH to 1.
1712 (reg/mem-imm ((op (#b1000001 ,subop)) (width 1)
1713 (imm nil :type signed-imm-byte)))
1714 (rex-reg/mem-imm ((op (#b1000001 ,subop)) (width 1)
1715 (imm nil :type signed-imm-byte)))
1716 (reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))
1717 (rex-reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))))
1720 (define-instruction add (segment dst src)
1721 (:printer-list (arith-inst-printer-list #b000))
1722 (:emitter (emit-random-arith-inst "ADD" segment dst src #b000)))
1724 (define-instruction adc (segment dst src)
1725 (:printer-list (arith-inst-printer-list #b010))
1726 (:emitter (emit-random-arith-inst "ADC" segment dst src #b010)))
1728 (define-instruction sub (segment dst src)
1729 (:printer-list (arith-inst-printer-list #b101))
1730 (:emitter (emit-random-arith-inst "SUB" segment dst src #b101)))
1732 (define-instruction sbb (segment dst src)
1733 (:printer-list (arith-inst-printer-list #b011))
1734 (:emitter (emit-random-arith-inst "SBB" segment dst src #b011)))
1736 (define-instruction cmp (segment dst src)
1737 (:printer-list (arith-inst-printer-list #b111))
1738 (:emitter (emit-random-arith-inst "CMP" segment dst src #b111 t)))
1740 (define-instruction inc (segment dst)
1742 (:printer modrm-reg-no-width ((modrm-reg #b000)))
1744 ;; (:printer rex-reg/mem ((op '(#b11111111 #b001))))
1745 (:printer reg/mem ((op '(#b1111111 #b000))))
1747 (let ((size (operand-size dst)))
1748 (maybe-emit-operand-size-prefix segment size)
1749 (cond #+nil ; these opcodes become REX prefixes in x86-64
1750 ((and (not (eq size :byte)) (register-p dst))
1751 (emit-byte-with-reg segment #b01000 (reg-tn-encoding dst)))
1753 (maybe-emit-rex-for-ea segment dst nil)
1754 (emit-byte segment (if (eq size :byte) #b11111110 #b11111111))
1755 (emit-ea segment dst #b000))))))
1757 (define-instruction dec (segment dst)
1759 (:printer modrm-reg-no-width ((modrm-reg #b001)))
1761 (:printer reg/mem ((op '(#b1111111 #b001))))
1763 (let ((size (operand-size dst)))
1764 (maybe-emit-operand-size-prefix segment size)
1766 ((and (not (eq size :byte)) (register-p dst))
1767 (emit-byte-with-reg segment #b01001 (reg-tn-encoding dst)))
1769 (maybe-emit-rex-for-ea segment dst nil)
1770 (emit-byte segment (if (eq size :byte) #b11111110 #b11111111))
1771 (emit-ea segment dst #b001))))))
1773 (define-instruction neg (segment dst)
1774 (:printer reg/mem ((op '(#b1111011 #b011))))
1775 (:printer rex-reg/mem ((op '(#b1111011 #b011))))
1777 (let ((size (operand-size dst)))
1778 (maybe-emit-operand-size-prefix segment size)
1779 (maybe-emit-rex-for-ea segment dst nil)
1780 (emit-byte segment (if (eq size :byte) #b11110110 #b11110111))
1781 (emit-ea segment dst #b011))))
1783 (define-instruction mul (segment dst src)
1784 (:printer accum-reg/mem ((op '(#b1111011 #b100))))
1785 (:printer rex-accum-reg/mem ((op '(#b1111011 #b100))))
1787 (let ((size (matching-operand-size dst src)))
1788 (aver (accumulator-p dst))
1789 (maybe-emit-operand-size-prefix segment size)
1790 (maybe-emit-rex-for-ea segment src nil)
1791 (emit-byte segment (if (eq size :byte) #b11110110 #b11110111))
1792 (emit-ea segment src #b100))))
1794 (define-instruction imul (segment dst &optional src1 src2)
1795 (:printer accum-reg/mem ((op '(#b1111011 #b101))))
1796 (:printer rex-accum-reg/mem ((op '(#b1111011 #b101))))
1797 (:printer ext-reg-reg/mem-no-width ((op #b10101111)))
1798 (:printer rex-ext-reg-reg/mem-no-width ((op #b10101111)))
1799 (:printer reg-reg/mem ((op #b0110100) (width 1)
1800 (imm nil :type 'signed-imm-data))
1801 '(:name :tab reg ", " reg/mem ", " imm))
1802 (:printer rex-reg-reg/mem ((op #b0110100) (width 1)
1803 (imm nil :type 'signed-imm-data))
1804 '(:name :tab reg ", " reg/mem ", " imm))
1805 (:printer reg-reg/mem ((op #b0110101) (width 1)
1806 (imm nil :type 'signed-imm-byte))
1807 '(:name :tab reg ", " reg/mem ", " imm))
1808 (:printer rex-reg-reg/mem ((op #b0110101) (width 1)
1809 (imm nil :type 'signed-imm-byte))
1810 '(:name :tab reg ", " reg/mem ", " imm))
1812 (flet ((r/m-with-immed-to-reg (reg r/m immed)
1813 (let* ((size (matching-operand-size reg r/m))
1814 (sx (and (not (eq size :byte)) (<= -128 immed 127))))
1815 (maybe-emit-operand-size-prefix segment size)
1816 (maybe-emit-rex-for-ea segment r/m reg)
1817 (emit-byte segment (if sx #b01101011 #b01101001))
1818 (emit-ea segment r/m (reg-tn-encoding reg))
1820 (emit-byte segment immed)
1821 (emit-sized-immediate segment size immed)))))
1823 (r/m-with-immed-to-reg dst src1 src2))
1826 (r/m-with-immed-to-reg dst dst src1)
1827 (let ((size (matching-operand-size dst src1)))
1828 (maybe-emit-operand-size-prefix segment size)
1829 (maybe-emit-rex-for-ea segment src1 dst)
1830 (emit-byte segment #b00001111)
1831 (emit-byte segment #b10101111)
1832 (emit-ea segment src1 (reg-tn-encoding dst)))))
1834 (let ((size (operand-size dst)))
1835 (maybe-emit-operand-size-prefix segment size)
1836 (maybe-emit-rex-for-ea segment dst nil)
1837 (emit-byte segment (if (eq size :byte) #b11110110 #b11110111))
1838 (emit-ea segment dst #b101)))))))
1840 (define-instruction div (segment dst src)
1841 (:printer accum-reg/mem ((op '(#b1111011 #b110))))
1842 (:printer rex-accum-reg/mem ((op '(#b1111011 #b110))))
1844 (let ((size (matching-operand-size dst src)))
1845 (aver (accumulator-p dst))
1846 (maybe-emit-operand-size-prefix segment size)
1847 (maybe-emit-rex-for-ea segment src nil)
1848 (emit-byte segment (if (eq size :byte) #b11110110 #b11110111))
1849 (emit-ea segment src #b110))))
1851 (define-instruction idiv (segment dst src)
1852 (:printer accum-reg/mem ((op '(#b1111011 #b111))))
1853 (:printer rex-accum-reg/mem ((op '(#b1111011 #b111))))
1855 (let ((size (matching-operand-size dst src)))
1856 (aver (accumulator-p dst))
1857 (maybe-emit-operand-size-prefix segment size)
1858 (maybe-emit-rex-for-ea segment src nil)
1859 (emit-byte segment (if (eq size :byte) #b11110110 #b11110111))
1860 (emit-ea segment src #b111))))
1862 (define-instruction bswap (segment dst)
1863 (:printer ext-reg-no-width ((op #b11001)))
1865 (let ((size (operand-size dst)))
1866 (maybe-emit-rex-prefix segment size nil nil dst)
1867 (emit-byte segment #x0f)
1868 (emit-byte-with-reg segment #b11001 (reg-tn-encoding dst)))))
1870 ;;; CBW -- Convert Byte to Word. AX <- sign_xtnd(AL)
1871 (define-instruction cbw (segment)
1872 (:printer x66-byte ((op #b10011000)))
1874 (maybe-emit-operand-size-prefix segment :word)
1875 (emit-byte segment #b10011000)))
1877 ;;; CWDE -- Convert Word To Double Word Extended. EAX <- sign_xtnd(AX)
1878 (define-instruction cwde (segment)
1879 (:printer byte ((op #b10011000)))
1881 (maybe-emit-operand-size-prefix segment :dword)
1882 (emit-byte segment #b10011000)))
1884 ;;; CDQE -- Convert Word To Double Word Extended. RAX <- sign_xtnd(EAX)
1885 (define-instruction cdqe (segment)
1886 (:printer rex-byte ((op #b10011000)))
1888 (maybe-emit-rex-prefix segment :qword nil nil nil)
1889 (emit-byte segment #b10011000)))
1891 ;;; CWD -- Convert Word to Double Word. DX:AX <- sign_xtnd(AX)
1892 (define-instruction cwd (segment)
1893 (:printer x66-byte ((op #b10011001)))
1895 (maybe-emit-operand-size-prefix segment :word)
1896 (emit-byte segment #b10011001)))
1898 ;;; CDQ -- Convert Double Word to Quad Word. EDX:EAX <- sign_xtnd(EAX)
1899 (define-instruction cdq (segment)
1900 (:printer byte ((op #b10011001)))
1902 (maybe-emit-operand-size-prefix segment :dword)
1903 (emit-byte segment #b10011001)))
1905 ;;; CQO -- Convert Quad Word to Octaword. RDX:RAX <- sign_xtnd(RAX)
1906 (define-instruction cqo (segment)
1907 (:printer rex-byte ((op #b10011001)))
1909 (maybe-emit-rex-prefix segment :qword nil nil nil)
1910 (emit-byte segment #b10011001)))
1912 (define-instruction xadd (segment dst src)
1913 ;; Register/Memory with Register.
1914 (:printer ext-reg-reg/mem ((op #b1100000)) '(:name :tab reg/mem ", " reg))
1916 (aver (register-p src))
1917 (let ((size (matching-operand-size src dst)))
1918 (maybe-emit-operand-size-prefix segment size)
1919 (maybe-emit-rex-for-ea segment dst src)
1920 (emit-byte segment #b00001111)
1921 (emit-byte segment (if (eq size :byte) #b11000000 #b11000001))
1922 (emit-ea segment dst (reg-tn-encoding src)))))
1927 (defun emit-shift-inst (segment dst amount opcode)
1928 (let ((size (operand-size dst)))
1929 (maybe-emit-operand-size-prefix segment size)
1930 (multiple-value-bind (major-opcode immed)
1932 (:cl (values #b11010010 nil))
1933 (1 (values #b11010000 nil))
1934 (t (values #b11000000 t)))
1935 (maybe-emit-rex-for-ea segment dst nil)
1937 (if (eq size :byte) major-opcode (logior major-opcode 1)))
1938 (emit-ea segment dst opcode)
1940 (emit-byte segment amount)))))
1942 (eval-when (:compile-toplevel :execute)
1943 (defun shift-inst-printer-list (subop)
1944 `((reg/mem ((op (#b1101000 ,subop)))
1945 (:name :tab reg/mem ", 1"))
1946 (rex-reg/mem ((op (#b1101000 ,subop)))
1947 (:name :tab reg/mem ", 1"))
1948 (reg/mem ((op (#b1101001 ,subop)))
1949 (:name :tab reg/mem ", " 'cl))
1950 (rex-reg/mem ((op (#b1101001 ,subop)))
1951 (:name :tab reg/mem ", " 'cl))
1952 (reg/mem-imm ((op (#b1100000 ,subop))
1953 (imm nil :type imm-byte)))
1954 (rex-reg/mem-imm ((op (#b1100000 ,subop))
1955 (imm nil :type imm-byte))))))
1957 (define-instruction rol (segment dst amount)
1959 (shift-inst-printer-list #b000))
1961 (emit-shift-inst segment dst amount #b000)))
1963 (define-instruction ror (segment dst amount)
1965 (shift-inst-printer-list #b001))
1967 (emit-shift-inst segment dst amount #b001)))
1969 (define-instruction rcl (segment dst amount)
1971 (shift-inst-printer-list #b010))
1973 (emit-shift-inst segment dst amount #b010)))
1975 (define-instruction rcr (segment dst amount)
1977 (shift-inst-printer-list #b011))
1979 (emit-shift-inst segment dst amount #b011)))
1981 (define-instruction shl (segment dst amount)
1983 (shift-inst-printer-list #b100))
1985 (emit-shift-inst segment dst amount #b100)))
1987 (define-instruction shr (segment dst amount)
1989 (shift-inst-printer-list #b101))
1991 (emit-shift-inst segment dst amount #b101)))
1993 (define-instruction sar (segment dst amount)
1995 (shift-inst-printer-list #b111))
1997 (emit-shift-inst segment dst amount #b111)))
1999 (defun emit-double-shift (segment opcode dst src amt)
2000 (let ((size (matching-operand-size dst src)))
2001 (when (eq size :byte)
2002 (error "Double shifts can only be used with words."))
2003 (maybe-emit-operand-size-prefix segment size)
2004 (maybe-emit-rex-for-ea segment dst src)
2005 (emit-byte segment #b00001111)
2006 (emit-byte segment (dpb opcode (byte 1 3)
2007 (if (eq amt :cl) #b10100101 #b10100100)))
2008 (emit-ea segment dst (reg-tn-encoding src))
2009 (unless (eq amt :cl)
2010 (emit-byte segment amt))))
2012 (eval-when (:compile-toplevel :execute)
2013 (defun double-shift-inst-printer-list (op)
2015 (ext-reg-reg/mem-imm ((op ,(logior op #b100))
2016 (imm nil :type signed-imm-byte)))
2017 (ext-reg-reg/mem ((op ,(logior op #b101)))
2018 (:name :tab reg/mem ", " 'cl)))))
2020 (define-instruction shld (segment dst src amt)
2021 (:declare (type (or (member :cl) (mod 32)) amt))
2022 (:printer-list (double-shift-inst-printer-list #b10100000))
2024 (emit-double-shift segment #b0 dst src amt)))
2026 (define-instruction shrd (segment dst src amt)
2027 (:declare (type (or (member :cl) (mod 32)) amt))
2028 (:printer-list (double-shift-inst-printer-list #b10101000))
2030 (emit-double-shift segment #b1 dst src amt)))
2032 (define-instruction and (segment dst src)
2034 (arith-inst-printer-list #b100))
2036 (emit-random-arith-inst "AND" segment dst src #b100)))
2038 (define-instruction test (segment this that)
2039 (:printer accum-imm ((op #b1010100)))
2040 (:printer rex-accum-imm ((op #b1010100)))
2041 (:printer reg/mem-imm ((op '(#b1111011 #b000))))
2042 (:printer rex-reg/mem-imm ((op '(#b1111011 #b000))))
2043 (:printer reg-reg/mem ((op #b1000010)))
2044 (:printer rex-reg-reg/mem ((op #b1000010)))
2046 (let ((size (matching-operand-size this that)))
2047 (maybe-emit-operand-size-prefix segment size)
2048 (flet ((test-immed-and-something (immed something)
2049 (cond ((accumulator-p something)
2050 (maybe-emit-rex-for-ea segment something nil)
2052 (if (eq size :byte) #b10101000 #b10101001))
2053 (emit-sized-immediate segment size immed))
2055 (maybe-emit-rex-for-ea segment something nil)
2057 (if (eq size :byte) #b11110110 #b11110111))
2058 (emit-ea segment something #b000)
2059 (emit-sized-immediate segment size immed))))
2060 (test-reg-and-something (reg something)
2061 (maybe-emit-rex-for-ea segment something reg)
2062 (emit-byte segment (if (eq size :byte) #b10000100 #b10000101))
2063 (emit-ea segment something (reg-tn-encoding reg))))
2064 (cond ((integerp that)
2065 (test-immed-and-something that this))
2067 (test-immed-and-something this that))
2069 (test-reg-and-something this that))
2071 (test-reg-and-something that this))
2073 (error "bogus operands for TEST: ~S and ~S" this that)))))))
2075 (define-instruction or (segment dst src)
2077 (arith-inst-printer-list #b001))
2079 (emit-random-arith-inst "OR" segment dst src #b001)))
2081 (define-instruction xor (segment dst src)
2083 (arith-inst-printer-list #b110))
2085 (emit-random-arith-inst "XOR" segment dst src #b110)))
2087 (define-instruction not (segment dst)
2088 (:printer reg/mem ((op '(#b1111011 #b010))))
2089 (:printer rex-reg/mem ((op '(#b1111011 #b010))))
2091 (let ((size (operand-size dst)))
2092 (maybe-emit-operand-size-prefix segment size)
2093 (maybe-emit-rex-for-ea segment dst nil)
2094 (emit-byte segment (if (eq size :byte) #b11110110 #b11110111))
2095 (emit-ea segment dst #b010))))
2097 ;;;; string manipulation
2099 (define-instruction cmps (segment size)
2100 (:printer string-op ((op #b1010011)))
2101 (:printer rex-string-op ((op #b1010011)))
2103 (maybe-emit-operand-size-prefix segment size)
2104 (maybe-emit-rex-prefix segment size nil nil nil)
2105 (emit-byte segment (if (eq size :byte) #b10100110 #b10100111))))
2107 (define-instruction ins (segment acc)
2108 (:printer string-op ((op #b0110110)))
2109 (:printer rex-string-op ((op #b0110110)))
2111 (let ((size (operand-size acc)))
2112 (aver (accumulator-p acc))
2113 (maybe-emit-operand-size-prefix segment size)
2114 (maybe-emit-rex-prefix segment size nil nil nil)
2115 (emit-byte segment (if (eq size :byte) #b01101100 #b01101101)))))
2117 (define-instruction lods (segment acc)
2118 (:printer string-op ((op #b1010110)))
2119 (:printer rex-string-op ((op #b1010110)))
2121 (let ((size (operand-size acc)))
2122 (aver (accumulator-p acc))
2123 (maybe-emit-operand-size-prefix segment size)
2124 (maybe-emit-rex-prefix segment size nil nil nil)
2125 (emit-byte segment (if (eq size :byte) #b10101100 #b10101101)))))
2127 (define-instruction movs (segment size)
2128 (:printer string-op ((op #b1010010)))
2129 (:printer rex-string-op ((op #b1010010)))
2131 (maybe-emit-operand-size-prefix segment size)
2132 (maybe-emit-rex-prefix segment size nil nil nil)
2133 (emit-byte segment (if (eq size :byte) #b10100100 #b10100101))))
2135 (define-instruction outs (segment acc)
2136 (:printer string-op ((op #b0110111)))
2137 (:printer rex-string-op ((op #b0110111)))
2139 (let ((size (operand-size acc)))
2140 (aver (accumulator-p acc))
2141 (maybe-emit-operand-size-prefix segment size)
2142 (maybe-emit-rex-prefix segment size nil nil nil)
2143 (emit-byte segment (if (eq size :byte) #b01101110 #b01101111)))))
2145 (define-instruction scas (segment acc)
2146 (:printer string-op ((op #b1010111)))
2147 (:printer rex-string-op ((op #b1010111)))
2149 (let ((size (operand-size acc)))
2150 (aver (accumulator-p acc))
2151 (maybe-emit-operand-size-prefix segment size)
2152 (maybe-emit-rex-prefix segment size nil nil nil)
2153 (emit-byte segment (if (eq size :byte) #b10101110 #b10101111)))))
2155 (define-instruction stos (segment acc)
2156 (:printer string-op ((op #b1010101)))
2157 (:printer rex-string-op ((op #b1010101)))
2159 (let ((size (operand-size acc)))
2160 (aver (accumulator-p acc))
2161 (maybe-emit-operand-size-prefix segment size)
2162 (maybe-emit-rex-prefix segment size nil nil nil)
2163 (emit-byte segment (if (eq size :byte) #b10101010 #b10101011)))))
2165 (define-instruction xlat (segment)
2166 (:printer byte ((op #b11010111)))
2168 (emit-byte segment #b11010111)))
2170 (define-instruction rep (segment)
2172 (emit-byte segment #b11110010)))
2174 (define-instruction repe (segment)
2175 (:printer byte ((op #b11110011)))
2177 (emit-byte segment #b11110011)))
2179 (define-instruction repne (segment)
2180 (:printer byte ((op #b11110010)))
2182 (emit-byte segment #b11110010)))
2185 ;;;; bit manipulation
2187 (define-instruction bsf (segment dst src)
2188 (:printer ext-reg-reg/mem-no-width ((op #b10111100)))
2189 (:printer rex-ext-reg-reg/mem-no-width ((op #b10111100)))
2191 (let ((size (matching-operand-size dst src)))
2192 (when (eq size :byte)
2193 (error "can't scan bytes: ~S" src))
2194 (maybe-emit-operand-size-prefix segment size)
2195 (maybe-emit-rex-for-ea segment src dst)
2196 (emit-byte segment #b00001111)
2197 (emit-byte segment #b10111100)
2198 (emit-ea segment src (reg-tn-encoding dst)))))
2200 (define-instruction bsr (segment dst src)
2201 (:printer ext-reg-reg/mem-no-width ((op #b10111101)))
2202 (:printer rex-ext-reg-reg/mem-no-width ((op #b10111101)))
2204 (let ((size (matching-operand-size dst src)))
2205 (when (eq size :byte)
2206 (error "can't scan bytes: ~S" src))
2207 (maybe-emit-operand-size-prefix segment size)
2208 (maybe-emit-rex-for-ea segment src dst)
2209 (emit-byte segment #b00001111)
2210 (emit-byte segment #b10111101)
2211 (emit-ea segment src (reg-tn-encoding dst)))))
2213 (defun emit-bit-test-and-mumble (segment src index opcode)
2214 (let ((size (operand-size src)))
2215 (when (eq size :byte)
2216 (error "can't scan bytes: ~S" src))
2217 (maybe-emit-operand-size-prefix segment size)
2218 (cond ((integerp index)
2219 (maybe-emit-rex-for-ea segment src nil)
2220 (emit-byte segment #b00001111)
2221 (emit-byte segment #b10111010)
2222 (emit-ea segment src opcode)
2223 (emit-byte segment index))
2225 (maybe-emit-rex-for-ea segment src index)
2226 (emit-byte segment #b00001111)
2227 (emit-byte segment (dpb opcode (byte 3 3) #b10000011))
2228 (emit-ea segment src (reg-tn-encoding index))))))
2230 (eval-when (:compile-toplevel :execute)
2231 (defun bit-test-inst-printer-list (subop)
2232 `((ext-reg/mem-imm ((op (#b1011101 ,subop))
2233 (reg/mem nil :type reg/mem)
2234 (imm nil :type imm-byte)
2236 (ext-reg-reg/mem ((op ,(dpb subop (byte 3 2) #b1000001))
2238 (:name :tab reg/mem ", " reg)))))
2240 (define-instruction bt (segment src index)
2241 (:printer-list (bit-test-inst-printer-list #b100))
2243 (emit-bit-test-and-mumble segment src index #b100)))
2245 (define-instruction btc (segment src index)
2246 (:printer-list (bit-test-inst-printer-list #b111))
2248 (emit-bit-test-and-mumble segment src index #b111)))
2250 (define-instruction btr (segment src index)
2251 (:printer-list (bit-test-inst-printer-list #b110))
2253 (emit-bit-test-and-mumble segment src index #b110)))
2255 (define-instruction bts (segment src index)
2256 (:printer-list (bit-test-inst-printer-list #b101))
2258 (emit-bit-test-and-mumble segment src index #b101)))
2261 ;;;; control transfer
2263 (define-instruction call (segment where)
2264 (:printer near-jump ((op #b11101000)))
2265 (:printer reg/mem-default-qword ((op '(#b11111111 #b010))))
2266 (:printer rex-reg/mem-default-qword ((op '(#b11111111 #b010))))
2270 (maybe-emit-rex-for-ea segment where nil)
2271 (emit-byte segment #b11101000) ; 32 bit relative
2272 (emit-back-patch segment
2274 (lambda (segment posn)
2276 (- (label-position where)
2279 (maybe-emit-rex-for-ea segment where nil)
2280 (emit-byte segment #b11101000)
2281 (emit-relative-fixup segment where))
2283 (maybe-emit-rex-for-ea segment where nil)
2284 (emit-byte segment #b11111111)
2285 (emit-ea segment where #b010)))))
2287 (defun emit-byte-displacement-backpatch (segment target)
2288 (emit-back-patch segment
2290 (lambda (segment posn)
2291 (let ((disp (- (label-position target) (1+ posn))))
2292 (aver (<= -128 disp 127))
2293 (emit-byte segment disp)))))
2295 (define-instruction jmp (segment cond &optional where)
2296 ;; conditional jumps
2297 (:printer short-cond-jump ((op #b0111)) '('j cc :tab label))
2298 (:printer near-cond-jump () '('j cc :tab label))
2299 ;; unconditional jumps
2300 (:printer short-jump ((op #b1011)))
2301 (:printer near-jump ((op #b11101001)) )
2302 (:printer reg/mem-default-qword ((op '(#b11111111 #b100))))
2303 (:printer rex-reg/mem-default-qword ((op '(#b11111111 #b100))))
2308 (lambda (segment posn delta-if-after)
2309 (let ((disp (- (label-position where posn delta-if-after)
2311 (when (<= -128 disp 127)
2313 (dpb (conditional-opcode cond)
2316 (emit-byte-displacement-backpatch segment where)
2318 (lambda (segment posn)
2319 (let ((disp (- (label-position where) (+ posn 6))))
2320 (emit-byte segment #b00001111)
2322 (dpb (conditional-opcode cond)
2325 (emit-dword segment disp)))))
2326 ((label-p (setq where cond))
2329 (lambda (segment posn delta-if-after)
2330 (let ((disp (- (label-position where posn delta-if-after)
2332 (when (<= -128 disp 127)
2333 (emit-byte segment #b11101011)
2334 (emit-byte-displacement-backpatch segment where)
2336 (lambda (segment posn)
2337 (let ((disp (- (label-position where) (+ posn 5))))
2338 (emit-byte segment #b11101001)
2339 (emit-dword segment disp)))))
2341 (emit-byte segment #b11101001)
2342 (emit-relative-fixup segment where))
2344 (unless (or (ea-p where) (tn-p where))
2345 (error "don't know what to do with ~A" where))
2346 ;; near jump defaults to 64 bit
2347 ;; w-bit in rex prefix is unnecessary
2348 (maybe-emit-rex-for-ea segment where nil :operand-size :dword)
2349 (emit-byte segment #b11111111)
2350 (emit-ea segment where #b100)))))
2352 (define-instruction jmp-short (segment label)
2354 (emit-byte segment #b11101011)
2355 (emit-byte-displacement-backpatch segment label)))
2357 (define-instruction ret (segment &optional stack-delta)
2358 (:printer byte ((op #b11000011)))
2359 (:printer byte ((op #b11000010) (imm nil :type 'imm-word-16))
2363 (emit-byte segment #b11000010)
2364 (emit-word segment stack-delta))
2366 (emit-byte segment #b11000011)))))
2368 (define-instruction jecxz (segment target)
2369 (:printer short-jump ((op #b0011)))
2371 (emit-byte segment #b11100011)
2372 (emit-byte-displacement-backpatch segment target)))
2374 (define-instruction loop (segment target)
2375 (:printer short-jump ((op #b0010)))
2377 (emit-byte segment #b11100010) ; pfw this was 11100011, or jecxz!!!!
2378 (emit-byte-displacement-backpatch segment target)))
2380 (define-instruction loopz (segment target)
2381 (:printer short-jump ((op #b0001)))
2383 (emit-byte segment #b11100001)
2384 (emit-byte-displacement-backpatch segment target)))
2386 (define-instruction loopnz (segment target)
2387 (:printer short-jump ((op #b0000)))
2389 (emit-byte segment #b11100000)
2390 (emit-byte-displacement-backpatch segment target)))
2392 ;;;; conditional move
2393 (define-instruction cmov (segment cond dst src)
2394 (:printer cond-move ())
2395 (:printer rex-cond-move ())
2397 (aver (register-p dst))
2398 (let ((size (matching-operand-size dst src)))
2399 (aver (or (eq size :word) (eq size :dword) (eq size :qword) ))
2400 (maybe-emit-operand-size-prefix segment size))
2401 (maybe-emit-rex-for-ea segment src dst)
2402 (emit-byte segment #b00001111)
2403 (emit-byte segment (dpb (conditional-opcode cond) (byte 4 0) #b01000000))
2404 (emit-ea segment src (reg-tn-encoding dst))))
2406 ;;;; conditional byte set
2408 (define-instruction set (segment dst cond)
2409 (:printer cond-set ())
2411 (maybe-emit-rex-for-ea segment dst nil)
2412 (emit-byte segment #b00001111)
2413 (emit-byte segment (dpb (conditional-opcode cond) (byte 4 0) #b10010000))
2414 (emit-ea segment dst #b000)))
2418 (define-instruction enter (segment disp &optional (level 0))
2419 (:declare (type (unsigned-byte 16) disp)
2420 (type (unsigned-byte 8) level))
2421 (:printer enter-format ((op #b11001000)))
2423 (emit-byte segment #b11001000)
2424 (emit-word segment disp)
2425 (emit-byte segment level)))
2427 (define-instruction leave (segment)
2428 (:printer byte ((op #b11001001)))
2430 (emit-byte segment #b11001001)))
2432 ;;;; interrupt instructions
2434 (defun snarf-error-junk (sap offset &optional length-only)
2435 (let* ((length (sb!sys:sap-ref-8 sap offset))
2436 (vector (make-array length :element-type '(unsigned-byte 8))))
2437 (declare (type sb!sys:system-area-pointer sap)
2438 (type (unsigned-byte 8) length)
2439 (type (simple-array (unsigned-byte 8) (*)) vector))
2441 (values 0 (1+ length) nil nil))
2443 (sb!kernel:copy-ub8-from-system-area sap (1+ offset)
2445 (collect ((sc-offsets)
2447 (lengths 1) ; the length byte
2449 (error-number (sb!c:read-var-integer vector index)))
2452 (when (>= index length)
2454 (let ((old-index index))
2455 (sc-offsets (sb!c:read-var-integer vector index))
2456 (lengths (- index old-index))))
2457 (values error-number
2463 (defmacro break-cases (breaknum &body cases)
2464 (let ((bn-temp (gensym)))
2465 (collect ((clauses))
2466 (dolist (case cases)
2467 (clauses `((= ,bn-temp ,(car case)) ,@(cdr case))))
2468 `(let ((,bn-temp ,breaknum))
2469 (cond ,@(clauses))))))
2472 (defun break-control (chunk inst stream dstate)
2473 (declare (ignore inst))
2474 (flet ((nt (x) (if stream (sb!disassem:note x dstate))))
2475 ;; FIXME: Make sure that BYTE-IMM-CODE is defined. The genesis
2476 ;; map has it undefined; and it should be easier to look in the target
2477 ;; Lisp (with (DESCRIBE 'BYTE-IMM-CODE)) than to definitively deduce
2478 ;; from first principles whether it's defined in some way that genesis
2480 (case (byte-imm-code chunk dstate)
2483 (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
2486 (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
2488 (nt "breakpoint trap"))
2489 (#.pending-interrupt-trap
2490 (nt "pending interrupt trap"))
2493 (#.fun-end-breakpoint-trap
2494 (nt "function end breakpoint trap")))))
2496 (define-instruction break (segment code)
2497 (:declare (type (unsigned-byte 8) code))
2498 (:printer byte-imm ((op #b11001100)) '(:name :tab code)
2499 :control #'break-control)
2501 (emit-byte segment #b11001100)
2502 (emit-byte segment code)))
2504 (define-instruction int (segment number)
2505 (:declare (type (unsigned-byte 8) number))
2506 (:printer byte-imm ((op #b11001101)))
2510 (emit-byte segment #b11001100))
2512 (emit-byte segment #b11001101)
2513 (emit-byte segment number)))))
2515 (define-instruction into (segment)
2516 (:printer byte ((op #b11001110)))
2518 (emit-byte segment #b11001110)))
2520 (define-instruction bound (segment reg bounds)
2522 (let ((size (matching-operand-size reg bounds)))
2523 (when (eq size :byte)
2524 (error "can't bounds-test bytes: ~S" reg))
2525 (maybe-emit-operand-size-prefix segment size)
2526 (maybe-emit-rex-for-ea segment bounds reg)
2527 (emit-byte segment #b01100010)
2528 (emit-ea segment bounds (reg-tn-encoding reg)))))
2530 (define-instruction iret (segment)
2531 (:printer byte ((op #b11001111)))
2533 (emit-byte segment #b11001111)))
2535 ;;;; processor control
2537 (define-instruction hlt (segment)
2538 (:printer byte ((op #b11110100)))
2540 (emit-byte segment #b11110100)))
2542 (define-instruction nop (segment)
2543 (:printer byte ((op #b10010000)))
2545 (emit-byte segment #b10010000)))
2547 (define-instruction wait (segment)
2548 (:printer byte ((op #b10011011)))
2550 (emit-byte segment #b10011011)))
2552 (define-instruction lock (segment)
2553 (:printer byte ((op #b11110000)))
2555 (emit-byte segment #b11110000)))
2557 ;;;; miscellaneous hackery
2559 (define-instruction byte (segment byte)
2561 (emit-byte segment byte)))
2563 (define-instruction word (segment word)
2565 (emit-word segment word)))
2567 (define-instruction dword (segment dword)
2569 (emit-dword segment dword)))
2571 (defun emit-header-data (segment type)
2572 (emit-back-patch segment
2574 (lambda (segment posn)
2578 (component-header-length))
2582 (define-instruction simple-fun-header-word (segment)
2584 (emit-header-data segment simple-fun-header-widetag)))
2586 (define-instruction lra-header-word (segment)
2588 (emit-header-data segment return-pc-header-widetag)))
2590 ;;;; fp instructions
2592 ;;;; Note: We treat the single-precision and double-precision variants
2593 ;;;; as separate instructions.
2595 ;;; Load single to st(0).
2596 (define-instruction fld (segment source)
2597 (:printer floating-point ((op '(#b001 #b000))))
2599 (and (not (fp-reg-tn-p source))
2600 (maybe-emit-rex-for-ea segment source nil))
2601 (emit-byte segment #b11011001)
2602 (emit-fp-op segment source #b000)))
2604 ;;; Load double to st(0).
2605 (define-instruction fldd (segment source)
2606 (:printer floating-point ((op '(#b101 #b000))))
2607 (:printer floating-point-fp ((op '(#b001 #b000))))
2609 (if (fp-reg-tn-p source)
2610 (emit-byte segment #b11011001)
2612 (maybe-emit-rex-for-ea segment source nil)
2613 (emit-byte segment #b11011101)))
2614 (emit-fp-op segment source #b000)))
2616 ;;; Load long to st(0).
2617 (define-instruction fldl (segment source)
2618 (:printer floating-point ((op '(#b011 #b101))))
2620 (and (not (fp-reg-tn-p source))
2621 (maybe-emit-rex-for-ea segment source nil))
2622 (emit-byte segment #b11011011)
2623 (emit-fp-op segment source #b101)))
2625 ;;; Store single from st(0).
2626 (define-instruction fst (segment dest)
2627 (:printer floating-point ((op '(#b001 #b010))))
2629 (cond ((fp-reg-tn-p dest)
2630 (emit-byte segment #b11011101)
2631 (emit-fp-op segment dest #b010))
2633 (maybe-emit-rex-for-ea segment dest nil)
2634 (emit-byte segment #b11011001)
2635 (emit-fp-op segment dest #b010)))))
2637 ;;; Store double from st(0).
2638 (define-instruction fstd (segment dest)
2639 (:printer floating-point ((op '(#b101 #b010))))
2640 (:printer floating-point-fp ((op '(#b101 #b010))))
2642 (cond ((fp-reg-tn-p dest)
2643 (emit-byte segment #b11011101)
2644 (emit-fp-op segment dest #b010))
2646 (maybe-emit-rex-for-ea segment dest nil)
2647 (emit-byte segment #b11011101)
2648 (emit-fp-op segment dest #b010)))))
2650 ;;; Arithmetic ops are all done with at least one operand at top of
2651 ;;; stack. The other operand is is another register or a 32/64 bit
2654 ;;; dtc: I've tried to follow the Intel ASM386 conventions, but note
2655 ;;; that these conflict with the Gdb conventions for binops. To reduce
2656 ;;; the confusion I've added comments showing the mathamatical
2657 ;;; operation and the two syntaxes. By the ASM386 convention the
2658 ;;; instruction syntax is:
2661 ;;; or Fop Destination, Source
2663 ;;; If only one operand is given then it is the source and the
2664 ;;; destination is ST(0). There are reversed forms of the fsub and
2665 ;;; fdiv instructions inducated by an 'R' suffix.
2667 ;;; The mathematical operation for the non-reverse form is always:
2668 ;;; destination = destination op source
2670 ;;; For the reversed form it is:
2671 ;;; destination = source op destination
2673 ;;; The instructions below only accept one operand at present which is
2674 ;;; usually the source. I've hack in extra instructions to implement
2675 ;;; the fops with a ST(i) destination, these have a -sti suffix and
2676 ;;; the operand is the destination with the source being ST(0).
2679 ;;; st(0) = st(0) + memory or st(i).
2680 (define-instruction fadd (segment source)
2681 (:printer floating-point ((op '(#b000 #b000))))
2683 (and (not (fp-reg-tn-p source))
2684 (maybe-emit-rex-for-ea segment source nil))
2685 (emit-byte segment #b11011000)
2686 (emit-fp-op segment source #b000)))
2689 ;;; st(0) = st(0) + memory or st(i).
2690 (define-instruction faddd (segment source)
2691 (:printer floating-point ((op '(#b100 #b000))))
2692 (:printer floating-point-fp ((op '(#b000 #b000))))
2694 (and (not (fp-reg-tn-p source))
2695 (maybe-emit-rex-for-ea segment source nil))
2696 (if (fp-reg-tn-p source)
2697 (emit-byte segment #b11011000)
2698 (emit-byte segment #b11011100))
2699 (emit-fp-op segment source #b000)))
2701 ;;; Add double destination st(i):
2702 ;;; st(i) = st(0) + st(i).
2703 (define-instruction fadd-sti (segment destination)
2704 (:printer floating-point-fp ((op '(#b100 #b000))))
2706 (aver (fp-reg-tn-p destination))
2707 (emit-byte segment #b11011100)
2708 (emit-fp-op segment destination #b000)))
2710 (define-instruction faddp-sti (segment destination)
2711 (:printer floating-point-fp ((op '(#b110 #b000))))
2713 (aver (fp-reg-tn-p destination))
2714 (emit-byte segment #b11011110)
2715 (emit-fp-op segment destination #b000)))
2717 ;;; Subtract single:
2718 ;;; st(0) = st(0) - memory or st(i).
2719 (define-instruction fsub (segment source)
2720 (:printer floating-point ((op '(#b000 #b100))))
2722 (and (not (fp-reg-tn-p source))
2723 (maybe-emit-rex-for-ea segment source nil))
2724 (emit-byte segment #b11011000)
2725 (emit-fp-op segment source #b100)))
2727 ;;; Subtract single, reverse:
2728 ;;; st(0) = memory or st(i) - st(0).
2729 (define-instruction fsubr (segment source)
2730 (:printer floating-point ((op '(#b000 #b101))))
2732 (and (not (fp-reg-tn-p source))
2733 (maybe-emit-rex-for-ea segment source nil))
2734 (emit-byte segment #b11011000)
2735 (emit-fp-op segment source #b101)))
2737 ;;; Subtract double:
2738 ;;; st(0) = st(0) - memory or st(i).
2739 (define-instruction fsubd (segment source)
2740 (:printer floating-point ((op '(#b100 #b100))))
2741 (:printer floating-point-fp ((op '(#b000 #b100))))
2743 (if (fp-reg-tn-p source)
2744 (emit-byte segment #b11011000)
2746 (and (not (fp-reg-tn-p source))
2747 (maybe-emit-rex-for-ea segment source nil))
2748 (emit-byte segment #b11011100)))
2749 (emit-fp-op segment source #b100)))
2751 ;;; Subtract double, reverse:
2752 ;;; st(0) = memory or st(i) - st(0).
2753 (define-instruction fsubrd (segment source)
2754 (:printer floating-point ((op '(#b100 #b101))))
2755 (:printer floating-point-fp ((op '(#b000 #b101))))
2757 (if (fp-reg-tn-p source)
2758 (emit-byte segment #b11011000)
2760 (and (not (fp-reg-tn-p source))
2761 (maybe-emit-rex-for-ea segment source nil))
2762 (emit-byte segment #b11011100)))
2763 (emit-fp-op segment source #b101)))
2765 ;;; Subtract double, destination st(i):
2766 ;;; st(i) = st(i) - st(0).
2768 ;;; ASM386 syntax: FSUB ST(i), ST
2769 ;;; Gdb syntax: fsubr %st,%st(i)
2770 (define-instruction fsub-sti (segment destination)
2771 (:printer floating-point-fp ((op '(#b100 #b101))))
2773 (aver (fp-reg-tn-p destination))
2774 (emit-byte segment #b11011100)
2775 (emit-fp-op segment destination #b101)))
2777 (define-instruction fsubp-sti (segment destination)
2778 (:printer floating-point-fp ((op '(#b110 #b101))))
2780 (aver (fp-reg-tn-p destination))
2781 (emit-byte segment #b11011110)
2782 (emit-fp-op segment destination #b101)))
2784 ;;; Subtract double, reverse, destination st(i):
2785 ;;; st(i) = st(0) - st(i).
2787 ;;; ASM386 syntax: FSUBR ST(i), ST
2788 ;;; Gdb syntax: fsub %st,%st(i)
2789 (define-instruction fsubr-sti (segment destination)
2790 (:printer floating-point-fp ((op '(#b100 #b100))))
2792 (aver (fp-reg-tn-p destination))
2793 (emit-byte segment #b11011100)
2794 (emit-fp-op segment destination #b100)))
2796 (define-instruction fsubrp-sti (segment destination)
2797 (:printer floating-point-fp ((op '(#b110 #b100))))
2799 (aver (fp-reg-tn-p destination))
2800 (emit-byte segment #b11011110)
2801 (emit-fp-op segment destination #b100)))
2803 ;;; Multiply single:
2804 ;;; st(0) = st(0) * memory or st(i).
2805 (define-instruction fmul (segment source)
2806 (:printer floating-point ((op '(#b000 #b001))))
2808 (and (not (fp-reg-tn-p source))
2809 (maybe-emit-rex-for-ea segment source nil))
2810 (emit-byte segment #b11011000)
2811 (emit-fp-op segment source #b001)))
2813 ;;; Multiply double:
2814 ;;; st(0) = st(0) * memory or st(i).
2815 (define-instruction fmuld (segment source)
2816 (:printer floating-point ((op '(#b100 #b001))))
2817 (:printer floating-point-fp ((op '(#b000 #b001))))
2819 (if (fp-reg-tn-p source)
2820 (emit-byte segment #b11011000)
2822 (and (not (fp-reg-tn-p source))
2823 (maybe-emit-rex-for-ea segment source nil))
2824 (emit-byte segment #b11011100)))
2825 (emit-fp-op segment source #b001)))
2827 ;;; Multiply double, destination st(i):
2828 ;;; st(i) = st(i) * st(0).
2829 (define-instruction fmul-sti (segment destination)
2830 (:printer floating-point-fp ((op '(#b100 #b001))))
2832 (aver (fp-reg-tn-p destination))
2833 (emit-byte segment #b11011100)
2834 (emit-fp-op segment destination #b001)))
2837 ;;; st(0) = st(0) / memory or st(i).
2838 (define-instruction fdiv (segment source)
2839 (:printer floating-point ((op '(#b000 #b110))))
2841 (and (not (fp-reg-tn-p source))
2842 (maybe-emit-rex-for-ea segment source nil))
2843 (emit-byte segment #b11011000)
2844 (emit-fp-op segment source #b110)))
2846 ;;; Divide single, reverse:
2847 ;;; st(0) = memory or st(i) / st(0).
2848 (define-instruction fdivr (segment source)
2849 (:printer floating-point ((op '(#b000 #b111))))
2851 (and (not (fp-reg-tn-p source))
2852 (maybe-emit-rex-for-ea segment source nil))
2853 (emit-byte segment #b11011000)
2854 (emit-fp-op segment source #b111)))
2857 ;;; st(0) = st(0) / memory or st(i).
2858 (define-instruction fdivd (segment source)
2859 (:printer floating-point ((op '(#b100 #b110))))
2860 (:printer floating-point-fp ((op '(#b000 #b110))))
2862 (if (fp-reg-tn-p source)
2863 (emit-byte segment #b11011000)
2865 (and (not (fp-reg-tn-p source))
2866 (maybe-emit-rex-for-ea segment source nil))
2867 (emit-byte segment #b11011100)))
2868 (emit-fp-op segment source #b110)))
2870 ;;; Divide double, reverse:
2871 ;;; st(0) = memory or st(i) / st(0).
2872 (define-instruction fdivrd (segment source)
2873 (:printer floating-point ((op '(#b100 #b111))))
2874 (:printer floating-point-fp ((op '(#b000 #b111))))
2876 (if (fp-reg-tn-p source)
2877 (emit-byte segment #b11011000)
2879 (and (not (fp-reg-tn-p source))
2880 (maybe-emit-rex-for-ea segment source nil))
2881 (emit-byte segment #b11011100)))
2882 (emit-fp-op segment source #b111)))
2884 ;;; Divide double, destination st(i):
2885 ;;; st(i) = st(i) / st(0).
2887 ;;; ASM386 syntax: FDIV ST(i), ST
2888 ;;; Gdb syntax: fdivr %st,%st(i)
2889 (define-instruction fdiv-sti (segment destination)
2890 (:printer floating-point-fp ((op '(#b100 #b111))))
2892 (aver (fp-reg-tn-p destination))
2893 (emit-byte segment #b11011100)
2894 (emit-fp-op segment destination #b111)))
2896 ;;; Divide double, reverse, destination st(i):
2897 ;;; st(i) = st(0) / st(i).
2899 ;;; ASM386 syntax: FDIVR ST(i), ST
2900 ;;; Gdb syntax: fdiv %st,%st(i)
2901 (define-instruction fdivr-sti (segment destination)
2902 (:printer floating-point-fp ((op '(#b100 #b110))))
2904 (aver (fp-reg-tn-p destination))
2905 (emit-byte segment #b11011100)
2906 (emit-fp-op segment destination #b110)))
2908 ;;; Exchange fr0 with fr(n). (There is no double precision variant.)
2909 (define-instruction fxch (segment source)
2910 (:printer floating-point-fp ((op '(#b001 #b001))))
2912 (unless (and (tn-p source)
2913 (eq (sb-name (sc-sb (tn-sc source))) 'float-registers))
2915 (emit-byte segment #b11011001)
2916 (emit-fp-op segment source #b001)))
2918 ;;; Push 32-bit integer to st0.
2919 (define-instruction fild (segment source)
2920 (:printer floating-point ((op '(#b011 #b000))))
2922 (and (not (fp-reg-tn-p source))
2923 (maybe-emit-rex-for-ea segment source nil))
2924 (emit-byte segment #b11011011)
2925 (emit-fp-op segment source #b000)))
2927 ;;; Push 64-bit integer to st0.
2928 (define-instruction fildl (segment source)
2929 (:printer floating-point ((op '(#b111 #b101))))
2931 (and (not (fp-reg-tn-p source))
2932 (maybe-emit-rex-for-ea segment source nil))
2933 (emit-byte segment #b11011111)
2934 (emit-fp-op segment source #b101)))
2936 ;;; Store 32-bit integer.
2937 (define-instruction fist (segment dest)
2938 (:printer floating-point ((op '(#b011 #b010))))
2940 (and (not (fp-reg-tn-p dest))
2941 (maybe-emit-rex-for-ea segment dest nil))
2942 (emit-byte segment #b11011011)
2943 (emit-fp-op segment dest #b010)))
2945 ;;; Store and pop 32-bit integer.
2946 (define-instruction fistp (segment dest)
2947 (:printer floating-point ((op '(#b011 #b011))))
2949 (and (not (fp-reg-tn-p dest))
2950 (maybe-emit-rex-for-ea segment dest nil))
2951 (emit-byte segment #b11011011)
2952 (emit-fp-op segment dest #b011)))
2954 ;;; Store and pop 64-bit integer.
2955 (define-instruction fistpl (segment dest)
2956 (:printer floating-point ((op '(#b111 #b111))))
2958 (and (not (fp-reg-tn-p dest))
2959 (maybe-emit-rex-for-ea segment dest nil))
2960 (emit-byte segment #b11011111)
2961 (emit-fp-op segment dest #b111)))
2963 ;;; Store single from st(0) and pop.
2964 (define-instruction fstp (segment dest)
2965 (:printer floating-point ((op '(#b001 #b011))))
2967 (cond ((fp-reg-tn-p dest)
2968 (emit-byte segment #b11011101)
2969 (emit-fp-op segment dest #b011))
2971 (maybe-emit-rex-for-ea segment dest nil)
2972 (emit-byte segment #b11011001)
2973 (emit-fp-op segment dest #b011)))))
2975 ;;; Store double from st(0) and pop.
2976 (define-instruction fstpd (segment dest)
2977 (:printer floating-point ((op '(#b101 #b011))))
2978 (:printer floating-point-fp ((op '(#b101 #b011))))
2980 (cond ((fp-reg-tn-p dest)
2981 (emit-byte segment #b11011101)
2982 (emit-fp-op segment dest #b011))
2984 (maybe-emit-rex-for-ea segment dest nil)
2985 (emit-byte segment #b11011101)
2986 (emit-fp-op segment dest #b011)))))
2988 ;;; Store long from st(0) and pop.
2989 (define-instruction fstpl (segment dest)
2990 (:printer floating-point ((op '(#b011 #b111))))
2992 (and (not (fp-reg-tn-p dest))
2993 (maybe-emit-rex-for-ea segment dest nil))
2994 (emit-byte segment #b11011011)
2995 (emit-fp-op segment dest #b111)))
2997 ;;; Decrement stack-top pointer.
2998 (define-instruction fdecstp (segment)
2999 (:printer floating-point-no ((op #b10110)))
3001 (emit-byte segment #b11011001)
3002 (emit-byte segment #b11110110)))
3004 ;;; Increment stack-top pointer.
3005 (define-instruction fincstp (segment)
3006 (:printer floating-point-no ((op #b10111)))
3008 (emit-byte segment #b11011001)
3009 (emit-byte segment #b11110111)))
3011 ;;; Free fp register.
3012 (define-instruction ffree (segment dest)
3013 (:printer floating-point-fp ((op '(#b101 #b000))))
3015 (and (not (fp-reg-tn-p dest))
3016 (maybe-emit-rex-for-ea segment dest nil))
3017 (emit-byte segment #b11011101)
3018 (emit-fp-op segment dest #b000)))
3020 (define-instruction fabs (segment)
3021 (:printer floating-point-no ((op #b00001)))
3023 (emit-byte segment #b11011001)
3024 (emit-byte segment #b11100001)))
3026 (define-instruction fchs (segment)
3027 (:printer floating-point-no ((op #b00000)))
3029 (emit-byte segment #b11011001)
3030 (emit-byte segment #b11100000)))
3032 (define-instruction frndint(segment)
3033 (:printer floating-point-no ((op #b11100)))
3035 (emit-byte segment #b11011001)
3036 (emit-byte segment #b11111100)))
3039 (define-instruction fninit(segment)
3040 (:printer floating-point-5 ((op #b00011)))
3042 (emit-byte segment #b11011011)
3043 (emit-byte segment #b11100011)))
3045 ;;; Store Status Word to AX.
3046 (define-instruction fnstsw(segment)
3047 (:printer floating-point-st ((op #b00000)))
3049 (emit-byte segment #b11011111)
3050 (emit-byte segment #b11100000)))
3052 ;;; Load Control Word.
3054 ;;; src must be a memory location
3055 (define-instruction fldcw(segment src)
3056 (:printer floating-point ((op '(#b001 #b101))))
3058 (and (not (fp-reg-tn-p src))
3059 (maybe-emit-rex-for-ea segment src nil))
3060 (emit-byte segment #b11011001)
3061 (emit-fp-op segment src #b101)))
3063 ;;; Store Control Word.
3064 (define-instruction fnstcw(segment dst)
3065 (:printer floating-point ((op '(#b001 #b111))))
3067 (and (not (fp-reg-tn-p dst))
3068 (maybe-emit-rex-for-ea segment dst nil))
3069 (emit-byte segment #b11011001)
3070 (emit-fp-op segment dst #b111)))
3072 ;;; Store FP Environment.
3073 (define-instruction fstenv(segment dst)
3074 (:printer floating-point ((op '(#b001 #b110))))
3076 (and (not (fp-reg-tn-p dst))
3077 (maybe-emit-rex-for-ea segment dst nil))
3078 (emit-byte segment #b11011001)
3079 (emit-fp-op segment dst #b110)))
3081 ;;; Restore FP Environment.
3082 (define-instruction fldenv(segment src)
3083 (:printer floating-point ((op '(#b001 #b100))))
3085 (and (not (fp-reg-tn-p src))
3086 (maybe-emit-rex-for-ea segment src nil))
3087 (emit-byte segment #b11011001)
3088 (emit-fp-op segment src #b100)))
3091 (define-instruction fsave(segment dst)
3092 (:printer floating-point ((op '(#b101 #b110))))
3094 (and (not (fp-reg-tn-p dst))
3095 (maybe-emit-rex-for-ea segment dst nil))
3096 (emit-byte segment #b11011101)
3097 (emit-fp-op segment dst #b110)))
3099 ;;; Restore FP State.
3100 (define-instruction frstor(segment src)
3101 (:printer floating-point ((op '(#b101 #b100))))
3103 (and (not (fp-reg-tn-p src))
3104 (maybe-emit-rex-for-ea segment src nil))
3105 (emit-byte segment #b11011101)
3106 (emit-fp-op segment src #b100)))
3108 ;;; Clear exceptions.
3109 (define-instruction fnclex(segment)
3110 (:printer floating-point-5 ((op #b00010)))
3112 (emit-byte segment #b11011011)
3113 (emit-byte segment #b11100010)))
3116 (define-instruction fcom (segment src)
3117 (:printer floating-point ((op '(#b000 #b010))))
3119 (and (not (fp-reg-tn-p src))
3120 (maybe-emit-rex-for-ea segment src nil))
3121 (emit-byte segment #b11011000)
3122 (emit-fp-op segment src #b010)))
3124 (define-instruction fcomd (segment src)
3125 (:printer floating-point ((op '(#b100 #b010))))
3126 (:printer floating-point-fp ((op '(#b000 #b010))))
3128 (if (fp-reg-tn-p src)
3129 (emit-byte segment #b11011000)
3131 (maybe-emit-rex-for-ea segment src nil)
3132 (emit-byte segment #b11011100)))
3133 (emit-fp-op segment src #b010)))
3135 ;;; Compare ST1 to ST0, popping the stack twice.
3136 (define-instruction fcompp (segment)
3137 (:printer floating-point-3 ((op '(#b110 #b011001))))
3139 (emit-byte segment #b11011110)
3140 (emit-byte segment #b11011001)))
3142 ;;; unordered comparison
3143 (define-instruction fucom (segment src)
3144 (:printer floating-point-fp ((op '(#b101 #b100))))
3146 (aver (fp-reg-tn-p src))
3147 (emit-byte segment #b11011101)
3148 (emit-fp-op segment src #b100)))
3150 (define-instruction ftst (segment)
3151 (:printer floating-point-no ((op #b00100)))
3153 (emit-byte segment #b11011001)
3154 (emit-byte segment #b11100100)))
3158 (define-instruction fsqrt(segment)
3159 (:printer floating-point-no ((op #b11010)))
3161 (emit-byte segment #b11011001)
3162 (emit-byte segment #b11111010)))
3164 (define-instruction fscale(segment)
3165 (:printer floating-point-no ((op #b11101)))
3167 (emit-byte segment #b11011001)
3168 (emit-byte segment #b11111101)))
3170 (define-instruction fxtract(segment)
3171 (:printer floating-point-no ((op #b10100)))
3173 (emit-byte segment #b11011001)
3174 (emit-byte segment #b11110100)))
3176 (define-instruction fsin(segment)
3177 (:printer floating-point-no ((op #b11110)))
3179 (emit-byte segment #b11011001)
3180 (emit-byte segment #b11111110)))
3182 (define-instruction fcos(segment)
3183 (:printer floating-point-no ((op #b11111)))
3185 (emit-byte segment #b11011001)
3186 (emit-byte segment #b11111111)))
3188 (define-instruction fprem1(segment)
3189 (:printer floating-point-no ((op #b10101)))
3191 (emit-byte segment #b11011001)
3192 (emit-byte segment #b11110101)))
3194 (define-instruction fprem(segment)
3195 (:printer floating-point-no ((op #b11000)))
3197 (emit-byte segment #b11011001)
3198 (emit-byte segment #b11111000)))
3200 (define-instruction fxam (segment)
3201 (:printer floating-point-no ((op #b00101)))
3203 (emit-byte segment #b11011001)
3204 (emit-byte segment #b11100101)))
3206 ;;; These do push/pop to stack and need special handling
3207 ;;; in any VOPs that use them. See the book.
3209 ;;; st0 <- st1*log2(st0)
3210 (define-instruction fyl2x(segment) ; pops stack
3211 (:printer floating-point-no ((op #b10001)))
3213 (emit-byte segment #b11011001)
3214 (emit-byte segment #b11110001)))
3216 (define-instruction fyl2xp1(segment)
3217 (:printer floating-point-no ((op #b11001)))
3219 (emit-byte segment #b11011001)
3220 (emit-byte segment #b11111001)))
3222 (define-instruction f2xm1(segment)
3223 (:printer floating-point-no ((op #b10000)))
3225 (emit-byte segment #b11011001)
3226 (emit-byte segment #b11110000)))
3228 (define-instruction fptan(segment) ; st(0) <- 1; st(1) <- tan
3229 (:printer floating-point-no ((op #b10010)))
3231 (emit-byte segment #b11011001)
3232 (emit-byte segment #b11110010)))
3234 (define-instruction fpatan(segment) ; POPS STACK
3235 (:printer floating-point-no ((op #b10011)))
3237 (emit-byte segment #b11011001)
3238 (emit-byte segment #b11110011)))
3240 ;;;; loading constants
3242 (define-instruction fldz(segment)
3243 (:printer floating-point-no ((op #b01110)))
3245 (emit-byte segment #b11011001)
3246 (emit-byte segment #b11101110)))
3248 (define-instruction fld1(segment)
3249 (:printer floating-point-no ((op #b01000)))
3251 (emit-byte segment #b11011001)
3252 (emit-byte segment #b11101000)))
3254 (define-instruction fldpi(segment)
3255 (:printer floating-point-no ((op #b01011)))
3257 (emit-byte segment #b11011001)
3258 (emit-byte segment #b11101011)))
3260 (define-instruction fldl2t(segment)
3261 (:printer floating-point-no ((op #b01001)))
3263 (emit-byte segment #b11011001)
3264 (emit-byte segment #b11101001)))
3266 (define-instruction fldl2e(segment)
3267 (:printer floating-point-no ((op #b01010)))
3269 (emit-byte segment #b11011001)
3270 (emit-byte segment #b11101010)))
3272 (define-instruction fldlg2(segment)
3273 (:printer floating-point-no ((op #b01100)))
3275 (emit-byte segment #b11011001)
3276 (emit-byte segment #b11101100)))
3278 (define-instruction fldln2(segment)
3279 (:printer floating-point-no ((op #b01101)))
3281 (emit-byte segment #b11011001)
3282 (emit-byte segment #b11101101)))
3284 ;; new xmm insns required by sse float
3285 ;; movsd andpd comisd comiss
3287 (define-instruction movsd (segment dst src)
3288 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3290 (cond ((typep src 'tn)
3291 (emit-byte segment #xf2)
3292 (maybe-emit-rex-for-ea segment dst src)
3293 (emit-byte segment #x0f)
3294 (emit-byte segment #x11)
3295 (emit-ea segment dst (reg-tn-encoding src)))
3297 (emit-byte segment #xf2)
3298 (maybe-emit-rex-for-ea segment src dst)
3299 (emit-byte segment #x0f)
3300 (emit-byte segment #x10)
3301 (emit-ea segment src (reg-tn-encoding dst))))))
3303 (define-instruction movss (segment dst src)
3304 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3307 (emit-byte segment #xf3)
3308 (maybe-emit-rex-for-ea segment dst src)
3309 (emit-byte segment #x0f)
3310 (emit-byte segment #x11)
3311 (emit-ea segment dst (reg-tn-encoding src)))
3313 (emit-byte segment #xf3)
3314 (maybe-emit-rex-for-ea segment src dst)
3315 (emit-byte segment #x0f)
3316 (emit-byte segment #x10)
3317 (emit-ea segment src (reg-tn-encoding dst))))))
3319 (define-instruction andpd (segment dst src)
3320 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3322 (emit-byte segment #x66)
3323 (maybe-emit-rex-for-ea segment src dst)
3324 (emit-byte segment #x0f)
3325 (emit-byte segment #x54)
3326 (emit-ea segment src (reg-tn-encoding dst))))
3328 (define-instruction andps (segment dst src)
3330 (maybe-emit-rex-for-ea segment src dst)
3331 (emit-byte segment #x0f)
3332 (emit-byte segment #x54)
3333 (emit-ea segment src (reg-tn-encoding dst))))
3335 (define-instruction comisd (segment dst src)
3336 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3338 (emit-byte segment #x66)
3339 (maybe-emit-rex-for-ea segment src dst)
3340 (emit-byte segment #x0f)
3341 (emit-byte segment #x2f)
3342 (emit-ea segment src (reg-tn-encoding dst))))
3344 (define-instruction comiss (segment dst src)
3345 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3347 (maybe-emit-rex-for-ea segment src dst)
3348 (emit-byte segment #x0f)
3349 (emit-byte segment #x2f)
3350 (emit-ea segment src (reg-tn-encoding dst))))
3352 ;; movd movq xorp xord
3354 ;; we only do the xmm version of movd
3355 (define-instruction movd (segment dst src)
3356 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3358 (cond ((fp-reg-tn-p dst)
3359 (emit-byte segment #x66)
3360 (maybe-emit-rex-for-ea segment src dst)
3361 (emit-byte segment #x0f)
3362 (emit-byte segment #x6e)
3363 (emit-ea segment src (reg-tn-encoding dst)))
3365 (aver (fp-reg-tn-p src))
3366 (emit-byte segment #x66)
3367 (maybe-emit-rex-for-ea segment dst src)
3368 (emit-byte segment #x0f)
3369 (emit-byte segment #x7e)
3370 (emit-ea segment dst (reg-tn-encoding src))))))
3372 (define-instruction movq (segment dst src)
3373 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3375 (cond ((fp-reg-tn-p dst)
3376 (emit-byte segment #xf3)
3377 (maybe-emit-rex-for-ea segment src dst)
3378 (emit-byte segment #x0f)
3379 (emit-byte segment #x7e)
3380 (emit-ea segment src (reg-tn-encoding dst)))
3382 (aver (fp-reg-tn-p src))
3383 (emit-byte segment #x66)
3384 (maybe-emit-rex-for-ea segment dst src)
3385 (emit-byte segment #x0f)
3386 (emit-byte segment #xd6)
3387 (emit-ea segment dst (reg-tn-encoding src))))))
3389 (define-instruction xorpd (segment dst src)
3390 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3392 (emit-byte segment #x66)
3393 (maybe-emit-rex-for-ea segment src dst)
3394 (emit-byte segment #x0f)
3395 (emit-byte segment #x57)
3396 (emit-ea segment src (reg-tn-encoding dst))))
3398 (define-instruction xorps (segment dst src)
3399 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3401 (maybe-emit-rex-for-ea segment src dst)
3402 (emit-byte segment #x0f)
3403 (emit-byte segment #x57)
3404 (emit-ea segment src (reg-tn-encoding dst))))
3406 (define-instruction cvtsd2si (segment dst src)
3407 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3409 (emit-byte segment #xf2)
3410 (maybe-emit-rex-for-ea segment src dst :operand-size :qword)
3411 (emit-byte segment #x0f)
3412 (emit-byte segment #x2d)
3413 (emit-ea segment src (reg-tn-encoding dst))))
3415 (define-instruction cvtsd2ss (segment dst src)
3416 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3418 (emit-byte segment #xf2)
3419 (maybe-emit-rex-for-ea segment src dst)
3420 (emit-byte segment #x0f)
3421 (emit-byte segment #x5a)
3422 (emit-ea segment src (reg-tn-encoding dst))))
3424 (define-instruction cvtss2si (segment dst src)
3425 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3427 (emit-byte segment #xf3)
3428 (maybe-emit-rex-for-ea segment src dst :operand-size :qword)
3429 (emit-byte segment #x0f)
3430 (emit-byte segment #x2d)
3431 (emit-ea segment src (reg-tn-encoding dst))))
3433 (define-instruction cvtss2sd (segment dst src)
3434 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3436 (emit-byte segment #xf3)
3437 (maybe-emit-rex-for-ea segment src dst)
3438 (emit-byte segment #x0f)
3439 (emit-byte segment #x5a)
3440 (emit-ea segment src (reg-tn-encoding dst))))
3442 (define-instruction cvtsi2ss (segment dst src)
3443 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3445 (emit-byte segment #xf3)
3446 (maybe-emit-rex-for-ea segment src dst)
3447 (emit-byte segment #x0f)
3448 (emit-byte segment #x2a)
3449 (emit-ea segment src (reg-tn-encoding dst))))
3451 (define-instruction cvtsi2sd (segment dst src)
3452 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3454 (emit-byte segment #xf2)
3455 (maybe-emit-rex-for-ea segment src dst)
3456 (emit-byte segment #x0f)
3457 (emit-byte segment #x2a)
3458 (emit-ea segment src (reg-tn-encoding dst))))
3460 (define-instruction cvtdq2pd (segment dst src)
3461 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3463 (emit-byte segment #xf3)
3464 (maybe-emit-rex-for-ea segment src dst)
3465 (emit-byte segment #x0f)
3466 (emit-byte segment #xe6)
3467 (emit-ea segment src (reg-tn-encoding dst))))
3469 (define-instruction cvtdq2ps (segment dst src)
3470 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3472 (maybe-emit-rex-for-ea segment src dst)
3473 (emit-byte segment #x0f)
3474 (emit-byte segment #x5b)
3475 (emit-ea segment src (reg-tn-encoding dst))))
3477 ;; CVTTSD2SI CVTTSS2SI
3479 (define-instruction cvttsd2si (segment dst src)
3480 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3482 (emit-byte segment #xf2)
3483 (maybe-emit-rex-for-ea segment src dst :operand-size :qword)
3484 (emit-byte segment #x0f)
3485 (emit-byte segment #x2c)
3486 (emit-ea segment src (reg-tn-encoding dst))))
3488 (define-instruction cvttss2si (segment dst src)
3489 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3491 (emit-byte segment #xf3)
3492 (maybe-emit-rex-for-ea segment src dst :operand-size :qword)
3493 (emit-byte segment #x0f)
3494 (emit-byte segment #x2c)
3495 (emit-ea segment src (reg-tn-encoding dst))))
3497 (define-instruction addsd (segment dst src)
3498 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3500 (emit-byte segment #xf2)
3501 (maybe-emit-rex-for-ea segment src dst)
3502 (emit-byte segment #x0f)
3503 (emit-byte segment #x58)
3504 (emit-ea segment src (reg-tn-encoding dst))))
3506 (define-instruction addss (segment dst src)
3507 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3509 (emit-byte segment #xf3)
3510 (maybe-emit-rex-for-ea segment src dst)
3511 (emit-byte segment #x0f)
3512 (emit-byte segment #x58)
3513 (emit-ea segment src (reg-tn-encoding dst))))
3515 (define-instruction divsd (segment dst src)
3516 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3518 (emit-byte segment #xf2)
3519 (maybe-emit-rex-for-ea segment src dst)
3520 (emit-byte segment #x0f)
3521 (emit-byte segment #x5e)
3522 (emit-ea segment src (reg-tn-encoding dst))))
3524 (define-instruction divss (segment dst src)
3525 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3527 (emit-byte segment #xf3)
3528 (maybe-emit-rex-for-ea segment src dst)
3529 (emit-byte segment #x0f)
3530 (emit-byte segment #x5e)
3531 (emit-ea segment src (reg-tn-encoding dst))))
3533 (define-instruction mulsd (segment dst src)
3534 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3536 (emit-byte segment #xf2)
3537 (maybe-emit-rex-for-ea segment src dst)
3538 (emit-byte segment #x0f)
3539 (emit-byte segment #x59)
3540 (emit-ea segment src (reg-tn-encoding dst))))
3542 (define-instruction mulss (segment dst src)
3543 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3545 (emit-byte segment #xf3)
3546 (maybe-emit-rex-for-ea segment src dst)
3547 (emit-byte segment #x0f)
3548 (emit-byte segment #x59)
3549 (emit-ea segment src (reg-tn-encoding dst))))
3551 (define-instruction subsd (segment dst src)
3552 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3554 (emit-byte segment #xf2)
3555 (maybe-emit-rex-for-ea segment src dst)
3556 (emit-byte segment #x0f)
3557 (emit-byte segment #x5c)
3558 (emit-ea segment src (reg-tn-encoding dst))))
3560 (define-instruction subss (segment dst src)
3561 ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
3563 (emit-byte segment #xf3)
3564 (maybe-emit-rex-for-ea segment src dst)
3565 (emit-byte segment #x0f)
3566 (emit-byte segment #x5c)
3567 (emit-ea segment src (reg-tn-encoding dst))))
3569 (define-instruction ldmxcsr (segment src)
3571 (emit-byte segment #x0f)
3572 (emit-byte segment #xae)
3573 (emit-ea segment src 2)))
3575 (define-instruction stmxcsr (segment dst)
3577 (emit-byte segment #x0f)
3578 (emit-byte segment #xae)
3579 (emit-ea segment dst 3)))