Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv1564
Modified Files: asm-x86.lisp Log Message: Some assembler work over christmas.
--- /project/movitz/cvsroot/movitz/asm-x86.lisp 2007/12/20 22:52:18 1.4 +++ /project/movitz/cvsroot/movitz/asm-x86.lisp 2008/01/03 10:34:18 1.5 @@ -6,7 +6,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: asm-x86.lisp,v 1.4 2007/12/20 22:52:18 ffjeld Exp $ +;;;; $Id: asm-x86.lisp,v 1.5 2008/01/03 10:34:18 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -17,6 +17,7 @@
(defvar *symtab* nil) (defvar *cpu-mode* :32-bit) +(defvar *pc* nil "Current program counter.")
(defvar *instruction-encoders* (make-hash-table :test 'eq)) @@ -81,22 +82,24 @@ (encode-to-parts instruction) (unless opcode (error "Unable to encode instruction ~S." instruction)) - (when (or (and (eq operand-size :16-bit) - (eq *cpu-mode* :64-bit)) - (and (eq operand-size :16-bit) - (eq *cpu-mode* :32-bit)) - (and (eq operand-size :32-bit) - (eq *cpu-mode* :16-bit))) - (pushnew :operand-size-override - prefixes)) (when (or (and (eq address-size :32-bit) (eq *cpu-mode* :64-bit)) (and (eq address-size :16-bit) (eq *cpu-mode* :32-bit)) + (and (eq address-size :64-bit) + (eq *cpu-mode* :32-bit)) (and (eq address-size :32-bit) (eq *cpu-mode* :16-bit))) (pushnew :address-size-override prefixes)) + (when (or (and (eq operand-size :16-bit) + (eq *cpu-mode* :64-bit)) + (and (eq operand-size :16-bit) + (eq *cpu-mode* :32-bit)) + (and (eq operand-size :32-bit) + (eq *cpu-mode* :16-bit))) + (pushnew :operand-size-override + prefixes)) (append (mapcar #'prefix-lookup (reverse prefixes)) (rex-encode rexes :rm rm) (when (< 8(integer-length opcode)) @@ -206,8 +209,12 @@ (check-type operator keyword) (let ((defun-name (intern (format nil "~A-~A" 'instruction-encoder operator)))) `(progn - (defun ,defun-name ,lambda-list (block operator - ,@body)) + (defun ,defun-name ,lambda-list + (let ((operator-mode nil) + (default-rex nil)) + (declare (ignorable operator-mode default-rex)) + (block operator + ,@body))) (setf (gethash ',operator *instruction-encoders*) ',defun-name) ',operator))) @@ -216,6 +223,7 @@ `(define-operator ,operator ,lambda-list (let ((operator-mode :8-bit) (default-rex nil)) + (declare (ignorable operator-mode default-rex)) (macrolet ((yield (&rest args) `(encoded-result :operand-size 8 ,@args))) ,@body)))) @@ -232,6 +240,7 @@ `(define-operator ,operator ,lambda-list (let ((operator-mode :32-bit) (default-rex nil)) + (declare (ignorable operator-mode)) (macrolet ((yield (&rest args) `(encoded-result :operand-size operator-mode ,@args))) ,@body)))) @@ -240,6 +249,7 @@ `(define-operator ,operator ,lambda-list (let ((operator-mode :64-bit) (default-rex '(:rex.w))) + (declare (ignorable operator-mode)) (macrolet ((yield (&rest args) `(encoded-result :operand-size operator-mode ,@args))) ,@body)))) @@ -250,15 +260,19 @@ (default-rex (case *cpu-mode* (:64-bit nil) (t '(:rex.w))))) + (declare (ignorable operator-mode)) ,@body)))
(defmacro define-operator* ((&key |16| |32| |64|) args &body body) (let ((body16 (subst '(xint 16) :int-16-32-64 - (subst :ax :ax-eax-rax body))) + (subst :dx :dx-edx-rdx + (subst :ax :ax-eax-rax body)))) (body32 (subst '(xint 32) :int-16-32-64 - (subst :eax :ax-eax-rax body))) + (subst :edx :dx-edx-rdx + (subst :eax :ax-eax-rax body)))) (body64 (subst '(sint 32) :int-16-32-64 - (subst :rax :ax-eax-rax body)))) + (subst :rdx :dx-edx-rdx + (subst :rax :ax-eax-rax body))))) `(progn ,(when |16| `(define-operator/16 ,|16| ,args ,@body16)) @@ -267,12 +281,6 @@ ,(when |64| `(define-operator/64 ,|64| ,args ,@body64)))))
- -(defmacro define-simple (operator opcode) - (check-type opcode (unsigned-byte 16)) - `(define-operator ,operator () - (encoded-values :opcode ,opcode))) - (defun resolve (x) (etypecase x (integer @@ -296,11 +304,13 @@ (t (error "Unresolved symbol ~S (size ~S)." x size))) type))
-(defun encode-pc-relative (operand type) - (when (typep operand '(cons (eql :pc+))) - (encode-integer (reduce #'+ (cdr operand) - :key #'resolve) - type))) +(defun resolve-pc-relative (operand) + (typecase operand + ((cons (eql :pc+)) + (reduce #'+ (cdr operand) + :key #'resolve)) + (symbol-reference + (- (resolve operand) *pc*))))
(defun encode-integer (i type) (assert (typep i type)) @@ -340,8 +350,8 @@
(defun encode-reg/mem (operand mode) - (check-type mode (member :8-bit :16-bit :32-bit :64-bit :mm :xmm)) - (if (keywordp operand) + (check-type mode (member nil :8-bit :16-bit :32-bit :64-bit :mm :xmm)) + (if (and mode (keywordp operand)) (encoded-values :mod #b11 :rm (or (position operand (ecase mode (:8-bit '(:al :cl :dl :bl :ah :ch :dh :bh)) @@ -361,10 +371,18 @@ (let ((offset (reduce #'+ offsets :key #'resolve))) (cond + ((and (not reg) + (eq mode :16-bit) + (typep offset '(xint 16))) + (encoded-values :mod #b00 + :rm #b110 + :address-size :16-bit + :displacement (encode-integer offset '(xint 16)))) ((and (not reg) (typep offset '(xint 32))) (encoded-values :mod #b00 :rm #b101 + :address-size :32-bit :displacement (encode-integer offset '(xint 32)))) ((and (eq reg :sp) (not reg2) @@ -483,13 +501,27 @@ :rm register-index :displacement (encode-integer offset '(sint 32)) :address-size address-size)) + ((and (not reg2) + register-index + (if (eq :64-bit *cpu-mode*) + (typep offset '(sint 32)) + (typep offset '(xint 32))) + (not (= #b100 register-index))) + (encoded-values :rm #b100 + :mod #b00 + :index register-index + :base #b101 + :scale (or (position reg-scale '(1 2 4 8)) + (error "Unknown register scale ~S." reg-scale)) + :displacement (encode-integer offset '(xint 32)))) ((and reg2 register-index (zerop offset) (not (= register-index #b100))) (encoded-values :mod #b00 :rm #b100 - :scale (position reg-scale '(1 2 4 8)) + :scale (or (position reg-scale '(1 2 4 8)) + (error "Unknown register scale ~S." reg-scale)) :index register-index :base (or (position reg2 map) (error "unknown reg2 [A] ~S" reg2)) @@ -580,13 +612,13 @@ (declare (ignore prefixes prefix rex opcode mod reg rm scale index base displacement immediate operand-size address-size)) `(return-from operator (encoded-values ,@args)))
-(defmacro imm (imm-operand condition opcode imm-type &rest extras) - `(when (and ,(or condition t) - (immediate-p ,imm-operand)) +(defmacro imm (imm-operand opcode imm-type &rest extras) + `(when (immediate-p ,imm-operand) (let ((immediate (resolve ,imm-operand))) (when (typep immediate ',imm-type) (encoded-result :opcode ,opcode :immediate (encode-integer immediate ',imm-type) + :operand-size operator-mode :rex default-rex ,@extras)))))
@@ -597,29 +629,29 @@ (return-from operator (merge-encodings (encoded-values :opcode ,opcode :reg ,digit - :operand-size (when (eq operator-mode :16-bit) - :16-bit) + :operand-size operator-mode :rex default-rex :immediate (encode-integer immediate ',type)) (encode-reg/mem ,op-modrm operator-mode)))))))
-(defmacro pc-rel (opcode operand type) - `(let ((offset (encode-pc-relative ,operand ',type))) - (when offset +(defmacro pc-rel (opcode operand type &rest extras) + `(let ((offset (resolve-pc-relative ,operand))) + (when (typep offset ',type) (return-from operator (encoded-values :opcode ,opcode - :displacement offset))))) + :displacement (encode-integer offset ',type) + ,@extras)))))
(defmacro modrm (operand opcode digit) - `(return-from operator - (merge-encodings (encoded-values :opcode ,opcode - :reg ,digit - :operand-size (when (eq operator-mode :16-bit) - :16-bit) - :rex default-rex) - (encode-reg/mem ,operand operator-mode)))) + `(when (typep ,operand '(or register-operand indirect-operand)) + (return-from operator + (merge-encodings (encoded-values :opcode ,opcode + :reg ,digit + :operand-size operator-mode + :rex default-rex) + (encode-reg/mem ,operand operator-mode)))))
-(defmacro reg-modrm (op-reg op-modrm opcode) +(defmacro reg-modrm (op-reg op-modrm opcode &rest extras) `(let* ((reg-map (ecase operator-mode (:8-bit '(:al :cl :dl :bl :ah :ch :dh :bh)) (:16-bit '(:ax :cx :dx :bx :sp :bp :si :di)) @@ -632,9 +664,9 @@ (return-from operator (merge-encodings (encoded-values :opcode ,opcode :reg reg-index - :operand-size (case operator-mode - (:16-bit :16-bit)) - :rex default-rex) + :operand-size operator-mode + :rex default-rex + ,@extras) (encode-reg/mem ,op-modrm operator-mode))))))
(defmacro sreg-modrm (op-sreg op-modrm opcode) @@ -659,6 +691,17 @@ :key #'resolve) ',type)))))))
+(defmacro opcode (opcode &rest extras) + `(return-from operator + (encoded-values :opcode ,opcode + ,@extras + :operand-size operator-mode))) + +(defmacro opcode* (opcode &rest extras) + `(return-from operator + (encoded-values :opcode ,opcode + ,@extras))) + (defmacro opcode-reg (opcode op-reg) `(let* ((reg-map (ecase operator-mode (:8-bit '(:al :cl :dl :bl :ah :ch :dh :bh)) @@ -704,19 +747,22 @@
;;;;;;;;;;;;;;;;
-(define-simple :nop #x90) +(define-operator :nop () + (opcode #x90))
;;;;;;;;;;; ADC
(define-operator/8 :adcb (src dst) - (imm src (eq dst :al) #x14 (xint 8)) + (when (eq dst :al) + (imm src #x14 (xint 8))) (imm-modrm src dst #x80 2 (xint 8)) (reg-modrm dst src #x12) (reg-modrm src dst #x10))
(define-operator* (:16 :adcw :32 :adcl :64 :adcr) (src dst) (imm-modrm src dst #x83 2 (sint 8)) - (imm src (eq dst :ax-eax-rax) #x15 :int-16-32-64) + (when (eq dst :ax-eax-rax) + (imm src #x15 :int-16-32-64)) (imm-modrm src dst #x81 2 :int-16-32-64) (reg-modrm dst src #x13) (reg-modrm src dst #x11)) @@ -724,14 +770,16 @@ ;;;;;;;;;;; ADD
(define-operator/8 :addb (src dst) - (imm src (eq dst :al) #x04 (xint 8)) + (when (eq dst :al) + (imm src #x04 (xint 8))) (imm-modrm src dst #x80 0 (xint 8)) (reg-modrm dst src #x02) (reg-modrm src dst #x00))
(define-operator* (:16 :addw :32 :addl :64 :addr) (src dst) (imm-modrm src dst #x83 0 (sint 8)) - (imm src (eq dst :ax-eax-rax) #x05 :int-16-32-64) + (when (eq dst :ax-eax-rax) + (imm src #x05 :int-16-32-64)) (imm-modrm src dst #x81 0 :int-16-32-64) (reg-modrm dst src #x03) (reg-modrm src dst #x01)) @@ -739,14 +787,16 @@ ;;;;;;;;;;; AND
(define-operator/8 :andb (mask dst) - (imm mask (eq dst :al) #x24 (xint 8)) + (when (eq dst :al) + (imm mask #x24 (xint 8))) (imm-modrm mask dst #x80 4 (xint 8)) (reg-modrm dst mask #x22) (reg-modrm mask dst #x20))
(define-operator* (:16 :andw :32 :andl :64 :andr) (mask dst) (imm-modrm mask dst #x83 4 (sint 8)) - (imm mask (eq dst :ax-eax-rax) #x25 :int-16-32-64) + (when (eq dst :ax-eax-rax) + (imm mask #x25 :int-16-32-64)) (imm-modrm mask dst #x81 4 :int-16-32-64) (reg-modrm dst mask #x23) (reg-modrm mask dst #x21)) @@ -798,11 +848,11 @@
;;;;;;;;;;; CLC, CLD, CLI, CLTS, CMC
-(define-simple :clc #xf8) -(define-simple :cld #xfc) -(define-simple :cli #xfa) -(define-simple :clts #x0f06) -(define-simple :cmc #xf5) +(define-operator :clc () (opcode #xf8)) +(define-operator :cld () (opcode #xfc)) +(define-operator :cli () (opcode #xfa)) +(define-operator :clts () (opcode #x0f06)) +(define-operator :cmc () (opcode #xf5))
;;;;;;;;;;; CMOVcc
@@ -890,14 +940,16 @@ ;;;;;;;;;;; CMP
(define-operator/8 :cmpb (src dst) - (imm src (eq dst :al) #x3c (xint 8)) + (when (eq dst :al) + (imm src #x3c (xint 8))) (imm-modrm src dst #x80 7 (xint 8)) (reg-modrm dst src #x3a) (reg-modrm src dst #x38))
(define-operator* (:16 :cmpw :32 :cmpl :64 :cmpr) (src dst) (imm-modrm src dst #x83 7 (sint 8)) - (imm src (eq dst :ax-eax-rax) #x3d :int-16-32-64) + (when (eq dst :ax-eax-rax) + (imm src #x3d :int-16-32-64)) (imm-modrm src dst #x81 7 :int-16-32-64) (reg-modrm dst src #x3b) (reg-modrm src dst #x39)) @@ -962,6 +1014,234 @@ (when (eq al-dst :ax-eax-rax) (reg-modrm cmp-reg cmp-modrm #x0fb1)))
[256 lines skipped]
-
ffjeld