Commit 79099f49 authored by Frode Vatvedt Fjeld's avatar Frode Vatvedt Fjeld

Testing new assembler.

parent 225ceb4b
......@@ -9,7 +9,7 @@
;;;; Created at: Thu May 4 15:16:45 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
;;;; $Id: codec.lisp,v 1.7 2005/08/13 20:24:04 ffjeld Exp $
;;;; $Id: codec.lisp,v 1.8 2007/02/26 22:14:00 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
......@@ -645,16 +645,40 @@ original size (its instruction-original-datum)."
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 @@ that byte (i.e. #c(255 1) => -1)."
(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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment