#include <strings.h>
#include <errno.h>
+#include "sbcl.h"
#include "runtime.h"
#include "os.h"
-#include "sbcl.h"
#include "globals.h"
#include "validate.h"
#include "interrupt.h"
#include "purify.h"
#include "interr.h"
+#include "fixnump.h"
#include "gc.h"
#include "gc-internal.h"
#include "thread.h"
#include "genesis/primitive-objects.h"
#include "genesis/static-symbols.h"
+#include "genesis/layout.h"
#define PRINTNOISE
-#if defined(LISP_FEATURE_X86)
-/* again, what's so special about the x86 that this is differently
- * visible there than on other platforms? -dan 20010125
+#if defined(LISP_FEATURE_GENCGC)
+/* this is another artifact of the poor integration between gencgc and
+ * the rest of the runtime: on cheney gc there is a global
+ * dynamic_space_free_pointer which is valid whenever foreign function
+ * call is active, but in gencgc there's no such variable and we have
+ * to keep our own
*/
static lispobj *dynamic_space_free_pointer;
#endif
static lispobj *read_only_free, *static_free;
-static lispobj *pscav(lispobj *addr, int nwords, boolean constant);
+static lispobj *pscav(lispobj *addr, long nwords, boolean constant);
#define LATERBLOCKSIZE 1020
#define LATERMAXCOUNT 10
struct later *next;
union {
lispobj *ptr;
- int count;
+ long count;
} u[LATERBLOCKSIZE];
} *later_blocks = NULL;
-static int later_count = 0;
+static long later_count = 0;
-#define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
-#define NWORDS(x,y) (CEILING((x),(y)) / (y))
+#if N_WORD_BITS == 32
+ #define SIMPLE_ARRAY_WORD_WIDETAG SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG
+#elif N_WORD_BITS == 64
+ #define SIMPLE_ARRAY_WORD_WIDETAG SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
+#endif
/* FIXME: Shouldn't this be defined in sbcl.h? See also notes in
* cheneygc.c */
-#ifdef sparc
+#ifdef LISP_FEATURE_SPARC
#define FUN_RAW_ADDR_OFFSET 0
#else
#define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - FUN_POINTER_LOWTAG)
#endif
}
-static inline newspace_alloc(int nwords, int constantp)
+static inline lispobj *
+newspace_alloc(long nwords, int constantp)
{
lispobj *ret;
nwords=CEILING(nwords,2);
\f
-#ifdef LISP_FEATURE_X86
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
#ifdef LISP_FEATURE_GENCGC
/*
break;
case CLOSURE_HEADER_WIDETAG:
case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
- if ((int)pointer != ((int)start_addr+FUN_POINTER_LOWTAG)) {
+ if ((long)pointer != ((long)start_addr+FUN_POINTER_LOWTAG)) {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wf2: %x %x %x\n", (unsigned int) pointer,
- (unsigned int) start_addr, *start_addr);
+ fprintf(stderr,"*Wf2: %x %x %x\n",
+ (unsigned long) pointer,
+ (unsigned long) start_addr, *start_addr);
}
return 0;
}
break;
default:
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wf3: %x %x %x\n", (unsigned int) pointer,
- (unsigned int) start_addr, *start_addr);
+ fprintf(stderr,"*Wf3: %x %x %x\n", (unsigned long) pointer,
+ (unsigned long) start_addr, *start_addr);
}
return 0;
}
break;
case LIST_POINTER_LOWTAG:
- if ((int)pointer != ((int)start_addr+LIST_POINTER_LOWTAG)) {
+ if ((long)pointer != ((long)start_addr+LIST_POINTER_LOWTAG)) {
if (pointer_filter_verbose)
- fprintf(stderr,"*Wl1: %x %x %x\n", (unsigned int) pointer,
- (unsigned int) start_addr, *start_addr);
+ fprintf(stderr,"*Wl1: %x %x %x\n", (unsigned long) pointer,
+ (unsigned long) start_addr, *start_addr);
return 0;
}
/* 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)
+ || ((start_addr[0] & FIXNUM_TAG_MASK) == 0) /* fixnum */
+ || (widetag_of(start_addr[0]) == CHARACTER_WIDETAG)
+#if N_WORD_BITS == 64
+ || (widetag_of(start_addr[0]) == SINGLE_FLOAT_WIDETAG)
+#endif
|| (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)
+ || ((start_addr[1] & FIXNUM_TAG_MASK) == 0) /* fixnum */
+ || (widetag_of(start_addr[1]) == CHARACTER_WIDETAG)
+#if N_WORD_BITS == 64
+ || (widetag_of(start_addr[1]) == SINGLE_FLOAT_WIDETAG)
+#endif
|| (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG))) {
break;
} else {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wl2: %x %x %x\n", (unsigned int) pointer,
- (unsigned int) start_addr, *start_addr);
+ fprintf(stderr,"*Wl2: %x %x %x\n", (unsigned long) pointer,
+ (unsigned long) start_addr, *start_addr);
}
return 0;
}
case INSTANCE_POINTER_LOWTAG:
- if ((int)pointer != ((int)start_addr+INSTANCE_POINTER_LOWTAG)) {
+ if ((long)pointer != ((long)start_addr+INSTANCE_POINTER_LOWTAG)) {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wi1: %x %x %x\n", (unsigned int) pointer,
- (unsigned int) start_addr, *start_addr);
+ fprintf(stderr,"*Wi1: %x %x %x\n", (unsigned long) pointer,
+ (unsigned long) start_addr, *start_addr);
}
return 0;
}
if (widetag_of(start_addr[0]) != INSTANCE_HEADER_WIDETAG) {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wi2: %x %x %x\n", (unsigned int) pointer,
- (unsigned int) start_addr, *start_addr);
+ fprintf(stderr,"*Wi2: %x %x %x\n", (unsigned long) pointer,
+ (unsigned long) start_addr, *start_addr);
}
return 0;
}
break;
case OTHER_POINTER_LOWTAG:
- if ((int)pointer != ((int)start_addr+OTHER_POINTER_LOWTAG)) {
+ if ((long)pointer != ((long)start_addr+OTHER_POINTER_LOWTAG)) {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo1: %x %x %x\n", (unsigned int) pointer,
- (unsigned int) start_addr, *start_addr);
+ fprintf(stderr,"*Wo1: %x %x %x\n", (unsigned long) pointer,
+ (unsigned long) start_addr, *start_addr);
}
return 0;
}
/* Is it plausible? Not a cons. XXX should check the headers. */
- if (is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0)) {
+ if (is_lisp_pointer(start_addr[0]) || ((start_addr[0] & FIXNUM_TAG_MASK) == 0)) {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo2: %x %x %x\n", (unsigned int) pointer,
- (unsigned int) start_addr, *start_addr);
+ fprintf(stderr,"*Wo2: %x %x %x\n", (unsigned long) pointer,
+ (unsigned long) start_addr, *start_addr);
}
return 0;
}
switch (widetag_of(start_addr[0])) {
case UNBOUND_MARKER_WIDETAG:
- case BASE_CHAR_WIDETAG:
+ case CHARACTER_WIDETAG:
+#if N_WORD_BITS == 64
+ case SINGLE_FLOAT_WIDETAG:
+#endif
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo3: %x %x %x\n", (unsigned int) pointer,
- (unsigned int) start_addr, *start_addr);
+ fprintf(stderr,"*Wo3: %x %x %x\n", (unsigned long) pointer,
+ (unsigned long) start_addr, *start_addr);
}
return 0;
case CLOSURE_HEADER_WIDETAG:
case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo4: %x %x %x\n", (unsigned int) pointer,
- (unsigned int) start_addr, *start_addr);
+ fprintf(stderr,"*Wo4: %x %x %x\n", (unsigned long) pointer,
+ (unsigned long) start_addr, *start_addr);
}
return 0;
case INSTANCE_HEADER_WIDETAG:
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo5: %x %x %x\n", (unsigned int) pointer,
- (unsigned int) start_addr, *start_addr);
+ fprintf(stderr,"*Wo5: %x %x %x\n", (unsigned long) pointer,
+ (unsigned long) start_addr, *start_addr);
}
return 0;
#endif
case SIMPLE_ARRAY_WIDETAG:
case COMPLEX_BASE_STRING_WIDETAG:
+#ifdef COMPLEX_CHARACTER_STRING_WIDETAG
+ case COMPLEX_CHARACTER_STRING_WIDETAG:
+#endif
case COMPLEX_VECTOR_NIL_WIDETAG:
case COMPLEX_BIT_VECTOR_WIDETAG:
case COMPLEX_VECTOR_WIDETAG:
case FDEFN_WIDETAG:
case CODE_HEADER_WIDETAG:
case BIGNUM_WIDETAG:
+#if N_WORD_BITS != 64
case SINGLE_FLOAT_WIDETAG:
+#endif
case DOUBLE_FLOAT_WIDETAG:
#ifdef LONG_FLOAT_WIDETAG
case LONG_FLOAT_WIDETAG:
#endif
case SIMPLE_ARRAY_NIL_WIDETAG:
case SIMPLE_BASE_STRING_WIDETAG:
+#ifdef SIMPLE_CHARACTER_STRING_WIDETAG
+ case SIMPLE_CHARACTER_STRING_WIDETAG:
+#endif
case SIMPLE_BIT_VECTOR_WIDETAG:
case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
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_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
+#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG:
+#endif
#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
#endif
#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
case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
default:
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo6: %x %x %x\n", (unsigned int) pointer,
- (unsigned int) start_addr, *start_addr);
+ fprintf(stderr,"*Wo6: %x %x %x\n", (unsigned long) pointer,
+ (unsigned long) start_addr, *start_addr);
}
return 0;
}
break;
default:
if (pointer_filter_verbose) {
- fprintf(stderr,"*W?: %x %x %x\n", (unsigned int) pointer,
- (unsigned int) start_addr, *start_addr);
+ fprintf(stderr,"*W?: %x %x %x\n", (unsigned long) pointer,
+ (unsigned long) start_addr, *start_addr);
}
return 0;
}
#define MAX_STACK_POINTERS 256
lispobj *valid_stack_locations[MAX_STACK_POINTERS];
-unsigned int num_valid_stack_locations;
+unsigned long num_valid_stack_locations;
#define MAX_STACK_RETURN_ADDRESSES 128
lispobj *valid_stack_ra_locations[MAX_STACK_RETURN_ADDRESSES];
lispobj *valid_stack_ra_code_objects[MAX_STACK_RETURN_ADDRESSES];
-unsigned int num_valid_stack_ra_locations;
+unsigned long num_valid_stack_ra_locations;
/* Identify valid stack slots. */
static void
MAX_STACK_RETURN_ADDRESSES);
valid_stack_ra_locations[num_valid_stack_ra_locations] = sp;
valid_stack_ra_code_objects[num_valid_stack_ra_locations++] =
- (lispobj *)((int)start_addr + OTHER_POINTER_LOWTAG);
+ (lispobj *)((long)start_addr + OTHER_POINTER_LOWTAG);
} else {
if (valid_dynamic_space_pointer((void *)thing, start_addr)) {
gc_assert(num_valid_stack_locations < MAX_STACK_POINTERS);
static void
pscav_i386_stack(void)
{
- int i;
+ long i;
for (i = 0; i < num_valid_stack_locations; i++)
pscav(valid_stack_locations[i], 1, 0);
if (pointer_filter_verbose) {
fprintf(stderr,"*C moved RA %x to %x; for code object %x to %x\n",
*valid_stack_ra_locations[i],
- (int)(*valid_stack_ra_locations[i])
- - ((int)valid_stack_ra_code_objects[i] - (int)code_obj),
- (unsigned int) valid_stack_ra_code_objects[i], code_obj);
+ (long)(*valid_stack_ra_locations[i])
+ - ((long)valid_stack_ra_code_objects[i] - (long)code_obj),
+ (unsigned long) valid_stack_ra_code_objects[i], code_obj);
}
*valid_stack_ra_locations[i] =
- ((int)(*valid_stack_ra_locations[i])
- - ((int)valid_stack_ra_code_objects[i] - (int)code_obj));
+ ((long)(*valid_stack_ra_locations[i])
+ - ((long)valid_stack_ra_code_objects[i] - (long)code_obj));
}
}
#endif
\f
static void
-pscav_later(lispobj *where, int count)
+pscav_later(lispobj *where, long count)
{
struct later *new;
static lispobj
ptrans_boxed(lispobj thing, lispobj header, boolean constant)
{
- int nwords;
+ long nwords;
lispobj result, *new, *old;
- nwords = 1 + HeaderValue(header);
+ nwords = CEILING(1 + HeaderValue(header), 2);
/* Allocate it */
old = (lispobj *)native_pointer(thing);
* space placed into it (e.g. the cache-name slot), but
* the lists and arrays at the time of a purify can be
* moved to the RO space. */
- int nwords;
+ long nwords;
lispobj result, *new, *old;
- nwords = 1 + HeaderValue(header);
+ nwords = CEILING(1 + HeaderValue(header), 2);
/* Allocate it */
old = (lispobj *)native_pointer(thing);
static lispobj
ptrans_fdefn(lispobj thing, lispobj header)
{
- int nwords;
+ long nwords;
lispobj result, *new, *old, oldfn;
struct fdefn *fdefn;
- nwords = 1 + HeaderValue(header);
+ nwords = CEILING(1 + HeaderValue(header), 2);
/* Allocate it */
old = (lispobj *)native_pointer(thing);
static lispobj
ptrans_unboxed(lispobj thing, lispobj header)
{
- int nwords;
+ long nwords;
lispobj result, *new, *old;
- nwords = 1 + HeaderValue(header);
+ nwords = CEILING(1 + HeaderValue(header), 2);
/* Allocate it */
old = (lispobj *)native_pointer(thing);
}
static lispobj
-ptrans_vector(lispobj thing, int bits, int extra,
+ptrans_vector(lispobj thing, long bits, long extra,
boolean boxed, boolean constant)
{
struct vector *vector;
- int nwords;
+ long nwords;
lispobj result, *new;
+ long length;
vector = (struct vector *)native_pointer(thing);
- nwords = 2 + (CEILING((fixnum_value(vector->length)+extra)*bits,32)>>5);
+ length = fixnum_value(vector->length)+extra;
+ // Argh, handle simple-vector-nil separately.
+ if (bits == 0) {
+ nwords = 2;
+ } else {
+ nwords = CEILING(NWORDS(length, bits) + 2, 2);
+ }
new=newspace_alloc(nwords, (constant || !boxed));
bcopy(vector, new, nwords * sizeof(lispobj));
return result;
}
-#ifdef LISP_FEATURE_X86
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
static void
apply_code_fixups_during_purify(struct code *old_code, struct code *new_code)
{
- int nheader_words, ncode_words, nwords;
+ long nheader_words, ncode_words, nwords;
void *constants_start_addr, *constants_end_addr;
void *code_start_addr, *code_end_addr;
lispobj fixups = NIL;
nheader_words = HeaderValue(*(lispobj *)new_code);
nwords = ncode_words + nheader_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;
/* The first constant should be a pointer to the fixups for this
* code objects. Check. */
(struct vector *)native_pointer(*(lispobj *)fixups_vector);
}
- if (widetag_of(fixups_vector->header) ==
- SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG) {
+ if (widetag_of(fixups_vector->header) == SIMPLE_ARRAY_WORD_WIDETAG) {
/* We got the fixups for the code block. Now work through the
* vector, and apply a fixup at each address. */
- int length = fixnum_value(fixups_vector->length);
- int i;
+ long length = fixnum_value(fixups_vector->length);
+ long i;
for (i=0; i<length; i++) {
unsigned offset = fixups_vector->data[i];
/* Now check the current value of offset. */
/* 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;
ptrans_code(lispobj thing)
{
struct code *code, *new;
- int nwords;
+ long nwords;
lispobj func, result;
code = (struct code *)native_pointer(thing);
- nwords = HeaderValue(code->header) + fixnum_value(code->code_size);
+ nwords = CEILING(HeaderValue(code->header) + fixnum_value(code->code_size),
+ 2);
new = (struct code *)newspace_alloc(nwords,1); /* constant */
bcopy(code, new, nwords * sizeof(lispobj));
-#ifdef LISP_FEATURE_X86
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
apply_code_fixups_during_purify(code,new);
#endif
pscav_later(&new->debug_info, 1);
/* FIXME: why would this be a fixnum? */
- if (!(new->trace_table_offset & (EVEN_FIXNUM_LOWTAG|ODD_FIXNUM_LOWTAG)))
+ /* "why" is a hard word, but apparently for compiled functions the
+ trace_table_offset contains the length of the instructions, as
+ a fixnum. See CODE-INST-AREA-LENGTH in
+ src/compiler/target-disassem.lisp. -- CSR, 2004-01-08 */
+ if (!(fixnump(new->trace_table_offset)))
#if 0
pscav(&new->trace_table_offset, 1, 0);
#else
gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG);
gc_assert(!dynamic_pointer_p(func));
-#ifdef LISP_FEATURE_X86
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
/* Temporarily convert the self pointer to a real function pointer. */
((struct simple_fun *)native_pointer(func))->self
-= FUN_RAW_ADDR_OFFSET;
#endif
pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1);
-#ifdef LISP_FEATURE_X86
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
((struct simple_fun *)native_pointer(func))->self
+= FUN_RAW_ADDR_OFFSET;
#endif
static lispobj
ptrans_func(lispobj thing, lispobj header)
{
- int nwords;
+ long nwords;
lispobj code, *new, *old, result;
struct simple_fun *function;
}
else {
/* It's some kind of closure-like thing. */
- nwords = 1 + HeaderValue(header);
+ nwords = CEILING(1 + HeaderValue(header), 2);
old = (lispobj *)native_pointer(thing);
/* Allocate the new one. FINs *must* not go in read_only
ptrans_list(lispobj thing, boolean constant)
{
struct cons *old, *new, *orig;
- int length;
+ long length;
- orig = newspace_alloc(0,constant);
+ orig = (struct cons *) newspace_alloc(0,constant);
length = 0;
do {
case COMPLEX_WIDETAG:
case SIMPLE_ARRAY_WIDETAG:
case COMPLEX_BASE_STRING_WIDETAG:
+#ifdef COMPLEX_CHARACTER_STRING_WIDETAG
+ case COMPLEX_CHARACTER_STRING_WIDETAG:
+#endif
case COMPLEX_BIT_VECTOR_WIDETAG:
case COMPLEX_VECTOR_NIL_WIDETAG:
case COMPLEX_VECTOR_WIDETAG:
case SIMPLE_BASE_STRING_WIDETAG:
return ptrans_vector(thing, 8, 1, 0, constant);
+#ifdef SIMPLE_CHARACTER_STRING_WIDETAG
+ case SIMPLE_CHARACTER_STRING_WIDETAG:
+ return ptrans_vector(thing, 32, 1, 0, constant);
+#endif
+
case SIMPLE_BIT_VECTOR_WIDETAG:
return ptrans_vector(thing, 1, 0, 0, constant);
case SIMPLE_VECTOR_WIDETAG:
- return ptrans_vector(thing, 32, 0, 1, constant);
+ return ptrans_vector(thing, N_WORD_BITS, 0, 1, constant);
case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
return ptrans_vector(thing, 2, 0, 0, constant);
#endif
return ptrans_vector(thing, 32, 0, 0, constant);
+#if N_WORD_BITS == 64
+#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
+#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_64_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
+ return ptrans_vector(thing, 64, 0, 0, constant);
+#endif
+
case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
return ptrans_vector(thing, 32, 0, 0, constant);
#ifdef LISP_FEATURE_X86
return ptrans_vector(thing, 96, 0, 0, constant);
#endif
-#ifdef sparc
+#ifdef LISP_FEATURE_SPARC
return ptrans_vector(thing, 128, 0, 0, constant);
#endif
#endif
#ifdef LISP_FEATURE_X86
return ptrans_vector(thing, 192, 0, 0, constant);
#endif
-#ifdef sparc
+#ifdef LISP_FEATURE_SPARC
return ptrans_vector(thing, 256, 0, 0, constant);
#endif
#endif
return ptrans_fdefn(thing, header);
default:
+ fprintf(stderr, "Invalid widetag: %d\n", widetag_of(header));
/* Should only come across other pointers to the above stuff. */
gc_abort();
return NIL;
}
}
-static int
+static long
pscav_fdefn(struct fdefn *fdefn)
{
boolean fix_func;
return sizeof(struct fdefn) / sizeof(lispobj);
}
-#ifdef LISP_FEATURE_X86
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
/* now putting code objects in static space */
-static int
+static long
pscav_code(struct code*code)
{
- int nwords;
+ long nwords;
lispobj func;
- nwords = HeaderValue(code->header) + fixnum_value(code->code_size);
+ nwords = CEILING(HeaderValue(code->header) + fixnum_value(code->code_size),
+ 2);
/* Arrange to scavenge the debug info later. */
pscav_later(&code->debug_info, 1);
gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG);
gc_assert(!dynamic_pointer_p(func));
-#ifdef LISP_FEATURE_X86
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
/* Temporarily convert the self pointer to a real function
* pointer. */
((struct simple_fun *)native_pointer(func))->self
-= FUN_RAW_ADDR_OFFSET;
#endif
pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1);
-#ifdef LISP_FEATURE_X86
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
((struct simple_fun *)native_pointer(func))->self
+= FUN_RAW_ADDR_OFFSET;
#endif
#endif
static lispobj *
-pscav(lispobj *addr, int nwords, boolean constant)
+pscav(lispobj *addr, long nwords, boolean constant)
{
lispobj thing, *thingp, header;
- int count = 0; /* (0 = dummy init value to stop GCC warning) */
+ long count = 0; /* (0 = dummy init value to stop GCC warning) */
struct vector *vector;
while (nwords > 0) {
}
count = 1;
}
- else if (thing & 3) { /* FIXME: 3? not 2? */
+#if N_WORD_BITS == 64
+ else if (widetag_of(thing) == SINGLE_FLOAT_WIDETAG) {
+ count = 1;
+ }
+#endif
+ else if (thing & FIXNUM_TAG_MASK) {
/* It's an other immediate. Maybe the header for an unboxed */
/* object. */
switch (widetag_of(thing)) {
#endif
case SAP_WIDETAG:
/* It's an unboxed simple object. */
- count = HeaderValue(thing)+1;
+ count = CEILING(HeaderValue(thing)+1, 2);
break;
case SIMPLE_VECTOR_WIDETAG:
*addr = (subtype_VectorMustRehash << N_WIDETAG_BITS) |
SIMPLE_VECTOR_WIDETAG;
}
- count = 1;
+ count = 2;
break;
case SIMPLE_ARRAY_NIL_WIDETAG:
case SIMPLE_BASE_STRING_WIDETAG:
vector = (struct vector *)addr;
- count = CEILING(NWORDS(fixnum_value(vector->length)+1,4)+2,2);
+ count = CEILING(NWORDS(fixnum_value(vector->length)+1,8)+2,2);
break;
+#ifdef SIMPLE_CHARACTER_STRING_WIDETAG
+ case SIMPLE_CHARACTER_STRING_WIDETAG:
+ vector = (struct vector *)addr;
+ count = CEILING(NWORDS(fixnum_value(vector->length)+1,32)+2,2);
+ break;
+#endif
+
case SIMPLE_BIT_VECTOR_WIDETAG:
vector = (struct vector *)addr;
- count = CEILING(NWORDS(fixnum_value(vector->length),32)+2,2);
+ count = CEILING(NWORDS(fixnum_value(vector->length),1)+2,2);
break;
case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
vector = (struct vector *)addr;
- count = CEILING(NWORDS(fixnum_value(vector->length),16)+2,2);
+ count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2);
break;
case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
vector = (struct vector *)addr;
- count = CEILING(NWORDS(fixnum_value(vector->length),8)+2,2);
+ count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2);
break;
case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
#endif
vector = (struct vector *)addr;
- count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2);
+ count = CEILING(NWORDS(fixnum_value(vector->length),8)+2,2);
break;
case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
#endif
vector = (struct vector *)addr;
- count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2);
+ count = CEILING(NWORDS(fixnum_value(vector->length),16)+2,2);
break;
case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
#endif
vector = (struct vector *)addr;
- count = CEILING(fixnum_value(vector->length)+2,2);
+ count = CEILING(NWORDS(fixnum_value(vector->length),32)+2,2);
+ break;
+
+#if N_WORD_BITS == 64
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG:
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG:
+#endif
+#ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
+ case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG:
+ case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG:
+#endif
+ vector = (struct vector *)addr;
+ count = CEILING(NWORDS(fixnum_value(vector->length),64)+2,2);
break;
+#endif
case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
vector = (struct vector *)addr;
- count = CEILING(fixnum_value(vector->length)+2,2);
+ count = CEILING(NWORDS(fixnum_value(vector->length), 32) + 2,
+ 2);
break;
case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
#endif
vector = (struct vector *)addr;
- count = fixnum_value(vector->length)*2+2;
+ count = CEILING(NWORDS(fixnum_value(vector->length), 64) + 2,
+ 2);
break;
#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
#ifdef LISP_FEATURE_X86
count = fixnum_value(vector->length)*3+2;
#endif
-#ifdef sparc
+#ifdef LISP_FEATURE_SPARC
count = fixnum_value(vector->length)*4+2;
#endif
break;
#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
vector = (struct vector *)addr;
- count = fixnum_value(vector->length)*4+2;
+ count = CEILING(NWORDS(fixnum_value(vector->length), 128) + 2,
+ 2);
break;
#endif
#ifdef LISP_FEATURE_X86
count = fixnum_value(vector->length)*6+2;
#endif
-#ifdef sparc
+#ifdef LISP_FEATURE_SPARC
count = fixnum_value(vector->length)*8+2;
#endif
break;
#endif
case CODE_HEADER_WIDETAG:
-#ifndef LISP_FEATURE_X86
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
gc_abort(); /* no code headers in static space */
#else
count = pscav_code((struct code*)addr);
gc_abort();
break;
-#ifdef LISP_FEATURE_X86
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
case CLOSURE_HEADER_WIDETAG:
case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
/* The function self pointer needs special care on the
count = pscav_fdefn((struct fdefn *)addr);
break;
+ case INSTANCE_HEADER_WIDETAG:
+ {
+ struct instance *instance = (struct instance *) addr;
+ struct layout *layout
+ = (struct layout *) native_pointer(instance->slots[0]);
+ long nuntagged = fixnum_value(layout->n_untagged_slots);
+ long nslots = HeaderValue(*addr);
+ pscav(addr + 1, nslots - nuntagged, constant);
+ count = CEILING(1 + nslots, 2);
+ }
+ break;
+
default:
count = 1;
break;
purify(lispobj static_roots, lispobj read_only_roots)
{
lispobj *clean;
- int count, i;
+ long count, i;
struct later *laters, *next;
struct thread *thread;
return 0;
}
-#if defined(LISP_FEATURE_X86)
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
dynamic_space_free_pointer =
(lispobj*)SymbolValue(ALLOCATION_POINTER,0);
#endif
fflush(stdout);
#endif
-#if (defined(LISP_FEATURE_GENCGC) && defined(LISP_FEATURE_X86))
+#if defined(LISP_FEATURE_GENCGC) && (defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
/* note this expects only one thread to be active. We'd have to
* stop all the others in the same way as GC does if we wanted
* PURIFY to work when >1 thread exists */
printf(" stack");
fflush(stdout);
#endif
-#ifndef LISP_FEATURE_X86
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
pscav((lispobj *)all_threads->control_stack_start,
current_control_stack_pointer -
all_threads->control_stack_start,
printf(" bindings");
fflush(stdout);
#endif
-#if !defined(LISP_FEATURE_X86)
+#if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
pscav( (lispobj *)all_threads->binding_stack_start,
(lispobj *)current_binding_stack_pointer -
all_threads->binding_stack_start,
/* Zero the stack. Note that the stack is also zeroed by SUB-GC
* calling SCRUB-CONTROL-STACK - this zeros the stack on the x86. */
-#ifndef LISP_FEATURE_X86
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
os_zero((os_vm_address_t) current_control_stack_pointer,
(os_vm_size_t)
((all_threads->control_stack_end -
SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free,0);
SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free,0);
-#if !defined(LISP_FEATURE_X86)
+#if !defined(ALLOCATION_POINTER)
dynamic_space_free_pointer = current_dynamic_space;
set_auto_gc_trigger(bytes_consed_between_gcs);
#else
#endif
#endif
+ /* Blast away instruction cache */
+ os_flush_icache((os_vm_address_t)READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE);
+ os_flush_icache((os_vm_address_t)STATIC_SPACE_START, STATIC_SPACE_SIZE);
+
#ifdef PRINTNOISE
printf(" done]\n");
fflush(stdout);
projects / sbcl.git / blobdiff