Changeset 12906

Timestamp:

Oct 4, 2009, 6:41:08 PM (15 years ago)

Author:

R. Matthew Emerson

Message:

New function X86-EMULATE-WRITE-INSTRUCTION and a couple of helpers.

File:

• branches/watchpoints/lib/misc.lisp (modified) (1 diff)

branches/watchpoints/lib/misc.lisp

@@ -1065 +1065 @@
                       (return-from unwatch (%unwatch thing new)))))
               area-watched area-watched))
+
+;;; These functions would seem to belong somewhere else.
       
+;; This will work only if the uvector is in a static gc area.
+(defun %uvector-index-for-address (uvector address)
+  (let* ((size (uvsize uvector))
+         (nbytes (if (ivectorp uvector)
+                   (subtag-bytes (typecode uvector) size)
+                   (* size target::node-size)))
+         (bytes-per-element (/ nbytes size))
+         (noderef (logandc2 (%address-of uvector)
+                            target::fulltagmask))
+         (offset (- address (+ noderef target::node-size)))
+         (index (/ offset bytes-per-element)))
+    index))
+
+(defun x86-imm-reg-p (reg-num)
+  (member reg-num (list x8664::imm0 x8664::imm1 x8664::imm2
+                        x8664::imm0.l x8664::imm0.l x8664::imm2.l
+                        x8664::imm0.w x8664::imm0.w x8664::imm2.w
+                        x8664::imm0.b x8664::imm0.b x8664::imm2.b)))
+
+;;; Try to emulate the instruction.  Returns true on success,
+;;; NIL on failure.  If dest isn't in a static area, we will lose...
+(defun x86-emulate-write-instruction (xp insn addr dest)
+  (let ((op0 (x86-di-op0 insn)))
+    (unless (and (typep op0 'x86::x86-register-operand)
+                 (string= (subseq (x86-di-mnemonic insn) 0 3) "mov"))
+      (return-from x86-emulate-write-instruction nil))
+    (let* ((reg-entry (x86::x86-register-operand-entry op0))
+           (reg-num (x86::reg-entry-reg-num reg-entry)))
+      (if (uvectorp dest)
+        (cond ((gvectorp dest)
+               (let* ((src (encoded-gpr-lisp xp reg-num))
+                      (index (%uvector-index-for-address dest addr)))
+                 (if (fixnump index)
+                   (setf (uvref dest index) src))))
+              ((ivectorp dest)
+               (let* ((src (if (x86-imm-reg-p reg-num)
+                             (encoded-gpr-integer xp reg-num)
+                             (encoded-gpr-lisp xp reg-num)))
+                      (index (%uvector-index-for-address dest addr)))
+                 (if (fixnump index)
+                   (setf (uvref dest index) src))
+               (setq src (encoded-gpr-lisp xp reg-num)))))
+        (if (consp dest)
+          (let* ((src (encoded-gpr-lisp xp reg-num)))
+            (if (= addr (+ (%address-of dest) target::cons.cdr))
+              (rplacd dest src)
+              (if (= addr (+ (%address-of dest) target::cons.car))
+                (rplaca dest src)))))))))