#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"
#include "validate.h"
#include "lispregs.h"
#include "arch.h"
+#include "fixnump.h"
#include "gc.h"
#include "gc-internal.h"
#include "thread.h"
/* 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 *);
* that don't have pointers to younger generations? */
boolean enable_page_protection = 1;
+/* Should we unmap a page and re-mmap it to have it zero filled? */
+#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.
+ *
+ * The CMU CL comment didn't specify a version, but was probably an
+ * old version of FreeBSD (pre-4.0), so this might no longer be true.
+ * OTOH, if it is true, this behavior might exist on OpenBSD too, so
+ * for now we don't unmap there either. -- WHN 2001-04-07 */
+boolean gencgc_unmap_zero = 0;
+#else
+boolean gencgc_unmap_zero = 1;
+#endif
+
/* the minimum size (in bytes) for a large object*/
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. */
/* Calculate the start address for the given page number. */
-static inline void *
+inline void *
page_address(int page_num)
{
return (heap_base + (page_num * PAGE_BYTES));
return count;
}
-#if QSHOW
+#ifdef QSHOW
static int
count_dont_move_pages(void)
{
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);
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 {
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;
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;
{
int tag;
lispobj *new;
- lispobj *source, *dest;
int first_page;
gc_assert(is_lisp_pointer(object));
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);
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)
"/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);
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;
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++) {
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
/* 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",
/* 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;
}
\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;
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
}
/* 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 {
}
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",
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)
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);
/* 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);
}
&& (page_table[last_page].bytes_used != 0)
&& (page_table[last_page].gen == from_space));
- /* Zero pages from first_page to (last_page-1). */
- memset(page_address(first_page), 0, PAGE_BYTES*(last_page-first_page));
+ /* Zero pages from first_page to (last_page-1).
+ *
+ * FIXME: Why not use os_zero(..) function instead of
+ * hand-coding this again? (Check other gencgc_unmap_zero
+ * stuff too. */
+ if (gencgc_unmap_zero) {
+ void *page_start, *addr;
+
+ page_start = (void *)page_address(first_page);
+
+ 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) {
+ lose("free_oldspace: page moved, 0x%08x ==> 0x%08x",page_start,
+ addr);
+ }
+ } else {
+ int *page_start;
+
+ page_start = (int *)page_address(first_page);
+ memset(page_start, 0,PAGE_BYTES*(last_page-first_page));
+ }
first_page = last_page;
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:
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) {
}
}
-#if QSHOW
+#ifdef QSHOW
if (gencgc_verbose > 1) {
int num_dont_move_pages = count_dont_move_pages();
fprintf(stderr,
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;
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
{
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