Skip to content

Commit ad93f94

Browse files
committed
Shuffle runqueue everytime we unblock threads
1 parent ffab18c commit ad93f94

File tree

2 files changed

+22
-3
lines changed

2 files changed

+22
-3
lines changed

io-sim/src/Control/Monad/IOSim/Internal.hs

Lines changed: 19 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -849,14 +849,17 @@ reschedule !simstate@SimState{ threads, timers, curTime = time } =
849849
timeoutSTMAction TimerTimeout{} = return ()
850850

851851
unblockThreads :: Bool -> [IOSimThreadId] -> SimState s a -> ([IOSimThreadId], SimState s a)
852-
unblockThreads !onlySTM !wakeup !simstate@SimState {runqueue, threads} =
852+
unblockThreads !onlySTM !wakeup !simstate@SimState {runqueue, threads, stdGen} =
853853
-- To preserve our invariants (that threadBlocked is correct)
854854
-- we update the runqueue and threads together here
855855
(unblocked, simstate {
856-
runqueue = runqueue <> Deque.fromList unblocked,
857-
threads = threads'
856+
runqueue = Deque.fromList shuffledRunqueue,
857+
threads = threads',
858+
stdGen = stdGen'
858859
})
859860
where
861+
!(shuffledRunqueue, stdGen') = fisherYatesShuffle stdGen runqueue'
862+
!runqueue' = Deque.toList $ runqueue <> Deque.fromList unblocked
860863
-- can only unblock if the thread exists and is blocked (not running)
861864
!unblocked = [ tid
862865
| tid <- wakeup
@@ -873,6 +876,19 @@ unblockThreads !onlySTM !wakeup !simstate@SimState {runqueue, threads} =
873876
threads
874877
unblocked
875878

879+
-- Fisher-Yates shuffle implementation
880+
fisherYatesShuffle :: StdGen -> [a] -> ([a], StdGen)
881+
fisherYatesShuffle gen [] = ([], gen)
882+
fisherYatesShuffle gen l =
883+
let (l', gen') = go (length l - 1) l gen
884+
in (l', gen')
885+
where
886+
go 0 lst g = (lst, g)
887+
go n lst g = let (k, newGen) = randomR (0, n) g
888+
(x:xs) = drop k lst
889+
swapped = take k lst ++ [lst !! n] ++ drop (k + 1) lst
890+
in go (n - 1) (take n swapped ++ [x] ++ drop n xs) newGen
891+
876892
-- | This function receives a list of TimerTimeout values that represent threads
877893
-- for which the timeout expired and kills the running thread if needed.
878894
--

io-sim/src/Data/Deque/Strict.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -39,3 +39,6 @@ uncons = \case
3939

4040
filter :: (a -> Bool) -> Deque a -> Deque a
4141
filter f (Deque head tail) = Deque (List.filter f head) (List.filter f tail)
42+
43+
toList :: Deque a -> [a]
44+
toList = foldr (:) []

0 commit comments

Comments
 (0)