[movitz-cvs] CVS movitz
ffjeld
ffjeld at common-lisp.net
Thu Feb 28 20:09:08 UTC 2008
Update of /project/movitz/cvsroot/movitz
In directory clnet:/tmp/cvs-serv20701
Modified Files:
asm-x86.lisp
Log Message:
Disassemblers for reg-cr and far-pointer.
--- /project/movitz/cvsroot/movitz/asm-x86.lisp 2008/02/27 21:22:47 1.33
+++ /project/movitz/cvsroot/movitz/asm-x86.lisp 2008/02/28 20:09:08 1.34
@@ -6,7 +6,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef at acm.org>
;;;; Distribution: See the accompanying file COPYING.
;;;;
-;;;; $Id: asm-x86.lisp,v 1.33 2008/02/27 21:22:47 ffjeld Exp $
+;;;; $Id: asm-x86.lisp,v 1.34 2008/02/28 20:09:08 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -218,7 +218,8 @@
((atom body)
nil)
((member (car body) '(reg-modrm modrm opcode imm-modrm imm opcode-reg
- opcode-reg-imm pc-rel moffset sreg-modrm))
+ opcode-reg-imm pc-rel moffset sreg-modrm reg-cr
+ far-pointer))
(list body))
(t (mapcan #'find-forms body)))))
(let ((defun-name (intern (format nil "~A-~A" 'instruction-encoder operator))))
@@ -312,6 +313,19 @@
(set-it *opcode-disassemblers-64* opcode)))))
+(defmacro pop-code (code-place &optional context)
+ `(progn
+ (unless ,code-place
+ (error "End of byte-stream in the middle of an instruction."))
+ (let ((x (pop ,code-place)))
+ (check-type x (unsigned-byte 8) ,(format nil "an octet (context: ~A)" context))
+ x)))
+
+(defmacro code-call (form &optional (code-place (case (car form) ((funcall apply) (third form)) (t (second form)))))
+ "Execute form, then 'magically' update the code binding with the secondary return value from form."
+ `(let (tmp)
+ (declare (ignorable tmp))
+ (setf (values tmp ,code-place) ,form)))
(defmacro define-disassembler ((operator opcode &optional cpu-mode digit backup-p operand-size) lambda-list &body body)
(cond
@@ -773,20 +787,6 @@
collect (or (getf operands key)
(error "No operand ~S in ~S." key operands))))
-(defmacro pop-code (code-place &optional context)
- `(progn
- (unless ,code-place
- (error "End of byte-stream in the middle of an instruction."))
- (let ((x (pop ,code-place)))
- (check-type x (unsigned-byte 8) ,(format nil "an octet (context: ~A)" context))
- x)))
-
-(defmacro code-call (form &optional (code-place (case (car form) ((funcall apply) (third form)) (t (second form)))))
- "Execute form, then 'magically' update the code binding with the secondary return value from form."
- `(let (tmp)
- (declare (ignorable tmp))
- (setf (values tmp ,code-place) ,form)))
-
(defun decode-integer (code type)
"Decode an integer of specified type."
(let* ((bit-size (cadr type))
@@ -839,6 +839,17 @@
(remove nil fixed-operands))
code))
+(defun decode-reg-cr (code operator opcode operand-size address-size rex operand-ordering)
+ (declare (ignore opcode operand-size address-size))
+ (let ((modrm (pop-code code)))
+ (values (list* operator
+ (order-operands operand-ordering
+ :reg (nth (ldb (byte 3 0) modrm)
+ (register-set-by-mode (if rex :64-bit :32-bit)))
+ :cr (nth (ldb (byte 3 3) modrm)
+ '(:cr0 :cr1 :cr2 :cr3 :cr4 :cr5 :cr6 :cr7))))
+ code)))
+
(defun decode-reg-modrm (code operator opcode operand-size address-size rex operand-ordering &optional (reg-mode operand-size))
(declare (ignore opcode rex))
(values (list* operator
@@ -877,6 +888,15 @@
:imm (code-call (decode-integer code imm-type))))
code))
+(defun decode-far-pointer (code operator opcode operand-size address-size rex type)
+ (declare (ignore opcode operand-size address-size rex))
+ (let ((offset (code-call (decode-integer code type)))
+ (segment (code-call (decode-integer code '(uint 16)))))
+ (values (list operator
+ segment
+ offset)
+ code)))
+
(defun decode-pc-rel (code operator opcode operand-size address-size rex type)
(declare (ignore opcode operand-size address-size rex))
(values (list operator
@@ -1140,7 +1160,15 @@
extras)))))
(defmacro reg-cr (op-reg op-cr opcode &rest extras)
- `(return-when (encode-reg-cr operator legacy-prefixes ,op-reg ,op-cr ,opcode operator-mode default-rex , at extras)))
+ `(progn
+ (assembler
+ (return-when (encode-reg-cr operator legacy-prefixes ,op-reg ,op-cr ,opcode operator-mode default-rex , at extras)))
+ (disassembler
+ (define-disassembler (operator ,opcode nil nil nil :32-bit)
+ decode-reg-cr
+ (operand-ordering operand-formals
+ :reg ',op-reg
+ :cr ',op-cr)))))
(defmacro sreg-modrm (op-sreg op-modrm opcode &rest extras)
`(progn
@@ -1283,16 +1311,22 @@
',type)))))
(defmacro far-pointer (opcode segment offset offset-type &rest extra)
- `(when (and (immediate-p ,segment)
- (indirect-operand-p ,offset)); FIXME: should be immediate-p, change in bootblock.lisp.
- (let ((segment (resolve-operand ,segment))
- (offset (resolve-operand (car ,offset))))
- (when (and (typep segment '(uint 16))
- (typep offset ',offset-type))
- (return-when (encode (encoded-values :opcode ,opcode
- :immediate (append (encode-integer offset ',offset-type)
- (encode-integer segment '(uint 16)))
- , at extra)))))))
+ `(progn
+ (assembler
+ (when (and (immediate-p ,segment)
+ (indirect-operand-p ,offset)) ; FIXME: should be immediate-p, change in bootblock.lisp.
+ (let ((segment (resolve-operand ,segment))
+ (offset (resolve-operand (car ,offset))))
+ (when (and (typep segment '(uint 16))
+ (typep offset ',offset-type))
+ (return-when (encode (encoded-values :opcode ,opcode
+ :immediate (append (encode-integer offset ',offset-type)
+ (encode-integer segment '(uint 16)))
+ , at extra)))))))
+ (disassembler
+ (define-disassembler (operator ,opcode operator-mode)
+ decode-far-pointer
+ ',offset-type))))
;;;;;;;;;;; Pseudo-instructions
@@ -1843,10 +1877,10 @@
(moffset #xa0 src (uint 16) (dst :ax))
(opcode-reg-imm #xb8 dst src (xint 16))
(imm-modrm src dst #xc7 0 (xint 16))
- (reg-modrm dst src #x8b)
- (reg-modrm src dst #x89)
(sreg-modrm src dst #x8c)
- (sreg-modrm dst src #x8e))
+ (sreg-modrm dst src #x8e)
+ (reg-modrm dst src #x8b)
+ (reg-modrm src dst #x89))
(define-operator/32 :movl (src dst)
(moffset #xa3 dst (uint 32) (src :eax))
@@ -1858,17 +1892,9 @@
;;;;;;;;;;; MOVCR
-(define-operator* (:32 :movcrl :64 :movcrr :dispatch :movcr) (src dst)
- (when (eq src :cr8)
- (reg-cr dst :cr0 #xf00f20
- :operand-size nil))
- (when (eq dst :cr8)
- (reg-cr src :cr0 #xf00f22
- :operand-size nil))
- (reg-cr src dst #x0f22
- :operand-size nil)
- (reg-cr dst src #x0f20
- :operand-size nil))
+(define-operator* (:32 :movcrl :dispatch :movcr) (src dst)
+ (reg-cr src dst #x0f22)
+ (reg-cr dst src #x0f20))
;;;;;;;;;;; MOVS
More information about the Movitz-cvs
mailing list