[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