finalisation de valeurs allouees

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

19 files changed, 349 insertions, 58 deletions

diff --git a/asmrun/Makefile b/asmrun/Makefile
index 3e6125f05..8693676c8 100644
--- a/asmrun/Makefile
+++ b/asmrun/Makefile
@@ -24,7 +24,7 @@ COBJS=startup.o main.o fail.o roots.o signals.o \
   misc.o freelist.o major_gc.o minor_gc.o memory.o alloc.o compare.o ints.o \
   floats.o str.o array.o io.o extern.o intern.o hash.o sys.o parsing.o \
   gc_ctrl.o terminfo.o md5.o obj.o lexing.o printexc.o callback.o weak.o \
-  compact.o
+  compact.o finalise.o
 
 ASMOBJS=$(ARCH).o
 
@@ -126,13 +126,15 @@ weak.c: ../byterun/weak.c
 	ln -s ../byterun/weak.c weak.c
 compact.c: ../byterun/compact.c
 	ln -s ../byterun/compact.c compact.c
+finalise.c: ../byterun/finalise.c
+	ln -s ../byterun/finalise.c finalise.c
 meta.c: ../byterun/meta.c
 	ln -s ../byterun/meta.c meta.c
 
 LINKEDFILES=misc.c freelist.c major_gc.c minor_gc.c memory.c alloc.c array.c \
   compare.c ints.c floats.c str.c io.c extern.c intern.c hash.c sys.c \
   parsing.c gc_ctrl.c terminfo.c md5.c obj.c lexing.c printexc.c callback.c \
-  weak.c compact.c meta.c
+  weak.c compact.c finalise.c meta.c
 
 clean::
 	rm -f $(LINKEDFILES)
diff --git a/asmrun/Makefile.nt b/asmrun/Makefile.nt
index 782a6e6ac..925855f10 100644
--- a/asmrun/Makefile.nt
+++ b/asmrun/Makefile.nt
@@ -22,7 +22,7 @@ COBJS=startup.obj main.obj fail.obj roots.obj signals.obj \
   compare.obj ints.obj floats.obj str.obj array.obj io.obj extern.obj \
   intern.obj hash.obj sys.obj parsing.obj gc_ctrl.obj terminfo.obj \
   md5.obj obj.obj lexing.obj wincmdline.obj printexc.obj callback.obj \
-  weak.obj compact.obj
+  weak.obj compact.obj finalise.obj
 
 ASMOBJS=$(ARCH)nt.obj
 
@@ -91,6 +91,8 @@ weak.c: ../byterun/weak.c
 	cp ../byterun/weak.c weak.c
 compact.c: ../byterun/compact.c
 	cp ../byterun/compact.c compact.c
+finalise.c: ../byterun/finalise.c
+	cp ../byterun/finalise.c finalise.c
 meta.c: ../byterun/meta.c
 	cp ../byterun/meta.c meta.c
 
diff --git a/asmrun/roots.c b/asmrun/roots.c
index 023705db1..08f5e9e2a 100644
--- a/asmrun/roots.c
+++ b/asmrun/roots.c
@@ -127,8 +127,7 @@ value * caml_gc_regs;
 long caml_globals_inited = 0;
 static long caml_globals_scanned = 0;
 
-/* Call [oldify] on all stack roots, C roots and global roots */
-
+/* Call [oldify] on (at least) all the roots that point to the minor heap. */
 void oldify_local_roots (void)
 {
   char * sp;
@@ -217,6 +216,8 @@ void oldify_local_roots (void)
   for (gr = global_roots; gr != NULL; gr = gr->next) {
     oldify(*(gr->root), gr->root);
   }
+  /* Finalised values */
+  final_do_young_roots (&oldify);
   /* Hook */
   if (scan_roots_hook != NULL) (*scan_roots_hook)(oldify);
 }
@@ -248,6 +249,8 @@ void do_roots (scanning_action f)
   for (gr = global_roots; gr != NULL; gr = gr->next) {
     f (*(gr->root), gr->root);
   }
+  /* Finalised values */
+  final_do_strong_roots (f);
   /* Hook */
   if (scan_roots_hook != NULL) (*scan_roots_hook)(f);
 }
diff --git a/byterun/Makefile b/byterun/Makefile
index 3e8ca8014..7f6d46ade 100644
--- a/byterun/Makefile
+++ b/byterun/Makefile
@@ -23,13 +23,13 @@ OBJS=interp.o misc.o stacks.o fix_code.o startup.o main.o \
   fail.o signals.o printexc.o \
   compare.o ints.o floats.o str.o array.o io.o extern.o intern.o \
   hash.o sys.o meta.o parsing.o gc_ctrl.o terminfo.o md5.o obj.o \
-  lexing.o callback.o debugger.o weak.o compact.o
+  lexing.o callback.o debugger.o weak.o compact.o finalise.o
 
 DOBJS=$(OBJS:.o=.d.o) instrtrace.d.o
 
 PRIMS=alloc.c array.c compare.c extern.c floats.c gc_ctrl.c hash.c \
   intern.c interp.c ints.c io.c lexing.c md5.c meta.c obj.c parsing.c \
-  signals.c str.c sys.c terminfo.c callback.c weak.c
+  signals.c str.c sys.c terminfo.c callback.c weak.c finalise.c
 
 PUBLIC_INCLUDES=mlvalues.h alloc.h misc.h callback.h fail.h
 
diff --git a/byterun/Makefile.Mac b/byterun/Makefile.Mac
index 6f788af00..78a18dddc 100644
--- a/byterun/Makefile.Mac
+++ b/byterun/Makefile.Mac
@@ -37,7 +37,7 @@ OBJS = interp.a.o misc.c.o stacks.c.o fix_code.c.o startup.c.o main.c.o ¶
   intern.c.o ¶
   hash.c.o sys.c.o meta.c.o parsing.c.o gc_ctrl.c.o terminfo.c.o md5.c.o ¶
   obj.c.o lexing.c.o macintosh.c.o rotatecursor.c.o printexc.c.o callback.c.o ¶
-  debugger.c.o weak.c.o compact.c.o instrtrace.c.o
+  debugger.c.o weak.c.o compact.c.o instrtrace.c.o finalise.c.o
 
 PPCOBJS = interp.c.x misc.c.x stacks.c.x fix_code.c.x startup.c.x main.c.x ¶
   freelist.c.x major_gc.c.x minor_gc.c.x memory.c.x alloc.c.x roots.c.x ¶
@@ -46,11 +46,11 @@ PPCOBJS = interp.c.x misc.c.x stacks.c.x fix_code.c.x startup.c.x main.c.x ¶
   intern.c.x ¶
   hash.c.x sys.c.x meta.c.x parsing.c.x gc_ctrl.c.x terminfo.c.x md5.c.x ¶
   obj.c.x lexing.c.x macintosh.c.x rotatecursor.c.x printexc.c.x callback.c.x ¶
-  debugger.c.x weak.c.x compact.c.x instrtrace.c.x
+  debugger.c.x weak.c.x compact.c.x instrtrace.c.x finalise.c.x
 
 PRIMS = alloc.c array.c compare.c extern.c floats.c gc_ctrl.c hash.c ¶
   intern.c interp.c ints.c io.c lexing.c md5.c meta.c obj.c parsing.c ¶
-  signals.c str.c sys.c terminfo.c callback.c weak.c
+  signals.c str.c sys.c terminfo.c callback.c weak.c finalise.c
 
 PUBLIC_INCLUDES = mlvalues.h alloc.h misc.h callback.h fail.h
 
diff --git a/byterun/Makefile.nt b/byterun/Makefile.nt
index 5ebaf7794..840924553 100644
--- a/byterun/Makefile.nt
+++ b/byterun/Makefile.nt
@@ -22,11 +22,12 @@ OBJS=interp.obj misc.obj stacks.obj fix_code.obj startup.obj main.obj \
   memory.obj alloc.obj roots.obj compare.obj ints.obj floats.obj \
   str.obj array.obj io.obj extern.obj intern.obj hash.obj sys.obj \
   meta.obj parsing.obj gc_ctrl.obj terminfo.obj md5.obj obj.obj lexing.obj \
-  wincmdline.obj printexc.obj callback.obj debugger.obj weak.obj compact.obj
+  wincmdline.obj printexc.obj callback.obj debugger.obj weak.obj compact.obj \
+  finalise.obj
 
 PRIMS=alloc.c array.c compare.c extern.c floats.c gc_ctrl.c hash.c \
   intern.c interp.c ints.c io.c lexing.c md5.c meta.c obj.c parsing.c \
-  signals.c str.c sys.c terminfo.c callback.c weak.c
+  signals.c str.c sys.c terminfo.c callback.c weak.c finalise.c
 
 PUBLIC_INCLUDES=mlvalues.h alloc.h misc.h callback.h fail.h
 
diff --git a/byterun/compact.c b/byterun/compact.c
index 22da4862a..68054d4af 100644
--- a/byterun/compact.c
+++ b/byterun/compact.c
@@ -15,6 +15,7 @@
 #include <string.h>
 
 #include "config.h"
+#include "finalise.h"
 #include "freelist.h"
 #include "gc.h"
 #include "gc_ctrl.h"
@@ -182,8 +183,10 @@ void compact_heap (void)
      Don't forget roots and weak pointers. */
   {
     /* Invert roots first because the threads library needs some heap
-       data structures to find its roots. */
+       data structures to find its roots.  Fortunately, it doesn't need
+       the headers (see above). */
     do_roots (invert_root);
+    final_do_weak_roots (invert_root);
 
     ch = heap_start;
     while (ch != NULL){
diff --git a/byterun/finalise.c b/byterun/finalise.c
new file mode 100644
index 000000000..62139e207
--- /dev/null
+++ b/byterun/finalise.c
@@ -0,0 +1,169 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Objective Caml                            */
+/*                                                                     */
+/*          Damien Doligez, projet Moscova, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 2000 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License.         */
+/*                                                                     */
+/***********************************************************************/
+
+/* $Id$ */
+
+/* Handling of finalised values. */
+
+#include "callback.h"
+#include "fail.h"
+#include "mlvalues.h"
+#include "roots.h"
+#include "signals.h"
+
+typedef struct final {
+  value fun;
+  value val;
+};
+
+static struct final *final_table = NULL;
+static unsigned long old = 0, young = 0, active = 0, size = 0;
+/* [0..old) : finalisable set
+   [old..young) : recent set
+   [young..active) : free space
+   [active..size) : finalising set
+*/
+
+/* Find white finalisable values, darken them, and put them in the
+   finalising set.
+   The recent set is empty.
+*/
+void final_update (void)
+{
+  unsigned long i;
+  
+  Assert (young == old);
+  Assert (young <= active);
+  for (i = 0; i < old; i++){
+    Assert (Is_block (final_table[i].val) && Is_in_heap (final_table[i].val));
+    if (Is_white_val (final_table[i].val)){
+      struct final f = final_table[i];
+      darken (f.val, NULL);
+      final_table[i] = final_table[--old];
+      final_table[--active] = f;
+      -- i;
+    }
+  }
+  young = old;
+}
+
+/* Call the finalisation functions for the finalising set.
+   Note that this function must be reentrant.
+*/
+void final_do_calls (void)
+{
+  struct final f;
+  
+  Assert (active <= size);
+  if (active < size){
+    gc_message (0x80, "Calling finalisation functions.\n", 0);
+    while (active < size){
+      f = final_table[active++];
+      callback (f.fun, f.val);
+    }
+    gc_message (0x80, "Done calling finalisation functions.\n", 0);
+  }
+}
+
+/* Call a scanning_action [f] on [x]. */
+#define Call_action(f,x) (*f) (x, &(x))
+
+/* Call [*f] on the closures of the finalisable set and
+   the closures and values of the finalising set.
+   The recent set is empty.
+   This is called by the major GC and the compactor through [darken_all_roots].
+*/
+void final_do_strong_roots (scanning_action f)
+{
+  unsigned long i;
+
+  Assert (old == young);
+  Assert (young <= active);
+  Assert (active <= size);
+  for (i = 0; i < old; i++) Call_action (f, final_table[i].fun);
+  for (i = active; i < size; i++){
+    Call_action (f, final_table[i].fun);
+    Call_action (f, final_table[i].val);
+  }
+}
+
+/* Call [*f] on the values of the finalisable set.
+   The recent set is empty.
+   This is called directly by the compactor.
+*/
+void final_do_weak_roots (scanning_action f)
+{
+  unsigned long i;
+
+  Assert (old == young);
+  for (i = 0; i < old; i++) Call_action (f, final_table[i].val);
+}
+
+/* Call [*f] on the closures and values of the recent set.
+   This is called by the minor GC through [oldify_local_roots].
+*/
+void final_do_young_roots (scanning_action f)
+{
+  unsigned long i;
+  
+  Assert (old <= young);
+  for (i = old; i < young; i++){
+    Call_action (f, final_table[i].fun);
+    Call_action (f, final_table[i].val);
+  }
+}
+
+/* Empty the recent set into the finalisable set.
+   This is called at the end of each minor collection.
+   The minor heap must be empty when this is called.
+*/
+void final_empty_young (void)
+{
+  old = young;
+}
+
+/* Put (f,v) in the recent set. */
+value final_register (value f, value v)       /* ML */
+{
+  if (!(Is_block (v) && (Is_in_heap (v) || Is_young (v)))){
+    invalid_argument ("Gc.finalise");
+  }
+
+  Assert (old <= young);
+  Assert (young <= active);
+  Assert (active <= size);
+  
+  if (young >= active){
+    if (final_table == NULL){
+      unsigned long new_size = 30;
+      final_table = stat_alloc (new_size * sizeof (struct final));
+      Assert (old == 0 && young == 0);
+      active = size = new_size;
+    }else{
+      unsigned long new_size = size * 2;
+      unsigned long i;
+      final_table = stat_resize (final_table, new_size * sizeof (struct final));
+      for (i = size-1; i >= active; i--){
+        final_table[i + new_size - size] = final_table[i];
+      }
+      active += new_size - size;
+      size = new_size;
+    }
+  }
+  Assert (young < active);
+  final_table[young].fun = f;
+  if (Tag_val (v) == Infix_tag) v -= Infix_offset_val (v);
+  final_table[young].val = v;
+  ++ young;
+
+  return Val_unit;
+}
diff --git a/byterun/finalise.h b/byterun/finalise.h
new file mode 100644
index 000000000..e0f7c8807
--- /dev/null
+++ b/byterun/finalise.h
@@ -0,0 +1,23 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Objective Caml                            */
+/*                                                                     */
+/*          Damien Doligez, projet Moscova, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 2000 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License.         */
+/*                                                                     */
+/***********************************************************************/
+
+/* $Id$ */
+
+#include "roots.h"
+
+void final_update (void);
+void final_do_calls (void);
+void final_do_strong_roots (scanning_action f);
+void final_do_weak_roots (scanning_action f);
+void final_do_young_roots (scanning_action f);
+void final_minor_gc_done (void);
+value final_register (value f, value v);
diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c
index 662f742a6..a0adb0cdc 100644
--- a/byterun/gc_ctrl.c
+++ b/byterun/gc_ctrl.c
@@ -124,7 +124,7 @@ static value heap_stats (int returnstats)
   header_t cur_hd;
 
 #ifdef DEBUG
-  gc_message (0xFFFF, "### O'Caml runtime: heap check ###\n", 0);
+  gc_message (-1, "### O'Caml runtime: heap check ###\n", 0);
 #endif
 
   while (chunk != NULL){
@@ -336,22 +336,26 @@ value gc_minor(value v) /* ML */
 
 value gc_major(value v) /* ML */
 {                                                    Assert (v == Val_unit);
-  minor_collection ();
+  empty_minor_heap ();
   finish_major_cycle ();
+  final_do_calls ();
   return Val_unit;
 }
 
 value gc_full_major(value v) /* ML */
 {                                                    Assert (v == Val_unit);
-  minor_collection ();
+  empty_minor_heap ();
   finish_major_cycle ();
+  final_do_calls ();
+  empty_minor_heap ();
   finish_major_cycle ();
+  final_do_calls ();
   return Val_unit;
 }
 
 value gc_compaction(value v) /* ML */
 {                                                    Assert (v == Val_unit);
-  minor_collection ();
+  empty_minor_heap ();
   finish_major_cycle ();
   finish_major_cycle ();
   compact_heap ();
@@ -365,12 +369,13 @@ void init_gc (unsigned long minor_size, unsigned long major_size,
   unsigned long major_heap_size = Bsize_wsize (norm_heapincr (major_size));
 
 #ifdef DEBUG
-  gc_message (0xFFFF, "### O'Caml runtime: debug mode "
+  gc_message (-1, "### O'Caml runtime: debug mode "
 #ifdef CPU_TYPE_STRING
                                "(" CPU_TYPE_STRING ") "
 #endif
                                                        "###\n", 0);
 #endif /* DEBUG */
+/* FIXME remove comments in preprocessor lines (ANSI C wart) */
 
   verb_gc = verb;
   set_minor_heap_size (Bsize_wsize (norm_minsize (minor_size)));
diff --git a/byterun/major_gc.c b/byterun/major_gc.c
index 247a0ce00..a34ebd4fa 100644
--- a/byterun/major_gc.c
+++ b/byterun/major_gc.c
@@ -17,6 +17,7 @@
 #include "compact.h"
 #include "config.h"
 #include "fail.h"
+#include "finalise.h"
 #include "freelist.h"
 #include "gc.h"
 #include "gc_ctrl.h"
@@ -104,6 +105,7 @@ static void mark_slice (long work)
   header_t hd;
   mlsize_t size, i;
 
+  gc_message (0x40, "Marking %lu words\n", work);
   gray_vals_ptr = gray_vals_cur;
   while (work > 0){
     if (gray_vals_ptr > gray_vals){
@@ -155,11 +157,17 @@ static void mark_slice (long work)
       chunk = heap_start;
       markhp = chunk;
       limit = chunk + Chunk_size (chunk);
+    }else if (gc_phase == Phase_mark){
+      /* The main marking phase is over.  Handle finalised values. */
+      gray_vals_cur = gray_vals_ptr;
+      final_update ();
+      gray_vals_ptr = gray_vals_cur;
+      gc_phase = Phase_mark_final;
     }else{
       /* Marking is done. */
 
       update_weak_pointers ();
-      
+
       /* Initialise the sweep phase. */
       gray_vals_cur = gray_vals_ptr;
       gc_sweep_hp = heap_start;
@@ -209,6 +217,7 @@ static void sweep_slice (long int work)
   char *hp;
   header_t hd;
 
+  gc_message (0x40, "Sweeping %lu words\n", work);
   while (work > 0){
     if (gc_sweep_hp < limit){
       hp = gc_sweep_hp;
@@ -247,11 +256,11 @@ static void sweep_slice (long int work)
   }
 }
 
-/* The main entry point for the GC.  Called at each minor GC. */
+/* The main entry point for the GC.  Called after each minor GC. */
 void major_collection_slice (void)
 {
   double p;
-  /* 
+  /*
      Free memory at the start of the GC cycle (garbage + free list) (assumed):
                  FM = stat_heap_size * percent_free / (100 + percent_free)
      Garbage at the start of the GC cycle:
@@ -291,19 +300,13 @@ void major_collection_slice (void)
   gc_message (0x40, "amount of work to do = %luu\n",
               (unsigned long) (p * 1000000));
 
-  if (gc_phase == Phase_mark){
+  if (gc_phase == Phase_mark || gc_phase == Phase_mark_final){
     long work = (long) (p * stat_heap_size * 100 / (100+percent_free)) + Margin;
-    if (verb_gc & 0x40){
-      gc_message (0x40, "Marking %lu words\n", work);
-    }
     mark_slice (work);
     gc_message (0x02, "!", 0);
   }else{
     long work = (long) (p * stat_heap_size) + Margin;
     Assert (gc_phase == Phase_sweep);
-    if (verb_gc & 0x40){
-      gc_message (0x40, "Sweeping %lu words\n", work);
-    }
     sweep_slice (work);
     gc_message (0x02, "$", 0);
   }
@@ -315,7 +318,9 @@ void major_collection_slice (void)
   extra_heap_memory = 0.0;
 }
 
-/* The minor heap must be empty when this function is called. */
+/* The minor heap must be empty when this function is called;
+   the minor heap is empty when this function returns.
+*/
 /* This does not call compact_heap_maybe because the estimations of
    free and live memory are only valid for a cycle done incrementally.
    Besides, this function is called by compact_heap_maybe.
@@ -369,7 +374,7 @@ void init_major_heap (asize_t heap_size)
   page_high = Page (heap_end);
 
   page_table_size = page_high - page_low;
-  page_table_block = 
+  page_table_block =
     (page_table_entry *) malloc (page_table_size * sizeof (page_table_entry));
   if (page_table_block == NULL){
     fatal_error ("Fatal error: not enough memory for the initial heap.\n");
diff --git a/byterun/major_gc.h b/byterun/major_gc.h
index 3d58ebfac..0b86b6072 100644
--- a/byterun/major_gc.h
+++ b/byterun/major_gc.h
@@ -36,6 +36,7 @@ extern unsigned long allocated_words;
 extern double extra_heap_memory;
 
 #define Phase_mark 0
+#define Phase_mark_final 3
 #define Phase_sweep 1
 #define Phase_idle 2
 
diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c
index 735135516..893ddf9a7 100644
--- a/byterun/minor_gc.c
+++ b/byterun/minor_gc.c
@@ -15,6 +15,7 @@
 #include <string.h>
 #include "config.h"
 #include "fail.h"
+#include "finalise.h"
 #include "gc.h"
 #include "gc_ctrl.h"
 #include "major_gc.h"
@@ -117,26 +118,46 @@ void oldify (value v, value *p)
   }
 }
 
-void minor_collection (void)
+/* Make sure the minor heap is empty by performing a minor collection
+   if needed.
+*/
+void empty_minor_heap (void)
 {
   value **r;
+
+  if (young_ptr != young_end){
+    in_minor_collection = 1;
+    gc_message (0x02, "<", 0);
+    oldify_local_roots();
+    for (r = ref_table; r < ref_table_ptr; r++) oldify (**r, *r);
+    stat_minor_words += Wsize_bsize (young_end - young_ptr);
+    young_ptr = young_end;
+    ref_table_ptr = ref_table;
+    ref_table_limit = ref_table_threshold;
+    gc_message (0x02, ">", 0);
+    in_minor_collection = 0;
+  }
+  final_empty_young ();
+}
+
+/* Do a minor collection and a slice of major collection, call finalisation
+   functions, etc.
+   Leave the minor heap empty.
+*/
+void minor_collection (void)
+{
   long prev_alloc_words = allocated_words;
 
-  in_minor_collection = 1;
-  gc_message (0x02, "<", 0);
-  oldify_local_roots();
-  for (r = ref_table; r < ref_table_ptr; r++) oldify (**r, *r);
-  stat_minor_words += Wsize_bsize (young_end - young_ptr);
-  young_ptr = young_end;
-  ref_table_ptr = ref_table;
-  ref_table_limit = ref_table_threshold;
-  gc_message (0x02, ">", 0);
-  in_minor_collection = 0;
+  empty_minor_heap ();
 
   stat_promoted_words += allocated_words - prev_alloc_words;
   ++ stat_minor_collections;
   major_collection_slice ();
   force_major_slice = 0;
+  
+  final_do_calls ();
+
+  empty_minor_heap ();
 }
 
 value check_urgent_gc (value extra_root)
diff --git a/byterun/minor_gc.h b/byterun/minor_gc.h
index 0ad37070c..196d4ef3d 100644
--- a/byterun/minor_gc.h
+++ b/byterun/minor_gc.h
@@ -24,9 +24,10 @@ extern asize_t minor_heap_size;
 extern int in_minor_collection;
 
 #define Is_young(val) \
-  ((addr)(val) > (addr)young_start && (addr)(val) < (addr)young_end)
+  ((addr)(val) < (addr)young_end && (addr)(val) > (addr)young_start)
 
 extern void set_minor_heap_size (asize_t);
+extern void empty_minor_heap (void);
 extern void minor_collection (void);
 extern void garbage_collection (void); /* for the native-code system */
 extern void realloc_ref_table (void);
diff --git a/byterun/roots.c b/byterun/roots.c
index 42d802d3a..9235b843d 100644
--- a/byterun/roots.c
+++ b/byterun/roots.c
@@ -24,6 +24,7 @@
 
 struct caml__roots_block *local_roots = NULL;
 
+/* FIXME turn this into a table and synchronise with asmrun/roots.c */
 struct global_root {
   value * root;
   struct global_root * next;
@@ -61,8 +62,8 @@ void remove_global_root(value *r)
   }
 }
 
-/* Call [oldify] on all roots except [global_data] */
-
+/* FIXME rename to [oldify_young_roots] and synchronise with asmrun/roots.c */
+/* Call [oldify] on (at least) all the roots that point to the minor heap. */
 void oldify_local_roots (void)
 {
   register value * sp;
@@ -74,7 +75,7 @@ void oldify_local_roots (void)
   for (sp = extern_sp; sp < stack_high; sp++) {
     oldify (*sp, sp);
   }
-  /* Local C roots */
+  /* Local C roots */  /* FIXME do the old-frame trick ? */
   for (lr = local_roots; lr != NULL; lr = lr->next) {
     for (i = 0; i < lr->ntables; i++){
       for (j = 0; j < lr->nitems; j++){
@@ -87,8 +88,10 @@ void oldify_local_roots (void)
   for (gr = global_roots; gr != NULL; gr = gr->next) {
     oldify(*(gr->root), gr->root);
   }
+  /* Finalised values */
+  final_do_young_roots (&oldify);
   /* Hook */
-  if (scan_roots_hook != NULL) (*scan_roots_hook)(oldify);
+  if (scan_roots_hook != NULL) (*scan_roots_hook)(&oldify);
 }
 
 /* Call [darken] on all roots */
@@ -112,11 +115,14 @@ void do_roots (scanning_action f)
   for (gr = global_roots; gr != NULL; gr = gr->next) {
     f (*(gr->root), gr->root);
   }
+  /* Finalised values */
+  final_do_strong_roots (f);
   /* Hook */
   if (scan_roots_hook != NULL) (*scan_roots_hook)(f);
 }
 
-void do_local_roots (scanning_action f, value *stack_low, value *stack_high, struct caml__roots_block *local_roots)
+void do_local_roots (scanning_action f, value *stack_low, value *stack_high,
+                     struct caml__roots_block *local_roots)
 {
   register value * sp;
   struct caml__roots_block *lr;
diff --git a/byterun/roots.h b/byterun/roots.h
index 99240d6c5..b8ce028dd 100644
--- a/byterun/roots.h
+++ b/byterun/roots.h
@@ -20,7 +20,7 @@
 
 typedef void (*scanning_action) (value, value *);
 
-void oldify_local_roots (void);
+void oldify_young_roots (void);
 void darken_all_roots (void);
 void do_roots (scanning_action);
 #ifndef NATIVE_CODE
diff --git a/stdlib/gc.ml b/stdlib/gc.ml
index a6a874eaa..9dcc5ae19 100644
--- a/stdlib/gc.ml
+++ b/stdlib/gc.ml
@@ -70,3 +70,5 @@ let print_stat c =
 let allocated_bytes () =
   let (mi, ma, pro) = counters () in (mi + ma - pro) * (Sys.word_size / 8)
 ;;
+
+external finalise : ('a -> unit) -> 'a -> unit = "final_register";;
diff --git a/stdlib/gc.mli b/stdlib/gc.mli
index 347e29d9f..61f9f822d 100644
--- a/stdlib/gc.mli
+++ b/stdlib/gc.mli
@@ -12,7 +12,9 @@
 
 (* $Id$ *)
 
-(* Module [Gc]: memory management control and statistics *)
+(* Module [Gc]:
+   memory management control and statistics; finalised values
+*)
 
 type stat = {
   minor_words : int;
@@ -97,13 +99,14 @@ type control = {
 -     [verbose]  This value controls the GC messages on standard error output.
              It is a sum of some of the following flags, to print messages
              on the corresponding events:
--            [1 ] Start of major GC cycle.
--            [2 ] Minor collection and major GC slice.
--            [4 ] Growing and shrinking of the heap.
--            [8 ] Resizing of stacks and memory manager tables.
--            [16] Heap compaction.
--            [32] Change of GC parameters.
--            [64] Computation of major GC slice size.
+-            [0x01] Start of major GC cycle.
+-            [0x02] Minor collection and major GC slice.
+-            [0x04] Growing and shrinking of the heap.
+-            [0x08] Resizing of stacks and memory manager tables.
+-            [0x10] Heap compaction.
+-            [0x20] Change of GC parameters.
+-            [0x40] Computation of major GC slice size.
+-            [0x80] Calling of finalisation functions.
              Default: 0.
 -     [stack_limit]  The maximum size of the stack (in words).  This is only
              relevant to the byte-code runtime, as the native code runtime
@@ -139,4 +142,48 @@ val print_stat : out_channel -> unit
 
 val allocated_bytes : unit -> int
   (* Return the total number of bytes allocated since the program was
-     started. *)
+     started.  Warning: on 32-bit machines, this counter can easily
+     get beyond [max_int] and roll over. *)
+
+
+val finalise : ('a -> unit) -> 'a -> unit;;
+  (* [Gc.finalise f v] registers [f] as a finalisation function for [v].
+     [v] must be heap-allocated.  [f] will be called with [v] as
+     argument at some point between the first time [v] becomes unreachable
+     and the time [v] is collected by the GC.  Several functions can
+     be registered for the same value, or even several instances of the
+     same function.  Each instance will be called once (or never,
+     if the program terminates before the GC deallocates [v]).
+     
+     A number of pitfalls are associated with finalised values:
+     finalisation functions are called asynchronously, sometimes
+     even during the execution of other finalisation functions.
+     In a multithreaded program, finalisation functions are called
+     from any thread, thus they cannot not acquire any mutex.
+
+     Anything reachable from the closure of finalisation functions
+     is considered reachable, so the following code will not work:
+-    [ let v = ... in Gc.finalise (fun x -> ...) v ]
+     Instead you should write:
+-    [ let f = fun x -> ... ;; let v = ... in Gc.finalise f v ]
+     
+     The [f] function can use all features of O'Caml, including
+     assignments that make the value reachable again (indeed, the value
+     is already reachable from the stack during the execution of the
+     function).  It can also loop forever (in this case, the other
+     finalisation functions will be called during the execution of f).
+     It can call [Gc.finalise] on [v] or other values to register other
+     functions or even itself.  It can raise an exception; in this case
+     the exception will interrupt whatever the program was doing when
+     the function was called.
+     
+     [Gc.finalise] will raise [Invalid_argument "Gc.finalise"] if [v]
+     is not heap-allocated.  Some examples of values that are not
+     heap-allocated are integers, constant constructors, booleans,
+     the empty array, the empty list, the unit value.  The exact list
+     of what is heap-allocated or not is implementation-dependent.
+     You should also be aware that some optimisations will duplicate
+     some immutable values, especially floating-point numbers when
+     stored into arrays, so they can be finalised and collected while
+     another copy is still in use by the program.
+  *)
diff --git a/utils/config.mlp b/utils/config.mlp
index 2bf5a7ee3..c01c07ad0 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -12,7 +12,7 @@
 
 (* $Id$ *)
 
-let version = "2.99 (1999-12-32)"
+let version = "2.99 (2000-01-07)"
 
 let standard_library =
   try