[Git][ghc/ghc][wip/reset-static-link-on-revert] 2 commits: rts: Reset STATIC_LINK field of reverted CAFs

[Ben Gamari]

Ben Gamari pushed to branch wip/reset-static-link-on-revert at Glasgow Haskell Compiler / GHC


Commits:
2a960c3a by Ben Gamari at 2019-06-18T19:12:04Z
rts: Reset STATIC_LINK field of reverted CAFs

When we revert a CAF we must reset the STATIC_LINK field lest the GC
might ignore the CAF (e.g. as it carries the STATIC_FLAG_LIST flag) and
will consequently overlook references to object code that we are trying
to unload. This would result in the reachable object code being
unloaded. See Note [CAF lists] and Note [STATIC_LINK fields].

This fixes #16842.

Idea-due-to: Phuong Trinh <lolotp at fb.com>

- - - - -
f01924ad by Ben Gamari at 2019-06-18T19:12:52Z
testsuite: Add caf_crash testcase

- - - - -


7 changed files:

- rts/sm/GCAux.c
- + testsuite/tests/ghci/caf_crash/A.hs
- + testsuite/tests/ghci/caf_crash/B.hs
- + testsuite/tests/ghci/caf_crash/D.hs
- + testsuite/tests/ghci/caf_crash/all.T
- + testsuite/tests/ghci/caf_crash/caf_crash.script
- + testsuite/tests/ghci/caf_crash/caf_crash.stdout


Changes:

=====================================
rts/sm/GCAux.c
=====================================
@@ -114,16 +114,21 @@ isAlive(StgClosure *p)
 void
 revertCAFs( void )
 {
-    StgIndStatic *c;
+    StgIndStatic *c = revertible_caf_list;
 
-    for (c = revertible_caf_list;
-         c != (StgIndStatic *)END_OF_CAF_LIST;
-         c = (StgIndStatic *)c->static_link)
-    {
+    while (c != (StgIndStatic *) END_OF_CAF_LIST) {
         c = (StgIndStatic *)UNTAG_STATIC_LIST_PTR(c);
+        StgIndStatic *next = (StgIndStatic *) c->static_link;
+
         SET_INFO((StgClosure *)c, c->saved_info);
         c->saved_info = NULL;
-        // could, but not necessary: c->static_link = NULL;
+        // We must reset static_link lest the major GC finds that
+        // static_flag==3 and will consequently ignore references
+        // into code that we are trying to unload. This would result
+        // in reachable object code being unloaded prematurely.
+        // See #16842.
+        c->static_link = NULL;
+        c = next;
     }
     revertible_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
 }


=====================================
testsuite/tests/ghci/caf_crash/A.hs
=====================================
@@ -0,0 +1,18 @@
+module A (caf, mainx, square) where
+
+import B (idd)
+
+caf :: Int
+caf = 23423
+
+mainx :: IO ()
+mainx = do
+    putStrLn $ show (caf + idd)
+    putStrLn "Hello"
+    putStrLn "World"
+
+square :: IO Int
+square = do
+    let ss = "I'm a square"
+    putStrLn $ ss
+    return $ length ss


=====================================
testsuite/tests/ghci/caf_crash/B.hs
=====================================
@@ -0,0 +1,5 @@
+module B (idd) where
+
+idd :: Int
+idd = 100000242418429
+


=====================================
testsuite/tests/ghci/caf_crash/D.hs
=====================================
@@ -0,0 +1,22 @@
+module D where
+
+import A
+
+data MyFunc = MyFunc String (IO Int)
+
+funcCaf :: [MyFunc]
+funcCaf = [MyFunc "square" square]
+
+f1 :: MyFunc -> String
+f1 (MyFunc s _) = s
+
+f2 :: MyFunc -> IO Int
+f2 (MyFunc s d) = d
+
+main :: IO ()
+main = do
+    mainx
+    putStrLn $ show $ length funcCaf
+    putStrLn $ show $ f1 $ head funcCaf
+    yay <- f2 $ head funcCaf
+    print yay


=====================================
testsuite/tests/ghci/caf_crash/all.T
=====================================
@@ -0,0 +1,6 @@
+test('caf_crash',
+     [extra_files(['A.hs', 'B.hs', 'D.hs', ]),
+      when(ghc_dynamic(), skip),
+      extra_ways(['ghci-ext']),
+      omit_ways(['ghci']), ],
+     ghci_script, ['caf_crash.script'])


=====================================
testsuite/tests/ghci/caf_crash/caf_crash.script
=====================================
@@ -0,0 +1,9 @@
+:set -fobject-code
+:l D.hs
+:set -fbyte-code
+:add *D
+main
+:l []
+System.Mem.performGC
+System.Mem.performGC
+3+4


=====================================
testsuite/tests/ghci/caf_crash/caf_crash.stdout
=====================================
@@ -0,0 +1,7 @@
+100000242441852
+Hello
+World
+1
+"square"
+I'm a square
+12



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1a76db446b53a95ae6b515e8a3331d9d360f2b7d...f01924adcfbd3c8b087c74bc26d5ddf9559097f7

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1a76db446b53a95ae6b515e8a3331d9d360f2b7d...f01924adcfbd3c8b087c74bc26d5ddf9559097f7
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/20190618/676592b4/attachment-0001.html>