[Git][ghc/ghc][wip/decode_cloned_stack] Decode catch frames

[Sven Tennie (@supersven)]

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


Commits:
ead7958b by Sven Tennie at 2022-10-09T11:59:22+00:00
Decode catch frames

- - - - -


2 changed files:

- libraries/ghc-heap/GHC/Exts/DecodeStack.hs
- libraries/ghc-heap/cbits/Stack.cmm


Changes:

=====================================
libraries/ghc-heap/GHC/Exts/DecodeStack.hs
=====================================
@@ -131,7 +131,11 @@ unpackStackFrameIter sfi@(StackFrameIter (# s#, i# #)) =
         !t = (toEnum . fromInteger . toInteger) (W# (getUpdateFrameType# s# i#))
        in
         UpdateFrame t c
-     CATCH_FRAME ->  CatchFrame
+     CATCH_FRAME -> let
+        c = toClosure unpackHandlerFromCatchFrame# sfi
+        exceptionsBlocked = W# (getCatchFrameExceptionsBlocked# s# i#)
+       in
+        CatchFrame exceptionsBlocked c
      UNDERFLOW_FRAME ->  UnderflowFrame
      STOP_FRAME ->  StopFrame
      ATOMICALLY_FRAME ->  AtomicallyFrame
@@ -171,6 +175,10 @@ foreign import prim "derefStackWordzh" derefStackWord# :: StackSnapshot# -> Word
 
 foreign import prim "getUpdateFrameTypezh" getUpdateFrameType# :: StackSnapshot# -> Word# -> Word#
 
+foreign import prim "unpackHandlerFromCatchFramezh" unpackHandlerFromCatchFrame# :: StackSnapshot# -> Word# -> (# Addr#, ByteArray#, Array# b #)
+
+foreign import prim "getCatchFrameExceptionsBlockedzh" getCatchFrameExceptionsBlocked#  :: StackSnapshot# -> Word# -> Word#
+
 data BitmapPayload = Closure CL.Closure | Primitive Word
 
 instance Show BitmapPayload where
@@ -210,7 +218,7 @@ data UpdateFrameType =
 
 data StackFrame =
   UpdateFrame UpdateFrameType CL.Closure |
-  CatchFrame |
+  CatchFrame Word CL.Closure |
   CatchStmFrame |
   CatchRetryFrame |
   AtomicallyFrame |


=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -134,3 +134,23 @@ getUpdateFrameTypezh(P_ stack, W_ index){
   (type) = ccall getUpdateFrameType(c);
   return (type);
 }
+
+unpackHandlerFromCatchFramezh(P_ stack, W_ index){
+  P_ closurePtr, closurePtrPrime, handlerPtr;
+  closurePtr = (StgStack_sp(stack) + WDS(index));
+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(closurePtr));
+  handlerPtr = StgCatchFrame_handler(closurePtr);
+  // ccall debugBelch("unpackUpdateeFromUpdateFramezh - frame %p, updateePtr %p\n", closurePtr, updateePtr);
+  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));
+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(closurePtr));
+
+  W_ exceptions_blocked;
+  exceptions_blocked = StgCatchFrame_exceptions_blocked(closurePtr);
+  return (exceptions_blocked);
+}



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ead7958b8116fbb651649864b7b6f6fb09a3634d
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/20221009/4f6195e6/attachment-0001.html>