/[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.2 - (show annotations)
Sat Feb 3 18:05:04 1990 UTC (24 years, 2 months ago) by wlott
Branch: MAIN
Changes since 1.1: +37 -26 lines
Added more hacks for NOP and MOVE.
Added lisp register names.
1 ;;; -*- Mode: Lisp; Package: MIPS -*-
2 ;;;
3 ;;; $Header: /tiger/var/lib/cvsroots/cmucl/src/code/pmax-disassem.lisp,v 1.2 1990/02/03 18:05:04 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
13 ;;;; Instruction Layout
14
15 ;;;
16 ;;; Each instrunction on the MIPS R2000 consists of a single word (32
17 ;;; bits) aligned on a single word boundaray. There are three
18 ;;; instrunction formats:
19 ;;;
20 ;;; I-Type (Immediate)
21 ;;;
22 ;;; 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
23 ;;; 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
24 ;;; ---------------------------------------------------------------
25 ;;; [ op ] [ rs ] [ rt ] [ immediate ]
26 ;;; ---------------------------------------------------------------
27 ;;;
28 ;;;
29 ;;; J-Type (Jump)
30 ;;;
31 ;;; 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
32 ;;; 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
33 ;;; ---------------------------------------------------------------
34 ;;; [ op ] [ target ]
35 ;;; ---------------------------------------------------------------
36 ;;;
37 ;;;
38 ;;; R-Type (Register)
39 ;;;
40 ;;; 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
41 ;;; 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
42 ;;; ---------------------------------------------------------------
43 ;;; [ op ] [ rs ] [ rt ] [ rd ] [ shmat ] [ funct ]
44 ;;; ---------------------------------------------------------------
45 ;;;
46 ;;; These instructions fall into 5 categories: Load/Store,
47 ;;; Computational, Jump/Branch, Coprocessor, and Special.
48 ;;;
49
50
51 ;;;; Register Names
52
53 (defparameter register-name-style :lisp
54 "The register name style: :c, :lisp, :raw")
55
56 (defvar *c-register-names*
57 '#("zero" "$at" "$v0" "$v1" "$a0" "$a1" "$a2" "$a3"
58 "$t0" "$t1" "$t2" "$t3" "$t4" "$t5" "$t6" "$t7"
59 "$s0" "$s1" "$s2" "$s3" "$s4" "$s5" "$s6" "$s7"
60 "$t8" "$t9" "$k0" "$k1" "$gp" "$sp" "$s8" "$ra"))
61
62 (defvar *lisp-register-names*
63 '#("$zero" "$lip" "$nl0" "$nl1" "$nl2" "$nl3" "$nl4" "$nl5/nargs"
64 "$l0" "$l1" "$l2" "$l3" "$l4" "$l5/env" "$l6/old-cont" "$l7/call-name"
65 "$a0" "$a1" "$a2" "$a3" "$a4" "$a5" "$l14/args" "$l15/lra"
66 "$bsp" "$csp" "$k0" "$k1" "$null" "$nsp" "$code" "$cont"))
67
68 (defvar *raw-register-names*
69 '#("$r0" "$r1" "$r2" "$r3" "$r4" "$r5" "$r6" "$r7"
70 "$r8" "$r9" "$r10" "$r12" "$r13" "$r14" "$r15"
71 "$r16" "$r17" "$r18" "$r19" "$r20" "$r21" "$r22" "$r23"
72 "$r24" "$r25" "$r26" "$r27" "$r28" "$r29" "$r30" "$r31"))
73
74 (defun register-name (register-number)
75 (unless (<= 0 register-number 31)
76 (error "Illegal register number!"))
77 (let ((register-names (ecase register-name-style
78 (:c
79 *c-register-names*)
80 (:lisp
81 *lisp-register-names*)
82 (:raw
83 *raw-register-names*))))
84 (svref register-names register-number)))
85
86
87 ;;;; Instruction Type Definition
88
89 ;;;
90 ;;; These instruction types correspond to the various ways the decoded
91 ;;; instructions are printed which in turn corresponds somewhat to the
92 ;;; way the instructions are decoded.
93 ;;;
94
95 (defvar *mips-instruction-types* (make-hash-table :test #'eq))
96
97 (defmacro def-mips-instruction-type (types &body body)
98 `(let ((closure #'(lambda (name word stream) ,@body)))
99 (dolist (type ',types)
100 (when (gethash type *mips-instruction-types*)
101 (warn "Instruction type ~S being redefined" type))
102 (setf (gethash type *mips-instruction-types*)
103 closure))))
104
105 (defun mips-instruction-type-p (type)
106 (not (not (gethash type *mips-instruction-types*))))
107
108
109 ;;;; Instruction Types
110
111 (def-mips-instruction-type (:ls-type)
112 (let ((rs (ldb (byte 5 21) word))
113 (rt (ldb (byte 5 16) word))
114 (immed (signed-ldb (byte 16 0) word)))
115 (format stream "~8,8T~A~8,8T~A, #x~X(~A)~%"
116 name (register-name rt) immed (register-name rs))))
117
118 (def-mips-instruction-type (:si-type)
119 (let ((rs (ldb (byte 5 21) word))
120 (rt (ldb (byte 5 16) word))
121 (immed (signed-ldb (byte 16 0) word)))
122 (format stream "~8,8T~A~8,8T~A, ~A, #x~X~%"
123 name (register-name rt) (register-name rs) immed)))
124
125 (def-mips-instruction-type (:ui-type)
126 (let ((rs (ldb (byte 5 21) word))
127 (rt (ldb (byte 5 16) word))
128 (immed (ldb (byte 16 0) word)))
129 (format stream "~8,8T~A~8,8T~A, ~A, #x~X~%"
130 name (register-name rt) (register-name rs) immed)))
131
132 (def-mips-instruction-type (:lui-type)
133 (let ((rt (ldb (byte 5 16) word))
134 (immed (ldb (byte 16 0) word)))
135 (format stream "~8,8T~A~8,8T~A, #x~X~%" name (register-name rt) immed)))
136
137 (def-mips-instruction-type (:j-type)
138 (let ((target (ldb (byte 26 0) word)))
139 (format stream "~8,8T~A~8,8Ttarget = ~D~%" name target)))
140
141 (def-mips-instruction-type (:jr-type)
142 (let ((rs (ldb (byte 5 21) word)))
143 (format stream "~8,8T~A~8,8T~A~%" name (register-name rs))))
144
145 (def-mips-instruction-type (:jalr-type)
146 (let ((rs (ldb (byte 5 21) word))
147 (rd (ldb (byte 5 11) word)))
148 (format stream "~8,8T~A~8,8T~A, ~A~%" name (register-name rd) (register-name rs))))
149
150 (def-mips-instruction-type (:branch-type)
151 (let ((rs (ldb (byte 5 21) word))
152 (offset (ldb (byte 16 0) word)))
153 (format stream "~8,8T~A~8,8T~A, offset = ~D~%" name (register-name rs) offset)))
154
155 (def-mips-instruction-type (:branch2-type)
156 (let ((rs (ldb (byte 5 21) word))
157 (rt (ldb (byte 5 16) word))
158 (offset (ldb (byte 16 0) word)))
159 (format stream "~8,8T~A~8,8T~A, ~A, offset = ~D~%"
160 name (register-name rs) (register-name rt) offset)))
161
162 (def-mips-instruction-type (:r3-type)
163 (let ((rs (ldb (byte 5 21) word))
164 (rt (ldb (byte 5 16) word))
165 (rd (ldb (byte 5 11) word)))
166 (cond ((zerop rd)
167 ;; Hack for NOP
168 (format stream "~8,8TNOP~%"))
169 ((and (zerop rt) (string= name "OR"))
170 ;; Hack for MOVE
171 (format stream "~8,8TMOVE~8,8T~A, ~A~%"
172 (register-name rd) (register-name rs)))
173 (t
174 (format stream "~8,8T~A~8,8T~A, ~A, ~A~%"
175 name (register-name rd) (register-name rs)
176 (register-name rt))))))
177
178 (def-mips-instruction-type (:mf-type)
179 (let ((rd (ldb (byte 5 11) word)))
180 (format stream "~8,8T~A~8,8T~A~%" name (register-name rd))))
181
182 (def-mips-instruction-type (:mt-type)
183 (let ((rs (ldb (byte 5 21) word)))
184 (format stream "~8,8T~A~8,8T~A~%" name (register-name rs))))
185
186 (def-mips-instruction-type (:mult-type)
187 (let ((rs (ldb (byte 5 21) word))
188 (rt (ldb (byte 5 16) word)))
189 (format stream "~8,8T~A~8,8T~A, ~A~%" name (register-name rs) (register-name rt))))
190
191 (def-mips-instruction-type (:shift-type)
192 (let ((rt (ldb (byte 5 16) word))
193 (rd (ldb (byte 5 11) word))
194 (shamt (ldb (byte 5 6) word)))
195 ;; Hack for NOP
196 (cond ((= word 0)
197 (format stream "~8,8TNOP~%"))
198 (t
199 (format stream "~8,8T~A~8,8T~A, ~A, #x~X~%"
200 name (register-name rd) (register-name rt) shamt)))))
201
202 (def-mips-instruction-type (:shiftv-type)
203 (let ((rs (ldb (byte 5 21) word))
204 (rt (ldb (byte 5 16) word))
205 (rd (ldb (byte 5 11) word)))
206 (format stream "~8,8T~A~8,8T~A, ~A, ~A~%"
207 name (register-name rd) (register-name rt) (register-name rs))))
208
209 (def-mips-instruction-type (:break-type)
210 (let ((code (ldb (byte 10 16) word))) ; the whole field is (byte 20 6)
211 (format stream "~8,8T~A~8,8T#x~X~%" name code)))
212
213 (def-mips-instruction-type (:syscall-type)
214 (declare (ignore word))
215 (format stream "~8,8T~A~%" name))
216
217 (def-mips-instruction-type (:cop0-type :cop1-type :cop2-type :cop3-type)
218 (format stream "~8,8T~A~8,8T(#x~X)~%" name word))
219
220
221 ;;;; Instruction Definition
222
223 (defstruct (mips-instruction
224 (:constructor make-mips-instruction (name type))
225 (:print-function %print-mips-instruction))
226 (name "" :type simple-string)
227 type)
228
229 (defun %print-mips-instruction (instr stream depth)
230 (declare (ignore depth))
231 (format stream "#<MIPS instruction ~A>" (mips-instruction-name instr)))
232
233
234 (defconstant mips-instruction-bits 6)
235
236 (defvar *mips-instructions*
237 (make-array (ash 1 mips-instruction-bits)))
238 (proclaim '(type *mips-instructions* 'simple-vector))
239
240 (defmacro def-mips-instr (name op-code type)
241 `(let ((name ,name)
242 (type ,type))
243 (unless (mips-instruction-type-p type)
244 (warn "~S is an unknown instruction type" type))
245 (setf (svref *mips-instructions* ,op-code)
246 (make-mips-instruction name ,type))
247 name))
248
249
250 (defconstant mips-special-instruction-bits 6)
251
252 (defvar *mips-special-instructions*
253 (make-array (ash 1 mips-special-instruction-bits)))
254 (proclaim '(type *mips-special-instructions* 'simple-vector))
255
256 (defmacro def-mips-special-instr (name op-code type)
257 `(let ((name ,name)
258 (type ,type))
259 (unless (mips-instruction-type-p type)
260 (warn "~S is an unknown instruction type" type))
261 (setf (svref *mips-special-instructions* ,op-code)
262 (make-mips-instruction name ,type))
263 name))
264
265
266 (defconstant mips-bcond-instruction-bits 6)
267
268 (defvar *mips-bcond-instructions*
269 (make-array (ash 1 mips-bcond-instruction-bits)))
270 (proclaim '(type *mips-bcond-instructions* 'simple-vector))
271
272 (defmacro def-mips-bcond-instr (name op-code type)
273 `(let ((name ,name)
274 (type ,type))
275 (unless (mips-instruction-type-p type)
276 (warn "~S is an unknown instruction type" type))
277 (setf (svref *mips-bcond-instructions* ,op-code)
278 (make-mips-instruction name ,type))
279 name))
280
281
282 ;;;; Normal Opcodes
283
284 (def-mips-instr "J" #b000010 :j-type)
285 (def-mips-instr "JAL" #b000011 :j-type)
286 (def-mips-instr "BEQ" #b000100 :branch2-type)
287 (def-mips-instr "BNE" #b000101 :branch2-type)
288 (def-mips-instr "BLEZ" #b000110 :branch-type)
289 (def-mips-instr "BGTZ" #b000111 :branch-type)
290
291 (def-mips-instr "ADDI" #b001000 :si-type)
292 (def-mips-instr "ADDIU" #b001001 :si-type)
293 (def-mips-instr "SLTI" #b001010 :si-type)
294 (def-mips-instr "SLTIU" #b001011 :si-type)
295 (def-mips-instr "ANDI" #b001100 :ui-type)
296 (def-mips-instr "ORI" #b001101 :ui-type)
297 (def-mips-instr "XORI" #b001110 :ui-type)
298 (def-mips-instr "LUI" #b001111 :lui-type)
299
300 (def-mips-instr "COP0" #b010000 :cop0-type)
301 (def-mips-instr "COP1" #b010001 :cop1-type)
302 (def-mips-instr "COP2" #b010010 :cop2-type)
303 (def-mips-instr "COP3" #b010011 :cop3-type)
304
305 (def-mips-instr "LB" #b100000 :ls-type)
306 (def-mips-instr "LH" #b100001 :ls-type)
307 (def-mips-instr "LWL" #b100010 :ls-type)
308 (def-mips-instr "LW" #b100011 :ls-type)
309 (def-mips-instr "LBU" #b100100 :ls-type)
310 (def-mips-instr "LHU" #b100101 :ls-type)
311 (def-mips-instr "LWR" #b100110 :ls-type)
312
313 (def-mips-instr "SB" #b101000 :ls-type)
314 (def-mips-instr "SH" #b101001 :ls-type)
315 (def-mips-instr "SWL" #b101010 :ls-type)
316 (def-mips-instr "SW" #b101011 :ls-type)
317 (def-mips-instr "SWR" #b101110 :ls-type)
318
319 (def-mips-instr "LWC0" #b110000 :cop0-type)
320 (def-mips-instr "LWC1" #b110001 :cop1-type)
321 (def-mips-instr "LWC2" #b110010 :cop2-type)
322 (def-mips-instr "LWC3" #b110011 :cop3-type)
323
324 (def-mips-instr "SWC0" #b111000 :cop0-type)
325 (def-mips-instr "SWC1" #b111001 :cop1-type)
326 (def-mips-instr "SWC2" #b111010 :cop2-type)
327 (def-mips-instr "SWC3" #b111011 :cop3-type)
328
329
330 ;;;; SPECIAL Opcodes
331
332 (defconstant special-op #b000000)
333
334 (def-mips-special-instr "SLL" #b000000 :shift-type)
335 (def-mips-special-instr "SRL" #b000010 :shift-type)
336 (def-mips-special-instr "SRA" #b000011 :shift-type)
337 (def-mips-special-instr "SLLV" #b000100 :shiftv-type)
338 (def-mips-special-instr "SRLV" #b000110 :shiftv-type)
339 (def-mips-special-instr "SRAV" #b000111 :shiftv-type)
340
341 (def-mips-special-instr "JR" #b001000 :jr-type)
342 (def-mips-special-instr "JALR" #b001001 :jalr-type)
343 (def-mips-special-instr "SYSCALL" #b001100 :syscall-type)
344 (def-mips-special-instr "BREAK" #b001101 :break-type)
345
346 (def-mips-special-instr "MFHI" #b010000 :mf-type)
347 (def-mips-special-instr "MTHI" #b010001 :mt-type)
348 (def-mips-special-instr "MFLO" #b010010 :mf-type)
349 (def-mips-special-instr "MTLO" #b010011 :mt-type)
350
351 (def-mips-special-instr "MULT" #b011000 :mult-type)
352 (def-mips-special-instr "MULTU" #b011001 :mult-type)
353 (def-mips-special-instr "DIV" #b011010 :mult-type)
354 (def-mips-special-instr "DIVU" #b011011 :mult-type)
355
356 (def-mips-special-instr "ADD" #b100000 :r3-type)
357 (def-mips-special-instr "ADDU" #b100001 :r3-type)
358 (def-mips-special-instr "SUB" #b100010 :r3-type)
359 (def-mips-special-instr "SUBU" #b100011 :r3-type)
360 (def-mips-special-instr "AND" #b100100 :r3-type)
361 (def-mips-special-instr "OR" #b100101 :r3-type)
362 (def-mips-special-instr "XOR" #b100110 :r3-type)
363 (def-mips-special-instr "NOR" #b100111 :r3-type)
364
365 (def-mips-special-instr "SLT" #b101010 :r3-type)
366 (def-mips-special-instr "SLTU" #b101011 :r3-type)
367
368
369 ;;;; BCOND Opcodes
370
371 (defconstant bcond-op #b000001)
372
373 (def-mips-bcond-instr "BLTZ" #b00000 :branch-type)
374 (def-mips-bcond-instr "BLTZAL" #b00001 :branch-type)
375
376 (def-mips-bcond-instr "BLTZAL" #b10000 :branch-type)
377 (def-mips-bcond-instr "BGEZAL" #b10001 :branch-type)
378
379
380 ;;;; Signed-Ldb
381
382 (defun signed-ldb (byte-spec integer)
383 (let ((unsigned (ldb byte-spec integer))
384 (length (byte-size byte-spec)))
385 (if (logbitp (1- length) unsigned)
386 (- unsigned (ash 1 length))
387 unsigned)))
388
389
390 ;;;; Instruction Decoding
391
392 (defun mips-instruction (word)
393 (let* ((opcode (ldb (byte 6 26) word)))
394 (cond ((= opcode special-op)
395 (let ((function (ldb (byte 6 0) word)))
396 (svref *mips-special-instructions* function)))
397 ((= opcode bcond-op)
398 (let ((cond (ldb (byte 5 16) word)))
399 (svref *mips-bcond-instructions* cond)))
400 (t
401 (svref *mips-instructions* opcode)))))
402
403
404 ;;;; Disassemble-Instruction
405
406 (defun disassemble-instruction (word &optional (stream t))
407 (let ((instr (mips-instruction word)))
408 (unless instr
409 (format stream "UNKNOWN INSTR (#x~X)~%" word)
410 (return-from disassemble-instruction))
411 (let* ((instr-name (mips-instruction-name instr))
412 (instr-type (mips-instruction-type instr))
413 (closure (gethash instr-type *mips-instruction-types*)))
414 (cond (closure
415 (funcall closure instr-name word stream))
416 (t
417 (format stream "UNKNOWN TYPE (~A/~S/#x~X)~%"
418 instr-name instr-type word))))))
419
420
421 ;;; Dissassemble-Code-Vector
422
423 (defun disassemble-code-vector (code-vector length &optional (stream t))
424 (do ((i 0 (+ i 4)))
425 ((>= i length))
426 (disassemble-instruction (+ (ash (aref code-vector i) 24)
427 (ash (aref code-vector (+ i 1)) 16)
428 (ash (aref code-vector (+ i 2)) 8)
429 (aref code-vector (+ i 3)))
430 stream)))

  ViewVC Help
Powered by ViewVC 1.1.5