Too many native threads created on Windows

Summary

A Haskell program creates too many native threads on Windows.

When compiled for x86, it also causes malloc failure.

Steps to reproduce

Compile the following program for x86 or x86_64 on Windows using the default RTS. (.cabal and stack.yaml are available at https://gist.github.com/msakai/2cacc117731b81f199638ba9144105de )

module Main (main) where

import Control.Concurrent.Async
import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.IORef
import Foreign.C
import System.Random.MWC

main :: IO ()
main = do
  g <- createSystemRandom

  forever $ do
    ref <- newIORef False
    let timer = forever $ do
          threadDelay (100 * 1000) 
          writeIORef ref True

    withAsync timer $ \_ -> do
      replicateM 100 $ do
        k <- uniformR (0, 30) g
        replicateM_ 10 $ 
          evaluate $ product [1 .. toInteger (k::Int)] `mod` 123456789 

        shouldPrintStats <- readIORef ref
        when shouldPrintStats $ putStrLn "stats"
        writeIORef ref False

Run the program, then watch the task manager.

Task manager screenshot when compiled for x86_64:

Task manager screenshot when compiled for x86:

The one compiled for x86 crashes with the message malloc: failed on request for 12 bytes; message: stg_delayzh after a while.

Expected behavior

Since I'm using default non-threaded RTS and the program is written in such a way that the number of live haskell threads are limited, I expect only one or a small number of native threads to be created.

Environment

• GHC version used: 9.4.4 (for x86_64) and 8.6.3 (for x86)

Optional:

• Operating System: Windows 10
• System Architecture: x86 and x86_64