1: \ dis.fs Disassembler for ShBoom CPU
2:
3: >CROSS
4:
5: hex
6:
7: [IFUNDEF] X
8: : X ; immediate [THEN]
9: [IFUNDEF] linked,
10: : linked, ( link ) here swap dup @ , ! ; [THEN]
11:
12:
13: Create I-Latch 4 chars allot
14: Variable I-Nr
15: Variable T-IP
16: Variable I-IP
17: Variable Stop-IP
18: 4 Value MaxOps
19:
20: : getinit
21: 4 to MaxOps
22: 4 I-Nr ! ;
23:
24: : getquad ( -- n )
25: I-IP @ X @ X cell I-IP +! ;
26:
27: : getops ( -- )
28: 4 0 DO I-IP @ I + X c@ I-Latch I + C! LOOP
29: I-IP @ T-IP !
30: X cell I-IP +!
31: 0 I-Nr !
32: 4 to MaxOps ;
33:
34: : getop ( -- token true | false )
35: \ gets next opcode from instruction latch
36: I-Nr @ MaxOps = IF false EXIT THEN
37: I-Latch I-Nr @ chars + c@
38: 1 I-Nr +! true ;
39:
40: : getnextop ( -- token )
41: getop 0= IF cr getops getop drop THEN ;
42:
43: : getbyte ( -- c )
44: I-Nr @ MaxOps u>=
45: ABORT" No byte in opcode quad"
46: I-Latch 3 chars + c@
47: 3 to MaxOps ;
48:
49: : TotalCollect ( n -- n )
50: \ collect rest of instrution
51: BEGIN GetOp WHILE
52: swap 8 lshift or
53: REPEAT ;
54:
55: : RestBytesNr
56: 4 I-Nr @ - ;
57:
58: : TotalBrBits
59: RestBytesNr 8 * 3 + ;
60:
61: : DisCall ( calltarget -- )
62: gdiscover
63: IF @name '< emit type '> emit space
64: ELSE ." call " . THEN ;
65:
66: : b? ( token -- token false | true )
67: \ BREAK:
68: dup $e0 and
69: 0<> IF false EXIT THEN
70: TotalBrBits >r
71: dup $07 and TotalCollect
72:
73: \ check for highest bit
74: \ if set, fill rest to the left with 1
75: 1 r@ 1- lshift over and
76: IF 1 r> lshift 1- invert or
77: ELSE rdrop THEN
78: 4 * swap
79:
80: $18 and
81: CASE 0 OF ." br" ENDOF
82: $8 OF \ ." call"
83: T-IP @ + discall true EXIT ENDOF
84: $10 OF ." bz" ENDOF
85: $18 OF ." dbr" ENDOF
86: ENDCASE
87: space
88: . true ;
89:
90: : push.n? ( token -- token true | false )
91: dup $f0 and $20 <> IF false EXIT THEN
92: ." push.n #"
93: $f and
94: dup 9 u< IF . ELSE $10 - . THEN
95: true ;
96:
97: : push/pop? ( token -- token false | true )
98: dup $50 $60 within
99: IF ." pop g" $f and dec. true EXIT THEN
100: dup $70 $80 within
101: IF ." push g" $f and dec. true EXIT THEN
102: dup $a0 $af within
103: IF ." pop r" $f and dec. true EXIT THEN
104: dup $80 $8f within
105: IF ." push r" $f and dec. true EXIT THEN
106: false ;
107:
108: : op-simple ( adr -- )
109: 3 cells + count type space ;
110:
111: Variable op-link 0 op-link !
112: Variable op-xt
113:
114: : op1
115: op-link linked, name evaluate , , name string, align ;
116:
117: : op
118: op-xt @ op1 ;
119:
120: ' op-simple op-xt !
121:
122: op 30 skip
123: op 31 skipc
124: op 32 skipn
125: op 33 skipz
126: op 34 step
127: op 35 skipnc
128: op 36 skipnn
129: op 37 skipnz
130: op 38 mloop
131: op 39 mloopc
132: op 3a mloopn
133: op 3a mloopnp
134: op 3b mloopz
135: op 3c bkpt
136: op 3d mloopnc
137: op 3e mloopnn
138: op 3f mloopnz
139: op 40 @ \ ld[]
140: op 41 ld[x]
141: op 42 ld[r0]
142: op 44 ld[--r0]
143: op 45 scache
144: op 46 ld[r0++]
145: op 48 c@ \ ld.b[]
146: op 49 ld[x++]
147: op 4a ld[--x]
148: op 4b br[]
149: op 4d lcache
150: op 4e call[]
151: op 60 st[]
152: op 61 st[x]
153: op 62 st[r0]
154: op 64 st[--r0]
155: op 66 st[r0++]
156: op 68 st[--x]
157: op 69 st[x++]
158: op 6e ; \ ret
159: op 6f reti
160: op 80 r@ \ push_r0
161: op 91 push_mode
162: op 92 dup \ push_s0
163: op 93 over \ push_s1
164: op 94 push_ct
165: op 96 ldo[]
166: op 97 ldo.i[]
167: op 98 push_x
168: op 99 split
169: op 9a r> \ push_lstack
170: op 9b ldepth
171: op 9c push_sa
172: op 9d push_la
173: op 9e push_s2
174: op 9f sdepth
175: op b0 sto[]
176: op b1 sto.i[]
177: op b2 swap
178: op b3 drop
179: op b4 pop_ct
180: op b5 replexp
181: op b6 ei
182: op b7 di
183: op b8 pop_x
184: op b9 pop_mode
185: op ba >r \ pop_lstack
186: op bb add_pc
187: op bc pop_sa
188: op bd pop_la
189: op be lframe
190: op bf sframe
191: op c0 add
192: op c1 dec_ct
193: op c2 addc
194: op c3 xor
195: op c4 expdif
196: op c5 denorm
197: op c6 normr
198: op c7 norml
199: op c8 -
200: op c9 negate \ neg
201: op ca subb
202: op cb cmp
203: op cc inc#4
204: op cd dec#4
205: op ce 1+ \ inc#1
206: op cf 1- \ dec#1
207: op d0 copyb
208: op d1 rnd
209: op d2 addexp
210: op d3 subexp
211: op d4 testexp
212: op d5 muls
213: op d6 mulfs
214: op d7 mulu
215: op d8 sexb
216: op d9 testb
217: op da replb
218: op db extexp
219: op dc extsig
220: op dd notc
221: op de divu
222: op df mxm
223: op e0 or
224: op e1 and
225: op e2 shl#1
226: op e3 shr#1
227: op e4 rot \ rev
228: op e5 0= \ eqz
229: op e6 shld#1
230: op e7 shlr#1
231: op e8 +
232: op e9 iand
233: op ea nop
234: op ec shl#8
235: op ed shr#8
236: op ee shift
237: op ef shiftd
238:
239:
240: :noname ( adr -- )
241: drop ." push.l #" getquad u. ; op1 4f push.l
242:
243: :noname ( adr .. )
244: drop ." push.b #" getbyte u. ; op1 90 push.b
245:
246: : op-simple? ( token -- token flase | true )
247: >r op-link
248: BEGIN @ dup WHILE
249: dup cell+ @ r@ =
250: IF rdrop dup 2 cells + @ EXECUTE true EXIT THEN
251:
252: REPEAT
253: drop r> false ;
254:
255: : one-op ( token -- )
256: op-simple? ?EXIT
257: b? ?EXIT
258: push.n? ?EXIT
259: push/pop? ?EXIT
260: drop ." ??? " ;
261:
262: : disloop ( adr len -- )
263: over I-IP ! + Stop-IP !
264: getinit
265: BEGIN getnextop
266: dup _not_reached =
267: IF drop EXIT THEN
268: one-op
269: I-IP @ Stop-IP @ =
270: UNTIL ;
271:
272: : disxt ( adr -- )
273: -1 disloop ;
274:
275: : dis ( -- )
276: T ' H disxt ;
277:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dis.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth / arch / shboom