diff options
author | Sven Tennie <sven.tennie@gmail.com> | 2023-02-04 14:45:08 +0000 |
---|---|---|
committer | Sven Tennie <sven.tennie@gmail.com> | 2023-02-04 14:45:08 +0000 |
commit | 0ada16c38d99c7416ac027189f600e26f126d5d5 (patch) | |
tree | c8be26078c0128b83a3d120d5152f29a99b57a5b | |
parent | 8dde2bc20301110562e22146d20ccd65a7d4bf45 (diff) | |
download | haskell-0ada16c38d99c7416ac027189f600e26f126d5d5.tar.gz |
Test underflow framewip/decode_cloned_stack_save
-rw-r--r-- | libraries/ghc-heap/GHC/Exts/Heap.hs | 2 | ||||
-rw-r--r-- | libraries/ghc-heap/GHC/Exts/Heap/Closures.hs | 2 | ||||
-rw-r--r-- | libraries/ghc-heap/tests/stack_misc_closures.hs | 26 | ||||
-rw-r--r-- | libraries/ghc-heap/tests/stack_misc_closures_c.c | 13 | ||||
-rw-r--r-- | libraries/ghc-heap/tests/stack_misc_closures_prim.cmm | 6 |
5 files changed, 48 insertions, 1 deletions
diff --git a/libraries/ghc-heap/GHC/Exts/Heap.hs b/libraries/ghc-heap/GHC/Exts/Heap.hs index 0b451cc6fa..4b8a3f45c3 100644 --- a/libraries/ghc-heap/GHC/Exts/Heap.hs +++ b/libraries/ghc-heap/GHC/Exts/Heap.hs @@ -208,5 +208,7 @@ closureSize (StackFrameBox sfi) = unpackStackFrameIter sfi <&> RetFun {..} -> sizeStgRetFunFrame + length retFunPayload -- The one additional word is a pointer to the StgBCO in the closure's payload RetBCO {..} -> sizeStgClosure + 1 + length bcoArgs + -- The one additional word is a pointer to the next stack chunk + UnderflowFrame {} -> sizeStgClosure + 1 _ -> error "Unexpected closure type" #endif diff --git a/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs b/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs index d7032f50d5..8576800f7c 100644 --- a/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs +++ b/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs @@ -404,7 +404,7 @@ data GenClosure b -- TODO: nextChunk could be a CL.Closure, too! (StackClosure) | UnderflowFrame { info :: !StgInfoTable - , nextChunk:: !b + , nextChunk :: !b } | StopFrame diff --git a/libraries/ghc-heap/tests/stack_misc_closures.hs b/libraries/ghc-heap/tests/stack_misc_closures.hs index 1f4abda458..e6dbcd3a4d 100644 --- a/libraries/ghc-heap/tests/stack_misc_closures.hs +++ b/libraries/ghc-heap/tests/stack_misc_closures.hs @@ -58,6 +58,8 @@ foreign import prim "any_ret_fun_arg_gen_big_framezh" any_ret_fun_arg_gen_big_fr foreign import prim "any_bco_framezh" any_bco_frame# :: SetupFunction +foreign import prim "any_underflow_framezh" any_underflow_frame# :: SetupFunction + foreign import ccall "maxSmallBitmapBits" maxSmallBitmapBits_c :: Word foreign import ccall "belchStack" belchStack# :: StackSnapshot# -> IO () @@ -311,6 +313,30 @@ main = do traceM $ "Test 31" testSize any_bco_frame# 3 traceM $ "Test 32" + test any_underflow_frame# $ + \case + UnderflowFrame {..} -> do + assertEqual (tipe info) UNDERFLOW_FRAME + nextStack <- getBoxedClosureData nextChunk + case nextStack of + StackClosure {..} -> do + assertEqual (tipe info) STACK + assertEqual stack_size 27 + assertEqual stack_dirty 0 + assertEqual stack_marking 0 + nextStackClosures <- mapM getBoxedClosureData stack + assertEqual (length nextStackClosures) 2 + case head nextStackClosures of + RetSmall {..} -> + assertEqual (tipe info) RET_SMALL + e -> error $ "Wrong closure type: " ++ show e + case last nextStackClosures of + StopFrame {..} -> + assertEqual (tipe info) STOP_FRAME + e -> error $ "Wrong closure type: " ++ show e + e -> error $ "Wrong closure type: " ++ show e + e -> error $ "Wrong closure type: " ++ show e + testSize any_underflow_frame# 2 type SetupFunction = State# RealWorld -> (# State# RealWorld, StackSnapshot# #) diff --git a/libraries/ghc-heap/tests/stack_misc_closures_c.c b/libraries/ghc-heap/tests/stack_misc_closures_c.c index 582d636881..55edf30568 100644 --- a/libraries/ghc-heap/tests/stack_misc_closures_c.c +++ b/libraries/ghc-heap/tests/stack_misc_closures_c.c @@ -242,6 +242,14 @@ void create_any_bco_frame(Capability *cap, StgStack *stack, StgWord w) { c->payload[1] = (StgClosure *)rts_mkWord(cap, w); } +StgStack *any_ret_small_prim_frame(Capability *cap); + +void create_any_underflow_frame(Capability *cap, StgStack *stack, StgWord w) { + StgUnderflowFrame *underflowF = (StgUnderflowFrame *)stack->sp; + underflowF->info = &stg_stack_underflow_frame_info; + underflowF->next_chunk = any_ret_small_prim_frame(cap); +} + // Import from Sanity.c extern void checkSTACK(StgStack *stack); @@ -355,4 +363,9 @@ StgStack *any_bco_frame(Capability *cap) { &create_any_bco_frame); } +StgStack *any_underflow_frame(Capability *cap) { + return setup(cap, sizeofW(StgUnderflowFrame), + &create_any_underflow_frame); +} + void belchStack(StgStack *stack) { printStack(stack); } diff --git a/libraries/ghc-heap/tests/stack_misc_closures_prim.cmm b/libraries/ghc-heap/tests/stack_misc_closures_prim.cmm index 47f1bd544d..839c202da1 100644 --- a/libraries/ghc-heap/tests/stack_misc_closures_prim.cmm +++ b/libraries/ghc-heap/tests/stack_misc_closures_prim.cmm @@ -96,6 +96,12 @@ any_bco_framezh() { return (stack); } +any_underflow_framezh() { + P_ stack; + (stack) = ccall any_underflow_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, |