/[cmucl]/src/code/pmax-disassem.lisp
ViewVC logotype

Contents of /src/code/pmax-disassem.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (show annotations)
Sat Jun 23 19:01:03 1990 UTC (23 years, 10 months ago) by wlott
Branch: MAIN
Changes since 1.11: +4 -4 lines
Fixed several proclaims.
1 ;;; -*- Mode: Lisp; Package: MIPS -*-
2 ;;;
3 ;;; $Header: /tiger/var/lib/cvsroots/cmucl/src/code/pmax-disassem.lisp,v 1.12 1990/06/23 19:01:03 wlott Exp $
4 ;;;
5 ;;; A simple dissambler for the MIPS R2000.
6 ;;;
7 ;;; Written by Christopher Hoover.
8 ;;;
9
10 (in-package "MIPS" :use '("LISP"))
11
12 (export '(register-name disassemble-code-vector))
13
14
15 ;;;; Instruction Layout
16
17 ;;;
18 ;;; Each instrunction on the MIPS R2000 consists of a single word (32
19 ;;; bits) aligned on a single word boundaray. There are three
20 ;;; instrunction formats:
21 ;;;
22 ;;; I-Type (Immediate)
23 ;;;
24 ;;; 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0
25 ;;; 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
26 ;;; ---------------------------------------------------------------
27 ;;; [ op ] [ rs ] [ rt ] [ immediate ]
28 ;;; ---------------------------------------------------------------
29 ;;;
30 ;;;
31 ;;; J-Type (Jump)
32 ;;;
33 ;;; 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0
34 ;;; 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
35 ;;; ---------------------------------------------------------------
36 ;;; [ op ] [ target ]
37 ;;; ---------------------------------------------------------------
38 ;;;
39 ;;;
40 ;;; R-Type (Register)
41 ;;;
42 ;;; 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0
43 ;;; 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
44 ;;; ---------------------------------------------------------------
45 ;;; [ op ] [ rs ] [ rt ] [ rd ] [ shmat ] [ funct ]
46 ;;; ---------------------------------------------------------------
47 ;;;
48 ;;; These instructions fall into 5 categories: Load/Store,
49 ;;; Computational, Jump/Branch, Coprocessor, and Special.
50 ;;;
51
52
53 ;;;; Register Names
54
55 (defparameter register-name-style :lisp
56 "The register name style: :c, :lisp, :raw")
57
58 (defvar *c-register-names*
59 '#("ZERO" "$AT" "$V0" "$V1" "$A0" "$A1" "$A2" "$A3"
60 "$T0" "$T1" "$T2" "$T3" "$T4" "$T5" "$T6" "$T7"
61 "$S0" "$S1" "$S2" "$S3" "$S4" "$S5" "$S6" "$S7"
62 "$T8" "$T9" "$K0" "$K1" "$GP" "$SP" "$S8" "$RA"))
63
64 (defvar *lisp-register-names*
65 '#("$ZERO" "$LIP" "$NL0" "$NL1" "$NL2" "$NL3" "$NL4" "$NARGS"
66 "$A0" "$A1" "$A2" "$A3" "$A4" "$A5" "$CNAME" "$LEXENV"
67 "$ARGS" "$OLDCONT" "$LRA" "$L0" "$NULL" "$BSP" "$CONT" "$CSP"
68 "$FLAGS" "$ALLOC" "$K0" "$K1" "$L1" "$NSP" "$CODE" "$L2"))
69
70 (defvar *raw-register-names*
71 '#("$R0" "$R1" "$R2" "$R3" "$R4" "$R5" "$R6" "$R7"
72 "$R8" "$R9" "$R10" "$R12" "$R13" "$R14" "$R15"
73 "$R16" "$R17" "$R18" "$R19" "$R20" "$R21" "$R22" "$R23"
74 "$R24" "$R25" "$R26" "$R27" "$R28" "$R29" "$R30" "$R31"))
75
76 (defun register-name (register-number)
77 (unless (<= 0 register-number 31)
78 (error "Illegal register number!"))
79 (let ((register-names (ecase register-name-style
80 (:c *c-register-names*)
81 (:lisp *lisp-register-names*)
82 (:raw *raw-register-names*))))
83 (svref register-names register-number)))
84
85
86 ;;;; Instruction Type Definition
87
88 ;;;
89 ;;; These instruction types correspond to the various ways the decoded
90 ;;; instructions are printed which in turn corresponds somewhat to the
91 ;;; way the instructions are decoded.
92 ;;;
93
94 (defvar *mips-instruction-types* (make-hash-table :test #'eq))
95
96 (defmacro def-mips-instruction-type (types &body body)
97 `(let ((closure #'(lambda (name word stream) ,@body)))
98 (dolist (type ',types)
99 (when (gethash type *mips-instruction-types*)
100 (warn "Instruction type ~S being redefined" type))
101 (setf (gethash type *mips-instruction-types*) closure))))
102
103 (defun mips-instruction-type-p (type)
104 (not (not (gethash type *mips-instruction-types*))))
105
106
107 ;;;; Instruction Types
108
109 ;;;
110 ;;; Used later for relative branches.
111 (defvar *current-instruction-number* 0)
112
113 (def-mips-instruction-type (:ls-type)
114 (let ((rs (ldb (byte 5 21) word))
115 (rt (ldb (byte 5 16) word))
116 (immed (signed-ldb (byte 16 0) word)))
117 (format stream "~16,8T~A~8,8T~A, #x~X(~A)~%"
118 name (register-name rt) immed (register-name rs))))
119
120 (def-mips-instruction-type (:si-type)
121 (let ((rs (ldb (byte 5 21) word))
122 (rt (ldb (byte 5 16) word))
123 (immed (signed-ldb (byte 16 0) word)))
124 (cond ((and (zerop rs) (or (string= name "ADDI") (string= name "ADDIU")))
125 (format stream "~16,8TLOADI~8,8T~A, #x~X~%"
126 (register-name rt) immed))
127 ((and (= rs c::null-offset) (string= name "ADDI")
128 (eq register-name-style :lisp))
129 ;; Major hack ...
130 (format stream "~16,8T~A~8,8T~A, ~A, #x~X~48,8T; ~S~%"
131 name (register-name rt) (register-name rs) immed
132 (vm:offset-static-symbol immed)))
133 (t
134 (format stream "~16,8T~A~8,8T~A, ~A, #x~X~%"
135 name (register-name rt) (register-name rs) immed)))))
136
137 (def-mips-instruction-type (:ui-type)
138 (let ((rs (ldb (byte 5 21) word))
139 (rt (ldb (byte 5 16) word))
140 (immed (ldb (byte 16 0) word)))
141 (cond ((and (zerop rs) (or (string= name "ORI") (string= name "XORI")))
142 (format stream "~16,8TLOADI~8,8T~A, #x~X~%"
143 (register-name rt) immed))
144 (t
145 (format stream "~16,8T~A~8,8T~A, ~A, #x~X~%"
146 name (register-name rt) (register-name rs) immed)))))
147
148 (def-mips-instruction-type (:lui-type)
149 (let ((rt (ldb (byte 5 16) word))
150 (immed (ldb (byte 16 0) word)))
151 (format stream "~16,8T~A~8,8T~A, #x~X~%" name (register-name rt) immed)))
152
153 (def-mips-instruction-type (:j-type)
154 (let ((target (ldb (byte 26 0) word)))
155 (format stream "~16,8T~A~8,8Ttarget = ~D~%" name target)))
156
157 (def-mips-instruction-type (:jr-type)
158 (let ((rs (ldb (byte 5 21) word)))
159 (format stream "~16,8T~A~8,8T~A~%" name (register-name rs))))
160
161 (def-mips-instruction-type (:jalr-type)
162 (let ((rs (ldb (byte 5 21) word))
163 (rd (ldb (byte 5 11) word)))
164 (format stream "~16,8T~A~8,8T~A, ~A~%" name
165 (register-name rd) (register-name rs))))
166
167 (defun branch-target (offset)
168 (+ *current-instruction-number* offset 1))
169
170 (def-mips-instruction-type (:branch-type)
171 (let ((rs (ldb (byte 5 21) word))
172 (offset (signed-ldb (byte 16 0) word)))
173 (format stream "~16,8T~A~8,8T~A, ~D~%" name
174 (register-name rs) (branch-target offset))))
175
176 (def-mips-instruction-type (:branch2-type)
177 (let* ((rs (ldb (byte 5 21) word))
178 (rt (ldb (byte 5 16) word))
179 (offset (signed-ldb (byte 16 0) word))
180 (target (branch-target offset)))
181 (cond ((and (zerop rs) (zerop rt) (string= name "BEQ"))
182 (format stream "~16,8TB~8,8T~D~%" target))
183 (t
184 (format stream "~16,8T~A~8,8T~A, ~A, ~D~%" name
185 (register-name rs) (register-name rt) target)))))
186
187 (def-mips-instruction-type (:r3-type)
188 (let ((rs (ldb (byte 5 21) word))
189 (rt (ldb (byte 5 16) word))
190 (rd (ldb (byte 5 11) word)))
191 (cond ((zerop rd)
192 ;; Hack for NOP
193 (format stream "~16,8TNOP~%"))
194 ((and (zerop rt) (or (string= name "OR") (string= name "ADDU")))
195 ;; Hack for MOVE
196 (format stream "~16,8TMOVE~8,8T~A, ~A~%"
197 (register-name rd) (register-name rs)))
198 (t
199 (format stream "~16,8T~A~8,8T~A, ~A, ~A~%"
200 name (register-name rd) (register-name rs)
201 (register-name rt))))))
202
203 (def-mips-instruction-type (:mf-type)
204 (let ((rd (ldb (byte 5 11) word)))
205 (format stream "~16,8T~A~8,8T~A~%" name (register-name rd))))
206
207 (def-mips-instruction-type (:mt-type)
208 (let ((rs (ldb (byte 5 21) word)))
209 (format stream "~16,8T~A~8,8T~A~%" name (register-name rs))))
210
211 (def-mips-instruction-type (:mult-type)
212 (let ((rs (ldb (byte 5 21) word))
213 (rt (ldb (byte 5 16) word)))
214 (format stream "~16,8T~A~8,8T~A, ~A~%" name
215 (register-name rs) (register-name rt))))
216
217 (def-mips-instruction-type (:shift-type)
218 (let ((rt (ldb (byte 5 16) word))
219 (rd (ldb (byte 5 11) word))
220 (shamt (ldb (byte 5 6) word)))
221 ;; Hack for NOP
222 (cond ((= word 0)
223 (format stream "~16,8TNOP~%"))
224 (t
225 (format stream "~16,8T~A~8,8T~A, ~A, #x~X~%"
226 name (register-name rd) (register-name rt) shamt)))))
227
228 (def-mips-instruction-type (:shiftv-type)
229 (let ((rs (ldb (byte 5 21) word))
230 (rt (ldb (byte 5 16) word))
231 (rd (ldb (byte 5 11) word)))
232 (format stream "~16,8T~A~8,8T~A, ~A, ~A~%"
233 name (register-name rd) (register-name rt) (register-name rs))))
234
235 (def-mips-instruction-type (:break-type)
236 (let ((code (ldb (byte 10 16) word))) ; The entire field is (byte 20 6)
237 (format stream "~16,8T~A~8,8T#x~X~%" name code)))
238
239 (def-mips-instruction-type (:syscall-type)
240 (declare (ignore word))
241 (format stream "~16,8T~A~%" name))
242
243 (def-mips-instruction-type (:cop0-type :cop1-type :cop2-type :cop3-type)
244 (format stream "~16,8T~A~8,8T(#x~X)~%" name word))
245
246
247 ;;;; Instruction Definition
248
249 (defstruct (mips-instruction
250 (:constructor make-mips-instruction (name type))
251 (:print-function %print-mips-instruction))
252 (name "" :type simple-string)
253 type)
254
255 (defun %print-mips-instruction (instr stream depth)
256 (declare (ignore depth))
257 (format stream "#<MIPS instruction ~A>" (mips-instruction-name instr)))
258
259
260 (defconstant mips-instruction-bits 6)
261
262 (defvar *mips-instructions*
263 (make-array (ash 1 mips-instruction-bits)))
264 (proclaim '(type simple-vector *mips-instructions*))
265
266 (defmacro def-mips-instr (name op-code type)
267 `(let ((name ,name)
268 (type ,type))
269 (unless (mips-instruction-type-p type)
270 (warn "~S is an unknown instruction type" type))
271 (setf (svref *mips-instructions* ,op-code)
272 (make-mips-instruction name ,type))
273 name))
274
275
276 (defconstant mips-special-instruction-bits 6)
277
278 (defvar *mips-special-instructions*
279 (make-array (ash 1 mips-special-instruction-bits)))
280 (proclaim '(type simple-vector *mips-special-instructions*))
281
282 (defmacro def-mips-special-instr (name op-code type)
283 `(let ((name ,name)
284 (type ,type))
285 (unless (mips-instruction-type-p type)
286 (warn "~S is an unknown instruction type" type))
287 (setf (svref *mips-special-instructions* ,op-code)
288 (make-mips-instruction name ,type))
289 name))
290
291
292 (defconstant mips-bcond-instruction-bits 6)
293
294 (defvar *mips-bcond-instructions*
295 (make-array (ash 1 mips-bcond-instruction-bits)))
296 (proclaim '(type simple-vector *mips-bcond-instructions*))
297
298 (defmacro def-mips-bcond-instr (name op-code type)
299 `(let ((name ,name)
300 (type ,type))
301 (unless (mips-instruction-type-p type)
302 (warn "~S is an unknown instruction type" type))
303 (setf (svref *mips-bcond-instructions* ,op-code)
304 (make-mips-instruction name ,type))
305 name))
306
307
308 ;;;; Normal Opcodes
309
310 (def-mips-instr "J" #b000010 :j-type)
311 (def-mips-instr "JAL" #b000011 :j-type)
312 (def-mips-instr "BEQ" #b000100 :branch2-type)
313 (def-mips-instr "BNE" #b000101 :branch2-type)
314 (def-mips-instr "BLEZ" #b000110 :branch-type)
315 (def-mips-instr "BGTZ" #b000111 :branch-type)
316
317 (def-mips-instr "ADDI" #b001000 :si-type)
318 (def-mips-instr "ADDIU" #b001001 :si-type)
319 (def-mips-instr "SLTI" #b001010 :si-type)
320 (def-mips-instr "SLTIU" #b001011 :si-type)
321 (def-mips-instr "ANDI" #b001100 :ui-type)
322 (def-mips-instr "ORI" #b001101 :ui-type)
323 (def-mips-instr "XORI" #b001110 :ui-type)
324 (def-mips-instr "LUI" #b001111 :lui-type)
325
326 (def-mips-instr "COP0" #b010000 :cop0-type)
327 (def-mips-instr "COP1" #b010001 :cop1-type)
328 (def-mips-instr "COP2" #b010010 :cop2-type)
329 (def-mips-instr "COP3" #b010011 :cop3-type)
330
331 (def-mips-instr "LB" #b100000 :ls-type)
332 (def-mips-instr "LH" #b100001 :ls-type)
333 (def-mips-instr "LWL" #b100010 :ls-type)
334 (def-mips-instr "LW" #b100011 :ls-type)
335 (def-mips-instr "LBU" #b100100 :ls-type)
336 (def-mips-instr "LHU" #b100101 :ls-type)
337 (def-mips-instr "LWR" #b100110 :ls-type)
338
339 (def-mips-instr "SB" #b101000 :ls-type)
340 (def-mips-instr "SH" #b101001 :ls-type)
341 (def-mips-instr "SWL" #b101010 :ls-type)
342 (def-mips-instr "SW" #b101011 :ls-type)
343 (def-mips-instr "SWR" #b101110 :ls-type)
344
345 (def-mips-instr "LWC0" #b110000 :cop0-type)
346 (def-mips-instr "LWC1" #b110001 :cop1-type)
347 (def-mips-instr "LWC2" #b110010 :cop2-type)
348 (def-mips-instr "LWC3" #b110011 :cop3-type)
349
350 (def-mips-instr "SWC0" #b111000 :cop0-type)
351 (def-mips-instr "SWC1" #b111001 :cop1-type)
352 (def-mips-instr "SWC2" #b111010 :cop2-type)
353 (def-mips-instr "SWC3" #b111011 :cop3-type)
354
355
356 ;;;; SPECIAL Opcodes
357
358 (defconstant special-op #b000000)
359
360 (def-mips-special-instr "SLL" #b000000 :shift-type)
361 (def-mips-special-instr "SRL" #b000010 :shift-type)
362 (def-mips-special-instr "SRA" #b000011 :shift-type)
363 (def-mips-special-instr "SLLV" #b000100 :shiftv-type)
364 (def-mips-special-instr "SRLV" #b000110 :shiftv-type)
365 (def-mips-special-instr "SRAV" #b000111 :shiftv-type)
366
367 (def-mips-special-instr "JR" #b001000 :jr-type)
368 (def-mips-special-instr "JALR" #b001001 :jalr-type)
369 (def-mips-special-instr "SYSCALL" #b001100 :syscall-type)
370 (def-mips-special-instr "BREAK" #b001101 :break-type)
371
372 (def-mips-special-instr "MFHI" #b010000 :mf-type)
373 (def-mips-special-instr "MTHI" #b010001 :mt-type)
374 (def-mips-special-instr "MFLO" #b010010 :mf-type)
375 (def-mips-special-instr "MTLO" #b010011 :mt-type)
376
377 (def-mips-special-instr "MULT" #b011000 :mult-type)
378 (def-mips-special-instr "MULTU" #b011001 :mult-type)
379 (def-mips-special-instr "DIV" #b011010 :mult-type)
380 (def-mips-special-instr "DIVU" #b011011 :mult-type)
381
382 (def-mips-special-instr "ADD" #b100000 :r3-type)
383 (def-mips-special-instr "ADDU" #b100001 :r3-type)
384 (def-mips-special-instr "SUB" #b100010 :r3-type)
385 (def-mips-special-instr "SUBU" #b100011 :r3-type)
386 (def-mips-special-instr "AND" #b100100 :r3-type)
387 (def-mips-special-instr "OR" #b100101 :r3-type)
388 (def-mips-special-instr "XOR" #b100110 :r3-type)
389 (def-mips-special-instr "NOR" #b100111 :r3-type)
390
391 (def-mips-special-instr "SLT" #b101010 :r3-type)
392 (def-mips-special-instr "SLTU" #b101011 :r3-type)
393
394
395 ;;;; BCOND Opcodes
396
397 (defconstant bcond-op #b000001)
398
399 (def-mips-bcond-instr "BLTZ" #b00000 :branch-type)
400 (def-mips-bcond-instr "BLTZAL" #b00001 :branch-type)
401
402 (def-mips-bcond-instr "BLTZAL" #b10000 :branch-type)
403 (def-mips-bcond-instr "BGEZAL" #b10001 :branch-type)
404
405
406 ;;;; Signed-Ldb
407
408 (defun signed-ldb (byte-spec integer)
409 (let ((unsigned (ldb byte-spec integer))
410 (length (byte-size byte-spec)))
411 (if (logbitp (1- length) unsigned)
412 (- unsigned (ash 1 length))
413 unsigned)))
414
415
416 ;;;; Instruction Decoding
417
418 (defun mips-instruction (word)
419 (let* ((opcode (ldb (byte 6 26) word)))
420 (cond ((= opcode special-op)
421 (let ((function (ldb (byte 6 0) word)))
422 (svref *mips-special-instructions* function)))
423 ((= opcode bcond-op)
424 (let ((cond (ldb (byte 5 16) word)))
425 (svref *mips-bcond-instructions* cond)))
426 (t
427 (svref *mips-instructions* opcode)))))
428
429
430 ;;;; Disassemble-Instruction
431
432 (defun disassemble-instruction (word &optional (stream t))
433 (let* ((instr (mips-instruction word)))
434 (cond (instr
435 (let* ((instr-name (mips-instruction-name instr))
436 (instr-type (mips-instruction-type instr))
437 (closure (gethash instr-type *mips-instruction-types*)))
438 (cond (closure
439 (funcall closure instr-name word stream))
440 (t
441 (format stream "UNKNOWN TYPE (~A/~S/#x~X)~%"
442 instr-name instr-type word)))
443 (values instr-name instr-type)))
444 (t
445 (format stream "~16,8TDATA~8,8T#x~X~%" word)
446 (return-from disassemble-instruction (values nil nil))))))
447
448
449
450 ;;; Dissassemble-Code-Vector
451
452 (defconstant delay-slot-instruction-types
453 '(:j-type :jr-type :jalr-type :branch-type :branch2-type))
454
455 (defun disassemble-code-vector (code-vector length &optional (stream t))
456 (do ((i 0 (+ i 4))
457 (*current-instruction-number* 0 (1+ *current-instruction-number*))
458 (instruction-in-delay-slot-p nil))
459 ((>= i length))
460 (unless instruction-in-delay-slot-p
461 (format stream "~6D:" *current-instruction-number*))
462 (multiple-value-bind
463 (name type)
464 (disassemble-instruction (logior (aref code-vector i)
465 (ash (aref code-vector (+ i 1)) 8)
466 (ash (aref code-vector (+ i 2)) 16)
467 (ash (aref code-vector (+ i 3)) 24))
468 stream)
469 (declare (ignore name))
470 (cond ((member type delay-slot-instruction-types :test #'eq)
471 (setf instruction-in-delay-slot-p t))
472 (t
473 (setf instruction-in-delay-slot-p nil))))))

  ViewVC Help
Powered by ViewVC 1.1.5