diff --git a/compiler/disassem.lisp b/compiler/disassem.lisp index 7f196ac496e5a04a7c091b8c4d28af044f01365c..d0eebe780b89cecc61e3cae61c2e6d1b61929b5c 100644 --- a/compiler/disassem.lisp +++ b/compiler/disassem.lisp @@ -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))))) diff --git a/compiler/ppc/insts.lisp b/compiler/ppc/insts.lisp index a47e41dee6ba1df6b2fa091ce9b302463f102d26..52f743c2d80f0a3af18f68a478c812169ff14706 100644 --- a/compiler/ppc/insts.lisp +++ b/compiler/ppc/insts.lisp @@ -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)