Merge remote-tracking branch 'origin/type-nats' into type-nats-merge
[ghc.git] / rts / Disassembler.c
1 /* -----------------------------------------------------------------------------
2 * Bytecode disassembler
3 *
4 * Copyright (c) 1994-2002.
5 *
6 * $RCSfile: Disassembler.c,v $
7 * $Revision: 1.29 $
8 * $Date: 2004/09/03 15:28:19 $
9 * ---------------------------------------------------------------------------*/
10
11 #ifdef DEBUG
12
13 #include "PosixSource.h"
14 #include "Rts.h"
15 #include "RtsAPI.h"
16 #include "rts/Bytecodes.h"
17
18 #include "RtsUtils.h"
19 #include "Schedule.h"
20 #include "Printer.h"
21 #include "Disassembler.h"
22 #include "Interpreter.h"
23
24 /* --------------------------------------------------------------------------
25 * Disassembler
26 * ------------------------------------------------------------------------*/
27
28 int
29 disInstr ( StgBCO *bco, int pc )
30 {
31 int i;
32 StgWord16 instr;
33
34 StgWord16* instrs = (StgWord16*)(bco->instrs->payload);
35
36 StgArrWords* literal_arr = bco->literals;
37 StgWord* literals = (StgWord*)(&literal_arr->payload[0]);
38
39 StgMutArrPtrs* ptrs_arr = bco->ptrs;
40 StgPtr* ptrs = (StgPtr*)(&ptrs_arr->payload[0]);
41
42 instr = instrs[pc++];
43 if (instr & bci_FLAG_LARGE_ARGS) {
44 debugBelch ("LARGE ");
45 }
46
47 #define BCO_NEXT instrs[pc++]
48 #define BCO_NEXT_32 (pc += 2)
49 #define BCO_READ_NEXT_32 (BCO_NEXT_32, (((StgWord) instrs[pc-2]) << 16) \
50 + ( (StgWord) instrs[pc-1]))
51 #define BCO_NEXT_64 (pc += 4)
52 #define BCO_READ_NEXT_64 (BCO_NEXT_64, (((StgWord) instrs[pc-4]) << 48) \
53 + (((StgWord) instrs[pc-3]) << 32) \
54 + (((StgWord) instrs[pc-2]) << 16) \
55 + ( (StgWord) instrs[pc-1]))
56 #if WORD_SIZE_IN_BITS == 32
57 #define BCO_NEXT_WORD BCO_NEXT_32
58 #define BCO_READ_NEXT_WORD BCO_READ_NEXT_32
59 #elif WORD_SIZE_IN_BITS == 64
60 #define BCO_NEXT_WORD BCO_NEXT_64
61 #define BCO_READ_NEXT_WORD BCO_READ_NEXT_64
62 #else
63 #error Cannot cope with WORD_SIZE_IN_BITS being nether 32 nor 64
64 #endif
65 #define BCO_GET_LARGE_ARG ((instr & bci_FLAG_LARGE_ARGS) ? BCO_READ_NEXT_WORD : BCO_NEXT)
66
67 switch (instr & 0xff) {
68 case bci_BRK_FUN:
69 debugBelch ("BRK_FUN " ); printPtr( ptrs[instrs[pc]] );
70 debugBelch (" %d ", instrs[pc+1]); printPtr( ptrs[instrs[pc+2]] ); debugBelch("\n" );
71 pc += 3;
72 break;
73 case bci_SWIZZLE:
74 debugBelch("SWIZZLE stkoff %d by %d\n",
75 instrs[pc], (signed int)instrs[pc+1]);
76 pc += 2; break;
77 case bci_CCALL:
78 debugBelch("CCALL marshaller at 0x%lx\n",
79 literals[instrs[pc]] );
80 pc += 1; break;
81 case bci_STKCHECK: {
82 StgWord stk_words_reqd = BCO_GET_LARGE_ARG + 1;
83 debugBelch("STKCHECK %lu\n", (lnat)stk_words_reqd );
84 break;
85 }
86 case bci_PUSH_L:
87 debugBelch("PUSH_L %d\n", instrs[pc] );
88 pc += 1; break;
89 case bci_PUSH_LL:
90 debugBelch("PUSH_LL %d %d\n", instrs[pc], instrs[pc+1] );
91 pc += 2; break;
92 case bci_PUSH_LLL:
93 debugBelch("PUSH_LLL %d %d %d\n", instrs[pc], instrs[pc+1],
94 instrs[pc+2] );
95 pc += 3; break;
96 case bci_PUSH_G:
97 debugBelch("PUSH_G " ); printPtr( ptrs[instrs[pc]] );
98 debugBelch("\n" );
99 pc += 1; break;
100
101 case bci_PUSH_ALTS:
102 debugBelch("PUSH_ALTS " ); printPtr( ptrs[instrs[pc]] );
103 debugBelch("\n");
104 pc += 1; break;
105 case bci_PUSH_ALTS_P:
106 debugBelch("PUSH_ALTS_P " ); printPtr( ptrs[instrs[pc]] );
107 debugBelch("\n");
108 pc += 1; break;
109 case bci_PUSH_ALTS_N:
110 debugBelch("PUSH_ALTS_N " ); printPtr( ptrs[instrs[pc]] );
111 debugBelch("\n");
112 pc += 1; break;
113 case bci_PUSH_ALTS_F:
114 debugBelch("PUSH_ALTS_F " ); printPtr( ptrs[instrs[pc]] );
115 debugBelch("\n");
116 pc += 1; break;
117 case bci_PUSH_ALTS_D:
118 debugBelch("PUSH_ALTS_D " ); printPtr( ptrs[instrs[pc]] );
119 debugBelch("\n");
120 pc += 1; break;
121 case bci_PUSH_ALTS_L:
122 debugBelch("PUSH_ALTS_L " ); printPtr( ptrs[instrs[pc]] );
123 debugBelch("\n");
124 pc += 1; break;
125 case bci_PUSH_ALTS_V:
126 debugBelch("PUSH_ALTS_V " ); printPtr( ptrs[instrs[pc]] );
127 debugBelch("\n");
128 pc += 1; break;
129
130 case bci_PUSH_UBX:
131 debugBelch("PUSH_UBX ");
132 for (i = 0; i < instrs[pc+1]; i++)
133 debugBelch("0x%lx ", literals[i + instrs[pc]] );
134 debugBelch("\n");
135 pc += 2; break;
136 case bci_PUSH_APPLY_N:
137 debugBelch("PUSH_APPLY_N\n");
138 break;
139 case bci_PUSH_APPLY_V:
140 debugBelch("PUSH_APPLY_V\n");
141 break;
142 case bci_PUSH_APPLY_F:
143 debugBelch("PUSH_APPLY_F\n");
144 break;
145 case bci_PUSH_APPLY_D:
146 debugBelch("PUSH_APPLY_D\n");
147 break;
148 case bci_PUSH_APPLY_L:
149 debugBelch("PUSH_APPLY_L\n");
150 break;
151 case bci_PUSH_APPLY_P:
152 debugBelch("PUSH_APPLY_P\n");
153 break;
154 case bci_PUSH_APPLY_PP:
155 debugBelch("PUSH_APPLY_PP\n");
156 break;
157 case bci_PUSH_APPLY_PPP:
158 debugBelch("PUSH_APPLY_PPP\n");
159 break;
160 case bci_PUSH_APPLY_PPPP:
161 debugBelch("PUSH_APPLY_PPPP\n");
162 break;
163 case bci_PUSH_APPLY_PPPPP:
164 debugBelch("PUSH_APPLY_PPPPP\n");
165 break;
166 case bci_PUSH_APPLY_PPPPPP:
167 debugBelch("PUSH_APPLY_PPPPPP\n");
168 break;
169 case bci_SLIDE:
170 debugBelch("SLIDE %d down by %d\n", instrs[pc], instrs[pc+1] );
171 pc += 2; break;
172 case bci_ALLOC_AP:
173 debugBelch("ALLOC_AP %d words\n", instrs[pc] );
174 pc += 1; break;
175 case bci_ALLOC_AP_NOUPD:
176 debugBelch("ALLOC_AP_NOUPD %d words\n", instrs[pc] );
177 pc += 1; break;
178 case bci_ALLOC_PAP:
179 debugBelch("ALLOC_PAP %d arity, %d words\n",
180 instrs[pc], instrs[pc+1] );
181 pc += 2; break;
182 case bci_MKAP:
183 debugBelch("MKAP %d words, %d stkoff\n", instrs[pc+1],
184 instrs[pc] );
185 pc += 2; break;
186 case bci_MKPAP:
187 debugBelch("MKPAP %d words, %d stkoff\n", instrs[pc+1],
188 instrs[pc] );
189 pc += 2; break;
190 case bci_UNPACK:
191 debugBelch("UNPACK %d\n", instrs[pc] );
192 pc += 1; break;
193 case bci_PACK:
194 debugBelch("PACK %d words with itbl ", instrs[pc+1] );
195 printPtr( (StgPtr)literals[instrs[pc]] );
196 debugBelch("\n");
197 pc += 2; break;
198
199 case bci_TESTLT_I: {
200 unsigned int discr = BCO_NEXT;
201 int failto = BCO_GET_LARGE_ARG;
202 debugBelch("TESTLT_I %ld, fail to %d\n", literals[discr], failto);
203 break;
204 }
205 case bci_TESTEQ_I:
206 debugBelch("TESTEQ_I %ld, fail to %d\n", literals[instrs[pc]],
207 instrs[pc+1]);
208 pc += 2; break;
209
210 case bci_TESTLT_F:
211 debugBelch("TESTLT_F %ld, fail to %d\n", literals[instrs[pc]],
212 instrs[pc+1]);
213 pc += 2; break;
214 case bci_TESTEQ_F:
215 debugBelch("TESTEQ_F %ld, fail to %d\n", literals[instrs[pc]],
216 instrs[pc+1]);
217 pc += 2; break;
218
219 case bci_TESTLT_D:
220 debugBelch("TESTLT_D %ld, fail to %d\n", literals[instrs[pc]],
221 instrs[pc+1]);
222 pc += 2; break;
223 case bci_TESTEQ_D:
224 debugBelch("TESTEQ_D %ld, fail to %d\n", literals[instrs[pc]],
225 instrs[pc+1]);
226 pc += 2; break;
227
228 case bci_TESTLT_P:
229 debugBelch("TESTLT_P %d, fail to %d\n", instrs[pc],
230 instrs[pc+1]);
231 pc += 2; break;
232 case bci_TESTEQ_P:
233 debugBelch("TESTEQ_P %d, fail to %d\n", instrs[pc],
234 instrs[pc+1]);
235 pc += 2; break;
236 case bci_CASEFAIL:
237 debugBelch("CASEFAIL\n" );
238 break;
239 case bci_JMP:
240 debugBelch("JMP to %d\n", instrs[pc]);
241 pc += 1; break;
242
243 case bci_ENTER:
244 debugBelch("ENTER\n");
245 break;
246
247 case bci_RETURN:
248 debugBelch("RETURN\n" );
249 break;
250 case bci_RETURN_P:
251 debugBelch("RETURN_P\n" );
252 break;
253 case bci_RETURN_N:
254 debugBelch("RETURN_N\n" );
255 break;
256 case bci_RETURN_F:
257 debugBelch("RETURN_F\n" );
258 break;
259 case bci_RETURN_D:
260 debugBelch("RETURN_D\n" );
261 break;
262 case bci_RETURN_L:
263 debugBelch("RETURN_L\n" );
264 break;
265 case bci_RETURN_V:
266 debugBelch("RETURN_V\n" );
267 break;
268
269 default:
270 barf("disInstr: unknown opcode %u", (unsigned int) instr);
271 }
272 return pc;
273 }
274
275
276 /* Something of a kludge .. how do we know where the end of the insn
277 array is, since it isn't recorded anywhere? Answer: the first
278 short is the number of bytecodes which follow it.
279 See ByteCodeGen.linkBCO.insns_arr for construction ...
280 */
281 void disassemble( StgBCO *bco )
282 {
283 nat i, j;
284 StgWord16* instrs = (StgWord16*)(bco->instrs->payload);
285 StgMutArrPtrs* ptrs = bco->ptrs;
286 nat nbcs = (int)instrs[0];
287 nat pc = 1;
288
289 debugBelch("BCO\n" );
290 pc = 1;
291 while (pc <= nbcs) {
292 debugBelch("\t%2d: ", pc );
293 pc = disInstr ( bco, pc );
294 }
295
296 debugBelch("INSTRS:\n " );
297 j = 16;
298 for (i = 0; i < nbcs; i++) {
299 debugBelch("%3d ", (int)instrs[i] );
300 j--;
301 if (j == 0) { j = 16; debugBelch("\n "); };
302 }
303 debugBelch("\n");
304
305 debugBelch("PTRS:\n " );
306 j = 8;
307 for (i = 0; i < ptrs->ptrs; i++) {
308 debugBelch("%8p ", ptrs->payload[i] );
309 j--;
310 if (j == 0) { j = 8; debugBelch("\n "); };
311 }
312 debugBelch("\n");
313
314 debugBelch("\n");
315 ASSERT(pc == nbcs+1);
316 }
317
318 #endif /* DEBUG */