[Git][ghc/ghc][wip/decode_cloned_stack] Test RET_BCO
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sat Jan 21 09:49:38 UTC 2023
Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC
Commits:
2255ab49 by Sven Tennie at 2023-01-21T09:49:00+00:00
Test RET_BCO
- - - - -
10 changed files:
- libraries/ghc-heap/GHC/Exts/DecodeStack.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/StackConstants.hsc
- libraries/ghc-heap/cbits/Stack.c
- libraries/ghc-heap/cbits/Stack.cmm
- libraries/ghc-heap/tests/TestUtils.hs
- libraries/ghc-heap/tests/stack_lib.c
- libraries/ghc-heap/tests/stack_misc_closures.hs
- libraries/ghc-heap/tests/stack_misc_closures_c.c
- libraries/ghc-heap/tests/stack_misc_closures_prim.cmm
Changes:
=====================================
libraries/ghc-heap/GHC/Exts/DecodeStack.hs
=====================================
@@ -108,6 +108,7 @@ toBitmapPayload e | isPrimitive e = pure $ DecodedClosureBox. CL.UnknownTypeWord
toWord (StackFrameIter (# s#, i# #)) = W# (derefStackWord# s# i#)
toBitmapPayload e = toClosure unpackClosureFromStackFrame# (closureFrame e)
+-- TODO: Offset should be in Words. That's the smallest reasonable unit.
-- TODO: Negative offsets won't work! Consider using Word
getClosure :: StackFrameIter -> Int -> IO Box
getClosure sfi relativeOffset = toClosure (unpackClosureReferencedByFrame# (intToWord# relativeOffset)) sfi
@@ -151,24 +152,16 @@ getHalfWord (StackFrameIter (# s#, i# #)) relativeOffset = W# (getHalfWord# s# i
getWord :: StackFrameIter -> Int -> Word
getWord (StackFrameIter (# s#, i# #)) relativeOffset = W# (getWord# s# i# (intToWord# relativeOffset))
+bytesToWords :: Int -> Int
+bytesToWords b = b `div` bytesInWord
+
unpackStackFrameIter :: StackFrameIter -> IO CL.Closure
unpackStackFrameIter sfi@(StackFrameIter (# s#, i# #)) = trace ("decoding ... " ++ show @ClosureType ((toEnum . fromIntegral) (W# (getInfoTableType# s# i#))) ++ "\n") $
case (toEnum . fromIntegral) (W# (getInfoTableType# s# i#)) of
RET_BCO -> do
- instrs' <- getClosure sfi offsetStgRetBCOFrameInstrs
- literals'<- getClosure sfi offsetStgRetBCOFrameLiterals
- ptrs' <- getClosure sfi offsetStgRetBCOFramePtrs
- let arity' = getHalfWord sfi offsetStgRetBCOFrameArity
- size' = getHalfWord sfi offsetStgRetBCOFrameSize
- payload' <- decodeLargeBitmap getBCOLargeBitmap# sfi 2##
- pure $ CL.RetBCO {
- bcoInstrs = instrs',
- bcoLiterals = literals',
- bcoPtrs = ptrs',
- bcoArity = arity',
- bcoSize = size',
- bcoPayload = payload'
- }
+ bco' <- getClosure sfi offsetStgClosurePayload
+ args' <- decodeLargeBitmap getBCOLargeBitmap# sfi 2##
+ pure $ CL.RetBCO bco' args'
RET_SMALL -> do
payloads <- decodeSmallBitmap getSmallBitmap# sfi 1##
let special# = getRetSmallSpecialType# s# i#
@@ -180,6 +173,7 @@ unpackStackFrameIter sfi@(StackFrameIter (# s#, i# #)) = trace ("decoding ... "
size' = getWord sfi offsetStgRetFunFrameSize
fun' <- getClosure sfi offsetStgRetFunFrameFun
payload' <-
+ -- TODO: ARG_BCO is likely very special...
if t == CL.ARG_GEN_BIG then
decodeLargeBitmap getRetFunLargeBitmap# sfi 3##
else
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -379,12 +379,9 @@ data GenClosure b
| RetBCO
-- TODO: Add pre-defined BCO closures (like knownUpdateFrameType)
- { bcoInstrs :: !b
- , bcoLiterals :: !b
- , bcoPtrs :: !b
- , bcoArity :: !Word
- , bcoSize :: !Word
- , bcoPayload :: ![b]
+ {
+ bco :: !b, -- must be a BCOClosure
+ bcoArgs :: ![b]
}
#endif
------------------------------------------------------------
@@ -583,7 +580,7 @@ allClosures (AtomicallyFrame {..}) = [atomicallyFrameCode, result]
allClosures (RetSmall {..}) = payload
allClosures (RetBig {..}) = payload
allClosures (RetFun {..}) = retFunFun : retFunPayload
-allClosures (RetBCO {..}) = bcoInstrs : bcoLiterals : bcoPtrs : bcoPayload
+allClosures (RetBCO {..}) = bco : bcoArgs
#endif
allClosures _ = []
=====================================
libraries/ghc-heap/GHC/Exts/StackConstants.hsc
=====================================
@@ -49,18 +49,24 @@ offsetStgRetFunFrameFun = (#const OFFSET_StgRetFun_fun)
offsetStgRetFunFramePayload :: Int
offsetStgRetFunFramePayload = (#const OFFSET_StgRetFun_payload)
-offsetStgRetBCOFrameInstrs :: Int
-offsetStgRetBCOFrameInstrs = (#const OFFSET_StgBCO_instrs) + (#size StgHeader)
+offsetStgBCOFrameInstrs :: Int
+offsetStgBCOFrameInstrs = (#const OFFSET_StgBCO_instrs) + (#size StgHeader)
-offsetStgRetBCOFrameLiterals :: Int
-offsetStgRetBCOFrameLiterals = (#const OFFSET_StgBCO_literals) + (#size StgHeader)
+offsetStgBCOFrameLiterals :: Int
+offsetStgBCOFrameLiterals = (#const OFFSET_StgBCO_literals) + (#size StgHeader)
-offsetStgRetBCOFramePtrs :: Int
-offsetStgRetBCOFramePtrs = (#const OFFSET_StgBCO_ptrs) + (#size StgHeader)
+offsetStgBCOFramePtrs :: Int
+offsetStgBCOFramePtrs = (#const OFFSET_StgBCO_ptrs) + (#size StgHeader)
-offsetStgRetBCOFrameArity :: Int
-offsetStgRetBCOFrameArity = (#const OFFSET_StgBCO_arity) + (#size StgHeader)
+offsetStgBCOFrameArity :: Int
+offsetStgBCOFrameArity = (#const OFFSET_StgBCO_arity) + (#size StgHeader)
-offsetStgRetBCOFrameSize :: Int
-offsetStgRetBCOFrameSize = (#const OFFSET_StgBCO_size) + (#size StgHeader)
+offsetStgBCOFrameSize :: Int
+offsetStgBCOFrameSize = (#const OFFSET_StgBCO_size) + (#size StgHeader)
+
+offsetStgClosurePayload :: Int
+offsetStgClosurePayload = (#const OFFSET_StgClosure_payload) + (#size StgHeader)
+
+bytesInWord :: Int
+bytesInWord = (#const SIZEOF_UNSIGNED_LONG)
#endif
=====================================
libraries/ghc-heap/cbits/Stack.c
=====================================
@@ -110,14 +110,14 @@ StgWord getRetFunBitmapSize(StgRetFun *ret_fun) {
const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
switch (fun_info->f.fun_type) {
- case ARG_GEN:
- return BITMAP_SIZE(fun_info->f.b.bitmap);
- case ARG_GEN_BIG:
- return GET_FUN_LARGE_BITMAP(fun_info)->size;
- default:
- return BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
+ case ARG_GEN:
+ return BITMAP_SIZE(fun_info->f.b.bitmap);
+ case ARG_GEN_BIG:
+ return GET_FUN_LARGE_BITMAP(fun_info)->size;
+ default:
+ return BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
}
- }
+}
StgWord getBitmapWord(StgClosure *c) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
@@ -136,14 +136,14 @@ StgWord getRetFunBitmapWord(StgRetFun *ret_fun) {
const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
switch (fun_info->f.fun_type) {
- case ARG_GEN:
- return BITMAP_BITS(fun_info->f.b.bitmap);
- case ARG_GEN_BIG:
- // Cannot do more than warn and exit.
- errorBelch("Unexpected ARG_GEN_BIG StgRetFun closure %p", ret_fun);
- stg_exit(EXIT_INTERNAL_ERROR);
- default:
- return BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
+ case ARG_GEN:
+ return BITMAP_BITS(fun_info->f.b.bitmap);
+ case ARG_GEN_BIG:
+ // Cannot do more than warn and exit.
+ errorBelch("Unexpected ARG_GEN_BIG StgRetFun closure %p", ret_fun);
+ stg_exit(EXIT_INTERNAL_ERROR);
+ default:
+ return BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
}
}
@@ -161,19 +161,21 @@ StgWord getRetFunSize(StgRetFun *ret_fun) {
const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
switch (fun_info->f.fun_type) {
- case ARG_GEN:
- return BITMAP_SIZE(fun_info->f.b.bitmap);
- case ARG_GEN_BIG:
- return GET_FUN_LARGE_BITMAP(fun_info)->size;
- default:
- return BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
+ case ARG_GEN:
+ return BITMAP_SIZE(fun_info->f.b.bitmap);
+ case ARG_GEN_BIG:
+ return GET_FUN_LARGE_BITMAP(fun_info)->size;
+ default:
+ return BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
}
}
StgWord getBCOLargeBitmapSize(StgClosure *c) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
- return BCO_BITMAP_SIZE(c);
+ StgBCO *bco = (StgBCO *)*c->payload;
+
+ return BCO_BITMAP_SIZE(bco);
}
#define ROUNDUP_BITS_TO_WDS(n) \
@@ -219,13 +221,13 @@ StgArrBytes *getRetFunLargeBitmaps(Capability *cap, StgRetFun *ret_fun) {
return array;
}
-// TODO: Much duplication between: getBCOLargeBitmaps, getRetFunLargeBitmaps, getLargeBitmaps
+// TODO: Much duplication between: getBCOLargeBitmaps, getRetFunLargeBitmaps,
+// getLargeBitmaps
StgArrBytes *getBCOLargeBitmaps(Capability *cap, StgClosure *c) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
- const StgInfoTable *info = get_itbl(c);
- StgLargeBitmap *bitmap = BCO_BITMAP(info);
- // TODO: Use BCO_BITMAP_SIZEW?
+ StgBCO *bco = (StgBCO *)*c->payload;
+ StgLargeBitmap *bitmap = BCO_BITMAP(bco);
StgWord neededWords = ROUNDUP_BITS_TO_WDS(bitmap->size);
StgArrBytes *array =
(StgArrBytes *)allocate(cap, sizeofW(StgArrBytes) + neededWords);
=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -117,7 +117,6 @@ getRetFunSmallBitmapzh(P_ stack, W_ index) {
(bitmap) = ccall getRetFunBitmapWord(c);
(size) = ccall getRetFunBitmapSize(c);
- ccall debugBelch("getRetFunSmallBitmapzh - bitmap %ul , size %u\n", bitmap, size);
return (bitmap, size);
}
=====================================
libraries/ghc-heap/tests/TestUtils.hs
=====================================
@@ -100,8 +100,8 @@ stackFrameToClosureTypes = getClosureTypes
getClosureTypes (RetSmall {payload, ..}) = RET_SMALL : getBitmapClosureTypes payload
getClosureTypes (RetBig {payload}) = RET_BIG : getBitmapClosureTypes payload
getClosureTypes (RetFun {retFunFun, retFunPayload, ..}) = RET_FUN : getClosureTypes (unbox retFunFun) ++ getBitmapClosureTypes retFunPayload
- getClosureTypes (RetBCO {bcoInstrs, bcoLiterals, bcoPtrs, bcoPayload, ..}) =
- RET_BCO : getClosureTypes (unbox bcoInstrs) ++ getClosureTypes (unbox bcoLiterals) ++ getClosureTypes (unbox bcoPtrs) ++ getBitmapClosureTypes bcoPayload
+ getClosureTypes (RetBCO {bco, bcoArgs, ..}) =
+ RET_BCO : getClosureTypes (unbox bco) ++ getBitmapClosureTypes bcoArgs
-- Other closures
getClosureTypes (ConstrClosure {info, ..}) = [tipe info]
getClosureTypes (FunClosure {info, ..}) = [tipe info]
=====================================
libraries/ghc-heap/tests/stack_lib.c
=====================================
@@ -155,6 +155,7 @@ ClosureTypeList *foldStackToList(StgStack *stack) {
case RET_BCO: {
StgWord c = *sp;
StgBCO *bco = ((StgBCO *)sp[1]);
+ result = add(result, get_itbl((StgClosure*) bco)->type);
ClosureTypeList *bitmapList = foldLargeBitmapToList(
spBottom, sp + 2, BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco));
result = concat(result, bitmapList);
=====================================
libraries/ghc-heap/tests/stack_misc_closures.hs
=====================================
@@ -56,6 +56,8 @@ foreign import prim "any_ret_fun_arg_gen_framezh" any_ret_fun_arg_gen_framezh# :
foreign import prim "any_ret_fun_arg_gen_big_framezh" any_ret_fun_arg_gen_big_framezh# :: SetupFunction
+foreign import prim "any_bco_framezh" any_bco_frame# :: SetupFunction
+
foreign import ccall "maxSmallBitmapBits" maxSmallBitmapBits_c :: Word
foreign import ccall "belchStack" belchStack# :: StackSnapshot# -> IO ()
@@ -231,6 +233,28 @@ main = do
assertEqual (length pCs) 59
let wds = map getWordFromConstr01 pCs
assertEqual wds [1 .. 59]
+ -- TODO: Test ret_fun bco
+ test any_bco_frame# $
+ \case
+ RetBCO {..} -> do
+ pCs <- mapM getBoxedClosureData bcoArgs
+ assertEqual (length pCs) 1
+ let wds = map getWordFromConstr01 pCs
+ assertEqual wds [3]
+ bco <- getBoxedClosureData bco
+ case bco of
+ BCOClosure {..} -> do
+ assertEqual (tipe info) BCO
+ assertEqual arity 3
+ assertArrWordsClosure [1] =<< getBoxedClosureData instrs
+ assertArrWordsClosure [2] =<< getBoxedClosureData literals
+ assertMutArrClosure [3] =<< getBoxedClosureData bcoptrs
+ assertEqual [
+ 1, -- StgLargeBitmap size in words
+ 0 -- StgLargeBitmap first words
+ ] bitmap
+ e -> error $ "Wrong closure type: " ++ show e
+ e -> error $ "Wrong closure type: " ++ show e
type SetupFunction = State# RealWorld -> (# State# RealWorld, StackSnapshot# #)
@@ -282,6 +306,21 @@ assertConstrClosure w c = case c of
assertEqual (null ptrArgs) True
e -> error $ "Wrong closure type: " ++ show e
+assertArrWordsClosure :: HasCallStack => [Word] -> Closure -> IO ()
+assertArrWordsClosure wds c = case c of
+ ArrWordsClosure {..} -> do
+ assertEqual (tipe info) ARR_WORDS
+ assertEqual arrWords wds
+ e -> error $ "Wrong closure type: " ++ show e
+
+assertMutArrClosure :: HasCallStack => [Word] -> Closure -> IO ()
+assertMutArrClosure wds c = case c of
+ MutArrClosure {..} -> do
+ assertEqual (tipe info) MUT_ARR_PTRS_FROZEN_CLEAN
+ xs <-mapM getBoxedClosureData mccPayload
+ assertEqual wds $ map getWordFromConstr01 xs
+ e -> error $ "Wrong closure type: " ++ show e
+
assertFun01Closure :: HasCallStack => Word -> Closure -> IO ()
assertFun01Closure w c = case c of
FunClosure {..} -> do
@@ -382,14 +421,14 @@ argGenBigFun ::
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
+ 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 #-}
+{-# NOINLINE argGenFun #-}
argGenFun ::
Word ->
Word ->
=====================================
libraries/ghc-heap/tests/stack_misc_closures_c.c
=====================================
@@ -182,10 +182,7 @@ void create_any_ret_fun_arg_gen_frame(Capability *cap, StgStack *stack,
c->info = &test_ret_fun_info;
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);
- debugBelch("size %lu", c->size);
for (int i = 0; i < c->size; i++) {
c->payload[i] = rts_mkWord(cap, w++);
}
@@ -204,6 +201,47 @@ void create_any_ret_fun_arg_gen_big_frame(Capability *cap, StgStack *stack,
}
}
+RTS_RET(test_ret_bco);
+void create_any_bco_frame(Capability *cap, StgStack *stack, StgWord w) {
+ StgClosure *c = (StgClosure *)stack->sp;
+ SET_HDR(c, &test_ret_bco_info, CCS_SYSTEM);
+ StgWord bcoSizeWords = sizeofW(StgBCO) + sizeofW(StgLargeBitmap) + sizeofW(StgWord);
+ StgBCO *bco = allocate(cap, bcoSizeWords);
+ SET_HDR(bco, &stg_BCO_info, CCS_MAIN);
+ c->payload[0] = (StgClosure *)bco;
+
+ bco->size = bcoSizeWords;
+ bco->arity = 3;
+
+ StgArrBytes *instrs =
+ (StgArrBytes *)allocate(cap, sizeofW(StgArrBytes) + sizeofW(StgWord));
+ SET_HDR(instrs, &stg_ARR_WORDS_info, CCCS);
+ instrs->bytes = WDS(1);
+ instrs->payload[0] = w++;
+ bco->instrs = instrs;
+
+ StgArrBytes *literals =
+ (StgArrBytes *)allocate(cap, sizeofW(StgArrBytes) + sizeofW(StgWord));
+ SET_HDR(literals, &stg_ARR_WORDS_info, CCCS);
+ bco->literals = literals;
+ literals->bytes = WDS(1);
+ literals->payload[0] = w++;
+ bco->literals = literals;
+
+ StgWord ptrsSize = 1 + mutArrPtrsCardTableSize(1);
+ StgMutArrPtrs *ptrs = allocate(cap, sizeofW(StgMutArrPtrs) + ptrsSize);
+ SET_HDR(ptrs, &stg_MUT_ARR_PTRS_FROZEN_CLEAN_info, ccs);
+ ptrs->ptrs = 1;
+ ptrs->size = ptrsSize;
+ ptrs->payload[0] = rts_mkWord(cap, w);
+ bco->ptrs = ptrs;
+
+ StgLargeBitmap *bitmap = (StgLargeBitmap *)bco->bitmap;
+ bitmap->size = 1;
+ bitmap->bitmap[0] = 0; // set bit 0 to 0 indicating a closure
+ c->payload[1] = (StgClosure *)rts_mkWord(cap, w);
+}
+
// Import from Sanity.c
extern void checkSTACK(StgStack *stack);
@@ -302,15 +340,18 @@ StgStack *any_ret_fun_arg_n_prim_frame(Capability *cap) {
}
StgStack *any_ret_fun_arg_gen_frame(Capability *cap) {
- return setup(
- cap, sizeofW(StgRetFun) + 9 * sizeofW(StgClosure),
- &create_any_ret_fun_arg_gen_frame);
+ return setup(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) + 59 * sizeofW(StgWord),
- &create_any_ret_fun_arg_gen_big_frame);
+ return setup(cap, sizeofW(StgRetFun) + 59 * sizeofW(StgWord),
+ &create_any_ret_fun_arg_gen_big_frame);
+}
+
+StgStack *any_bco_frame(Capability *cap) {
+ return setup(cap, sizeofW(StgClosure) + 2 * sizeofW(StgWord),
+ &create_any_bco_frame);
}
void belchStack(StgStack *stack) { printStack(stack); }
=====================================
libraries/ghc-heap/tests/stack_misc_closures_prim.cmm
=====================================
@@ -90,6 +90,12 @@ any_ret_fun_arg_gen_big_framezh() {
return (stack);
}
+any_bco_framezh() {
+ P_ stack;
+ (stack) = ccall any_bco_frame(MyCapability() "ptr");
+ return (stack);
+}
+
INFO_TABLE_RET ( test_small_ret_full_p, RET_SMALL, W_ info_ptr,
#if SIZEOF_VOID_P == 4
P_ ptr1, P_ ptr2, P_ ptr3, P_ ptr4, P_ ptr5, P_ ptr6, P_ ptr7, P_ ptr8, P_ ptr9, P_ ptr10,
@@ -211,3 +217,9 @@ INFO_TABLE_FUN ( test_arg_n_fun_0_1, 0 , 0, FUN_0_1, "FUN_0_1", "FUN_0_1", 1, A
{
return ();
}
+
+INFO_TABLE_RET( test_ret_bco, RET_BCO)
+ return (/* no return values */)
+{
+ return ();
+}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2255ab49a573d61c9086bd3775d878ef245dec30
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2255ab49a573d61c9086bd3775d878ef245dec30
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/20230121/4eb5e433/attachment-0001.html>
More information about the ghc-commits
mailing list