Annotation of gforth/arch/mips/disasm.fs, revision 1.9
1.1 anton 1: \ disasm.fs disassembler file (for MIPS R3000)
2: \
3: \ Copyright (C) 1995-97 Martin Anton Ertl, Christian Pirker
4: \
5: \ This file is part of RAFTS.
6: \
7: \ RAFTS is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
9: \ as published by the Free Software Foundation; either version 2
10: \ of the License, or (at your option) any later version.
11: \
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16: \
17: \ You should have received a copy of the GNU General Public License
18: \ along with this program; if not, write to the Free Software
19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20:
1.4 anton 21: \ this disassembler is based on data from the R4400 manual
22: \ http://www.mips.com/Documentation/R4400_Uman_book_Ed2.pdf, in
1.6 anton 23: \ particular pages A3, A181, A182 (p. 471, 649, 650 in xpdf).
1.4 anton 24: \ it is limited to the R3000 (MIPS-I) architecture, though.
1.2 anton 25:
1.7 anton 26: \ test this with
1.9 ! anton 27: \ gforth arch/mips/disasm.fs -e "here" arch/mips/testdisasm.fs -e "here over - disasm bye" |sed 's/([^)]*) //'|diff -u - arch/mips/testasm.fs
1.7 anton 28:
1.8 anton 29: get-current
30: vocabulary disassembler
31: also disassembler definitions
32:
1.4 anton 33: \ instruction fields
1.3 anton 34:
35: : disasm-op ( w -- u )
36: 26 rshift ;
37:
38: : disasm-rs ( w -- u )
39: 21 rshift $1F and ;
40:
41: : disasm-rt ( w -- u )
42: 16 rshift $1f and ;
43:
44: : disasm-rd ( w -- u )
45: 11 rshift $1f and ;
46:
47: : disasm-shamt ( w -- u )
48: \ shift amount field
49: 6 rshift $1f and ;
50:
51: : disasm-funct ( w -- u )
52: $3f and ;
53:
54: : disasm-copz ( w -- u )
55: disasm-op 3 and ;
56:
1.5 anton 57: : disasm-uimm ( w -- u )
58: $ffff and ;
59:
1.3 anton 60: : disasm-imm ( w -- n )
1.5 anton 61: disasm-uimm dup 15 rshift negate 15 lshift or ;
1.3 anton 62:
63: : disasm-relative ( addr n -- w )
64: \ compute printable form of relative address n relative to addr
1.6 anton 65: 2 lshift nip ( + ) ;
1.3 anton 66:
1.4 anton 67: \ decode tables
68:
69: : disasm-illegal ( addr w -- )
70: \ disassemble illegal/unknown instruction w at addr
71: hex. ." , ( illegal inst ) " drop ;
72:
73: : disasm-table ( n "name" -- )
74: \ initialize table with n entries with disasm-illegal
75: create 0 ?do
76: ['] disasm-illegal ,
77: loop
78: does> ( u -- addr )
79: swap cells + ;
80:
81: $40 disasm-table opc-tab-entry \ top-level decode table
82: $40 disasm-table funct-tab-entry \ special function table
83: $20 disasm-table regimm-tab-entry \ regim instructions rt table
84: $20 disasm-table copz-rs-tab-entry \ COPz instructions rs table
85: $20 disasm-table copz-rt-tab-entry \ COPz BC instructions rt table
86: $40 disasm-table cp0-tab-entry \ COP0 CO instructions funct table
87:
1.3 anton 88: \ disassembler central decode cascade
89:
1.8 anton 90: dup set-current
91:
1.3 anton 92: : disasm-inst ( addr w -- )
93: \G disassemble instruction w at addr (addr is used for computing
94: \G branch targets)
1.4 anton 95: dup disasm-op opc-tab-entry @ execute ;
1.3 anton 96:
1.9 ! anton 97: : disasm ( addr u -- ) \ gforth
1.3 anton 98: \G disassemble u aus starting at addr
99: bounds u+do
100: cr ." ( " i hex. ." ) " i i @ disasm-inst
101: 1 cells +loop ;
102:
1.8 anton 103: definitions
104:
1.3 anton 105: : disasm-special ( addr w -- )
106: \ disassemble inst with opcode special
1.4 anton 107: dup disasm-funct funct-tab-entry @ execute ;
108: ' disasm-special 0 opc-tab-entry ! \ enter it for opcode special
1.3 anton 109:
110: : disasm-regimm ( addr w -- )
111: \ disassemble regimm inst
1.4 anton 112: dup disasm-rt regimm-tab-entry @ execute ;
113: ' disasm-regimm 1 opc-tab-entry ! \ enter it for opcode regimm
1.3 anton 114:
115: : disasm-copz-rs ( addr w -- )
116: \ disassemble inst with opcode COPz
1.4 anton 117: dup disasm-rs copz-rs-tab-entry @ execute ;
118: ' disasm-copz-rs $10 opc-tab-entry ! \ enter it for opcodes COPz
119: ' disasm-copz-rs $11 opc-tab-entry !
120: ' disasm-copz-rs $12 opc-tab-entry !
1.3 anton 121:
122: : disasm-copz-rt ( addr w -- )
123: \ disassemble inst with opcode COPz, rs=BC
1.4 anton 124: dup disasm-rt copz-rt-tab-entry @ execute ;
125: ' disasm-copz-rt $08 copz-rs-tab-entry ! \ into COPz-table for rs=BC
1.3 anton 126:
127: : disasm-cp0 ( addr w -- )
128: \ disassemble inst with opcode COPz, rs=CO
1.4 anton 129: dup disasm-funct cp0-tab-entry @ execute ;
130: ' disasm-cp0 $10 copz-rs-tab-entry ! \ into COPz-table for rs=CO
1.3 anton 131:
1.4 anton 132: \ dummy words for insts.fs (words with these names are needed by asm.fs)
1.3 anton 133:
134: : asm-op ( -- ) ;
1.4 anton 135: : asm-rs ( -- ) ;
136: : asm-rt ( -- ) ;
137:
138: \ disassemble various formats
1.3 anton 139:
140: : disasm-J-target ( addr w -- )
141: \ print jump target
1.7 anton 142: 2 lshift $0fffffff and swap $f0000000 and or hex. ;
1.3 anton 143:
144: : disasm-I-rs,rt,imm ( addr w -- )
145: dup disasm-rs .
146: dup disasm-rt .
147: disasm-imm disasm-relative . ;
148:
149: : disasm-I-rs,imm ( addr w -- )
150: dup disasm-rs .
151: disasm-imm disasm-relative . ;
152:
153: : disasm-rt,rs,imm ( addr w -- )
154: dup disasm-rt .
155: dup disasm-rs .
156: disasm-imm .
157: drop ;
1.1 anton 158:
1.5 anton 159: : disasm-rt,rs,uimm ( addr w -- )
1.3 anton 160: dup disasm-rt .
1.5 anton 161: dup disasm-rs .
162: disasm-uimm hex.
163: drop ;
164:
165: : disasm-rt,uimm ( addr w -- )
166: dup disasm-rt .
167: disasm-uimm hex.
1.1 anton 168: drop ;
169:
1.3 anton 170: : disasm-rt,imm,rs ( addr w -- )
171: dup disasm-rt .
172: dup disasm-imm .
173: dup disasm-rs .
174: 2drop ;
175:
176: : disasm-rd,rt,sa ( addr w -- )
177: dup disasm-rd .
178: dup disasm-rt .
179: dup disasm-shamt .
180: 2drop ;
181:
182: : disasm-rd,rt,rs ( addr w -- )
183: dup disasm-rd .
184: dup disasm-rt .
185: dup disasm-rs .
186: 2drop ;
187:
188: : disasm-rs. ( addr w -- )
189: dup disasm-rs .
190: 2drop ;
191:
192: : disasm-rd,rs ( addr w -- )
193: dup disasm-rd .
194: dup disasm-rs .
195: 2drop ;
196:
197: : disasm-rd. ( addr w -- )
198: dup disasm-rd .
199: 2drop ;
200:
201: : disasm-rs,rt ( addr w -- )
202: dup disasm-rs .
203: dup disasm-rt .
204: 2drop ;
205:
206: : disasm-rd,rs,rt ( addr w -- )
207: dup disasm-rd .
208: dup disasm-rs .
209: dup disasm-rt .
210: 2drop ;
211:
212: : disasm-rt,rd,z ( addr w -- )
213: dup disasm-rt .
214: dup disasm-rd .
215: dup disasm-copz .
216: 2drop ;
217:
1.5 anton 218: : disasm-I-imm,z ( addr w -- )
219: tuck disasm-imm disasm-relative .
220: disasm-copz . ;
1.4 anton 221:
222: \ meta-defining word for instruction format disassembling definitions
223:
224: \ The following word defines instruction-format words, which in turn
225: \ define anonymous words for disassembling specific instructions and
226: \ put them in the appropriate decode table.
227:
228: : define-format ( disasm-xt table-xt -- )
229: \ define an instruction format that uses disasm-xt for
230: \ disassembling and enters the defined instructions into table
231: \ table-xt
232: create 2,
233: does> ( u "inst" -- )
234: \ defines an anonymous word for disassembling instruction inst,
235: \ and enters it as u-th entry into table-xt
236: 2@ swap here name string, ( u table-xt disasm-xt c-addr ) \ remember string
237: noname create 2, \ define anonymous word
238: execute lastxt swap ! \ enter xt of defined word into table-xt
239: does> ( addr w -- )
240: \ disassemble instruction w at addr
241: 2@ >r ( addr w disasm-xt R: c-addr )
242: execute ( R: c-addr ) \ disassemble operands
243: r> count type ; \ print name
244:
245: \ all the following words have the stack effect ( u "name" )
246: ' disasm-J-target ' opc-tab-entry define-format asm-J-target
247: ' disasm-I-rs,rt,imm ' opc-tab-entry define-format asm-I-rs,rt,imm
248: ' disasm-I-rs,imm ' opc-tab-entry define-format asm-I-rs,imm1
249: ' disasm-rt,rs,imm ' opc-tab-entry define-format asm-I-rt,rs,imm
1.5 anton 250: ' disasm-rt,rs,uimm ' opc-tab-entry define-format asm-I-rt,rs,uimm
251: ' disasm-rt,uimm ' opc-tab-entry define-format asm-I-rt,uimm
1.4 anton 252: ' disasm-rt,imm,rs ' opc-tab-entry define-format asm-I-rt,offset,rs
253: ' disasm-rd,rt,sa ' funct-tab-entry define-format asm-special-rd,rt,sa
254: ' disasm-rd,rt,rs ' funct-tab-entry define-format asm-special-rd,rt,rs
255: ' disasm-rs. ' funct-tab-entry define-format asm-special-rs
256: ' disasm-rd,rs ' funct-tab-entry define-format asm-special-rd,rs
257: ' 2drop ' funct-tab-entry define-format asm-special-nothing
258: ' disasm-rd. ' funct-tab-entry define-format asm-special-rd
259: ' disasm-rs,rt ' funct-tab-entry define-format asm-special-rs,rt
260: ' disasm-rd,rs,rt ' funct-tab-entry define-format asm-special-rd,rs,rt
261: ' disasm-I-rs,imm ' regimm-tab-entry define-format asm-regimm-rs,imm
262: ' 2drop ' cp0-tab-entry define-format asm-copz0
263: ' disasm-rt,rd,z ' copz-rs-tab-entry define-format asm-copz-rt,rd1
1.5 anton 264: ' disasm-I-imm,z ' copz-rt-tab-entry define-format asm-copz-imm1
1.4 anton 265:
266: : asm-I-rs,imm ( u1 u2 "name" -- ; compiled code: addr w -- )
267: nip asm-I-rs,imm1 ;
268:
1.3 anton 269: : asm-copz-rt,rd ( u1 u2 "name" -- )
1.4 anton 270: drop asm-copz-rt,rd1 ;
1.3 anton 271:
1.4 anton 272: : asm-copz-rt,offset,rs ( u "name" -- )
273: \ ignore these insts, we disassemble using asm-I-rt,offset,rs
274: drop name 2drop ;
1.3 anton 275:
276: : asm-copz-imm ( u1 u2 u3 "name" -- )
1.4 anton 277: drop nip asm-copz-imm1 ;
1.1 anton 278:
1.3 anton 279: include ./insts.fs
1.8 anton 280:
281: previous set-current
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to disasm.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth / arch / mips