source: branches/qres/ccl/lib/x86-watch.lisp @ 14308

Last change on this file since 14308 was 13070, checked in by gz, 10 years ago

r13066, r13067 from trunk: copyrights etc

File size: 3.5 KB
Line 
1;;; Copyright 2009 Clozure Associates
2;;; This file is part of Clozure CL. 
3;;;
4;;; Clozure CL is licensed under the terms of the Lisp Lesser GNU
5;;; Public License , known as the LLGPL and distributed with Clozure
6;;; CL as the file "LICENSE".  The LLGPL consists of a preamble and
7;;; the LGPL, which is distributed with Clozure CL as the file "LGPL".
8;;; Where these conflict, the preamble takes precedence.
9;;;
10;;; Clozure CL is referenced in the preamble as the "LIBRARY."
11;;;
12;;; The LLGPL is also available online at
13;;; http://opensource.franz.com/preamble.html
14
15(in-package "CCL")
16
17;;; Return the effective address of a memory operand by using the
18;;; register state in xp, or NIL if we can't figure it out.
19;;; Needs to run inside a without-gcing form.
20(defun x86-memory-operand-ea (xp op)
21  (let* ((seg (x86::x86-memory-operand-seg op))
22         (disp (x86::x86-memory-operand-disp op))
23         (base (x86::x86-memory-operand-base op))
24         (index (x86::x86-memory-operand-index op))
25         (scale (x86::x86-memory-operand-scale op)))
26    (cond
27      ((and base index (not seg))
28       (let* ((base-re (x86::x86-register-operand-entry base))
29              (index-re (x86::x86-register-operand-entry index))
30              (base-num (x86::reg-entry-reg-num base-re))
31              (index-num (x86::reg-entry-reg-num index-re))
32              (base-val nil)
33              (index-val nil))
34         (when (logtest (x86::reg-entry-reg-flags base-re) x86::+regrex+)
35           (incf base-num 8))
36         (setq base-val (encoded-gpr-integer xp base-num))
37         (when (logtest (x86::reg-entry-reg-flags index-re) x86::+regrex+)
38           (incf index-num 8))
39         (setq index-val (encoded-gpr-integer xp index-num))
40         (when scale
41           (setq index-val (ash index-val scale)))
42         (+ (or disp 0) base-val index-val))))))
43
44;;; Try to emulate the disassembled instruction using the
45;;; register state in xp.  Return NIL if we couldn't do it.
46;;; This will run with other threads suspended.
47(defun x86-emulate-instruction (xp instruction)
48  (let* ((mnemonic (x86-di-mnemonic instruction))
49         (op0 (x86-di-op0 instruction))
50         (op1 (x86-di-op1 instruction))
51         (op2 (x86-di-op2 instruction)))
52    (when (and op0 op1 (not op2)
53               (typep op0 'x86::x86-register-operand)
54               (typep op1 'x86::x86-memory-operand))
55      (without-gcing
56        (let* ((src-re (x86::x86-register-operand-entry op0))
57               (src-num (x86::reg-entry-reg-num src-re))
58               (src-val nil)
59               (ea (x86-memory-operand-ea xp op1)))
60          (when (logtest (x86::reg-entry-reg-flags src-re) x86::+regrex+)
61            (incf src-num 8))
62          (setq src-val (encoded-gpr-integer xp src-num))
63          (when ea
64            (with-macptrs ((p (%int-to-ptr ea)))
65              (cond
66                ((string= mnemonic "movb")
67                 (setf (%get-signed-byte p) (ldb (byte 8 0) src-val)))
68                ((string= mnemonic "movw")
69                 (setf (%get-signed-word p) (ldb (byte 16 0) src-val)))
70                ((string= mnemonic "movl")
71                 (setf (%get-signed-long p) (ldb (byte 32 0) src-val)))
72                ((string= mnemonic "movq")
73                 (setf (%%get-signed-longlong p 0) (ldb (byte 64 0) src-val)))))))))))
74
75(defun x86-can-emulate-instruction (instruction)
76  (let* ((mnemonic (x86-di-mnemonic instruction))
77         (op0 (x86-di-op0 instruction))
78         (op1 (x86-di-op1 instruction))
79         (op2 (x86-di-op2 instruction)))
80    (when (and op0 op1 (not op2)
81               (typep op0 'x86::x86-register-operand)
82               (typep op1 'x86::x86-memory-operand)
83               (member mnemonic '("movb" "movw" "movl" "movq") :test 'string=))
84      (let* ((seg (x86::x86-memory-operand-seg op1))
85             (base (x86::x86-memory-operand-base op1))
86             (index (x86::x86-memory-operand-index op1)))
87        (and base index (not seg))))))
Note: See TracBrowser for help on using the repository browser.