[Git][ghc/ghc][wip/decode_cloned_stack] Decode StgCatchStmFrame

[Sven Tennie (@supersven)]

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


Commits:
7bde90e2 by Sven Tennie at 2022-10-23T15:03:02+00:00
Decode StgCatchStmFrame

- - - - -


4 changed files:

- libraries/ghc-heap/GHC/Exts/DecodeStack.hs
- libraries/ghc-heap/cbits/Stack.cmm
- libraries/ghc-heap/tests/all.T
- rts/Printer.c


Changes:

=====================================
libraries/ghc-heap/GHC/Exts/DecodeStack.hs
=====================================
@@ -150,7 +150,11 @@ unpackStackFrameIter sfi@(StackFrameIter (# s#, i# #)) =
      STOP_FRAME ->  StopFrame
      ATOMICALLY_FRAME ->  AtomicallyFrame
      CATCH_RETRY_FRAME ->  CatchRetryFrame
-     CATCH_STM_FRAME ->  CatchStmFrame
+     CATCH_STM_FRAME -> let
+          c = toClosure unpackCodeFromCatchSTMFrame# sfi
+          h = toClosure unpackHandlerFromCatchSTMFrame# sfi
+        in
+          CatchStmFrame c h
      x -> error $ "Unexpected closure type on stack: " ++ show x
 
 -- | Right-fold over the elements of a 'ByteArray'.
@@ -187,6 +191,10 @@ foreign import prim "getUpdateFrameTypezh" getUpdateFrameType# :: StackSnapshot#
 
 foreign import prim "unpackHandlerFromCatchFramezh" unpackHandlerFromCatchFrame# :: StackSnapshot# -> Word# -> (# Addr#, ByteArray#, Array# b #)
 
+foreign import prim "unpackHandlerFromCatchSTMFramezh" unpackHandlerFromCatchSTMFrame# :: StackSnapshot# -> Word# -> (# Addr#, ByteArray#, Array# b #)
+
+foreign import prim "unpackCodeFromCatchSTMFramezh" unpackCodeFromCatchSTMFrame# :: StackSnapshot# -> Word# -> (# Addr#, ByteArray#, Array# b #)
+
 foreign import prim "getCatchFrameExceptionsBlockedzh" getCatchFrameExceptionsBlocked#  :: StackSnapshot# -> Word# -> Word#
 
 foreign import prim "getUnderflowFrameNextChunkzh" getUnderflowFrameNextChunk# :: StackSnapshot# -> Word# -> StackSnapshot#
@@ -229,14 +237,14 @@ data UpdateFrameType =
   deriving (Enum, Eq, Show)
 
 data StackFrame =
-  UpdateFrame UpdateFrameType CL.Closure |
-  CatchFrame Word CL.Closure |
-  CatchStmFrame |
+  UpdateFrame { knownUpdateFrameType :: UpdateFrameType, updatee :: CL.Closure } |
+  CatchFrame { exceptions_blocked :: Word,  handler :: CL.Closure } |
+  CatchStmFrame { code :: CL.Closure, handler :: CL.Closure  } |
   CatchRetryFrame |
   AtomicallyFrame |
   UnderflowFrame { nextChunk:: StackSnapshot } |
   StopFrame |
-  RetSmall SpecialRetSmall [BitmapPayload] |
+  RetSmall { knownRetSmallType :: SpecialRetSmall, payload :: [BitmapPayload]} |
   RetBig { payload :: [BitmapPayload] } |
   RetFun |
   RetBCO


=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -147,6 +147,25 @@ unpackHandlerFromCatchFramezh(P_ stack, W_ index){
   jump stg_unpackClosurezh(handlerPtr);
 }
 
+// Reduce duplication by using offsets instead on pointer macros.
+unpackCodeFromCatchSTMFramezh(P_ stack, W_ index){
+  P_ closurePtr, closurePtrPrime, codePtr;
+  closurePtr = (StgStack_sp(stack) + WDS(index));
+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(closurePtr));
+  codePtr = StgCatchSTMFrame_code(closurePtr);
+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(codePtr));
+  jump stg_unpackClosurezh(codePtr);
+}
+
+unpackHandlerFromCatchSTMFramezh(P_ stack, W_ index){
+  P_ closurePtr, closurePtrPrime, handlerPtr;
+  closurePtr = (StgStack_sp(stack) + WDS(index));
+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(closurePtr));
+  handlerPtr = StgCatchSTMFrame_handler(closurePtr);
+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(handlerPtr));
+  jump stg_unpackClosurezh(handlerPtr);
+}
+
 getCatchFrameExceptionsBlockedzh(P_ stack, W_ index){
   P_ closurePtr, closurePtrPrime, updateePtr;
   closurePtr = (StgStack_sp(stack) + WDS(index));


=====================================
libraries/ghc-heap/tests/all.T
=====================================
@@ -74,8 +74,16 @@ test('stack_big_ret',
 test('stack_underflow',
      [
         extra_files(['TestUtils.hs']),
-         extra_run_opts('+RTS -kc512B -kb64B -RTS'),
-         ignore_stdout,
-         ignore_stderr
+        extra_run_opts('+RTS -kc512B -kb64B -RTS'),
+        ignore_stdout,
+        ignore_stderr
      ],
      compile_and_run, ['-rtsopts'])
+
+test('stack_stm_frames',
+     [
+        extra_files(['TestUtils.hs']),
+        ignore_stdout,
+        ignore_stderr
+      ],
+     compile_and_run, ['-debug'])


=====================================
rts/Printer.c
=====================================
@@ -280,6 +280,32 @@ printClosure( const StgClosure *obj )
             break;
         }
 
+    case CATCH_STM_FRAME:
+        {
+            StgCatchSTMFrame* c = (StgCatchSTMFrame*)obj;
+            debugBelch("CATCH_STM_FRAME(");
+            printPtr((StgPtr)GET_INFO((StgClosure *)c));
+            debugBelch(",");
+            printPtr((StgPtr)c->code);
+             debugBelch(",");
+            printPtr((StgPtr)c->handler);
+            debugBelch(")\n");
+            break;
+        }
+
+    case ATOMICALLY_FRAME :
+        {
+            StgAtomicallyFrame* f = (StgAtomicallyFrame*)obj;
+            debugBelch("ATOMICALLY_FRAME(");
+            printPtr((StgPtr)GET_INFO((StgClosure *)f));
+            debugBelch(",");
+            printPtr((StgPtr)f->code);
+            debugBelch(",");
+            printPtr((StgPtr)f->result);
+            debugBelch(")\n");
+            break;
+         }
+
     case UNDERFLOW_FRAME:
         {
             StgUnderflowFrame* u = (StgUnderflowFrame*)obj;
@@ -553,10 +579,12 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
 
         switch (info->type) {
 
+        case UNDERFLOW_FRAME:
         case UPDATE_FRAME:
         case CATCH_FRAME:
-        case UNDERFLOW_FRAME:
         case STOP_FRAME:
+        case CATCH_STM_FRAME:
+        case ATOMICALLY_FRAME:
             printClosure((StgClosure*)sp);
             continue;
 



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bde90e29ac27488a524289d0f3f44aff8dcc65c
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/20221023/11fe2f47/attachment-0001.html>