diff --git a/code/pmax-disassem.lisp b/code/pmax-disassem.lisp index e2eb93c9f79c850fde9678137f55da854dd22bcb..5e4b4dfb72cdd18c18a0312b6656373f4850ed10 100644 --- a/code/pmax-disassem.lisp +++ b/code/pmax-disassem.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Package: MIPS -*- ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pmax-disassem.lisp,v 1.3 1990/02/05 13:04:49 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pmax-disassem.lisp,v 1.4 1990/02/06 02:22:56 ch Exp $ ;;; ;;; A simple dissambler for the MIPS R2000. ;;; @@ -54,22 +54,22 @@ "The register name style: :c, :lisp, :raw") (defvar *c-register-names* - '#("zero" "$at" "$v0" "$v1" "$a0" "$a1" "$a2" "$a3" - "$t0" "$t1" "$t2" "$t3" "$t4" "$t5" "$t6" "$t7" - "$s0" "$s1" "$s2" "$s3" "$s4" "$s5" "$s6" "$s7" - "$t8" "$t9" "$k0" "$k1" "$gp" "$sp" "$s8" "$ra")) + '#("ZERO" "$AT" "$V0" "$V1" "$A0" "$A1" "$A2" "$A3" + "$T0" "$T1" "$T2" "$T3" "$T4" "$T5" "$T6" "$T7" + "$S0" "$S1" "$S2" "$S3" "$S4" "$S5" "$S6" "$S7" + "$T8" "$T9" "$K0" "$K1" "$GP" "$SP" "$S8" "$RA")) (defvar *lisp-register-names* - '#("$zero" "$lip" "$nl0" "$nl1" "$nl2" "$nl3" "$nl4" "$nl5/nargs" - "$l0" "$l1" "$l2" "$l3" "$l4" "$l5/env" "$l6/old-cont" "$l7/call-name" - "$a0" "$a1" "$a2" "$a3" "$a4" "$a5" "$l14/args" "$l15/lra" - "$bsp" "$csp" "$k0" "$k1" "$null" "$nsp" "$code" "$cont")) + '#("$ZERO" "$LIP" "$NL0" "$NL1" "$NL2" "$NL3" "$NL4" "$NL5/NARGS" + "$L0" "$L1" "$L2" "$L3" "$L4" "$L5/ENV" "$L6/OLD-CONT" "$L7/CALL-NAME" + "$A0" "$A1" "$A2" "$A3" "$A4" "$A5" "$L14/ARGS" "$L15/LRA" + "$BSP" "$CSP" "$K0" "$K1" "$NULL" "$NSP" "$CODE" "$CONT")) (defvar *raw-register-names* - '#("$r0" "$r1" "$r2" "$r3" "$r4" "$r5" "$r6" "$r7" - "$r8" "$r9" "$r10" "$r12" "$r13" "$r14" "$r15" - "$r16" "$r17" "$r18" "$r19" "$r20" "$r21" "$r22" "$r23" - "$r24" "$r25" "$r26" "$r27" "$r28" "$r29" "$r30" "$r31")) + '#("$R0" "$R1" "$R2" "$R3" "$R4" "$R5" "$R6" "$R7" + "$R8" "$R9" "$R10" "$R12" "$R13" "$R14" "$R15" + "$R16" "$R17" "$R18" "$R19" "$R20" "$R21" "$R22" "$R23" + "$R24" "$R25" "$R26" "$R27" "$R28" "$R29" "$R30" "$R31")) (defun register-name (register-number) (unless (<= 0 register-number 31) @@ -99,8 +99,7 @@ (dolist (type ',types) (when (gethash type *mips-instruction-types*) (warn "Instruction type ~S being redefined" type)) - (setf (gethash type *mips-instruction-types*) - closure)))) + (setf (gethash type *mips-instruction-types*) closure)))) (defun mips-instruction-type-p (type) (not (not (gethash type *mips-instruction-types*)))) @@ -108,56 +107,65 @@ ;;;; Instruction Types +;;; +;;; Used later for relative branches. +(defvar *current-instruction-number* 0) + (def-mips-instruction-type (:ls-type) (let ((rs (ldb (byte 5 21) word)) (rt (ldb (byte 5 16) word)) (immed (signed-ldb (byte 16 0) word))) - (format stream "~8,8T~A~8,8T~A, #x~X(~A)~%" + (format stream "~16,8T~A~8,8T~A, #x~X(~A)~%" name (register-name rt) immed (register-name rs)))) (def-mips-instruction-type (:si-type) (let ((rs (ldb (byte 5 21) word)) (rt (ldb (byte 5 16) word)) (immed (signed-ldb (byte 16 0) word))) - (format stream "~8,8T~A~8,8T~A, ~A, #x~X~%" + (format stream "~16,8T~A~8,8T~A, ~A, #x~X~%" name (register-name rt) (register-name rs) immed))) (def-mips-instruction-type (:ui-type) (let ((rs (ldb (byte 5 21) word)) (rt (ldb (byte 5 16) word)) (immed (ldb (byte 16 0) word))) - (format stream "~8,8T~A~8,8T~A, ~A, #x~X~%" + (format stream "~16,8T~A~8,8T~A, ~A, #x~X~%" name (register-name rt) (register-name rs) immed))) (def-mips-instruction-type (:lui-type) (let ((rt (ldb (byte 5 16) word)) (immed (ldb (byte 16 0) word))) - (format stream "~8,8T~A~8,8T~A, #x~X~%" name (register-name rt) immed))) + (format stream "~16,8T~A~8,8T~A, #x~X~%" name (register-name rt) immed))) (def-mips-instruction-type (:j-type) (let ((target (ldb (byte 26 0) word))) - (format stream "~8,8T~A~8,8Ttarget = ~D~%" name target))) + (format stream "~16,8T~A~8,8Ttarget = ~D~%" name target))) (def-mips-instruction-type (:jr-type) (let ((rs (ldb (byte 5 21) word))) - (format stream "~8,8T~A~8,8T~A~%" name (register-name rs)))) + (format stream "~16,8T~A~8,8T~A~%" name (register-name rs)))) (def-mips-instruction-type (:jalr-type) (let ((rs (ldb (byte 5 21) word)) (rd (ldb (byte 5 11) word))) - (format stream "~8,8T~A~8,8T~A, ~A~%" name (register-name rd) (register-name rs)))) + (format stream "~16,8T~A~8,8T~A, ~A~%" name + (register-name rd) (register-name rs)))) + +(defun branch-target (offset) + (+ *current-instruction-number* offset 1)) (def-mips-instruction-type (:branch-type) (let ((rs (ldb (byte 5 21) word)) - (offset (ldb (byte 16 0) word))) - (format stream "~8,8T~A~8,8T~A, offset = ~D~%" name (register-name rs) offset))) + (offset (signed-ldb (byte 16 0) word))) + (format stream "~16,8T~A~8,8T~A, ~D~%" name + (register-name rs) (branch-target offset)))) (def-mips-instruction-type (:branch2-type) (let ((rs (ldb (byte 5 21) word)) (rt (ldb (byte 5 16) word)) - (offset (ldb (byte 16 0) word))) - (format stream "~8,8T~A~8,8T~A, ~A, offset = ~D~%" - name (register-name rs) (register-name rt) offset))) + (offset (signed-ldb (byte 16 0) word))) + (format stream "~16,8T~A~8,8T~A, ~A, ~D~%" name + (register-name rs) (register-name rt) (branch-target offset)))) (def-mips-instruction-type (:r3-type) (let ((rs (ldb (byte 5 21) word)) @@ -165,28 +173,29 @@ (rd (ldb (byte 5 11) word))) (cond ((zerop rd) ;; Hack for NOP - (format stream "~8,8TNOP~%")) + (format stream "~16,8TNOP~%")) ((and (zerop rt) (string= name "OR")) ;; Hack for MOVE - (format stream "~8,8TMOVE~8,8T~A, ~A~%" + (format stream "~16,8TMOVE~8,8T~A, ~A~%" (register-name rd) (register-name rs))) (t - (format stream "~8,8T~A~8,8T~A, ~A, ~A~%" + (format stream "~16,8T~A~8,8T~A, ~A, ~A~%" name (register-name rd) (register-name rs) (register-name rt)))))) (def-mips-instruction-type (:mf-type) (let ((rd (ldb (byte 5 11) word))) - (format stream "~8,8T~A~8,8T~A~%" name (register-name rd)))) + (format stream "~16,8T~A~8,8T~A~%" name (register-name rd)))) (def-mips-instruction-type (:mt-type) (let ((rs (ldb (byte 5 21) word))) - (format stream "~8,8T~A~8,8T~A~%" name (register-name rs)))) + (format stream "~16,8T~A~8,8T~A~%" name (register-name rs)))) (def-mips-instruction-type (:mult-type) (let ((rs (ldb (byte 5 21) word)) (rt (ldb (byte 5 16) word))) - (format stream "~8,8T~A~8,8T~A, ~A~%" name (register-name rs) (register-name rt)))) + (format stream "~16,8T~A~8,8T~A, ~A~%" name + (register-name rs) (register-name rt)))) (def-mips-instruction-type (:shift-type) (let ((rt (ldb (byte 5 16) word)) @@ -194,28 +203,28 @@ (shamt (ldb (byte 5 6) word))) ;; Hack for NOP (cond ((= word 0) - (format stream "~8,8TNOP~%")) + (format stream "~16,8TNOP~%")) (t - (format stream "~8,8T~A~8,8T~A, ~A, #x~X~%" + (format stream "~16,8T~A~8,8T~A, ~A, #x~X~%" name (register-name rd) (register-name rt) shamt))))) (def-mips-instruction-type (:shiftv-type) (let ((rs (ldb (byte 5 21) word)) (rt (ldb (byte 5 16) word)) (rd (ldb (byte 5 11) word))) - (format stream "~8,8T~A~8,8T~A, ~A, ~A~%" + (format stream "~16,8T~A~8,8T~A, ~A, ~A~%" name (register-name rd) (register-name rt) (register-name rs)))) (def-mips-instruction-type (:break-type) (let ((code (ldb (byte 20 6) word))) ; sandro's adb uses (byte 10 16) - (format stream "~8,8T~A~8,8T#x~X~%" name code))) + (format stream "~16,8T~A~8,8T#x~X~%" name code))) (def-mips-instruction-type (:syscall-type) (declare (ignore word)) - (format stream "~8,8T~A~%" name)) + (format stream "~16,8T~A~%" name)) (def-mips-instruction-type (:cop0-type :cop1-type :cop2-type :cop3-type) - (format stream "~8,8T~A~8,8T(#x~X)~%" name word)) + (format stream "~16,8T~A~8,8T(#x~X)~%" name word)) ;;;; Instruction Definition @@ -407,7 +416,7 @@ (let ((instr (mips-instruction word))) (unless instr (format stream "UNKNOWN INSTR (#x~X)~%" word) - (return-from disassemble-instruction)) + (return-from disassemble-instruction (values nil nil))) (let* ((instr-name (mips-instruction-name instr)) (instr-type (mips-instruction-type instr)) (closure (gethash instr-type *mips-instruction-types*))) @@ -415,16 +424,31 @@ (funcall closure instr-name word stream)) (t (format stream "UNKNOWN TYPE (~A/~S/#x~X)~%" - instr-name instr-type word)))))) + instr-name instr-type word))) + (values instr-name instr-type)))) ;;; Dissassemble-Code-Vector +(defconstant delay-slot-instruction-types + '(:j-type :jr-type :jalr-type :branch-type :branch2-type)) + (defun disassemble-code-vector (code-vector length &optional (stream t)) - (do ((i 0 (+ i 4))) + (do ((i 0 (+ i 4)) + (*current-instruction-number* 0 (1+ *current-instruction-number*)) + (instruction-in-delay-slot-p nil)) ((>= i length)) - (disassemble-instruction (+ (ash (aref code-vector i) 24) - (ash (aref code-vector (+ i 1)) 16) - (ash (aref code-vector (+ i 2)) 8) - (aref code-vector (+ i 3))) - stream))) + (unless instruction-in-delay-slot-p + (format stream "~6D:" *current-instruction-number*)) + (multiple-value-bind + (name type) + (disassemble-instruction (+ (ash (aref code-vector i) 24) + (ash (aref code-vector (+ i 1)) 16) + (ash (aref code-vector (+ i 2)) 8) + (aref code-vector (+ i 3))) + stream) + (declare (ignore name)) + (cond ((member type delay-slot-instruction-types :test #'eq) + (setf instruction-in-delay-slot-p t)) + (t + (setf instruction-in-delay-slot-p nil))))))