Disable the BCO disassembler
[ghc-heap-view.git] / cbits / HeapView.c
1 #include "Rts.h"
2
3 StgWord gtc_heap_view_closureSize(StgClosure *closure) {
4     ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure));
5     return closure_sizeW(closure);
6 }
7
8 static void
9 gtc_heap_view_closure_ptrs_in_large_bitmap(StgClosure *ptrs[], StgWord *nptrs, StgClosure **p, StgLargeBitmap *large_bitmap, uint32_t size )
10 {
11     uint32_t i, j, b;
12     StgWord bitmap;
13
14     b = 0;
15
16     for (i = 0; i < size; b++) {
17         bitmap = large_bitmap->bitmap[b];
18         j = stg_min(size-i, BITS_IN(W_));
19         i += j;
20         for (; j > 0; j--, p++) {
21             if ((bitmap & 1) == 0) {
22                 ptrs[(*nptrs)++] = *p;
23             }
24             bitmap = bitmap >> 1;
25         }            
26     }
27 }
28
29 // from rts/Printer.c
30 char *gtc_heap_view_closure_type_names[] = {
31  [INVALID_OBJECT]        = "INVALID_OBJECT",
32  [CONSTR]                = "CONSTR",
33  [CONSTR_1_0]            = "CONSTR_1_0",
34  [CONSTR_0_1]            = "CONSTR_0_1",
35  [CONSTR_2_0]            = "CONSTR_2_0",
36  [CONSTR_1_1]            = "CONSTR_1_1",
37  [CONSTR_0_2]            = "CONSTR_0_2",
38 #if defined(GHC_8_0)
39  [CONSTR_STATIC]         = "CONSTR_STATIC",
40  [CONSTR_NOCAF_STATIC]   = "CONSTR_NOCAF_STATIC",
41 #else
42  [CONSTR_NOCAF]          = "CONSTR_NOCAF",
43 #endif
44  [FUN]                   = "FUN",
45  [FUN_1_0]               = "FUN_1_0",
46  [FUN_0_1]               = "FUN_0_1",
47  [FUN_2_0]               = "FUN_2_0",
48  [FUN_1_1]               = "FUN_1_1",
49  [FUN_0_2]               = "FUN_0_2",
50  [FUN_STATIC]            = "FUN_STATIC",
51  [THUNK]                 = "THUNK",
52  [THUNK_1_0]             = "THUNK_1_0",
53  [THUNK_0_1]             = "THUNK_0_1",
54  [THUNK_2_0]             = "THUNK_2_0",
55  [THUNK_1_1]             = "THUNK_1_1",
56  [THUNK_0_2]             = "THUNK_0_2",
57  [THUNK_STATIC]          = "THUNK_STATIC",
58  [THUNK_SELECTOR]        = "THUNK_SELECTOR",
59  [BCO]                   = "BCO",
60  [AP]                    = "AP",
61  [PAP]                   = "PAP",
62  [AP_STACK]              = "AP_STACK",
63  [IND]                   = "IND",
64 #if defined(GHC_8_0)
65  [IND_PERM]              = "IND_PERM",
66 #endif
67  [IND_STATIC]            = "IND_STATIC",
68  [RET_BCO]               = "RET_BCO",
69  [RET_SMALL]             = "RET_SMALL",
70  [RET_BIG]               = "RET_BIG",
71  [RET_FUN]               = "RET_FUN",
72  [UPDATE_FRAME]          = "UPDATE_FRAME",
73  [CATCH_FRAME]           = "CATCH_FRAME",
74  [UNDERFLOW_FRAME]       = "UNDERFLOW_FRAME",
75  [STOP_FRAME]            = "STOP_FRAME",
76  [BLACKHOLE]             = "BLACKHOLE",
77  [BLOCKING_QUEUE]        = "BLOCKING_QUEUE",
78  [MVAR_CLEAN]            = "MVAR_CLEAN",
79  [MVAR_DIRTY]            = "MVAR_DIRTY",
80  [ARR_WORDS]             = "ARR_WORDS",
81  [MUT_ARR_PTRS_CLEAN]    = "MUT_ARR_PTRS_CLEAN",
82  [MUT_ARR_PTRS_DIRTY]    = "MUT_ARR_PTRS_DIRTY",
83  [MUT_ARR_PTRS_FROZEN0]  = "MUT_ARR_PTRS_FROZEN0",
84  [MUT_ARR_PTRS_FROZEN]   = "MUT_ARR_PTRS_FROZEN",
85  [MUT_VAR_CLEAN]         = "MUT_VAR_CLEAN",
86  [MUT_VAR_DIRTY]         = "MUT_VAR_DIRTY",
87  [WEAK]                  = "WEAK",
88  [PRIM]                  = "PRIM",
89  [MUT_PRIM]              = "MUT_PRIM",
90  [TSO]                   = "TSO",
91  [STACK]                 = "STACK",
92  [TREC_CHUNK]            = "TREC_CHUNK",
93  [ATOMICALLY_FRAME]      = "ATOMICALLY_FRAME",
94  [CATCH_RETRY_FRAME]     = "CATCH_RETRY_FRAME",
95  [CATCH_STM_FRAME]       = "CATCH_STM_FRAME",
96  [WHITEHOLE]             = "WHITEHOLE",
97  [SMALL_MUT_ARR_PTRS_CLEAN]   = "SMALL_MUT_ARR_PTRS_CLEAN",
98  [SMALL_MUT_ARR_PTRS_DIRTY]   = "SMALL_MUT_ARR_PTRS_DIRTY",
99  [SMALL_MUT_ARR_PTRS_FROZEN0] = "SMALL_MUT_ARR_PTRS_FROZEN0",
100  [SMALL_MUT_ARR_PTRS_FROZEN]  = "SMALL_MUT_ARR_PTRS_FROZEN",
101 #if defined(GHC_8_2)
102  [COMPACT_NFDATA]  = "COMPACT_NFDATA",
103 #endif
104 };
105
106
107 void gtc_heap_view_closure_ptrs_in_pap_payload(StgClosure *ptrs[], StgWord *nptrs, StgClosure *fun, StgClosure **payload, StgWord size) {
108     StgWord bitmap;
109     const StgFunInfoTable *fun_info;
110
111     fun_info = get_fun_itbl(UNTAG_CLOSURE(fun));
112     // ASSERT(fun_info->i.type != PAP);
113     StgClosure **p = payload;
114
115     switch (fun_info->f.fun_type) {
116     case ARG_GEN:
117         bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
118         goto small_bitmap;
119     case ARG_GEN_BIG:
120         gtc_heap_view_closure_ptrs_in_large_bitmap(ptrs, nptrs, payload, GET_FUN_LARGE_BITMAP(fun_info), size);
121         break;
122     case ARG_BCO:
123         gtc_heap_view_closure_ptrs_in_large_bitmap(ptrs, nptrs, payload, BCO_BITMAP(fun), size);
124         break;
125     default:
126         bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
127     small_bitmap:
128         while (size > 0) {
129             if ((bitmap & 1) == 0) {
130                 ptrs[(*nptrs)++] = *p;
131             }
132             bitmap = bitmap >> 1;
133             p++;
134             size--;
135         }
136         break;
137     }
138 }
139
140 StgMutArrPtrs *gtc_heap_view_closurePtrs(Capability *cap, StgClosure *closure) {
141     ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure));
142
143     StgWord size = gtc_heap_view_closureSize(closure);
144     StgWord nptrs = 0;
145     StgWord i;
146
147     // First collect all pointers here, with the comfortable memory bound
148     // of the whole closure. Afterwards we know how many pointers are in
149     // the closure and then we can allocate space on the heap and copy them
150     // there
151     StgClosure *ptrs[size];
152
153     StgClosure **end;
154     StgClosure **ptr;
155
156     const StgInfoTable *info = get_itbl(closure);
157     StgThunkInfoTable *thunk_info;
158     StgFunInfoTable *fun_info;
159
160     // fprintf(stderr,"closurePtrs: Reading type %s\n", gtc_heap_view_closure_type_names[info->type]);
161
162     switch (info->type) {
163         case INVALID_OBJECT:
164             barf("Invalid Object");
165             break;
166
167         // No pointers
168         case ARR_WORDS:
169             break;
170
171         // Default layout
172         case CONSTR_1_0:
173         case CONSTR_0_1:
174         case CONSTR_2_0:
175         case CONSTR_1_1:
176         case CONSTR_0_2:
177         case CONSTR:
178 #if defined(GHC_8_0)
179         case CONSTR_STATIC:
180         case CONSTR_NOCAF_STATIC:
181 #else
182         case CONSTR_NOCAF:
183 #endif
184         case PRIM:
185
186         case FUN:
187         case FUN_1_0:
188         case FUN_0_1:
189         case FUN_1_1:
190         case FUN_2_0:
191         case FUN_0_2:
192         case FUN_STATIC:
193             end = closure->payload + info->layout.payload.ptrs;
194             for (ptr = closure->payload; ptr < end; ptr++) {
195                 ptrs[nptrs++] = *ptr;
196             }
197             break;
198
199         case THUNK:
200         case THUNK_1_0:
201         case THUNK_0_1:
202         case THUNK_1_1:
203         case THUNK_2_0:
204         case THUNK_0_2:
205         case THUNK_STATIC:
206             end = ((StgThunk *)closure)->payload + info->layout.payload.ptrs;
207             for (ptr = ((StgThunk *)closure)->payload; ptr < end; ptr++) {
208                 ptrs[nptrs++] = *ptr;
209             }
210             break;
211
212         case THUNK_SELECTOR:
213             ptrs[nptrs++] = ((StgSelector *)closure)->selectee;
214             break;
215             
216         case AP:
217             ptrs[nptrs++] = ((StgAP *)closure)->fun;
218             gtc_heap_view_closure_ptrs_in_pap_payload(ptrs, &nptrs,
219                 ((StgAP *)closure)->fun,
220                 ((StgAP *)closure)->payload,
221                 ((StgAP *)closure)->n_args);
222             break;
223             
224         case PAP:
225             ptrs[nptrs++] = ((StgPAP *)closure)->fun;
226             gtc_heap_view_closure_ptrs_in_pap_payload(ptrs, &nptrs,
227                 ((StgPAP *)closure)->fun,
228                 ((StgPAP *)closure)->payload,
229                 ((StgPAP *)closure)->n_args);
230             break;
231             
232         case AP_STACK:
233             ptrs[nptrs++] = ((StgAP_STACK *)closure)->fun;
234             for (i = 0; i < ((StgAP_STACK *)closure)->size; ++i) {
235                 ptrs[nptrs++] = ((StgAP_STACK *)closure)->payload[i];
236             }
237             break;
238             
239         case BCO:
240             ptrs[nptrs++] = (StgClosure *)((StgBCO *)closure)->instrs;
241             ptrs[nptrs++] = (StgClosure *)((StgBCO *)closure)->literals;
242             ptrs[nptrs++] = (StgClosure *)((StgBCO *)closure)->ptrs;
243             break;
244             
245         case IND:
246 #if defined(GHC_8_0)
247         case IND_PERM:
248 #endif
249         case IND_STATIC:
250         case BLACKHOLE:
251             ptrs[nptrs++] = (StgClosure *)(((StgInd *)closure)->indirectee);
252             break;
253
254         case MUT_ARR_PTRS_CLEAN:
255         case MUT_ARR_PTRS_DIRTY:
256         case MUT_ARR_PTRS_FROZEN:
257         case MUT_ARR_PTRS_FROZEN0:
258             for (i = 0; i < ((StgMutArrPtrs *)closure)->ptrs; ++i) {
259                 ptrs[nptrs++] = ((StgMutArrPtrs *)closure)->payload[i];
260             }
261             break;
262         case MUT_VAR_CLEAN:
263             ptrs[nptrs++] = ((StgMutVar *)closure)->var;
264             break;
265         case MVAR_DIRTY:
266         case MVAR_CLEAN:
267             ptrs[nptrs++] = (StgClosure *)((StgMVar *)closure)->head;
268             ptrs[nptrs++] = (StgClosure *)((StgMVar *)closure)->tail;
269             ptrs[nptrs++] = ((StgMVar *)closure)->value;
270             break;
271
272         default:
273             //fprintf(stderr,"closurePtrs: Cannot handle type %s yet\n", gtc_heap_view_closure_type_names[info->type]);
274             break;
275     }
276
277     size = nptrs + mutArrPtrsCardTableSize(nptrs);
278     StgMutArrPtrs *arr = 
279         (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + size);
280     TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), nptrs, 0);
281     SET_HDR(arr, &stg_MUT_ARR_PTRS_FROZEN_info, CCCS);
282     arr->ptrs = nptrs;
283     arr->size = size;
284
285     for (i = 0; i<nptrs; i++) {
286         arr->payload[i] = ptrs[i];
287     }
288
289     return arr;
290 }