1 ;;;; that part of the description of the x86 instruction set (for
2 ;;;; 80386 and above) 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 (deftype reg
() '(unsigned-byte 3))
23 (def!constant
+default-operand-size
+ :dword
)
25 (eval-when (#-sb-xc
:compile-toplevel
:load-toplevel
:execute
)
27 (defun offset-next (value dstate
)
28 (declare (type integer value
)
29 (type sb
!disassem
:disassem-state dstate
))
30 (+ (sb!disassem
:dstate-next-addr dstate
) value
))
32 (defparameter *default-address-size
*
33 ;; Actually, :DWORD is the only one really supported.
36 (defparameter *byte-reg-names
*
37 #(al cl dl bl ah ch dh bh
))
38 (defparameter *word-reg-names
*
39 #(ax cx dx bx sp bp si di
))
40 (defparameter *dword-reg-names
*
41 #(eax ecx edx ebx esp ebp esi edi
))
43 (defun print-reg-with-width (value width stream dstate
)
44 (declare (ignore dstate
))
45 (princ (aref (ecase width
46 (:byte
*byte-reg-names
*)
47 (:word
*word-reg-names
*)
48 (:dword
*dword-reg-names
*))
51 ;; XXX plus should do some source-var notes
54 (defun print-reg (value stream dstate
)
55 (declare (type reg value
)
57 (type sb
!disassem
:disassem-state dstate
))
58 (print-reg-with-width value
59 (sb!disassem
:dstate-get-prop dstate
'width
)
63 (defun print-word-reg (value stream dstate
)
64 (declare (type reg value
)
66 (type sb
!disassem
:disassem-state dstate
))
67 (print-reg-with-width value
68 (or (sb!disassem
:dstate-get-prop dstate
'word-width
)
69 +default-operand-size
+)
73 (defun print-byte-reg (value stream dstate
)
74 (declare (type reg value
)
76 (type sb
!disassem
:disassem-state dstate
))
77 (print-reg-with-width value
:byte stream dstate
))
79 (defun print-addr-reg (value stream dstate
)
80 (declare (type reg value
)
82 (type sb
!disassem
:disassem-state dstate
))
83 (print-reg-with-width value
*default-address-size
* stream dstate
))
85 (defun print-reg/mem
(value stream dstate
)
86 (declare (type (or list reg
) value
)
88 (type sb
!disassem
:disassem-state dstate
))
89 (if (typep value
'reg
)
90 (print-reg value stream dstate
)
91 (print-mem-access value stream nil dstate
)))
93 ;; Same as print-reg/mem, but prints an explicit size indicator for
95 (defun print-sized-reg/mem
(value stream dstate
)
96 (declare (type (or list reg
) value
)
98 (type sb
!disassem
:disassem-state dstate
))
99 (if (typep value
'reg
)
100 (print-reg value stream dstate
)
101 (print-mem-access value stream t dstate
)))
103 (defun print-byte-reg/mem
(value stream dstate
)
104 (declare (type (or list reg
) value
)
106 (type sb
!disassem
:disassem-state dstate
))
107 (if (typep value
'reg
)
108 (print-byte-reg value stream dstate
)
109 (print-mem-access value stream t dstate
)))
111 (defun print-word-reg/mem
(value stream dstate
)
112 (declare (type (or list reg
) value
)
114 (type sb
!disassem
:disassem-state dstate
))
115 (if (typep value
'reg
)
116 (print-word-reg value stream dstate
)
117 (print-mem-access value stream nil dstate
)))
119 (defun print-label (value stream dstate
)
120 (declare (ignore dstate
))
121 (sb!disassem
:princ16 value stream
))
123 ;;; Returns either an integer, meaning a register, or a list of
124 ;;; (BASE-REG OFFSET INDEX-REG INDEX-SCALE), where any component
125 ;;; may be missing or nil to indicate that it's not used or has the
126 ;;; obvious default value (e.g., 1 for the index-scale).
127 (defun prefilter-reg/mem
(value dstate
)
128 (declare (type list value
)
129 (type sb
!disassem
:disassem-state dstate
))
130 (let ((mod (car value
))
132 (declare (type (unsigned-byte 2) mod
)
133 (type (unsigned-byte 3) r
/m
))
139 (let ((sib (sb!disassem
:read-suffix
8 dstate
)))
140 (declare (type (unsigned-byte 8) sib
))
141 (let ((base-reg (ldb (byte 3 0) sib
))
142 (index-reg (ldb (byte 3 3) sib
))
143 (index-scale (ldb (byte 2 6) sib
)))
144 (declare (type (unsigned-byte 3) base-reg index-reg
)
145 (type (unsigned-byte 2) index-scale
))
149 (if (= base-reg
#b101
)
150 (sb!disassem
:read-signed-suffix
32 dstate
)
153 (sb!disassem
:read-signed-suffix
8 dstate
))
155 (sb!disassem
:read-signed-suffix
32 dstate
)))))
156 (list (if (and (= mod
#b00
) (= base-reg
#b101
)) nil base-reg
)
158 (if (= index-reg
#b100
) nil index-reg
)
159 (ash 1 index-scale
))))))
160 ((and (= mod
#b00
) (= r
/m
#b101
))
161 (list nil
(sb!disassem
:read-signed-suffix
32 dstate
)) )
165 (list r
/m
(sb!disassem
:read-signed-suffix
8 dstate
)))
167 (list r
/m
(sb!disassem
:read-signed-suffix
32 dstate
))))))
170 ;;; This is a sort of bogus prefilter that just stores the info globally for
171 ;;; other people to use; it probably never gets printed.
172 (defun prefilter-width (value dstate
)
173 (setf (sb!disassem
:dstate-get-prop dstate
'width
)
177 ;; set by a prefix instruction
178 (or (sb!disassem
:dstate-get-prop dstate
'word-width
)
179 +default-operand-size
+)))
180 (when (not (eql word-width
+default-operand-size
+))
182 (setf (sb!disassem
:dstate-get-prop dstate
'word-width
)
183 +default-operand-size
+))
186 (defun read-address (value dstate
)
187 (declare (ignore value
)) ; always nil anyway
188 (sb!disassem
:read-suffix
(width-bits *default-address-size
*) dstate
))
190 (defun width-bits (width)
200 ;;;; disassembler argument types
202 (sb!disassem
:define-arg-type displacement
204 :use-label
#'offset-next
205 :printer
(lambda (value stream dstate
)
206 (sb!disassem
:maybe-note-assembler-routine value nil dstate
)
207 (print-label value stream dstate
)))
209 (sb!disassem
:define-arg-type accum
210 :printer
(lambda (value stream dstate
)
211 (declare (ignore value
)
213 (type sb
!disassem
:disassem-state dstate
))
214 (print-reg 0 stream dstate
)))
216 (sb!disassem
:define-arg-type word-accum
217 :printer
(lambda (value stream dstate
)
218 (declare (ignore value
)
220 (type sb
!disassem
:disassem-state dstate
))
221 (print-word-reg 0 stream dstate
)))
223 (sb!disassem
:define-arg-type reg
224 :printer
#'print-reg
)
226 (sb!disassem
:define-arg-type addr-reg
227 :printer
#'print-addr-reg
)
229 (sb!disassem
:define-arg-type word-reg
230 :printer
#'print-word-reg
)
232 (sb!disassem
:define-arg-type imm-addr
233 :prefilter
#'read-address
234 :printer
#'print-label
)
236 (sb!disassem
:define-arg-type imm-data
237 :prefilter
(lambda (value dstate
)
238 (declare (ignore value
)) ; always nil anyway
239 (sb!disassem
:read-suffix
240 (width-bits (sb!disassem
:dstate-get-prop dstate
'width
))
243 (sb!disassem
:define-arg-type signed-imm-data
244 :prefilter
(lambda (value dstate
)
245 (declare (ignore value
)) ; always nil anyway
246 (let ((width (sb!disassem
:dstate-get-prop dstate
'width
)))
247 (sb!disassem
:read-signed-suffix
(width-bits width
) dstate
))))
249 (sb!disassem
:define-arg-type signed-imm-byte
250 :prefilter
(lambda (value dstate
)
251 (declare (ignore value
)) ; always nil anyway
252 (sb!disassem
:read-signed-suffix
8 dstate
)))
254 (sb!disassem
:define-arg-type signed-imm-dword
255 :prefilter
(lambda (value dstate
)
256 (declare (ignore value
)) ; always nil anyway
257 (sb!disassem
:read-signed-suffix
32 dstate
)))
259 (sb!disassem
:define-arg-type imm-word
260 :prefilter
(lambda (value dstate
)
261 (declare (ignore value
)) ; always nil anyway
263 (or (sb!disassem
:dstate-get-prop dstate
'word-width
)
264 +default-operand-size
+)))
265 (sb!disassem
:read-suffix
(width-bits width
) dstate
))))
267 (sb!disassem
:define-arg-type signed-imm-word
268 :prefilter
(lambda (value dstate
)
269 (declare (ignore value
)) ; always nil anyway
271 (or (sb!disassem
:dstate-get-prop dstate
'word-width
)
272 +default-operand-size
+)))
273 (sb!disassem
:read-signed-suffix
(width-bits width
) dstate
))))
275 ;;; needed for the ret imm16 instruction
276 (sb!disassem
:define-arg-type imm-word-16
277 :prefilter
(lambda (value dstate
)
278 (declare (ignore value
)) ; always nil anyway
279 (sb!disassem
:read-suffix
16 dstate
)))
281 (sb!disassem
:define-arg-type reg
/mem
282 :prefilter
#'prefilter-reg
/mem
283 :printer
#'print-reg
/mem
)
284 (sb!disassem
:define-arg-type sized-reg
/mem
285 ;; Same as reg/mem, but prints an explicit size indicator for
286 ;; memory references.
287 :prefilter
#'prefilter-reg
/mem
288 :printer
#'print-sized-reg
/mem
)
289 (sb!disassem
:define-arg-type byte-reg
/mem
290 :prefilter
#'prefilter-reg
/mem
291 :printer
#'print-byte-reg
/mem
)
292 (sb!disassem
:define-arg-type word-reg
/mem
293 :prefilter
#'prefilter-reg
/mem
294 :printer
#'print-word-reg
/mem
)
297 (eval-when (#-sb-xc
:compile-toplevel
:load-toplevel
:execute
)
298 (defun print-fp-reg (value stream dstate
)
299 (declare (ignore dstate
))
300 (format stream
"FR~D" value
))
301 (defun prefilter-fp-reg (value dstate
)
303 (declare (ignore dstate
))
306 (sb!disassem
:define-arg-type fp-reg
307 :prefilter
#'prefilter-fp-reg
308 :printer
#'print-fp-reg
)
310 (sb!disassem
:define-arg-type width
311 :prefilter
#'prefilter-width
312 :printer
(lambda (value stream dstate
)
315 (and (numberp value
) (zerop value
))) ; zzz jrd
318 ;; set by a prefix instruction
319 (or (sb!disassem
:dstate-get-prop dstate
'word-width
)
320 +default-operand-size
+)))
321 (princ (schar (symbol-name word-width
) 0) stream
)))))
323 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
324 (defparameter *conditions
*
327 (:b .
2) (:nae .
2) (:c .
2)
328 (:nb .
3) (:ae .
3) (:nc .
3)
329 (:eq .
4) (:e .
4) (:z .
4)
336 (:np .
11) (:po .
11)
337 (:l .
12) (:nge .
12)
338 (:nl .
13) (:ge .
13)
339 (:le .
14) (:ng .
14)
340 (:nle .
15) (:g .
15)))
341 (defparameter *condition-name-vec
*
342 (let ((vec (make-array 16 :initial-element nil
)))
343 (dolist (cond *conditions
*)
344 (when (null (aref vec
(cdr cond
)))
345 (setf (aref vec
(cdr cond
)) (car cond
))))
349 ;;; Set assembler parameters. (In CMU CL, this was done with
350 ;;; a call to a macro DEF-ASSEMBLER-PARAMS.)
351 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
352 (setf sb
!assem
:*assem-scheduler-p
* nil
))
354 (sb!disassem
:define-arg-type condition-code
355 :printer
*condition-name-vec
*)
357 (defun conditional-opcode (condition)
358 (cdr (assoc condition
*conditions
* :test
#'eq
)))
360 ;;;; disassembler instruction formats
362 (eval-when (:compile-toplevel
:execute
)
363 (defun swap-if (direction field1 separator field2
)
364 `(:if
(,direction
:constant
0)
365 (,field1
,separator
,field2
)
366 (,field2
,separator
,field1
))))
368 (sb!disassem
:define-instruction-format
(byte 8 :default-printer
'(:name
))
369 (op :field
(byte 8 0))
374 (sb!disassem
:define-instruction-format
(simple 8)
375 (op :field
(byte 7 1))
376 (width :field
(byte 1 0) :type
'width
)
381 ;;; Same as simple, but with direction bit
382 (sb!disassem
:define-instruction-format
(simple-dir 8 :include
'simple
)
383 (op :field
(byte 6 2))
384 (dir :field
(byte 1 1)))
386 ;;; Same as simple, but with the immediate value occurring by default,
387 ;;; and with an appropiate printer.
388 (sb!disassem
:define-instruction-format
(accum-imm 8
390 :default-printer
'(:name
391 :tab accum
", " imm
))
392 (imm :type
'imm-data
))
394 (sb!disassem
:define-instruction-format
(reg-no-width 8
395 :default-printer
'(:name
:tab reg
))
396 (op :field
(byte 5 3))
397 (reg :field
(byte 3 0) :type
'word-reg
)
399 (accum :type
'word-accum
)
402 ;;; adds a width field to reg-no-width
403 (sb!disassem
:define-instruction-format
(reg 8
404 :default-printer
'(:name
:tab reg
))
405 (op :field
(byte 4 4))
406 (width :field
(byte 1 3) :type
'width
)
407 (reg :field
(byte 3 0) :type
'reg
)
413 ;;; Same as reg, but with direction bit
414 (sb!disassem
:define-instruction-format
(reg-dir 8 :include
'reg
)
415 (op :field
(byte 3 5))
416 (dir :field
(byte 1 4)))
418 (sb!disassem
:define-instruction-format
(two-bytes 16
419 :default-printer
'(:name
))
420 (op :fields
(list (byte 8 0) (byte 8 8))))
422 (sb!disassem
:define-instruction-format
(reg-reg/mem
16
424 `(:name
:tab reg
", " reg
/mem
))
425 (op :field
(byte 7 1))
426 (width :field
(byte 1 0) :type
'width
)
427 (reg/mem
:fields
(list (byte 2 14) (byte 3 8))
429 (reg :field
(byte 3 11) :type
'reg
)
433 ;;; same as reg-reg/mem, but with direction bit
434 (sb!disassem
:define-instruction-format
(reg-reg/mem-dir
16
435 :include
'reg-reg
/mem
439 ,(swap-if 'dir
'reg
/mem
", " 'reg
)))
440 (op :field
(byte 6 2))
441 (dir :field
(byte 1 1)))
443 ;;; Same as reg-rem/mem, but uses the reg field as a second op code.
444 (sb!disassem
:define-instruction-format
(reg/mem
16
445 :default-printer
'(:name
:tab reg
/mem
))
446 (op :fields
(list (byte 7 1) (byte 3 11)))
447 (width :field
(byte 1 0) :type
'width
)
448 (reg/mem
:fields
(list (byte 2 14) (byte 3 8))
449 :type
'sized-reg
/mem
)
453 ;;; Same as reg/mem, but with the immediate value occurring by default,
454 ;;; and with an appropiate printer.
455 (sb!disassem
:define-instruction-format
(reg/mem-imm
16
458 '(:name
:tab reg
/mem
", " imm
))
459 (reg/mem
:type
'sized-reg
/mem
)
460 (imm :type
'imm-data
))
462 ;;; Same as reg/mem, but with using the accumulator in the default printer
463 (sb!disassem
:define-instruction-format
465 :include
'reg
/mem
:default-printer
'(:name
:tab accum
", " reg
/mem
))
466 (reg/mem
:type
'reg
/mem
) ; don't need a size
467 (accum :type
'accum
))
469 ;;; Same as reg-reg/mem, but with a prefix of #b00001111
470 (sb!disassem
:define-instruction-format
(ext-reg-reg/mem
24
472 `(:name
:tab reg
", " reg
/mem
))
473 (prefix :field
(byte 8 0) :value
#b00001111
)
474 (op :field
(byte 7 9))
475 (width :field
(byte 1 8) :type
'width
)
476 (reg/mem
:fields
(list (byte 2 22) (byte 3 16))
478 (reg :field
(byte 3 19) :type
'reg
)
482 ;;; Same as reg/mem, but with a prefix of #b00001111
483 (sb!disassem
:define-instruction-format
(ext-reg/mem
24
484 :default-printer
'(:name
:tab reg
/mem
))
485 (prefix :field
(byte 8 0) :value
#b00001111
)
486 (op :fields
(list (byte 7 9) (byte 3 19)))
487 (width :field
(byte 1 8) :type
'width
)
488 (reg/mem
:fields
(list (byte 2 22) (byte 3 16))
489 :type
'sized-reg
/mem
)
493 (sb!disassem
:define-instruction-format
(ext-reg/mem-imm
24
494 :include
'ext-reg
/mem
496 '(:name
:tab reg
/mem
", " imm
))
497 (imm :type
'imm-data
))
499 ;;;; This section was added by jrd, for fp instructions.
501 ;;; regular fp inst to/from registers/memory
502 (sb!disassem
:define-instruction-format
(floating-point 16
504 `(:name
:tab reg
/mem
))
505 (prefix :field
(byte 5 3) :value
#b11011
)
506 (op :fields
(list (byte 3 0) (byte 3 11)))
507 (reg/mem
:fields
(list (byte 2 14) (byte 3 8)) :type
'reg
/mem
))
509 ;;; fp insn to/from fp reg
510 (sb!disassem
:define-instruction-format
(floating-point-fp 16
511 :default-printer
`(:name
:tab fp-reg
))
512 (prefix :field
(byte 5 3) :value
#b11011
)
513 (suffix :field
(byte 2 14) :value
#b11
)
514 (op :fields
(list (byte 3 0) (byte 3 11)))
515 (fp-reg :field
(byte 3 8) :type
'fp-reg
))
517 ;;; fp insn to/from fp reg, with the reversed source/destination flag.
518 (sb!disassem
:define-instruction-format
519 (floating-point-fp-d 16
520 :default-printer
`(:name
:tab
,(swap-if 'd
"ST0" ", " 'fp-reg
)))
521 (prefix :field
(byte 5 3) :value
#b11011
)
522 (suffix :field
(byte 2 14) :value
#b11
)
523 (op :fields
(list (byte 2 0) (byte 3 11)))
524 (d :field
(byte 1 2))
525 (fp-reg :field
(byte 3 8) :type
'fp-reg
))
528 ;;; (added by (?) pfw)
529 ;;; fp no operand isns
530 (sb!disassem
:define-instruction-format
(floating-point-no 16
531 :default-printer
'(:name
))
532 (prefix :field
(byte 8 0) :value
#b11011001
)
533 (suffix :field
(byte 3 13) :value
#b111
)
534 (op :field
(byte 5 8)))
536 (sb!disassem
:define-instruction-format
(floating-point-3 16
537 :default-printer
'(:name
))
538 (prefix :field
(byte 5 3) :value
#b11011
)
539 (suffix :field
(byte 2 14) :value
#b11
)
540 (op :fields
(list (byte 3 0) (byte 6 8))))
542 (sb!disassem
:define-instruction-format
(floating-point-5 16
543 :default-printer
'(:name
))
544 (prefix :field
(byte 8 0) :value
#b11011011
)
545 (suffix :field
(byte 3 13) :value
#b111
)
546 (op :field
(byte 5 8)))
548 (sb!disassem
:define-instruction-format
(floating-point-st 16
549 :default-printer
'(:name
))
550 (prefix :field
(byte 8 0) :value
#b11011111
)
551 (suffix :field
(byte 3 13) :value
#b111
)
552 (op :field
(byte 5 8)))
554 (sb!disassem
:define-instruction-format
(string-op 8
556 :default-printer
'(:name width
)))
558 (sb!disassem
:define-instruction-format
(short-cond-jump 16)
559 (op :field
(byte 4 4))
560 (cc :field
(byte 4 0) :type
'condition-code
)
561 (label :field
(byte 8 8) :type
'displacement
))
563 (sb!disassem
:define-instruction-format
(short-jump 16
564 :default-printer
'(:name
:tab label
))
565 (const :field
(byte 4 4) :value
#b1110
)
566 (op :field
(byte 4 0))
567 (label :field
(byte 8 8) :type
'displacement
))
569 (sb!disassem
:define-instruction-format
(near-cond-jump 16)
570 (op :fields
(list (byte 8 0) (byte 4 12)) :value
'(#b00001111
#b1000
))
571 (cc :field
(byte 4 8) :type
'condition-code
)
572 ;; The disassembler currently doesn't let you have an instruction > 32 bits
573 ;; long, so we fake it by using a prefilter to read the offset.
574 (label :type
'displacement
575 :prefilter
(lambda (value dstate
)
576 (declare (ignore value
)) ; always nil anyway
577 (sb!disassem
:read-signed-suffix
32 dstate
))))
579 (sb!disassem
:define-instruction-format
(near-jump 8
580 :default-printer
'(:name
:tab label
))
581 (op :field
(byte 8 0))
582 ;; The disassembler currently doesn't let you have an instruction > 32 bits
583 ;; long, so we fake it by using a prefilter to read the address.
584 (label :type
'displacement
585 :prefilter
(lambda (value dstate
)
586 (declare (ignore value
)) ; always nil anyway
587 (sb!disassem
:read-signed-suffix
32 dstate
))))
590 (sb!disassem
:define-instruction-format
(cond-set 24
591 :default-printer
'('set cc
:tab reg
/mem
))
592 (prefix :field
(byte 8 0) :value
#b00001111
)
593 (op :field
(byte 4 12) :value
#b1001
)
594 (cc :field
(byte 4 8) :type
'condition-code
)
595 (reg/mem
:fields
(list (byte 2 22) (byte 3 16))
597 (reg :field
(byte 3 19) :value
#b000
))
599 (sb!disassem
:define-instruction-format
(cond-move 24
601 '('cmov cc
:tab reg
", " reg
/mem
))
602 (prefix :field
(byte 8 0) :value
#b00001111
)
603 (op :field
(byte 4 12) :value
#b0100
)
604 (cc :field
(byte 4 8) :type
'condition-code
)
605 (reg/mem
:fields
(list (byte 2 22) (byte 3 16))
607 (reg :field
(byte 3 19) :type
'reg
))
609 (sb!disassem
:define-instruction-format
(enter-format 32
610 :default-printer
'(:name
612 (:unless
(:constant
0)
614 (op :field
(byte 8 0))
615 (disp :field
(byte 16 8))
616 (level :field
(byte 8 24)))
618 (sb!disassem
:define-instruction-format
(prefetch 24
620 '(:name
", " reg
/mem
))
621 (prefix :field
(byte 8 0) :value
#b00001111
)
622 (op :field
(byte 8 8) :value
#b00011000
)
623 (reg/mem
:fields
(list (byte 2 22) (byte 3 16)) :type
'byte-reg
/mem
)
624 (reg :field
(byte 3 19) :type
'reg
))
626 ;;; Single byte instruction with an immediate byte argument.
627 (sb!disassem
:define-instruction-format
(byte-imm 16
628 :default-printer
'(:name
:tab code
))
629 (op :field
(byte 8 0))
630 (code :field
(byte 8 8)))
632 ;;; Two byte instruction with an immediate byte argument.
634 (sb!disassem
:define-instruction-format
(word-imm 24
635 :default-printer
'(:name
:tab code
))
636 (op :field
(byte 16 0))
637 (code :field
(byte 8 16)))
640 ;;;; primitive emitters
642 (define-bitfield-emitter emit-word
16
645 (define-bitfield-emitter emit-dword
32
648 (define-bitfield-emitter emit-byte-with-reg
8
649 (byte 5 3) (byte 3 0))
651 (define-bitfield-emitter emit-mod-reg-r
/m-byte
8
652 (byte 2 6) (byte 3 3) (byte 3 0))
654 (define-bitfield-emitter emit-sib-byte
8
655 (byte 2 6) (byte 3 3) (byte 3 0))
659 (defun emit-absolute-fixup (segment fixup
)
660 (note-fixup segment
:absolute fixup
)
661 (let ((offset (fixup-offset fixup
)))
663 (emit-back-patch segment
664 4 ; FIXME: n-word-bytes
665 (lambda (segment posn
)
666 (declare (ignore posn
))
668 (- (+ (component-header-length)
669 (or (label-position offset
)
671 other-pointer-lowtag
))))
672 (emit-dword segment
(or offset
0)))))
674 (defun emit-relative-fixup (segment fixup
)
675 (note-fixup segment
:relative fixup
)
676 (emit-dword segment
(or (fixup-offset fixup
) 0)))
678 ;;;; the effective-address (ea) structure
680 (defun reg-tn-encoding (tn)
681 (declare (type tn tn
))
682 (aver (eq (sb-name (sc-sb (tn-sc tn
))) 'registers
))
683 (let ((offset (tn-offset tn
)))
684 (logior (ash (logand offset
1) 2)
687 (defstruct (ea (:constructor make-ea
(size &key base index scale disp
))
689 (size nil
:type
(member :byte
:word
:dword
))
690 (base nil
:type
(or tn null
))
691 (index nil
:type
(or tn null
))
692 (scale 1 :type
(member 1 2 4 8))
693 (disp 0 :type
(or (unsigned-byte 32) (signed-byte 32) fixup
)))
694 (def!method print-object
((ea ea
) stream
)
695 (cond ((or *print-escape
* *print-readably
*)
696 (print-unreadable-object (ea stream
:type t
)
698 "~S~@[ base=~S~]~@[ index=~S~]~@[ scale=~S~]~@[ disp=~S~]"
702 (let ((scale (ea-scale ea
)))
703 (if (= scale
1) nil scale
))
706 (format stream
"~A PTR [" (symbol-name (ea-size ea
)))
708 (write-string (sb!c
::location-print-name
(ea-base ea
)) stream
)
710 (write-string "+" stream
)))
712 (write-string (sb!c
::location-print-name
(ea-index ea
)) stream
))
713 (unless (= (ea-scale ea
) 1)
714 (format stream
"*~A" (ea-scale ea
)))
715 (typecase (ea-disp ea
)
718 (format stream
"~@D" (ea-disp ea
)))
720 (format stream
"+~A" (ea-disp ea
))))
721 (write-char #\
] stream
))))
723 (defun emit-ea (segment thing reg
&optional allow-constants
)
726 (ecase (sb-name (sc-sb (tn-sc thing
)))
728 (emit-mod-reg-r/m-byte segment
#b11 reg
(reg-tn-encoding thing
)))
730 ;; Convert stack tns into an index off of EBP.
731 (let ((disp (frame-byte-offset (tn-offset thing
))))
732 (cond ((<= -
128 disp
127)
733 (emit-mod-reg-r/m-byte segment
#b01 reg
#b101
)
734 (emit-byte segment disp
))
736 (emit-mod-reg-r/m-byte segment
#b10 reg
#b101
)
737 (emit-dword segment disp
)))))
739 (unless allow-constants
741 "Constant TNs can only be directly used in MOV, PUSH, and CMP."))
742 (emit-mod-reg-r/m-byte segment
#b00 reg
#b101
)
743 (emit-absolute-fixup segment
746 (- (* (tn-offset thing
) n-word-bytes
)
747 other-pointer-lowtag
))))))
749 (let* ((base (ea-base thing
))
750 (index (ea-index thing
))
751 (scale (ea-scale thing
))
752 (disp (ea-disp thing
))
753 (mod (cond ((or (null base
)
755 (not (= (reg-tn-encoding base
) #b101
))))
757 ((and (fixnump disp
) (<= -
128 disp
127))
761 (r/m
(cond (index #b100
)
763 (t (reg-tn-encoding base
)))))
764 (emit-mod-reg-r/m-byte segment mod reg r
/m
)
766 (let ((ss (1- (integer-length scale
)))
767 (index (if (null index
)
769 (let ((index (reg-tn-encoding index
)))
771 (error "can't index off of ESP")
773 (base (if (null base
)
775 (reg-tn-encoding base
))))
776 (emit-sib-byte segment ss index base
)))
778 (emit-byte segment disp
))
779 ((or (= mod
#b10
) (null base
))
781 (emit-absolute-fixup segment disp
)
782 (emit-dword segment disp
))))))
784 (emit-mod-reg-r/m-byte segment
#b00 reg
#b101
)
785 (emit-absolute-fixup segment thing
))))
787 (defun fp-reg-tn-p (thing)
789 (eq (sb-name (sc-sb (tn-sc thing
))) 'float-registers
)))
791 ;;; like the above, but for fp-instructions--jrd
792 (defun emit-fp-op (segment thing op
)
793 (if (fp-reg-tn-p thing
)
794 (emit-byte segment
(dpb op
(byte 3 3) (dpb (tn-offset thing
)
797 (emit-ea segment thing op
)))
799 (defun byte-reg-p (thing)
801 (eq (sb-name (sc-sb (tn-sc thing
))) 'registers
)
802 (member (sc-name (tn-sc thing
)) *byte-sc-names
*)
805 (defun byte-ea-p (thing)
807 (ea (eq (ea-size thing
) :byte
))
809 (and (member (sc-name (tn-sc thing
)) *byte-sc-names
*) t
))
812 (defun word-reg-p (thing)
814 (eq (sb-name (sc-sb (tn-sc thing
))) 'registers
)
815 (member (sc-name (tn-sc thing
)) *word-sc-names
*)
818 (defun word-ea-p (thing)
820 (ea (eq (ea-size thing
) :word
))
821 (tn (and (member (sc-name (tn-sc thing
)) *word-sc-names
*) t
))
824 (defun dword-reg-p (thing)
826 (eq (sb-name (sc-sb (tn-sc thing
))) 'registers
)
827 (member (sc-name (tn-sc thing
)) *dword-sc-names
*)
830 (defun dword-ea-p (thing)
832 (ea (eq (ea-size thing
) :dword
))
834 (and (member (sc-name (tn-sc thing
)) *dword-sc-names
*) t
))
837 (defun register-p (thing)
839 (eq (sb-name (sc-sb (tn-sc thing
))) 'registers
)))
841 (defun accumulator-p (thing)
842 (and (register-p thing
)
843 (= (tn-offset thing
) 0)))
847 (def!constant
+operand-size-prefix-byte
+ #b01100110
)
849 (defun maybe-emit-operand-size-prefix (segment size
)
850 (unless (or (eq size
:byte
) (eq size
+default-operand-size
+))
851 (emit-byte segment
+operand-size-prefix-byte
+)))
853 (defun operand-size (thing)
856 ;; FIXME: might as well be COND instead of having to use #. readmacro
857 ;; to hack up the code
858 (case (sc-name (tn-sc thing
))
865 ;; added by jrd: float-registers is a separate size (?)
871 (error "can't tell the size of ~S ~S" thing
(sc-name (tn-sc thing
))))))
877 (defun matching-operand-size (dst src
)
878 (let ((dst-size (operand-size dst
))
879 (src-size (operand-size src
)))
882 (if (eq dst-size src-size
)
884 (error "size mismatch: ~S is a ~S and ~S is a ~S."
885 dst dst-size src src-size
))
889 (error "can't tell the size of either ~S or ~S" dst src
)))))
891 (defun emit-sized-immediate (segment size value
)
894 (emit-byte segment value
))
896 (emit-word segment value
))
898 (emit-dword segment value
))))
900 (defun toggle-word-width (chunk inst stream dstate
)
901 (declare (ignore chunk inst stream
))
902 (let ((word-width (or (sb!disassem
:dstate-get-prop dstate
'word-width
)
903 +default-operand-size
+)))
904 (setf (sb!disassem
:dstate-get-prop dstate
'word-width
)
909 ;;; This is a "prefix" instruction, which means that it modifies the
910 ;;; following instruction in some way without having an actual
911 ;;; mnemonic of its own.
912 (define-instruction operand-size-prefix
(segment)
913 (:printer byte
((op +operand-size-prefix-byte
+))
914 nil
; don't actually print it
915 :control
#'toggle-word-width
))
917 ;;;; general data transfer
919 (define-instruction mov
(segment dst src
)
920 ;; immediate to register
921 (:printer reg
((op #b1011
) (imm nil
:type
'imm-data
))
922 '(:name
:tab reg
", " imm
))
923 ;; absolute mem to/from accumulator
924 (:printer simple-dir
((op #b101000
) (imm nil
:type
'imm-addr
))
925 `(:name
:tab
,(swap-if 'dir
'accum
", " '("[" imm
"]"))))
926 ;; register to/from register/memory
927 (:printer reg-reg
/mem-dir
((op #b100010
)))
928 ;; immediate to register/memory
929 (:printer reg
/mem-imm
((op '(#b1100011
#b000
))))
932 (let ((size (matching-operand-size dst src
)))
933 (maybe-emit-operand-size-prefix segment size
)
934 (cond ((register-p dst
)
935 (cond ((integerp src
)
936 (emit-byte-with-reg segment
940 (reg-tn-encoding dst
))
941 (emit-sized-immediate segment size src
))
942 ((and (fixup-p src
) (accumulator-p dst
))
947 (emit-absolute-fixup segment src
))
953 (emit-ea segment src
(reg-tn-encoding dst
) t
))))
954 ((and (fixup-p dst
) (accumulator-p src
))
955 (emit-byte segment
(if (eq size
:byte
) #b10100010
#b10100011
))
956 (emit-absolute-fixup segment dst
))
958 (emit-byte segment
(if (eq size
:byte
) #b11000110
#b11000111
))
959 (emit-ea segment dst
#b000
)
960 (emit-sized-immediate segment size src
))
962 (emit-byte segment
(if (eq size
:byte
) #b10001000
#b10001001
))
963 (emit-ea segment dst
(reg-tn-encoding src
)))
965 (aver (eq size
:dword
))
966 (emit-byte segment
#b11000111
)
967 (emit-ea segment dst
#b000
)
968 (emit-absolute-fixup segment src
))
970 (error "bogus arguments to MOV: ~S ~S" dst src
))))))
972 (defun emit-move-with-extension (segment dst src opcode
)
973 (aver (register-p dst
))
974 (let ((dst-size (operand-size dst
))
975 (src-size (operand-size src
)))
978 (aver (eq src-size
:byte
))
979 (maybe-emit-operand-size-prefix segment
:word
)
980 (emit-byte segment
#b00001111
)
981 (emit-byte segment opcode
)
982 (emit-ea segment src
(reg-tn-encoding dst
)))
986 (maybe-emit-operand-size-prefix segment
:dword
)
987 (emit-byte segment
#b00001111
)
988 (emit-byte segment opcode
)
989 (emit-ea segment src
(reg-tn-encoding dst
)))
991 (emit-byte segment
#b00001111
)
992 (emit-byte segment
(logior opcode
1))
993 (emit-ea segment src
(reg-tn-encoding dst
))))))))
995 (define-instruction movsx
(segment dst src
)
996 (:printer ext-reg-reg
/mem
((op #b1011111
) (reg nil
:type
'word-reg
)))
997 (:emitter
(emit-move-with-extension segment dst src
#b10111110
)))
999 (define-instruction movzx
(segment dst src
)
1000 (:printer ext-reg-reg
/mem
((op #b1011011
) (reg nil
:type
'word-reg
)))
1001 (:emitter
(emit-move-with-extension segment dst src
#b10110110
)))
1003 (define-instruction push
(segment src
)
1005 (:printer reg-no-width
((op #b01010
)))
1007 (:printer reg
/mem
((op '(#b1111111
#b110
)) (width 1)))
1009 (:printer byte
((op #b01101010
) (imm nil
:type
'signed-imm-byte
))
1011 (:printer byte
((op #b01101000
) (imm nil
:type
'imm-word
))
1013 ;; ### segment registers?
1016 (cond ((integerp src
)
1017 (cond ((<= -
128 src
127)
1018 (emit-byte segment
#b01101010
)
1019 (emit-byte segment src
))
1021 (emit-byte segment
#b01101000
)
1022 (emit-dword segment src
))))
1024 ;; Interpret the fixup as an immediate dword to push.
1025 (emit-byte segment
#b01101000
)
1026 (emit-absolute-fixup segment src
))
1028 (let ((size (operand-size src
)))
1029 (aver (not (eq size
:byte
)))
1030 (maybe-emit-operand-size-prefix segment size
)
1031 (cond ((register-p src
)
1032 (emit-byte-with-reg segment
#b01010
(reg-tn-encoding src
)))
1034 (emit-byte segment
#b11111111
)
1035 (emit-ea segment src
#b110 t
))))))))
1037 (define-instruction pusha
(segment)
1038 (:printer byte
((op #b01100000
)))
1040 (emit-byte segment
#b01100000
)))
1042 (define-instruction pop
(segment dst
)
1043 (:printer reg-no-width
((op #b01011
)))
1044 (:printer reg
/mem
((op '(#b1000111
#b000
)) (width 1)))
1046 (let ((size (operand-size dst
)))
1047 (aver (not (eq size
:byte
)))
1048 (maybe-emit-operand-size-prefix segment size
)
1049 (cond ((register-p dst
)
1050 (emit-byte-with-reg segment
#b01011
(reg-tn-encoding dst
)))
1052 (emit-byte segment
#b10001111
)
1053 (emit-ea segment dst
#b000
))))))
1055 (define-instruction popa
(segment)
1056 (:printer byte
((op #b01100001
)))
1058 (emit-byte segment
#b01100001
)))
1060 (define-instruction xchg
(segment operand1 operand2
)
1061 ;; Register with accumulator.
1062 (:printer reg-no-width
((op #b10010
)) '(:name
:tab accum
", " reg
))
1063 ;; Register/Memory with Register.
1064 (:printer reg-reg
/mem
((op #b1000011
)))
1066 (let ((size (matching-operand-size operand1 operand2
)))
1067 (maybe-emit-operand-size-prefix segment size
)
1068 (labels ((xchg-acc-with-something (acc something
)
1069 (if (and (not (eq size
:byte
)) (register-p something
))
1070 (emit-byte-with-reg segment
1072 (reg-tn-encoding something
))
1073 (xchg-reg-with-something acc something
)))
1074 (xchg-reg-with-something (reg something
)
1075 (emit-byte segment
(if (eq size
:byte
) #b10000110
#b10000111
))
1076 (emit-ea segment something
(reg-tn-encoding reg
))))
1077 (cond ((accumulator-p operand1
)
1078 (xchg-acc-with-something operand1 operand2
))
1079 ((accumulator-p operand2
)
1080 (xchg-acc-with-something operand2 operand1
))
1081 ((register-p operand1
)
1082 (xchg-reg-with-something operand1 operand2
))
1083 ((register-p operand2
)
1084 (xchg-reg-with-something operand2 operand1
))
1086 (error "bogus args to XCHG: ~S ~S" operand1 operand2
)))))))
1088 (define-instruction lea
(segment dst src
)
1089 (:printer reg-reg
/mem
((op #b1000110
) (width 1)))
1091 (aver (dword-reg-p dst
))
1092 (emit-byte segment
#b10001101
)
1093 (emit-ea segment src
(reg-tn-encoding dst
))))
1095 (define-instruction cmpxchg
(segment dst src
)
1096 ;; Register/Memory with Register.
1097 (:printer ext-reg-reg
/mem
((op #b1011000
)) '(:name
:tab reg
/mem
", " reg
))
1099 (aver (register-p src
))
1100 (let ((size (matching-operand-size src dst
)))
1101 (maybe-emit-operand-size-prefix segment size
)
1102 (emit-byte segment
#b00001111
)
1103 (emit-byte segment
(if (eq size
:byte
) #b10110000
#b10110001
))
1104 (emit-ea segment dst
(reg-tn-encoding src
)))))
1108 (define-instruction fs-segment-prefix
(segment)
1109 (:printer byte
((op #b01100100
)))
1111 (emit-byte segment
#x64
)))
1113 (define-instruction gs-segment-prefix
(segment)
1114 (:printer byte
((op #b01100101
)))
1116 (emit-byte segment
#x65
)))
1118 ;;;; flag control instructions
1120 ;;; CLC -- Clear Carry Flag.
1121 (define-instruction clc
(segment)
1122 (:printer byte
((op #b11111000
)))
1124 (emit-byte segment
#b11111000
)))
1126 ;;; CLD -- Clear Direction Flag.
1127 (define-instruction cld
(segment)
1128 (:printer byte
((op #b11111100
)))
1130 (emit-byte segment
#b11111100
)))
1132 ;;; CLI -- Clear Iterrupt Enable Flag.
1133 (define-instruction cli
(segment)
1134 (:printer byte
((op #b11111010
)))
1136 (emit-byte segment
#b11111010
)))
1138 ;;; CMC -- Complement Carry Flag.
1139 (define-instruction cmc
(segment)
1140 (:printer byte
((op #b11110101
)))
1142 (emit-byte segment
#b11110101
)))
1144 ;;; LAHF -- Load AH into flags.
1145 (define-instruction lahf
(segment)
1146 (:printer byte
((op #b10011111
)))
1148 (emit-byte segment
#b10011111
)))
1150 ;;; POPF -- Pop flags.
1151 (define-instruction popf
(segment)
1152 (:printer byte
((op #b10011101
)))
1154 (emit-byte segment
#b10011101
)))
1156 ;;; PUSHF -- push flags.
1157 (define-instruction pushf
(segment)
1158 (:printer byte
((op #b10011100
)))
1160 (emit-byte segment
#b10011100
)))
1162 ;;; SAHF -- Store AH into flags.
1163 (define-instruction sahf
(segment)
1164 (:printer byte
((op #b10011110
)))
1166 (emit-byte segment
#b10011110
)))
1168 ;;; STC -- Set Carry Flag.
1169 (define-instruction stc
(segment)
1170 (:printer byte
((op #b11111001
)))
1172 (emit-byte segment
#b11111001
)))
1174 ;;; STD -- Set Direction Flag.
1175 (define-instruction std
(segment)
1176 (:printer byte
((op #b11111101
)))
1178 (emit-byte segment
#b11111101
)))
1180 ;;; STI -- Set Interrupt Enable Flag.
1181 (define-instruction sti
(segment)
1182 (:printer byte
((op #b11111011
)))
1184 (emit-byte segment
#b11111011
)))
1188 (defun emit-random-arith-inst (name segment dst src opcode
1189 &optional allow-constants
)
1190 (let ((size (matching-operand-size dst src
)))
1191 (maybe-emit-operand-size-prefix segment size
)
1194 (cond ((and (not (eq size
:byte
)) (<= -
128 src
127))
1195 (emit-byte segment
#b10000011
)
1196 (emit-ea segment dst opcode allow-constants
)
1197 (emit-byte segment src
))
1198 ((accumulator-p dst
)
1205 (emit-sized-immediate segment size src
))
1207 (emit-byte segment
(if (eq size
:byte
) #b10000000
#b10000001
))
1208 (emit-ea segment dst opcode allow-constants
)
1209 (emit-sized-immediate segment size src
))))
1214 (if (eq size
:byte
) #b00000000
#b00000001
)))
1215 (emit-ea segment dst
(reg-tn-encoding src
) allow-constants
))
1220 (if (eq size
:byte
) #b00000010
#b00000011
)))
1221 (emit-ea segment src
(reg-tn-encoding dst
) allow-constants
))
1223 (error "bogus operands to ~A" name
)))))
1225 (eval-when (:compile-toplevel
:execute
)
1226 (defun arith-inst-printer-list (subop)
1227 `((accum-imm ((op ,(dpb subop
(byte 3 2) #b0000010
))))
1228 (reg/mem-imm
((op (#b1000000
,subop
))))
1229 (reg/mem-imm
((op (#b1000001
,subop
))
1230 (imm nil
:type signed-imm-byte
)))
1231 (reg-reg/mem-dir
((op ,(dpb subop
(byte 3 1) #b000000
))))))
1234 (define-instruction add
(segment dst src
)
1235 (:printer-list
(arith-inst-printer-list #b000
))
1236 (:emitter
(emit-random-arith-inst "ADD" segment dst src
#b000
)))
1238 (define-instruction adc
(segment dst src
)
1239 (:printer-list
(arith-inst-printer-list #b010
))
1240 (:emitter
(emit-random-arith-inst "ADC" segment dst src
#b010
)))
1242 (define-instruction sub
(segment dst src
)
1243 (:printer-list
(arith-inst-printer-list #b101
))
1244 (:emitter
(emit-random-arith-inst "SUB" segment dst src
#b101
)))
1246 (define-instruction sbb
(segment dst src
)
1247 (:printer-list
(arith-inst-printer-list #b011
))
1248 (:emitter
(emit-random-arith-inst "SBB" segment dst src
#b011
)))
1250 (define-instruction cmp
(segment dst src
)
1251 (:printer-list
(arith-inst-printer-list #b111
))
1252 (:emitter
(emit-random-arith-inst "CMP" segment dst src
#b111 t
)))
1254 (define-instruction inc
(segment dst
)
1256 (:printer reg-no-width
((op #b01000
)))
1258 (:printer reg
/mem
((op '(#b1111111
#b000
))))
1260 (let ((size (operand-size dst
)))
1261 (maybe-emit-operand-size-prefix segment size
)
1262 (cond ((and (not (eq size
:byte
)) (register-p dst
))
1263 (emit-byte-with-reg segment
#b01000
(reg-tn-encoding dst
)))
1265 (emit-byte segment
(if (eq size
:byte
) #b11111110
#b11111111
))
1266 (emit-ea segment dst
#b000
))))))
1268 (define-instruction dec
(segment dst
)
1270 (:printer reg-no-width
((op #b01001
)))
1272 (:printer reg
/mem
((op '(#b1111111
#b001
))))
1274 (let ((size (operand-size dst
)))
1275 (maybe-emit-operand-size-prefix segment size
)
1276 (cond ((and (not (eq size
:byte
)) (register-p dst
))
1277 (emit-byte-with-reg segment
#b01001
(reg-tn-encoding dst
)))
1279 (emit-byte segment
(if (eq size
:byte
) #b11111110
#b11111111
))
1280 (emit-ea segment dst
#b001
))))))
1282 (define-instruction neg
(segment dst
)
1283 (:printer reg
/mem
((op '(#b1111011
#b011
))))
1285 (let ((size (operand-size dst
)))
1286 (maybe-emit-operand-size-prefix segment size
)
1287 (emit-byte segment
(if (eq size
:byte
) #b11110110
#b11110111
))
1288 (emit-ea segment dst
#b011
))))
1290 (define-instruction aaa
(segment)
1291 (:printer byte
((op #b00110111
)))
1293 (emit-byte segment
#b00110111
)))
1295 (define-instruction aas
(segment)
1296 (:printer byte
((op #b00111111
)))
1298 (emit-byte segment
#b00111111
)))
1300 (define-instruction daa
(segment)
1301 (:printer byte
((op #b00100111
)))
1303 (emit-byte segment
#b00100111
)))
1305 (define-instruction das
(segment)
1306 (:printer byte
((op #b00101111
)))
1308 (emit-byte segment
#b00101111
)))
1310 (define-instruction mul
(segment dst src
)
1311 (:printer accum-reg
/mem
((op '(#b1111011
#b100
))))
1313 (let ((size (matching-operand-size dst src
)))
1314 (aver (accumulator-p dst
))
1315 (maybe-emit-operand-size-prefix segment size
)
1316 (emit-byte segment
(if (eq size
:byte
) #b11110110
#b11110111
))
1317 (emit-ea segment src
#b100
))))
1319 (define-instruction imul
(segment dst
&optional src1 src2
)
1320 (:printer accum-reg
/mem
((op '(#b1111011
#b101
))))
1321 (:printer ext-reg-reg
/mem
((op #b1010111
)))
1322 (:printer reg-reg
/mem
((op #b0110100
) (width 1)
1323 (imm nil
:type
'signed-imm-word
))
1324 '(:name
:tab reg
", " reg
/mem
", " imm
))
1325 (:printer reg-reg
/mem
((op #b0110101
) (width 1)
1326 (imm nil
:type
'signed-imm-byte
))
1327 '(:name
:tab reg
", " reg
/mem
", " imm
))
1329 (flet ((r/m-with-immed-to-reg
(reg r
/m immed
)
1330 (let* ((size (matching-operand-size reg r
/m
))
1331 (sx (and (not (eq size
:byte
)) (<= -
128 immed
127))))
1332 (maybe-emit-operand-size-prefix segment size
)
1333 (emit-byte segment
(if sx
#b01101011
#b01101001
))
1334 (emit-ea segment r
/m
(reg-tn-encoding reg
))
1336 (emit-byte segment immed
)
1337 (emit-sized-immediate segment size immed
)))))
1339 (r/m-with-immed-to-reg dst src1 src2
))
1342 (r/m-with-immed-to-reg dst dst src1
)
1343 (let ((size (matching-operand-size dst src1
)))
1344 (maybe-emit-operand-size-prefix segment size
)
1345 (emit-byte segment
#b00001111
)
1346 (emit-byte segment
#b10101111
)
1347 (emit-ea segment src1
(reg-tn-encoding dst
)))))
1349 (let ((size (operand-size dst
)))
1350 (maybe-emit-operand-size-prefix segment size
)
1351 (emit-byte segment
(if (eq size
:byte
) #b11110110
#b11110111
))
1352 (emit-ea segment dst
#b101
)))))))
1354 (define-instruction div
(segment dst src
)
1355 (:printer accum-reg
/mem
((op '(#b1111011
#b110
))))
1357 (let ((size (matching-operand-size dst src
)))
1358 (aver (accumulator-p dst
))
1359 (maybe-emit-operand-size-prefix segment size
)
1360 (emit-byte segment
(if (eq size
:byte
) #b11110110
#b11110111
))
1361 (emit-ea segment src
#b110
))))
1363 (define-instruction idiv
(segment dst src
)
1364 (:printer accum-reg
/mem
((op '(#b1111011
#b111
))))
1366 (let ((size (matching-operand-size dst src
)))
1367 (aver (accumulator-p dst
))
1368 (maybe-emit-operand-size-prefix segment size
)
1369 (emit-byte segment
(if (eq size
:byte
) #b11110110
#b11110111
))
1370 (emit-ea segment src
#b111
))))
1372 (define-instruction aad
(segment)
1373 (:printer two-bytes
((op '(#b11010101
#b00001010
))))
1375 (emit-byte segment
#b11010101
)
1376 (emit-byte segment
#b00001010
)))
1378 (define-instruction aam
(segment)
1379 (:printer two-bytes
((op '(#b11010100
#b00001010
))))
1381 (emit-byte segment
#b11010100
)
1382 (emit-byte segment
#b00001010
)))
1384 ;;; CBW -- Convert Byte to Word. AX <- sign_xtnd(AL)
1385 (define-instruction cbw
(segment)
1387 (maybe-emit-operand-size-prefix segment
:word
)
1388 (emit-byte segment
#b10011000
)))
1390 ;;; CWDE -- Convert Word To Double Word Extened. EAX <- sign_xtnd(AX)
1391 (define-instruction cwde
(segment)
1393 (maybe-emit-operand-size-prefix segment
:dword
)
1394 (emit-byte segment
#b10011000
)))
1396 ;;; CWD -- Convert Word to Double Word. DX:AX <- sign_xtnd(AX)
1397 (define-instruction cwd
(segment)
1399 (maybe-emit-operand-size-prefix segment
:word
)
1400 (emit-byte segment
#b10011001
)))
1402 ;;; CDQ -- Convert Double Word to Quad Word. EDX:EAX <- sign_xtnd(EAX)
1403 (define-instruction cdq
(segment)
1404 (:printer byte
((op #b10011001
)))
1406 (maybe-emit-operand-size-prefix segment
:dword
)
1407 (emit-byte segment
#b10011001
)))
1409 (define-instruction xadd
(segment dst src
)
1410 ;; Register/Memory with Register.
1411 (:printer ext-reg-reg
/mem
((op #b1100000
)) '(:name
:tab reg
/mem
", " reg
))
1413 (aver (register-p src
))
1414 (let ((size (matching-operand-size src dst
)))
1415 (maybe-emit-operand-size-prefix segment size
)
1416 (emit-byte segment
#b00001111
)
1417 (emit-byte segment
(if (eq size
:byte
) #b11000000
#b11000001
))
1418 (emit-ea segment dst
(reg-tn-encoding src
)))))
1423 (defun emit-shift-inst (segment dst amount opcode
)
1424 (let ((size (operand-size dst
)))
1425 (maybe-emit-operand-size-prefix segment size
)
1426 (multiple-value-bind (major-opcode immed
)
1428 (:cl
(values #b11010010 nil
))
1429 (1 (values #b11010000 nil
))
1430 (t (values #b11000000 t
)))
1432 (if (eq size
:byte
) major-opcode
(logior major-opcode
1)))
1433 (emit-ea segment dst opcode
)
1435 (emit-byte segment amount
)))))
1437 (eval-when (:compile-toplevel
:execute
)
1438 (defun shift-inst-printer-list (subop)
1439 `((reg/mem
((op (#b1101000
,subop
)))
1440 (:name
:tab reg
/mem
", 1"))
1441 (reg/mem
((op (#b1101001
,subop
)))
1442 (:name
:tab reg
/mem
", " 'cl
))
1443 (reg/mem-imm
((op (#b1100000
,subop
))
1444 (imm nil
:type signed-imm-byte
))))))
1446 (define-instruction rol
(segment dst amount
)
1448 (shift-inst-printer-list #b000
))
1450 (emit-shift-inst segment dst amount
#b000
)))
1452 (define-instruction ror
(segment dst amount
)
1454 (shift-inst-printer-list #b001
))
1456 (emit-shift-inst segment dst amount
#b001
)))
1458 (define-instruction rcl
(segment dst amount
)
1460 (shift-inst-printer-list #b010
))
1462 (emit-shift-inst segment dst amount
#b010
)))
1464 (define-instruction rcr
(segment dst amount
)
1466 (shift-inst-printer-list #b011
))
1468 (emit-shift-inst segment dst amount
#b011
)))
1470 (define-instruction shl
(segment dst amount
)
1472 (shift-inst-printer-list #b100
))
1474 (emit-shift-inst segment dst amount
#b100
)))
1476 (define-instruction shr
(segment dst amount
)
1478 (shift-inst-printer-list #b101
))
1480 (emit-shift-inst segment dst amount
#b101
)))
1482 (define-instruction sar
(segment dst amount
)
1484 (shift-inst-printer-list #b111
))
1486 (emit-shift-inst segment dst amount
#b111
)))
1488 (defun emit-double-shift (segment opcode dst src amt
)
1489 (let ((size (matching-operand-size dst src
)))
1490 (when (eq size
:byte
)
1491 (error "Double shifts can only be used with words."))
1492 (maybe-emit-operand-size-prefix segment size
)
1493 (emit-byte segment
#b00001111
)
1494 (emit-byte segment
(dpb opcode
(byte 1 3)
1495 (if (eq amt
:cl
) #b10100101
#b10100100
)))
1497 (emit-ea segment dst src
)
1498 (emit-ea segment dst
(reg-tn-encoding src
)) ; pw tries this
1499 (unless (eq amt
:cl
)
1500 (emit-byte segment amt
))))
1502 (eval-when (:compile-toplevel
:execute
)
1503 (defun double-shift-inst-printer-list (op)
1505 (ext-reg-reg/mem-imm
((op ,(logior op
#b10
))
1506 (imm nil
:type signed-imm-byte
)))
1507 (ext-reg-reg/mem
((op ,(logior op
#b10
)))
1508 (:name
:tab reg
/mem
", " reg
", " 'cl
)))))
1510 (define-instruction shld
(segment dst src amt
)
1511 (:declare
(type (or (member :cl
) (mod 32)) amt
))
1512 (:printer-list
(double-shift-inst-printer-list #b1010000
))
1514 (emit-double-shift segment
#b0 dst src amt
)))
1516 (define-instruction shrd
(segment dst src amt
)
1517 (:declare
(type (or (member :cl
) (mod 32)) amt
))
1518 (:printer-list
(double-shift-inst-printer-list #b1010100
))
1520 (emit-double-shift segment
#b1 dst src amt
)))
1522 (define-instruction and
(segment dst src
)
1524 (arith-inst-printer-list #b100
))
1526 (emit-random-arith-inst "AND" segment dst src
#b100
)))
1528 (define-instruction test
(segment this that
)
1529 (:printer accum-imm
((op #b1010100
)))
1530 (:printer reg
/mem-imm
((op '(#b1111011
#b000
))))
1531 (:printer reg-reg
/mem
((op #b1000010
)))
1533 (let ((size (matching-operand-size this that
)))
1534 (maybe-emit-operand-size-prefix segment size
)
1535 (flet ((test-immed-and-something (immed something
)
1536 (cond ((accumulator-p something
)
1538 (if (eq size
:byte
) #b10101000
#b10101001
))
1539 (emit-sized-immediate segment size immed
))
1542 (if (eq size
:byte
) #b11110110
#b11110111
))
1543 (emit-ea segment something
#b000
)
1544 (emit-sized-immediate segment size immed
))))
1545 (test-reg-and-something (reg something
)
1546 (emit-byte segment
(if (eq size
:byte
) #b10000100
#b10000101
))
1547 (emit-ea segment something
(reg-tn-encoding reg
))))
1548 (cond ((integerp that
)
1549 (test-immed-and-something that this
))
1551 (test-immed-and-something this that
))
1553 (test-reg-and-something this that
))
1555 (test-reg-and-something that this
))
1557 (error "bogus operands for TEST: ~S and ~S" this that
)))))))
1559 ;;; Emit the most compact form of the test immediate instruction,
1560 ;;; using an 8 bit test when the immediate is only 8 bits and the
1561 ;;; value is one of the four low registers (eax, ebx, ecx, edx) or the
1563 (defun emit-optimized-test-inst (x y
)
1566 (let ((offset (tn-offset x
)))
1567 (cond ((and (sc-is x any-reg descriptor-reg
)
1568 (or (= offset eax-offset
) (= offset ebx-offset
)
1569 (= offset ecx-offset
) (= offset edx-offset
)))
1570 (inst test
(make-random-tn :kind
:normal
1571 :sc
(sc-or-lose 'byte-reg
)
1574 ((sc-is x control-stack
)
1575 (inst test
(make-ea :byte
:base ebp-tn
1576 :disp
(- (* (1+ offset
) n-word-bytes
)))
1583 (define-instruction or
(segment dst src
)
1585 (arith-inst-printer-list #b001
))
1587 (emit-random-arith-inst "OR" segment dst src
#b001
)))
1589 (define-instruction xor
(segment dst src
)
1591 (arith-inst-printer-list #b110
))
1593 (emit-random-arith-inst "XOR" segment dst src
#b110
)))
1595 (define-instruction not
(segment dst
)
1596 (:printer reg
/mem
((op '(#b1111011
#b010
))))
1598 (let ((size (operand-size dst
)))
1599 (maybe-emit-operand-size-prefix segment size
)
1600 (emit-byte segment
(if (eq size
:byte
) #b11110110
#b11110111
))
1601 (emit-ea segment dst
#b010
))))
1603 ;;;; string manipulation
1605 (define-instruction cmps
(segment size
)
1606 (:printer string-op
((op #b1010011
)))
1608 (maybe-emit-operand-size-prefix segment size
)
1609 (emit-byte segment
(if (eq size
:byte
) #b10100110
#b10100111
))))
1611 (define-instruction ins
(segment acc
)
1612 (:printer string-op
((op #b0110110
)))
1614 (let ((size (operand-size acc
)))
1615 (aver (accumulator-p acc
))
1616 (maybe-emit-operand-size-prefix segment size
)
1617 (emit-byte segment
(if (eq size
:byte
) #b01101100
#b01101101
)))))
1619 (define-instruction lods
(segment acc
)
1620 (:printer string-op
((op #b1010110
)))
1622 (let ((size (operand-size acc
)))
1623 (aver (accumulator-p acc
))
1624 (maybe-emit-operand-size-prefix segment size
)
1625 (emit-byte segment
(if (eq size
:byte
) #b10101100
#b10101101
)))))
1627 (define-instruction movs
(segment size
)
1628 (:printer string-op
((op #b1010010
)))
1630 (maybe-emit-operand-size-prefix segment size
)
1631 (emit-byte segment
(if (eq size
:byte
) #b10100100
#b10100101
))))
1633 (define-instruction outs
(segment acc
)
1634 (:printer string-op
((op #b0110111
)))
1636 (let ((size (operand-size acc
)))
1637 (aver (accumulator-p acc
))
1638 (maybe-emit-operand-size-prefix segment size
)
1639 (emit-byte segment
(if (eq size
:byte
) #b01101110
#b01101111
)))))
1641 (define-instruction scas
(segment acc
)
1642 (:printer string-op
((op #b1010111
)))
1644 (let ((size (operand-size acc
)))
1645 (aver (accumulator-p acc
))
1646 (maybe-emit-operand-size-prefix segment size
)
1647 (emit-byte segment
(if (eq size
:byte
) #b10101110
#b10101111
)))))
1649 (define-instruction stos
(segment acc
)
1650 (:printer string-op
((op #b1010101
)))
1652 (let ((size (operand-size acc
)))
1653 (aver (accumulator-p acc
))
1654 (maybe-emit-operand-size-prefix segment size
)
1655 (emit-byte segment
(if (eq size
:byte
) #b10101010
#b10101011
)))))
1657 (define-instruction xlat
(segment)
1658 (:printer byte
((op #b11010111
)))
1660 (emit-byte segment
#b11010111
)))
1662 (define-instruction rep
(segment)
1664 (emit-byte segment
#b11110010
)))
1666 (define-instruction repe
(segment)
1667 (:printer byte
((op #b11110011
)))
1669 (emit-byte segment
#b11110011
)))
1671 (define-instruction repne
(segment)
1672 (:printer byte
((op #b11110010
)))
1674 (emit-byte segment
#b11110010
)))
1677 ;;;; bit manipulation
1679 (define-instruction bsf
(segment dst src
)
1680 (:printer ext-reg-reg
/mem
((op #b1011110
) (width 0)))
1682 (let ((size (matching-operand-size dst src
)))
1683 (when (eq size
:byte
)
1684 (error "can't scan bytes: ~S" src
))
1685 (maybe-emit-operand-size-prefix segment size
)
1686 (emit-byte segment
#b00001111
)
1687 (emit-byte segment
#b10111100
)
1688 (emit-ea segment src
(reg-tn-encoding dst
)))))
1690 (define-instruction bsr
(segment dst src
)
1691 (:printer ext-reg-reg
/mem
((op #b1011110
) (width 1)))
1693 (let ((size (matching-operand-size dst src
)))
1694 (when (eq size
:byte
)
1695 (error "can't scan bytes: ~S" src
))
1696 (maybe-emit-operand-size-prefix segment size
)
1697 (emit-byte segment
#b00001111
)
1698 (emit-byte segment
#b10111101
)
1699 (emit-ea segment src
(reg-tn-encoding dst
)))))
1701 (defun emit-bit-test-and-mumble (segment src index opcode
)
1702 (let ((size (operand-size src
)))
1703 (when (eq size
:byte
)
1704 (error "can't scan bytes: ~S" src
))
1705 (maybe-emit-operand-size-prefix segment size
)
1706 (emit-byte segment
#b00001111
)
1707 (cond ((integerp index
)
1708 (emit-byte segment
#b10111010
)
1709 (emit-ea segment src opcode
)
1710 (emit-byte segment index
))
1712 (emit-byte segment
(dpb opcode
(byte 3 3) #b10000011
))
1713 (emit-ea segment src
(reg-tn-encoding index
))))))
1715 (eval-when (:compile-toplevel
:execute
)
1716 (defun bit-test-inst-printer-list (subop)
1717 `((ext-reg/mem-imm
((op (#b1011101
,subop
))
1718 (reg/mem nil
:type word-reg
/mem
)
1719 (imm nil
:type imm-data
)
1721 (ext-reg-reg/mem
((op ,(dpb subop
(byte 3 2) #b1000001
))
1723 (:name
:tab reg
/mem
", " reg
)))))
1725 (define-instruction bt
(segment src index
)
1726 (:printer-list
(bit-test-inst-printer-list #b100
))
1728 (emit-bit-test-and-mumble segment src index
#b100
)))
1730 (define-instruction btc
(segment src index
)
1731 (:printer-list
(bit-test-inst-printer-list #b111
))
1733 (emit-bit-test-and-mumble segment src index
#b111
)))
1735 (define-instruction btr
(segment src index
)
1736 (:printer-list
(bit-test-inst-printer-list #b110
))
1738 (emit-bit-test-and-mumble segment src index
#b110
)))
1740 (define-instruction bts
(segment src index
)
1741 (:printer-list
(bit-test-inst-printer-list #b101
))
1743 (emit-bit-test-and-mumble segment src index
#b101
)))
1746 ;;;; control transfer
1748 (define-instruction call
(segment where
)
1749 (:printer near-jump
((op #b11101000
)))
1750 (:printer reg
/mem
((op '(#b1111111
#b010
)) (width 1)))
1754 (emit-byte segment
#b11101000
)
1755 (emit-back-patch segment
1757 (lambda (segment posn
)
1759 (- (label-position where
)
1762 (emit-byte segment
#b11101000
)
1763 (emit-relative-fixup segment where
))
1765 (emit-byte segment
#b11111111
)
1766 (emit-ea segment where
#b010
)))))
1768 (defun emit-byte-displacement-backpatch (segment target
)
1769 (emit-back-patch segment
1771 (lambda (segment posn
)
1772 (let ((disp (- (label-position target
) (1+ posn
))))
1773 (aver (<= -
128 disp
127))
1774 (emit-byte segment disp
)))))
1776 (define-instruction jmp
(segment cond
&optional where
)
1777 ;; conditional jumps
1778 (:printer short-cond-jump
((op #b0111
)) '('j cc
:tab label
))
1779 (:printer near-cond-jump
() '('j cc
:tab label
))
1780 ;; unconditional jumps
1781 (:printer short-jump
((op #b1011
)))
1782 (:printer near-jump
((op #b11101001
)) )
1783 (:printer reg
/mem
((op '(#b1111111
#b100
)) (width 1)))
1788 (lambda (segment posn delta-if-after
)
1789 (let ((disp (- (label-position where posn delta-if-after
)
1791 (when (<= -
128 disp
127)
1793 (dpb (conditional-opcode cond
)
1796 (emit-byte-displacement-backpatch segment where
)
1798 (lambda (segment posn
)
1799 (let ((disp (- (label-position where
) (+ posn
6))))
1800 (emit-byte segment
#b00001111
)
1802 (dpb (conditional-opcode cond
)
1805 (emit-dword segment disp
)))))
1806 ((label-p (setq where cond
))
1809 (lambda (segment posn delta-if-after
)
1810 (let ((disp (- (label-position where posn delta-if-after
)
1812 (when (<= -
128 disp
127)
1813 (emit-byte segment
#b11101011
)
1814 (emit-byte-displacement-backpatch segment where
)
1816 (lambda (segment posn
)
1817 (let ((disp (- (label-position where
) (+ posn
5))))
1818 (emit-byte segment
#b11101001
)
1819 (emit-dword segment disp
)))))
1821 (emit-byte segment
#b11101001
)
1822 (emit-relative-fixup segment where
))
1824 (unless (or (ea-p where
) (tn-p where
))
1825 (error "don't know what to do with ~A" where
))
1826 (emit-byte segment
#b11111111
)
1827 (emit-ea segment where
#b100
)))))
1829 (define-instruction jmp-short
(segment label
)
1831 (emit-byte segment
#b11101011
)
1832 (emit-byte-displacement-backpatch segment label
)))
1834 (define-instruction ret
(segment &optional stack-delta
)
1835 (:printer byte
((op #b11000011
)))
1836 (:printer byte
((op #b11000010
) (imm nil
:type
'imm-word-16
))
1840 (emit-byte segment
#b11000010
)
1841 (emit-word segment stack-delta
))
1843 (emit-byte segment
#b11000011
)))))
1845 (define-instruction jecxz
(segment target
)
1846 (:printer short-jump
((op #b0011
)))
1848 (emit-byte segment
#b11100011
)
1849 (emit-byte-displacement-backpatch segment target
)))
1851 (define-instruction loop
(segment target
)
1852 (:printer short-jump
((op #b0010
)))
1854 (emit-byte segment
#b11100010
) ; pfw this was 11100011, or jecxz!!!!
1855 (emit-byte-displacement-backpatch segment target
)))
1857 (define-instruction loopz
(segment target
)
1858 (:printer short-jump
((op #b0001
)))
1860 (emit-byte segment
#b11100001
)
1861 (emit-byte-displacement-backpatch segment target
)))
1863 (define-instruction loopnz
(segment target
)
1864 (:printer short-jump
((op #b0000
)))
1866 (emit-byte segment
#b11100000
)
1867 (emit-byte-displacement-backpatch segment target
)))
1869 ;;;; conditional move
1870 (define-instruction cmov
(segment cond dst src
)
1871 (:printer cond-move
())
1873 (aver (register-p dst
))
1874 (let ((size (matching-operand-size dst src
)))
1875 (aver (or (eq size
:word
) (eq size
:dword
)))
1876 (maybe-emit-operand-size-prefix segment size
))
1877 (emit-byte segment
#b00001111
)
1878 (emit-byte segment
(dpb (conditional-opcode cond
) (byte 4 0) #b01000000
))
1879 (emit-ea segment src
(reg-tn-encoding dst
))))
1881 ;;;; conditional byte set
1883 (define-instruction set
(segment dst cond
)
1884 (:printer cond-set
())
1886 (emit-byte segment
#b00001111
)
1887 (emit-byte segment
(dpb (conditional-opcode cond
) (byte 4 0) #b10010000
))
1888 (emit-ea segment dst
#b000
)))
1892 (define-instruction enter
(segment disp
&optional
(level 0))
1893 (:declare
(type (unsigned-byte 16) disp
)
1894 (type (unsigned-byte 8) level
))
1895 (:printer enter-format
((op #b11001000
)))
1897 (emit-byte segment
#b11001000
)
1898 (emit-word segment disp
)
1899 (emit-byte segment level
)))
1901 (define-instruction leave
(segment)
1902 (:printer byte
((op #b11001001
)))
1904 (emit-byte segment
#b11001001
)))
1907 (define-instruction prefetchnta
(segment ea
)
1908 (:printer prefetch
((op #b00011000
) (reg #b000
)))
1910 (aver (typep ea
'ea
))
1911 (aver (eq :byte
(ea-size ea
)))
1912 (emit-byte segment
#b00001111
)
1913 (emit-byte segment
#b00011000
)
1914 (emit-ea segment ea
#b000
)))
1916 (define-instruction prefetcht0
(segment ea
)
1917 (:printer prefetch
((op #b00011000
) (reg #b001
)))
1919 (aver (typep ea
'ea
))
1920 (aver (eq :byte
(ea-size ea
)))
1921 (emit-byte segment
#b00001111
)
1922 (emit-byte segment
#b00011000
)
1923 (emit-ea segment ea
#b001
)))
1925 (define-instruction prefetcht1
(segment ea
)
1926 (:printer prefetch
((op #b00011000
) (reg #b010
)))
1928 (aver (typep ea
'ea
))
1929 (aver (eq :byte
(ea-size ea
)))
1930 (emit-byte segment
#b00001111
)
1931 (emit-byte segment
#b00011000
)
1932 (emit-ea segment ea
#b010
)))
1934 (define-instruction prefetcht2
(segment ea
)
1935 (:printer prefetch
((op #b00011000
) (reg #b011
)))
1937 (aver (typep ea
'ea
))
1938 (aver (eq :byte
(ea-size ea
)))
1939 (emit-byte segment
#b00001111
)
1940 (emit-byte segment
#b00011000
)
1941 (emit-ea segment ea
#b011
)))
1943 ;;;; interrupt instructions
1945 (defun snarf-error-junk (sap offset
&optional length-only
)
1946 (let* ((length (sb!sys
:sap-ref-8 sap offset
))
1947 (vector (make-array length
:element-type
'(unsigned-byte 8))))
1948 (declare (type sb
!sys
:system-area-pointer sap
)
1949 (type (unsigned-byte 8) length
)
1950 (type (simple-array (unsigned-byte 8) (*)) vector
))
1952 (values 0 (1+ length
) nil nil
))
1954 (sb!kernel
:copy-ub8-from-system-area sap
(1+ offset
)
1956 (collect ((sc-offsets)
1958 (lengths 1) ; the length byte
1960 (error-number (sb!c
:read-var-integer vector index
)))
1963 (when (>= index length
)
1965 (let ((old-index index
))
1966 (sc-offsets (sb!c
:read-var-integer vector index
))
1967 (lengths (- index old-index
))))
1968 (values error-number
1974 (defmacro break-cases
(breaknum &body cases
)
1975 (let ((bn-temp (gensym)))
1976 (collect ((clauses))
1977 (dolist (case cases
)
1978 (clauses `((= ,bn-temp
,(car case
)) ,@(cdr case
))))
1979 `(let ((,bn-temp
,breaknum
))
1980 (cond ,@(clauses))))))
1983 (defun break-control (chunk inst stream dstate
)
1984 (declare (ignore inst
))
1985 (flet ((nt (x) (if stream
(sb!disassem
:note x dstate
))))
1986 ;; FIXME: Make sure that BYTE-IMM-CODE is defined. The genesis
1987 ;; map has it undefined; and it should be easier to look in the target
1988 ;; Lisp (with (DESCRIBE 'BYTE-IMM-CODE)) than to definitively deduce
1989 ;; from first principles whether it's defined in some way that genesis
1991 (case #!-darwin
(byte-imm-code chunk dstate
)
1992 #!+darwin
(word-imm-code chunk dstate
)
1995 (sb!disassem
:handle-break-args
#'snarf-error-junk stream dstate
))
1998 (sb!disassem
:handle-break-args
#'snarf-error-junk stream dstate
))
2000 (nt "breakpoint trap"))
2001 (#.pending-interrupt-trap
2002 (nt "pending interrupt trap"))
2005 (#.fun-end-breakpoint-trap
2006 (nt "function end breakpoint trap")))))
2008 (define-instruction break
(segment code
)
2009 (:declare
(type (unsigned-byte 8) code
))
2010 #!-darwin
(:printer byte-imm
((op #b11001100
)) '(:name
:tab code
)
2011 :control
#'break-control
)
2012 #!+darwin
(:printer word-imm
((op #b0000101100001111
)) '(:name
:tab code
)
2013 :control
#'break-control
)
2015 #!-darwin
(emit-byte segment
#b11001100
)
2016 ;; On darwin, trap handling via SIGTRAP is unreliable, therefore we
2017 ;; throw a sigill with 0x0b0f instead and check for this in the
2018 ;; SIGILL handler and pass it on to the sigtrap handler if
2020 #!+darwin
(emit-word segment
#b0000101100001111
)
2021 (emit-byte segment code
)))
2023 (define-instruction int
(segment number
)
2024 (:declare
(type (unsigned-byte 8) number
))
2025 (:printer byte-imm
((op #b11001101
)))
2029 (emit-byte segment
#b11001100
))
2031 (emit-byte segment
#b11001101
)
2032 (emit-byte segment number
)))))
2034 (define-instruction into
(segment)
2035 (:printer byte
((op #b11001110
)))
2037 (emit-byte segment
#b11001110
)))
2039 (define-instruction bound
(segment reg bounds
)
2041 (let ((size (matching-operand-size reg bounds
)))
2042 (when (eq size
:byte
)
2043 (error "can't bounds-test bytes: ~S" reg
))
2044 (maybe-emit-operand-size-prefix segment size
)
2045 (emit-byte segment
#b01100010
)
2046 (emit-ea segment bounds
(reg-tn-encoding reg
)))))
2048 (define-instruction iret
(segment)
2049 (:printer byte
((op #b11001111
)))
2051 (emit-byte segment
#b11001111
)))
2053 ;;;; processor control
2055 (define-instruction hlt
(segment)
2056 (:printer byte
((op #b11110100
)))
2058 (emit-byte segment
#b11110100
)))
2060 (define-instruction nop
(segment)
2061 (:printer byte
((op #b10010000
)))
2063 (emit-byte segment
#b10010000
)))
2065 (define-instruction wait
(segment)
2066 (:printer byte
((op #b10011011
)))
2068 (emit-byte segment
#b10011011
)))
2070 (define-instruction lock
(segment)
2071 (:printer byte
((op #b11110000
)))
2073 (emit-byte segment
#b11110000
)))
2075 ;;;; miscellaneous hackery
2077 (define-instruction byte
(segment byte
)
2079 (emit-byte segment byte
)))
2081 (define-instruction word
(segment word
)
2083 (emit-word segment word
)))
2085 (define-instruction dword
(segment dword
)
2087 (emit-dword segment dword
)))
2089 (defun emit-header-data (segment type
)
2090 (emit-back-patch segment
2092 (lambda (segment posn
)
2096 (component-header-length))
2100 (define-instruction simple-fun-header-word
(segment)
2102 (emit-header-data segment simple-fun-header-widetag
)))
2104 (define-instruction lra-header-word
(segment)
2106 (emit-header-data segment return-pc-header-widetag
)))
2108 ;;;; fp instructions
2110 ;;;; FIXME: This section said "added by jrd", which should end up in CREDITS.
2112 ;;;; Note: We treat the single-precision and double-precision variants
2113 ;;;; as separate instructions.
2115 ;;; Load single to st(0).
2116 (define-instruction fld
(segment source
)
2117 (:printer floating-point
((op '(#b001
#b000
))))
2119 (emit-byte segment
#b11011001
)
2120 (emit-fp-op segment source
#b000
)))
2122 ;;; Load double to st(0).
2123 (define-instruction fldd
(segment source
)
2124 (:printer floating-point
((op '(#b101
#b000
))))
2125 (:printer floating-point-fp
((op '(#b001
#b000
))))
2127 (if (fp-reg-tn-p source
)
2128 (emit-byte segment
#b11011001
)
2129 (emit-byte segment
#b11011101
))
2130 (emit-fp-op segment source
#b000
)))
2132 ;;; Load long to st(0).
2133 (define-instruction fldl
(segment source
)
2134 (:printer floating-point
((op '(#b011
#b101
))))
2136 (emit-byte segment
#b11011011
)
2137 (emit-fp-op segment source
#b101
)))
2139 ;;; Store single from st(0).
2140 (define-instruction fst
(segment dest
)
2141 (:printer floating-point
((op '(#b001
#b010
))))
2143 (cond ((fp-reg-tn-p dest
)
2144 (emit-byte segment
#b11011101
)
2145 (emit-fp-op segment dest
#b010
))
2147 (emit-byte segment
#b11011001
)
2148 (emit-fp-op segment dest
#b010
)))))
2150 ;;; Store double from st(0).
2151 (define-instruction fstd
(segment dest
)
2152 (:printer floating-point
((op '(#b101
#b010
))))
2153 (:printer floating-point-fp
((op '(#b101
#b010
))))
2155 (cond ((fp-reg-tn-p dest
)
2156 (emit-byte segment
#b11011101
)
2157 (emit-fp-op segment dest
#b010
))
2159 (emit-byte segment
#b11011101
)
2160 (emit-fp-op segment dest
#b010
)))))
2162 ;;; Arithmetic ops are all done with at least one operand at top of
2163 ;;; stack. The other operand is is another register or a 32/64 bit
2166 ;;; dtc: I've tried to follow the Intel ASM386 conventions, but note
2167 ;;; that these conflict with the Gdb conventions for binops. To reduce
2168 ;;; the confusion I've added comments showing the mathamatical
2169 ;;; operation and the two syntaxes. By the ASM386 convention the
2170 ;;; instruction syntax is:
2173 ;;; or Fop Destination, Source
2175 ;;; If only one operand is given then it is the source and the
2176 ;;; destination is ST(0). There are reversed forms of the fsub and
2177 ;;; fdiv instructions inducated by an 'R' suffix.
2179 ;;; The mathematical operation for the non-reverse form is always:
2180 ;;; destination = destination op source
2182 ;;; For the reversed form it is:
2183 ;;; destination = source op destination
2185 ;;; The instructions below only accept one operand at present which is
2186 ;;; usually the source. I've hack in extra instructions to implement
2187 ;;; the fops with a ST(i) destination, these have a -sti suffix and
2188 ;;; the operand is the destination with the source being ST(0).
2191 ;;; st(0) = st(0) + memory or st(i).
2192 (define-instruction fadd
(segment source
)
2193 (:printer floating-point
((op '(#b000
#b000
))))
2195 (emit-byte segment
#b11011000
)
2196 (emit-fp-op segment source
#b000
)))
2199 ;;; st(0) = st(0) + memory or st(i).
2200 (define-instruction faddd
(segment source
)
2201 (:printer floating-point
((op '(#b100
#b000
))))
2202 (:printer floating-point-fp
((op '(#b000
#b000
))))
2204 (if (fp-reg-tn-p source
)
2205 (emit-byte segment
#b11011000
)
2206 (emit-byte segment
#b11011100
))
2207 (emit-fp-op segment source
#b000
)))
2209 ;;; Add double destination st(i):
2210 ;;; st(i) = st(0) + st(i).
2211 (define-instruction fadd-sti
(segment destination
)
2212 (:printer floating-point-fp
((op '(#b100
#b000
))))
2214 (aver (fp-reg-tn-p destination
))
2215 (emit-byte segment
#b11011100
)
2216 (emit-fp-op segment destination
#b000
)))
2218 (define-instruction faddp-sti
(segment destination
)
2219 (:printer floating-point-fp
((op '(#b110
#b000
))))
2221 (aver (fp-reg-tn-p destination
))
2222 (emit-byte segment
#b11011110
)
2223 (emit-fp-op segment destination
#b000
)))
2225 ;;; Subtract single:
2226 ;;; st(0) = st(0) - memory or st(i).
2227 (define-instruction fsub
(segment source
)
2228 (:printer floating-point
((op '(#b000
#b100
))))
2230 (emit-byte segment
#b11011000
)
2231 (emit-fp-op segment source
#b100
)))
2233 ;;; Subtract single, reverse:
2234 ;;; st(0) = memory or st(i) - st(0).
2235 (define-instruction fsubr
(segment source
)
2236 (:printer floating-point
((op '(#b000
#b101
))))
2238 (emit-byte segment
#b11011000
)
2239 (emit-fp-op segment source
#b101
)))
2241 ;;; Subtract double:
2242 ;;; st(0) = st(0) - memory or st(i).
2243 (define-instruction fsubd
(segment source
)
2244 (:printer floating-point
((op '(#b100
#b100
))))
2245 (:printer floating-point-fp
((op '(#b000
#b100
))))
2247 (if (fp-reg-tn-p source
)
2248 (emit-byte segment
#b11011000
)
2249 (emit-byte segment
#b11011100
))
2250 (emit-fp-op segment source
#b100
)))
2252 ;;; Subtract double, reverse:
2253 ;;; st(0) = memory or st(i) - st(0).
2254 (define-instruction fsubrd
(segment source
)
2255 (:printer floating-point
((op '(#b100
#b101
))))
2256 (:printer floating-point-fp
((op '(#b000
#b101
))))
2258 (if (fp-reg-tn-p source
)
2259 (emit-byte segment
#b11011000
)
2260 (emit-byte segment
#b11011100
))
2261 (emit-fp-op segment source
#b101
)))
2263 ;;; Subtract double, destination st(i):
2264 ;;; st(i) = st(i) - st(0).
2266 ;;; ASM386 syntax: FSUB ST(i), ST
2267 ;;; Gdb syntax: fsubr %st,%st(i)
2268 (define-instruction fsub-sti
(segment destination
)
2269 (:printer floating-point-fp
((op '(#b100
#b101
))))
2271 (aver (fp-reg-tn-p destination
))
2272 (emit-byte segment
#b11011100
)
2273 (emit-fp-op segment destination
#b101
)))
2275 (define-instruction fsubp-sti
(segment destination
)
2276 (:printer floating-point-fp
((op '(#b110
#b101
))))
2278 (aver (fp-reg-tn-p destination
))
2279 (emit-byte segment
#b11011110
)
2280 (emit-fp-op segment destination
#b101
)))
2282 ;;; Subtract double, reverse, destination st(i):
2283 ;;; st(i) = st(0) - st(i).
2285 ;;; ASM386 syntax: FSUBR ST(i), ST
2286 ;;; Gdb syntax: fsub %st,%st(i)
2287 (define-instruction fsubr-sti
(segment destination
)
2288 (:printer floating-point-fp
((op '(#b100
#b100
))))
2290 (aver (fp-reg-tn-p destination
))
2291 (emit-byte segment
#b11011100
)
2292 (emit-fp-op segment destination
#b100
)))
2294 (define-instruction fsubrp-sti
(segment destination
)
2295 (:printer floating-point-fp
((op '(#b110
#b100
))))
2297 (aver (fp-reg-tn-p destination
))
2298 (emit-byte segment
#b11011110
)
2299 (emit-fp-op segment destination
#b100
)))
2301 ;;; Multiply single:
2302 ;;; st(0) = st(0) * memory or st(i).
2303 (define-instruction fmul
(segment source
)
2304 (:printer floating-point
((op '(#b000
#b001
))))
2306 (emit-byte segment
#b11011000
)
2307 (emit-fp-op segment source
#b001
)))
2309 ;;; Multiply double:
2310 ;;; st(0) = st(0) * memory or st(i).
2311 (define-instruction fmuld
(segment source
)
2312 (:printer floating-point
((op '(#b100
#b001
))))
2313 (:printer floating-point-fp
((op '(#b000
#b001
))))
2315 (if (fp-reg-tn-p source
)
2316 (emit-byte segment
#b11011000
)
2317 (emit-byte segment
#b11011100
))
2318 (emit-fp-op segment source
#b001
)))
2320 ;;; Multiply double, destination st(i):
2321 ;;; st(i) = st(i) * st(0).
2322 (define-instruction fmul-sti
(segment destination
)
2323 (:printer floating-point-fp
((op '(#b100
#b001
))))
2325 (aver (fp-reg-tn-p destination
))
2326 (emit-byte segment
#b11011100
)
2327 (emit-fp-op segment destination
#b001
)))
2330 ;;; st(0) = st(0) / memory or st(i).
2331 (define-instruction fdiv
(segment source
)
2332 (:printer floating-point
((op '(#b000
#b110
))))
2334 (emit-byte segment
#b11011000
)
2335 (emit-fp-op segment source
#b110
)))
2337 ;;; Divide single, reverse:
2338 ;;; st(0) = memory or st(i) / st(0).
2339 (define-instruction fdivr
(segment source
)
2340 (:printer floating-point
((op '(#b000
#b111
))))
2342 (emit-byte segment
#b11011000
)
2343 (emit-fp-op segment source
#b111
)))
2346 ;;; st(0) = st(0) / memory or st(i).
2347 (define-instruction fdivd
(segment source
)
2348 (:printer floating-point
((op '(#b100
#b110
))))
2349 (:printer floating-point-fp
((op '(#b000
#b110
))))
2351 (if (fp-reg-tn-p source
)
2352 (emit-byte segment
#b11011000
)
2353 (emit-byte segment
#b11011100
))
2354 (emit-fp-op segment source
#b110
)))
2356 ;;; Divide double, reverse:
2357 ;;; st(0) = memory or st(i) / st(0).
2358 (define-instruction fdivrd
(segment source
)
2359 (:printer floating-point
((op '(#b100
#b111
))))
2360 (:printer floating-point-fp
((op '(#b000
#b111
))))
2362 (if (fp-reg-tn-p source
)
2363 (emit-byte segment
#b11011000
)
2364 (emit-byte segment
#b11011100
))
2365 (emit-fp-op segment source
#b111
)))
2367 ;;; Divide double, destination st(i):
2368 ;;; st(i) = st(i) / st(0).
2370 ;;; ASM386 syntax: FDIV ST(i), ST
2371 ;;; Gdb syntax: fdivr %st,%st(i)
2372 (define-instruction fdiv-sti
(segment destination
)
2373 (:printer floating-point-fp
((op '(#b100
#b111
))))
2375 (aver (fp-reg-tn-p destination
))
2376 (emit-byte segment
#b11011100
)
2377 (emit-fp-op segment destination
#b111
)))
2379 ;;; Divide double, reverse, destination st(i):
2380 ;;; st(i) = st(0) / st(i).
2382 ;;; ASM386 syntax: FDIVR ST(i), ST
2383 ;;; Gdb syntax: fdiv %st,%st(i)
2384 (define-instruction fdivr-sti
(segment destination
)
2385 (:printer floating-point-fp
((op '(#b100
#b110
))))
2387 (aver (fp-reg-tn-p destination
))
2388 (emit-byte segment
#b11011100
)
2389 (emit-fp-op segment destination
#b110
)))
2391 ;;; Exchange fr0 with fr(n). (There is no double precision variant.)
2392 (define-instruction fxch
(segment source
)
2393 (:printer floating-point-fp
((op '(#b001
#b001
))))
2395 (unless (and (tn-p source
)
2396 (eq (sb-name (sc-sb (tn-sc source
))) 'float-registers
))
2398 (emit-byte segment
#b11011001
)
2399 (emit-fp-op segment source
#b001
)))
2401 ;;; Push 32-bit integer to st0.
2402 (define-instruction fild
(segment source
)
2403 (:printer floating-point
((op '(#b011
#b000
))))
2405 (emit-byte segment
#b11011011
)
2406 (emit-fp-op segment source
#b000
)))
2408 ;;; Push 64-bit integer to st0.
2409 (define-instruction fildl
(segment source
)
2410 (:printer floating-point
((op '(#b111
#b101
))))
2412 (emit-byte segment
#b11011111
)
2413 (emit-fp-op segment source
#b101
)))
2415 ;;; Store 32-bit integer.
2416 (define-instruction fist
(segment dest
)
2417 (:printer floating-point
((op '(#b011
#b010
))))
2419 (emit-byte segment
#b11011011
)
2420 (emit-fp-op segment dest
#b010
)))
2422 ;;; Store and pop 32-bit integer.
2423 (define-instruction fistp
(segment dest
)
2424 (:printer floating-point
((op '(#b011
#b011
))))
2426 (emit-byte segment
#b11011011
)
2427 (emit-fp-op segment dest
#b011
)))
2429 ;;; Store and pop 64-bit integer.
2430 (define-instruction fistpl
(segment dest
)
2431 (:printer floating-point
((op '(#b111
#b111
))))
2433 (emit-byte segment
#b11011111
)
2434 (emit-fp-op segment dest
#b111
)))
2436 ;;; Store single from st(0) and pop.
2437 (define-instruction fstp
(segment dest
)
2438 (:printer floating-point
((op '(#b001
#b011
))))
2440 (cond ((fp-reg-tn-p dest
)
2441 (emit-byte segment
#b11011101
)
2442 (emit-fp-op segment dest
#b011
))
2444 (emit-byte segment
#b11011001
)
2445 (emit-fp-op segment dest
#b011
)))))
2447 ;;; Store double from st(0) and pop.
2448 (define-instruction fstpd
(segment dest
)
2449 (:printer floating-point
((op '(#b101
#b011
))))
2450 (:printer floating-point-fp
((op '(#b101
#b011
))))
2452 (cond ((fp-reg-tn-p dest
)
2453 (emit-byte segment
#b11011101
)
2454 (emit-fp-op segment dest
#b011
))
2456 (emit-byte segment
#b11011101
)
2457 (emit-fp-op segment dest
#b011
)))))
2459 ;;; Store long from st(0) and pop.
2460 (define-instruction fstpl
(segment dest
)
2461 (:printer floating-point
((op '(#b011
#b111
))))
2463 (emit-byte segment
#b11011011
)
2464 (emit-fp-op segment dest
#b111
)))
2466 ;;; Decrement stack-top pointer.
2467 (define-instruction fdecstp
(segment)
2468 (:printer floating-point-no
((op #b10110
)))
2470 (emit-byte segment
#b11011001
)
2471 (emit-byte segment
#b11110110
)))
2473 ;;; Increment stack-top pointer.
2474 (define-instruction fincstp
(segment)
2475 (:printer floating-point-no
((op #b10111
)))
2477 (emit-byte segment
#b11011001
)
2478 (emit-byte segment
#b11110111
)))
2480 ;;; Free fp register.
2481 (define-instruction ffree
(segment dest
)
2482 (:printer floating-point-fp
((op '(#b101
#b000
))))
2484 (emit-byte segment
#b11011101
)
2485 (emit-fp-op segment dest
#b000
)))
2487 (define-instruction fabs
(segment)
2488 (:printer floating-point-no
((op #b00001
)))
2490 (emit-byte segment
#b11011001
)
2491 (emit-byte segment
#b11100001
)))
2493 (define-instruction fchs
(segment)
2494 (:printer floating-point-no
((op #b00000
)))
2496 (emit-byte segment
#b11011001
)
2497 (emit-byte segment
#b11100000
)))
2499 (define-instruction frndint
(segment)
2500 (:printer floating-point-no
((op #b11100
)))
2502 (emit-byte segment
#b11011001
)
2503 (emit-byte segment
#b11111100
)))
2506 (define-instruction fninit
(segment)
2507 (:printer floating-point-5
((op #b00011
)))
2509 (emit-byte segment
#b11011011
)
2510 (emit-byte segment
#b11100011
)))
2512 ;;; Store Status Word to AX.
2513 (define-instruction fnstsw
(segment)
2514 (:printer floating-point-st
((op #b00000
)))
2516 (emit-byte segment
#b11011111
)
2517 (emit-byte segment
#b11100000
)))
2519 ;;; Load Control Word.
2521 ;;; src must be a memory location
2522 (define-instruction fldcw
(segment src
)
2523 (:printer floating-point
((op '(#b001
#b101
))))
2525 (emit-byte segment
#b11011001
)
2526 (emit-fp-op segment src
#b101
)))
2528 ;;; Store Control Word.
2529 (define-instruction fnstcw
(segment dst
)
2530 (:printer floating-point
((op '(#b001
#b111
))))
2532 (emit-byte segment
#b11011001
)
2533 (emit-fp-op segment dst
#b111
)))
2535 ;;; Store FP Environment.
2536 (define-instruction fstenv
(segment dst
)
2537 (:printer floating-point
((op '(#b001
#b110
))))
2539 (emit-byte segment
#b11011001
)
2540 (emit-fp-op segment dst
#b110
)))
2542 ;;; Restore FP Environment.
2543 (define-instruction fldenv
(segment src
)
2544 (:printer floating-point
((op '(#b001
#b100
))))
2546 (emit-byte segment
#b11011001
)
2547 (emit-fp-op segment src
#b100
)))
2550 (define-instruction fsave
(segment dst
)
2551 (:printer floating-point
((op '(#b101
#b110
))))
2553 (emit-byte segment
#b11011101
)
2554 (emit-fp-op segment dst
#b110
)))
2556 ;;; Restore FP State.
2557 (define-instruction frstor
(segment src
)
2558 (:printer floating-point
((op '(#b101
#b100
))))
2560 (emit-byte segment
#b11011101
)
2561 (emit-fp-op segment src
#b100
)))
2563 ;;; Clear exceptions.
2564 (define-instruction fnclex
(segment)
2565 (:printer floating-point-5
((op #b00010
)))
2567 (emit-byte segment
#b11011011
)
2568 (emit-byte segment
#b11100010
)))
2571 (define-instruction fcom
(segment src
)
2572 (:printer floating-point
((op '(#b000
#b010
))))
2574 (emit-byte segment
#b11011000
)
2575 (emit-fp-op segment src
#b010
)))
2577 (define-instruction fcomd
(segment src
)
2578 (:printer floating-point
((op '(#b100
#b010
))))
2579 (:printer floating-point-fp
((op '(#b000
#b010
))))
2581 (if (fp-reg-tn-p src
)
2582 (emit-byte segment
#b11011000
)
2583 (emit-byte segment
#b11011100
))
2584 (emit-fp-op segment src
#b010
)))
2586 ;;; Compare ST1 to ST0, popping the stack twice.
2587 (define-instruction fcompp
(segment)
2588 (:printer floating-point-3
((op '(#b110
#b011001
))))
2590 (emit-byte segment
#b11011110
)
2591 (emit-byte segment
#b11011001
)))
2593 ;;; unordered comparison
2594 (define-instruction fucom
(segment src
)
2595 (:printer floating-point-fp
((op '(#b101
#b100
))))
2597 (aver (fp-reg-tn-p src
))
2598 (emit-byte segment
#b11011101
)
2599 (emit-fp-op segment src
#b100
)))
2601 (define-instruction ftst
(segment)
2602 (:printer floating-point-no
((op #b00100
)))
2604 (emit-byte segment
#b11011001
)
2605 (emit-byte segment
#b11100100
)))
2609 (define-instruction fsqrt
(segment)
2610 (:printer floating-point-no
((op #b11010
)))
2612 (emit-byte segment
#b11011001
)
2613 (emit-byte segment
#b11111010
)))
2615 (define-instruction fscale
(segment)
2616 (:printer floating-point-no
((op #b11101
)))
2618 (emit-byte segment
#b11011001
)
2619 (emit-byte segment
#b11111101
)))
2621 (define-instruction fxtract
(segment)
2622 (:printer floating-point-no
((op #b10100
)))
2624 (emit-byte segment
#b11011001
)
2625 (emit-byte segment
#b11110100
)))
2627 (define-instruction fsin
(segment)
2628 (:printer floating-point-no
((op #b11110
)))
2630 (emit-byte segment
#b11011001
)
2631 (emit-byte segment
#b11111110
)))
2633 (define-instruction fcos
(segment)
2634 (:printer floating-point-no
((op #b11111
)))
2636 (emit-byte segment
#b11011001
)
2637 (emit-byte segment
#b11111111
)))
2639 (define-instruction fprem1
(segment)
2640 (:printer floating-point-no
((op #b10101
)))
2642 (emit-byte segment
#b11011001
)
2643 (emit-byte segment
#b11110101
)))
2645 (define-instruction fprem
(segment)
2646 (:printer floating-point-no
((op #b11000
)))
2648 (emit-byte segment
#b11011001
)
2649 (emit-byte segment
#b11111000
)))
2651 (define-instruction fxam
(segment)
2652 (:printer floating-point-no
((op #b00101
)))
2654 (emit-byte segment
#b11011001
)
2655 (emit-byte segment
#b11100101
)))
2657 ;;; These do push/pop to stack and need special handling
2658 ;;; in any VOPs that use them. See the book.
2660 ;;; st0 <- st1*log2(st0)
2661 (define-instruction fyl2x
(segment) ; pops stack
2662 (:printer floating-point-no
((op #b10001
)))
2664 (emit-byte segment
#b11011001
)
2665 (emit-byte segment
#b11110001
)))
2667 (define-instruction fyl2xp1
(segment)
2668 (:printer floating-point-no
((op #b11001
)))
2670 (emit-byte segment
#b11011001
)
2671 (emit-byte segment
#b11111001
)))
2673 (define-instruction f2xm1
(segment)
2674 (:printer floating-point-no
((op #b10000
)))
2676 (emit-byte segment
#b11011001
)
2677 (emit-byte segment
#b11110000
)))
2679 (define-instruction fptan
(segment) ; st(0) <- 1; st(1) <- tan
2680 (:printer floating-point-no
((op #b10010
)))
2682 (emit-byte segment
#b11011001
)
2683 (emit-byte segment
#b11110010
)))
2685 (define-instruction fpatan
(segment) ; POPS STACK
2686 (:printer floating-point-no
((op #b10011
)))
2688 (emit-byte segment
#b11011001
)
2689 (emit-byte segment
#b11110011
)))
2691 ;;;; loading constants
2693 (define-instruction fldz
(segment)
2694 (:printer floating-point-no
((op #b01110
)))
2696 (emit-byte segment
#b11011001
)
2697 (emit-byte segment
#b11101110
)))
2699 (define-instruction fld1
(segment)
2700 (:printer floating-point-no
((op #b01000
)))
2702 (emit-byte segment
#b11011001
)
2703 (emit-byte segment
#b11101000
)))
2705 (define-instruction fldpi
(segment)
2706 (:printer floating-point-no
((op #b01011
)))
2708 (emit-byte segment
#b11011001
)
2709 (emit-byte segment
#b11101011
)))
2711 (define-instruction fldl2t
(segment)
2712 (:printer floating-point-no
((op #b01001
)))
2714 (emit-byte segment
#b11011001
)
2715 (emit-byte segment
#b11101001
)))
2717 (define-instruction fldl2e
(segment)
2718 (:printer floating-point-no
((op #b01010
)))
2720 (emit-byte segment
#b11011001
)
2721 (emit-byte segment
#b11101010
)))
2723 (define-instruction fldlg2
(segment)
2724 (:printer floating-point-no
((op #b01100
)))
2726 (emit-byte segment
#b11011001
)
2727 (emit-byte segment
#b11101100
)))
2729 (define-instruction fldln2
(segment)
2730 (:printer floating-point-no
((op #b01101
)))
2732 (emit-byte segment
#b11011001
)
2733 (emit-byte segment
#b11101101
)))