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
-
ffjeld