source: trunk/source/compiler/X86/x86-disassemble.lisp

Last change on this file was 16697, checked in by gb, 6 years ago

when printing instruction addresses, just show the relative address. the
aligned address is always at a fixed offset from the relative address,
and showing it on every instruction is rarely useful and information about
label alignment is already provided in other ways.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 134.6 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;; Copyright 2005-2009 Clozure Associates
4;;;
5;;; Licensed under the Apache License, Version 2.0 (the "License");
6;;; you may not use this file except in compliance with the License.
7;;; You may obtain a copy of the License at
8;;;
9;;;     http://www.apache.org/licenses/LICENSE-2.0
10;;;
11;;; Unless required by applicable law or agreed to in writing, software
12;;; distributed under the License is distributed on an "AS IS" BASIS,
13;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14;;; See the License for the specific language governing permissions and
15;;; limitations under the License.
16
17(in-package "CCL")
18
19(eval-when (:compile-toplevel :load-toplevel :execute)
20  (require "NXENV")
21  (require "DLL-NODE")
22  (require "X86-ASM")
23  (require "X86-LAP"))
24
25(defparameter *tra-tag* (target-arch-case (:x8664 -4) (:x8632 -5)))
26
27(defstruct (x86-disassembled-instruction (:include dll-node)
28                                         (:conc-name x86-di-))
29  address
30  labeled
31  prefixes                              ;explicit prefixes
32  mnemonic
33  op0
34  op1
35  op2
36  start                                 ;start of instruction in code-vector
37  end                                   ;and its end
38  flags
39  )
40
41(defmethod print-object ((xdi x86-disassembled-instruction) stream)
42  (print-unreadable-object (xdi stream :type t :identity t)
43    (dolist (p (x86-di-prefixes xdi))
44      (format stream "(~a) " p))
45    (format stream "(~a" (x86-di-mnemonic xdi))
46    (let* ((op0 (x86-di-op0 xdi))
47           (op1 (x86-di-op1 xdi))
48           (op2 (x86-di-op2 xdi))
49           (ds (make-x86-disassembly-state :mode-64 #+x8664-target t
50                                                    #+x8632-target nil
51                                           :code-vector nil
52                                           :code-pointer 0)))
53      (when op0
54        (write-x86-lap-operand stream op0 ds)
55        (when op1
56          (write-x86-lap-operand stream op1 ds)
57          (when op2
58            (write-x86-lap-operand stream op2 ds)))))
59    (format stream ")")))
60
61(defstruct (x86-disassembly-state (:conc-name x86-ds-))
62  (mode-64 t)
63  (prefixes 0)
64  (used-prefixes 0)
65  (rex 0)
66  (rex-used 0)
67  (need-modrm nil)
68  (mod 0)
69  (reg 0)
70  (rm 0)
71  (blocks (make-dll-header))
72  (insn-start 0)                        ; offset of first prefix byte
73  (opcode-start 0)                      ; offset of first opcode byte
74  code-vector
75  code-pointer
76  code-limit
77  constants-vector
78  pending-labels
79  (entry-point 0)
80  current-instruction
81  (string-buffer (make-array 16 :element-type 'character
82                             :fill-pointer 0
83                             :adjustable t))
84  (symbolic-names ())
85)
86
87(defun badop (ds)
88  (setf (x86-ds-code-pointer ds) (1+ (x86-ds-opcode-start ds)))
89  ;;; Do more here.
90  )
91
92(defun x86-ds-peek-u8 (ds)
93  (aref (x86-ds-code-vector ds) (x86-ds-code-pointer ds)))
94
95(defun x86-ds-skip (ds &optional (n 1))
96  (incf (x86-ds-code-pointer ds) n))
97
98(defun x86-ds-next-u8 (ds)
99  (let* ((idx (x86-ds-code-pointer ds)))
100    (incf (x86-ds-code-pointer ds))
101    (aref (x86-ds-code-vector ds) idx)))
102
103(defun x86-ds-next-s8 (ds)
104  (let* ((u8 (x86-ds-next-u8 ds)))
105    (if (logbitp 7 u8)
106      (- u8 #x100)
107      u8)))
108
109(defun x86-ds-next-u16 (ds)
110  (let* ((low (x86-ds-next-u8 ds))
111         (high (x86-ds-next-u8 ds)))
112    (declare (type (unsigned-byte 8) low high))
113    (logior (the fixnum (ash high 8)) low)))
114
115(defun x86-ds-next-s16 (ds)
116  (let* ((low (x86-ds-next-u8 ds))
117         (high (x86-ds-next-s8 ds)))
118    (declare (type (unsigned-byte 8) low)
119             (type (signed-byte 8) high))
120    (logior (the fixnum (ash high 8)) low)))
121
122(defun x86-ds-next-u32 (ds)
123  (let* ((low (x86-ds-next-u16 ds))
124         (high (x86-ds-next-u16 ds)))
125    (declare (type (unsigned-byte 16) low high))
126    (logior (ash high 16) low)))
127
128(defun x86-ds-next-s32 (ds)
129  (let* ((low (x86-ds-next-u16 ds))
130         (high (x86-ds-next-s16 ds)))
131    (declare (type (unsigned-byte 16) low)
132             (type (signed-byte 16) high))
133    (logior (ash high 16) low)))
134
135(defun x86-ds-next-u64 (ds)
136  (let* ((low (x86-ds-next-u32 ds))
137         (high (x86-ds-next-u32 ds)))
138    (logior (ash high 32) low)))
139
140(defun x86-ds-next-s64 (ds)
141  (let* ((low (x86-ds-next-u32 ds))
142         (high (x86-ds-next-s32 ds)))
143    (logior (ash high 32) low)))
144
145(defun x86-ds-u8-ref (ds idx)
146  (aref (x86-ds-code-vector ds) (+ idx (x86-ds-entry-point ds))))
147
148(defun x86-ds-u16-ref (ds idx)
149  (logior (x86-ds-u8-ref ds idx)
150          (ash (x86-ds-u8-ref ds (1+ idx)) 8)))
151
152(defun x86-ds-u32-ref (ds idx)
153  (logior (x86-ds-u16-ref ds idx)
154          (ash (x86-ds-u16-ref ds (+ idx 2)) 16)))
155
156
157
158(defun used-rex (ds value)
159  (if (not (zerop value))
160    (setf (x86-ds-rex-used ds)
161          (logior (x86-ds-rex-used ds)
162                  (if (logtest (x86-ds-rex ds) value)
163                    #x40
164                    0)))
165    (setf (x86-ds-rex-used ds)
166          (logior (x86-ds-rex-used ds) #x40))))
167
168(defun used-prefix (ds mask)
169  (setf (x86-ds-used-prefixes ds)
170        (logior (x86-ds-used-prefixes ds)
171                (logand (x86-ds-prefixes ds) mask))))
172
173
174
175;;; An x86-disassembly-block is -something- like a basic block in a
176;;; compiler flow graph; it ends with an unconditional jump and it's
177;;; either the entry node in that graph or it's reachable via a jump
178;;; or branch from some other reachable block.  There may, however, be
179;;; internal labels that are referenced from within the block's
180;;; instructions, from some other block, or both.  Each disassembled
181;;; instruction within a block keeps track of its address and whether
182;;; or not it's a label (a branch or jump target or a tagged return
183;;; address.)  The first instruction in each block is a label; others
184;;; (initally) aren't.  Whenever we encounter a branch or jmp
185;;; instruction (or a manipulation of a tagged return address, which
186;;; is a kind of jmp) and determine the address of the label, we add
187;;; that address to the disassembly-state's PENDING-LABELS set.  When
188;;; we're through processing the block (having encountered an
189;;; unconditional jmp), we remove a pending label from that set.  If
190;;; it's within a block that's already been processed, we ensure that
191;;; the instruction at that address is marked as a label; otherwise,
192;;; we process the new block which starts at that address.
193;;; Eventually, this'll terminate with all reachable code having been
194;;; processed.  There's embedded data and alignment padding in Clozure CL
195;;; x86 functions and this approach means that we won't try to
196;;; disassemble any of that; if the compiler generates any unreachable
197;;; code, we won't see that, either.
198
199;;; There might be a large number of blocks, in which case
200;;; keeping them in a search tree might be a better idea.
201(defstruct (x86-dis-block (:include dll-node))
202  start-address
203  end-address
204  (instructions (make-dll-header))
205  (align nil)
206)
207
208;;; Insert the block before the first existing block whose
209;;; start address is greater than or equal to this block's
210;;; end address.  (Yes, they can be equal; no, there should
211;;; never be any overlap.)
212(defun insert-x86-block (block blocks)
213  (let* ((this-end (x86-dis-block-end-address block)))
214    (declare (fixnum this-end))
215    (do-dll-nodes (other blocks (append-dll-node block blocks))
216      (when (>= (the fixnum (x86-dis-block-start-address other))
217                this-end)
218        (return (insert-dll-node-before block other))))))
219
220(defun x86-dis-find-label (address blocks)
221  (declare (fixnum address))
222  (do-dll-nodes (block blocks)
223    (when (and (>= address (the fixnum (x86-dis-block-start-address block)))
224               (< address (the fixnum (x86-dis-block-end-address block))))
225      (let* ((instruction
226              (do-dll-nodes (i (x86-dis-block-instructions block))
227                (when (= (x86-di-address i) address)
228                  (return i)))))
229        (unless instruction
230          (error "Bug: no instruction at address #x~x" address))
231        (return (and
232                 (or (x86-di-labeled instruction)
233                    (setf (x86-di-labeled instruction) t))
234                 instruction))))))
235
236
237;;; Flags stored in PREFIXES
238(defconstant +PREFIX-REPZ+ 1)
239(defconstant +PREFIX-REPNZ+ 2)
240(defconstant +PREFIX-LOCK+ 4)
241(defconstant +PREFIX-CS+ 8)
242(defconstant +PREFIX-SS+ #x10)
243(defconstant +PREFIX-DS+ #x20)
244(defconstant +PREFIX-ES+ #x40)
245(defconstant +PREFIX-FS+ #x80)
246(defconstant +PREFIX-GS+ #x100)
247(defconstant +PREFIX-DATA+ #x200)
248(defconstant +PREFIX-ADDR+ #x400)
249(defconstant +PREFIX-FWAIT+ #x800)
250
251
252
253                             
254(defstruct (x86-dis (:constructor %make-x86-dis))
255  mnemonic                              ; may be nil
256  flags                                 ; extra info
257  op1                                   ; function to obtain 1st operand
258  bytemode1                             ; flags associated with operand1
259  op2                                   ; function for second operand
260  bytemode2                             ; flags for operand2
261  op3                                   ; function,
262  bytemode3                             ; flags for operand3
263  )
264
265(defconstant +SUFFIX-ALWAYS+ 4)
266(defconstant +AFLAG+ 2)
267(defconstant +DFLAG+ 1)
268
269(defconstant +b-mode+ 1)                ; byte operand
270(defconstant +v-mode+ 2)                ; operand size depends on prefixes
271(defconstant +w-mode+ 3)                ; word operand
272(defconstant +d-mode+ 4)                ; double word operand
273(defconstant +q-mode+ 5)                ; quad word operand
274(defconstant +t-mode+ 6)                ; ten-byte operand
275(defconstant +x-mode+ 7)                ; 16-byte XMM operand
276(defconstant +m-mode+ 8)                ; d-mode in 32bit, q-mode in 64bit mode.
277(defconstant +cond-jump-mode+ 9)
278(defconstant +loop-jcxz-mode+ 10)
279(defconstant +dq-mode+ 11)              ; operand size depends on REX prefixes.
280(defconstant +dqw-mode+ 12)             ; registers like dq-mode, memory like w-mode.
281(defconstant +f-mode+ 13)               ; 4- or 6-byte pointer operand
282(defconstant +const-1-mode+ 14)
283
284(defconstant +es-reg+ 100)
285(defconstant +cs-reg+ 101)
286(defconstant +ss-reg+ 102)
287(defconstant +ds-reg+ 103)
288(defconstant +fs-reg+ 104)
289(defconstant +gs-reg+ 105)
290
291(defconstant +eAX-reg+ 108)
292(defconstant +eCX-reg+ 109)
293(defconstant +eDX-reg+ 110)
294(defconstant +eBX-reg+ 111)
295(defconstant +eSP-reg+ 112)
296(defconstant +eBP-reg+ 113)
297(defconstant +eSI-reg+ 114)
298(defconstant +eDI-reg+ 115)
299
300(defconstant +al-reg+ 116)
301(defconstant +cl-reg+ 117)
302(defconstant +dl-reg+ 118)
303(defconstant +bl-reg+ 119)
304(defconstant +ah-reg+ 120)
305(defconstant +ch-reg+ 121)
306(defconstant +dh-reg+ 122)
307(defconstant +bh-reg+ 123)
308
309(defconstant +ax-reg+ 124)
310(defconstant +cx-reg+ 125)
311(defconstant +dx-reg+ 126)
312(defconstant +bx-reg+ 127)
313(defconstant +sp-reg+ 128)
314(defconstant +bp-reg+ 129)
315(defconstant +si-reg+ 130)
316(defconstant +di-reg+ 131)
317
318(defconstant +rAX-reg+ 132)
319(defconstant +rCX-reg+ 133)
320(defconstant +rDX-reg+ 134)
321(defconstant +rBX-reg+ 135)
322(defconstant +rSP-reg+ 136)
323(defconstant +rBP-reg+ 137)
324(defconstant +rSI-reg+ 138)
325(defconstant +rDI-reg+ 139)
326
327(defconstant +indir-dx-reg+ 150)
328
329(defconstant +FLOATCODE+ 1)
330(defconstant +USE-GROUPS+ 2)
331(defconstant +USE-PREFIX-USER-TABLE+ 3)
332(defconstant +X86-64-SPECIAL+ 4)
333(defconstant +UUOCODE+ 5)
334
335(defconstant +REX-MODE64+ 8)
336(defconstant +REX-EXTX+ 4)
337(defconstant +REX-EXTY+ 2)
338(defconstant +REX-EXTZ+ 1)
339
340(defparameter *x86-segment-prefix-alist*
341  `((,+prefix-cs+ . "cs")
342    (,+prefix-ds+ . "ds")
343    (,+prefix-ss+ . "ss")
344    (,+prefix-es+ . "es")
345    (,+prefix-fs+ . "fs")
346    (,+prefix-gs+ . "gs")))
347
348
349(defun segment-register-from-prefixes (ds)
350  (let* ((prefixes (x86-ds-prefixes ds)))
351    (dolist (pair *x86-segment-prefix-alist*)
352      (when (logtest (car pair) prefixes)
353        (setf (x86-ds-used-prefixes ds)
354              (logior (x86-ds-used-prefixes ds)
355                      (car pair)))
356        (return (parse-x86-register-operand (cdr pair) :%))))))
357
358(defun x86-dis-make-reg-operand (r)
359  (x86::make-x86-register-operand
360   :type (logandc2 (x86::reg-entry-reg-type r)
361                   (x86::encode-operand-type :baseIndex))
362   :entry r))
363
364(defun op-st (ds bytemode sizeflag)
365  (declare (ignore ds bytemode sizeflag))
366  (parse-x86-register-operand "st" :%))
367
368(defun op-sti (ds bytemode sizeflag)
369  (declare (ignore bytemode sizeflag))
370  (x86-dis-make-reg-operand (svref x86::*x86-float-regs* (x86-ds-rm ds))))
371
372(defun op-indire (ds bytemode sizeflag)
373  (when (and (x86-ds-mode-64 ds)
374             (zerop (x86-ds-prefixes ds)))
375    (setf (x86-ds-rex ds) (logior #x48 (x86-ds-rex ds))))
376  (op-e ds bytemode sizeflag))
377
378
379(defun op-e (ds bytemode sizeflag)
380  (let* ((add 0)
381         (riprel nil))
382    (used-rex ds +rex-extz+)
383    (if (logtest (x86-ds-rex ds) +rex-extz+)
384      (setq add 8))
385    (x86-ds-skip ds)                    ;skip MODRM byte
386    (cond ((eql (x86-ds-mod ds) 3)      ; EA is just a register
387           (cond ((eql bytemode +b-mode+)
388                  (used-rex ds 0)
389                  ;; This is wrong: if we don't have an REX prefix,
390                  ;; we should use the old byte register names
391                  ;; (dh, ah, ...) instead of the new ones (bpl, sil ...)
392                  ;; That'll matter if Lisp code ever needs to
393                  ;; access the #xff00 byte, but that seems unlikely
394                  (x86-dis-make-reg-operand (x86::x86-reg8 (+ (x86-ds-rm ds)
395                                                              add))))
396                 ((eql bytemode +w-mode+)
397                  (x86-dis-make-reg-operand (x86::x86-reg16 (+ (x86-ds-rm ds)
398                                                              add))))
399                 ((eql bytemode +d-mode+)
400                  (x86-dis-make-reg-operand (x86::x86-reg32 (+ (x86-ds-rm ds)
401                                                              add))))
402                 ((eql bytemode +q-mode+)
403                  (x86-dis-make-reg-operand (x86::x86-reg64 (+ (x86-ds-rm ds)
404                                                              add))))
405                 ((eql bytemode +m-mode+)
406                  (if (x86-ds-mode-64 ds)
407                    (x86-dis-make-reg-operand (x86::x86-reg64 (+ (x86-ds-rm ds)
408                                                              add)))
409                    (x86-dis-make-reg-operand (x86::x86-reg32 (+ (x86-ds-rm ds)
410                                                              add)))))
411                 ((or (eql bytemode +v-mode+)
412                      (eql bytemode +dq-mode+)
413                      (eql bytemode +dqw-mode+))
414                  (used-rex ds +rex-mode64+)
415                  (used-prefix ds +prefix-data+)
416                  (cond ((logtest (x86-ds-rex ds) +rex-mode64+)
417                         (x86-dis-make-reg-operand (x86::x86-reg64 (+ (x86-ds-rm ds)
418                                                              add))))
419                        ((or (logtest sizeflag +dflag+)
420                             (not (eql bytemode +v-mode+)))
421                         (x86-dis-make-reg-operand (x86::x86-reg32 (+ (x86-ds-rm ds)
422                                                              add))))
423                        (t
424                         (x86-dis-make-reg-operand (x86::x86-reg16 (+ (x86-ds-rm ds)
425                                                              add))))))
426                 ((eql bytemode 0) nil)
427                 (t (error "Disassembly error"))))
428          (t                            ; memory operand
429           (let* ((disp nil)
430                  (base (x86-ds-rm ds))
431                  (index nil)
432                  (scale nil)
433                  (have-base t)
434                  (have-sib nil)
435                  (memop (x86::make-x86-memory-operand)))
436             (setf (x86::x86-memory-operand-seg memop)
437                   (segment-register-from-prefixes ds))
438             (when (= base 4)
439               (setq have-sib t)
440               (let* ((sib (x86-ds-next-u8 ds)))
441                 (setq index (ldb (byte 3 3) sib))
442                 (if (or (x86-ds-mode-64 ds)
443                         (not (eql index 4)))
444                   (setq scale (ldb (byte 2 6) sib)))
445                 (setq base (ldb (byte 3 0) sib))
446                 (used-rex ds +rex-exty+)
447                 (used-rex ds +rex-extz+)
448                 (when (logtest (x86-ds-rex ds) +rex-exty+)
449                   (incf index 8))
450                 (when (logtest  (x86-ds-rex ds) +rex-extz+)
451                   (incf base 8))))
452             (case (x86-ds-mod ds)
453               (0
454                (when (= 5 (logand base 7))
455                  (setq have-base nil)
456                  (if (and (x86-ds-mode-64 ds) (not have-sib))
457                    (setq riprel t))
458                  (setq disp (x86-ds-next-s32 ds))))
459               (1
460                (setq disp (x86-ds-next-s8 ds)))
461               (2
462                (setq disp (x86-ds-next-s32 ds))))
463             (when (or (not (eql (x86-ds-mod ds) 0))
464                       (eql 5 (logand base 7)))
465               (setf (x86::x86-memory-operand-disp memop)
466                     (parse-x86-lap-expression disp))
467               (when riprel
468                 (setf (x86::x86-memory-operand-base memop)
469                       (parse-x86-register-operand "rip" :%))))
470             (when (or have-base
471                       (and have-sib
472                            (or (not (eql index 4))
473                                (not (eql scale 0)))))
474               (used-rex ds +rex-extz+)
475               (if (and (not have-sib)
476                        (logtest (x86-ds-rex ds) +rex-extz+))
477                 (incf base 8))
478               (if have-base
479                 (setf (x86::x86-memory-operand-base memop)
480                       (if (and (x86-ds-mode-64 ds)
481                                (logtest sizeflag +aflag+))
482                         (x86-dis-make-reg-operand (x86::x86-reg64 base))
483                         (x86-dis-make-reg-operand (x86::x86-reg32 base)))))
484               (when have-sib
485                 (unless (= index 4)
486                   (setf (x86::x86-memory-operand-index memop)
487                    (if (and (x86-ds-mode-64 ds)
488                             (logtest sizeflag +aflag+))
489                      (x86-dis-make-reg-operand (x86::x86-reg64 index))
490                      (x86-dis-make-reg-operand (x86::x86-reg32 index)))))
491                 (unless scale
492                   (setq scale 0))
493                 (when (or (not (eql scale 0))
494                           (not (eql index 4)))
495                   (setf (x86::x86-memory-operand-scale memop) scale))))
496             memop)))))
497
498
499(defun op-g (ds bytemode sizeflag)
500  (let* ((add 0)
501         (reg (x86-ds-reg ds)))
502    (used-rex ds +rex-extx+)
503    (if (logtest (x86-ds-rex ds) +rex-extx+)
504      (setq add 8))
505    (cond ((eql bytemode +b-mode+)
506           (used-rex ds 0)
507           ;; This is wrong: if we don't have an REX prefix,
508           ;; we should use the old byte register names
509           ;; (dh, ah, ...) instead of the new ones (bpl, sil ...)
510           ;; That'll matter if Lisp code ever needs to
511           ;; access the #xff00 byte, but that seems unlikely
512           (x86-dis-make-reg-operand (x86::x86-reg8 (+ reg add))))
513          ((eql bytemode +w-mode+)
514           (x86-dis-make-reg-operand (x86::x86-reg16 (+ reg add))))
515          ((eql bytemode +d-mode+)
516           (x86-dis-make-reg-operand (x86::x86-reg32 (+ reg add))))
517          ((eql bytemode +q-mode+)
518           (x86-dis-make-reg-operand (x86::x86-reg64 (+ reg add))))
519          ((eql bytemode +m-mode+)
520           (if (x86-ds-mode-64 ds)
521             (x86-dis-make-reg-operand (x86::x86-reg64 (+ reg add)))
522             (x86-dis-make-reg-operand (x86::x86-reg32 (+ reg add)))))
523          ((or (eql bytemode +v-mode+)
524               (eql bytemode +dq-mode+)
525               (eql bytemode +dqw-mode+))
526           (used-rex ds +rex-mode64+)
527           (used-prefix ds +prefix-data+)
528           (cond ((logtest (x86-ds-rex ds) +rex-mode64+)
529                  (x86-dis-make-reg-operand (x86::x86-reg64 (+ reg add))))
530                 ((or (logtest sizeflag +dflag+)
531                      (not (eql bytemode +v-mode+)))
532                  (x86-dis-make-reg-operand (x86::x86-reg32 (+ reg add))))
533                 (t
534                  (x86-dis-make-reg-operand (x86::x86-reg16 (+ reg add))))))
535          ((eql bytemode 0) nil)
536          (t (error "Disassembly error")))))
537
538(defun op-reg (ds code sizeflag)
539  (declare (fixnum code))
540  (let* ((add 0))
541    (used-rex ds +rex-extz+)
542    (if (logtest (x86-ds-rex ds) +rex-extz+)
543      (setq add 8))
544    (cond ((= code +indir-dx-reg+)
545           (x86::make-x86-memory-operand
546            :base (parse-x86-register-operand "dx" :%)))
547          (t
548           (let* ((r (cond ((and (>= code +ax-reg+)
549                                 (<= code +di-reg+))
550                            (x86::x86-reg16 (+ (- code +ax-reg+) add)))
551                           ((= code +es-reg+) (lookup-x86-register "es" :%))
552                           ((= code +cs-reg+) (lookup-x86-register "cs" :%))
553                           ((= code +ds-reg+) (lookup-x86-register "ds" :%))
554                           ((= code +ss-reg+) (lookup-x86-register "ss" :%))
555                           ((= code +fs-reg+) (lookup-x86-register "fs" :%))
556                           ((= code +gs-reg+) (lookup-x86-register "gs" :%))
557                           ((and (>= code +al-reg+)
558                                 (<= code +dh-reg+))
559                            ;; Again, this is wrong if there's no REX
560                            ;; prefix.
561                            (used-rex ds 0)
562                            (x86::x86-reg8 (+ add (- code +al-reg+))))
563                           ((and (>= code +rax-reg+)
564                                 (<= code +rdi-reg+)
565                                 (or (x86-ds-mode-64 ds)
566                                     (progn
567                                       (setq code (+ code (- +eax-reg+ +rax-reg+)))
568                                       nil)))
569                            (x86::x86-reg64 (+ add (- code +rax-reg+))))
570                           ((and (>= code +eax-reg+)
571                                 (<= code +edi-reg+))
572                            (used-rex ds +rex-mode64+)
573                            (used-prefix ds +prefix-data+)
574                            (if (logtest (x86-ds-rex ds) +rex-mode64+)
575                              (x86::x86-reg64 (+ add (- code +eax-reg+)))
576                              (if (logtest sizeflag +dflag+)
577                                (x86::x86-reg32 (+ add (- code +eax-reg+)))
578                                (x86::x86-reg16 (+ add (- code +eax-reg+))))))
579                           ((and (>= code +al-reg+)
580                                 (<= code +bh-reg+))
581                            (x86::x86-reg8 (+ add (- code +al-reg+))))
582                           (t (error "Disassembly error: code = ~s" code)))))
583             (x86-dis-make-reg-operand r))))))
584
585;;; Like OP-REG, but doesn't deal with extended 64-bit registers.
586(defun op-imreg (ds code sizeflag)
587  (declare (fixnum code))
588  (cond ((= code +indir-dx-reg+)
589         (x86::make-x86-memory-operand
590          :base (parse-x86-register-operand "dx" :%)))
591        (t
592         (let* ((r (cond ((and (>= code +ax-reg+)
593                               (<= code +di-reg+))
594                          (x86::x86-reg16 (- code +ax-reg+)))
595                         ((= code +es-reg+) (lookup-x86-register "es" :%))
596                         ((= code +cs-reg+) (lookup-x86-register "cs" :%))
597                         ((= code +ds-reg+) (lookup-x86-register "ds" :%))
598                         ((= code +ss-reg+) (lookup-x86-register "ss" :%))
599                         ((= code +fs-reg+) (lookup-x86-register "fs" :%))
600                         ((= code +gs-reg+) (lookup-x86-register "gs" :%))
601                         ((and (>= code +al-reg+)
602                               (<= code +dh-reg+))
603                          ;; Again, this is wrong if there's no REX
604                          ;; prefix.
605                          (used-rex ds 0)
606                          (x86::x86-reg8 (- code +al-reg+)))
607
608                         ((and (>= code +eax-reg+)
609                                 (<= code +edi-reg+))
610                          (used-rex ds +rex-mode64+)
611                          (used-prefix ds +prefix-data+)
612                          (if (logtest (x86-ds-rex ds) +rex-mode64+)
613                            (x86::x86-reg64 (- code +eax-reg+))
614                            (if (logtest sizeflag +dflag+)
615                              (x86::x86-reg32 (- code +eax-reg+))
616                              (x86::x86-reg16 (- code +eax-reg+)))))
617                         (t (error "Disassembly error")))))
618           (x86-dis-make-reg-operand r)))))
619
620;;; A (possibly unsigned) immediate.
621(defun op-i (ds bytemode sizeflag)
622  (let* ((mask -1)
623         (op (cond ((= bytemode +b-mode+)
624                    (setq mask #xff)
625                    (x86-ds-next-u8 ds))
626                   ((and (= bytemode +q-mode+)
627                         (x86-ds-mode-64 ds))
628                    (x86-ds-next-s32 ds))
629                   ((or (= bytemode +q-mode+)
630                        (= bytemode +v-mode+))
631                    (used-rex ds +rex-mode64+)
632                    (used-prefix ds +prefix-data+)
633                    (if (logtest (x86-ds-rex ds) +rex-mode64+)
634                      (x86-ds-next-s32 ds)
635                      (if (logtest sizeflag +dflag+)
636                        (progn
637                          (setq mask #xffffffff)
638                          (x86-ds-next-u32 ds))
639                        (progn
640                          (setq mask #xfffff)
641                          (x86-ds-next-u16 ds)))))
642                   ((= bytemode +w-mode+)
643                    (setq mask #xfffff)
644                    (x86-ds-next-u16 ds))
645                   ((= bytemode +const-1-mode+)
646                    nil))))
647    (when op
648      (setq op (logand op mask))
649      (x86::make-x86-immediate-operand :value (parse-x86-lap-expression op)))))
650
651(defun op-i64 (ds bytemode sizeflag)
652  (if (not (x86-ds-mode-64 ds))
653    (op-i ds bytemode sizeflag)
654    (let* ((op (cond ((= bytemode +b-mode+)
655                      (x86-ds-next-u8 ds))
656                     ((= bytemode +v-mode+)
657                      (used-rex ds +rex-mode64+)
658                      (used-prefix ds +prefix-data+)
659                      (if (logtest (x86-ds-rex ds) +rex-mode64+)
660                        (x86-ds-next-u64 ds)
661                        (if (logtest sizeflag +dflag+)
662                          (x86-ds-next-u32 ds)
663                          (x86-ds-next-u16 ds))))
664                     ((= bytemode +w-mode+)
665                      (x86-ds-next-u16 ds))
666                     (t (error "Disassembly error")))))
667      (when op
668        (x86::make-x86-immediate-operand :value (parse-x86-lap-expression op))))))
669
670(defun op-si (ds bytemode sizeflag)
671  (let* ((op
672          (cond ((= bytemode +b-mode+)
673                 (x86-ds-next-s8 ds))
674                ((= bytemode +v-mode+)
675                 (used-rex ds +rex-mode64+)
676                 (used-prefix ds +prefix-data+)
677                 (if (logtest (x86-ds-rex ds) +rex-mode64+)
678                   (x86-ds-next-s32 ds)
679                   (if (logtest sizeflag +dflag+)
680                     (x86-ds-next-s32 ds)
681                     (x86-ds-next-s16 ds))))
682                ((= bytemode +w-mode+)
683                 (x86-ds-next-s16 ds))
684                (t (error "Disassembly error")))))
685    (x86::make-x86-immediate-operand :value (parse-x86-lap-expression op))))
686
687
688(defun x86-dis-align-address (ds address)
689  (let* ((apc (+ address  (if (x86-ds-mode-64 ds) x8664::node-size  x8632::node-size))))
690    (cond ((not (logtest 15 apc))
691           4)
692          ((not (logtest 7 apc))
693           3)
694          ((not (logtest 3 apc))
695           2)
696          ((not (logtest 1 apc))
697           1))))
698
699(defun op-j (ds bytemode sizeflag)
700  (let* ((mask -1)
701         (disp (cond ((= bytemode +b-mode+)
702                      (x86-ds-next-s8 ds))
703                     ((= bytemode +v-mode+)
704                      (if (logtest sizeflag +dflag+)
705                        (x86-ds-next-s32 ds)
706                        (progn
707                          (setq mask #xffff)
708                          (x86-ds-next-u16 ds))))
709                     (t (error "Disassembly error"))))
710         (label-address (logand (+ (x86-ds-code-pointer ds) disp)
711                                mask)))
712    (let* ((align (x86-dis-align-address ds label-address)))
713      (if align
714        (push (cons label-address align) (x86-ds-pending-labels ds))
715       
716        (push label-address (x86-ds-pending-labels ds))))
717    (x86::make-x86-label-operand :label label-address)))
718
719(defun op-seg (ds x y)
720  (declare (ignore x y))
721  (x86-dis-make-reg-operand (x86::x86-segment-register (x86-ds-reg ds))))
722
723(defun op-dir (ds x sizeflag)
724  (declare (ignore x))
725  (let* ((offset (if (logtest sizeflag +dflag+)
726                   (x86-ds-next-u32 ds)
727                   (x86-ds-next-u16 ds)))
728         (seg (x86-ds-next-u16 ds)))
729    (list (x86::make-x86-immediate-operand :value (parse-x86-lap-expression seg))
730          (x86::make-x86-memory-operand :disp (parse-x86-lap-expression offset)))))
731
732(defun op-off (ds x sizeflag)
733  (declare (ignore x))
734  (x86::make-x86-memory-operand
735   :seg (segment-register-from-prefixes ds)
736   :disp (parse-x86-lap-expression (cond ((or (x86-ds-mode-64 ds)
737                                              (logtest sizeflag +aflag+))
738                                          (x86-ds-next-u32 ds))
739                                         (t (x86-ds-next-u16 ds))))))
740
741
742(defun op-off64 (ds bytemode sizeflag)
743  (if (not (x86-ds-mode-64 ds))
744    (op-off ds bytemode sizeflag)
745    (x86::make-x86-memory-operand
746     :seg (segment-register-from-prefixes ds)
747     :disp (parse-x86-lap-expression (x86-ds-next-u64 ds)))))
748       
749
750(defun %ptr-reg (ds code sizeflag)
751  (used-prefix ds +prefix-addr+)
752  (let* ((idx (- code +eax-reg+))
753         (r (if (x86-ds-mode-64 ds)
754              (if (not (logtest sizeflag +aflag+))
755                (x86::x86-reg32 idx)
756                (x86::x86-reg64 idx))
757              (if (logtest sizeflag +aflag+)
758                (x86::x86-reg32 idx)
759                (x86::x86-reg16 idx)))))
760    (x86-dis-make-reg-operand r)))
761
762(defun op-esreg (ds code sizeflag)
763  (x86::make-x86-memory-operand
764   :seg (parse-x86-register-operand "es" :%)
765   :base (%ptr-reg ds code sizeflag)))
766     
767(defun op-dsreg (ds code sizeflag)
768  (unless (logtest (x86-ds-prefixes ds)
769                   (logior +prefix-cs+
770                           +prefix-ds+
771                           +prefix-ss+
772                           +prefix-es+
773                           +prefix-fs+
774                           +prefix-gs+))
775    (setf (x86-ds-prefixes ds)
776          (logior (x86-ds-prefixes ds) +prefix-ds+)))
777  (x86::make-x86-memory-operand
778   :seg (segment-register-from-prefixes ds)
779   :base (%ptr-reg ds code sizeflag)))
780
781;;; Control-register reference.
782(defun op-c (ds x sizeflag)
783  (declare (ignore x sizeflag))
784  (let* ((add (cond ((logtest (x86-ds-rex ds) +rex-extx+)
785                     (used-rex ds +rex-extx+)
786                     8)
787                    ((and (not (x86-ds-mode-64 ds))
788                          (logtest (x86-ds-prefixes ds) +prefix-lock+))
789                     (setf (x86-ds-used-prefixes ds)
790                           (logior (x86-ds-used-prefixes ds) +prefix-lock+))
791                     8)
792                    (t 0)))
793         (regname (format nil "cr~d" (+ (x86-ds-reg ds) add))))
794    (parse-x86-register-operand regname :%)))
795 
796;;; Debug-register reference.
797(defun op-d (ds x sizeflag)
798  (declare (ignore x sizeflag))
799  (used-rex ds +rex-extx+)
800  (let* ((add (if (logtest (x86-ds-rex ds) +rex-extx+)
801                8
802                0))
803         (regname (format nil "db~d" (+ (x86-ds-reg ds) add))))
804    (parse-x86-register-operand regname :%)))
805
806;;; Test-register.  There are only 8 of them, even on x86-64.
807(defun op-t (ds x y)
808  (declare (ignore x y))
809  (parse-x86-register-operand (format nil "tr~d" (x86-ds-reg ds)) :%))
810
811(defun op-rd (ds bytemode sizeflag)
812  (if (= (x86-ds-mod ds) 3)
813    (op-e ds bytemode sizeflag)
814    (badop ds)))
815
816
817;;; A data prefix causes a reference to an xmm register instead of
818;;; the (default) case of referencing an mmx register.
819(defun op-mmx (ds x sizeflag)
820  (declare (ignore x sizeflag))
821  (let* ((prefixes (x86-ds-prefixes ds)))
822    (used-prefix ds +prefix-data+)
823    (if (logtest prefixes +prefix-data+)
824      (let* ((add (progn (used-rex ds +rex-extx+)
825                         (if (logtest (x86-ds-rex ds) +rex-extx+)
826                           8
827                           0))))
828        (x86-dis-make-reg-operand (x86::x86-xmm-register (+ (x86-ds-reg ds) add))))
829      (x86-dis-make-reg-operand (x86::x86-mmx-register (x86-ds-reg ds))))))
830
831
832(defun op-xmm (ds bytemode sizeflag)
833  (declare (ignore bytemode sizeflag))
834  (used-rex ds +rex-extx+)
835  (let* ((add (if (logtest (x86-ds-rex ds) +rex-extx+) 8 0)))
836    (x86-dis-make-reg-operand (x86::x86-xmm-register (+ (x86-ds-reg ds) add)))))
837
838(defun op-em (ds bytemode sizeflag)
839  (if (not (eql (x86-ds-mod ds) 3))
840    (op-e ds bytemode sizeflag)
841    (let* ((prefixes (x86-ds-prefixes ds)))
842      (x86-ds-skip ds)                  ; skip modrm
843      (used-prefix ds +prefix-data+)
844      (cond ((logtest prefixes +prefix-data+)
845             (used-rex ds +rex-extz+)
846             (let* ((add (if (logtest (x86-ds-rex ds) +rex-extz+)
847                           8
848                           0)))
849               (x86-dis-make-reg-operand
850                (x86::x86-xmm-register (+ (x86-ds-rm ds) add)))))
851            (t
852             (x86-dis-make-reg-operand
853              (x86::x86-mmx-register (x86-ds-rm ds))))))))
854
855(defun op-ex (ds bytemode sizeflag)
856  (if (not (eql (x86-ds-mod ds) 3))
857    (op-e ds bytemode sizeflag)
858    (let* ((add (if (logtest (x86-ds-rex ds) +rex-extz+) 8 0)))
859      (used-rex ds +rex-extz+)
860      (x86-ds-skip ds)                  ; skip modrm
861      (x86-dis-make-reg-operand (x86::x86-xmm-register (+ (x86-ds-rm ds) add))))))
862           
863(defun op-ms (ds bytemode sizeflag)
864  (if (eql (x86-ds-mod ds) 3)
865    (op-em ds bytemode sizeflag)
866    (badop ds)))
867
868(defun op-xs (ds bytemode sizeflag)
869  (if (eql (x86-ds-mod ds) 3)
870    (op-ex ds bytemode sizeflag)
871    (badop ds)))
872
873(defun op-m (ds bytemode sizeflag)
874  (if (eql (x86-ds-mod ds) 3)
875    (badop ds)
876    (op-e ds bytemode sizeflag)))
877
878(defun op-0f07 (ds bytemode sizeflag)
879  (if (or (not (eql (x86-ds-mod ds) 3))
880          (not (eql (x86-ds-rm ds) 0)))
881    (badop ds)
882    (op-e ds bytemode sizeflag)))
883
884(defun nop-fixup (ds bytemode sizeflag)
885  (declare (ignore bytemode sizeflag)
886           (ignorable ds))
887  #+nothing
888  (if (logtest (x86-ds-prefixes ds) +prefix-repz+)
889    (break "should be PAUSE")))
890
891;;;             
892
893(defun make-x86-dis (opstring &optional
894                             op1-fun
895                             (op1-byte 0)
896                             op2-fun
897                             (op2-byte 0)
898                             op3-fun
899                             (op3-byte 0))
900  (let* ((flags nil))
901    (if (consp opstring)
902      (setq flags (cdr opstring) opstring (car opstring)))
903    (%make-x86-dis :mnemonic opstring
904                   :flags flags
905                   :op1 op1-fun
906                   :bytemode1 op1-byte
907                   :op2 op2-fun
908                   :bytemode2 op2-byte
909                   :op3 op3-fun
910                   :bytemode3 op3-byte)))
911                         
912
913;;; The root of all evil, unless the first byte of the opcode
914;;; is #xf
915(defparameter *disx86*
916  (vector
917   ;; #x00
918   (make-x86-dis "addB" 'op-e +b-mode+ 'op-g +b-mode+)
919   (make-x86-dis "addS" 'op-e +v-mode+ 'op-g +v-mode+)
920   (make-x86-dis "addB" 'op-g +b-mode+ 'op-e +b-mode+)
921   (make-x86-dis "addS" 'op-g +v-mode+ 'op-e +v-mode+)
922   (make-x86-dis "addB" 'op-imreg +al-reg+ 'op-i +b-mode+)
923   (make-x86-dis "addS" 'op-imreg +eax-reg+ 'op-i +v-mode+)
924   (make-x86-dis '(("pushT" . "(bad)")) 'op-reg +es-reg+)
925   (make-x86-dis '(("popT" . "(bad)")) 'op-reg +es-reg+)
926   ;; #x08
927   (make-x86-dis "orB" 'op-e +b-mode+ 'op-g +b-mode+)
928   (make-x86-dis "orS" 'op-e +v-mode+ 'op-g +v-mode+)
929   (make-x86-dis "orB" 'op-g +b-mode+ 'op-e +b-mode+)
930   (make-x86-dis "orS" 'op-g +v-mode+ 'op-e +v-mode+)
931   (make-x86-dis "orB" 'op-imreg +al-reg+ 'op-i +b-mode+)
932   (make-x86-dis "orS" 'op-imreg +eax-reg+ 'op-i +v-mode+)
933   (make-x86-dis '(("pushT" . "(bad)")) 'op-reg +cs-reg+)
934   (make-x86-dis "(bad)")               ; #x0f extended opcode escape
935   ;; #x10
936   (make-x86-dis "adcB" 'op-e +b-mode+ 'op-g +b-mode+)
937   (make-x86-dis "adcS" 'op-e +v-mode+ 'op-g +v-mode+)
938   (make-x86-dis "adcB" 'op-g +b-mode+ 'op-e +b-mode+)
939   (make-x86-dis "adcS" 'op-g +v-mode+ 'op-e +v-mode+)
940   (make-x86-dis "adcB" 'op-imreg +al-reg+ 'op-i +b-mode+)
941   (make-x86-dis "adcS" 'op-imreg +eax-reg+ 'op-i +v-mode+)
942   (make-x86-dis '(("pushT" . "(bad)")) 'op-reg +ss-reg+)
943   (make-x86-dis '(("popT" . "(bad)")) 'op-reg +ss-reg+)
944   ;; #x18
945   (make-x86-dis "sbbB" 'op-e +b-mode+ 'op-g +b-mode+)
946   (make-x86-dis "sbbS" 'op-e +v-mode+ 'op-g +v-mode+)
947   (make-x86-dis "sbbB" 'op-g +b-mode+ 'op-e +b-mode+)
948   (make-x86-dis "sbbS" 'op-g +v-mode+ 'op-e +v-mode+)
949   (make-x86-dis "sbbB" 'op-imreg +al-reg+ 'op-i +b-mode+)
950   (make-x86-dis "sbbS" 'op-imreg +eax-reg+ 'op-i +v-mode+)
951   (make-x86-dis '(("pushT" . "(bad)")) 'op-reg +ds-reg+)
952   (make-x86-dis '(("popT" . "(bad)")) 'op-reg +ds-reg+)
953   ;; #x20
954   (make-x86-dis "andB" 'op-e +b-mode+ 'op-g +b-mode+)
955   (make-x86-dis "andS" 'op-e +v-mode+ 'op-g +v-mode+)
956   (make-x86-dis "andB" 'op-g +b-mode+ 'op-e +b-mode+)
957   (make-x86-dis "andS" 'op-g +v-mode+ 'op-e +v-mode+)
958   (make-x86-dis "andB" 'op-imreg +al-reg+ 'op-i +b-mode+)
959   (make-x86-dis "andS" 'op-imreg +eax-reg+ 'op-i +v-mode+)
960   (make-x86-dis "(bad)")               ; SEG ES prefix
961   (make-x86-dis '(("daa" . "(bad)")))
962   ;; #x28
963   (make-x86-dis "subB" 'op-e +b-mode+ 'op-g +b-mode+)
964   (make-x86-dis "subS" 'op-e +v-mode+ 'op-g +v-mode+)
965   (make-x86-dis "subB" 'op-g +b-mode+ 'op-e +b-mode+)
966   (make-x86-dis "subS" 'op-g +v-mode+ 'op-e +v-mode+)
967   (make-x86-dis "subB" 'op-imreg +al-reg+ 'op-i +b-mode+)
968   (make-x86-dis "subS" 'op-imreg +eax-reg+ 'op-i +v-mode+)
969   (make-x86-dis "(bad)")               ; SEG CS prefix
970   (make-x86-dis '(("das" . "(bad)")))
971   ;; #x30
972   (make-x86-dis "xorB" 'op-e +b-mode+ 'op-g +b-mode+)
973   (make-x86-dis "xorS" 'op-e +v-mode+ 'op-g +v-mode+)
974   (make-x86-dis "xorB" 'op-g +b-mode+ 'op-e +b-mode+)
975   (make-x86-dis "xorS" 'op-g +v-mode+ 'op-e +v-mode+)
976   (make-x86-dis "xorB" 'op-imreg +al-reg+ 'op-i +b-mode+)
977   (make-x86-dis "xorS" 'op-imreg +eax-reg+ 'op-i +v-mode+)
978   (make-x86-dis "(bad)")               ; SEG SS prefix
979   (make-x86-dis '(("aaa" . "(bad)")))
980   ;; #x38
981   (make-x86-dis "cmpB" 'op-e +b-mode+ 'op-g +b-mode+)
982   (make-x86-dis "cmpS" 'op-e +v-mode+ 'op-g +v-mode+)
983   (make-x86-dis "cmpB" 'op-g +b-mode+ 'op-e +b-mode+)
984   (make-x86-dis "cmpS" 'op-g +v-mode+ 'op-e +v-mode+)
985   (make-x86-dis "cmpB" 'op-imreg +al-reg+ 'op-i +b-mode+)
986   (make-x86-dis "cmpS" 'op-imreg +eax-reg+ 'op-i +v-mode+)
987   (make-x86-dis "(bad)")               ; SEG DS prefix
988   (make-x86-dis '(("aas" . "(bad)")))
989   ;; #x40
990   (make-x86-dis '(("incS" . "(bad)")) 'op-reg +eax-reg+)
991   (make-x86-dis '(("incS" . "(bad)")) 'op-reg +ecx-reg+)
992   (make-x86-dis '(("incS" . "(bad)")) 'op-reg +edx-reg+)
993   (make-x86-dis '(("incS" . "(bad)")) 'op-reg +ebx-reg+)
994   (make-x86-dis '(("incS" . "(bad)")) 'op-reg +esp-reg+)
995   (make-x86-dis '(("incS" . "(bad)")) 'op-reg +ebp-reg+)
996   (make-x86-dis '(("incS" . "(bad)")) 'op-reg +esi-reg+)
997   (make-x86-dis '(("incS" . "(bad)")) 'op-reg +edi-reg+)
998   ;; #x48
999   (make-x86-dis '(("decS" . "(bad)")) 'op-reg +eax-reg+)
1000   (make-x86-dis '(("decS" . "(bad)")) 'op-reg +ecx-reg+)
1001   (make-x86-dis '(("decS" . "(bad)")) 'op-reg +edx-reg+)
1002   (make-x86-dis '(("decS" . "(bad)")) 'op-reg +ebx-reg+)
1003   (make-x86-dis '(("decS" . "(bad)")) 'op-reg +esp-reg+)
1004   (make-x86-dis '(("decS" . "(bad)")) 'op-reg +ebp-reg+)
1005   (make-x86-dis '(("decS" . "(bad)")) 'op-reg +esi-reg+)
1006   (make-x86-dis '(("decS" . "(bad)")) 'op-reg +edi-reg+)
1007   ;; #x50
1008   (make-x86-dis "pushT" 'op-reg +rax-reg+)
1009   (make-x86-dis "pushT" 'op-reg +rcx-reg+)
1010   (make-x86-dis "pushT" 'op-reg +rdx-reg+)
1011   (make-x86-dis "pushT" 'op-reg +rbx-reg+)
1012   (make-x86-dis "pushT" 'op-reg +rsp-reg+)
1013   (make-x86-dis "pushT" 'op-reg +rbp-reg+)
1014   (make-x86-dis "pushT" 'op-reg +rsi-reg+)
1015   (make-x86-dis "pushT" 'op-reg +rdi-reg+)
1016   ;; #x58
1017   (make-x86-dis "popT" 'op-reg +rax-reg+)
1018   (make-x86-dis "popT" 'op-reg +rcx-reg+)
1019   (make-x86-dis "popT" 'op-reg +rdx-reg+)
1020   (make-x86-dis "popT" 'op-reg +rbx-reg+)
1021   (make-x86-dis "popT" 'op-reg +rsp-reg+)
1022   (make-x86-dis "popT" 'op-reg +rbp-reg+)
1023   (make-x86-dis "popT" 'op-reg +rsi-reg+)
1024   (make-x86-dis "popT" 'op-reg +rdi-reg+)
1025   ;; #x60
1026   (make-x86-dis '(("pushaP" . "(bad)")))
1027   (make-x86-dis '(("popaP" . "(bad)")))
1028   (make-x86-dis '(("boundS" . "(bad)")) 'op-g +v-mode+ 'op-e +v-mode+)
1029   (make-x86-dis nil nil +x86-64-special+)
1030   (make-x86-dis "(bad)")               ; seg fs
1031   (make-x86-dis "(bad)")               ; seg gs
1032   (make-x86-dis "(bad)")               ; op size prefix
1033   (make-x86-dis "(bad)")               ; adr size prefix
1034   ;; #x68
1035   (make-x86-dis "pushT" 'op-i +q-mode+)
1036   (make-x86-dis "imulS" 'op-g +v-mode+ 'op-e +v-mode+ 'op-i +v-mode+ )
1037   (make-x86-dis "pushT" 'op-si +b-mode+)
1038   (make-x86-dis "imulS" 'op-g +v-mode+ 'op-e +v-mode+ 'op-si +b-mode+ )
1039   (make-x86-dis "insb" 'op-dsreg +esi-reg+ 'op-imreg +indir-dx-reg+)
1040   (make-x86-dis "insR" 'op-esreg +edi-reg+ 'op-imreg +indir-dx-reg+)
1041   (make-x86-dis "outsb" 'op-imreg +indir-dx-reg+ 'op-dsreg +esi-reg+)
1042   (make-x86-dis "outsR" 'op-imreg +indir-dx-reg+ 'op-dsreg +esi-reg+)
1043   ;; #x70
1044   (make-x86-dis "joH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1045   (make-x86-dis "jnoH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1046   (make-x86-dis "jbH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1047   (make-x86-dis "jaeH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1048   (make-x86-dis "jeH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1049   (make-x86-dis "jneH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1050   (make-x86-dis "jbeH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1051   (make-x86-dis "jaH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1052   ;; #x78
1053   (make-x86-dis "jsH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1054   (make-x86-dis "jnsH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1055   (make-x86-dis "jpH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1056   (make-x86-dis "jnpH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1057   (make-x86-dis "jlH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1058   (make-x86-dis "jgeH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1059   (make-x86-dis "jleH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1060   (make-x86-dis "jgH" 'op-j +b-mode+ nil +cond-jump-mode+ )
1061   ;; #x80
1062   (make-x86-dis nil nil +use-groups+ nil 0)
1063   (make-x86-dis nil nil +use-groups+ nil 1)
1064   (make-x86-dis "(bad)")
1065   (make-x86-dis nil nil +use-groups+ nil 2 )
1066   (make-x86-dis "testB" 'op-e +b-mode+ 'op-g +b-mode+)
1067   (make-x86-dis "testS" 'op-e +v-mode+ 'op-g +v-mode+)
1068   (make-x86-dis "xchgB" 'op-e +b-mode+ 'op-g +b-mode+)
1069   (make-x86-dis "xchgS" 'op-e +v-mode+ 'op-g +v-mode+)
1070   ;; #x88
1071   (make-x86-dis "movB" 'op-e +b-mode+ 'op-g +b-mode+)
1072   (make-x86-dis "movS" 'op-e +v-mode+ 'op-g +v-mode+)
1073   (make-x86-dis "movB" 'op-g +b-mode+ 'op-e +b-mode+)
1074   (make-x86-dis "movS" 'op-g +v-mode+ 'op-e +v-mode+)
1075   (make-x86-dis "movQ" 'op-e +v-mode+ 'op-seg +w-mode+)
1076   (make-x86-dis '("leaS" . :lea) 'op-g +v-mode+ 'op-m 0)
1077   (make-x86-dis "movQ" 'op-seg +w-mode+ 'op-e +v-mode+)
1078   (make-x86-dis "popU" 'op-e +v-mode+)
1079   ;; #x90
1080   (make-x86-dis '("nop" . :nop) 'nop-fixup 0)
1081   (make-x86-dis "xchgS" 'op-reg +ecx-reg+ 'op-imreg +eax-reg+)
1082   (make-x86-dis "xchgS" 'op-reg +edx-reg+ 'op-imreg +eax-reg+)
1083   (make-x86-dis "xchgS" 'op-reg +ebx-reg+ 'op-imreg +eax-reg+)
1084   (make-x86-dis "xchgS" 'op-reg +esp-reg+ 'op-imreg +eax-reg+)
1085   (make-x86-dis "xchgS" 'op-reg +ebp-reg+ 'op-imreg +eax-reg+)
1086   (make-x86-dis "xchgS" 'op-reg +esi-reg+ 'op-imreg +eax-reg+)
1087   (make-x86-dis "xchgS" 'op-reg +edi-reg+ 'op-imreg +eax-reg+)
1088   ;; #x98
1089   (make-x86-dis "cWtR")
1090   (make-x86-dis "cRtO")
1091   (make-x86-dis '(("JcallT" . "(bad)")) 'op-dir 0)
1092   (make-x86-dis "(bad)")               ; fwait
1093   (make-x86-dis "pushfT")
1094   (make-x86-dis "popfT")
1095   ;; "sahf" and "lahf" are unimplemented on some Intel EM64T
1096   ;; steppings, allegedly because an early AMD64 manual
1097   ;; accidentally omitted them.  It makes sense to disassemble
1098   ;; them in 64-bit mode, but it may require some thought
1099   ;; before using them in compiled code.
1100   (make-x86-dis "sahf")
1101   (make-x86-dis "lahf")
1102   ;; #xa0
1103   (make-x86-dis "movB" 'op-imreg +al-reg+ 'op-off64 +b-mode+)
1104   (make-x86-dis "movS" 'op-imreg +eax-reg+ 'op-off64 +v-mode+)
1105   (make-x86-dis "movB" 'op-off64 +b-mode+  'op-imreg +al-reg+)
1106   (make-x86-dis "movS" 'op-off64 +v-mode+ 'op-imreg +eax-reg+)
1107   (make-x86-dis "movsb" 'op-dsreg +esi-reg+ 'op-dsreg +esi-reg+)
1108   (make-x86-dis "movsR" 'op-esreg +edi-reg+ 'op-dsreg +esi-reg+)
1109   (make-x86-dis "cmpsb" 'op-dsreg +esi-reg+ 'op-dsreg +esi-reg+)
1110   (make-x86-dis "cmpsR" 'op-dsreg +esi-reg+ 'op-esreg +edi-reg+)
1111   ;; #xa8
1112   (make-x86-dis "testB" 'op-imreg +al-reg+ 'op-i +b-mode+)
1113   (make-x86-dis "testS" 'op-imreg +eax-reg+ 'op-i +v-mode+)
1114   (make-x86-dis "stosB" 'op-dsreg +esi-reg+ 'op-imreg +al-reg+)
1115   (make-x86-dis "stosS" 'op-esreg +edi-reg+ 'op-imreg +eax-reg+)
1116   (make-x86-dis "lodsB" 'op-imreg +al-reg+ 'op-dsreg +esi-reg+)
1117   (make-x86-dis "lodsS" 'op-imreg +eax-reg+ 'op-dsreg +esi-reg+)
1118   (make-x86-dis "scasB" 'op-imreg +al-reg+ 'op-dsreg +esi-reg+)
1119   (make-x86-dis "scasS" 'op-imreg +eax-reg+ 'op-esreg +edi-reg+)
1120   ;; #xb0
1121   (make-x86-dis "movB" 'op-reg +al-reg+ 'op-i +b-mode+)
1122   (make-x86-dis "movB" 'op-reg +cl-reg+ 'op-i +b-mode+)
1123   (make-x86-dis "movB" 'op-reg +dl-reg+ 'op-i +b-mode+)
1124   (make-x86-dis "movB" 'op-reg +bl-reg+ 'op-i +b-mode+)
1125   (make-x86-dis "movB" 'op-reg +ah-reg+ 'op-i +b-mode+)
1126   (make-x86-dis "movB" 'op-reg +ch-reg+ 'op-i +b-mode+)
1127   (make-x86-dis "movB" 'op-reg +dh-reg+ 'op-i +b-mode+)
1128   (make-x86-dis "movB" 'op-reg +bh-reg+ 'op-i +b-mode+)
1129   ;; #xb8
1130   (make-x86-dis "movS" 'op-reg +eax-reg+ 'op-i64 +v-mode+)
1131   (make-x86-dis "movS" 'op-reg +ecx-reg+ 'op-i64 +v-mode+)
1132   (make-x86-dis "movS" 'op-reg +edx-reg+ 'op-i64 +v-mode+)
1133   (make-x86-dis "movS" 'op-reg +ebx-reg+ 'op-i64 +v-mode+)
1134   (make-x86-dis "movS" 'op-reg +esp-reg+ 'op-i64 +v-mode+)
1135   (make-x86-dis "movS" 'op-reg +ebp-reg+ 'op-i64 +v-mode+)
1136   (make-x86-dis "movS" 'op-reg +esi-reg+ 'op-i64 +v-mode+)
1137   (make-x86-dis "movS" 'op-reg +edi-reg+ 'op-i64 +v-mode+)
1138   ;; #xc0
1139   (make-x86-dis nil nil +use-groups+ nil 3)
1140   (make-x86-dis nil nil +use-groups+ nil 4)
1141   (make-x86-dis '("retT" . :jump) 'op-i +w-mode+)
1142   (make-x86-dis '("retT" . :jump))
1143   (make-x86-dis '(("lesS" . "(bad)")) 'op-g +v-mode+ 'op-m +f-mode+)
1144   (make-x86-dis "ldsS" 'op-g +v-mode+ 'op-m +f-mode+)
1145   (make-x86-dis "movA" 'op-e +b-mode+ 'op-i +b-mode+)
1146   (make-x86-dis "movQ" 'op-e +v-mode+ 'op-i +v-mode+)
1147   ;; #xc8
1148   (make-x86-dis "enterT" 'op-i +w-mode+ 'op-i +b-mode+)
1149   (make-x86-dis "leaveT")
1150   (make-x86-dis "lretP" 'op-i +w-mode+)
1151   (make-x86-dis "lretP")
1152   (make-x86-dis "int3")
1153   (make-x86-dis nil nil +uuocode+)
1154   (make-x86-dis '(("into" . "(bad)")))
1155   (make-x86-dis "iretP")
1156   ;; #xd0
1157   (make-x86-dis nil nil +use-groups+ nil 5)
1158   (make-x86-dis nil nil +use-groups+ nil 6)
1159   (make-x86-dis nil nil +use-groups+ nil 7)
1160   (make-x86-dis nil nil +use-groups+ nil 8)
1161   (make-x86-dis '(("aam" . "(bad)")) 'op-si +b-mode+)
1162   (make-x86-dis '(("aad" . "(bad)")) 'op-si +b-mode+)
1163   (make-x86-dis "(bad)")
1164   (make-x86-dis "xlat" 'op-dsreg +ebx-reg+)
1165   ;; #xd8
1166   (make-x86-dis nil nil +floatcode+)
1167   (make-x86-dis nil nil +floatcode+)
1168   (make-x86-dis nil nil +floatcode+)
1169   (make-x86-dis nil nil +floatcode+)
1170   (make-x86-dis nil nil +floatcode+)
1171   (make-x86-dis nil nil +floatcode+)
1172   (make-x86-dis nil nil +floatcode+)
1173   (make-x86-dis nil nil +floatcode+)
1174   ;; #xe0
1175   (make-x86-dis "loopneFH" 'op-j +b-mode+ nil +loop-jcxz-mode+ )
1176   (make-x86-dis "loopeFH" 'op-j +b-mode+ nil +loop-jcxz-mode+ )
1177   (make-x86-dis "loopFH" 'op-j +b-mode+ nil +loop-jcxz-mode+ )
1178   (make-x86-dis "jEcxzH" 'op-j +b-mode+ nil +loop-jcxz-mode+ )
1179   (make-x86-dis "inB" 'op-imreg +al-reg+ 'op-i +b-mode+)
1180   (make-x86-dis "inS" 'op-imreg +eax-reg+ 'op-i +b-mode+)
1181   (make-x86-dis "outB" 'op-i +b-mode+ 'op-imreg +al-reg+)
1182   (make-x86-dis "outS" 'op-i +b-mode+ 'op-imreg +eax-reg+)
1183   ;; #xe8
1184   (make-x86-dis '("callT" . :call) 'op-j +v-mode+)
1185   (make-x86-dis '("jmpT" . :jump) 'op-j +v-mode+)
1186   (make-x86-dis '(("JjmpT" . "(bad)") . :jump) 'op-dir 0)
1187   (make-x86-dis '("jmp" . :jump)  'op-j +b-mode+)
1188   (make-x86-dis "inB" 'op-imreg +al-reg+ 'op-imreg +indir-dx-reg+)
1189   (make-x86-dis "inS" 'op-imreg +eax-reg+ 'op-imreg +indir-dx-reg+)
1190   (make-x86-dis "outB" 'op-imreg +indir-dx-reg+ 'op-imreg +al-reg+)
1191   (make-x86-dis "outS" 'op-imreg +indir-dx-reg+ 'op-imreg +eax-reg+)
1192   ;; #xf0
1193   (make-x86-dis "(bad)")               ; lock prefix
1194   (make-x86-dis "icebp")
1195   (make-x86-dis "(bad)")               ; repne
1196   (make-x86-dis "(bad)")               ; repz
1197   (make-x86-dis "hlt")
1198   (make-x86-dis "cmc")
1199   (make-x86-dis nil nil +use-groups+ nil 9)
1200   (make-x86-dis nil nil +use-groups+ nil 10)
1201   ;; #xf8
1202   (make-x86-dis "clc")
1203   (make-x86-dis "stc")
1204   (make-x86-dis "cli")
1205   (make-x86-dis "sti")
1206   (make-x86-dis "cld")
1207   (make-x86-dis "std")
1208   (make-x86-dis nil nil +use-groups+ nil 11)
1209   (make-x86-dis nil nil +use-groups+ nil 12)
1210   ))
1211
1212(defparameter *disx86-twobyte*
1213  (vector
1214   ;; #x00
1215   (make-x86-dis nil nil +use-groups+ nil 13)
1216   (make-x86-dis nil nil +use-groups+ nil 14)
1217   (make-x86-dis "larS" 'op-g +v-mode+ 'op-e +w-mode+)
1218   (make-x86-dis "lslS" 'op-g +v-mode+ 'op-e +w-mode+)
1219   (make-x86-dis "(bad)")
1220   (make-x86-dis "syscall")
1221   (make-x86-dis "clts")
1222   (make-x86-dis "sysretP")
1223   ;; #x08
1224   (make-x86-dis "invd")
1225   (make-x86-dis "wbinvd")
1226   (make-x86-dis "(bad)")
1227   (make-x86-dis "ud2a" 'op-i +b-mode+)
1228   (make-x86-dis "(bad)")
1229   (make-x86-dis nil nil +use-groups+ nil 22)
1230   (make-x86-dis "femms")
1231   (make-x86-dis "" 'op-mmx 0 'op-em +v-mode+ 'op-3dnowsuffix 0) ; See OP-3DNowSuffix.
1232   ;; #x10
1233   (make-x86-dis nil nil +use-prefix-user-table+ nil 8)
1234   (make-x86-dis nil nil +use-prefix-user-table+ nil 9)
1235   (make-x86-dis nil nil +use-prefix-user-table+ nil 30)
1236   (make-x86-dis "movlpX" 'op-ex +v-mode+ 'op-xmm 0 'SIMD-Fixup #\h)
1237   (make-x86-dis "unpcklpX" 'op-xmm 0 'op-ex +v-mode+)
1238   (make-x86-dis "unpckhpX" 'op-xmm 0 'op-ex +v-mode+)
1239   (make-x86-dis nil nil +use-prefix-user-table+ nil 31)
1240   (make-x86-dis "movhpX" 'op-ex +v-mode+ 'op-xmm 0 'SIMD-Fixup #\l)
1241   ;; #x18
1242   (make-x86-dis nil nil +use-groups+ nil 21)
1243   (make-x86-dis "(bad)")
1244   (make-x86-dis "(bad)")
1245   (make-x86-dis "(bad)")
1246   (make-x86-dis "(bad)")
1247   (make-x86-dis "(bad)")
1248   (make-x86-dis "(bad)")
1249   (make-x86-dis '("nopS" . :nop) 'op-e +v-mode+)
1250   ;; #x20
1251   (make-x86-dis "movL" 'op-rd +m-mode+ 'op-c +m-mode+)
1252   (make-x86-dis "movL" 'op-rd +m-mode+ 'op-d +m-mode+)
1253   (make-x86-dis "movL" 'op-c +m-mode+ 'op-rd +m-mode+)
1254   (make-x86-dis "movL" 'op-d +m-mode+ 'op-rd +m-mode+)
1255   (make-x86-dis "movL" 'op-rd +d-mode+ 'op-t +d-mode+)
1256   (make-x86-dis "(bad)")
1257   (make-x86-dis "movL" 'op-t +d-mode+ 'op-rd +d-mode+)
1258   (make-x86-dis "(bad)")
1259   ;; #x28
1260   (make-x86-dis "movapX" 'op-xmm 0 'op-ex +v-mode+)
1261   (make-x86-dis "movapX" 'op-ex +v-mode+ 'op-xmm 0)
1262   (make-x86-dis nil nil +use-prefix-user-table+ nil 2)
1263   (make-x86-dis "movntpX" 'op-e +v-mode+ 'op-xmm 0)
1264   (make-x86-dis nil nil +use-prefix-user-table+ nil 4)
1265   (make-x86-dis nil nil +use-prefix-user-table+ nil 3)
1266   (make-x86-dis "ucomisX" 'op-xmm 0 'op-ex +v-mode+)
1267   (make-x86-dis "comisX" 'op-xmm 0 'op-ex +v-mode+)
1268   ;; #x30
1269   (make-x86-dis "wrmsr")
1270   (make-x86-dis "rdtsc")
1271   (make-x86-dis "rdmsr")
1272   (make-x86-dis "rdpmc")
1273   (make-x86-dis "sysenter")
1274   (make-x86-dis "sysexit")
1275   (make-x86-dis "(bad)")
1276   (make-x86-dis "(bad)")
1277   ;; #x38
1278   (make-x86-dis "(bad)")
1279   (make-x86-dis "(bad)")
1280   (make-x86-dis "(bad)")
1281   (make-x86-dis "(bad)")
1282   (make-x86-dis "(bad)")
1283   (make-x86-dis "(bad)")
1284   (make-x86-dis "(bad)")
1285   (make-x86-dis "(bad)")
1286   ;; #x40
1287   (make-x86-dis "cmovoS" 'op-g +v-mode+ 'op-e +v-mode+)
1288   (make-x86-dis "cmovnoS" 'op-g +v-mode+ 'op-e +v-mode+)
1289   (make-x86-dis "cmovbS" 'op-g +v-mode+ 'op-e +v-mode+)
1290   (make-x86-dis "cmovaeS" 'op-g +v-mode+ 'op-e +v-mode+)
1291   (make-x86-dis "cmoveS" 'op-g +v-mode+ 'op-e +v-mode+)
1292   (make-x86-dis "cmovneS" 'op-g +v-mode+ 'op-e +v-mode+)
1293   (make-x86-dis "cmovbeS" 'op-g +v-mode+ 'op-e +v-mode+)
1294   (make-x86-dis "cmovaS" 'op-g +v-mode+ 'op-e +v-mode+)
1295   ;; #x48
1296   (make-x86-dis "cmovsS" 'op-g +v-mode+ 'op-e +v-mode+)
1297   (make-x86-dis "cmovnsS" 'op-g +v-mode+ 'op-e +v-mode+)
1298   (make-x86-dis "cmovpS" 'op-g +v-mode+ 'op-e +v-mode+)
1299   (make-x86-dis "cmovnpS" 'op-g +v-mode+ 'op-e +v-mode+)
1300   (make-x86-dis "cmovlS" 'op-g +v-mode+ 'op-e +v-mode+)
1301   (make-x86-dis "cmovgeS" 'op-g +v-mode+ 'op-e +v-mode+)
1302   (make-x86-dis "cmovleS" 'op-g +v-mode+ 'op-e +v-mode+)
1303   (make-x86-dis "cmovgS" 'op-g +v-mode+ 'op-e +v-mode+)
1304   ;; #x50
1305   (make-x86-dis "movmskpX" 'op-g +dq-mode+ 'op-xs +v-mode+)
1306   (make-x86-dis nil nil +use-prefix-user-table+ nil 13)
1307   (make-x86-dis nil nil +use-prefix-user-table+ nil 12)
1308   (make-x86-dis nil nil +use-prefix-user-table+ nil 11)
1309   (make-x86-dis "andpX" 'op-xmm 0 'op-ex +v-mode+)
1310   (make-x86-dis "andnpX" 'op-xmm 0 'op-ex +v-mode+)
1311   (make-x86-dis "orpX" 'op-xmm 0 'op-ex +v-mode+)
1312   (make-x86-dis "xorpX" 'op-xmm 0 'op-ex +v-mode+)
1313   ;; #x58
1314   (make-x86-dis nil nil +use-prefix-user-table+ nil 0)
1315   (make-x86-dis nil nil +use-prefix-user-table+ nil 10)
1316   (make-x86-dis nil nil +use-prefix-user-table+ nil 17)
1317   (make-x86-dis nil nil +use-prefix-user-table+ nil 16)
1318   (make-x86-dis nil nil +use-prefix-user-table+ nil 14)
1319   (make-x86-dis nil nil +use-prefix-user-table+ nil 7)
1320   (make-x86-dis nil nil +use-prefix-user-table+ nil 5)
1321   (make-x86-dis nil nil +use-prefix-user-table+ nil 6)
1322   ;; #x60
1323   (make-x86-dis "punpcklbw" 'op-mmx 0 'op-em +v-mode+)
1324   (make-x86-dis "punpcklwd" 'op-mmx 0 'op-em +v-mode+)
1325   (make-x86-dis "punpckldq" 'op-mmx 0 'op-em +v-mode+)
1326   (make-x86-dis "packsswb" 'op-mmx 0 'op-em +v-mode+)
1327   (make-x86-dis "pcmpgtb" 'op-mmx 0 'op-em +v-mode+)
1328   (make-x86-dis "pcmpgtw" 'op-mmx 0 'op-em +v-mode+)
1329   (make-x86-dis "pcmpgtd" 'op-mmx 0 'op-em +v-mode+)
1330   (make-x86-dis "packuswb" 'op-mmx 0 'op-em +v-mode+)
1331   ;; #x68
1332   (make-x86-dis "punpckhbw" 'op-mmx 0 'op-em +v-mode+)
1333   (make-x86-dis "punpckhwd" 'op-mmx 0 'op-em +v-mode+)
1334   (make-x86-dis "punpckhdq" 'op-mmx 0 'op-em +v-mode+)
1335   (make-x86-dis "packssdw" 'op-mmx 0 'op-em +v-mode+)
1336   (make-x86-dis nil nil +use-prefix-user-table+ nil 26)
1337   (make-x86-dis nil nil +use-prefix-user-table+ nil 24)
1338   (make-x86-dis "movd" 'op-mmx 0 'op-e +dq-mode+)
1339   (make-x86-dis nil nil +use-prefix-user-table+ nil 19)
1340   ;; #x70
1341   (make-x86-dis nil nil +use-prefix-user-table+ nil 22)
1342   (make-x86-dis nil nil +use-groups+ nil 17)
1343   (make-x86-dis nil nil +use-groups+ nil 18)
1344   (make-x86-dis nil nil +use-groups+ nil 19)
1345   (make-x86-dis "pcmpeqb" 'op-mmx 0 'op-em +v-mode+)
1346   (make-x86-dis "pcmpeqw" 'op-mmx 0 'op-em +v-mode+)
1347   (make-x86-dis "pcmpeqd" 'op-mmx 0 'op-em +v-mode+)
1348   (make-x86-dis "emms")
1349   ;; #x78
1350   (make-x86-dis "(bad)")
1351   (make-x86-dis "(bad)")
1352   (make-x86-dis "(bad)")
1353   (make-x86-dis "(bad)")
1354   (make-x86-dis nil nil +use-prefix-user-table+ nil 28)
1355   (make-x86-dis nil nil +use-prefix-user-table+ nil 29)
1356   (make-x86-dis nil nil +use-prefix-user-table+ nil 23)
1357   (make-x86-dis nil nil +use-prefix-user-table+ nil 20)
1358   ;; #x80
1359   (make-x86-dis "joH" 'op-j +v-mode+ nil +cond-jump-mode+)
1360   (make-x86-dis "jnoH" 'op-j +v-mode+ nil +cond-jump-mode+)
1361   (make-x86-dis "jbH" 'op-j +v-mode+ nil +cond-jump-mode+)
1362   (make-x86-dis "jaeH" 'op-j +v-mode+ nil +cond-jump-mode+)
1363   (make-x86-dis "jeH" 'op-j +v-mode+ nil +cond-jump-mode+)
1364   (make-x86-dis "jneH" 'op-j +v-mode+ nil +cond-jump-mode+)
1365   (make-x86-dis "jbeH" 'op-j +v-mode+ nil +cond-jump-mode+)
1366   (make-x86-dis "jaH" 'op-j +v-mode+ nil +cond-jump-mode+)
1367   ;; #x88
1368   (make-x86-dis "jsH" 'op-j +v-mode+ nil +cond-jump-mode+)
1369   (make-x86-dis "jnsH" 'op-j +v-mode+ nil +cond-jump-mode+)
1370   (make-x86-dis "jpH" 'op-j +v-mode+ nil +cond-jump-mode+)
1371   (make-x86-dis "jnpH" 'op-j +v-mode+ nil +cond-jump-mode+)
1372   (make-x86-dis "jlH" 'op-j +v-mode+ nil +cond-jump-mode+)
1373   (make-x86-dis "jgeH" 'op-j +v-mode+ nil +cond-jump-mode+)
1374   (make-x86-dis "jleH" 'op-j +v-mode+ nil +cond-jump-mode+)
1375   (make-x86-dis "jgH" 'op-j +v-mode+ nil +cond-jump-mode+)
1376   ;; #x90
1377   (make-x86-dis "seto" 'op-e +b-mode+)
1378   (make-x86-dis "setno" 'op-e +b-mode+)
1379   (make-x86-dis "setb" 'op-e +b-mode+)
1380   (make-x86-dis "setae" 'op-e +b-mode+)
1381   (make-x86-dis "sete" 'op-e +b-mode+)
1382   (make-x86-dis "setne" 'op-e +b-mode+)
1383   (make-x86-dis "setbe" 'op-e +b-mode+)
1384   (make-x86-dis "seta" 'op-e +b-mode+)
1385   ;; #x98
1386   (make-x86-dis "sets" 'op-e +b-mode+)
1387   (make-x86-dis "setns" 'op-e +b-mode+)
1388   (make-x86-dis "setp" 'op-e +b-mode+)
1389   (make-x86-dis "setnp" 'op-e +b-mode+)
1390   (make-x86-dis "setl" 'op-e +b-mode+)
1391   (make-x86-dis "setge" 'op-e +b-mode+)
1392   (make-x86-dis "setle" 'op-e +b-mode+)
1393   (make-x86-dis "setg" 'op-e +b-mode+)
1394   ;; #xa0
1395   (make-x86-dis "pushT" 'op-reg +fs-reg+)
1396   (make-x86-dis "popT" 'op-reg +fs-reg+)
1397   (make-x86-dis "cpuid")
1398   (make-x86-dis "btS" 'op-e +v-mode+ 'op-g +v-mode+)
1399   (make-x86-dis "shldS" 'op-e +v-mode+ 'op-g +v-mode+ 'op-i +b-mode+)
1400   (make-x86-dis "shldS" 'op-e +v-mode+ 'op-g +v-mode+ 'op-imreg +cl-reg+)
1401   (make-x86-dis nil nil +use-groups+ nil 24)
1402   (make-x86-dis nil nil +use-groups+ nil 23)
1403   ;; #xa8
1404   (make-x86-dis "pushT" 'op-reg +gs-reg+)
1405   (make-x86-dis "popT" 'op-reg +gs-reg+)
1406   (make-x86-dis "rsm")
1407   (make-x86-dis "btsS" 'op-e +v-mode+ 'op-g +v-mode+)
1408   (make-x86-dis "shrdS" 'op-e +v-mode+ 'op-g +v-mode+ 'op-i +b-mode+)
1409   (make-x86-dis "shrdS" 'op-e +v-mode+ 'op-g +v-mode+ 'op-imreg +cl-reg+)
1410   (make-x86-dis nil nil +use-groups+ nil 20)
1411   (make-x86-dis "imulS" 'op-g +v-mode+ 'op-e +v-mode+)
1412   ;; #xb0
1413   (make-x86-dis "cmpxchgB" 'op-e +b-mode+ 'op-g +b-mode+)
1414   (make-x86-dis "cmpxchgS" 'op-e +v-mode+ 'op-g +v-mode+)
1415   (make-x86-dis "lssS" 'op-g +v-mode+ 'op-m +f-mode+)
1416   (make-x86-dis "btrS" 'op-e +v-mode+ 'op-g +v-mode+)
1417   (make-x86-dis "lfsS" 'op-g +v-mode+ 'op-m +f-mode+)
1418   (make-x86-dis "lgsS" 'op-g +v-mode+ 'op-m +f-mode+)
1419   (make-x86-dis "movzbR" 'op-g +v-mode+ 'op-e +b-mode+)
1420   (make-x86-dis "movzwR" 'op-g +v-mode+ 'op-e +w-mode+) ; yes there really is movzww !
1421   ;; #xb8
1422   (make-x86-dis "(bad)")
1423   (make-x86-dis "ud2b")
1424   (make-x86-dis nil nil +use-groups+ nil 15)
1425   (make-x86-dis "btcS" 'op-e +v-mode+ 'op-g +v-mode+)
1426   (make-x86-dis "bsfS" 'op-g +v-mode+ 'op-e +v-mode+)
1427   (make-x86-dis "bsrS" 'op-g +v-mode+ 'op-e +v-mode+)
1428   (make-x86-dis "movsbR" 'op-g +v-mode+ 'op-e +b-mode+)
1429   (make-x86-dis "movswR" 'op-g +v-mode+ 'op-e +w-mode+) ; yes there really is movsww !
1430   ;; #xc0
1431   (make-x86-dis "xaddB" 'op-e +b-mode+ 'op-g +b-mode+)
1432   (make-x86-dis "xaddS" 'op-e +v-mode+ 'op-g +v-mode+)
1433   (make-x86-dis nil nil +use-prefix-user-table+ nil 1)
1434   (make-x86-dis "movntiS" 'op-e +v-mode+ 'op-g +v-mode+)
1435   (make-x86-dis "pinsrw" 'op-mmx 0 'op-e +dqw-mode+ 'op-i +b-mode+)
1436   (make-x86-dis "pextrw" 'op-g +dq-mode+ 'op-ms +v-mode+ 'op-i +b-mode+)
1437   (make-x86-dis "shufpX" 'op-xmm 0 'op-ex +v-mode+ 'op-i +b-mode+)
1438   (make-x86-dis nil nil +use-groups+ nil 16)
1439   ;; #xc8
1440   (make-x86-dis "bswap" 'op-reg +eax-reg+)
1441   (make-x86-dis "bswap" 'op-reg +ecx-reg+)
1442   (make-x86-dis "bswap" 'op-reg +edx-reg+)
1443   (make-x86-dis "bswap" 'op-reg +ebx-reg+)
1444   (make-x86-dis "bswap" 'op-reg +esp-reg+)
1445   (make-x86-dis "bswap" 'op-reg +ebp-reg+)
1446   (make-x86-dis "bswap" 'op-reg +esi-reg+)
1447   (make-x86-dis "bswap" 'op-reg +edi-reg+)
1448   ;; #xd0
1449   (make-x86-dis nil nil +use-prefix-user-table+ nil 27)
1450   (make-x86-dis "psrlw" 'op-mmx 0 'op-em +v-mode+)
1451   (make-x86-dis "psrld" 'op-mmx 0 'op-em +v-mode+)
1452   (make-x86-dis "psrlq" 'op-mmx 0 'op-em +v-mode+)
1453   (make-x86-dis "paddq" 'op-mmx 0 'op-em +v-mode+)
1454   (make-x86-dis "pmullw" 'op-mmx 0 'op-em +v-mode+)
1455   (make-x86-dis nil nil +use-prefix-user-table+ nil 21)
1456   (make-x86-dis "pmovmskb" 'op-g +dq-mode+ 'op-ms +v-mode+)
1457   ;; #xd8
1458   (make-x86-dis "psubusb" 'op-mmx 0 'op-em +v-mode+)
1459   (make-x86-dis "psubusw" 'op-mmx 0 'op-em +v-mode+)
1460   (make-x86-dis "pminub" 'op-mmx 0 'op-em +v-mode+)
1461   (make-x86-dis "pand" 'op-mmx 0 'op-em +v-mode+)
1462   (make-x86-dis "paddusb" 'op-mmx 0 'op-em +v-mode+)
1463   (make-x86-dis "paddusw" 'op-mmx 0 'op-em +v-mode+)
1464   (make-x86-dis "pmaxub" 'op-mmx 0 'op-em +v-mode+)
1465   (make-x86-dis "pandn" 'op-mmx 0 'op-em +v-mode+)
1466   ;; #xe0
1467   (make-x86-dis "pavgb" 'op-mmx 0 'op-em +v-mode+)
1468   (make-x86-dis "psraw" 'op-mmx 0 'op-em +v-mode+)
1469   (make-x86-dis "psrad" 'op-mmx 0 'op-em +v-mode+)
1470   (make-x86-dis "pavgw" 'op-mmx 0 'op-em +v-mode+)
1471   (make-x86-dis "pmulhuw" 'op-mmx 0 'op-em +v-mode+)
1472   (make-x86-dis "pmulhw" 'op-mmx 0 'op-em +v-mode+)
1473   (make-x86-dis nil nil +use-prefix-user-table+ nil 15)
1474   (make-x86-dis nil nil +use-prefix-user-table+ nil 25)
1475   ;; #xe8
1476   (make-x86-dis "psubsb" 'op-mmx 0 'op-em +v-mode+)
1477   (make-x86-dis "psubsw" 'op-mmx 0 'op-em +v-mode+)
1478   (make-x86-dis "pminsw" 'op-mmx 0 'op-em +v-mode+)
1479   (make-x86-dis "por" 'op-mmx 0 'op-em +v-mode+)
1480   (make-x86-dis "paddsb" 'op-mmx 0 'op-em +v-mode+)
1481   (make-x86-dis "paddsw" 'op-mmx 0 'op-em +v-mode+)
1482   (make-x86-dis "pmaxsw" 'op-mmx 0 'op-em +v-mode+)
1483   (make-x86-dis "pxor" 'op-mmx 0 'op-em +v-mode+)
1484   ;; #xf0
1485   (make-x86-dis nil nil +use-prefix-user-table+ nil 32)
1486   (make-x86-dis "psllw" 'op-mmx 0 'op-em +v-mode+)
1487   (make-x86-dis "pslld" 'op-mmx 0 'op-em +v-mode+)
1488   (make-x86-dis "psllq" 'op-mmx 0 'op-em +v-mode+)
1489   (make-x86-dis "pmuludq" 'op-mmx 0 'op-em +v-mode+)
1490   (make-x86-dis "pmaddwd" 'op-mmx 0 'op-em +v-mode+)
1491   (make-x86-dis "psadbw" 'op-mmx 0 'op-em +v-mode+)
1492   (make-x86-dis nil nil +use-prefix-user-table+ nil 18)
1493   ;; #xf8
1494   (make-x86-dis "psubb" 'op-mmx 0 'op-em +v-mode+)
1495   (make-x86-dis "psubw" 'op-mmx 0 'op-em +v-mode+)
1496   (make-x86-dis "psubd" 'op-mmx 0 'op-em +v-mode+)
1497   (make-x86-dis "psubq" 'op-mmx 0 'op-em +v-mode+)
1498   (make-x86-dis "paddb" 'op-mmx 0 'op-em +v-mode+)
1499   (make-x86-dis "paddw" 'op-mmx 0 'op-em +v-mode+)
1500   (make-x86-dis "paddd" 'op-mmx 0 'op-em +v-mode+)
1501   (make-x86-dis "(bad)")
1502   ))
1503
1504(defparameter *onebyte-has-modrm*
1505  (make-array 256 :element-type 'bit
1506              :initial-contents '(
1507  #|       0 1 2 3 4 5 6 7 8 9 a b c d e f        |#
1508  #|       -------------------------------        |#
1509  #| 00 |# 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0 0  #| 00 |#
1510  #| 10 |# 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0 0  #| 10 |#
1511  #| 20 |# 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0 0  #| 20 |#
1512  #| 30 |# 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0 0  #| 30 |#
1513  #| 40 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| 40 |#
1514  #| 50 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| 50 |#
1515  #| 60 |# 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 0  #| 60 |#
1516  #| 70 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| 70 |#
1517  #| 80 |# 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1  #| 80 |#
1518  #| 90 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| 90 |#
1519  #| a0 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| a0 |#
1520  #| b0 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| b0 |#
1521  #| c0 |# 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 0  #| c0 |#
1522  #| d0 |# 1 1 1 1 0 0 0 0 1 1 1 1 1 1 1 1  #| d0 |#
1523  #| e0 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| e0 |#
1524  #| f0 |# 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 1  #| f0 |#
1525  #|       -------------------------------        |#
1526  #|       0 1 2 3 4 5 6 7 8 9 a b c d e f        |#
1527)))
1528
1529
1530(defparameter *twobyte-has-modrm*
1531  (make-array 256 :element-type 'bit
1532              :initial-contents '(
1533  #|       0 1 2 3 4 5 6 7 8 9 a b c d e f        |#
1534  #|       -------------------------------        |#
1535  #| 00 |# 1 1 1 1 0 0 0 0 0 0 0 0 0 1 0 1  #| 0f |#
1536  #| 10 |# 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 1  #| 1f |#
1537  #| 20 |# 1 1 1 1 1 0 1 0 1 1 1 1 1 1 1 1  #| 2f |#
1538  #| 30 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| 3f |#
1539  #| 40 |# 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1  #| 4f |#
1540  #| 50 |# 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1  #| 5f |#
1541  #| 60 |# 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1  #| 6f |#
1542  #| 70 |# 1 1 1 1 1 1 1 0 0 0 0 0 1 1 1 1  #| 7f |#
1543  #| 80 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| 8f |#
1544  #| 90 |# 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1  #| 9f |#
1545  #| a0 |# 0 0 0 1 1 1 1 1 0 0 0 1 1 1 1 1  #| af |#
1546  #| b0 |# 1 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1  #| bf |#
1547  #| c0 |# 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0  #| cf |#
1548  #| d0 |# 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1  #| df |#
1549  #| e0 |# 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1  #| ef |#
1550  #| f0 |# 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0  #| ff |#
1551  #|       -------------------------------        |#
1552  #|       0 1 2 3 4 5 6 7 8 9 a b c d e f        |#
1553)))
1554
1555(defparameter *twobyte-uses-sse-prefix*
1556  (make-array 256 :element-type 'bit
1557              :initial-contents '(
1558  #|       0 1 2 3 4 5 6 7 8 9 a b c d e f        |#
1559  #|       -------------------------------        |#
1560  #| 00 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| 0f |#
1561  #| 10 |# 1 1 1 0 0 0 1 0 0 0 0 0 0 0 0 0  #| 1f |#
1562  #| 20 |# 0 0 0 0 0 0 0 0 0 0 1 0 1 1 0 0  #| 2f |#
1563  #| 30 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| 3f |#
1564  #| 40 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| 4f |#
1565  #| 50 |# 0 1 1 1 0 0 0 0 1 1 1 1 1 1 1 1  #| 5f |#
1566  #| 60 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1  #| 6f |#
1567  #| 70 |# 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1  #| 7f |#
1568  #| 80 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| 8f |#
1569  #| 90 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| 9f |#
1570  #| a0 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| af |#
1571  #| b0 |# 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0  #| bf |#
1572  #| c0 |# 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0  #| cf |#
1573  #| d0 |# 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0  #| df |#
1574  #| e0 |# 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0  #| ef |#
1575  #| f0 |# 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0  #| ff |#
1576  #|       -------------------------------        |#
1577  #|       0 1 2 3 4 5 6 7 8 9 a b c d e f        |#
1578)))
1579
1580
1581
1582(defparameter *grps*
1583  (vector
1584   ;; GRP1b
1585   (vector
1586    (make-x86-dis "addA" 'op-e +b-mode+ 'op-i +b-mode+)
1587    (make-x86-dis "orA" 'op-e +b-mode+ 'op-i +b-mode+)
1588    (make-x86-dis "adcA" 'op-e +b-mode+ 'op-i +b-mode+)
1589    (make-x86-dis "sbbA" 'op-e +b-mode+ 'op-i +b-mode+)
1590    (make-x86-dis "andA" 'op-e +b-mode+ 'op-i +b-mode+)
1591    (make-x86-dis "subA" 'op-e +b-mode+ 'op-i +b-mode+)
1592    (make-x86-dis "xorA" 'op-e +b-mode+ 'op-i +b-mode+)
1593    (make-x86-dis "cmpA" 'op-e +b-mode+ 'op-i +b-mode+))
1594   ;; GRP1S
1595   (vector
1596    (make-x86-dis '("addQ" . :addi32) 'op-e +v-mode+ 'op-i +v-mode+)
1597    (make-x86-dis "orQ" 'op-e +v-mode+ 'op-i +v-mode+)
1598    (make-x86-dis "adcQ" 'op-e +v-mode+ 'op-i +v-mode+)
1599    (make-x86-dis "sbbQ" 'op-e +v-mode+ 'op-i +v-mode+)
1600    (make-x86-dis "andQ" 'op-e +v-mode+ 'op-i +v-mode+)
1601    (make-x86-dis '("subQ" . :subi32) 'op-e +v-mode+ 'op-i +v-mode+)
1602    (make-x86-dis "xorQ" 'op-e +v-mode+ 'op-i +v-mode+)
1603    (make-x86-dis "cmpQ" 'op-e +v-mode+ 'op-i +v-mode+))
1604   ;; GRP1Ss
1605   (vector
1606    (make-x86-dis '("addQ" . :addi64) 'op-e +v-mode+ 'op-si +b-mode+)
1607    (make-x86-dis "orQ" 'op-e +v-mode+ 'op-si +b-mode+)
1608    (make-x86-dis "adcQ" 'op-e +v-mode+ 'op-si +b-mode+)
1609    (make-x86-dis "sbbQ" 'op-e +v-mode+ 'op-si +b-mode+)
1610    (make-x86-dis "andQ" 'op-e +v-mode+ 'op-si +b-mode+)
1611    (make-x86-dis '("subQ" . :subi64) 'op-e +v-mode+ 'op-si +b-mode+)
1612    (make-x86-dis "xorQ" 'op-e +v-mode+ 'op-si +b-mode+)
1613    (make-x86-dis "cmpQ" 'op-e +v-mode+ 'op-si +b-mode+))
1614   ;; GRP2b
1615   (vector
1616    (make-x86-dis "rolA" 'op-e +b-mode+ 'op-i +b-mode+)
1617    (make-x86-dis "rorA" 'op-e +b-mode+ 'op-i +b-mode+)
1618    (make-x86-dis "rclA" 'op-e +b-mode+ 'op-i +b-mode+)
1619    (make-x86-dis "rcrA" 'op-e +b-mode+ 'op-i +b-mode+)
1620    (make-x86-dis "shlA" 'op-e +b-mode+ 'op-i +b-mode+)
1621    (make-x86-dis "shrA" 'op-e +b-mode+ 'op-i +b-mode+)
1622    (make-x86-dis "(bad)")
1623    (make-x86-dis "sarA" 'op-e +b-mode+ 'op-i +b-mode+))
1624   ;; GRP2S
1625   (vector
1626    (make-x86-dis "rolQ" 'op-e +v-mode+ 'op-i +b-mode+)
1627    (make-x86-dis "rorQ" 'op-e +v-mode+ 'op-i +b-mode+)
1628    (make-x86-dis "rclQ" 'op-e +v-mode+ 'op-i +b-mode+)
1629    (make-x86-dis "rcrQ" 'op-e +v-mode+ 'op-i +b-mode+)
1630    (make-x86-dis "shlQ" 'op-e +v-mode+ 'op-i +b-mode+)
1631    (make-x86-dis "shrQ" 'op-e +v-mode+ 'op-i +b-mode+)
1632    (make-x86-dis "(bad)")
1633    (make-x86-dis "sarQ" 'op-e +v-mode+ 'op-i +b-mode+))
1634   ;; GRP2b-one
1635   (vector
1636    (make-x86-dis "rolA" 'op-e +b-mode+ 'op-i +const-1-mode+)
1637    (make-x86-dis "rorA" 'op-e +b-mode+ 'op-i +const-1-mode+)
1638    (make-x86-dis "rclA" 'op-e +b-mode+ 'op-i +const-1-mode+)
1639    (make-x86-dis "rcrA" 'op-e +b-mode+ 'op-i +const-1-mode+)
1640    (make-x86-dis "shlA" 'op-e +b-mode+ 'op-i +const-1-mode+)
1641    (make-x86-dis "shrA" 'op-e +b-mode+ 'op-i +const-1-mode+)
1642    (make-x86-dis "(bad)")
1643    (make-x86-dis "sarA" 'op-e +b-mode+ 'op-i +const-1-mode+))
1644   ;; GRP2S-one
1645   (vector
1646    (make-x86-dis "rolQ" 'op-e +v-mode+ 'op-i +const-1-mode+)
1647    (make-x86-dis "rorQ" 'op-e +v-mode+ 'op-i +const-1-mode+)
1648    (make-x86-dis "rclQ" 'op-e +v-mode+ 'op-i +const-1-mode+)
1649    (make-x86-dis "rcrQ" 'op-e +v-mode+ 'op-i +const-1-mode+)
1650    (make-x86-dis "shlQ" 'op-e +v-mode+ 'op-i +const-1-mode+)
1651    (make-x86-dis "shrQ" 'op-e +v-mode+ 'op-i +const-1-mode+)
1652    (make-x86-dis "(bad)")
1653    (make-x86-dis "sarQ" 'op-e +v-mode+ 'op-i +const-1-mode+))
1654   ;; GRP2b-cl
1655   (vector
1656    (make-x86-dis "rolA" 'op-e +b-mode+ 'op-imreg +cl-reg+)
1657    (make-x86-dis "rorA" 'op-e +b-mode+ 'op-imreg +cl-reg+)
1658    (make-x86-dis "rclA" 'op-e +b-mode+ 'op-imreg +cl-reg+)
1659    (make-x86-dis "rcrA" 'op-e +b-mode+ 'op-imreg +cl-reg+)
1660    (make-x86-dis "shlA" 'op-e +b-mode+ 'op-imreg +cl-reg+)
1661    (make-x86-dis "shrA" 'op-e +b-mode+ 'op-imreg +cl-reg+)
1662    (make-x86-dis "(bad)")
1663    (make-x86-dis "sarA" 'op-e +b-mode+ 'op-imreg +cl-reg+))
1664   ;; GRP2S-cl
1665   (vector
1666    (make-x86-dis "rolQ" 'op-e +v-mode+ 'op-imreg +cl-reg+)
1667    (make-x86-dis "rorQ" 'op-e +v-mode+ 'op-imreg +cl-reg+)
1668    (make-x86-dis "rclQ" 'op-e +v-mode+ 'op-imreg +cl-reg+)
1669    (make-x86-dis "rcrQ" 'op-e +v-mode+ 'op-imreg +cl-reg+)
1670    (make-x86-dis "shlQ" 'op-e +v-mode+ 'op-imreg +cl-reg+)
1671    (make-x86-dis "shrQ" 'op-e +v-mode+ 'op-imreg +cl-reg+)
1672    (make-x86-dis "(bad)")
1673    (make-x86-dis "sarQ" 'op-e +v-mode+ 'op-imreg +cl-reg+))
1674   ;; GRP3b
1675   (vector
1676    (make-x86-dis "testA" 'op-e +b-mode+ 'op-i +b-mode+)
1677    (make-x86-dis "(bad)" 'op-e +b-mode+)
1678    (make-x86-dis "notA" 'op-e +b-mode+)
1679    (make-x86-dis "negA" 'op-e +b-mode+)
1680    (make-x86-dis "mulA" 'op-e +b-mode+)            ; Don't print the implicit %al register
1681    (make-x86-dis "imulA" 'op-e +b-mode+)           ; to distinguish these opcodes from other
1682    (make-x86-dis "divA" 'op-e +b-mode+)            ; mul/imul opcodes. Do the same for div
1683    (make-x86-dis "idivA" 'op-e +b-mode+)           ; and idiv for consistency.
1684    )
1685   ;; GRP3S
1686   (vector
1687    (make-x86-dis "testQ" 'op-e +v-mode+ 'op-i +v-mode+)
1688    (make-x86-dis "(bad)")
1689    (make-x86-dis "notQ" 'op-e +v-mode+)
1690    (make-x86-dis "negQ" 'op-e +v-mode+)
1691    (make-x86-dis "mulQ" 'op-e +v-mode+)            ; Don't print the implicit register.
1692    (make-x86-dis "imulQ" 'op-e +v-mode+)
1693    (make-x86-dis "divQ" 'op-e +v-mode+)
1694    (make-x86-dis "idivQ" 'op-e +v-mode+))
1695   ;; GRP4
1696   (vector
1697    (make-x86-dis "incA" 'op-e +b-mode+)
1698    (make-x86-dis "decA" 'op-e +b-mode+)
1699    (make-x86-dis "(bad)")
1700    (make-x86-dis "(bad)")
1701    (make-x86-dis "(bad)")
1702    (make-x86-dis "(bad)")
1703    (make-x86-dis "(bad)")
1704    (make-x86-dis "(bad)"))
1705   ;; GRP5
1706   (vector
1707    (make-x86-dis "incQ" 'op-e +v-mode+)
1708    (make-x86-dis "decQ" 'op-e +v-mode+)
1709    (make-x86-dis '("callT" . :call) 'op-indire +v-mode+)
1710    (make-x86-dis '("JcallT" . :call) 'op-indire +f-mode+)
1711    (make-x86-dis '("jmpT" . :jump) 'op-indire +v-mode+)
1712    (make-x86-dis '("JjmpT" . :jump) 'op-indire +f-mode+)
1713    (make-x86-dis "pushU" 'op-e +v-mode+)
1714    (make-x86-dis "(bad)"))
1715   ;; GRP6
1716   (vector
1717    (make-x86-dis "sldtQ" 'op-e +v-mode+)
1718    (make-x86-dis "strQ" 'op-e +v-mode+)
1719    (make-x86-dis "lldt" 'op-e +w-mode+)
1720    (make-x86-dis "ltr" 'op-e +w-mode+)
1721    (make-x86-dis "verr" 'op-e +w-mode+)
1722    (make-x86-dis "verw" 'op-e +w-mode+)
1723    (make-x86-dis "(bad)")
1724    (make-x86-dis "(bad)"))
1725   ;; GRP7
1726   (vector
1727    (make-x86-dis "sgdtQ" 'op-m 0)
1728    (make-x86-dis "sidtQ" 'pni-fixup 0)
1729    (make-x86-dis '(("lgdtQ" . "lgdt")) 'op-m 0)
1730    (make-x86-dis '(("lidtQ" . "lidt")) 'op-m 0)
1731    (make-x86-dis "smswQ" 'op-e +v-mode+)
1732    (make-x86-dis "(bad)")
1733    (make-x86-dis "lmsw" 'op-e +w-mode+)
1734    (make-x86-dis "invlpg" 'INVLPG-Fixup +w-mode+))
1735   ;; GRP8
1736   (vector
1737    (make-x86-dis "(bad)")
1738    (make-x86-dis "(bad)")
1739    (make-x86-dis "(bad)")
1740    (make-x86-dis "(bad)")
1741    (make-x86-dis "btQ" 'op-e +v-mode+ 'op-i +b-mode+)
1742    (make-x86-dis "btsQ" 'op-e +v-mode+ 'op-i +b-mode+)
1743    (make-x86-dis "btrQ" 'op-e +v-mode+ 'op-i +b-mode+)
1744    (make-x86-dis "btcQ" 'op-e +v-mode+ 'op-i +b-mode+))
1745   ;; GRP9
1746   (vector
1747    (make-x86-dis "(bad)")
1748    (make-x86-dis "cmpxchg8b" 'op-e +q-mode+)
1749    (make-x86-dis "(bad)")
1750    (make-x86-dis "(bad)")
1751    (make-x86-dis "(bad)")
1752    (make-x86-dis "(bad)")
1753    (make-x86-dis "(bad)")
1754    (make-x86-dis "(bad)"))
1755   ;; GRP10
1756   (vector
1757    (make-x86-dis "(bad)")
1758    (make-x86-dis "(bad)")
1759    (make-x86-dis "psrlw" 'op-ms +v-mode+ 'op-i +b-mode+)
1760    (make-x86-dis "(bad)")
1761    (make-x86-dis "psraw" 'op-ms +v-mode+ 'op-i +b-mode+)
1762    (make-x86-dis "(bad)")
1763    (make-x86-dis "psllw" 'op-ms +v-mode+ 'op-i +b-mode+)
1764    (make-x86-dis "(bad)"))
1765   ;; GRP11
1766   (vector
1767    (make-x86-dis "(bad)")
1768    (make-x86-dis "(bad)")
1769    (make-x86-dis "psrld" 'op-ms +v-mode+ 'op-i +b-mode+)
1770    (make-x86-dis "(bad)")
1771    (make-x86-dis "psrad" 'op-ms +v-mode+ 'op-i +b-mode+)
1772    (make-x86-dis "(bad)")
1773    (make-x86-dis "pslld" 'op-ms +v-mode+ 'op-i +b-mode+)
1774    (make-x86-dis "(bad)"))
1775   ;; GRP12
1776   (vector
1777    (make-x86-dis "(bad)")
1778    (make-x86-dis "(bad)")
1779    (make-x86-dis "psrlq" 'op-ms +v-mode+ 'op-i +b-mode+)
1780    (make-x86-dis "psrldq" 'op-ms +v-mode+ 'op-i +b-mode+)
1781    (make-x86-dis "(bad)")
1782    (make-x86-dis "(bad)")
1783    (make-x86-dis "psllq" 'op-ms +v-mode+ 'op-i +b-mode+)
1784    (make-x86-dis "pslldq" 'op-ms +v-mode+ 'op-i +b-mode+))
1785   ;; GRP13
1786   (vector
1787    (make-x86-dis "fxsave" 'op-e +v-mode+)
1788    (make-x86-dis "fxrstor" 'op-e +v-mode+)
1789    (make-x86-dis "ldmxcsr" 'op-e +v-mode+)
1790    (make-x86-dis "stmxcsr" 'op-e +v-mode+)
1791    (make-x86-dis "(bad)")
1792    (make-x86-dis "lfence" 'OP-0fae 0)
1793    (make-x86-dis "mfence" 'OP-0fae 0)
1794    (make-x86-dis "clflush" 'OP-0fae 0))
1795   ;; GRP14
1796   (vector
1797    (make-x86-dis "prefetchnta" 'op-e +v-mode+)
1798    (make-x86-dis "prefetcht0" 'op-e +v-mode+)
1799    (make-x86-dis "prefetcht1" 'op-e +v-mode+)
1800    (make-x86-dis "prefetcht2" 'op-e +v-mode+)
1801    (make-x86-dis "(bad)")
1802    (make-x86-dis "(bad)")
1803    (make-x86-dis "(bad)")
1804    (make-x86-dis "(bad)"))
1805   ;; GRPAMD
1806   (vector
1807    (make-x86-dis "prefetch" 'op-e +b-mode+)
1808    (make-x86-dis "prefetchw" 'op-e +b-mode+)
1809    (make-x86-dis "(bad)")
1810    (make-x86-dis "(bad)")
1811    (make-x86-dis "(bad)")
1812    (make-x86-dis "(bad)")
1813    (make-x86-dis "(bad)")
1814    (make-x86-dis "(bad)"))
1815   ;; GRPPADLCK1
1816   (vector
1817    (make-x86-dis "xstorerng" 'op-0f07 0)
1818    (make-x86-dis "xcryptecb" 'op-0f07 0)
1819    (make-x86-dis "xcryptcbc" 'op-0f07 0)
1820    (make-x86-dis "(bad)" 'op-0f07 0)
1821    (make-x86-dis "xcryptcfb" 'op-0f07 0)
1822    (make-x86-dis "xcryptofb" 'op-0f07 0)
1823    (make-x86-dis "(bad)" 'op-0f07 0)
1824    (make-x86-dis "(bad)" 'op-0f07 0))
1825   ;; GRPPADLCK2
1826   (vector
1827    (make-x86-dis "montmul" 'op-0f07 0)
1828    (make-x86-dis "xsha1" 'op-0f07 0)
1829    (make-x86-dis "xsha256" 'op-0f07 0)
1830    (make-x86-dis "(bad)" 'op-0f07 0)
1831    (make-x86-dis "(bad)" 'op-0f07 0)
1832    (make-x86-dis "(bad)" 'op-0f07 0)
1833    (make-x86-dis "(bad)" 'op-0f07 0)
1834    (make-x86-dis "(bad)" 'op-0f07 0))))
1835
1836(defparameter *prefix-user-table*
1837  (vector
1838   ;; PREGRP0
1839   (vector
1840    (make-x86-dis "addps" 'op-xmm 0 'op-ex +v-mode+)
1841    (make-x86-dis "addss" 'op-xmm 0 'op-ex +v-mode+)
1842    (make-x86-dis "addpd" 'op-xmm 0 'op-ex +v-mode+)
1843    (make-x86-dis "addsd" 'op-xmm 0 'op-ex +v-mode+))
1844   ;; PREGRP1
1845   (vector
1846    (make-x86-dis "" 'op-xmm 0 'op-ex +v-mode+ 'op-simd-suffix 0);; See OP-SIMD-SUFFIX.
1847    (make-x86-dis "" 'op-xmm 0 'op-ex +v-mode+ 'op-simd-suffix 0)
1848    (make-x86-dis "" 'op-xmm 0 'op-ex +v-mode+ 'op-simd-suffix 0)
1849    (make-x86-dis "" 'op-xmm 0 'op-ex +v-mode+ 'op-simd-suffix 0))
1850   ;; PREGRP2
1851   (vector
1852    (make-x86-dis "cvtpi2ps" 'op-xmm 0 'op-em +v-mode+)
1853    (make-x86-dis "cvtsi2ssY" 'op-xmm 0 'op-e +v-mode+)
1854    (make-x86-dis "cvtpi2pd" 'op-xmm 0 'op-em +v-mode+)
1855    (make-x86-dis "cvtsi2sdY" 'op-xmm 0 'op-e +v-mode+))
1856   ;; PREGRP3
1857   (vector
1858    (make-x86-dis "cvtps2pi" 'op-mmx 0 'op-ex +v-mode+)
1859    (make-x86-dis "cvtss2siY" 'op-g +v-mode+ 'op-ex +v-mode+)
1860    (make-x86-dis "cvtpd2pi" 'op-mmx 0 'op-ex +v-mode+)
1861    (make-x86-dis "cvtsd2siY" 'op-g +v-mode+ 'op-ex +v-mode+))
1862   ;; PREGRP4
1863   (vector
1864    (make-x86-dis "cvttps2pi" 'op-mmx 0 'op-ex +v-mode+)
1865    (make-x86-dis "cvttss2siY" 'op-g +v-mode+ 'op-ex +v-mode+)
1866    (make-x86-dis "cvttpd2pi" 'op-mmx 0 'op-ex +v-mode+)
1867    (make-x86-dis "cvttsd2siY" 'op-g +v-mode+ 'op-ex +v-mode+))
1868   ;; PREGRP5
1869   (vector
1870    (make-x86-dis "divps" 'op-xmm 0 'op-ex +v-mode+)
1871    (make-x86-dis "divss" 'op-xmm 0 'op-ex +v-mode+)
1872    (make-x86-dis "divpd" 'op-xmm 0 'op-ex +v-mode+)
1873    (make-x86-dis "divsd" 'op-xmm 0 'op-ex +v-mode+))
1874   ;; PREGRP6
1875   (vector
1876    (make-x86-dis "maxps" 'op-xmm 0 'op-ex +v-mode+)
1877    (make-x86-dis "maxss" 'op-xmm 0 'op-ex +v-mode+)
1878    (make-x86-dis "maxpd" 'op-xmm 0 'op-ex +v-mode+)
1879    (make-x86-dis "maxsd" 'op-xmm 0 'op-ex +v-mode+))
1880   ;; PREGRP7
1881   (vector
1882    (make-x86-dis "minps" 'op-xmm 0 'op-ex +v-mode+)
1883    (make-x86-dis "minss" 'op-xmm 0 'op-ex +v-mode+)
1884    (make-x86-dis "minpd" 'op-xmm 0 'op-ex +v-mode+)
1885    (make-x86-dis "minsd" 'op-xmm 0 'op-ex +v-mode+))
1886   ;; PREGRP8
1887   (vector
1888    (make-x86-dis "movups" 'op-xmm 0 'op-ex +v-mode+)
1889    (make-x86-dis '("movss" .  :single) 'op-xmm 0 'op-ex +v-mode+)
1890    (make-x86-dis "movupd" 'op-xmm 0 'op-ex +v-mode+)
1891    (make-x86-dis '("movsd" . :double) 'op-xmm 0 'op-ex +v-mode+))
1892   ;; PREGRP9
1893   (vector
1894    (make-x86-dis "movups" 'op-ex +v-mode+ 'op-xmm 0)
1895    (make-x86-dis '("movss" . :single)'op-ex +v-mode+ 'op-xmm 0)
1896    (make-x86-dis "movupd" 'op-ex +v-mode+ 'op-xmm 0)
1897    (make-x86-dis '("movsd" . :double) 'op-ex +v-mode+ 'op-xmm 0))
1898   ;; PREGRP10
1899   (vector
1900    (make-x86-dis "mulps" 'op-xmm 0 'op-ex +v-mode+)
1901    (make-x86-dis "mulss" 'op-xmm 0 'op-ex +v-mode+)
1902    (make-x86-dis "mulpd" 'op-xmm 0 'op-ex +v-mode+)
1903    (make-x86-dis "mulsd" 'op-xmm 0 'op-ex +v-mode+))
1904   ;; PREGRP11
1905   (vector
1906    (make-x86-dis "rcpps" 'op-xmm 0 'op-ex +v-mode+)
1907    (make-x86-dis "rcpss" 'op-xmm 0 'op-ex +v-mode+)
1908    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+)
1909    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+))
1910   ;; PREGRP12
1911   (vector
1912    (make-x86-dis "rsqrtps" 'op-xmm 0 'op-ex +v-mode+)
1913    (make-x86-dis "rsqrtss" 'op-xmm 0 'op-ex +v-mode+)
1914    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+)
1915    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+))
1916   ;; PREGRP13
1917   (vector
1918    (make-x86-dis "sqrtps" 'op-xmm 0 'op-ex +v-mode+)
1919    (make-x86-dis "sqrtss" 'op-xmm 0 'op-ex +v-mode+)
1920    (make-x86-dis "sqrtpd" 'op-xmm 0 'op-ex +v-mode+)
1921    (make-x86-dis "sqrtsd" 'op-xmm 0 'op-ex +v-mode+))
1922   ;; PREGRP14
1923   (vector
1924    (make-x86-dis "subps" 'op-xmm 0 'op-ex +v-mode+)
1925    (make-x86-dis "subss" 'op-xmm 0 'op-ex +v-mode+)
1926    (make-x86-dis "subpd" 'op-xmm 0 'op-ex +v-mode+)
1927    (make-x86-dis "subsd" 'op-xmm 0 'op-ex +v-mode+))
1928   ;; PREGRP15
1929   (vector
1930    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+)
1931    (make-x86-dis "cvtdq2pd" 'op-xmm 0 'op-ex +v-mode+)
1932    (make-x86-dis "cvttpd2dq" 'op-xmm 0 'op-ex +v-mode+)
1933    (make-x86-dis "cvtpd2dq" 'op-xmm 0 'op-ex +v-mode+))
1934   ;; PREGRP16
1935   (vector
1936    (make-x86-dis "cvtdq2ps" 'op-xmm 0 'op-ex +v-mode+)
1937    (make-x86-dis "cvttps2dq" 'op-xmm 0 'op-ex +v-mode+)
1938    (make-x86-dis "cvtps2dq" 'op-xmm 0 'op-ex +v-mode+)
1939    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+))
1940   ;; PREGRP17
1941   (vector
1942    (make-x86-dis "cvtps2pd" 'op-xmm 0 'op-ex +v-mode+)
1943    (make-x86-dis "cvtss2sd" 'op-xmm 0 'op-ex +v-mode+)
1944    (make-x86-dis "cvtpd2ps" 'op-xmm 0 'op-ex +v-mode+)
1945    (make-x86-dis "cvtsd2ss" 'op-xmm 0 'op-ex +v-mode+))
1946   ;; PREGRP18
1947   (vector
1948    (make-x86-dis "maskmovq" 'op-mmx 0 'op-s +v-mode+)
1949    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+)
1950    (make-x86-dis "maskmovdqu" 'op-xmm 0 'op-ex +v-mode+)
1951    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+))
1952   ;; PREGRP19
1953   (vector
1954    (make-x86-dis "movq" 'op-mmx 0 'op-em +v-mode+)
1955    (make-x86-dis "movdqu" 'op-xmm 0 'op-ex +v-mode+)
1956    (make-x86-dis "movdqa" 'op-xmm 0 'op-ex +v-mode+)
1957    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+))
1958   ;; PREGRP20
1959   (vector
1960    (make-x86-dis "movq" 'op-em +v-mode+ 'op-mmx 0)
1961    (make-x86-dis "movdqu" 'op-ex +v-mode+ 'op-xmm 0)
1962    (make-x86-dis "movdqa" 'op-ex +v-mode+ 'op-xmm 0)
1963    (make-x86-dis "(bad)" 'op-ex +v-mode+ 'op-xmm 0))
1964   ;; PREGRP21
1965   (vector
1966    (make-x86-dis "(bad)" 'op-ex +v-mode+ 'op-xmm 0)
1967    (make-x86-dis "movq2dq" 'op-xmm 0 'op-s +v-mode+)
1968    (make-x86-dis "movq" 'op-ex +v-mode+ 'op-xmm 0)
1969    (make-x86-dis "movdq2q" 'op-mmx 0 'op-xs +v-mode+))
1970   ;; PREGRP22
1971   (vector
1972    (make-x86-dis "pshufw" 'op-mmx 0 'op-em +v-mode+ 'op-i +b-mode+)
1973    (make-x86-dis "pshufhw" 'op-xmm 0 'op-ex +v-mode+ 'op-i +b-mode+)
1974    (make-x86-dis "pshufd" 'op-xmm 0 'op-ex +v-mode+ 'op-i +b-mode+)
1975    (make-x86-dis "pshuflw" 'op-xmm 0 'op-ex +v-mode+ 'op-i +b-mode+))
1976   ;; PREGRP23
1977   (vector
1978    (make-x86-dis "movd" 'op-e +dq-mode+ 'op-mmx 0)
1979    (make-x86-dis "movq" 'op-xmm 0 'op-ex +v-mode+)
1980    (make-x86-dis "movd" 'op-e +dq-mode+ 'op-xmm 0)
1981    (make-x86-dis "(bad)" 'op-e +d-mode+ 'op-xmm 0))
1982   ;; PREGRP24
1983   (vector
1984    (make-x86-dis "(bad)" 'op-mmx 0 'op-ex +v-mode+)
1985    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+)
1986    (make-x86-dis "punpckhqdq" 'op-xmm 0 'op-ex +v-mode+)
1987    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+))
1988   ;; PREGRP25
1989   (vector
1990    (make-x86-dis "movntq" 'op-em +v-mode+ 'op-mmx 0)
1991    (make-x86-dis "(bad)" 'op-em +v-mode+ 'op-xmm 0)
1992    (make-x86-dis "movntdq" 'op-em +v-mode+ 'op-xmm 0)
1993    (make-x86-dis "(bad)" 'op-em +v-mode+ 'op-xmm 0))
1994   ;; PREGRP26
1995   (vector
1996    (make-x86-dis "(bad)" 'op-mmx 0 'op-ex +v-mode+)
1997    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+)
1998    (make-x86-dis "punpcklqdq" 'op-xmm 0 'op-ex +v-mode+)
1999    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+))
2000   ;; PREGRP27
2001   (vector
2002    (make-x86-dis "(bad)" 'op-mmx 0 'op-ex +v-mode+)
2003    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+)
2004    (make-x86-dis "addsubpd" 'op-xmm 0 'op-ex +v-mode+)
2005    (make-x86-dis "addsubps" 'op-xmm 0 'op-ex +v-mode+))
2006   ;; PREGRP28
2007   (vector
2008    (make-x86-dis "(bad)" 'op-mmx 0 'op-ex +v-mode+)
2009    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+)
2010    (make-x86-dis "haddpd" 'op-xmm 0 'op-ex +v-mode+)
2011    (make-x86-dis "haddps" 'op-xmm 0 'op-ex +v-mode+))
2012   ;; PREGRP29
2013   (vector
2014    (make-x86-dis "(bad)" 'op-mmx 0 'op-ex +v-mode+)
2015    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+)
2016    (make-x86-dis "hsubpd" 'op-xmm 0 'op-ex +v-mode+)
2017    (make-x86-dis "hsubps" 'op-xmm 0 'op-ex +v-mode+))
2018   ;; PREGRP30
2019   (vector
2020    (make-x86-dis "movlpX" 'op-xmm 0 'op-ex +v-mode+ 'SIMD-Fixup #\h);; really only 2 operands
2021    (make-x86-dis "movsldup" 'op-xmm 0 'op-ex +v-mode+)
2022    (make-x86-dis "movlpd" 'op-xmm 0 'op-ex +v-mode+)
2023    (make-x86-dis "movddup" 'op-xmm 0 'op-ex +v-mode+))
2024   ;; PREGRP31
2025   (vector
2026    (make-x86-dis "movhpX" 'op-xmm 0 'op-ex +v-mode+ 'SIMD-Fixup #\l)
2027    (make-x86-dis "movshdup" 'op-xmm 0 'op-ex +v-mode+)
2028    (make-x86-dis "movhpd" 'op-xmm 0 'op-ex +v-mode+)
2029    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+))
2030   ;; PREGRP32
2031   (vector
2032    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+)
2033    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+)
2034    (make-x86-dis "(bad)" 'op-xmm 0 'op-ex +v-mode+)
2035    (make-x86-dis "lddqu" 'op-xmm 0 'op-m 0))))
2036
2037(defparameter *x86-64-table*
2038    (vector
2039     (vector
2040      (make-x86-dis "arpl" 'op-e +w-mode+ 'op-g +w-mode+)
2041      (make-x86-dis "movslq" 'op-g +v-mode+ 'op-e +d-mode+))))
2042
2043
2044(defun prefix-name (ds b sizeflag)
2045  (case b
2046    (#x40 "rex")
2047    (#x41 "rexZ")
2048    (#x42 "rexY")
2049    (#x43 "rexYZ")
2050    (#x44 "rexX")
2051    (#x45 "rexXZ")
2052    (#x46 "rexYZ")
2053    (#x47 "rexXYZ")
2054    (#x48 "rex64")
2055    (#x49 "rex64Z")
2056    (#x4a "rex64Y")
2057    (#x4b "rex64YZ")
2058    (#x4c "rex64X")
2059    (#x4d "rex64XZ")
2060    (#x4e "rex64XY")
2061    (#x4f "rex64XYZ")
2062    (#xf3 "repz")
2063    (#xf2 "repnz")
2064    (#xf0 "lock")
2065    (#x2e "cs")
2066    (#x36 "ss")
2067    (#x3e "ds")
2068    (#x26 "es")
2069    (#x64 "fs")
2070    (#x65 "gs")
2071    (#x66 (if (logtest sizeflag +dflag+) "data16" "data32"))
2072    (#x67 (if (x86-ds-mode-64 ds)
2073            (if (logtest sizeflag +aflag+) "addr32" "addr64")
2074            (if (logtest sizeflag +aflag+) "addr16" "addr32")))
2075
2076    (#x9b "fwait")))
2077
2078(defun scan-prefixes (ds instruction)
2079  (setf (x86-ds-prefixes ds) 0
2080        (x86-ds-used-prefixes ds) 0
2081        (x86-ds-rex ds) 0
2082        (x86-ds-rex-used ds) 0)
2083  (let* ((newrex 0)
2084         (prefixes 0))
2085    (declare (fixnum prefixes))
2086    (do* ((b (x86-ds-peek-u8 ds)
2087             (progn (x86-ds-skip ds)
2088                    (x86-ds-peek-u8 ds))))
2089         ()
2090      (declare (type (unsigned-byte 8) b))
2091      (setq newrex 0)
2092      (cond ((and (>= b #x40)
2093                  (<= b #x4f))
2094             (if (x86-ds-mode-64 ds)
2095               (setq newrex b)
2096               (return)))
2097            ((= b #xf3)
2098             (setq prefixes (logior prefixes +prefix-repz+)))
2099            ((= b #xf2)
2100             (setq prefixes (logior prefixes +prefix-repnz+)))
2101            ((= b #xf0)
2102             (setq prefixes (logior prefixes +prefix-lock+)))
2103            ((= b #x2e)
2104             (setq prefixes (logior prefixes +prefix-cs+)))
2105            ((= b #x36)
2106             (setq prefixes (logior prefixes +prefix-ss+)))
2107            ((= b #x3e)
2108             (setq prefixes (logior prefixes +prefix-ds+)))
2109            ((= b #x26)
2110             (setq prefixes (logior prefixes +prefix-es+)))
2111            ((= b #x64)
2112             (setq prefixes (logior prefixes +prefix-fs+)))
2113            ((= b #x65)
2114             (setq prefixes (logior prefixes +prefix-gs+)))
2115            ((= b #x66)
2116             (setq prefixes (logior prefixes +prefix-data+)))
2117            ((= b #x67)
2118             (setq prefixes (logior prefixes +prefix-addr+)))
2119            ((= b #x9b)
2120             ;; FWAIT. If there are already some prefixes,
2121             ;; we've found the opcode.
2122             (if (= prefixes 0)
2123               (progn
2124                 (setq prefixes +prefix-fwait+)
2125                 (return))
2126               (setq prefixes (logior prefixes +prefix-fwait+))))
2127            (t (return)))
2128      (unless (zerop (x86-ds-rex ds))
2129        (let* ((prefix-name (prefix-name ds (x86-ds-rex ds) 0)))
2130          (when prefix-name
2131            (push prefix-name
2132                  (x86-di-prefixes instruction)))))
2133      (setf (x86-ds-rex ds) newrex))
2134    (setf (x86-ds-prefixes ds) prefixes)))
2135
2136
2137(defun x86-putop (ds template sizeflag instruction flags)
2138  (let* ((ok t))
2139    (when (consp template)
2140      (if (x86-ds-mode-64 ds)
2141        (setq template (cdr template))
2142        (setq template (car template))))
2143    (setf (x86-di-flags instruction) flags)
2144    (if (dotimes (i (length template) t)
2145          (unless (lower-case-p (schar template i))
2146            (return nil)))
2147      (setf (x86-di-mnemonic instruction) template)
2148      (let* ((string-buffer (x86-ds-string-buffer ds))
2149             (mod (x86-ds-mod ds))
2150             (rex (x86-ds-rex ds))
2151             (prefixes (x86-ds-prefixes ds))
2152             (mode64 (x86-ds-mode-64 ds)))
2153        (declare (fixnum rex prefixes))
2154        (setf (fill-pointer string-buffer) 0)
2155        (dotimes (i (length template))
2156          (let* ((c (schar template i))
2157                 (b 
2158                  (case c
2159                    (#\) (setq ok nil))
2160                    (#\A (if (or (not (eql mod 3))
2161                                 (logtest sizeflag +suffix-always+))
2162                           #\b))
2163                    (#\B (if (logtest sizeflag +suffix-always+)
2164                           #\b))
2165                    (#\C (when (or (logtest prefixes +prefix-data+)
2166                                   (logtest sizeflag +suffix-always+))
2167                           (used-prefix ds +prefix-data+)
2168                           (if (logtest sizeflag +dflag+)
2169                             #\l
2170                             #\s)))
2171                    (#\E (used-prefix ds +prefix-addr+)
2172                         (if mode64
2173                           (if (logtest sizeflag +aflag+)
2174                             #\r
2175                             #\e)
2176                           (if (logtest sizeflag +aflag+)
2177                             #\e)))
2178                    (#\F (when (or (logtest prefixes +prefix-addr+)
2179                                   (logtest sizeflag +suffix-always+))
2180                           (used-prefix ds +prefix-addr+)
2181                           (if (logtest sizeflag +aflag+)
2182                             (if mode64 #\q #\l)
2183                             (if mode64 #\l #\w))))
2184                    (#\H (let* ((ds-or-cs
2185                                 (logand prefixes
2186                                         (logior +prefix-ds+ +prefix-ds+)))
2187                                (ds-only (= ds-or-cs +prefix-ds+))
2188                                (cs-only (= ds-or-cs +prefix-cs+)))
2189                           (when (or ds-only cs-only)
2190                             (setf (x86-ds-used-prefixes ds)
2191                                   (logior (x86-ds-used-prefixes ds)
2192                                           ds-or-cs))
2193                             (if ds-only ".pt" ".pn"))))
2194                    (#\J #\l)
2195                    (#\L (if (logtest sizeflag +suffix-always+) #\l))
2196                    (#\N (if (logtest prefixes +prefix-fwait+)
2197                           (setf (x86-ds-used-prefixes ds)
2198                                 (logior (x86-ds-used-prefixes ds)
2199                                         +prefix-fwait+))
2200                           #\n))
2201                    (#\O (used-rex ds +rex-mode64+)
2202                         (if (logtest rex +rex-mode64+)
2203                           #\o
2204                           #\d))
2205                    ((#\T #\P)
2206                     (if (and (eql c #\T) mode64)
2207                       #\q
2208                       (when (or (logtest prefixes +prefix-data+)
2209                                 (logtest rex +rex-mode64+)
2210                                 (logtest sizeflag +suffix-always+))
2211                         (used-rex ds +rex-mode64+)
2212                         (if (logtest rex +rex-mode64+)
2213                           #\q
2214                           (progn
2215                             (used-prefix ds +prefix-data+)
2216                             (if (logtest sizeflag +dflag+)
2217                               #\l
2218                               #\w))))))
2219                    ((#\U #\Q)
2220                     (if (and (eql c #\U) mode64)
2221                       #\q
2222                       (progn
2223                         (used-rex ds +rex-mode64+)
2224                         (when (or (not (eql mod 3))
2225                                   (logtest sizeflag +suffix-always+))
2226                           (if (logtest rex +rex-mode64+)
2227                             #\q
2228                             (progn
2229                               (used-prefix ds +prefix-data+)
2230                               (if (logtest sizeflag +dflag+)
2231                                 #\l
2232                                 #\w)))))))
2233                    (#\R
2234                     (used-rex ds +rex-mode64+)
2235                     (if (logtest rex +rex-mode64+)
2236                       #\q
2237                       (if (logtest sizeflag +dflag+)
2238                         #\l
2239                         #\w)))
2240                    (#\S
2241                     (when (logtest sizeflag +suffix-always+)
2242                       (if (logtest rex +rex-mode64+)
2243                         #\q
2244                         (progn
2245                           (used-prefix ds +prefix-data+)
2246                           (if (logtest sizeflag +dflag+)
2247                             #\l
2248                             #\w)))))
2249                    (#\X
2250                     (used-prefix ds +prefix-data+)
2251                     (if (logtest prefixes +prefix-data+)
2252                       #\d
2253                       #\s))
2254                    (#\Y
2255                     (when (logtest rex +rex-mode64+)
2256                       (used-rex ds +rex-mode64+)
2257                       #\q))
2258                    (#\W
2259                     (used-rex ds 0)
2260                     (if (not (eql rex 0))
2261                       #\l
2262                       (progn
2263                         (used-prefix ds +prefix-data+)
2264                         (if (logtest sizeflag +dflag+)
2265                           #\w
2266                           #\b))))
2267                    (t c))))
2268            (if b
2269              (if (typep b 'character)
2270                (vector-push-extend b string-buffer)
2271                (dotimes (i (length b))
2272                  (vector-push-extend (schar b i) string-buffer))))))
2273        (setf (x86-di-mnemonic instruction) (subseq string-buffer 0))))
2274    ok))
2275
2276(defparameter *x86-disassemble-print-nop* nil)
2277(defparameter *x86-disassemble-always-print-suffix* t)
2278
2279(defun x86-dis-do-float (ds instruction floatop sizeflag)
2280  (declare (ignore floatop sizeflag))
2281  ;; Later; we want to make minimal use of the x87 fpu.
2282  (setf (x86-di-mnemonic instruction) "x87-fpu-op")
2283  (x86-ds-skip ds))
2284
2285(defun x86-dis-do-uuo (ds instruction intop)
2286  (declare (type (unsigned-byte 8) intop))
2287  (let* ((stop t)
2288         (regmask (if (x86-ds-mode-64 ds) #xf #x7)))
2289    (cond ((and (>= intop #x70) (< intop #x80))
2290           (let* ((pseudo-modrm-byte (x86-ds-next-u8 ds)))
2291             (setf (x86-di-mnemonic instruction)
2292                   "uuo-error-slot-unbound"
2293                   (x86-di-op0 instruction)
2294                   (x86-dis-make-reg-operand (lookup-x86-register (logand intop regmask) :%))                     
2295                   (x86-di-op1 instruction)
2296                   (x86-dis-make-reg-operand (lookup-x86-register (ldb (byte 4 4)
2297                                                                       pseudo-modrm-byte) :%))
2298                   (x86-di-op2 instruction)
2299                   (x86-dis-make-reg-operand (lookup-x86-register (ldb (byte 4 0)
2300                                                                       pseudo-modrm-byte) :%)))))
2301          ((< intop #x90)
2302           (setf (x86-di-mnemonic instruction) "int"
2303                 (x86-di-op0 instruction)
2304                 (x86::make-x86-immediate-operand :value (parse-x86-lap-expression intop))))
2305          ((< intop #xa0)
2306           (setf (x86-di-mnemonic instruction)
2307                 "uuo-error-unbound"
2308                 (x86-di-op0 instruction)
2309                 (x86-dis-make-reg-operand (lookup-x86-register (logand intop regmask) :%))))
2310          ((< intop #xb0)
2311           (setf (x86-di-mnemonic instruction)
2312                 "uuo-error-udf"
2313                 (x86-di-op0 instruction)
2314                 (x86-dis-make-reg-operand (lookup-x86-register (logand intop regmask) :%))))
2315         
2316          ((< intop #xc0)
2317           (setf (x86-di-mnemonic instruction)
2318                 "uuo-error-reg-not-type"
2319                 (x86-di-op0 instruction)
2320                 (x86-dis-make-reg-operand (lookup-x86-register (logand intop regmask) :%))
2321                 (x86-di-op1 instruction)
2322                 (x86::make-x86-immediate-operand :value (parse-x86-lap-expression (x86-ds-next-u8 ds)))))
2323          ((< intop #xc8)
2324           (if (= intop #xc3)
2325             (let* ((pseudo-modrm-byte (x86-ds-next-u8 ds)))
2326               (setf (x86-di-mnemonic instruction)
2327                     "uuo-error-array-rank"
2328                     (x86-di-op0 instruction)
2329                     (x86-dis-make-reg-operand (lookup-x86-register (ldb (byte 4 4)
2330                                                                         pseudo-modrm-byte) :%))
2331                     (x86-di-op1 instruction)
2332                     (x86-dis-make-reg-operand (lookup-x86-register (ldb (byte 4 0)
2333                                                                         pseudo-modrm-byte) :%))))
2334                   
2335           (setf (x86-di-mnemonic instruction)
2336                 (case intop
2337                   (#xc0 "uuo-error-too-few-args")
2338                   (#xc1 "uuo-error-too-many-args")
2339                   (#xc2 "uuo-error-wrong-number-of-args")
2340                   (#xc4 (progn (setq stop nil) "uuo-gc-trap"))
2341                   (#xc5 "uuo-alloc")
2342                   (#xc6 "uuo-error-not-callable")
2343                   (#xc7 "uuo-udf-call")
2344                   (t "unknown-UUO")))))
2345          ((= intop #xc8)
2346           (let* ((pseudo-modrm-byte (x86-ds-next-u8 ds)))
2347             (declare (type (unsigned-byte 8) pseudo-modrm-byte))
2348             (setf (x86-di-op0 instruction)
2349                 (x86-dis-make-reg-operand
2350                  (lookup-x86-register (ldb (byte 4 4) pseudo-modrm-byte) :%))
2351                 (x86-di-op1 instruction)
2352                 (x86-dis-make-reg-operand
2353                  (lookup-x86-register (ldb (byte 4 0) pseudo-modrm-byte) :%))
2354                 (x86-di-mnemonic instruction) "uuo-error-vector-bounds")))
2355          ((< intop #xd0)
2356           (cond ((= intop #xcb)
2357                  (let* ((pseudo-modrm-byte (x86-ds-next-u8 ds)))
2358                    (setf (x86-di-mnemonic instruction)
2359                          "uuo-error-array-bounds"
2360                          (x86-di-op0 instruction)
2361                          (x86-dis-make-reg-operand
2362                           (lookup-x86-register (ldb (byte 4 4)
2363                                                     pseudo-modrm-byte) :%))
2364                          (x86-di-op1 instruction)
2365                          (x86-dis-make-reg-operand
2366                           (lookup-x86-register (ldb (byte 4 0)
2367                                                     pseudo-modrm-byte) :%)))))
2368                 ((= intop #xcc)
2369                  (let* ((pseudo-modrm-byte (x86-ds-next-u8 ds)))
2370                    (setf (x86-di-mnemonic instruction)
2371                          "uuo-error-eep-unresolved"
2372                          (x86-di-op0 instruction)
2373                          (x86-dis-make-reg-operand
2374                           (lookup-x86-register (ldb (byte 4 4)
2375                                                     pseudo-modrm-byte) :%))
2376                          (x86-di-op1 instruction)
2377                          (x86-dis-make-reg-operand
2378                           (lookup-x86-register (ldb (byte 4 0)
2379                                                     pseudo-modrm-byte) :%)))))
2380                 (t (setf (x86-di-mnemonic instruction)
2381                          (case intop
2382                            (#xc9 "uuo-error-call-macro-or-special-operator")
2383                            (#xca (setq stop nil) "uuo-error-debug-trap")
2384                            (#xcd (setq stop nil) "uuo-error-debug-trap-with-string")
2385                            (t "unknown-UUO"))))))
2386          ((< intop #xe0)
2387           (setf (x86-di-mnemonic instruction)
2388                 "uuo-error-reg-not-tag"
2389                 (x86-di-op0 instruction)
2390                 (x86-dis-make-reg-operand (lookup-x86-register (logand intop regmask) :%))
2391                 (x86-di-op1 instruction)
2392                 (x86::make-x86-immediate-operand :value (parse-x86-lap-expression (x86-ds-next-u8 ds)))))
2393          ((< intop #xf0)
2394           (setf (x86-di-mnemonic instruction)
2395                 "uuo-error-reg-not-list"
2396                 (x86-di-op0 instruction)
2397                 (x86-dis-make-reg-operand (lookup-x86-register (logand intop regmask) :%))))
2398          (t
2399           (setf (x86-di-mnemonic instruction)
2400                 "uuo-error-reg-not-fixnum"
2401                 (x86-di-op0 instruction)
2402                 (x86-dis-make-reg-operand (lookup-x86-register (logand intop regmask) :%)))))
2403    stop))
2404
2405
2406
2407(defun x86-dis-analyze-operands (ds instruction flag)
2408  ;; If instruction is adding a positive displacement to the FN
2409  ;; register, note the effective address as a label reference
2410  ;; and modify the operand(s).
2411  ;; If the instruction is a MOV or PUSH whose source operand
2412  ;; is relative to the FN register, generate a constant reference.
2413  ;; If the instruction is adding a displacement to RIP, note
2414  ;; the effective address as a label reference.
2415  ;; On ia32, if op0 is a 32-bit immediate and op1 is (% fn),
2416  ;; treat the immediate as :self.
2417  (let* ((op0 (x86-di-op0 instruction))
2418         (op1 (x86-di-op1 instruction))
2419         (entry-ea (x86-ds-entry-point ds)))
2420    (flet ((is-fn (thing)
2421             (if (typep thing 'x86::x86-register-operand)
2422               (let* ((entry (x86::x86-register-operand-entry thing)))
2423                 (eq entry (if (x86-ds-mode-64 ds)
2424                             (x86::x86-reg64 13)
2425                             (x86::x86-reg32 x8632::fn))))))
2426           (is-rip (thing)
2427             (if (and (typep thing 'x86::x86-register-operand)
2428                      (x86-ds-mode-64 ds))
2429              (let* ((entry (x86::x86-register-operand-entry thing)))
2430                 (eq entry (svref x86::*x8664-register-entries* 102)))))
2431           (is-ra0 (thing)
2432             (if (typep thing 'x86::x86-register-operand)
2433               (let* ((entry (x86::x86-register-operand-entry thing)))
2434                 (eq entry (if (x86-ds-mode-64 ds)
2435                             (x86::x86-reg64 10)
2436                             (x86::x86-reg32 7))))))
2437           (is-disp-only (thing)
2438             (and (typep thing 'x86::x86-memory-operand)
2439                  (null (x86::x86-memory-operand-base thing))
2440                  (null (x86::x86-memory-operand-index thing))
2441                  (x86::x86-memory-operand-disp thing)))
2442           (is-disp-and-base (thing)
2443             (and (typep thing 'x86::x86-memory-operand)
2444                  (x86::x86-memory-operand-base thing)
2445                  (null (x86::x86-memory-operand-index thing))
2446                  (x86::x86-memory-operand-disp thing))))
2447             
2448      (flet ((is-fn-ea (thing)
2449               (and (typep thing 'x86::x86-memory-operand)
2450                    (is-fn (x86::x86-memory-operand-base thing))
2451                    (null (x86::x86-memory-operand-index thing))
2452                    (let* ((scale (x86::x86-memory-operand-scale thing)))
2453                      (or (null scale) (eql 0 scale)))
2454                    (let* ((disp (x86::x86-memory-operand-disp thing)))
2455                      (and disp (early-x86-lap-expression-value disp)))))
2456             (is-jump-table-ref (thing)
2457               (and (typep thing 'x86::x86-memory-operand)
2458                    (is-fn (x86::x86-memory-operand-base thing))
2459                    (x86::x86-memory-operand-index thing)
2460                    (let* ((disp (x86::x86-memory-operand-disp thing)))
2461                      (and disp (early-x86-lap-expression-value disp)))))
2462             (is-ra0-ea (thing)
2463               (and (typep thing 'x86::x86-memory-operand)
2464                    (is-ra0 (x86::x86-memory-operand-base thing))
2465                    (null (x86::x86-memory-operand-index thing))
2466                    (let* ((scale (x86::x86-memory-operand-scale thing)))
2467                      (or (null scale) (eql 0 scale)))
2468                    (let* ((disp (x86::x86-memory-operand-disp thing)))
2469                      (and disp (early-x86-lap-expression-value disp)))))
2470             (is-rip-ea (thing)
2471               (and (typep thing 'x86::x86-memory-operand)
2472                    (is-rip (x86::x86-memory-operand-base thing))
2473                    (null (x86::x86-memory-operand-index thing))
2474                    (let* ((scale (x86::x86-memory-operand-scale thing)))
2475                      (or (null scale) (eql 0 scale)))
2476                    (let* ((disp (x86::x86-memory-operand-disp thing)))
2477                      (and disp (early-x86-lap-expression-value disp))))))
2478        (case flag
2479          ;; Should also check alignment here, and check
2480         
2481          ((:lea :single :double)
2482           (let* ((disp ))
2483             (if (or (and (setq disp (is-fn-ea op0)) (> disp 0))
2484                     (and (setq disp (is-ra0-ea op0)) (< disp 0) (is-fn op1)))
2485               (let* ((label-ea (+ entry-ea (abs disp))))
2486                 (when (< label-ea (x86-ds-code-limit ds))
2487                   (setf (x86::x86-memory-operand-disp op0)
2488                         (parse-x86-lap-expression
2489                          (if (< disp 0)
2490                            `(- (:^ ,label-ea))
2491                            `(:^ ,label-ea))))
2492                   (push label-ea  (x86-ds-pending-labels ds))
2493                   (when (or (eq flag :single) (eq flag :double))
2494                     (let* ((block (make-x86-dis-block :start-address label-ea
2495                                                       :end-address (+ label-ea (if (eq flag :single) 4 8))))
2496                            (instructions (x86-dis-block-instructions block))
2497                            (instruction (make-x86-disassembled-instruction
2498                                          :address label-ea
2499                                          :labeled t
2500                                          :mnemonic (if (eq flag :single)
2501                                                      ":long"
2502                                                      ":quad")
2503                                          :op0 (x86::make-x86-immediate-operand
2504                                                :value (if (eq flag :single)
2505                                                         (x86-ds-u32-ref ds disp)
2506                                                         (logior
2507                                                          (x86-ds-u32-ref ds disp)
2508                                                          (ash (x86-ds-u32-ref ds (+ disp 4))
2509                                                               32))))
2510                                          :start label-ea
2511                                          :end (+ label-ea (if (eq flag :single) 4 8)))))
2512                       (append-dll-node instruction instructions)
2513                       (insert-x86-block block (x86-ds-blocks ds))))))
2514                     
2515                   
2516               (when (and (setq disp (is-rip-ea op0)) (< disp 0) (is-fn op1))
2517                 (setf (x86-di-mnemonic instruction) "recover-fn-from-rip"
2518                       (x86-di-op0 instruction) nil
2519                         (x86-di-op0 instruction) nil)))))
2520          ((:jump :call)
2521           (let* ((disp (is-disp-only op0)))
2522             (cond ( disp
2523               (let* ((info (find (early-x86-lap-expression-value disp)
2524                                  (if (x86-ds-mode-64 ds)
2525                                    x8664::*x8664-subprims*
2526                                    x8632::*x8632-subprims*)
2527                                  :key #'subprimitive-info-offset)))
2528                 (when info (setf (x86::x86-memory-operand-disp op0)
2529                                  (subprimitive-info-name info)
2530                                 
2531                                  (x86-di-mnemonic instruction)
2532                                  (case flag
2533                                    (:jump (if (subprimitive-info-platform-info info) "lisp-jump" "jmp"))
2534                                    (:call "lisp-call ")
2535                                  )))))
2536 
2537               (t
2538                (if (eq flag :call)
2539                  (setf (x86-di-mnemonic instruction)
2540                        "lisp-call")
2541                 
2542                  )))))
2543          (t
2544           (Let* ((jtab (is-jump-table-ref op0)))
2545             (if (and jtab (> jtab 0))
2546               (let* ((count (x86-ds-u32-ref ds (- jtab 4)))
2547                      (block (make-x86-dis-block :start-address (+ jtab (x86-ds-entry-point ds))
2548                                                 :end-address (+ jtab (x86-ds-entry-point ds) (* 4 count))))
2549                      (instructions (x86-dis-block-instructions block))
2550                      (labeled t))
2551                 (setf (x86::x86-memory-operand-disp op0)
2552                       (parse-x86-lap-expression `(:^ ,(+ jtab (x86-ds-entry-point ds)))))
2553                 (dotimes (i count)
2554                   (let* ((target (+ (x86-ds-u32-ref ds jtab)
2555                                     (x86-ds-entry-point ds)))
2556                          (start (+ jtab (x86-ds-entry-point ds)))
2557                          (instruction (make-x86-disassembled-instruction
2558                                        :address start
2559                                        :labeled labeled
2560                                        :mnemonic ":long"
2561                                        :op0 (parse-x86-lap-expression `(:^ ,target))
2562                                        :start start
2563                                        :end (+ start 4))))
2564                     (append-dll-node instruction instructions)
2565                     (setq labeled nil)
2566                     (push target (x86-ds-pending-labels ds))
2567                     (incf jtab 4)))
2568                 (insert-x86-block block (x86-ds-blocks ds)))
2569               (unless (x86-ds-mode-64 ds)
2570                 (when (and (is-fn op1)
2571                            (typep op0 'x86::x86-immediate-operand)
2572                            ;; Not sure what else would have an
2573                            ;; immediate source and %fn as destination,
2574                            ;; but check for this.
2575                            (equal (x86-di-mnemonic instruction) "movl"))
2576                   (setf (x86-di-mnemonic instruction) "recover-fn"
2577                         (x86-di-op0 instruction) nil
2578                         (x86-di-op0 instruction) nil))))))
2579
2580          )))
2581    instruction))
2582
2583(defun x86-disassemble-instruction (ds labeled)
2584  (let* ((addr (x86-ds-code-pointer ds))
2585         (sizeflag (logior +aflag+ +dflag+
2586                           (if *x86-disassemble-always-print-suffix*
2587                             +suffix-always+
2588                             0)))
2589         (instruction (make-x86-disassembled-instruction :address addr
2590                                                         :labeled labeled))
2591         (stop nil))
2592    (setf (x86-ds-insn-start ds) addr
2593          (x86-ds-current-instruction ds) instruction)
2594    (scan-prefixes ds instruction)
2595    (setf (x86-ds-opcode-start ds) (x86-ds-code-pointer ds))
2596    (let* ((primary-opcode (x86-ds-next-u8 ds))
2597           (two-source-ops (or (= primary-opcode #x62)
2598                               (= primary-opcode #xc8)))
2599           (prefixes (x86-ds-prefixes ds))
2600           (need-modrm nil)
2601           (uses-sse-prefix nil)
2602           (uses-lock-prefix nil)
2603           (dp nil))
2604      (declare (type (unsigned-byte 8) primary-opcode)
2605               (fixnum prefixes))
2606      (if (= primary-opcode #x0f)       ;two-byte opcode
2607        (setq primary-opcode (x86-ds-next-u8 ds)
2608              dp (svref *disx86-twobyte* primary-opcode)
2609              need-modrm (eql 1 (sbit *twobyte-has-modrm* primary-opcode))
2610              uses-sse-prefix (eql 1 (sbit *twobyte-uses-sse-prefix* primary-opcode))
2611              uses-lock-prefix (= #x20 (logandc2 primary-opcode 2)))
2612        (setq dp (svref *disx86* primary-opcode)
2613              need-modrm (eql 1 (sbit *onebyte-has-modrm* primary-opcode))))
2614      (when (and (not uses-sse-prefix) 
2615                 (logtest prefixes +prefix-repz+))
2616        (push "repz" (x86-di-prefixes instruction))
2617        (setf (x86-ds-used-prefixes ds)
2618              (logior (x86-ds-used-prefixes ds) +prefix-repz+)))
2619      (when (and (not uses-sse-prefix) 
2620                 (logtest prefixes +prefix-repnz+))
2621        (push "repnz" (x86-di-prefixes instruction))
2622        (setf (x86-ds-used-prefixes ds)
2623              (logior (x86-ds-used-prefixes ds) +prefix-repnz+)))
2624      (when (and (not uses-lock-prefix)
2625                 (logtest prefixes +prefix-lock+))
2626        (push "lock" (x86-di-prefixes instruction))
2627        (setf (x86-ds-used-prefixes ds)
2628              (logior (x86-ds-used-prefixes ds) +prefix-lock+)))
2629      (when (logtest prefixes +prefix-addr+)
2630        (setq sizeflag (logxor sizeflag +aflag+))
2631        (unless (= (x86-dis-bytemode3 dp) +loop-jcxz-mode+)
2632          (if (or (x86-ds-mode-64 ds)
2633                  (logtest sizeflag +aflag+))
2634            (push "addr32" (x86-di-prefixes instruction))
2635            (push "addr16" (x86-di-prefixes instruction)))
2636          (setf (x86-ds-used-prefixes ds)
2637                (logior (x86-ds-used-prefixes ds) +prefix-addr+))))
2638      (when (and (not uses-sse-prefix)
2639                 (logtest prefixes +prefix-data+))
2640        (setq sizeflag (logxor sizeflag +dflag+))
2641        (when (and (= (x86-dis-bytemode3 dp) +cond-jump-mode+)
2642                   (= (x86-dis-bytemode1 dp) +v-mode+))
2643          (if (logtest sizeflag +dflag+)
2644            (push "data32" (x86-di-prefixes instruction))
2645            (push "data16" (x86-di-prefixes instruction)))
2646          (setf (x86-ds-used-prefixes ds)
2647                (logior (x86-ds-used-prefixes ds) +prefix-data+))))
2648      (when need-modrm
2649        (let* ((modrm-byte (x86-ds-peek-u8 ds)))
2650          (declare (type (unsigned-byte 8) modrm-byte))
2651          (setf (x86-ds-mod ds) (ldb (byte 2 6) modrm-byte)
2652                (x86-ds-reg ds) (ldb (byte 3 3) modrm-byte)
2653                (x86-ds-rm ds) (ldb (byte 3 0) modrm-byte))))
2654      (if (and (null (x86-dis-mnemonic dp))
2655               (eql (x86-dis-bytemode1 dp) +floatcode+))
2656        (x86-dis-do-float ds instruction primary-opcode sizeflag)
2657        (if (and (null (x86-dis-mnemonic dp))
2658                 (eql (x86-dis-bytemode1 dp) +uuocode+))
2659          (progn
2660            (setq stop
2661                  (x86-dis-do-uuo ds instruction (x86-ds-next-u8 ds))))
2662          (progn
2663            (when (null (x86-dis-mnemonic dp))
2664              (let* ((bytemode1 (x86-dis-bytemode1 dp)))
2665                (declare (fixnum bytemode1))
2666                (cond ((= bytemode1 +use-groups+)
2667                       (setq dp (svref (svref *grps* (x86-dis-bytemode2 dp))
2668                                       (x86-ds-reg ds))))
2669                      ((= bytemode1 +use-prefix-user-table+)
2670                       (let* ((index 0))
2671                         (used-prefix ds +prefix-repz+)
2672                         (if (logtest prefixes +prefix-repz+)
2673                           (setq index 1)
2674                           (progn
2675                             (used-prefix ds +prefix-data+)
2676                             (if (logtest prefixes +prefix-data+)
2677                               (setq index 2)
2678                               (progn
2679                                 (used-prefix ds +prefix-repnz+)
2680                                 (if (logtest prefixes +prefix-repnz+)
2681                                   (setq index 3))))))
2682                         (setq dp (svref (svref *prefix-user-table*
2683                                                (x86-dis-bytemode2 dp))
2684                                         index))))
2685                      ((= bytemode1 +x86-64-special+)
2686                       (setq dp (svref (svref *x86-64-table*
2687                                              (x86-dis-bytemode2 dp))
2688                                       (if (x86-ds-mode-64 ds) 1 0))))
2689                    (t (error "Disassembly error")))))
2690          (when (x86-putop ds (x86-dis-mnemonic dp) sizeflag instruction (x86-dis-flags dp))
2691            (let* ((operands ())
2692                   (op1 (x86-dis-op1 dp))
2693                   (op2 (x86-dis-op2 dp))
2694                   (op3 (x86-dis-op3 dp))
2695                   (operand nil))
2696              (when op1
2697                ;(format t "~& op1 = ~s" op1)
2698                (setq operand (funcall op1 ds (x86-dis-bytemode1 dp) sizeflag))
2699                (if operand
2700                  (push operand operands)))
2701              (when op2
2702                ;(format t "~& op2 = ~s" op2)
2703                (setq operand (funcall op2 ds (x86-dis-bytemode2 dp) sizeflag))
2704                (if operand
2705                  (push operand operands)))
2706              (when op3
2707                ;(format t "~& op3 = ~s" op3)
2708                (setq operand (funcall op3 ds (x86-dis-bytemode3 dp) sizeflag))
2709                (if operand
2710                  (push operand operands)))
2711              (if two-source-ops
2712                (setf (x86-di-op1 instruction) (pop operands)
2713                      (x86-di-op0 instruction) (pop operands))
2714                (setf (x86-di-op0 instruction) (pop operands)
2715                      (x86-di-op1 instruction) (pop operands)
2716                      (x86-di-op2 instruction) (pop operands))))))))
2717      (setf (x86-di-start instruction) (x86-ds-insn-start ds)
2718            (x86-di-end instruction) (x86-ds-code-pointer ds))
2719      (values (x86-dis-analyze-operands ds instruction (x86-dis-flags dp))
2720              (or stop (eq (x86-dis-flags dp) :jump))))))
2721
2722(defun x86-disassemble-new-block (ds addr &optional align)
2723  (setf (x86-ds-code-pointer ds) addr)
2724  (let* ((limit (do-dll-nodes (b (x86-ds-blocks ds) (x86-ds-code-limit ds))
2725                  (when (> (x86-dis-block-start-address b) addr)
2726                    (return (x86-dis-block-start-address b)))))
2727         (block (make-x86-dis-block  :start-address addr ))
2728         (instructions (x86-dis-block-instructions block))
2729         (labeled (not (eql addr (x86-ds-entry-point ds)))))
2730    (loop
2731      (multiple-value-bind (instruction stop)
2732          (x86-disassemble-instruction ds (or align labeled))
2733        (setq labeled nil align nil)
2734        (append-dll-node instruction instructions)
2735        (if stop (return))
2736        (if (>= (x86-ds-code-pointer ds) limit)
2737          (if (= (x86-ds-code-pointer ds) limit)
2738            (return)
2739            (error "Internal disassembly error")))))
2740    (setf (x86-dis-block-end-address block) (x86-ds-code-pointer ds))
2741    (insert-x86-block block (x86-ds-blocks ds))))
2742
2743(defmethod unparse-x86-lap-expression ((exp t)
2744                                       ds)
2745  (declare (ignore ds))
2746  exp)
2747
2748(defmethod unparse-x86-lap-expression ((exp constant-x86-lap-expression)
2749                                       ds)
2750  (declare (ignore ds))
2751  (constant-x86-lap-expression-value exp))
2752
2753(defmethod unparse-x86-lap-expression ((exp label-x86-lap-expression)
2754                                       ds)
2755  (let* ((label (label-x86-lap-expression-label exp))
2756         (name (x86-lap-label-name label))
2757         (entry (x86-ds-entry-point ds)))
2758    `(":^" , (if (typep name 'fixnum)
2759            (format nil "L~d" (- name entry))
2760            name))))
2761
2762(defmethod unparse-x86-lap-expression ((exp unary-x86-lap-expression)
2763                                       ds)
2764  `(,(unary-x86-lap-expression-operator exp)
2765    ,(unparse-x86-lap-expression (unary-x86-lap-expression-operand exp) ds)))
2766
2767(defmethod unparse-x86-lap-expression ((exp binary-x86-lap-expression)
2768                                       ds)
2769  `(,(binary-x86-lap-expression-operator exp)
2770    ,(unparse-x86-lap-expression (binary-x86-lap-expression-operand0 exp) ds)
2771    ,(unparse-x86-lap-expression (binary-x86-lap-expression-operand1 exp) ds)))
2772
2773(defmethod unparse-x86-lap-expression ((exp n-ary-x86-lap-expression)
2774                                       ds)
2775  `(,(n-ary-x86-lap-expression-operator exp)
2776    ,@(mapcar #'(lambda (x)
2777                  (unparse-x86-lap-expression x ds))
2778              (n-ary-x86-lap-expression-operands exp))))
2779
2780(defmethod unparse-x86-lap-operand ((op x86::x86-register-operand)
2781                                    ds)
2782  (let* ((r (x86::x86-register-operand-entry op))
2783         (symbolic-names (x86-ds-symbolic-names ds))
2784         (reg-name (x86::reg-entry-reg-name r))
2785         (name (or (if symbolic-names
2786                     (gethash reg-name symbolic-names))
2787                     reg-name)))
2788    `(% ,name)))
2789
2790(defmethod unparse-x86-lap-operand ((op x86::x86-immediate-operand)
2791                                    ds)
2792  `($ ,(unparse-x86-lap-expression (x86::x86-immediate-operand-value op)
2793                                   ds)))
2794
2795(defmethod unparse-x86-lap-operand ((op x86::x86-label-operand)
2796                                    ds)
2797  (let* ((addr (x86::x86-label-operand-label op))
2798         (entrypoint (x86-ds-entry-point ds)))
2799    (format nil "L~d" (- addr entrypoint))))
2800
2801(defmethod unparse-x86-lap-operand ((op label-x86-lap-expression)
2802                                    ds)
2803  (unparse-x86-lap-expression op ds))
2804
2805
2806(defmethod x86-lap-operand-constant-offset (op ds)
2807  (declare (ignore op ds))
2808  nil)
2809
2810(defmethod x86-lap-operand-constant-offset ((op x86::x86-memory-operand) ds)
2811  (let* ((disp (x86::x86-memory-operand-disp op)) 
2812         (base (x86::x86-memory-operand-base op))
2813         (index (x86::x86-memory-operand-index op))
2814         (scale (x86::x86-memory-operand-scale op))
2815         (code-limit (x86-ds-code-limit ds))
2816         (val (and base
2817                   (eq (x86::x86-register-operand-entry base)
2818                       (if (x86-ds-mode-64 ds)
2819                         (x86::x86-reg64 13)
2820                         (x86::x86-reg32 x8632::fn)))
2821                   (null index)
2822                   (or (eql scale 0) (null scale))
2823                   (typecase disp
2824                     (constant-x86-lap-expression
2825                      (+ (x86-ds-entry-point ds)
2826                         (constant-x86-lap-expression-value disp)))
2827                     (integer
2828                      (+ (x86-ds-entry-point ds) disp))
2829                     (t nil)))))
2830    (when (and code-limit val (>= val code-limit))
2831      (- val code-limit))))
2832
2833(defun x86-lap-operand-constant (op ds)
2834  (let ((diff (x86-lap-operand-constant-offset op ds)))
2835    (when diff
2836      (values (uvref (x86-ds-constants-vector ds)
2837                     (1+ (ash diff (if (x86-ds-mode-64 ds)
2838                                     (- x8664::word-shift)
2839                                     (- x8632::word-shift)))))
2840              t))))
2841
2842
2843(defmethod unparse-x86-lap-operand ((x x86::x86-memory-operand) ds)
2844  (multiple-value-bind (constant foundp) (x86-lap-operand-constant x ds)
2845    (if foundp
2846      `(@ ',constant ,(unparse-x86-lap-operand (x86::x86-memory-operand-base x) ds))
2847      (let* ((seg (x86::x86-memory-operand-seg x))
2848             (disp (x86::x86-memory-operand-disp x)) 
2849             (base (x86::x86-memory-operand-base x))
2850             (index (x86::x86-memory-operand-index x))
2851             (scale (x86::x86-memory-operand-scale x)))
2852        (collect ((subforms))
2853          (subforms '@)
2854          (if seg
2855            (subforms (unparse-x86-lap-operand seg ds)))
2856          (if disp
2857            (subforms (unparse-x86-lap-expression disp ds)))
2858          (if base
2859            (subforms (unparse-x86-lap-operand base ds)))
2860          (if index
2861            (subforms (unparse-x86-lap-operand index ds)))
2862          (if (and scale (not (eql scale 0)))
2863            (subforms (ash 1 scale)))
2864          (subforms))))))
2865   
2866(defmethod unparse-x86-lap-operand :around ((op x86::x86-operand)
2867                                            ds)
2868  (declare (ignore ds))
2869  (let* ((usual (call-next-method))
2870         (type (or (x86::x86-operand-type op) 0)))
2871    (if (logtest (x86::encode-operand-type :jumpabsolute) type)
2872      `(* ,usual)
2873      usual)))
2874
2875(defun write-x86-lap-operand (stream op ds)
2876  ;; Basically, have to princ because some parts are already stringified,
2877  ;; plus don't want package prefixes on assembler syntax.  But want to
2878  ;; prin1 immediates.
2879  (let ((expr (unparse-x86-lap-operand op ds)))
2880    (format stream " ")
2881    (labels ((out (stream expr)
2882               (cond ((atom expr)
2883                      (if (and (typep expr 'integer)
2884                               (> (abs expr) 100))
2885                        (format stream "#x~x" expr)
2886                        (format stream "~a" expr)))
2887                     ((quoted-form-p expr)
2888                      (format stream "'~s" (cadr expr)))
2889                     (t
2890                      (loop for item in expr as pre = "(" then " "
2891                        do (format stream pre)
2892                        do (out stream item))
2893                      (format stream ")")))))
2894      (out stream expr))))
2895
2896(defvar *previous-source-note*)
2897
2898(defun x86-print-di-lap (ds instruction tab-stop pc)
2899  (let ((comment-start-offset 40))
2900
2901    (unless (and (eq :nop (x86-di-flags instruction))
2902                 (not *x86-disassemble-print-nop*)
2903                 (not *disassemble-verbose*))
2904     
2905      (dolist (p (x86-di-prefixes instruction))
2906        (when tab-stop
2907          (format t "~vt" tab-stop))
2908        (format t "(~a)~%" p))
2909      (when tab-stop
2910        (format t "~vt" tab-stop))
2911      (format t "(~a" (x86-di-mnemonic instruction))
2912      (let* ((op0 (x86-di-op0 instruction))
2913             (op1 (x86-di-op1 instruction))
2914             (op2 (x86-di-op2 instruction))
2915             )
2916        (when op0
2917          (write-x86-lap-operand t op0 ds)
2918          (when op1
2919            (write-x86-lap-operand t op1 ds)
2920            (when op2
2921              (write-x86-lap-operand t op2 ds)))))
2922       (format t ")~vt;~8<[~D]~>" (+ comment-start-offset tab-stop) pc))
2923    (format t "~&")))
2924
2925(defun x86-print-di-raw (ds instruction tab-stop pc)
2926  (declare (ignore tab-stop))
2927  (let* ((op0 (x86-di-op0 instruction))
2928         (op1 (x86-di-op1 instruction))
2929         (op2 (x86-di-op2 instruction))
2930         (istart (x86-di-start instruction))
2931         (iend (x86-di-end instruction))
2932         (nbytes (- iend istart))
2933         (code-vector (x86-ds-code-vector ds))
2934         (byteidx istart))
2935    (format t "~5@d: " pc)
2936    (dotimes (i (min nbytes 4))
2937      (format t "~(~2,'0x~) " (aref code-vector byteidx))
2938      (incf byteidx))
2939    (format t "~20t(~a" (x86-di-mnemonic instruction))
2940    (when op0
2941      (write-x86-lap-operand t op0 ds)
2942      (when op1
2943        (write-x86-lap-operand t op1 ds)
2944        (when op2
2945          (write-x86-lap-operand t op2 ds))))
2946    (format t ")~&")
2947    (decf nbytes 4)
2948    (while (plusp nbytes)
2949      (dotimes (i (min nbytes 4))
2950        (format t "~7t~(~2,'0x~)" (aref code-vector byteidx))
2951        (incf byteidx))
2952      (format t "~%")
2953      (decf nbytes 4))))
2954
2955(defun x86-print-disassembled-instruction (ds instruction seq function)
2956  (let* ((addr (x86-di-address instruction))
2957         (labeled (x86-di-labeled instruction))
2958         (align (if (typep labeled 'fixnum) labeled))
2959         (entry (x86-ds-entry-point ds))
2960         (comment-start-offset 44)
2961         (pc (- addr entry)))
2962    (let ((source-note (find-source-note-at-pc function pc)))
2963      (unless (eql (source-note-file-range source-note)
2964                   (source-note-file-range *previous-source-note*))
2965        (setf *previous-source-note* source-note)
2966        (let* ((source-text (source-note-text source-note))
2967               (text (if source-text
2968                       (string-sans-most-whitespace source-text 100)
2969                       "#<no source text>")))
2970          (format t "~&~%;;; ~A" text))))
2971    (when labeled 
2972      (when (and align (> align 0))
2973          (format t "~&~%~vt(:align ~d)" (if *disassemble-verbose* 20 4) align))
2974      (format t "~&L~d ~vt;~8< [@~D]~>~%" pc comment-start-offset (+ pc  (if (x86-ds-mode-64 ds) x8664::fulltag-function x8632::fulltag-misc)))
2975      (setq seq 0))
2976    (format t "~&")
2977    (let ((tab-stop 4)
2978          (fn (if *disassemble-verbose*
2979                'x86-print-di-raw
2980                'x86-print-di-lap)))
2981      (funcall fn ds instruction tab-stop pc))
2982    (1+ seq)))
2983
2984(defun x86-print-disassembled-function-header (function xfunction)
2985  (declare (ignore xfunction))
2986  (let ((source-note (function-source-note function)))
2987    (when source-note
2988      (ensure-source-note-text source-note)
2989      (if (source-note-filename source-note)
2990        (format t ";; ~S:~D-~D"
2991                (source-note-filename source-note)
2992                (source-note-start-pos source-note)
2993                (source-note-end-pos source-note))
2994          (let* ((source-text (source-note-text source-note)))
2995            (when source-text
2996              (format t ";;; ~A" (string-sans-most-whitespace source-text 100))))))))
2997
2998;;; find blocks of code that are unreferenced but which may affect alignment of successors,
2999(defun x86-disassemble-find-alignment-blocks (ds)
3000  (declare (ignorable ds))
3001  #+later
3002  (let* ((blocks (x86-ds-blocks ds)))
3003    (do-dll-nodes (b blocks)
3004      (format t "~&~d ~d"(x86-dis-block-start-address b) (x86-dis-block-end-address b)))
3005   
3006    (break())))
3007
3008(defun x86-disassemble-xfunction (function xfunction
3009                                  &key (symbolic-names #+x8664-target target::*x8664-symbolic-register-names*
3010                                                       #+x8632-target target::*x8632-symbolic-register-names*)
3011                                       (collect-function #'x86-print-disassembled-instruction)
3012                                       (header-function #'x86-print-disassembled-function-header))
3013  (check-type xfunction xfunction)
3014  (check-type (uvref xfunction 0) (simple-array (unsigned-byte 8) (*)))
3015  (let* ((entry-point  #+x8664-target 7  #+x8632-target 2)
3016         (ds (make-x86-disassembly-state
3017              :mode-64 #+x8664-target t #+x8632-target nil
3018              :code-vector (uvref xfunction 0)
3019              :constants-vector xfunction
3020              :entry-point entry-point
3021              :code-pointer 0           ; for next-u32/next-u16 below
3022              :symbolic-names symbolic-names
3023              :pending-labels (list entry-point)))
3024         (blocks (x86-ds-blocks ds)))
3025    (setf (x86-ds-code-limit ds)
3026          #+x8664-target (ash (x86-ds-next-u32 ds) 3)
3027          #+x8632-target (ash (x86-ds-next-u16 ds) 2))
3028    (do* ()
3029         ((null (x86-ds-pending-labels ds)))
3030      (let* ((lab (pop (x86-ds-pending-labels ds)))
3031             (align nil))
3032        (when (consp lab)
3033          (setq align (cdr lab) lab (car lab))) 
3034        (or (let* ((i (x86-dis-find-label lab blocks)))
3035              (when (and i align) (setf (x86-di-labeled i) align))
3036              i)
3037            (x86-disassemble-new-block  ds lab align))))
3038    (when (and header-function
3039               blocks
3040               (let ((something-to-disassemble nil))
3041                 (do-dll-nodes (block blocks)
3042                   (do-dll-nodes (instruction (x86-dis-block-instructions block))
3043                     (setf something-to-disassemble t)))
3044                 something-to-disassemble))
3045      (funcall header-function function xfunction))
3046    (let* ((seq 0)
3047           (*previous-source-note* nil))
3048      (declare (special *previous-source-note*))
3049      (when *disassemble-verbose*
3050        (x86-disassemble-find-alignment-blocks ds))
3051      (do-dll-nodes (block blocks)
3052        (do-dll-nodes (instruction (x86-dis-block-instructions block))
3053          (setq seq (funcall collect-function ds instruction seq function)))))))
3054
3055(defun x86-xdisassemble (function
3056                         &optional (collect-function #'x86-print-disassembled-instruction)
3057                                   (header-function #'x86-print-disassembled-function-header))
3058  (let* ((fv (function-to-function-vector function))
3059         (function-size-in-words (uvsize fv))
3060         (code-words (%function-code-words function))
3061         (ncode-bytes (ash function-size-in-words target::word-shift))
3062         (code-bytes (make-array ncode-bytes
3063                                 :element-type '(unsigned-byte 8)))
3064         (numimms (- function-size-in-words code-words))
3065         (xfunction (%alloc-misc (the fixnum (1+ numimms)) target::subtag-xfunction)))
3066    (declare (fixnum code-words ncode-bytes numimms))
3067    (%copy-ivector-to-ivector fv 0 code-bytes 0 ncode-bytes)
3068    (setf (uvref xfunction 0) code-bytes)
3069    (do* ((k code-words (1+ k))
3070          (j 1 (1+ j)))
3071         ((= k function-size-in-words)
3072          (x86-disassemble-xfunction function xfunction
3073                                     :collect-function collect-function
3074                                     :header-function header-function))
3075      (declare (fixnum j k))
3076      (setf (uvref xfunction j) (uvref fv k)))))
3077
3078(defun disassemble-list (function)
3079  (collect ((instructions))
3080    (x86-xdisassemble
3081     function
3082     #'(lambda (ds instruction seq function)
3083         (declare (ignore function))
3084         (collect ((insn))
3085           (let* ((addr (x86-di-address instruction))
3086                  (entry (x86-ds-entry-point ds))
3087                  (rpc (- addr entry)))
3088             (if (x86-di-labeled instruction)
3089               (progn
3090                 (insn `(label ,rpc))
3091                 (setq seq 0))
3092               (insn rpc))
3093             (dolist (p (x86-di-prefixes instruction))
3094               (insn p))
3095             (insn (x86-di-mnemonic instruction))
3096             (let* ((op0 (x86-di-op0 instruction))
3097                    (op1 (x86-di-op1 instruction))
3098                    (op2 (x86-di-op2 instruction)))
3099               (when op0
3100                 (insn (unparse-x86-lap-operand op0 ds))
3101                 (when op1
3102                   (insn (unparse-x86-lap-operand op1 ds))
3103                   (when op2
3104                     (insn (unparse-x86-lap-operand op2 ds))  ))))
3105             (instructions (insn))
3106             (1+ seq))))
3107     nil)
3108    (instructions)))
3109
3110(defun x86-disassembled-instruction-line (ds instruction function &optional string-stream)
3111  (if (null string-stream)
3112    (with-output-to-string (stream)
3113      (return-from x86-disassembled-instruction-line
3114                   (x86-disassembled-instruction-line ds instruction function stream)))
3115    (let* ((addr (x86-di-address instruction))
3116           (entry (x86-ds-entry-point ds))
3117           (pc (- addr entry))
3118           (op0 (x86-di-op0 instruction))
3119           (op1 (x86-di-op1 instruction))
3120           (op2 (x86-di-op2 instruction))
3121           (label (if (x86-di-labeled instruction) (list :label pc) pc))
3122           (instr (progn
3123                    (dolist (p (x86-di-prefixes instruction))
3124                      (format string-stream "(~a) " p))
3125                    (format string-stream "(~a" (x86-di-mnemonic instruction))
3126                    (when op0 (write-x86-lap-operand string-stream op0 ds))
3127                    (when op1 (write-x86-lap-operand string-stream op1 ds))
3128                    (when op2 (write-x86-lap-operand string-stream op2 ds))
3129                    (format string-stream ")")
3130                    (get-output-stream-string string-stream)))
3131           (comment (let ((source-note (find-source-note-at-pc function pc)))
3132                      (unless (eql (source-note-file-range source-note)
3133                                   (source-note-file-range *previous-source-note*))
3134                        (setf *previous-source-note* source-note)
3135                        (let* ((source-text (source-note-text source-note))
3136                               (text (if source-text
3137                                       (string-sans-most-whitespace source-text 100)
3138                                       "#<no source text>")))
3139                          (format string-stream ";;; ~A" text)
3140                          (get-output-stream-string string-stream)))))
3141           (imms (let ((imms nil))
3142                   (multiple-value-bind (imm foundp) (x86-lap-operand-constant op2 ds)
3143                     (when foundp (push imm imms)))
3144                   (multiple-value-bind (imm foundp) (x86-lap-operand-constant op1 ds)
3145                     (when foundp (push imm imms)))
3146                   (multiple-value-bind (imm foundp) (x86-lap-operand-constant op0 ds)
3147                     (when foundp (push imm imms)))
3148                   imms)))
3149      ;; Subtle difference between no imms and a single NIL imm, so if anybody ever
3150      ;; cares for some reason, they could distinguish the two cases.
3151      (if imms
3152        (values comment label instr (if (cdr imms) (coerce imms 'vector) (car imms)))
3153        (values comment label instr)))))
3154
3155(defun disassemble-lines (function)
3156  (let ((source-note (function-source-note function)))
3157    (when source-note
3158      ;; Fetch source from file if don't already have it.
3159      (ensure-source-note-text source-note)))
3160  (let ((lines (make-array 20 :adjustable t :fill-pointer 0)))
3161    (with-output-to-string (stream)
3162      (x86-xdisassemble
3163       function
3164       #'(lambda (ds instruction seq function)
3165           (declare (ignore seq))
3166           (multiple-value-bind (comment label instr object)
3167                                (x86-disassembled-instruction-line ds instruction function stream)
3168             (when comment
3169               (vector-push-extend comment lines))
3170             (vector-push-extend (list object label instr) lines)))
3171       nil))
3172    (coerce lines 'simple-vector)))
3173
3174(defun disassemble-to-file (function path)
3175  (let* ((name (if (typep function 'symbol) function (function-name function)))
3176         (*disassemble-verbose* nil)
3177         (*x86-disassemble-print-nop* nil)
3178         (header (if name (format nil "(~s ~s ()" (target-arch-case (:x8664 'defx86lapfunction)(:x8632 'defx86lapfunction))name) (error "Not yet: anonymous function"))))
3179    (with-open-file (*standard-output* path :direction :output :if-exists :supersede) 
3180      (write-line header)
3181      (disassemble function)
3182      (write-line ")"))
3183    path))
3184
3185
3186
3187
3188
3189
3190
3191(export  '(disassemble-to-file  *x86-disassemble-print-nop*))
3192
3193(provide "X86-DISASSEMBLE")
Note: See TracBrowser for help on using the repository browser.