[Git][ghc/ghc][wip/decode_cloned_stack] Test max limit of small bitmap
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Tue Dec 27 11:52:25 UTC 2022
Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC
Commits:
57f856f9 by Sven Tennie at 2022-12-27T11:52:02+00:00
Test max limit of small bitmap
- - - - -
3 changed files:
- 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/tests/stack_misc_closures.hs
=====================================
@@ -36,10 +36,14 @@ foreign import prim "any_ret_small_prim_framezh" any_ret_small_prim_frame# :: Wo
foreign import prim "any_ret_small_closure_framezh" any_ret_small_closure_frame# :: Word# -> (# StackSnapshot# #)
+foreign import prim "any_ret_small_closures_framezh" any_ret_small_closures_frame# :: Word# -> (# StackSnapshot# #)
+
foreign import prim "any_ret_big_prims_framezh" any_ret_big_prims_frame# :: Word# -> (# StackSnapshot# #)
foreign import prim "any_ret_big_closures_framezh" any_ret_big_closures_frame# :: Word# -> (# StackSnapshot# #)
+foreign import ccall "maxSmallBitmapBits" maxSmallBitmapBits_c :: Word
+
main :: HasCallStack => IO ()
main = do
test any_update_frame# 42## $
@@ -90,6 +94,17 @@ main = do
assertEqual (length pCs) 1
assertConstrClosure 51 (head pCs)
e -> error $ "Wrong closure type: " ++ show e
+ test any_ret_small_closures_frame# 1## $
+ \case
+ RetSmall {..} -> do
+ assertEqual knownRetSmallType None
+ pCs <- mapM getBoxedClosureData payload
+ assertEqual (length pCs) (fromIntegral maxSmallBitmapBits_c)
+ assertConstrClosure 1 (head pCs)
+ assertConstrClosure 58 (last pCs)
+ let wds = map getWordFromConstr01 pCs
+ assertEqual wds [1..58]
+ e -> error $ "Wrong closure type: " ++ show e
test any_ret_big_prims_frame# 52## $
\case
RetBig {..} -> do
@@ -122,6 +137,11 @@ assertConstrClosure w c = case c of
assertEqual (null ptrArgs) True
e -> error $ "Wrong closure type: " ++ show e
+getWordFromConstr01 :: HasCallStack => Closure -> Word
+getWordFromConstr01 c = case c of
+ ConstrClosure {..} -> head dataArgs
+ e -> error $ "Wrong closure type: " ++ show e
+
assertUnknownTypeWordSizedPrimitive :: HasCallStack => Word -> Closure -> IO ()
assertUnknownTypeWordSizedPrimitive w c = case c of
UnknownTypeWordSizedPrimitive {..} -> do
=====================================
libraries/ghc-heap/tests/stack_misc_closures_c.c
=====================================
@@ -18,18 +18,17 @@ extern void printStack(StgStack *stack);
#define SIZEOF_W SIZEOF_VOID_P
#define WDS(n) ((n)*SIZEOF_W)
-// TODO: Try to remove UNTAG_CLOSURE. This should happen in the decoding logic.
void create_any_update_frame(Capability *cap, StgStack *stack, StgWord w) {
StgUpdateFrame *updF = (StgUpdateFrame *)stack->sp;
SET_HDR(updF, &stg_upd_frame_info, CCS_SYSTEM);
- StgClosure *payload = UNTAG_CLOSURE(rts_mkWord(cap, w));
+ StgClosure *payload = rts_mkWord(cap, w);
updF->updatee = payload;
}
void create_any_catch_frame(Capability *cap, StgStack *stack, StgWord w) {
StgCatchFrame *catchF = (StgCatchFrame *)stack->sp;
SET_HDR(catchF, &stg_catch_frame_info, CCS_SYSTEM);
- StgClosure *payload = UNTAG_CLOSURE(rts_mkWord(cap, w));
+ StgClosure *payload = rts_mkWord(cap, w);
catchF->exceptions_blocked = 1;
catchF->handler = payload;
}
@@ -37,8 +36,8 @@ void create_any_catch_frame(Capability *cap, StgStack *stack, StgWord w) {
void create_any_catch_stm_frame(Capability *cap, StgStack *stack, StgWord w) {
StgCatchSTMFrame *catchF = (StgCatchSTMFrame *)stack->sp;
SET_HDR(catchF, &stg_catch_stm_frame_info, CCS_SYSTEM);
- StgClosure *payload1 = UNTAG_CLOSURE(rts_mkWord(cap, w));
- StgClosure *payload2 = UNTAG_CLOSURE(rts_mkWord(cap, w + 1));
+ StgClosure *payload1 = rts_mkWord(cap, w);
+ StgClosure *payload2 = rts_mkWord(cap, w + 1);
catchF->code = payload1;
catchF->handler = payload2;
}
@@ -47,8 +46,8 @@ void create_any_catch_stm_frame(Capability *cap, StgStack *stack, StgWord w) {
void create_any_catch_retry_frame(Capability *cap, StgStack *stack, StgWord w) {
StgCatchRetryFrame *catchRF = (StgCatchRetryFrame *)stack->sp;
SET_HDR(catchRF, &stg_catch_retry_frame_info, CCS_SYSTEM);
- StgClosure *payload1 = UNTAG_CLOSURE(rts_mkWord(cap, w));
- StgClosure *payload2 = UNTAG_CLOSURE(rts_mkWord(cap, w + 1));
+ StgClosure *payload1 = rts_mkWord(cap, w);
+ StgClosure *payload2 = rts_mkWord(cap, w + 1);
catchRF->running_alt_code = 1;
catchRF->first_code = payload1;
catchRF->alt_code = payload2;
@@ -57,8 +56,8 @@ void create_any_catch_retry_frame(Capability *cap, StgStack *stack, StgWord w) {
void create_any_atomically_frame(Capability *cap, StgStack *stack, StgWord w) {
StgAtomicallyFrame *aF = (StgAtomicallyFrame *)stack->sp;
SET_HDR(aF, &stg_atomically_frame_info, CCS_SYSTEM);
- StgClosure *payload1 = UNTAG_CLOSURE(rts_mkWord(cap, w));
- StgClosure *payload2 = UNTAG_CLOSURE(rts_mkWord(cap, w + 1));
+ StgClosure *payload1 = rts_mkWord(cap, w);
+ StgClosure *payload2 = rts_mkWord(cap, w + 1);
aF->code = payload1;
aF->result = payload2;
}
@@ -76,10 +75,28 @@ void create_any_ret_small_closure_frame(Capability *cap, StgStack *stack,
StgWord w) {
StgClosure *c = (StgClosure *)stack->sp;
SET_HDR(c, &stg_ret_p_info, CCS_SYSTEM);
- StgClosure *payload = UNTAG_CLOSURE(rts_mkWord(cap, w));
+ StgClosure *payload = rts_mkWord(cap, w);
c->payload[0] = payload;
}
+#define MAX_SMALL_BITMAP_BITS (BITS_IN(W_) - BITMAP_BITS_SHIFT)
+
+StgWord maxSmallBitmapBits(){
+ return MAX_SMALL_BITMAP_BITS;
+}
+
+RTS_RET(test_small_ret_full_p);
+void create_any_ret_small_closures_frame(Capability *cap, StgStack *stack,
+ StgWord w) {
+ StgClosure *c = (StgClosure *)stack->sp;
+ SET_HDR(c, &test_small_ret_full_p_info, CCS_SYSTEM);
+ for(int i = 0; i < MAX_SMALL_BITMAP_BITS; i++) {
+ StgClosure *payload1 = rts_mkWord(cap, w);
+ w++;
+ c->payload[i] = payload1;
+ }
+}
+
void create_any_ret_big_prims_frame(Capability *cap, StgStack *stack,
StgWord w) {
StgClosure *c = (StgClosure *)stack->sp;
@@ -162,6 +179,11 @@ StgStack *any_ret_small_closure_frame(StgWord w) {
&create_any_ret_small_closure_frame);
}
+StgStack *any_ret_small_closures_frame(StgWord w) {
+ return setup(sizeofW(StgClosure) + MAX_SMALL_BITMAP_BITS * sizeofW(StgClosurePtr), w,
+ &create_any_ret_small_closures_frame);
+}
+
StgStack *any_ret_big_closures_frame(StgWord w) {
return NULL; // TODO: Implement
// return setup(sizeofW(StgClosure) + sizeofW(StgClosurePtr), w,
=====================================
libraries/ghc-heap/tests/stack_misc_closures_prim.cmm
=====================================
@@ -42,6 +42,12 @@ any_ret_small_closure_framezh(W_ w){
return (stack);
}
+any_ret_small_closures_framezh(W_ w){
+ P_ stack;
+ (stack) = ccall any_ret_small_closures_frame(w);
+ return (stack);
+}
+
any_ret_big_prims_framezh(W_ w){
P_ stack;
(stack) = ccall any_ret_big_prims_frame(w);
@@ -53,3 +59,24 @@ any_ret_big_closures_framezh(W_ w){
(stack) = ccall any_ret_big_closures_frame(w);
return (stack);
}
+
+#if SIZEOF_VOID_P == 4
+INFO_TABLE_RET ( test_small_ret_full_p, RET_SMALL, W_ info_ptr,
+P_ ptr1, P_ ptr2, P_ ptr3, P_ ptr4, P_ ptr5, P_ ptr6, P_ ptr7, P_ ptr8, P_ ptr9, P_ ptr10,
+P_ ptr11, P_ ptr12, P_ ptr13, P_ ptr14, P_ ptr15, P_ ptr16, P_ ptr17, P_ ptr18, P_ ptr19, P_ ptr20,
+P_ ptr21, P_ ptr22, P_ ptr23, P_ ptr24, P_ ptr25, P_ ptr26, P_ ptr27
+)
+#elif SIZEOF_VOID_P == 8
+INFO_TABLE_RET ( test_small_ret_full_p, RET_SMALL, W_ info_ptr,
+P_ ptr1, P_ ptr2, P_ ptr3, P_ ptr4, P_ ptr5, P_ ptr6, P_ ptr7, P_ ptr8, P_ ptr9, P_ ptr10,
+P_ ptr11, P_ ptr12, P_ ptr13, P_ ptr14, P_ ptr15, P_ ptr16, P_ ptr17, P_ ptr18, P_ ptr19, P_ ptr20,
+P_ ptr21, P_ ptr22, P_ ptr23, P_ ptr24, P_ ptr25, P_ ptr26, P_ ptr27, P_ ptr28, P_ ptr29, P_ ptr30,
+P_ ptr31, P_ ptr32, P_ ptr33, P_ ptr34, P_ ptr35, P_ ptr36, P_ ptr37, P_ ptr38, P_ ptr39, P_ ptr40,
+P_ ptr41, P_ ptr42, P_ ptr43, P_ ptr44, P_ ptr45, P_ ptr46, P_ ptr47, P_ ptr48, P_ ptr49, P_ ptr50,
+P_ ptr51, P_ ptr52, P_ ptr53, P_ ptr54, P_ ptr55, P_ ptr56, P_ ptr57, P_ ptr58
+)
+#endif
+ return (/* no return values */)
+{
+ return ();
+}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57f856f9a16ae21a50756538afc4dc2b038ff4fd
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57f856f9a16ae21a50756538afc4dc2b038ff4fd
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/20221227/4ddca39f/attachment-0001.html>
More information about the ghc-commits
mailing list