474a7eb8dc2de9f68c5067248a1257b44055b5e0
[ghc-heap-view.git] / cbits / HeapViewPrim.cmm
1 #include "Cmm.h"
2
3 #if GHC_7_7
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_StgArrWords + 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     StgArrWords_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 #else
58 aToWordzh
59 {
60         W_ clos;
61         clos = R1;
62         RET_N(clos);
63 }
64
65 // Taken from stg_unpackClosurezh in rts/PrimOps.cmm
66 slurpClosurezh
67 {
68 /* args: R1 = closure to analyze */
69
70     W_ clos, len;
71     clos = UNTAG(R1);
72
73     W_ info;
74     info = %GET_STD_INFO(clos);
75
76     (len) = foreign "C" gtc_heap_view_closureSize(clos "ptr") [R1];
77
78     W_ data_arr_sz;
79     data_arr_sz = SIZEOF_StgArrWords  + WDS(len);
80
81     ALLOC_PRIM (data_arr_sz, R1_PTR, slurpClosurezh);
82
83     W_ data_arr;
84     data_arr = Hp - data_arr_sz + WDS(1);
85
86     SET_HDR(data_arr, stg_ARR_WORDS_info, CCCS);
87     StgArrWords_bytes(data_arr) = WDS(len);
88     W_ p;
89     p = 0;
90 for:
91     if(p < len) {
92          // W_[BYTE_ARR_CTS(data_arr) + WDS(p)] = StgClosure_payload(clos, p);
93          W_[BYTE_ARR_CTS(data_arr) + WDS(p)] = W_[clos + WDS(p)];
94          p = p + 1;
95          goto for;
96     }
97
98     W_ ptrArray;
99
100     ("ptr" ptrArray) = foreign "C" gtc_heap_view_closurePtrs(MyCapability() "ptr", clos "ptr") [];
101
102     RET_NPP(info, data_arr, ptrArray);
103 }
104
105 reallyUnsafePtrEqualityUpToTag
106 {
107     W_ clos1;
108     W_ clos2;
109     clos1 = UNTAG(R1);
110     clos2 = UNTAG(R2);
111     RET_N(clos1 == clos2);
112 }
113 #endif