s/StgArrWords/StgArrBytes
[ghc-heap-view.git] / cbits / HeapViewPrim.cmm
1 #include "Cmm.h"
2
3 #if GHC_8_0
4
5 aToWordzh (P_ clos)
6 {
7         return (clos);
8 }
9
10 slurpClosurezh ( P_ closure )
11 {
12     W_ info, ptrs, nptrs, p, ptrs_arr, dat_arr;
13     info  = %GET_STD_INFO(UNTAG(closure));
14
15     ptrs  = TO_W_(%INFO_PTRS(info));
16     nptrs = TO_W_(%INFO_NPTRS(info));
17
18     W_ clos;
19     clos = UNTAG(closure);
20
21     W_ len;
22     (len) = foreign "C" gtc_heap_view_closureSize(clos "ptr");
23
24     W_ ptrs_arr_sz, ptrs_arr_cards, dat_arr_sz;
25     dat_arr_sz = SIZEOF_StgArrBytes + WDS(len);
26
27     ALLOC_PRIM_P (dat_arr_sz, slurpClosurezh, closure);
28
29     dat_arr = Hp - dat_arr_sz + WDS(1);
30
31
32     SET_HDR(dat_arr, stg_ARR_WORDS_info, CCCS);
33     StgArrBytes_bytes(dat_arr) = WDS(len);
34     p = 0;
35 for:
36     if(p < len) {
37          W_[BYTE_ARR_CTS(dat_arr) + WDS(p)] = W_[clos + WDS(p)];
38          p = p + 1;
39          goto for;
40     }
41
42     W_ ptrArray;
43
44     ("ptr" ptrArray) = foreign "C" gtc_heap_view_closurePtrs(MyCapability() "ptr", clos "ptr");
45
46     return (info, dat_arr, ptrArray);
47 }
48
49
50 reallyUnsafePtrEqualityUpToTag (W_ clos1, W_  clos2)
51 {
52     clos1 = UNTAG(clos1);
53     clos2 = UNTAG(clos2);
54     return (clos1 == clos2);
55 }
56
57 #elif GHC_7_7
58
59 aToWordzh (P_ clos)
60 {
61         return (clos);
62 }
63
64 slurpClosurezh ( P_ closure )
65 {
66     W_ info, ptrs, nptrs, p, ptrs_arr, dat_arr;
67     info  = %GET_STD_INFO(UNTAG(closure));
68
69     ptrs  = TO_W_(%INFO_PTRS(info));
70     nptrs = TO_W_(%INFO_NPTRS(info));
71
72     W_ clos;
73     clos = UNTAG(closure);
74
75     W_ len;
76     (len) = foreign "C" gtc_heap_view_closureSize(clos "ptr");
77
78     W_ ptrs_arr_sz, ptrs_arr_cards, dat_arr_sz;
79     dat_arr_sz = SIZEOF_StgArrWords + WDS(len);
80
81     ALLOC_PRIM_P (dat_arr_sz, slurpClosurezh, closure);
82
83     dat_arr = Hp - dat_arr_sz + WDS(1);
84
85
86     SET_HDR(dat_arr, stg_ARR_WORDS_info, CCCS);
87     StgArrWords_bytes(dat_arr) = WDS(len);
88     p = 0;
89 for:
90     if(p < len) {
91          W_[BYTE_ARR_CTS(dat_arr) + WDS(p)] = W_[clos + WDS(p)];
92          p = p + 1;
93          goto for;
94     }
95
96     W_ ptrArray;
97
98     ("ptr" ptrArray) = foreign "C" gtc_heap_view_closurePtrs(MyCapability() "ptr", clos "ptr");
99
100     return (info, dat_arr, ptrArray);
101 }
102
103
104 reallyUnsafePtrEqualityUpToTag (W_ clos1, W_  clos2)
105 {
106     clos1 = UNTAG(clos1);
107     clos2 = UNTAG(clos2);
108     return (clos1 == clos2);
109 }
110
111 #else
112 aToWordzh
113 {
114         W_ clos;
115         clos = R1;
116         RET_N(clos);
117 }
118
119 // Taken from stg_unpackClosurezh in rts/PrimOps.cmm
120 slurpClosurezh
121 {
122 /* args: R1 = closure to analyze */
123
124     W_ clos, len;
125     clos = UNTAG(R1);
126
127     W_ info;
128     info = %GET_STD_INFO(clos);
129
130     (len) = foreign "C" gtc_heap_view_closureSize(clos "ptr") [R1];
131
132     W_ data_arr_sz;
133     data_arr_sz = SIZEOF_StgArrWords  + WDS(len);
134
135     ALLOC_PRIM (data_arr_sz, R1_PTR, slurpClosurezh);
136
137     W_ data_arr;
138     data_arr = Hp - data_arr_sz + WDS(1);
139
140     SET_HDR(data_arr, stg_ARR_WORDS_info, CCCS);
141     StgArrWords_bytes(data_arr) = WDS(len);
142     W_ p;
143     p = 0;
144 for:
145     if(p < len) {
146          // W_[BYTE_ARR_CTS(data_arr) + WDS(p)] = StgClosure_payload(clos, p);
147          W_[BYTE_ARR_CTS(data_arr) + WDS(p)] = W_[clos + WDS(p)];
148          p = p + 1;
149          goto for;
150     }
151
152     W_ ptrArray;
153
154     ("ptr" ptrArray) = foreign "C" gtc_heap_view_closurePtrs(MyCapability() "ptr", clos "ptr") [];
155
156     RET_NPP(info, data_arr, ptrArray);
157 }
158
159 reallyUnsafePtrEqualityUpToTag
160 {
161     W_ clos1;
162     W_ clos2;
163     clos1 = UNTAG(R1);
164     clos2 = UNTAG(R2);
165     RET_N(clos1 == clos2);
166 }
167 #endif