diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,11 @@
 # Revision history for rhine-gloss
 
+## 1.8
+
+* Remove dependency on `monad-schedule` because of performance problems.
+  See https://github.com/turion/rhine/issues/377.
+* Revert scheduling in the `IO` backend to `IO`.
+
 ## 1.4
 
 * Use `FreeAsyncT` in the gloss IO backend for fairer concurrency.
diff --git a/rhine-gloss.cabal b/rhine-gloss.cabal
--- a/rhine-gloss.cabal
+++ b/rhine-gloss.cabal
@@ -1,7 +1,7 @@
 -- Initial rhine-gloss.cabal generated by cabal init.  For further
 -- documentation, see http://haskell.org/cabal/users-guide/
 name: rhine-gloss
-version: 1.7
+version: 1.8
 synopsis: Gloss backend for Rhine
 description:
   This package provides a simple wrapper for the `gloss` library,
@@ -38,11 +38,10 @@
 
   build-depends:
     automaton,
-    base >=4.16 && <4.22,
+    base >=4.18 && <4.22,
     gloss >=1.12,
     mmorph >=1.1,
-    monad-schedule >=1.6,
-    rhine ^>=1.7,
+    rhine ^>=1.8,
     transformers >=0.5
 
   hs-source-dirs: src
@@ -57,7 +56,7 @@
   main-is: Main.hs
   ghc-options: -threaded
   build-depends:
-    base >=4.16 && <4.22,
+    base >=4.18 && <4.22,
     rhine-gloss
 
   default-language: Haskell2010
diff --git a/src/FRP/Rhine/Gloss/IO.hs b/src/FRP/Rhine/Gloss/IO.hs
--- a/src/FRP/Rhine/Gloss/IO.hs
+++ b/src/FRP/Rhine/Gloss/IO.hs
@@ -47,9 +47,8 @@
 -- gloss
 import Graphics.Gloss.Interface.IO.Game
 
--- monad-schedule
-import Control.Monad.Schedule.Class
-import Control.Monad.Schedule.FreeAsync
+-- automaton
+import Data.Automaton.Schedule
 
 -- rhine
 import FRP.Rhine
@@ -68,30 +67,32 @@
   , timeRef :: IORef (Seconds Float)
   }
 
-{- | Effects in the gloss backend
+{- | Effects in the gloss backend.
 
-* Wraps the concurrent variables needed for communication with the @gloss@ backend.
-* Adds the 'FreeAsyncT' concurrency layer for fairer scheduling
+Wraps the concurrent variables needed for communication with the @gloss@ backend.
 -}
 newtype GlossConcT m a = GlossConcT
-  {unGlossConcT :: ReaderT GlossEnv (FreeAsyncT m) a}
+  {unGlossConcT :: ReaderT GlossEnv m a}
   deriving (Functor, Applicative, Monad, MonadIO)
 
 -- | When @gloss@ is the only effect you are using, use this monad to simplify your type signatures.
 type GlossConc = GlossConcT IO
 
 instance MonadTrans GlossConcT where
-  lift = GlossConcT . lift . lift
+  lift = GlossConcT . lift
 
 -- FIXME MFunctor & MMonad instances pending https://github.com/HeinrichApfelmus/operational/pull/28/
 
 -- | Remove the 'GlossConcT' transformer by explicitly providing an environment.
 runGlossConcT :: (MonadIO m) => GlossConcT m a -> GlossEnv -> m a
-runGlossConcT ma env = runFreeAsyncT $ runReaderT (unGlossConcT ma) env
+runGlossConcT ma = runReaderT (unGlossConcT ma)
 
 -- | Disregards scheduling capabilities of @m@, as it uses 'FreeAsync'.
-instance (MonadIO m) => MonadSchedule (GlossConcT m) where
-  schedule actions = GlossConcT $ fmap (second $ map GlossConcT) $ schedule $ unGlossConcT <$> actions
+instance (MonadIO m, MonadSchedule m) => MonadSchedule (GlossConcT m) where
+  schedule =
+    fmap (hoistS unGlossConcT)
+      >>> schedule
+      >>> hoistS GlossConcT
 
 withPicRef ::
   (MonadIO m) =>
@@ -126,14 +127,14 @@
 instance (MonadIO m) => Clock (GlossConcT m) GlossEventClockIO where
   type Time GlossEventClockIO = Seconds Float
   type Tag GlossEventClockIO = Event
-  initClock _ = return (constM getEvent, 0)
+  initClock _ = pure (constM getEvent, 0)
     where
       getEvent = do
         GlossEnv {eventVar, timeRef} <- GlossConcT ask
-        event <- GlossConcT $ lift $ asyncMVar eventVar
         liftIO $ do
+          event <- takeMVar eventVar
           time <- readIORef timeRef
-          return (time, event)
+          pure (time, event)
   {-# INLINE initClock #-}
 
 instance GetClockProxy GlossEventClockIO
@@ -149,11 +150,11 @@
 instance (MonadIO m) => Clock (GlossConcT m) GlossSimClockIO where
   type Time GlossSimClockIO = Seconds Float
   type Tag GlossSimClockIO = ()
-  initClock _ = return (constM getTime &&& arr (const ()), 0)
+  initClock _ = pure (constM getTime &&& arr (const ()), 0)
     where
       getTime = GlossConcT $ do
         GlossEnv {timeVar} <- ask
-        lift $ asyncMVar timeVar
+        liftIO $ takeMVar timeVar
   {-# INLINE initClock #-}
 
 instance GetClockProxy GlossSimClockIO
@@ -187,7 +188,7 @@
           void $
             timeout 100000 $ -- timeout in case noone is listening for events
               putMVar eventVar event
-      return vars
+      pure vars
     simStep diffTime vars@GlossEnv {timeVar, timeRef} = do
       time <- readIORef timeRef
       let !time' = time + Seconds diffTime
@@ -195,18 +196,18 @@
       -- which can lead to non-monotonous time updates.
       tryPutMVar timeVar time'
       writeIORef timeRef time'
-      return vars
+      pure vars
   void $ liftIO $ forkIO $ playIO display backgroundColor stepsPerSecond vars getPic handleEvent simStep
-  return vars
+  pure vars
 
 {- | Apply this to supply the 'GlossConcT' effect.
-   Creates a new thread in which @gloss@ is run,
-   and feeds the clocks 'GlossEventClockIO' and 'GlossSimClockIO'.
+     Creates a new thread in which @gloss@ is run,
+     and feeds the clocks 'GlossEventClockIO' and 'GlossSimClockIO'.
 
-   Usually, this function is applied to the result of 'flow',
-   so you can handle all occurring effects as needed.
-   If you only use @gloss@ in your whole signal network,
-   you can use 'flowGlossIO' instead.
+     Usually, this function is applied to the result of 'flow',
+     so you can handle all occurring effects as needed.
+     If you only use @gloss@ in your whole signal network,
+     you can use 'flowGlossIO' instead.
 -}
 launchInGlossThread ::
   (MonadIO m) =>
@@ -218,7 +219,7 @@
   runGlossConcT glossLoop vars
 
 {- | Run a 'Rhine' in the 'GlossConcT' monad by launching a separate thread for the @gloss@ backend,
-   and reactimate in the foreground.
+  and reactimate in the foreground.
 -}
 flowGlossIO ::
   ( MonadIO m
@@ -233,13 +234,13 @@
 flowGlossIO settings = launchInGlossThread settings . flow
 
 {- | Apply this wrapper to your clock type @cl@ in order to escape the 'GlossConcT' transformer.
-  The resulting clock will be in @m@, not 'GlossConcT m' anymore.
-  Typically, @m@ will have the 'MonadIO' constraint.
+ The resulting clock will be in @m@, not 'GlossConcT m' anymore.
+ Typically, @m@ will have the 'MonadIO' constraint.
 -}
 type RunGlossEnvClock m cl = HoistClock (GlossConcT m) m cl
 
 {- | Apply to a gloss clock to remove a 'GlossConcT' layer.
-  You will have to have initialized a 'GlossEnv', for example by calling 'launchGlossThread'.
+ You will have to have initialized a 'GlossEnv', for example by calling 'launchGlossThread'.
 -}
 runGlossEnvClock ::
   (MonadIO m) =>
@@ -266,7 +267,7 @@
 glossConcTClock unhoistedClock =
   HoistClock
     { unhoistedClock
-    , monadMorphism = GlossConcT . lift . freeAsync
+    , monadMorphism = GlossConcT . liftIO
     }
 
 {- | Lift an 'IO' clock to 'GlossConc'.
diff --git a/src/FRP/Rhine/Gloss/Pure.hs b/src/FRP/Rhine/Gloss/Pure.hs
--- a/src/FRP/Rhine/Gloss/Pure.hs
+++ b/src/FRP/Rhine/Gloss/Pure.hs
@@ -19,7 +19,8 @@
   currentEvent,
   flowGloss,
   flowGlossClSF,
-) where
+)
+where
 
 -- base
 import qualified Control.Category as Category
@@ -30,11 +31,9 @@
 import Control.Monad.Trans.Reader
 import Control.Monad.Trans.Writer.Strict
 
--- monad-schedule
-import Control.Monad.Schedule.Class
-import Control.Monad.Schedule.Yield
-
 -- automaton
+import Data.Automaton.Schedule (MonadSchedule (..))
+import Data.Automaton.Schedule.Trans (SkipT, runSkipT, skip)
 import Data.Automaton.Trans.Except (performOnFirstSample)
 import qualified Data.Automaton.Trans.Reader as AutomatonReader
 import qualified Data.Automaton.Trans.Writer as AutomatonWriter
@@ -48,12 +47,12 @@
 -- * @gloss@ effects
 
 -- | A pure monad in which all effects caused by the @gloss@ backend take place.
-newtype GlossM a = GlossM {unGlossM :: YieldT (ReaderT (Seconds Float, Maybe Event) (Writer Picture)) a}
+newtype GlossM a = GlossM {unGlossM :: SkipT (ReaderT (Seconds Float, Maybe Event) (Writer Picture)) a}
   deriving (Functor, Applicative, Monad)
 
 -- Would have liked to make this a derived instance, but for some reason deriving gets thrown off by the newtype
 instance MonadSchedule GlossM where
-  schedule actions = fmap (fmap (fmap GlossM)) $ GlossM $ schedule $ fmap unGlossM actions
+  schedule = fmap (hoistS unGlossM) >>> schedule >>> hoistS GlossM
 
 -- | Add a picture to the canvas.
 paint :: Picture -> GlossM ()
@@ -72,7 +71,7 @@
 -- * Clocks
 
 {- | The overall clock of a pure @rhine@ 'ClSF' that can be run by @gloss@.
-   It ticks both on events (@tag = Just Event@) and simulation steps (@tag = Nothing@).
+  It ticks both on events (@tag = Just Event@) and simulation steps (@tag = Nothing@).
 -}
 data GlossClock = GlossClock
 
@@ -82,7 +81,7 @@
 instance Clock GlossM GlossClock where
   type Time GlossClock = Seconds Float
   type Tag GlossClock = Maybe Event
-  initClock _ = return (constM (GlossM $ yield >> lift ask) >>> (sumN *** Category.id), 0)
+  initClock _ = pure (constM (GlossM (skip >> lift ask)) >>> (sumN *** Category.id), 0)
   {-# INLINE initClock #-}
 
 instance GetClockProxy GlossClock
@@ -99,7 +98,7 @@
 type GlossClSF = ClSF GlossM GlossClock () Picture
 
 {- | Observe whether there was an event this tick,
-   and which one.
+  and which one.
 -}
 currentEvent :: ClSF GlossM GlossClock () (Maybe Event)
 currentEvent = tagS
@@ -126,7 +125,7 @@
   play display backgroundColor stepsPerSecond (worldAutomaton, Blank) getPic handleEvent simStep
   where
     worldAutomaton :: WorldAutomaton
-    worldAutomaton = AutomatonWriter.runWriterS $ AutomatonReader.runReaderS $ hoistS (runYieldT . unGlossM) $ performOnFirstSample $ eraseClock rhine
+    worldAutomaton = AutomatonWriter.runWriterS $ AutomatonReader.runReaderS $ hoistS (runSkipT . unGlossM) $ performOnFirstSample $ eraseClock rhine
     stepWith :: (Float, Maybe Event) -> (WorldAutomaton, Picture) -> (WorldAutomaton, Picture)
     stepWith (diff, eventMaybe) (automaton, _) = let Result automaton' (picture, _) = runIdentity $ stepAutomaton automaton ((Seconds diff, eventMaybe), ()) in (automaton', picture)
     getPic (_, pic) = pic