aboutsummaryrefslogtreecommitdiff
path: root/stm
diff options
context:
space:
mode:
authorGaëtan Gilbert2021-03-26 15:34:59 +0100
committerGaëtan Gilbert2021-04-14 12:54:38 +0200
commit3efee577b4c92b38a987b40e555fae2c0a2023c4 (patch)
tree182f9cd42fdb9969bab3149f3add552c7455de2e /stm
parent004bf5770bdcdd1b35dd27f683c733505823e741 (diff)
Remove remote counter system
Diffstat (limited to 'stm')
-rw-r--r--stm/asyncTaskQueue.ml31
-rw-r--r--stm/stm.ml19
2 files changed, 8 insertions, 42 deletions
diff --git a/stm/asyncTaskQueue.ml b/stm/asyncTaskQueue.ml
index dd80ff21aa..a9f203014f 100644
--- a/stm/asyncTaskQueue.ml
+++ b/stm/asyncTaskQueue.ml
@@ -56,12 +56,8 @@ module Make(T : Task) () = struct
type response =
| Response of T.response
| RespFeedback of Feedback.feedback
- | RespGetCounterNewUnivLevel
type request = Request of T.request
- type more_data =
- | MoreDataUnivLevel of UnivGen.univ_unique_id list
-
let slave_respond (Request r) =
let res = T.perform r in
Response res
@@ -94,16 +90,6 @@ module Make(T : Task) () = struct
with Failure s | Invalid_argument s | Sys_error s ->
marshal_err ("unmarshal_response: "^s)
- let marshal_more_data oc (res : more_data) =
- try marshal_to_channel oc res
- with Failure s | Invalid_argument s | Sys_error s ->
- marshal_err ("marshal_more_data: "^s)
-
- let unmarshal_more_data ic =
- try (CThread.thread_friendly_input_value ic : more_data)
- with Failure s | Invalid_argument s | Sys_error s ->
- marshal_err ("unmarshal_more_data: "^s)
-
let report_status ?(id = !Flags.async_proofs_worker_id) s =
let open Feedback in
feedback ~id:Stateid.initial (WorkerStatus(id, s))
@@ -198,8 +184,6 @@ module Make(T : Task) () = struct
| Unix.WEXITED i -> Printf.sprintf "exit(%d)" i
| Unix.WSIGNALED sno -> Printf.sprintf "signalled(%d)" sno
| Unix.WSTOPPED sno -> Printf.sprintf "stopped(%d)" sno) in
- let more_univs n =
- CList.init n (fun _ -> UnivGen.new_univ_id ()) in
let rec kill_if () =
if not (Worker.is_alive proc) then ()
@@ -231,9 +215,6 @@ module Make(T : Task) () = struct
marshal_request oc (Request req);
let rec continue () =
match unmarshal_response ic with
- | RespGetCounterNewUnivLevel ->
- marshal_more_data oc (MoreDataUnivLevel (more_univs 10));
- continue ()
| RespFeedback fbk -> T.forward_feedback fbk; continue ()
| Response resp ->
match T.use_response !worker_age task resp with
@@ -315,13 +296,6 @@ module Make(T : Task) () = struct
let ic, oc = Spawned.get_channels () in
slave_oc := Some oc; slave_ic := Some ic
- let bufferize f =
- let l = ref [] in
- fun () ->
- match !l with
- | [] -> let data = f () in l := List.tl data; List.hd data
- | x::tl -> l := tl; x
-
let slave_handshake () =
Pool.worker_handshake (Option.get !slave_ic) (Option.get !slave_oc)
@@ -339,11 +313,6 @@ module Make(T : Task) () = struct
Marshal.to_channel oc (RespFeedback (debug_with_pid fb)) []; flush oc) ()
in
ignore (Feedback.add_feeder (fun x -> slave_feeder (Option.get !slave_oc) x));
- (* We ask master to allocate universe identifiers *)
- UnivGen.set_remote_new_univ_id (bufferize @@ Control.protect_sigalrm (fun () ->
- marshal_response (Option.get !slave_oc) RespGetCounterNewUnivLevel;
- match unmarshal_more_data (Option.get !slave_ic) with
- | MoreDataUnivLevel l -> l));
let working = ref false in
slave_handshake ();
while true do
diff --git a/stm/stm.ml b/stm/stm.ml
index f5768726c3..6287943cee 100644
--- a/stm/stm.ml
+++ b/stm/stm.ml
@@ -2447,24 +2447,21 @@ let join ~doc =
VCS.print ();
doc
-let dump_snapshot () = Slaves.dump_snapshot (), RemoteCounter.snapshot ()
-
-type tasks = int Slaves.tasks * RemoteCounter.remote_counters_status
-let check_task name (tasks,rcbackup) i =
- RemoteCounter.restore rcbackup;
+type tasks = int Slaves.tasks
+let check_task name tasks i =
let vcs = VCS.backup () in
try
let rc = State.purify (Slaves.check_task name tasks) i in
VCS.restore vcs;
rc
with e when CErrors.noncritical e -> VCS.restore vcs; false
-let info_tasks (tasks,_) = Slaves.info_tasks tasks
-let finish_tasks name u p (t,rcbackup as tasks) =
- RemoteCounter.restore rcbackup;
+let info_tasks = Slaves.info_tasks
+
+let finish_tasks name u p tasks =
let finish_task u (_,_,i) =
let vcs = VCS.backup () in
- let u = State.purify (Slaves.finish_task name u p t) i in
+ let u = State.purify (Slaves.finish_task name u p tasks) i in
VCS.restore vcs;
u in
try
@@ -2515,13 +2512,13 @@ let snapshot_vio ~create_vos ~doc ~output_native_objects ldir long_f_dot_vo =
CErrors.user_err ~hdr:"stm" (str"Cannot dump a vio with open proofs");
(* LATER: when create_vos is true, it could be more efficient to not allocate the futures; but for now it seems useful for synchronization of the workers,
below, [snapshot] gets computed even if [create_vos] is true. *)
- let (tasks,counters) = dump_snapshot() in
+ let tasks = Slaves.dump_snapshot() in
let except = List.fold_left (fun e (r,_) ->
Future.UUIDSet.add r.Stateid.uuid e) Future.UUIDSet.empty tasks in
let todo_proofs =
if create_vos
then Library.ProofsTodoSomeEmpty except
- else Library.ProofsTodoSome (except,tasks,counters)
+ else Library.ProofsTodoSome (except,tasks)
in
Library.save_library_to todo_proofs ~output_native_objects ldir long_f_dot_vo (Global.opaque_tables ());
doc