[Git][ghc/ghc][wip/decode_cloned_stack] Unify decoding of referenced closures

Sven Tennie (@supersven) gitlab at gitlab.haskell.org
Sat Oct 29 08:29:42 UTC 2022



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


Commits:
627fa394 by Sven Tennie at 2022-10-29T08:28:55+00:00
Unify decoding of referenced closures

- - - - -


4 changed files:

- libraries/ghc-heap/GHC/Exts/DecodeStack.hs
- libraries/ghc-heap/cbits/Stack.cmm
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-heap/tests/all.T


Changes:

=====================================
libraries/ghc-heap/GHC/Exts/DecodeStack.hs
=====================================
@@ -19,6 +19,7 @@ module GHC.Exts.DecodeStack (
   decodeStack
                             ) where
 
+import GHC.Exts.StackConstants
 import GHC.Exts.Heap.Constants (wORD_SIZE_IN_BITS)
 import Data.Maybe
 import Data.Bits
@@ -134,12 +135,12 @@ unpackStackFrameIter sfi@(StackFrameIter (# s#, i# #)) =
      RET_FUN ->  RetFun
      -- TODO: Decode update frame type
      UPDATE_FRAME -> let
-        c = toClosure unpackUpdateeFromUpdateFrame# sfi
+        c = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgUpdateFrameUpdatee)) sfi
         !t = (toEnum . fromInteger . toInteger) (W# (getUpdateFrameType# s# i#))
        in
         UpdateFrame t c
      CATCH_FRAME -> let
-        c = toClosure unpackHandlerFromCatchFrame# sfi
+        c = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgCatchFrameHandler)) sfi
         exceptionsBlocked = W# (getCatchFrameExceptionsBlocked# s# i#)
        in
         CatchFrame exceptionsBlocked c
@@ -151,8 +152,8 @@ unpackStackFrameIter sfi@(StackFrameIter (# s#, i# #)) =
      ATOMICALLY_FRAME ->  AtomicallyFrame
      CATCH_RETRY_FRAME ->  CatchRetryFrame
      CATCH_STM_FRAME -> let
-          c = toClosure unpackCodeFromCatchSTMFrame# sfi
-          h = toClosure unpackHandlerFromCatchSTMFrame# sfi
+          c = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgCatchSTMFrameCode)) sfi
+          h = toClosure  (unpackClosureReferencedByFrame# (intToWord# offsetStgCatchSTMFrameHandler)) sfi
         in
           CatchStmFrame c h
      x -> error $ "Unexpected closure type on stack: " ++ show x
@@ -178,6 +179,9 @@ sizeofByteArray arr# = I# (sizeofByteArray# arr#)
 toInt# :: Int -> Int#
 toInt# (I# i) = i
 
+intToWord# :: Int -> Word#
+intToWord# i = int2Word# (toInt# i)
+
 -- TODO: Is the function type below needed? (Was proposed by Ben)
 -- derefStackPtr :: StackSnapshot# -> Int# -> a
 
@@ -189,11 +193,7 @@ 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 "unpackHandlerFromCatchSTMFramezh" unpackHandlerFromCatchSTMFrame# :: StackSnapshot# -> Word# -> (# Addr#, ByteArray#, Array# b #)
-
-foreign import prim "unpackCodeFromCatchSTMFramezh" unpackCodeFromCatchSTMFrame# :: StackSnapshot# -> Word# -> (# Addr#, ByteArray#, Array# b #)
+foreign import prim "unpackClosureReferencedByFramezh" unpackClosureReferencedByFrame# :: Word# -> StackSnapshot# -> Word# -> (# Addr#, ByteArray#, Array# b #)
 
 foreign import prim "getCatchFrameExceptionsBlockedzh" getCatchFrameExceptionsBlocked#  :: StackSnapshot# -> Word# -> Word#
 


=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -8,6 +8,10 @@
 #error Unknown word size
 #endif
 
+// TODO: comment out
+// Uncomment to enable assertions during development
+#define DEBUG 1
+
 advanceStackFrameIterzh (P_ stack, W_ index) {
   P_ newStack;
   W_ newIndex;
@@ -109,6 +113,7 @@ getLargeBitmapzh(P_ stack, W_ index){
   return (stgArrBytes, size);
 }
 
+// TODO: Use generalized version unpackClosureReferencedByFramezh with offset=0
 unpackClosureFromStackFramezh(P_ stack, W_ index){
   P_ closurePtr, closurePtrPrime;
   closurePtr = (StgStack_sp(stack) + WDS(index));
@@ -117,16 +122,6 @@ unpackClosureFromStackFramezh(P_ stack, W_ index){
   jump stg_unpackClosurezh(closurePtrPrime);
 }
 
-unpackUpdateeFromUpdateFramezh(P_ stack, W_ index){
-  P_ closurePtr, closurePtrPrime, updateePtr;
-  closurePtr = (StgStack_sp(stack) + WDS(index));
-  ASSERT(LOOKS_LIKE_CLOSURE_PTR(closurePtr));
-  updateePtr = StgUpdateFrame_updatee(closurePtr);
-  // ccall debugBelch("unpackUpdateeFromUpdateFramezh - frame %p, updateePtr %p\n", closurePtr, updateePtr);
-  ASSERT(LOOKS_LIKE_CLOSURE_PTR(updateePtr));
-  jump stg_unpackClosurezh(updateePtr);
-}
-
 getUpdateFrameTypezh(P_ stack, W_ index){
   P_ c;
   c = StgStack_sp(stack) + WDS(index);
@@ -137,18 +132,8 @@ getUpdateFrameTypezh(P_ stack, W_ index){
   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);
-}
-
 // Reduce duplication by using offsets instead on pointer macros.
-unpackCodeFromCatchSTMFramezh(P_ stack, W_ index){
+unpackClosureReferencedByFramezh(W_ offset, P_ stack, W_ index){
   P_ closurePtr, closurePtrPrime, codePtr;
   closurePtr = (StgStack_sp(stack) + WDS(index));
   ASSERT(LOOKS_LIKE_CLOSURE_PTR(closurePtr));
@@ -157,15 +142,6 @@ unpackCodeFromCatchSTMFramezh(P_ stack, W_ index){
   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/ghc-heap.cabal.in
=====================================
@@ -50,3 +50,4 @@ library
                     GHC.Exts.Heap.ProfInfo.PeekProfInfo
                     GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingDisabled
                     GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled
+                    GHC.Exts.StackConstants


=====================================
libraries/ghc-heap/tests/all.T
=====================================
@@ -67,7 +67,7 @@ test('stack_big_ret',
         ignore_stderr
      ],
      compile_and_run,
-     [''])
+     ['-debug'])
 
 # Options:
 #   - `-kc512B -kb64B`: Make stack chunk size small to provoke underflow stack frames.
@@ -78,7 +78,7 @@ test('stack_underflow',
         ignore_stdout,
         ignore_stderr
      ],
-     compile_and_run, ['-rtsopts'])
+     compile_and_run, ['-debug -rtsopts'])
 
 test('stack_stm_frames',
      [



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/627fa39448a2322e40c5498d9dca831966ca376a
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/20221029/5b02c90a/attachment-0001.html>


More information about the ghc-commits mailing list