Skip to content
Snippets Groups Projects
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
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -3205,8 +3205,13 @@
#+sparc #+sparc
(progn (progn
;; Initialize these to a sane value, just in case. ;; Initialize these to a sane value, just in case.
(setf sparc::*note-sethi-inst* nil) (setf vm::*note-sethi-inst* nil)
(setf sparc::*pseudo-atomic-set* 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) (dolist (seg segments)
(disassemble-segment seg stream dstate))))) (disassemble-segment seg stream dstate)))))
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -83,11 +83,83 @@
(t (make-symbol (concatenate 'string "$" name))))) (t (make-symbol (concatenate 'string "$" name)))))
*register-names*)) *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 (defvar *note-addis-inst* nil
"An alist for the disassembler indicating the target register and "An alist for the disassembler indicating the target register and
value used in an ADDIS instruction. This is used to make annotations value used in an ADDIS instruction. This is used to make annotations
about function addresses and register values.") about function addresses and register values.")
(defvar *pseudo-atomic-set* nil)
(defun handle-ld/st-inst (reg word dstate) (defun handle-ld/st-inst (reg word dstate)
(let ((ra (ldb (byte 5 16) word)) (let ((ra (ldb (byte 5 16) word))
(d (ldb (byte 16 0) word))) (d (ldb (byte 16 0) word)))
...@@ -104,16 +176,75 @@ about function addresses and register values.") ...@@ -104,16 +176,75 @@ about function addresses and register values.")
(disassem:maybe-note-static-function d dstate))))))) (disassem:maybe-note-static-function d dstate)))))))
(defun handle-addi-inst (reg word 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))) (d (ldb (byte 16 0) word)))
(when (= reg ra) (when (= reg ra)
(case ra (let ((addis (assoc ra *note-addis-inst*)))
(18 (cond
;; An ADDI rt, $NULL, <n> instruction. This a (addis
;; reference to a static symbol. ;; RA was used in a ADDIS instruction. Assume that this is
(disassem::maybe-note-nil-indexed-object d dstate)))))) ;; the offset part of the ADDIS instruction for a full
;; 32-bit address or value. Make a note about this usage as
(defun handle-addis-inst (reg word state) ;; 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 ;; Look at the current instruction and see if we can't add some notes
...@@ -135,13 +266,17 @@ about function addresses and register values.") ...@@ -135,13 +266,17 @@ about function addresses and register values.")
(cond ((or (= 32 opcode) (cond ((or (= 32 opcode)
(= 36 opcode)) (= 36 opcode))
;; An LWZ or STW instruction. Extract the target and src ;; An LWZ or STW instruction.
;; register and the offset.
(handle-ld/st-inst reg word dstate)) (handle-ld/st-inst reg word dstate))
((= 14 opcode) ((or (= 14 opcode)
;; An ADDI instruction. Extract the target and src register (= 24 opcode))
;; and the offset. ;; An ADDI or ORI instruction.
(handle-addi-inst reg word dstate))))) (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) (eval-when (:compile-toplevel :load-toplevel :execute)
(defun reg-arg-printer (value stream dstate) (defun reg-arg-printer (value stream dstate)
...@@ -1122,19 +1257,19 @@ about function addresses and register values.") ...@@ -1122,19 +1257,19 @@ about function addresses and register values.")
(eval-when (compile load eval) (eval-when (compile load eval)
(defun addis-arg-printer (value stream dstate) (defun addis-arg-printer (value stream dstate)
(format stream "~D" value) (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 ;; Save the immediate value and the destination register for this
;; addis instruction. This is used later to print some possible ;; addis instruction. This is used later to print some possible
;; notes about the value loaded by addis. ;; 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) (disassem:dstate-cur-offs dstate)
vm:word-bytes vm:word-bytes
(disassem::dstate-byte-order dstate))) (disassem::dstate-byte-order dstate)))
(si (ldb (byte 0 16) word)) (si (ldb (byte 0 16) word))
(rd (ldb (byte 5 26) word))) (rd (ldb (byte 5 21) word)))
#+nil (disassem:note (format nil "0x~x = ~D" shifted shifted)
(push (cons rd si) *note-addis-inst*)))) dstate)
(push (cons rd value) *note-addis-inst*))))
(define-d-si-instruction addis 15 :fixup :ha :si-printer #'addis-arg-printer) (define-d-si-instruction addis 15 :fixup :ha :si-printer #'addis-arg-printer)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment