diff --git a/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs b/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs index 568c2bf2b131189c2232f3cbd8641d43b2ff69c7..2d2e871da9707ece1b28fca6ec63ff996cf270da 100644 --- a/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs +++ b/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@. -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 diff --git a/libraries/ghc-heap/GHC/Exts/Stack/Decode.hs b/libraries/ghc-heap/GHC/Exts/Stack/Decode.hs index 9034db6de7d4e73db90f4ae851c2f566ecae93e1..c1af6e6fba5704a6b306876c41e09e79f275bcb4 100644 --- a/libraries/ghc-heap/GHC/Exts/Stack/Decode.hs +++ b/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' diff --git a/libraries/ghc-heap/cbits/Stack.c b/libraries/ghc-heap/cbits/Stack.c index 3bbcbf1bd3627d5b09df5aaa2159b2e36dcfb264..25d6d2c2f478be872f7184a5e4f306c8d4e26835 100644 --- a/libraries/ghc-heap/cbits/Stack.c +++ b/libraries/ghc-heap/cbits/Stack.c @@ -5,6 +5,7 @@ #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) { @@ -140,11 +141,11 @@ StgStack *getUnderflowFrameNextChunk(StgUnderflowFrame *frame) { return frame->next_chunk; } -StgWord getRetFunType(StgRetFun *ret_fun) { +StgWord 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; } diff --git a/libraries/ghc-heap/cbits/Stack.cmm b/libraries/ghc-heap/cbits/Stack.cmm index ed9712fe7b25c06610d15cc731c403f521462261..da5b882f259c9bf35a0452f2feceaccf30e5b150 100644 --- a/libraries/ghc-heap/cbits/Stack.cmm +++ b/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); + (type) = ccall isArgGenBigRetFunType(c); return (type); } diff --git a/libraries/ghc-heap/tests/stack_misc_closures.hs b/libraries/ghc-heap/tests/stack_misc_closures.hs index 821b85f6745b140318d731c741138bf9b6d759bb..0632af1a4fce7813fd39037cfb16ee7062feaec6 100644 --- a/libraries/ghc-heap/tests/stack_misc_closures.hs +++ b/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