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