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