[movitz-cvs] CVS movitz
ffjeld
ffjeld at common-lisp.net
Sun Dec 16 19:53:39 UTC 2007
Update of /project/movitz/cvsroot/movitz
In directory clnet:/tmp/cvs-serv13240
Modified Files:
asm-x86.lisp
Log Message:
This is what I did while sitting in the car for four hours
today. Added some instructions, down to CMPXCHG.
--- /project/movitz/cvsroot/movitz/asm-x86.lisp 2007/12/16 08:57:20 1.1
+++ /project/movitz/cvsroot/movitz/asm-x86.lisp 2007/12/16 19:53:39 1.2
@@ -6,7 +6,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef at acm.org>
;;;; Distribution: See the accompanying file COPYING.
;;;;
-;;;; $Id: asm-x86.lisp,v 1.1 2007/12/16 08:57:20 ffjeld Exp $
+;;;; $Id: asm-x86.lisp,v 1.2 2007/12/16 19:53:39 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -77,7 +77,7 @@
((:symtab *symtab*) *symtab*)
((:cpu-mode *cpu-mode*) *cpu-mode*))
"Return list of octets,"
- (multiple-value-bind (prefixes rexes opcode opcode2 mod reg rm scale index base displacement immediate operand-size address-size)
+ (multiple-value-bind (prefixes rexes opcode mod reg rm scale index base displacement immediate operand-size address-size)
(encode-to-parts instruction)
(unless opcode
(error "Unable to encode instruction ~S." instruction))
@@ -99,9 +99,9 @@
prefixes))
(append (mapcar #'prefix-lookup (reverse prefixes))
(rex-encode rexes :rm rm)
- (list opcode)
- (when opcode2
- (list opcode2))
+ (when (< 8(integer-length opcode))
+ (list (ldb (byte 8 8) opcode)))
+ (list (ldb (byte 8 0) opcode))
(when (or mod reg rm)
(assert (and mod reg rm) (mod reg rm)
"Either all or none of mod, reg, and rm must be defined. mod=~S, reg=~S, rm=~S." mod reg rm)
@@ -128,9 +128,9 @@
immediate)))
(defmacro merge-encodings (form1 form2)
- `(multiple-value-bind (prefixes1 rexes1 opcode1 opcode21 mod1 reg1 rm1 scale1 index1 base1 displacement1 immediate1 operand-size1 address-size1)
+ `(multiple-value-bind (prefixes1 rexes1 opcode1 mod1 reg1 rm1 scale1 index1 base1 displacement1 immediate1 operand-size1 address-size1)
,form1
- (multiple-value-bind (prefixes2 rexes2 opcode2 opcode22 mod2 reg2 rm2 scale2 index2 base2 displacement2 immediate2 operand-size2 address-size2)
+ (multiple-value-bind (prefixes2 rexes2 opcode2 mod2 reg2 rm2 scale2 index2 base2 displacement2 immediate2 operand-size2 address-size2)
,form2
(macrolet ((getone (a b name)
`(cond
@@ -146,7 +146,6 @@
rexes2
(list rexes2)))
:opcode (getone opcode1 opcode2 opcode)
- :opcode2 (getone opcode21 opcode22 opcode2)
:mod (getone mod1 mod2 mod)
:reg (getone reg1 reg2 reg)
:rm (getone rm1 rm2 rm)
@@ -160,7 +159,7 @@
-(defun encoded-values (&key prefixes prefix rex opcode opcode2 mod reg rm scale index base displacement immediate operand-size address-size)
+(defun encoded-values (&key prefixes prefix rex opcode mod reg rm scale index base displacement immediate operand-size address-size)
(values (append (when prefix
(list prefix))
prefixes)
@@ -168,7 +167,6 @@
(list rex)
rex)
opcode
- opcode2
mod reg rm
scale index base
displacement
@@ -185,7 +183,7 @@
instruction))
(destructuring-bind (operator &rest operands)
instruction
- (multiple-value-bind (prefixes prefix rex opcode opcode2 mod reg rm scale index base displacement immediate operand-size address-size)
+ (multiple-value-bind (prefixes prefix rex opcode mod reg rm scale index base displacement immediate operand-size address-size)
(apply (or (gethash operator *instruction-encoders*)
(error "Unknown instruction operator ~S in ~S." operator instruction))
operands)
@@ -193,7 +191,6 @@
prefix
rex
opcode
- opcode2
mod
reg
rm
@@ -255,12 +252,26 @@
(t '(:rex.w)))))
, at body)))
-(defmacro def-simple (operator opcode1 &optional opcode2)
- (check-type opcode1 octet)
- (check-type opcode2 (or null octet))
+(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)))
+ (body32 (subst '(xint 32) :int-16-32-64
+ (subst :eax :ax-eax-rax body)))
+ (body64 (subst '(sint 32) :int-16-32-64
+ (subst :rax :ax-eax-rax body))))
+ `(progn
+ ,(when |16|
+ `(define-operator/16 ,|16| ,args , at body16))
+ ,(when |32|
+ `(define-operator/32 ,|32| ,args , at body32))
+ ,(when |64|
+ `(define-operator/64 ,|64| ,args , at body64)))))
+
+
+(defmacro define-simple (operator opcode)
+ (check-type opcode (unsigned-byte 16))
`(define-operator ,operator ()
- (encoded-values :opcode ,opcode1
- :opcode2 ,opcode2)))
+ (encoded-values :opcode ,opcode)))
(defun resolve (x)
(etypecase x
@@ -539,13 +550,13 @@
-(defmacro encoded-result (&rest args &key prefixes prefix rex opcode opcode2 mod reg rm scale index base displacement immediate operand-size address-size)
- (declare (ignore prefixes prefix rex opcode opcode2 mod reg rm scale index base displacement immediate operand-size address-size))
+(defmacro encoded-result (&rest args &key prefixes prefix rex opcode mod reg rm scale index base displacement immediate operand-size address-size)
+ (declare (ignore prefixes prefix rex opcode mod reg rm scale index base displacement immediate operand-size address-size))
`(return-from operator (encoded-values , at args)))
(defmacro imm (imm-operand condition opcode imm-type &rest extras)
`(when (and ,(or condition t)
- (immediate-p src))
+ (immediate-p ,imm-operand))
(let ((immediate (resolve ,imm-operand)))
(when (typep immediate ',imm-type)
(encoded-result :opcode ,opcode
@@ -553,9 +564,9 @@
:rex default-rex
, at extras)))))
-(defmacro imm-modrm (src dst opcode digit type)
- `(when (immediate-p ,src)
- (let ((immediate (resolve ,src)))
+(defmacro imm-modrm (op-imm op-modrm opcode digit type)
+ `(when (immediate-p ,op-imm)
+ (let ((immediate (resolve ,op-imm)))
(when (typep immediate ',type)
(return-from operator
(merge-encodings (encoded-values :opcode ,opcode
@@ -564,7 +575,7 @@
:16-bit)
:rex default-rex
:immediate (encode-integer immediate ',type))
- (encode-reg/mem ,dst operator-mode)))))))
+ (encode-reg/mem ,op-modrm operator-mode)))))))
(defmacro modrm (operand opcode digit)
`(return-from operator
@@ -638,7 +649,24 @@
;;;;;;;;;;;;;;;;
-(def-simple :nop #x90)
+(define-simple :nop #x90)
+
+;;;;;;;;;;; ADC
+
+(define-operator/8 :adcb (src dst)
+ (imm src (eq dst :al) #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)
+ (imm-modrm src dst #x81 2 :int-16-32-64)
+ (reg-modrm dst src #x13)
+ (reg-modrm src dst #x11))
+
+;;;;;;;;;;; ADD
(define-operator/8 :addb (src dst)
(imm src (eq dst :al) #x04 (xint 8))
@@ -646,26 +674,175 @@
(reg-modrm dst src #x02)
(reg-modrm src dst #x00))
-(define-operator/16 :addw (src dst)
+(define-operator* (:16 :addw :32 :addl :64 :addr) (src dst)
(imm-modrm src dst #x83 0 (sint 8))
- (imm src (eq dst :ax) #x05 (xint 16))
- (imm-modrm src dst #x81 0 (xint 16))
+ (imm src (eq dst :ax-eax-rax) #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))
-(define-operator/32 :addl (src dst)
- (imm-modrm src dst #x83 0 (sint 8))
- (imm src (eq dst :eax) #x05 (xint 32))
- (imm-modrm src dst #x81 0 (xint 32))
- (reg-modrm dst src #x03)
- (reg-modrm src dst #x01))
+;;;;;;;;;;; AND
-(define-operator/64 :addr (src dst)
- (imm-modrm src dst #x83 0 (sint 8))
- (imm src (eq dst :rax) #x05 (sint 32))
- (imm-modrm src dst #x81 0 (sint 32))
- (reg-modrm dst src #x03)
- (reg-modrm src dst #x01))
+(define-operator/8 :andb (mask dst)
+ (imm mask (eq dst :al) #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)
+ (imm-modrm mask dst #x81 4 :int-16-32-64)
+ (reg-modrm dst mask #x23)
+ (reg-modrm mask dst #x21))
+
+;;;;;;;;;;; BOUND, BSF, BSR, BSWAP
+
+(define-operator* (:16 :boundw :32 :boundl) (bounds reg)
+ (reg-modrm reg bounds #x62))
+
+(define-operator* (:16 :bsfw :32 :bsfl :64 :bsfr) (src dst)
+ (reg-modrm dst src #x0fbc))
+
+(define-operator* (:16 :bsrw :32 :bsrl :64 :bsrr) (src dst)
+ (reg-modrm dst src #x0fbd))
+
+(define-operator* (:32 :bswapl :64 :bswapr) (dst)
+ (opcode-reg #x0fc8 dst))
+
+;;;;;;;;;;; BT, BTC, BTR, BTS
+
+(define-operator* (:16 :btw :32 :btl :64 :btr) (bit src)
+ (imm-modrm bit src #x0fba 4 (uint 8))
+ (reg-modrm bit src #x0fa3))
+
+(define-operator* (:16 :btcw :32 :btcl :64 :btcr) (bit src)
+ (imm-modrm bit src #x0fba 7 (uint 8))
+ (reg-modrm bit src #x0fbb))
+
+(define-operator* (:16 :btrw :32 :btrl :64 :btrr) (bit src)
+ (imm-modrm bit src #x0fba 6 (uint 8))
+ (reg-modrm bit src #x0fb3))
+
+(define-operator* (:16 :btsw :32 :btsl :64 :btsr) (bit src)
+ (imm-modrm bit src #x0fba 5 (uint 8))
+ (reg-modrm bit src #x0fab))
+
+;;;;;;;;;;; CALL
+
+(define-operator/16 :callw (dest)
+ (modrm dest #xff 2))
+
+(define-operator/32 :call (dest)
+ (modrm dest #xff 2))
+
+;;;;;;;;;;; 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)
+
+;;;;;;;;;;; CMOVcc
+
+(define-operator* (:16 :cmovaw :32 :cmova :64 :cmovar) (src dst)
+ (reg-modrm dst src #x0f47)) ; Move if above, CF=0 and ZF=0.
+
+(define-operator* (:16 :cmovaew :32 :cmovae :64 :cmovaer) (src dst)
+ (reg-modrm dst src #x0f43)) ; Move if above or equal, CF=0.
+
+(define-operator* (:16 :cmovbw :32 :cmovb :64 :cmovbr) (src dst)
+ (reg-modrm dst src #x0f42)) ; Move if below, CF=1.
+
+(define-operator* (:16 :cmovbew :32 :cmovbe :64 :cmovber) (src dst)
+ (reg-modrm dst src #x0f46)) ; Move if below or equal, CF=1 or ZF=1.
+
+(define-operator* (:16 :cmovcw :32 :cmovc :64 :cmovcr) (src dst)
+ (reg-modrm dst src #x0f42)) ; Move if carry, CF=1.
+
+(define-operator* (:16 :cmovew :32 :cmove :64 :cmover) (src dst)
+ (reg-modrm dst src #x0f44)) ; Move if equal, ZF=1.
+
+(define-operator* (:16 :cmovgw :32 :cmovg :64 :cmovgr) (src dst)
+ (reg-modrm dst src #x0f4f)) ; Move if greater, ZF=0 and SF=OF.
+
+(define-operator* (:16 :cmovgew :32 :cmovge :64 :cmovger) (src dst)
+ (reg-modrm dst src #x0f4d)) ; Move if greater or equal, SF=OF.
+
+(define-operator* (:16 :cmovlw :32 :cmovl :64 :cmovlr) (src dst)
+ (reg-modrm dst src #x0f4c))
+
+(define-operator* (:16 :cmovlew :32 :cmovle :64 :cmovler) (src dst)
+ (reg-modrm dst src #x0f4e)) ; Move if less or equal, ZF=1 or SF/=OF.
+
+(define-operator* (:16 :cmovnaw :32 :cmovna :64 :cmovnar) (src dst)
+ (reg-modrm dst src #x0f46)) ; Move if not above, CF=1 or ZF=1.
+
+(define-operator* (:16 :cmovnaew :32 :cmovnae :64 :cmovnaer) (src dst)
+ (reg-modrm dst src #x0f42)) ; Move if not above or equal, CF=1.
+
+(define-operator* (:16 :cmovnbw :32 :cmovnb :64 :cmovnbr) (src dst)
+ (reg-modrm dst src #x0f43)) ; Move if not below, CF=0.
+
+(define-operator* (:16 :cmovnbew :32 :cmovnbe :64 :cmovnber) (src dst)
+ (reg-modrm dst src #x0f47)) ; Move if not below or equal, CF=0 and ZF=0.
+
+(define-operator* (:16 :cmovncw :32 :cmovnc :64 :cmovncr) (src dst)
+ (reg-modrm dst src #x0f43)) ; Move if not carry, CF=0.
+
+(define-operator* (:16 :cmovnew :32 :cmovne :64 :cmovner) (src dst)
+ (reg-modrm dst src #x0f45)) ; Move if not equal, ZF=0.
+
+(define-operator* (:16 :cmovngew :32 :cmovnge :64 :cmovnger) (src dst)
+ (reg-modrm dst src #x0f4c)) ; Move if not greater or equal, SF/=OF.
+
+(define-operator* (:16 :cmovnlw :32 :cmovnl :64 :cmovnlr) (src dst)
+ (reg-modrm dst src #x0f4d)) ; Move if not less SF=OF.
+
+(define-operator* (:16 :cmovnlew :32 :cmovnle :64 :cmovnler) (src dst)
+ (reg-modrm dst src #x0f4f)) ; Move if not less or equal, ZF=0 and SF=OF.
+
+(define-operator* (:16 :cmovnow :32 :cmovno :64 :cmovnor) (src dst)
+ (reg-modrm dst src #x0f41)) ; Move if not overflow, OF=0.
+
+(define-operator* (:16 :cmovnpw :32 :cmovnp :64 :cmovnpr) (src dst)
+ (reg-modrm dst src #x0f4b)) ; Move if not parity, PF=0.
+
+(define-operator* (:16 :cmovnsw :32 :cmovns :64 :cmovnsr) (src dst)
+ (reg-modrm dst src #x0f49)) ; Move if not sign, SF=0.
+
+(define-operator* (:16 :cmovnzw :32 :cmovnz :64 :cmovnzr) (src dst)
+ (reg-modrm dst src #x0f45)) ; Move if not zero, ZF=0.
+
+(define-operator* (:16 :cmovow :32 :cmovo :64 :cmovor) (src dst)
+ (reg-modrm dst src #x0f40)) ; Move if overflow, OF=1.
+
+(define-operator* (:16 :cmovpw :32 :cmovp :64 :cmovpr) (src dst)
+ (reg-modrm dst src #x0f4a)) ; Move if parity, PF=1.
+
+(define-operator* (:16 :cmovsw :32 :cmovs :64 :cmovsr) (src dst)
+ (reg-modrm dst src #x0f48)) ; Move if sign, SF=1
+
+(define-operator* (:16 :cmovzw :32 :cmovz :64 :cmovzr) (src dst)
+ (reg-modrm dst src #x0f44)) ; Move if zero, ZF=1
+
+;;;;;;;;;;; CMP
+
+(define-operator/8 :cmpb (src dst)
+ (imm src (eq dst :al) #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)
+ (imm-modrm src dst #x81 7 :int-16-32-64)
+ (reg-modrm dst src #x3b)
+ (reg-modrm src dst #x39))
+
+;;;;;;;;;;; MOV
(define-operator/8 :movb (src dst)
(opcode-reg-imm #xb0 dst src (xint 8))
@@ -685,23 +862,15 @@
(reg-modrm dst src #x8b)
(reg-modrm src dst #x89))
-(define-operator/16 :popw (dst)
- (case dst
- (:ds (yield :opcode #x1f))
- (:es (yield :opcode #x07))
- (:ss (yield :opcode #x17))
- (:fs (yield :opcode #x0f :opcode2 #xa1))
- (:gs (yield :opcode #x0f :opcode2 #xa9)))
- (opcode-reg #x58 dst)
- (modrm dst #x8f 0))
+;;;;;;;;;;; POP
-(define-operator/32 :popl (dst)
+(define-operator* (:16 :popw :32 :popl) (dst)
(case dst
(:ds (yield :opcode #x1f))
(:es (yield :opcode #x07))
(:ss (yield :opcode #x17))
- (:fs (yield :opcode #x0f :opcode2 #xa1))
- (:gs (yield :opcode #x0f :opcode2 #xa9)))
+ (:fs (yield :opcode #x0fa1))
+ (:gs (yield :opcode #x0fa9)))
[50 lines skipped]
More information about the Movitz-cvs
mailing list