[Git][ghc/ghc][wip/decode_cloned_stack] stack_comparison can decode simple stack

[Sven Tennie (@supersven)]

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


Commits:
139fd93d by Sven Tennie at 2022-11-26T11:11:49+00:00
stack_comparison can decode simple stack

- - - - -


3 changed files:

- libraries/ghc-heap/tests/all.T
- libraries/ghc-heap/tests/stack_comparison.hs
- libraries/ghc-heap/tests/stack_lib.c


Changes:

=====================================
libraries/ghc-heap/tests/all.T
=====================================
@@ -90,7 +90,7 @@ test('stack_stm_frames',
 
 test('stack_comparison',
      [extra_files(['stack_lib.c','TestUtils.hs']),
-      ignore_stdout,
+#      ignore_stdout,
       ignore_stderr
      ],
      multi_compile_and_run, ['stack_comparison', [('stack_lib.c','')], '-debug -optc-g -g'])


=====================================
libraries/ghc-heap/tests/stack_comparison.hs
=====================================
@@ -9,6 +9,7 @@ import GHC.Stack.CloneStack
 import TestUtils
 import GHC.Exts
 import Data.Array.Byte
+import GHC.Exts.Heap
 
 foreign import ccall "foldStackToArrayClosure" foldStackToArrayClosure# :: StackSnapshot# -> ByteArray#
 
@@ -19,14 +20,30 @@ main :: IO ()
 main = do
   stack <- cloneMyStack
   let ba = foldStackToArrayClosure stack
-  print . show . toWords $ ba
+  let s = I# (sizeofByteArray# b#)
+      (ByteArray b#) = ba
+--  print $ "ByteArray size" ++ show (I# (sizeofByteArray# b#))
+--  print $ "indices " ++ show [0..((wds s) -1)]
+  print . show . toClosureTypes . toWords $ ba
+
+maxWordIndex :: ByteArray -> Int
+maxWordIndex (ByteArray ba#) =
+  let s = I# (sizeofByteArray# ba#)
+      words = s `div` 8
+  in
+    case words of
+      w | w == 0 -> error "ByteArray contains no content!"
+      w -> w - 1
 
 toWords :: ByteArray -> [Word]
-toWords (ByteArray b#) =
+toWords ba@(ByteArray b#) =
   let s = I# (sizeofByteArray# b#)
   in
     -- TODO: Adjust 8 to machine word size
-    [ W# (indexWordArray# b# (toInt# i)) | i <- [0..], i<=(s `div` 8)  ]
+    [ W# (indexWordArray# b# (toInt# i)) | i <- [0..maxWordIndex(ba)] ]
+
+toClosureTypes :: [Word] -> [ClosureType]
+toClosureTypes = map (toEnum . fromIntegral)
 
 toInt# :: Int -> Int#
 toInt# (I# i#) = i#


=====================================
libraries/ghc-heap/tests/stack_lib.c
=====================================
@@ -193,6 +193,11 @@ ClosureTypeList *foldStackToList(StgStack *stack) {
   return result;
 }
 
+// Copied from Cmm.h
+/* Converting quantities of words to bytes */
+#define SIZEOF_W SIZEOF_VOID_P
+#define WDS(n) ((n)*SIZEOF_W)
+
 StgArrBytes *createArrayClosure(ClosureTypeList *list) {
   Capability *cap = rts_lock();
   // Mapping closure types to StgWord is pretty generous as they would fit
@@ -201,7 +206,7 @@ StgArrBytes *createArrayClosure(ClosureTypeList *list) {
   StgArrBytes *array =
       (StgArrBytes *)allocate(cap, sizeofW(StgArrBytes) + neededWords);
   SET_HDR(array, &stg_ARR_WORDS_info, CCCS);
-  array->bytes = listSize(list);
+  array->bytes = WDS(listSize(list));
 
   for (int i = 0; list != NULL; i++) {
     array->payload[i] = list->closureType;



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/139fd93ddaf7cf6f6cd3b060b2914b3999b62b4f
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/20221126/fa331964/attachment-0001.html>