Commit 15fd8568 authored by rtoy's avatar rtoy
Browse files

Add additional disassembly notes to

o Note the pseudo-atomic sections
o Note the header word being created
o Note the value of 32-bit constants
parent 3c951ec8
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/disassem.lisp,v 1.46 2005/02/07 17:27:16 rtoy Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/disassem.lisp,v 1.47 2005/04/10 15:01:44 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -3205,8 +3205,13 @@
#+sparc
(progn
;; Initialize these to a sane value, just in case.
(setf sparc::*note-sethi-inst* nil)
(setf sparc::*pseudo-atomic-set* nil))
(setf vm::*note-sethi-inst* nil)
(setf vm::*pseudo-atomic-set* nil))
#+ppc
(progn
;; Initialize these to a sane value, just in case.
(setf vm::*note-addis-inst* nil)
(setf vm::*pseudo-atomic-set* nil))
(dolist (seg segments)
(disassemble-segment seg stream dstate)))))
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/insts.lisp,v 1.9 2005/04/10 02:15:52 rtoy Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/insts.lisp,v 1.10 2005/04/10 15:01:45 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -83,11 +83,83 @@
(t (make-symbol (concatenate 'string "$" name)))))
*register-names*))
(defun get-reg-name (index)
(if *disassem-use-lisp-reg-names*
(aref reg-symbols index)
(format nil "~A~D" 'r index)))
(macrolet
((frob (&rest names)
(let ((results (mapcar #'(lambda (n)
(let ((nn (intern (concatenate 'string (string n)
"-TYPE"))))
`(,(eval nn) ,nn)))
names)))
`(eval-when (compile load eval)
(defconstant header-word-type-alist
',results)))))
;; This is the same list as in objdefs.
(frob bignum
ratio
single-float
double-float
#+long-float long-float
complex
complex-single-float
complex-double-float
#+long-float complex-long-float
simple-array
simple-string
simple-bit-vector
simple-vector
simple-array-unsigned-byte-2
simple-array-unsigned-byte-4
simple-array-unsigned-byte-8
simple-array-unsigned-byte-16
simple-array-unsigned-byte-32
simple-array-signed-byte-8
simple-array-signed-byte-16
simple-array-signed-byte-30
simple-array-signed-byte-32
simple-array-single-float
simple-array-double-float
#+long-float simple-array-long-float
simple-array-complex-single-float
simple-array-complex-double-float
#+long-float simple-array-complex-long-float
complex-string
complex-bit-vector
complex-vector
complex-array
code-header
function-header
closure-header
funcallable-instance-header
byte-code-function
byte-code-closure
dylan-function-header
closure-function-header
#-gengc return-pc-header
#+gengc forwarding-pointer
value-cell-header
symbol-header
base-char
sap
unbound-marker
weak-pointer
instance-header
fdefn
#+(or gengc gencgc) scavenger-hook))
(defvar *note-addis-inst* nil
"An alist for the disassembler indicating the target register and
value used in an ADDIS instruction. This is used to make annotations
about function addresses and register values.")
(defvar *pseudo-atomic-set* nil)
(defun handle-ld/st-inst (reg word dstate)
(let ((ra (ldb (byte 5 16) word))
(d (ldb (byte 16 0) word)))
......@@ -104,16 +176,75 @@ about function addresses and register values.")
(disassem:maybe-note-static-function d dstate)))))))
(defun handle-addi-inst (reg word dstate)
(let ((ra (ldb (byte 5 16) word))
(let ((rt (ldb (byte 5 21) word))
(ra (ldb (byte 5 16) word))
(d (ldb (byte 16 0) word)))
(when (= reg ra)
(case ra
(18
;; An ADDI rt, $NULL, <n> instruction. This a
;; reference to a static symbol.
(disassem::maybe-note-nil-indexed-object d dstate))))))
(defun handle-addis-inst (reg word state)
(let ((addis (assoc ra *note-addis-inst*)))
(cond
(addis
;; RA was used in a ADDIS instruction. Assume that this is
;; the offset part of the ADDIS instruction for a full
;; 32-bit address or value. Make a note about this usage as
;; a Lisp assembly routine or a foreign routine. If note,
;; just note the final value.
(let ((addr (+ d (ash (cdr addis) 16))))
(or (disassem::note-code-constant-absolute addr dstate)
(disassem::maybe-note-assembler-routine addr t dstate)
(disassem::note (format nil "~A = #x~8,'0X"
(get-reg-name rt) addr)
dstate)))
;; We're done with this ADDIS/ADDI instruction combination.
;; Remove ADDIS.
(setf *note-addis-inst* (delete addis *note-addis-inst*)))
((= ra null-offset)
;; An ADDI rt, $NULL, <n> instruction. This a
;; reference to a static symbol.
(disassem::maybe-note-nil-indexed-object d dstate))
((= ra alloc-offset)
;; addi rt, $alloc, n. This must be some allocation or
;; pseudo-atomic stuff. Look at the pseudo-atomic macro to
;; make sure this is right.
(cond ((and (= d 4)
(= rt alloc-offset)
(not *pseudo-atomic-set*))
;; "ADD $ALLOC, $ALLOC, 4" sets the PA flag
(disassem:note "Set pseudo-atomic flag" dstate)
(setf *pseudo-atomic-set*
(sys:sap+ (disassem:dstate-segment-sap dstate)
(disassem:dstate-cur-offs dstate))))
((and (= rt alloc-offset)
*pseudo-atomic-set*
(not (sys:sap= *pseudo-atomic-set*
(sys:sap+ (disassem:dstate-segment-sap dstate)
(disassem:dstate-cur-offs dstate)))))
;; "ADD $ALLOC, $ALLOC, n" is allocating space
(disassem:note (format nil "Allocating ~D bytes" d)
dstate))))
((and (= ra zero-offset) *pseudo-atomic-set*)
;; "ADDI RT, $ZERO, n" inside a pseudo-atomic is very likely
;; loading up a header word. Make a note to that effect.
(let ((type (second (assoc (logand d #xff) header-word-type-alist)))
(size (ldb (byte 24 8) d)))
(when type
(disassem:note (format nil "Header word ~A, size ~D?" type size)
dstate)))))))))
(defun handle-add-inst (reg word dstate)
(let ((rt (ldb (byte 5 21) word))
(ra (ldb (byte 5 16) word)))
(when (and (= reg 6)
(= rt alloc-offset)
(= ra alloc-offset))
;; We have "ADD $ALLOC, $ALLOC, $NL3". This turns off
;; pseudo-atomic. (See the pseudo-atomic macro.)
(disassem:note "Reset pseudo-atomic flag" dstate)
(setf *pseudo-atomic-set* nil))))
(defun update-addis-notes (word)
;; If this instruction writes to register that was the target of an
;; ADDIS instruction, we should remove it from *note-addis-inst* so
;; we don't get confused an print out erroneous notes.
)
;; Look at the current instruction and see if we can't add some notes
......@@ -135,13 +266,17 @@ about function addresses and register values.")
(cond ((or (= 32 opcode)
(= 36 opcode))
;; An LWZ or STW instruction. Extract the target and src
;; register and the offset.
;; An LWZ or STW instruction.
(handle-ld/st-inst reg word dstate))
((= 14 opcode)
;; An ADDI instruction. Extract the target and src register
;; and the offset.
(handle-addi-inst reg word dstate)))))
((or (= 14 opcode)
(= 24 opcode))
;; An ADDI or ORI instruction.
(handle-addi-inst reg word dstate))
((and (= 31 opcode)
(= 266 (ldb (byte 9 1) word)))
;; An ADD instruction
(handle-add-inst reg word dstate)))
(update-addis-notes word)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun reg-arg-printer (value stream dstate)
......@@ -1122,19 +1257,19 @@ about function addresses and register values.")
(eval-when (compile load eval)
(defun addis-arg-printer (value stream dstate)
(format stream "~D" value)
(let ((shifted (ash value 16)))
(disassem:note (format nil "0x~x = ~D" shifted shifted) dstate))
;; Save the immediate value and the destination register for this
;; addis instruction. This is used later to print some possible
;; notes about the value loaded by addis.
(let* ((word (disassem::sap-ref-int (disassem:dstate-segment-sap dstate)
(let* ((shifted (ash value 16))
(word (disassem::sap-ref-int (disassem:dstate-segment-sap dstate)
(disassem:dstate-cur-offs dstate)
vm:word-bytes
(disassem::dstate-byte-order dstate)))
(si (ldb (byte 0 16) word))
(rd (ldb (byte 5 26) word)))
#+nil
(push (cons rd si) *note-addis-inst*))))
(rd (ldb (byte 5 21) word)))
(disassem:note (format nil "0x~x = ~D" shifted shifted)
dstate)
(push (cons rd value) *note-addis-inst*))))
(define-d-si-instruction addis 15 :fixup :ha :si-printer #'addis-arg-printer)
......
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