Anonymous avatar Anonymous committed 7f46203

PR#5757: GC compaction bug (crash)

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

Comments (0)

Files changed (8)

 - PR#5712: some documentation problems
 - PR#5719: ocamlyacc generates code that is not warning 33-compliant
 - PR#5742: missing bound checks in Array.sub
+- PR#5757: GC compaction bug (crash)
 
 
 OCaml 4.00.0:
-4.01.0+dev7_2012-08-06
+4.01.0+dev8_2012-09-10
 
 # The version string is the first line of this file.
 # It must be in the format described in stdlib/sys.mli

byterun/compact.c

         word q = *p;
         if (Color_hd (q) == Caml_white){
           size_t sz = Bhsize_hd (q);
-          char *newadr = compact_allocate (sz);  Assert (newadr <= (char *)p);
+          char *newadr = compact_allocate (sz);
           memmove (newadr, p, sz);
           p += Wsize_bsize (sz);
         }else{
     while (ch != NULL){
       if (Chunk_size (ch) > Chunk_alloc (ch)){
         caml_make_free_blocks ((value *) (ch + Chunk_alloc (ch)),
-                               Wsize_bsize (Chunk_size(ch)-Chunk_alloc(ch)), 1);
+                               Wsize_bsize (Chunk_size(ch)-Chunk_alloc(ch)), 1,
+                               Caml_white);
       }
       ch = Chunk_next (ch);
     }
 
 void caml_compact_heap (void)
 {
-  uintnat target_size, live;
+  uintnat target_words, target_size, live;
 
   do_compaction ();
   /* Compaction may fail to shrink the heap to a reasonable size
      See PR#5389
   */
   /* We compute:
-     freewords = caml_fl_cur_size          (exact)
-     heapsize = caml_heap_size             (exact)
-     live = heap_size - freewords
-     target_size = live * (1 + caml_percent_free / 100)
-                 = live / 100 * (100 + caml_percent_free)
-     We add 1 to live/100 to make sure it isn't 0.
+     freewords = caml_fl_cur_size                  (exact)
+     heapwords = Wsize_bsize (caml_heap_size)      (exact)
+     live = heapwords - freewords
+     wanted = caml_percent_free * (live / 100 + 1) (same as in do_compaction)
+     target_words = live + wanted
+     We add one page to make sure a small difference in counting sizes
+     won't make [do_compaction] keep the second block (and break all sorts
+     of invariants).
 
      We recompact if target_size < heap_size / 2
   */
-  live = caml_stat_heap_size - Bsize_wsize (caml_fl_cur_size);
-  target_size = (live / 100 + 1) * (100 + caml_percent_free);
-  target_size = caml_round_heap_chunk_size (target_size);
+  live = Wsize_bsize (caml_stat_heap_size) - caml_fl_cur_size;
+  target_words = live + caml_percent_free * (live / 100 + 1)
+                 + Wsize_bsize (Page_size);
+  target_size = caml_round_heap_chunk_size (Bsize_wsize (target_words));
   if (target_size < caml_stat_heap_size / 2){
     char *chunk;
 
-    /* round it up to a page size */
+    caml_gc_message (0x10, "Recompacting heap (target=%luk)\n",
+                     target_size / 1024);
+
     chunk = caml_alloc_for_heap (target_size);
     if (chunk == NULL) return;
+    /* PR#5757: we need to make the new blocks blue, or they won't be
+       recognized as free by the recompaction. */
     caml_make_free_blocks ((value *) chunk,
-                           Wsize_bsize (Chunk_size (chunk)), 0);
+                           Wsize_bsize (Chunk_size (chunk)), 0, Caml_blue);
     if (caml_page_table_add (In_heap, chunk, chunk + Chunk_size (chunk)) != 0){
       caml_free_for_heap (chunk);
       return;
     do_compaction ();
     Assert (caml_stat_heap_chunks == 1);
     Assert (Chunk_next (caml_heap_start) == NULL);
+    Assert (caml_stat_heap_size == Chunk_size (chunk));
   }
 }
 

byterun/freelist.c

    p: pointer to the first word of the block
    size: size of the block (in words)
    do_merge: 1 -> do merge; 0 -> do not merge
+   color: which color to give to the pieces; if [do_merge] is 1, this
+          is overridden by the merge code, but we have historically used
+          [Caml_white].
 */
-void caml_make_free_blocks (value *p, mlsize_t size, int do_merge)
+void caml_make_free_blocks (value *p, mlsize_t size, int do_merge, int color)
 {
   mlsize_t sz;
 
     }else{
       sz = size;
     }
-    *(header_t *)p = Make_header (Wosize_whsize (sz), 0, Caml_white);
+    *(header_t *)p = Make_header (Wosize_whsize (sz), 0, color);
     if (do_merge) caml_fl_merge_block (Bp_hp (p));
     size -= sz;
     p += sz;

byterun/freelist.h

 void caml_fl_reset (void);
 char *caml_fl_merge_block (char *);
 void caml_fl_add_blocks (char *);
-void caml_make_free_blocks (value *, mlsize_t, int);
+void caml_make_free_blocks (value *, mlsize_t, int, int);
 void caml_set_allocation_policy (uintnat);
 
 
     Assert(intern_dest <= end_extra_block);
     if (intern_dest < end_extra_block){
       caml_make_free_blocks ((value *) intern_dest,
-                             end_extra_block - intern_dest, 0);
+                             end_extra_block - intern_dest, 0, Caml_white);
     }
     caml_allocated_words +=
       Wsize_bsize ((char *) intern_dest - intern_extra_block);

byterun/major_gc.c

 
   caml_fl_init_merge ();
   caml_make_free_blocks ((value *) caml_heap_start,
-                         Wsize_bsize (caml_stat_heap_size), 1);
+                         Wsize_bsize (caml_stat_heap_size), 1, Caml_white);
   caml_gc_phase = Phase_idle;
   gray_vals_size = 2048;
   gray_vals = (value *) malloc (gray_vals_size * sizeof (value));
   }
   remain = malloc_request;
   prev = hp = mem;
-  /* XXX find a way to do this with a call to caml_make_free_blocks */
+  /* FIXME 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
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.