X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Fjobs.ml;h=708a258305ecfd09293c8033bb2b6c1c97bc0742;hb=ec7d2c76a7ae7447866522103b18107f154083cb;hp=f9ead5298a73bdbebaf9ae4794fb2f63f5193a95;hpb=2a9d33a300ac414c21679c520bc6434d48f499a9;p=goals.git

diff --git a/src/jobs.ml b/src/jobs.ml
index f9ead52..708a258 100644
--- a/src/jobs.ml
+++ b/src/jobs.ml
@@ -29,6 +29,7 @@ module type Jobs = sig
   val new_group : unit -> group
   val start : group -> key -> (unit -> unit) -> unit
   val wait : group -> unit
+  val stop_all : unit -> unit
 end
 
 module Make (K : Key) = struct
@@ -79,12 +80,17 @@ module Make (K : Key) = struct
    *)
   let ready = ref 1
 
+  (* If stop_all is called, this is set to true and we stop
+   * running new jobs.
+   *)
+  let stop = ref false
+
   (* The worker thread. *)
   let rec worker _ =
     let id = Thread.id (Thread.self ()) in
     Mutex.lock lock;
     incr ready;
-    while !ready <= Cmdline.nr_jobs do
+    while not !stop && !ready <= Cmdline.nr_jobs () do
       (* See if there's any queue with a job which is ready to run. *)
       Cmdline.debug "thread %d: checking for a runnable queue" id;
       match get_runnable_queue () with
@@ -170,7 +176,7 @@ module Make (K : Key) = struct
     while not (all_done group); do
       decr ready;
       (* Start more threads if fewer than nr_jobs threads are ready. *)
-      let needed = Cmdline.nr_jobs - !ready in
+      let needed = Cmdline.nr_jobs () - !ready in
       if needed > 0 then
         ignore (Array.init needed (Thread.create worker));
 
@@ -185,4 +191,13 @@ module Make (K : Key) = struct
    *)
   and all_done group = List.for_all (fun { state } -> state = Done) !group
 
+  let stop_all () =
+    Mutex.lock lock;
+    (* All threads will exit after running jobs if this is set. *)
+    stop := true;
+    while !ready > 1 do
+      Condition.wait idle lock;
+    done;
+    Mutex.unlock lock
+
 end