Skip testl fcntl.flock.2 on NetBSD.
[sbcl.git] / src / runtime / gencgc.c
index 0e787c3..1dbef40 100644 (file)
@@ -81,7 +81,13 @@ enum {
 boolean enable_page_protection = 1;
 
 /* the minimum size (in bytes) for a large object*/
+#if (GENCGC_ALLOC_GRANULARITY >= PAGE_BYTES) && (GENCGC_ALLOC_GRANULARITY >= GENCGC_CARD_BYTES)
 long large_object_size = 4 * GENCGC_ALLOC_GRANULARITY;
+#elif (GENCGC_CARD_BYTES >= PAGE_BYTES) && (GENCGC_CARD_BYTES >= GENCGC_ALLOC_GRANULARITY)
+long large_object_size = 4 * GENCGC_CARD_BYTES;
+#else
+long large_object_size = 4 * PAGE_BYTES;
+#endif
 
 \f
 /*
@@ -358,6 +364,9 @@ static pthread_mutex_t allocation_lock = PTHREAD_MUTEX_INITIALIZER;
 extern unsigned long gencgc_release_granularity;
 unsigned long gencgc_release_granularity = GENCGC_RELEASE_GRANULARITY;
 
+extern unsigned long gencgc_alloc_granularity;
+unsigned long gencgc_alloc_granularity = GENCGC_ALLOC_GRANULARITY;
+
 \f
 /*
  * miscellaneous heap functions
@@ -627,6 +636,15 @@ zero_pages(page_index_t start, page_index_t end) {
 
 }
 
+static void
+zero_and_mark_pages(page_index_t start, page_index_t end) {
+    page_index_t i;
+
+    zero_pages(start, end);
+    for (i = start; i <= end; i++)
+        page_table[i].need_to_zero = 0;
+}
+
 /* Zero the pages from START to END (inclusive), except for those
  * pages that are known to already zeroed. Mark all pages in the
  * ranges as non-zeroed.
@@ -1263,84 +1281,87 @@ gc_find_freeish_pages(page_index_t *restart_page_ptr, long nbytes,
 {
     page_index_t first_page, last_page;
     page_index_t restart_page = *restart_page_ptr;
+    long nbytes_goal = nbytes;
     long bytes_found = 0;
     long most_bytes_found = 0;
+    page_index_t most_bytes_found_from, most_bytes_found_to;
+    int small_object = nbytes < GENCGC_CARD_BYTES;
     /* FIXME: assert(free_pages_lock is held); */
 
+    if (nbytes_goal < gencgc_alloc_granularity)
+            nbytes_goal = gencgc_alloc_granularity;
+
     /* Toggled by gc_and_save for heap compaction, normally -1. */
     if (gencgc_alloc_start_page != -1) {
         restart_page = gencgc_alloc_start_page;
     }
 
     gc_assert(nbytes>=0);
-    if (((unsigned long)nbytes)>=GENCGC_CARD_BYTES) {
-        /* Search for a contiguous free space of at least nbytes,
-         * aligned on a page boundary. The page-alignment is strictly
-         * speaking needed only for objects at least large_object_size
-         * bytes in size. */
-        do {
-            first_page = restart_page;
-            while ((first_page < page_table_pages) &&
-                   page_allocated_p(first_page))
+    /* Search for a page with at least nbytes of space. We prefer
+     * not to split small objects on multiple pages, to reduce the
+     * number of contiguous allocation regions spaning multiple
+     * pages: this helps avoid excessive conservativism.
+     *
+     * For other objects, we guarantee that they start on their own
+     * page boundary.
+     */
+    first_page = restart_page;
+    while (first_page < page_table_pages) {
+        bytes_found = 0;
+        if (page_free_p(first_page)) {
+                gc_assert(0 == page_table[first_page].bytes_used);
+                bytes_found = GENCGC_CARD_BYTES;
+        } else if (small_object &&
+                   (page_table[first_page].allocated == page_type_flag) &&
+                   (page_table[first_page].large_object == 0) &&
+                   (page_table[first_page].gen == gc_alloc_generation) &&
+                   (page_table[first_page].write_protected == 0) &&
+                   (page_table[first_page].dont_move == 0)) {
+            bytes_found = GENCGC_CARD_BYTES - page_table[first_page].bytes_used;
+            if (bytes_found < nbytes) {
+                if (bytes_found > most_bytes_found)
+                    most_bytes_found = bytes_found;
                 first_page++;
-
-            last_page = first_page;
-            bytes_found = GENCGC_CARD_BYTES;
-            while ((bytes_found < nbytes) &&
-                   (last_page < (page_table_pages-1)) &&
-                   page_free_p(last_page+1)) {
-                last_page++;
-                bytes_found += GENCGC_CARD_BYTES;
-                gc_assert(0 == page_table[last_page].bytes_used);
-                gc_assert(0 == page_table[last_page].write_protected);
+                continue;
             }
-            if (bytes_found > most_bytes_found)
-                most_bytes_found = bytes_found;
-            restart_page = last_page + 1;
-        } while ((restart_page < page_table_pages) && (bytes_found < nbytes));
-
-    } else {
-        /* Search for a page with at least nbytes of space. We prefer
-         * not to split small objects on multiple pages, to reduce the
-         * number of contiguous allocation regions spaning multiple
-         * pages: this helps avoid excessive conservativism. */
-        first_page = restart_page;
-        while (first_page < page_table_pages) {
-            if (page_free_p(first_page))
-                {
-                    gc_assert(0 == page_table[first_page].bytes_used);
-                    bytes_found = GENCGC_CARD_BYTES;
-                    break;
-                }
-            else if ((page_table[first_page].allocated == page_type_flag) &&
-                     (page_table[first_page].large_object == 0) &&
-                     (page_table[first_page].gen == gc_alloc_generation) &&
-                     (page_table[first_page].write_protected == 0) &&
-                     (page_table[first_page].dont_move == 0))
-                {
-                    bytes_found = GENCGC_CARD_BYTES
-                        - page_table[first_page].bytes_used;
-                    if (bytes_found > most_bytes_found)
-                        most_bytes_found = bytes_found;
-                    if (bytes_found >= nbytes)
-                        break;
-                }
+        } else {
             first_page++;
+            continue;
         }
-        last_page = first_page;
-        restart_page = first_page + 1;
+
+        gc_assert(page_table[first_page].write_protected == 0);
+        for (last_page = first_page+1;
+             ((last_page < page_table_pages) &&
+              page_free_p(last_page) &&
+              (bytes_found < nbytes_goal));
+             last_page++) {
+            bytes_found += GENCGC_CARD_BYTES;
+            gc_assert(0 == page_table[last_page].bytes_used);
+            gc_assert(0 == page_table[last_page].write_protected);
+        }
+
+        if (bytes_found > most_bytes_found) {
+            most_bytes_found = bytes_found;
+            most_bytes_found_from = first_page;
+            most_bytes_found_to = last_page;
+        }
+        if (bytes_found >= nbytes_goal)
+            break;
+
+        first_page = last_page;
     }
 
+    bytes_found = most_bytes_found;
+    restart_page = first_page + 1;
+
     /* Check for a failure */
     if (bytes_found < nbytes) {
         gc_assert(restart_page >= page_table_pages);
         gc_heap_exhausted_error_or_lose(most_bytes_found, nbytes);
     }
 
-    gc_assert(page_table[first_page].write_protected == 0);
-
-    *restart_page_ptr = first_page;
-    return last_page;
+    *restart_page_ptr = most_bytes_found_from;
+    return most_bytes_found_to-1;
 }
 
 /* Allocate bytes.  All the rest of the special-purpose allocation
@@ -2477,14 +2498,11 @@ looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr)
         case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
         case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
         case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
-#ifdef  SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
-        case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
-#endif
+
+        case SIMPLE_ARRAY_UNSIGNED_FIXNUM_WIDETAG:
+
         case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
         case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
-#ifdef  SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
-        case SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG:
-#endif
 #ifdef  SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
         case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG:
 #endif
@@ -2497,15 +2515,12 @@ looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr)
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
         case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
 #endif
-#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
-        case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
-#endif
+
+        case SIMPLE_ARRAY_FIXNUM_WIDETAG:
+
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
         case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
 #endif
-#ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
-        case SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG:
-#endif
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
         case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG:
 #endif
@@ -2635,14 +2650,11 @@ maybe_adjust_large_object(lispobj *where)
     case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
-#ifdef  SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
-    case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
-#endif
+
+    case SIMPLE_ARRAY_UNSIGNED_FIXNUM_WIDETAG:
+
     case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
-#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
-    case SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG:
-#endif
 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
     case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG:
 #endif
@@ -2655,15 +2667,12 @@ maybe_adjust_large_object(lispobj *where)
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
     case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
 #endif
-#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
-    case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
-#endif
+
+    case SIMPLE_ARRAY_FIXNUM_WIDETAG:
+
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
     case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
 #endif
-#ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
-    case SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG:
-#endif
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
     case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG:
 #endif
@@ -3656,14 +3665,11 @@ verify_space(lispobj *start, size_t words)
                 case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
                 case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
                 case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
-#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
-                case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
-#endif
+
+                case SIMPLE_ARRAY_UNSIGNED_FIXNUM_WIDETAG:
+
                 case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
                 case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
-#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
-                case SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG:
-#endif
 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
                 case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG:
 #endif
@@ -3676,15 +3682,12 @@ verify_space(lispobj *start, size_t words)
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
                 case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
 #endif
-#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
-                case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
-#endif
+
+                case SIMPLE_ARRAY_FIXNUM_WIDETAG:
+
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
                 case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
 #endif
-#ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
-                case SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG:
-#endif
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
                 case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG:
 #endif
@@ -4117,7 +4120,7 @@ garbage_collect_generation(generation_index_t generation, int raise)
             scavenge((lispobj *) th->binding_stack_start,len);
 #ifdef LISP_FEATURE_SB_THREAD
             /* do the tls as well */
-            len=fixnum_value(SymbolValue(FREE_TLS_INDEX,0)) -
+            len=(SymbolValue(FREE_TLS_INDEX,0) >> WORD_SHIFT) -
                 (sizeof (struct thread))/(sizeof (lispobj));
             scavenge((lispobj *) (th+1),len);
 #endif
@@ -4262,22 +4265,16 @@ update_dynamic_space_free_pointer(void)
 }
 
 static void
-remap_page_range (page_index_t from, page_index_t to, int forcibly)
+remap_page_range (page_index_t from, page_index_t to)
 {
     /* There's a mysterious Solaris/x86 problem with using mmap
      * tricks for memory zeroing. See sbcl-devel thread
      * "Re: patch: standalone executable redux".
-     *
-     * Since pages don't have to be zeroed ahead of time, only do
-     * so when called from purify.
      */
 #if defined(LISP_FEATURE_SUNOS)
-    if (forcibly)
-        zero_pages(from, to);
+    zero_and_mark_pages(from, to);
 #else
-    page_index_t aligned_from, aligned_end, end = to+1;
-
-    const page_index_t 
+    const page_index_t
             release_granularity = gencgc_release_granularity/GENCGC_CARD_BYTES,
                    release_mask = release_granularity-1,
                             end = to+1,
@@ -4286,29 +4283,24 @@ remap_page_range (page_index_t from, page_index_t to, int forcibly)
 
     if (aligned_from < aligned_end) {
         zero_pages_with_mmap(aligned_from, aligned_end-1);
-        if (forcibly) {
-            if (aligned_from != from)
-                zero_pages(from, aligned_from-1);
-            if (aligned_end != end)
-                zero_pages(aligned_end, end-1);
-        }
-    } else if (forcibly)
-        zero_pages(from, to);
+        if (aligned_from != from)
+            zero_and_mark_pages(from, aligned_from-1);
+        if (aligned_end != end)
+            zero_and_mark_pages(aligned_end, end-1);
+    } else {
+        zero_and_mark_pages(from, to);
+    }
 #endif
 }
 
 static void
 remap_free_pages (page_index_t from, page_index_t to, int forcibly)
 {
-    page_index_t first_page, last_page,
-                 first_aligned_page, last_aligned_page;
+    page_index_t first_page, last_page;
 
     if (forcibly)
-        return remap_page_range(from, to, 1);
+        return remap_page_range(from, to);
 
-    /* See comment above about mysterious failures on Solaris/x86.
-     */
-#if !defined(LISP_FEATURE_SUNOS)
     for (first_page = from; first_page <= to; first_page++) {
         if (page_allocated_p(first_page) ||
             (page_table[first_page].need_to_zero == 0))
@@ -4320,11 +4312,10 @@ remap_free_pages (page_index_t from, page_index_t to, int forcibly)
                (page_table[last_page].need_to_zero == 1))
             last_page++;
 
-        remap_page_range(first_page, last_page-1, 0);
+        remap_page_range(first_page, last_page-1);
 
         first_page = last_page;
     }
-#endif
 }
 
 generation_index_t small_generation_limit = 1;
@@ -4973,7 +4964,8 @@ prepare_for_final_gc ()
  * SB!VM:RESTART-LISP-FUNCTION */
 void
 gc_and_save(char *filename, boolean prepend_runtime,
-            boolean save_runtime_options)
+            boolean save_runtime_options,
+            boolean compressed, int compression_level)
 {
     FILE *file;
     void *runtime_bytes = NULL;
@@ -5008,7 +5000,8 @@ gc_and_save(char *filename, boolean prepend_runtime,
     /* The dumper doesn't know that pages need to be zeroed before use. */
     zero_all_free_pages();
     save_to_filehandle(file, filename, SymbolValue(RESTART_LISP_FUNCTION,0),
-                       prepend_runtime, save_runtime_options);
+                       prepend_runtime, save_runtime_options,
+                       compressed ? compression_level : COMPRESSION_LEVEL_NONE);
     /* Oops. Save still managed to fail. Since we've mangled the stack
      * beyond hope, there's not much we can do.
      * (beyond FUNCALLing RESTART_LISP_FUNCTION, but I suspect that's