diff --git a/.github/docker/debian-asan.dockerfile b/.github/docker/debian-asan.dockerfile
index 663d40765c..321f42b2ba 100644
--- a/.github/docker/debian-asan.dockerfile
+++ b/.github/docker/debian-asan.dockerfile
@@ -5,7 +5,7 @@ FROM $BASE_IMAGE AS ocaml
 
 MAINTAINER The Savonet Team <contact@liquidsoap.info>
 
-ARG OCAML_VERSION=5.4.0
+ARG OCAML_VERSION=5.5.0
 
 ENV DEBIAN_FRONTEND=noninteractive
 ENV ASAN_OPTIONS="detect_leaks=0:detect_stack_use_after_return=0:detect_container_overflow=0:protect_shadow_gap=0:verify_asan_link_order=0"
diff --git a/.github/docker/website.dockerfile b/.github/docker/website.dockerfile
index 483fb0190e..dcdbdaed37 100644
--- a/.github/docker/website.dockerfile
+++ b/.github/docker/website.dockerfile
@@ -1,4 +1,4 @@
-FROM ghcr.io/savonet/liquidsoap:ci-v2-debian_trixie-5.4.0
+FROM ghcr.io/savonet/liquidsoap:ci-v2-debian_trixie-5.5.0
 
 MAINTAINER The Savonet Team <contact@liquidsoap.info>
 
diff --git a/.github/docker/win32-base.dockerfile b/.github/docker/win32-base.dockerfile
index 3c9defe708..6efbd096fa 100644
--- a/.github/docker/win32-base.dockerfile
+++ b/.github/docker/win32-base.dockerfile
@@ -1,59 +1,111 @@
-ARG OCAML_VERSION=5.4.1
-FROM ghcr.io/ocaml-cross/windows-x64-base:${OCAML_VERSION} AS builder
+ARG DEBIAN_VERSION=bookworm
 
-# Install missing build-time prerequisites for MXE packages.
-# python3-packaging is required by glib (a build dep of curl and others).
+FROM debian:${DEBIAN_VERSION}-slim AS builder
+
+ARG OCAML_VERSION=5.5.0
+
+# MXE revision. This is pinned rather than tracked: MXE decides a package is
+# stale by comparing its install stamp against the mtime of the recipe, so a
+# moving tree rebuilds the toolchain and every C library under it, and the
+# library versions we ship change without anything in this repo changing.
+ARG MXE_GIT_TAG=71cb7a3c56c0fde5d6aa806ad7623240e9128d57
+
+ARG DEBIAN_FRONTEND=noninteractive
+
+ENV MXE_DIR=/usr/src/mxe
+ENV CROSS_TRIPLE=x86_64-w64-mingw32.static
+
+# MXE's own requirements, from its docs/index.html. wine runs the built
+# executable, xvfb gives the initial wineboot a display, zip bundles the
+# release and gosu drops the CI step to the opam user.
 RUN apt-get update && \
-    apt-get install -y --no-install-recommends python3-packaging && \
-    apt-get clean
-
-# Update MXE to get the latest package recipes (e.g. ffmpeg 7.1.1).
-RUN cd /usr/src/mxe && git fetch origin && git reset --hard origin/master
-
-# Build MXE packages required by the Windows opam packages.
-# Each package is a separate layer to maximise Docker cache reuse.
-# ffmpeg is last because it is the slowest build and the most stable,
-# so its cache is only invalidated when strictly necessary.
-
-RUN cd /usr/src/mxe && make openssl
-RUN cd /usr/src/mxe && make curl
-RUN cd /usr/src/mxe && make libsrt
-RUN cd /usr/src/mxe && make jack
-RUN cd /usr/src/mxe && make portaudio
-RUN cd /usr/src/mxe && make libsamplerate
-RUN cd /usr/src/mxe && make dlfcn-win32
-RUN cd /usr/src/mxe && make libao
-RUN cd /usr/src/mxe && make ogg
-RUN cd /usr/src/mxe && make flac
-RUN cd /usr/src/mxe && make vorbis
-RUN cd /usr/src/mxe && make opus
-RUN cd /usr/src/mxe && make faad2
-RUN cd /usr/src/mxe && make lame
-RUN cd /usr/src/mxe && make libmad
-RUN cd /usr/src/mxe && make fdk-aac
-RUN cd /usr/src/mxe && make ffmpeg
-
-# Install xvfb to provide a virtual display for the initial Wine setup.
-RUN apt-get update && apt-get install -y --no-install-recommends xvfb xauth && apt-get clean
-
-# Install the latest opam release, answering prompts non-interactively.
+    apt-get install --no-install-recommends --yes \
+      autoconf automake autopoint bash bison bzip2 ca-certificates flex \
+      g++ g++-multilib gettext git gperf intltool libc6-dev-i386 \
+      libclang-dev libgdk-pixbuf-2.0-dev libgl-dev libltdl-dev libpcre2-dev \
+      libssl-dev libtool-bin libxml-parser-perl lzip make openssl p7zip-full \
+      patch perl python3 python3-mako python3-packaging python3-pkg-resources \
+      python3-setuptools python-is-python3 ruby sed sqlite3 unzip wget \
+      xz-utils \
+      curl gosu wine xvfb xauth zip && \
+    apt-get clean && rm -rf /var/lib/apt/lists/*
+
+RUN git clone https://github.com/mxe/mxe.git "${MXE_DIR}" && \
+    git -C "${MXE_DIR}" checkout "${MXE_GIT_TAG}"
+
+# settings.mk is gitignored, so it is ours to own. The default target is
+# narrowed so that a bare `make` cannot start building all of MXE.
+RUN printf '%s\n' \
+      "MXE_TARGETS := ${CROSS_TRIPLE}" \
+      'MXE_USE_CCACHE :=' \
+      'LOCAL_PKG_LIST := cc' \
+      '.DEFAULT local-pkg-list:' \
+      'local-pkg-list: $(LOCAL_PKG_LIST)' \
+      > "${MXE_DIR}/settings.mk"
+
+# The cross toolchain, on its own layer: it is the slowest thing here and it
+# only moves when MXE_GIT_TAG does.
+RUN cd "${MXE_DIR}" && make cc
+
+# C libraries needed by the Windows opam packages. Each is a separate layer so
+# that adding one does not rebuild the others; ffmpeg is last because it is the
+# slowest and pulls the largest dependency chain.
+RUN cd "${MXE_DIR}" && make openssl
+RUN cd "${MXE_DIR}" && make curl
+RUN cd "${MXE_DIR}" && make libsrt
+RUN cd "${MXE_DIR}" && make jack
+RUN cd "${MXE_DIR}" && make portaudio
+RUN cd "${MXE_DIR}" && make libsamplerate
+RUN cd "${MXE_DIR}" && make dlfcn-win32
+RUN cd "${MXE_DIR}" && make libao
+RUN cd "${MXE_DIR}" && make ogg
+RUN cd "${MXE_DIR}" && make flac
+RUN cd "${MXE_DIR}" && make vorbis
+RUN cd "${MXE_DIR}" && make opus
+RUN cd "${MXE_DIR}" && make faad2
+RUN cd "${MXE_DIR}" && make lame
+RUN cd "${MXE_DIR}" && make libmad
+RUN cd "${MXE_DIR}" && make fdk-aac
+RUN cd "${MXE_DIR}" && make ffmpeg
+
+# The cross environment the final image also exports. The opam packages are
+# built in this stage, and without it their configure scripts find no
+# x86_64-w64-mingw32.static tools and quietly build for the host. MXE's bin
+# directory is appended, never prepended, so it cannot shadow the host tools
+# opam itself needs.
+ENV PATH="${PATH}:/usr/src/mxe/usr/bin"
+ENV WINEARCH=win64
+ENV CMAKE_TOOLCHAIN_FILE="/usr/src/mxe/usr/x86_64-w64-mingw32.static/share/cmake/mxe-conf.cmake"
+# PKG_CONFIG_PATH_default_windows is this repo's own dune-context convention;
+# an opam package's configure script only reads the real one.
+ENV PKG_CONFIG_PATH="/usr/src/mxe/usr/x86_64-w64-mingw32.static/lib/pkgconfig/"
+ENV TOOLPREF64="/usr/src/mxe/usr/bin/x86_64-w64-mingw32.static-"
+ENV PKG_CONFIG_PATH_default_windows="/usr/src/mxe/usr/x86_64-w64-mingw32.static/lib/pkgconfig/"
+ENV PKG_CONFIG_default_windows="/usr/src/mxe/usr/bin/x86_64-w64-mingw32.static-pkg-config"
+
 RUN printf "\ny\n" | bash -c "sh <(curl -fsSL https://raw.githubusercontent.com/ocaml/opam/master/shell/install.sh)"
 
-# Pre-install opam dependencies so the CI build step only compiles liquidsoap.
+RUN useradd -g staff --create-home opam
 
 USER opam
 
 # Local opam overlay: camomile-embedded is not in opam-cross-windows.
-COPY .github/opam /tmp/opam-overlay
+COPY --chown=opam .github/opam /home/opam/opam-overlay
 
 RUN xvfb-run -a wineboot --init
 
+RUN opam init --auto-setup --disable-sandboxing --compiler="${OCAML_VERSION}" && \
+    opam repository add windows https://github.com/ocaml-cross/opam-cross-windows.git && \
+    opam repository add archive git+https://github.com/ocaml/opam-repository-archive && \
+    opam repository add liquidsoap-devel /home/opam/opam-overlay
+
+RUN eval $(opam env) && \
+    opam install -y ocaml-windows && \
+    opam clean
+
+# Pre-install opam dependencies so the CI build step only compiles liquidsoap.
 RUN eval $(opam env) && \
-    opam repository set-url windows https://github.com/ocaml-cross/opam-cross-windows.git && \
-    opam repo add archive git+https://github.com/ocaml/opam-repository-archive && \
-    opam repo add liquidsoap-devel /tmp/opam-overlay && \
-    opam update && \
-    opam install --deps-only -y /tmp/opam-overlay/liquidsoap-windows.opam && \
+    opam install --deps-only -y /home/opam/opam-overlay/liquidsoap-windows.opam && \
     opam clean
 
 FROM scratch
diff --git a/.github/opam/liquidsoap-windows.opam b/.github/opam/liquidsoap-windows.opam
index de003e361d..9d13179fa0 100644
--- a/.github/opam/liquidsoap-windows.opam
+++ b/.github/opam/liquidsoap-windows.opam
@@ -16,7 +16,7 @@ homepage: "https://github.com/savonet/liquidsoap"
 bug-reports: "https://github.com/savonet/liquidsoap/issues"
 depends: [
   "dune" {>= "3.23"}
-  "ocaml-windows" {>= "5.4"}
+  "ocaml-windows" {>= "5.5"}
   "re" {>= "1.11.0" & < "1.14.0"}
   "re-windows" {>= "1.11.0" & < "1.14.0"}
   "curl-windows"
diff --git a/.github/scripts/build-win32.sh b/.github/scripts/build-win32.sh
index 8aaf253864..346cb00756 100755
--- a/.github/scripts/build-win32.sh
+++ b/.github/scripts/build-win32.sh
@@ -20,19 +20,18 @@ echo "::group::Build liquidsoap-windows"
 
 eval "$(opam env)"
 
-# The CI image lacks the local opam overlay and predates crunch 4.1.0, which
-# camomile-embedded needs to build. Refreshing the windows repo there forces a
-# cross recompile that fails, hence default only; delete both lines once the
-# image is rebuilt.
-opam repo add liquidsoap-devel "${BASE_DIR}/.github/opam"
-opam update --repositories default
-
-# Diagnostic: surface the full dune error, which opam elides from the
-# combined install output.
-opam install -y -v camomile-embedded-windows
+# The image ships the overlay it was built against. Point it at this checkout
+# so a branch changing .github/opam is built with its own packages.
+opam repository set-url liquidsoap-devel "${BASE_DIR}/.github/opam"
+opam update liquidsoap-devel
 
 opam install -y --deps-only .github/opam/liquidsoap-windows.opam
 
+# The image sets PKG_CONFIG_PATH so that the opam packages configure against
+# mxe. Building liquidsoap goes through the dune context instead, and leaving
+# it set enables optional modules whose transitive libraries are not linked.
+unset PKG_CONFIG_PATH
+
 export LIQUIDSOAP_BUILD_VERSION="${TAG}${VERSION}"
 export LIQUIDSOAP_BUILD_TARGET=standalone
 export LIQUIDSOAP_SYS_CONFIG=mingw
diff --git a/.github/scripts/check-mutexed-lazy.sh b/.github/scripts/check-mutexed-lazy.sh
new file mode 100755
index 0000000000..302e2ae1e9
--- /dev/null
+++ b/.github/scripts/check-mutexed-lazy.sh
@@ -0,0 +1,15 @@
+#!/bin/sh
+# Stdlib Lazy is unsafe to force from several threads or domains, which
+# liquidsoap does. Lazy.Mutexed is the safe equivalent.
+
+set -e
+
+[ $# -eq 0 ] && exit 0
+
+if matches=$(grep -nE '\bLazy\.(force|t|from_val|from_fun|is_val)\b' "$@"); then
+  echo "Use Lazy.Mutexed rather than Lazy:"
+  echo "${matches}"
+  exit 1
+fi
+
+exit 0
diff --git a/.github/workflows/build-asan.yml b/.github/workflows/build-asan.yml
index 2d90cad09a..c447243ae1 100644
--- a/.github/workflows/build-asan.yml
+++ b/.github/workflows/build-asan.yml
@@ -6,13 +6,13 @@ on:
       ocaml_version:
         description: "OCaml version"
         required: false
-        default: "5.4.0"
+        default: "5.5.0"
         type: string
   workflow_call:
     inputs:
       ocaml_version:
         required: false
-        default: "5.4.0"
+        default: "5.5.0"
         type: string
     secrets:
       DEPOT_TOKEN:
@@ -22,12 +22,12 @@ jobs:
   build:
     runs-on: ubuntu-24.04
     container:
-      image: ghcr.io/savonet/liquidsoap:ci-asan-${{ inputs.ocaml_version || '5.4.0' }}
+      image: ghcr.io/savonet/liquidsoap:ci-asan-${{ inputs.ocaml_version || '5.5.0' }}
       options: --user root --privileged -v ${{ github.workspace }}/${{ github.run_number }}:/tmp/artifacts
     env:
       HOME: /home/opam
       LIQUIDSOAP_INSTALL_NO_OPTIONAL_FAIL: "true"
-      OCAML_VERSION: ${{ inputs.ocaml_version || '5.4.0' }}
+      OCAML_VERSION: ${{ inputs.ocaml_version || '5.5.0' }}
       BRANCH: ${{ github.head_ref || github.ref_name }}
       ASAN_OPTIONS: "detect_leaks=0:detect_stack_use_after_return=0:detect_container_overflow=0:protect_shadow_gap=0:verify_asan_link_order=0"
       SKIP_SDL: "true"
@@ -52,7 +52,7 @@ jobs:
         id: build_deb
         env:
           GITHUB_SHA: ${{ github.sha }}
-          DOCKER_TAG: debian-testing-asan-ocaml${{ inputs.ocaml_version || '5.4.0' }}
+          DOCKER_TAG: debian-testing-asan-ocaml${{ inputs.ocaml_version || '5.5.0' }}
           BRANCH: ${{ github.head_ref || github.ref_name }}
           LIQ_TMP_DIR: /tmp/artifacts
           PLATFORM: amd64
diff --git a/.github/workflows/build-no-depopts.yml b/.github/workflows/build-no-depopts.yml
index a30cbd70c4..9483893504 100644
--- a/.github/workflows/build-no-depopts.yml
+++ b/.github/workflows/build-no-depopts.yml
@@ -14,7 +14,7 @@ jobs:
   build_no_depopts:
     runs-on: ubuntu-24.04
     container:
-      image: ghcr.io/savonet/liquidsoap:ci-v2-debian_trixie-5.4.0@sha256:1521b53591f846a76affe11cddc69402de41936523339c3fafa8c248fa396f5d
+      image: ghcr.io/savonet/liquidsoap:ci-v2-debian_trixie-5.5.0@sha256:5c9b006dc14a8b81316da0bfa6938780c83797eb7d21f25f1b231bbca5d43d08
       options: --user opam
     env:
       HOME: /home/opam
diff --git a/.github/workflows/build-opam.yml b/.github/workflows/build-opam.yml
index 7a6ffbab55..4f8e212015 100644
--- a/.github/workflows/build-opam.yml
+++ b/.github/workflows/build-opam.yml
@@ -10,8 +10,7 @@ jobs:
       fail-fast: false
       matrix:
         ocaml-compiler:
-          - 5.4.x
-          - 5.x
+          - 5.5.x
     steps:
       - name: Checkout latest code
         uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1
@@ -33,18 +32,18 @@ jobs:
         run: |
           opam install --cli=2.1 --confirm-level=unsafe-yes .
       - name: Install ocamlformat
-        if: matrix.ocaml-compiler == '5.4.x'
+        if: matrix.ocaml-compiler == '5.5.x'
         run: |
           opam install ocamlformat=0.28.1
       - name: Set PY env variable.
-        if: matrix.ocaml-compiler == '5.4.x'
+        if: matrix.ocaml-compiler == '5.5.x'
         run: echo "PY=$(python -VV | sha256sum | cut -d' ' -f1)" >> $GITHUB_ENV
       - name: Restore pre-commit cache
-        if: matrix.ocaml-compiler == '5.4.x'
+        if: matrix.ocaml-compiler == '5.5.x'
         uses: actions/cache@55cc8345863c7cc4c66a329aec7e433d2d1c52a9 # v6.1.0
         with:
           path: ~/.cache/pre-commit
           key: pre-commit|${{ env.PY }}|${{ hashFiles('.pre-commit-config.yaml') }}
       - name: Run pre-commit
-        if: matrix.ocaml-compiler == '5.4.x'
+        if: matrix.ocaml-compiler == '5.5.x'
         uses: pre-commit/action@2c7b3805fd2a0fd8c1884dcaebf91fc102a13ecd # v3.0.1
diff --git a/.github/workflows/build-win32.yml b/.github/workflows/build-win32.yml
index 173e75db07..bf4f69aaef 100644
--- a/.github/workflows/build-win32.yml
+++ b/.github/workflows/build-win32.yml
@@ -23,7 +23,7 @@ jobs:
   build_win32:
     runs-on: ubuntu-24.04
     container:
-      image: ghcr.io/savonet/liquidsoap:ci-v2-win32-x64-5.4.1@sha256:b9dac6d22a7ec55e251ebc32d0bf4fd2c2e75e981dc35ea799bae45e1b105b17
+      image: ghcr.io/savonet/liquidsoap:ci-v2-win32-x64-5.5.0
       options: --user root -v ${{ github.workspace }}/${{ github.run_number }}:/tmp/${{ github.run_number }}
     env:
       IS_SNAPSHOT: ${{ inputs.is_snapshot == 'true' }}
diff --git a/.github/workflows/doc.yml b/.github/workflows/doc.yml
index 4c8eb03984..eb21d3e014 100644
--- a/.github/workflows/doc.yml
+++ b/.github/workflows/doc.yml
@@ -22,7 +22,7 @@ jobs:
   update_doc:
     runs-on: ubuntu-24.04
     container:
-      image: ghcr.io/savonet/liquidsoap:ci-v2-debian_trixie-5.4.0@sha256:1521b53591f846a76affe11cddc69402de41936523339c3fafa8c248fa396f5d
+      image: ghcr.io/savonet/liquidsoap:ci-v2-debian_trixie-5.5.0@sha256:5c9b006dc14a8b81316da0bfa6938780c83797eb7d21f25f1b231bbca5d43d08
       options: --user root -v ${{ github.workspace }}/${{ github.run_number }}:/tmp/${{ github.run_number }}
     env:
       HOME: /home/opam
diff --git a/.github/workflows/docker-ci-asan.yml b/.github/workflows/docker-ci-asan.yml
index 27cd2a581d..6df756b72b 100644
--- a/.github/workflows/docker-ci-asan.yml
+++ b/.github/workflows/docker-ci-asan.yml
@@ -6,7 +6,7 @@ on:
       ocaml_versions:
         description: "OCaml versions (JSON array)"
         required: false
-        default: '["5.4.0"]'
+        default: '["5.5.0"]'
         type: string
       push:
         description: "Push images to registry"
diff --git a/.github/workflows/docker-ci-win32.yml b/.github/workflows/docker-ci-win32.yml
index dc076c2454..592fdf5daa 100644
--- a/.github/workflows/docker-ci-win32.yml
+++ b/.github/workflows/docker-ci-win32.yml
@@ -6,7 +6,7 @@ on:
       ocaml_versions:
         description: "OCaml versions (JSON array)"
         required: false
-        default: '["5.4.1"]'
+        default: '["5.5.0"]'
         type: string
       no_cache:
         description: "Disable Docker layer cache"
@@ -28,6 +28,12 @@ jobs:
         ocaml_version: ${{ fromJSON(inputs.ocaml_versions) }}
     steps:
       - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7
+      - name: Login to GitHub Container Registry
+        uses: docker/login-action@dbcb813823bdd20940b903addbd779551569679f # v4.6.0
+        with:
+          registry: ghcr.io
+          username: ${{ github.actor }}
+          password: ${{ secrets.GITHUB_TOKEN }}
       - name: Set up Depot CLI
         uses: depot/setup-action@91bc8495a33ebfc504ffc89e5674379ccf23c29c # v1.7.2
       - name: Build and push
diff --git a/.github/workflows/js.yml b/.github/workflows/js.yml
index 50b39bca69..c22a5b1f8e 100644
--- a/.github/workflows/js.yml
+++ b/.github/workflows/js.yml
@@ -14,7 +14,7 @@ jobs:
   build_js:
     runs-on: ubuntu-24.04
     container:
-      image: ghcr.io/savonet/liquidsoap:ci-v2-debian_trixie-5.4.0@sha256:1521b53591f846a76affe11cddc69402de41936523339c3fafa8c248fa396f5d
+      image: ghcr.io/savonet/liquidsoap:ci-v2-debian_trixie-5.5.0@sha256:5c9b006dc14a8b81316da0bfa6938780c83797eb7d21f25f1b231bbca5d43d08
       options: --user root
     env:
       HOME: /home/opam
diff --git a/.github/workflows/tests.yml b/.github/workflows/tests.yml
index 549062cdaa..7c18b73804 100644
--- a/.github/workflows/tests.yml
+++ b/.github/workflows/tests.yml
@@ -23,7 +23,7 @@ jobs:
   run_tests:
     runs-on: ubuntu-24.04
     container:
-      image: ghcr.io/savonet/liquidsoap:ci-v2-debian_trixie-5.4.0@sha256:1521b53591f846a76affe11cddc69402de41936523339c3fafa8c248fa396f5d
+      image: ghcr.io/savonet/liquidsoap:ci-v2-debian_trixie-5.5.0@sha256:5c9b006dc14a8b81316da0bfa6938780c83797eb7d21f25f1b231bbca5d43d08
       options: --user root --privileged --ulimit core=-1 --security-opt seccomp=unconfined -v ${{ github.workspace }}/${{ github.run_number }}:/tmp/${{ github.run_number }}
     strategy:
       fail-fast: false
diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml
index 7a817dc12b..c9a8dc21fe 100644
--- a/.pre-commit-config.yaml
+++ b/.pre-commit-config.yaml
@@ -66,6 +66,12 @@ repos:
         entry: koalaman/shellcheck --color=always
         types: [shell]
 
+      - id: mutexed-lazy
+        name: mutexed-lazy
+        language: system
+        entry: .github/scripts/check-mutexed-lazy.sh
+        files: ^src/(core|lang|js|bin)/.*\.mli?$
+
       - id: dunefmt
         name: dunefmt
         language: system
diff --git a/CHANGES.md b/CHANGES.md
index dc7fa0f517..1a54bb0af3 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -3,6 +3,10 @@
 ## New:
 
 - Added `getter(t)` type annotation syntax for getter types (#5078).
+- Added `r.exchange(v)`, which sets a reference and returns the value it replaced in one
+  indivisible step. Now that script code runs on several cores at once, a flag guarding
+  work that must happen only once cannot be read and set separately: two threads both see
+  it unset and both do the work.
 - Added `source.content` operator returning an associative list of frame field names to their content format, `track.format` returning the content format of a single track, and `format.description` returning a typed record description of a content format.
 - Renamed the internal video content type from `canvas` to `yuv420p`, which better reflects the
   actual content; the content itself is still organized as a canvas of `yuv420p` layers. Type
@@ -44,6 +48,20 @@
 
 ## Changed:
 
+- Removed `ref.make` and `ref.map`. Building a reference from a pair of functions gave one
+  that could not offer `exchange` indivisibly, which is what the rest of the language now
+  assumes of a reference.
+- Scheduled work — requests, harbor clients, script callbacks, `thread.run` handlers — is now fully concurrent,
+  taking advantage of OCaml 5's core-based concurrency, so a busy instance keeps up with much more of it at once.
+  Heavy work in a callback or a request resolution no longer stalls playback either.
+- Removed `settings.scheduler.generic_queues`, `settings.scheduler.fast_queues` and
+  `settings.scheduler.non_blocking_queues`: the scheduler sizes itself from the number of cores and there is
+  nothing left to tune. Scripts setting them must drop those lines. `settings.scheduler.blocking_tasks` replaces
+  them, limiting how many slow tasks — request resolutions, `thread.run` handlers, last.fm submissions — may
+  run at once.
+- When the scheduler is busy, quick work is served before slow work: the server, then request resolutions, then
+  long tasks such as last.fm submissions. The order used to be arbitrary and often favoured the slow ones.
+
 - Bindings written without `let` accept the same targets as `let` — destructuring patterns, field paths and type
   annotations — so `(x, y) = (1, 2)`, `r.field = 1` and `(n : int) = 2` are all valid, and an invalid left-hand side
   reports what is allowed instead of a bare syntax error. A leading binding inside the `{ … }` function shorthand
@@ -91,6 +109,12 @@
 
 ## Fixed:
 
+- Error messages naming a type no longer come out with the type missing, which could happen when the error was
+  raised from a callback or a `thread.run` handler.
+- The last lines of the log are no longer lost on shutdown.
+- `time.zone.set` now takes effect. Setting the time zone was silently ignored once anything had already
+  read the local time, which in practice meant always.
+
 - Callbacks a script registers on the sources `switch` and `cross` hand to `on_select`,
   `on_leave` and transition functions are now released when the selection or the crossing
   ends, instead of accumulating on those sources for as long as they live.
diff --git a/doc/content/callbacks.md b/doc/content/callbacks.md
index 2f1bcb97d7..96178f00c5 100644
--- a/doc/content/callbacks.md
+++ b/doc/content/callbacks.md
@@ -37,13 +37,13 @@ external program. In exchange you give up three things:
 - **Timing.** The callback runs shortly after the event, not at it. By then the
   source may have moved on, so use what the callback is handed rather than
   asking the source what it is doing now.
-- **Ordering.** Firings are queued independently and the queues run in parallel,
-  so they can overlap and complete out of order. With the default five generic
-  queues, five copies of a slow callback can be running at once.
-- **Room for other work.** Those queues also resolve requests — downloads,
+- **Ordering.** Firings are scheduled independently and run in parallel, one per
+  core, so they can overlap and complete out of order. Several copies of a slow
+  callback can be running at once.
+- **Room for other work.** The scheduler also resolves requests — downloads,
   playlist reloads. A callback slower than the events feeding it builds a
-  backlog and crowds them out. `settings.scheduler.generic_queues` and
-  `settings.scheduler.fast_queues` control how many queues there are.
+  backlog and crowds them out. `settings.scheduler.blocking_tasks` caps how many
+  such tasks run at once.
 
 When in doubt, ask what the callback does: if it only reads its arguments and
 sets a variable, `synchronous=true`; if it talks to anything outside
diff --git a/doc/content/liq/radiopi.liq b/doc/content/liq/radiopi.liq
index e43e4a0e57..2ff2ac2f20 100644
--- a/doc/content/liq/radiopi.liq
+++ b/doc/content/liq/radiopi.liq
@@ -16,12 +16,6 @@ settings.harbor.bind_addrs.set(["0.0.0.0"])
 # Verbose logs
 log.level.set(4)
 
-# We use the scheduler intensively,
-# therefore we create many queues.
-settings.scheduler.generic_queues.set(5)
-settings.scheduler.fast_queues.set(3)
-settings.scheduler.non_blocking_queues.set(3)
-
 # === Settings ===
 
 # The host to request files
diff --git a/dune-project b/dune-project
index 50d0f2f7b6..1f3dc5d9b3 100644
--- a/dune-project
+++ b/dune-project
@@ -21,7 +21,7 @@
 (package
   (name liquidsoap)
    (depends
-    (ocaml (>= 5.4))
+    (ocaml (>= 5.5))
     base-bytes
     (mm (>= 0.8.6))
     (re (and (>= 1.11.0) (< 1.14.0)))
@@ -126,7 +126,7 @@
 (package
   (name liquidsoap-lang)
   (depends
-    (ocaml (>= 5.4))
+    (ocaml (>= 5.5))
     dune-site
     (re (>= 1.11.0))
     (ppx_string :build)
@@ -142,7 +142,7 @@
 (package
   (name liquidsoap-js)
   (depends
-    (ocaml (>= 5.4))
+    (ocaml (>= 5.5))
     (liquidsoap-lang (= :version))
     js_of_ocaml-ppx
     (js_of_ocaml (>= 5.7.2)))
diff --git a/opam/liquidsoap-js.opam b/opam/liquidsoap-js.opam
index d10a1f8015..43f6fe62f6 100644
--- a/opam/liquidsoap-js.opam
+++ b/opam/liquidsoap-js.opam
@@ -9,7 +9,7 @@ homepage: "https://github.com/savonet/liquidsoap"
 bug-reports: "https://github.com/savonet/liquidsoap/issues"
 depends: [
   "dune" {>= "3.23"}
-  "ocaml" {>= "5.4"}
+  "ocaml" {>= "5.5"}
   "liquidsoap-lang" {= version}
   "js_of_ocaml-ppx"
   "js_of_ocaml" {>= "5.7.2"}
diff --git a/opam/liquidsoap-lang.opam b/opam/liquidsoap-lang.opam
index ffd11fd840..53a3055016 100644
--- a/opam/liquidsoap-lang.opam
+++ b/opam/liquidsoap-lang.opam
@@ -9,7 +9,7 @@ homepage: "https://github.com/savonet/liquidsoap"
 bug-reports: "https://github.com/savonet/liquidsoap/issues"
 depends: [
   "dune" {>= "3.23"}
-  "ocaml" {>= "5.4"}
+  "ocaml" {>= "5.5"}
   "dune-site"
   "re" {>= "1.11.0"}
   "ppx_string" {build}
diff --git a/opam/liquidsoap.opam b/opam/liquidsoap.opam
index 83f8710294..3f0b4a75be 100644
--- a/opam/liquidsoap.opam
+++ b/opam/liquidsoap.opam
@@ -17,7 +17,7 @@ homepage: "https://github.com/savonet/liquidsoap"
 bug-reports: "https://github.com/savonet/liquidsoap/issues"
 depends: [
   "dune" {>= "3.23"}
-  "ocaml" {>= "5.4"}
+  "ocaml" {>= "5.5"}
   "base-bytes"
   "mm" {>= "0.8.6"}
   "re" {>= "1.11.0" & < "1.14.0"}
diff --git a/src/bin/runtime/main.ml b/src/bin/runtime/main.ml
index e43f266b09..ddad3a4368 100644
--- a/src/bin/runtime/main.ml
+++ b/src/bin/runtime/main.ml
@@ -46,7 +46,7 @@ let run_streams = ref true
 let allow_root =
   Dtools.Conf.bool
     ~p:(Configure.conf_init#plug "allow_root")
-    ~d:(Lazy.force Utils.is_docker)
+    ~d:(Lazy.Mutexed.force Utils.is_docker)
     "Do not warn when liquidsoap is run as root"
     ~comments:
       [
@@ -135,7 +135,8 @@ let eval () =
   Lifecycle.load ();
   (* Register settings module. Needs to be done last to make sure every
      dependent OCaml module has been linked. *)
-  Stdlib.Lazy.force Liquidsoap_builtins.Builtins_settings.settings_module;
+  Stdlib.Lazy.Mutexed.force
+    Liquidsoap_builtins.Builtins_settings.settings_module;
   let scripts = Queue.flush_elements to_load in
   let script =
     String.concat "\n"
@@ -669,6 +670,10 @@ let () =
            daemonization facility such as `systemd` or `launchd` instead.")
 
 let daemonize () =
+  (* Forking is refused by the runtime once a domain exists, and the scheduler
+     spawns its own. *)
+  if Tutils.scheduler_started () then
+    failwith "Cannot daemonize once the scheduler has started!";
   Dtools.Log.conf_stdout#set false;
   (* Change user.. *)
   let conf_daemon_change_user =
diff --git a/src/core/builtins/builtins_settings.ml b/src/core/builtins/builtins_settings.ml
index dd65daf171..27e5f99c6c 100644
--- a/src/core/builtins/builtins_settings.ml
+++ b/src/core/builtins/builtins_settings.ml
@@ -43,125 +43,125 @@ let dtools_constr =
 (* Return a lazy variable, to be executed when all dependent
    OCaml modules have been linked. *)
 let settings_module =
-  lazy
-    (let get_conf_type conf =
-       let is_type fn =
-         try
-           ignore (fn conf);
-           true
-         with _ -> false
-       in
-       let has_default_value fn =
-         try
-           ignore (fn conf)#get;
-           true
-         with _ -> false
-       in
-       if is_type Dtools.Conf.as_unit then (Lang.unit_t, false)
-       else if is_type Dtools.Conf.as_int then
-         (Lang.int_t, has_default_value Dtools.Conf.as_int)
-       else if is_type Dtools.Conf.as_float then
-         (Lang.float_t, has_default_value Dtools.Conf.as_float)
-       else if is_type Dtools.Conf.as_bool then
-         (Lang.bool_t, has_default_value Dtools.Conf.as_bool)
-       else if is_type Dtools.Conf.as_string then
-         (Lang.string_t, has_default_value Dtools.Conf.as_string)
-       else if is_type Dtools.Conf.as_list then
-         (Lang.list_t Lang.string_t, has_default_value Dtools.Conf.as_list)
-       else (Lang.unit_t, false)
-     in
-     let set_t ty =
-       [
-         ("description", ([], Lang.string_t), "Description of the setting");
-         ( "comments",
-           ([], Lang.string_t),
-           "Additional comments about the setting" );
-       ]
-       @
-       if ty = Lang.unit_t then []
-       else
-         [
-           ( "set",
-             ([], Lang.fun_t [(false, "", ty)] Lang.unit_t),
-             "Set configuration value" );
-         ]
-     in
-     let get_t ~has_default_value ty =
-       match (ty, has_default_value) with
-         | ty, _ when ty = Lang.unit_t -> Lang.unit_t
-         | ty, true -> Lang.fun_t [] ty
-         | ty, false -> Lang.fun_t [] (Lang.nullable_t ty)
-     in
-     let rec get_type ?(sub = []) conf =
-       let ty, has_default_value = get_conf_type conf in
-       Lang.method_t
-         (get_t ~has_default_value ty)
-         (set_t ty @ leaf_types conf @ sub)
-     and leaf_types conf =
-       List.map
-         (fun label ->
-           let ty = get_type (conf#path [label]) in
-           let label = Utils.normalize_parameter_string label in
-           ( label,
-             ([], ty),
-             Printf.sprintf "Entry for configuration key %s" label ))
-         conf#subs
-     in
-     let settings_t = get_type Configure.conf in
-     let get_v fn conv_to conv_from conf =
-       let get =
-         Lang.val_fun [] (fun _ ->
-             try conv_to (fn conf)#get with _ -> Lang.null)
-       in
-       let set =
-         Lang.val_fun
-           [("", "", None)]
-           (fun p ->
-             (fn conf)#set (conv_from (List.assoc "" p));
-             Lang.unit)
-       in
-       (get, Some set)
-     in
-     let rec get_value ?(sub = []) conf =
-       let to_v fn conv_to conv_from =
-         try
-           ignore (fn conf);
-           raise (Found (get_v fn conv_to conv_from conf))
-         with
-           | Found v -> raise (Found v)
-           | _ -> ()
-       in
-       let get_v, set_v =
-         try
-           to_v Dtools.Conf.as_int Lang.int Lang.to_int;
-           to_v Dtools.Conf.as_float Lang.float Lang.to_float;
-           to_v Dtools.Conf.as_bool Lang.bool Lang.to_bool;
-           to_v Dtools.Conf.as_string Lang.string Lang.to_string;
-           to_v Dtools.Conf.as_list
-             (fun l -> Lang.list (List.map Lang.string l))
-             (fun v -> List.map Lang.to_string (Lang.to_list v));
-           (Lang.unit, None)
-         with Found v -> v
-       in
-       Lang.meth get_v
-         ((if set_v <> None then [("set", Option.get set_v)] else [])
-         @ [
-             ("description", Lang.string (String.trim conf#descr));
-             ( "comments",
-               Lang.string (String.trim (String.concat "" conf#comments)) );
-           ]
-         @ leaf_values conf @ sub)
-     and leaf_values conf =
-       List.map
-         (fun label ->
-           let v = get_value (conf#path [label]) in
-           (Utils.normalize_parameter_string label, v))
-         conf#subs
-     in
-     settings := get_value Configure.conf;
-     ignore
-       (Lang.add_builtin_value ~category:`Settings "settings"
-          ~descr:"All settings." ~flags:[`Hidden] !settings settings_t))
+  Lazy.Mutexed.from_fun (fun () ->
+      let get_conf_type conf =
+        let is_type fn =
+          try
+            ignore (fn conf);
+            true
+          with _ -> false
+        in
+        let has_default_value fn =
+          try
+            ignore (fn conf)#get;
+            true
+          with _ -> false
+        in
+        if is_type Dtools.Conf.as_unit then (Lang.unit_t, false)
+        else if is_type Dtools.Conf.as_int then
+          (Lang.int_t, has_default_value Dtools.Conf.as_int)
+        else if is_type Dtools.Conf.as_float then
+          (Lang.float_t, has_default_value Dtools.Conf.as_float)
+        else if is_type Dtools.Conf.as_bool then
+          (Lang.bool_t, has_default_value Dtools.Conf.as_bool)
+        else if is_type Dtools.Conf.as_string then
+          (Lang.string_t, has_default_value Dtools.Conf.as_string)
+        else if is_type Dtools.Conf.as_list then
+          (Lang.list_t Lang.string_t, has_default_value Dtools.Conf.as_list)
+        else (Lang.unit_t, false)
+      in
+      let set_t ty =
+        [
+          ("description", ([], Lang.string_t), "Description of the setting");
+          ( "comments",
+            ([], Lang.string_t),
+            "Additional comments about the setting" );
+        ]
+        @
+        if ty = Lang.unit_t then []
+        else
+          [
+            ( "set",
+              ([], Lang.fun_t [(false, "", ty)] Lang.unit_t),
+              "Set configuration value" );
+          ]
+      in
+      let get_t ~has_default_value ty =
+        match (ty, has_default_value) with
+          | ty, _ when ty = Lang.unit_t -> Lang.unit_t
+          | ty, true -> Lang.fun_t [] ty
+          | ty, false -> Lang.fun_t [] (Lang.nullable_t ty)
+      in
+      let rec get_type ?(sub = []) conf =
+        let ty, has_default_value = get_conf_type conf in
+        Lang.method_t
+          (get_t ~has_default_value ty)
+          (set_t ty @ leaf_types conf @ sub)
+      and leaf_types conf =
+        List.map
+          (fun label ->
+            let ty = get_type (conf#path [label]) in
+            let label = Utils.normalize_parameter_string label in
+            ( label,
+              ([], ty),
+              Printf.sprintf "Entry for configuration key %s" label ))
+          conf#subs
+      in
+      let settings_t = get_type Configure.conf in
+      let get_v fn conv_to conv_from conf =
+        let get =
+          Lang.val_fun [] (fun _ ->
+              try conv_to (fn conf)#get with _ -> Lang.null)
+        in
+        let set =
+          Lang.val_fun
+            [("", "", None)]
+            (fun p ->
+              (fn conf)#set (conv_from (List.assoc "" p));
+              Lang.unit)
+        in
+        (get, Some set)
+      in
+      let rec get_value ?(sub = []) conf =
+        let to_v fn conv_to conv_from =
+          try
+            ignore (fn conf);
+            raise (Found (get_v fn conv_to conv_from conf))
+          with
+            | Found v -> raise (Found v)
+            | _ -> ()
+        in
+        let get_v, set_v =
+          try
+            to_v Dtools.Conf.as_int Lang.int Lang.to_int;
+            to_v Dtools.Conf.as_float Lang.float Lang.to_float;
+            to_v Dtools.Conf.as_bool Lang.bool Lang.to_bool;
+            to_v Dtools.Conf.as_string Lang.string Lang.to_string;
+            to_v Dtools.Conf.as_list
+              (fun l -> Lang.list (List.map Lang.string l))
+              (fun v -> List.map Lang.to_string (Lang.to_list v));
+            (Lang.unit, None)
+          with Found v -> v
+        in
+        Lang.meth get_v
+          ((if set_v <> None then [("set", Option.get set_v)] else [])
+          @ [
+              ("description", Lang.string (String.trim conf#descr));
+              ( "comments",
+                Lang.string (String.trim (String.concat "" conf#comments)) );
+            ]
+          @ leaf_values conf @ sub)
+      and leaf_values conf =
+        List.map
+          (fun label ->
+            let v = get_value (conf#path [label]) in
+            (Utils.normalize_parameter_string label, v))
+          conf#subs
+      in
+      settings := get_value Configure.conf;
+      ignore
+        (Lang.add_builtin_value ~category:`Settings "settings"
+           ~descr:"All settings." ~flags:[`Hidden] !settings settings_t))
 
 (** Hack to keep track of latest settings at runtime. *)
 let _ =
diff --git a/src/core/builtins/builtins_source.ml b/src/core/builtins/builtins_source.ml
index 690cf70a47..d38483353d 100644
--- a/src/core/builtins/builtins_source.ml
+++ b/src/core/builtins/builtins_source.ml
@@ -149,7 +149,7 @@ let _ =
     (fun p ->
       let s = Lang.to_source (List.assoc "" p) in
       let ticks = Clock.ticks s#clock in
-      let frame_position = Lazy.force Frame.duration *. float ticks in
+      let frame_position = Lazy.Mutexed.force Frame.duration *. float ticks in
       Lang.float frame_position)
 
 let _ =
diff --git a/src/core/builtins/builtins_time.ml b/src/core/builtins/builtins_time.ml
index e37a922d7c..d2e121e983 100644
--- a/src/core/builtins/builtins_time.ml
+++ b/src/core/builtins/builtins_time.ml
@@ -169,7 +169,7 @@ let _ =
             (Printf.sprintf "Failed to parse %s as time predicate" predicate)
           ~pos:(Lang.pos p) "string")
 
-let _ =
+let time_zone =
   let tz_t =
     Lang.method_t Lang.string_t
       [
@@ -187,6 +187,19 @@ let _ =
       Lang.meth (Lang.string std)
         [("daylight", Lang.string dst); ("utc_diff", Lang.int tz)])
 
+let _ =
+  Lang.add_builtin ~category:`Time ~base:time_zone "set"
+    ~descr:
+      "Set the time zone for the running process. This is equivalent to \
+       setting the `TZ` environment variable, except that it takes effect \
+       immediately."
+    [("", Lang.string_t, None, Some "Time zone, e.g. `\"Europe/Paris\"`.")]
+    Lang.unit_t
+    (fun p ->
+      Unix.putenv "TZ" (Lang.to_string (List.assoc "" p));
+      Utils.tzset ();
+      Lang.unit)
+
 let _ =
   Lang.add_builtin ~category:`Time ~base:time "string"
     ~descr:
diff --git a/src/core/clock/clock.ml b/src/core/clock/clock.ml
index 5ba51a78df..7d328f143b 100644
--- a/src/core/clock/clock.ml
+++ b/src/core/clock/clock.ml
@@ -197,7 +197,7 @@ type source =
       (old:sync_source option -> sync_source option -> unit) -> unit -> unit >
 
 let self_sync_type_of_sources sources =
-  Lazy.from_fun (fun () ->
+  Lazy.Mutexed.from_fun (fun () ->
       if List.exists (fun s -> fst s#self_sync = `Dynamic) sources then `Dynamic
       else `Static)
 
@@ -220,8 +220,9 @@ let self_sync_of_sources sources =
         (fun { sync_source = s } { sync_source = s' } -> Stdlib.compare s s')
         sync_sources
     with
-      | [] -> (Lazy.force self_sync_type, None)
-      | [{ sync_source }] -> (Lazy.force self_sync_type, Some sync_source)
+      | [] -> (Lazy.Mutexed.force self_sync_type, None)
+      | [{ sync_source }] ->
+          (Lazy.Mutexed.force self_sync_type, Some sync_source)
       | sync_sources ->
           raise
             (Sync_error { name = source#id; stack = source#stack; sync_sources })
@@ -1256,7 +1257,7 @@ let rec _start ?force ~c clock =
   let module Time = (val time_implementation : Liq_time.T) in
   let params =
     {
-      frame_duration = Lazy.force Frame.duration;
+      frame_duration = Lazy.Mutexed.force Frame.duration;
       current_sync_source = None;
       sync_source_entries = [];
       log_delay = conf_log_delay#get;
diff --git a/src/core/clock/clock.mli b/src/core/clock/clock.mli
index 4783587c00..f36bde11bb 100644
--- a/src/core/clock/clock.mli
+++ b/src/core/clock/clock.mli
@@ -141,7 +141,7 @@ val self_sync_of_sources :
 
 (** [`Dynamic] as soon as one of the sources is, [`Static] otherwise. *)
 val self_sync_type_of_sources :
-  < self_sync : self_sync ; .. > list -> [ `Static | `Dynamic ] Lazy.t
+  < self_sync : self_sync ; .. > list -> [ `Static | `Dynamic ] Lazy.Mutexed.t
 
 (** Sync mode of a clock:
     - [`Automatic]: the clock delegates latency control to its current sync
diff --git a/src/core/decoders/image_decoder.ml b/src/core/decoders/image_decoder.ml
index 88bbb10e89..061cb0ee6d 100644
--- a/src/core/decoders/image_decoder.ml
+++ b/src/core/decoders/image_decoder.ml
@@ -29,8 +29,8 @@ let log = Log.make ["image"; "decoder"]
 (** Function to retrieve width an height from parameters. *)
 let wh iw ih w h =
   let frame_w, frame_h = Frame.video_dimensions () in
-  let frame_w = Lazy.force frame_w in
-  let frame_h = Lazy.force frame_h in
+  let frame_w = Lazy.Mutexed.force frame_w in
+  let frame_h = Lazy.Mutexed.force frame_h in
   match (w, h) with
     | None, None ->
         (* By default resize anamorphically to the maximum size wrt the frame *)
@@ -50,8 +50,8 @@ let wh iw ih w h =
 
 let wh_string iw ih w h =
   let frame_w, frame_h = Frame.video_dimensions () in
-  let frame_w = Lazy.force frame_w in
-  let frame_h = Lazy.force frame_h in
+  let frame_w = Lazy.Mutexed.force frame_w in
+  let frame_h = Lazy.Mutexed.force frame_h in
   let f d i l =
     if l = "" then None
     else if l.[String.length l - 1] = '%' then (
@@ -70,8 +70,8 @@ let wh_string iw ih w h =
    anymore (for instance to have a scrolling image). *)
 let off_string iw ih ox oy =
   let frame_w, frame_h = Frame.video_dimensions () in
-  let frame_w = Lazy.force frame_w in
-  let frame_h = Lazy.force frame_h in
+  let frame_w = Lazy.Mutexed.force frame_w in
+  let frame_h = Lazy.Mutexed.force frame_h in
   let f d frame l =
     if l = "" then d
     else if l.[String.length l - 1] = '%' then (
diff --git a/src/core/decoders/midi_decoder.ml b/src/core/decoders/midi_decoder.ml
index c7f78ee333..4533025d68 100644
--- a/src/core/decoders/midi_decoder.ml
+++ b/src/core/decoders/midi_decoder.ml
@@ -50,7 +50,7 @@ let decoder ~ctype file =
     let m = Content.Midi.get_data (Frame.get frame Frame.Fields.midi) in
     let r =
       close_on_err
-        (fun () -> fd#read (Lazy.force Frame.midi_rate) m 0 length)
+        (fun () -> fd#read (Lazy.Mutexed.force Frame.midi_rate) m 0 length)
         ()
     in
     Frame.set_data (Frame.slice frame r) Frame.Fields.midi
diff --git a/src/core/encoder/avi_encoder.ml b/src/core/encoder/avi_encoder.ml
index e171992587..3096a2f0f1 100644
--- a/src/core/encoder/avi_encoder.ml
+++ b/src/core/encoder/avi_encoder.ml
@@ -31,7 +31,7 @@ let log = Log.make ["avi"; "encoder"]
 let encode_frame ~channels ~samplerate ~width ~height ~converter frame =
   let target_width = width in
   let target_height = height in
-  let ratio = float samplerate /. float (Lazy.force Frame.audio_rate) in
+  let ratio = float samplerate /. float (Lazy.Mutexed.force Frame.audio_rate) in
   let audio =
     let alen = AFrame.position frame in
     let pcm = AFrame.pcm frame in
@@ -90,10 +90,10 @@ let encode_frame ~channels ~samplerate ~width ~height ~converter frame =
 
 let encoder avi =
   let channels = avi.channels in
-  let samplerate = Lazy.force avi.samplerate in
+  let samplerate = Lazy.Mutexed.force avi.samplerate in
   let converter = Audio_converter.Samplerate.create channels in
-  let width = Lazy.force avi.width in
-  let height = Lazy.force avi.height in
+  let width = Lazy.Mutexed.force avi.width in
+  let height = Lazy.Mutexed.force avi.height in
   log#info "Encoding at %dx%d, %d channels, %d Hz.%!" width height channels
     samplerate;
   (* TODO: use duration *)
diff --git a/src/core/encoder/avi_format.ml b/src/core/encoder/avi_format.ml
index dcceffac7d..c004b997c3 100644
--- a/src/core/encoder/avi_format.ml
+++ b/src/core/encoder/avi_format.ml
@@ -24,13 +24,15 @@ type t = {
   (* Samplerate is lazy in order to avoid forcing the evaluation of the
      samplerate at typing time, see #933. For channels this is pointless since
      we really need that for typing. *)
-  samplerate : int Lazy.t;
+  samplerate : int Lazy.Mutexed.t;
   channels : int;
-  width : int Lazy.t;
-  height : int Lazy.t;
+  width : int Lazy.Mutexed.t;
+  height : int Lazy.Mutexed.t;
 }
 
 let to_string w =
   Printf.sprintf "%%avi(samplerate=%d,channels=%d,width=%d,height=%d)"
-    (Lazy.force w.samplerate) w.channels (Lazy.force w.width)
-    (Lazy.force w.height)
+    (Lazy.Mutexed.force w.samplerate)
+    w.channels
+    (Lazy.Mutexed.force w.width)
+    (Lazy.Mutexed.force w.height)
diff --git a/src/core/encoder/encoder.ml b/src/core/encoder/encoder.ml
index 8dff8a8a19..a182658cfb 100644
--- a/src/core/encoder/encoder.ml
+++ b/src/core/encoder/encoder.ml
@@ -64,9 +64,9 @@ let type_of_format f =
     | Shine m -> audio_type m.Shine_format.channels
     | NDI { audio = false; video = false } -> assert false
     | NDI { audio = true; video = false } ->
-        audio_type (Lazy.force Frame.audio_channels)
+        audio_type (Lazy.Mutexed.force Frame.audio_channels)
     | NDI { audio = true; video = true } ->
-        audio_video_type (Lazy.force Frame.audio_channels)
+        audio_video_type (Lazy.Mutexed.force Frame.audio_channels)
     | NDI { audio = false; video = true } -> video_type ()
     | Flac m -> audio_type m.Flac_format.channels
     | Ffmpeg m ->
@@ -103,7 +103,7 @@ let type_of_format f =
                     let params =
                       {
                         Content.Audio.channel_layout =
-                          Lazy.from_val
+                          Lazy.Mutexed.from_val
                             (Audio_converter.Channel_layout.layout_of_channels
                                channels);
                       }
@@ -166,7 +166,7 @@ let string_of_format = function
 
 let video_size = function
   | Ogg { Ogg_format.video = Some { Theora_format.width; height } } ->
-      Some (Lazy.force width, Lazy.force height)
+      Some (Lazy.Mutexed.force width, Lazy.Mutexed.force height)
   | Ffmpeg m -> (
       match
         List.fold_left
@@ -177,7 +177,8 @@ let video_size = function
               | _ -> cur)
           [] m.Ffmpeg_format.streams
       with
-        | (width, height) :: [] -> Some (Lazy.force width, Lazy.force height)
+        | (width, height) :: [] ->
+            Some (Lazy.Mutexed.force width, Lazy.Mutexed.force height)
         | _ -> None)
   | _ -> None
 
diff --git a/src/core/encoder/encoder_utils.ml b/src/core/encoder/encoder_utils.ml
index 0b07a52593..7e7cd1c460 100644
--- a/src/core/encoder/encoder_utils.ml
+++ b/src/core/encoder/encoder_utils.ml
@@ -24,14 +24,15 @@
 let render_mpeg2_timestamp =
   let mpeg2_timestamp_unit = 90000. in
   let frame_len =
-    Lazy.from_fun (fun () ->
+    Lazy.Mutexed.from_fun (fun () ->
         Int64.of_float
-          (Frame.seconds_of_main (Lazy.force Frame.size) *. mpeg2_timestamp_unit))
+          (Frame.seconds_of_main (Lazy.Mutexed.force Frame.size)
+          *. mpeg2_timestamp_unit))
   in
   fun ~frame_position ~sample_position () ->
     let buf = Buffer.create 10 in
     let frame_position =
-      Int64.mul (Lazy.force frame_len) (Int64.of_int frame_position)
+      Int64.mul (Lazy.Mutexed.force frame_len) (Int64.of_int frame_position)
     in
     let sample_position =
       Int64.of_float
diff --git a/src/core/encoder/external_encoder.ml b/src/core/encoder/external_encoder.ml
index 191d0984fa..67b6b1ad9e 100644
--- a/src/core/encoder/external_encoder.ml
+++ b/src/core/encoder/external_encoder.ml
@@ -48,14 +48,14 @@ let encoder id ext =
   let header =
     if ext.video <> None then (
       let width, height = Option.get ext.video in
-      let width = Lazy.force width in
-      let height = Lazy.force height in
+      let width = Lazy.Mutexed.force width in
+      let height = Lazy.Mutexed.force height in
       Avi.header ~width ~height ~channels:ext.channels
-        ~samplerate:(Lazy.force ext.samplerate)
+        ~samplerate:(Lazy.Mutexed.force ext.samplerate)
         ())
     else if ext.header then
       Wav_aiff.wav_header ~channels:ext.channels
-        ~sample_rate:(Lazy.force ext.samplerate)
+        ~sample_rate:(Lazy.Mutexed.force ext.samplerate)
         ~sample_size:16 ()
     else ""
   in
@@ -112,16 +112,17 @@ let encoder id ext =
   in
   let converter = Audio_converter.Samplerate.create ext.channels in
   let ratio =
-    float (Lazy.force ext.samplerate) /. float (Frame.audio_of_seconds 1.)
+    float (Lazy.Mutexed.force ext.samplerate)
+    /. float (Frame.audio_of_seconds 1.)
   in
   let encode frame =
     let channels = ext.channels in
-    let samplerate = Lazy.force ext.samplerate in
+    let samplerate = Lazy.Mutexed.force ext.samplerate in
     let sbuf =
       if ext.video <> None then (
         let width, height = Option.get ext.video in
-        let width = Lazy.force width in
-        let height = Lazy.force height in
+        let width = Lazy.Mutexed.force width in
+        let height = Lazy.Mutexed.force height in
         Avi_encoder.encode_frame ~channels ~samplerate ~converter ~width ~height
           frame)
       else (
diff --git a/src/core/encoder/external_encoder_format.ml b/src/core/encoder/external_encoder_format.ml
index f472657906..b38810d6f2 100644
--- a/src/core/encoder/external_encoder_format.ml
+++ b/src/core/encoder/external_encoder_format.ml
@@ -26,8 +26,8 @@ type restart_condition = Delay of int | Metadata | No_condition
 
 type t = {
   channels : int;
-  samplerate : int Lazy.t;
-  video : (int Lazy.t * int Lazy.t) option;
+  samplerate : int Lazy.Mutexed.t;
+  video : (int Lazy.Mutexed.t * int Lazy.Mutexed.t) option;
   header : bool;
   restart_on_crash : bool;
   restart : restart_condition;
@@ -45,11 +45,13 @@ let to_string e =
     match e.video with
       | None -> "video=false"
       | Some (w, h) ->
-          Printf.sprintf "video=true,width=%d,height=%d" (Lazy.force w)
-            (Lazy.force h)
+          Printf.sprintf "video=true,width=%d,height=%d" (Lazy.Mutexed.force w)
+            (Lazy.Mutexed.force h)
   in
   Printf.sprintf
     "%%external(channels=%i,samplerate=%i,%s,header=%b,restart_on_crash=%b,%s,process=%s)"
-    e.channels (Lazy.force e.samplerate) video e.header e.restart_on_crash
+    e.channels
+    (Lazy.Mutexed.force e.samplerate)
+    video e.header e.restart_on_crash
     (string_of_restart_condition e.restart)
     e.process
diff --git a/src/core/encoder/fdkaac_format.ml b/src/core/encoder/fdkaac_format.ml
index 5c3203a136..b5865fcd5d 100644
--- a/src/core/encoder/fdkaac_format.ml
+++ b/src/core/encoder/fdkaac_format.ml
@@ -34,7 +34,7 @@ type t = {
   bitrate_mode : bitrate_mode;
   bitrate : int;
   channels : int;
-  samplerate : int Lazy.t;
+  samplerate : int Lazy.Mutexed.t;
   sbr_mode : bool;
   transmux : transmux;
 }
@@ -86,7 +86,8 @@ let to_string m =
   Printf.sprintf
     "%%fdkaac(afterburner=%b,aot=%S,%s,channels=%d,samplerate=%d,sbr_mode=%b,transmux=%S)"
     m.afterburner (string_of_aot m.aot) br_info m.channels
-    (Lazy.force m.samplerate) m.sbr_mode
+    (Lazy.Mutexed.force m.samplerate)
+    m.sbr_mode
     (string_of_transmux m.transmux)
 
 let bitrate m = m.bitrate * 1000
diff --git a/src/core/encoder/ffmpeg_format.ml b/src/core/encoder/ffmpeg_format.ml
index d30b4893a4..9e28ad47b0 100644
--- a/src/core/encoder/ffmpeg_format.ml
+++ b/src/core/encoder/ffmpeg_format.ml
@@ -38,14 +38,14 @@ let string_of_hwaccel = function
 type audio_options = {
   pcm_kind : Content.kind;
   channels : int;
-  samplerate : int Lazy.t;
+  samplerate : int Lazy.Mutexed.t;
   sample_format : string option;
 }
 
 type video_options = {
-  framerate : int Lazy.t;
-  width : int Lazy.t;
-  height : int Lazy.t;
+  framerate : int Lazy.Mutexed.t;
+  width : int Lazy.Mutexed.t;
+  height : int Lazy.Mutexed.t;
   pixel_format : string option;
   alpha : bool option;
   hwaccel : hwaccel;
@@ -133,11 +133,11 @@ let to_string m =
                      Hashtbl.replace stream_opts "codec" (`String codec))
                    codec);
               Hashtbl.replace stream_opts "framerate"
-                (`Int (Lazy.force options.framerate));
+                (`Int (Lazy.Mutexed.force options.framerate));
               Hashtbl.replace stream_opts "width"
-                (`Int (Lazy.force options.width));
+                (`Int (Lazy.Mutexed.force options.width));
               Hashtbl.replace stream_opts "height"
-                (`Int (Lazy.force options.height));
+                (`Int (Lazy.Mutexed.force options.height));
               Hashtbl.replace stream_opts "hwaccel"
                 (`Var (string_of_hwaccel options.hwaccel));
               Hashtbl.replace stream_opts "hwaccel_device"
@@ -158,7 +158,7 @@ let to_string m =
                    codec);
               Hashtbl.replace stream_opts "channels" (`Int options.channels);
               Hashtbl.replace stream_opts "samplerate"
-                (`Int (Lazy.force options.samplerate));
+                (`Int (Lazy.Mutexed.force options.samplerate));
               Printf.sprintf "%s(%s%s)" name
                 (if Re.Pcre.pmatch ~rex:(Re.Pcre.regexp "audio") name then ""
                  else "audio_content,")
diff --git a/src/core/encoder/flac_format.ml b/src/core/encoder/flac_format.ml
index 4d3c63028b..e8ebbf674e 100644
--- a/src/core/encoder/flac_format.ml
+++ b/src/core/encoder/flac_format.ml
@@ -23,7 +23,7 @@
 type t = {
   channels : int;
   bits_per_sample : int;
-  samplerate : int Lazy.t;
+  samplerate : int Lazy.Mutexed.t;
   compression : int;
   fill : int option;
 }
@@ -31,4 +31,6 @@ type t = {
 let to_string m =
   Printf.sprintf
     "%%flac(channels=%i,bits_per_sample=%i,samplerate=%d,compression=%i)"
-    m.channels m.bits_per_sample (Lazy.force m.samplerate) m.compression
+    m.channels m.bits_per_sample
+    (Lazy.Mutexed.force m.samplerate)
+    m.compression
diff --git a/src/core/encoder/lang_avi.ml b/src/core/encoder/lang_avi.ml
index c56782aa1c..a9d783d713 100644
--- a/src/core/encoder/lang_avi.ml
+++ b/src/core/encoder/lang_avi.ml
@@ -40,11 +40,11 @@ let make params =
         | `Labelled ("channels", Int { value = c }) ->
             { f with Avi_format.channels = c }
         | `Labelled ("samplerate", Int { value = i; _ }) ->
-            { f with Avi_format.samplerate = Lazy.from_val i }
+            { f with Avi_format.samplerate = Lazy.Mutexed.from_val i }
         | `Labelled ("width", Int { value = i; _ }) ->
-            { f with Avi_format.width = Lazy.from_val i }
+            { f with Avi_format.width = Lazy.Mutexed.from_val i }
         | `Labelled ("height", Int { value = i; _ }) ->
-            { f with Avi_format.height = Lazy.from_val i }
+            { f with Avi_format.height = Lazy.Mutexed.from_val i }
         | t -> Lang_encoder.raise_generic_error t)
       defaults params
   in
diff --git a/src/core/encoder/lang_external_encoder.ml b/src/core/encoder/lang_external_encoder.ml
index 75931b8659..b7630d9478 100644
--- a/src/core/encoder/lang_external_encoder.ml
+++ b/src/core/encoder/lang_external_encoder.ml
@@ -65,7 +65,10 @@ let make params =
         | `Labelled ("channels", Value.Int { value = c }) ->
             { f with External_encoder_format.channels = c }
         | `Labelled ("samplerate", Value.Int { value = i; _ }) ->
-            { f with External_encoder_format.samplerate = Lazy.from_val i }
+            {
+              f with
+              External_encoder_format.samplerate = Lazy.Mutexed.from_val i;
+            }
         | `Labelled ("video", Value.Bool { value = b; _ }) ->
             let w, h =
               match f.External_encoder_format.video with
@@ -82,7 +85,7 @@ let make params =
                 | None -> Frame.video_dimensions ()
                 | Some (w, h) -> (w, h)
             in
-            let w = Lazy.from_val w in
+            let w = Lazy.Mutexed.from_val w in
             { f with External_encoder_format.video = Some (w, h) }
         | `Labelled ("height", Int { value = h }) ->
             let w, _ =
@@ -90,7 +93,7 @@ let make params =
                 | None -> Frame.video_dimensions ()
                 | Some (w, h) -> (w, h)
             in
-            let h = Lazy.from_val h in
+            let h = Lazy.Mutexed.from_val h in
             { f with External_encoder_format.video = Some (w, h) }
         | `Labelled ("header", Bool { value = h }) ->
             { f with External_encoder_format.header = h }
diff --git a/src/core/encoder/lang_fdkaac.ml b/src/core/encoder/lang_fdkaac.ml
index 18bcf26e2e..1569afa831 100644
--- a/src/core/encoder/lang_fdkaac.ml
+++ b/src/core/encoder/lang_fdkaac.ml
@@ -42,8 +42,8 @@ let make params =
     ]
   in
   let check_samplerate ~pos i =
-    Lazy.from_fun (fun () ->
-        let i = Lazy.force i in
+    Lazy.Mutexed.from_fun (fun () ->
+        let i = Lazy.Mutexed.force i in
         if not (List.mem i valid_samplerates) then (
           let err =
             Printf.sprintf "invalid samplerate value. Possible values: %s"
@@ -104,7 +104,8 @@ let make params =
         | `Labelled ("samplerate", Value.Int { value = i; pos }) ->
             {
               f with
-              Fdkaac_format.samplerate = check_samplerate ~pos (Lazy.from_val i);
+              Fdkaac_format.samplerate =
+                check_samplerate ~pos (Lazy.Mutexed.from_val i);
             }
         | `Labelled ("sbr_mode", Value.Bool { value = b; _ }) ->
             { f with Fdkaac_format.sbr_mode = b }
diff --git a/src/core/encoder/lang_flac.ml b/src/core/encoder/lang_flac.ml
index 1afc8b3487..adb891f054 100644
--- a/src/core/encoder/lang_flac.ml
+++ b/src/core/encoder/lang_flac.ml
@@ -46,7 +46,7 @@ let flac_gen params =
       | `Labelled ("channels", Int { value = i; _ }) ->
           { f with Flac_format.channels = i }
       | `Labelled ("samplerate", Int { value = i; _ }) ->
-          { f with Flac_format.samplerate = Lazy.from_val i }
+          { f with Flac_format.samplerate = Lazy.Mutexed.from_val i }
       | `Labelled ("compression", Int { value = i; pos }) ->
           if i < 0 || i > 8 then
             Lang_encoder.raise_error ~pos "invalid compression value";
diff --git a/src/core/encoder/lang_mp3.ml b/src/core/encoder/lang_mp3.ml
index 6182cca8e9..6623a491a4 100644
--- a/src/core/encoder/lang_mp3.ml
+++ b/src/core/encoder/lang_mp3.ml
@@ -30,8 +30,8 @@ let allowed_bitrates =
   ]
 
 let check_samplerate ~pos i =
-  Lazy.from_fun (fun () ->
-      let i = Lazy.force i in
+  Lazy.Mutexed.from_fun (fun () ->
+      let i = Lazy.Mutexed.force i in
       let allowed =
         [8000; 11025; 12000; 16000; 22050; 24000; 32000; 44100; 48000]
       in
@@ -69,7 +69,10 @@ let mp3_base f = function
           "internal quality must be a value between 0 and 9";
       { f with Mp3_format.internal_quality = q }
   | `Labelled ("samplerate", Value.Int { value = i; pos }) ->
-      { f with Mp3_format.samplerate = check_samplerate ~pos (Lazy.from_val i) }
+      {
+        f with
+        Mp3_format.samplerate = check_samplerate ~pos (Lazy.Mutexed.from_val i);
+      }
   | `Labelled ("id3v2", Bool { value = true; _ }) ->
       { f with Mp3_format.id3v2 = Some 3 }
   | `Labelled ("id3v2", Bool { value = false; _ }) ->
diff --git a/src/core/encoder/lang_shine.ml b/src/core/encoder/lang_shine.ml
index 16d137a08c..27a4d3f20e 100644
--- a/src/core/encoder/lang_shine.ml
+++ b/src/core/encoder/lang_shine.ml
@@ -48,7 +48,7 @@ let make params =
         | `Labelled ("channels", Int { value = i; _ }) ->
             { f with Shine_format.channels = i }
         | `Labelled ("samplerate", Int { value = i; _ }) ->
-            { f with Shine_format.samplerate = Lazy.from_val i }
+            { f with Shine_format.samplerate = Lazy.Mutexed.from_val i }
         | `Labelled ("bitrate", Int { value = i; _ }) ->
             { f with Shine_format.bitrate = i }
         | `Anonymous s when String.lowercase_ascii s = "mono" ->
diff --git a/src/core/encoder/lang_speex.ml b/src/core/encoder/lang_speex.ml
index c528aecc5b..b1650f682a 100644
--- a/src/core/encoder/lang_speex.ml
+++ b/src/core/encoder/lang_speex.ml
@@ -46,7 +46,7 @@ let make params =
         | `Labelled ("mono", Value.Bool { value = b; _ }) ->
             { f with Speex_format.stereo = not b }
         | `Labelled ("samplerate", Value.Int { value = i; _ }) ->
-            { f with Speex_format.samplerate = Lazy.from_val i }
+            { f with Speex_format.samplerate = Lazy.Mutexed.from_val i }
         | `Labelled ("abr", Value.Int { value = i; _ }) ->
             { f with Speex_format.bitrate_control = Speex_format.Abr i }
         | `Labelled ("quality", Int { value = q; pos }) ->
diff --git a/src/core/encoder/lang_theora.ml b/src/core/encoder/lang_theora.ml
index d9fedace32..9187ef627e 100644
--- a/src/core/encoder/lang_theora.ml
+++ b/src/core/encoder/lang_theora.ml
@@ -62,8 +62,8 @@ let make params =
               "invalid frame width value (should be a multiple of 16)";
           {
             f with
-            Theora_format.width = Lazy.from_val i;
-            picture_width = Lazy.from_val i;
+            Theora_format.width = Lazy.Mutexed.from_val i;
+            picture_width = Lazy.Mutexed.from_val i;
           }
       | `Labelled ("height", Value.Int { value = i; pos }) ->
           (* According to the doc: must be a multiple of 16, and less than 1048576. *)
@@ -72,29 +72,29 @@ let make params =
               "invalid frame height value (should be a multiple of 16)";
           {
             f with
-            Theora_format.height = Lazy.from_val i;
-            picture_height = Lazy.from_val i;
+            Theora_format.height = Lazy.Mutexed.from_val i;
+            picture_height = Lazy.Mutexed.from_val i;
           }
       | `Labelled ("picture_width", Value.Int { value = i; pos }) ->
           (* According to the doc: must not be larger than width. *)
-          if i > Lazy.force f.Theora_format.width then
+          if i > Lazy.Mutexed.force f.Theora_format.width then
             Lang_encoder.raise_error ~pos
               "picture width must not be larger than width";
-          { f with Theora_format.picture_width = Lazy.from_val i }
+          { f with Theora_format.picture_width = Lazy.Mutexed.from_val i }
       | `Labelled ("picture_height", Value.Int { value = i; pos }) ->
           (* According to the doc: must not be larger than height. *)
-          if i > Lazy.force f.Theora_format.height then
+          if i > Lazy.Mutexed.force f.Theora_format.height then
             Lang_encoder.raise_error ~pos
               "picture height must not be larger than height";
-          { f with Theora_format.picture_height = Lazy.from_val i }
+          { f with Theora_format.picture_height = Lazy.Mutexed.from_val i }
       | `Labelled ("picture_x", Value.Int { value = i; pos }) ->
           (* According to the doc: must be no larger than width-picture_width
            * or 255, whichever is smaller. *)
           if
             i
             > min
-                (Lazy.force f.Theora_format.width
-                - Lazy.force f.Theora_format.picture_width)
+                (Lazy.Mutexed.force f.Theora_format.width
+                - Lazy.Mutexed.force f.Theora_format.picture_width)
                 255
           then
             Lang_encoder.raise_error ~pos
@@ -106,12 +106,12 @@ let make params =
            * and frame_height-pic_height-pic_y must be no larger than 255. *)
           if
             i
-            > Lazy.force f.Theora_format.height
-              - Lazy.force f.Theora_format.picture_height
+            > Lazy.Mutexed.force f.Theora_format.height
+              - Lazy.Mutexed.force f.Theora_format.picture_height
           then
             Lang_encoder.raise_error ~pos
               "picture y must not be larger than height - picture height";
-          if Lazy.force f.Theora_format.picture_height - i > 255 then
+          if Lazy.Mutexed.force f.Theora_format.picture_height - i > 255 then
             Lang_encoder.raise_error ~pos
               "picture height - picture y must not be larger than 255";
           { f with Theora_format.picture_y = i }
diff --git a/src/core/encoder/lang_vorbis.ml b/src/core/encoder/lang_vorbis.ml
index aa8ffa5346..bc90a3ded3 100644
--- a/src/core/encoder/lang_vorbis.ml
+++ b/src/core/encoder/lang_vorbis.ml
@@ -39,7 +39,7 @@ let make_cbr params =
     List.fold_left
       (fun f -> function
         | `Labelled ("samplerate", Int { value = i; _ }) ->
-            { f with Vorbis_format.samplerate = Lazy.from_val i }
+            { f with Vorbis_format.samplerate = Lazy.Mutexed.from_val i }
         | `Labelled ("bitrate", Int { value = i; _ }) ->
             { f with Vorbis_format.mode = Vorbis_format.CBR i }
         | `Labelled ("stereo", Bool { value = b; _ }) ->
@@ -77,7 +77,7 @@ let make_abr params =
     List.fold_left
       (fun f -> function
         | `Labelled ("samplerate", Int { value = i; _ }) ->
-            { f with Vorbis_format.samplerate = Lazy.from_val i }
+            { f with Vorbis_format.samplerate = Lazy.Mutexed.from_val i }
         | `Labelled ("bitrate", Int { value = i; _ }) ->
             let x, _, y = get_rates f in
             { f with Vorbis_format.mode = Vorbis_format.ABR (x, Some i, y) }
@@ -117,7 +117,7 @@ let make params =
     List.fold_left
       (fun f -> function
         | `Labelled ("samplerate", Int { value = i; _ }) ->
-            { f with Vorbis_format.samplerate = Lazy.from_val i }
+            { f with Vorbis_format.samplerate = Lazy.Mutexed.from_val i }
         | `Labelled ("quality", Float { value = q; pos }) ->
             if q < -0.2 || q > 1. then
               Lang_encoder.raise_error ~pos "quality should be in [(-0.2)..1]";
diff --git a/src/core/encoder/lang_wav.ml b/src/core/encoder/lang_wav.ml
index b3fcb891cd..608338d541 100644
--- a/src/core/encoder/lang_wav.ml
+++ b/src/core/encoder/lang_wav.ml
@@ -52,7 +52,7 @@ let make params =
         | `Labelled ("duration", Float { value = d }) ->
             { f with Wav_format.duration = Some d }
         | `Labelled ("samplerate", Int { value = i; _ }) ->
-            { f with Wav_format.samplerate = Lazy.from_val i }
+            { f with Wav_format.samplerate = Lazy.Mutexed.from_val i }
         | `Labelled ("samplesize", Int { value = i; pos }) ->
             if i <> 8 && i <> 16 && i <> 24 && i <> 32 then
               Lang_encoder.raise_error ~pos "invalid sample size";
diff --git a/src/core/encoder/mp3_format.ml b/src/core/encoder/mp3_format.ml
index 964395d31c..ab05cce033 100644
--- a/src/core/encoder/mp3_format.ml
+++ b/src/core/encoder/mp3_format.ml
@@ -64,7 +64,7 @@ type t = {
   stereo_mode : stereo_mode;
   bitrate_control : bitrate_control;
   internal_quality : int;
-  samplerate : int Lazy.t;
+  samplerate : int Lazy.Mutexed.t;
   id3v2 : int option;
 }
 
@@ -78,7 +78,7 @@ let to_string m =
   Printf.sprintf "%s(%s,%s,samplerate=%d,id3v2=%s)" name
     (Encoder_formats.string_of_stereo m.stereo)
     (string_of_bitrate_control m.bitrate_control)
-    (Lazy.force m.samplerate)
+    (Lazy.Mutexed.force m.samplerate)
     (match m.id3v2 with None -> "none" | Some v -> string_of_int v)
 
 let bitrate m =
diff --git a/src/core/encoder/shine_format.ml b/src/core/encoder/shine_format.ml
index dd53cdb2b0..33512b9786 100644
--- a/src/core/encoder/shine_format.ml
+++ b/src/core/encoder/shine_format.ml
@@ -20,10 +20,11 @@
 
  *****************************************************************************)
 
-type t = { channels : int; samplerate : int Lazy.t; bitrate : int }
+type t = { channels : int; samplerate : int Lazy.Mutexed.t; bitrate : int }
 
 let to_string m =
   Printf.sprintf "%%shine(channels=%d,samplerate=%d,bitrate=%d)" m.channels
-    (Lazy.force m.samplerate) m.bitrate
+    (Lazy.Mutexed.force m.samplerate)
+    m.bitrate
 
 let bitrate m = m.bitrate * 1000
diff --git a/src/core/encoder/speex_format.ml b/src/core/encoder/speex_format.ml
index 020a5ecdfe..4448024763 100644
--- a/src/core/encoder/speex_format.ml
+++ b/src/core/encoder/speex_format.ml
@@ -25,7 +25,7 @@ type mode = Narrowband | Wideband | Ultra_wideband
 
 type t = {
   bitrate_control : bitrate_control;
-  samplerate : int Lazy.t;
+  samplerate : int Lazy.Mutexed.t;
   stereo : bool;
   mode : mode;
   frames_per_packet : int;
@@ -55,6 +55,7 @@ let to_string m =
     "%%speex(%s,%s,samplerate=%d,mode=%s,frames_per_packet=%d%s,dtx=%B,vad=%B)"
     (Encoder_formats.string_of_stereo m.stereo)
     (string_of_br_ctl m.bitrate_control)
-    (Lazy.force m.samplerate) (string_of_mode m.mode) m.frames_per_packet
+    (Lazy.Mutexed.force m.samplerate)
+    (string_of_mode m.mode) m.frames_per_packet
     (string_of_complexity m.complexity)
     m.dtx m.vad
diff --git a/src/core/encoder/theora_format.ml b/src/core/encoder/theora_format.ml
index 16a690d2ce..94a088283c 100644
--- a/src/core/encoder/theora_format.ml
+++ b/src/core/encoder/theora_format.ml
@@ -25,10 +25,10 @@ type bitrate_control = Quality of int | Bitrate of int
 type t = {
   (* TODO: framerate ! *)
   bitrate_control : bitrate_control;
-  width : int Lazy.t;
-  height : int Lazy.t;
-  picture_width : int Lazy.t;
-  picture_height : int Lazy.t;
+  width : int Lazy.Mutexed.t;
+  height : int Lazy.Mutexed.t;
+  picture_width : int Lazy.Mutexed.t;
+  picture_height : int Lazy.Mutexed.t;
   picture_x : int;
   picture_y : int;
   aspect_numerator : int;
@@ -53,7 +53,7 @@ let print_some_int v x =
   match x with None -> "" | Some x -> Printf.sprintf "%s=%i" v x
 
 let to_string th =
-  let f = Lazy.force in
+  let f = Lazy.Mutexed.force in
   Printf.sprintf
     "%%theora(%s,width=%d,height=%d,picture_width=%d,picture_height=%d,picture_x=%d,picture_y=%d,aspect_numerator=%d,aspect_denominator=%d,keyframe_frequency=%d,%s,soft_target=%b,%s,%s)"
     (bit_ctl_to_string th.bitrate_control)
diff --git a/src/core/encoder/vorbis_format.ml b/src/core/encoder/vorbis_format.ml
index 4f7994b56c..4520e41605 100644
--- a/src/core/encoder/vorbis_format.ml
+++ b/src/core/encoder/vorbis_format.ml
@@ -33,7 +33,7 @@ type mode =
 type t = {
   channels : int;
   mode : mode;
-  samplerate : int Lazy.t;
+  samplerate : int Lazy.Mutexed.t;
   fill : int option;
 }
 
@@ -49,4 +49,5 @@ let string_of_mode = function
 
 let to_string v =
   Printf.sprintf "%%vorbis%s,channels=%d,samplerate=%d)" (string_of_mode v.mode)
-    v.channels (Lazy.force v.samplerate)
+    v.channels
+    (Lazy.Mutexed.force v.samplerate)
diff --git a/src/core/encoder/wav_encoder.ml b/src/core/encoder/wav_encoder.ml
index 8a09b457d1..9ff6405b42 100644
--- a/src/core/encoder/wav_encoder.ml
+++ b/src/core/encoder/wav_encoder.ml
@@ -28,9 +28,11 @@ open Wav_format
 
 let encoder ~pos wav =
   let channels = wav.channels in
-  let sample_rate = Lazy.force wav.samplerate in
+  let sample_rate = Lazy.Mutexed.force wav.samplerate in
   let sample_size = wav.samplesize in
-  let ratio = float sample_rate /. float (Lazy.force Frame.audio_rate) in
+  let ratio =
+    float sample_rate /. float (Lazy.Mutexed.force Frame.audio_rate)
+  in
   let converter = Audio_converter.Samplerate.create channels in
   let len =
     match wav.duration with
diff --git a/src/core/encoder/wav_format.ml b/src/core/encoder/wav_format.ml
index cda23dec3b..7c0404ab16 100644
--- a/src/core/encoder/wav_format.ml
+++ b/src/core/encoder/wav_format.ml
@@ -21,7 +21,7 @@
  *****************************************************************************)
 
 type t = {
-  samplerate : int Lazy.t;
+  samplerate : int Lazy.Mutexed.t;
   samplesize : int;
   channels : int;
   duration : float option;
@@ -35,4 +35,5 @@ let to_string w =
       | Some d -> Printf.sprintf ",duration=%f" d
   in
   Printf.sprintf "%%wav(samplerate=%d,channels=%d,samplesize=%d,header=%b%s)"
-    (Lazy.force w.samplerate) w.channels w.samplesize w.header duration
+    (Lazy.Mutexed.force w.samplerate)
+    w.channels w.samplesize w.header duration
diff --git a/src/core/media/avi.ml b/src/core/media/avi.ml
index 4ee666d5cb..44255ee4a7 100644
--- a/src/core/media/avi.ml
+++ b/src/core/media/avi.ml
@@ -64,7 +64,7 @@ let header ~width ~height ~channels ~samplerate () =
   (* Writing in two steps because 0xffffffff cannot be represented on 32 bits
      architectures. *)
   let dword_max () = word 0xffff ^ word 0xffff in
-  let video_rate = Lazy.force Frame.video_rate in
+  let video_rate = Lazy.Mutexed.force Frame.video_rate in
   let avi_header =
     chunk "avih"
       (dword (1000000 / video_rate) (* microsec per frame *)
diff --git a/src/core/media/decoder.ml b/src/core/media/decoder.ml
index a810d37bda..2deb15fb6d 100644
--- a/src/core/media/decoder.ml
+++ b/src/core/media/decoder.ml
@@ -222,7 +222,8 @@ let test_file ~(log : Log.t) ~extension ~mime ~mimes ~extensions fname =
   ext_ok || mime_ok
 
 let channel_layout audio =
-  Lazy.force Content.(Audio.(get_params audio).Content.Audio.channel_layout)
+  Lazy.Mutexed.force
+    Content.(Audio.(get_params audio).Content.Audio.channel_layout)
 
 let can_decode_type decoded_type target_type =
   let map_convertible cur (field, target_field) =
@@ -444,12 +445,12 @@ let mk_buffer ~ctype generator =
                   (Option.get (Frame.Fields.find_opt Frame.Fields.video ctype))
               with Content.Invalid ->
                 (* We might have encoded contents *)
-                (Lazy.force video_width, Lazy.force video_height)
+                (Lazy.Mutexed.force video_width, Lazy.Mutexed.force video_height)
             in
             Decoder_utils.video_scale ~width ~height ()
           in
           let out_freq =
-            Decoder_utils.{ num = Lazy.force Frame.video_rate; den = 1 }
+            Decoder_utils.{ num = Lazy.Mutexed.force Frame.video_rate; den = 1 }
           in
           let params =
             {
diff --git a/src/core/media/decoder_utils.ml b/src/core/media/decoder_utils.ml
index 1b044be329..a6f0927854 100644
--- a/src/core/media/decoder_utils.ml
+++ b/src/core/media/decoder_utils.ml
@@ -33,7 +33,7 @@ let samplerate_converter () =
   let state = ref None in
   fun ~samplerate audio_buf ofs len ->
     let _channels = Array.length audio_buf in
-    let audio_dst_rate = float (Lazy.force Frame.audio_rate) in
+    let audio_dst_rate = float (Lazy.Mutexed.force Frame.audio_rate) in
     let ratio = audio_dst_rate /. float samplerate in
     match !state with
       | Some converter ->
diff --git a/src/core/net/harbor.ml b/src/core/net/harbor.ml
index 7c6606f3dc..51dd5765f7 100644
--- a/src/core/net/harbor.ml
+++ b/src/core/net/harbor.ml
@@ -84,13 +84,8 @@ let conf_accept_timeout =
 
 let log = Log.make ["harbor"]
 
-module Monad = Duppy.Monad
 module Http = Liq_http
 
-let ( let* ) = Duppy.Monad.bind
-
-module type Monad_t = module type of Monad with module Io := Monad.Io
-
 type login_args = {
   socket : Http.socket;
   meth : string;
@@ -108,17 +103,7 @@ module type Transport_t = sig
   val write : socket -> bytes -> int -> int -> int
   val close : socket -> unit
 
-  module Duppy : sig
-    module Io : Duppy.Io_t with type socket = socket
-
-    module Monad : sig
-      module Io :
-        Duppy.Monad.Monad_io_t with type socket = socket and module Io = Io
-
-      include Monad_t
-    end
-  end
-
+  module Io : Duppy.Io_t with type socket = socket
   module Websocket : Websocket.Websocket_t with type socket = socket
 end
 
@@ -133,23 +118,12 @@ module Http_transport = struct
   module Duppy_transport : Duppy.Transport_t with type t = Http.socket = struct
     type t = Http.socket
 
-    type bigarray =
-      (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
-
     let sock socket = socket#file_descr
     let read = read
     let write = write
-    let ba_write _ _ _ _ = failwith "Not implemented!"
   end
 
-  module Duppy = struct
-    module Io = Duppy.MakeIo (Duppy_transport)
-
-    module Monad = struct
-      module Io = Duppy.Monad.MakeIo (Io)
-      include (Monad : Monad_t)
-    end
-  end
+  module Io = Duppy.MakeIo (Duppy_transport)
 
   module Websocket_transport = struct
     type socket = Http.socket
@@ -185,6 +159,8 @@ module type T = sig
   type http_verb = [ `Get | `Post | `Put | `Delete | `Head | `Options ]
   type reply = Close of (unit -> string) | Relay of string | Custom
 
+  exception Reply of reply
+
   type http_handler =
     protocol:string ->
     meth:http_verb ->
@@ -193,14 +169,14 @@ module type T = sig
     query:(string * string) list ->
     socket:socket ->
     string ->
-    (reply, reply) Duppy.Monad.t
+    reply
 
   val verb_of_string : string -> http_verb
   val string_of_verb : http_verb -> string
   val mk_simple : string -> unit -> string
-  val simple_reply : string -> ('a, reply) Duppy.Monad.t
-  val reply : (unit -> string) -> ('a, reply) Duppy.Monad.t
-  val custom : unit -> ('a, reply) Duppy.Monad.t
+  val simple_reply : string -> 'a
+  val reply : (unit -> string) -> 'a
+  val custom : unit -> 'a
 
   val add_http_handler :
     pos:Liquidsoap_lang_prelude.Pos.t list ->
@@ -251,9 +227,9 @@ module type T = sig
     login:string * (login_args -> bool) ->
     socket ->
     (string * string) list ->
-    (unit, reply) Duppy.Monad.t
+    unit
 
-  val relayed : string -> ('a, reply) Duppy.Monad.t
+  val relayed : string -> 'a
 
   val add_source :
     pos:Liquidsoap_lang_prelude.Pos.t list ->
@@ -270,7 +246,7 @@ end
 module Make (T : Transport_t) : T with type socket = T.socket = struct
   module Websocket = T.Websocket
   module Task = Duppy.Task
-  module Duppy = T.Duppy
+  module Io = T.Io
 
   type socket = T.socket
 
@@ -280,8 +256,8 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
   let close = T.close
 
   let protocol_name h =
-    Printf.sprintf "%s/%s" h.Duppy.Monad.Io.socket#transport#protocol
-      h.Duppy.Monad.Io.socket#transport#name
+    Printf.sprintf "%s/%s" h.Io.socket#transport#protocol
+      h.Io.socket#transport#name
 
   (* Define what we need as a source *)
 
@@ -380,10 +356,12 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
     let ret = Atomic.make s in
     fun () -> Atomic.exchange ret ""
 
-  let simple_reply s = Duppy.Monad.raise (Close (mk_simple s))
-  let reply s = Duppy.Monad.raise (Close s)
-  let relayed s = Duppy.Monad.raise (Relay s)
-  let custom () = Duppy.Monad.raise Custom
+  exception Reply of reply
+
+  let simple_reply s = raise (Reply (Close (mk_simple s)))
+  let reply s = raise (Reply (Close s))
+  let relayed s = raise (Reply (Relay s))
+  let custom () = raise (Reply Custom)
 
   type http_handler =
     protocol:string ->
@@ -393,7 +371,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
     query:(string * string) list ->
     socket:socket ->
     string ->
-    (reply, reply) Duppy.Monad.t
+    reply
 
   type http_handlers = (http_verb * Lang.regexp * http_handler) list Atomic.t
   type handler = { sources : sources; http : http_handlers }
@@ -478,30 +456,30 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
       try Liq_http.parse_auth r
       with Not_found -> { Liq_http.user = ""; password = r }
     in
-    let* s, _ =
-      try Duppy.Monad.return (find_source "/" (port - 1))
+    let s, _ =
+      try find_source "/" (port - 1)
       with Not_found ->
         log#info "ICY error: no / mountpoint";
         simple_reply "No / mountpoint\r\n\r\n"
     in
     (* Authentication can be blocking. *)
-    Duppy.Monad.Io.exec ~priority:`Maybe_blocking h
-      (let user, auth_f = s.login in
-       let user = if requested_user = "" then user else requested_user in
-       if
-         auth_f
-           {
-             socket = h.Duppy.Monad.Io.socket;
-             meth = "ICY";
-             uri = "/";
-             query = [];
-             user;
-             password;
-           }
-       then Duppy.Monad.return (`Shout, "/", `Icy)
-       else (
-         log#info "ICY error: invalid password";
-         simple_reply "Invalid password\r\n\r\n"))
+    Duppy.reschedule ~priority:`Maybe_blocking h.Io.scheduler;
+    let user, auth_f = s.login in
+    let user = if requested_user = "" then user else requested_user in
+    if
+      auth_f
+        {
+          socket = h.Io.socket;
+          meth = "ICY";
+          uri = "/";
+          query = [];
+          user;
+          password;
+        }
+    then (`Shout, "/", `Icy)
+    else (
+      log#info "ICY error: invalid password";
+      simple_reply "Invalid password\r\n\r\n")
 
   exception Protocol_not_supported of string
 
@@ -509,15 +487,14 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
     try
       let data = Re.Pcre.split ~rex:(Re.Pcre.regexp "[ \t]+") r in
       let protocol = verb_or_source_of_string (List.nth data 0) in
-      Duppy.Monad.return
-        ( protocol,
-          List.nth data 1,
-          match String.uppercase_ascii (List.nth data 2) with
-            | "HTTP/1.0" -> `Http_10
-            | "HTTP/1.1" -> `Http_11
-            | "ICE/1.0" -> `Ice_10
-            | s when protocol = `Source -> `Xaudiocast_uri s
-            | s -> raise (Protocol_not_supported s) )
+      ( protocol,
+        List.nth data 1,
+        match String.uppercase_ascii (List.nth data 2) with
+          | "HTTP/1.0" -> `Http_10
+          | "HTTP/1.1" -> `Http_11
+          | "ICE/1.0" -> `Ice_10
+          | s when protocol = `Source -> `Xaudiocast_uri s
+          | s -> raise (Protocol_not_supported s) )
     with
       | Protocol_not_supported p ->
           log#info "Protocol not supported for request %s: %s" r p;
@@ -554,7 +531,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
     try
       if not (auth_f args) then raise Not_authenticated else ();
       log#info "Client logged in.";
-      Duppy.Monad.return ()
+      ()
     with
     | Runtime_error.Runtime_error { kind; _ }
     when kind = "error.icecast.server.mount_taken"
@@ -621,14 +598,14 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
           Hashtbl.fold (fun lbl k query -> (lbl, k) :: query) query [])
         args
     in
-    Duppy.Monad.Io.exec ~priority:`Maybe_blocking h
-      (http_auth_check ?query ~meth ~uri ~login h.Duppy.Monad.Io.socket headers)
+    Duppy.reschedule ~priority:`Maybe_blocking h.Io.scheduler;
+    http_auth_check ?query ~meth ~uri ~login h.Io.socket headers
 
   let socket_with_remaining h =
-    let rem_data = h.Duppy.Monad.Io.data in
+    let rem_data = h.Io.data in
     let rem_len = String.length rem_data in
     let rem_ofs = Atomic.make 0 in
-    let socket = h.Duppy.Monad.Io.socket in
+    let socket = h.Io.socket in
     object
       method typ = socket#typ
       method transport = socket#transport
@@ -663,14 +640,14 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
   let handle_source_request ~port ~auth ~smethod hprotocol h uri headers =
     (* ICY request are on port+1 *)
     let source_port = if smethod = `Shout then port - 1 else port in
-    let* s, groups =
-      try Duppy.Monad.return (find_source uri source_port)
+    let s, groups =
+      try find_source uri source_port
       with Not_found ->
         log#info "Request failed: no mountpoint '%s'!" uri;
         simple_reply
           (http_error_page 404 "Not found" "This mountpoint isn't available.")
     in
-    let* () =
+    let () =
       if
         (* ICY and Xaudiocast auth check was done before.. *)
         not auth
@@ -684,7 +661,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
               | `Xaudiocast -> "SOURCE"
               | `Shout -> "ICY")
           ~uri ~login:s.login h headers
-      else Duppy.Monad.return ()
+      else ()
     in
     try
       let sproto =
@@ -748,6 +725,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
           simple_reply
             (http_error_page 501 "Not Implemented"
                "This stream's format is not recognized.")
+      | Reply _ as e -> raise e
       | e ->
           let bt = Printexc.get_backtrace () in
           Utils.log_exception ~log ~bt
@@ -792,34 +770,35 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
                     let password =
                       json_string_of (List.assoc "password" data)
                     in
-                    Duppy.Monad.return (mime, mount, user, password)
+                    (mime, mount, user, password)
                 | _ -> error ())
           | _ -> error ()
-      with _ -> error ()
+      with
+        | Reply _ as e -> raise e
+        | _ -> error ()
     in
-    let* () =
-      Duppy.Monad.Io.write ?timeout:(Some conf_timeout#get)
-        ~priority:`Non_blocking h
+    let () =
+      Io.write ?timeout:(Some conf_timeout#get) ~priority:`Non_blocking h
         (Bytes.of_string (Websocket.upgrade headers))
     in
-    let* stype, huri, user, password =
-      Duppy.Monad.Io.exec ~priority:`Blocking h
-        (read_hello h.Duppy.Monad.Io.socket)
+    let stype, huri, user, password =
+      Duppy.reschedule ~priority:`Blocking h.Io.scheduler;
+      read_hello h.Io.socket
     in
     log#info "Mime type: %s" stype;
     log#info "Mount point: %s" huri;
-    let* source, groups =
-      try Duppy.Monad.return (find_source huri port)
+    let source, groups =
+      try find_source huri port
       with Not_found ->
         log#info "Request failed: no mountpoint '%s'!" huri;
         simple_reply (websocket_error 1011 "This mountpoint isn't available.")
     in
     let _, auth_f = source.login in
-    let* () =
+    let () =
       try
         auth_check ~auth_f
           {
-            socket = h.Duppy.Monad.Io.socket;
+            socket = h.Io.socket;
             meth = "WEBSOCKET";
             uri = huri;
             query = [];
@@ -861,7 +840,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
         stype;
         headers;
         read = Some read;
-        socket = h.Duppy.Monad.Io.socket;
+        socket = h.Io.socket;
       };
     relayed ""
 
@@ -882,18 +861,18 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
     simple_reply (http_error_page 400 "Bad Request" s)
 
   let admin ~icy ~port ~uri ~headers ~args h =
-    let* mode =
-      try Duppy.Monad.return (Hashtbl.find args "mode")
+    let mode =
+      try Hashtbl.find args "mode"
       with Not_found -> ans_400 ~uri "unrecognised command"
     in
     let len =
       try int_of_string (assoc_uppercase "CONTENT-LENGTH" headers) with _ -> 0
     in
-    let* data =
+    let data =
       if len > 0 then
-        Duppy.Monad.Io.read ?timeout:(Some conf_timeout#get)
-          ~priority:`Non_blocking ~marker:(Duppy.Io.Length len) h
-      else Duppy.Monad.return ""
+        Io.read ?timeout:(Some conf_timeout#get) ~priority:`Non_blocking h
+          (Io.Length len)
+      else ""
     in
     (try
        if
@@ -906,14 +885,14 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
           let mount = try Hashtbl.find args "mount" with Not_found -> "/" in
           log#info "Request to update metadata for mount %s on port %i" mount
             port;
-          let* s, _ =
-            try Duppy.Monad.return (find_source mount port)
+          let s, _ =
+            try find_source mount port
             with Not_found -> ans_400 ~uri "Source is not available"
           in
-          let* () =
+          let () =
             exec_http_auth_check ~args ~meth:"GET" ~uri ~login:s.login h headers
           in
-          let* () =
+          let () =
             match s.get_mime_type ~mount with
               | None ->
                   log#critical
@@ -923,8 +902,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
                   simple_reply
                     (http_error_page 500 "Internal Server Error"
                        "Internal Server Error")
-              | Some f when List.mem f conf_icy_metadata#get ->
-                  Duppy.Monad.return ()
+              | Some f when List.mem f conf_icy_metadata#get -> ()
               | Some f ->
                   log#info
                     "Returned 405 for '%s': Source format %s does not support \
@@ -996,11 +974,11 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
     let f (verb, regex, handler) =
       let rex = regex.Liquidsoap_lang.Lang_regexp.regexp in
       let sub =
-        Lazy.from_fun (fun () ->
+        Lazy.Mutexed.from_fun (fun () ->
             try Some (Re.Pcre.exec ~rex base_uri) with _ -> None)
       in
-      if (verb :> verb) = hmethod && Lazy.force sub <> None then (
-        let sub = Option.get (Lazy.force sub) in
+      if (verb :> verb) = hmethod && Lazy.Mutexed.force sub <> None then (
+        let sub = Option.get (Lazy.Mutexed.force sub) in
         let groups =
           List.fold_left
             (fun groups name ->
@@ -1077,8 +1055,9 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
                   fun timeout -> fst (Http.read_chunked ~timeout socket)
               | _ -> fun _ -> ""
           in
-          Duppy.Monad.Io.exec ~priority:`Maybe_blocking h
-            (handler ~protocol ~meth ~headers ~data ~socket ~query base_uri)
+          Duppy.reschedule ~priority:`Maybe_blocking h.Io.scheduler;
+          handler ~protocol ~meth ~headers ~data ~socket ~query base_uri
+      | Reply _ as e -> raise e
       | e ->
           let bt = Printexc.get_backtrace () in
           Utils.log_exception ~log ~bt
@@ -1088,17 +1067,14 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
 
   let handle_client ~port ~icy h =
     (* Read and process lines *)
-    let* s =
-      Duppy.Monad.Io.read ?timeout:(Some conf_timeout#get)
-        ~priority:`Non_blocking
-        ~marker:
-          (match icy with
-            | true -> Duppy.Io.Split "[\r]?\n"
-            | false -> Duppy.Io.Split "[\r]?\n[\r]?\n")
-        h
+    let s =
+      Io.read ?timeout:(Some conf_timeout#get) ~priority:`Non_blocking h
+        (match icy with
+          | true -> Io.Split "[\r]?\n"
+          | false -> Io.Split "[\r]?\n[\r]?\n")
     in
     let lines = Re.Pcre.split ~rex:(Re.Pcre.regexp "[\r]?\n") s in
-    let* hmethod, huri, hprotocol =
+    let hmethod, huri, hprotocol =
       let s = List.hd lines in
       if icy then parse_icy_request_line ~port h s
       else parse_http_request_line s
@@ -1126,42 +1102,39 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
       with Not_found -> false
     in
     let handle_source smethod =
-      let* auth, huri, smethod =
+      let auth, huri, smethod =
         (* X-audiocast sends lines of the form:
            [SOURCE password path] *)
           match hprotocol with
           | `Xaudiocast_uri uri ->
               let password = huri in
               (* We check authentication here *)
-              let* s, _ =
-                try Duppy.Monad.return (find_source uri port)
+              let s, _ =
+                try find_source uri port
                 with Not_found ->
                   log#info "Request failed: no mountpoint '%s'!" uri;
                   simple_reply
                     (http_error_page 404 "Not found"
                        "This mountpoint isn't available.")
               in
-              (* Authentication can be blocking *)
-              Duppy.Monad.Io.exec
-                ~priority:
-                  (* ICY = true means that authentication has already
-                     happened *)
-                  `Maybe_blocking h
-                (let valid_user, auth_f = s.login in
-                 if
-                   not
-                     (auth_f
-                        {
-                          socket = h.Duppy.Monad.Io.socket;
-                          meth = "SOURCE";
-                          uri;
-                          query = [];
-                          user = valid_user;
-                          password;
-                        })
-                 then simple_reply "Invalid password!"
-                 else Duppy.Monad.return (true, uri, `Xaudiocast))
-          | _ -> Duppy.Monad.return (false, huri, smethod)
+              (* Authentication can be blocking. ICY = true means that
+                 authentication has already happened. *)
+              Duppy.reschedule ~priority:`Maybe_blocking h.Io.scheduler;
+              let valid_user, auth_f = s.login in
+              if
+                not
+                  (auth_f
+                     {
+                       socket = h.Io.socket;
+                       meth = "SOURCE";
+                       uri;
+                       query = [];
+                       user = valid_user;
+                       password;
+                     })
+              then simple_reply "Invalid password!"
+              else (true, uri, `Xaudiocast)
+          | _ -> (false, huri, smethod)
       in
       handle_source_request ~port ~auth ~smethod hprotocol h huri headers
     in
@@ -1176,16 +1149,14 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
       | (`Get | `Post | `Put | `Delete | `Options | `Head) when not icy ->
           handle_http_request ~hmethod ~hprotocol ~port h huri headers
       | `Shout when icy ->
-          let* () =
-            Duppy.Monad.Io.write ?timeout:(Some conf_timeout#get)
-              ~priority:`Non_blocking h
+          let () =
+            Io.write ?timeout:(Some conf_timeout#get) ~priority:`Non_blocking h
               (Bytes.of_string "OK2\r\nicy-caps:11\r\n\r\n")
           in
           (* Now parsing headers *)
-          let* s =
-            Duppy.Monad.Io.read ?timeout:(Some conf_timeout#get)
-              ~priority:`Non_blocking ~marker:(Duppy.Io.Split "[\r]?\n[\r]?\n")
-              h
+          let s =
+            Io.read ?timeout:(Some conf_timeout#get) ~priority:`Non_blocking h
+              (Io.Split "[\r]?\n[\r]?\n")
           in
           let lines = Re.Pcre.split ~rex:(Re.Pcre.regexp "[\r]?\n") s in
           let headers = parse_headers lines in
@@ -1214,57 +1185,59 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
         Unix.setsockopt unix_socket Unix.TCP_NODELAY true;
         let on_error e =
           (match e with
-            | Duppy.Io.Io_error -> log#info "Client %s disconnected" ip
-            | Duppy.Io.Timeout ->
+            | Io.Io_error -> log#info "Client %s disconnected" ip
+            | Io.Timeout ->
                 log#info "Timeout while communicating with client %s." ip
-            | Duppy.Io.Unix (c, p, m, bt) ->
+            | Io.Unix (c, p, m, bt) ->
                 Utils.log_exception ~log
                   ~bt:(Printexc.raw_backtrace_to_string bt)
                   (Printf.sprintf "Unix error: %s"
                      (Printexc.to_string (Unix.Unix_error (c, p, m))))
-            | Duppy.Io.Unknown (exn, bt) ->
+            | Io.Unknown (exn, bt) ->
                 Utils.log_exception ~log
                   ~bt:(Printexc.raw_backtrace_to_string bt)
                   (Printf.sprintf "Unknown error: %s" (Printexc.to_string exn)));
 
           (* Sending an HTTP response in case of timeout
            * even though ICY connections are not HTTP.. *)
-          if e = Duppy.Io.Timeout then
+          if e = Io.Timeout then
             Close
               (mk_simple
                  (http_error_page 408 "Request Time-out"
                     "The server timed out waiting for the request."))
           else Close (mk_simple "")
         in
-        let h =
-          {
-            Duppy.Monad.Io.scheduler = Tutils.scheduler;
-            socket;
-            data = "";
-            on_error;
-          }
-        in
-        let rec reply r =
+        let h = Io.handle Tutils.scheduler socket in
+        let send r =
           let close () = try close socket with _ -> () in
-          let s, exec =
+          let write s =
+            Io.write ~timeout:conf_timeout#get ~priority:`Non_blocking h
+              (Bytes.of_string s)
+          in
+          try
             match r with
-              | Custom -> ("", fun () -> ())
-              | Relay s -> (s, fun () -> ())
+              | Custom -> ()
+              | Relay s -> write s
               | Close fn ->
-                  let s = fn () in
-                  let exec =
-                    if s = "" then close else fun () -> reply (Close fn)
+                  (* A reply is sent in as many chunks as [fn] hands over, and
+                     an empty one ends it. *)
+                  let rec flush () =
+                    match fn () with
+                      | "" -> close ()
+                      | s ->
+                          write s;
+                          flush ()
                   in
-                  (s, exec)
-          in
-          let on_error e =
+                  flush ()
+          with Io.Error e ->
             ignore (on_error e);
             close ()
-          in
-          Duppy.Io.write ~timeout:conf_timeout#get ~priority:`Non_blocking
-            ~on_error ~string:(Bytes.of_string s) ~exec Tutils.scheduler socket
         in
-        Duppy.Monad.run ~return:reply ~raise:reply (handle_client ~port ~icy h)
+        Duppy.run (fun () ->
+            send
+              (try handle_client ~port ~icy h with
+                | Reply r -> r
+                | Io.Error e -> on_error e))
       with e ->
         let bt = Printexc.get_backtrace () in
         Utils.log_exception ~log ~bt
diff --git a/src/core/net/harbor.mli b/src/core/net/harbor.mli
index 53f1a330f1..baa90b59c2 100644
--- a/src/core/net/harbor.mli
+++ b/src/core/net/harbor.mli
@@ -20,7 +20,6 @@
 
   *****************************************************************************)
 
-module Monad = Duppy.Monad
 module Http = Liq_http
 
 (** {1 Settings}
@@ -39,8 +38,6 @@ val conf_map_song_metadata : bool Dtools.Conf.t
 val conf_timeout : float Dtools.Conf.t
 val conf_accept_timeout : float Dtools.Conf.t
 
-module type Monad_t = module type of Monad with module Io := Monad.Io
-
 module type Transport_t = sig
   type socket = Http.socket
 
@@ -49,17 +46,7 @@ module type Transport_t = sig
   val write : socket -> bytes -> int -> int -> int
   val close : socket -> unit
 
-  module Duppy : sig
-    module Io : Duppy.Io_t with type socket = socket
-
-    module Monad : sig
-      module Io :
-        Duppy.Monad.Monad_io_t with type socket = socket and module Io = Io
-
-      include Monad_t
-    end
-  end
-
+  module Io : Duppy.Io_t with type socket = socket
   module Websocket : Websocket.Websocket_t with type socket = socket
 end
 
@@ -93,6 +80,10 @@ module type T = sig
   type http_verb = [ `Get | `Post | `Put | `Delete | `Head | `Options ]
   type reply = Close of (unit -> string) | Relay of string | Custom
 
+  (** How a handler finishes: raised rather than returned, so it can happen from
+      anywhere in the exchange. *)
+  exception Reply of reply
+
   type http_handler =
     protocol:string ->
     meth:http_verb ->
@@ -101,14 +92,17 @@ module type T = sig
     query:(string * string) list ->
     socket:socket ->
     string ->
-    (reply, reply) Duppy.Monad.t
+    reply
 
   val verb_of_string : string -> http_verb
   val string_of_verb : http_verb -> string
+
+  (** These do not return: they raise {!Reply}. *)
   val mk_simple : string -> unit -> string
-  val simple_reply : string -> ('a, reply) Duppy.Monad.t
-  val reply : (unit -> string) -> ('a, reply) Duppy.Monad.t
-  val custom : unit -> ('a, reply) Duppy.Monad.t
+
+  val simple_reply : string -> 'a
+  val reply : (unit -> string) -> 'a
+  val custom : unit -> 'a
 
   val add_http_handler :
     pos:Liquidsoap_lang_prelude.Pos.t list ->
@@ -157,9 +151,9 @@ module type T = sig
     login:string * (login_args -> bool) ->
     socket ->
     (string * string) list ->
-    (unit, reply) Duppy.Monad.t
+    unit
 
-  val relayed : string -> ('a, reply) Duppy.Monad.t
+  val relayed : string -> 'a
 
   val add_source :
     pos:Liquidsoap_lang_prelude.Pos.t list ->
diff --git a/src/core/operators/add.ml b/src/core/operators/add.ml
index f9ba3adaa3..c3960a2bc7 100644
--- a/src/core/operators/add.ml
+++ b/src/core/operators/add.ml
@@ -282,8 +282,8 @@ let tile_pos n =
           (!x, y, dx, y' - y)))
   in
   let video_width, video_height = Frame.video_dimensions () in
-  let x' = Lazy.force video_width in
-  let y' = Lazy.force video_height in
+  let x' = Lazy.Mutexed.force video_width in
+  let y' = Lazy.Mutexed.force video_height in
   let horiz m n =
     Array.append (vert m 0 0 x' (y' / 2)) (vert n 0 (y' / 2) x' y')
   in
diff --git a/src/core/operators/child_support.ml b/src/core/operators/child_support.ml
index 9ec7780766..7e4665f9a7 100644
--- a/src/core/operators/child_support.ml
+++ b/src/core/operators/child_support.ml
@@ -213,7 +213,7 @@ class virtual base ?child_frame_type ~check_self_sync child_val =
        to stop at a track boundary: only the returned frame's length is
        consumed from the buffer. *)
     method child_get_frame ?(get_partial_frame = fun frame -> frame) () =
-      let size = Lazy.force Frame.size in
+      let size = Lazy.Mutexed.force Frame.size in
       while child#is_ready && Generator.length child_buffer < size do
         self#child_tick
       done;
diff --git a/src/core/operators/compress.ml b/src/core/operators/compress.ml
index 6f77ec3cbe..ee5e3c8bdc 100644
--- a/src/core/operators/compress.ml
+++ b/src/core/operators/compress.ml
@@ -68,7 +68,7 @@ class compress ~attack ~release ~threshold ~ratio ~knee ~track_sensitive
       let pos = AFrame.position frame in
       let buf = Content.Audio.get_data (Frame.get frame field) in
       let chans = Array.length buf in
-      let samplerate = float (Lazy.force Frame.audio_rate) in
+      let samplerate = float (Lazy.Mutexed.force Frame.audio_rate) in
       let threshold = threshold () in
       let knee = knee () in
       let ratio = ratio () in
diff --git a/src/core/operators/cross.ml b/src/core/operators/cross.ml
index b0d23cceef..fe4436005a 100644
--- a/src/core/operators/cross.ml
+++ b/src/core/operators/cross.ml
@@ -30,7 +30,7 @@ class consumer ~name ~clock buffer =
     method private can_generate_frame = 0 < Generator.length buffer
 
     method private generate_frame =
-      Generator.slice buffer (Lazy.force Frame.size)
+      Generator.slice buffer (Lazy.Mutexed.force Frame.size)
 
     method abort_track = Generator.clear buffer
     method self_sync = (`Static, None)
@@ -68,7 +68,7 @@ class cross val_source ~override_duration ~duration_getter ~persist_override
     method set_main_duration =
       let duration = duration_getter () in
       let _main_duration = Frame.main_of_seconds duration in
-      let frame_size = Lazy.force Frame.size in
+      let frame_size = Lazy.Mutexed.force Frame.size in
 
       main_duration <-
         (if _main_duration < 0 then (
diff --git a/src/core/operators/defer.ml b/src/core/operators/defer.ml
index 1c70ddcc6d..2542e0d1f5 100644
--- a/src/core/operators/defer.ml
+++ b/src/core/operators/defer.ml
@@ -40,7 +40,7 @@ type state = { offset : int; position : int }
 class defer ~delay ~overhead ~field source =
   let overhead =
     match overhead with
-      | None -> Lazy.force Frame.size
+      | None -> Lazy.Mutexed.force Frame.size
       | Some v -> Frame.main_of_seconds v
   in
   let delay = Frame.main_of_seconds delay in
@@ -138,7 +138,7 @@ class defer ~delay ~overhead ~field source =
       (not deferred) && Generator.length self#generator > 0
 
     method private generate_frame =
-      Generator.slice self#generator (Lazy.force Frame.size)
+      Generator.slice self#generator (Lazy.Mutexed.force Frame.size)
   end
 
 let _ =
diff --git a/src/core/operators/delay.ml b/src/core/operators/delay.ml
index b98f32f6a8..762deca96e 100644
--- a/src/core/operators/delay.ml
+++ b/src/core/operators/delay.ml
@@ -83,7 +83,7 @@ class delay ~initial (source : source) delay =
       in_track <- false
 
     method private generate_frame =
-      let size = Lazy.force Frame.size in
+      let size = Lazy.Mutexed.force Frame.size in
       let append frame =
         if Frame.position frame > 0 then in_track <- true;
         Generator.append self#buffer frame
diff --git a/src/core/operators/delay_line.ml b/src/core/operators/delay_line.ml
index cff9750bab..1a134597f6 100644
--- a/src/core/operators/delay_line.ml
+++ b/src/core/operators/delay_line.ml
@@ -40,7 +40,7 @@ class delay (source : source) duration =
        otherwise an unused delay line (e.g. inside an unselected [switch]
        branch) grows without bound. *)
     method private drop_expired_data =
-      let max_length = duration () + Lazy.force Frame.size in
+      let max_length = duration () + Lazy.Mutexed.force Frame.size in
       let excess = Generator.length self#buffer - max_length in
       if 0 < excess then Generator.truncate self#buffer excess
 
@@ -65,7 +65,7 @@ class delay (source : source) duration =
       (not deferred) && Generator.length self#buffer > 0
 
     method private generate_frame =
-      Generator.slice self#buffer (Lazy.force Frame.size)
+      Generator.slice self#buffer (Lazy.Mutexed.force Frame.size)
   end
 
 let _ =
diff --git a/src/core/operators/dtmf.ml b/src/core/operators/dtmf.ml
index e0f3bfb59a..bf9b4d14b9 100644
--- a/src/core/operators/dtmf.ml
+++ b/src/core/operators/dtmf.ml
@@ -151,7 +151,7 @@ let key =
 
 class dtmf ~duration ~bands ~threshold ~smoothing ~debug callback
   (source : source) =
-  let samplerate = float (Lazy.force Frame.audio_rate) in
+  let samplerate = float (Lazy.Mutexed.force Frame.audio_rate) in
   let nbands = bands in
   let size = float nbands in
   object (self)
@@ -289,7 +289,7 @@ let _ =
 
 class detect ~duration ~bands ~threshold ~smoothing ~debug ~frequencies callback
   (source : source) =
-  let samplerate = float (Lazy.force Frame.audio_rate) in
+  let samplerate = float (Lazy.Mutexed.force Frame.audio_rate) in
   let nbands = bands in
   let size = float nbands in
   object (self)
diff --git a/src/core/operators/echo.ml b/src/core/operators/echo.ml
index 28059bbd37..5a77e95a4c 100644
--- a/src/core/operators/echo.ml
+++ b/src/core/operators/echo.ml
@@ -39,7 +39,7 @@ class echo (source : source) delay feedback ping_pong =
           effect_ <-
             Some
               (Audio.Effect.delay self#audio_channels
-                 (Lazy.force Frame.audio_rate)
+                 (Lazy.Mutexed.force Frame.audio_rate)
                  ~ping_pong (delay ()) (feedback ())))
 
     val mutable past_pos = 0
diff --git a/src/core/operators/filter.ml b/src/core/operators/filter.ml
index 7190409460..af3e44613d 100644
--- a/src/core/operators/filter.ml
+++ b/src/core/operators/filter.ml
@@ -25,7 +25,7 @@ open Source
 type mode = Low_pass | High_pass | Band_pass | Notch
 
 class filter (source : source) freq q wet mode =
-  let rate = float (Lazy.force Frame.audio_rate) in
+  let rate = float (Lazy.Mutexed.force Frame.audio_rate) in
   object (self)
     inherit operator ~name:"filter" [source]
     method fallible = source#fallible
diff --git a/src/core/operators/filter_rc.ml b/src/core/operators/filter_rc.ml
index 795d9d66c7..55bb5c8dfc 100644
--- a/src/core/operators/filter_rc.ml
+++ b/src/core/operators/filter_rc.ml
@@ -25,7 +25,7 @@ open Source
 type mode = Low_pass | High_pass
 
 class filter (source : source) freq wet mode =
-  let rate = float (Lazy.force Frame.audio_rate) in
+  let rate = float (Lazy.Mutexed.force Frame.audio_rate) in
   let dt = 1. /. rate in
   object (self)
     inherit operator ~name:"filter.rc" [source]
diff --git a/src/core/operators/gate.ml b/src/core/operators/gate.ml
index d1a8e9642a..db10cf2564 100644
--- a/src/core/operators/gate.ml
+++ b/src/core/operators/gate.ml
@@ -45,7 +45,7 @@ class gate ~threshold ~attack ~release ~hold ~range ~window (source : source) =
 
     (* Time remaining before closing. *)
     val mutable hold_delay =
-      int_of_float (hold () *. float (Lazy.force Frame.audio_rate))
+      int_of_float (hold () *. float (Lazy.Mutexed.force Frame.audio_rate))
 
     method private generate_frame =
       let buf =
@@ -53,7 +53,7 @@ class gate ~threshold ~attack ~release ~hold ~range ~window (source : source) =
       in
       let position = self#frame_audio_position in
       let chans = self#audio_channels in
-      let samplerate = float (Lazy.force Frame.audio_rate) in
+      let samplerate = float (Lazy.Mutexed.force Frame.audio_rate) in
       let attack = attack () in
       let attack_rate = 1. /. (attack *. samplerate) in
       let release = release () in
diff --git a/src/core/operators/insert_subtitles.ml b/src/core/operators/insert_subtitles.ml
index dfcb56b433..111ef55e02 100644
--- a/src/core/operators/insert_subtitles.ml
+++ b/src/core/operators/insert_subtitles.ml
@@ -42,7 +42,9 @@ class insert_subtitles ~field (s : source option) =
       let buf =
         opt
           (fun s -> s#get_frame)
-          (Frame.create ~length:(Lazy.force Frame.size) self#content_type)
+          (Frame.create
+             ~length:(Lazy.Mutexed.force Frame.size)
+             self#content_type)
       in
       let length = Frame.position buf in
       let existing =
diff --git a/src/core/operators/keyboard.ml b/src/core/operators/keyboard.ml
index af998ac49a..0ffd883408 100644
--- a/src/core/operators/keyboard.ml
+++ b/src/core/operators/keyboard.ml
@@ -120,7 +120,9 @@ class keyboard =
     method private generate_frame =
       let t = self#get_events in
       Frame.set_data
-        (Frame.create ~length:(Lazy.force Frame.size) Frame.Fields.empty)
+        (Frame.create
+           ~length:(Lazy.Mutexed.force Frame.size)
+           Frame.Fields.empty)
         Frame.Fields.midi Content.Midi.lift_data [| t |]
   end
 
diff --git a/src/core/operators/muxer.ml b/src/core/operators/muxer.ml
index 6c75bc87b1..c40962df9a 100644
--- a/src/core/operators/muxer.ml
+++ b/src/core/operators/muxer.ml
@@ -129,7 +129,7 @@ class muxer ~pos ~base tracks =
             tracks
 
     method generate_frame =
-      let length = Lazy.force Frame.size in
+      let length = Lazy.Mutexed.force Frame.size in
       let pos, frame =
         List.fold_left
           (fun (pos, frame) { fields; source } ->
diff --git a/src/core/operators/pitch.ml b/src/core/operators/pitch.ml
index 6b63abea09..81796b3ce8 100644
--- a/src/core/operators/pitch.ml
+++ b/src/core/operators/pitch.ml
@@ -73,8 +73,9 @@ class pitch every length freq_min freq_max (source : source) =
 
     (** Array used to get data to analyze. *)
     method databuf =
-      Lazy.force
-        (Lazy.from_fun (fun () -> Audio.create self#audio_channels length))
+      Lazy.Mutexed.force
+        (Lazy.Mutexed.from_fun (fun () ->
+             Audio.create self#audio_channels length))
 
     val mutable computations = -1
     method fallible = source#fallible
diff --git a/src/core/operators/rms_smooth.ml b/src/core/operators/rms_smooth.ml
index 92dac0fc50..3c5d031570 100644
--- a/src/core/operators/rms_smooth.ml
+++ b/src/core/operators/rms_smooth.ml
@@ -23,7 +23,7 @@
 open Source
 
 class rms ~tau source =
-  let samplerate = float (Lazy.force Frame.audio_rate) in
+  let samplerate = float (Lazy.Mutexed.force Frame.audio_rate) in
   object (self)
     inherit operator [source] ~name:"rms"
     method fallible = source#fallible
diff --git a/src/core/operators/sequence.ml b/src/core/operators/sequence.ml
index b2825d59e3..9e4f56748c 100644
--- a/src/core/operators/sequence.ml
+++ b/src/core/operators/sequence.ml
@@ -41,7 +41,7 @@ class sequence ?(name = "sequence") ?(merge = false) ?(single_track = true)
         ()
 
     method self_sync =
-      ( Lazy.force self_sync_type,
+      ( Lazy.Mutexed.force self_sync_type,
         match sources with hd :: _ -> snd hd#self_sync | [] -> None )
 
     method fallible =
diff --git a/src/core/operators/switch.ml b/src/core/operators/switch.ml
index f6266e699e..17c5f31cc8 100644
--- a/src/core/operators/switch.ml
+++ b/src/core/operators/switch.ml
@@ -344,7 +344,7 @@ class switch ~all_predicates children =
               | _ -> None)
 
     method self_sync =
-      ( Lazy.force self_sync_type,
+      ( Lazy.Mutexed.force self_sync_type,
         match self#selected with
           | Some s -> snd s.effective_source#self_sync
           | None -> None )
diff --git a/src/core/operators/synth_op.ml b/src/core/operators/synth_op.ml
index ef15fc7b01..67981534c1 100644
--- a/src/core/operators/synth_op.ml
+++ b/src/core/operators/synth_op.ml
@@ -98,7 +98,9 @@ let register obj name descr =
          let adsr =
            if Lang.to_bool (f "envelope") then
              Some
-               (Audio.Mono.Effect.ADSR.make (Lazy.force Frame.audio_rate) adsr)
+               (Audio.Mono.Effect.ADSR.make
+                  (Lazy.Mutexed.force Frame.audio_rate)
+                  adsr)
            else None
          in
          let src = Lang.to_source (f "") in
@@ -144,11 +146,13 @@ let register obj name descr =
          let adsr =
            if Lang.to_bool (f "envelope") then
              Some
-               (Audio.Mono.Effect.ADSR.make (Lazy.force Frame.audio_rate) adsr)
+               (Audio.Mono.Effect.ADSR.make
+                  (Lazy.Mutexed.force Frame.audio_rate)
+                  adsr)
            else None
          in
          let synths =
-           Array.init (Lazy.force Frame.midi_channels) (fun c ->
+           Array.init (Lazy.Mutexed.force Frame.midi_channels) (fun c ->
                ((fun () -> 1.), new synth (obj adsr) src c 1.))
          in
          let synths =
@@ -168,17 +172,17 @@ let register obj name descr =
 
 let () =
   register
-    (fun adsr -> new Synth.sine ?adsr (Lazy.force Frame.audio_rate))
+    (fun adsr -> new Synth.sine ?adsr (Lazy.Mutexed.force Frame.audio_rate))
     "sine" "Sine synthesizer."
 
 let () =
   register
-    (fun adsr -> new Synth.square ?adsr (Lazy.force Frame.audio_rate))
+    (fun adsr -> new Synth.square ?adsr (Lazy.Mutexed.force Frame.audio_rate))
     "square" "Square synthesizer."
 
 let () =
   register
-    (fun adsr -> new Synth.saw ?adsr (Lazy.force Frame.audio_rate))
+    (fun adsr -> new Synth.saw ?adsr (Lazy.Mutexed.force Frame.audio_rate))
     "saw" "Saw synthesizer."
 
 (*
diff --git a/src/core/operators/time_warp.ml b/src/core/operators/time_warp.ml
index bc6b25f95d..651409389f 100644
--- a/src/core/operators/time_warp.ml
+++ b/src/core/operators/time_warp.ml
@@ -37,7 +37,7 @@ module Buffer = struct
   (* The kind of value shared by a producer and a consumer. *)
   type control = {
     lock : Mutex_utils.state;
-    generator : Generator.t Lazy.t;
+    generator : Generator.t Lazy.Mutexed.t;
     mutable buffering : bool;
     mutable abort : bool;
   }
@@ -55,7 +55,8 @@ module Buffer = struct
       method fallible = true
 
       method remaining =
-        proceed c (fun () -> Generator.remaining (Lazy.force c.generator))
+        proceed c (fun () ->
+            Generator.remaining (Lazy.Mutexed.force c.generator))
 
       method private can_generate_frame =
         proceed c (fun () ->
@@ -63,12 +64,12 @@ module Buffer = struct
             not is_buffering)
 
       method! seek len =
-        let len = min (Generator.length (Lazy.force c.generator)) len in
-        Generator.truncate (Lazy.force c.generator) len;
+        let len = min (Generator.length (Lazy.Mutexed.force c.generator)) len in
+        Generator.truncate (Lazy.Mutexed.force c.generator) len;
         len
 
       method effective_source = (self :> Source.source)
-      method buffer_length = Generator.length (Lazy.force c.generator)
+      method buffer_length = Generator.length (Lazy.Mutexed.force c.generator)
 
       (* Returns true if metadata should be replayed. *)
       method private save_metadata frame =
@@ -102,11 +103,13 @@ module Buffer = struct
             let was_buffering = is_buffering in
             is_buffering <- false;
             let frame =
-              Generator.slice (Lazy.force c.generator) (Lazy.force Frame.size)
+              Generator.slice
+                (Lazy.Mutexed.force c.generator)
+                (Lazy.Mutexed.force Frame.size)
             in
             if
               Frame.is_partial frame
-              && Generator.length (Lazy.force c.generator) = 0
+              && Generator.length (Lazy.Mutexed.force c.generator) = 0
             then (
               self#log#important "Buffer emptied, start buffering...";
               c.buffering <- true);
@@ -144,12 +147,13 @@ module Buffer = struct
             if c.abort then (
               c.abort <- false;
               source#abort_track);
-            Generator.append (Lazy.force c.generator) frame;
-            if Generator.length (Lazy.force c.generator) > prebuf then (
+            Generator.append (Lazy.Mutexed.force c.generator) frame;
+            if Generator.length (Lazy.Mutexed.force c.generator) > prebuf then (
               c.buffering <- false;
-              if Generator.length (Lazy.force c.generator) > maxbuf then
-                Generator.truncate (Lazy.force c.generator)
-                  (Generator.length (Lazy.force c.generator) - maxbuf)))
+              if Generator.length (Lazy.Mutexed.force c.generator) > maxbuf then
+                Generator.truncate
+                  (Lazy.Mutexed.force c.generator)
+                  (Generator.length (Lazy.Mutexed.force c.generator) - maxbuf)))
     end
 
   let create ~id ~autostart ~infallible ~pre_buffer ~max_buffer ~add_track_mark
@@ -157,7 +161,7 @@ module Buffer = struct
     let control =
       {
         generator =
-          Lazy.from_fun (fun () ->
+          Lazy.Mutexed.from_fun (fun () ->
               Generator.create (Lang.to_source source_val)#content_type);
         lock = Mutex_utils.mk_state ();
         buffering = true;
@@ -371,7 +375,7 @@ module AdaptativeBuffer = struct
             let scaling = c.rb_length /. prebuf in
             let scale n = int_of_float (float n *. scaling) in
             let unscale n = int_of_float (float n /. scaling) in
-            let length = Lazy.force Frame.size in
+            let length = Lazy.Mutexed.force Frame.size in
             let frame = Frame.create ~length self#content_type in
             let alen = Frame.audio_of_main length in
             let buf =
diff --git a/src/core/operators/video_effects.ml b/src/core/operators/video_effects.ml
index e32708406a..2e2c88e3d4 100644
--- a/src/core/operators/video_effects.ml
+++ b/src/core/operators/video_effects.ml
@@ -219,7 +219,7 @@ let _ =
     (fun p ->
       let duration = List.assoc "duration" p |> Lang.to_float_getter in
       let src = List.assoc "" p |> Lang.to_source in
-      let fps = Lazy.force Frame.video_rate |> float_of_int in
+      let fps = Lazy.Mutexed.force Frame.video_rate |> float_of_int in
       let prev = ref (Image.YUV420.create 0 0) in
       new effect_ ~name:"video.persistence" src (fun buf ->
           let duration = duration () in
@@ -590,12 +590,14 @@ let _ =
       let s = List.assoc "" p |> Lang.to_source in
       let video_width, video_height = Frame.video_dimensions () in
       let width =
-        match width with Some width -> width | None -> Lazy.force video_width
+        match width with
+          | Some width -> width
+          | None -> Lazy.Mutexed.force video_width
       in
       let height =
         match height with
           | Some height -> height
-          | None -> Lazy.force video_height
+          | None -> Lazy.Mutexed.force video_height
       in
       new effect_map ~name:"video.viewport" s (fun buf ->
           Video.Canvas.Image.viewport ~x ~y width height buf))
diff --git a/src/core/operators/video_text_native.ml b/src/core/operators/video_text_native.ml
index 3325387b81..908d09b0f4 100644
--- a/src/core/operators/video_text_native.ml
+++ b/src/core/operators/video_text_native.ml
@@ -24,6 +24,11 @@ open Mm
 open Extralib
 
 let log = Log.make ["video"; "text"; "native"]
+
+(* The font's character map is shared, and rendering happens on whichever
+   domain runs the source. *)
+module Font = Image.Bitmap.Font.Make (Lazy.Mutexed)
+
 let warned_custom_font = ref false
 
 let render_text ~font ~size text =
@@ -31,11 +36,11 @@ let render_text ~font ~size text =
     warned_custom_font := true;
     log#important "video.text.native does not support custom fonts yet!");
   let () = ignore font in
-  let font = Image.Bitmap.Font.native in
-  let bmp = Image.Bitmap.Font.render text in
+  let font = Font.native in
+  let bmp = Font.render text in
   let w = Image.Bitmap.width bmp in
   let h = Image.Bitmap.height bmp in
-  let char_height = Image.Bitmap.Font.height font in
+  let char_height = Font.height font in
   let get_pixel x y =
     let x = x * char_height / size in
     let y = y * char_height / size in
diff --git a/src/core/optionals/alsa/alsa_io.ml b/src/core/optionals/alsa/alsa_io.ml
index de1a62fdce..b09ede0c2b 100644
--- a/src/core/optionals/alsa/alsa_io.ml
+++ b/src/core/optionals/alsa/alsa_io.ml
@@ -33,7 +33,7 @@ let handle lbl f x =
 
 class virtual base ~buffer_size:buffer_size_seconds ~self_sync
   ?(default_self_sync = fun () -> (`Static, None)) dev mode =
-  let samples_per_second = Lazy.force Frame.audio_rate in
+  let samples_per_second = Lazy.Mutexed.force Frame.audio_rate in
   let periods = Alsa_settings.periods#get in
   let buffer_size = Frame.audio_of_seconds buffer_size_seconds in
   object (self)
@@ -173,7 +173,7 @@ class virtual base ~buffer_size:buffer_size_seconds ~self_sync
 class output ~buffer_size ~self_sync ~start ~infallible ~register_telnet dev
   val_source =
   let s = Lang.to_source val_source in
-  let samples_per_second = Lazy.force Frame.audio_rate in
+  let samples_per_second = Lazy.Mutexed.force Frame.audio_rate in
   let name = Printf.sprintf "alsa_out(%s)" dev in
   object (self)
     inherit
@@ -264,7 +264,7 @@ class input ~buffer_size ~self_sync ~start ~fallible dev =
     (* TODO: convert samplerate *)
     method private generate_frame =
       let pcm = Option.get pcm in
-      let length = Lazy.force Frame.size in
+      let length = Lazy.Mutexed.force Frame.size in
       let alsa_buffer_size = self#alsa_buffer_size in
       let gen = self#generator in
       let format = Frame.Fields.find Frame.Fields.audio self#content_type in
@@ -336,7 +336,7 @@ let _ =
         match
           Lang.to_valued_option Lang.to_float (List.assoc "buffer_size" p)
         with
-          | None -> Lazy.force Frame.duration
+          | None -> Lazy.Mutexed.force Frame.duration
           | Some v -> v
       in
       let start = Lang.to_bool (List.assoc "start" p) in
@@ -383,7 +383,7 @@ let _ =
         match
           Lang.to_valued_option Lang.to_float (List.assoc "buffer_size" p)
         with
-          | None -> Lazy.force Frame.duration
+          | None -> Lazy.Mutexed.force Frame.duration
           | Some v -> v
       in
       let start = Lang.to_bool (List.assoc "start" p) in
diff --git a/src/core/optionals/ao/ao_out.ml b/src/core/optionals/ao/ao_out.ml
index 3cd2ed656f..3937e5d95e 100644
--- a/src/core/optionals/ao/ao_out.ml
+++ b/src/core/optionals/ao/ao_out.ml
@@ -37,7 +37,7 @@ let sync_source = SyncSource.make ()
 
 class output ~self_sync ~driver ~register_telnet ~infallible ~options
   ?channels_matrix source start =
-  let samples_per_second = Lazy.force Frame.audio_rate in
+  let samples_per_second = Lazy.Mutexed.force Frame.audio_rate in
   let bytes_per_sample = 2 in
   let s = Lang.to_source source in
   object (self)
diff --git a/src/core/optionals/bjack/bjack_in.ml b/src/core/optionals/bjack/bjack_in.ml
index b077dbfcf0..da43fe6acb 100644
--- a/src/core/optionals/bjack/bjack_in.ml
+++ b/src/core/optionals/bjack/bjack_in.ml
@@ -26,7 +26,7 @@ let log = Log.make ["input"; "jack"]
 
 class jack_in ~fallible ~autostart ~server =
   let samples_per_frame = AFrame.size () in
-  let samples_per_second = Lazy.force Frame.audio_rate in
+  let samples_per_second = Lazy.Mutexed.force Frame.audio_rate in
   let bytes_per_sample = 2 in
 
   object (self)
@@ -80,7 +80,7 @@ class jack_in ~fallible ~autostart ~server =
       done
 
     method private generate_frame =
-      let length = Lazy.force Frame.size in
+      let length = Lazy.Mutexed.force Frame.size in
       let alen = Frame.audio_of_main length in
       let blen = Audio.S16LE.size self#audio_channels alen in
       self#read_data blen;
diff --git a/src/core/optionals/bjack/bjack_out.ml b/src/core/optionals/bjack/bjack_out.ml
index 7464aa541e..6e1f5c9b1d 100644
--- a/src/core/optionals/bjack/bjack_out.ml
+++ b/src/core/optionals/bjack/bjack_out.ml
@@ -27,7 +27,7 @@ let bytes_per_sample = 2
 class output ~infallible ~register_telnet ~server source =
   let samples_per_frame = AFrame.size () in
   let seconds_per_frame = Frame.seconds_of_audio samples_per_frame in
-  let samples_per_second = Lazy.force Frame.audio_rate in
+  let samples_per_second = Lazy.Mutexed.force Frame.audio_rate in
   object (self)
     inherit
       Output.output
diff --git a/src/core/optionals/dssi/dssi_op.ml b/src/core/optionals/dssi/dssi_op.ml
index 0492018a76..1b310cf579 100644
--- a/src/core/optionals/dssi/dssi_op.ml
+++ b/src/core/optionals/dssi/dssi_op.ml
@@ -66,7 +66,7 @@ class dssi ?chan plugin descr outputs params source =
           (if chan <> None then 1 else all_chans)
           (fun _ ->
             Ladspa.Descriptor.instantiate (Descriptor.ladspa d)
-              (Lazy.force Frame.audio_rate)) )
+              (Lazy.Mutexed.force Frame.audio_rate)) )
 
     initializer
       Array.iter (fun inst -> Ladspa.Descriptor.activate inst) (snd di)
diff --git a/src/core/optionals/fdkaac/fdkaac_encoder.ml b/src/core/optionals/fdkaac/fdkaac_encoder.ml
index 06465c7b9d..fed732521e 100644
--- a/src/core/optionals/fdkaac/fdkaac_encoder.ml
+++ b/src/core/optionals/fdkaac/fdkaac_encoder.ml
@@ -33,7 +33,7 @@ let create_encoder ~pos params =
     [
       `Aot params.Fdkaac_format.aot;
       `Bandwidth bandwidth;
-      `Samplerate (Lazy.force params.Fdkaac_format.samplerate);
+      `Samplerate (Lazy.Mutexed.force params.Fdkaac_format.samplerate);
       `Transmux params.Fdkaac_format.transmux;
       `Afterburner params.Fdkaac_format.afterburner;
     ]
@@ -72,7 +72,7 @@ let create_encoder ~pos params =
 let encoder ~pos aac =
   let enc = create_encoder ~pos aac in
   let channels = aac.Fdkaac_format.channels in
-  let samplerate = Lazy.force aac.Fdkaac_format.samplerate in
+  let samplerate = Lazy.Mutexed.force aac.Fdkaac_format.samplerate in
   let samplerate_converter = Audio_converter.Samplerate.create channels in
   let src_freq = float (Frame.audio_of_seconds 1.) in
   let dst_freq = float samplerate in
diff --git a/src/core/optionals/ffmpeg/base/ffmpeg_audio_converter.ml b/src/core/optionals/ffmpeg/base/ffmpeg_audio_converter.ml
index 2e662de2e5..d29d141cf5 100644
--- a/src/core/optionals/ffmpeg/base/ffmpeg_audio_converter.ml
+++ b/src/core/optionals/ffmpeg/base/ffmpeg_audio_converter.ml
@@ -27,7 +27,7 @@ module Resampler =
 
 let samplerate_converter channels =
   let chans = Avutil.Channel_layout.get_default channels in
-  let in_freq = Lazy.force Frame.audio_rate in
+  let in_freq = Lazy.Mutexed.force Frame.audio_rate in
   let rs = ref None in
   let rs_out_freq = ref 0 in
   fun x buf offset length ->
diff --git a/src/core/optionals/ffmpeg/base/ffmpeg_inline.ml b/src/core/optionals/ffmpeg/base/ffmpeg_inline.ml
index 4262fde3a3..252acac820 100644
--- a/src/core/optionals/ffmpeg/base/ffmpeg_inline.ml
+++ b/src/core/optionals/ffmpeg/base/ffmpeg_inline.ml
@@ -31,7 +31,7 @@ let relay_metadata generator frame =
   List.iter
     (fun (pos, m) -> Generator.add_metadata ~pos generator m)
     (Frame.get_all_metadata frame);
-  let size = Lazy.force Frame.size in
+  let size = Lazy.Mutexed.force Frame.size in
   List.iter
     (fun pos -> Generator.add_track_mark ~pos generator)
     (List.filter (fun pos -> pos < size) (Frame.track_marks frame))
diff --git a/src/core/optionals/ffmpeg/base/ffmpeg_utils.ml b/src/core/optionals/ffmpeg/base/ffmpeg_utils.ml
index d2f7a3baf4..4aaab630eb 100644
--- a/src/core/optionals/ffmpeg/base/ffmpeg_utils.ml
+++ b/src/core/optionals/ffmpeg/base/ffmpeg_utils.ml
@@ -97,13 +97,13 @@ let () =
             log#f conf_level#get "%s" (String.trim s)))
 
 let liq_main_ticks_time_base () =
-  { Avutil.num = 1; den = Lazy.force Frame.main_rate }
+  { Avutil.num = 1; den = Lazy.Mutexed.force Frame.main_rate }
 
 let liq_audio_sample_time_base () =
-  { Avutil.num = 1; den = Lazy.force Frame.audio_rate }
+  { Avutil.num = 1; den = Lazy.Mutexed.force Frame.audio_rate }
 
 let liq_video_sample_time_base () =
-  { Avutil.num = 1; den = Lazy.force Frame.video_rate }
+  { Avutil.num = 1; den = Lazy.Mutexed.force Frame.video_rate }
 
 (* Callers report an unknown value their own way: the container encoder can
    point at the script position, the inline one cannot. *)
diff --git a/src/core/optionals/ffmpeg/decoder/builtins_ffmpeg_decoder.ml b/src/core/optionals/ffmpeg/decoder/builtins_ffmpeg_decoder.ml
index 908463e2ee..42a11b770d 100644
--- a/src/core/optionals/ffmpeg/decoder/builtins_ffmpeg_decoder.ml
+++ b/src/core/optionals/ffmpeg/decoder/builtins_ffmpeg_decoder.ml
@@ -37,9 +37,9 @@ let log = Log.make ["ffmpeg"; "internal"; "decoder"]
 
 let decode_audio_frame ~field ~mode generator =
   let internal_channel_layout =
-    Avutil.Channel_layout.get_default (Lazy.force Frame.audio_channels)
+    Avutil.Channel_layout.get_default (Lazy.Mutexed.force Frame.audio_channels)
   in
-  let internal_samplerate = Lazy.force Frame.audio_rate in
+  let internal_samplerate = Lazy.Mutexed.force Frame.audio_rate in
 
   let mk_converter ~in_sample_format ~channel_layout ~samplerate =
     let converter =
@@ -195,9 +195,9 @@ let decode_audio_frame ~field ~mode generator =
 
 let decode_video_frame ~field ~mode generator =
   let video_width, video_height = Frame.video_dimensions () in
-  let internal_width = Lazy.force video_width in
-  let internal_height = Lazy.force video_height in
-  let target_fps = Lazy.force Frame.video_rate in
+  let internal_width = Lazy.Mutexed.force video_width in
+  let internal_height = Lazy.Mutexed.force video_height in
+  let target_fps = Lazy.Mutexed.force Frame.video_rate in
 
   let mk_converter () =
     let converter = ref None in
diff --git a/src/core/optionals/ffmpeg/decoder/ffmpeg_decoder.ml b/src/core/optionals/ffmpeg/decoder/ffmpeg_decoder.ml
index b8e9862a9e..3c88a7d7dc 100644
--- a/src/core/optionals/ffmpeg/decoder/ffmpeg_decoder.ml
+++ b/src/core/optionals/ffmpeg/decoder/ffmpeg_decoder.ml
@@ -806,7 +806,8 @@ let create_decoder ~ctype ~metadata fname =
       Ffmpeg_decoder_conf.image_file_extensions#get
   then (
     Hashtbl.replace opts "loop" (`Int 1);
-    Hashtbl.replace opts "framerate" (`Int (Lazy.force Frame.video_rate)));
+    Hashtbl.replace opts "framerate"
+      (`Int (Lazy.Mutexed.force Frame.video_rate)));
   let container = open_decoding_input ?format ~opts fname in
   check_opts opts;
   mk_decoder_record ~ctype ~decode_first_metadata:false container
@@ -831,7 +832,8 @@ let create_stream_decoder ~ctype mime input =
   if List.exists (fun s -> mime = s) Ffmpeg_decoder_conf.image_mime_types#get
   then (
     Hashtbl.replace opts "loop" (`Int 1);
-    Hashtbl.replace opts "framerate" (`Int (Lazy.force Frame.video_rate)));
+    Hashtbl.replace opts "framerate"
+      (`Int (Lazy.Mutexed.force Frame.video_rate)));
   let container =
     Av.open_input_stream ?seek:seek_input ~opts ?format input.Decoder.read
   in
diff --git a/src/core/optionals/ffmpeg/decoder/ffmpeg_internal_decoder.ml b/src/core/optionals/ffmpeg/decoder/ffmpeg_internal_decoder.ml
index 47a69a4cae..9c51807a95 100644
--- a/src/core/optionals/ffmpeg/decoder/ffmpeg_internal_decoder.ml
+++ b/src/core/optionals/ffmpeg/decoder/ffmpeg_internal_decoder.ml
@@ -84,7 +84,7 @@ let mk_audio_decoder ~channels ~field ~pcm_kind codec =
   let in_sample_rate = ref (Avcodec.Audio.get_sample_rate codec) in
   let in_channel_layout = ref (Avcodec.Audio.get_channel_layout codec) in
   let in_sample_format = ref (Avcodec.Audio.get_sample_format codec) in
-  let target_sample_rate = Lazy.force Frame.audio_rate in
+  let target_sample_rate = Lazy.Mutexed.force Frame.audio_rate in
   let target_channel_layout = Avutil.Channel_layout.get_default channels in
   let mk_converter () =
     Converter.create !in_channel_layout ~in_sample_format:!in_sample_format
@@ -132,7 +132,7 @@ let mk_video_decoder ~width ~height ~alpha ~stream ~field codec =
   let target_height = height in
   let width = Avcodec.Video.get_width codec in
   let height = Avcodec.Video.get_height codec in
-  let target_fps = Lazy.force Frame.video_rate in
+  let target_fps = Lazy.Mutexed.force Frame.video_rate in
   let target_pixel_format =
     if alpha then Ffmpeg_utils.liq_frame_pixel_format_with_alpha
     else Ffmpeg_utils.liq_frame_pixel_format
@@ -277,8 +277,8 @@ let mk_bitmap_subtitle_decoder ~field ~width ~height =
   let generator =
     Content.Video.make_generator
       {
-        Content.Video.width = Some (lazy width);
-        height = Some (lazy height);
+        Content.Video.width = Some (Lazy.Mutexed.from_fun (fun () -> width));
+        height = Some (Lazy.Mutexed.from_fun (fun () -> height));
         alpha = Unifier.make (Some true);
       }
   in
diff --git a/src/core/optionals/ffmpeg/encoder/builtins_ffmpeg_encoder.ml b/src/core/optionals/ffmpeg/encoder/builtins_ffmpeg_encoder.ml
index 65fc859774..f69c052e8a 100644
--- a/src/core/optionals/ffmpeg/encoder/builtins_ffmpeg_encoder.ml
+++ b/src/core/optionals/ffmpeg/encoder/builtins_ffmpeg_encoder.ml
@@ -53,12 +53,12 @@ let encode_audio_frame ~source_idx ~type_t ~mode ~opts ?codec ~format
       (Content.Audio.channels_of_format
          (Frame.Fields.find field (content_type ())))
   in
-  let internal_samplerate = Lazy.force Frame.audio_rate in
+  let internal_samplerate = Lazy.Mutexed.force Frame.audio_rate in
   let target_channels = format.Ffmpeg_format.channels in
   let target_channel_layout =
     Avutil.Channel_layout.get_default target_channels
   in
-  let target_samplerate = Lazy.force format.Ffmpeg_format.samplerate in
+  let target_samplerate = Lazy.Mutexed.force format.Ffmpeg_format.samplerate in
   let target_time_base = { Avutil.num = 1; den = target_samplerate } in
 
   let target_sample_format =
@@ -201,16 +201,16 @@ let encode_audio_frame ~source_idx ~type_t ~mode ~opts ?codec ~format
 let encode_video_frame ~source_idx ~type_t ~mode ~opts ?codec ~format
     ~content_type ~field generator =
   let chosen_pixel_format = ref Ffmpeg_utils.liq_frame_pixel_format in
-  let internal_fps = Lazy.force Frame.video_rate in
+  let internal_fps = Lazy.Mutexed.force Frame.video_rate in
   let internal_time_base = { Avutil.num = 1; den = internal_fps } in
   let video_width, video_height = Frame.video_dimensions () in
-  let internal_width = Lazy.force video_width in
-  let internal_height = Lazy.force video_height in
+  let internal_width = Lazy.Mutexed.force video_width in
+  let internal_height = Lazy.Mutexed.force video_height in
 
-  let target_fps = Lazy.force format.Ffmpeg_format.framerate in
+  let target_fps = Lazy.Mutexed.force format.Ffmpeg_format.framerate in
   let target_frame_rate = { Avutil.num = target_fps; den = 1 } in
-  let target_width = Lazy.force format.Ffmpeg_format.width in
-  let target_height = Lazy.force format.Ffmpeg_format.height in
+  let target_width = Lazy.Mutexed.force format.Ffmpeg_format.width in
+  let target_height = Lazy.Mutexed.force format.Ffmpeg_format.height in
   let target_pixel_aspect = { Avutil.num = 1; den = 1 } in
 
   let flag =
diff --git a/src/core/optionals/ffmpeg/encoder/ffmpeg_encoder_common.ml b/src/core/optionals/ffmpeg/encoder/ffmpeg_encoder_common.ml
index 745e953594..344233e2bb 100644
--- a/src/core/optionals/ffmpeg/encoder/ffmpeg_encoder_common.ml
+++ b/src/core/optionals/ffmpeg/encoder/ffmpeg_encoder_common.ml
@@ -272,7 +272,7 @@ let encoder ~pos ~hls_utils ~mk_streams ffmpeg meta =
                   let position =
                     Int64.of_int
                       (Frame.audio_of_main
-                         ((frame_position * Lazy.force Frame.size)
+                         ((frame_position * Lazy.Mutexed.force Frame.size)
                          + sample_position))
                   in
                   Avcodec.Packet.set_pts packet (Some position);
diff --git a/src/core/optionals/ffmpeg/encoder/ffmpeg_internal_encoder.ml b/src/core/optionals/ffmpeg/encoder/ffmpeg_internal_encoder.ml
index f046590d65..0d5878cd54 100644
--- a/src/core/optionals/ffmpeg/encoder/ffmpeg_internal_encoder.ml
+++ b/src/core/optionals/ffmpeg/encoder/ffmpeg_internal_encoder.ml
@@ -153,7 +153,7 @@ let mk_audio ~pos ~on_keyframe ~mode ~codec ~params ~options ~field output =
         | _ -> Printexc.raise_with_backtrace e bt)
   in
 
-  let target_samplerate = Lazy.force params.Ffmpeg_format.samplerate in
+  let target_samplerate = Lazy.Mutexed.force params.Ffmpeg_format.samplerate in
   let target_liq_audio_sample_time_base =
     { Avutil.num = 1; den = target_samplerate }
   in
@@ -169,7 +169,7 @@ let mk_audio ~pos ~on_keyframe ~mode ~codec ~params ~options ~field output =
   in
 
   let internal_converter () =
-    let src_samplerate = Lazy.force Frame.audio_rate in
+    let src_samplerate = Lazy.Mutexed.force Frame.audio_rate in
     (* The typing system ensures that this is the number of channels in the frame. *)
     let src_channels = params.Ffmpeg_format.channels in
     let src_channel_layout = get_channel_layout ~pos src_channels in
@@ -342,10 +342,10 @@ let mk_video ~pos ~on_keyframe ~mode ~codec ~params ~options ~field output =
   in
   let pixel_aspect = { Avutil.num = 1; den = 1 } in
 
-  let target_fps = Lazy.force params.Ffmpeg_format.framerate in
+  let target_fps = Lazy.Mutexed.force params.Ffmpeg_format.framerate in
   let target_video_frame_time_base = { Avutil.num = 1; den = target_fps } in
-  let target_width = Lazy.force params.Ffmpeg_format.width in
-  let target_height = Lazy.force params.Ffmpeg_format.height in
+  let target_width = Lazy.Mutexed.force params.Ffmpeg_format.width in
+  let target_height = Lazy.Mutexed.force params.Ffmpeg_format.height in
   let flag =
     match Ffmpeg_utils.scaling_algorithm () with
       | Some f -> f
@@ -495,8 +495,8 @@ let mk_video ~pos ~on_keyframe ~mode ~codec ~params ~options ~field output =
 
   let internal_converter cb =
     let video_width, video_height = Frame.video_dimensions () in
-    let src_width = Lazy.force video_width in
-    let src_height = Lazy.force video_height in
+    let src_width = Lazy.Mutexed.force video_width in
+    let src_height = Lazy.Mutexed.force video_height in
     let scaler = ref None in
     let nb_frames = ref 0L in
     let time_base = Ffmpeg_utils.liq_video_sample_time_base () in
diff --git a/src/core/optionals/ffmpeg/encoder/lang_ffmpeg.ml b/src/core/optionals/ffmpeg/encoder/lang_ffmpeg.ml
index 2afce8ad92..f93df34cfe 100644
--- a/src/core/optionals/ffmpeg/encoder/lang_ffmpeg.ml
+++ b/src/core/optionals/ffmpeg/encoder/lang_ffmpeg.ml
@@ -374,11 +374,17 @@ let ffmpeg_gen params =
           args
     | ("samplerate", t) :: args ->
         parse_audio_args ~opts
-          { options with Ffmpeg_format.samplerate = Lazy.from_val (to_int t) }
+          {
+            options with
+            Ffmpeg_format.samplerate = Lazy.Mutexed.from_val (to_int t);
+          }
           args
     | ("ar", t) :: args ->
         parse_audio_args ~opts
-          { options with Ffmpeg_format.samplerate = Lazy.from_val (to_int t) }
+          {
+            options with
+            Ffmpeg_format.samplerate = Lazy.Mutexed.from_val (to_int t);
+          }
           args
     | ("sample_format", t) :: args ->
         parse_audio_args ~opts
@@ -392,19 +398,31 @@ let ffmpeg_gen params =
     | [] -> options
     | ("framerate", t) :: args ->
         parse_video_args ~opts
-          { options with Ffmpeg_format.framerate = Lazy.from_val (to_int t) }
+          {
+            options with
+            Ffmpeg_format.framerate = Lazy.Mutexed.from_val (to_int t);
+          }
           args
     | ("r", t) :: args ->
         parse_video_args ~opts
-          { options with Ffmpeg_format.framerate = Lazy.from_val (to_int t) }
+          {
+            options with
+            Ffmpeg_format.framerate = Lazy.Mutexed.from_val (to_int t);
+          }
           args
     | ("width", t) :: args ->
         parse_video_args ~opts
-          { options with Ffmpeg_format.width = Lazy.from_val (to_int t) }
+          {
+            options with
+            Ffmpeg_format.width = Lazy.Mutexed.from_val (to_int t);
+          }
           args
     | ("height", t) :: args ->
         parse_video_args ~opts
-          { options with Ffmpeg_format.height = Lazy.from_val (to_int t) }
+          {
+            options with
+            Ffmpeg_format.height = Lazy.Mutexed.from_val (to_int t);
+          }
           args
     | ("pixel_format", String { value = "guess" }) :: args ->
         parse_video_args ~opts
diff --git a/src/core/optionals/ffmpeg/filter/ffmpeg_filter_graph.ml b/src/core/optionals/ffmpeg/filter/ffmpeg_filter_graph.ml
index dc66486a11..858b13794b 100644
--- a/src/core/optionals/ffmpeg/filter/ffmpeg_filter_graph.ml
+++ b/src/core/optionals/ffmpeg/filter/ffmpeg_filter_graph.ml
@@ -66,7 +66,8 @@ class source ~name ~pull ~is_ready ~flush_inputs ~reset ~self_sync () =
     (* Readiness must not tick anything: this is called from
        [before_streaming_cycle], where a clock tick is not ours to make. *)
     method private can_generate_frame =
-      Lazy.force Frame.size <= Generator.length self#buffer || is_ready ()
+      Lazy.Mutexed.force Frame.size <= Generator.length self#buffer
+      || is_ready ()
 
     (* One output can legitimately run ahead of another while a filter fills
        its lookahead, so we wait on the slowest. If they never converge the
@@ -91,7 +92,7 @@ class source ~name ~pull ~is_ready ~flush_inputs ~reset ~self_sync () =
     (* Ticking the inputs is what makes the outputs produce, hence the
        alternation. *)
     method private fill_buffer =
-      let size = Lazy.force Frame.size in
+      let size = Lazy.Mutexed.force Frame.size in
       let drain () =
         List.iter (fun sink -> sink.drain ~generator:self#buffer) sinks;
         self#check_buffer
@@ -132,7 +133,7 @@ class source ~name ~pull ~is_ready ~flush_inputs ~reset ~self_sync () =
       with Exit -> ()
 
     method private generate_frame =
-      let size = Lazy.force Frame.size in
+      let size = Lazy.Mutexed.force Frame.size in
       if Generator.length self#buffer < size then self#fill_buffer;
       Generator.slice self#buffer size
   end
diff --git a/src/core/optionals/ffmpeg/io/ffmpeg_io.ml b/src/core/optionals/ffmpeg/io/ffmpeg_io.ml
index 0f0243cbeb..c22e54dd10 100644
--- a/src/core/optionals/ffmpeg/io/ffmpeg_io.ml
+++ b/src/core/optionals/ffmpeg/io/ffmpeg_io.ml
@@ -210,13 +210,13 @@ class input ?(name = "input.ffmpeg") ~autostart ~self_sync ~poll_delay ~debug
 
     method private decode =
       let { decoder; buffer; closed; _ } = self#get_connected_container in
-      while Generator.length self#buffer < Lazy.force Frame.size do
+      while Generator.length self#buffer < Lazy.Mutexed.force Frame.size do
         if Atomic.get shutdown || Atomic.get closed then raise Not_connected;
         decoder.decode buffer
       done
 
     method private generate_frame =
-      let size = Lazy.force Frame.size in
+      let size = Lazy.Mutexed.force Frame.size in
       try
         self#decode;
         let frame = Generator.slice self#buffer size in
diff --git a/src/core/optionals/flac/flac_encoder.ml b/src/core/optionals/flac/flac_encoder.ml
index 422ceff265..11343e566e 100644
--- a/src/core/optionals/flac/flac_encoder.ml
+++ b/src/core/optionals/flac/flac_encoder.ml
@@ -30,7 +30,7 @@ let encoder flac meta =
   in
   let channels = flac.Flac_format.channels in
   let samplerate_converter = Audio_converter.Samplerate.create channels in
-  let samplerate = Lazy.force flac.Flac_format.samplerate in
+  let samplerate = Lazy.Mutexed.force flac.Flac_format.samplerate in
   let src_freq = float (Frame.audio_of_seconds 1.) in
   let dst_freq = float samplerate in
   let p =
diff --git a/src/core/optionals/frei0r/frei0r_op.ml b/src/core/optionals/frei0r/frei0r_op.ml
index 212332ab04..dcc1f3b8c3 100644
--- a/src/core/optionals/frei0r/frei0r_op.ml
+++ b/src/core/optionals/frei0r/frei0r_op.ml
@@ -43,7 +43,7 @@ let plugin_dirs =
   with Not_found -> Frei0r.default_paths
 
 class frei0r_filter ~name bgra instance params (source : source) =
-  let fps = Lazy.force Frame.video_rate in
+  let fps = Lazy.Mutexed.force Frame.video_rate in
   let dt = 1. /. float fps in
   object (self)
     inherit operator ~name:("frei0r." ^ name) [source]
@@ -82,7 +82,7 @@ class frei0r_filter ~name bgra instance params (source : source) =
   end
 
 class frei0r_mixer ~name bgra instance params (source : source) source2 =
-  let fps = Lazy.force Frame.video_rate in
+  let fps = Lazy.Mutexed.force Frame.video_rate in
   let dt = 1. /. float fps in
   let self_sync = Clock.self_sync_of_sources [source; source2] in
   object (self)
@@ -164,7 +164,7 @@ class frei0r_mixer ~name bgra instance params (source : source) source2 =
   end
 
 class frei0r_source ~name bgra instance params =
-  let fps = Lazy.force Frame.video_rate in
+  let fps = Lazy.Mutexed.force Frame.video_rate in
   let dt = 1. /. float fps in
   object (self)
     inherit source ~name:("frei0r." ^ name) ()
@@ -193,7 +193,7 @@ class frei0r_source ~name bgra instance params =
         self#end_of_track)
       else (
         params ();
-        let length = Lazy.force Frame.size in
+        let length = Lazy.Mutexed.force Frame.size in
         let buf = Frame.create ~length self#content_type in
         let rgb = self#generate_video ~field:Frame.Fields.video length in
         let data =
@@ -333,8 +333,8 @@ let register_plugin fname =
        ~category:`Video ~flags:[`Extra] ~descr (fun p ->
          let instance =
            let video_width, video_height = Frame.video_dimensions () in
-           let width = Lazy.force video_width in
-           let height = Lazy.force video_height in
+           let width = Lazy.Mutexed.force video_width in
+           let height = Lazy.Mutexed.force video_height in
            Frei0r.create plugin width height
          in
          let f v = List.assoc v p in
diff --git a/src/core/optionals/jack/jack_io.ml b/src/core/optionals/jack/jack_io.ml
index c28f165d4b..d425d97d25 100644
--- a/src/core/optionals/jack/jack_io.ml
+++ b/src/core/optionals/jack/jack_io.ml
@@ -196,7 +196,7 @@ class jack_port ~source ~is_input ~(unregister : unit -> unit) ~sample_rate
   end
 
 class jack_client ~id (server : string option) =
-  let liq_rate = Lazy.force Frame.audio_rate in
+  let liq_rate = Lazy.Mutexed.force Frame.audio_rate in
   object
     val mutable client : Jack.client option = None
     val mutable activated = false
@@ -252,14 +252,14 @@ class jack_client ~id (server : string option) =
       int_of_float
         (Float.floor
            (float frames
-           *. float (Lazy.force Frame.audio_rate)
+           *. float (Lazy.Mutexed.force Frame.audio_rate)
            /. float sample_rate))
 
     method frames_of_main ticks =
       int_of_float
         (Float.floor
            (float ticks *. float sample_rate
-           /. float (Lazy.force Frame.audio_rate)))
+           /. float (Lazy.Mutexed.force Frame.audio_rate)))
   end
 
 type port_content = {
@@ -365,7 +365,7 @@ module Jack_output_port_value =
 
 class virtual base ~server () =
   let { server_state; sync_source } = get_server_data server in
-  let samples_per_second = Lazy.force Frame.audio_rate in
+  let samples_per_second = Lazy.Mutexed.force Frame.audio_rate in
   object (self)
     method virtual log : Log.t
     method virtual audio_channels : int
@@ -433,7 +433,8 @@ class virtual base ~server () =
     method private prefill_silence =
       let jack_client = self#jack_client in
       let n_samples =
-        int_of_float (Lazy.force Frame.duration *. float jack_client#sample_rate)
+        int_of_float
+          (Lazy.Mutexed.force Frame.duration *. float jack_client#sample_rate)
       in
       (* Add one JACK buffer of padding to cover reads and writes that land in
          the middle of a JACK buffer. This can be skipped when the sample rates
@@ -489,7 +490,7 @@ class input ~server ~autostart =
     method private can_generate_frame =
       if active_source#started then begin
         self#drain_ringbuffer;
-        Generator.length self#buffer >= Lazy.force Frame.size
+        Generator.length self#buffer >= Lazy.Mutexed.force Frame.size
       end
       else false
 
@@ -531,7 +532,7 @@ class input ~server ~autostart =
       end
 
     method private generate_frame =
-      let frame_size = Lazy.force Frame.size in
+      let frame_size = Lazy.Mutexed.force Frame.size in
       while Generator.length self#buffer < frame_size do
         if self#jack_stopped then raise Clock.Has_stopped;
         self#drain_ringbuffer;
diff --git a/src/core/optionals/ladspa/ladspa_op.ml b/src/core/optionals/ladspa/ladspa_op.ml
index 8eda77c869..1413576ab7 100644
--- a/src/core/optionals/ladspa/ladspa_op.ml
+++ b/src/core/optionals/ladspa/ladspa_op.ml
@@ -106,7 +106,7 @@ class ladspa_mono (source : source) plugin descr input output params =
               (Content.Audio.channels_of_format
                  (Option.get
                     (Frame.Fields.find_opt Frame.Fields.audio self#content_type)))
-              (fun _ -> instantiate d (Lazy.force Frame.audio_rate))
+              (fun _ -> instantiate d (Lazy.Mutexed.force Frame.audio_rate))
           in
           Array.iter Descriptor.activate i;
           inst <- Some i)
@@ -137,7 +137,7 @@ class ladspa (source : source) plugin descr inputs outputs params =
     val inst =
       let p = Plugin.load plugin in
       let d = Descriptor.descriptor p descr in
-      instantiate d (Lazy.force Frame.audio_rate)
+      instantiate d (Lazy.Mutexed.force Frame.audio_rate)
 
     initializer Descriptor.activate inst
 
@@ -177,7 +177,7 @@ class ladspa_nosource plugin descr outputs params =
     val inst =
       let p = Plugin.load plugin in
       let d = Descriptor.descriptor p descr in
-      instantiate d (Lazy.force Frame.audio_rate)
+      instantiate d (Lazy.Mutexed.force Frame.audio_rate)
 
     initializer Descriptor.activate inst
 
@@ -186,7 +186,7 @@ class ladspa_nosource plugin descr outputs params =
         must_fail <- false;
         self#end_of_track)
       else (
-        let length = Lazy.force Frame.size in
+        let length = Lazy.Mutexed.force Frame.size in
         let buf = Frame.create ~length self#content_type in
         let b = Content.Audio.get_data (Frame.get buf Frame.Fields.audio) in
         List.iter
diff --git a/src/core/optionals/lame/lame_encoder.ml b/src/core/optionals/lame/lame_encoder.ml
index 9e7c779cfb..e16b352872 100644
--- a/src/core/optionals/lame/lame_encoder.ml
+++ b/src/core/optionals/lame/lame_encoder.ml
@@ -29,7 +29,7 @@ let () =
   let create_encoder mp3 =
     let enc = Lame.create_encoder () in
     (* Input settings *)
-    Lame.set_in_samplerate enc (Lazy.force Frame.audio_rate);
+    Lame.set_in_samplerate enc (Lazy.Mutexed.force Frame.audio_rate);
     Lame.set_num_channels enc (if mp3.Mp3_format.stereo then 2 else 1);
 
     (* Internal quality *)
@@ -70,7 +70,7 @@ let () =
             Lame.set_vbr_mode enc Lame.Vbr_abr;
             apply_constaints enc c
     end;
-    Lame.set_out_samplerate enc (Lazy.force mp3.Mp3_format.samplerate);
+    Lame.set_out_samplerate enc (Lazy.Mutexed.force mp3.Mp3_format.samplerate);
     Lame.set_bWriteVbrTag enc false;
     Lame.init_params enc;
     enc
diff --git a/src/core/optionals/lilv/lilv_op.ml b/src/core/optionals/lilv/lilv_op.ml
index bf054088a5..8286b6d53f 100644
--- a/src/core/optionals/lilv/lilv_op.ml
+++ b/src/core/optionals/lilv/lilv_op.ml
@@ -75,7 +75,7 @@ class lilv_mono (source : source) plugin input output params =
                     (Frame.Fields.find_opt Frame.Fields.audio self#content_type)))
               (fun _ ->
                 Plugin.instantiate plugin
-                  (float_of_int (Lazy.force Frame.audio_rate)))
+                  (float_of_int (Lazy.Mutexed.force Frame.audio_rate)))
           in
           Array.iter Plugin.Instance.activate i;
           inst <- Some i)
@@ -107,7 +107,8 @@ class lilv (source : source) plugin inputs outputs params =
     inherit base source
 
     val inst =
-      Plugin.instantiate plugin (float_of_int (Lazy.force Frame.audio_rate))
+      Plugin.instantiate plugin
+        (float_of_int (Lazy.Mutexed.force Frame.audio_rate))
 
     initializer Plugin.Instance.activate inst
 
@@ -156,7 +157,8 @@ class lilv_nosource plugin outputs params =
     method self_sync = (`Static, None)
 
     val inst =
-      Plugin.instantiate plugin (float_of_int (Lazy.force Frame.audio_rate))
+      Plugin.instantiate plugin
+        (float_of_int (Lazy.Mutexed.force Frame.audio_rate))
 
     initializer Plugin.Instance.activate inst
 
@@ -165,7 +167,7 @@ class lilv_nosource plugin outputs params =
         must_fail <- false;
         self#end_of_track)
       else (
-        let length = Lazy.force Frame.size in
+        let length = Lazy.Mutexed.force Frame.size in
         let buf = Frame.create ~length self#content_type in
         let b = Content.Audio.get_data (Frame.get buf Frame.Fields.audio) in
         let chans = Array.length b in
@@ -191,7 +193,8 @@ class lilv_noout source plugin inputs params =
     inherit base source
 
     val inst =
-      Plugin.instantiate plugin (float_of_int (Lazy.force Frame.audio_rate))
+      Plugin.instantiate plugin
+        (float_of_int (Lazy.Mutexed.force Frame.audio_rate))
 
     initializer Plugin.Instance.activate inst
 
diff --git a/src/core/optionals/ndi/ndi_out.ml b/src/core/optionals/ndi/ndi_out.ml
index 4007f078d5..6683352237 100644
--- a/src/core/optionals/ndi/ndi_out.ml
+++ b/src/core/optionals/ndi/ndi_out.ml
@@ -41,14 +41,14 @@ type sender = { handler : Ndi.Send.sender; mutable position : int64 }
 class output ~self_sync ~register_telnet ~name ~groups ~infallible ~handler
   ~format source start =
   let s = Lang.to_source source in
-  let sample_rate = Lazy.force Frame.audio_rate in
-  let frame_rate = Lazy.force Frame.video_rate in
+  let sample_rate = Lazy.Mutexed.force Frame.audio_rate in
+  let frame_rate = Lazy.Mutexed.force Frame.video_rate in
   let video_width, video_height = Frame.video_dimensions () in
-  let video_height = Lazy.force video_height in
-  let video_width = Lazy.force video_width in
+  let video_height = Lazy.Mutexed.force video_height in
+  let video_width = Lazy.Mutexed.force video_width in
   (* Timecode is in increment of 100 ns *)
   let timecode_base =
-    Int64.div 10_000_000L (Int64.of_int (Lazy.force Frame.main_rate))
+    Int64.div 10_000_000L (Int64.of_int (Lazy.Mutexed.force Frame.main_rate))
   in
   let clock_audio, clock_video =
     match (self_sync, format.audio, format.video) with
diff --git a/src/core/optionals/ogg/liq_ogg_decoder.ml b/src/core/optionals/ogg/liq_ogg_decoder.ml
index 768201ed14..02a9bb4969 100644
--- a/src/core/optionals/ogg/liq_ogg_decoder.ml
+++ b/src/core/optionals/ogg/liq_ogg_decoder.ml
@@ -55,8 +55,8 @@ let video_convert scale =
   let converter = converter () in
   let video_width, video_height = Frame.video_dimensions () in
   fun buf ->
-    let width = Lazy.force video_width in
-    let height = Lazy.force video_height in
+    let width = Lazy.Mutexed.force video_width in
+    let height = Lazy.Mutexed.force video_height in
     if buf.Ogg_decoder.format <> Ogg_decoder.Yuvj_420 then (
       let img =
         Image.YUV420.make buf.Ogg_decoder.frame_width
diff --git a/src/core/optionals/ogg_flac/ogg_flac_encoder.ml b/src/core/optionals/ogg_flac/ogg_flac_encoder.ml
index 944bae7642..a2e4e186e6 100644
--- a/src/core/optionals/ogg_flac/ogg_flac_encoder.ml
+++ b/src/core/optionals/ogg_flac/ogg_flac_encoder.ml
@@ -24,7 +24,7 @@ external set_stream_eos : Ogg.Stream.stream -> unit
   = "liq_ocaml_ogg_stream_set_eos"
 
 let create_encoder ~flac ~comments () =
-  let samplerate = Lazy.force flac.Flac_format.samplerate in
+  let samplerate = Lazy.Mutexed.force flac.Flac_format.samplerate in
   let p =
     {
       Flac.Encoder.channels = flac.Flac_format.channels;
@@ -57,7 +57,7 @@ let create_encoder ~flac ~comments () =
           x
   in
   let empty_data () =
-    Array.make (Lazy.force Frame.audio_channels) (Array.make 1 0.)
+    Array.make (Lazy.Mutexed.force Frame.audio_channels) (Array.make 1 0.)
   in
   let header_encoder os =
     match get_enc os with
@@ -118,7 +118,7 @@ let create_flac = function
         Ogg_muxer.register_track ?fill:flac.Flac_format.fill ogg_enc enc
       in
       let src_freq = float (Frame.audio_of_seconds 1.) in
-      let dst_freq = float (Lazy.force flac.Flac_format.samplerate) in
+      let dst_freq = float (Lazy.Mutexed.force flac.Flac_format.samplerate) in
       let channels = flac.Flac_format.channels in
       let encode = Ogg_encoder.encode_audio ~channels ~dst_freq ~src_freq () in
       { Ogg_encoder.encode; reset; id = None }
diff --git a/src/core/optionals/opus/liq_opus_decoder.ml b/src/core/optionals/opus/liq_opus_decoder.ml
index 0a7cb33532..86955630df 100644
--- a/src/core/optionals/opus/liq_opus_decoder.ml
+++ b/src/core/optionals/opus/liq_opus_decoder.ml
@@ -24,7 +24,7 @@ let samplerates = [8000; 12000; 16000; 24000; 48000]
 
 let () =
   Lifecycle.on_start ~name:"opus decoder initialization" (fun () ->
-      let rate = Lazy.force Frame.audio_rate in
+      let rate = Lazy.Mutexed.force Frame.audio_rate in
       let rec f = function
         | [] -> 48000
         | x :: l when x < rate -> f l
diff --git a/src/core/optionals/opus/opus_encoder.ml b/src/core/optionals/opus/opus_encoder.ml
index fb2477b84e..a4748490ce 100644
--- a/src/core/optionals/opus/opus_encoder.ml
+++ b/src/core/optionals/opus/opus_encoder.ml
@@ -101,7 +101,8 @@ let create_encoder ~opus ~comments () =
     {
       Ogg_muxer.offset = 0;
       length = 1;
-      data = Array.make (Lazy.force Frame.audio_channels) (Array.make 1 0.);
+      data =
+        Array.make (Lazy.Mutexed.force Frame.audio_channels) (Array.make 1 0.);
     }
   in
   let end_of_page p =
diff --git a/src/core/optionals/oss/oss_io.ml b/src/core/optionals/oss/oss_io.ml
index 81cc8e7909..372940ff36 100644
--- a/src/core/optionals/oss/oss_io.ml
+++ b/src/core/optionals/oss/oss_io.ml
@@ -45,7 +45,7 @@ let force f fd x =
 
 class output ~self_sync ~infallible ~register_telnet ~start dev val_source =
   let s = Lang.to_source val_source in
-  let samples_per_second = Lazy.force Frame.audio_rate in
+  let samples_per_second = Lazy.Mutexed.force Frame.audio_rate in
   let name = Printf.sprintf "oss_out(%s)" dev in
   object (self)
     inherit
@@ -88,7 +88,7 @@ class output ~self_sync ~infallible ~register_telnet ~start dev val_source =
   end
 
 class input ~self_sync ~start ~fallible dev =
-  let samples_per_second = Lazy.force Frame.audio_rate in
+  let samples_per_second = Lazy.Mutexed.force Frame.audio_rate in
   object (self)
     inherit
       Start_stop.active_source
@@ -121,7 +121,7 @@ class input ~self_sync ~start ~fallible dev =
       fd <- None
 
     method generate_frame =
-      let length = Lazy.force Frame.size in
+      let length = Lazy.Mutexed.force Frame.size in
       let frame = Frame.create ~length self#content_type in
       let buf = Content.Audio.get_data (Frame.get frame Frame.Fields.audio) in
       let fd = Option.get fd in
diff --git a/src/core/optionals/portaudio/portaudio_io.ml b/src/core/optionals/portaudio/portaudio_io.ml
index b8538a8ef4..c8f43d093b 100644
--- a/src/core/optionals/portaudio/portaudio_io.ml
+++ b/src/core/optionals/portaudio/portaudio_io.ml
@@ -92,7 +92,7 @@ class virtual base =
 
     method get_device ~(mode : [ `Input | `Output ]) ~latency ~channels ~buflen
         ~device_name ~device_id =
-      let samples_per_second = Lazy.force Frame.audio_rate in
+      let samples_per_second = Lazy.Mutexed.force Frame.audio_rate in
       let device_id =
         let device_name_value = device_name in
         let device_name = Lang.to_valued_option Lang.to_string device_name in
@@ -270,7 +270,7 @@ class input ~self_sync ~start ~fallible ~device_name ~device_id ~latency buflen
       stream <- None
 
     method generate_frame =
-      let size = Lazy.force Frame.size in
+      let size = Lazy.Mutexed.force Frame.size in
       let frame = Frame.create ~length:size self#content_type in
       let buf = Content.Audio.get_data (Frame.get frame Frame.Fields.audio) in
       let stream = Option.get stream in
diff --git a/src/core/optionals/prometheus/builtins_prometheus.ml b/src/core/optionals/prometheus/builtins_prometheus.ml
index 9a195584c5..c94aace687 100644
--- a/src/core/optionals/prometheus/builtins_prometheus.ml
+++ b/src/core/optionals/prometheus/builtins_prometheus.ml
@@ -159,7 +159,7 @@ let source_monitor ~prefix ~label_names ~labels ~window s =
     in
     add_latency
   in
-  let frame_duration = Lazy.force Frame.duration in
+  let frame_duration = Lazy.Mutexed.force Frame.duration in
   let add_input_latency = track_latency "input" in
   let add_output_latency = track_latency "output" in
   let add_overall_latency = track_latency "overall" in
diff --git a/src/core/optionals/pulseaudio/pulseaudio_io.ml b/src/core/optionals/pulseaudio/pulseaudio_io.ml
index 976ec2fafb..c139ede1aa 100644
--- a/src/core/optionals/pulseaudio/pulseaudio_io.ml
+++ b/src/core/optionals/pulseaudio/pulseaudio_io.ml
@@ -77,7 +77,7 @@ class output ~infallible ~register_telnet ~start p =
       (match device with None -> "(default)" | Some s -> s)
   in
   let val_source = List.assoc "" p in
-  let samples_per_second = Lazy.force Frame.audio_rate in
+  let samples_per_second = Lazy.Mutexed.force Frame.audio_rate in
   let self_sync = Lang.to_bool (List.assoc "self_sync" p) in
   object (self)
     inherit
@@ -164,7 +164,7 @@ class input p =
   let self_sync = Lang.to_bool (List.assoc "self_sync" p) in
   let start = Lang.to_bool (List.assoc "start" p) in
   let fallible = Lang.to_bool (List.assoc "fallible" p) in
-  let samples_per_second = Lazy.force Frame.audio_rate in
+  let samples_per_second = Lazy.Mutexed.force Frame.audio_rate in
   object (self)
     inherit
       Start_stop.active_source
@@ -220,7 +220,7 @@ class input p =
 
     method generate_frame =
       try
-        let size = Lazy.force Frame.size in
+        let size = Lazy.Mutexed.force Frame.size in
         let frame = Frame.create ~length:size self#content_type in
         let buf = Content.Audio.get_data (Frame.get frame Frame.Fields.audio) in
         let stream = Option.get stream in
diff --git a/src/core/optionals/shine/shine_encoder.ml b/src/core/optionals/shine/shine_encoder.ml
index 7941e71ca5..26e31e77a9 100644
--- a/src/core/optionals/shine/shine_encoder.ml
+++ b/src/core/optionals/shine/shine_encoder.ml
@@ -29,7 +29,7 @@ let create_encoder ~samplerate ~bitrate ~channels =
 
 let encoder ~pos shine =
   let channels = shine.channels in
-  let samplerate = Lazy.force shine.samplerate in
+  let samplerate = Lazy.Mutexed.force shine.samplerate in
   let enc = create_encoder ~samplerate ~bitrate:shine.bitrate ~channels in
   let samplerate_converter = Audio_converter.Samplerate.create channels in
   let src_freq = float (Frame.audio_of_seconds 1.) in
diff --git a/src/core/optionals/soundtouch/soundtouch_op.ml b/src/core/optionals/soundtouch/soundtouch_op.ml
index ffb6bdad3f..45461d1df9 100644
--- a/src/core/optionals/soundtouch/soundtouch_op.ml
+++ b/src/core/optionals/soundtouch/soundtouch_op.ml
@@ -68,7 +68,7 @@ class soundtouch source_val rate tempo pitch =
           st <-
             Some
               (Soundtouch.make self#audio_channels
-                 (Lazy.force Frame.audio_rate));
+                 (Lazy.Mutexed.force Frame.audio_rate));
           self#log#important "Using soundtouch %s."
             (Soundtouch.get_version_string (Option.get st));
           self#child#set_process_frame (fun generator -> function
diff --git a/src/core/optionals/soundtouch/st_bpm.ml b/src/core/optionals/soundtouch/st_bpm.ml
index 1c07298cb6..485af1c82f 100644
--- a/src/core/optionals/soundtouch/st_bpm.ml
+++ b/src/core/optionals/soundtouch/st_bpm.ml
@@ -42,7 +42,7 @@ class bpm (source : source) =
                     (Option.get
                        (Frame.Fields.find_opt Frame.Fields.audio
                           self#content_type)))
-                 (Lazy.force Frame.audio_rate)))
+                 (Lazy.Mutexed.force Frame.audio_rate)))
 
     method private generate_frame =
       let buf =
diff --git a/src/core/optionals/speex/speex_encoder.ml b/src/core/optionals/speex/speex_encoder.ml
index b32cff9494..8048f5a092 100644
--- a/src/core/optionals/speex/speex_encoder.ml
+++ b/src/core/optionals/speex/speex_encoder.ml
@@ -37,7 +37,7 @@ let create speex ~metadata () =
       | _ -> false
   in
   let channels = if speex.Speex_format.stereo then 2 else 1 in
-  let rate = Lazy.force speex.Speex_format.samplerate in
+  let rate = Lazy.Mutexed.force speex.Speex_format.samplerate in
   let header =
     Speex.Header.init ~frames_per_packet ~mode ~vbr ~nb_channels:channels ~rate
       ()
@@ -172,7 +172,7 @@ let create_speex = function
       in
       let channels = if speex.Speex_format.stereo then 2 else 1 in
       let src_freq = float (Frame.audio_of_seconds 1.) in
-      let dst_freq = float (Lazy.force speex.Speex_format.samplerate) in
+      let dst_freq = float (Lazy.Mutexed.force speex.Speex_format.samplerate) in
       let encode = Ogg_encoder.encode_audio ~channels ~dst_freq ~src_freq () in
       { Ogg_encoder.reset; encode; id = None }
   | _ -> assert false
diff --git a/src/core/optionals/srt/srt_io.ml b/src/core/optionals/srt/srt_io.ml
index 4994fb745d..cc5ba7c39c 100644
--- a/src/core/optionals/srt/srt_io.ml
+++ b/src/core/optionals/srt/srt_io.ml
@@ -540,27 +540,27 @@ module Poll = struct
 end
 
 let init =
-  lazy
-    (Lifecycle.on_start ~name:"srt initialization" (fun () ->
-         Srt.startup ();
-         if conf_log#get then (
-           let level =
-             match conf_verbosity#get with
-               | "critical" -> `Critical
-               | "error" -> `Error
-               | "warning" -> `Warning
-               | "notice" -> `Notice
-               | "debug" -> `Debug
-               | _ ->
-                   log#severe "Invalid value for \"srt.log.verbosity\"!";
-                   `Error
-           in
-           Srt.Log.setloglevel level;
-           Srt.Log.set_handler log_handler));
-
-     Lifecycle.on_final_cleanup ~name:"set cleanup" (fun () ->
-         Srt.Poll.release Poll.t.Poll.p;
-         Srt.cleanup ()))
+  Lazy.Mutexed.from_fun (fun () ->
+      Lifecycle.on_start ~name:"srt initialization" (fun () ->
+          Srt.startup ();
+          if conf_log#get then (
+            let level =
+              match conf_verbosity#get with
+                | "critical" -> `Critical
+                | "error" -> `Error
+                | "warning" -> `Warning
+                | "notice" -> `Notice
+                | "debug" -> `Debug
+                | _ ->
+                    log#severe "Invalid value for \"srt.log.verbosity\"!";
+                    `Error
+            in
+            Srt.Log.setloglevel level;
+            Srt.Log.set_handler log_handler));
+
+      Lifecycle.on_final_cleanup ~name:"set cleanup" (fun () ->
+          Srt.Poll.release Poll.t.Poll.p;
+          Srt.cleanup ()))
 
 let string_of_address = function
   | Unix.ADDR_UNIX _ -> assert false
@@ -591,7 +591,7 @@ let id =
   fun () -> Atomic.fetch_and_add counter 1
 
 class virtual base () =
-  let () = Lazy.force init in
+  let () = Lazy.Mutexed.force init in
   object
     val should_stop = Atomic.make false
     val id = id ()
@@ -970,7 +970,7 @@ class virtual input_base ~max ~self_sync ~payload_size ~dump ~autostart format =
       create_decoder { Decoder.read; tell = None; length = None; lseek = None }
 
     method private generate_frame =
-      let size = Lazy.force Frame.size in
+      let size = Lazy.Mutexed.force Frame.size in
       try
         let _, socket = self#get_socket in
         let decoder, buffer =
diff --git a/src/core/optionals/stereotool/stereotool_op.ml b/src/core/optionals/stereotool/stereotool_op.ml
index a317ad0a99..a6a68910a2 100644
--- a/src/core/optionals/stereotool/stereotool_op.ml
+++ b/src/core/optionals/stereotool/stereotool_op.ml
@@ -34,12 +34,12 @@ class virtual base ~field ~handler (source : Source.source) =
     method virtual log : Log.t
 
     val config =
-      Lazy.from_fun (fun () ->
+      Lazy.Mutexed.from_fun (fun () ->
           (* This is computed first to inject some audio data. *)
           let latency =
             Frame.seconds_of_audio
               (Stereotool.latency
-                 ~samplerate:(Lazy.force Frame.audio_rate)
+                 ~samplerate:(Lazy.Mutexed.force Frame.audio_rate)
                  ~feed_silence:true handler)
           in
           {
@@ -51,7 +51,7 @@ class virtual base ~field ~handler (source : Source.source) =
             software_version = Stereotool.software_version handler;
           })
 
-    method config = Lazy.force config
+    method config = Lazy.Mutexed.force config
 
     initializer
       self#on_wake_up (fun () ->
@@ -83,7 +83,7 @@ class virtual base ~field ~handler (source : Source.source) =
     method private generate_frame =
       let b = Content.Audio.get_data (source#get_mutable_content field) in
       Stereotool.process
-        ~samplerate:(Lazy.force Frame.audio_rate)
+        ~samplerate:(Lazy.Mutexed.force Frame.audio_rate)
         handler b 0 source#frame_audio_position;
       source#set_frame_data field Content.Audio.lift_data b
   end
diff --git a/src/core/optionals/theora/theora_encoder.ml b/src/core/optionals/theora/theora_encoder.ml
index bd513e5b0f..0362974558 100644
--- a/src/core/optionals/theora/theora_encoder.ml
+++ b/src/core/optionals/theora/theora_encoder.ml
@@ -29,10 +29,10 @@ let create_encoder ~theora ~metadata () =
       | Theora_format.Bitrate x -> (0, x)
       | Theora_format.Quality x -> (x, 0)
   in
-  let width = Lazy.force theora.Theora_format.width in
-  let height = Lazy.force theora.Theora_format.height in
-  let picture_width = Lazy.force theora.Theora_format.picture_width in
-  let picture_height = Lazy.force theora.Theora_format.picture_height in
+  let width = Lazy.Mutexed.force theora.Theora_format.width in
+  let height = Lazy.Mutexed.force theora.Theora_format.height in
+  let picture_width = Lazy.Mutexed.force theora.Theora_format.picture_width in
+  let picture_height = Lazy.Mutexed.force theora.Theora_format.picture_height in
   let picture_x = theora.Theora_format.picture_x in
   let picture_y = theora.Theora_format.picture_y in
   let aspect_numerator = theora.Theora_format.aspect_numerator in
diff --git a/src/core/optionals/vorbis/vorbis_encoder.ml b/src/core/optionals/vorbis/vorbis_encoder.ml
index 561025d47a..369073800c 100644
--- a/src/core/optionals/vorbis/vorbis_encoder.ml
+++ b/src/core/optionals/vorbis/vorbis_encoder.ml
@@ -46,7 +46,7 @@ let create_gen enc freq m =
     Vorbis.Encoder.encode_buffer_float enc os b ofs len
   in
   let empty_data () =
-    Array.make (Lazy.force Frame.audio_channels) (Array.make 1 0.)
+    Array.make (Lazy.Mutexed.force Frame.audio_channels) (Array.make 1 0.)
   in
   let end_of_page p =
     let granulepos = Ogg.Page.granulepos p in
@@ -92,7 +92,7 @@ let create ~channels ~samplerate ~quality ~metadata () =
 let create_vorbis = function
   | Ogg_format.Vorbis vorbis ->
       let channels = vorbis.Vorbis_format.channels in
-      let samplerate = Lazy.force vorbis.Vorbis_format.samplerate in
+      let samplerate = Lazy.Mutexed.force vorbis.Vorbis_format.samplerate in
       let reset ogg_enc m =
         let m = Frame.Metadata.Export.to_metadata m in
         let metas = Hashtbl.create 0 in
diff --git a/src/core/outputs/harbor_output.ml b/src/core/outputs/harbor_output.ml
index 268ca01ce7..5fe642273a 100644
--- a/src/core/outputs/harbor_output.ml
+++ b/src/core/outputs/harbor_output.ml
@@ -20,8 +20,6 @@
 
  *****************************************************************************)
 
-let ( let* ) = Duppy.Monad.bind
-
 module Http = Liq_http
 
 let log = Log.make ["harbor"; "output"]
@@ -34,7 +32,6 @@ let () =
 (** Output to harbor listeners. *)
 
 module Task = Duppy.Task
-module Duppy = Harbor.Http_transport.Duppy
 
 module Icecast = struct
   type protocol = unit
@@ -427,7 +424,7 @@ class virtual ['a] base p =
           metadata_interval:int option ->
           stream_url:string option ->
           timeout:float ->
-          ('a listener, Harbor.reply) Duppy.Monad.t
+          'a listener
 
     (* Called when a listener disconnects. Subclasses stop any per-listener
        encoder. *)
@@ -640,47 +637,38 @@ class virtual ['a] base p =
           encoder_data.format icy_header extra_headers_str
       in
       let close () = try Harbor.close socket with _ -> () in
-      let handler =
-        {
-          Duppy.Monad.Io.scheduler = Tutils.scheduler;
-          socket;
-          data = "";
-          on_error =
-            (fun e ->
-              let error_msg =
-                match e with
-                  | Duppy.Io.Timeout ->
-                      Printf.sprintf "Timeout for %s" client_id
-                  | Duppy.Io.Io_error ->
-                      Printf.sprintf "I/O error for %s" client_id
-                  | Duppy.Io.Unix (c, p, m, _) ->
-                      Printf.sprintf "Unix error for %s: %s" client_id
-                        (Printexc.to_string (Unix.Unix_error (c, p, m)))
-                  | Duppy.Io.Unknown (e, _) -> Printexc.to_string e
-              in
-              self#log#info "%s" error_msg;
-              List.find_opt (fun l -> l.id = client_id) (Atomic.get listeners)
-              |> Option.iter self#handle_disconnect;
-              Harbor.Close (Harbor.mk_simple ""));
-        }
+      let on_failure exn =
+        let error_msg =
+          match exn with
+            | Duppy.Io.Error Duppy.Io.Timeout ->
+                Printf.sprintf "Timeout for %s" client_id
+            | Duppy.Io.Error Duppy.Io.Io_error ->
+                Printf.sprintf "I/O error for %s" client_id
+            | Duppy.Io.Error (Duppy.Io.Unix (c, p, m, _)) ->
+                Printf.sprintf "Unix error for %s: %s" client_id
+                  (Printexc.to_string (Unix.Unix_error (c, p, m)))
+            | e -> Printexc.to_string e
+        in
+        self#log#info "%s" error_msg;
+        List.find_opt (fun l -> l.id = client_id) (Atomic.get listeners)
+        |> Option.iter self#handle_disconnect;
+        Harbor.simple_reply ""
       in
       self#log#info "New listener connection from %s" client_id;
-      let* () =
-        match login with
-          | Some login ->
-              Duppy.Monad.catch
-                (Duppy.Monad.Io.exec ~priority:`Maybe_blocking handler
-                   (Harbor.http_auth_check ~query ~meth:"GET" ~uri:request_uri
-                      ~login socket headers))
-                (function
-                  | Harbor.Close s ->
-                      self#log#info "Listener %s failed to authenticate"
-                        client_id;
-                      Harbor.reply s
-                  | _ -> assert false)
-          | None -> Duppy.Monad.return ()
-      in
-      let* listener =
+      (match login with
+        | Some login -> (
+            Duppy.reschedule ~priority:`Maybe_blocking Tutils.scheduler;
+            try
+              Harbor.http_auth_check ~query ~meth:"GET" ~uri:request_uri ~login
+                socket headers
+            with
+              | Harbor.Reply (Harbor.Close s) ->
+                  self#log#info "Listener %s failed to authenticate" client_id;
+                  Harbor.reply s
+              | Harbor.Reply _ as e -> raise e
+              | e -> on_failure e)
+        | None -> ());
+      let listener =
         self#create_listener ~protocol ~id:client_id ~socket ~close
           ~metadata_interval ~stream_url ~timeout
       in
@@ -701,7 +689,8 @@ class virtual ['a] base p =
       List.iter
         (fun fn -> fn ~headers ~uri:request_uri ~protocol client_id)
         (Callbacks.elements on_connect_callbacks);
-      Duppy.Monad.Io.exec ~priority:`Maybe_blocking handler (Harbor.custom ())
+      Duppy.reschedule ~priority:`Maybe_blocking Tutils.scheduler;
+      Harbor.custom ()
 
     method private register_http_handler =
       Harbor.add_http_handler ~pos ~transport ~port ~verb:`Get ~uri
@@ -729,9 +718,8 @@ class shared_output p =
             Harbor.reply (fun () ->
                 Printf.sprintf "HTTP/%s 404 Not found\r\n" protocol)
         | Some _ ->
-            Duppy.Monad.return
-              (create_listener ~encoder:() ~id ~socket ~close ~metadata_interval
-                 ~stream_url ~timeout)
+            create_listener ~encoder:() ~id ~socket ~close ~metadata_interval
+              ~stream_url ~timeout
 
     method private connect_listener listener =
       let e = Option.get enc in
@@ -836,9 +824,8 @@ class dedicated_output p =
                 Printf.sprintf "HTTP/%s 404 Not found\r\n" protocol)
         | Some factory ->
             let encoder = factory Frame.Metadata.Export.empty in
-            Duppy.Monad.return
-              (create_listener ~encoder ~id ~socket ~close ~metadata_interval
-                 ~stream_url ~timeout)
+            create_listener ~encoder ~id ~socket ~close ~metadata_interval
+              ~stream_url ~timeout
 
     method private connect_listener listener =
       let burst =
diff --git a/src/core/outputs/hls_output.ml b/src/core/outputs/hls_output.ml
index 0b76dd03fe..c40f62cf6d 100644
--- a/src/core/outputs/hls_output.ml
+++ b/src/core/outputs/hls_output.ml
@@ -329,9 +329,9 @@ type stream = {
   name : string;
   format : Encoder.format;
   encoder : Encoder.encoder;
-  video_size : (int * int) option Lazy.t;
-  bandwidth : int Lazy.t;
-  codecs : string Lazy.t;  (** codecs (see RFC 6381) *)
+  video_size : (int * int) option Lazy.Mutexed.t;
+  bandwidth : int Lazy.Mutexed.t;
+  codecs : string Lazy.Mutexed.t;  (** codecs (see RFC 6381) *)
   extname : string;
   id3_enabled : bool;
   replay_id3 : bool;
@@ -388,10 +388,11 @@ class hls_output p =
                (fun stream ->
                  Lang.meth (Lang.string stream.name)
                    [
-                     ("bandwidth", Lang.int (Lazy.force stream.bandwidth));
-                     ("codecs", Lang.string (Lazy.force stream.codecs));
+                     ( "bandwidth",
+                       Lang.int (Lazy.Mutexed.force stream.bandwidth) );
+                     ("codecs", Lang.string (Lazy.Mutexed.force stream.codecs));
                      ( "video_size",
-                       match Lazy.force stream.video_size with
+                       match Lazy.Mutexed.force stream.video_size with
                          | None -> Lang.null
                          | Some (w, h) -> Lang.product (Lang.int w) (Lang.int h)
                      );
@@ -465,9 +466,9 @@ class hls_output p =
   (* better choice? *)
   let segment_duration = Lang.to_float (List.assoc "segment_duration" p) in
   let segment_ticks =
-    Frame.main_of_seconds segment_duration / Lazy.force Frame.size
+    Frame.main_of_seconds segment_duration / Lazy.Mutexed.force Frame.size
   in
-  let segment_main_duration = segment_ticks * Lazy.force Frame.size in
+  let segment_main_duration = segment_ticks * Lazy.Mutexed.force Frame.size in
   let segment_duration = Frame.seconds_of_main segment_main_duration in
   let segment_name = Lang.to_fun (List.assoc "segment_name" p) in
   let segment_name ~position ~extname ~duration ~ticks sname =
@@ -509,7 +510,7 @@ class hls_output p =
           Frame.Metadata.Export.empty
       in
       let bandwidth =
-        Lazy.from_fun (fun () ->
+        Lazy.Mutexed.from_fun (fun () ->
             try Lang.to_int (List.assoc "bandwidth" stream_info)
             with Not_found -> (
               match Encoder.(encoder.hls.bitrate ()) with
@@ -528,7 +529,7 @@ class hls_output p =
                              [] )))))
       in
       let codecs =
-        Lazy.from_fun (fun () ->
+        Lazy.Mutexed.from_fun (fun () ->
             try Lang.to_string (List.assoc "codecs" stream_info)
             with Not_found -> (
               match Encoder.(encoder.hls.codec_attrs ()) with
@@ -563,7 +564,7 @@ class hls_output p =
       in
       let extname = if extname = "mp4" then "m4s" else extname in
       let video_size =
-        Lazy.from_fun (fun () ->
+        Lazy.Mutexed.from_fun (fun () ->
             try
               let w, h =
                 Lang.to_product (List.assoc "video_size" stream_info)
@@ -1147,7 +1148,7 @@ class hls_output p =
     method encode frame =
       let len = Frame.position frame in
       let frame_pos, samples_pos = current_position in
-      let frame_size = Lazy.force Frame.size in
+      let frame_size = Lazy.Mutexed.force Frame.size in
       let samples_pos = samples_pos + len in
       current_position <-
         (frame_pos + (samples_pos / frame_size), samples_pos mod frame_size);
@@ -1270,12 +1271,12 @@ let value_of_stream
       ("name", Lang.string name);
       ("encoder", Lang_encoder.L.format format);
       ( "video_size",
-        match Lazy.force video_size with
+        match Lazy.Mutexed.force video_size with
           | None -> Lang.null
           | Some (w, h) ->
               Lang.record [("width", Lang.int w); ("height", Lang.int h)] );
-      ("bandwidth", Lang.int (Lazy.force bandwidth));
-      ("codecs", Lang.string (Lazy.force codecs));
+      ("bandwidth", Lang.int (Lazy.Mutexed.force bandwidth));
+      ("codecs", Lang.string (Lazy.Mutexed.force codecs));
       ("extname", Lang.string extname);
       ("id3_enabled", Lang.bool id3_enabled);
       ("replay_id3", Lang.bool replay_id3);
diff --git a/src/core/outputs/icecast2.ml b/src/core/outputs/icecast2.ml
index 635b99fe74..db5bc928af 100644
--- a/src/core/outputs/icecast2.ml
+++ b/src/core/outputs/icecast2.ml
@@ -73,21 +73,21 @@ module Icecast = struct
           {
             quality;
             bitrate;
-            samplerate = Some (Lazy.force m.Mp3_format.samplerate);
+            samplerate = Some (Lazy.Mutexed.force m.Mp3_format.samplerate);
             channels = Some (if m.Mp3_format.stereo then 2 else 1);
           }
       | Encoder.Shine m ->
           {
             quality = None;
             bitrate = Some m.Shine_format.bitrate;
-            samplerate = Some (Lazy.force m.Shine_format.samplerate);
+            samplerate = Some (Lazy.Mutexed.force m.Shine_format.samplerate);
             channels = Some m.Shine_format.channels;
           }
       | Encoder.FdkAacEnc m ->
           {
             quality = None;
             bitrate = Some m.Fdkaac_format.bitrate;
-            samplerate = Some (Lazy.force m.Fdkaac_format.samplerate);
+            samplerate = Some (Lazy.Mutexed.force m.Fdkaac_format.samplerate);
             channels = Some m.Fdkaac_format.channels;
           }
       | Encoder.NDI _ ->
@@ -96,14 +96,15 @@ module Icecast = struct
           {
             quality = None;
             bitrate = None;
-            samplerate = Some (Lazy.force m.External_encoder_format.samplerate);
+            samplerate =
+              Some (Lazy.Mutexed.force m.External_encoder_format.samplerate);
             channels = Some m.External_encoder_format.channels;
           }
       | Encoder.Flac m ->
           {
             quality = Some (string_of_int m.Flac_format.compression);
             bitrate = None;
-            samplerate = Some (Lazy.force m.Flac_format.samplerate);
+            samplerate = Some (Lazy.Mutexed.force m.Flac_format.samplerate);
             channels = Some m.Flac_format.channels;
           }
       | Encoder.Ffmpeg m ->
@@ -120,7 +121,8 @@ module Icecast = struct
             bitrate;
             samplerate =
               Option.map
-                (fun stream -> Lazy.force stream.Ffmpeg_format.samplerate)
+                (fun stream ->
+                  Lazy.Mutexed.force stream.Ffmpeg_format.samplerate)
                 audio_stream;
             channels =
               Option.map
@@ -131,14 +133,14 @@ module Icecast = struct
           {
             quality = None;
             bitrate = None;
-            samplerate = Some (Lazy.force m.Wav_format.samplerate);
+            samplerate = Some (Lazy.Mutexed.force m.Wav_format.samplerate);
             channels = Some m.Wav_format.channels;
           }
       | Encoder.AVI m ->
           {
             quality = None;
             bitrate = None;
-            samplerate = Some (Lazy.force m.Avi_format.samplerate);
+            samplerate = Some (Lazy.Mutexed.force m.Avi_format.samplerate);
             channels = Some m.Avi_format.channels;
           }
       | Encoder.Ogg { Ogg_format.audio; _ } -> (
@@ -154,7 +156,7 @@ module Icecast = struct
                 {
                   quality = Some (string_of_float q);
                   bitrate = None;
-                  samplerate = Some (Lazy.force s);
+                  samplerate = Some (Lazy.Mutexed.force s);
                   channels = Some n;
                 }
             | Some
@@ -168,7 +170,7 @@ module Icecast = struct
                 {
                   quality = None;
                   bitrate = b;
-                  samplerate = Some (Lazy.force s);
+                  samplerate = Some (Lazy.Mutexed.force s);
                   channels = Some n;
                 }
             | Some
@@ -182,7 +184,7 @@ module Icecast = struct
                 {
                   quality = None;
                   bitrate = Some b;
-                  samplerate = Some (Lazy.force s);
+                  samplerate = Some (Lazy.Mutexed.force s);
                   channels = Some n;
                 }
             | _ ->
diff --git a/src/core/outputs/output.ml b/src/core/outputs/output.ml
index e86326015e..b2399427bb 100644
--- a/src/core/outputs/output.ml
+++ b/src/core/outputs/output.ml
@@ -260,7 +260,7 @@ class virtual ['a] encoded ~output_kind ?clock ~name ~infallible
         in
         function
         | [] -> assert false
-        | [i] -> assert (i = Lazy.force Frame.size || not infallible)
+        | [i] -> assert (i = Lazy.Mutexed.force Frame.size || not infallible)
         | start :: stop :: l ->
             if start < stop then f start stop else assert (start = stop);
             output_chunks frame (stop :: l)
diff --git a/src/core/request/request.ml b/src/core/request/request.ml
index 8dcb07c78a..b162bb7fcf 100644
--- a/src/core/request/request.ml
+++ b/src/core/request/request.ml
@@ -593,7 +593,9 @@ let get_decoder ~ctype r =
                       (Frame.seconds_of_main cue_out);
                     Frame.slice buf (cue_out - old_pos))
                   else (
-                    if filled < len && Lazy.force Frame.size < cue_out - new_pos
+                    if
+                      filled < len
+                      && Lazy.Mutexed.force Frame.size < cue_out - new_pos
                     then
                       r.logger#important
                         "End of track reached at %.02f before cue-out point at \
diff --git a/src/core/runtime/lang.mli b/src/core/runtime/lang.mli
index 0fc3a269e1..a477ece78d 100644
--- a/src/core/runtime/lang.mli
+++ b/src/core/runtime/lang.mli
@@ -279,7 +279,15 @@ val product : value -> value -> value
 val tuple : value list -> value
 val meth : value -> (string * value) list -> value
 val record : (string * value) list -> value
-val reference : (unit -> value) -> (value -> unit) -> value
+
+(** Build a reference from a getter and a setter.
+
+    Pass [exchange] whenever the underlying state can do it in one step: the
+    fallback is a get followed by a set, and callers take a reference to be
+    atomic. *)
+val reference :
+  ?exchange:(value -> value) -> (unit -> value) -> (value -> unit) -> value
+
 val http_transport : Liq_http.transport -> value
 val base_http_transport : Liq_http.transport -> value
 
diff --git a/src/core/source/lang_source.ml b/src/core/source/lang_source.ml
index db1da0c796..3f722fb160 100644
--- a/src/core/source/lang_source.ml
+++ b/src/core/source/lang_source.ml
@@ -676,7 +676,7 @@ let source_methods : source_meth list =
           val_fun [] (fun _ ->
               let ticks = Clock.ticks s#clock in
               let frame_position =
-                Lazy.force Frame.duration *. float_of_int ticks
+                Lazy.Mutexed.force Frame.duration *. float_of_int ticks
               in
               let in_frame_position =
                 if s#is_ready then
diff --git a/src/core/source/source.ml b/src/core/source/source.ml
index 636020f313..7ffe1807e8 100644
--- a/src/core/source/source.ml
+++ b/src/core/source/source.ml
@@ -332,7 +332,7 @@ class virtual operator ?(stack = []) ?clock ~name sources =
     method private samplerate =
       match samplerate with
         | -1. ->
-            let s = float_of_int (Lazy.force Frame.audio_rate) in
+            let s = float_of_int (Lazy.Mutexed.force Frame.audio_rate) in
             samplerate <- s;
             s
         | s -> s
@@ -589,7 +589,7 @@ class virtual operator ?(stack = []) ?clock ~name sources =
             List.iter (fun fn -> fn ()) on_before_streaming_cycle;
             consumed <- 0;
             let cache_pos = self#cache_pos in
-            let size = Lazy.force Frame.size in
+            let size = Lazy.Mutexed.force Frame.size in
             let can_generate_frame = self#can_generate_frame in
             if cache_pos > 0 || can_generate_frame then
               Atomic.set streaming_state
@@ -1020,7 +1020,7 @@ class virtual generate_from_multiple_sources ~merge ~track_sensitive () =
       let s = Option.get ready_source in
       assert s#is_ready;
       let buf = self#continue_frame s in
-      let size = Lazy.force Frame.size in
+      let size = Lazy.Mutexed.force Frame.size in
       let rec f ~last_source ~last_chunk buf =
         let pos = Frame.position buf in
         let last_chunk_pos = Frame.position last_chunk in
diff --git a/src/core/sources/audio_gen.ml b/src/core/sources/audio_gen.ml
index 45a0cd9776..06577eadcd 100644
--- a/src/core/sources/audio_gen.ml
+++ b/src/core/sources/audio_gen.ml
@@ -90,15 +90,15 @@ let add name g =
 
 let sine f =
   new Audio.Generator.of_mono
-    (new Audio.Mono.Generator.sine (Lazy.force Frame.audio_rate) f)
+    (new Audio.Mono.Generator.sine (Lazy.Mutexed.force Frame.audio_rate) f)
 
 let square f =
   new Audio.Generator.of_mono
-    (new Audio.Mono.Generator.square (Lazy.force Frame.audio_rate) f)
+    (new Audio.Mono.Generator.square (Lazy.Mutexed.force Frame.audio_rate) f)
 
 let saw f =
   new Audio.Generator.of_mono
-    (new Audio.Mono.Generator.saw (Lazy.force Frame.audio_rate) f)
+    (new Audio.Mono.Generator.saw (Lazy.Mutexed.force Frame.audio_rate) f)
 
 let sine = add "sine" sine
 
diff --git a/src/core/sources/blank.ml b/src/core/sources/blank.ml
index f4f4ca6b79..ed27c9bc4b 100644
--- a/src/core/sources/blank.ml
+++ b/src/core/sources/blank.ml
@@ -55,7 +55,7 @@ class blank d =
     val mutable frame = None
 
     method private make_frame =
-      let length = Lazy.force Frame.size in
+      let length = Lazy.Mutexed.force Frame.size in
       let audio_len = Frame.audio_of_main length in
       Frame.Fields.fold
         (fun field format frame ->
@@ -105,7 +105,7 @@ class blank d =
 
     method generate_frame =
       let frame = self#blank_frame in
-      let length = Lazy.force Frame.size in
+      let length = Lazy.Mutexed.force Frame.size in
       match (Atomic.get position, self#remaining) with
         | `New_track, _ ->
             Atomic.set position (`Elapsed length);
diff --git a/src/core/sources/external_input_video.ml b/src/core/sources/external_input_video.ml
index b9a248d8f8..5a106f9257 100644
--- a/src/core/sources/external_input_video.ml
+++ b/src/core/sources/external_input_video.ml
@@ -103,13 +103,13 @@ let _ =
               video_format := Some fmt;
               width := Some w;
               height := Some h;
-              if fps <> float (Lazy.force Frame.video_rate) then
+              if fps <> float (Lazy.Mutexed.force Frame.video_rate) then
                 failwith
                   (Printf.sprintf
                      "Wrong video rate (%f instead of %d). Support for \
                       timestretching should be added some day in the future."
                      fps
-                     (Lazy.force Frame.video_rate));
+                     (Lazy.Mutexed.force Frame.video_rate));
               let converter data =
                 let video_format = Option.get !video_format in
                 let of_string s =
@@ -124,8 +124,8 @@ let _ =
                 let in_width = Video.Image.width src in
                 let in_height = Video.Image.height src in
                 let video_width, video_height = Frame.video_dimensions () in
-                let out_width = Lazy.force video_width in
-                let out_height = Lazy.force video_height in
+                let out_width = Lazy.Mutexed.force video_width in
+                let out_height = Lazy.Mutexed.force video_height in
                 if
                   out_width = in_width && out_height = in_height
                   && video_format = `I420
@@ -224,8 +224,8 @@ let _ =
     (fun p ->
       let command = Lang.to_string_getter (List.assoc "" p) in
       let video_width, video_height = Frame.video_dimensions () in
-      let width = Lazy.force video_width in
-      let height = Lazy.force video_height in
+      let width = Lazy.Mutexed.force video_width in
+      let height = Lazy.Mutexed.force video_height in
       let buflen = width * height * 3 in
       let buf = Bytes.create buflen in
       let on_data ~buffer reader =
diff --git a/src/core/sources/generated.ml b/src/core/sources/generated.ml
index c1621d0066..b41cbcd8ff 100644
--- a/src/core/sources/generated.ml
+++ b/src/core/sources/generated.ml
@@ -98,7 +98,9 @@ class virtual source ?(seek = false) ?(replay_meta = false) ~bufferize
           let was_buffering = buffering in
           buffering <- false;
           if add_track_mark && empty_on_abort then Generator.clear self#buffer;
-          let buf = Generator.slice self#buffer (Lazy.force Frame.size) in
+          let buf =
+            Generator.slice self#buffer (Lazy.Mutexed.force Frame.size)
+          in
           let buf =
             if was_buffering || add_track_mark then (
               self#log#info "Adding track mark.";
diff --git a/src/core/sources/request_dynamic.ml b/src/core/sources/request_dynamic.ml
index 006ba852bc..7d212e12ee 100644
--- a/src/core/sources/request_dynamic.ml
+++ b/src/core/sources/request_dynamic.ml
@@ -166,7 +166,7 @@ class dynamic ?(name = "request.dynamic") ~retry_delay ~available ~prefetch
             else buf
 
     method private generate_frame =
-      let size = Lazy.force Frame.size in
+      let size = Lazy.Mutexed.force Frame.size in
       let rec fill buf =
         let pos = Frame.position buf in
         if pos < size then (
diff --git a/src/core/sources/synthesized.ml b/src/core/sources/synthesized.ml
index eb58538b62..29cbbb4b06 100644
--- a/src/core/sources/synthesized.ml
+++ b/src/core/sources/synthesized.ml
@@ -55,9 +55,9 @@ class virtual source ~name duration =
     method private generate_frame =
       let len =
         match remaining with
-          | Some -1 | None -> Lazy.force Frame.size
+          | Some -1 | None -> Lazy.Mutexed.force Frame.size
           | Some r ->
-              let len = min (Lazy.force Frame.size) r in
+              let len = min (Lazy.Mutexed.force Frame.size) r in
               remaining <- Some (r - len);
               len
       in
diff --git a/src/core/sources/video_board.ml b/src/core/sources/video_board.ml
index 5a705886a7..a8caa3f5be 100644
--- a/src/core/sources/video_board.ml
+++ b/src/core/sources/video_board.ml
@@ -204,12 +204,14 @@ let _ =
       in
       let video_width, video_height = Frame.video_dimensions () in
       let width =
-        match width with Some width -> width | None -> Lazy.force video_width
+        match width with
+          | Some width -> width
+          | None -> Lazy.Mutexed.force video_width
       in
       let height =
         match height with
           | Some height -> height
-          | None -> Lazy.force video_height
+          | None -> Lazy.Mutexed.force video_height
       in
       let img = Video.YUV420.create width height in
       Printf.printf "image: %dx%d\nx%!" width height;
diff --git a/src/core/stream/aFrame.ml b/src/core/stream/aFrame.ml
index 849e9e2c50..4a63a73c52 100644
--- a/src/core/stream/aFrame.ml
+++ b/src/core/stream/aFrame.ml
@@ -28,8 +28,8 @@ type t = Frame.t
 let sot = audio_of_main
 let content b = try Frame.audio b with Not_found -> raise Content.Invalid
 let pcm b = Content.Audio.get_data (content b)
-let duration () = Lazy.force duration
-let size () = sot (Lazy.force size)
+let duration () = Lazy.Mutexed.force duration
+let size () = sot (Lazy.Mutexed.force size)
 let position t = sot (position t)
 let rms b off len = Audio.Analyze.rms (pcm b) off len
 
diff --git a/src/core/stream/content.ml b/src/core/stream/content.ml
index 8ae4a76f3f..afd55dedf8 100644
--- a/src/core/stream/content.ml
+++ b/src/core/stream/content.ml
@@ -40,7 +40,7 @@ module Audio = struct
   include Content_audio
 
   type audio_params = Content_audio.Specs.params = {
-    channel_layout : [ `Mono | `Stereo | `Five_point_one ] Lazy.t;
+    channel_layout : [ `Mono | `Stereo | `Five_point_one ] Lazy.Mutexed.t;
   }
 end
 
@@ -54,8 +54,8 @@ module Video = struct
   }
 
   type video_params = Content_video.Specs.params = {
-    width : int Lazy.t option;
-    height : int Lazy.t option;
+    width : int Lazy.Mutexed.t option;
+    height : int Lazy.Mutexed.t option;
     alpha : bool option Unifier.t;
   }
 
@@ -67,8 +67,8 @@ module Video = struct
         length = Frame_settings.main_of_video 1;
         params =
           {
-            height = Some (Lazy.from_val height);
-            width = Some (Lazy.from_val width);
+            height = Some (Lazy.Mutexed.from_val height);
+            width = Some (Lazy.Mutexed.from_val width);
             alpha = Unifier.make (Some (Video.Canvas.Image.has_alpha img));
           };
         data = [(0, img)];
@@ -93,18 +93,18 @@ module Video = struct
   let make_generator params =
     let default_width, default_height = Frame_settings.video_dimensions () in
     let width =
-      Lazy.force
+      Lazy.Mutexed.force
         (Option.value ~default:default_width params.Content_video.Specs.width)
     in
     let height =
-      Lazy.force
+      Lazy.Mutexed.force
         (Option.value ~default:default_height params.Content_video.Specs.height)
     in
     {
       params =
         {
-          Content_video.Specs.width = Some (Lazy.from_val width);
-          height = Some (Lazy.from_val height);
+          Content_video.Specs.width = Some (Lazy.Mutexed.from_val width);
+          height = Some (Lazy.Mutexed.from_val height);
           alpha = params.Content_video.Specs.alpha;
         };
       width;
diff --git a/src/core/stream/content.mli b/src/core/stream/content.mli
index 8b56edaaf1..ec6f228115 100644
--- a/src/core/stream/content.mli
+++ b/src/core/stream/content.mli
@@ -140,7 +140,7 @@ val kind_of_string : string -> kind
 
 module Audio : sig
   type audio_params = Content_audio.Specs.params = {
-    channel_layout : [ `Mono | `Stereo | `Five_point_one ] Lazy.t;
+    channel_layout : [ `Mono | `Stereo | `Five_point_one ] Lazy.Mutexed.t;
   }
 
   include
@@ -162,8 +162,8 @@ module Video : sig
   }
 
   type video_params = Content_video.Specs.params = {
-    width : int Lazy.t option;
-    height : int Lazy.t option;
+    width : int Lazy.Mutexed.t option;
+    height : int Lazy.Mutexed.t option;
     alpha : bool option Unifier.t;
   }
 
diff --git a/src/core/stream/content_audio.ml b/src/core/stream/content_audio.ml
index 25a207e1ac..71c53163ff 100644
--- a/src/core/stream/content_audio.ml
+++ b/src/core/stream/content_audio.ml
@@ -29,7 +29,7 @@ module Specs = struct
   type kind = [ `Pcm ]
 
   type params = {
-    channel_layout : [ `Mono | `Stereo | `Five_point_one ] Lazy.t;
+    channel_layout : [ `Mono | `Stereo | `Five_point_one ] Lazy.Mutexed.t;
   }
 
   type data = Audio.Mono.buffer array
@@ -62,9 +62,9 @@ module Specs = struct
   let copy d = Audio.copy d 0 (Audio.length d)
 
   let param_of_channels = function
-    | 1 -> { channel_layout = Lazy.from_val `Mono }
-    | 2 -> { channel_layout = Lazy.from_val `Stereo }
-    | 6 -> { channel_layout = Lazy.from_val `Five_point_one }
+    | 1 -> { channel_layout = Lazy.Mutexed.from_val `Mono }
+    | 2 -> { channel_layout = Lazy.Mutexed.from_val `Stereo }
+    | 6 -> { channel_layout = Lazy.Mutexed.from_val `Five_point_one }
     | _ -> raise Invalid
 
   let channels_of_param = function
@@ -74,16 +74,17 @@ module Specs = struct
 
   let parse_param label value =
     match (label, value) with
-      | "", "mono" -> Some { channel_layout = Lazy.from_val `Mono }
-      | "", "stereo" -> Some { channel_layout = Lazy.from_val `Stereo }
-      | "", "5.1" -> Some { channel_layout = Lazy.from_val `Five_point_one }
+      | "", "mono" -> Some { channel_layout = Lazy.Mutexed.from_val `Mono }
+      | "", "stereo" -> Some { channel_layout = Lazy.Mutexed.from_val `Stereo }
+      | "", "5.1" ->
+          Some { channel_layout = Lazy.Mutexed.from_val `Five_point_one }
       | _ -> None
 
   let params d = param_of_channels (Array.length d)
   let kind = `Pcm
 
   let default_params _ =
-    param_of_channels (Lazy.force Frame_settings.audio_channels)
+    param_of_channels (Lazy.Mutexed.force Frame_settings.audio_channels)
 
   let make ?(length = 0) { channel_layout } =
     let channels =
@@ -123,7 +124,7 @@ module Specs = struct
 
   let params_to_value ({ channel_layout } as p) =
     let open Liquidsoap_lang in
-    let channels = channels_of_param (Lazy.force channel_layout) in
+    let channels = channels_of_param (Lazy.Mutexed.force channel_layout) in
     let layout = string_of_params p in
     Lang_core.record
       [
@@ -137,10 +138,10 @@ include MkContentBase (Specs)
 let kind = lift_kind `Pcm
 
 let format_of_channels = function
-  | 1 -> lift_params { channel_layout = Lazy.from_val `Mono }
-  | 2 -> lift_params { channel_layout = Lazy.from_val `Stereo }
-  | 6 -> lift_params { channel_layout = Lazy.from_val `Five_point_one }
+  | 1 -> lift_params { channel_layout = Lazy.Mutexed.from_val `Mono }
+  | 2 -> lift_params { channel_layout = Lazy.Mutexed.from_val `Stereo }
+  | 6 -> lift_params { channel_layout = Lazy.Mutexed.from_val `Five_point_one }
   | _ -> raise Invalid
 
 let channels_of_format p =
-  Specs.(channels_of_param (Lazy.force (get_params p).channel_layout))
+  Specs.(channels_of_param (Lazy.Mutexed.force (get_params p).channel_layout))
diff --git a/src/core/stream/content_midi.ml b/src/core/stream/content_midi.ml
index c6df3261b8..092b798be4 100644
--- a/src/core/stream/content_midi.ml
+++ b/src/core/stream/content_midi.ml
@@ -48,7 +48,9 @@ module Specs = struct
   let copy m = Array.map MIDI.copy m
   let params m = { channels = MIDI.Multitrack.channels m }
   let kind = `Midi
-  let default_params _ = { channels = Lazy.force Frame_settings.midi_channels }
+
+  let default_params _ =
+    { channels = Lazy.Mutexed.force Frame_settings.midi_channels }
 
   let make ?(length = 0) { channels } =
     MIDI.Multitrack.create channels (midi_of_main length)
diff --git a/src/core/stream/content_pcm_base.ml b/src/core/stream/content_pcm_base.ml
index 849d04af81..d2bdc02c1c 100644
--- a/src/core/stream/content_pcm_base.ml
+++ b/src/core/stream/content_pcm_base.ml
@@ -53,7 +53,7 @@ let parse_param = Content_audio.Specs.parse_param
 let params d = param_of_channels (Array.length d)
 
 let default_params _ =
-  param_of_channels (Lazy.force Frame_settings.audio_channels)
+  param_of_channels (Lazy.Mutexed.force Frame_settings.audio_channels)
 
 let make ~fmt ?(length = 0) { Content_audio.Specs.channel_layout } =
   let channels =
@@ -74,4 +74,4 @@ let clear_content ~v b ofs len =
 
 let channels_of_format ~get_params p =
   Content_audio.Specs.(
-    channels_of_param (Lazy.force (get_params p).channel_layout))
+    channels_of_param (Lazy.Mutexed.force (get_params p).channel_layout))
diff --git a/src/core/stream/content_video.ml b/src/core/stream/content_video.ml
index fbfe0bcc63..6c27804675 100644
--- a/src/core/stream/content_video.ml
+++ b/src/core/stream/content_video.ml
@@ -87,8 +87,8 @@ module Specs = struct
      value) is required so that refinement still propagates across formats
      unified by [merge]. *)
   type params = {
-    width : int Lazy.t option;
-    height : int Lazy.t option;
+    width : int Lazy.Mutexed.t option;
+    height : int Lazy.Mutexed.t option;
     alpha : bool option Unifier.t;
   }
 
@@ -122,7 +122,7 @@ module Specs = struct
       | "width" ->
           Some
             {
-              width = Some (Lazy.from_val (int_of_string value));
+              width = Some (Lazy.Mutexed.from_val (int_of_string value));
               height = None;
               alpha = Unifier.make None;
             }
@@ -130,7 +130,7 @@ module Specs = struct
           Some
             {
               width = None;
-              height = Some (Lazy.from_val (int_of_string value));
+              height = Some (Lazy.Mutexed.from_val (int_of_string value));
               alpha = Unifier.make None;
             }
       | "alpha" ->
@@ -150,13 +150,15 @@ module Specs = struct
     Unifier.(p.alpha <-- p'.alpha);
     {
       width =
-        Option.map Lazy.from_val
+        Option.map Lazy.Mutexed.from_val
           (merge_param ~name:"width"
-             (Option.map Lazy.force p.width, Option.map Lazy.force p'.width));
+             ( Option.map Lazy.Mutexed.force p.width,
+               Option.map Lazy.Mutexed.force p'.width ));
       height =
-        Option.map Lazy.from_val
+        Option.map Lazy.Mutexed.from_val
           (merge_param ~name:"height"
-             (Option.map Lazy.force p.height, Option.map Lazy.force p'.height));
+             ( Option.map Lazy.Mutexed.force p.height,
+               Option.map Lazy.Mutexed.force p'.height ));
       alpha = p.alpha;
     }
 
@@ -222,8 +224,12 @@ module Specs = struct
   let params_to_value { width; height; alpha } =
     let open Liquidsoap_lang in
     let default_width, default_height = Frame_settings.video_dimensions () in
-    let width = Lazy.force (Option.value ~default:default_width width) in
-    let height = Lazy.force (Option.value ~default:default_height height) in
+    let width =
+      Lazy.Mutexed.force (Option.value ~default:default_width width)
+    in
+    let height =
+      Lazy.Mutexed.force (Option.value ~default:default_height height)
+    in
     Lang_core.record
       [
         ("width", Lang_core.mk (`Int width));
@@ -242,8 +248,12 @@ let kind = lift_kind `Canvas
 let dimensions_of_format p =
   let p = get_params p in
   let default_width, default_height = Frame_settings.video_dimensions () in
-  let width = Lazy.force (Option.value ~default:default_width p.width) in
-  let height = Lazy.force (Option.value ~default:default_height p.height) in
+  let width =
+    Lazy.Mutexed.force (Option.value ~default:default_width p.width)
+  in
+  let height =
+    Lazy.Mutexed.force (Option.value ~default:default_height p.height)
+  in
   (width, height)
 
 let alpha_of_format p = Unifier.deref (get_params p).alpha = Some true
@@ -256,8 +266,9 @@ let lift_canvas ?(offset = 0) ?length data =
       | [] -> { Specs.width = None; height = None; alpha = Unifier.make None }
       | (_, i) :: _ ->
           {
-            Specs.width = Some (Lazy.from_val (Video.Canvas.Image.width i));
-            height = Some (Lazy.from_val (Video.Canvas.Image.height i));
+            Specs.width =
+              Some (Lazy.Mutexed.from_val (Video.Canvas.Image.width i));
+            height = Some (Lazy.Mutexed.from_val (Video.Canvas.Image.height i));
             alpha = Unifier.make (Some (Video.Canvas.Image.has_alpha i));
           }
   in
diff --git a/src/core/stream/format_type.ml b/src/core/stream/format_type.ml
index 567e6cd981..4abbd804da 100644
--- a/src/core/stream/format_type.ml
+++ b/src/core/stream/format_type.ml
@@ -303,7 +303,7 @@ let audio_n ?(pcm_kind = Content_audio.kind) n =
           (Frame_base.audio_format ~pcm_kind
              {
                channel_layout =
-                 Lazy.from_val (Audio_layout.layout_of_channels n);
+                 Lazy.Mutexed.from_val (Audio_layout.layout_of_channels n);
              })))
 
 let audio_mono ?pcm_kind () = audio_n ?pcm_kind 1
diff --git a/src/core/stream/frame.mli b/src/core/stream/frame.mli
index b57f58970e..bbf91e8d82 100644
--- a/src/core/stream/frame.mli
+++ b/src/core/stream/frame.mli
@@ -146,7 +146,7 @@ val position : t -> int
 val remaining : t -> int
 
 (** Is the frame partially filled, i.e. is its end [position] strictly before
-    [Lazy.force Frame.size]? *)
+    [Lazy.Mutexed.force Frame.size]? *)
 val is_partial : t -> bool
 
 (** {3 Track marks} *)
@@ -210,13 +210,13 @@ val compatible : content_type -> content_type -> bool
     they are really useful. *)
 
 (** Default number of audio channels. *)
-val audio_channels : int Lazy.t
+val audio_channels : int Lazy.Mutexed.t
 
 (** Is video enabled? *)
-val default_video_enabled : bool Lazy.t
+val default_video_enabled : bool Lazy.Mutexed.t
 
 (** Default number of MIDI channels. *)
-val midi_channels : int Lazy.t
+val midi_channels : int Lazy.Mutexed.t
 
 (** Ideal video size for auto-detection. *)
 type ideal_size = { width : int; height : int; source : string }
@@ -224,23 +224,24 @@ type ideal_size = { width : int; height : int; source : string }
 (** Get video dimensions as a pair of lazy values. Forcing one forces the other.
     If [~ideal_size] is provided and the dimensions haven't been explicitly set
     by the user or forced yet, use the ideal dimensions as the default. *)
-val video_dimensions : ?ideal_size:ideal_size -> unit -> int Lazy.t * int Lazy.t
+val video_dimensions :
+  ?ideal_size:ideal_size -> unit -> int Lazy.Mutexed.t * int Lazy.Mutexed.t
 
 (** Rate of audio (in samples per second). *)
-val audio_rate : int Lazy.t
+val audio_rate : int Lazy.Mutexed.t
 
 (** Video rate (in images per second). *)
-val video_rate : int Lazy.t
+val video_rate : int Lazy.Mutexed.t
 
-val midi_rate : int Lazy.t
+val midi_rate : int Lazy.Mutexed.t
 
 (** Ticks per second. *)
-val main_rate : int Lazy.t
+val main_rate : int Lazy.Mutexed.t
 
-val size : int Lazy.t
+val size : int Lazy.Mutexed.t
 
 (** Duration of a frame in seconds. *)
-val duration : float Lazy.t
+val duration : float Lazy.Mutexed.t
 
 (** {2 Time and frequency conversions} *)
 
diff --git a/src/core/stream/frame_base.ml b/src/core/stream/frame_base.ml
index 687462c033..9eec18b71c 100644
--- a/src/core/stream/frame_base.ml
+++ b/src/core/stream/frame_base.ml
@@ -103,7 +103,7 @@ let position frame =
          | Some p -> Some (Int.min p (Content_base.length c)))
        frame None)
 
-let remaining b = Lazy.force Frame_settings.size - position b
+let remaining b = Lazy.Mutexed.force Frame_settings.size - position b
 let is_partial b = 0 < remaining b
 
 (** Metadata of a frame. *)
@@ -125,7 +125,7 @@ let format_of_channels ~pcm_kind n =
   audio_format ~pcm_kind
     {
       Content_audio.Specs.channel_layout =
-        Lazy.from_val (Audio_layout.layout_of_channels n);
+        Lazy.Mutexed.from_val (Audio_layout.layout_of_channels n);
     }
 
 let add_timed_content ?length content =
diff --git a/src/core/stream/frame_settings.ml b/src/core/stream/frame_settings.ml
index 291b29f4ba..d8397bcab1 100644
--- a/src/core/stream/frame_settings.ml
+++ b/src/core/stream/frame_settings.ml
@@ -123,8 +123,8 @@ let lazy_config_eval = ref false
 let delayed_eval = Queue.create ()
 
 let delayed f =
-  let ret = Lazy.from_fun f in
-  Queue.push (fun () -> ignore (Lazy.force ret)) delayed_eval;
+  let ret = Lazy.Mutexed.from_fun f in
+  Queue.push (fun () -> ignore (Lazy.Mutexed.force ret)) delayed_eval;
   ret
 
 let () =
@@ -139,7 +139,7 @@ let delayed_conf ~to_string x =
       log#info "frame.%s set to: %s" (String.concat "." routes) (to_string ret);
       ret)
 
-let ( !! ) = Lazy.force
+let ( !! ) = Lazy.Mutexed.force
 
 (** The channel numbers are only defaults, used when channel numbers cannot be
     inferred / are not forced from the context. I'm currently unsure how much
@@ -161,17 +161,17 @@ type ideal_size = { width : int; height : int; source : string }
 let video_dimensions =
   (* We don't want to use delayed config here because those are evaluated too early. *)
   let dimensions =
-    lazy
-      (assert !lazy_config_eval;
-       let w = conf_video_width#get in
-       let h = conf_video_height#get in
-       (w, h))
+    Lazy.Mutexed.from_fun (fun () ->
+        assert !lazy_config_eval;
+        let w = conf_video_width#get in
+        let h = conf_video_height#get in
+        (w, h))
   in
   fun ?ideal_size () ->
     (match ideal_size with
       | Some { width; height; source }
         when conf_video_detect_dimensions#get
-             && (not (Lazy.is_val dimensions))
+             && (not (Lazy.Mutexed.is_val dimensions))
              && (not conf_video_width#is_set)
              && not conf_video_height#is_set ->
           log#important "Auto-detected video dimensions: %dx%d (source: %s)."
@@ -179,8 +179,12 @@ let video_dimensions =
           conf_video_width#set width;
           conf_video_height#set height
       | _ -> ());
-    let width = lazy (fst (Lazy.force dimensions)) in
-    let height = lazy (snd (Lazy.force dimensions)) in
+    let width =
+      Lazy.Mutexed.from_fun (fun () -> fst (Lazy.Mutexed.force dimensions))
+    in
+    let height =
+      Lazy.Mutexed.from_fun (fun () -> snd (Lazy.Mutexed.force dimensions))
+    in
     (width, height)
 
 let audio_rate = delayed_conf ~to_string:string_of_int conf_audio_samplerate
diff --git a/src/core/stream/mFrame.ml b/src/core/stream/mFrame.ml
index f86a6caa87..9f301f4c5a 100644
--- a/src/core/stream/mFrame.ml
+++ b/src/core/stream/mFrame.ml
@@ -25,7 +25,7 @@ open Frame
 type t = Frame.t
 
 let mot = midi_of_main
-let size () = mot (Lazy.force Frame.size)
+let size () = mot (Lazy.Mutexed.force Frame.size)
 
 let content ?(field = Frame.Fields.midi) b =
   try Frame.get b field with Not_found -> raise Content.Invalid
diff --git a/src/core/stream/vFrame.ml b/src/core/stream/vFrame.ml
index 26219bb11f..c93f4c8a84 100644
--- a/src/core/stream/vFrame.ml
+++ b/src/core/stream/vFrame.ml
@@ -27,7 +27,8 @@ type t = Frame.t
 let vot ?round x =
   match round with
     | None | Some `Down -> Frame.video_of_main x
-    | Some `Up -> Frame.video_of_main (x + Lazy.force Frame.video_rate - 1)
+    | Some `Up ->
+        Frame.video_of_main (x + Lazy.Mutexed.force Frame.video_rate - 1)
 
 let content ?(field = Frame.Fields.video) b =
   try Frame.get b field with Not_found -> raise Content.Invalid
diff --git a/src/core/utils/sandbox.ml b/src/core/utils/sandbox.ml
index 857c5bf495..75a112deee 100644
--- a/src/core/utils/sandbox.ml
+++ b/src/core/utils/sandbox.ml
@@ -82,15 +82,15 @@ let conf_shell_path =
      otherwise."
 
 let has_binary =
-  Lazy.from_fun (fun () ->
+  Lazy.Mutexed.from_fun (fun () ->
       Utils.which_opt ~path:(Configure.path ()) conf_binary#get <> None)
 
 let () =
   Lifecycle.before_start ~name:"sandbox start" (fun () ->
-      if Lazy.force Utils.is_docker then (
+      if Lazy.Mutexed.force Utils.is_docker then (
         log#important "Running inside a docker container, disabling sandboxing.";
         conf_sandbox#set false)
-      else if not (Lazy.force has_binary) then (
+      else if not (Lazy.Mutexed.force has_binary) then (
         log#important "Could not find binary %s, disabling sandboxing."
           conf_binary#get;
         conf_sandbox#set false)
diff --git a/src/core/utils/server.ml b/src/core/utils/server.ml
index 199802ed34..0585096661 100644
--- a/src/core/utils/server.ml
+++ b/src/core/utils/server.ml
@@ -20,8 +20,6 @@
 
  *****************************************************************************)
 
-let ( let* ) = Duppy.Monad.bind
-
 module Http = Liq_http
 
 exception Bind_error of string
@@ -123,8 +121,6 @@ let conf_log_level =
   Dtools.Conf.int ~p:(conf_log#plug "level") ~d:3
     "Default log level for messages."
 
-exception Duppy of Duppy.Io.failure
-
 (* {1 Manage available commands} *)
 
 type namespace = string list
@@ -160,49 +156,6 @@ let remove ~ns cmd =
     (fun () -> Hashtbl.remove commands (prefix_ns cmd ns))
     ()
 
-(* That's if you want to have your command wait. *)
-type condition = {
-  wait : (unit -> string) -> unit;
-  signal : unit -> unit;
-  broadcast : unit -> unit;
-}
-
-module Mutex_control = struct
-  type priority = Tutils.priority
-
-  let scheduler = Tutils.scheduler
-  let priority = `Non_blocking
-end
-
-module Duppy_m = Duppy.Monad.Mutex.Factory (Mutex_control)
-module Duppy_c = Duppy.Monad.Condition.Factory (Duppy_m)
-
-type server_condition = {
-  condition : Duppy_c.condition;
-  mutex : Duppy_m.mutex;
-  resume : unit -> string;
-}
-
-exception Server_wait of server_condition
-
-let condition () =
-  let mutex = Duppy_m.create () in
-  let condition = Duppy_c.create () in
-  let wait resume = raise (Server_wait { mutex; condition; resume }) in
-  let signal () =
-    Duppy.Monad.run
-      ~return:(fun () -> ())
-      ~raise:(fun exn -> raise exn)
-      (Duppy_c.signal condition)
-  in
-  let broadcast () =
-    Duppy.Monad.run
-      ~return:(fun () -> ())
-      ~raise:(fun exn -> raise exn)
-      (Duppy_c.broadcast condition)
-  in
-  { wait; signal; broadcast }
-
 type ('a, 'b) interruption = { payload : 'a; after : 'b -> string }
 type write = (string, unit) interruption
 
@@ -262,7 +215,6 @@ let exec s =
     let command, _, _ = Mutex_utils.mutexify lock (Hashtbl.find commands) s in
     command args
   with
-    | Server_wait opts -> raise (Server_wait opts)
     | Write opts -> raise (Write opts)
     | Read opts -> raise (Read opts)
     | Exit -> raise Exit
@@ -271,107 +223,75 @@ let exec s =
     | e -> Printf.sprintf "ERROR: %s" (Printexc.to_string e)
 
 let handle_client socket ip =
-  let on_error e =
-    (match e with
-      | Duppy.Io.Io_error -> ()
-      | Duppy.Io.Timeout ->
-          log#f (conf_log_level#get + 1)
-            "Timeout reached while communicating to client %s." ip
-      | Duppy.Io.Unix (c, p, m, bt) ->
-          log#f (conf_log_level#get + 1) "%s%s"
-            (Printexc.to_string (Unix.Unix_error (c, p, m)))
-            (if conf_log_level#get > 4 then
-               "\n" ^ Printexc.raw_backtrace_to_string bt
-             else "")
-      | Duppy.Io.Unknown (e, bt) ->
-          log#f (conf_log_level#get + 1) "%s%s" (Printexc.to_string e)
-            (if conf_log_level#get > 4 then
-               "\n" ^ Printexc.raw_backtrace_to_string bt
-             else ""));
-    Duppy e
+  let log_failure = function
+    | Duppy.Io.Io_error -> ()
+    | Duppy.Io.Timeout ->
+        log#f (conf_log_level#get + 1)
+          "Timeout reached while communicating to client %s." ip
+    | Duppy.Io.Unix (c, p, m, bt) ->
+        log#f (conf_log_level#get + 1) "%s%s"
+          (Printexc.to_string (Unix.Unix_error (c, p, m)))
+          (if conf_log_level#get > 4 then
+             "\n" ^ Printexc.raw_backtrace_to_string bt
+           else "")
+    | Duppy.Io.Unknown (e, bt) ->
+        log#f (conf_log_level#get + 1) "%s%s" (Printexc.to_string e)
+          (if conf_log_level#get > 4 then
+             "\n" ^ Printexc.raw_backtrace_to_string bt
+           else "")
   in
-  let h =
-    { Duppy.Monad.Io.scheduler = Tutils.scheduler; socket; data = ""; on_error }
+  let h = Duppy.Io.handle Tutils.scheduler socket in
+  let read marker =
+    Duppy.Io.read ~timeout:(get_timeout ()) ~priority:`Non_blocking h marker
   in
-  (* Read and process lines *)
-  let process =
-    let* req =
-      Duppy.Monad.Io.read
-        ?timeout:(Some (get_timeout ()))
-        ~priority:`Non_blocking ~marker:(Duppy.Io.Split "[\r\n]+") h
-    in
-    let rec run exec =
-      try Duppy.Monad.return (exec ()) with
-        | Server_wait opts ->
-            let* () = Duppy_c.wait opts.condition opts.mutex in
-            run opts.resume
-        | Write opts ->
-            (* Make sure write are synchronous by setting TCP_NODELAY off and off. *)
-            Unix.setsockopt socket Unix.TCP_NODELAY false;
-            let* () =
-              Duppy.Monad.Io.write
-                ?timeout:(Some (get_timeout ()))
-                ~priority:`Non_blocking h
-                (Bytes.of_string opts.payload)
-            in
-            Unix.setsockopt socket Unix.TCP_NODELAY true;
-            run opts.after
-        | Read opts ->
-            let* ret =
-              Duppy.Monad.Io.read
-                ?timeout:(Some (get_timeout ()))
-                ~priority:`Non_blocking ~marker:opts.payload h
-            in
-            run (fun () -> opts.after ret)
-        | e -> Duppy.Monad.raise e
-    in
-    let* ans =
-      Duppy.Monad.Io.exec ~priority:`Maybe_blocking h (run (fun () -> exec req))
-    in
-    let* () =
-      let* () =
-        Duppy.Monad.Io.write
-          ?timeout:(Some (* "BEGIN\r\n"; *) (get_timeout ()))
-          ~priority:`Non_blocking h (Bytes.of_string ans)
-      in
-      Duppy.Monad.Io.write
-        ?timeout:(Some (get_timeout ()))
-        ~priority:`Non_blocking h
-        (Bytes.of_string "\r\nEND\r\n")
-    in
-    Duppy.Monad.return ()
+  let write s =
+    Duppy.Io.write ~timeout:(get_timeout ()) ~priority:`Non_blocking h
+      (Bytes.of_string s)
   in
   let close () = try Unix.close socket with _ -> () in
-  let rec run () =
-    let raise = function
-      | (Exit | Duppy Duppy.Io.Timeout) as e ->
-          let on_error e =
-            ignore (on_error e);
-            log#f conf_log_level#get
-              "Client %s disconnected while saying goodbye..!" ip;
-            close ()
-          in
-          let msg =
-            match e with
-              | Exit -> "Bye!\r\n"
-              | Duppy Duppy.Io.Timeout -> "Connection timed out.. Bye!\r\n"
-              | _ -> assert false
-          in
-          let exec () =
-            log#f conf_log_level#get "Client %s disconnected." ip;
-            close ()
-          in
-          Duppy.Io.write ~timeout:(get_timeout ()) ~priority:`Non_blocking
-            ~on_error ~exec Tutils.scheduler ~string:(Bytes.of_string msg)
-            socket
-      | _ ->
-          log#f conf_log_level#get
-            "Client %s disconnected without saying goodbye..!" ip;
-          close ()
-    in
-    Duppy.Monad.run ~return:run ~raise process
+  let rec answer exec =
+    try exec () with
+      | Write opts ->
+          (* Make writes synchronous by turning TCP_NODELAY off and on. *)
+          Unix.setsockopt socket Unix.TCP_NODELAY false;
+          write opts.payload;
+          Unix.setsockopt socket Unix.TCP_NODELAY true;
+          answer opts.after
+      | Read opts ->
+          let ret = read opts.payload in
+          answer (fun () -> opts.after ret)
   in
-  run ()
+  let rec process () =
+    let req = read (Duppy.Io.Split "[\r\n]+") in
+    (* A command can block, and holds a non-blocking priority until here. *)
+    Duppy.reschedule ~priority:`Maybe_blocking Tutils.scheduler;
+    let ans = answer (fun () -> exec req) in
+    write ans;
+    write "\r\nEND\r\n";
+    process ()
+  in
+  let goodbye msg =
+    try
+      write msg;
+      log#f conf_log_level#get "Client %s disconnected." ip
+    with Duppy.Io.Error failure ->
+      log_failure failure;
+      log#f conf_log_level#get "Client %s disconnected while saying goodbye..!"
+        ip
+  in
+  Duppy.run (fun () ->
+      (try process () with
+        | Exit -> goodbye "Bye!\r\n"
+        | Duppy.Io.Error Duppy.Io.Timeout ->
+            goodbye "Connection timed out.. Bye!\r\n"
+        | Duppy.Io.Error failure ->
+            log_failure failure;
+            log#f conf_log_level#get
+              "Client %s disconnected without saying goodbye..!" ip
+        | _ ->
+            log#f conf_log_level#get
+              "Client %s disconnected without saying goodbye..!" ip);
+      close ())
 
 (* {1 The server} *)
 let start_socket () =
diff --git a/src/core/utils/server.mli b/src/core/utils/server.mli
index 04200b88c0..da25319c9d 100644
--- a/src/core/utils/server.mli
+++ b/src/core/utils/server.mli
@@ -56,16 +56,6 @@ type namespace = string list
 (** Get a string representation of a namespace. *)
 val to_string : namespace -> string
 
-(** Specialized implementation of conditions to use in server commands. *)
-type condition = {
-  wait : (unit -> string) -> unit;
-  signal : unit -> unit;
-  broadcast : unit -> unit;
-}
-
-(** [condition ()] instantiates a server command condition. *)
-val condition : unit -> condition
-
 (** Partial response write without returning. *)
 val write : after:(unit -> string) -> string -> unit
 
diff --git a/src/core/utils/tutils.ml b/src/core/utils/tutils.ml
index a4e8e66d09..8a2da9fc6f 100644
--- a/src/core/utils/tutils.ml
+++ b/src/core/utils/tutils.ml
@@ -35,11 +35,10 @@ let conf_scheduler =
         "Finally, \"slow\" tasks are those that are always taking a long time,";
         "like last.fm submission, or user-defined tasks register via";
         "`thread.run`.";
-        "The scheduler consists in a number of queues that process incoming";
-        "tasks. Some queues might only process some kinds of tasks so that";
-        "they are more responsive.";
-        "Having more queues often do not make the program faster in average,";
-        "but affect mostly the order in which tasks are processed.";
+        "The scheduler runs one domain per core and dispatches ready tasks";
+        "onto whichever of them is free. Non-blocking tasks run directly on a";
+        "domain; the other two kinds run on a thread inside one, so that";
+        "waiting on a socket or a file leaves the domain free for other work.";
       ]
 
 type exit_status =
@@ -68,41 +67,17 @@ let exit () =
     | `Done (`Error (bt, err)) -> Printexc.raise_with_backtrace err bt
     | _ -> exit (exit_code ())
 
-let generic_queues =
+let blocking_tasks =
   Dtools.Conf.int
-    ~p:(conf_scheduler#plug "generic_queues")
-    ~d:5 "Generic queues"
+    ~p:(conf_scheduler#plug "blocking_tasks")
+    ~d:64 "Blocking tasks"
     ~comments:
       [
-        "Number of event queues accepting any kind of task.";
-        "There should at least be one. Having more can be useful to make sure";
-        "that trivial request resolutions (local files) are not delayed";
-        "because of a stalled download. But N stalled download can block";
-        "N queues anyway.";
-      ]
-
-let fast_queues =
-  Dtools.Conf.int
-    ~p:(conf_scheduler#plug "fast_queues")
-    ~d:0 "Fast queues"
-    ~comments:
-      [
-        "Number of queues that are dedicated to fast tasks.";
-        "It might be useful to create some if your request resolutions,";
-        "or some user defined tasks (cf `thread.run`), are";
-        "delayed too much because of slow tasks blocking the generic queues,";
-        "such as last.fm submissions or slow `thread.run` handlers.";
-      ]
-
-let non_blocking_queues =
-  Dtools.Conf.int
-    ~p:(conf_scheduler#plug "non_blocking_queues")
-    ~d:2 "Non-blocking queues"
-    ~comments:
-      [
-        "Number of queues dedicated to internal non-blocking tasks.";
-        "These are only started if such tasks are needed.";
-        "There should be at least one.";
+        "Maximum number of blocking tasks running at once, spread evenly over";
+        "the scheduler's domains. Blocking tasks spend most of their time";
+        "waiting on a socket or a file rather than using a core, so this can";
+        "be much larger than the number of cores. Each domain keeps at least";
+        "one slot, so setting this below the number of cores has no effect.";
       ]
 
 let scheduler_log =
@@ -132,7 +107,6 @@ module Set = Set.Make (struct
 end)
 
 let all = ref Set.empty
-let queues = ref Set.empty
 
 let join_all ~set () =
   let rec f () =
@@ -159,9 +133,9 @@ let set_done, wait_done =
 
 exception Exit
 
-let create ~queue f x s =
+let create f x s =
   let c = Condition.create () in
-  let set = if queue then queues else all in
+  let set = all in
   Mutex_utils.mutexify lock
     (fun () ->
       let id =
@@ -185,17 +159,6 @@ let create ~queue f x s =
                 | Failure e as exn ->
                     log#important "Thread %S failed: %s!" s e;
                     Printexc.raise_with_backtrace exn raw_bt
-                | e when queue ->
-                    Dtools.Init.exec Dtools.Log.stop;
-                    Printf.printf "Queue %s crashed with exception %s\n%s" s
-                      (Printexc.to_string e) bt;
-                    Printf.printf
-                      "PANIC: Liquidsoap has crashed, exiting.,\n\
-                       Please report at: https://github.com/savonet/liquidsoap";
-                    Printf.printf "Queue %s crashed with exception %s\n%s" s
-                      (Printexc.to_string e) bt;
-                    flush_all ();
-                    _exit 1
                 | e ->
                     log#important "Thread %S aborts with exception %s!" s
                       (Printexc.to_string e);
@@ -242,12 +205,35 @@ let rec error_handler ~bt exn =
         let bt = Printexc.get_backtrace () in
         error_handler ~bt exn
 
+(* Polymorphic compare orders these by name hash, which is not the order we
+   want: the server must come first, and a request resolution before a last.fm
+   submission. *)
+let priority_rank = function
+  | `Non_blocking -> 0
+  | `Maybe_blocking -> 1
+  | `Blocking -> 2
+
 let scheduler : priority Duppy.scheduler =
   Duppy.create
     ~on_error:(fun exn raw_bt ->
       let bt = Printexc.raw_backtrace_to_string raw_bt in
       if not (error_handler ~bt exn) then
         Printexc.raise_with_backtrace exn raw_bt)
+    ~on_fatal:(fun exn bt ->
+      Dtools.Init.exec Dtools.Log.stop;
+      Printf.printf "Scheduler crashed with exception %s\n%s"
+        (Printexc.to_string exn)
+        (Printexc.raw_backtrace_to_string bt);
+      Printf.printf
+        "PANIC: Liquidsoap has crashed, exiting.,\n\
+         Please report at: https://github.com/savonet/liquidsoap";
+      flush_all ();
+      _exit 1)
+    ~compare:(fun a b -> compare (priority_rank a) (priority_rank b))
+    ~classify:(function `Non_blocking -> `Immediate | _ -> `Blocking)
+      (* Tasks run script code, which registers its callbacks through an
+         effect. *)
+    ~wrapper:{ Duppy.wrap = Script_callback.uncollected }
     ()
 
 let () =
@@ -256,38 +242,20 @@ let () =
       Duppy.stop scheduler;
       log#important "Scheduler shut down.")
 
-let scheduler_log n =
+let scheduler_started () = Duppy.started scheduler
+
+let scheduler_logger () =
   if scheduler_log#get then (
-    let log = Log.make [n] in
-    fun m -> log#info "%s" m)
-  else fun _ -> ()
-
-let new_queue ?priorities ~name () =
-  let qlog = scheduler_log name in
-  let queue () =
-    match priorities with
-      | None -> Duppy.queue scheduler ~log:qlog name
-      | Some priorities -> Duppy.queue scheduler ~log:qlog ~priorities name
-  in
-  ignore (create ~queue:true queue () name)
+    let log = Log.make ["scheduler"] in
+    Some (fun m -> log#info "%s" m))
+  else None
 
-let create f x name = create ~queue:false f x name
 let join_all () = join_all ~set:all ()
 
 let start () =
-  if Atomic.compare_and_set state `Idle `Starting then (
-    for i = 1 to generic_queues#get do
-      let name = Printf.sprintf "Generic Queue #%d" i in
-      new_queue ~name ()
-    done;
-    for i = 1 to fast_queues#get do
-      let name = Printf.sprintf "Fast Queue #%d" i in
-      new_queue ~name ~priorities:(fun x -> x = `Maybe_blocking) ()
-    done;
-    for i = 1 to non_blocking_queues#get do
-      let name = Printf.sprintf "Non-Blocking Queue #%d" i in
-      new_queue ~priorities:(fun x -> x = `Non_blocking) ~name ()
-    done)
+  if Atomic.compare_and_set state `Idle `Starting then
+    Duppy.start ~max_blocking:blocking_tasks#get ?log:(scheduler_logger ())
+      scheduler
 
 (** Waits for [f()] to become true on condition [c]. *)
 let wait c m f =
diff --git a/src/core/utils/tutils.mli b/src/core/utils/tutils.mli
index 8f5b8ac67d..c1479f5eb8 100644
--- a/src/core/utils/tutils.mli
+++ b/src/core/utils/tutils.mli
@@ -60,6 +60,10 @@ type priority =
 (** task scheduler *)
 val scheduler : priority Duppy.scheduler
 
+(** Whether the scheduler's domains have been spawned. [Unix.fork] fails once
+    they have, so anything that forks must check this first. *)
+val scheduler_started : unit -> bool
+
 (** {1 Misc} *)
 
 (** Waits for [f()] to become true on condition [c]. The mutex [m] protecting
diff --git a/src/core/utils/utils.ml b/src/core/utils/utils.ml
index c605ccbf5d..4bf39f88de 100644
--- a/src/core/utils/utils.ml
+++ b/src/core/utils/utils.ml
@@ -256,6 +256,10 @@ external timezone : unit -> int = "liquidsoap_get_timezone"
 external timezone_by_name : unit -> string * string
   = "liquidsoap_get_timezone_by_name"
 
+(** Re-read [TZ]. The C library parses it once and caches it, so a change to the
+    variable is ignored until this runs. *)
+let tzset () = ignore (timezone ())
+
 (* Same as [Unix.mktime] but honnors [isdst] *)
 type tm = {
   tm_sec : int;
@@ -596,7 +600,7 @@ let id3v2_of_metadata ~version m =
   Metadata.ID3v2.make ~version frames
 
 let is_docker =
-  Lazy.from_fun (fun () ->
+  Lazy.Mutexed.from_fun (fun () ->
       Sys.unix
       && Sys.command "grep 'docker\\|lxc' /proc/1/cgroup >/dev/null 2>&1" = 0)
 
diff --git a/src/core/utils/utils.mli b/src/core/utils/utils.mli
index 2f83a0c727..cbbcfeeb48 100644
--- a/src/core/utils/utils.mli
+++ b/src/core/utils/utils.mli
@@ -92,7 +92,7 @@ val select :
   Unix.file_descr list * Unix.file_descr list * Unix.file_descr list
 
 val log_exception : log:Log.t -> bt:string -> string -> unit
-val is_docker : bool Lazy.t
+val is_docker : bool Lazy.Mutexed.t
 
 (** {1 Time} *)
 
@@ -104,6 +104,10 @@ external timezone : unit -> int = "liquidsoap_get_timezone" [@@noalloc]
 external timezone_by_name : unit -> string * string
   = "liquidsoap_get_timezone_by_name"
 
+(** Re-read [TZ]. The C library parses it once and caches it, so a change to the
+    variable is ignored until this runs. *)
+val tzset : unit -> unit
+
 (** [Unix.tm] with [tm_isdst] left unknown when it is [None], so that [mktime]
     works it out from the date rather than being told. *)
 type tm = {
diff --git a/src/lang/ast/term.ml b/src/lang/ast/term.ml
index 6b51aed54a..66c7b997ed 100644
--- a/src/lang/ast/term.ml
+++ b/src/lang/ast/term.ml
@@ -59,7 +59,7 @@ let conf_debug_errors = ref false
 
 (** Are we in debugging mode? *)
 let debug =
-  Lazy.from_fun (fun () ->
+  Lazy.Mutexed.from_fun (fun () ->
       try
         ignore (Sys.getenv "LIQUIDSOAP_DEBUG_LANG");
         true
@@ -485,7 +485,7 @@ end
 let make ?pos ?t ?flags ?methods e =
   let term = make ?pos ?t ?flags ?methods e in
   let t = match t with Some t -> t | None -> Type.var ?pos () in
-  if Lazy.force debug then
+  if Lazy.Mutexed.force debug then
     Printf.eprintf "%s (%s): assigned type var %s\n"
       (Pos.Option.to_string t.Type.pos)
       (try to_string term with _ -> "<?>")
diff --git a/src/lang/ast/term.mli b/src/lang/ast/term.mli
index 1cdaca9533..d330289581 100644
--- a/src/lang/ast/term.mli
+++ b/src/lang/ast/term.mli
@@ -35,7 +35,7 @@ exception Unsupported_encoder of (Pos.t option * string)
 
 val conf_debug : bool ref
 val conf_debug_errors : bool ref
-val debug : bool Lazy.t
+val debug : bool Lazy.Mutexed.t
 val profile : bool ref
 val ref_t : ?pos:Pos.t -> Type.t -> Type.t
 
diff --git a/src/lang/console/console.ml b/src/lang/console/console.ml
index 9117319adb..6e11f8906c 100644
--- a/src/lang/console/console.ml
+++ b/src/lang/console/console.ml
@@ -23,7 +23,8 @@
 (* Some of the code below was borrowed from opam. *)
 
 let dumb_term =
-  lazy (try Sys.getenv "TERM" = "dumb" with Not_found -> Sys.win32)
+  Lazy.Mutexed.from_fun (fun () ->
+      try Sys.getenv "TERM" = "dumb" with Not_found -> Sys.win32)
 
 type color_conf = [ `Always | `Never | `Auto ]
 
@@ -31,15 +32,15 @@ let color_conf : color_conf ref = ref `Auto
 
 let color =
   let auto =
-    lazy
-      (try Unix.isatty Unix.stdout && not (Lazy.force dumb_term)
-       with _ -> false)
+    Lazy.Mutexed.from_fun (fun () ->
+        try Unix.isatty Unix.stdout && not (Lazy.Mutexed.force dumb_term)
+        with _ -> false)
   in
   fun () ->
     match !color_conf with
       | `Always -> true
       | `Never -> false
-      | `Auto -> Lazy.force auto
+      | `Auto -> Lazy.Mutexed.force auto
 
 type text_style =
   [ `bold
diff --git a/src/lang/data/doc.ml b/src/lang/data/doc.ml
index 8d518f98be..d1208e82d9 100644
--- a/src/lang/data/doc.ml
+++ b/src/lang/data/doc.ml
@@ -197,13 +197,13 @@ module Value = struct
 
   let db = ref Map.empty
 
-  let add (name : string) (doc : t Lazy.t) =
+  let add (name : string) (doc : t Lazy.Mutexed.t) =
     let name =
       Re.replace ~all:true ~f:(fun _ -> "null") (Re.Pcre.regexp "^_null") name
     in
     db := Map.add name doc !db
 
-  let get name = Lazy.force (Map.find name !db)
+  let get name = Lazy.Mutexed.force (Map.find name !db)
   let count () = Map.cardinal !db
 
   (** Only print function names. *)
@@ -223,7 +223,7 @@ module Value = struct
         print ("# " ^ category_name ^ "\n\n");
         Map.iter
           (fun f d ->
-            let d = Lazy.force d in
+            let d = Lazy.Mutexed.force d in
             if d.category = category && not (List.mem `Hidden d.flags) then
               print ("- " ^ f ^ "\n"))
           !db;
@@ -350,7 +350,7 @@ module Value = struct
   let to_json () : Json.t =
     !db |> Map.to_seq
     |> Seq.map (fun (l, f) ->
-        let f = Lazy.force f in
+        let f = Lazy.Mutexed.force f in
         let arguments =
           List.map
             (fun (l, a) ->
@@ -414,7 +414,7 @@ module Value = struct
 
   let print_functions_md ?extra ?deprecated print =
     let should_show ~category d =
-      let d = Lazy.force d in
+      let d = Lazy.Mutexed.force d in
       (not (List.mem `Hidden d.flags))
       && ((not (deprecated = Some true)) || List.mem `Deprecated d.flags)
       && (deprecated = Some true || not (List.mem `Deprecated d.flags))
@@ -445,7 +445,7 @@ module Value = struct
         Map.iter
           (fun f d ->
             if should_show ~category d then (
-              let d = Lazy.force d in
+              let d = Lazy.Mutexed.force d in
               print ("### `" ^ f ^ "`\n\n");
               print d.description;
               print "\n\n";
@@ -534,7 +534,7 @@ module Value = struct
     print "(defconst liquidsoap-completions '(\n";
     Map.iter
       (fun name f ->
-        let f = Lazy.force f in
+        let f = Lazy.Mutexed.force f in
         if not (List.mem `Hidden f.flags || List.mem `Deprecated f.flags) then (
           let t = String.map (fun c -> if c = '\n' then ' ' else c) f.typ in
           Printf.ksprintf print
diff --git a/src/lang/data/doc.mli b/src/lang/data/doc.mli
index c3fcc96764..d60fe7eab2 100644
--- a/src/lang/data/doc.mli
+++ b/src/lang/data/doc.mli
@@ -92,7 +92,7 @@ module Value : sig
   (** Register documentation under a name. Lazy: building it forces the
       operator's type to be printed, which is wasted work for the common case
       where nobody asks for documentation. *)
-  val add : string -> t Lazy.t -> unit
+  val add : string -> t Lazy.Mutexed.t -> unit
 
   val count : unit -> int
 
diff --git a/src/lang/runtime/builtins_math.ml b/src/lang/runtime/builtins_math.ml
index a1efc29124..dd49da056b 100644
--- a/src/lang/runtime/builtins_math.ml
+++ b/src/lang/runtime/builtins_math.ml
@@ -20,7 +20,7 @@
 
  *****************************************************************************)
 
-let log = lazy (!Hooks.make_log ["math"])
+let log = Lazy.Mutexed.from_fun (fun () -> !Hooks.make_log ["math"])
 
 let () =
   let add op name descr =
@@ -171,7 +171,7 @@ let _ =
       let x = List.assoc "" p |> Lang.to_num in
       let raise = List.assoc "raise" p |> Lang.to_bool in
       let pos = Lang.pos p in
-      let log = Lazy.force log in
+      let log = Lazy.Mutexed.force log in
       let x =
         match x with
           | `Int x -> x
diff --git a/src/lang/runtime/builtins_ref.ml b/src/lang/runtime/builtins_ref.ml
index cfc21067fc..f868f78553 100644
--- a/src/lang/runtime/builtins_ref.ml
+++ b/src/lang/runtime/builtins_ref.ml
@@ -30,4 +30,5 @@ let ref =
       let x = List.assoc "" p |> Atomic.make in
       let get () = Atomic.get x in
       let set v = Atomic.set x v in
-      Lang.reference get set)
+      let exchange v = Atomic.exchange x v in
+      Lang.reference ~exchange get set)
diff --git a/src/lang/runtime/evaluation.ml b/src/lang/runtime/evaluation.ml
index c6a7ea3901..84516709a4 100644
--- a/src/lang/runtime/evaluation.ml
+++ b/src/lang/runtime/evaluation.ml
@@ -486,7 +486,7 @@ let toplevel_add ?doc pat ~t v =
               composition_description;
             }
           in
-          Some (Lazy.from_fun doc)
+          Some (Lazy.Mutexed.from_fun doc)
   in
   let env, pa = Typechecking.type_of_pat ~level:max_int ~pos:None pat in
   Typing.(t <: pa);
@@ -516,7 +516,7 @@ let rec eval_toplevel ?(interactive = false) t =
               | `PTuple _ -> assert false)
         in
         toplevel_add ?doc pat ~t:(generalized, def_t) def;
-        if Lazy.force debug then
+        if Lazy.Mutexed.force debug then
           Printf.eprintf "Added toplevel %s : %s\n%!" (string_of_pat pat)
             (Type.to_string ~generalized def_t);
         let var = string_of_pat pat in
diff --git a/src/lang/runtime/lang.mli b/src/lang/runtime/lang.mli
index 403f45bf77..abc295e655 100644
--- a/src/lang/runtime/lang.mli
+++ b/src/lang/runtime/lang.mli
@@ -176,7 +176,14 @@ val product : value -> value -> value
 val tuple : value list -> value
 val meth : value -> (string * value) list -> value
 val record : (string * value) list -> value
-val reference : (unit -> value) -> (value -> unit) -> value
+
+(** Build a reference from a getter and a setter.
+
+    Pass [exchange] whenever the underlying state can do it in one step: the
+    fallback is a get followed by a set, and callers take a reference to be
+    atomic. *)
+val reference :
+  ?exchange:(value -> value) -> (unit -> value) -> (value -> unit) -> value
 
 (** Build a function from an OCaml function. Items in the prototype indicate the
     label and optional values. Second string value is used when renaming
diff --git a/src/lang/runtime/lang_core.ml b/src/lang/runtime/lang_core.ml
index 7e6827eadb..9371af867d 100644
--- a/src/lang/runtime/lang_core.ml
+++ b/src/lang/runtime/lang_core.ml
@@ -116,16 +116,30 @@ let val_cst_fun p c =
     | String { value = i } -> f (mkg Type.String) (`String i)
     | _ -> mk (`FFI { ffi_args = p; ffi_fn = (fun _ -> c) })
 
-let reference get set =
-  let get = val_fun [] (fun _ -> get ()) in
-  let set =
+let reference ?exchange get set =
+  (* Without one of its own, a reference can only offer the two steps it is
+     built from, which is as indivisible as its [set] already is. *)
+  let exchange =
+    match exchange with
+      | Some fn -> fn
+      | None ->
+          fun v ->
+            let previous = get () in
+            set v;
+            previous
+  in
+  let get_fn = val_fun [] (fun _ -> get ()) in
+  let set_fn =
     val_fun
       [("", "", None)]
       (fun p ->
         List.assoc "" p |> set;
         unit)
   in
-  meth get [("set", set)]
+  let exchange_fn =
+    val_fun [("", "", None)] (fun p -> List.assoc "" p |> exchange)
+  in
+  meth get_fn [("set", set_fn); ("exchange", exchange_fn)]
 
 (** Helpers for defining builtin functions. *)
 
@@ -255,7 +269,7 @@ let add_builtin ~category ~descr ?(flags = []) ?(meth = []) ?(examples = [])
       }
     (* to_plugin_doc category flags examples descr proto return_t *)
   in
-  let doc = Lazy.from_fun doc in
+  let doc = Lazy.Mutexed.from_fun doc in
   let generalized = Typing.filter_vars (fun _ -> true) t in
   Environment.add_builtin ~doc
     (String.split_on_char '.' name)
@@ -281,7 +295,8 @@ let add_builtin_value ~category ~descr ?(flags = []) ?base name value t =
         composition = [];
       }
   in
-  Environment.add_builtin ~doc:(Lazy.from_fun doc)
+  Environment.add_builtin
+    ~doc:(Lazy.Mutexed.from_fun doc)
     (String.split_on_char '.' name)
     ((generalized, t), value);
   name
diff --git a/src/lang/runtime/runtime.ml b/src/lang/runtime/runtime.ml
index 543d34b79b..3afaff4227 100644
--- a/src/lang/runtime/runtime.ml
+++ b/src/lang/runtime/runtime.ml
@@ -302,7 +302,8 @@ let type_term ?name ?stdlib ?term ?ty ?cache_dirtype ~cache ~trim ~lib
   match cached_term with
     | Some term -> term
     | None ->
-        if Lazy.force Term.debug then Printf.eprintf "Type checking...\n%!";
+        if Lazy.Mutexed.force Term.debug then
+          Printf.eprintf "Type checking...\n%!";
         (* Type checking *)
         let time fn =
           match name with
@@ -342,7 +343,7 @@ let type_term ?name ?stdlib ?term ?ty ?cache_dirtype ~cache ~trim ~lib
                 Typechecking.check ?env
                   ~check_top_level_override:(stdlib <> None) ~throw checked_term));
 
-        if Lazy.force Term.debug then
+        if Lazy.Mutexed.force Term.debug then
           Printf.eprintf "Checking for unused variables...\n%!";
         (* Check for unused variables, relies on types *)
         report ~lexbuf:None
@@ -362,7 +363,7 @@ let eval_term ?name ~toplevel ast =
       (fun ~throw:_ () ->
         if toplevel then Evaluation.eval_toplevel ast else Evaluation.eval ast)
   in
-  if Lazy.force Term.debug then Printf.eprintf "Evaluating...\n%!";
+  if Lazy.Mutexed.force Term.debug then Printf.eprintf "Evaluating...\n%!";
   match name with
     | None -> eval ()
     | Some name ->
diff --git a/src/lang/runtime/typechecking.ml b/src/lang/runtime/typechecking.ml
index 3a0fbf4902..a0cd2dae9f 100644
--- a/src/lang/runtime/typechecking.ml
+++ b/src/lang/runtime/typechecking.ml
@@ -383,7 +383,7 @@ let rec check ?(print_toplevel = false) ~throw ~level ~env e =
       | `Var var ->
           let s = env#get ~pos var in
           base_type >: Typing.instantiate ~level s;
-          if Lazy.force Term.debug then
+          if Lazy.Mutexed.force Term.debug then
             Printf.eprintf "Instantiate %s : %s becomes %s\n" var
               (Type.string_of_scheme s) (Type.to_string base_type)
       | `Let ({ pat; replace; def; body; _ } as l) ->
diff --git a/src/lang/types/repr.ml b/src/lang/types/repr.ml
index ad0ceffef8..2a9b58df51 100644
--- a/src/lang/types/repr.ml
+++ b/src/lang/types/repr.ml
@@ -214,7 +214,7 @@ let print f t =
   let rec print ~par vars : t -> DS.t = function
     | `Constr (name, [(_, (`Meth _ as record_type))])
       when name = "source" || name = "format" ->
-        Format.open_box (1 + String.length name);
+        Format.pp_open_box f (1 + String.length name);
         Format.fprintf f "%s(" name;
         let rec extract fields = function
           | `Meth ({ R.name = field }, base_type)
@@ -248,7 +248,7 @@ let print f t =
             (true, vars) fields
         in
         Format.fprintf f ")";
-        Format.close_box ();
+        Format.pp_close_box f ();
         vars
     (* The source constructor with no content parameter is [source(_)]: print it
        the way it is written. *)
@@ -262,11 +262,11 @@ let print f t =
         Format.fprintf f "none";
         vars
     | `Constr (name, params) ->
-        Format.open_box (1 + String.length name);
+        Format.pp_open_box f (1 + String.length name);
         Format.fprintf f "%s(" name;
         let vars = print_list vars params in
         Format.fprintf f ")";
-        Format.close_box ();
+        Format.pp_close_box f ();
         vars
     | `Tuple [] ->
         Format.fprintf f "unit";
@@ -480,10 +480,14 @@ let print f t =
   end;
   Format.fprintf f "@]"
 
+(* Its own buffer rather than [Format.str_formatter], which is per-domain and
+   shared by whatever else on that domain formats a value. *)
 let to_string t =
-  print Format.str_formatter t;
-  Format.fprintf Format.str_formatter "@?";
-  Format.flush_str_formatter ()
+  let buf = Buffer.create 64 in
+  let f = Format.formatter_of_buffer buf in
+  print f t;
+  Format.pp_print_flush f ();
+  Buffer.contents buf
 
 let print_type f t = print f (make t)
 
diff --git a/src/lang/types/type.ml b/src/lang/types/type.ml
index 6fa923caa8..d9191e9561 100644
--- a/src/lang/types/type.ml
+++ b/src/lang/types/type.ml
@@ -32,7 +32,13 @@ let string_of_scheme = Repr.string_of_scheme
 let reference ?pos a =
   let get = make ?pos (Arrow ([], a)) in
   let set = make ?pos (Arrow ([(false, "", a)], make ?pos unit)) in
-  meth ?pos "set" ([], set) ~doc:"Set the value of the reference." get
+  let exchange = make ?pos (Arrow ([(false, "", a)], a)) in
+  meth ?pos "set" ([], set) ~doc:"Set the value of the reference."
+    (meth ?pos "exchange" ([], exchange)
+       ~doc:
+         "Set the value of the reference and return the value it replaced, as \
+          one indivisible step."
+       get)
 
 let record_constr =
   {
diff --git a/src/lang/values/environment.mli b/src/lang/values/environment.mli
index 8d5f34ba8b..25f2ef1966 100644
--- a/src/lang/values/environment.mli
+++ b/src/lang/values/environment.mli
@@ -32,7 +32,7 @@ val get_builtin : string -> (Type.scheme * Value.t) option
 val add_builtin :
   ?override:bool ->
   ?register:bool ->
-  ?doc:Doc.Value.t Lazy.t ->
+  ?doc:Doc.Value.t Lazy.Mutexed.t ->
   string list ->
   Type.scheme * Value.t ->
   unit
diff --git a/src/libs/playlist.liq b/src/libs/playlist.liq
index 665a9e53cb..396dbb7845 100644
--- a/src/libs/playlist.liq
+++ b/src/libs/playlist.liq
@@ -597,8 +597,10 @@ let register_playlist_parsers =
     registered = ref(false)
     fun () ->
       begin
+        # Claiming the flag and reading it has to be one step: several threads
+        # reach here for the same parsers, and registering one twice fails.
         if
-          not registered()
+          not registered.exchange(true)
         then
           parsers = settings.playlist.mime_types.basic()
 %ifdef playlist.parse.xml
@@ -615,7 +617,6 @@ let register_playlist_parsers =
             parsers
           )
         end
-        registered := true
       end
   end
 on_start(register_playlist_parsers)
diff --git a/src/libs/ref.liq b/src/libs/ref.liq
index 7095dd05f0..173c6c9f53 100644
--- a/src/libs/ref.liq
+++ b/src/libs/ref.liq
@@ -1,11 +1,3 @@
-# Create a reference from a pair of get / set functions.
-# @category Programming
-# @param get Function to retrieve the value of the reference.
-# @param set Function to change the value of the reference.
-def ref.make(get, set) =
-  (get.{set = set} : ref)
-end
-
 # Create a getter from a reference (sometimes useful to remove the `set`
 # method).
 # @category Programming
@@ -13,14 +5,6 @@ def ref.getter((r:ref)) =
   {r()}
 end
 
-# Map functions to a reference.
-# @category Programming
-# @param g Function to apply to the getter.
-# @param s Function to apply to the setter.
-def ref.map(g, s, (r:ref)) =
-  ref.make({g(r())}, fun (x) -> r.set(s(x)))
-end
-
 # Increment a reference to an integer.
 # @category Programming
 def ref.incr(r) =
diff --git a/src/libs/runtime.liq b/src/libs/runtime.liq
index 9b42beed7d..f317665dfc 100644
--- a/src/libs/runtime.liq
+++ b/src/libs/runtime.liq
@@ -59,12 +59,4 @@ def runtime.cpu.usage_getter() =
 end
 %endif
 
-# Set the current time zone. This is
-# equivalent to setting the `TZ` environment
-# variable.
-# @category Time
-def time.zone.set(tz) =
-  environment.set("TZ", tz)
-end
-
 runtime.gc.set(runtime.gc.get().{space_overhead = 80})
diff --git a/src/libs/thread.liq b/src/libs/thread.liq
index d0a459c12c..8f300a660e 100644
--- a/src/libs/thread.liq
+++ b/src/libs/thread.liq
@@ -1,6 +1,6 @@
 # Run a function in a separate thread.
 # @category Programming
-# @param ~fast Whether the thread is supposed to return quickly or not. Typically, blocking tasks (e.g. fetching data over the internet) should not be considered to be fast. When set to `false` its priority will be lowered below that of request resolutions and fast timeouts. This is only effective if you set a dedicated queue for fast tasks, see the "scheduler" settings for more details.
+# @param ~fast Whether the thread is supposed to return quickly or not. Typically, blocking tasks (e.g. fetching data over the internet) should not be considered to be fast. When set to `false` its priority will be lowered below that of request resolutions and fast timeouts.
 # @param ~delay Delay (in seconds) after which the thread should be launched.
 # @param ~every How often (in seconds) the thread should be run. If negative or `null`, run once.
 # @param ~on_error Error callback executed when an error occurred while running the given function. When passed, \
diff --git a/src/modules/dtools/dtools_impl.ml b/src/modules/dtools/dtools_impl.ml
index 410b8cc537..edc5c892a0 100644
--- a/src/modules/dtools/dtools_impl.ml
+++ b/src/modules/dtools/dtools_impl.ml
@@ -837,6 +837,9 @@ module Log = struct
           Condition.signal log_condition;
           Thread.join th
     end;
+    (* The thread returns as soon as it sees [log_stop], so entries queued
+       during shutdown are still pending here. *)
+    flush_queue ();
     match !log_ch with
       | None -> ()
       | Some ch ->
diff --git a/src/modules/duppy/dune b/src/modules/duppy/dune
index 760f065b45..a1bc6702c4 100644
--- a/src/modules/duppy/dune
+++ b/src/modules/duppy/dune
@@ -1,7 +1,4 @@
 (library
  (name duppy)
  (libraries unix threads.posix re stdlib_utils)
- (foreign_stubs
-  (language c)
-  (names duppy_stubs))
  (synopsis "OCaml advanced scheduler"))
diff --git a/src/modules/duppy/duppy.ml b/src/modules/duppy/duppy.ml
index 83004221d0..3a6f1e0cb1 100644
--- a/src/modules/duppy/duppy.ml
+++ b/src/modules/duppy/duppy.ml
@@ -23,76 +23,208 @@
 module Pcre = Re.Pcre
 
 type fd = Unix.file_descr
+type event = [ `Delay of float | `Write of fd | `Read of fd | `Exception of fd ]
 
-let select, select_fname =
-  match Sys.os_type with
-    | "Unix" -> (Unix_utils.poll, "poll")
-    | _ -> (Unix_utils.select, "select")
-
-(** [remove f l] is like [List.find f l] but also returns the result of removing
-    * the found element from the original list. *)
-let remove f l =
-  let rec aux acc = function
-    | [] -> raise Not_found
-    | x :: l -> if f x then (x, List.rev_append acc l) else aux (x :: acc) l
-  in
-  aux [] l
-
-(** Events and tasks from the implementation point-of-view: * we have to hide
-    the 'a parameter. *)
-
-type e = { r : fd list; w : fd list; x : fd list; t : float }
-
+(** A task waiting to run: what it waits on, when its earliest delay elapses and
+    what to run with whichever of its events fired. [dispatched] retires the
+    entry a task leaves behind in the timer index when a descriptor fired first.
+*)
 type 'a t = {
+  id : int;
   prio : 'a;
-  enrich : e -> e;
-  is_ready : e -> (unit -> 'a t list) option;
+  t0 : float;
+  events : event list;
+  deadline : float;
+  fire : event list -> 'a t list;
+  mutable dispatched : bool;
+}
+
+(** Waiting tasks ordered by when they expire, the id breaking ties between
+    tasks sharing a deadline. *)
+module Timers = Map.Make (struct
+  type t = float * int
+
+  let compare = compare
+end)
+
+let next_id = Atomic.make 0
+let time () = Unix.gettimeofday ()
+let no_interest = { Pollset.read = false; write = false; except = false }
+
+let fds_of_events events =
+  List.sort_uniq compare
+    (List.filter_map
+       (function
+         | `Read fd | `Write fd | `Exception fd -> Some fd | `Delay _ -> None)
+       events)
+
+let interest_for fd events =
+  List.fold_left
+    (fun acc ev ->
+      match ev with
+        | `Read f when f = fd -> { acc with Pollset.read = true }
+        | `Write f when f = fd -> { acc with Pollset.write = true }
+        | `Exception f when f = fd -> { acc with Pollset.except = true }
+        | _ -> acc)
+    no_interest events
+
+(** Which of [t]'s events have fired, given what a wait reported. A descriptor
+    in error satisfies whatever it was awaited for, so the task runs and finds
+    out. *)
+let fired_events t ready =
+  let of_fd fd = List.assoc_opt fd ready in
+  List.filter
+    (fun ev ->
+      match ev with
+        | `Delay d -> time () >= t.t0 +. d
+        | `Read fd -> (
+            match of_fd fd with
+              | Some i -> i.Pollset.read || i.Pollset.except
+              | None -> false)
+        | `Write fd -> (
+            match of_fd fd with
+              | Some i -> i.Pollset.write || i.Pollset.except
+              | None -> false)
+        | `Exception fd -> (
+            match of_fd fd with Some i -> i.Pollset.except | None -> false))
+    t.events
+
+type execution_class = [ `Immediate | `Blocking ]
+
+(** Wraps every task body. Effect handlers do not cross the thread a task is
+    dispatched to, so a caller whose tasks need one installs it here. *)
+type wrapper = { wrap : 'a. (unit -> 'a) -> 'a }
+
+(** One domain of the pool. [wake] carries a signal across the window between
+    registering as idle and blocking on [worker_c], so a wake-up sent in that
+    window is not lost. [blocking] counts the tasks parked on this worker's
+    auxiliary threads. *)
+type worker = {
+  worker_m : Mutex.t;
+  worker_c : Condition.t;
+  mutable wake : bool;
+  mutable took_batch : bool;
+  blocking : int Atomic.t;
 }
 
 type 'a scheduler = {
   on_error : exn -> Printexc.raw_backtrace -> unit;
-  out_pipe : Unix.file_descr;
-  in_pipe : Unix.file_descr;
+  on_fatal : exn -> Printexc.raw_backtrace -> unit;
+  mutable log : (string -> unit) option;
   compare : 'a -> 'a -> int;
-  select_m : Mutex.t;
-  mutable tasks : 'a t list;
+  classify : 'a -> execution_class;
+  wrapper : wrapper;
+  out_pipe : fd;
+  in_pipe : fd;
+  pollset : Pollset.t;
+  by_fd : (fd, 'a t list) Hashtbl.t;
+  mutable timers : 'a t Timers.t;
   tasks_m : Mutex.t;
   mutable ready : ('a * (unit -> 'a t list)) list;
+  mutable idle : worker list;
   ready_m : Mutex.t;
-  mutable queues : Condition.t list;
-  queues_m : Mutex.t;
-  mutable stop : bool;
-  stop_m : Mutex.t;
-  queue_stopped_c : Condition.t;
+  started : bool Atomic.t;
+  stopped : bool Atomic.t;
+  poller_done : bool Atomic.t;
+  mutable blocking_per_worker : int;
+  mutable workers : worker list;
+  mutable domains : unit Domain.t list;
 }
 
+(** The interest registered for a descriptor is the union of what the tasks
+    waiting on it want, so dropping one task does not stop watching for the
+    others. [s.tasks_m] must be held. *)
+let rearm s fd =
+  match Hashtbl.find_opt s.by_fd fd with
+    | None | Some [] ->
+        Hashtbl.remove s.by_fd fd;
+        Pollset.remove s.pollset fd
+    | Some tasks ->
+        Pollset.set s.pollset fd
+          (List.fold_left
+             (fun acc t ->
+               let i = interest_for fd t.events in
+               {
+                 Pollset.read = acc.Pollset.read || i.Pollset.read;
+                 write = acc.Pollset.write || i.Pollset.write;
+                 except = acc.Pollset.except || i.Pollset.except;
+               })
+             no_interest tasks)
+
+let register s t =
+  List.iter
+    (fun fd ->
+      Hashtbl.replace s.by_fd fd
+        (t :: Option.value ~default:[] (Hashtbl.find_opt s.by_fd fd));
+      rearm s fd)
+    (fds_of_events t.events);
+  if t.deadline < infinity then
+    s.timers <- Timers.add (t.deadline, t.id) t s.timers
+
+let unregister s t =
+  List.iter
+    (fun fd ->
+      (match Hashtbl.find_opt s.by_fd fd with
+        | None -> ()
+        | Some tasks ->
+            Hashtbl.replace s.by_fd fd
+              (List.filter (fun x -> x.id <> t.id) tasks));
+      rearm s fd)
+    (fds_of_events t.events);
+  if t.deadline < infinity then
+    s.timers <- Timers.remove (t.deadline, t.id) s.timers
+
 let clear_tasks s =
   Mutex.lock s.tasks_m;
-  s.tasks <- [];
+  Hashtbl.iter (fun fd _ -> Pollset.remove s.pollset fd) s.by_fd;
+  Hashtbl.reset s.by_fd;
+  s.timers <- Timers.empty;
   Mutex.unlock s.tasks_m
 
-let create ?(on_error = Printexc.raise_with_backtrace) ?(compare = compare) () =
+let default_on_fatal exn bt =
+  Printf.eprintf "Duppy: event loop crashed with %s\n%s\n%!"
+    (Printexc.to_string exn)
+    (Printexc.raw_backtrace_to_string bt);
+  exit 1
+
+let create ?(on_error = Printexc.raise_with_backtrace)
+    ?(on_fatal = default_on_fatal) ?(compare = compare)
+    ?(classify : 'a -> execution_class = fun _ -> `Blocking)
+    ?(wrapper = { wrap = (fun fn -> fn ()) }) () =
   (* A socket pair rather than a pipe: on Windows only sockets can be made
      non-blocking, and a blocking wake-up write could hang its caller. *)
   let out_pipe, in_pipe = Unix_utils.socketpair () in
   Unix.set_nonblock in_pipe;
+  let pollset = Pollset.create () in
+  Pollset.set pollset out_pipe
+    { Pollset.read = true; write = false; except = false };
   {
     on_error;
+    on_fatal;
+    log = None;
+    compare;
+    classify;
+    wrapper;
     out_pipe;
     in_pipe;
-    compare;
-    select_m = Mutex.create ();
-    tasks = [];
+    pollset;
+    by_fd = Hashtbl.create 64;
+    timers = Timers.empty;
     tasks_m = Mutex.create ();
     ready = [];
+    idle = [];
     ready_m = Mutex.create ();
-    queues = [];
-    queues_m = Mutex.create ();
-    stop = false;
-    stop_m = Mutex.create ();
-    queue_stopped_c = Condition.create ();
+    started = Atomic.make false;
+    stopped = Atomic.make false;
+    poller_done = Atomic.make false;
+    blocking_per_worker = 1;
+    workers = [];
+    domains = [];
   }
 
+let started s = Atomic.get s.started
+let log s fn = match s.log with None -> () | Some log -> log (fn ())
+
 let wake_up s =
   try ignore (Unix_utils.write s.in_pipe (Bytes.of_string "x") 0 1)
   with
@@ -101,11 +233,38 @@ let wake_up s =
   ->
     ()
 
+let signal_worker w =
+  Mutex.lock w.worker_m;
+  w.wake <- true;
+  Condition.signal w.worker_c;
+  Mutex.unlock w.worker_m
+
+(** Detach up to [n] idle workers. [s.ready_m] must be held. *)
+let take_idle s n =
+  let rec f n acc =
+    if n <= 0 then acc
+    else (
+      match s.idle with
+        | [] -> acc
+        | w :: l ->
+            s.idle <- l;
+            f (n - 1) (w :: acc))
+  in
+  f n []
+
+let wake_idle s n =
+  let workers = Mutex.protect s.ready_m (fun () -> take_idle s n) in
+  List.iter signal_worker workers
+
+let wake_worker s w =
+  Mutex.protect s.ready_m (fun () ->
+      s.idle <- List.filter (fun x -> x != w) s.idle);
+  signal_worker w
+
 module Task = struct
   (** Events and tasks from the user's point-of-view. *)
 
-  type event =
-    [ `Delay of float | `Write of fd | `Read of fd | `Exception of fd ]
+  type nonrec event = event
 
   type ('a, 'b) task = {
     priority : 'a;
@@ -113,51 +272,44 @@ module Task = struct
     handler : 'b list -> ('a, 'b) task list;
   }
 
-  let time () = Unix.gettimeofday ()
-
   let rec t_of_task (task : ('a, [< event ]) task) =
     let t0 = time () in
+    let events = (task.events :> event list) in
     {
+      id = Atomic.fetch_and_add next_id 1;
       prio = task.priority;
-      enrich =
-        (fun e ->
-          List.fold_left
-            (fun e -> function
-              | `Delay s -> { e with t = min e.t (t0 +. s) }
-              | `Read s -> { e with r = s :: e.r }
-              | `Write s -> { e with w = s :: e.w }
-              | `Exception s -> { e with x = s :: e.x })
-            e task.events);
-      is_ready =
-        (fun e ->
+      t0;
+      events;
+      deadline =
+        List.fold_left
+          (fun d -> function `Delay s -> min d (t0 +. s) | _ -> d)
+          infinity events;
+      fire =
+        (fun fired ->
           let l =
-            List.filter
-              (fun evt ->
-                match (evt :> event) with
-                  | `Delay s when time () > t0 +. s -> true
-                  | `Read s when List.mem s e.r -> true
-                  | `Write s when List.mem s e.w -> true
-                  | `Exception s when List.mem s e.x -> true
-                  | _ -> false)
-              task.events
+            List.filter (fun ev -> List.mem (ev :> event) fired) task.events
           in
-          if l = [] then None
-          else Some (fun () -> List.map t_of_task (task.handler l)));
+          List.map t_of_task (task.handler l));
+      dispatched = false;
     }
 
   let add_t s items =
+    let ready = ref 0 in
     let f item =
-      match item.is_ready { r = []; w = []; x = []; t = 0. } with
-        | Some f ->
-            Mutex.lock s.ready_m;
-            s.ready <- (item.prio, f) :: s.ready;
-            Mutex.unlock s.ready_m
-        | None ->
+      match fired_events item [] with
+        | [] ->
             Mutex.lock s.tasks_m;
-            s.tasks <- item :: s.tasks;
+            register s item;
             Mutex.unlock s.tasks_m
+        | fired ->
+            item.dispatched <- true;
+            Mutex.lock s.ready_m;
+            s.ready <- (item.prio, fun () -> item.fire fired) :: s.ready;
+            Mutex.unlock s.ready_m;
+            incr ready
     in
     List.iter f items;
+    if 0 < !ready then wake_idle s !ready;
     wake_up s
 
   let add s t = add_t s [t_of_task t]
@@ -165,197 +317,291 @@ end
 
 open Task
 
-let stop s =
-  clear_tasks s;
-  Mutex.lock s.stop_m;
-  s.stop <- true;
-  Mutex.unlock s.stop_m;
-  Mutex.lock s.queues_m;
-  while List.length s.queues > 0 do
-    wake_up s;
-    Mutex.lock s.ready_m;
-    List.iter Condition.signal s.queues;
-    Mutex.unlock s.ready_m;
-    Condition.wait s.queue_stopped_c s.queues_m
-  done;
-  Mutex.unlock s.queues_m
+(** A parked computation and the means to wake it. *)
+type suspension = { park : (event list -> unit) -> unit }
+
+type _ Effect.t += Await : suspension -> event list Effect.t
+
+let await ~priority s events =
+  let events = (events :> event list) in
+  Effect.perform
+    (Await
+       {
+         park =
+           (fun resume ->
+             Task.add s
+               {
+                 priority;
+                 events;
+                 handler =
+                   (fun e ->
+                     resume e;
+                     []);
+               });
+       })
+
+let reschedule ?(delay = 0.) ~priority s =
+  ignore (await ~priority s [`Delay delay])
+
+(* A deep handler is part of the continuation it captures, so resuming
+   reinstates it and the computation can park again. Parking registers an
+   ordinary task whose handler resumes, which is why the task returns no new
+   work of its own. *)
+let run fn =
+  let open Effect.Deep in
+  match_with fn ()
+    {
+      retc = (fun () -> ());
+      exnc = (fun exn -> raise exn);
+      effc =
+        (fun (type a) (e : a Effect.t) ->
+          match e with
+            | Await { park } ->
+                Some
+                  (fun (k : (a, unit) continuation) ->
+                    park (fun events -> continue k events))
+            | _ -> None);
+    }
 
 let tmp = Bytes.create 1024
 
-(** There should be only one call of #process at a time. * Process waits for
-    tasks to become ready, and moves ready tasks * to the ready queue. *)
-let process s log =
-  (* Compute the union of all events. *)
-  let e =
-    List.fold_left
-      (fun e t -> t.enrich e)
-      { r = [s.out_pipe]; w = []; x = []; t = infinity }
-      s.tasks
-  in
-  (* Poll for an event. *)
-  let r, w, x =
-    try
-      let timeout = if e.t = infinity then -1. else max 0. (e.t -. time ()) in
-      log
-        (Printf.sprintf "Enter %s at %f, timeout %f (%d/%d/%d)." select_fname
-           (time ()) timeout (List.length e.r) (List.length e.w)
-           (List.length e.x));
-      let r, w, x = select e.r e.w e.x timeout in
-      log
-        (Printf.sprintf "Left %s at %f (%d/%d/%d)." select_fname (time ())
-           (List.length r) (List.length w) (List.length x));
-      (r, w, x)
-    with e ->
-      (* Uncaught exception:
-       * 1) Discards all tasks currently in the loop (we do not know which
-       *    socket caused an error).
-       * 2) Re-Raise e *)
-      clear_tasks s;
-      raise e
-  in
-  (* Empty the wake_up pipe if needed. *)
-  let () =
-    if List.mem s.out_pipe r then
-      (* For safety, we may absorb more than
-       * one write. This avoids bad situation
-       * when exceesive wake_up may fill up the
-       * pipe's write buffer, causing a wake_up
-       * to become blocking.. *)
-      ignore (Unix_utils.read s.out_pipe tmp 0 1024)
+type 'a work = Batch of (unit -> 'a t list) list | One of (unit -> 'a t list)
+
+(** Pick this worker's next unit of work and the idle workers to signal for what
+    is left behind. [s.ready_m] must be held.
+
+    Immediate tasks go as one batch: they do not block, so running them in
+    sequence on the calling domain costs less than a hand-off each. Blocking
+    tasks go one at a time, so they spread over the pool. *)
+let take_work s w =
+  let immediate, blocking =
+    List.partition (fun (p, _) -> s.classify p = `Immediate) s.ready
   in
-  (* Move ready tasks to the ready list. *)
-  let e = { r; w; x; t = 0. } in
-  Mutex.lock s.tasks_m;
-  (* Split [tasks] into [r]eady and still [w]aiting. *)
-  let r, w =
-    List.fold_left
-      (fun (r, w) t ->
-        match t.is_ready e with
-          | Some f -> ((t.prio, f) :: r, w)
-          | None -> (r, t :: w))
-      ([], []) s.tasks
+  let can_block =
+    blocking <> [] && Atomic.get w.blocking < s.blocking_per_worker
   in
-  s.tasks <- w;
-  Mutex.unlock s.tasks_m;
-  Mutex.lock s.ready_m;
-  s.ready <-
-    List.stable_sort (fun (p, _) (p', _) -> s.compare p p') (s.ready @ r);
-  Mutex.unlock s.ready_m
-
-(** Code for a queue to process ready tasks. * Returns true a task was found
-    (and hence processed). * * s.ready_m *must* be locked before calling * this
-    function, and is freed *only* * if some task was processed. *)
-let exec s (priorities : 'a -> bool) =
-  (* This assertion does not work on
-   * win32 because a thread can double-lock
-   * the same mutex.. *)
-  if Sys.os_type <> "Win32" then assert (not (Mutex.try_lock s.ready_m));
-  match remove (fun (p, _) -> priorities p) s.ready with
-    | (_, task), remaining ->
-        s.ready <- remaining;
-        Mutex.unlock s.ready_m;
-        let tasks =
-          match task () with
-            | exception exn ->
-                let bt = Printexc.get_raw_backtrace () in
-                s.on_error exn bt;
-                []
-            | v -> v
+  (* A worker alternates between the two classes. Taking every ready immediate
+     task on every round starves blocking work whenever the ready list refills
+     as fast as it drains, which a lone worker cannot escape by leaving the
+     rest to someone else. *)
+    match immediate with
+    | _ :: _ when not (w.took_batch && can_block) ->
+        s.ready <- blocking;
+        w.took_batch <- true;
+        ( Some (Batch (List.rev_map snd immediate)),
+          take_idle s (List.length blocking) )
+    | _ when can_block ->
+        let best =
+          List.fold_left
+            (fun best x -> if s.compare (fst x) (fst best) < 0 then x else best)
+            (List.hd blocking) blocking
         in
-        add_t s tasks;
-        true
-    | exception Not_found -> false
+        s.ready <- List.filter (fun x -> x != best) s.ready;
+        w.took_batch <- false;
+        (Some (One (snd best)), take_idle s (List.length s.ready))
+    | _ -> (None, [])
+
+let run_task s fn =
+  match s.wrapper.wrap fn with
+    | exception exn ->
+        let bt = Printexc.get_raw_backtrace () in
+        s.on_error exn bt;
+        []
+    | v -> v
+
+(** Blocking tasks run on an auxiliary systhread inside the worker's domain:
+    once the task parks in a syscall it releases the runtime lock and the domain
+    goes back to dispatching. One thread per task rather than a pool, since a
+    task in this class is long enough that the spawn does not show. *)
+let run_blocking s w fn =
+  Atomic.incr w.blocking;
+  ignore
+    (Thread.create
+       (fun () ->
+         let tasks = run_task s fn in
+         Atomic.decr w.blocking;
+         add_t s tasks;
+         wake_worker s w)
+       ())
+
+let wait_for_work s w =
+  Mutex.lock w.worker_m;
+  while (not w.wake) && not (Atomic.get s.stopped) do
+    Condition.wait w.worker_c w.worker_m
+  done;
+  w.wake <- false;
+  Mutex.unlock w.worker_m
 
-exception Queue_stopped
-exception Queue_processed
+(** How long [stop] waits for a parked task before giving up on it. *)
+let drain_timeout = 5.
 
-(** Main loop for queues. *)
-let queue ?log ?(priorities = fun _ -> true) s name =
-  let log =
-    match log with Some e -> e | None -> Printf.printf "queue %s: %s\n" name
-  in
-  let c =
-    let c = Condition.create () in
-    Mutex.lock s.queues_m;
-    s.queues <- c :: s.queues;
-    Mutex.unlock s.queues_m;
-    log (Printf.sprintf "Queue #%d starting..." (List.length s.queues));
-    c
-  in
-  (* Try to process ready tasks, otherwise try to become the master,
-   * or be a slave and wait for the master to get some more ready tasks. *)
-  let run () =
-    Mutex.lock s.stop_m;
-    let stop = s.stop in
-    Mutex.unlock s.stop_m;
-    if stop then raise Queue_stopped;
-    (* Lock the ready tasks until the queue has a task to proceed,
-     * *or* is really ready to restart on its condition, see the
-     * Condition.wait call below for the atomic unlock and wait. *)
+(** Longest the loop parks in one wait. A wake-up is a byte on a socket the
+    writer drops when its buffer is full, so waiting on one alone risks never
+    looking at [stopped] again. *)
+let idle_timeout = 1.
+
+let dispatch s w =
+  while not (Atomic.get s.stopped) do
     Mutex.lock s.ready_m;
-    log (Printf.sprintf "There are %d ready tasks." (List.length s.ready));
-    if exec s priorities then raise Queue_processed;
-    let wake () =
-      let is_ready =
-        Mutex.lock s.ready_m;
-        let is_ready = s.ready <> [] in
-        Mutex.unlock s.ready_m;
-        is_ready
-      in
-      (* Wake up other queues if there are remaining tasks *)
-      if is_ready then begin
-        Mutex.lock s.queues_m;
-        List.iter (fun x -> if x <> c then Condition.signal x) s.queues;
-        Mutex.unlock s.queues_m
-      end
-    in
-    if Mutex.try_lock s.select_m then begin
-      (* Processing finished for me
-       * I can unlock ready_m now.. *)
-      Mutex.unlock s.ready_m;
-      process s log;
-      Mutex.unlock s.select_m;
-      wake ()
-    end
-    else begin
-      (* We use s.ready_m mutex here.
-       * Hence, we avoid race conditions
-       * with any other queue being processing
-       * a task that would create a new task:
-       * without this mutex, the new task may not be
-       * notified to this queue if it is going to sleep
-       * in concurrency..
-       * It also avoid race conditions when restarting
-       * queues since s.ready_m is locked until all
-       * queues have been signaled. *)
-      Condition.wait c s.ready_m;
-      Mutex.unlock s.ready_m
+    let work, wake = take_work s w in
+    (match work with None -> s.idle <- w :: s.idle | Some _ -> ());
+    Mutex.unlock s.ready_m;
+    List.iter signal_worker wake;
+    begin match work with
+      | Some (Batch fns) -> List.iter (fun fn -> add_t s (run_task s fn)) fns
+      | Some (One fn) -> run_blocking s w fn
+      | None -> wait_for_work s w
     end
+  done
+
+(** Wait for events, then move the tasks they woke to the ready list. *)
+let poll_once s =
+  let timeout =
+    Mutex.protect s.tasks_m (fun () ->
+        match Timers.min_binding_opt s.timers with
+          | None -> idle_timeout
+          | Some ((deadline, _), _) ->
+              min idle_timeout (max 0. (deadline -. time ())))
   in
-  let rec f () =
-    begin try run () with Queue_processed -> ()
-    end;
-    (f [@tailcall]) ()
+  log s (fun () ->
+      Printf.sprintf "Waiting on %s at %f, timeout %f."
+        (Pollset.backend s.pollset)
+        (time ()) timeout);
+  let fired =
+    try Pollset.wait s.pollset ~timeout
+    with exn ->
+      (* We do not know which descriptor caused the error, so every task
+         currently in the loop is discarded. *)
+      clear_tasks s;
+      raise exn
   in
-  let on_done () =
-    Mutex.lock s.queues_m;
-    s.queues <- List.filter (fun q -> q <> c) s.queues;
-    Condition.signal s.queue_stopped_c;
-    Mutex.unlock s.queues_m
+  log s (fun () ->
+      Printf.sprintf "Woke at %f (%d)." (time ()) (List.length fired));
+  (* Absorb more than one write: excessive wake-ups would otherwise fill the
+     socket's buffer and make [wake_up] block. *)
+  if List.mem_assoc s.out_pipe fired then
+    ignore (Unix_utils.read s.out_pipe tmp 0 1024);
+  let collected =
+    Mutex.protect s.tasks_m (fun () ->
+        let collected = ref [] in
+        let take t =
+          if not t.dispatched then (
+            match fired_events t fired with
+              | [] -> ()
+              | events ->
+                  t.dispatched <- true;
+                  collected := (t, events) :: !collected)
+        in
+        List.iter
+          (fun (fd, _) ->
+            match Hashtbl.find_opt s.by_fd fd with
+              | None -> ()
+              | Some tasks -> List.iter take tasks)
+          fired;
+        let now = time () in
+        let rec expired () =
+          match Timers.min_binding_opt s.timers with
+            | Some ((deadline, _), t) when deadline <= now ->
+                s.timers <- Timers.remove (deadline, t.id) s.timers;
+                take t;
+                expired ()
+            | _ -> ()
+        in
+        expired ();
+        List.iter (fun (t, _) -> unregister s t) !collected;
+        !collected)
   in
-  (try f () with
-    | Queue_stopped -> ()
-    | exn ->
-        let bt = Printexc.get_raw_backtrace () in
-        (try on_done () with _ -> ());
-        Printexc.raise_with_backtrace exn bt);
-  on_done ()
+  match collected with
+    | [] -> ()
+    | _ ->
+        let wake =
+          Mutex.protect s.ready_m (fun () ->
+              List.iter
+                (fun (t, events) ->
+                  s.ready <- (t.prio, fun () -> t.fire events) :: s.ready)
+                collected;
+              take_idle s (List.length collected))
+        in
+        List.iter signal_worker wake
+
+let poller s =
+  Fun.protect
+    ~finally:(fun () -> Atomic.set s.poller_done true)
+    (fun () ->
+      while not (Atomic.get s.stopped) do
+        poll_once s
+      done)
+
+let start ?domains ?(max_blocking = 64) ?log:logger s =
+  if not (Atomic.compare_and_set s.started false true) then
+    failwith "Duppy.start: scheduler already started";
+  s.log <- logger;
+  let count =
+    match domains with
+      | Some n -> max 1 n
+      | None -> max 1 (Domain.recommended_domain_count ())
+  in
+  s.blocking_per_worker <- max 1 (max_blocking / count);
+  let workers =
+    List.init count (fun _ ->
+        {
+          worker_m = Mutex.create ();
+          worker_c = Condition.create ();
+          wake = false;
+          took_batch = false;
+          blocking = Atomic.make 0;
+        })
+  in
+  s.workers <- workers;
+  let spawn fn =
+    Domain.spawn (fun () ->
+        try fn ()
+        with exn ->
+          let bt = Printexc.get_raw_backtrace () in
+          s.on_fatal exn bt)
+  in
+  s.domains <-
+    spawn (fun () -> poller s)
+    :: List.map (fun w -> spawn (fun () -> dispatch s w)) workers;
+  log s (fun () ->
+      Printf.sprintf "Started %d dispatch domains, %d blocking tasks each."
+        count s.blocking_per_worker)
+
+let stop s =
+  if Atomic.get s.started then begin
+    clear_tasks s;
+    Atomic.set s.stopped true;
+    wake_up s;
+    List.iter signal_worker s.workers;
+    (* Let the tasks still parked on the workers finish, bounded because a
+       blocking task is under no obligation to return. *)
+    let deadline = time () +. drain_timeout in
+    while
+      ((not (Atomic.get s.poller_done))
+      || List.exists (fun w -> 0 < Atomic.get w.blocking) s.workers)
+      && time () < deadline
+    do
+      Thread.delay 0.01
+    done;
+    (* A domain terminates once every thread created inside it has finished, and
+       a task is free to start one that outlives it: a binding logging from its
+       own thread pins the domain that ran it for good. Reaping is handed to a
+       thread of our own so that waiting for one cannot hold up stopping. *)
+    List.iter
+      (fun d -> ignore (Thread.create (fun () -> Domain.join d) ()))
+      s.domains;
+    s.domains <- [];
+    s.workers <- [];
+    (* Freeing what the loop waits on while it is still in there is a use after
+       free, and a descriptor is the cheaper thing to lose. *)
+    if Atomic.get s.poller_done then Pollset.close s.pollset
+  end
 
 module Async = struct
   (* m is used to make sure that
    * calls to [wake_up] and [stop]
    * are thread-safe. *)
-  type t = { stop : bool ref; mutable fd : fd option; m : Mutex.t }
+  type t = { stop : bool Atomic.t; mutable fd : fd option; m : Mutex.t }
 
   exception Stopped
 
@@ -364,13 +610,13 @@ module Async = struct
        pipe. *)
     let out_pipe, in_pipe = Unix_utils.socketpair () in
     Unix.set_nonblock in_pipe;
-    let stop = ref false in
+    let stop = Atomic.make false in
     let tmp = Bytes.create 1024 in
     let rec task l =
       if List.exists (( = ) (`Read out_pipe)) l then
         (* Consume data from the pipe *)
         ignore (Unix_utils.read out_pipe tmp 0 1024);
-      if !stop then begin
+      if Atomic.get stop then begin
         begin try
           (* This interface is purely asynchronous
            * so we close both sides of the pipe here. *)
@@ -413,7 +659,7 @@ module Async = struct
     try
       begin match t.fd with
         | Some c ->
-            t.stop := true;
+            Atomic.set t.stop true;
             ignore (Unix_utils.write c (Bytes.of_string " ") 0 1)
         | None -> raise Stopped
       end;
@@ -427,65 +673,55 @@ end
 module type Transport_t = sig
   type t
 
-  type bigarray =
-    (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
-
   val sock : t -> Unix.file_descr
   val read : t -> Bytes.t -> int -> int -> int
   val write : t -> Bytes.t -> int -> int -> int
-  val ba_write : t -> bigarray -> int -> int -> int
 end
 
 module Unix_transport : Transport_t with type t = Unix.file_descr = struct
   type t = Unix.file_descr
 
-  type bigarray =
-    (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
-
   let sock s = s
   let read = Unix_utils.read
   let write = Unix_utils.write
-
-  external ba_write : t -> bigarray -> int -> int -> int
-    = "ocaml_duppy_write_ba"
 end
 
 module type Io_t = sig
   type socket
   type marker = Length of int | Split of string
 
-  type bigarray =
-    (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
-
   type failure =
     | Io_error
     | Unix of (Unix.error * string * string * Printexc.raw_backtrace)
     | Unknown of exn * Printexc.raw_backtrace
     | Timeout
 
-  val read :
-    ?recursive:bool ->
-    ?init:string ->
-    ?on_error:(string * failure -> unit) ->
-    ?timeout:float ->
-    priority:'a ->
-    'a scheduler ->
-    socket ->
-    marker ->
-    (string * string option -> unit) ->
-    unit
+  (** Raised by [read] and [write]. On a read, whatever had been read before the
+      failure is left in the handle's [data]. *)
+  exception Error of failure
+
+  (** [data] holds what a read consumed past its marker, which the next read on
+      the same socket picks up. *)
+  type 'a handle = {
+    scheduler : 'a scheduler;
+    socket : socket;
+    mutable data : string;
+  }
+
+  val handle : 'a scheduler -> socket -> 'a handle
+
+  (** [read ?timeout ~priority h marker] returns the data up to [marker],
+      parking the computation until enough has arrived. [timeout] applies to
+      each wait rather than to the call. *)
+  val read : ?timeout:float -> priority:'a -> 'a handle -> marker -> string
 
   val write :
-    ?exec:(unit -> unit) ->
-    ?on_error:(failure -> unit) ->
-    ?bigarray:bigarray ->
+    ?timeout:float ->
     ?offset:int ->
     ?length:int ->
-    ?string:Bytes.t ->
-    ?timeout:float ->
     priority:'a ->
-    'a scheduler ->
-    socket ->
+    'a handle ->
+    Bytes.t ->
     unit
 end
 
@@ -500,583 +736,122 @@ struct
     | Unknown of exn * Printexc.raw_backtrace
     | Timeout
 
-  exception Io
-  exception Timeout_exc
+  exception Error of failure
 
-  type bigarray =
-    (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+  type 'a handle = {
+    scheduler : 'a scheduler;
+    socket : socket;
+    mutable data : string;
+  }
 
-  let read ?(recursive = false) ?(init = "") ?(on_error = fun _ -> ()) ?timeout
-      ~priority (scheduler : 'a scheduler) socket marker exec =
+  let handle scheduler socket = { scheduler; socket; data = "" }
+
+  (** Split a buffer at [marker], returning what precedes it and what follows,
+      or [None] while the marker has not arrived. The marker is resolved once so
+      that a [Split] pattern is compiled per read rather than per chunk. *)
+  let matcher = function
+    | Split r ->
+        let rex = Pcre.regexp r in
+        let rec find = function
+          | Pcre.Text s :: Pcre.Delim _ :: rest ->
+              let rem = Buffer.create 10 in
+              List.iter
+                (function
+                  | Pcre.Text s | Pcre.Delim s -> Buffer.add_string rem s
+                  | _ -> ())
+                rest;
+              Some (s, Buffer.contents rem)
+          | _ :: rest -> find rest
+          | [] -> None
+        in
+        fun buffer ->
+          find (Pcre.full_split ~max:2 ~rex (Buffer.contents buffer))
+    | Length n ->
+        fun buffer ->
+          if n <= Buffer.length buffer then
+            Some
+              ( Buffer.sub buffer 0 n,
+                Buffer.sub buffer n (Buffer.length buffer - n) )
+          else None
+
+  let wait_events ~timeout socket =
+    match timeout with
+      | None -> ([`Read socket], fun _ -> false)
+      | Some t -> ([`Read socket; `Delay t], List.mem (`Delay t))
+
+  let read ?timeout ~priority h marker =
     let length = 1024 in
-    let b = Buffer.create length in
+    let buffer = Buffer.create length in
     let buf = Bytes.make length ' ' in
-    Buffer.add_string b init;
-    let unix_socket = Transport.sock socket in
-    let events, check_timeout =
-      match timeout with
-        | None -> ([`Read unix_socket], fun _ -> false)
-        | Some f -> ([`Read unix_socket; `Delay f], List.mem (`Delay f))
+    Buffer.add_string buffer h.data;
+    h.data <- "";
+    let socket = Transport.sock h.socket in
+    let events, timed_out = wait_events ~timeout socket in
+    let take = matcher marker in
+    let fail failure =
+      h.data <- Buffer.contents buffer;
+      raise (Error failure)
     in
-    let rec f l =
-      if check_timeout l then raise Timeout_exc;
-      if List.mem (`Read unix_socket) l then begin
-        let input = Transport.read socket buf 0 length in
-        if input <= 0 then raise Io;
-        Buffer.add_subbytes b buf 0 input
-      end;
-      let ret =
-        match marker with
-          | Split r ->
-              let rex = Pcre.regexp r in
-              let acc = Buffer.contents b in
-              let ret = Pcre.full_split ~max:2 ~rex acc in
-              let rec p l =
-                match l with
-                  | Pcre.Text x :: Pcre.Delim _ :: l ->
-                      let f b x =
-                        match x with
-                          | Pcre.Text s | Pcre.Delim s -> Buffer.add_string b s
-                          | _ -> ()
-                      in
-                      if recursive then begin
-                        Buffer.reset b;
-                        List.iter (f b) l;
-                        Some (x, None)
-                      end
-                      else begin
-                        let b = Buffer.create 10 in
-                        List.iter (f b) l;
-                        Some (x, Some (Buffer.contents b))
-                      end
-                  | _ :: l' -> p l'
-                  | [] -> None
-              in
-              p ret
-          | Length n when n <= Buffer.length b ->
-              let s = Buffer.sub b 0 n in
-              let rem = Buffer.sub b n (Buffer.length b - n) in
-              if recursive then begin
-                Buffer.reset b;
-                Buffer.add_string b rem;
-                Some (s, None)
-              end
-              else Some (s, Some rem)
-          | _ -> None
-      in
-      (* Catch all exceptions.. *)
-      let f x =
-        try f x with
-          | Io ->
-              on_error (Buffer.contents b, Io_error);
-              []
-          | Timeout_exc ->
-              on_error (Buffer.contents b, Timeout);
-              []
-          | Unix.Unix_error (x, y, z) ->
-              let bt = Printexc.get_raw_backtrace () in
-              on_error (Buffer.contents b, Unix (x, y, z, bt));
-              []
-          | e ->
-              let bt = Printexc.get_raw_backtrace () in
-              on_error (Buffer.contents b, Unknown (e, bt));
-              []
-      in
-      match ret with
-        | Some x -> (
-            match x with
-              | s, Some _ when recursive ->
-                  exec (s, None);
-                  [{ priority; events; handler = f }]
-              | _ ->
-                  exec x;
-                  [])
-        | None -> [{ priority; events; handler = f }]
-    in
-    (* Catch all exceptions.. *)
-    let f x =
-      try f x with
-        | Io ->
-            on_error (Buffer.contents b, Io_error);
-            []
-        | Timeout_exc ->
-            on_error (Buffer.contents b, Timeout);
-            []
-        | Unix.Unix_error (x, y, z) ->
-            let bt = Printexc.get_raw_backtrace () in
-            on_error (Buffer.contents b, Unix (x, y, z, bt));
-            []
-        | e ->
-            let bt = Printexc.get_raw_backtrace () in
-            on_error (Buffer.contents b, Unknown (e, bt));
-            []
-    in
-    (* First one is without read,
-     * in case init contains the wanted match.
-     * Unless the user sets timeout to 0., this
-     * should not interfere with user-defined timeout.. *)
-    let task =
-      { priority; events = [`Delay 0.; `Read unix_socket]; handler = f }
-    in
-    add scheduler task
-
-  let write ?(exec = fun () -> ()) ?(on_error = fun _ -> ()) ?bigarray
-      ?(offset = 0) ?length ?string ?timeout ~priority
-      (scheduler : 'a scheduler) socket =
-    let length, write =
-      match (string, bigarray) with
-        | Some s, _ ->
-            let length =
-              match length with Some length -> length | None -> Bytes.length s
-            in
-            (length, Transport.write socket s)
-        | None, Some b ->
-            let length =
-              match length with
-                | Some length -> length
-                | None -> Bigarray.Array1.dim b
+    let rec loop () =
+      match take buffer with
+        | Some (s, rem) ->
+            h.data <- rem;
+            s
+        | None ->
+            let fired = await ~priority h.scheduler events in
+            if timed_out fired then fail Timeout;
+            let n =
+              try Transport.read h.socket buf 0 length with
+                | Unix.Unix_error (x, y, z) ->
+                    fail (Unix (x, y, z, Printexc.get_raw_backtrace ()))
+                | e -> fail (Unknown (e, Printexc.get_raw_backtrace ()))
             in
-            (length, Transport.ba_write socket b)
-        | _ -> (0, fun _ _ -> 0)
+            if n <= 0 then fail Io_error;
+            Buffer.add_subbytes buffer buf 0 n;
+            loop ()
     in
-    let unix_socket = Transport.sock (socket : Transport.t) in
-    let exec () =
-      if Sys.os_type = "Win32" then Unix.clear_nonblock unix_socket;
-      exec ()
-    in
-    let events, check_timeout =
+    loop ()
+
+  let write ?timeout ?(offset = 0) ?length ~priority h data =
+    let len = match length with Some len -> len | None -> Bytes.length data in
+    let socket = Transport.sock h.socket in
+    let events, timed_out =
       match timeout with
-        | None -> ([`Write unix_socket], fun _ -> false)
-        | Some f -> ([`Write unix_socket; `Delay f], List.mem (`Delay f))
+        | None -> ([`Write socket], fun _ -> false)
+        | Some t -> ([`Write socket; `Delay t], List.mem (`Delay t))
     in
-    let rec f pos l =
-      try
-        if check_timeout l then raise Timeout_exc;
-        assert (List.exists (( = ) (`Write unix_socket)) l);
-        let len = length - pos in
-        let n = write pos len in
-        if n <= 0 then (
-          on_error Io_error;
-          [])
-        else if n < len then
-          [{ priority; events = [`Write unix_socket]; handler = f (pos + n) }]
-        else (
-          exec ();
-          [])
-      with
-        | Unix.Unix_error (Unix.EWOULDBLOCK, _, _) when Sys.os_type = "Win32" ->
-            [{ priority; events = [`Write unix_socket]; handler = f pos }]
-        | Timeout_exc ->
-            on_error Timeout;
-            []
-        | Unix.Unix_error (x, y, z) ->
-            let bt = Printexc.get_raw_backtrace () in
-            on_error (Unix (x, y, z, bt));
-            []
-        | e ->
-            let bt = Printexc.get_raw_backtrace () in
-            on_error (Unknown (e, bt));
-            []
+    (* Win32 blocks on a blocking socket rather than accepting a partial write,
+       and does not report writability while the socket still has room: there
+       the socket goes non-blocking and we write as much as it takes. *)
+    let win32 = Sys.os_type = "Win32" in
+    let restore () = if win32 then Unix.clear_nonblock socket in
+    let fail failure =
+      restore ();
+      raise (Error failure)
     in
-    let task = { priority; events; handler = f offset } in
-    if length > 0 then
-      (* Win32 is particularly bad with writing on sockets. It is nearly impossible
-       * to write proper non-blocking code. send will block on blocking sockets if
-       * there isn't enough data available instead of returning a partial buffer
-       * and WSAEventSelect will not return if the socket still has available space.
-       * Thus, setting the socket to non-blocking and writing as much as we can. *)
-      if Sys.os_type = "Win32" then begin
-        Unix.set_nonblock unix_socket;
-        List.iter (add scheduler) (f offset [`Write unix_socket])
+    let wait () =
+      let fired = await ~priority h.scheduler events in
+      if timed_out fired then fail Timeout
+    in
+    if win32 then Unix.set_nonblock socket;
+    let rec loop pos =
+      if pos < len then begin
+        if not win32 then wait ();
+        let n =
+          try Transport.write h.socket data pos (len - pos) with
+            | Unix.Unix_error (Unix.EWOULDBLOCK, _, _) when win32 ->
+                wait ();
+                -1
+            | Unix.Unix_error (x, y, z) ->
+                fail (Unix (x, y, z, Printexc.get_raw_backtrace ()))
+            | e -> fail (Unknown (e, Printexc.get_raw_backtrace ()))
+        in
+        if n = 0 then fail Io_error;
+        loop (pos + max 0 n)
       end
-      else add scheduler task
-    else exec ()
+    in
+    loop offset;
+    restore ()
 end
 
 module Io : Io_t with type socket = Unix.file_descr = MakeIo (Unix_transport)
-
-(** A monad for implicit continuations or responses *)
-module Monad = struct
-  type ('a, 'b) handler = { return : 'a -> unit; raise : 'b -> unit }
-  type ('a, 'b) t = ('a, 'b) handler -> unit
-
-  let return x h = h.return x
-  let raise x h = h.raise x
-
-  let bind f g h =
-    let ret x =
-      let process = g x in
-      process h
-    in
-    f { return = ret; raise = h.raise }
-
-  let ( >>= ) = bind
-  let run ~return:ret ~raise f = f { return = ret; raise }
-
-  let catch f g h =
-    let raise x =
-      let process = g x in
-      process h
-    in
-    f { return = h.return; raise }
-
-  let ( =<< ) x y = catch y x
-
-  let rec fold_left f a = function
-    | [] -> a
-    | b :: l -> fold_left f (bind a (fun a -> f a b)) l
-
-  let fold_left f a l = fold_left f (return a) l
-  let iter f l = fold_left (fun () b -> f b) () l
-
-  module Mutex_o = Mutex
-
-  module Mutex = struct
-    module type Mutex_control = sig
-      type priority
-
-      val scheduler : priority scheduler
-      val priority : priority
-    end
-
-    module type Mutex_t = sig
-      (** Type for a mutex. *)
-      type mutex
-
-      module Control : Mutex_control
-
-      (** [create ()] creates a mutex. Implementation-wise, * a duppy task is
-          created that will be used to select a * waiting computation, lock the
-          mutex on it and resume it. * Thus, [priority] and [s] represents,
-          resp., the priority * and scheduler used when running calling process'
-          computation. *)
-      val create : unit -> mutex
-
-      (** A computation that locks a mutex * and returns [unit] afterwards.
-          Computation * will be blocked until the mutex is successfully locked.
-      *)
-      val lock : mutex -> (unit, 'a) t
-
-      (** A computation that tries to lock a mutex. * Returns immediately [true]
-          if the mutex was successfully locked * or [false] otherwise. *)
-      val try_lock : mutex -> (bool, 'a) t
-
-      (** A computation that unlocks a mutex. * Should return immediately. *)
-      val unlock : mutex -> (unit, 'a) t
-    end
-
-    module Factory (Control : Mutex_control) = struct
-      (* A mutex is either locked or not
-       * and has a list of tasks waiting to get
-       * it. *)
-      type mutex = {
-        mutable locked : bool;
-        mutable tasks : (unit -> unit) list;
-      }
-
-      module Control = Control
-
-      let tmp = Bytes.create 1024
-
-      (* A socket pair rather than a pipe: on Windows, a single non-socket fd
-         in the scheduler forces [Unix.select] into its worker-thread emulation
-         for every call, which leaks native memory. See [create] above. *)
-      let x, y = Unix_utils.socketpair ()
-      let stop = ref false
-      let wake_up () = ignore (Unix_utils.write y (Bytes.of_string " ") 0 1)
-      let ctl_m = Mutex_o.create ()
-
-      let finalise _ =
-        stop := true;
-        wake_up ()
-
-      let mutexes = Queue.create ()
-      let () = Gc.finalise finalise mutexes
-
-      let register () =
-        let m = { locked = false; tasks = [] } in
-        Queue.push m mutexes;
-        m
-
-      let cleanup m =
-        Mutex_o.lock ctl_m;
-        let q = Queue.create () in
-        Queue.iter (fun m' -> if m <> m' then Queue.push m q) mutexes;
-        Queue.clear mutexes;
-        Queue.transfer q mutexes;
-        Mutex_o.unlock ctl_m
-
-      let task f =
-        {
-          Task.priority = Control.priority;
-          events = [`Delay 0.];
-          handler =
-            (fun _ ->
-              f ();
-              []);
-        }
-
-      (* This should only be called when [ctl_m] is locked. *)
-      let process_mutex tasks m =
-        if not m.locked then (
-          (* I don't think shuffling tasks
-           * matters here.. *)
-            match m.tasks with
-            | x :: l ->
-                m.tasks <- l;
-                m.locked <- true;
-                task x :: tasks
-            | _ -> tasks)
-        else tasks
-
-      let rec handler _ =
-        Mutex_o.lock ctl_m;
-        if not !stop then begin
-          let tasks = Queue.fold process_mutex [] mutexes in
-          Mutex_o.unlock ctl_m;
-          ignore (Unix_utils.read x tmp 0 1024);
-          { Task.priority = Control.priority; events = [`Read x]; handler }
-          :: tasks
-        end
-        else begin
-          Mutex_o.unlock ctl_m;
-          try
-            Unix.close x;
-            Unix.close y;
-            []
-          with _ -> []
-        end
-
-      let () =
-        Task.add Control.scheduler
-          { Task.priority = Control.priority; events = [`Read x]; handler }
-
-      let create () =
-        Mutex_o.lock ctl_m;
-        let ret = register () in
-        Mutex_o.unlock ctl_m;
-        Gc.finalise cleanup ret;
-        ret
-
-      let lock m h' =
-        Mutex_o.lock ctl_m;
-        if not m.locked then begin
-          m.locked <- true;
-          Mutex_o.unlock ctl_m;
-          h'.return ()
-        end
-        else begin
-          m.tasks <- h'.return :: m.tasks;
-          Mutex_o.unlock ctl_m
-        end
-
-      let try_lock m h' =
-        Mutex_o.lock ctl_m;
-        if not m.locked then begin
-          m.locked <- true;
-          Mutex_o.unlock ctl_m;
-          h'.return true
-        end
-        else begin
-          Mutex_o.unlock ctl_m;
-          h'.return false
-        end
-
-      let unlock m h' =
-        Mutex_o.lock ctl_m;
-        (* Here we allow inter-thread
-         * and double unlock.. Double unlock
-         * is not necessarily a problem and
-         * inter-thread unlock well.. what is
-         * a thread here ?? :-) *)
-        m.locked <- false;
-        let wake = m.tasks <> [] in
-        Mutex_o.unlock ctl_m;
-        if wake then wake_up ();
-        h'.return ()
-    end
-  end
-
-  module Condition = struct
-    module Factory (Mutex : Mutex.Mutex_t) = struct
-      type condition = {
-        condition_m : Mutex_o.t;
-        waiting : (unit -> unit) Queue.t;
-      }
-
-      module Control = Mutex.Control
-
-      let create () =
-        { condition_m = Mutex_o.create (); waiting = Queue.create () }
-
-      (* Mutex.unlock m needs to happen _after_
-       * the task has been registered. *)
-      let wait c m h =
-        let proc () = Mutex.lock m h in
-        Mutex_o.lock c.condition_m;
-        Queue.push proc c.waiting;
-        Mutex_o.unlock c.condition_m;
-        (* Mutex.unlock does not raise exceptions (for now..) *)
-        let h' = { return = (fun () -> ()); raise = (fun _ -> assert false) } in
-        Mutex.unlock m h'
-
-      let wake_up h =
-        let handler _ =
-          h ();
-          []
-        in
-        Task.add Control.scheduler
-          { Task.priority = Control.priority; events = [`Delay 0.]; handler }
-
-      let signal c h =
-        Mutex_o.lock c.condition_m;
-        let h' = Queue.pop c.waiting in
-        Mutex_o.unlock c.condition_m;
-        wake_up h';
-        h.return ()
-
-      let broadcast c h =
-        let q = Queue.create () in
-        Mutex_o.lock c.condition_m;
-        Queue.transfer c.waiting q;
-        Mutex_o.unlock c.condition_m;
-        Queue.iter wake_up q;
-        h.return ()
-    end
-  end
-
-  module type Monad_io_t = sig
-    type socket
-
-    module Io : Io_t with type socket = socket
-
-    type ('a, 'b) handler = {
-      scheduler : 'a scheduler;
-      socket : Io.socket;
-      mutable data : string;
-      on_error : Io.failure -> 'b;
-    }
-
-    val exec :
-      ?delay:float ->
-      priority:'a ->
-      ('a, 'b) handler ->
-      ('c, 'b) t ->
-      ('c, 'b) t
-
-    val delay : priority:'a -> ('a, 'b) handler -> float -> (unit, 'b) t
-
-    val read :
-      ?timeout:float ->
-      priority:'a ->
-      marker:Io.marker ->
-      ('a, 'b) handler ->
-      (string, 'b) t
-
-    val read_all :
-      ?timeout:float ->
-      priority:'a ->
-      'a scheduler ->
-      Io.socket ->
-      (string, string * Io.failure) t
-
-    val write :
-      ?timeout:float ->
-      priority:'a ->
-      ('a, 'b) handler ->
-      ?offset:int ->
-      ?length:int ->
-      Bytes.t ->
-      (unit, 'b) t
-
-    val write_bigarray :
-      ?timeout:float ->
-      priority:'a ->
-      ('a, 'b) handler ->
-      Io.bigarray ->
-      (unit, 'b) t
-  end
-
-  module MakeIo (Io : Io_t) = struct
-    type socket = Io.socket
-
-    module Io = Io
-
-    type ('a, 'b) handler = {
-      scheduler : 'a scheduler;
-      socket : Io.socket;
-      mutable data : string;
-      on_error : Io.failure -> 'b;
-    }
-
-    let exec ?(delay = 0.) ~priority h f h' =
-      let handler _ =
-        begin try f h'
-        with e ->
-          let bt = Printexc.get_raw_backtrace () in
-          h'.raise (h.on_error (Io.Unknown (e, bt)))
-        end;
-        []
-      in
-      Task.add h.scheduler { Task.priority; events = [`Delay delay]; handler }
-
-    let delay ~priority h delay = exec ~delay ~priority h (return ())
-
-    let read ?timeout ~priority ~marker h h' =
-      let process x =
-        let s =
-          match x with
-            | s, None ->
-                h.data <- "";
-                s
-            | s, Some s' ->
-                h.data <- s';
-                s
-        in
-        h'.return s
-      in
-      let init = h.data in
-      h.data <- "";
-      let on_error (s, x) =
-        h.data <- s;
-        h'.raise (h.on_error x)
-      in
-      Io.read ?timeout ~priority ~init ~recursive:false ~on_error h.scheduler
-        h.socket marker process
-
-    let read_all ?timeout ~priority s sock =
-      let handler =
-        { scheduler = s; socket = sock; data = ""; on_error = (fun e -> e) }
-      in
-      let buf = Buffer.create 1024 in
-      let rec f () =
-        let data = read ?timeout ~priority ~marker:(Io.Length 1024) handler in
-        let process data =
-          Buffer.add_string buf data;
-          f ()
-        in
-        data >>= process
-      in
-      let catch_ret e =
-        Buffer.add_string buf handler.data;
-        match e with
-          | Io.Io_error -> return (Buffer.contents buf)
-          | e -> raise (Buffer.contents buf, e)
-      in
-      catch (f ()) catch_ret
-
-    let write ?timeout ~priority h ?offset ?length s h' =
-      let on_error x = h'.raise (h.on_error x) in
-      let exec () = h'.return () in
-      Io.write ?timeout ~priority ~on_error ~exec ?offset ?length ~string:s
-        h.scheduler h.socket
-
-    let write_bigarray ?timeout ~priority h ba h' =
-      let on_error x = h'.raise (h.on_error x) in
-      let exec () = h'.return () in
-      Io.write ?timeout ~priority ~on_error ~exec ~bigarray:ba h.scheduler
-        h.socket
-  end
-
-  module Io = MakeIo (Io)
-end
diff --git a/src/modules/duppy/duppy.mli b/src/modules/duppy/duppy.mli
index 04b2289791..729cd81e23 100644
--- a/src/modules/duppy/duppy.mli
+++ b/src/modules/duppy/duppy.mli
@@ -49,44 +49,70 @@
     * Finally, {!Duppy.Monad} and {!Duppy.Monad.Io} provide a monadic interface to
     * program server code that with an implicit return/reply execution flow.
     *
-    * The scheduler can use several queues running concurrently, each queue
-    * processing ready tasks. Of course, a queue should run in its own thread.*)
+    * The scheduler runs a pool of domains, one per core: a task is dispatched
+    * onto whichever domain is free when it becomes ready.*)
 
-(** A scheduler is a device for processing tasks. Several queues might run in *
-    different threads, processing one scheduler's tasks. * * ['a] is the type of
+(** A scheduler is a device for processing tasks. * * ['a] is the type of
     objects used for priorities. *)
 type 'a scheduler
 
-(** Initiate a new scheduler
+(** How a task is run.
+
+    [`Immediate] tasks never block. All the ready ones are taken as a single
+    batch and run in sequence directly on a domain of the pool, which costs less
+    than handing each of them over.
+
+    [`Blocking] tasks may park in a syscall. Each one is run on an auxiliary
+    thread inside its domain, so that parking releases the runtime lock and the
+    domain goes back to dispatching. *)
+type execution_class = [ `Immediate | `Blocking ]
+
+(** Wraps every task body. Effect handlers do not cross the thread a task is
+    dispatched to, so a caller whose tasks need one installs it here rather than
+    at each of its own entry points. *)
+type wrapper = { wrap : 'a. (unit -> 'a) -> 'a }
+
+(** Initiate a new scheduler. It has no domains until [start] is called.
+  * @param on_error called when a task raises.
+  * @param on_fatal called when the event loop itself crashes, which should be
+  * considered a MAJOR FAILURE: all non-ready tasks are dropped. Default: print
+  * the backtrace and exit.
   * @param compare the comparison function used to sort tasks according to priorities.
-  * Works as in [List.sort] *)
+  * Works as in [List.sort]
+  * @param classify how each priority is run. Default: [fun _ -> `Blocking]
+  * @param wrapper wraps every task body. Default: run it as is *)
 val create :
   ?on_error:(exn -> Printexc.raw_backtrace -> unit) ->
+  ?on_fatal:(exn -> Printexc.raw_backtrace -> unit) ->
   ?compare:('a -> 'a -> int) ->
+  ?classify:('a -> execution_class) ->
+  ?wrapper:wrapper ->
   unit ->
   'a scheduler
 
-(** [queue ~log ~priorities s name]
- * starts a queue, on the scheduler [s] only processing priorities [p]
- * for which [priorities p] returns [true].
- *
- * Several queues can be run concurrently against [s].
- * @param log Logging function. Default: [Printf.printf "queue %s: %s\n" name]
- * @param priorities Predicate specifying which priority to process. Default: [fun _ -> _ -> true]
- *
- * An exception is raised from this call when duppy's event loops has
- * crashed. This exception should be considered a MAJOR FAILURE. All current
- * non-ready tasks registered for the calling scheduler are dropped. You may
- * restart Duppy's queues after it is raised but it should only be used to terminate
- * the process diligently!! *)
-val queue :
+(** [start s] spawns the scheduler's domains: one running the event loop, and
+  * [domains] running tasks. Raises [Failure] if [s] is already started.
+  *
+  * Spawning a domain makes [Unix.fork] fail from then on, so this must be
+  * called after any daemonization.
+  * @param domains number of dispatching domains.
+  * Default: [Domain.recommended_domain_count ()]
+  * @param max_blocking the most [`Blocking] tasks that may be in flight at
+  * once, spread evenly over the pool. Each domain keeps at least one slot, so
+  * a value below [domains] gives one per domain. Default: [64]
+  * @param log Logging function. Default: no logging *)
+val start :
+  ?domains:int ->
+  ?max_blocking:int ->
   ?log:(string -> unit) ->
-  ?priorities:('a -> bool) ->
   'a scheduler ->
-  string ->
   unit
 
-(** Stop all queues running on that scheduler and wait for them to return. *)
+(** Whether [start] has been called. *)
+val started : 'a scheduler -> bool
+
+(** Stop the scheduler, let the tasks already running finish, and wait for its
+    domains to return. *)
 val stop : 'a scheduler -> unit
 
 (** Core task registration. * * A task will be a set of events to watch, and a
@@ -114,6 +140,26 @@ module Task : sig
   val add : 'a scheduler -> ('a, [< event ]) task -> unit
 end
 
+(** {2 Direct-style computations}
+
+    [run f] executes [f] so that it can park on {!await} instead of splitting
+    into tasks. It returns as soon as [f] finishes or parks; a parked
+    computation resumes on whichever domain picks up its task, which may not be
+    the one it started on. *)
+val run : (unit -> unit) -> unit
+
+(** [await ~priority s events] parks the calling computation until one of
+    [events] occurs and returns those that did.
+
+    Only a computation running under {!run} can park: calling this from a plain
+    task handler raises [Effect.Unhandled]. *)
+val await :
+  priority:'a -> 'a scheduler -> [< Task.event ] list -> Task.event list
+
+(** [reschedule ?delay ~priority s] parks and resumes the computation under
+    [priority], to leave a priority a computation should no longer hold. *)
+val reschedule : ?delay:float -> priority:'a -> 'a scheduler -> unit
+
 (** Asynchronous task module * * This module implements an asynchronous API to
     {!Duppy.scheduler} * It allows to create a task that will run and then go to
     sleep. *)
@@ -146,335 +192,65 @@ end
 module type Transport_t = sig
   type t
 
-  type bigarray =
-    (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
-
   val sock : t -> Unix.file_descr
   val read : t -> Bytes.t -> int -> int -> int
   val write : t -> Bytes.t -> int -> int -> int
-  val ba_write : t -> bigarray -> int -> int -> int
 end
 
-(** Easy parsing of [Unix.file_descr]. * * With {!Duppy.Io.read}, you can pass a
-    file descriptor to the scheduler, * along with a marker, and have it run the
-    associated function when the * marker is found. * * With {!Duppy.Io.write},
-    the schdeduler will try to write recursively to the file descriptor * the
-    given string. *)
+(** Reading and writing a socket from a computation running under {!run}: both
+    park until the socket is ready rather than returning to the scheduler. *)
 module type Io_t = sig
   type socket
 
-  (** Type for markers. * * [Split s] recognizes all regexp allowed by the *
-      [Pcre] module. *)
+  (** Type for markers. [Split s] recognizes all regexp allowed by the [Pcre]
+      module. *)
   type marker = Length of int | Split of string
 
-  (** Type of [Bigarray] used here. *)
-  type bigarray =
-    (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
-
-  (** Different types of failure. * * [Io_error] is raised when reading or
-      writing * returned 0. This usually means that the socket * was closed. *)
+  (** Different types of failure. [Io_error] is raised when reading or writing
+      returned 0, which usually means the socket was closed. *)
   type failure =
     | Io_error
     | Unix of (Unix.error * string * string * Printexc.raw_backtrace)
     | Unknown of exn * Printexc.raw_backtrace
     | Timeout
 
-  (** Wrapper to perform a read on a socket and trigger a function when
-    * a marker has been detected, or enough data has been read.
-    * It reads recursively on a socket, splitting into strings separated
-    * by the marker (if any) and calls the given function on the list of strings.
-    *
-    * Can be used recursively or not, depending on the way you process strings.
-    * Because of Unix's semantic, it is not possible to stop reading
-    * at first marker, so there can be a remaining string. If not used
-    * recursively, the second optional argument may contain a remaining
-    * string. You should then initiate the next read with this value.
-    *
-    * The [on_error] function is used when reading failed on the socket.
-    * Depending on your usage, it can be a hard failure, or simply a lost client.
-    * The string passed to [on_error] contains data read before error
-    * occurred.
-    * @param recursive recursively read and process, default: [true]
-    * @param init initial string for reading, default: [""]
-    * @param on_error function used when read failed, default: [fun _ -> ()]
-    * @param timeout Terminate with [Timeout] failure if nothing has been read
-    *                after the given amount of time in seconds. More precisely,
-    *                the exception is raised when no character have been read
-    *                and the socket was not close while waiting. Default: wait
-    *                forever. *)
-  val read :
-    ?recursive:bool ->
-    ?init:string ->
-    ?on_error:(string * failure -> unit) ->
-    ?timeout:float ->
-    priority:'a ->
-    'a scheduler ->
-    socket ->
-    marker ->
-    (string * string option -> unit) ->
-    unit
+  (** Raised by [read] and [write]. On a read, whatever had been read before the
+      failure is left in the handle's [data]. *)
+  exception Error of failure
 
-  (** Similar to [read] but less complex.
-    * [write ?exec ?on_error ?string ?bigarray ~priority scheduler socket]
-    * write data from [string], or from [bigarray] if no string is given,
-    * to [socket], and executes [exec] or [on_error] if errors occurred.
-    *
-    * Caveat: on Win32, all file descriptors are expected to be in blocking
-    * mode before being passed to this call due to limitations in the emulation
-    * of the unix/posix API. See code comments for more details.
-    *
-    * @param exec function to execute after writing, default: [fun () -> ()]
-    * @param on_error function to execute when an error occurred, default: [fun _ -> ()]
-    * @param string write data from this string
-    * @param bigarray write data from this bigarray, if no [string] is given
-    * @param timeout Terminate with [Timeout] failure if nothing has been written
-    *                after the given amount of time in seconds. More precisely,
-    *                the exception is raised when no character have been written
-    *                and the socket was not close while waiting. Default: wait
-    *                forever. *)
+  (** [data] holds what a read consumed past its marker, which the next read on
+      the same socket picks up. *)
+  type 'a handle = {
+    scheduler : 'a scheduler;
+    socket : socket;
+    mutable data : string;
+  }
+
+  val handle : 'a scheduler -> socket -> 'a handle
+
+  (** [read ?timeout ~priority h marker] returns the data up to [marker],
+      parking the computation until enough of it has arrived.
+      @param timeout
+        applies to each wait rather than to the call. Default: wait forever. *)
+  val read : ?timeout:float -> priority:'a -> 'a handle -> marker -> string
+
+  (** [write ?timeout ~priority h data] writes all of [data], parking until the
+      socket accepts it.
+      @param timeout
+        applies to each wait rather than to the call. Default: wait forever. *)
   val write :
-    ?exec:(unit -> unit) ->
-    ?on_error:(failure -> unit) ->
-    ?bigarray:bigarray ->
+    ?timeout:float ->
     ?offset:int ->
     ?length:int ->
-    ?string:Bytes.t ->
-    ?timeout:float ->
     priority:'a ->
-    'a scheduler ->
-    socket ->
+    'a handle ->
+    Bytes.t ->
     unit
 end
 
 module MakeIo (Transport : Transport_t) : Io_t with type socket = Transport.t
 module Io : Io_t with type socket = Unix.file_descr
 
-(** Monadic interface to {!Duppy.Io}. * * This module can be used to write code
-    * that runs in various Duppy's tasks and * raise values in a completely
-    transparent way. * * You can see examples of its use * in the [examples/]
-    directory of the * source code and in the files *
-    [src/tools/{harbor.camlp4,server.camlp4}] * in liquidsoap's code. * * When a
-    server communicates * with a client, it performs several * computations and,
-    eventually, terminates. * A computation can either return a new * value or
-    terminate. For instance: * * - Client connects. * - Server tries to
-    authenticate the client. * - If authentication is ok, proceed with the next
-    step. * - Otherwise terminate. * * The purpose of the monad is to embed *
-    computations which can either return * a new value or raise a value that is
-    used * to terminate. *)
-module Monad : sig
-  (** Type representing a computation * which returns a value of type ['a] * or
-      raises a value of type ['b] *)
-  type ('a, 'b) t
-
-  (** [return x] create a computation that * returns value [x]. *)
-  val return : 'a -> ('a, 'b) t
-
-  (** [raise x] create a computation that raises * value [x]. *)
-  val raise : 'b -> ('a, 'b) t
-
-  (** Compose two computations. * [bind f g] is equivalent to: *
-      [let x = f in g x] where [x] * has f's return type. *)
-  val bind : ('a, 'b) t -> ('a -> ('c, 'b) t) -> ('c, 'b) t
-
-  (** [>>=] is an alternative notation * for [bind] *)
-  val ( >>= ) : ('a, 'b) t -> ('a -> ('c, 'b) t) -> ('c, 'b) t
-
-  (** [run f ~return ~raise ()] executes [f] and process * returned values with
-      [return] or raised values * with [raise]. *)
-  val run : return:('a -> unit) -> raise:('b -> unit) -> ('a, 'b) t -> unit
-
-  (** [catch f g] redirects values [x] raised during * [f]'s execution to [g].
-      The name suggests the * usual [try .. with ..] exception catching. *)
-  val catch : ('a, 'b) t -> ('b -> ('a, 'c) t) -> ('a, 'c) t
-
-  (** [=<<] is an alternative notation for catch. *)
-  val ( =<< ) : ('b -> ('a, 'c) t) -> ('a, 'b) t -> ('a, 'c) t
-
-  (** [fold_left f a [b1; b2; ..]] returns computation *
-      [ (f a b1) >>= (fun a -> f a b2) >>= ...] *)
-  val fold_left : ('a -> 'b -> ('a, 'c) t) -> 'a -> 'b list -> ('a, 'c) t
-
-  (** [iter f [x1; x2; ..]] returns computation *
-      [f x1 >>= (fun () -> f x2) >>= ...] *)
-  val iter : ('a -> (unit, 'b) t) -> 'a list -> (unit, 'b) t
-
-  (** This module implements monadic * mutex computations. They can be used * to
-      write blocking code that is compatible * with duppy's tasks, i.e.
-      [Mutex.lock m] blocks * the calling computation and not the calling
-      thread. *)
-  module Mutex : sig
-    (** Information used to initialize a Mutex module. * [priority] and
-        [scheduler] are used to initialize a task * which treat mutexes as well
-        as conditions from the below * [Condition] module. *)
-    module type Mutex_control = sig
-      type priority
-
-      val scheduler : priority scheduler
-      val priority : priority
-    end
-
-    module type Mutex_t = sig
-      (** Type for a mutex. *)
-      type mutex
-
-      module Control : Mutex_control
-
-      (** [create ()] creates a mutex. *)
-      val create : unit -> mutex
-
-      (** A computation that locks a mutex * and returns [unit] afterwards.
-          Computation * will be blocked until the mutex is successfully locked.
-      *)
-      val lock : mutex -> (unit, 'a) t
-
-      (** A computation that tries to lock a mutex. * Returns immediately [true]
-          if the mutex was successfully locked * or [false] otherwise. *)
-      val try_lock : mutex -> (bool, 'a) t
-
-      (** A computation that unlocks a mutex. * Should return immediately. *)
-      val unlock : mutex -> (unit, 'a) t
-    end
-
-    module Factory (_ : Mutex_control) : Mutex_t
-  end
-
-  (** This module implements monadic * condition computations. They can be used
-      * to write waiting code that is compatible * with duppy's tasks, i.e.
-      [Condition.wait c m] blocks * the calling computation and not the calling
-      thread * until [Condition.signal c] or [Condition.broadcast c] has * been
-      called. *)
-  module Condition : sig
-    module Factory (Mutex : Mutex.Mutex_t) : sig
-      (** Type of a condition, used in [wait] and [broadcast] *)
-      type condition
-
-      (** Create a condition. Implementation-wise, * a duppy task is created
-          that will be used to select a * waiting computation, and resume it. *
-          Thus, [priority] and [s] represents, resp., the priority * and
-          scheduler used when running calling process' computation. *)
-      val create : unit -> condition
-
-      (** [wait h m] is a computation that:
-        * {ul
-        * {- Unlock mutex [m]}
-        * {- Wait until [Condition.signal c] or [Condition.broadcast c]
-             has been called}
-        * {- Locks mutex [m]}
-        * {- Returns [unit]}} *)
-      val wait : condition -> Mutex.mutex -> (unit, 'a) t
-
-      (** [broadcast c] is a computation that * resumes all computations waiting
-          on [c]. It should * return immediately. *)
-      val broadcast : condition -> (unit, 'a) t
-
-      (** [signal c] is a computation that resumes one * computation waiting on
-          [c]. It should return * immediately. *)
-      val signal : condition -> (unit, 'a) t
-    end
-  end
-
-  (** This module implements monadic computations * using [Duppy.Io]. It can be
-      used to create * computations that read or write from a socket, * and also
-      to redirect a computation in a different * queue with a new priority. *)
-  module type Monad_io_t = sig
-    type socket
-
-    module Io : Io_t with type socket = socket
-
-    (** {2 Type} *)
-
-    (** A handler for this module * is a record that contains the * required
-        elements. In particular, * [on_error] is a function that transforms * an
-        error raised by [Duppy.Io] to a reply * used to terminate the
-        computation. * [data] is an internal data buffer. It should * be
-        initialized with [""]. It contains the * remaining data that was
-        received when * using [read]. If an error occurred, * [data] contain
-        data read before the * error. *)
-    type ('a, 'b) handler = {
-      scheduler : 'a scheduler;
-      socket : Io.socket;
-      mutable data : string;
-      on_error : Io.failure -> 'b;
-    }
-
-    (** {2 Execution flow} *)
-
-    (** [exec ?delay ~priority h f] redirects computation * [f] into a new queue
-        with priority [priority] and * delay [delay] ([0.] by default). * It can
-        be used to redirect a computation that * has to run under a different
-        priority. For instance, * a computation that reads from a socket is
-        generally * not blocking because the function is executed * only when
-        some data is available for reading. * However, if the data that is read
-        needs to be processed * by a computation that can be blocking, then one
-        may * use [exec] to redirect this computation into an * appropriate
-        queue. *)
-    val exec :
-      ?delay:float ->
-      priority:'a ->
-      ('a, 'b) handler ->
-      ('c, 'b) t ->
-      ('c, 'b) t
-
-    (** [delay ~priority h d] creates a computation that returns * [unit] after
-        delay [d] in seconds. *)
-    val delay : priority:'a -> ('a, 'b) handler -> float -> (unit, 'b) t
-
-    (** {2 Read/write} *)
-
-    (** [read ?timeout ~priority ~marker h] creates a * computation that reads
-        from [h.socket] * and returns the first string split * according to
-        [marker]. This function * can be used to create a computation that *
-        reads data from a socket. [timeout] parameter * forces the computation
-        to return an error if * nothing has been read for more than [timeout] *
-        seconds. Default: wait forever. *)
-    val read :
-      ?timeout:float ->
-      priority:'a ->
-      marker:Io.marker ->
-      ('a, 'b) handler ->
-      (string, 'b) t
-
-    (** [read_all ?timeout ~priority s sock] creates a * computation that reads
-        all data from [sock] * and returns it. Raised value contains data * read
-        before an error occurred. *)
-    val read_all :
-      ?timeout:float ->
-      priority:'a ->
-      'a scheduler ->
-      Io.socket ->
-      (string, string * Io.failure) t
-
-    (** [write ?timeout ~priority h s] creates a computation * that writes
-        string [s] to [h.socket]. This * function can be used to create a
-        computation * that sends data to a socket. [timeout] parameter * forces
-        the computation to return an error if * nothing has been written for
-        more than [timeout] * seconds. Default: wait forever. *)
-    val write :
-      ?timeout:float ->
-      priority:'a ->
-      ('a, 'b) handler ->
-      ?offset:int ->
-      ?length:int ->
-      Bytes.t ->
-      (unit, 'b) t
-
-    (** [write_bigarray ?timeout ~priority h ba] creates a computation * that
-        writes data from [ba] to [h.socket]. This function * can to create a
-        computation that writes data to a socket. *)
-    val write_bigarray :
-      ?timeout:float ->
-      priority:'a ->
-      ('a, 'b) handler ->
-      Io.bigarray ->
-      (unit, 'b) t
-  end
-
-  module MakeIo (Io : Io_t) :
-    Monad_io_t with type socket = Io.socket and module Io = Io
-
-  module Io : Monad_io_t with type socket = Unix.file_descr and module Io = Io
-end
-
 (** {2 Some culture..}
     * {e Duppy is a Caribbean patois word of West African origin meaning ghost or spirit.
     * Much of Caribbean folklore revolves around duppies.
diff --git a/src/modules/duppy/duppy_stubs.c b/src/modules/duppy/duppy_stubs.c
deleted file mode 100644
index 15f2ff4970..0000000000
--- a/src/modules/duppy/duppy_stubs.c
+++ /dev/null
@@ -1,74 +0,0 @@
-/*
- * Copyright 2010 Savonet team
- *
- * This file is part of Ocaml-duppy.
- *
- * Ocaml-duppy is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * Ocaml-duppy is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with Ocaml-duppy; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
- *
- */
-
-#include <caml/alloc.h>
-#include <caml/bigarray.h>
-#include <caml/fail.h>
-#include <caml/memory.h>
-#include <caml/signals.h>
-#include <caml/threads.h>
-#include <caml/unixsupport.h>
-
-#include <errno.h>
-
-/* On native Windows platforms, many macros are not defined.  */
-#if (defined _WIN32 || defined __WIN32__) && !defined __CYGWIN__
-
-#ifndef EWOULDBLOCK
-#define EWOULDBLOCK EAGAIN
-#endif
-
-#endif
-
-#ifdef WIN32
-#define Fd_val(fd) win_CRT_fd_of_filedescr(fd)
-#define Val_fd(fd) caml_failwith("Val_fd")
-#else
-#define Fd_val(fd) Int_val(fd)
-#define Val_fd(fd) Val_int(fd)
-#endif
-
-CAMLprim value ocaml_duppy_write_ba(value _fd, value ba, value _ofs,
-                                    value _len) {
-  CAMLparam4(_fd, ba, _ofs, _len);
-  int fd = Fd_val(_fd);
-  long ofs = Long_val(_ofs);
-  long len = Long_val(_len);
-  void *buf = Caml_ba_data_val(ba);
-  int ret;
-
-  int written = 0;
-  while (len > 0) {
-    caml_enter_blocking_section();
-    ret = write(fd, buf + ofs, len);
-    caml_leave_blocking_section();
-    if (ret == -1) {
-      if ((errno == EAGAIN || errno == EWOULDBLOCK) && written > 0)
-        break;
-      uerror("write", Nothing);
-    }
-    written += ret;
-    ofs += ret;
-    len -= ret;
-  }
-
-  CAMLreturn(Val_long(written));
-}
diff --git a/src/modules/duppy/examples/dune b/src/modules/duppy/examples/dune
index 887559fc82..3e116df71b 100644
--- a/src/modules/duppy/examples/dune
+++ b/src/modules/duppy/examples/dune
@@ -1,9 +1,10 @@
-(executable
- (name http)
- (modules http)
- (libraries duppy))
+(executables
+ (names http telnet)
+ (libraries duppy re unix threads.posix))
 
-(executable
- (name telnet)
- (modules telnet)
- (libraries duppy))
+; Nothing else builds the examples, so this is what keeps them compiling.
+
+(rule
+ (alias citest)
+ (deps ./http.exe ./telnet.exe)
+ (action (progn)))
diff --git a/src/modules/duppy/examples/http.ml b/src/modules/duppy/examples/http.ml
index 0c6d7cb73b..f5630c6ac1 100644
--- a/src/modules/duppy/examples/http.ml
+++ b/src/modules/duppy/examples/http.ml
@@ -1,9 +1,8 @@
 module Pcre = Re.Pcre
 
-let non_blocking_queues = ref 3
-let maybe_blocking_queues = ref 1
 let files_path = ref ""
 let port = ref 8080
+let domains = ref None
 let usage = "usage: http [options] /path/to/files"
 
 let () =
@@ -17,14 +16,9 @@ let () =
   in
   Arg.parse
     [
-      ( "--non_blocking_queues",
-        Arg.Int (fun i -> non_blocking_queues := i),
-        Printf.sprintf "Number of non-blocking queues. (default: %d)"
-          !non_blocking_queues );
-      ( "--maybe_blocking_queues",
-        Arg.Int (fun i -> maybe_blocking_queues := i),
-        Printf.sprintf "Number of maybe-blocking queues. (default: %d)"
-          !maybe_blocking_queues );
+      ( "--domains",
+        Arg.Int (fun i -> domains := Some i),
+        "Number of domains serving requests. (default: one per core)" );
       ( "--port",
         Arg.Int (fun i -> port := i),
         Printf.sprintf "Port used to bind the server. (default: %d)" !port );
@@ -37,7 +31,15 @@ let () =
 
 type priority = Maybe_blocking | Non_blocking
 
-let scheduler = Duppy.create ()
+(* Parsing a request and writing a reply never block, so they run directly on
+   a domain of the pool. Reading the file, or running a CGI, does block. *)
+let scheduler =
+  Duppy.create
+    ~classify:(function
+      | Non_blocking -> `Immediate | Maybe_blocking -> `Blocking)
+    ~on_error:(fun exn _ ->
+      Printf.printf "Task failed: %s\n%!" (Printexc.to_string exn))
+    ()
 
 type http_method = Post | Get
 type http_protocol = Http_11 | Http_10
@@ -125,53 +127,47 @@ let http_302 protocol uri =
 
 type socket_status = Keep | Close
 
+(** A handler finishes by raising its reply, from wherever it got to. *)
+exception Reply of reply
+
 let send_reply h reply =
   let write s =
-    Duppy.Monad.Io.write ?timeout:None ~priority:Non_blocking h
-      (Bytes.unsafe_of_string s)
+    Duppy.Io.write ~priority:Non_blocking h (Bytes.unsafe_of_string s)
   in
   let code, status = reply.reply_status in
-  let http_header =
-    Printf.sprintf "%s %d %s\r\n%s\r\n\r\n"
-      (string_of_protocol reply.reply_protocol)
-      code status
-      (String.concat "\r\n"
-         (List.map
-            (fun (x, y) -> Printf.sprintf "%s: %s" x y)
-            reply.reply_headers))
-  in
-  Duppy.Monad.bind (write http_header) (fun () ->
-      match reply.reply_data with
-        | String s -> write s
-        | File fd ->
-            let stats = Unix.fstat fd in
-            let ba =
-              Unix.map_file fd Bigarray.char Bigarray.c_layout false
-                [| stats.Unix.st_size |]
-            in
-            let ba = Bigarray.array1_of_genarray ba in
-            let close () = try Unix.close fd with _ -> () in
-            let on_error e =
-              close ();
-              h.Duppy.Monad.Io.on_error e
-            in
-            let h = { h with Duppy.Monad.Io.on_error } in
-            Duppy.Monad.bind
-              (Duppy.Monad.Io.write_bigarray ?timeout:None
-                 ~priority:Non_blocking h ba) (fun () ->
-                Duppy.Monad.return (close ()))
-        | None -> Duppy.Monad.return ())
+  write
+    (Printf.sprintf "%s %d %s\r\n%s\r\n\r\n"
+       (string_of_protocol reply.reply_protocol)
+       code status
+       (String.concat "\r\n"
+          (List.map
+             (fun (x, y) -> Printf.sprintf "%s: %s" x y)
+             reply.reply_headers)));
+  match reply.reply_data with
+    | String s -> write s
+    | None -> ()
+    | File fd ->
+        let close () = try Unix.close fd with _ -> () in
+        let length = 4096 in
+        let buf = Bytes.create length in
+        let rec copy () =
+          match Unix.read fd buf 0 length with
+            | 0 -> ()
+            | n ->
+                Duppy.Io.write ~length:n ~priority:Non_blocking h buf;
+                copy ()
+        in
+        Fun.protect ~finally:close copy
 
 let parse_headers headers =
+  let rex = Pcre.regexp "([^:\r\n]+):\\s*([^\r\n]+)" in
   let split_header l h =
     try
-      let rex = Pcre.regexp "([^:\\r\\n]+):\\s*([^\\r\\n]+)" in
       let sub = Pcre.exec ~rex h in
-      Duppy.Monad.return
-        ((Pcre.get_substring sub 1, Pcre.get_substring sub 2) :: l)
-    with Not_found -> Duppy.Monad.raise error_500
+      (Pcre.get_substring sub 1, Pcre.get_substring sub 2) :: l
+    with Not_found -> raise (Reply error_500)
   in
-  Duppy.Monad.fold_left split_header [] headers
+  List.fold_left split_header [] headers
 
 let index_uri path index protocol uri =
   let uri =
@@ -183,14 +179,15 @@ let index_uri path index protocol uri =
   try
     if Sys.is_directory (Printf.sprintf "%s%s" path uri) then
       if uri.[String.length uri - 1] <> '/' then
-        Duppy.Monad.raise (http_302 protocol (Printf.sprintf "%s/" uri))
+        raise (Reply (http_302 protocol (Printf.sprintf "%s/" uri)))
       else (
         let index = Printf.sprintf "%s/%s" uri index in
-        if Sys.file_exists (Printf.sprintf "%s/%s" path index) then
-          Duppy.Monad.return index
-        else Duppy.Monad.return uri)
-    else Duppy.Monad.return uri
-  with _ -> Duppy.Monad.return uri
+        if Sys.file_exists (Printf.sprintf "%s/%s" path index) then index
+        else uri)
+    else uri
+  with
+    | Reply _ as e -> raise e
+    | _ -> uri
 
 let file_request path _ request =
   let uri =
@@ -201,313 +198,255 @@ let file_request path _ request =
       ret.(1)
     with Not_found -> request.request_uri
   in
-  let __pa_duppy_0 = index_uri path "index.html" request.request_protocol uri in
-  Duppy.Monad.bind __pa_duppy_0 (fun uri ->
-      let fname = Printf.sprintf "%s%s" path uri in
-      if Sys.file_exists fname then (
-        try
-          let fd = Unix.openfile fname [Unix.O_RDONLY] 0o640 in
-          let stats = Unix.fstat fd in
-          let headers =
-            [
-              ("Server", server);
-              ("Content-Length", string_of_int stats.Unix.st_size);
-            ]
-          in
-          let headers =
-            if Pcre.pmatch ~rex:(Pcre.regexp "\\.html$") fname then
-              ("Content-Type", "text/html") :: headers
-            else if Pcre.pmatch ~rex:(Pcre.regexp "\\.css$") fname then
-              ("Content-Type", "text/css") :: headers
-            else headers
-          in
-          Duppy.Monad.raise
-            {
-              reply_protocol = request.request_protocol;
-              reply_status = (200, "OK");
-              reply_headers = headers;
-              reply_data = File fd;
-            }
-        with _ -> Duppy.Monad.raise (error_403 request.request_protocol))
-      else Duppy.Monad.raise (error_404 request.request_protocol))
-
-let file_handler = ((fun _ -> Duppy.Monad.return true), file_request !files_path)
-
-let cgi_handler process path h request =
+  let uri = index_uri path "index.html" request.request_protocol uri in
+  let fname = Printf.sprintf "%s%s" path uri in
+  if not (Sys.file_exists fname) then
+    raise (Reply (error_404 request.request_protocol));
+  let fd =
+    try Unix.openfile fname [Unix.O_RDONLY] 0o640
+    with _ -> raise (Reply (error_403 request.request_protocol))
+  in
+  let stats = Unix.fstat fd in
+  let headers =
+    [("Server", server); ("Content-Length", string_of_int stats.Unix.st_size)]
+  in
+  let headers =
+    if Pcre.pmatch ~rex:(Pcre.regexp "\\.html$") fname then
+      ("Content-Type", "text/html") :: headers
+    else if Pcre.pmatch ~rex:(Pcre.regexp "\\.css$") fname then
+      ("Content-Type", "text/css") :: headers
+    else headers
+  in
+  raise
+    (Reply
+       {
+         reply_protocol = request.request_protocol;
+         reply_status = (200, "OK");
+         reply_headers = headers;
+         reply_data = File fd;
+       })
+
+let file_handler = ((fun _ -> true), file_request !files_path)
+
+let read_all h =
+  let buf = Buffer.create 1024 in
+  (try
+     while true do
+       Buffer.add_string buf
+         (Duppy.Io.read ~priority:Non_blocking h (Duppy.Io.Length 1024))
+     done
+   with Duppy.Io.Error _ -> ());
+  Buffer.contents buf
+
+let cgi_handler process path _ request =
   let uri, args, suffix =
     try
       let ret =
         Pcre.extract ~rex:(Pcre.regexp "([^\\?]*)\\?(.*)") request.request_uri
       in
+      let args = Pcre.split ~rex:(Pcre.regexp "&") ret.(2) in
+      let args =
+        List.map
+          (fun s ->
+            let ret = Pcre.extract ~rex:(Pcre.regexp "([^=]*)=(.*)") s in
+            (ret.(1), ret.(2)))
+          args
+      in
+      (ret.(1), args, Printf.sprintf "?%s" ret.(2))
+    with Not_found -> (request.request_uri, [], "")
+  in
+  let uri = index_uri path "index.php" request.request_protocol uri in
+  let fname = Printf.sprintf "%s%s" path uri in
+  if not (Sys.file_exists fname) then
+    raise (Reply (error_404 request.request_protocol));
+  let headers = request.request_headers in
+  let env =
+    Printf.sprintf
+      "export GATEWAY_INTERFACE=CGI/1.1; export SERVER_SOFTWARE=%s; export \
+       SERVER_PROTOCOL=%s; export REQUEST_METHOD=%s; export \
+       SCRIPT_FILENAME=%s; export SCRIPT_NAME=%s; export REQUEST_URI=%s%s; \
+       export QUERY_STRING=%s; export REDIRECT_STATUS=200"
+      server
+      (string_of_protocol request.request_protocol)
+      (string_of_method request.request_method)
+      (Filename.quote fname) (Filename.quote uri) (Filename.quote uri)
+      (Filename.quote suffix)
+      (Filename.quote
+         (String.concat "&" (List.map (fun (x, y) -> x ^ "=" ^ y) args)))
+  in
+  let append env key =
+    if List.mem_assoc key headers then
+      Printf.sprintf "%s; export %s=%s" env key
+        (Filename.quote (List.assoc key headers))
+    else env
+  in
+  let env = append env "CONTENT_TYPE" in
+  let env = append env "CONTENT_LENGTH" in
+  let env =
+    if List.mem_assoc "AUTHORIZATION" headers then (
+      let ret =
+        Pcre.extract
+          ~rex:(Pcre.regexp "(^[^\\s]*\\s.*)$")
+          (List.assoc "AUTHORIZATION" headers)
+      in
+      if Array.length ret > 0 then
+        Printf.sprintf "%s; extract AUTH_TYPE=%s" env ret.(1)
+      else raise (Reply error_500))
+    else env
+  in
+  let env =
+    List.fold_left
+      (fun env (x, y) ->
+        Printf.sprintf "%s; export HTTP_%s=%s" env x (Filename.quote y))
+      env headers
+  in
+  let data =
+    match request.request_data with
+      | None -> ""
+      | String s -> s
+      | _ -> assert false
+  in
+  let process = Printf.sprintf "%s; %s 2>/dev/null" env process in
+  let in_c, out_c = Unix.open_process process in
+  let out_s = Unix.descr_of_out_channel out_c in
+  let h_out = Duppy.Io.handle scheduler out_s in
+  Duppy.Io.write ~priority:Non_blocking h_out (Bytes.unsafe_of_string data);
+  let in_s = Unix.descr_of_in_channel in_c in
+  let h_in = Duppy.Io.handle scheduler in_s in
+  let headers =
+    Duppy.Io.read ~priority:Non_blocking h_in (Duppy.Io.Split "[\r]?\n[\r]?\n")
+  in
+  let data = read_all h_in in
+  ignore (Unix.close_process (in_c, out_c));
+  let headers = parse_headers (Pcre.split ~rex:(Pcre.regexp "\r\n") headers) in
+  let status, headers =
+    if List.mem_assoc "Status" headers then (
       try
         let ans =
-          Pcre.extract ~rex:(Pcre.regexp "^([^/]*)/([^&=]*)$") ret.(2)
+          Pcre.extract
+            ~rex:(Pcre.regexp "([\\d]+)\\s(.*)")
+            (List.assoc "Status" headers)
         in
-        (ret.(1), ans.(1), ans.(2))
-      with Not_found -> (ret.(1), ret.(2), "")
-    with Not_found -> (request.request_uri, "", "")
+        ( (int_of_string ans.(1), ans.(2)),
+          List.filter (fun (x, _) -> x <> "Status") headers )
+      with _ -> raise (Reply error_500))
+    else ((200, "OK"), headers)
   in
-  let __pa_duppy_0 = index_uri path "index.php" request.request_protocol uri in
-  Duppy.Monad.bind __pa_duppy_0 (fun script ->
-      let script = Printf.sprintf "%s%s" path script in
-      let env =
-        Printf.sprintf
-          "export SERVER_SOFTWARE=Duppy-httpd/1.0; export \
-           SERVER_NAME=localhost; export GATEWAY_INTERFACE=CGI/1.1; export \
-           SERVER_PROTOCOL=%s; export SERVER_PORT=%d; export \
-           REQUEST_METHOD=%s; export REQUEST_URI=%s; export \
-           REDIRECT_STATUS=200; export SCRIPT_FILENAME=%s"
-          (string_of_protocol request.request_protocol)
-          !port
-          (string_of_method request.request_method)
-          (Filename.quote uri) (Filename.quote script)
-      in
-      let env =
-        Printf.sprintf "%s; export QUERY_STRING=%s" env (Filename.quote args)
-      in
-      let env =
-        let tr_suffix = Printf.sprintf "%s%s" path suffix in
-        (* Trick ! *)
-        let tr_suffix =
-          Printf.sprintf "%s/%s"
-            (Filename.dirname tr_suffix)
-            (Filename.basename tr_suffix)
-        in
-        Printf.sprintf "%s; export PATH_TRANSLATED=%s; export PATH_INFO=%s" env
-          (Filename.quote tr_suffix) (Filename.quote suffix)
-      in
-      let sanitize s =
-        Pcre.substitute ~rex:(Pcre.regexp "-")
-          ~subst:(fun _ -> "_")
-          (String.uppercase_ascii s)
-      in
-      let headers =
-        List.map (fun (x, y) -> (sanitize x, y)) request.request_headers
-      in
-      let append env key =
-        if List.mem_assoc key headers then
-          Printf.sprintf "%s; export %s=%s" env key
-            (Filename.quote (List.assoc key headers))
-        else env
-      in
-      let env = append env "CONTENT_TYPE" in
-      let env = append env "CONTENT_LENGTH" in
-      let __pa_duppy_0 =
-        if List.mem_assoc "AUTHORIZATION" headers then (
-          let ret =
-            Pcre.extract
-              ~rex:(Pcre.regexp "(^[^\\s]*\\s.*)$")
-              (List.assoc "AUTHORIZATION" headers)
-          in
-          if Array.length ret > 0 then
-            Duppy.Monad.return
-              (Printf.sprintf "%s; extract AUTH_TYPE=%s" env ret.(1))
-          else Duppy.Monad.raise error_500)
-        else Duppy.Monad.return env
-      in
-      Duppy.Monad.bind __pa_duppy_0 (fun env ->
-          let f env (x, y) =
-            Printf.sprintf "%s; export HTTP_%s=%s" env x (Filename.quote y)
-          in
-          let env = List.fold_left f env headers in
-          let data =
-            match request.request_data with
-              | None -> ""
-              | String s -> s
-              | _ -> assert false
-          in
-          (* not implemented *)
-          let process = Printf.sprintf "%s; %s 2>/dev/null" env process in
-          let in_c, out_c = Unix.open_process process in
-          let out_s = Unix.descr_of_out_channel out_c in
-          let h = { h with Duppy.Monad.Io.socket = out_s; data = "" } in
-          let __pa_duppy_0 =
-            Duppy.Monad.Io.write ?timeout:None ~priority:Non_blocking h
-              (Bytes.unsafe_of_string data)
-          in
-          Duppy.Monad.bind __pa_duppy_0 (fun () ->
-              let in_s = Unix.descr_of_in_channel in_c in
-              let h = { h with Duppy.Monad.Io.socket = in_s; data = "" } in
-              let __pa_duppy_0 =
-                Duppy.Monad.Io.read ?timeout:None ~priority:Non_blocking
-                  ~marker:(Duppy.Io.Split "[\r]?\n[\r]?\n") h
-              in
-              Duppy.Monad.bind __pa_duppy_0 (fun headers ->
-                  let __pa_duppy_0 =
-                    Duppy.Monad.catch
-                      (Duppy.Monad.Io.read_all ?timeout:None
-                         ~priority:Non_blocking h.Duppy.Monad.Io.scheduler in_s)
-                      (fun (s, _) -> Duppy.Monad.return s)
-                  in
-                  Duppy.Monad.bind __pa_duppy_0 (fun data ->
-                      let data =
-                        Printf.sprintf "%s%s" h.Duppy.Monad.Io.data data
-                      in
-                      ignore (Unix.close_process (in_c, out_c));
-                      let __pa_duppy_0 =
-                        let headers =
-                          Pcre.split ~rex:(Pcre.regexp "\r\n") headers
-                        in
-                        parse_headers headers
-                      in
-                      Duppy.Monad.bind __pa_duppy_0 (fun headers ->
-                          let __pa_duppy_0 =
-                            if List.mem_assoc "Status" headers then (
-                              try
-                                let ans =
-                                  Pcre.extract
-                                    ~rex:(Pcre.regexp "([\\d]+)\\s(.*)")
-                                    (List.assoc "Status" headers)
-                                in
-                                Duppy.Monad.return
-                                  ( (int_of_string ans.(1), ans.(2)),
-                                    List.filter
-                                      (fun (x, _) -> x <> "Status")
-                                      headers )
-                              with _ -> Duppy.Monad.raise error_500)
-                            else Duppy.Monad.return ((200, "OK"), headers)
-                          in
-                          Duppy.Monad.bind __pa_duppy_0
-                            (fun (status, headers) ->
-                              let headers =
-                                ( "Content-length",
-                                  string_of_int (String.length data) )
-                                :: headers
-                              in
-                              Duppy.Monad.raise
-                                {
-                                  reply_protocol = request.request_protocol;
-                                  reply_status = status;
-                                  reply_headers = headers;
-                                  reply_data = String data;
-                                })))))))
+  raise
+    (Reply
+       {
+         reply_protocol = request.request_protocol;
+         reply_status = status;
+         reply_headers =
+           ("Content-length", string_of_int (String.length data)) :: headers;
+         reply_data = String data;
+       })
 
 let php_handler =
   ( (fun request ->
-      let __pa_duppy_0 =
+      let uri =
         index_uri !files_path "index.php" request.request_protocol
           request.request_uri
       in
-      Duppy.Monad.bind __pa_duppy_0 (fun uri ->
-          Duppy.Monad.return (Pcre.pmatch ~rex:(Pcre.regexp "\\.php$") uri))),
+      Pcre.pmatch ~rex:(Pcre.regexp "\\.php$") uri),
     cgi_handler "php-cgi" !files_path )
 
 let handlers = [php_handler; file_handler]
 
 let handle_request h request =
-  let f (check, handler) =
-    let __pa_duppy_0 = check request in
-    Duppy.Monad.bind __pa_duppy_0 (fun check ->
-        if check then handler h request else Duppy.Monad.return ())
-  in
-  Duppy.Monad.catch
-    (Duppy.Monad.bind (Duppy.Monad.iter f handlers) (fun () ->
-         Duppy.Monad.return (error_404 request.request_protocol)))
-    (fun reply -> Duppy.Monad.return reply)
+  try
+    List.iter
+      (fun (check, handler) -> if check request then handler h request)
+      handlers;
+    error_404 request.request_protocol
+  with Reply reply -> reply
 
 let parse_request h r =
   try
     let headers = Pcre.split ~rex:(Pcre.regexp "\r\n") r in
-    let __pa_duppy_0 =
+    let request, headers =
       match headers with
-        | e :: l ->
-            let __pa_duppy_0 = parse_headers l in
-            Duppy.Monad.bind __pa_duppy_0 (fun headers ->
-                Duppy.Monad.return (e, headers))
-        | _ -> Duppy.Monad.raise error_500
+        | e :: l -> (e, parse_headers l)
+        | _ -> raise (Reply error_500)
     in
-    Duppy.Monad.bind __pa_duppy_0 (fun (request, headers) ->
-        let rex = Pcre.regexp "([\\w]+)\\s([^\\s]+)\\s(HTTP/1.[01])" in
-        let __pa_duppy_0 =
-          try
-            let sub = Pcre.exec ~rex request in
-            let http_method, uri, protocol =
-              ( Pcre.get_substring sub 1,
-                Pcre.get_substring sub 2,
-                Pcre.get_substring sub 3 )
-            in
-            Duppy.Monad.return
-              (method_of_string http_method, uri, protocol_of_string protocol)
-          with _ -> Duppy.Monad.raise error_500
+    let http_method, uri, protocol =
+      try
+        let sub =
+          Pcre.exec
+            ~rex:(Pcre.regexp "([\\w]+)\\s([^\\s]+)\\s(HTTP/1.[01])")
+            request
         in
-        Duppy.Monad.bind __pa_duppy_0 (fun (http_method, uri, protocol) ->
-            let __pa_duppy_0 =
-              match http_method with
-                | Get -> Duppy.Monad.return None
-                | Post ->
-                    let __pa_duppy_0 =
-                      try
-                        let length = assoc_uppercase "CONTENT-LENGTH" headers in
-                        Duppy.Monad.return (int_of_string length)
-                      with
-                        | Not_found -> Duppy.Monad.return 0
-                        | _ -> Duppy.Monad.raise error_500
-                    in
-                    Duppy.Monad.bind __pa_duppy_0 (fun len ->
-                        match len with
-                          | 0 -> Duppy.Monad.return None
-                          | d ->
-                              let __pa_duppy_0 =
-                                Duppy.Monad.Io.read ?timeout:None
-                                  ~priority:Non_blocking
-                                  ~marker:(Duppy.Io.Length d) h
-                              in
-                              Duppy.Monad.bind __pa_duppy_0 (fun data ->
-                                  Duppy.Monad.return (String data)))
+        ( method_of_string (Pcre.get_substring sub 1),
+          Pcre.get_substring sub 2,
+          protocol_of_string (Pcre.get_substring sub 3) )
+      with
+        | Reply _ as e -> raise e
+        | _ -> raise (Reply error_500)
+    in
+    let data =
+      match http_method with
+        | Get -> None
+        | Post -> (
+            let len =
+              try int_of_string (assoc_uppercase "CONTENT-LENGTH" headers) with
+                | Not_found -> 0
+                | _ -> raise (Reply error_500)
             in
-            Duppy.Monad.bind __pa_duppy_0 (fun data ->
-                Duppy.Monad.return
-                  {
-                    request_method = http_method;
-                    request_protocol = protocol;
-                    request_uri = uri;
-                    request_headers = headers;
-                    request_data = data;
-                  })))
-  with _ -> Duppy.Monad.raise error_500
+            match len with
+              | 0 -> None
+              | d ->
+                  String
+                    (Duppy.Io.read ~priority:Non_blocking h (Duppy.Io.Length d))
+            )
+    in
+    {
+      request_method = http_method;
+      request_protocol = protocol;
+      request_uri = uri;
+      request_headers = headers;
+      request_data = data;
+    }
+  with
+    | Reply _ as e -> raise e
+    | _ -> raise (Reply error_500)
 
 let handle_client socket =
-  (* Read and process lines *)
-  let on_error _ = error_500 in
-  let h = { Duppy.Monad.Io.scheduler; socket; data = ""; on_error } in
+  let h = Duppy.Io.handle scheduler socket in
   let rec exec () =
-    let __pa_duppy_0 =
-      Duppy.Monad.catch
-        (let __pa_duppy_0 =
-           Duppy.Monad.Io.read ?timeout:None ~priority:Non_blocking
-             ~marker:(Duppy.Io.Split "\r\n\r\n") h
-         in
-         Duppy.Monad.bind __pa_duppy_0 (fun data ->
-             let __pa_duppy_0 = parse_request h data in
-             Duppy.Monad.bind __pa_duppy_0 (fun request ->
-                 let __pa_duppy_0 = handle_request h request in
-                 Duppy.Monad.bind __pa_duppy_0 (fun reply ->
-                     let close_header headers =
-                       try assoc_uppercase "CONNECTION" headers = "close"
-                       with Not_found -> false
-                     in
-                     let keep =
-                       if
-                         request.request_protocol = Http_10
-                         || close_header request.request_headers
-                         || close_header reply.reply_headers
-                       then Close
-                       else Keep
-                     in
-                     Duppy.Monad.return (keep, reply)))))
-        (fun reply -> Duppy.Monad.return (Close, reply))
+    let keep, reply =
+      try
+        let data =
+          Duppy.Io.read ~priority:Non_blocking h (Duppy.Io.Split "\r\n\r\n")
+        in
+        let request = parse_request h data in
+        let reply = handle_request h request in
+        let close_header headers =
+          try assoc_uppercase "CONNECTION" headers = "close"
+          with Not_found -> false
+        in
+        let keep =
+          if
+            request.request_protocol = Http_10
+            || close_header request.request_headers
+            || close_header reply.reply_headers
+          then Close
+          else Keep
+        in
+        (keep, reply)
+      with
+        | Reply reply -> (Close, reply)
+        | Duppy.Io.Error _ -> (Close, error_500)
     in
-    Duppy.Monad.bind __pa_duppy_0 (fun (keep, reply) ->
-        Duppy.Monad.bind (send_reply h reply) (fun () ->
-            if keep = Keep then exec () else Duppy.Monad.return ()))
+    let keep =
+      try
+        send_reply h reply;
+        keep
+      with Duppy.Io.Error _ -> Close
+    in
+    if keep = Keep then exec ()
   in
-  let finish _ = try Unix.close socket with _ -> () in
-  Duppy.Monad.run ~return:finish ~raise:finish (exec ())
-
-let new_queue ~priority ~name () =
-  let priorities p = p = priority in
-  let queue () = Duppy.queue scheduler ~log:(fun _ -> ()) ~priorities name in
-  Thread.create queue ()
+  let finish () = try Unix.close socket with _ -> () in
+  Duppy.run (fun () -> Fun.protect ~finally:finish exec)
 
 let bind_addr_inet = Unix.inet_addr_of_string "0.0.0.0"
 let bind_addr = Unix.ADDR_INET (bind_addr_inet, !port)
@@ -545,16 +484,7 @@ let () =
       events = [`Read sock];
       handler = incoming;
     };
-  for i = 1 to !non_blocking_queues do
-    ignore
-      (new_queue ~priority:Non_blocking
-         ~name:(Printf.sprintf "Non blocking queue #%d" i)
-         ())
-  done;
-  for i = 1 to !maybe_blocking_queues do
-    ignore
-      (new_queue ~priority:Maybe_blocking
-         ~name:(Printf.sprintf "Maybe blocking queue #%d" i)
-         ())
-  done;
-  Duppy.queue scheduler ~log:(fun _ -> ()) "root"
+  Duppy.start ?domains:!domains scheduler;
+  while true do
+    Unix.sleep 3600
+  done
diff --git a/src/modules/duppy/examples/telnet.ml b/src/modules/duppy/examples/telnet.ml
index 82417debb3..7b4b5be93f 100644
--- a/src/modules/duppy/examples/telnet.ml
+++ b/src/modules/duppy/examples/telnet.ml
@@ -2,23 +2,13 @@ type priority = Non_blocking | Maybe_blocking
 
 let io_priority = Non_blocking
 
-(* Create scheduler *)
-let scheduler = Duppy.create ()
-
-(* Create two queues,
- * one for non blocking events
- * and another for blocking
- * events *)
-let new_queue ~priority ~name () =
-  let log = Printf.printf "%s: %s\n%!" name in
-  let priorities p = p = priority in
-  let queue () = Duppy.queue scheduler ~log ~priorities name in
-  Thread.create queue ()
-
-let th =
-  ignore (new_queue ~priority:Non_blocking ~name:"Non blocking queue" ());
-  ignore (new_queue ~priority:Maybe_blocking ~name:"Maybe blocking queue #1" ());
-  new_queue ~priority:Maybe_blocking ~name:"Maybe blocking queue #2" ()
+(* Reading and writing to the socket never blocks, so it runs directly on a
+   domain of the pool. Running a command does block, so it gets a thread. *)
+let scheduler =
+  Duppy.create
+    ~classify:(function
+      | Non_blocking -> `Immediate | Maybe_blocking -> `Blocking)
+    ()
 
 let exec_command s () =
   let chan = Unix.open_process_in s in
@@ -29,18 +19,20 @@ let exec_command s () =
   in
   let l = aux () in
   ignore (Unix.close_process_in chan);
-  Duppy.Monad.return (String.concat "\r\n" l)
+  String.concat "\r\n" l
+
+exception Quit
 
 let commands = Hashtbl.create 10
 
 let () =
-  Hashtbl.add commands "hello" (false, fun () -> Duppy.Monad.return "world");
-  Hashtbl.add commands "foo" (false, fun () -> Duppy.Monad.return "bar");
+  Hashtbl.add commands "hello" (false, fun () -> "world");
+  Hashtbl.add commands "foo" (false, fun () -> "bar");
   Hashtbl.add commands "uptime" (true, exec_command "uptime");
   Hashtbl.add commands "date" (true, exec_command "date");
   Hashtbl.add commands "whoami" (true, exec_command "whoami");
   Hashtbl.add commands "sleep" (true, exec_command "sleep 15");
-  Hashtbl.add commands "exit" (true, fun () -> Duppy.Monad.raise ())
+  Hashtbl.add commands "exit" (true, fun () -> raise Quit)
 
 (* Add commands here *)
 let help = Buffer.create 10
@@ -50,61 +42,43 @@ let () =
   Hashtbl.iter
     (fun x _ -> Buffer.add_string help (Printf.sprintf "\r\n%s" x))
     commands;
-  Hashtbl.add commands "help"
-    (false, fun () -> Duppy.Monad.return (Buffer.contents help))
+  Hashtbl.add commands "help" (false, fun () -> Buffer.contents help)
 
 let handle_client socket =
-  let on_error e =
-    match e with
-      | Duppy.Io.Io_error -> Printf.printf "Client disconnected"
-      | Duppy.Io.Unix (c, p, m, _) ->
-          Printf.printf "%s" (Printexc.to_string (Unix.Unix_error (c, p, m)))
-      | Duppy.Io.Unknown (e, _) -> Printf.printf "%s" (Printexc.to_string e)
-      | Duppy.Io.Timeout -> Printf.printf "Timeout"
+  let report = function
+    | Duppy.Io.Io_error -> Printf.printf "Client disconnected"
+    | Duppy.Io.Unix (c, p, m, _) ->
+        Printf.printf "%s" (Printexc.to_string (Unix.Unix_error (c, p, m)))
+    | Duppy.Io.Unknown (e, _) -> Printf.printf "%s" (Printexc.to_string e)
+    | Duppy.Io.Timeout -> Printf.printf "Timeout"
   in
-  let h = { Duppy.Monad.Io.scheduler; socket; data = ""; on_error } in
-  (* Read and process lines *)
-  let rec exec () =
-    let __pa_duppy_0 =
-      Duppy.Monad.Io.read ?timeout:None ~priority:io_priority
-        ~marker:(Duppy.Io.Split "[\r\n]+") h
-    in
-    Duppy.Monad.bind __pa_duppy_0 (fun req ->
-        let __pa_duppy_0 =
-          try
-            let blocking, command = Hashtbl.find commands req in
-            if not blocking then command ()
-            else Duppy.Monad.Io.exec ~priority:Maybe_blocking h (command ())
-          with Not_found ->
-            Duppy.Monad.return
-              "ERROR: unknown command, type \"help\" to get a list of commands."
-        in
-        Duppy.Monad.bind __pa_duppy_0 (fun ans ->
-            Duppy.Monad.bind
-              (Duppy.Monad.bind
-                 (Duppy.Monad.Io.write ?timeout:None ~priority:io_priority h
-                    (Bytes.unsafe_of_string "BEGIN\r\n"))
-                 (fun () ->
-                   Duppy.Monad.bind
-                     (Duppy.Monad.Io.write ?timeout:None ~priority:io_priority h
-                        (Bytes.unsafe_of_string ans))
-                     (fun () ->
-                       Duppy.Monad.Io.write ?timeout:None ~priority:io_priority
-                         h
-                         (Bytes.unsafe_of_string "\r\nEND\r\n"))))
-              (fun () -> exec ())))
+  let h = Duppy.Io.handle scheduler socket in
+  let write s =
+    Duppy.Io.write ~priority:io_priority h (Bytes.unsafe_of_string s)
   in
   let close () = try Unix.close socket with _ -> () in
-  let return () =
-    let on_error e =
-      on_error e;
-      close ()
+  let rec exec () =
+    let req =
+      Duppy.Io.read ~priority:io_priority h (Duppy.Io.Split "[\r\n]+")
+    in
+    let ans =
+      match Hashtbl.find_opt commands req with
+        | Some (blocking, command) ->
+            if blocking then Duppy.reschedule ~priority:Maybe_blocking scheduler;
+            command ()
+        | None ->
+            "ERROR: unknown command, type \"help\" to get a list of commands."
     in
-    Duppy.Io.write ~priority:io_priority ~on_error ~exec:close scheduler
-      ~string:(Bytes.unsafe_of_string "Bye!\r\n")
-      socket
+    write "BEGIN\r\n";
+    write ans;
+    write "\r\nEND\r\n";
+    exec ()
   in
-  Duppy.Monad.run ~return ~raise:close (exec ())
+  Duppy.run (fun () ->
+      (try exec () with
+        | Quit -> ( try write "Bye!\r\n" with Duppy.Io.Error e -> report e)
+        | Duppy.Io.Error e -> report e);
+      close ())
 
 open Unix
 
@@ -147,4 +121,8 @@ let () =
       Duppy.Task.events = [`Read sock];
       Duppy.Task.handler = incoming;
     };
-  Thread.join th
+  Duppy.start ~log:(Printf.printf "telnet: %s\n%!") scheduler;
+  (* The pool runs on its own domains, so this thread has nothing left to do. *)
+  while true do
+    Unix.sleep 3600
+  done
diff --git a/src/modules/duppy/test/bench_duppy.ml b/src/modules/duppy/test/bench_duppy.ml
new file mode 100644
index 0000000000..c083d1de9b
--- /dev/null
+++ b/src/modules/duppy/test/bench_duppy.ml
@@ -0,0 +1,161 @@
+(* Reports what the pool is worth: how CPU-bound tasks scale with the number of
+   domains, and how much a periodic thread — a clock's shape — is delayed while
+   they run. Not a gate; run it by hand with `dune build @bench`. *)
+
+type priority = Immediate | Blocking
+
+let classify = function Immediate -> `Immediate | Blocking -> `Blocking
+
+let burn n =
+  let x = ref 0.0 in
+  for i = 1 to n do
+    x := Sys.opaque_identity (!x +. sqrt (float_of_int i))
+  done;
+  ignore (Sys.opaque_identity !x)
+
+type latch = { m : Mutex.t; c : Condition.t; n : int Atomic.t }
+
+let latch () =
+  { m = Mutex.create (); c = Condition.create (); n = Atomic.make 0 }
+
+let bump l =
+  ignore (Atomic.fetch_and_add l.n 1);
+  Mutex.lock l.m;
+  Condition.broadcast l.c;
+  Mutex.unlock l.m
+
+let await l target =
+  Mutex.lock l.m;
+  while Atomic.get l.n < target do
+    Condition.wait l.c l.m
+  done;
+  Mutex.unlock l.m
+
+let scaling ~domains ~tasks ~work =
+  let s = Duppy.create ~classify () in
+  let l = latch () in
+  for _ = 1 to tasks do
+    Duppy.Task.add s
+      {
+        Duppy.Task.priority = Blocking;
+        events = [`Delay 0.];
+        handler =
+          (fun _ ->
+            burn work;
+            bump l;
+            []);
+      }
+  done;
+  let start = Unix.gettimeofday () in
+  Duppy.start ~domains s;
+  await l tasks;
+  let elapsed = Unix.gettimeofday () -. start in
+  Duppy.stop s;
+  elapsed
+
+let percentile l p =
+  let l = List.sort compare l in
+  List.nth l
+    (min (List.length l - 1) (int_of_float (p *. float_of_int (List.length l))))
+
+let jitter ~domains ~load =
+  let s = Duppy.create ~classify () in
+  let ticks = 300 in
+  let period = 0.02 in
+  let running = Atomic.make true in
+  let rec spin _ =
+    burn 200_000;
+    if Atomic.get running then
+      [{ Duppy.Task.priority = Blocking; events = [`Delay 0.]; handler = spin }]
+    else []
+  in
+  for _ = 1 to load do
+    Duppy.Task.add s
+      { Duppy.Task.priority = Blocking; events = [`Delay 0.]; handler = spin }
+  done;
+  Duppy.start ~domains s;
+  let start = Unix.gettimeofday () in
+  let lateness = ref [] in
+  for i = 1 to ticks do
+    let target = start +. (float_of_int i *. period) in
+    let now = Unix.gettimeofday () in
+    if target > now then Thread.delay (target -. now);
+    lateness := (Unix.gettimeofday () -. target) :: !lateness
+  done;
+  Atomic.set running false;
+  Duppy.stop s;
+  !lateness
+
+(* What one turn of the loop costs while N tasks sit waiting on quiet sockets:
+   the shape of a harbor with that many connected-but-silent clients. *)
+let idle_cost ~idle ~rounds =
+  let s = Duppy.create ~classify () in
+  let keep =
+    List.init idle (fun _ ->
+        let a, b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
+        Duppy.Task.add s
+          {
+            Duppy.Task.priority = Blocking;
+            events = [`Read a];
+            handler = (fun _ -> []);
+          };
+        (a, b))
+  in
+  let l = latch () in
+  let rec ping _ =
+    bump l;
+    if Atomic.get l.n < rounds then
+      [
+        {
+          Duppy.Task.priority = Blocking;
+          events = [`Delay 1e-6];
+          handler = ping;
+        };
+      ]
+    else []
+  in
+  let start = Unix.gettimeofday () in
+  Duppy.Task.add s
+    { Duppy.Task.priority = Blocking; events = [`Delay 1e-6]; handler = ping };
+  Duppy.start ~domains:2 s;
+  await l rounds;
+  let elapsed = Unix.gettimeofday () -. start in
+  Duppy.stop s;
+  List.iter
+    (fun (a, b) ->
+      Unix.close a;
+      Unix.close b)
+    keep;
+  elapsed *. 1e6 /. float_of_int rounds
+
+let () =
+  let cores = Domain.recommended_domain_count () in
+  Printf.printf "%d cores available\n\n%!" cores;
+  Printf.printf "CPU-bound tasks (32 tasks)\n";
+  let base = ref 0. in
+  List.iter
+    (fun domains ->
+      if domains <= cores then begin
+        let elapsed = scaling ~domains ~tasks:32 ~work:8_000_000 in
+        if domains = 1 then base := elapsed;
+        Printf.printf "  domains=%-2d  wall=%6.3fs  speed-up=%.1fx\n%!" domains
+          elapsed (!base /. elapsed)
+      end)
+    [1; 2; 4; 6; 8];
+  Printf.printf "\nLateness of a 20ms periodic thread\n";
+  List.iter
+    (fun load ->
+      let l = jitter ~domains:cores ~load in
+      Printf.printf
+        "  busy tasks=%-2d  p50=%6.2fms  p99=%6.2fms  max=%6.2fms%s\n%!" load
+        (percentile l 0.5 *. 1e3)
+        (percentile l 0.99 *. 1e3)
+        (List.fold_left max 0. l *. 1e3)
+        (if cores <= load then "  (oversubscribed)" else ""))
+    [0; 2; 4; 7];
+  Printf.printf "\nCost of one loop turn vs waiting tasks\n";
+  List.iter
+    (fun idle ->
+      Printf.printf "  idle tasks=%-5d %6.1f us/turn\n%!" idle
+        (idle_cost ~idle ~rounds:2000))
+    [0; 100; 500; 1000; 2000]
diff --git a/src/modules/duppy/test/dune b/src/modules/duppy/test/dune
new file mode 100644
index 0000000000..ce6dabde9d
--- /dev/null
+++ b/src/modules/duppy/test/dune
@@ -0,0 +1,13 @@
+(executables
+ (names test_duppy bench_duppy)
+ (libraries duppy unix threads.posix))
+
+(rule
+ (alias citest)
+ (action
+  (run ./test_duppy.exe)))
+
+(rule
+ (alias bench)
+ (action
+  (run ./bench_duppy.exe)))
diff --git a/src/modules/duppy/test/test_duppy.ml b/src/modules/duppy/test/test_duppy.ml
new file mode 100644
index 0000000000..508ff74627
--- /dev/null
+++ b/src/modules/duppy/test/test_duppy.ml
@@ -0,0 +1,345 @@
+(* The pool dispatches across domains, batches immediate tasks onto one of
+   them, delivers socket events, and lets running tasks finish on stop. *)
+
+type priority = Immediate | Blocking
+
+let classify = function Immediate -> `Immediate | Blocking -> `Blocking
+let domain_id () = (Domain.self () :> int)
+
+let fail fmt =
+  Printf.ksprintf
+    (fun s ->
+      prerr_endline ("FAIL: " ^ s);
+      exit 1)
+    fmt
+
+let ok fmt = Printf.ksprintf (fun s -> print_endline ("ok: " ^ s)) fmt
+
+type latch = { m : Mutex.t; c : Condition.t; n : int Atomic.t }
+
+let latch () =
+  { m = Mutex.create (); c = Condition.create (); n = Atomic.make 0 }
+
+let bump l =
+  ignore (Atomic.fetch_and_add l.n 1);
+  Mutex.lock l.m;
+  Condition.broadcast l.c;
+  Mutex.unlock l.m
+
+let await l target =
+  Mutex.lock l.m;
+  while Atomic.get l.n < target do
+    Condition.wait l.c l.m
+  done;
+  Mutex.unlock l.m
+
+(* A hang would otherwise wedge the whole suite. *)
+let watchdog seconds =
+  ignore
+    (Thread.create
+       (fun () ->
+         Thread.delay seconds;
+         prerr_endline "FAIL: timed out";
+         exit 1)
+       ())
+
+let burn n =
+  let x = ref 0.0 in
+  for i = 1 to n do
+    x := Sys.opaque_identity (!x +. sqrt (float_of_int i))
+  done;
+  ignore (Sys.opaque_identity !x)
+
+(* A negative delay is already elapsed when the task is added, so the task is
+   ready before the pool starts rather than reaching it through the poller. *)
+let task priority handler =
+  { Duppy.Task.priority; events = [`Delay (-1.)]; handler }
+
+let ran_on domains =
+  Array.iteri (fun i d -> if d < 0 then fail "task %d never ran" i) domains;
+  List.length (List.sort_uniq compare (Array.to_list domains))
+
+(* One blocking slot per worker, and every task holds its slot until all of
+   them are running: they can only all make progress if each landed on a
+   different worker, so a pool that dispatches to one domain deadlocks here
+   rather than passing. *)
+let test_parallel () =
+  let s = Duppy.create ~classify () in
+  let started = latch () in
+  let finished = latch () in
+  let count = 4 in
+  let domains = Array.make count (-1) in
+  for i = 0 to count - 1 do
+    Duppy.Task.add s
+      (task Blocking (fun _ ->
+           domains.(i) <- domain_id ();
+           bump started;
+           await started count;
+           bump finished;
+           []))
+  done;
+  Duppy.start ~domains:count ~max_blocking:count s;
+  await finished count;
+  Duppy.stop s;
+  let distinct = ran_on domains in
+  if distinct <> count then
+    fail "%d concurrent tasks ran on %d domains, expected %d" count distinct
+      count;
+  ok "%d blocking tasks ran concurrently on %d domains" count distinct
+
+let test_batch () =
+  let s = Duppy.create ~classify () in
+  let l = latch () in
+  let count = 32 in
+  let domains = Array.make count (-1) in
+  for i = 0 to count - 1 do
+    Duppy.Task.add s
+      (task Immediate (fun _ ->
+           domains.(i) <- domain_id ();
+           bump l;
+           []))
+  done;
+  Duppy.start ~domains:4 s;
+  await l count;
+  Duppy.stop s;
+  let distinct = ran_on domains in
+  if distinct <> 1 then
+    fail "%d immediate tasks spread over %d domains, they were not batched"
+      count distinct;
+  ok "%d immediate tasks ran as one batch" count
+
+let test_io () =
+  let s = Duppy.create ~classify () in
+  let l = latch () in
+  let r, w = Unix.pipe () in
+  Duppy.Task.add s
+    {
+      Duppy.Task.priority = Blocking;
+      events = [`Read r];
+      handler =
+        (fun _ ->
+          ignore (Unix.read r (Bytes.create 4) 0 4);
+          bump l;
+          []);
+    };
+  Duppy.start ~domains:2 s;
+  ignore (Unix.write w (Bytes.of_string "ping") 0 4);
+  await l 1;
+  Duppy.stop s;
+  Unix.close r;
+  Unix.close w;
+  ok "the event loop delivered a socket event"
+
+(* A task that never returns must not keep [stop] from returning: it parks in a
+   syscall on a descriptor the loop has dropped, and stopping joins its domain. *)
+let test_stop_with_stuck_task () =
+  let s = Duppy.create ~classify () in
+  let started = latch () in
+  let release = Atomic.make false in
+  Duppy.Task.add s
+    (task Blocking (fun _ ->
+         bump started;
+         while not (Atomic.get release) do
+           Thread.delay 0.01
+         done;
+         []));
+  Duppy.start ~domains:2 s;
+  await started 1;
+  let t0 = Unix.gettimeofday () in
+  Duppy.stop s;
+  let elapsed = Unix.gettimeofday () -. t0 in
+  Atomic.set release true;
+  if elapsed > 30. then fail "stop took %.1fs with a stuck task" elapsed;
+  ok "stop returned in %.1fs despite a stuck task" elapsed
+
+(* With nothing to wait for, the loop must still come back on its own: a
+   wake-up is a byte on a socket whose writer drops it when the buffer is full,
+   so a loop that only ever leaves on one can miss [stopped] for good. *)
+let test_idle_loop_wakes_itself () =
+  let s = Duppy.create ~classify () in
+  let wakes = Atomic.make 0 in
+  let log m =
+    if String.length m >= 4 && String.sub m 0 4 = "Woke" then
+      ignore (Atomic.fetch_and_add wakes 1)
+  in
+  Duppy.start ~domains:1 ~log s;
+  Thread.delay 2.5;
+  let n = Atomic.get wakes in
+  Duppy.stop s;
+  if n < 2 then fail "idle loop came back %d times in 2.5s" n;
+  ok "idle loop came back on its own %d times in 2.5s" n
+
+(* A task is free to start a thread that outlives it, which is what a binding
+   logging from its own thread does. That thread belongs to the domain that ran
+   the task, and a domain does not terminate until its threads have, so
+   stopping must not wait on one. *)
+let test_stop_with_thread_outliving_its_task () =
+  let s = Duppy.create ~classify () in
+  let started = latch () in
+  let release = Atomic.make false in
+  Duppy.Task.add s
+    (task Blocking (fun _ ->
+         ignore
+           (Thread.create
+              (fun () ->
+                while not (Atomic.get release) do
+                  Thread.delay 0.01
+                done)
+              ());
+         bump started;
+         []));
+  Duppy.start ~domains:2 s;
+  await started 1;
+  Thread.delay 0.2;
+  let t0 = Unix.gettimeofday () in
+  Duppy.stop s;
+  let elapsed = Unix.gettimeofday () -. t0 in
+  Atomic.set release true;
+  if elapsed > 30. then
+    fail "stop took %.1fs with a thread outliving its task" elapsed;
+  ok "stop returned in %.1fs with a thread pinning a domain" elapsed
+
+let test_stop_drains () =
+  let count = 8 in
+  for _ = 1 to 5 do
+    let s = Duppy.create ~classify () in
+    let started = latch () in
+    let finished = latch () in
+    for _ = 1 to count do
+      Duppy.Task.add s
+        (task Blocking (fun _ ->
+             bump started;
+             Thread.delay 0.1;
+             bump finished;
+             []))
+    done;
+    Duppy.start ~domains:4 s;
+    await started count;
+    Duppy.stop s;
+    let done_ = Atomic.get finished.n in
+    if done_ < count then
+      fail "stop returned with %d of %d tasks still running" (count - done_)
+        count
+  done;
+  ok "stop drained %d running tasks, 5 times over" count
+
+(* With every worker at its cap, the slot freed by a finishing task has to
+   reach the worker that freed it, or the remaining tasks never get picked up. *)
+let test_blocking_cap () =
+  let s = Duppy.create ~classify () in
+  let l = latch () in
+  let count = 24 in
+  for _ = 1 to count do
+    Duppy.Task.add s
+      (task Blocking (fun _ ->
+           Thread.delay 0.05;
+           bump l;
+           []))
+  done;
+  Duppy.start ~domains:4 ~max_blocking:4 s;
+  await l count;
+  Duppy.stop s;
+  ok "%d blocking tasks all ran with only 4 slots" count
+
+(* A computation started here parks on the pool and resumes on one of its
+   domains, so the two halves never run on the same one. *)
+let test_effect_resumes_elsewhere () =
+  let s = Duppy.create ~classify () in
+  Duppy.start ~domains:2 s;
+  let l = latch () in
+  let before = ref (-1) in
+  let after = ref (-1) in
+  let r, w = Unix.pipe () in
+  Duppy.run (fun () ->
+      before := domain_id ();
+      let events = Duppy.await ~priority:Blocking s [`Read r] in
+      if events <> [`Read r] then fail "await returned the wrong events";
+      ignore (Unix.read r (Bytes.create 4) 0 4);
+      after := domain_id ();
+      bump l);
+  if !after <> -1 then fail "await did not park the computation";
+  ignore (Unix.write w (Bytes.of_string "ping") 0 4);
+  await l 1;
+  Duppy.stop s;
+  Unix.close r;
+  Unix.close w;
+  if !before = !after then
+    fail "computation resumed on its starting domain %d" !before;
+  ok "computation started on domain %d and resumed on %d" !before !after
+
+let test_effect_raises_to_on_error () =
+  let caught = Atomic.make None in
+  let s =
+    Duppy.create ~classify
+      ~on_error:(fun exn _ -> Atomic.set caught (Some exn))
+      ()
+  in
+  Duppy.start ~domains:2 s;
+  let l = latch () in
+  Duppy.run (fun () ->
+      Duppy.reschedule ~priority:Blocking s;
+      bump l;
+      raise Exit);
+  await l 1;
+  Duppy.stop s;
+  match Atomic.get caught with
+    | Some Exit -> ok "an exception after resuming reached on_error"
+    | Some e -> fail "on_error saw %s, expected Exit" (Printexc.to_string e)
+    | None -> fail "an exception after resuming reached nobody"
+
+let test_await_outside_run () =
+  let s = Duppy.create ~classify () in
+  match Duppy.await ~priority:Blocking s [`Delay 0.] with
+    | _ -> fail "await outside run returned instead of raising"
+    | exception Effect.Unhandled _ ->
+        ok "await outside run raises Effect.Unhandled"
+
+(* A lone worker facing a ready list that refills as fast as it drains must
+   still dispatch the other class. *)
+let test_no_starvation () =
+  let s = Duppy.create ~classify () in
+  let stop = Atomic.make false in
+  let blocking_ran = Atomic.make false in
+  let l = latch () in
+  let rec churn _ =
+    if Atomic.get stop then []
+    else
+      [
+        {
+          Duppy.Task.priority = Immediate;
+          events = [`Delay (-1.)];
+          handler = churn;
+        };
+      ]
+  in
+  for _ = 1 to 20 do
+    Duppy.Task.add s (task Immediate churn)
+  done;
+  Duppy.Task.add s
+    (task Blocking (fun _ ->
+         Atomic.set blocking_ran true;
+         bump l;
+         []));
+  Duppy.start ~domains:1 s;
+  await l 1;
+  Atomic.set stop true;
+  Duppy.stop s;
+  if not (Atomic.get blocking_ran) then
+    fail "a flood of immediate tasks starved the blocking one";
+  ok "one worker dispatched blocking work under an immediate flood"
+
+let () =
+  watchdog 60.;
+  test_parallel ();
+  test_batch ();
+  test_io ();
+  test_blocking_cap ();
+  test_stop_drains ();
+  test_stop_with_thread_outliving_its_task ();
+  test_idle_loop_wakes_itself ();
+  test_stop_with_stuck_task ();
+  test_effect_resumes_elsewhere ();
+  test_effect_raises_to_on_error ();
+  test_await_outside_run ();
+  test_no_starvation ();
+  print_endline "all duppy pool checks passed"
diff --git a/src/modules/stdlib-utils/dune b/src/modules/stdlib-utils/dune
index 61d37ff07a..078dbe2663 100644
--- a/src/modules/stdlib-utils/dune
+++ b/src/modules/stdlib-utils/dune
@@ -4,5 +4,5 @@
  (wrapped false)
  (foreign_stubs
   (language c)
-  (names unix_utils_stubs))
+  (names unix_utils_stubs pollset_stubs))
  (synopsis "Stdlib utilities"))
diff --git a/src/modules/stdlib-utils/pollset.ml b/src/modules/stdlib-utils/pollset.ml
new file mode 100644
index 0000000000..086d6d6dc3
--- /dev/null
+++ b/src/modules/stdlib-utils/pollset.ml
@@ -0,0 +1,124 @@
+(*****************************************************************************
+
+  Liquidsoap, a programmable stream generator.
+  Copyright 2003-2026 Savonet team
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details, fully stated in the COPYING
+  file at the root of the liquidsoap distribution.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
+
+ *****************************************************************************)
+
+type interest = { read : bool; write : bool; except : bool }
+
+external available : unit -> bool = "caml_pollset_available"
+external backend_name : unit -> string = "caml_pollset_backend_name"
+external native_create : unit -> Unix.file_descr = "caml_pollset_create"
+
+external native_set : Unix.file_descr -> Unix.file_descr -> bool -> bool -> unit
+  = "caml_pollset_set"
+
+external native_remove : Unix.file_descr -> Unix.file_descr -> unit
+  = "caml_pollset_remove"
+
+external native_wait : Unix.file_descr -> float -> (Unix.file_descr * int) array
+  = "caml_pollset_wait"
+
+type impl = Native of Unix.file_descr | Select
+
+type t = {
+  mutex : Mutex.t;
+  registry : (Unix.file_descr, interest) Hashtbl.t;
+  impl : impl;
+}
+
+let read_flag = 1
+let write_flag = 2
+let except_flag = 4
+
+let interest_of_flags flags =
+  {
+    read = flags land read_flag <> 0;
+    write = flags land write_flag <> 0;
+    except = flags land except_flag <> 0;
+  }
+
+(* Setting LIQ_POLLSET_BACKEND=select forces the fallback, so the platform that
+   only has it is not the only place it runs. *)
+let forced_select () = Sys.getenv_opt "LIQ_POLLSET_BACKEND" = Some "select"
+
+let create () =
+  let impl =
+    if available () && not (forced_select ()) then Native (native_create ())
+    else Select
+  in
+  { mutex = Mutex.create (); registry = Hashtbl.create 64; impl }
+
+let backend t =
+  match t.impl with Native _ -> backend_name () | Select -> "select"
+
+let close t =
+  Mutex.protect t.mutex (fun () ->
+      Hashtbl.reset t.registry;
+      match t.impl with
+        | Native set -> ( try Unix.close set with _ -> ())
+        | Select -> ())
+
+let set t fd interest =
+  Mutex.protect t.mutex (fun () ->
+      Hashtbl.replace t.registry fd interest;
+      match t.impl with
+        | Native set -> native_set set fd interest.read interest.write
+        | Select -> ())
+
+let remove t fd =
+  Mutex.protect t.mutex (fun () ->
+      Hashtbl.remove t.registry fd;
+      match t.impl with Native set -> native_remove set fd | Select -> ())
+
+let mem t fd = Mutex.protect t.mutex (fun () -> Hashtbl.mem t.registry fd)
+
+(* Building the lists under the lock and releasing it before the syscall means a
+   registration made while we wait lands on the next round, which is what the
+   caller's wake-up descriptor is for. *)
+let select_wait t timeout =
+  let r, w, x =
+    Mutex.protect t.mutex (fun () ->
+        Hashtbl.fold
+          (fun fd interest (r, w, x) ->
+            ( (if interest.read then fd :: r else r),
+              (if interest.write then fd :: w else w),
+              if interest.except then fd :: x else x ))
+          t.registry ([], [], []))
+  in
+  let r, w, x = Unix_utils.select r w x timeout in
+  let fired = Hashtbl.create 16 in
+  let add flag fd =
+    let flags = try Hashtbl.find fired fd with Not_found -> 0 in
+    Hashtbl.replace fired fd (flags lor flag)
+  in
+  List.iter (add read_flag) r;
+  List.iter (add write_flag) w;
+  List.iter (add except_flag) x;
+  Hashtbl.fold
+    (fun fd flags acc -> (fd, interest_of_flags flags) :: acc)
+    fired []
+
+let wait t ~timeout =
+  match t.impl with
+    | Native set ->
+        Array.fold_left
+          (fun acc (fd, flags) -> (fd, interest_of_flags flags) :: acc)
+          [] (native_wait set timeout)
+    | Select -> select_wait t timeout
diff --git a/src/modules/stdlib-utils/pollset.mli b/src/modules/stdlib-utils/pollset.mli
new file mode 100644
index 0000000000..dcb88cd875
--- /dev/null
+++ b/src/modules/stdlib-utils/pollset.mli
@@ -0,0 +1,60 @@
+(*****************************************************************************
+
+  Liquidsoap, a programmable stream generator.
+  Copyright 2003-2026 Savonet team
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details, fully stated in the COPYING
+  file at the root of the liquidsoap distribution.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
+
+ *****************************************************************************)
+
+(** A set of file descriptors watched for readiness, kept across waits.
+
+    [epoll] on Linux and [kqueue] on BSD hold the registration in the kernel and
+    report only what fired, so a wait costs what is ready rather than what is
+    watched. Elsewhere this falls back to [select], which does not, and the only
+    gain is that callers need not know which they got. *)
+type t
+
+(** What a descriptor is watched for, and what a wait reports about it. Errors
+    and hangups are reported whether or not [except] was asked for. *)
+type interest = { read : bool; write : bool; except : bool }
+
+val create : unit -> t
+val close : t -> unit
+
+(** The mechanism in use, for logs. Setting [LIQ_POLLSET_BACKEND=select] forces
+    the fallback, so it can be exercised where the native mechanisms exist. *)
+val backend : t -> string
+
+(** [set t fd i] watches [fd] for [i], replacing what it was watched for.
+    Watching for neither reading nor writing leaves it watched for errors alone.
+*)
+val set : t -> Unix.file_descr -> interest -> unit
+
+(** Descriptors that were never added, and ones already closed, are accepted and
+    ignored: a closed descriptor leaves the kernel's set on its own, and the
+    caller cannot always tell that it has. *)
+val remove : t -> Unix.file_descr -> unit
+
+val mem : t -> Unix.file_descr -> bool
+
+(** [wait t ~timeout] blocks until a descriptor is ready or [timeout] seconds
+    pass, and reports what fired for each. A negative [timeout] waits
+    indefinitely, [0.] polls.
+
+    Readiness is level-triggered on every backend: a descriptor that stays ready
+    is reported by every wait until it is drained or removed. *)
+val wait : t -> timeout:float -> (Unix.file_descr * interest) list
diff --git a/src/modules/stdlib-utils/pollset_stubs.c b/src/modules/stdlib-utils/pollset_stubs.c
new file mode 100644
index 0000000000..8df6b8ffd7
--- /dev/null
+++ b/src/modules/stdlib-utils/pollset_stubs.c
@@ -0,0 +1,259 @@
+/*
+ * Copyright 2003-2026 Savonet team
+ *
+ * This file is part of Liquidsoap.
+ *
+ * Liquidsoap is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * Liquidsoap is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details, fully stated in the COPYING
+ * file at the root of the liquidsoap distribution.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Liquidsoap; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+#include <caml/threads.h>
+#include <caml/unixsupport.h>
+
+#include <errno.h>
+#include <string.h>
+
+#define POLLSET_READ 1
+#define POLLSET_WRITE 2
+#define POLLSET_EXCEPT 4
+#define POLLSET_MAX_EVENTS 512
+
+typedef struct {
+  int fd;
+  int flags;
+} pollset_event;
+
+/* Each platform supplies these five, and the entry points below are written
+   once against them. A descriptor closed by its owner leaves the kernel's set
+   on its own, so removing what is not there is not an error. */
+
+#if defined(__linux__)
+
+#include <sys/epoll.h>
+
+static const char *pollset_backend = "epoll";
+static const int pollset_has_backend = 1;
+
+static int pollset_create(void) { return epoll_create1(EPOLL_CLOEXEC); }
+
+static int pollset_set(int set, int fd, int read, int write) {
+  struct epoll_event ev;
+  memset(&ev, 0, sizeof(ev));
+  if (read)
+    ev.events |= EPOLLIN;
+  if (write)
+    ev.events |= EPOLLOUT;
+  ev.data.fd = fd;
+
+  if (epoll_ctl(set, EPOLL_CTL_MOD, fd, &ev) == 0)
+    return 0;
+  if (errno != ENOENT)
+    return -1;
+  return epoll_ctl(set, EPOLL_CTL_ADD, fd, &ev);
+}
+
+static int pollset_remove(int set, int fd) {
+  if (epoll_ctl(set, EPOLL_CTL_DEL, fd, NULL) == 0)
+    return 0;
+  return (errno == ENOENT || errno == EBADF || errno == EPERM) ? 0 : -1;
+}
+
+static int pollset_wait(int set, double timeout, pollset_event *out, int max) {
+  struct epoll_event evs[POLLSET_MAX_EVENTS];
+  int ms = timeout < 0 ? -1 : (int)(timeout * 1e3);
+  int n, i;
+
+  n = epoll_wait(set, evs, max, ms);
+  if (n < 0)
+    return n;
+
+  for (i = 0; i < n; i++) {
+    out[i].fd = evs[i].data.fd;
+    out[i].flags = 0;
+    if (evs[i].events & EPOLLIN)
+      out[i].flags |= POLLSET_READ;
+    if (evs[i].events & EPOLLOUT)
+      out[i].flags |= POLLSET_WRITE;
+    if (evs[i].events & (EPOLLERR | EPOLLHUP))
+      out[i].flags |= POLLSET_EXCEPT;
+  }
+  return n;
+}
+
+#elif defined(__APPLE__) || defined(__FreeBSD__) || defined(__OpenBSD__) ||    \
+    defined(__NetBSD__) || defined(__DragonFly__)
+
+#include <sys/event.h>
+#include <sys/time.h>
+#include <sys/types.h>
+
+static const char *pollset_backend = "kqueue";
+static const int pollset_has_backend = 1;
+
+static int pollset_create(void) { return kqueue(); }
+
+static int pollset_filter(int set, int fd, int filter, int enable) {
+  struct kevent ch;
+  EV_SET(&ch, fd, filter, enable ? EV_ADD : EV_DELETE, 0, 0, NULL);
+  if (kevent(set, &ch, 1, NULL, 0, NULL) == 0)
+    return 0;
+  return (errno == ENOENT || errno == EBADF) ? 0 : -1;
+}
+
+static int pollset_set(int set, int fd, int read, int write) {
+  if (pollset_filter(set, fd, EVFILT_READ, read) == -1)
+    return -1;
+  return pollset_filter(set, fd, EVFILT_WRITE, write);
+}
+
+static int pollset_remove(int set, int fd) {
+  if (pollset_filter(set, fd, EVFILT_READ, 0) == -1)
+    return -1;
+  return pollset_filter(set, fd, EVFILT_WRITE, 0);
+}
+
+static int pollset_wait(int set, double timeout, pollset_event *out, int max) {
+  struct kevent evs[POLLSET_MAX_EVENTS];
+  struct timespec ts;
+  struct timespec *tsp = NULL;
+  int n, i;
+
+  if (timeout >= 0) {
+    ts.tv_sec = (time_t)timeout;
+    ts.tv_nsec = (long)((timeout - (double)ts.tv_sec) * 1e9);
+    tsp = &ts;
+  }
+
+  n = kevent(set, NULL, 0, evs, max, tsp);
+  if (n < 0)
+    return n;
+
+  for (i = 0; i < n; i++) {
+    out[i].fd = (int)evs[i].ident;
+    out[i].flags = 0;
+    if (evs[i].filter == EVFILT_READ)
+      out[i].flags |= POLLSET_READ;
+    if (evs[i].filter == EVFILT_WRITE)
+      out[i].flags |= POLLSET_WRITE;
+    if (evs[i].flags & (EV_ERROR | EV_EOF))
+      out[i].flags |= POLLSET_EXCEPT;
+  }
+  return n;
+}
+
+#else
+
+static const char *pollset_backend = "select";
+static const int pollset_has_backend = 0;
+
+static int pollset_unsupported(void) {
+  errno = ENOSYS;
+  return -1;
+}
+
+static int pollset_create(void) { return pollset_unsupported(); }
+
+static int pollset_set(int set, int fd, int read, int write) {
+  (void)set;
+  (void)fd;
+  (void)read;
+  (void)write;
+  return pollset_unsupported();
+}
+
+static int pollset_remove(int set, int fd) {
+  (void)set;
+  (void)fd;
+  return pollset_unsupported();
+}
+
+static int pollset_wait(int set, double timeout, pollset_event *out, int max) {
+  (void)set;
+  (void)timeout;
+  (void)out;
+  (void)max;
+  return pollset_unsupported();
+}
+
+#endif
+
+CAMLprim value caml_pollset_available(value unit) {
+  (void)unit;
+  return Val_bool(pollset_has_backend);
+}
+
+CAMLprim value caml_pollset_backend_name(value unit) {
+  (void)unit;
+  return caml_copy_string(pollset_backend);
+}
+
+CAMLprim value caml_pollset_create(value unit) {
+  int fd = pollset_create();
+  (void)unit;
+  if (fd == -1)
+    caml_uerror("pollset_create", Nothing);
+  return Val_int(fd);
+}
+
+CAMLprim value caml_pollset_set(value _set, value _fd, value _read,
+                                value _write) {
+  if (pollset_set(Int_val(_set), Int_val(_fd), Bool_val(_read),
+                  Bool_val(_write)) == -1)
+    caml_uerror("pollset_set", Nothing);
+  return Val_unit;
+}
+
+CAMLprim value caml_pollset_remove(value _set, value _fd) {
+  if (pollset_remove(Int_val(_set), Int_val(_fd)) == -1)
+    caml_uerror("pollset_remove", Nothing);
+  return Val_unit;
+}
+
+CAMLprim value caml_pollset_wait(value _set, value _timeout) {
+  CAMLparam2(_set, _timeout);
+  CAMLlocal2(ret, pair);
+  pollset_event evs[POLLSET_MAX_EVENTS];
+  int set = Int_val(_set);
+  double timeout = Double_val(_timeout);
+  int n, i;
+
+  caml_release_runtime_system();
+  n = pollset_wait(set, timeout, evs, POLLSET_MAX_EVENTS);
+  while (n == -1 && errno == EINTR) {
+    caml_acquire_runtime_system();
+    caml_process_pending_actions();
+    caml_release_runtime_system();
+    n = pollset_wait(set, timeout, evs, POLLSET_MAX_EVENTS);
+  }
+  caml_acquire_runtime_system();
+
+  if (n == -1)
+    caml_uerror("pollset_wait", Nothing);
+
+  ret = caml_alloc(n, 0);
+  for (i = 0; i < n; i++) {
+    pair = caml_alloc_tuple(2);
+    Store_field(pair, 0, Val_int(evs[i].fd));
+    Store_field(pair, 1, Val_int(evs[i].flags));
+    Store_field(ret, i, pair);
+  }
+
+  CAMLreturn(ret);
+}
diff --git a/src/modules/stdlib-utils/test/dune b/src/modules/stdlib-utils/test/dune
new file mode 100644
index 0000000000..f4b755fc75
--- /dev/null
+++ b/src/modules/stdlib-utils/test/dune
@@ -0,0 +1,13 @@
+(executables
+ (names test_pollset pollcost)
+ (libraries stdlib_utils unix threads.posix))
+
+(rule
+ (alias citest)
+ (action
+  (run ./test_pollset.exe)))
+
+(rule
+ (alias bench)
+ (action
+  (run ./pollcost.exe)))
diff --git a/src/modules/stdlib-utils/test/pollcost.ml b/src/modules/stdlib-utils/test/pollcost.ml
new file mode 100644
index 0000000000..a762dc6258
--- /dev/null
+++ b/src/modules/stdlib-utils/test/pollcost.ml
@@ -0,0 +1,73 @@
+(* Splits one event-loop iteration into its two costs: the poll syscall over N
+   registered sockets, and the OCaml-side rebuild of the fd sets and readiness
+   test over N waiting tasks. *)
+
+let bench name n fn =
+  let rounds = 200 in
+  let start = Unix.gettimeofday () in
+  for _ = 1 to rounds do
+    fn ()
+  done;
+  let us = (Unix.gettimeofday () -. start) *. 1e6 /. float_of_int rounds in
+  Printf.printf "  %-28s n=%-5d %7.1f us\n%!" name n us
+
+type e = { r : Unix.file_descr list; t : float }
+
+let () =
+  let counts = [0; 100; 500; 1000; 2000; 4000] in
+  let socks =
+    List.map
+      (fun _ ->
+        let a, b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
+        ignore b;
+        a)
+      (List.init (List.hd (List.rev counts)) (fun i -> i))
+  in
+  let wake_r, _wake_w = Unix.pipe () in
+  List.iter
+    (fun n ->
+      let fds = List.filteri (fun i _ -> i < n) socks in
+      (* The syscall alone, with the fd list already built. *)
+      let all = wake_r :: fds in
+      bench "poll syscall" n (fun () -> ignore (Unix_utils.poll all [] [] 0.));
+      let ps = Pollset.create () in
+      List.iter
+        (fun fd ->
+          Pollset.set ps fd
+            { Pollset.read = true; write = false; except = false })
+        all;
+      bench "Pollset.wait" n (fun () -> ignore (Pollset.wait ps ~timeout:0.));
+      Pollset.close ps;
+      (* What duppy does around it: fold every task to build the event set,
+         then test every task against the result. *)
+      let tasks =
+        List.map
+          (fun fd ->
+            let enrich e = { e with r = fd :: e.r } in
+            let is_ready e = if List.mem fd e.r then Some () else None in
+            (enrich, is_ready))
+          fds
+      in
+      (* [is_ready] is tested against what poll returned, which is empty while
+         the sockets stay quiet, not against the set that was submitted. *)
+      let fired = { r = []; t = 0. } in
+      bench "enrich fold (build set)" n (fun () ->
+          let e =
+            List.fold_left
+              (fun e (enrich, _) -> enrich e)
+              { r = [wake_r]; t = infinity }
+              tasks
+          in
+          ignore (List.length e.r));
+      bench "is_ready fold (dispatch)" n (fun () ->
+          let ready, waiting =
+            List.fold_left
+              (fun (ready, waiting) (_, is_ready) ->
+                match is_ready fired with
+                  | Some () -> (() :: ready, waiting)
+                  | None -> (ready, () :: waiting))
+              ([], []) tasks
+          in
+          ignore (List.length ready + List.length waiting));
+      print_newline ())
+    counts
diff --git a/src/modules/stdlib-utils/test/test_pollset.ml b/src/modules/stdlib-utils/test/test_pollset.ml
new file mode 100644
index 0000000000..9648d66fdc
--- /dev/null
+++ b/src/modules/stdlib-utils/test/test_pollset.ml
@@ -0,0 +1,140 @@
+(*****************************************************************************
+
+  Liquidsoap, a programmable stream generator.
+  Copyright 2003-2026 Savonet team
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details, fully stated in the COPYING
+  file at the root of the liquidsoap distribution.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
+
+ *****************************************************************************)
+
+let fail fmt =
+  Printf.ksprintf
+    (fun s ->
+      prerr_endline ("FAIL: " ^ s);
+      exit 1)
+    fmt
+
+let ok fmt = Printf.ksprintf (fun s -> print_endline ("ok: " ^ s)) fmt
+let r = { Pollset.read = true; write = false; except = false }
+let w = { Pollset.read = false; write = true; except = false }
+let pair () = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0
+let poke fd = ignore (Unix.write fd (Bytes.of_string "x") 0 1)
+
+let test_registry () =
+  let t = Pollset.create () in
+  let a, b = pair () in
+  if Pollset.mem t a then fail "an unregistered descriptor was reported present";
+  Pollset.set t a r;
+  if not (Pollset.mem t a) then fail "a registered descriptor was not present";
+  Pollset.remove t a;
+  if Pollset.mem t a then fail "a removed descriptor was still present";
+  Pollset.remove t a;
+  Pollset.close t;
+  List.iter Unix.close [a; b];
+  ok "set, mem and remove agree, and removing twice is accepted"
+
+let test_readiness () =
+  let t = Pollset.create () in
+  let a, b = pair () in
+  let c, d = pair () in
+  Pollset.set t a r;
+  Pollset.set t c r;
+  if Pollset.wait t ~timeout:0. <> [] then
+    fail "quiet descriptors were reported";
+  poke b;
+  (match Pollset.wait t ~timeout:1. with
+    | [(fd, i)] when fd = a && i.Pollset.read -> ()
+    | l -> fail "expected only the poked descriptor, got %d" (List.length l));
+  Pollset.close t;
+  List.iter Unix.close [a; b; c; d];
+  ok "a ready descriptor is reported and a quiet one is not"
+
+(* The property the kernel-side set exists for: what a wait costs should follow
+   what is ready, not what is watched. *)
+let test_one_of_many () =
+  let t = Pollset.create () in
+  let n = 500 in
+  let socks = List.init n (fun _ -> pair ()) in
+  List.iter (fun (a, _) -> Pollset.set t a r) socks;
+  let target, peer = List.nth socks (n / 2) in
+  poke peer;
+  (match Pollset.wait t ~timeout:1. with
+    | [(fd, _)] when fd = target -> ()
+    | l ->
+        fail "with %d watched and one ready, wait returned %d" n (List.length l));
+  Pollset.close t;
+  List.iter
+    (fun (a, b) ->
+      Unix.close a;
+      Unix.close b)
+    socks;
+  ok "with %d watched and one ready, wait returned exactly that one" n
+
+let test_write_and_timeout () =
+  let t = Pollset.create () in
+  let a, b = pair () in
+  Pollset.set t a w;
+  (match Pollset.wait t ~timeout:1. with
+    | [(fd, i)] when fd = a && i.Pollset.write -> ()
+    | _ -> fail "a writable socket was not reported writable");
+  Pollset.set t a r;
+  let start = Unix.gettimeofday () in
+  if Pollset.wait t ~timeout:0.2 <> [] then
+    fail "a quiet wait reported something";
+  let waited = Unix.gettimeofday () -. start in
+  if waited < 0.15 then
+    fail "wait returned after %.3fs, before its timeout" waited;
+  Pollset.close t;
+  List.iter Unix.close [a; b];
+  ok "write readiness is reported and a timeout is honoured"
+
+let test_level_triggered () =
+  let t = Pollset.create () in
+  let a, b = pair () in
+  Pollset.set t a r;
+  poke b;
+  if List.length (Pollset.wait t ~timeout:1.) <> 1 then
+    fail "first wait missed it";
+  if List.length (Pollset.wait t ~timeout:0.) <> 1 then
+    fail "undrained data was reported once only, which is edge-triggered";
+  ignore (Unix.read a (Bytes.create 1) 0 1);
+  if Pollset.wait t ~timeout:0. <> [] then
+    fail "drained data was still reported";
+  Pollset.close t;
+  List.iter Unix.close [a; b];
+  ok "readiness is level-triggered"
+
+let test_peer_close () =
+  let t = Pollset.create () in
+  let a, b = pair () in
+  Pollset.set t a r;
+  Unix.close b;
+  (match Pollset.wait t ~timeout:1. with
+    | [(fd, _)] when fd = a -> ()
+    | _ -> fail "a closed peer was not reported");
+  Pollset.close t;
+  Unix.close a;
+  ok "a closed peer is reported"
+
+let () =
+  Printf.printf "backend: %s\n%!" (Pollset.backend (Pollset.create ()));
+  test_registry ();
+  test_readiness ();
+  test_one_of_many ();
+  test_write_and_timeout ();
+  test_level_triggered ();
+  test_peer_close ();
+  print_endline "all pollset checks passed"
diff --git a/src/modules/synced/lo/src/lo_stubs.c b/src/modules/synced/lo/src/lo_stubs.c
index cc1b3da332..c1421d4f3c 100644
--- a/src/modules/synced/lo/src/lo_stubs.c
+++ b/src/modules/synced/lo/src/lo_stubs.c
@@ -149,17 +149,14 @@ static void error_msg(int num, const char *msg, const char *path) {
   fprintf(stderr, "liblo server error %d in path %s: %s\n", num, path, msg);
 }
 
-static int generic_handler(const char *path, const char *types, lo_arg **argv,
-                           int argc, lo_message msg, void *user_data) {
-  server_t *s = (server_t *)user_data;
+/* The roots are the runtime's to unwind: an unhandled type raises out of here,
+   and so may the handler, which would leave a root pointing into this frame
+   long after it is gone. */
+static void generic_handler_locked(server_t *s, const char *path,
+                                   const char *types, lo_arg **argv, int argc) {
+  CAMLparam0();
+  CAMLlocal2(arg, v);
   int i;
-  value arg = 0;
-  value v = 0;
-
-  caml_leave_blocking_section();
-
-  caml_register_global_root(&arg);
-  caml_register_global_root(&v);
 
   arg = caml_alloc_tuple(argc);
 
@@ -222,9 +219,15 @@ static int generic_handler(const char *path, const char *types, lo_arg **argv,
 
   caml_callback2(s->handler, caml_copy_string(path), arg);
 
-  caml_remove_global_root(&v);
-  caml_remove_global_root(&arg);
+  CAMLreturn0;
+}
+
+static int generic_handler(const char *path, const char *types, lo_arg **argv,
+                           int argc, lo_message msg, void *user_data) {
+  server_t *s = (server_t *)user_data;
 
+  caml_leave_blocking_section();
+  generic_handler_locked(s, path, types, argv, argc);
   caml_enter_blocking_section();
 
   return 0;
diff --git a/src/modules/synced/mm/src/image.mli b/src/modules/synced/mm/src/image.mli
index c29fb4d650..ca5107264b 100644
--- a/src/modules/synced/mm/src/image.mli
+++ b/src/modules/synced/mm/src/image.mli
@@ -101,6 +101,14 @@ module Bitmap : sig
   val set_pixel : t -> int -> int -> bool -> unit
   val scale : t -> t -> unit
 
+  (** What [Font.Make] needs of a suspension. *)
+  module type Lazy_t = sig
+    type 'a t
+
+    val from_fun : (unit -> 'a) -> 'a t
+    val force : 'a t -> 'a
+  end
+
   (** Operations on bitmap fonts. *)
   module Font : sig
     (** A font. *)
@@ -115,6 +123,16 @@ module Bitmap : sig
     (** Render text with given font, at given size (height of characters in
         pixels). *)
     val render : ?font:t -> ?size:int -> string -> bitmap
+
+    (** The character map is built on first use, so a program sharing a font
+        across domains instantiates this with a suspension of its own. *)
+    module Make (Lazy : Lazy_t) : sig
+      type t
+
+      val native : t
+      val height : t -> int
+      val render : ?font:t -> ?size:int -> string -> bitmap
+    end
   end
 end
 
diff --git a/src/modules/synced/mm/src/imageBitmap.ml b/src/modules/synced/mm/src/imageBitmap.ml
index 9f82a5a8bf..c4a3eb7718 100644
--- a/src/modules/synced/mm/src/imageBitmap.ml
+++ b/src/modules/synced/mm/src/imageBitmap.ml
@@ -75,8 +75,16 @@ let blit src ?(x = 0) ?(y = 0) dst =
     done
   done
 
-(** Bitmap fonts. *)
-module Font = struct
+(** What [Font.Make] needs of a suspension: enough to defer building the
+    character map. *)
+module type Lazy_t = sig
+  type 'a t
+
+  val from_fun : (unit -> 'a) -> 'a t
+  val force : 'a t -> 'a
+end
+
+module Font_make (Lazy : Lazy_t) = struct
   module CharMap = Map.Make (struct
     type t = char
 
@@ -216,3 +224,9 @@ module Font = struct
     done;
     rescale height font.height img
 end
+
+(** Bitmap fonts. *)
+module Font = struct
+  module Make = Font_make
+  include Font_make (Stdlib.Lazy)
+end
diff --git a/tests/language/ref.liq b/tests/language/ref.liq
index 32be9b418b..1c658b57aa 100644
--- a/tests/language/ref.liq
+++ b/tests/language/ref.liq
@@ -17,8 +17,9 @@ def f() =
   test.equal(s(), "b")
   f = ref(id)
   f := incr
-  r = ref.make({0}, fun (x) -> ignore(x + 1))
-  _ = ref.map(float_of_int, int_of_float, r)
+  b = ref(false)
+  test.equal(b.exchange(true), false)
+  test.equal(b.exchange(true), true)
   test.pass()
 end
 
diff --git a/tests/regression/callback_from_task.liq b/tests/regression/callback_from_task.liq
new file mode 100644
index 0000000000..d9839ac565
--- /dev/null
+++ b/tests/regression/callback_from_task.liq
@@ -0,0 +1,14 @@
+# Script code runs on scheduler tasks, and registering a callback there goes
+# through an effect whose handler does not cross the thread it is dispatched to.
+s = sine()
+output.dummy(s)
+
+thread.run(
+  delay=0.5,
+  fun () ->
+    begin
+      s.on_metadata(synchronous=false, fun (_) -> ())
+      ignore(s.on_track(synchronous=true, fun (_) -> ()))
+      test.pass()
+    end
+)
diff --git a/tests/regression/dune.inc b/tests/regression/dune.inc
index bcd47004ad..fcb6accf5f 100644
--- a/tests/regression/dune.inc
+++ b/tests/regression/dune.inc
@@ -1544,6 +1544,29 @@
    %{test_liq}
    callback_counts.liq)))
 
+(rule
+ (alias test_callback_from_task)
+ (package liquidsoap)
+ (deps
+  callback_from_task.liq
+  (glob_files ../media/**)
+  ../liquidsoap-test-assets
+  ../../src/bin/liquidsoap.exe
+  ../streams/file1.png
+  ../streams/file1.mp3
+  ./theora-test.mp4
+  (package liquidsoap)
+  (source_tree ../../src/libs)
+  (:test_liq ../test.liq)
+  (:run_test ../run_test.exe))
+ (action
+  (run
+   %{run_test}
+   callback_from_task
+   liquidsoap
+   %{test_liq}
+   callback_from_task.liq)))
+
 (rule
  (alias test_callback_release)
  (package liquidsoap)
@@ -1895,6 +1918,29 @@
    %{test_liq}
    ffmpeg_seek_preroll.liq)))
 
+(rule
+ (alias test_harbor_source_relay)
+ (package liquidsoap)
+ (deps
+  harbor_source_relay.liq
+  (glob_files ../media/**)
+  ../liquidsoap-test-assets
+  ../../src/bin/liquidsoap.exe
+  ../streams/file1.png
+  ../streams/file1.mp3
+  ./theora-test.mp4
+  (package liquidsoap)
+  (source_tree ../../src/libs)
+  (:test_liq ../test.liq)
+  (:run_test ../run_test.exe))
+ (action
+  (run
+   %{run_test}
+   harbor_source_relay
+   liquidsoap
+   %{test_liq}
+   harbor_source_relay.liq)))
+
 (rule
  (alias test_infallible-shutdown)
  (package liquidsoap)
@@ -2123,6 +2169,29 @@
  (action
   (run %{run_test} replaygain liquidsoap %{test_liq} replaygain.liq)))
 
+(rule
+ (alias test_scheduler_parallel)
+ (package liquidsoap)
+ (deps
+  scheduler_parallel.liq
+  (glob_files ../media/**)
+  ../liquidsoap-test-assets
+  ../../src/bin/liquidsoap.exe
+  ../streams/file1.png
+  ../streams/file1.mp3
+  ./theora-test.mp4
+  (package liquidsoap)
+  (source_tree ../../src/libs)
+  (:test_liq ../test.liq)
+  (:run_test ../run_test.exe))
+ (action
+  (run
+   %{run_test}
+   scheduler_parallel
+   liquidsoap
+   %{test_liq}
+   scheduler_parallel.liq)))
+
 (rule
  (alias test_seek_track_map)
  (package liquidsoap)
@@ -2477,6 +2546,29 @@
    %{test_liq}
    track_sensitive.liq)))
 
+(rule
+ (alias test_type_printing_from_task)
+ (package liquidsoap)
+ (deps
+  type_printing_from_task.liq
+  (glob_files ../media/**)
+  ../liquidsoap-test-assets
+  ../../src/bin/liquidsoap.exe
+  ../streams/file1.png
+  ../streams/file1.mp3
+  ./theora-test.mp4
+  (package liquidsoap)
+  (source_tree ../../src/libs)
+  (:test_liq ../test.liq)
+  (:run_test ../run_test.exe))
+ (action
+  (run
+   %{run_test}
+   type_printing_from_task
+   liquidsoap
+   %{test_liq}
+   type_printing_from_task.liq)))
+
 (rule
  (alias test_unified-pcm-types)
  (package liquidsoap)
@@ -2606,6 +2698,7 @@
   (alias test_append-merge)
   (alias test_append-merge2)
   (alias test_callback_counts)
+  (alias test_callback_from_task)
   (alias test_callback_release)
   (alias test_callback_release_mixed_content)
   (alias test_cleanup)
@@ -2622,6 +2715,7 @@
   (alias test_ffmpeg-copy-input-http)
   (alias test_ffmpeg-naming-convention)
   (alias test_ffmpeg_seek_preroll)
+  (alias test_harbor_source_relay)
   (alias test_infallible-shutdown)
   (alias test_init-error)
   (alias test_initial_request_queue)
@@ -2633,6 +2727,7 @@
   (alias test_output_reopen_on_error_delay)
   (alias test_playlist-id)
   (alias test_replaygain)
+  (alias test_scheduler_parallel)
   (alias test_seek_track_map)
   (alias test_shoutcast-args)
   (alias test_source_cleanup)
@@ -2649,5 +2744,6 @@
   (alias test_switch_reselect_after_idle)
   (alias test_switch_skipped_track_metadata)
   (alias test_track_sensitive)
+  (alias test_type_printing_from_task)
   (alias test_unified-pcm-types)
   (alias test_video-only)))
diff --git a/tests/regression/harbor_source_relay.liq b/tests/regression/harbor_source_relay.liq
new file mode 100644
index 0000000000..49f1a42389
--- /dev/null
+++ b/tests/regression/harbor_source_relay.liq
@@ -0,0 +1,28 @@
+# A source connecting to harbor is handed the socket, which the handler signals
+# the same way it signals an error page. Connecting is not enough to prove that
+# worked: the stream has to arrive and decode.
+s = input.harbor("test", port=5359, password="hackme")
+output.dummy(fallible=true, s)
+
+output.icecast(
+  %mp3,
+  host="localhost",
+  port=5359,
+  password="hackme",
+  mount="test",
+  mksafe(sine())
+)
+
+def check() =
+  if
+    s.buffer_length() > 0.
+  then
+    test.pass()
+  else
+    test.fail(
+      "no stream reached the mount"
+    )
+  end
+end
+
+thread.run(delay=5., check)
diff --git a/tests/regression/scheduler_parallel.liq b/tests/regression/scheduler_parallel.liq
new file mode 100644
index 0000000000..227b797ac9
--- /dev/null
+++ b/tests/regression/scheduler_parallel.liq
@@ -0,0 +1,49 @@
+n = 8
+starts = list.init(n, fun (_) -> ref(0.))
+ends = list.init(n, fun (_) -> ref(0.))
+
+# Each handler holds its slot for the whole pause, so if the last one to start
+# did so before the first one finished, all of them were running at once.
+def worker(i) =
+  def run() =
+    list.nth(starts, i) := time()
+    thread.pause(0.4)
+    list.nth(ends, i) := time()
+  end
+
+  thread.run(fast=false, run)
+end
+
+for i = 0 to n - 1 do worker(i)  end
+
+def check() =
+  started = list.map(fun (r) -> r(), starts)
+  ended = list.map(fun (r) -> r(), ends)
+
+  if
+    list.exists(fun (t) -> t == 0., ended)
+  then
+    test.fail(
+      "only #{list.length(list.filter(fun (t) -> t != 0., ended))} of #{n} \
+       handlers finished"
+    )
+  else
+    last_start = list.fold(fun (m, t) -> max(m, t), 0., started)
+    first_end = list.fold(fun (m, t) -> min(m, t), list.hd(ended), ended)
+
+    if
+      first_end <= last_start
+    then
+      test.fail(
+        "handlers did not overlap: last start #{last_start}, first end #{
+          first_end
+        }"
+      )
+    else
+      test.pass()
+    end
+  end
+end
+
+thread.run(delay=3., check)
+output.dummy(blank())
diff --git a/tests/regression/type_printing_from_task.liq b/tests/regression/type_printing_from_task.liq
new file mode 100644
index 0000000000..02db2e4696
--- /dev/null
+++ b/tests/regression/type_printing_from_task.liq
@@ -0,0 +1,17 @@
+# Rendering a type reaches for a formatter, and a task does not necessarily run
+# where the last one did.
+def f() =
+  try
+    let json.parse (val : {x: int}) = "[]"
+    print(val.x)
+  catch err : [error.json] do
+    test.equal(
+      err.message,
+      "Parsing error: json value cannot be parsed as type {x : int}"
+    )
+  end
+
+  test.pass()
+end
+
+test.check(f)