-
Notifications
You must be signed in to change notification settings - Fork 6
/
disasm.ft
156 lines (138 loc) · 5.72 KB
/
disasm.ft
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
\ Copyright (c) 2012, Matt Hellige
\ All rights reserved.
\
\ Redistribution and use in source and binary forms, with or without
\ modification, are permitted provided that the following conditions are met:
\
\ Redistributions of source code must retain the above copyright notice,
\ this list of conditions and the following disclaimer.
\
\ Redistributions in binary form must reproduce the above copyright
\ notice, this list of conditions and the following disclaimer in the
\ documentation and/or other materials provided with the distribution.
\
\ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
\ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
\ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
\ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
\ HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
\ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
\ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
\ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
\ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
\ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
\ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
\ this file contains a simple forth decompiler in the form of SEE.
\ it relies on a number of heuristics which will generally be correct
\ for user-defined words, but will not always be correct for words
\ defined in the forth kernel. some tidying of the kernel and care
\ to separate forth-visible words from other fragments of assembly
\ code should clean that up. but we'll still have to rely on heuristics
\ in any event, so the situation as it is isn't so terrible.
\ a number of other words in this file may be useful in their own
\ right for navigating the dictionary.
\ we exploit the fact that the final link pointer is 0, and
\ thus less than any word in the dictionary
: next-head ( addr -- limit addr )
latest @ here ! here ( start at here in case we 'see' latest )
swap >r ( stash addr )
begin dup @ r@ > while @ repeat
r> ;
: >name ( xt -- nt ) next-head drop @ 1+ ;
: count ( c-addr -- c-addr u ) dup 1+ swap @ ;
: id. ( nt -- ) count lenmask and type ;
: xu.r0 ( u n -- ) base @ >r hex u.r0 r> base ! ;
\ colon decompiler for forth words
: '"' char " emit ;
: see-word ( addr -- n )
space dup 4 xu.r0 ." : "
dup @ case
['] lit of ." < " 1+ ? ." >" 2 endof
['] litstring of '"' 1+ dup @ 2 + swap count type '"' endof
['] 0branch of ." 0branch " 1+ ? 2 endof
['] branch of ." branch " 1+ ? 2 endof
>name id. 1 swap
endcase ;
\ includes start, excludes limit
: see-range ( limit start -- ) cr ?do i see-word cr +loop ;
\ native disassembler for primitives (and any other memory, obviously)
variable /disasm-pc
: disasm-pc@ ( -- u ) /disasm-pc @ 1 /disasm-pc +! ;
: "regs" s" abcxyzij" ;
: reg ( reg -- ) "regs" drop + @ emit ;
: "opname" s" ---setaddsubmulmlidivdvimodmdiandborxorshrasrshlifbifcifeifnifgifaiflifu------adxsbx------stistd" ;
: opname ( op -- ) 3 * "opname" drop + 3 type space ;
: disasm-op ( inst -- op ) 0x 1f and ;
: disasm-nextlit ( arg -- ea ) case
0x 1a of disasm-pc@ @ endof
0x 1e of disasm-pc@ @ endof
0x 1f of disasm-pc@ @ endof
dup 0x 10 0x 18 within if drop disasm-pc@ @ else
0 swap
endcase ;
: fetch-b ( inst -- arg ) 5 rshift 0x 1f and ;
: disasm-b ( inst -- pa pl ea arg ) s" push" rot fetch-b
dup disasm-nextlit swap ;
: disasm-a ( inst -- pa pl ea arg ) s" pop" rot 10 rshift
dup disasm-nextlit swap ;
: decode-arg ( pa pl ea arg -- ) case
0x 18 of drop 2dup type endof
0x 19 of ." peek" drop endof
0x 1a of ." pick " 0 .r endof
0x 1b of ." sp" drop endof
0x 1c of ." pc" drop endof
0x 1d of ." ex" drop endof
0x 1e of ." [" 0 .r ." ]" endof
0x 1f of 0 .r endof
dup 0x 08 u< if 7 and reg drop else
dup 0x 10 u< if 7 and ." [" reg ." ]" drop else
dup 0x 18 u< if 7 and swap ." [" 0 .r ." +" reg ." ]" else
dup 0x 1f u> if 0x 21 - 0 xu.r0 drop else
dup ." unknown oparg: " 2 xu.r0 nip
endcase 2drop ;
: disasm-special ( inst -- )
( it's ok to deal with b before a, since b can't advance pc )
dup fetch-b case
0x 01 of ." jsr" endof
0x 08 of ." int" endof
0x 09 of ." iag" endof
0x 0a of ." ias" endof
0x 0b of ." rfi" endof
0x 0c of ." iaq" endof
0x 10 of ." hwn" endof
0x 11 of ." hwq" endof
0x 12 of ." hwi" endof
dup ." unk[" 2 xu.r0 ." ]"
endcase
space disasm-a decode-arg ;
: disasm-inst ( -- )
space disasm-pc@ dup 4 xu.r0 ." : "
@ dup disasm-op ?dup if
opname dup disasm-a 2>r 2>r disasm-b decode-arg ." , "
2r> 2r> decode-arg
else
disasm-special
then ;
\ include start excludes limit
: disasm-range ( limit start -- )
cr /disasm-pc !
begin dup /disasm-pc @ > while disasm-inst cr repeat drop ;
\ higher-level 'see' support
: docol-see ( xt -- ) ." colon-defined word:" 1+ next-head see-range ;
: const-see ( xt -- ) ." constant: " 1+ ? ;
: var-see ( xt -- ) ." variable: " 1+ ? ;
: prim-see ( xt -- ) ." primitive:" next-head disasm-range ;
: xt-see dup @ case
docol: of dup docol-see endof
dovar: of dup var-see endof
docon: of dup const-see endof
( xt [xt] -- )
2dup 1- = if prim-see else
( TODO heuristic check for does> dispatch at the target address )
." unrecognized code field value"
endcase
drop cr ;
: see ' ?dup 0= abort" no such word" cr xt-see ;
\ save the new image
here dump-core
bye