aboutsummaryrefslogtreecommitdiff
path: root/stm
diff options
context:
space:
mode:
authorEnrico Tassi2019-01-21 13:46:31 +0100
committerEnrico Tassi2019-01-22 18:03:18 +0100
commit816d8e6723c7272f2df0ff9e614f8a0fe19f66c9 (patch)
tree08547fb1a9ef780d2e7b56e99de17db3866f7b89 /stm
parent05e2222e04323d11429d659b415750cf40e2babd (diff)
[thread] protect threads against sigalrm
This makes the implementation of Timeout on unix more reliable since only the main thread will receive the signal for timeout.
Diffstat (limited to 'stm')
-rw-r--r--stm/asyncTaskQueue.ml4
-rw-r--r--stm/spawned.ml2
-rw-r--r--stm/stm.ml2
-rw-r--r--stm/workerPool.ml2
4 files changed, 5 insertions, 5 deletions
diff --git a/stm/asyncTaskQueue.ml b/stm/asyncTaskQueue.ml
index 51166cf238..2f8129bbfd 100644
--- a/stm/asyncTaskQueue.ml
+++ b/stm/asyncTaskQueue.ml
@@ -190,7 +190,7 @@ module Make(T : Task) () = struct
let () = TQueue.broadcast queue in
Worker.kill proc
in
- let _ = Thread.create kill_if () in
+ let _ = CThread.create kill_if () in
try while true do
report_status ~id "Idle";
@@ -250,7 +250,7 @@ module Make(T : Task) () = struct
{
active = Pool.create queue ~size;
queue;
- cleaner = if size > 0 then Some (Thread.create cleaner queue) else None;
+ cleaner = if size > 0 then Some (CThread.create cleaner queue) else None;
}
let destroy { active; queue } =
diff --git a/stm/spawned.ml b/stm/spawned.ml
index a5d6ea96f9..bd772d825d 100644
--- a/stm/spawned.ml
+++ b/stm/spawned.ml
@@ -38,7 +38,7 @@ let controller h pr pw =
prerr_endline ("control channel broken: " ^ Printexc.to_string e);
exit 1 in
loop () in
- ignore(Thread.create main ())
+ ignore(CThread.create main ())
let main_channel = ref None
let control_channel = ref None
diff --git a/stm/stm.ml b/stm/stm.ml
index 169d608d2d..9bd61f226d 100644
--- a/stm/stm.ml
+++ b/stm/stm.ml
@@ -739,7 +739,7 @@ end = struct (* {{{ *)
else begin
set_last_job job;
if Option.is_empty !worker then
- worker := Some (Thread.create run_command ())
+ worker := Some (CThread.create run_command ())
end
end
diff --git a/stm/workerPool.ml b/stm/workerPool.ml
index 0ff66686e4..2432e72c8a 100644
--- a/stm/workerPool.ml
+++ b/stm/workerPool.ml
@@ -86,7 +86,7 @@ let rec create_worker extra pool id =
let exit () = cancel := true; cleanup pool; Thread.exit () in
let cancelled () = !cancel in
let cpanel = { exit; cancelled; extra } in
- let manager = Thread.create (Model.manager cpanel) worker in
+ let manager = CThread.create (Model.manager cpanel) worker in
{ name; cancel; manager; process }
and cleanup x = locking x begin fun { workers; count; extra_arg } ->