Add :application-type parameter for save-lisp-and-die on Windows.

[sbcl.git] / src / runtime / gencgc.c

diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index 27cca07..5d218b1 100644 (file)
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -125,8 +125,10 @@ boolean verify_after_free_heap = 0;
  * during a heap verify? */
 boolean verify_dynamic_code_check = 0;
 
+#ifdef LISP_FEATURE_X86
 /* Should we check code objects for fixup errors after they are transported? */
 boolean check_code_fixups = 0;
+#endif
 
 /* Should we check that newly allocated regions are zero filled? */
 boolean gencgc_zero_check = 0;
@@ -1650,10 +1652,10 @@ static lispobj trans_boxed(lispobj object);
  *
  * Currently only absolute fixups to the constant vector, or to the
  * code area are checked. */
+#ifdef LISP_FEATURE_X86
 void
 sniff_code_object(struct code *code, os_vm_size_t displacement)
 {
-#ifdef LISP_FEATURE_X86
     sword_t nheader_words, ncode_words, nwords;
     os_vm_address_t constants_start_addr = NULL, constants_end_addr, p;
     os_vm_address_t code_start_addr, code_end_addr;
@@ -1822,14 +1824,13 @@ sniff_code_object(struct code *code, os_vm_size_t displacement)
                "/code start = %x, end = %x\n",
                code_start_addr, code_end_addr));
     }
-#endif
 }
+#endif
 
+#ifdef LISP_FEATURE_X86
 void
 gencgc_apply_code_fixups(struct code *old_code, struct code *new_code)
 {
-/* x86-64 uses pc-relative addressing instead of this kludge */
-#ifndef LISP_FEATURE_X86_64
     sword_t nheader_words, ncode_words, nwords;
     os_vm_address_t constants_start_addr, constants_end_addr;
     os_vm_address_t code_start_addr, code_end_addr;
@@ -1925,9 +1926,8 @@ gencgc_apply_code_fixups(struct code *old_code, struct code *new_code)
     if (check_code_fixups) {
         sniff_code_object(new_code,displacement);
     }
-#endif
 }
-
+#endif
 
 static lispobj
 trans_boxed_large(lispobj object)
@@ -2310,21 +2310,22 @@ preserve_pointer(void *addr)
     /* Adjust any large objects before promotion as they won't be
      * copied after promotion. */
     if (page_table[first_page].large_object) {
-        maybe_adjust_large_object(page_address(first_page));
-        /* If a large object has shrunk then addr may now point to a
-         * free area in which case it's ignored here. Note it gets
-         * through the valid pointer test above because the tail looks
-         * like conses. */
-        if (page_free_p(addr_page_index)
-            || (page_table[addr_page_index].bytes_used == 0)
-            /* Check the offset within the page. */
-            || (((uword_t)addr & (GENCGC_CARD_BYTES - 1))
-                > page_table[addr_page_index].bytes_used)) {
-            FSHOW((stderr,
-                   "weird? ignore ptr 0x%x to freed area of large object\n",
-                   addr));
+        /* Large objects (specifically vectors and bignums) can
+         * shrink, leaving a "tail" of zeroed space, which appears to
+         * the filter above as a seris of valid conses, both car and
+         * cdr of which contain the fixnum zero, but will be
+         * deallocated when the GC shrinks the large object region to
+         * fit the object within.  We allow raw pointers within code
+         * space, but for boxed and unboxed space we do not, nor do
+         * pointers to within a non-code object appear valid above.  A
+         * cons cell will never merit allocation to a large object
+         * page, so pick them off now, before we try to adjust the
+         * object. */
+        if ((lowtag_of((lispobj)addr) == LIST_POINTER_LOWTAG) &&
+            !code_page_p(first_page)) {
             return;
         }
+        maybe_adjust_large_object(page_address(first_page));
         /* It may have moved to unboxed pages. */
         region_allocation = page_table[first_page].allocated;
     }
@@ -3084,6 +3085,9 @@ verify_space(lispobj *start, size_t words)
 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
                 case COMPLEX_LONG_FLOAT_WIDETAG:
 #endif
+#ifdef SIMD_PACK_WIDETAG
+                case SIMD_PACK_WIDETAG:
+#endif
                 case SIMPLE_BASE_STRING_WIDETAG:
 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
                 case SIMPLE_CHARACTER_STRING_WIDETAG:
@@ -3191,7 +3195,6 @@ verify_generation(generation_index_t generation)
             && (page_table[i].bytes_used != 0)
             && (page_table[i].gen == generation)) {
             page_index_t last_page;
-            int region_allocation = page_table[i].allocated;
 
             /* This should be the start of a contiguous block */
             gc_assert(page_starts_contiguous_block_p(i));
@@ -4528,8 +4531,8 @@ prepare_for_final_gc ()
  * SB!VM:RESTART-LISP-FUNCTION */
 void
 gc_and_save(char *filename, boolean prepend_runtime,
-            boolean save_runtime_options,
-            boolean compressed, int compression_level)
+            boolean save_runtime_options, boolean compressed,
+            int compression_level, int application_type)
 {
     FILE *file;
     void *runtime_bytes = NULL;
@@ -4559,7 +4562,8 @@ gc_and_save(char *filename, boolean prepend_runtime,
     collect_garbage(HIGHEST_NORMAL_GENERATION+1);
 
     if (prepend_runtime)
-        save_runtime_to_filehandle(file, runtime_bytes, runtime_size);
+        save_runtime_to_filehandle(file, runtime_bytes, runtime_size,
+                                   application_type);
 
     /* The dumper doesn't know that pages need to be zeroed before use. */
     zero_all_free_pages();