4 ;; Lisp assembler syntax
6 ;; (MOV :EAX #0XFF) ;; immediate
7 ;; (MOV :EAX :EBX) ;; register
8 ;; (MOV :EAX (:dword #X0FFF)) ;; direct
9 ;; (MOX :EAX (:dword (+ :ES #X0FFF))) ;; direct based
10 ;; (MOV :EAX (:dword (+ :ES (+ :EBX (* 2 :ESI) #0XFF))) ;; indirect based scaled index offset
18 ;; ((= rm 5) (displacement 4))
20 ;; (let ((index (decode-register (extract-index sib)))
22 ;; (t (displacement 0)))))
28 ;; (register (decode-register r/m))))
29 ;; ((= r/m 4) ;; sib is present
31 ;; ((base-reigster (decode-register (extract-base sib)))
33 ;; (if (not (= (extract-index sib) 4))
34 ;; (decode-register (extract-index sib))))
35 ;; (scale (nth '(1 2 4 8) (extract-scale sib)))))))
37 (in-package :cl-x86-asm
)
39 ;;; ------- opcode and address decoding related things -----------------------------
41 (defparameter *operand-sizes
* '(:dword
:word
:byte
))
43 (defparameter *opcode-encodings
* '(:|rw
/rd|
:|rb|
:|ow
/od|
:OF
:/2 :|
+cc|
44 :/7 :/3 :/1 :/4 :/5 :/0 :|
+r|
:/6 :|ib|
45 :|iw|
:|o16|
:|id|
:|o32|
:|
/r|
))
47 (defparameter *operand-types
* '(:|mm
/mem64|
:|xmm
/mem128|
48 :|xmm
/mem64|
:|xmm
/mem32|
49 :|xmm2
/mem64|
:|mem80|
:|mem16|
50 :|fpureg|
:ST0
:|memory|
51 :|imm
:imm16|
:|imm
:imm32|
54 :|memoffs16|
:|memoffs32|
55 :CR0
/2/3/4 :DR0
/1/2/3/6/7
56 :TR3
/4/5/6/7 :|xmm1
/m128|
57 :|m128|
:|mm2|
:|mm1
/m64|
58 :|xmm2
/m64|
:|xmm1
/m64|
59 :|xmm2
/m32|
:|xmm1
/m32|
60 :|xmm2|
:|xmm1
/mem128|
61 :|xmm2
/mem128|
:|xmm2
/mem32|
63 :|r16
/r32
/m16|
:|m64|
:|mem64|
68 :|mm2
/m64|
:|mm1|
:|mem|
69 :|
1|
:CL
:|m32|
:|segreg|
71 :|reg16|
:|reg32|
:|r
/m8|
73 :|imm8|
:AL
:|imm16|
:AX
75 :|xmm2
/m128|
:|xmm1|
:|none|
))
77 (defconstant +LOCK-PREFIX
+ #XF0
)
78 (defconstant +REPNE
/REPNZ-PREFIX
+ #XF2
)
79 (defconstant +REP-PREFIX
+ #XF3
)
80 (defconstant +REPE
/REPZ-PREFIX
#XF3
)
82 (defconstant +CS-SEGMENT-OVERRIDE-PREFIX
+ #X2E
)
83 (defconstant +SS-SEGMENT-OVERRIDE-PREFIX
#X36
)
84 (defconstant +DS-SEGMENT-OVERRIDE-PREFIX
#X3E
)
85 (defconstant +ES-SEGMENT-OVERRIDE-PREFIX
#X26
)
86 (defconstant +FS-SEGMENT-OVERRIDE-PREFIX
#X64
)
87 (defconstant +GS-SEGMENT-OVERRIDE-PREFIX
#X65
)
89 (defconstant +OPERAND-SIZE-OVERRIDE-PREFIX
+ #X66
)
90 (defconstant +ADDRESS-SIZE-OVERRIDE-PREFIX
+ #X67
)
92 (defparameter *registers-32
* (list :eax
:ecx
:edx
:ebx
:esp
:ebp
:esi
:edi
))
93 (defparameter *registers-16
* (list :ax
:cx
:dx
:bx
:sp
:bi
:si
:di
))
94 (defparameter *registers-8
* (list :al
:cl
:dl
:bl
:ah
:ch
:dh
:bh
))
95 (defparameter *registers-mmx
* (list :mm0
:mm1
:mm2
:mm3
:mm4
:mm5
:mm6
:mm7
))
96 (defparameter *registers-xmm
* (list :xmm0
:xmm1
:xmm2
:xmm3
:xmm4
:xmm5
:xmm6
:xmm7
))
98 (defparameter *registers-segment
*
99 (list :es
:cs
:ss
:ds
:fs
:gs
))
101 (defparameter *registers-fp
*
102 (list :st0
:st1
:st2
:st3
:st4
:st5
:st6
:st7
))
104 (defparameter *registers-control
*
105 (list :cr0
:invalid
:cr2
:cr3
:cr4
))
107 (defparameter *registers-debug
*
108 (list :dr0
:dr1
:dr2
:dr3
:invalid
:invalid
:dr6
:dr7
))
110 (defparameter *registers-test
*
111 (list :invalid
:invalid
:invalid
:tr3
:tr4
:tr5
:tr6
:tr7
))
115 (defun byte-p (x) (and (numberp x
)
120 (defun word-p (x) (and (numberp x
)
124 ;; 4 bytes (32 bit) == 1 float
125 (defun dword-p (x) (and (numberp x
)
129 ;; 8 bytes (64 bit) == 2 floats
130 (defun qword-p (x) (and (numberp x
)
131 (>= x
#X-7FFFFFFFFFFFFFFF
)
132 (< x
#X10000000000000000
)))
134 ;; 16 bytes (128 bit) == 4 floats
135 (defun oword-p (x) (and (numberp x
)
136 (>= x
#X-7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
)
137 (< x
#X100000000000000000000000000000000
)))
139 (defun byte-register (x) (position x
*registers-8
*))
141 (defun word-register (x) (position x
*registers-16
*))
143 (defun fpu-register (x) (position x
*registers-fp
*))
145 (defun mmx-register (x) (position x
*registers-mmx
*))
147 (defun xmm-register (x) (position x
*registers-xmm
*))
149 (defun dword-register (x) (position x
*registers-32
*))
151 (defun segment-register (x) (position x
*registers-segment
*))
153 (defun control-register (x) (position x
*registers-control
*))
155 (defun debug-register (x) (position x
*registers-debug
*))
157 (defun test-register (x) (position x
*registers-test
*))
160 (defparameter *operand-type-checkers
*
163 (list (function (lambda (opcode)
164 (eq :|mm
/mem64| opcode
)))))
166 (list (function (lambda (opcode)
167 (eq :|xmm
/mem128| opcode
)))))
169 (list (function (lambda (opcode)
170 (eq :|xmm
/mem64| opcode
)))))
172 (list (function (lambda (opcode)
173 (eq :|xmm
/mem32| opcode
)))))
175 (list (function (lambda (opcode)
176 (eq :|xmm2
/mem64| opcode
)))))
179 (lambda (opcode) (eq :|mem80| opcode
)))))
182 (lambda (opcode) (eq :|mem16| opcode
)))))
185 (lambda (opcode) (fpu-register opcode
)))))
188 (lambda (opcode) (eq :ST0 opcode
)))))
191 (lambda (opcode) (eq :|memory| opcode
)))))
194 (lambda (opcode) (eq :|imm
:imm16| opcode
)))))
197 (lambda (opcode) (eq :|imm
:imm32| opcode
)))))
200 (lambda (opcode) (eq :|mem32| opcode
)))))
203 (lambda (opcode) (eq :CX opcode
)))))
206 (lambda (opcode) (eq :ECX opcode
)))))
209 (lambda (opcode) (numberp opcode
)))))
212 (lambda (opcode) (eq :|memoffs8| opcode
)))))
215 (lambda (opcode) (eq :|memoffs16| opcode
)))))
218 (lambda (opcode) (eq :|memoffs32| opcode
)))))
221 (lambda (opcode) (control-register opcode
)))))
224 (lambda (opcode) (debug-register opcode
)))))
227 (lambda (opcode) (test-register opcode
)))))
230 (lambda (opcode) (eq :|xmm1
/m128| opcode
)))))
233 (lambda (opcode) (eq :|m128| opcode
)))))
237 (lambda (opcode) (eq :|mm2| opcode
)))))
241 (lambda (opcode) (eq :|mm1
/m64| opcode
)))))
245 (lambda (opcode) (eq :|xmm2
/m64| opcode
)))))
249 (lambda (opcode) (eq :|xmm1
/m64| opcode
)))))
253 (lambda (opcode) (eq :|xmm2
/m32| opcode
)))))
257 (lambda (opcode) (eq :|xmm1
/m32| opcode
)))))
261 (lambda (opcode) (eq :|xmm2| opcode
)))))
265 (lambda (opcode) (eq :|xmm1
/mem128| opcode
)))))
269 (lambda (opcode) (eq :|xmm2
/mem128| opcode
)))))
273 (lambda (opcode) (eq :|xmm2
/mem32| opcode
)))))
277 (lambda (opcode) (eq :DX opcode
)))))
281 (lambda (opcode) (eq :|r
/m64| opcode
)))))
284 (function (lambda (opcode) (eq :|r16
/r32
/m16| opcode
)))))
286 (list (function (lambda (opcode) (eq :|m64| opcode
)))))
288 (list (function (lambda (opcode) (eq :|mem64| opcode
)))))
290 (list (function (lambda (opcode) (mmx-register opcode
)))))
292 (list (function (lambda (opcode) (eq :|mem8| opcode
)))))
294 (list (function (lambda (opcode) (eq :|m8| opcode
)))))
296 (list (function (lambda (opcode) (eq :|mm| opcode
)))))
298 (list (function (lambda (opcode) (eq :|xmm| opcode
)))))
302 (lambda (opcode) (eq :|mm2
/m32| opcode
)))))
306 (lambda (opcode) (eq :CS opcode
)))))
310 (lambda (opcode) (eq :DS opcode
)))))
314 (lambda (opcode) (eq :ES opcode
)))))
318 (lambda (opcode) (eq :SS opcode
)))))
322 (lambda (opcode) (eq :FS opcode
)))))
326 (lambda (opcode) (eq :GS opcode
)))))
330 (lambda (opcode) (eq :|mm2
/m64| opcode
)))))
334 (lambda (opcode) (eq :|mm1| opcode
)))))
338 (lambda (opcode) (eq :|mem| opcode
)))))
342 (lambda (opcode) (eq :|
1| opcode
)))))
346 (lambda (opcode) (eq :CL opcode
)))))
350 (lambda (opcode) (eq :|m32| opcode
)))))
354 (lambda (opcode) (segment-register opcode
)))))
358 (lambda (opcode) (eq :|m80| opcode
)))))
362 (lambda (opcode) (byte-register opcode
)))))
366 (lambda (opcode) (word-register opcode
)))))
370 (lambda (opcode) (dword-register opcode
)))))
376 (byte-register opcode
)
378 (= (length opcode
) 1)
379 (byte-register (first opcode
)))
381 (eq (first opcode
) :byte
)))))))
386 (or (word-register opcode
)
388 (= (length opcode
) 1)
389 (dword-register (first opcode
)))
391 (eq (first opcode
) :word
)))))))
396 (or (dword-register opcode
)
398 (= (length opcode
) 1)
399 (dword-register (first opcode
)))
401 (eq (first opcode
) :dword
)))))))
405 (lambda (opcode) (byte-p opcode
)))))
409 (lambda (opcode) (eq :AL opcode
)))))
413 (lambda (opcode) (word-p opcode
)))))
417 (lambda (opcode) (eq :AX opcode
)))))
421 (lambda (opcode) (dword-p opcode
)))))
424 (function (lambda (opcode) (eq :EAX opcode
)))))
428 (lambda (opcode) (eq :|xmm2
/m128| opcode
)))))
432 (lambda (opcode) (eq :|xmm1| opcode
)))))
436 (lambda (opcode) (eq nil opcode
)))))))
439 ;; our test effective address
440 (defparameter *test-ea
*
441 '(:dword
:ES
(+ :EBX
(* 2 :ESI
) #XFF
) #XFFFF
))
444 (defun find-size (effective-address)
445 "(find-size ea) Identify the size of the thing addressed
448 for element in effective-address
449 thereis
(and (not (listp element
) )
450 (first (member element
*operand-sizes
*)))))
454 (defun find-segreg (effective-address)
455 "(find-segreg ea) Given an effective address, find
456 the segment register used to offset it"
458 for element in effective-address
459 thereis
(and (not (listp element
))
461 (member element
*registers-segment
*)))))
464 ;; TO DO -- this needs to handle symbols
466 (defun find-numeric (effective-address)
467 "(find-numeric ea) Given an effective adress component
468 find the numeric portion of it"
470 for element in effective-address
475 (defun find-base-list (effective-address)
476 "(find-base-list ea) Given an effective address find
477 the portion with the base register offset"
479 for element in effective-address
480 thereis
(and (listp element
)
481 (eq (first element
) '+)
486 (defun find-index-list (effective-address)
487 "(find-index-list ea) - given an effective address,
488 find the list which contains the indexing portion"
489 (flet ((find-index-list-aux (candidate-list)
491 for element in candidate-list
492 thereis
(or (and (listp element
)
493 (eq (first element
) '*)
495 (or (find-index-list-aux effective-address
)
497 (find-base-list effective-address
)))))
501 (defun find-reg (base-list)
502 "(find-reg base-list) - given a component of an
503 effective address, find the register within it"
505 for element in base-list
506 thereis
(and (not (listp element
))
507 (first (member element
508 (append *registers-32
*
514 (defmacro with-effective-address
(symbols ea
&body forms
)
515 "(with-effective-address ((size-sym segment-register-sym
522 Pick apart an effective address of the form
523 (:dword :ES (+ :EBX (* 2 :ESI) #0XFF))
524 and assign components to the correct symbols in the body"
525 (let ((ea-sym (gensym)))
527 (size-sym segreg-sym basereg-sym
528 scale-sym indexreg-sym
529 displacement-sym immediate-sym
)
531 `(declare (ignorable ,size-sym
,segreg-sym
,basereg-sym
532 ,scale-sym
,indexreg-sym
533 ,displacement-sym
,immediate-sym
))
534 `(let ((,ea-sym
,ea
))
535 (assert (listp ,ea-sym
))
537 ((,size-sym
(find-size ,ea-sym
))
538 (,segreg-sym
(find-segreg ,ea-sym
))
539 (,immediate-sym
(find-numeric ,ea-sym
))
540 (,basereg-sym
(find-reg (find-base-list ,ea-sym
)))
541 (,displacement-sym
(find-numeric (find-base-list ,ea-sym
)))
542 (,indexreg-sym
(find-reg (find-index-list ,ea-sym
)))
543 (,scale-sym
(find-numeric (find-index-list ,ea-sym
))))
549 ;;(with-effective-address (size seg-reg base-reg scale index-reg displacement immediate) *test-ea*
550 ;; (format *debug-io* "Size ~A seg-reg ~A base-reg ~A scale ~A index-reg ~A displacement ~A immediate ~A "
551 ;; size seg-reg base-reg scale index-reg displacement immediate))