[movitz-cvs] CVS movitz

[ffjeld]

Update of /project/movitz/cvsroot/movitz
In directory clnet:/tmp/cvs-serv18373

Modified Files:
	asm-x86.lisp 
Log Message:
A bit of progress on the assembler.


--- /project/movitz/cvsroot/movitz/asm-x86.lisp	2007/12/16 19:53:39	1.2
+++ /project/movitz/cvsroot/movitz/asm-x86.lisp	2007/12/18 21:45:06	1.3
@@ -6,7 +6,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: asm-x86.lisp,v 1.2 2007/12/16 19:53:39 ffjeld Exp $
+;;;; $Id: asm-x86.lisp,v 1.3 2007/12/18 21:45:06 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -323,6 +323,11 @@
 	((cons (eql :+))
 	 (dolist (term (cdr expr))
 	   (push term offsets)))))
+    (when (and (eq reg2 :esp)
+	       (or (not reg-scale)
+		   (eql 1 reg-scale)))
+      (psetf reg reg2
+	     reg2 reg))
     (values reg offsets reg2 (if (not reg)
 				 nil
 				 (or reg-scale 1)))))
@@ -383,32 +388,33 @@
 				:base #b100
 				:address-size :16-bit))))
 	    ((and (eq reg :esp)
-		  (not reg2)
 		  (= 1 reg-scale))
-	     (etypecase offset
-	       ((eql 0)
-		(encoded-values :mod #b00
-				:rm #b100
-				:scale 0
-				:index #b100
-				:base #b100
-				:address-size :32-bit))
-	       ((sint 8)
-		(encoded-values :mod #b01
-				:rm #b100
-				:displacement (encode-integer offset '(sint 8))
-				:scale 0
-				:index #b100
-				:base #b100
-				:address-size :32-bit))
-	       ((xint 32)
-		(encoded-values :mod #b10
-				:rm #b100
-				:displacement (encode-integer offset '(xint 32))
-				:scale 0
-				:index #b100
-				:base #b100
-				:address-size :32-bit))))
+	     (let ((reg2-index (or (position reg2 '(:eax :ecx :edx :ebx nil :ebp :esi :edi))
+				   (error "Unknown reg2 [F] ~S." reg2))))
+	       (etypecase offset
+		 ((eql 0)
+		  (encoded-values :mod #b00
+				  :rm #b100
+				  :scale 0
+				  :index reg2-index
+				  :base #b100
+				  :address-size :32-bit))
+		 ((sint 8)
+		  (encoded-values :mod #b01
+				  :rm #b100
+				  :displacement (encode-integer offset '(sint 8))
+				  :scale 0
+				  :index reg2-index
+				  :base #b100
+				  :address-size :32-bit))
+		 ((xint 32)
+		  (encoded-values :mod #b10
+				  :rm #b100
+				  :displacement (encode-integer offset '(xint 32))
+				  :scale 0
+				  :index reg2-index
+				  :base #b100
+				  :address-size :32-bit)))))
 	    ((and (eq reg :rsp)
 		  (not reg2)
 		  (= 1 reg-scale))
@@ -437,9 +443,9 @@
 				:base #b100
 				:address-size :64-bit))))
 	    (t (multiple-value-bind (register-index map address-size)
-		   (let* ((map32 '(:eax :ecx :edx :ebx nil :ebp :esi :edi))
+		   (let* ((map32 '(:eax :ecx :edx :ebx :esp :ebp :esi :edi))
 			  (index32 (position reg map32))
-			  (map64 '(:rax :rcx :rdx :rbx nil :rbp :rsi :rdi :r8 :r9 :r10 :r11 :r12 :r13 :r14 :r15))
+			  (map64 '(:rax :rcx :rdx :rbx :rsp :rbp :rsi :rdi :r8 :r9 :r10 :r11 :r12 :r13 :r14 :r15))
 			  (index64 (unless index32
 				     (position reg map64))))
 		     (if index32
@@ -480,7 +486,7 @@
 				    :scale (position reg-scale '(1 2 4 8))
 				    :index register-index
 				    :base (or (position reg2 map)
-					      (error "unknown reg2 ~S" reg2))
+					      (error "unknown reg2 [A] ~S" reg2))
 				    :address-size address-size))
 		   ((and reg2
 			 register-index
@@ -491,21 +497,35 @@
 				    :scale (position reg-scale '(1 2 4 8))
 				    :index register-index
 				    :base (or (position reg2 map)
-					      (error "unknown reg2 ~S" reg2))
+					      (error "unknown reg2 [B] ~S" reg2))
 				    :address-size address-size
 				    :displacement (encode-integer offset '(sint 8))))
 		   ((and reg2
 			 register-index
 			 (eq :32-bit address-size)
-			 (typep offset '(xint 32))
+			 (typep offset '(sint 8))
 			 (not (= register-index #b100)))
 		    (encoded-values :mod #b01
 				    :rm #b100
 				    :scale (position reg-scale '(1 2 4 8))
 				    :index register-index
-				    :base (position reg2 (cdr map))
-				    :address-size (car map)
-				    :displacement (encode-integer offset '(xint 8))))
+				    :base (or (position reg2 map)
+					      (error "unknown reg2 [C] ~S." reg2))
+				    :address-size address-size
+				    :displacement (encode-integer offset '(sint 8))))
+		   ((and reg2
+			 register-index
+			 (eq :32-bit address-size)
+			 (typep offset '(xint 32))
+			 (not (= register-index #b100)))
+		    (encoded-values :mod #b10
+				    :rm #b100
+				    :scale (position reg-scale '(1 2 4 8))
+				    :index register-index
+				    :base (or (position reg2 map)
+					      (error "unknown reg2 [D] ~S." reg2))
+				    :address-size address-size
+				    :displacement (encode-integer offset '(xint 32))))
 		   ((and reg2
 			 register-index
 			 (eq :64-bit address-size)
@@ -516,7 +536,7 @@
 				    :scale (position reg-scale '(1 2 4 8))
 				    :index register-index
 				    :base (or (position reg2 map)
-					      (error "unknown reg2 ~S" reg2))
+					      (error "unknown reg2 [E] ~S" reg2))
 				    :address-size address-size
 				    :displacement (encode-integer offset '(sint 32))))
 		   (t (let ((rm16 (position-if (lambda (x)
@@ -604,6 +624,16 @@
 					  :rex default-rex)
 			  (encode-reg/mem ,op-modrm operator-mode))))))
 
+(defmacro sreg-modrm (op-sreg op-modrm opcode)
+  `(let* ((reg-map '(:es :cs :ss :ds :fs :gs))
+	  (reg-index (position ,op-sreg reg-map)))
+     (when reg-index
+       (return-from operator
+	 (merge-encodings (encoded-values :opcode ,opcode
+					  :reg reg-index
+					  :rex default-rex)
+			  (encode-reg/mem ,op-modrm operator-mode))))))
+
 (defmacro opcode-reg (opcode op-reg)
   `(let* ((reg-map (ecase operator-mode
 		     (:8-bit '(:al :cl :dl :bl :ah :ch :dh :bh))
@@ -853,6 +883,8 @@
 (define-operator/16 :movw (src dst)
   (opcode-reg-imm #xb8 dst src (xint 16))
   (imm-modrm src dst #xc7 0 (xint 16))
+  (sreg-modrm src dst #x8c)
+  (sreg-modrm dst src #x8e)
   (reg-modrm dst src #x8b)
   (reg-modrm src dst #x89))
 
@@ -909,4 +941,3 @@
   (imm src t #x68 (sint 16) :operand-size :16-bit)
   (imm src t #x68 (sint 32))
   (modrm src #xff 6))
-