[Git][ghc/ghc][wip/decode_cloned_stack] 2 commits: Remove RetFunType from RetFun stack frame representation

Sven Tennie (@supersven) gitlab at gitlab.haskell.org
Fri Aug 4 19:01:18 UTC 2023



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


Commits:
fa776894 by Sven Tennie at 2023-08-04T20:58:23+02:00
Remove RetFunType from RetFun stack frame representation

It's a technical detail. The single usage is replaced by a predicate.

- - - - -
9b939c90 by Sven Tennie at 2023-08-04T20:58:36+02:00
Better parameter name

The call-site uses the term "offset", too.

- - - - -


5 changed files:

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


Changes:

=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -15,7 +15,6 @@ module GHC.Exts.Heap.Closures (
     , WhatNext(..)
     , WhyBlocked(..)
     , TsoFlags(..)
-    , RetFunType(..)
     , allClosures
     , closureSize
 
@@ -458,7 +457,6 @@ data GenStackFrame b =
 
   | RetFun
       { info_tbl            :: !StgInfoTable
-      , retFunType          :: !RetFunType
       , retFunSize          :: !Word
       , retFunFun           :: !b
       , retFunPayload       :: ![GenStackField b]
@@ -471,40 +469,6 @@ data GenStackFrame b =
       }
   deriving (Foldable, Functor, Generic, Show, Traversable)
 
--- | Fun types according to @FunTypes.h@
--- This `Enum` must be aligned with the values in @FunTypes.h at .
-data RetFunType =
-      ARG_GEN     |
-      ARG_GEN_BIG |
-      ARG_BCO     |
-      ARG_NONE    |
-      ARG_N       |
-      ARG_P       |
-      ARG_F       |
-      ARG_D       |
-      ARG_L       |
-      ARG_V16     |
-      ARG_V32     |
-      ARG_V64     |
-      ARG_NN      |
-      ARG_NP      |
-      ARG_PN      |
-      ARG_PP      |
-      ARG_NNN     |
-      ARG_NNP     |
-      ARG_NPN     |
-      ARG_NPP     |
-      ARG_PNN     |
-      ARG_PNP     |
-      ARG_PPN     |
-      ARG_PPP     |
-      ARG_PPPP    |
-      ARG_PPPPP   |
-      ARG_PPPPPP  |
-      ARG_PPPPPPP |
-      ARG_PPPPPPPP
-      deriving (Show, Eq, Enum, Generic)
-
 data PrimType
   = PInt
   | PWord


=====================================
libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
=====================================
@@ -26,8 +26,7 @@ import GHC.Exts
 import GHC.Exts.Heap (Box (..))
 import GHC.Exts.Heap.ClosureTypes
 import GHC.Exts.Heap.Closures
-  ( RetFunType (..),
-    StackFrame,
+  ( StackFrame,
     GenStackFrame (..),
     StgStackClosure,
     GenStgStackClosure (..),
@@ -124,12 +123,11 @@ getWord :: StackSnapshot# -> WordOffset -> Word
 getWord stackSnapshot# index =
   W# (getWord# stackSnapshot# (wordOffsetToWord# index))
 
-foreign import prim "getRetFunTypezh" getRetFunType# :: StackSnapshot# -> Word# -> Word#
+foreign import prim "isArgGenBigRetFunTypezh" isArgGenBigRetFunType# :: StackSnapshot# -> Word# -> Int#
 
-getRetFunType :: StackSnapshot# -> WordOffset -> RetFunType
-getRetFunType stackSnapshot# index =
-  toEnum . fromInteger . toInteger $
-    W# (getRetFunType# stackSnapshot# (wordOffsetToWord# index))
+isArgGenBigRetFunType :: StackSnapshot# -> WordOffset -> Bool
+isArgGenBigRetFunType stackSnapshot# index =
+  I# (isArgGenBigRetFunType# stackSnapshot# (wordOffsetToWord# index)) > 0
 
 -- | Gets contents of a `LargeBitmap` (@StgLargeBitmap@)
 --
@@ -319,17 +317,15 @@ unpackStackFrame (StackSnapshot stackSnapshot#, index) = do
                 stack_payload = payload'
               }
         RET_FUN -> do
-          let retFunType' = getRetFunType stackSnapshot# index
-              retFunSize' = getWord stackSnapshot# (index + offsetStgRetFunFrameSize)
+          let retFunSize' = getWord stackSnapshot# (index + offsetStgRetFunFrameSize)
           retFunFun' <- getClosureBox stackSnapshot# (index + offsetStgRetFunFrameFun)
           retFunPayload' <-
-            if retFunType' == ARG_GEN_BIG
+            if isArgGenBigRetFunType stackSnapshot# index == True
               then decodeLargeBitmap getRetFunLargeBitmap# stackSnapshot# index offsetStgRetFunFramePayload
               else decodeSmallBitmap getRetFunSmallBitmap# stackSnapshot# index offsetStgRetFunFramePayload
           pure $
             RetFun
               { info_tbl = info,
-                retFunType = retFunType',
                 retFunSize = retFunSize',
                 retFunFun = retFunFun',
                 retFunPayload = retFunPayload'


=====================================
libraries/ghc-heap/cbits/Stack.c
=====================================
@@ -5,16 +5,17 @@
 #include "rts/Types.h"
 #include "rts/storage/ClosureTypes.h"
 #include "rts/storage/Closures.h"
+#include "rts/storage/FunTypes.h"
 #include "rts/storage/InfoTables.h"
 
-StgWord stackFrameSize(StgStack *stack, StgWord index) {
-  StgClosure *c = (StgClosure *)stack->sp + index;
+StgWord stackFrameSize(StgStack *stack, StgWord offset) {
+  StgClosure *c = (StgClosure *)stack->sp + offset;
   ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
   return stack_frame_sizeW(c);
 }
 
-StgStack *getUnderflowFrameStack(StgStack *stack, StgWord index) {
-  StgClosure *frame = (StgClosure *)stack->sp + index;
+StgStack *getUnderflowFrameStack(StgStack *stack, StgWord offset) {
+  StgClosure *frame = (StgClosure *)stack->sp + offset;
   ASSERT(LOOKS_LIKE_CLOSURE_PTR(frame));
   const StgRetInfoTable *info = get_ret_itbl((StgClosure *)frame);
 
@@ -140,11 +141,11 @@ StgStack *getUnderflowFrameNextChunk(StgUnderflowFrame *frame) {
   return frame->next_chunk;
 }
 
-StgWord getRetFunType(StgRetFun *ret_fun) {
+StgBool isArgGenBigRetFunType(StgRetFun *ret_fun) {
   ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun));
 
   const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
-  return fun_info->f.fun_type;
+  return fun_info->f.fun_type == ARG_GEN_BIG;
 }
 
 StgClosure *getStackClosure(StgClosure **c) { return *c; }


=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -136,13 +136,13 @@ getUnderflowFrameNextChunkzh(P_ stack, W_ offsetWords) {
 }
 
 // (StgWord) getRetFunTypezh(StgStack* stack, StgWord offsetWords)
-getRetFunTypezh(P_ stack, W_ offsetWords) {
+isArgGenBigRetFunTypezh(P_ stack, W_ offsetWords) {
   P_ c;
   c = StgStack_sp(stack) + WDS(offsetWords);
   ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
 
-  W_ type;
-  (type) = ccall getRetFunType(c);
+  CBool type;
+  (type) = ccall isArgGenBigRetFunType(c);
   return (type);
 }
 


=====================================
libraries/ghc-heap/tests/stack_misc_closures.hs
=====================================
@@ -230,7 +230,6 @@ main = do
     \case
       RetFun {..} -> do
         assertEqual (tipe info_tbl) RET_FUN
-        assertEqual retFunType ARG_N
         assertEqual retFunSize 1
         assertFun01Closure 1 retFunFun
         assertEqual (length retFunPayload) 1
@@ -242,7 +241,6 @@ main = do
     \case
       RetFun {..} -> do
         assertEqual (tipe info_tbl) RET_FUN
-        assertEqual retFunType ARG_GEN
         assertEqual retFunSize 9
         retFunFun' <- getBoxedClosureData retFunFun
         case retFunFun' of
@@ -264,7 +262,6 @@ main = do
     \case
       RetFun {..} -> do
         assertEqual (tipe info_tbl) RET_FUN
-        assertEqual retFunType ARG_GEN_BIG
         assertEqual retFunSize 59
         retFunFun' <- getBoxedClosureData retFunFun
         case retFunFun' of



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e191d70c0d5cf49a06f96e755d0915c8eefe0711...9b939c90dd1bbbab9b678fdc858b3aca063e9e4c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e191d70c0d5cf49a06f96e755d0915c8eefe0711...9b939c90dd1bbbab9b678fdc858b3aca063e9e4c
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/20230804/7e076d1b/attachment-0001.html>


More information about the ghc-commits mailing list