repos / gcs.git

commit

435c3a5

parent

9aea392

author

Evgenii Akentev

date

2024-09-17 22:16:13 +0400 +04

TwoFinger works

 1@@ -153,11 +153,10 @@ compact = do
 2   free <- relocate 1 8
 3   updateReferences 1 free
 4 
 5-move :: Int -> Int -> GcM ()
 6-move from to = do
 7-  s@GCState{heap} <- get
 8-  let obj = heap ! from
 9-  put $ s { heap = heap // [ (to, obj), (from, Nothing) ] }
10+move :: Int -> Int -> Heap -> Heap
11+move from to h =
12+  let obj = h ! from
13+  in h // [ (to, obj) ]
14 
15 -- slotSize == 1
16 relocate :: Int -> Int -> GcM Int
17@@ -169,27 +168,33 @@ relocate start end = go start end
18         gc <- get
19         let bm = bitmap gc
20         let indicesToUnmark = fmap fst $ takeWhile (\(_, marked) -> marked) $ sortBy (flip compare `on` Down . fst) $ assocs bm 
21-            free' = if indicesToUnmark == [] then free else maximum indicesToUnmark
22+            free' = if indicesToUnmark == [] then 1 + free else 1 + maximum indicesToUnmark
23             bm' = bm // [(i, False) | i <- indicesToUnmark] 
24-        put $ gc { bitmap = traceShow (free', indicesToUnmark) bm', heap = heap gc // [(i, Nothing) | (i, x) <- assocs bm, x == False]  }
25 
26         let
27-          findIndexStep (_, marked) idx
28-            | not marked && idx > free' = idx - 1
29-            | otherwise = idx 
30-          scan' = traceShowId $ foldr findIndexStep scan $ traceShowId $ take scan $ sortBy (flip compare `on` Down . fst) $ assocs bm'
31+          findIndexStep (_, marked) acc@(found, idx)
32+            | found = acc
33+            | not marked && idx > free' = (False, idx - 1)
34+            | otherwise = (True, idx) 
35+          scan' = snd $ foldr findIndexStep (False, scan) $ take scan $ sortBy (flip compare `on` Down . fst) $ assocs bm'
36        
37-        if scan' > free' then do
38-          put $ gc { bitmap = bm' // [(scan', False)]}
39+        let newH = if indicesToUnmark == [] then heap gc else heap gc // [(i, Nothing) | (i, x) <- assocs bm, x == False] 
40+        put $ gc { bitmap = bm' -- traceShow ("updating bitmap", free', indicesToUnmark, newH, bm') bm'
41+          , heap = newH }      
42 
43-          move scan' free'
44+        
45+        if (scan' > free') then do
46 
47-          let obj = (heap gc) ! scan'
48-          put $ gc { heap = heap gc // [ (scan', (\o -> o { forwardAddress = Just free' } ) <$> obj ) ] }
49+          let newHeap = move scan' free' newH
50+          let obj = newHeap ! scan'
51+          let newnewHeap = newHeap // [ (scan', (\o -> o { forwardAddress = Just free' } ) <$> obj ) ] 
52+          put $ gc { bitmap = bm' // [(scan', False)], heap = newnewHeap }
53 
54           go (free' + 1) (scan' - 1)
55         else go free' scan'
56-      | otherwise = pure free
57+      | otherwise = do
58+        GCState{heap, bitmap} <- get
59+        pure free -- traceShow (" leaving", free, scan, heap, bitmap) free
60 
61 -- slotSize == 1
62 updateReferences :: Int -> Int -> GcM ()
63@@ -199,18 +204,17 @@ updateReferences start end = do
64   let
65     step NullPtr = NullPtr
66     step ptr@(ObjectPtr p) =
67-      let newPtr = forwardAddress <$> heap ! p
68+      let newPtr = forwardAddress <$> (heap ! p)
69       in case newPtr of
70         Just (Just newPtr') | p >= end -> ObjectPtr newPtr'
71         _ -> ptr
72-  put $ s { roots = fmap step roots }
73 
74   let
75     updateStep (scan, res) item
76       | scan < end, Just obj <- item = (scan + 1, (scan, Just $ obj { fields = fmap step $ fields obj }) : res)
77       | otherwise = (scan + 1, res)
78 
79-  put $ s { heap = heap // (snd $ foldl updateStep (start, []) heap) }
80+  put $ s { roots = fmap step roots, heap = heap // (snd $ foldl updateStep (start, []) heap) }
81 
82 main :: IO ()
83 main = do
84@@ -233,7 +237,8 @@ main = do
85         collect
86 
87         ptr2' <- new (IntVal 2)
88+        writeToRoots 2 ptr2'
89         collect
90         
91-        return [ptr, ptr2, ptr2']
92-  print res
93+        return [ptr, ptr2]
94+  putStrLn $ "RESULT:" ++ (show $ snd res)