Commit 5a69d2bf authored by Guillaume Melquiond's avatar Guillaume Melquiond

Prevent lablgtk from triggering garbage collections. This greatly reduces the...

Prevent lablgtk from triggering garbage collections. This greatly reduces the startup time of the IDE.
parent 11c393ab
...@@ -550,17 +550,20 @@ opt: bin/why3ide.opt ...@@ -550,17 +550,20 @@ opt: bin/why3ide.opt
bin/why3ide.opt bin/why3ide.byte: INCLUDES += -I @LABLGTK2LIB@ bin/why3ide.opt bin/why3ide.byte: INCLUDES += -I @LABLGTK2LIB@
bin/why3ide.opt bin/why3ide.byte: EXTLIBS += lablgtk lablgtksourceview2 bin/why3ide.opt bin/why3ide.byte: EXTLIBS += lablgtk lablgtksourceview2
bin/why3ide.opt: lib/why3/why3.cmxa $(IDECMX) bin/why3ide.opt: lib/why3/why3.cmxa src/ide/resetgc.o $(IDECMX)
$(if $(QUIET),@echo 'Linking $@' &&) \ $(if $(QUIET),@echo 'Linking $@' &&) \
$(OCAMLOPT) $(OFLAGS) -o $@ $(OLINKFLAGS) $^ $(OCAMLOPT) $(OFLAGS) -o $@ $(OLINKFLAGS) $^
bin/why3ide.byte: lib/why3/why3.cma $(IDECMO) bin/why3ide.byte: lib/why3/why3.cma src/ide/resetgc.o $(IDECMO)
$(if $(QUIET),@echo 'Linking $@' &&) \ $(if $(QUIET),@echo 'Linking $@' &&) \
$(OCAMLC) $(BFLAGS) -o $@ $(BLINKFLAGS) $^ $(OCAMLC) $(BFLAGS) -o $@ $(BLINKFLAGS) -custom $^
bin/why3ide: bin/why3ide.@OCAMLBEST@ bin/why3ide: bin/why3ide.@OCAMLBEST@
ln -sf why3ide.@OCAMLBEST@ $@ ln -sf why3ide.@OCAMLBEST@ $@
src/ide/resetgc.o: src/ide/resetgc.c
$(CC) $(CFLAGS) -c -o $@ $<
# depend and clean targets # depend and clean targets
ifneq "$(MAKECMDGOALS)" "clean" ifneq "$(MAKECMDGOALS)" "clean"
......
...@@ -19,6 +19,17 @@ open Stdlib ...@@ -19,6 +19,17 @@ open Stdlib
open Debug open Debug
module C = Whyconf module C = Whyconf
external reset_gc : unit -> unit = "ml_reset_gc"
(* Setting a Gc.alarm is pointless; the function has to be called manually
before each lablgtk operation. Indeed, each major slice resets
caml_extra_heap_resources to zero, but alarms are executed only at
finalization time, that is, after a full collection completes. Note that
manual calls can fail to prevent extraneous collections too, if a major
slice happens right in the middle of a sequence of lablgtk operations due
to memory starvation. Hopefully, it seldom happens. *)
let () = reset_gc ()
let debug = Debug.lookup_flag "ide_info" let debug = Debug.lookup_flag "ide_info"
(************************) (************************)
...@@ -621,6 +632,7 @@ module MA = struct ...@@ -621,6 +632,7 @@ module MA = struct
type key = GTree.row_reference type key = GTree.row_reference
let create ?parent () = let create ?parent () =
reset_gc ();
session_needs_saving := true; session_needs_saving := true;
let parent = match parent with let parent = match parent with
| None -> None | None -> None
...@@ -650,6 +662,7 @@ module MA = struct ...@@ -650,6 +662,7 @@ module MA = struct
let notify_timer_state = let notify_timer_state =
let c = ref 0 in let c = ref 0 in
fun t s r -> fun t s r ->
reset_gc ();
incr c; incr c;
monitor_waiting#set_text ("Waiting: " ^ (string_of_int t)); monitor_waiting#set_text ("Waiting: " ^ (string_of_int t));
monitor_scheduled#set_text ("Scheduled: " ^ (string_of_int s)); monitor_scheduled#set_text ("Scheduled: " ^ (string_of_int s));
...@@ -658,6 +671,7 @@ module MA = struct ...@@ -658,6 +671,7 @@ module MA = struct
"Running: " ^ (string_of_int r)^ " " ^ (fan (!c / 10))) "Running: " ^ (string_of_int r)^ " " ^ (fan (!c / 10)))
let notify any = let notify any =
reset_gc ();
session_needs_saving := true; session_needs_saving := true;
let row,expanded = let row,expanded =
match any with match any with
...@@ -707,6 +721,7 @@ let notify any = ...@@ -707,6 +721,7 @@ let notify any =
let init = let init =
let cpt = ref (-1) in let cpt = ref (-1) in
fun row any -> fun row any ->
reset_gc ();
let ind = goals_model#get ~row:row#iter ~column:index_column in let ind = goals_model#get ~row:row#iter ~column:index_column in
if ind < 0 then if ind < 0 then
begin begin
...@@ -1821,6 +1836,7 @@ let color_loc (v:GSourceView2.source_view) ~color l b e = ...@@ -1821,6 +1836,7 @@ let color_loc (v:GSourceView2.source_view) ~color l b e =
buf#apply_tag ~start ~stop color buf#apply_tag ~start ~stop color
let scroll_to_loc ?(yalign=0.0) ~color loc = let scroll_to_loc ?(yalign=0.0) ~color loc =
reset_gc ();
let (f,l,b,e) = Loc.get loc in let (f,l,b,e) = Loc.get loc in
if f <> !current_file then if f <> !current_file then
begin begin
......
#include <caml/mlvalues.h>
#include <caml/memory.h>
/* Whenever this variable reaches 1, a garbage collection starts and the
variable is reset to 0. Unfortunately, it might take as few as 50
allocations of Glib/Gdk/Gtk objects for the variable to go from 0 to 1.
Most IDE operations involve tens, if not, hundreds, of such objects,
thus causing the garbage collector to constantly run. */
extern double caml_extra_heap_resources;
/* Set the accumulator to -inf to prevent it from reaching 1. It might
still reach it, since any collection sets it to 0, so the hack only
works for a short while. */
CAMLprim value ml_reset_gc(value unit)
{
CAMLparam1(unit);
caml_extra_heap_resources = - 1. / 0.;
CAMLreturn(Val_unit);
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment