[hcoop/debian/mlton.git] / regression / thread-switch.sml

(*
 * On my 400MhZ system, thread-switch 10000000 takes 4.98s, which comes out to
 * 2,008,032 switches per second.
 *)
   
structure Main =
struct

type int = Int.int
open MLton
open Thread

datatype t = T of (int * t) Thread.t

val done: Thread.Runnable.t option ref = ref NONE
   
fun loop (n: int, T t): unit =
   if n = 0
      then switch (fn _ => valOf (!done))
   else
      let
         val (n, t) = switch (fn t' => prepare (t, (n - 1, T t')))
      in
         loop(n, t)
      end
   
fun main () =
   let
      val numSwitches =
         case CommandLine.arguments () of
            [] => 1000
          | s :: _ => valOf (Int.fromString s)
   in
      switch (fn cur =>
              (done := SOME (prepare (cur, ()))
               ; prepare (new loop, (numSwitches, T (new loop)))))
      ; print "ok\n"
   end

end

val _ = Main.main ()
(*    SMLofNJ.exportFn
 *    ("thread-switch", fn _ => (Main.main(); OS.Process.success))
 *)
Commit	Line	Data
7f918cf1 CE	1	(*
	2	* On my 400MhZ system, thread-switch 10000000 takes 4.98s, which comes out to
	3	* 2,008,032 switches per second.
	4	*)
	5
	6	structure Main =
	7	struct
	8
	9	type int = Int.int
	10	open MLton
	11	open Thread
	12
	13	datatype t = T of (int * t) Thread.t
	14
	15	val done: Thread.Runnable.t option ref = ref NONE
	16
	17	fun loop (n: int, T t): unit =
	18	if n = 0
	19	then switch (fn _ => valOf (!done))
	20	else
	21	let
	22	val (n, t) = switch (fn t' => prepare (t, (n - 1, T t')))
	23	in
	24	loop(n, t)
	25	end
	26
	27	fun main () =
	28	let
	29	val numSwitches =
	30	case CommandLine.arguments () of
	31	[] => 1000
	32	\| s :: _ => valOf (Int.fromString s)
	33	in
	34	switch (fn cur =>
	35	(done := SOME (prepare (cur, ()))
	36	; prepare (new loop, (numSwitches, T (new loop)))))
	37	; print "ok\n"
	38	end
	39
	40	end
	41
	42	val _ = Main.main ()
	43	(* SMLofNJ.exportFn
	44	* ("thread-switch", fn _ => (Main.main(); OS.Process.success))
	45	*)