Changeset 13013

Timestamp:

Oct 13, 2009, 8:56:56 PM (15 years ago)

Author:

R. Matthew Emerson

Message:

New functions x86-memory-operand-ea, x86-emulate-instruction, and
x86-can-emulate-instruction.

File:

• trunk/source/lib/misc.lisp (modified) (1 diff)

trunk/source/lib/misc.lisp

@@ -1085 +1085 @@
                 area-watched area-watched)))
       
+;;; Return the effective address of a memory operand by using the
+;;; register state in xp, or NIL if we can't figure it out.
+;;; Needs to run inside a without-gcing form.
+(defun x86-memory-operand-ea (xp op)
+  (let* ((seg (x86::x86-memory-operand-seg op))
+         (disp (x86::x86-memory-operand-disp op))
+         (base (x86::x86-memory-operand-base op))
+         (index (x86::x86-memory-operand-index op))
+         (scale (x86::x86-memory-operand-scale op)))
+    (cond
+      ((and base index (not seg))
+       (let* ((base-re (x86::x86-register-operand-entry base))
+              (index-re (x86::x86-register-operand-entry index))
+              (base-num (x86::reg-entry-reg-num base-re))
+              (index-num (x86::reg-entry-reg-num index-re))
+              (base-val nil)
+              (index-val nil))
+         (when (logtest (x86::reg-entry-reg-flags base-re) x86::+regrex+)
+           (incf base-num 8))
+         (setq base-val (encoded-gpr-integer xp base-num))
+         (when (logtest (x86::reg-entry-reg-flags index-re) x86::+regrex+)
+           (incf index-num 8))
+         (setq index-val (encoded-gpr-integer xp index-num))
+         (when scale
+           (setq index-val (ash index-val scale)))
+         (+ (or disp 0) base-val index-val))))))
+
+;;; Try to emulate the disassembled instruction using the
+;;; register state in xp.  Return NIL if we couldn't do it.
+;;; This will run with other threads suspended.
+(defun x86-emulate-instruction (xp instruction)
+  (let* ((mnemonic (x86-di-mnemonic instruction))
+         (op0 (x86-di-op0 instruction))
+         (op1 (x86-di-op1 instruction))
+         (op2 (x86-di-op2 instruction)))
+    (when (and op0 op1 (not op2)
+               (typep op0 'x86::x86-register-operand)
+               (typep op1 'x86::x86-memory-operand))
+      (without-gcing
+        (let* ((src-re (x86::x86-register-operand-entry op0))
+               (src-num (x86::reg-entry-reg-num src-re))
+               (src-val nil)
+               (ea (x86-memory-operand-ea xp op1)))
+          (when (logtest (x86::reg-entry-reg-flags src-re) x86::+regrex+)
+            (incf src-num 8))
+          (setq src-val (encoded-gpr-integer xp src-num))
+          (when ea
+            (with-macptrs ((p (%int-to-ptr ea)))
+              (cond
+                ((string= mnemonic "movb")
+                 (setf (%get-signed-byte p) (ldb (byte 8 0) src-val)))
+                ((string= mnemonic "movw")
+                 (setf (%get-signed-word p) (ldb (byte 16 0) src-val)))
+                ((string= mnemonic "movl")
+                 (setf (%get-signed-long p) (ldb (byte 32 0) src-val)))
+                ((string= mnemonic "movq")
+                 (setf (%%get-signed-longlong p 0) (ldb (byte 64 0) src-val)))))))))))
+
+(defun x86-can-emulate-instruction (instruction)
+  (let* ((mnemonic (x86-di-mnemonic instruction))
+         (op0 (x86-di-op0 instruction))
+         (op1 (x86-di-op1 instruction))
+         (op2 (x86-di-op2 instruction)))
+    (when (and op0 op1 (not op2)
+               (typep op0 'x86::x86-register-operand)
+               (typep op1 'x86::x86-memory-operand)
+               (member mnemonic '("movb" "movw" "movl" "movq") :test 'string=))
+      (let* ((seg (x86::x86-memory-operand-seg op1))
+             (base (x86::x86-memory-operand-base op1))
+             (index (x86::x86-memory-operand-index op1)))
+        (and base index (not seg))))))