[Git][ghc/ghc][wip/decode_cloned_stack] Remove RetFunType from RetFun stack frame representation
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Thu Aug 3 18:55:18 UTC 2023
Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC
Commits:
dafd88de by Sven Tennie at 2023-08-03T20:53:35+02:00
Remove RetFunType from RetFun stack frame representation
It's a technical detail. The single usage is replaced by a predicate.
- - - - -
4 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
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,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) {
+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);
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dafd88de7b6356656623176a46617c954a754443
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dafd88de7b6356656623176a46617c954a754443
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/20230803/17b1c65d/attachment-0001.html>
More information about the ghc-commits
mailing list