[Git][ghc/ghc][wip/decode_cloned_stack] Decode Update Frame type

[Sven Tennie (@supersven)]

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


Commits:
ac527c8e by Sven Tennie at 2022-10-09T11:31:45+00:00
Decode Update Frame type

- - - - -


4 changed files:

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


Changes:

=====================================
libraries/ghc-heap/GHC/Exts/DecodeStack.hs
=====================================
@@ -126,7 +126,11 @@ unpackStackFrameIter sfi@(StackFrameIter (# s#, i# #)) =
                   RetBig payloads
      RET_FUN ->  RetFun
      -- TODO: Decode update frame type
-     UPDATE_FRAME ->  UpdateFrame NormalUpdateFrame (toClosure unpackUpdateeFromUpdateFrame# sfi)
+     UPDATE_FRAME -> let
+        c = toClosure unpackUpdateeFromUpdateFrame# sfi
+        !t = (toEnum . fromInteger . toInteger) (W# (getUpdateFrameType# s# i#))
+       in
+        UpdateFrame t c
      CATCH_FRAME ->  CatchFrame
      UNDERFLOW_FRAME ->  UnderflowFrame
      STOP_FRAME ->  StopFrame
@@ -165,6 +169,8 @@ foreign import prim "unpackUpdateeFromUpdateFramezh" unpackUpdateeFromUpdateFram
 
 foreign import prim "derefStackWordzh" derefStackWord# :: StackSnapshot# -> Word# -> Word#
 
+foreign import prim "getUpdateFrameTypezh" getUpdateFrameType# :: StackSnapshot# -> Word# -> Word#
+
 data BitmapPayload = Closure CL.Closure | Primitive Word
 
 instance Show BitmapPayload where
@@ -194,13 +200,13 @@ data SpecialRetSmall =
   RetL |
   RestoreCCCS |
   RestoreCCCSEval
-  deriving (Enum, Eq,Show)
+  deriving (Enum, Eq, Show)
 
 data UpdateFrameType =
   NormalUpdateFrame |
   BhUpdateFrame |
   MarkedUpdateFrame
-  deriving (Show)
+  deriving (Enum, Eq, Show)
 
 data StackFrame =
   UpdateFrame UpdateFrameType CL.Closure |


=====================================
libraries/ghc-heap/cbits/Stack.c
=====================================
@@ -79,6 +79,23 @@ StgWord getSpecialRetSmall(StgClosure *closure) {
   }
 }
 
+StgWord getUpdateFrameType(StgClosure* c) {
+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
+
+  const StgInfoTable* info = c->header.info;
+  if (info == &stg_upd_frame_info) {
+      return 0;
+  } else if (info == &stg_bh_upd_frame_info) {
+      return 1;
+  } else if (info == &stg_marked_upd_frame_info) {
+      return 2;
+  } else {
+    // Cannot do more than warn and exit.
+    errorBelch("Cannot decide Update Frame type for info table %p closure %p.", info, c);
+    stg_exit(EXIT_INTERNAL_ERROR);
+  }
+}
+
 StgWord getBitmapSize(StgClosure *c){
   ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
 


=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -93,6 +93,20 @@ getSmallBitmapzh(P_ stack, W_ index) {
   return (bitmap, size, specialType);
 }
 
+getLargeBitmapzh(P_ stack, W_ index){
+  P_ c, stgArrBytes;
+  W_ size;
+  c = StgStack_sp(stack) + WDS(index);
+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
+
+  (stgArrBytes) = ccall getLargeBitmaps(MyCapability(), c);
+  (size) = ccall getLargeBitmapSize(c);
+
+  // ccall debugBelch("getLargeBitmapzh - size %ul\n", size);
+
+  return (stgArrBytes, size);
+}
+
 unpackClosureFromStackFramezh(P_ stack, W_ index){
   P_ closurePtr, closurePtrPrime;
   closurePtr = (StgStack_sp(stack) + WDS(index));
@@ -111,16 +125,12 @@ unpackUpdateeFromUpdateFramezh(P_ stack, W_ index){
   jump stg_unpackClosurezh(updateePtr);
 }
 
-getLargeBitmapzh(P_ stack, W_ index){
-  P_ c, stgArrBytes;
-  W_ size;
+getUpdateFrameTypezh(P_ stack, W_ index){
+  P_ c;
   c = StgStack_sp(stack) + WDS(index);
   ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
 
-  (stgArrBytes) = ccall getLargeBitmaps(MyCapability(), c);
-  (size) = ccall getLargeBitmapSize(c);
-
-  // ccall debugBelch("getLargeBitmapzh - size %ul\n", size);
-
-  return (stgArrBytes, size);
+  W_ type;
+  (type) = ccall getUpdateFrameType(c);
+  return (type);
 }


=====================================
rts/Printer.c
=====================================
@@ -456,6 +456,7 @@ const char *info_update_frame(const StgClosure *closure)
     // it pointing to the code or struct members when compiling with
     // TABLES_NEXT_TO_CODE.
     const StgInfoTable *info = closure->header.info;
+    debugBelch("info_update_frame - closure %p, info %p\n", closure, info);
     if (info == &stg_upd_frame_info) {
         return "NORMAL_UPDATE_FRAME";
     } else if (info == &stg_bh_upd_frame_info) {



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac527c8e0b45c197d5eee1fcecbbf01f8033a728
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/48080a58/attachment-0001.html>