move GC hooks to a safe place for callbacks

git-svn-id: http://caml.inria.fr/svn/ocaml/version/4.02@16224 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

VERSION

@@ -1,4 +1,4 @@
-4.02.3+dev3-2015-07-20
+4.02.3+dev4-2015-07-20
 
 # The version string is the first line of this file.
 # It must be in the format described in stdlib/sys.mli

byterun/caml/misc.h

@@ -63,8 +63,10 @@ typedef char * addr;
 extern "C" {
 #endif
 
-/* GC timing hooks. These can be assigned by the user. The hook functions
-   must not allocate or change the heap in any way. */
+/* GC timing hooks. These can be assigned by the user.
+   [caml_minor_gc_begin_hook] must not allocate nor change any heap value.
+   The others can allocate and even call back to OCaml code.
+*/
 typedef void (*caml_timing_hook) (void);
 extern caml_timing_hook caml_major_slice_begin_hook, caml_major_slice_end_hook;
 extern caml_timing_hook caml_minor_gc_begin_hook, caml_minor_gc_end_hook;

byterun/finalise.c

@@ -125,6 +125,7 @@ void caml_final_do_calls (void)
   if (running_finalisation_function) return;
 
   if (to_do_hd != NULL){
+    if (caml_finalise_begin_hook != NULL) (*caml_finalise_begin_hook) ();
     caml_gc_message (0x80, "Calling finalisation functions.\n", 0);
     while (1){
       while (to_do_hd != NULL && to_do_hd->size == 0){
@@ -143,6 +144,7 @@ void caml_final_do_calls (void)
       if (Is_exception_result (res)) caml_raise (Extract_exception (res));
     }
     caml_gc_message (0x80, "Done calling finalisation functions.\n", 0);
+    if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) ();
   }
 }
 

byterun/major_gc.c

@@ -149,7 +149,6 @@ static void mark_slice (intnat work)
   int marking_closure = 0;
 #endif
 
-  if (caml_major_slice_begin_hook != NULL) (*caml_major_slice_begin_hook) ();
   caml_gc_message (0x40, "Marking %ld words\n", work);
   caml_gc_message (0x40, "Subphase = %ld\n", caml_gc_subphase);
   gray_vals_ptr = gray_vals_cur;
@@ -322,15 +321,13 @@ static void mark_slice (intnat work)
     }
   }
   gray_vals_cur = gray_vals_ptr;
-  if (caml_major_slice_end_hook != NULL) (*caml_major_slice_end_hook) ();
 }
 
 static void sweep_slice (intnat work)
 {
   char *hp;
   header_t hd;
 
-  if (caml_major_slice_begin_hook != NULL) (*caml_major_slice_begin_hook) ();
   caml_gc_message (0x40, "Sweeping %ld words\n", work);
   while (work > 0){
     if (caml_gc_sweep_hp < limit){
@@ -369,7 +366,6 @@ static void sweep_slice (intnat work)
       }
     }
   }
-  if (caml_major_slice_end_hook != NULL) (*caml_major_slice_end_hook) ();
 }
 
 /* The main entry point for the GC.  Called after each minor GC.
@@ -424,6 +420,8 @@ intnat caml_major_collection_slice (intnat howmuch)
      This slice will either mark MS words or sweep SS words.
   */
 
+  if (caml_major_slice_begin_hook != NULL) (*caml_major_slice_begin_hook) ();
+
   if (caml_gc_phase == Phase_idle) start_cycle ();
 
   p = (double) caml_allocated_words * 3.0 * (100 + caml_percent_free)
@@ -471,6 +469,7 @@ intnat caml_major_collection_slice (intnat howmuch)
   caml_allocated_words = 0;
   caml_dependent_allocated = 0;
   caml_extra_heap_resources = 0.0;
+  if (caml_major_slice_end_hook != NULL) (*caml_major_slice_end_hook) ();
   return computed_work;
 }
 

byterun/minor_gc.c

@@ -284,9 +284,7 @@ CAMLexport void caml_minor_collection (void)
   caml_major_collection_slice (0);
   caml_force_major_slice = 0;
 
-  if (caml_finalise_begin_hook != NULL) (*caml_finalise_begin_hook) ();
   caml_final_do_calls ();
-  if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) ();
 
   caml_empty_minor_heap ();
 }