0.8.16.9:
[sbcl.git] / src / runtime / gencgc.c
index 092a201..8fbff43 100644 (file)
@@ -28,8 +28,8 @@
 #include <signal.h>
 #include <errno.h>
 #include <string.h>
-#include "runtime.h"
 #include "sbcl.h"
+#include "runtime.h"
 #include "os.h"
 #include "interr.h"
 #include "globals.h"
@@ -37,6 +37,7 @@
 #include "validate.h"
 #include "lispregs.h"
 #include "arch.h"
+#include "fixnump.h"
 #include "gc.h"
 #include "gc-internal.h"
 #include "thread.h"
@@ -49,8 +50,6 @@ void do_pending_interrupt(void);
 
 /* forward declarations */
 int gc_find_freeish_pages(int *restart_page_ptr, int nbytes, int unboxed);
-void  gc_set_region_empty(struct alloc_region *region);
-void gc_alloc_update_all_page_tables(void);
 static void  gencgc_pickup_dynamic(void);
 boolean interrupt_maybe_gc_int(int, siginfo_t *, void *);
 
@@ -69,7 +68,7 @@ boolean interrupt_maybe_gc_int(int, siginfo_t *, void *);
 boolean enable_page_protection = 1;
 
 /* Should we unmap a page and re-mmap it to have it zero filled? */
-#if defined(__FreeBSD__) || defined(__OpenBSD__)
+#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__)
 /* comment from cmucl-2.4.8: This can waste a lot of swap on FreeBSD
  * so don't unmap there.
  *
@@ -94,7 +93,11 @@ unsigned large_object_size = 4 * PAGE_BYTES;
 
 /* the verbosity level. All non-error messages are disabled at level 0;
  * and only a few rare messages are printed at level 1. */
-unsigned gencgc_verbose = (QSHOW ? 1 : 0);
+#ifdef QSHOW
+unsigned gencgc_verbose = 1;
+#else
+unsigned gencgc_verbose = 0;
+#endif
 
 /* FIXME: At some point enable the various error-checking things below
  * and see what they say. */
@@ -295,7 +298,7 @@ count_generation_pages(int generation)
     return count;
 }
 
-#if QSHOW
+#ifdef QSHOW
 static int
 count_dont_move_pages(void)
 {
@@ -1148,7 +1151,7 @@ copy_large_object(lispobj object, int nwords)
        gc_assert(page_table[first_page].first_object_offset == 0);
 
        next_page = first_page;
-       remaining_bytes = nwords*4;
+       remaining_bytes = nwords*N_WORD_BYTES;
        while (remaining_bytes > PAGE_BYTES) {
            gc_assert(page_table[next_page].gen == from_space);
            gc_assert(page_table[next_page].allocated == BOXED_PAGE_FLAG);
@@ -1210,7 +1213,7 @@ copy_large_object(lispobj object, int nwords)
        bytes_allocated -= bytes_freed;
 
        /* Add the region to the new_areas if requested. */
-       add_new_area(first_page,0,nwords*4);
+       add_new_area(first_page,0,nwords*N_WORD_BYTES);
 
        return(object);
     } else {
@@ -1218,9 +1221,9 @@ copy_large_object(lispobj object, int nwords)
        tag = lowtag_of(object);
 
        /* Allocate space. */
-       new = gc_quick_alloc_large(nwords*4);
+       new = gc_quick_alloc_large(nwords*N_WORD_BYTES);
 
-       memcpy(new,native_pointer(object),nwords*4);
+       memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
 
        /* Return Lisp pointer of new object. */
        return ((lispobj) new) | tag;
@@ -1242,9 +1245,9 @@ copy_unboxed_object(lispobj object, int nwords)
     tag = lowtag_of(object);
 
     /* Allocate space. */
-    new = gc_quick_alloc_unboxed(nwords*4);
+    new = gc_quick_alloc_unboxed(nwords*N_WORD_BYTES);
 
-    memcpy(new,native_pointer(object),nwords*4);
+    memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
 
     /* Return Lisp pointer of new object. */
     return ((lispobj) new) | tag;
@@ -1266,7 +1269,6 @@ copy_large_unboxed_object(lispobj object, int nwords)
 {
     int tag;
     lispobj *new;
-    lispobj *source, *dest;
     int first_page;
 
     gc_assert(is_lisp_pointer(object));
@@ -1274,7 +1276,7 @@ copy_large_unboxed_object(lispobj object, int nwords)
     gc_assert((nwords & 0x01) == 0);
 
     if ((nwords > 1024*1024) && gencgc_verbose)
-       FSHOW((stderr, "/copy_large_unboxed_object: %d bytes\n", nwords*4));
+       FSHOW((stderr, "/copy_large_unboxed_object: %d bytes\n", nwords*N_WORD_BYTES));
 
     /* Check whether it's a large object. */
     first_page = find_page_index((void *)object);
@@ -1292,7 +1294,7 @@ copy_large_unboxed_object(lispobj object, int nwords)
        gc_assert(page_table[first_page].first_object_offset == 0);
 
        next_page = first_page;
-       remaining_bytes = nwords*4;
+       remaining_bytes = nwords*N_WORD_BYTES;
        while (remaining_bytes > PAGE_BYTES) {
            gc_assert(page_table[next_page].gen == from_space);
            gc_assert((page_table[next_page].allocated == UNBOXED_PAGE_FLAG)
@@ -1350,8 +1352,8 @@ copy_large_unboxed_object(lispobj object, int nwords)
                   "/copy_large_unboxed bytes_freed=%d\n",
                   bytes_freed));
 
-       generations[from_space].bytes_allocated -= 4*nwords + bytes_freed;
-       generations[new_space].bytes_allocated += 4*nwords;
+       generations[from_space].bytes_allocated -= nwords*N_WORD_BYTES + bytes_freed;
+       generations[new_space].bytes_allocated += nwords*N_WORD_BYTES;
        bytes_allocated -= bytes_freed;
 
        return(object);
@@ -1361,19 +1363,10 @@ copy_large_unboxed_object(lispobj object, int nwords)
        tag = lowtag_of(object);
 
        /* Allocate space. */
-       new = gc_quick_alloc_large_unboxed(nwords*4);
-
-       dest = new;
-       source = (lispobj *) native_pointer(object);
-
-       /* Copy the object. */
-       while (nwords > 0) {
-           dest[0] = source[0];
-           dest[1] = source[1];
-           dest += 2;
-           source += 2;
-           nwords -= 2;
-       }
+       new = gc_quick_alloc_large_unboxed(nwords*N_WORD_BYTES);
+
+        /* Copy the object. */
+        memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
 
        /* Return Lisp pointer of new object. */
        return ((lispobj) new) | tag;
@@ -1417,10 +1410,10 @@ sniff_code_object(struct code *code, unsigned displacement)
     nheader_words = HeaderValue(*(lispobj *)code);
     nwords = ncode_words + nheader_words;
 
-    constants_start_addr = (void *)code + 5*4;
-    constants_end_addr = (void *)code + nheader_words*4;
-    code_start_addr = (void *)code + nheader_words*4;
-    code_end_addr = (void *)code + nwords*4;
+    constants_start_addr = (void *)code + 5*N_WORD_BYTES;
+    constants_end_addr = (void *)code + nheader_words*N_WORD_BYTES;
+    code_start_addr = (void *)code + nheader_words*N_WORD_BYTES;
+    code_end_addr = (void *)code + nwords*N_WORD_BYTES;
 
     /* Work through the unboxed code. */
     for (p = code_start_addr; p < code_end_addr; p++) {
@@ -1429,7 +1422,7 @@ sniff_code_object(struct code *code, unsigned displacement)
        unsigned d2 = *((unsigned char *)p - 2);
        unsigned d3 = *((unsigned char *)p - 3);
        unsigned d4 = *((unsigned char *)p - 4);
-#if QSHOW
+#ifdef QSHOW
        unsigned d5 = *((unsigned char *)p - 5);
        unsigned d6 = *((unsigned char *)p - 6);
 #endif
@@ -1587,10 +1580,10 @@ gencgc_apply_code_fixups(struct code *old_code, struct code *new_code)
     /* FSHOW((stderr,
             "/compiled code object at %x: header words = %d, code words = %d\n",
             new_code, nheader_words, ncode_words)); */
-    constants_start_addr = (void *)new_code + 5*4;
-    constants_end_addr = (void *)new_code + nheader_words*4;
-    code_start_addr = (void *)new_code + nheader_words*4;
-    code_end_addr = (void *)new_code + nwords*4;
+    constants_start_addr = (void *)new_code + 5*N_WORD_BYTES;
+    constants_end_addr = (void *)new_code + nheader_words*N_WORD_BYTES;
+    code_start_addr = (void *)new_code + nheader_words*N_WORD_BYTES;
+    code_end_addr = (void *)new_code + nwords*N_WORD_BYTES;
     /*
     FSHOW((stderr,
           "/const start = %x, end = %x\n",
@@ -1646,7 +1639,7 @@ gencgc_apply_code_fixups(struct code *old_code, struct code *new_code)
            /* If it's within the old_code object then it must be an
             * absolute fixup (relative ones are not saved) */
            if ((old_value >= (unsigned)old_code)
-               && (old_value < ((unsigned)old_code + nwords*4)))
+               && (old_value < ((unsigned)old_code + nwords*N_WORD_BYTES)))
                /* So add the dispacement. */
                *(unsigned *)((unsigned)code_start_addr + offset) =
                    old_value + displacement;
@@ -1951,64 +1944,34 @@ scav_weak_pointer(lispobj *where, lispobj object)
 }
 
 \f
-/* Scan an area looking for an object which encloses the given pointer.
- * Return the object start on success or NULL on failure. */
-static lispobj *
-search_space(lispobj *start, size_t words, lispobj *pointer)
-{
-    while (words > 0) {
-       size_t count = 1;
-       lispobj thing = *start;
-
-       /* If thing is an immediate then this is a cons. */
-       if (is_lisp_pointer(thing)
-           || ((thing & 3) == 0) /* fixnum */
-           || (widetag_of(thing) == BASE_CHAR_WIDETAG)
-           || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG))
-           count = 2;
-       else
-           count = (sizetab[widetag_of(thing)])(start);
-
-       /* Check whether the pointer is within this object. */
-       if ((pointer >= start) && (pointer < (start+count))) {
-           /* found it! */
-           /*FSHOW((stderr,"/found %x in %x %x\n", pointer, start, thing));*/
-           return(start);
-       }
-
-       /* Round up the count. */
-       count = CEILING(count,2);
-
-       start += count;
-       words -= count;
-    }
-    return (NULL);
-}
-
-lispobj*
-search_read_only_space(lispobj *pointer)
+lispobj *
+search_read_only_space(void *pointer)
 {
-    lispobj* start = (lispobj*)READ_ONLY_SPACE_START;
-    lispobj* end = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0);
-    if ((pointer < start) || (pointer >= end))
+    lispobj *start = (lispobj *) READ_ONLY_SPACE_START;
+    lispobj *end = (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0);
+    if ((pointer < (void *)start) || (pointer >= (void *)end))
        return NULL;
-    return (search_space(start, (pointer+2)-start, pointer));
+    return (search_space(start, 
+                        (((lispobj *)pointer)+2)-start, 
+                        (lispobj *) pointer));
 }
 
 lispobj *
-search_static_space(lispobj *pointer)
+search_static_space(void *pointer)
 {
-    lispobj* start = (lispobj*)STATIC_SPACE_START;
-    lispobj* end = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER,0);
-    if ((pointer < start) || (pointer >= end))
+    lispobj *start = (lispobj *)STATIC_SPACE_START;
+    lispobj *end = (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0);
+    if ((pointer < (void *)start) || (pointer >= (void *)end))
        return NULL;
-    return (search_space(start, (pointer+2)-start, pointer));
+    return (search_space(start, 
+                        (((lispobj *)pointer)+2)-start, 
+                        (lispobj *) pointer));
 }
 
 /* a faster version for searching the dynamic space. This will work even
  * if the object is in a current allocation region. */
 lispobj *
-search_dynamic_space(lispobj *pointer)
+search_dynamic_space(void *pointer)
 {
     int page_index = find_page_index(pointer);
     lispobj *start;
@@ -2019,7 +1982,9 @@ search_dynamic_space(lispobj *pointer)
        return NULL;
     start = (lispobj *)((void *)page_address(page_index)
                        + page_table[page_index].first_object_offset);
-    return (search_space(start, (pointer+2)-start, pointer));
+    return (search_space(start, 
+                        (((lispobj *)pointer)+2)-start, 
+                        (lispobj *)pointer));
 }
 
 /* Is there any possibility that pointer is a valid Lisp object
@@ -2091,12 +2056,12 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer)
        }
        /* Is it plausible cons? */
        if ((is_lisp_pointer(start_addr[0])
-           || ((start_addr[0] & 3) == 0) /* fixnum */
-           || (widetag_of(start_addr[0]) == BASE_CHAR_WIDETAG)
+           || (fixnump(start_addr[0]))
+           || (widetag_of(start_addr[0]) == CHARACTER_WIDETAG)
            || (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG))
           && (is_lisp_pointer(start_addr[1])
-              || ((start_addr[1] & 3) == 0) /* fixnum */
-              || (widetag_of(start_addr[1]) == BASE_CHAR_WIDETAG)
+              || (fixnump(start_addr[1]))
+              || (widetag_of(start_addr[1]) == CHARACTER_WIDETAG)
               || (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG)))
            break;
        else {
@@ -2142,7 +2107,7 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer)
        }
        switch (widetag_of(start_addr[0])) {
        case UNBOUND_MARKER_WIDETAG:
-       case BASE_CHAR_WIDETAG:
+       case CHARACTER_WIDETAG:
            if (gencgc_verbose)
                FSHOW((stderr,
                       "*Wo3: %x %x %x\n",
@@ -2341,7 +2306,7 @@ maybe_adjust_large_object(lispobj *where)
     gc_assert(page_table[first_page].first_object_offset == 0);
 
     next_page = first_page;
-    remaining_bytes = nwords*4;
+    remaining_bytes = nwords*N_WORD_BYTES;
     while (remaining_bytes > PAGE_BYTES) {
        gc_assert(page_table[next_page].gen == from_space);
        gc_assert((page_table[next_page].allocated == BOXED_PAGE_FLAG)
@@ -2558,7 +2523,7 @@ update_page_write_prot(int page)
     int j;
     int wp_it = 1;
     void **page_addr = (void **)page_address(page);
-    int num_words = page_table[page].bytes_used / 4;
+    int num_words = page_table[page].bytes_used / N_WORD_BYTES;
 
     /* Shouldn't be a free page. */
     gc_assert(page_table[page].allocated != FREE_PAGE_FLAG);
@@ -2897,12 +2862,10 @@ scavenge_newspace_generation(int generation)
 
            /* Work through previous_new_areas. */
            for (i = 0; i < previous_new_areas_index; i++) {
-               /* FIXME: All these bare *4 and /4 should be something
-                * like BYTES_PER_WORD or WBYTES. */
                int page = (*previous_new_areas)[i].page;
                int offset = (*previous_new_areas)[i].offset;
-               int size = (*previous_new_areas)[i].size / 4;
-               gc_assert((*previous_new_areas)[i].size % 4 == 0);
+               int size = (*previous_new_areas)[i].size / N_WORD_BYTES;
+               gc_assert((*previous_new_areas)[i].size % N_WORD_BYTES == 0);
                scavenge(page_address(page)+offset, size);
            }
 
@@ -2968,7 +2931,6 @@ unprotect_oldspace(void)
  * assumes that all objects have been copied or promoted to an older
  * generation. Bytes_allocated and the generation bytes_allocated
  * counter are updated. The number of bytes freed is returned. */
-extern void i586_bzero(void *addr, int nbytes);
 static int
 free_oldspace(void)
 {
@@ -3029,23 +2991,14 @@ free_oldspace(void)
            os_invalidate(page_start, PAGE_BYTES*(last_page-first_page));
            addr = os_validate(page_start, PAGE_BYTES*(last_page-first_page));
            if (addr == NULL || addr != page_start) {
-               /* Is this an error condition? I couldn't really tell from
-                * the old CMU CL code, which fprintf'ed a message with
-                * an exclamation point at the end. But I've never seen the
-                * message, so it must at least be unusual..
-                *
-                * (The same condition is also tested for in gc_free_heap.)
-                *
-                * -- WHN 19991129 */
-               lose("i586_bzero: page moved, 0x%08x ==> 0x%08x",
-                    page_start,
+               lose("free_oldspace: page moved, 0x%08x ==> 0x%08x",page_start,
                     addr);
            }
        } else {
            int *page_start;
 
            page_start = (int *)page_address(first_page);
-           i586_bzero(page_start, PAGE_BYTES*(last_page-first_page));
+           memset(page_start, 0,PAGE_BYTES*(last_page-first_page));
        }
 
        first_page = last_page;
@@ -3166,7 +3119,7 @@ verify_space(lispobj *start, size_t words)
                case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
                case VALUE_CELL_HEADER_WIDETAG:
                case SYMBOL_HEADER_WIDETAG:
-               case BASE_CHAR_WIDETAG:
+               case CHARACTER_WIDETAG:
                case UNBOUND_MARKER_WIDETAG:
                case INSTANCE_HEADER_WIDETAG:
                case FDEFN_WIDETAG:
@@ -3382,7 +3335,7 @@ verify_zero_fill(void)
            if (free_bytes > 0) {
                int *start_addr = (int *)((unsigned)page_address(page)
                                          + page_table[page].bytes_used);
-               int size = free_bytes / 4;
+               int size = free_bytes / N_WORD_BYTES;
                int i;
                for (i = 0; i < size; i++) {
                    if (start_addr[i] != 0) {
@@ -3545,7 +3498,7 @@ garbage_collect_generation(int generation, int raise)
        }
     }
 
-#if QSHOW
+#ifdef QSHOW
     if (gencgc_verbose > 1) {
        int num_dont_move_pages = count_dont_move_pages();
        fprintf(stderr,
@@ -4042,8 +3995,12 @@ char *
 alloc(int nbytes)
 {
     struct thread *th=arch_os_get_current_thread();
-    struct alloc_region *region= 
+    struct alloc_region *region=
+#ifdef LISP_FEATURE_SB_THREAD
        th ? &(th->alloc_region) : &boxed_region; 
+#else
+        &boxed_region; 
+#endif
     void *new_obj;
     void *new_free_pointer;
 
@@ -4092,29 +4049,6 @@ alloc(int nbytes)
     new_obj = gc_alloc_with_region(nbytes,0,region,0);
     return (new_obj);
 }
-
-\f
-/* Find the code object for the given pc, or return NULL on failure.
- *
- * FIXME: PC shouldn't be lispobj*, should it? Maybe void*? */
-lispobj *
-component_ptr_from_pc(lispobj *pc)
-{
-    lispobj *object = NULL;
-
-    if ( (object = search_read_only_space(pc)) )
-       ;
-    else if ( (object = search_static_space(pc)) )
-       ;
-    else
-       object = search_dynamic_space(pc);
-
-    if (object) /* if we found something */
-       if (widetag_of(*object) == CODE_HEADER_WIDETAG) /* if it's a code object */
-           return(object);
-
-    return (NULL);
-}
 \f
 /*
  * shared support for the OS-dependent signal handlers which
@@ -4138,7 +4072,7 @@ gencgc_handle_wp_violation(void* fault_addr)
 {
     int  page_index = find_page_index(fault_addr);
 
-#if defined QSHOW_SIGNALS
+#ifdef QSHOW_SIGNALS
     FSHOW((stderr, "heap WP violation? fault_addr=%x, page_index=%d\n",
           fault_addr, page_index));
 #endif