repos / gcs.git

commit

9aea392

parent

399d780

author

Evgenii Akentev

date

2024-09-17 20:57:32 +0400 +04

TwoFinger wip

 1@@ -5,7 +5,8 @@
 2 module MarkCompact.TwoFinger where
 3 
 4 import Debug.Trace 
 5-import Data.List (sortBy)
 6+import Data.Ord (Down(..))
 7+import Data.List
 8 import Data.Function (on)
 9 import Data.Array
10 import Control.Monad.State
11@@ -112,9 +113,7 @@ allocate v = do
12       pure $ Right $ ObjectPtr p
13     Nothing -> pure $ Left "Out of memory"
14   where
15-      findIndexWithNothing h = foldl step Nothing $ sortBy (flip compare `on` fst) $ assocs h
16-      step _ (i, Nothing) = Just i
17-      step acc _ = acc
18+      findIndexWithNothing h = ((+)1) <$> (elemIndex Nothing $ map snd $ sortBy (flip compare `on` Down . fst) $ assocs h)
19 
20 mark :: [ObjectPtr] -> Heap -> Bitmap -> Bitmap
21 mark [] _ bm = bm
22@@ -146,7 +145,6 @@ markFromRoots = do
23 
24 collect :: GcM ()
25 collect = do
26-  traceShowM "mark!!!"
27   markFromRoots
28   compact
29 
30@@ -170,17 +168,17 @@ relocate start end = go start end
31       | free < scan = do
32         gc <- get
33         let bm = bitmap gc
34-        let indicesToUnmark = fmap fst $ takeWhile (\(_, marked) -> marked) $ assocs bm 
35+        let indicesToUnmark = fmap fst $ takeWhile (\(_, marked) -> marked) $ sortBy (flip compare `on` Down . fst) $ assocs bm 
36             free' = if indicesToUnmark == [] then free else maximum indicesToUnmark
37             bm' = bm // [(i, False) | i <- indicesToUnmark] 
38-        put $ gc { bitmap = traceShow (free', indicesToUnmark) bm' }
39+        put $ gc { bitmap = traceShow (free', indicesToUnmark) bm', heap = heap gc // [(i, Nothing) | (i, x) <- assocs bm, x == False]  }
40 
41         let
42-          findIndexStep marked (ok, idx)
43-            | not marked && idx > free' = (ok, idx - 1)
44-            | otherwise = (True, idx) 
45-          scan' = snd $ foldr findIndexStep (False, scan) bm'
46-    
47+          findIndexStep (_, marked) idx
48+            | not marked && idx > free' = idx - 1
49+            | otherwise = idx 
50+          scan' = traceShowId $ foldr findIndexStep scan $ traceShowId $ take scan $ sortBy (flip compare `on` Down . fst) $ assocs bm'
51+       
52         if scan' > free' then do
53           put $ gc { bitmap = bm' // [(scan', False)]}
54 
55@@ -230,9 +228,12 @@ main = do
56         ptr7 <- new (IntVal 7) 
57         ptr8 <- new (IntVal 8) 
58 
59+        writeToRoots 5 ptr6
60 
61         collect
62 
63-
64-        return [ptr, ptr2]
65+        ptr2' <- new (IntVal 2)
66+        collect
67+        
68+        return [ptr, ptr2, ptr2']
69   print res