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

  ViewVC Help
Powered by ViewVC 1.1.5