Performance issue when calling Async.RunSynchronously inside Async.Parallel

[eiriktsarpalis]

I can reproduce the following performance issue in VS 2015:

https://gist.github.com/eiriktsarpalis/17b5652d57974d0e3e5d

Not sure why this happens.

EDIT: it looks like this can be solved by increasing the minimum number of threads in the thread pool, however I'd still be interested to find out why RunSynchronously causes such dramatic performance degradation.

[radekm]

It seems that most of the time is spent in ResultCell.TryWaitForResultSynchronously in call resHandle.WaitOne.

[radekm]

I wonder whether the problem isn't caused by blocking thread pool threads by waiting.

[radekm]

I think that blocking threads by waiting for asynchronous operations should avoided - it may cause deadlock when thread pool runs out of threads (e.g. in your case by setting System.Threading.ThreadPool.SetMaxThreads(20, 1000)):

let run x = Async.RunSynchronously x

System.Threading.ThreadPool.SetMaxThreads(20, 1000) |> ignore

let runParallel (workflow : Async<'T>) =
    [| for i in 1 .. 100 -> workflow |] 
    |> Async.Parallel
    |> run

let a = async { return 42 }
let b = async { return run (async { return 42 })}

runParallel b

[latkin]

Can you comment on whether this affects older F#/VS versions, or repros differently for x86 vs x64/RyuJIT?

[radekm]

Times reported by this code

let run x = Async.RunSynchronously x

let runParallel (workflow : Async<'T>) =
    [| for i in 1 .. 100 -> workflow |] 
    |> Async.Parallel
    |> run

let b = async { return run (async { return 42 })}

let sw = System.Diagnostics.Stopwatch()

sw.Start()
runParallel b
printfn "time: %A" sw.Elapsed
System.Console.ReadLine()

on VS 2015, Windows 10:

• .NET Framework 4.5.2, x86: 00:01:37
• .NET Framework 4.5.2, x64: 00:01:35
• .NET Framework 4.6, x86: 00:01:36
• .NET Framework 4.6, x64: 00:01:37
• .NET Framework 4.6, x86, legacy JIT: 00:01:35
• .NET Framework 4.6, x64, legacy JIT: 00:01:36

What is actually interesting is that all threads cross the line (from control.fs)

let ok = resHandle.WaitOne(millisecondsTimeout= timeout,exitContext=true) 

almost always at the same time - after the last thread starts waiting.

[latkin]

I see the same perf compiling against F# 4.0, 3.1, 3.0. So at least not a recent regression.

[radekm]

What is actually interesting is that all threads cross the line (from control.fs)

The reason is that Async.Parallel queues all operations at the beginning. If I change

                    tasks |> Array.iteri (fun i p ->
                        queueAsync
                                innerCTS.Token
                                // on success, record the result
                                (fun res -> recordSuccess i res)
                                // on exception...
                                (fun edi -> recordFailure (Choice1Of2 edi))
                                // on cancellation...
                                (fun cexn -> recordFailure (Choice2Of2 cexn))
                                p
                            |> unfake);

to queue only Environment.ProcessorCount operations

                    let rec queueBatch tasks =
                        let now, later =
                            if Array.length tasks <= Environment.ProcessorCount
                            then tasks, [| |]
                            else tasks |> Array.splitAt Environment.ProcessorCount
                        now |> Array.iteri (fun i p ->
                            queueAsync
                                    innerCTS.Token
                                    // on success, record the result
                                    (fun res -> recordSuccess i res)
                                    // on exception...
                                    (fun edi -> recordFailure (Choice1Of2 edi))
                                    // on cancellation...
                                    (fun cexn -> recordFailure (Choice2Of2 cexn))
                                    p
                                |> unfake);
                        if later |> Array.isEmpty |> not then
                            ThreadPool.QueueUserWorkItem(fun _ -> queueBatch later)
                            |> ignore

                    queueBatch tasks

then it takes less than two seconds (because waiting for results is interleaved with computing results and ThreadPool doesn't need to grow up to 100 threads to do some work - originally almost always 100 waiting operations were queued before any operation which can compute some result).

[radekm]

Same behaviour but without async:

open System.Threading

let queue f =
    ThreadPool.QueueUserWorkItem(fun _ -> f () |> ignore) |> ignore

let work () =
    let ev = new ManualResetEvent(false)       
    queue (ev.Set)
    // Block current `ThreadPool` thread and wait
    // until another `ThreadPool` thread sets the event.
    ev.WaitOne() |> ignore

do
    let n = 100
    let finished = new CountdownEvent(1)

    seq { 1 .. n }
    |> Seq.iter (fun _ ->        
        finished.AddCount()
        queue (fun () ->
            work ()
            finished.Signal()))

    finished.Signal() |> ignore

    // Wait until work is done - usually until `ThreadPool` grows to `n + 1` threads.
    finished.Wait()

[radekm]

Maybe this issue could be solved if RunSynchronously could use current thread (especially if it is already a thread from ThreadPool) instead of blocking it and queuing work to another thread in ThreadPool (or do we have to start with an empty stack?).

[eiriktsarpalis]

I should point out that the issue does not occur if implementing an Async.RunSynchronously on top of Task.Result:

let run' (x : Async<'T>) =
    let tcs = new TaskCompletionSource<'T>()
    Async.StartWithContinuations(x, tcs.SetResult, tcs.SetException, fun _ -> tcs.SetCanceled ())
    tcs.Task.Result

let runParallel (workflow : Async<'T>) =
    [| for i in 1 .. 100 -> workflow |] 
    |> Async.Parallel
    |> run

let a = async { return 42 }
let b = async { return run (async { return 42 })}
let c = async { return run' (async { return 42 })}

runParallel a // Real: 00:00:00.031, CPU: 00:00:00.015, GC gen0: 0, gen1: 0, gen2: 0
runParallel b // Real: 00:01:24.086, CPU: 00:00:00.000, GC gen0: 0, gen1: 0, gen2: 0
runParallel c // Real: 00:00:00.003, CPU: 00:00:00.015, GC gen0: 0, gen1: 0, gen2: 0

[eulerfx]

I see similar numbers. However, using the following alternative to Async.Parallel it is much better:

open System
open System.Threading
open System.Threading.Tasks

[<AutoOpen>]
module AsyncEx =

  type Async with

      /// Creates an async computation which runs the provided sequence of computations and completes
      /// when all computations in the sequence complete. Up to parallelism computations will
      /// be in-flight at any given point in time. Error or cancellation of any computation in
      /// the sequence causes the resulting computation to error or cancel, respectively.
      static member ParallelIgnore (parallelism:int) (xs:seq<Async<_>>) = async {                
        let sm = new SemaphoreSlim(parallelism)
        let cde = new CountdownEvent(1)
        let tcs = new TaskCompletionSource<unit>()
        let inline tryComplete () =
          if cde.Signal() then
            tcs.SetResult(())
        let inline ok _ =
          sm.Release() |> ignore
          tryComplete ()                
        let inline err (ex:exn) =
          tcs.TrySetException ex |> ignore
          sm.Release() |> ignore                        
        let inline cnc (ex:OperationCanceledException) =      
          tcs.TrySetCanceled() |> ignore
          sm.Release() |> ignore
        try
          use en = xs.GetEnumerator()
          while not (tcs.Task.IsCompleted) && en.MoveNext() do
            sm.Wait()
            cde.AddCount(1)
            Async.StartWithContinuations(en.Current, ok, err, cnc)                              
          tryComplete ()
          do! tcs.Task |> Async.AwaitTask
        finally      
          cde.Dispose()    
          sm.Dispose() }




let run x = Async.RunSynchronously x

let runParallel (workflow : Async<'T>) =
    [| for i in 1 .. 100 -> workflow |] 
    |> Async.ParallelIgnore 10
    |> run

let a = async { return 42 }
let b = async { return run (async { return 42 })}

runParallel a // Real: 00:00:00.031, CPU: 00:00:00.015, GC gen0: 0, gen1: 0, gen2: 0
runParallel b // Real: 00:00:00.023, CPU: 00:00:00.031, GC gen0: 0, gen1: 0, gen2: 0

[radekm]

IMO the number of parallel computations should be controlled by ThreadPool by its hill climbing heuristics (especially in this case when tasks are very short).

[letrec]

Relying on ThreadPool makes sense only if computations are CPU bound, which is not always the case.