[Git][ghc/ghc][wip/decode_cloned_stack] Save 3

[Sven Tennie (@supersven)]

Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC


Commits:
be3ea151 by Sven Tennie at 2022-11-19T09:59:40+01:00
Save 3

- - - - -


2 changed files:

- libraries/ghc-heap/cbits/Stack.c
- libraries/ghc-heap/cbits/Stack.cmm


Changes:

=====================================
libraries/ghc-heap/cbits/Stack.c
=====================================
@@ -155,6 +155,12 @@ StgWord getLargeBitmapSize(StgClosure *c) {
   return bitmap->size;
 }
 
+StgWord getBCOLargeBitmapSize(StgClosure *c) {
+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
+
+  return BCO_BITMAP_SIZE(c);
+}
+
 #define ROUNDUP_BITS_TO_WDS(n)                                                 \
   (((n) + WORD_SIZE_IN_BITS - 1) / WORD_SIZE_IN_BITS)
 
@@ -198,6 +204,26 @@ StgArrBytes *getRetFunLargeBitmaps(Capability *cap, StgRetFun *ret_fun) {
   return array;
 }
 
+// TODO: Much duplication between: getBCOLargeBitmaps, getRetFunLargeBitmaps, getLargeBitmaps
+StgArrBytes *getBCOLargeBitmaps(Capability *cap, StgClosure *c) {
+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
+
+  const StgInfoTable *info = get_itbl(c);
+  StgLargeBitmap *bitmap = BCO_BITMAP(info);
+  // TODO: Use BCO_BITMAP_SIZEW?
+  StgWord neededWords = ROUNDUP_BITS_TO_WDS(bitmap->size);
+  StgArrBytes *array =
+      (StgArrBytes *)allocate(cap, sizeofW(StgArrBytes) + neededWords);
+  SET_HDR(array, &stg_ARR_WORDS_info, CCCS);
+  array->bytes = WDS(ROUNDUP_BITS_TO_WDS(bitmap->size));
+
+  for (int i = 0; i < neededWords; i++) {
+    array->payload[i] = bitmap->bitmap[i];
+  }
+
+  return array;
+}
+
 #if defined(DEBUG)
 extern void printStack(StgStack *stack);
 void belchStack(StgStack *stack) { printStack(stack); }


=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -120,7 +120,17 @@ getLargeBitmapzh(P_ stack, W_ index){
   (stgArrBytes) = ccall getLargeBitmaps(MyCapability(), c);
   (size) = ccall getLargeBitmapSize(c);
 
-  // ccall debugBelch("getLargeBitmapzh - size %ul\n", size);
+  return (stgArrBytes, size);
+}
+
+getBCOLargeBitmapzh(P_ stack, W_ index){
+  P_ c, stgArrBytes;
+  W_ size;
+  c = StgStack_sp(stack) + WDS(index);
+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
+
+  (stgArrBytes) = ccall getBCOLargeBitmaps(MyCapability(), c);
+  (size) = ccall getBCOLargeBitmapSize(c);
 
   return (stgArrBytes, size);
 }



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be3ea151f3114e58e27e77654a45f1cfb6867989

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be3ea151f3114e58e27e77654a45f1cfb6867989
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221119/58c970b0/attachment-0001.html>