#include "validate.h"
#include "lispregs.h"
#include "arch.h"
+#include "fixnump.h"
#include "gc.h"
#include "genesis/primitive-objects.h"
#include "genesis/static-symbols.h"
return newspace_copy;
}
-int (*scavtab[256])(lispobj *where, lispobj object);
+long (*scavtab[256])(lispobj *where, lispobj object);
lispobj (*transother[256])(lispobj object);
-int (*sizetab[256])(lispobj *where);
+long (*sizetab[256])(lispobj *where);
struct weak_pointer *weak_pointers;
unsigned long bytes_consed_between_gcs = 12*1024*1024;
/* to copy a boxed object */
lispobj
-copy_object(lispobj object, int nwords)
+copy_object(lispobj object, long nwords)
{
int tag;
lispobj *new;
tag = lowtag_of(object);
/* Allocate space. */
- new = gc_general_alloc(nwords*4,ALLOC_BOXED,ALLOC_QUICK);
+ new = gc_general_alloc(nwords*N_WORD_BYTES,ALLOC_BOXED,ALLOC_QUICK);
/* Copy the object. */
- memcpy(new,native_pointer(object),nwords*4);
+ memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
return make_lispobj(new,tag);
}
-static int scav_lose(lispobj *where, lispobj object); /* forward decl */
+static long scav_lose(lispobj *where, lispobj object); /* forward decl */
/* FIXME: Most calls end up going to some trouble to compute an
* 'n_words' value for this function. The system might be a little
{
lispobj *end = start + n_words;
lispobj *object_ptr;
- int n_words_scavenged;
+ long n_words_scavenged;
for (object_ptr = start;
+
object_ptr < end;
object_ptr += n_words_scavenged) {
}
}
#endif
- else if ((object & 3) == 0) {
+ else if (fixnump(object)) {
/* It's a fixnum: really easy.. */
n_words_scavenged = 1;
} else {
static lispobj trans_fun_header(lispobj object); /* forward decls */
static lispobj trans_boxed(lispobj object);
-static int
+static long
scav_fun_pointer(lispobj *where, lispobj object)
{
lispobj *first_pointer;
{
struct code *new_code;
lispobj first, l_code, l_new_code;
- int nheader_words, ncode_words, nwords;
+ long nheader_words, ncode_words, nwords;
unsigned long displacement;
lispobj fheaderl, *prev_pointer;
/* fix self pointer. */
nfheaderp->self =
-#ifdef LISP_FEATURE_X86
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
FUN_RAW_ADDR_OFFSET +
#endif
nfheaderl;
fheaderl = fheaderp->next;
prev_pointer = &nfheaderp->next;
}
- os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words),
- ncode_words * sizeof(int));
+ os_flush_icache((os_vm_address_t) (((long *)new_code) + nheader_words),
+ ncode_words * sizeof(long));
#ifdef LISP_FEATURE_GENCGC
gencgc_apply_code_fixups(code, new_code);
#endif
return new_code;
}
-static int
+static long
scav_code_header(lispobj *where, lispobj object)
{
struct code *code;
- int n_header_words, n_code_words, n_words;
+ long n_header_words, n_code_words, n_words;
lispobj entry_point; /* tagged pointer to entry point */
struct simple_fun *function_ptr; /* untagged pointer to entry point */
}
-static int
+static long
size_code_header(lispobj *where)
{
struct code *code;
- int nheader_words, ncode_words, nwords;
+ long nheader_words, ncode_words, nwords;
code = (struct code *) where;
return nwords;
}
-#ifndef LISP_FEATURE_X86
-static int
+#if !defined(LISP_FEATURE_X86) && ! defined(LISP_FEATURE_X86_64)
+static long
scav_return_pc_header(lispobj *where, lispobj object)
{
lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x",
struct code *code, *ncode;
return_pc = (struct simple_fun *) native_pointer(object);
- offset = HeaderValue(return_pc->header) * 4 ;
+ /* FIXME: was times 4, should it really be N_WORD_BYTES? */
+ offset = HeaderValue(return_pc->header) * N_WORD_BYTES;
/* Transport the whole code object */
code = (struct code *) ((unsigned long) return_pc - offset);
* objects don't move, we don't need to update anything, but we do
* have to figure out that the function is still live. */
-#ifdef LISP_FEATURE_X86
-static int
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+static long
scav_closure_header(lispobj *where, lispobj object)
{
struct closure *closure;
}
#endif
-#ifndef LISP_FEATURE_X86
-static int
+#if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
+static long
scav_fun_header(lispobj *where, lispobj object)
{
lose("attempted to scavenge a function header where=0x%08x object=0x%08x",
struct code *code, *ncode;
fheader = (struct simple_fun *) native_pointer(object);
- offset = HeaderValue(fheader->header) * 4;
+ /* FIXME: was times 4, should it really be N_WORD_BYTES? */
+ offset = HeaderValue(fheader->header) * N_WORD_BYTES;
/* Transport the whole code object */
code = (struct code *) ((unsigned long) fheader - offset);
* instances
*/
-static int
+static long
scav_instance_pointer(lispobj *where, lispobj object)
{
lispobj copy, *first_pointer;
static lispobj trans_list(lispobj object);
-static int
+static long
scav_list_pointer(lispobj *where, lispobj object)
{
lispobj first, *first_pointer;
* scavenging and transporting other pointers
*/
-static int
+static long
scav_other_pointer(lispobj *where, lispobj object)
{
lispobj first, *first_pointer;
* immediate, boxed, and unboxed objects
*/
-static int
+static long
size_pointer(lispobj *where)
{
return 1;
}
-static int
+static long
scav_immediate(lispobj *where, lispobj object)
{
return 1;
return NIL; /* bogus return value to satisfy static type checking */
}
-static int
+static long
size_immediate(lispobj *where)
{
return 1;
}
-static int
+static long
scav_boxed(lispobj *where, lispobj object)
{
return 1;
}
-static int
+static long
size_boxed(lispobj *where)
{
lispobj header;
/* Note: on the sparc we don't have to do anything special for fdefns, */
/* 'cause the raw-addr has a function lowtag. */
#ifndef LISP_FEATURE_SPARC
-static int
+static long
scav_fdefn(lispobj *where, lispobj object)
{
struct fdefn *fdefn;
fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
/* gc.c has more casts here, which may be relevant or alternatively
may be compiler warning defeaters. try
- fdefn->raw_addr =
- (u32) ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
+ fdefn->raw_addr = ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
*/
return sizeof(struct fdefn) / sizeof(lispobj);
} else {
}
#endif
-static int
+static long
scav_unboxed(lispobj *where, lispobj object)
{
unsigned long length;
return copy_unboxed_object(object, length);
}
-static int
+static long
size_unboxed(lispobj *where)
{
lispobj header;
return length;
}
-static int\f
+\f
/* vector-like objects */
-
+static long
scav_base_string(lispobj *where, lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
/* NOTE: Strings contain one more byte of data than the length */
/* slot indicates. */
trans_base_string(lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
gc_assert(is_lisp_pointer(object));
return copy_large_unboxed_object(object, nwords);
}
-static int
+static long
size_base_string(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
/* NOTE: A string contains one more byte of data (a terminating
* '\0' to help when interfacing with C functions) than indicated
return nwords;
}
+static long
+scav_character_string(lispobj *where, lispobj object)
+{
+ struct vector *vector;
+ int length, nwords;
+
+ /* NOTE: Strings contain one more byte of data than the length */
+ /* slot indicates. */
+
+ vector = (struct vector *) where;
+ length = fixnum_value(vector->length) + 1;
+ nwords = CEILING(NWORDS(length, 32) + 2, 2);
+
+ return nwords;
+}
static lispobj
-trans_vector(lispobj object)
+trans_character_string(lispobj object)
+{
+ struct vector *vector;
+ int length, nwords;
+
+ gc_assert(is_lisp_pointer(object));
+
+ /* NOTE: A string contains one more byte of data (a terminating
+ * '\0' to help when interfacing with C functions) than indicated
+ * by the length slot. */
+
+ vector = (struct vector *) native_pointer(object);
+ length = fixnum_value(vector->length) + 1;
+ nwords = CEILING(NWORDS(length, 32) + 2, 2);
+
+ return copy_large_unboxed_object(object, nwords);
+}
+
+static long
+size_character_string(lispobj *where)
{
struct vector *vector;
int length, nwords;
+ /* NOTE: A string contains one more byte of data (a terminating
+ * '\0' to help when interfacing with C functions) than indicated
+ * by the length slot. */
+
+ vector = (struct vector *) where;
+ length = fixnum_value(vector->length) + 1;
+ nwords = CEILING(NWORDS(length, 32) + 2, 2);
+
+ return nwords;
+}
+
+static lispobj
+trans_vector(lispobj object)
+{
+ struct vector *vector;
+ long length, nwords;
+
gc_assert(is_lisp_pointer(object));
vector = (struct vector *) native_pointer(object);
return copy_large_object(object, nwords);
}
-static int
+static long
size_vector(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
return nwords;
}
-static int
+static long
scav_vector_nil(lispobj *where, lispobj object)
{
return 2;
return copy_unboxed_object(object, 2);
}
-static int
+static long
size_vector_nil(lispobj *where)
{
/* Just the header word and the length word */
return 2;
}
-static int
+static long
scav_vector_bit(lispobj *where, lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
trans_vector_bit(lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
gc_assert(is_lisp_pointer(object));
return copy_large_unboxed_object(object, nwords);
}
-static int
+static long
size_vector_bit(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
return nwords;
}
-static int
+static long
scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
trans_vector_unsigned_byte_2(lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
gc_assert(is_lisp_pointer(object));
return copy_large_unboxed_object(object, nwords);
}
-static int
+static long
size_vector_unsigned_byte_2(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
return nwords;
}
-static int
+static long
scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
trans_vector_unsigned_byte_4(lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
gc_assert(is_lisp_pointer(object));
return copy_large_unboxed_object(object, nwords);
}
-static int
+static long
size_vector_unsigned_byte_4(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
}
-static int
+static long
scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
trans_vector_unsigned_byte_8(lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
gc_assert(is_lisp_pointer(object));
return copy_large_unboxed_object(object, nwords);
}
-static int
+static long
size_vector_unsigned_byte_8(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
}
-static int
+static long
scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
trans_vector_unsigned_byte_16(lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
gc_assert(is_lisp_pointer(object));
return copy_large_unboxed_object(object, nwords);
}
-static int
+static long
size_vector_unsigned_byte_16(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
return nwords;
}
-static int
+static long
scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
trans_vector_unsigned_byte_32(lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
gc_assert(is_lisp_pointer(object));
return copy_large_unboxed_object(object, nwords);
}
-static int
+static long
size_vector_unsigned_byte_32(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
}
#if N_WORD_BITS == 64
-static int
+static long
scav_vector_unsigned_byte_64(lispobj *where, lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
trans_vector_unsigned_byte_64(lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
gc_assert(is_lisp_pointer(object));
return copy_large_unboxed_object(object, nwords);
}
-static int
+static long
size_vector_unsigned_byte_64(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
}
#endif
-static int
+static long
scav_vector_single_float(lispobj *where, lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length + 2, 2);
+ nwords = CEILING(NWORDS(length, 32) + 2, 2);
return nwords;
}
trans_vector_single_float(lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
gc_assert(is_lisp_pointer(object));
vector = (struct vector *) native_pointer(object);
length = fixnum_value(vector->length);
- nwords = CEILING(length + 2, 2);
+ nwords = CEILING(NWORDS(length, 32) + 2, 2);
return copy_large_unboxed_object(object, nwords);
}
-static int
+static long
size_vector_single_float(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length + 2, 2);
+ nwords = CEILING(NWORDS(length, 32) + 2, 2);
return nwords;
}
-static int
+static long
scav_vector_double_float(lispobj *where, lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
+ nwords = CEILING(NWORDS(length, 64) + 2, 2);
return nwords;
}
trans_vector_double_float(lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
gc_assert(is_lisp_pointer(object));
vector = (struct vector *) native_pointer(object);
length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
+ nwords = CEILING(NWORDS(length, 64) + 2, 2);
return copy_large_unboxed_object(object, nwords);
}
-static int
+static long
size_vector_double_float(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
+ nwords = CEILING(NWORDS(length, 64) + 2, 2);
return nwords;
}
#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
-static int
+static long
scav_vector_long_float(lispobj *where, lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
trans_vector_long_float(lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
gc_assert(is_lisp_pointer(object));
return copy_large_unboxed_object(object, nwords);
}
-static int
+static long
size_vector_long_float(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
-static int
+static long
scav_vector_complex_single_float(lispobj *where, lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
+ nwords = CEILING(NWORDS(length, 64) + 2, 2);
return nwords;
}
trans_vector_complex_single_float(lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
gc_assert(is_lisp_pointer(object));
vector = (struct vector *) native_pointer(object);
length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
+ nwords = CEILING(NWORDS(length, 64) + 2, 2);
return copy_large_unboxed_object(object, nwords);
}
-static int
+static long
size_vector_complex_single_float(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
+ nwords = CEILING(NWORDS(length, 64) + 2, 2);
return nwords;
}
#endif
#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
-static int
+static long
scav_vector_complex_double_float(lispobj *where, lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length * 4 + 2, 2);
+ nwords = CEILING(NWORDS(length, 128) + 2, 2);
return nwords;
}
trans_vector_complex_double_float(lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
gc_assert(is_lisp_pointer(object));
vector = (struct vector *) native_pointer(object);
length = fixnum_value(vector->length);
- nwords = CEILING(length * 4 + 2, 2);
+ nwords = CEILING(NWORDS(length, 128) + 2, 2);
return copy_large_unboxed_object(object, nwords);
}
-static int
+static long
size_vector_complex_double_float(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length * 4 + 2, 2);
+ nwords = CEILING(NWORDS(length, 128) + 2, 2);
return nwords;
}
#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
-static int
+static long
scav_vector_complex_long_float(lispobj *where, lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
trans_vector_complex_long_float(lispobj object)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
gc_assert(is_lisp_pointer(object));
return copy_large_unboxed_object(object, nwords);
}
-static int
+static long
size_vector_complex_long_float(lispobj *where)
{
struct vector *vector;
- int length, nwords;
+ long length, nwords;
vector = (struct vector *) where;
length = fixnum_value(vector->length);
return copy;
}
-static int
+static long
size_weak_pointer(lispobj *where)
{
return WEAK_POINTER_NWORDS;
* initialization
*/
-static int
+static long
scav_lose(lispobj *where, lispobj object)
{
lose("no scavenge function for object 0x%08x (widetag 0x%x)",
- (unsigned long)object,
- widetag_of(*(lispobj*)native_pointer(object)));
+ (unsigned long)object,
+ widetag_of(*(lispobj*)native_pointer(object)));
+
return 0; /* bogus return value to satisfy static type checking */
}
return NIL; /* bogus return value to satisfy static type checking */
}
-static int
+static long
size_lose(lispobj *where)
{
lose("no size function for object at 0x%08x (widetag 0x%x)",
void
gc_init_tables(void)
{
- int i;
+ long i;
/* Set default value in all slots of scavenge table. FIXME
* replace this gnarly sizeof with something based on
* tag) get one entry each in the scavenge table. */
scavtab[BIGNUM_WIDETAG] = scav_unboxed;
scavtab[RATIO_WIDETAG] = scav_boxed;
+#if N_WORD_BITS == 64
+ scavtab[SINGLE_FLOAT_WIDETAG] = scav_immediate;
+#else
scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
+#endif
scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
#ifdef LONG_FLOAT_WIDETAG
scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
#endif
scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
+#ifdef SIMPLE_CHARACTER_STRING_WIDETAG
+ scavtab[SIMPLE_CHARACTER_STRING_WIDETAG] = scav_character_string;
+#endif
scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
scav_vector_unsigned_byte_16;
scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
scav_vector_unsigned_byte_16;
-#ifdef SIMPLE_ARRAY_SIGNED_BYTE_29_WIDETAG
+#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
scav_vector_unsigned_byte_32;
#endif
scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
scav_vector_unsigned_byte_32;
#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
- scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
+ scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
scav_vector_unsigned_byte_64;
#endif
#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
- scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
+ scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
scav_vector_unsigned_byte_64;
#endif
#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
scav_vector_complex_long_float;
#endif
scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
+#ifdef COMPLEX_CHARACTER_STRING_WIDETAG
+ scavtab[COMPLEX_CHARACTER_STRING_WIDETAG] = scav_boxed;
+#endif
scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
#endif
-#ifdef LISP_FEATURE_X86
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
#else
#endif
scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
- scavtab[BASE_CHAR_WIDETAG] = scav_immediate;
+ scavtab[CHARACTER_WIDETAG] = scav_immediate;
scavtab[SAP_WIDETAG] = scav_unboxed;
scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed;
transother[i] = trans_lose;
transother[BIGNUM_WIDETAG] = trans_unboxed;
transother[RATIO_WIDETAG] = trans_boxed;
+
+#if N_WORD_BITS == 64
+ transother[SINGLE_FLOAT_WIDETAG] = trans_immediate;
+#else
transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
+#endif
transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
#ifdef LONG_FLOAT_WIDETAG
transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
#endif
transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
+#ifdef SIMPLE_CHARACTER_STRING_WIDETAG
+ transother[SIMPLE_CHARACTER_STRING_WIDETAG] = trans_character_string;
+#endif
transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
trans_vector_unsigned_byte_32;
#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
transother[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
- trans_vector_unsigned_byte_32;
+ trans_vector_unsigned_byte_64;
#endif
#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
transother[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
trans_vector_complex_long_float;
#endif
transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
+#ifdef COMPLEX_CHARACTER_STRING_WIDETAG
+ transother[COMPLEX_CHARACTER_STRING_WIDETAG] = trans_boxed;
+#endif
transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
- transother[BASE_CHAR_WIDETAG] = trans_immediate;
+ transother[CHARACTER_WIDETAG] = trans_immediate;
transother[SAP_WIDETAG] = trans_unboxed;
transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
}
sizetab[BIGNUM_WIDETAG] = size_unboxed;
sizetab[RATIO_WIDETAG] = size_boxed;
+#if N_WORD_BITS == 64
+ sizetab[SINGLE_FLOAT_WIDETAG] = size_immediate;
+#else
sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
+#endif
sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
#ifdef LONG_FLOAT_WIDETAG
sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
#endif
sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
+#ifdef SIMPLE_CHARACTER_STRING_WIDETAG
+ sizetab[SIMPLE_CHARACTER_STRING_WIDETAG] = size_character_string;
+#endif
sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
size_vector_complex_long_float;
#endif
sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
+#ifdef COMPLEX_CHARACTER_STRING_WIDETAG
+ sizetab[COMPLEX_CHARACTER_STRING_WIDETAG] = size_boxed;
+#endif
sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
- sizetab[BASE_CHAR_WIDETAG] = size_immediate;
+ sizetab[CHARACTER_WIDETAG] = size_immediate;
sizetab[SAP_WIDETAG] = size_unboxed;
sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
return (NULL);
}
+
+/* Scan an area looking for an object which encloses the given pointer.
+ * Return the object start on success or NULL on failure. */
+lispobj *
+gc_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)
+ || (fixnump(thing))
+ || (widetag_of(thing) == CHARACTER_WIDETAG)
+#if N_WORD_BITS == 64
+ || (widetag_of(thing) == SINGLE_FLOAT_WIDETAG)
+#endif
+ || (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);
+}
projects / sbcl.git / blobdiff