hadrian: eliminate most of the remaining big rule enumerations
[ghc.git] / rts / Heap.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The University of Glasgow 2006-2017
4 *
5 * Introspection into GHC's heap representation
6 *
7 * ---------------------------------------------------------------------------*/
8
9 #include "Rts.h"
10 #include "RtsAPI.h"
11
12 #include "Capability.h"
13 #include "Printer.h"
14
15 StgWord heap_view_closureSize(StgClosure *closure) {
16 ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure));
17 return closure_sizeW(closure);
18 }
19
20 static void
21 heap_view_closure_ptrs_in_large_bitmap(StgClosure *ptrs[], StgWord *nptrs
22 , StgClosure **p, StgLargeBitmap *large_bitmap
23 , uint32_t size )
24 {
25 uint32_t i, j, b;
26 StgWord bitmap;
27
28 b = 0;
29
30 for (i = 0; i < size; b++) {
31 bitmap = large_bitmap->bitmap[b];
32 j = stg_min(size-i, BITS_IN(W_));
33 i += j;
34 for (; j > 0; j--, p++) {
35 if ((bitmap & 1) == 0) {
36 ptrs[(*nptrs)++] = *p;
37 }
38 bitmap = bitmap >> 1;
39 }
40 }
41 }
42
43 void heap_view_closure_ptrs_in_pap_payload(StgClosure *ptrs[], StgWord *nptrs
44 , StgClosure *fun, StgClosure **payload, StgWord size) {
45 StgWord bitmap;
46 const StgFunInfoTable *fun_info;
47
48 fun_info = get_fun_itbl(UNTAG_CLOSURE(fun));
49 // ASSERT(fun_info->i.type != PAP);
50 StgClosure **p = payload;
51
52 switch (fun_info->f.fun_type) {
53 case ARG_GEN:
54 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
55 goto small_bitmap;
56 case ARG_GEN_BIG:
57 heap_view_closure_ptrs_in_large_bitmap(ptrs, nptrs, payload,
58 GET_FUN_LARGE_BITMAP(fun_info), size);
59 break;
60 case ARG_BCO:
61 heap_view_closure_ptrs_in_large_bitmap(ptrs, nptrs, payload,
62 BCO_BITMAP(fun), size);
63 break;
64 default:
65 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
66 small_bitmap:
67 while (size > 0) {
68 if ((bitmap & 1) == 0) {
69 ptrs[(*nptrs)++] = *p;
70 }
71 bitmap = bitmap >> 1;
72 p++;
73 size--;
74 }
75 break;
76 }
77 }
78
79 StgMutArrPtrs *heap_view_closurePtrs(Capability *cap, StgClosure *closure) {
80 ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure));
81
82 StgWord size = heap_view_closureSize(closure);
83 StgWord nptrs = 0;
84 StgWord i;
85
86 // First collect all pointers here, with the comfortable memory bound
87 // of the whole closure. Afterwards we know how many pointers are in
88 // the closure and then we can allocate space on the heap and copy them
89 // there
90 StgClosure *ptrs[size];
91
92 StgClosure **end;
93 StgClosure **ptr;
94
95 const StgInfoTable *info = get_itbl(closure);
96
97 switch (info->type) {
98 case INVALID_OBJECT:
99 barf("Invalid Object");
100 break;
101
102 // No pointers
103 case ARR_WORDS:
104 break;
105
106 // Default layout
107 case CONSTR_1_0:
108 case CONSTR_0_1:
109 case CONSTR_2_0:
110 case CONSTR_1_1:
111 case CONSTR_0_2:
112 case CONSTR:
113
114
115 case PRIM:
116
117 case FUN:
118 case FUN_1_0:
119 case FUN_0_1:
120 case FUN_1_1:
121 case FUN_2_0:
122 case FUN_0_2:
123 case FUN_STATIC:
124 end = closure->payload + info->layout.payload.ptrs;
125 for (ptr = closure->payload; ptr < end; ptr++) {
126 ptrs[nptrs++] = *ptr;
127 }
128 break;
129
130 case THUNK:
131 case THUNK_1_0:
132 case THUNK_0_1:
133 case THUNK_1_1:
134 case THUNK_2_0:
135 case THUNK_0_2:
136 case THUNK_STATIC:
137 end = ((StgThunk *)closure)->payload + info->layout.payload.ptrs;
138 for (ptr = ((StgThunk *)closure)->payload; ptr < end; ptr++) {
139 ptrs[nptrs++] = *ptr;
140 }
141 break;
142
143 case THUNK_SELECTOR:
144 ptrs[nptrs++] = ((StgSelector *)closure)->selectee;
145 break;
146
147 case AP:
148 ptrs[nptrs++] = ((StgAP *)closure)->fun;
149 heap_view_closure_ptrs_in_pap_payload(ptrs, &nptrs,
150 ((StgAP *)closure)->fun,
151 ((StgAP *)closure)->payload,
152 ((StgAP *)closure)->n_args);
153 break;
154
155 case PAP:
156 ptrs[nptrs++] = ((StgPAP *)closure)->fun;
157 heap_view_closure_ptrs_in_pap_payload(ptrs, &nptrs,
158 ((StgPAP *)closure)->fun,
159 ((StgPAP *)closure)->payload,
160 ((StgPAP *)closure)->n_args);
161 break;
162
163 case AP_STACK:
164 ptrs[nptrs++] = ((StgAP_STACK *)closure)->fun;
165 /*
166 The payload is a stack, which consists of a mixture of pointers
167 and non-pointers. We can't simply pretend it's all pointers,
168 because that will cause crashes in the GC later. We could
169 traverse the stack and extract pointers and non-pointers, but that
170 would be complicated, so let's just ignore the payload for now.
171 See #15375.
172 */
173 break;
174
175 case BCO:
176 ptrs[nptrs++] = (StgClosure *)((StgBCO *)closure)->instrs;
177 ptrs[nptrs++] = (StgClosure *)((StgBCO *)closure)->literals;
178 ptrs[nptrs++] = (StgClosure *)((StgBCO *)closure)->ptrs;
179 break;
180
181 case IND:
182 case IND_STATIC:
183 case BLACKHOLE:
184 ptrs[nptrs++] = (StgClosure *)(((StgInd *)closure)->indirectee);
185 break;
186
187 case MUT_ARR_PTRS_CLEAN:
188 case MUT_ARR_PTRS_DIRTY:
189 case MUT_ARR_PTRS_FROZEN_CLEAN:
190 case MUT_ARR_PTRS_FROZEN_DIRTY:
191 for (i = 0; i < ((StgMutArrPtrs *)closure)->ptrs; ++i) {
192 ptrs[nptrs++] = ((StgMutArrPtrs *)closure)->payload[i];
193 }
194 break;
195 case MUT_VAR_CLEAN:
196 case MUT_VAR_DIRTY:
197 ptrs[nptrs++] = ((StgMutVar *)closure)->var;
198 break;
199 case MVAR_DIRTY:
200 case MVAR_CLEAN:
201 ptrs[nptrs++] = (StgClosure *)((StgMVar *)closure)->head;
202 ptrs[nptrs++] = (StgClosure *)((StgMVar *)closure)->tail;
203 ptrs[nptrs++] = ((StgMVar *)closure)->value;
204 break;
205
206 default:
207 fprintf(stderr,"closurePtrs: Cannot handle type %s yet\n",
208 closure_type_names[info->type]);
209 break;
210 }
211
212 size = nptrs + mutArrPtrsCardTableSize(nptrs);
213 StgMutArrPtrs *arr =
214 (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + size);
215 TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), nptrs, 0);
216 SET_HDR(arr, &stg_MUT_ARR_PTRS_FROZEN_CLEAN_info, cap->r.rCCCS);
217 arr->ptrs = nptrs;
218 arr->size = size;
219
220 for (i = 0; i<nptrs; i++) {
221 arr->payload[i] = ptrs[i];
222 }
223
224 return arr;
225 }