[Git][ghc/ghc][wip/decode_cloned_stack] 5 commits: Haddock

Sven Tennie (@supersven) gitlab at gitlab.haskell.org
Sun Apr 23 09:19:10 UTC 2023



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


Commits:
08e8e362 by Sven Tennie at 2023-04-23T08:45:10+00:00
Haddock

- - - - -
03521011 by Sven Tennie at 2023-04-23T08:53:15+00:00
Simplify stackHead

- - - - -
0fc54d87 by Sven Tennie at 2023-04-23T09:00:51+00:00
Formatting

- - - - -
8a30e8e7 by Sven Tennie at 2023-04-23T09:07:49+00:00
Rename: getBoxedClosure -> getStackClosure

- - - - -
e071fa31 by Sven Tennie at 2023-04-23T09:18:10+00:00
Document Cmm return values

- - - - -


5 changed files:

- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Stack.hs
- libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
- libraries/ghc-heap/cbits/Stack.c
- libraries/ghc-heap/cbits/Stack.cmm


Changes:

=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -390,38 +390,38 @@ data  StgStackClosure = StgStackClosure
 -- matches and complicates the whole implementation (and breaks existing code.)
 data StackFrame =
    UpdateFrame
-      { info_tbl            :: !StgInfoTable
-      , updatee :: !Closure
+      { info_tbl           :: !StgInfoTable
+      , updatee            :: !Closure
       }
 
   | CatchFrame
       { info_tbl            :: !StgInfoTable
-      , exceptions_blocked :: Word
-      , handler :: !Closure
+      , exceptions_blocked  :: Word
+      , handler             :: !Closure
       }
 
   | CatchStmFrame
       { info_tbl            :: !StgInfoTable
-      , catchFrameCode :: !Closure
-      , handler :: !Closure
+      , catchFrameCode      :: !Closure
+      , handler             :: !Closure
       }
 
   | CatchRetryFrame
       { info_tbl            :: !StgInfoTable
-      , running_alt_code :: !Word
-      , first_code :: !Closure
-      , alt_code :: !Closure
+      , running_alt_code    :: !Word
+      , first_code          :: !Closure
+      , alt_code            :: !Closure
       }
 
   | AtomicallyFrame
       { info_tbl            :: !StgInfoTable
       , atomicallyFrameCode :: !Closure
-      , result :: !Closure
+      , result              :: !Closure
       }
 
   | UnderflowFrame
       { info_tbl            :: !StgInfoTable
-      , nextChunk       :: !StgStackClosure
+      , nextChunk           :: !StgStackClosure
       }
 
   | StopFrame
@@ -429,26 +429,26 @@ data StackFrame =
 
   | RetSmall
       { info_tbl            :: !StgInfoTable
-      , stack_payload :: ![Closure]
+      , stack_payload       :: ![Closure]
       }
 
   | RetBig
       { info_tbl            :: !StgInfoTable
-      , stack_payload :: ![Closure]
+      , stack_payload       :: ![Closure]
       }
 
   | RetFun
       { info_tbl            :: !StgInfoTable
-      , retFunType :: RetFunType
-      , retFunSize :: Word
-      , retFunFun :: !Closure
-      , retFunPayload :: ![Closure]
+      , retFunType          :: RetFunType
+      , retFunSize          :: Word
+      , retFunFun           :: !Closure
+      , retFunPayload       :: ![Closure]
       }
 
   |  RetBCO
       { info_tbl            :: !StgInfoTable
-      , bco :: !Closure -- must be a BCOClosure
-      , bcoArgs :: ![Closure]
+      , bco                 :: !Closure -- must be a BCOClosure
+      , bcoArgs             :: ![Closure]
       }
   deriving (Show, Generic)
 


=====================================
libraries/ghc-heap/GHC/Exts/Stack.hs
=====================================
@@ -14,6 +14,9 @@ import GHC.Exts.Stack.Constants
 import GHC.Exts.Stack.Decode
 import Prelude
 
+-- | Get the size of the `StackFrame` in words.
+--
+-- Includes header and payload. Does not follow pointers.
 stackFrameSize :: StackFrame -> Int
 stackFrameSize (UpdateFrame {}) = sizeStgUpdateFrame
 stackFrameSize (CatchFrame {}) = sizeStgCatchFrame


=====================================
libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
=====================================
@@ -190,8 +190,8 @@ getInfoTableForStack stackSnapshot# =
   peekItbl $
     Ptr (getStackInfoTableAddr# stackSnapshot#)
 
-foreign import prim "getBoxedClosurezh"
-  getBoxedClosure# ::
+foreign import prim "getStackClosurezh"
+  getStackClosure# ::
     StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Any #)
 
 foreign import prim "getStackFieldszh"
@@ -205,8 +205,8 @@ getStackFields stackSnapshot# = IO $ \s ->
       (# s1, (W32# sSize#, W8# sDirty#, W8# sMarking#) #)
 
 -- | `StackFrameLocation` of the top-most stack frame
-stackHead :: StackSnapshot -> StackFrameLocation
-stackHead (StackSnapshot s#) = (StackSnapshot s#, 0) -- GHC stacks are never empty
+stackHead :: StackSnapshot# -> StackFrameLocation
+stackHead s# = (StackSnapshot s#, 0) -- GHC stacks are never empty
 
 -- | Advance to the next stack frame (if any)
 --
@@ -230,7 +230,7 @@ advanceStackFrameLocation ((StackSnapshot stackSnapshot#), index) =
 getClosure :: StackSnapshot# -> WordOffset -> IO Closure
 getClosure stackSnapshot# index =
   ( IO $ \s ->
-      case getBoxedClosure#
+      case getStackClosure#
         stackSnapshot#
         (wordOffsetToWord# index)
         s of
@@ -427,19 +427,25 @@ intToWord# i = int2Word# (toInt# i)
 wordOffsetToWord# :: WordOffset -> Word#
 wordOffsetToWord# wo = intToWord# (fromIntegral wo)
 
+-- | Location of a stackframe on the stack
+--
+-- It's defined by the `StackSnapshot` (@StgStack@) and the offset to the bottom
+-- of the stack.
 type StackFrameLocation = (StackSnapshot, WordOffset)
 
 -- | Decode `StackSnapshot` to a `StgStackClosure`
 --
 -- The return value is the representation of the @StgStack@ itself.
+--
+-- See /Note [Decoding the stack]/.
 decodeStack :: StackSnapshot -> IO StgStackClosure
 decodeStack (StackSnapshot stack#) = do
   info <- getInfoTableForStack stack#
   (stack_size', stack_dirty', stack_marking') <- getStackFields stack#
   case tipe info of
     STACK -> do
-      let sfis = stackFrameLocations (StackSnapshot stack#)
-      stack' <- mapM unpackStackFrame sfis
+      let sfls = stackFrameLocations stack#
+      stack' <- mapM unpackStackFrame sfls
       pure $
         StgStackClosure
           { ssc_info = info,
@@ -450,10 +456,10 @@ decodeStack (StackSnapshot stack#) = do
           }
     _ -> error $ "Expected STACK closure, got " ++ show info
   where
-    stackFrameLocations :: StackSnapshot -> [StackFrameLocation]
-    stackFrameLocations s =
-      stackHead s
-        : go (advanceStackFrameLocation (stackHead s))
+    stackFrameLocations :: StackSnapshot# -> [StackFrameLocation]
+    stackFrameLocations s# =
+      stackHead s#
+        : go (advanceStackFrameLocation (stackHead s#))
       where
         go :: Maybe StackFrameLocation -> [StackFrameLocation]
         go Nothing = []


=====================================
libraries/ghc-heap/cbits/Stack.c
=====================================
@@ -147,4 +147,4 @@ StgWord getRetFunType(StgRetFun *ret_fun) {
   return fun_info->f.fun_type;
 }
 
-StgClosure *getBoxedClosure(StgClosure **c) { return *c; }
+StgClosure *getStackClosure(StgClosure **c) { return *c; }


=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -8,7 +8,9 @@
 // developed.
 #if defined(StgStack_marking)
 
-// advanceStackFrameLocationzh(StgStack* stack, StgWord offsetWords)
+// Returns the next stackframe's StgStack* and offset in it. And, an indicator
+// if this frame is the last one (`hasNext` bit.)
+// (StgStack*, StgWord, StgWord) advanceStackFrameLocationzh(StgStack* stack, StgWord offsetWords)
 advanceStackFrameLocationzh (P_ stack, W_ offsetWords) {
   W_ frameSize;
   (frameSize) = ccall stackFrameSize(stack, offsetWords);
@@ -48,7 +50,7 @@ advanceStackFrameLocationzh (P_ stack, W_ offsetWords) {
   return (newStack, newOffsetWords, hasNext);
 }
 
-// getSmallBitmapzh(StgStack* stack, StgWord offsetWords)
+// (StgWord, StgWord) getSmallBitmapzh(StgStack* stack, StgWord offsetWords)
 getSmallBitmapzh(P_ stack, W_ offsetWords) {
   P_ c;
   c = StgStack_sp(stack) + WDS(offsetWords);
@@ -62,7 +64,7 @@ getSmallBitmapzh(P_ stack, W_ offsetWords) {
 }
 
 
-// getRetFunSmallBitmapzh(StgStack* stack, StgWord offsetWords)
+// (StgWord, StgWord) getRetFunSmallBitmapzh(StgStack* stack, StgWord offsetWords)
 getRetFunSmallBitmapzh(P_ stack, W_ offsetWords) {
   P_ c;
   c = StgStack_sp(stack) + WDS(offsetWords);
@@ -75,7 +77,7 @@ getRetFunSmallBitmapzh(P_ stack, W_ offsetWords) {
   return (bitmap, size);
 }
 
-// getLargeBitmapzh(StgStack* stack, StgWord offsetWords)
+// (StgWord*, StgWord) getLargeBitmapzh(StgStack* stack, StgWord offsetWords)
 getLargeBitmapzh(P_ stack, W_ offsetWords) {
   P_ c, words;
   W_ size;
@@ -88,7 +90,7 @@ getLargeBitmapzh(P_ stack, W_ offsetWords) {
   return (words, size);
 }
 
-// getBCOLargeBitmapzh(StgStack* stack, StgWord offsetWords)
+// (StgWord*, StgWord) getBCOLargeBitmapzh(StgStack* stack, StgWord offsetWords)
 getBCOLargeBitmapzh(P_ stack, W_ offsetWords) {
   P_ c, words;
   W_ size;
@@ -101,7 +103,7 @@ getBCOLargeBitmapzh(P_ stack, W_ offsetWords) {
   return (words, size);
 }
 
-// getRetFunLargeBitmapzh(StgStack* stack, StgWord offsetWords)
+// (StgWord*, StgWord) getRetFunLargeBitmapzh(StgStack* stack, StgWord offsetWords)
 getRetFunLargeBitmapzh(P_ stack, W_ offsetWords) {
   P_ c, words;
   W_ size;
@@ -114,22 +116,14 @@ getRetFunLargeBitmapzh(P_ stack, W_ offsetWords) {
   return (words, size);
 }
 
-// getWordzh(StgStack* stack, StgWord offsetWords)
+// (StgWord) getWordzh(StgStack* stack, StgWord offsetWords)
 getWordzh(P_ stack, W_ offsetWords) {
   P_ wordAddr;
   wordAddr = (StgStack_sp(stack) + WDS(offsetWords));
   return (W_[wordAddr]);
 }
 
-getAddrzh(P_ stack, W_ offsetWords){
-  P_ addr;
-  addr = (StgStack_sp(stack) + WDS(offsetWords));
-  P_ ptr;
-  ptr = P_[addr];
-  return (ptr);
-}
-
-// getUnderflowFrameNextChunkzh(StgStack* stack, StgWord offsetWords)
+// (StgStack*) getUnderflowFrameNextChunkzh(StgStack* stack, StgWord offsetWords)
 getUnderflowFrameNextChunkzh(P_ stack, W_ offsetWords) {
   P_ closurePtr;
   closurePtr = (StgStack_sp(stack) + WDS(offsetWords));
@@ -141,7 +135,7 @@ getUnderflowFrameNextChunkzh(P_ stack, W_ offsetWords) {
   return (next_chunk);
 }
 
-// getRetFunTypezh(StgStack* stack, StgWord offsetWords)
+// (StgWord) getRetFunTypezh(StgStack* stack, StgWord offsetWords)
 getRetFunTypezh(P_ stack, W_ offsetWords) {
   P_ c;
   c = StgStack_sp(stack) + WDS(offsetWords);
@@ -152,7 +146,7 @@ getRetFunTypezh(P_ stack, W_ offsetWords) {
   return (type);
 }
 
-// getInfoTableAddrzh(StgStack* stack, StgWord offsetWords)
+// (StgInfoTable*) getInfoTableAddrzh(StgStack* stack, StgWord offsetWords)
 getInfoTableAddrzh(P_ stack, W_ offsetWords) {
   P_ p, info;
   p = StgStack_sp(stack) + WDS(offsetWords);
@@ -162,24 +156,24 @@ getInfoTableAddrzh(P_ stack, W_ offsetWords) {
   return (info);
 }
 
-// getStackInfoTableAddrzh(StgStack* stack)
+// (StgInfoTable*) getStackInfoTableAddrzh(StgStack* stack)
 getStackInfoTableAddrzh(P_ stack) {
   P_ info;
   info = %GET_STD_INFO(UNTAG(stack));
   return (info);
 }
 
-// getBoxedClosurezh(StgStack* stack, StgWord offsetWords)
-getBoxedClosurezh(P_ stack, W_ offsetWords) {
+// (StgClosure*) getStackClosurezh(StgStack* stack, StgWord offsetWords)
+getStackClosurezh(P_ stack, W_ offsetWords) {
   P_ ptr;
   ptr = StgStack_sp(stack) + WDS(offsetWords);
 
-  P_ box;
-  (box) = ccall getBoxedClosure(ptr);
-  return (box);
+  P_ closure;
+  (closure) = ccall getStackClosure(ptr);
+  return (closure);
 }
 
-// getStackFieldszh(StgStack* stack)
+// (bits32, bits8, bits8) getStackFieldszh(StgStack* stack)
 getStackFieldszh(P_ stack){
   bits32 size;
   bits8 dirty, marking;



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e42e2f82e63ebd350dedfc1815f89e4a009d8506...e071fa31da7c5e9264685bf17ca582bde756d00f

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e42e2f82e63ebd350dedfc1815f89e4a009d8506...e071fa31da7c5e9264685bf17ca582bde756d00f
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/20230423/559af0eb/attachment-0001.html>


More information about the ghc-commits mailing list