better anti-fragmentation measures

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

13 files changed, 259 insertions, 77 deletions

diff --git a/VERSION b/VERSION
index 71f5ad659..6d24c1d09 100644
--- a/VERSION
+++ b/VERSION
@@ -1,4 +1,4 @@
-3.11+dev10 Private_abbrevs+natdynlink (2008-01-22)
+3.11+dev11 Private_abbrevs+natdynlink (2008-02-29)
 
 # The version string is the first line of this file.
 # It must be in the format described in stdlib/sys.mli
diff --git a/boot/ocamlc b/boot/ocamlc
index 54149e4c7..ba5682cc2 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamldep b/boot/ocamldep
index 86a6d5a5b..1c5778385 100755
--- a/boot/ocamldep
+++ b/boot/ocamldep
diff --git a/boot/ocamllex b/boot/ocamllex
index 9eeea0fdf..e1f22025c 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
diff --git a/byterun/compact.c b/byterun/compact.c
index 25a0080b1..ba1042fbe 100644
--- a/byterun/compact.c
+++ b/byterun/compact.c
@@ -38,7 +38,7 @@ extern void caml_shrink_heap (char *);              /* memory.c */
    1: integer or (unencoded) infix header
    2: inverted pointer for infix header
    3: integer or encoded (noninfix) header
-   
+
   XXX Should be fixed:
   XXX The above assumes that all roots are aligned on a 4-byte boundary,
   XXX which is not always guaranteed by C.
@@ -203,7 +203,7 @@ void caml_compact_heap (void)
         while (Ecolor (q) == 0) q = * (word *) q;
         sz = Whsize_ehd (q);
         t = Tag_ehd (q);
-        
+
         if (t == Infix_tag){
           /* Get the original header of this block. */
           infixes = p + sz;
@@ -252,18 +252,18 @@ void caml_compact_heap (void)
     ch = caml_heap_start;
     while (ch != NULL){
       word *p = (word *) ch;
-      
+
       chend = ch + Chunk_size (ch);
       while ((char *) p < chend){
         word q = *p;
-        
+
         if (Ecolor (q) == 0 || Tag_ehd (q) == Infix_tag){
           /* There were (normal or infix) pointers to this block. */
           size_t sz;
           tag_t t;
           char *newadr;
           word *infixes = NULL;
-          
+
           while (Ecolor (q) == 0) q = * (word *) q;
           sz = Whsize_ehd (q);
           t = Tag_ehd (q);
@@ -393,7 +393,7 @@ void caml_compact_heap (void)
   caml_gc_message (0x10, "done.\n", 0);
 }
 
-uintnat caml_percent_max;  /* used in gc_ctrl.c */
+uintnat caml_percent_max;  /* used in gc_ctrl.c and memory.c */
 
 void caml_compact_heap_maybe (void)
 {
@@ -408,7 +408,7 @@ void caml_compact_heap_maybe (void)
   float fw, fp;
                                           Assert (caml_gc_phase == Phase_idle);
   if (caml_percent_max >= 1000000) return;
-  if (caml_stat_major_collections < 5 || caml_stat_heap_chunks < 2) return;
+  if (caml_stat_major_collections < 3 || caml_stat_heap_chunks < 3) return;
 
   fw = 3.0 * caml_fl_cur_size - 2.0 * caml_fl_size_at_phase_change;
   if (fw < 0) fw = caml_fl_cur_size;
diff --git a/byterun/freelist.c b/byterun/freelist.c
index d91f7f243..da1b62eec 100644
--- a/byterun/freelist.c
+++ b/byterun/freelist.c
@@ -13,6 +13,8 @@
 
 /* $Id$ */
 
+#include <string.h>
+
 #include "config.h"
 #include "freelist.h"
 #include "gc.h"
@@ -41,7 +43,6 @@ static struct {
 } sentinel = {0, Make_header (0, 0, Caml_blue), 0, 0};
 
 #define Fl_head ((char *) (&(sentinel.first_bp)))
-static char *fl_prev = Fl_head;  /* Current allocation pointer. */
 static char *fl_last = NULL;     /* Last block in the list.  Only valid
                                  just after [caml_fl_allocate] returns NULL. */
 char *caml_fl_merge = Fl_head;   /* Current insertion pointer.  Managed
@@ -49,26 +50,41 @@ char *caml_fl_merge = Fl_head;   /* Current insertion pointer.  Managed
 asize_t caml_fl_cur_size = 0;    /* Number of words in the free list,
                                     including headers but not fragments. */
 
+#define FLP_MAX 1000
+static char *flp [FLP_MAX];
+static int flp_size = 0;
+static char *beyond = NULL;
+
 #define Next(b) (((block *) (b))->next_bp)
 
 #ifdef DEBUG
 static void fl_check (void)
 {
   char *cur, *prev;
-  int prev_found = 0, merge_found = 0;
+  int merge_found = 0;
   uintnat size_found = 0;
+  int flp_found = 0;
+  int sz = 0;
 
   prev = Fl_head;
   cur = Next (prev);
   while (cur != NULL){
     size_found += Whsize_bp (cur);
     Assert (Is_in_heap (cur));
-    if (cur == fl_prev) prev_found = 1;
+    if (Wosize_bp (cur) > sz){
+      sz = Wosize_bp (cur);
+      if (flp_found < flp_size){
+        Assert (Next (flp[flp_found]) == cur);
+        ++ flp_found;
+      }else{
+        Assert (beyond == NULL || cur >= Next (beyond));
+      }
+    }
     if (cur == caml_fl_merge) merge_found = 1;
     prev = cur;
     cur = Next (prev);
   }
-  Assert (prev_found || fl_prev == Fl_head);
+  Assert (flp_found == flp_size);
   Assert (merge_found || caml_fl_merge == Fl_head);
   Assert (size_found == caml_fl_cur_size);
 }
@@ -88,7 +104,7 @@ static void fl_check (void)
    it is located in the high-address words of the free block.  This way,
    the linking of the free-list does not change in case 2.
 */
-static char *allocate_block (mlsize_t wh_sz, char *prev, char *cur)
+static char *allocate_block (mlsize_t wh_sz, int flpi, char *prev, char *cur)
 {
   header_t h = Hd_bp (cur);
                                              Assert (Whsize_hd (h) >= wh_sz);
@@ -104,13 +120,18 @@ static char *allocate_block (mlsize_t wh_sz, char *prev, char *cur)
          In case 0, it gives an invalid header to the block.  The function
          calling [caml_fl_allocate] will overwrite it. */
     Hd_op (cur) = Make_header (0, 0, Caml_white);
+    if (flpi + 1 < flp_size && flp[flpi + 1] == cur){
+      flp[flpi + 1] = prev;
+    }else if (flpi == flp_size - 1){
+      beyond = (prev == Fl_head) ? NULL : prev;
+      -- flp_size;
+    }
   }else{                                                        /* Case 2. */
     caml_fl_cur_size -= wh_sz;
     Hd_op (cur) = Make_header (Wosize_hd (h) - wh_sz, 0, Caml_blue);
   }
-  fl_prev = prev;
   return cur + Bosize_hd (h) - Bsize_wsize (wh_sz);
-}  
+}
 
 /* [caml_fl_allocate] does not set the header of the newly allocated block.
    The calling function must do it before any GC function gets called.
@@ -118,33 +139,129 @@ static char *allocate_block (mlsize_t wh_sz, char *prev, char *cur)
 */
 char *caml_fl_allocate (mlsize_t wo_sz)
 {
-  char *cur, *prev;
+  char *cur = NULL, *prev, *result;
+  int i;
+  mlsize_t sz, prevsz;
                                   Assert (sizeof (char *) == sizeof (value));
-                                  Assert (fl_prev != NULL);
                                   Assert (wo_sz >= 1);
-    /* Search from [fl_prev] to the end of the list. */
-  prev = fl_prev;
-  cur = Next (prev);
-  while (cur != NULL){                             Assert (Is_in_heap (cur));
-    if (Wosize_bp (cur) >= wo_sz){
-      return allocate_block (Whsize_wosize (wo_sz), prev, cur);
+  /* Search in the flp array. */
+  for (i = 0; i < flp_size; i++){
+    sz = Wosize_bp (Next (flp[i]));
+    if (sz >= wo_sz){
+      result = allocate_block (Whsize_wosize (wo_sz), i, flp[i], Next (flp[i]));
+      goto update_flp;
     }
-    prev = cur;
+  }
+  /* Extend the flp array. */
+  if (flp_size == 0){
+    prev = Fl_head;
+    prevsz = 0;
+  }else{
+    prev = Next (flp[flp_size - 1]);
+    prevsz = Wosize_bp (prev);
+    if (beyond != NULL) prev = beyond;
+  }
+  while (flp_size < FLP_MAX){
     cur = Next (prev);
+    if (cur == NULL){
+      fl_last = prev;
+      beyond = (prev == Fl_head) ? NULL : prev;
+      return NULL;
+    }else{
+      sz = Wosize_bp (cur);
+      if (sz > prevsz){
+        flp[flp_size] = prev;
+        ++ flp_size;
+        if (sz >= wo_sz){
+          beyond = cur;
+          i = flp_size - 1;
+          result = allocate_block (Whsize_wosize (wo_sz), flp_size - 1, prev,
+                                   cur);
+          goto update_flp;
+        }
+        prevsz = sz;
+      }
+    }
+    prev = cur;
   }
-  fl_last = prev;
-    /* Search from the start of the list to [fl_prev]. */
-  prev = Fl_head;
+  beyond = cur;
+
+  /* The flp table is full.  Do a slow first-fit search. */
+
+  if (beyond != NULL){
+    prev = beyond;
+  }else{
+    prev = flp[flp_size - 1];
+  }
+  prevsz = Wosize_bp (Next (flp[FLP_MAX-1]));
+  Assert (prevsz < wo_sz);
   cur = Next (prev);
-  while (prev != fl_prev){
-    if (Wosize_bp (cur) >= wo_sz){
-      return allocate_block (Whsize_wosize (wo_sz), prev, cur);
+  while (cur != NULL){
+    Assert (Is_in_heap (cur));
+    sz = Wosize_bp (cur);
+    if (sz < prevsz){
+      beyond = cur;
+    }else if (sz >= wo_sz){
+      return allocate_block (Whsize_wosize (wo_sz), flp_size, prev, cur);
     }
     prev = cur;
     cur = Next (prev);
   }
-    /* No suitable block was found. */
+  fl_last = prev;
   return NULL;
+
+ update_flp: /* (i, sz) */
+  /* The block at [i] was removed or reduced.  Update the table. */
+  Assert (0 <= i && i < flp_size + 1);
+  if (i < flp_size){
+    if (i > 0){
+      prevsz = Wosize_bp (Next (flp[i-1]));
+    }else{
+      prevsz = 0;
+    }
+    if (i == flp_size - 1){
+      if (Wosize_bp (Next (flp[i])) <= prevsz){
+        beyond = Next (flp[i]);
+        -- flp_size;
+      }else{
+        beyond = NULL;
+      }
+    }else{
+      char *buf [FLP_MAX];
+      int j = 0;
+      mlsize_t oldsz = sz;
+
+      prev = flp[i];
+      while (prev != flp[i+1]){
+        cur = Next (prev);
+        sz = Wosize_bp (cur);
+        if (sz > prevsz){
+          buf[j++] = prev;
+          prevsz = sz;
+          if (sz >= oldsz){
+            Assert (sz == oldsz);
+            break;
+          }
+        }
+        prev = cur;
+      }
+      if (FLP_MAX >= flp_size + j - 1){
+        memmove (&flp[i+j], &flp[i+1], sizeof (block *) * (flp_size - i - 1));
+        memmove (&flp[i], &buf[0], sizeof (block *) * j);
+        flp_size += j - 1;
+      }else{
+        if (FLP_MAX > i + j){
+          memmove (&flp[i+j], &flp[i+1], sizeof (block *) * (FLP_MAX - i - j));
+          memmove (&flp[i], &buf[0], sizeof (block *) * j);
+        }else{
+          memmove (&flp[i], &buf[0], sizeof (block *) * (FLP_MAX - i));
+        }
+        flp_size = FLP_MAX - 1;
+        beyond = Next (flp[FLP_MAX - 1]);
+      }
+    }
+  }
+  return result;
 }
 
 static char *last_fragment;
@@ -158,11 +275,22 @@ void caml_fl_init_merge (void)
 #endif
 }
 
+static void truncate_flp (char *changed)
+{
+  if (changed == Fl_head){
+    flp_size = 0;
+    beyond = NULL;
+  }else{
+    while (flp_size > 0 && Next (flp[flp_size - 1]) >= changed) -- flp_size;
+    if (beyond >= changed) beyond = NULL;
+  }
+}
+
 /* This is called by caml_compact_heap. */
 void caml_fl_reset (void)
 {
-  Next (Fl_head) = 0;
-  fl_prev = Fl_head;
+  Next (Fl_head) = NULL;
+  truncate_flp (Fl_head);
   caml_fl_cur_size = 0;
   caml_fl_init_merge ();
 }
@@ -176,14 +304,9 @@ char *caml_fl_merge_block (char *bp)
   mlsize_t prev_wosz;
 
   caml_fl_cur_size += Whsize_hd (hd);
-  
+
 #ifdef DEBUG
-  {
-    mlsize_t i;
-    for (i = 0; i < Wosize_hd (hd); i++){
-      Field (Val_bp (bp), i) = Debug_free_major;
-    }
-  }
+  caml_set_fields (bp, 0, Debug_free_major);
 #endif
   prev = caml_fl_merge;
   cur = Next (prev);
@@ -192,6 +315,8 @@ char *caml_fl_merge_block (char *bp)
   Assert (prev < bp || prev == Fl_head);
   Assert (cur > bp || cur == NULL);
 
+  truncate_flp (prev);
+
   /* If [last_fragment] and [bp] are adjacent, merge them. */
   if (last_fragment == Hp_bp (bp)){
     mlsize_t bp_whsz = Whsize_bp (bp);
@@ -212,7 +337,6 @@ char *caml_fl_merge_block (char *bp)
 
     if (Wosize_hd (hd) + cur_whsz <= Max_wosize){
       Next (prev) = next_cur;
-      if (fl_prev == cur) fl_prev = prev;
       hd = Make_header (Wosize_hd (hd) + cur_whsz, 0, Caml_blue);
       Hd_bp (bp) = hd;
       adj = bp + Bosize_hd (hd);
@@ -250,45 +374,47 @@ char *caml_fl_merge_block (char *bp)
 
 /* This is a heap extension.  We have to insert it in the right place
    in the free-list.
-   [caml_fl_add_block] can only be called right after a call to
+   [caml_fl_add_blocks] can only be called right after a call to
    [caml_fl_allocate] that returned NULL.
    Most of the heap extensions are expected to be at the end of the
    free list.  (This depends on the implementation of [malloc].)
+
+   [bp] must point to a list of blocks chained by their field 0,
+   terminated by NULL, and field 1 of the first block must point to
+   the last block.
 */
-void caml_fl_add_block (char *bp)
+void caml_fl_add_blocks (char *bp)
 {
                                                    Assert (fl_last != NULL);
                                             Assert (Next (fl_last) == NULL);
-#ifdef DEBUG
-  {
-    mlsize_t i;
-    for (i = 0; i < Wosize_bp (bp); i++){
-      Field (Val_bp (bp), i) = Debug_free_major;
-    }
-  }
-#endif
-
   caml_fl_cur_size += Whsize_bp (bp);
 
   if (bp > fl_last){
     Next (fl_last) = bp;
-    Next (bp) = NULL;
+    if (fl_last == caml_fl_merge && bp < caml_gc_sweep_hp){
+      caml_fl_merge = (char *) Field (bp, 1);
+    }
+    if (flp_size < FLP_MAX) flp [flp_size++] = fl_last;
   }else{
     char *cur, *prev;
 
     prev = Fl_head;
     cur = Next (prev);
     while (cur != NULL && cur < bp){   Assert (prev < bp || prev == Fl_head);
+      /* XXX TODO: extend flp on the fly */
       prev = cur;
       cur = Next (prev);
     }                                  Assert (prev < bp || prev == Fl_head);
                                             Assert (cur > bp || cur == NULL);
-    Next (bp) = cur;
+    Next (Field (bp, 1)) = cur;
     Next (prev) = bp;
-    /* When inserting a block between [caml_fl_merge] and [caml_gc_sweep_hp],
+    /* When inserting blocks between [caml_fl_merge] and [caml_gc_sweep_hp],
        we must advance [caml_fl_merge] to the new block, so that [caml_fl_merge]
        is always the last free-list block before [caml_gc_sweep_hp]. */
-    if (prev == caml_fl_merge && bp <= caml_gc_sweep_hp) caml_fl_merge = bp;
+    if (prev == caml_fl_merge && bp < caml_gc_sweep_hp){
+      caml_fl_merge = (char *) Field (bp, 1);
+    }
+    truncate_flp (bp);
   }
 }
 
diff --git a/byterun/freelist.h b/byterun/freelist.h
index ea03ad986..823748548 100644
--- a/byterun/freelist.h
+++ b/byterun/freelist.h
@@ -28,7 +28,7 @@ char *caml_fl_allocate (mlsize_t);
 void caml_fl_init_merge (void);
 void caml_fl_reset (void);
 char *caml_fl_merge_block (char *);
-void caml_fl_add_block (char *);
+void caml_fl_add_blocks (char *);
 void caml_make_free_blocks (value *, mlsize_t, int);
 
 
diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c
index 5f028c0eb..6a69cc134 100644
--- a/byterun/gc_ctrl.c
+++ b/byterun/gc_ctrl.c
@@ -457,10 +457,6 @@ void caml_init_gc (uintnat minor_size, uintnat major_size,
 {
   uintnat major_heap_size = Bsize_wsize (norm_heapincr (major_size));
 
-#ifdef DEBUG
-  caml_gc_message (-1, "### O'Caml runtime: debug mode ###\n", 0);
-#endif
-
   caml_page_table_initialize(Bsize_wsize(minor_size) + major_heap_size);
   caml_set_minor_heap_size (Bsize_wsize (norm_minsize (minor_size)));
   caml_major_heap_increment = Bsize_wsize (norm_heapincr (major_incr));
diff --git a/byterun/main.c b/byterun/main.c
index 3454ffcd0..e6afb1b32 100644
--- a/byterun/main.c
+++ b/byterun/main.c
@@ -28,6 +28,27 @@ CAMLextern void caml_expand_command_line (int *, char ***);
 
 int main(int argc, char **argv)
 {
+#ifdef DEBUG
+  {
+    char *ocp;
+    char *cp;
+    int i;
+
+    caml_gc_message (-1, "### OCaml runtime: debug mode ###\n", 0);
+#if 0
+    caml_gc_message (-1, "### command line:", 0);
+    for (i = 0; i < argc; i++){
+      caml_gc_message (-1, " %s", argv[i]);
+    }
+    caml_gc_message (-1, "\n", 0);
+    ocp = getenv ("OCAMLRUNPARAM");
+    caml_gc_message (-1, "### OCAMLRUNPARAM=%s\n", ocp == NULL ? "" : ocp);
+    cp = getenv ("CAMLRUNPARAM");
+    caml_gc_message (-1, "### CAMLRUNPARAM=%s\n", cp == NULL ? "" : cp);
+    caml_gc_message (-1, "### working dir: %s\n", getcwd (NULL, 0));
+#endif
+  }
+#endif
 #ifdef _WIN32
   /* Expand wildcards and diversions in command line */
   caml_expand_command_line(&argc, &argv);
diff --git a/byterun/memory.c b/byterun/memory.c
index 934610c9c..0141517bf 100644
--- a/byterun/memory.c
+++ b/byterun/memory.c
@@ -27,6 +27,8 @@
 #include "mlvalues.h"
 #include "signals.h"
 
+extern uintnat caml_percent_free;                   /* major_gc.c */
+
 /* Page table management */
 
 #define Page(p) ((uintnat) (p) >> Page_log)
@@ -104,7 +106,7 @@ static int caml_page_table_resize(void)
   uintnat * new_entries;
   uintnat i, h;
 
-  caml_gc_message (0x08, "Growing page table to %lu entries\n", 
+  caml_gc_message (0x08, "Growing page table to %lu entries\n",
                    caml_page_table.size);
 
   new_entries = calloc(2 * old.size, sizeof(uintnat));
@@ -215,7 +217,7 @@ void caml_free_for_heap (char *mem)
    The contents of the chunk must be a sequence of valid blocks and
    fragments: no space between blocks and no trailing garbage.  If
    some blocks are blue, they must be added to the free list by the
-   caller.  All other blocks must have the color [caml_allocation_color(mem)].
+   caller.  All other blocks must have the color [caml_allocation_color(m)].
    The caller must update [caml_allocated_words] if applicable.
    Return value: 0 if no error; -1 in case of error.
 */
@@ -256,25 +258,52 @@ int caml_add_to_heap (char *m)
 }
 
 /* Allocate more memory from malloc for the heap.
-   Return a blue block of at least the requested size (in words).
-   The caller must insert the block into the free list.
+   Return a blue block of at least the requested size.
+   The blue block is chained to a sequence of blue blocks (through their
+   field 0); the last block of the chain is pointed by field 1 of the
+   first.  There may be a fragment after the last block.
+   The caller must insert the blocks into the free list.
    The request must be less than or equal to Max_wosize.
    Return NULL when out of memory.
 */
 static char *expand_heap (mlsize_t request)
 {
-  char *mem;
-  asize_t malloc_request;
+  char *mem, *hp, *prev;
+  asize_t over_request, malloc_request, remain;
 
-  malloc_request = caml_round_heap_chunk_size (Bhsize_wosize (request));
+  Assert (request <= Max_wosize);
+  over_request = request + request / 100 * caml_percent_free;
+  malloc_request = caml_round_heap_chunk_size (Bhsize_wosize (over_request));
   mem = caml_alloc_for_heap (malloc_request);
   if (mem == NULL){
     caml_gc_message (0x04, "No room for growing heap\n", 0);
     return NULL;
   }
-  Assert (Wosize_bhsize (malloc_request) >= request);
-  Hd_hp (mem) = Make_header (Wosize_bhsize (malloc_request), 0, Caml_blue);
-
+  remain = malloc_request;
+  prev = hp = mem;
+  /* XXX find a way to do this with a call to caml_make_free_blocks */
+  while (Wosize_bhsize (remain) > Max_wosize){
+    Hd_hp (hp) = Make_header (Max_wosize, 0, Caml_blue);
+#ifdef DEBUG
+    caml_set_fields (Bp_hp (hp), 0, Debug_free_major);
+#endif
+    hp += Bhsize_wosize (Max_wosize);
+    remain -= Bhsize_wosize (Max_wosize);
+    Field (Op_hp (mem), 1) = Field (Op_hp (prev), 0) = (value) Op_hp (hp);
+    prev = hp;
+  }
+  if (remain > 1){
+    Hd_hp (hp) = Make_header (Wosize_bhsize (remain), 0, Caml_blue);
+#ifdef DEBUG
+    caml_set_fields (Bp_hp (hp), 0, Debug_free_major);
+#endif
+    Field (Op_hp (mem), 1) = Field (Op_hp (prev), 0) = (value) Op_hp (hp);
+    Field (Op_hp (hp), 0) = (value) NULL;
+  }else{
+    Field (Op_hp (prev), 0) = (value) NULL;
+    if (remain == 1) Hd_hp (hp) = Make_header (0, 0, Caml_white);
+  }
+  Assert (Wosize_hp (mem) >= request);
   if (caml_add_to_heap (mem) != 0){
     caml_free_for_heap (mem);
     return NULL;
@@ -299,7 +328,7 @@ void caml_shrink_heap (char *chunk)
 
   caml_stat_heap_size -= Chunk_size (chunk);
   caml_gc_message (0x04, "Shrinking heap to %luk bytes\n",
-                   caml_stat_heap_size / 1024);
+                   (unsigned long) caml_stat_heap_size / 1024);
 
 #ifdef DEBUG
   {
@@ -351,7 +380,7 @@ CAMLexport value caml_alloc_shr (mlsize_t wosize, tag_t tag)
       else
         caml_raise_out_of_memory ();
     }
-    caml_fl_add_block (new_block);
+    caml_fl_add_blocks (new_block);
     hp = caml_fl_allocate (wosize);
   }
 
diff --git a/byterun/misc.c b/byterun/misc.c
index 2a660219c..e8597ee38 100644
--- a/byterun/misc.c
+++ b/byterun/misc.c
@@ -29,6 +29,14 @@ int caml_failed_assert (char * expr, char * file, int line)
   return 1; /* not reached */
 }
 
+void caml_set_fields (char *bp, unsigned long start, unsigned long filler)
+{
+  mlsize_t i;
+  for (i = start; i < Wosize_bp (bp); i++){
+    Field (Val_bp (bp), i) = (value) filler;
+  }
+}
+
 #endif /* DEBUG */
 
 uintnat caml_verb_gc = 0;
@@ -54,7 +62,7 @@ CAMLexport void caml_fatal_error_arg (char *fmt, char *arg)
 }
 
 CAMLexport void caml_fatal_error_arg2 (char *fmt1, char *arg1,
-				       char *fmt2, char *arg2)
+                                       char *fmt2, char *arg2)
 {
   fprintf (stderr, fmt1, arg1);
   fprintf (stderr, fmt2, arg2);
diff --git a/byterun/misc.h b/byterun/misc.h
index afc0aef95..d0aaffd1a 100644
--- a/byterun/misc.h
+++ b/byterun/misc.h
@@ -66,8 +66,8 @@ CAMLextern int caml_failed_assert (char *, char *, int);
 
 CAMLextern void caml_fatal_error (char *msg) Noreturn;
 CAMLextern void caml_fatal_error_arg (char *fmt, char *arg) Noreturn;
-CAMLextern void caml_fatal_error_arg2 (char *fmt1, char *arg1, 
-				       char *fmt2, char *arg2) Noreturn;
+CAMLextern void caml_fatal_error_arg2 (char *fmt1, char *arg1,
+                                       char *fmt2, char *arg2) Noreturn;
 
 /* Data structures */
 
@@ -122,6 +122,8 @@ char *caml_aligned_malloc (asize_t, int, void **);
 #define Debug_filler_align   Debug_tag (0x85)
 
 #define Debug_uninit_stat    0xD7
+
+extern void caml_set_fields (char *, unsigned long, unsigned long);
 #endif /* DEBUG */
 
 
diff --git a/stdlib/gc.mli b/stdlib/gc.mli
index 4d36a29f2..00fd23601 100644
--- a/stdlib/gc.mli
+++ b/stdlib/gc.mli
@@ -86,7 +86,7 @@ type control =
 
     mutable major_heap_increment : int;
     (** The minimum number of words to add to the
-       major heap when increasing it.  Default: 62k. *)
+       major heap when increasing it.  Default: 124k. *)
 
     mutable space_overhead : int;
     (** The major GC speed is computed from this parameter.