[Git][ghc/ghc][wip/decode_cloned_stack] 2 commits: Cleanup

[Sven Tennie (@supersven)]

Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC


Commits:
a98f1e6b by Sven Tennie at 2023-02-11T14:39:02+00:00
Cleanup

- - - - -
a440f513 by Sven Tennie at 2023-02-12T08:32:00+00:00
Fix ERW_

- - - - -


3 changed files:

- libraries/ghc-heap/tests/TestUtils.hs
- libraries/ghc-heap/tests/stack_misc_closures.hs
- rts/include/Stg.h


Changes:

=====================================
libraries/ghc-heap/tests/TestUtils.hs
=====================================
@@ -43,7 +43,7 @@ assertThat :: (HasCallStack, Monad m) => String -> (a -> Bool) -> a -> m ()
 assertThat s f a = if f a then pure () else error s
 
 assertStackInvariants :: (HasCallStack, MonadIO m) => StackSnapshot -> [Closure] -> m ()
-assertStackInvariants stack decodedStack = do
+assertStackInvariants stack decodedStack =
   assertThat
     "Last frame is stop frame"
     ( \case


=====================================
libraries/ghc-heap/tests/stack_misc_closures.hs
=====================================
@@ -12,9 +12,8 @@
 
 module Main where
 
--- TODO: Remove later
-
 import Data.Functor
+-- TODO: Remove later
 import Debug.Trace
 import GHC.Exts
 import GHC.Exts.DecodeStack
@@ -51,11 +50,11 @@ foreign import prim "any_ret_big_closures_min_framezh" any_ret_big_closures_min_
 
 foreign import prim "any_ret_big_closures_two_words_framezh" any_ret_big_closures_two_words_frame# :: SetupFunction
 
-foreign import prim "any_ret_fun_arg_n_prim_framezh" any_ret_fun_arg_n_prim_framezh# :: SetupFunction
+foreign import prim "any_ret_fun_arg_n_prim_framezh" any_ret_fun_arg_n_prim_frame# :: SetupFunction
 
-foreign import prim "any_ret_fun_arg_gen_framezh" any_ret_fun_arg_gen_framezh# :: SetupFunction
+foreign import prim "any_ret_fun_arg_gen_framezh" any_ret_fun_arg_gen_frame# :: SetupFunction
 
-foreign import prim "any_ret_fun_arg_gen_big_framezh" any_ret_fun_arg_gen_big_framezh# :: SetupFunction
+foreign import prim "any_ret_fun_arg_gen_big_framezh" any_ret_fun_arg_gen_big_frame# :: SetupFunction
 
 foreign import prim "any_bco_framezh" any_bco_frame# :: SetupFunction
 
@@ -147,7 +146,6 @@ main = do
       e -> error $ "Wrong closure type: " ++ show e
   traceM $ "Test 10"
   testSize any_atomically_frame# 3
-  -- TODO: Test for UnderflowFrame once it points to a Box payload
   traceM $ "Test 11"
   test any_ret_small_prim_frame# $
     \case
@@ -236,7 +234,7 @@ main = do
   traceM $ "Test 24"
   testSize any_ret_big_closures_two_words_frame# ((fromIntegral bitsInWord) + 1 + 1)
   traceM $ "Test 25"
-  test any_ret_fun_arg_n_prim_framezh# $
+  test any_ret_fun_arg_n_prim_frame# $
     \case
       RetFun {..} -> do
         assertEqual (tipe info) RET_FUN
@@ -249,7 +247,7 @@ main = do
         assertEqual wds [1]
       e -> error $ "Wrong closure type: " ++ show e
   traceM $ "Test 26"
-  test any_ret_fun_arg_gen_framezh# $
+  test any_ret_fun_arg_gen_frame# $
     \case
       RetFun {..} -> do
         assertEqual (tipe info) RET_FUN
@@ -268,10 +266,9 @@ main = do
         assertEqual wds [1 .. 9]
       e -> error $ "Wrong closure type: " ++ show e
   traceM $ "Test 27"
-  testSize any_ret_fun_arg_gen_framezh# (3 + 9)
+  testSize any_ret_fun_arg_gen_frame# (3 + 9)
   traceM $ "Test 28"
-  -- TODO: Check names: # and zh
-  test any_ret_fun_arg_gen_big_framezh# $
+  test any_ret_fun_arg_gen_big_frame# $
     \case
       RetFun {..} -> do
         assertEqual (tipe info) RET_FUN
@@ -289,7 +286,7 @@ main = do
         let wds = map getWordFromConstr01 pCs
         assertEqual wds [1 .. 59]
   traceM $ "Test 29"
-  testSize any_ret_fun_arg_gen_big_framezh# (3 + 59)
+  testSize any_ret_fun_arg_gen_big_frame# (3 + 59)
   traceM $ "Test 30"
   test any_bco_frame# $
     \case
@@ -378,14 +375,6 @@ test setup assertion = do
     assert sn stack = do
       assertStackInvariants sn stack
       assertEqual (length stack) 2
-      -- TODO: Isn't this also a stack invariant? (assertStackInvariants)
-      assertThat
-        "Last frame is stop frame"
-        ( \case
-            StopFrame info -> tipe info == STOP_FRAME
-            _ -> False
-        )
-        (last stack)
       assertion $ head stack
 
 entertainGC :: Int -> String


=====================================
rts/include/Stg.h
=====================================
@@ -309,7 +309,7 @@ typedef StgFunPtr       F_;
 #define EC_(X)    extern       StgWordArray (X) GNU_ATTRIBUTE(aligned (SIZEOF_VOID_P))
 #define IC_(X)    static       StgWordArray (X) GNU_ATTRIBUTE(aligned (SIZEOF_VOID_P))
 /* writable data (does not require alignment): */
-#define ERW_(X)   extern       StgWordArray (X)
+#define ERW_(X)   extern       const StgWordArray (X)
 #define IRW_(X)   static       StgWordArray (X)
 /* read-only data (does not require alignment): */
 #define ERO_(X)   extern const StgWordArray (X)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32e581a85cf92cde93ad1ca424f8f61eafbd3a96...a440f513988b32877d5cca9bcbd5a265e4d81256

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32e581a85cf92cde93ad1ca424f8f61eafbd3a96...a440f513988b32877d5cca9bcbd5a265e4d81256
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/20230212/b3960a48/attachment-0001.html>