[Git][ghc/ghc][wip/decode_cloned_stack] 2 commits: Simplify RET_FUN/ARG_GEN test
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sat Jan 14 16:18:22 UTC 2023
Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC
Commits:
909aa4b6 by Sven Tennie at 2023-01-14T16:07:29+00:00
Simplify RET_FUN/ARG_GEN test
- - - - -
632e18a9 by Sven Tennie at 2023-01-14T16:17:59+00:00
Fix hadrian/ghci
- - - - -
3 changed files:
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/tests/stack_misc_closures.hs
- libraries/ghc-heap/tests/stack_misc_closures_c.c
Changes:
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -573,7 +573,7 @@ allClosures (FunClosure {..}) = ptrArgs
allClosures (BlockingQueueClosure {..}) = [link, blackHole, owner, queue]
allClosures (WeakClosure {..}) = [cfinalizers, key, value, finalizer] ++ Data.Foldable.toList weakLink
allClosures (OtherClosure {..}) = hvalues
-#if MIN_VERSION_base(4,17,0)
+#if MIN_TOOL_VERSION_ghc(9,5,0)
allClosures (SimpleStack {..}) = stackClosures
allClosures (UpdateFrame {..}) = [updatee]
allClosures (CatchFrame {..}) = [handler]
=====================================
libraries/ghc-heap/tests/stack_misc_closures.hs
=====================================
@@ -202,7 +202,7 @@ main = do
\case
RetFun {..} -> do
assertEqual retFunType ARG_GEN
- assertEqual retFunSize 8
+ assertEqual retFunSize 9
fc <- getBoxedClosureData retFunFun
case fc of
FunClosure {..} -> do
@@ -211,22 +211,15 @@ main = do
assertEqual (null ptrArgs) True
e -> error $ "Wrong closure type: " ++ show e
pCs <- mapM getBoxedClosureData retFunPayload
- assertEqual (length pCs) 8
- let w0 = getWordFromUnknownTypeWordSizedPrimitive (head pCs)
- w1 = getWordFromConstr01 (pCs !! 1)
- w2 = getWordFromConstr01 (pCs !! 2)
- w3 = getWordFromUnknownTypeWordSizedPrimitive (pCs !! 3)
- w4 = getWordFromUnknownTypeWordSizedPrimitive (pCs !! 4)
- w5 = getWordFromUnknownTypeWordSizedPrimitive (pCs !! 5)
- w6 = getWordFromUnknownTypeWordSizedPrimitive (pCs !! 6)
- w7 = getWordFromConstr01 (pCs !! 7)
- assertEqual [w0, w1, w2, w3, w4, w5, w6, w7] [1, 2, 3, 4, 5, 6, 7, 8]
+ assertEqual (length pCs) 9
+ let wds = map getWordFromConstr01 pCs
+ assertEqual wds [1 .. 9]
e -> error $ "Wrong closure type: " ++ show e
test any_ret_fun_arg_gen_big_framezh# $
\case
RetFun {..} -> do
assertEqual retFunType ARG_GEN_BIG
- assertEqual retFunSize 70
+ assertEqual retFunSize 59
fc <- getBoxedClosureData retFunFun
case fc of
FunClosure {..} -> do
@@ -235,10 +228,9 @@ main = do
assertEqual (null ptrArgs) True
e -> error $ "Wrong closure type: " ++ show e
pCs <- mapM getBoxedClosureData retFunPayload
- traceM $ "pCs " ++ show pCs
- assertEqual (length pCs) 70
+ assertEqual (length pCs) 59
let wds = map getWordFromConstr01 pCs
- assertEqual wds [1 .. 70]
+ assertEqual wds [1 .. 59]
type SetupFunction = State# RealWorld -> (# State# RealWorld, StackSnapshot# #)
@@ -322,10 +314,13 @@ assertUnknownTypeWordSizedPrimitive w c = case c of
unboxSingletonTuple :: (# StackSnapshot# #) -> StackSnapshot#
unboxSingletonTuple (# s# #) = s#
-{-# NOINLINE bigFun #-}
-bigFun ::
- Word ->
- Word ->
+-- | A function with 59 arguments
+--
+-- A small bitmap has @64 - 6 = 58@ entries on 64bit machines. On 32bit machines
+-- it's less (for obvious reasons.) I.e. this function's bitmap a large one;
+-- function type is @ARG_GEN_BIG at .
+{-# NOINLINE argGenBigFun #-}
+argGenBigFun ::
Word ->
Word ->
Word ->
@@ -385,6 +380,17 @@ bigFun ::
Word ->
Word ->
Word ->
+ Word
+argGenBigFun a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 a51 a52 a53 a54 a55 a56 a57 a58 a59 =
+ a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 + a14 + a15 + a16 + a17 + a18 + a19 + a20 + a21 + a22 + a23 + a24 + a25 + a26 + a27 + a28 + a29 + a30 + a31 + a32 + a33 + a34 + a35 + a36 + a37 + a38 + a39 + a40 + a41 + a42 + a43 + a44 + a45 + a46 + a47 + a48 + a49 + a50 + a51 + a52 + a53 + a54 + a55 + a56 + a57 + a58 + a59
+
+-- | A function with more arguments than the pre-generated (@ARG_PPPPPPPP -> 8@) ones
+-- have
+--
+-- This results in a @ARG_GEN@ function (the number of arguments still fits in a
+-- small bitmap).
+{-# NOINLINE argGenFun #-}
+argGenFun ::
Word ->
Word ->
Word ->
@@ -395,5 +401,4 @@ bigFun ::
Word ->
Word ->
Word
-bigFun a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 a51 a52 a53 a54 a55 a56 a57 a58 a59 a60 a61 a62 a63 a64 a65 a66 a67 a68 a69 a70 =
- a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 + a14 + a15 + a16 + a17 + a18 + a19 + a20 + a21 + a22 + a23 + a24 + a25 + a26 + a27 + a28 + a29 + a30 + a31 + a32 + a33 + a34 + a35 + a36 + a37 + a38 + a39 + a40 + a41 + a42 + a43 + a44 + a45 + a46 + a47 + a48 + a49 + a50 + a51 + a52 + a53 + a54 + a55 + a56 + a57 + a58 + a59 + a60 + a61 + a62 + a63 + a64 + a65 + a66 + a67 + a68 + a69 + a70
+argGenFun a1 a2 a3 a4 a5 a6 a7 a8 a9 = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9
=====================================
libraries/ghc-heap/tests/stack_misc_closures_c.c
=====================================
@@ -175,40 +175,28 @@ void create_any_ret_fun_arg_n_prim_frame(Capability *cap, StgStack *stack,
f->payload[0] = (StgClosure *)w;
}
-RTS_CLOSURE(base_GHCziIOziEncodingziLatin1_zdwasciizuencode_closure);
+RTS_CLOSURE(Main_argGenFun_closure);
void create_any_ret_fun_arg_gen_frame(Capability *cap, StgStack *stack,
StgWord w) {
StgRetFun *c = (StgRetFun *)stack->sp;
c->info = &test_ret_fun_info;
- // The selection of this closure was a bit arbitrary: There aren't many
- // ARG_GEN closures around and I found this one first. N.B.: The payload
- // values (and their types) are non-sense. But, this should be okay as we're
- // only testing de-serialization.
- c->fun = &base_GHCziIOziEncodingziLatin1_zdwasciizuencode_closure;
+ c->fun = &Main_argGenFun_closure;
const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(c->fun));
+ debugBelch("type %ul", fun_info->i.type);
+ debugBelch("fun type %ul", fun_info->f.fun_type);
c->size = BITMAP_SIZE(fun_info->f.b.bitmap);
- c->payload[0] = (StgClosure *)w;
- c->payload[1] = rts_mkWord(cap, ++w);
- c->payload[2] = rts_mkWord(cap, ++w);
- c->payload[3] = (StgClosure *)++w;
- c->payload[4] = (StgClosure *)++w;
- c->payload[5] = (StgClosure *)++w;
- c->payload[6] = (StgClosure *)++w;
- c->payload[7] = rts_mkWord(cap, ++w);
-
- // TODO: Is this really needed? ghc-heap does not need it. Does the GC need
- // it?
- for (int i = 0; i < 8; i++) {
- c->fun->payload[i] = c->payload[i];
+ debugBelch("size %lu", c->size);
+ for (int i = 0; i < c->size; i++) {
+ c->payload[i] = rts_mkWord(cap, w++);
}
}
-RTS_CLOSURE(Main_bigFun_closure);
+RTS_CLOSURE(Main_argGenBigFun_closure);
void create_any_ret_fun_arg_gen_big_frame(Capability *cap, StgStack *stack,
StgWord w) {
StgRetFun *c = (StgRetFun *)stack->sp;
c->info = &test_ret_fun_info;
- c->fun = &Main_bigFun_closure;
+ c->fun = &Main_argGenBigFun_closure;
const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(c->fun));
c->size = GET_FUN_LARGE_BITMAP(fun_info)->size;
for (int i = 0; i < c->size; i++) {
@@ -315,13 +303,13 @@ StgStack *any_ret_fun_arg_n_prim_frame(Capability *cap) {
StgStack *any_ret_fun_arg_gen_frame(Capability *cap) {
return setup(
- cap, sizeofW(StgRetFun) + 5 * sizeofW(StgWord) + 3 * sizeofW(StgClosure),
+ cap, sizeofW(StgRetFun) + 9 * sizeofW(StgClosure),
&create_any_ret_fun_arg_gen_frame);
}
StgStack *any_ret_fun_arg_gen_big_frame(Capability *cap) {
return setup(
- cap, sizeofW(StgRetFun) + 70 * sizeofW(StgWord),
+ cap, sizeofW(StgRetFun) + 59 * sizeofW(StgWord),
&create_any_ret_fun_arg_gen_big_frame);
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3075f00d12dc406ae475030c2360d1fe330ed76...632e18a971b8cab4fc9ab63d75851c54b6204e47
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3075f00d12dc406ae475030c2360d1fe330ed76...632e18a971b8cab4fc9ab63d75851c54b6204e47
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/20230114/51769a8e/attachment-0001.html>
More information about the ghc-commits
mailing list