I am converting the OCaml Format module to F# and tracked a problem back to a use of the OCaml Pervasives at_exit.
val at_exit : (unit -> unit) -> unit
Register the given function to be called at program termination time. The functions registered with at_exit will be called when the program executes exit, or terminates, either normally or because of an uncaught exception. The functions are called in "last in, first out" order: the function most recently added with at_exit is called first.
In the process of conversion I commented out the line as the compiler did not flag it as being needed and I was not expecting an event in the code.
I checked the FSharp.PowerPack.Compatibility.PervasivesModule for at_exit using VS Object Browser and found none.
I did find how to run code "at_exit"? and How do I write an exit handler for an F# application?
The OCaml line is
at_exit print_flush
with print_flush signature: val print_flush : (unit -> unit)
Also in looking at the use of it during a debug session of the OCaml code, it looks like at_exit is called both at the end of initialization and at the end of each use of a call to the module.
Any suggestions, hints on how to do this. This will be my first event in F#.
EDIT
Here is some of what I have learned about the Format module that should shed some light on the problem.
The Format module is a library of functions for basic pretty printer commands of simple OCaml values such as int, bool, string. The format module has commands like print_string, but also some commands to say put the next line in a bounded box, think new set of left and right margins. So one could write:
print_string "Hello"
or
open_box 0; print_string "<<";
open_box 0; print_string "p \/ q ==> r"; close_box();
print_string ">>"; close_box()
The commands such as open_box and print_string are handled by a loop that interprets the commands and then decides wither to print on the current line or advance to the next line. The commands are held in a queue and there is a state record to hold mutable values such as left and right margin.
The queue and state needs to be primed, which from debugging the test cases against working OCaml code appears to be done at the end of initialization of the module but before the first call is made to any function in the Format module. The queue and state is cleaned up and primed again for the next set of commands by the use of mechanisms for at_exit that recognize that the last matching frame for the initial call to the format modules has been removed thus triggering the call to at_exit which pushes out any remaining command in the queue and re-initializes the queue and state.
So the sequencing of the calls to print_flush is critical and appears to be at more than what the OCaml documentation states.
This should do it:
module Pervasives =
open System
open System.Threading
//
let mutable private exitFunctions : (unit -> unit) list = List.empty
//
let mutable private exitFunctionsExecutedFlag = 0
//
let private tryExecuteExitFunctions _ =
if Interlocked.CompareExchange (&exitFunctionsExecutedFlag, 1, 0) = 0 then
// Run the exit functions in last-in-first-out order.
exitFunctions
|> List.iter (fun f -> f ())
// Register handlers for events which fire when the process exits cleanly
// or due to an exception being thrown.
do
AppDomain.CurrentDomain.ProcessExit.Add tryExecuteExitFunctions
AppDomain.CurrentDomain.UnhandledException.Add tryExecuteExitFunctions
//
let at_exit f =
// TODO : This function should be re-written using atomic operations
// for thread-safety!
exitFunctions <- f :: exitFunctions
And some code to test it:
open System
// Register a couple of handlers to test our code.
Pervasives.at_exit <| fun () ->
Console.WriteLine "The first registered function has fired!"
Pervasives.at_exit <| fun () ->
Console.WriteLine "The second registered function has fired!"
TimeSpan.FromSeconds 1.0
|> System.Threading.Thread.Sleep
Console.WriteLine "Exiting the second registered function!"
Pervasives.at_exit <| fun () ->
Console.WriteLine "The third registered function has fired!"
// Do some stuff in our program
printfn "blah"
printfn "foo"
printfn "bar"
(* The functions we registered with at_exit should be fired here. *)
// Uncomment this to see that our handlers work even when the
// program crashes due to an unhandled exception.
//failwith "Uh oh!"
Related
I'm trying to parallelize work. I'm trying to have subprocesses each take a piece of the work, then wait for the work to complete from the parent process.
The following solution seems to work for small examples:
let par_iter (items: 'i list) ~(f: 'i -> unit): unit =
let orig_pid = Unix.getpid () in
let rec loop = function
| [] -> ()
| h :: t ->
match Unix.fork () with
| 0 -> f h
| _ -> loop t
in
loop items;
if Unix.getpid () = orig_pid then
List.iter items ~f:(fun _ -> ignore ## Unix.wait ())
else
exit 0
Usage:
let () =
par_iter [1; 2; 3; 4] ~f:do_something_with_an_int;
The contract of Unix.wait when there are multiple subprocesses is not very clear to me. Here I'm relying on the behavior where waiting n times will wait for all and only n subprocesses to finish.
Does this solution rely on undefined behavior? Is there an alternative way to correctly implement par_iter such that it spawns work on child processes and waits for the work to finish?
tested on OCaml 4.14.0
If the original parent process already had some subprocesses, this can fail. Thus, IMHO it's not usable as a general library. You should use Unix.waitpid to wait specifically for the processes you created.
I want to add a listener mechanism to a Format-based logging facility, and I ended up in a situation where my program is typed by OCaml and compiles, but the formatted string just disappeared, and I don't understand exactly why this happens (it's related to formatters returning unit when they should return something else, but I expected the program not to type-check in that case).
This comes from a real use case; its simplification may however have led into a somewhat contrived program.
The basic need is this: to devise a Format.printf-like function (with variadic arguments) that is easy to use but also allows other formatters to be notified (e.g. duplicating their outputs).
I've been told this is not possible due to typing constraints, and indeed if I further simplify my example below, I do get typing errors, but for some reason the program below does type-check but does not produce the expected result.
open Format
let observers : formatter list ref = ref []
let add_observer o : unit =
observers := o :: !observers
let print_to_fmt (fmt: formatter) (text: ('a, formatter, unit) format) : unit =
Format.fprintf fmt "<";
Format.fprintf fmt text;
Format.fprintf fmt ">#."
let notify text : unit =
List.iter (fun fmt ->
Format.printf "MESSAGE: {";
Format.printf text;
Format.printf "}#.";
print_to_fmt fmt text
) !observers
let buffer = ref ""
let append text _ _ = buffer := text
let print text =
let fmt = Format.make_formatter append (fun () -> ()) in
Format.kfprintf (fun f -> ()) fmt text
let log text =
notify text;
print text
let () =
add_observer (Format.err_formatter);
log "this works";
log "this does not %d" 42;
log "this also works"
Any help on how to (1) change the program to display this does not 42, or (2) an explanation on why the program type-checks when it seems it shouldn't, would be much appreciated.
You're trying to do a very strange magic with formatters, that I would classify as an abuse, honestly. Formatter is a formatted channel, not data, so they impose all problems of channels, like non-persistent data that disappear suddenly.
If you want to have a log function, that will dispatch data between registered formatters, then the following will work:
open Format
let observers : formatter list ref = ref []
let add_observer o : unit =
observers := o :: !observers
let notify (text : string) : unit =
List.iter (fun fmt ->
fprintf fmt "MESSAGE: {%s}#." text) !observers
let log text = ksprintf notify text
let () =
add_observer Format.err_formatter;
log "this works";
log "this does not %d" 42;
log "this also works"
Will rend the following output:
MESSAGE: {this works}
MESSAGE: {this does not 42}
MESSAGE: {this also works}
I am trying to solve the following problem. I have some agents running in real-time, with a large heartbeat of couple of milliseconds, and the order of operations they process for this reason are mostly deterministic (as the message processing is not the bottleneck).
Now, I am running a large amount of simulations of the system where I no longer have a heartbeat (otherwise it will take a couple of centuries) - but I need to make sure the order of operations are preserved. For this, I adopted the following solution: the simulator makes sure each agent has processed his message queue, by posting a dummy synchronization message and blocking while waiting for the answer. This does work for my application, but the time it takes is not intuitive - as a single threaded implementation would be an order of magnitude faster (I guess - x 100 ish - although I have not tested ).
I have isolated a small test that shows the issue, even trying to use another library, akka.net
type Greet =
| Greet of string
| Hello of AsyncReplyChannel<bool>
| Hello2
[<EntryPoint>]
let main argv =
let system = System.create "MySystem" <| Configuration.load()
let greeter = spawn system "greeter" <| fun mailbox ->
let rec loop() = actor {
let! msg = mailbox.Receive()
let sender = mailbox.Sender()
match msg with
| Greet who -> () // printf "Hello, %s!\n" who
| Hello2 -> sender.Tell(true)
| _ -> ()
return! loop()
}
loop()
let greeterF =
MailboxProcessor.Start
(fun inbox ->
async {
while true do
let! msg = inbox.Receive()
match msg with
| Greet who -> () // printf "Hello, %s!\n" who
| Hello reply -> reply.Reply true
| _ -> ()
}
)
let n = 1000000
let t1 = System.Diagnostics.Stopwatch()
t1.Start()
for i = 1 to n do
let rep = greeterF.PostAndReply(fun reply -> (Hello reply)) |> ignore
()
printfn "elapsed Mailbox:%A" t1.ElapsedMilliseconds
t1.Restart()
for i = 1 to n do
let res = greeter.Ask (Hello2)
let rr = res.Result
()
printfn "elapsed Akka:%A" t1.ElapsedMilliseconds
System.Console.ReadLine () |> ignore
0
Basically, both take about 10 seconds for a mere 1 millions of synchronizations - and not computation what-so-ever involved, and this is... unfortunate.
I am wondering if anybody has come across the same problem and if there is anyway to switch off the overhead forcing everything to run in a single threaded mode... something like better than de-activating all the cpus but 1 in the bios - or writing a clone of the whole system without the agents.
Any help well appreciated.
The reason for the Akka.NET version beeing slow here is how you communicate with the actor:
main process Task FutureActorRef !!ThreadPool!! greeter
Ask ---------------------->
Tell----------->
MailboxRun ----->
(greeter mailbox is empty) |
<--------------------------Tell
<--Complete task
<----------.Result
For each iteration, a TPL task will be created
Then a single message is sent to the greeter.
The main process then blocks while waiting for the response to come back.
The greeter replies back which in turn completes the task inside the FutureActorRef
Rinse and Repeat..
This design will cause Akka.NET to start and stop the greeters "mailbox run" for each message as the mailbox queue becomes empty for each iteration.
This results in threadpool schedulation for each single message that is passed.
It's a bit like entering your car, putting the pedal to the metal, then abruptly stop and step out of the car, and then repeating the procedure again.
That is just not a very effective way to travel fast.
#Aaronontheweb's suggestion will only have effect if you work out the above kinks in your code.
The mailbox needs to be able to constantly pick messages of the internal queue to work with messages in batches to achieve full throughput.
Instead, separate the producer from the consumer.
Create an actor that listens for the responses from your greeter.
And once that actor have processes your 1000000 messages, let that actor send a WorkCompleted message back to the consumer.
[Edit]
I gave it a shot myself, I don't know F# so it might not be completely idiomatic :)
open Akka
open Akka.Actor
open Akka.FSharp
type Greet =
| Greet of string
| Hello of AsyncReplyChannel<bool>
| Hello2
type Consume =
| Response
| SetSender
[<EntryPoint>]
let main argv =
let system = System.create "MySystem" <| Configuration.load()
let greeter = spawn system "greeter" <| fun mailbox ->
let rec loop() = actor {
let! msg = mailbox.Receive()
let sender = mailbox.Sender()
match msg with
| Greet who -> () // printf "Hello, %s!\n" who
| Hello2 -> sender.Tell(Response)
| _ -> ()
return! loop()
}
loop()
let consumer = spawn system "consumer" <| fun mailbox ->
let rec loop(count,sender : IActorRef) = actor {
if count = 1000000 then sender.Tell(true)
let! msg = mailbox.Receive()
match msg with
| Response -> return! loop(count+1,sender)
| SetSender -> return! loop(count,mailbox.Sender())
}
loop(0,null)
let n = 1000000
let t1 = System.Diagnostics.Stopwatch()
t1.Start()
for i = 1 to n do
greeter.Tell(Hello2,consumer)
let workdone = consumer.Ask SetSender
workdone.Wait()
printfn "elapsed Akka:%A" t1.ElapsedMilliseconds
System.Console.ReadLine () |> ignore
0
I updated your code to use a separate consumer for the actor responses and then reply back once all replies had been processed.
By doing so, your processing time is now down to 650ms on my machine.
If you want better throughput, you need to involve more actors to parallelize more.
I'm not sure if this helps in your specific scenario
Here is a slightly modified MailboxProcessor version:
module MBPAsync =
type Greet =
| Greet of string
| Hello of AsyncReplyChannel<bool>
let run n =
let timer = Stopwatch.StartNew ()
use greeter =
MailboxProcessor.Start <| fun inbox -> async {
while true do
let! msg = inbox.Receive()
match msg with
| Greet who -> () // printf "Hello, %s!\n" who
| Hello reply -> reply.Reply true
}
Async.RunSynchronously <| async {
for i = 1 to n do
do! Async.Ignore (greeter.PostAndAsyncReply Hello)
}
let elapsed = timer.Elapsed
printfn "%A" elapsed
The difference here is that this version uses PostAndAsyncReply and keeps the computation in an async workflow. On my quick test this seemed to be much faster that using PostAndReply, but YMMV.
The timings I get from the above MBP version look roughly like this:
> MBPAsync.run 1000000 ;;
00:00:02.6883486
val it : unit = ()
A comment earlier mentioned my Hopac library. Here is an optimized version using Hopac:
module Hop =
type Greet =
| Greet of string
| Hello of IVar<bool>
let run n =
let timer = Stopwatch.StartNew ()
let greeterCh = ch ()
do greeterCh >>= function
| Greet who -> Job.unit ()
| Hello reply -> reply <-= true
|> Job.forever
|> server
Job.forUpToIgnore 1 n <| fun _ ->
let reply = ivar ()
greeterCh <-- Hello reply >>.
reply
|> run
let elapsed = timer.Elapsed
printfn "%A" elapsed
The timings I get from the above Hopac version look roughly like this:
> Hop.run 1000000 ;;
00:00:00.1088768
val it : unit = ()
I'm not an F# developer, but I'm a core dev on Akka.NET. A couple of ideas for your scenario:
If you're only using a single actor for this work, you can try using a PinnedDispatcher - that way the actor runs on its own dedicated thread all the time. That will save you on unnecessary context switching overhead.
You can also set the throughput of the mailbox to be much higher for this PinnedDispatcher than the normal settings. i.e. set a throughput value of 10000 (or something) instead of the normal 25. Assuming that the contents of your mailbox grow in large bursts this should save you on mailbox synchronization overhead.
Here's what your dispatcher configuration might look like:
my-pinned-dispatcher {
type = PinnedDispatcher
throughput = 1000 #your mileage may vary
}
And then configure an actor to use it
C# Fluent Interface
var myActor = myActorSystem.ActorOf(Props.Create<FooActor>()
.WithDispatcher("my-pinned-dispatcher");
Config
akka.actor.deployment{
/greeter{
dispatcher = my-pinned-dispatcher
}
}
These are both options you can configure via HOCON in App.config or Web.config or you can use the fluent interface on the Props class to do this. Also worth noting: there's a bug with pinned dispatchers at the moment, but that should be fixed in our next maintenance release (v1.0.1,) which should be out next week.
Your mileage may vary, but this is what I would try - basically it's just designed to help reduce contention and overhead around a single actor.
I wrote a simple TCP-client for some device, which consumes and produces 8-byte packets (the code of send-command-receive-result function is below).
When I run it on linux, it works perfectly, being part of the loop (send-recv-send-recv-...), but on windows it receives only first msg from device (send-recv-send-send-...). The packets are still going - I could clearly see them with Wireshark - but something under my client just ignores them (or truncates to zero?). It doesn't even print "Data was read!" - looks like the reading stucks and gets killed by timeout function.
Before that, I used the sockets directly; changing to HandleStream yelded no difference at all. Wrapping main in withSocketsDo did nothing, too.
transmit :: Int -> HandleStream ByteString -> ByteString -> IO [Bytestring]
transmit delay sock packet = do
let input = timeout delay $ sock `readBlock` 8 <* putStrLn "\nData was read!"
sock `writeBlock` pack
strings <- whileJust input
return [str | Right str <- strings]
whileJust action = do
result <- action
case result of
Just a -> (:) <$> return a <*> whileJust action
Nothing -> return []
What am I doing wrong?
In the OS X pthreads implementation (http://www.opensource.apple.com/source/Libc/Libc-825.26/pthreads/thread_setup.c?txt) they provide a fake return address on the thread stack (line 140):
ts->rip = (uintptr_t) routine;
/*
** We need to simulate a 16-byte aligned stack frame as if we had
** executed a call instruction. The stack should already be aligned
** before it comes to us and we don't need to push any arguments,
** so we shouldn't need to change it.
*/
ts->rdi = (uintptr_t) thread; /* argument to function */
*--sp = 0; /* fake return address */
ts->rsp = (uintptr_t) sp; /* set stack pointer */
I do not understand how this will not crash with an illegal instruction/segfault when the function that the thread is executing calls 'ret' and pops that return address from the stack. Can anyone explain how this is prevented/handled?
Without looking at the rest of the code, I can only venture a guess. My intuition says, the called thread procedure (the user-supplied start_routine parameter) should never return to the calling function.
Think about it: if the new thread did return, you would have two threads running over the same original code path. I imagine that the thread function that is actually called is a wrapper that calls the user-supplied start_routine. When the start_routine returns, the wrapper then calls pthread_exit.
(main thread)
v
pthread_create
v
thread_setup (sets up stack), and spawns new thread
v |
return to main thread |
|
|
v
wrapper_function
v
user-supplied start_routine
| (returns)
v
wrapper_function calls
v
pthread_exit
Again, this is just a guess, but the whole point is, the new thread should never return to the code that called pthread_create. The purpose of the wrapper then would be to ensure that pthread_exit gets called.
I would have to see what they are passing as routine to thread_setup.
My feelings are confirmed by the fact that you don't have to call pthread_exit.