1.0.38.2: Gencgc error-checking fixes.
[sbcl.git] / src / runtime / gencgc.c
index 2a6d7ea..8c61a09 100644 (file)
@@ -69,9 +69,7 @@ page_index_t  gc_find_freeish_pages(long *restart_page_ptr, long nbytes,
  * scratch space by the collector, and should never get collected.
  */
 enum {
-    HIGHEST_NORMAL_GENERATION = 5,
-    PSEUDO_STATIC_GENERATION,
-    SCRATCH_GENERATION,
+    SCRATCH_GENERATION = PSEUDO_STATIC_GENERATION+1,
     NUM_GENERATIONS
 };
 
@@ -257,7 +255,12 @@ size_t void_diff(void *x, void *y)
     return (pointer_sized_uint_t)x - (pointer_sized_uint_t)y;
 }
 
-/* a structure to hold the state of a generation */
+/* a structure to hold the state of a generation
+ *
+ * CAUTION: If you modify this, make sure to touch up the alien
+ * definition in src/code/gc.lisp accordingly. ...or better yes,
+ * deal with the FIXME there...
+ */
 struct generation {
 
     /* the first page that gc_alloc() checks on its next call */
@@ -287,9 +290,9 @@ struct generation {
     /* the number of GCs since the last raise */
     int num_gc;
 
-    /* the average age after which a GC will raise objects to the
+    /* the number of GCs to run on the generations before raising objects to the
      * next generation */
-    int trigger_age;
+    int number_of_gcs_before_promotion;
 
     /* the cumulative sum of the bytes allocated to this generation. It is
      * cleared after a GC on this generations, and update before new
@@ -301,7 +304,7 @@ struct generation {
     /* a minimum average memory age before a GC will occur helps
      * prevent a GC when a large number of new live objects have been
      * added, in which case a GC could be a waste of time */
-    double min_av_mem_age;
+    double minimum_age_before_gc;
 
     /* A linked list of lutex structures in this generation, used for
      * implementing lutex finalization. */
@@ -416,8 +419,8 @@ count_generation_bytes_allocated (generation_index_t gen)
 }
 
 /* Return the average age of the memory in a generation. */
-static double
-gen_av_mem_age(generation_index_t gen)
+extern double
+generation_average_age(generation_index_t gen)
 {
     if (generations[gen].bytes_allocated == 0)
         return 0.0;
@@ -429,10 +432,10 @@ gen_av_mem_age(generation_index_t gen)
 
 /* The verbose argument controls how much to print: 0 for normal
  * level of detail; 1 for debugging. */
-static void
-print_generation_stats(int verbose) /* FIXME: should take FILE argument */
+extern void
+print_generation_stats() /* FIXME: should take FILE argument, or construct a string */
 {
-    generation_index_t i, gens;
+    generation_index_t i;
 
 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
 #define FPU_STATE_SIZE 27
@@ -446,17 +449,11 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */
      * so they need to be saved and reset for C. */
     fpu_save(fpu_state);
 
-    /* highest generation to print */
-    if (verbose)
-        gens = SCRATCH_GENERATION;
-    else
-        gens = PSEUDO_STATIC_GENERATION;
-
     /* Print the heap stats. */
     fprintf(stderr,
             " Gen StaPg UbSta LaSta LUbSt Boxed Unboxed LB   LUB  !move  Alloc  Waste   Trig    WP  GCs Mem-age\n");
 
-    for (i = 0; i < gens; i++) {
+    for (i = 0; i < SCRATCH_GENERATION; i++) {
         page_index_t j;
         long boxed_cnt = 0;
         long unboxed_cnt = 0;
@@ -506,7 +503,7 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */
                 generations[i].gc_trigger,
                 count_write_protect_generation_pages(i),
                 generations[i].num_gc,
-                gen_av_mem_age(i));
+                generation_average_age(i));
     }
     fprintf(stderr,"   Total bytes allocated    = %lu\n", bytes_allocated);
     fprintf(stderr,"   Dynamic-space-size bytes = %u\n", dynamic_space_size);
@@ -1164,21 +1161,21 @@ gc_heap_exhausted_error_or_lose (long available, long requested)
     fprintf(stderr, "Heap exhausted during %s: %ld bytes available, %ld requested.\n",
             gc_active_p ? "garbage collection" : "allocation",
             available, requested);
-    if (gc_active_p || (available == 0)) {
-        /* If we are in GC, or totally out of memory there is no way
-         * to sanely transfer control to the lisp-side of things.
-         */
-        print_generation_stats(1);
+    print_generation_stats();
         fprintf(stderr, "GC control variables:\n");
-        fprintf(stderr, "          *GC-INHIBIT* = %s\n          *GC-PENDING* = %s\n",
+        fprintf(stderr, "   *GC-INHIBIT* = %s\n   *GC-PENDING* = %s\n",
                 SymbolValue(GC_INHIBIT,thread)==NIL ? "false" : "true",
                 (SymbolValue(GC_PENDING, thread) == T) ?
                 "true" : ((SymbolValue(GC_PENDING, thread) == NIL) ?
                   "false" : "in progress"));
 #ifdef LISP_FEATURE_SB_THREAD
-        fprintf(stderr, " *STOP-FOR-GC-PENDING* = %s\n",
+        fprintf(stderr, "   *STOP-FOR-GC-PENDING* = %s\n",
                 SymbolValue(STOP_FOR_GC_PENDING,thread)==NIL ? "false" : "true");
 #endif
+    if (gc_active_p || (available == 0)) {
+        /* If we are in GC, or totally out of memory there is no way
+         * to sanely transfer control to the lisp-side of things.
+         */
         lose("Heap exhausted, game over.");
     }
     else {
@@ -1415,15 +1412,11 @@ copy_large_object(lispobj object, long nwords)
             gc_assert(page_table[next_page].region_start_offset ==
                       npage_bytes(next_page-first_page));
             gc_assert(page_table[next_page].bytes_used == PAGE_BYTES);
+            /* Should have been unprotected by unprotect_oldspace(). */
+            gc_assert(page_table[next_page].write_protected == 0);
 
             page_table[next_page].gen = new_space;
 
-            /* Remove any write-protection. We should be able to rely
-             * on the write-protect flag to avoid redundant calls. */
-            if (page_table[next_page].write_protected) {
-                os_protect(page_address(next_page), PAGE_BYTES, OS_VM_PROT_ALL);
-                page_table[next_page].write_protected = 0;
-            }
             remaining_bytes -= PAGE_BYTES;
             next_page++;
         }
@@ -3248,23 +3241,41 @@ static void
 unprotect_oldspace(void)
 {
     page_index_t i;
+    void *region_addr = 0;
+    void *page_addr = 0;
+    unsigned long region_bytes = 0;
 
     for (i = 0; i < last_free_page; i++) {
         if (page_allocated_p(i)
             && (page_table[i].bytes_used != 0)
             && (page_table[i].gen == from_space)) {
-            void *page_start;
-
-            page_start = (void *)page_address(i);
 
             /* Remove any write-protection. We should be able to rely
              * on the write-protect flag to avoid redundant calls. */
             if (page_table[i].write_protected) {
-                os_protect(page_start, PAGE_BYTES, OS_VM_PROT_ALL);
                 page_table[i].write_protected = 0;
+                page_addr = page_address(i);
+                if (!region_addr) {
+                    /* First region. */
+                    region_addr = page_addr;
+                    region_bytes = PAGE_BYTES;
+                } else if (region_addr + region_bytes == page_addr) {
+                    /* Region continue. */
+                    region_bytes += PAGE_BYTES;
+                } else {
+                    /* Unprotect previous region. */
+                    os_protect(region_addr, region_bytes, OS_VM_PROT_ALL);
+                    /* First page in new region. */
+                    region_addr = page_addr;
+                    region_bytes = PAGE_BYTES;
+                }
             }
         }
     }
+    if (region_addr) {
+        /* Unprotect last region. */
+        os_protect(region_addr, region_bytes, OS_VM_PROT_ALL);
+    }
 }
 
 /* Work through all the pages and free any in from_space. This
@@ -3300,17 +3311,8 @@ free_oldspace(void)
                 page_table[last_page].bytes_used;
             page_table[last_page].allocated = FREE_PAGE_FLAG;
             page_table[last_page].bytes_used = 0;
-
-            /* Remove any write-protection. We should be able to rely
-             * on the write-protect flag to avoid redundant calls. */
-            {
-                void  *page_start = (void *)page_address(last_page);
-
-                if (page_table[last_page].write_protected) {
-                    os_protect(page_start, PAGE_BYTES, OS_VM_PROT_ALL);
-                    page_table[last_page].write_protected = 0;
-                }
-            }
+            /* Should already be unprotected by unprotect_oldspace(). */
+            gc_assert(!page_table[last_page].write_protected);
             last_page++;
         }
         while ((last_page < last_free_page)
@@ -3360,6 +3362,23 @@ print_ptr(lispobj *addr)
 }
 #endif
 
+static int
+is_in_stack_space(lispobj ptr)
+{
+    /* For space verification: Pointers can be valid if they point
+     * to a thread stack space.  This would be faster if the thread
+     * structures had page-table entries as if they were part of
+     * the heap space. */
+    struct thread *th;
+    for_each_thread(th) {
+        if ((th->control_stack_start <= (lispobj *)ptr) &&
+            (th->control_stack_end >= (lispobj *)ptr)) {
+            return 1;
+        }
+    }
+    return 0;
+}
+
 static void
 verify_space(lispobj *start, size_t words)
 {
@@ -3387,15 +3406,15 @@ verify_space(lispobj *start, size_t words)
                  * page. XX Could check the offset too. */
                 if (page_allocated_p(page_index)
                     && (page_table[page_index].bytes_used == 0))
-                    lose ("Ptr %x @ %x sees free page.\n", thing, start);
+                    lose ("Ptr %p @ %p sees free page.\n", thing, start);
                 /* Check that it doesn't point to a forwarding pointer! */
                 if (*((lispobj *)native_pointer(thing)) == 0x01) {
-                    lose("Ptr %x @ %x sees forwarding ptr.\n", thing, start);
+                    lose("Ptr %p @ %p sees forwarding ptr.\n", thing, start);
                 }
                 /* Check that its not in the RO space as it would then be a
                  * pointer from the RO to the dynamic space. */
                 if (is_in_readonly_space) {
-                    lose("ptr to dynamic space %x from RO space %x\n",
+                    lose("ptr to dynamic space %p from RO space %x\n",
                          thing, start);
                 }
                 /* Does it point to a plausible object? This check slows
@@ -3409,13 +3428,16 @@ verify_space(lispobj *start, size_t words)
                  * dynamically. */
                 /*
                 if (!possibly_valid_dynamic_space_pointer((lispobj *)thing)) {
-                    lose("ptr %x to invalid object %x\n", thing, start);
+                    lose("ptr %p to invalid object %p\n", thing, start);
                 }
                 */
             } else {
+                extern void funcallable_instance_tramp;
                 /* Verify that it points to another valid space. */
-                if (!to_readonly_space && !to_static_space) {
-                    lose("Ptr %x @ %x sees junk.\n", thing, start);
+                if (!to_readonly_space && !to_static_space
+                    && (thing != (lispobj)&funcallable_instance_tramp)
+                    && !is_in_stack_space(thing)) {
+                    lose("Ptr %p @ %p sees junk.\n", thing, start);
                 }
             }
         } else {
@@ -3492,7 +3514,7 @@ verify_space(lispobj *start, size_t words)
                             /* Only when enabled */
                             && verify_dynamic_code_check) {
                             FSHOW((stderr,
-                                   "/code object at %x in the dynamic space\n",
+                                   "/code object at %p in the dynamic space\n",
                                    start));
                         }
 
@@ -3608,7 +3630,7 @@ verify_space(lispobj *start, size_t words)
                     break;
 
                 default:
-                    lose("Unhandled widetag 0x%x at 0x%x\n",
+                    lose("Unhandled widetag %p at %p\n",
                          widetag_of(*start), start);
                 }
             }
@@ -4352,7 +4374,7 @@ collect_garbage(generation_index_t last_gen)
     }
 
     if (gencgc_verbose > 1)
-        print_generation_stats(0);
+        print_generation_stats();
 
     do {
         /* Collect the generation. */
@@ -4363,7 +4385,7 @@ collect_garbage(generation_index_t last_gen)
         } else {
             raise =
                 (gen < last_gen)
-                || (generations[gen].num_gc >= generations[gen].trigger_age);
+                || (generations[gen].num_gc >= generations[gen].number_of_gcs_before_promotion);
         }
 
         if (gencgc_verbose > 1) {
@@ -4390,7 +4412,7 @@ collect_garbage(generation_index_t last_gen)
 
         if (gencgc_verbose > 1) {
             FSHOW((stderr, "GC of generation %d finished:\n", gen));
-            print_generation_stats(0);
+            print_generation_stats();
         }
 
         gen++;
@@ -4400,8 +4422,8 @@ collect_garbage(generation_index_t last_gen)
                      && raise
                      && (generations[gen].bytes_allocated
                          > generations[gen].gc_trigger)
-                     && (gen_av_mem_age(gen)
-                         > generations[gen].min_av_mem_age))));
+                     && (generation_average_age(gen)
+                         > generations[gen].minimum_age_before_gc))));
 
     /* Now if gen-1 was raised all generations before gen are empty.
      * If it wasn't raised then all generations before gen-1 are empty.
@@ -4536,7 +4558,7 @@ gc_free_heap(void)
     }
 
     if (gencgc_verbose > 1)
-        print_generation_stats(0);
+        print_generation_stats();
 
     /* Initialize gc_alloc(). */
     gc_alloc_generation = 0;
@@ -4605,8 +4627,8 @@ gc_init(void)
         generations[i].cum_sum_bytes_allocated = 0;
         /* the tune-able parameters */
         generations[i].bytes_consed_between_gc = 2000000;
-        generations[i].trigger_age = 1;
-        generations[i].min_av_mem_age = 0.75;
+        generations[i].number_of_gcs_before_promotion = 1;
+        generations[i].minimum_age_before_gc = 0.75;
         generations[i].lutexes = NULL;
     }
 
@@ -4632,18 +4654,24 @@ gencgc_pickup_dynamic(void)
     generation_index_t gen = PSEUDO_STATIC_GENERATION;
     do {
         lispobj *first,*ptr= (lispobj *)page_address(page);
-        page_table[page].allocated = BOXED_PAGE_FLAG;
-        page_table[page].gen = gen;
-        page_table[page].bytes_used = PAGE_BYTES;
-        page_table[page].large_object = 0;
-        page_table[page].write_protected = 0;
-        page_table[page].write_protected_cleared = 0;
-        page_table[page].dont_move = 0;
-        page_table[page].need_to_zero = 1;
+
+        if (!gencgc_partial_pickup || page_allocated_p(page)) {
+          /* It is possible, though rare, for the saved page table
+           * to contain free pages below alloc_ptr. */
+          page_table[page].gen = gen;
+          page_table[page].bytes_used = PAGE_BYTES;
+          page_table[page].large_object = 0;
+          page_table[page].write_protected = 0;
+          page_table[page].write_protected_cleared = 0;
+          page_table[page].dont_move = 0;
+          page_table[page].need_to_zero = 1;
+        }
 
         if (!gencgc_partial_pickup) {
+            page_table[page].allocated = BOXED_PAGE_FLAG;
             first=gc_search_space(prev,(ptr+2)-prev,ptr);
-            if(ptr == first)  prev=ptr;
+            if(ptr == first)
+                prev=ptr;
             page_table[page].region_start_offset =
                 page_address(page) - (void *)prev;
         }