|
@@ -599,6 +599,42 @@ module Tasks = struct
|
|
Gc.set old_gc;
|
|
Gc.set old_gc;
|
|
ServerMessage.gc_stats (get_time() -. t0) stats do_compact new_space_overhead
|
|
ServerMessage.gc_stats (get_time() -. t0) stats do_compact new_space_overhead
|
|
end
|
|
end
|
|
|
|
+
|
|
|
|
+ class class_maintenance_task (cs : CompilationServer.t) (c : tclass) = object(self)
|
|
|
|
+ inherit server_task ["module maintenance"] 70
|
|
|
|
+
|
|
|
|
+ method private execute =
|
|
|
|
+ let rec field cf =
|
|
|
|
+ (* Unset cf_expr. This holds the optimized version for generators, which we don't need to persist. If
|
|
|
|
+ we compile again, the semi-optimized expression will be restored by calling cl_restore(). *)
|
|
|
|
+ cf.cf_expr <- None;
|
|
|
|
+ List.iter field cf.cf_overloads
|
|
|
|
+ in
|
|
|
|
+ (* What we're doing here at the moment is free, so we can just do it in one task. If this ever gets more expensive,
|
|
|
|
+ we should spawn a task per-field. *)
|
|
|
|
+ List.iter field c.cl_ordered_fields;
|
|
|
|
+ List.iter field c.cl_ordered_statics;
|
|
|
|
+ Option.may field c.cl_constructor;
|
|
|
|
+ end
|
|
|
|
+
|
|
|
|
+ class module_maintenance_task (cs : CompilationServer.t) (m : module_def) = object(self)
|
|
|
|
+ inherit server_task ["module maintenance"] 80
|
|
|
|
+
|
|
|
|
+ method private execute =
|
|
|
|
+ List.iter (fun mt -> match mt with
|
|
|
|
+ | TClassDecl c ->
|
|
|
|
+ cs#add_task (new class_maintenance_task cs c)
|
|
|
|
+ | _ ->
|
|
|
|
+ ()
|
|
|
|
+ ) m.m_types
|
|
|
|
+ end
|
|
|
|
+
|
|
|
|
+ class server_exploration_task (cs : CompilationServer.t) = object(self)
|
|
|
|
+ inherit server_task ["server explore"] 90
|
|
|
|
+
|
|
|
|
+ method private execute =
|
|
|
|
+ cs#iter_modules (fun m -> cs#add_task (new module_maintenance_task cs m))
|
|
|
|
+ end
|
|
end
|
|
end
|
|
|
|
|
|
(* The server main loop. Waits for the [accept] call to then process the sent compilation
|
|
(* The server main loop. Waits for the [accept] call to then process the sent compilation
|
|
@@ -697,6 +733,8 @@ let wait_loop process_params verbose accept =
|
|
(* If our connection always blocks, we have to execute all pending tasks now. *)
|
|
(* If our connection always blocks, we have to execute all pending tasks now. *)
|
|
if not support_nonblock then
|
|
if not support_nonblock then
|
|
while cs#has_task do cs#get_task#run done
|
|
while cs#has_task do cs#get_task#run done
|
|
|
|
+ else if sctx.was_compilation then
|
|
|
|
+ cs#add_task (new Tasks.server_exploration_task cs)
|
|
done
|
|
done
|
|
|
|
|
|
let mk_length_prefixed_communication allow_nonblock chin chout =
|
|
let mk_length_prefixed_communication allow_nonblock chin chout =
|