[movitz-cvs] CVS ia-x86

[ffjeld]

Update of /project/movitz/cvsroot/ia-x86
In directory clnet:/tmp/cvs-serv19184

Modified Files:
	codec.lisp 
Log Message:
Testing new assembler.


--- /project/movitz/cvsroot/ia-x86/codec.lisp	2007/02/26 22:14:00	1.8
+++ /project/movitz/cvsroot/ia-x86/codec.lisp	2007/12/20 22:41:55	1.9
@@ -9,7 +9,7 @@
 ;;;; Created at:    Thu May  4 15:16:45 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: codec.lisp,v 1.8 2007/02/26 22:14:00 ffjeld Exp $
+;;;; $Id: codec.lisp,v 1.9 2007/12/20 22:41:55 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -645,16 +645,40 @@
 	   teo-list))
 
 (defun instruction-encode (instr env &optional (optimize-teo-fn #'optimize-teo-smallest))
-  (let ((teo-list (instruction-encode-to-teo instr env)))
-    (if (null teo-list)
-	(error "Unable to encode ~A." instr)
-      (let ((teo (if (instruction-user-size instr)
-		     (optimize-teo-user-size teo-list instr env)
-		   (funcall optimize-teo-fn teo-list instr env))))
-	(if (not (teo-p teo))
-	    (error "Optimization with ~S of instruction ~S failed for teo-list ~S"
-		   optimize-teo-fn instr teo-list)
-	  (instruction-encode-from-teo instr teo env))))))
+  (let ((old-cbyte
+	 (let ((teo-list (instruction-encode-to-teo instr env)))
+	   (if (null teo-list)
+	       (error "Unable to encode ~A." instr)
+	       (let ((teo (if (instruction-user-size instr)
+			      (optimize-teo-user-size teo-list instr env)
+			      (funcall optimize-teo-fn teo-list instr env))))
+		 (if (not (teo-p teo))
+		     (error "Optimization with ~S of instruction ~S failed for teo-list ~S"
+			    optimize-teo-fn instr teo-list)
+		     (instruction-encode-from-teo instr teo env)))))))
+    #+ignore
+    (when (gethash (find-symbol (string (type-of instr))
+				:keyword)
+		   asm-x86::*instruction-encoders*)
+      (with-simple-restart (continue "Ignore asm-x86 check.")
+	(handler-case (let* ((string (let ((*package* (find-package :ia-x86-instr)))
+				       (write-to-string instr :readably t)))
+			     (expr (let ((*package* (find-package :keyword)))
+				     (read-from-string string)))
+			     (old-code (loop for b downfrom (1- (imagpart old-cbyte)) to 0
+					  collect (ldb (byte 8 (* 8 b))
+						       (realpart old-cbyte))))
+			     (new-code (asm-x86::encode-instruction expr
+								    :symtab (when env (assemble-env-symtab env))
+								    :cpu-mode *cpu-mode*)))
+			(loop while (and (cdr old-code)
+					 (eql #x90 (car old-code)))
+			   do (pop old-code))
+			(unless (equal old-code new-code)
+			  (break "asm fail: ~A: (~{#x~X~^ ~}) vs. (~{#x~X~^ ~})." expr old-code new-code)))
+	  (asm:unresolved-symbol (c)
+	    (warn (princ-to-string c))))))
+    old-cbyte))
 
 ;;;
 
@@ -673,12 +697,12 @@
   (let ((old-byte (realpart cdatum))
 	(numo (imagpart cdatum)))
     (cond
-      ((= 0 numo)
+      ((zerop numo)
        0)
       ((zerop (ldb (byte 1 (1- (* 8 numo))) old-byte))
        cdatum)
       (t (complex (- old-byte (dpb 1 (byte 1 (* 8 numo)) 0))
-                  numo)))))
+		  numo)))))
 
 (defun sign-extend (old-byte numo)
   "Given a two's complement signed byte (where the most significant