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

Modified Files: image.lisp Log Message: Add disassembly comments.

--- /project/movitz/cvsroot/movitz/image.lisp 2008/02/23 22:34:14 1.115 +++ /project/movitz/cvsroot/movitz/image.lisp 2008/02/24 12:13:06 1.116 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.115 2008/02/23 22:34:14 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.116 2008/02/24 12:13:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -1244,6 +1244,79 @@ (when (= offset (bt:slot-offset 'movitz-run-time-context slot-name)) (return slot-name))))

+#-ia-x86 +(defun comment-instruction (instruction funobj pc) + "Return a list of strings that comments on INSTRUCTION." + (declare (ignore pc)) + (loop for operand in (asm:instruction-operands instruction) + when (and (typep operand 'asm:indirect-operand) + (member :edi operand) + (run-time-context-find-slot (asm:indirect-operand-offset operand)) + (not (member (asm:instruction-operator instruction) + '(:leal :lea)))) + collect (format nil "<Global slot ~A>" + (run-time-context-find-slot (asm:indirect-operand-offset operand))) +;; when (and (typep operand 'ia-x86::operand-indirect-register) +;; (eq 'ia-x86::edi (ia-x86::operand-register operand)) +;; (typep instruction 'ia-x86-instr::lea) +;; (or (not (ia-x86::operand-register2 operand)) +;; (eq 'ia-x86::edi (ia-x86::operand-register2 operand)))) +;; collect (let ((x (+ (* (ia-x86::operand-scale operand) +;; (image-nil-word *image*)) +;; (ia-x86::operand-offset operand) +;; (ecase (ia-x86::operand-register2 operand) +;; (ia-x86::edi (image-nil-word *image*)) +;; ((nil) 0))))) +;; (case (ldb (byte 3 0) x) +;; (#.(tag :character) +;; (format nil "Immediate ~D (char ~S)" +;; x (code-char (ldb (byte 8 8) x)))) +;; (#.(mapcar 'tag +fixnum-tags+) +;; (format nil "Immediate ~D (fixnum ~D #x~X)" +;; x +;; (truncate x +movitz-fixnum-factor+) +;; (truncate x +movitz-fixnum-factor+))) +;; (t (format nil "Immediate ~D" x)))) + when (and funobj + (typep operand 'asm:indirect-operand) + (member :esi operand) + (<= 12 (asm:indirect-operand-offset operand))) + collect (format nil "~A" + (nth (truncate (- (+ (asm:indirect-operand-offset operand) + (if (member :edi operand) + (image-nil-word *image*) + 0)) + (slot-offset 'movitz-funobj 'constant0)) + 4) + (movitz-funobj-const-list funobj))) +;; when (and funobj +;; (typep operand 'ia-x86::operand-indirect-register) +;; (eq 'ia-x86::esi (ia-x86::operand-register2 operand)) +;; (eq 'ia-x86::edi (ia-x86::operand-register operand)) +;; (<= 12 (ia-x86::operand-offset operand))) +;; collect (format nil "~A" (nth (truncate (- (+ (ia-x86::operand-offset operand) +;; (* (ia-x86::operand-scale operand) +;; (image-nil-word *image*))) +;; (slot-offset 'movitz-funobj 'constant0)) +;; 4) +;; (movitz-funobj-const-list funobj))) +;; when (typep operand 'ia-x86::operand-rel-pointer) +;; collect (let* ((x (+ pc +;; (imagpart (ia-x86::instruction-original-datum instruction)) +;; (length (ia-x86:instruction-prefixes instruction)) +;; (ia-x86::operand-offset operand))) +;; (label (and funobj (car (find x (movitz-funobj-symtab funobj) :key #'cdr))))) +;; (if label +;; (format nil "branch to ~S at ~D" label x) +;; (format nil "branch to ~D" x))) + when (and (typep operand '(and integer asm:immediate-operand)) + (<= #x100 operand #x10000) + (= (tag :character) (mod operand 256))) + collect (format nil "#\~C" (code-char (truncate operand 256))) + when (and (typep operand '(and integer asm:immediate-operand)) + (zerop (mod operand +movitz-fixnum-factor+))) + collect (format nil "#x~X" (truncate operand +movitz-fixnum-factor+)))) + #+ia-x86 (defun comment-instruction (instruction funobj pc) "Return a list of strings that comments on INSTRUCTION." @@ -1396,7 +1469,7 @@ when (let ((x (find pc (movitz-funobj-symtab funobj) :key #'cdr))) (when x (list pc (list (format nil " ~A" (car x))) "" nil))) collect it - collect (list pc data instruction nil) + collect (list pc data instruction (comment-instruction instruction funobj pc)) do (incf pc (length data)))))) (when recursive (let ((*recursive-disassemble-remember-funobjs* @@ -1479,7 +1552,7 @@ collect (list pc data instruction - nil #+ignore (comment-instruction instruction nil pc)) + (comment-instruction instruction nil pc)) do (incf pc (length data)))) (values)))