- return nwords;
-}
-
-static int
-scav_return_pc_header(lispobj *where, lispobj object)
-{
- lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x",
- (unsigned long) where,
- (unsigned long) object);
- return 0; /* bogus return value to satisfy static type checking */
-}
-
-static lispobj
-trans_return_pc_header(lispobj object)
-{
- struct function *return_pc;
- unsigned long offset;
- struct code *code, *ncode;
-
- SHOW("/trans_return_pc_header: Will this work?");
-
- return_pc = (struct function *) PTR(object);
- offset = HeaderValue(return_pc->header) * 4;
-
- /* Transport the whole code object. */
- code = (struct code *) ((unsigned long) return_pc - offset);
- ncode = trans_code(code);
-
- return ((lispobj) ncode + offset) | type_OtherPointer;
-}
-
-/* On the 386, closures hold a pointer to the raw address instead of the
- * function object. */
-#ifdef __i386__
-static int
-scav_closure_header(lispobj *where, lispobj object)
-{
- struct closure *closure;
- lispobj fun;
-
- closure = (struct closure *)where;
- fun = closure->function - RAW_ADDR_OFFSET;
- scavenge(&fun, 1);
- /* The function may have moved so update the raw address. But
- * don't write unnecessarily. */
- if (closure->function != fun + RAW_ADDR_OFFSET)
- closure->function = fun + RAW_ADDR_OFFSET;
-
- return 2;
-}
-#endif
-
-static int
-scav_function_header(lispobj *where, lispobj object)
-{
- lose("attempted to scavenge a function header where=0x%08x object=0x%08x",
- (unsigned long) where,
- (unsigned long) object);
- return 0; /* bogus return value to satisfy static type checking */
-}
-
-static lispobj
-trans_function_header(lispobj object)
-{
- struct function *fheader;
- unsigned long offset;
- struct code *code, *ncode;
-
- fheader = (struct function *) PTR(object);
- offset = HeaderValue(fheader->header) * 4;
-
- /* Transport the whole code object. */
- code = (struct code *) ((unsigned long) fheader - offset);
- ncode = trans_code(code);
-
- return ((lispobj) ncode + offset) | type_FunctionPointer;
-}
-\f
-/*
- * instances
- */
-
-static int
-scav_instance_pointer(lispobj *where, lispobj object)
-{
- lispobj copy, *first_pointer;
-
- /* Object is a pointer into from space - not a FP. */
- copy = trans_boxed(object);
-
- gc_assert(copy != object);
-
- first_pointer = (lispobj *) PTR(object);
-
- /* Set forwarding pointer. */
- first_pointer[0] = 0x01;
- first_pointer[1] = copy;
- *where = copy;
-
- return 1;
-}
-\f
-/*
- * lists and conses
- */
-
-static lispobj trans_list(lispobj object);
-
-static int
-scav_list_pointer(lispobj *where, lispobj object)
-{
- lispobj first, *first_pointer;
-
- gc_assert(Pointerp(object));
-
- /* Object is a pointer into from space - not FP. */
-
- first = trans_list(object);
- gc_assert(first != object);
-
- first_pointer = (lispobj *) PTR(object);
-
- /* Set forwarding pointer */
- first_pointer[0] = 0x01;
- first_pointer[1] = first;
-
- gc_assert(Pointerp(first));
- gc_assert(!from_space_p(first));
- *where = first;
- return 1;
-}
-
-static lispobj
-trans_list(lispobj object)
-{
- lispobj new_list_pointer;
- struct cons *cons, *new_cons;
- lispobj cdr;
-
- gc_assert(from_space_p(object));
-
- cons = (struct cons *) PTR(object);
-
- /* Copy 'object'. */
- new_cons = (struct cons *) gc_quick_alloc(sizeof(struct cons));
- new_cons->car = cons->car;
- new_cons->cdr = cons->cdr; /* updated later */
- new_list_pointer = (lispobj)new_cons | LowtagOf(object);
-
- /* Grab the cdr before it is clobbered. */
- cdr = cons->cdr;
-
- /* Set forwarding pointer (clobbers start of list). */
- cons->car = 0x01;
- cons->cdr = new_list_pointer;
-
- /* Try to linearize the list in the cdr direction to help reduce
- * paging. */
- while (1) {
- lispobj new_cdr;
- struct cons *cdr_cons, *new_cdr_cons;
-
- if (LowtagOf(cdr) != type_ListPointer || !from_space_p(cdr)
- || (*((lispobj *)PTR(cdr)) == 0x01))
- break;
-
- cdr_cons = (struct cons *) PTR(cdr);
-
- /* Copy 'cdr'. */
- new_cdr_cons = (struct cons*) gc_quick_alloc(sizeof(struct cons));
- new_cdr_cons->car = cdr_cons->car;
- new_cdr_cons->cdr = cdr_cons->cdr;
- new_cdr = (lispobj)new_cdr_cons | LowtagOf(cdr);
-
- /* Grab the cdr before it is clobbered. */
- cdr = cdr_cons->cdr;
-
- /* Set forwarding pointer. */
- cdr_cons->car = 0x01;
- cdr_cons->cdr = new_cdr;
-
- /* Update the cdr of the last cons copied into new space to
- * keep the newspace scavenge from having to do it. */
- new_cons->cdr = new_cdr;
-
- new_cons = new_cdr_cons;
- }
-
- return new_list_pointer;
-}
-
-\f
-/*
- * scavenging and transporting other pointers
- */
-
-static int
-scav_other_pointer(lispobj *where, lispobj object)
-{
- lispobj first, *first_pointer;
-
- gc_assert(Pointerp(object));
-
- /* Object is a pointer into from space - not FP. */
- first_pointer = (lispobj *) PTR(object);
-
- first = (transother[TypeOf(*first_pointer)])(object);
-
- if (first != object) {
- /* Set forwarding pointer. */
- first_pointer[0] = 0x01;
- first_pointer[1] = first;
- *where = first;
- }
-
- gc_assert(Pointerp(first));
- gc_assert(!from_space_p(first));
-
- return 1;
-}
-\f
-/*
- * immediate, boxed, and unboxed objects
- */
-
-static int
-size_pointer(lispobj *where)
-{
- return 1;
-}
-
-static int
-scav_immediate(lispobj *where, lispobj object)
-{
- return 1;
-}
-
-static lispobj
-trans_immediate(lispobj object)
-{
- lose("trying to transport an immediate");
- return NIL; /* bogus return value to satisfy static type checking */
-}
-
-static int
-size_immediate(lispobj *where)
-{
- return 1;
-}
-
-
-static int
-scav_boxed(lispobj *where, lispobj object)
-{
- return 1;
-}
-
-static lispobj
-trans_boxed(lispobj object)
-{
- lispobj header;
- unsigned long length;
-
- gc_assert(Pointerp(object));
-
- header = *((lispobj *) PTR(object));
- length = HeaderValue(header) + 1;
- length = CEILING(length, 2);
-
- return copy_object(object, length);
-}
-
-static lispobj
-trans_boxed_large(lispobj object)
-{
- lispobj header;
- unsigned long length;
-
- gc_assert(Pointerp(object));
-
- header = *((lispobj *) PTR(object));
- length = HeaderValue(header) + 1;
- length = CEILING(length, 2);
-
- return copy_large_object(object, length);
-}
-
-static int
-size_boxed(lispobj *where)
-{
- lispobj header;
- unsigned long length;
-
- header = *where;
- length = HeaderValue(header) + 1;
- length = CEILING(length, 2);
-
- return length;
-}
-
-static int
-scav_fdefn(lispobj *where, lispobj object)
-{
- struct fdefn *fdefn;
-
- fdefn = (struct fdefn *)where;
-
- /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
- fdefn->function, fdefn->raw_addr)); */
-
- if ((char *)(fdefn->function + RAW_ADDR_OFFSET) == fdefn->raw_addr) {
- scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
-
- /* Don't write unnecessarily. */
- if (fdefn->raw_addr != (char *)(fdefn->function + RAW_ADDR_OFFSET))
- fdefn->raw_addr = (char *)(fdefn->function + RAW_ADDR_OFFSET);
-
- return sizeof(struct fdefn) / sizeof(lispobj);
- } else {
- return 1;
- }
-}
-
-static int
-scav_unboxed(lispobj *where, lispobj object)
-{
- unsigned long length;
-
- length = HeaderValue(object) + 1;
- length = CEILING(length, 2);
-
- return length;
-}
-
-static lispobj
-trans_unboxed(lispobj object)
-{
- lispobj header;
- unsigned long length;
-
-
- gc_assert(Pointerp(object));
-
- header = *((lispobj *) PTR(object));
- length = HeaderValue(header) + 1;
- length = CEILING(length, 2);
-
- return copy_unboxed_object(object, length);
-}
-
-static lispobj
-trans_unboxed_large(lispobj object)
-{
- lispobj header;
- unsigned long length;
-
-
- gc_assert(Pointerp(object));
-
- header = *((lispobj *) PTR(object));
- length = HeaderValue(header) + 1;
- length = CEILING(length, 2);
-
- return copy_large_unboxed_object(object, length);
-}
-
-static int
-size_unboxed(lispobj *where)
-{
- lispobj header;
- unsigned long length;
-
- header = *where;
- length = HeaderValue(header) + 1;
- length = CEILING(length, 2);
-
- return length;
-}
-\f
-/*
- * vector-like objects
- */
-
-#define NWORDS(x,y) (CEILING((x),(y)) / (y))
-
-static int
-scav_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, 4) + 2, 2);
-
- return nwords;
-}
-
-static lispobj
-trans_string(lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- gc_assert(Pointerp(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 *) PTR(object);
- length = fixnum_value(vector->length) + 1;
- nwords = CEILING(NWORDS(length, 4) + 2, 2);
-
- return copy_large_unboxed_object(object, nwords);
-}
-
-static int
-size_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, 4) + 2, 2);
-
- return nwords;
-}
-
-/* FIXME: What does this mean? */
-int gencgc_hash = 1;
-
-static int
-scav_vector(lispobj *where, lispobj object)
-{
- unsigned int kv_length;
- lispobj *kv_vector;
- unsigned int length = 0; /* (0 = dummy to stop GCC warning) */
- lispobj *hash_table;
- lispobj empty_symbol;
- unsigned int *index_vector = NULL; /* (NULL = dummy to stop GCC warning) */
- unsigned int *next_vector = NULL; /* (NULL = dummy to stop GCC warning) */
- unsigned int *hash_vector = NULL; /* (NULL = dummy to stop GCC warning) */
- lispobj weak_p_obj;
- unsigned next_vector_length = 0;
-
- /* FIXME: A comment explaining this would be nice. It looks as
- * though SB-VM:VECTOR-VALID-HASHING-SUBTYPE is set for EQ-based
- * hash tables in the Lisp HASH-TABLE code, and nowhere else. */
- if (HeaderValue(object) != subtype_VectorValidHashing)
- return 1;
-
- if (!gencgc_hash) {
- /* This is set for backward compatibility. FIXME: Do we need
- * this any more? */
- *where = (subtype_VectorMustRehash << type_Bits) | type_SimpleVector;
- return 1;
- }
-
- kv_length = fixnum_value(where[1]);
- kv_vector = where + 2; /* Skip the header and length. */
- /*FSHOW((stderr,"/kv_length = %d\n", kv_length));*/
-
- /* Scavenge element 0, which may be a hash-table structure. */
- scavenge(where+2, 1);
- if (!Pointerp(where[2])) {
- lose("no pointer at %x in hash table", where[2]);
- }
- hash_table = (lispobj *)PTR(where[2]);
- /*FSHOW((stderr,"/hash_table = %x\n", hash_table));*/
- if (TypeOf(hash_table[0]) != type_InstanceHeader) {
- lose("hash table not instance (%x at %x)", hash_table[0], hash_table);
- }
-
- /* Scavenge element 1, which should be some internal symbol that
- * the hash table code reserves for marking empty slots. */
- scavenge(where+3, 1);
- if (!Pointerp(where[3])) {
- lose("not empty-hash-table-slot symbol pointer: %x", where[3]);
- }
- empty_symbol = where[3];
- /* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/
- if (TypeOf(*(lispobj *)PTR(empty_symbol)) != type_SymbolHeader) {
- lose("not a symbol where empty-hash-table-slot symbol expected: %x",
- *(lispobj *)PTR(empty_symbol));
- }
-
- /* Scavenge hash table, which will fix the positions of the other
- * needed objects. */
- scavenge(hash_table, 16);
-
- /* Cross-check the kv_vector. */
- if (where != (lispobj *)PTR(hash_table[9])) {
- lose("hash_table table!=this table %x", hash_table[9]);
- }
-
- /* WEAK-P */
- weak_p_obj = hash_table[10];
-
- /* index vector */
- {
- lispobj index_vector_obj = hash_table[13];
-
- if (Pointerp(index_vector_obj) &&
- (TypeOf(*(lispobj *)PTR(index_vector_obj)) == type_SimpleArrayUnsignedByte32)) {
- index_vector = ((unsigned int *)PTR(index_vector_obj)) + 2;
- /*FSHOW((stderr, "/index_vector = %x\n",index_vector));*/
- length = fixnum_value(((unsigned int *)PTR(index_vector_obj))[1]);
- /*FSHOW((stderr, "/length = %d\n", length));*/
- } else {
- lose("invalid index_vector %x", index_vector_obj);
- }
- }
-
- /* next vector */
- {
- lispobj next_vector_obj = hash_table[14];
-
- if (Pointerp(next_vector_obj) &&
- (TypeOf(*(lispobj *)PTR(next_vector_obj)) == type_SimpleArrayUnsignedByte32)) {
- next_vector = ((unsigned int *)PTR(next_vector_obj)) + 2;
- /*FSHOW((stderr, "/next_vector = %x\n", next_vector));*/
- next_vector_length = fixnum_value(((unsigned int *)PTR(next_vector_obj))[1]);
- /*FSHOW((stderr, "/next_vector_length = %d\n", next_vector_length));*/
- } else {
- lose("invalid next_vector %x", next_vector_obj);
- }
- }
-
- /* maybe hash vector */
- {
- /* FIXME: This bare "15" offset should become a symbolic
- * expression of some sort. And all the other bare offsets
- * too. And the bare "16" in scavenge(hash_table, 16). And
- * probably other stuff too. Ugh.. */
- lispobj hash_vector_obj = hash_table[15];
-
- if (Pointerp(hash_vector_obj) &&
- (TypeOf(*(lispobj *)PTR(hash_vector_obj))
- == type_SimpleArrayUnsignedByte32)) {
- hash_vector = ((unsigned int *)PTR(hash_vector_obj)) + 2;
- /*FSHOW((stderr, "/hash_vector = %x\n", hash_vector));*/
- gc_assert(fixnum_value(((unsigned int *)PTR(hash_vector_obj))[1])
- == next_vector_length);
- } else {
- hash_vector = NULL;
- /*FSHOW((stderr, "/no hash_vector: %x\n", hash_vector_obj));*/
- }
- }
-
- /* These lengths could be different as the index_vector can be a
- * different length from the others, a larger index_vector could help
- * reduce collisions. */
- gc_assert(next_vector_length*2 == kv_length);
-
- /* now all set up.. */
-
- /* Work through the KV vector. */
- {
- int i;
- for (i = 1; i < next_vector_length; i++) {
- lispobj old_key = kv_vector[2*i];
- unsigned int old_index = (old_key & 0x1fffffff)%length;
-
- /* Scavenge the key and value. */
- scavenge(&kv_vector[2*i],2);
-
- /* Check whether the key has moved and is EQ based. */
- {
- lispobj new_key = kv_vector[2*i];
- unsigned int new_index = (new_key & 0x1fffffff)%length;
-
- if ((old_index != new_index) &&
- ((!hash_vector) || (hash_vector[i] == 0x80000000)) &&
- ((new_key != empty_symbol) ||
- (kv_vector[2*i] != empty_symbol))) {
-
- /*FSHOW((stderr,
- "* EQ key %d moved from %x to %x; index %d to %d\n",
- i, old_key, new_key, old_index, new_index));*/
-
- if (index_vector[old_index] != 0) {
- /*FSHOW((stderr, "/P1 %d\n", index_vector[old_index]));*/
-
- /* Unlink the key from the old_index chain. */
- if (index_vector[old_index] == i) {
- /*FSHOW((stderr, "/P2a %d\n", next_vector[i]));*/
- index_vector[old_index] = next_vector[i];
- /* Link it into the needing rehash chain. */
- next_vector[i] = fixnum_value(hash_table[11]);
- hash_table[11] = make_fixnum(i);
- /*SHOW("P2");*/
- } else {
- unsigned prior = index_vector[old_index];
- unsigned next = next_vector[prior];
-
- /*FSHOW((stderr, "/P3a %d %d\n", prior, next));*/
-
- while (next != 0) {
- /*FSHOW((stderr, "/P3b %d %d\n", prior, next));*/
- if (next == i) {
- /* Unlink it. */
- next_vector[prior] = next_vector[next];
- /* Link it into the needing rehash
- * chain. */
- next_vector[next] =
- fixnum_value(hash_table[11]);
- hash_table[11] = make_fixnum(next);
- /*SHOW("/P3");*/
- break;
- }
- prior = next;
- next = next_vector[next];
- }
- }
- }
- }
- }
- }
- }
- return (CEILING(kv_length + 2, 2));
-}
-
-static lispobj
-trans_vector(lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- gc_assert(Pointerp(object));
-
- vector = (struct vector *) PTR(object);
-
- length = fixnum_value(vector->length);
- nwords = CEILING(length + 2, 2);
-
- return copy_large_object(object, nwords);
-}
-
-static int
-size_vector(lispobj *where)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length + 2, 2);
-
- return nwords;
-}
-
-
-static int
-scav_vector_bit(lispobj *where, lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 32) + 2, 2);
-
- return nwords;
-}
-
-static lispobj
-trans_vector_bit(lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- gc_assert(Pointerp(object));
-
- vector = (struct vector *) PTR(object);
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 32) + 2, 2);
-
- return copy_large_unboxed_object(object, nwords);
-}
-
-static int
-size_vector_bit(lispobj *where)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 32) + 2, 2);
-
- return nwords;
-}
-
-
-static int
-scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 16) + 2, 2);
-
- return nwords;
-}
-
-static lispobj
-trans_vector_unsigned_byte_2(lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- gc_assert(Pointerp(object));
-
- vector = (struct vector *) PTR(object);
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 16) + 2, 2);
-
- return copy_large_unboxed_object(object, nwords);
-}
-
-static int
-size_vector_unsigned_byte_2(lispobj *where)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 16) + 2, 2);
-
- return nwords;
-}
-
-
-static int
-scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 8) + 2, 2);
-
- return nwords;
-}
-
-static lispobj
-trans_vector_unsigned_byte_4(lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- gc_assert(Pointerp(object));
-
- vector = (struct vector *) PTR(object);
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 8) + 2, 2);
-
- return copy_large_unboxed_object(object, nwords);
-}
-
-static int
-size_vector_unsigned_byte_4(lispobj *where)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 8) + 2, 2);
-
- return nwords;
-}
-
-static int
-scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 4) + 2, 2);
-
- return nwords;
-}
-
-static lispobj
-trans_vector_unsigned_byte_8(lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- gc_assert(Pointerp(object));
-
- vector = (struct vector *) PTR(object);
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 4) + 2, 2);
-
- return copy_large_unboxed_object(object, nwords);
-}
-
-static int
-size_vector_unsigned_byte_8(lispobj *where)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 4) + 2, 2);
-
- return nwords;
-}
-
-
-static int
-scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 2) + 2, 2);
-
- return nwords;
-}
-
-static lispobj
-trans_vector_unsigned_byte_16(lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- gc_assert(Pointerp(object));
-
- vector = (struct vector *) PTR(object);
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 2) + 2, 2);
-
- return copy_large_unboxed_object(object, nwords);
-}
-
-static int
-size_vector_unsigned_byte_16(lispobj *where)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(NWORDS(length, 2) + 2, 2);
-
- return nwords;
-}
-
-static int
-scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length + 2, 2);
-
- return nwords;
-}
-
-static lispobj
-trans_vector_unsigned_byte_32(lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- gc_assert(Pointerp(object));
-
- vector = (struct vector *) PTR(object);
- length = fixnum_value(vector->length);
- nwords = CEILING(length + 2, 2);
-
- return copy_large_unboxed_object(object, nwords);
-}
-
-static int
-size_vector_unsigned_byte_32(lispobj *where)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length + 2, 2);
-
- return nwords;
-}
-
-static int
-scav_vector_single_float(lispobj *where, lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length + 2, 2);
-
- return nwords;
-}
-
-static lispobj
-trans_vector_single_float(lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- gc_assert(Pointerp(object));
-
- vector = (struct vector *) PTR(object);
- length = fixnum_value(vector->length);
- nwords = CEILING(length + 2, 2);
-
- return copy_large_unboxed_object(object, nwords);
-}
-
-static int
-size_vector_single_float(lispobj *where)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length + 2, 2);
-
- return nwords;
-}
-
-static int
-scav_vector_double_float(lispobj *where, lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
-
- return nwords;
-}
-
-static lispobj
-trans_vector_double_float(lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- gc_assert(Pointerp(object));
-
- vector = (struct vector *) PTR(object);
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
-
- return copy_large_unboxed_object(object, nwords);
-}
-
-static int
-size_vector_double_float(lispobj *where)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
-
- return nwords;
-}
-
-#ifdef type_SimpleArrayLongFloat
-static int
-scav_vector_long_float(lispobj *where, lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 3 + 2, 2);
-
- return nwords;
-}
-
-static lispobj
-trans_vector_long_float(lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- gc_assert(Pointerp(object));
-
- vector = (struct vector *) PTR(object);
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 3 + 2, 2);
-
- return copy_large_unboxed_object(object, nwords);
-}
-
-static int
-size_vector_long_float(lispobj *where)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 3 + 2, 2);
-
- return nwords;
-}
-#endif
-
-
-#ifdef type_SimpleArrayComplexSingleFloat
-static int
-scav_vector_complex_single_float(lispobj *where, lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
-
- return nwords;
-}
-
-static lispobj
-trans_vector_complex_single_float(lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- gc_assert(Pointerp(object));
-
- vector = (struct vector *) PTR(object);
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
-
- return copy_large_unboxed_object(object, nwords);
-}
-
-static int
-size_vector_complex_single_float(lispobj *where)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
-
- return nwords;
-}
-#endif
-
-#ifdef type_SimpleArrayComplexDoubleFloat
-static int
-scav_vector_complex_double_float(lispobj *where, lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 4 + 2, 2);
-
- return nwords;
-}
-
-static lispobj
-trans_vector_complex_double_float(lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- gc_assert(Pointerp(object));
-
- vector = (struct vector *) PTR(object);
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 4 + 2, 2);
-
- return copy_large_unboxed_object(object, nwords);
-}
-
-static int
-size_vector_complex_double_float(lispobj *where)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 4 + 2, 2);
-
- return nwords;
-}
-#endif
-
-
-#ifdef type_SimpleArrayComplexLongFloat
-static int
-scav_vector_complex_long_float(lispobj *where, lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 6 + 2, 2);
-
- return nwords;
-}
-
-static lispobj
-trans_vector_complex_long_float(lispobj object)
-{
- struct vector *vector;
- int length, nwords;
-
- gc_assert(Pointerp(object));
-
- vector = (struct vector *) PTR(object);
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 6 + 2, 2);
-
- return copy_large_unboxed_object(object, nwords);
-}
-
-static int
-size_vector_complex_long_float(lispobj *where)
-{
- struct vector *vector;
- int length, nwords;
-
- vector = (struct vector *) where;
- length = fixnum_value(vector->length);
- nwords = CEILING(length * 6 + 2, 2);
-
- return nwords;
-}
-#endif
-
-\f
-/*
- * weak pointers
- */
-
-/* XX This is a hack adapted from cgc.c. These don't work too well with the
- * gencgc as a list of the weak pointers is maintained within the
- * objects which causes writes to the pages. A limited attempt is made
- * to avoid unnecessary writes, but this needs a re-think. */
-
-#define WEAK_POINTER_NWORDS \
- CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
-
-static int
-scav_weak_pointer(lispobj *where, lispobj object)
-{
- struct weak_pointer *wp = weak_pointers;
- /* Push the weak pointer onto the list of weak pointers.
- * Do I have to watch for duplicates? Originally this was
- * part of trans_weak_pointer but that didn't work in the
- * case where the WP was in a promoted region.
- */
-
- /* Check whether it's already in the list. */
- while (wp != NULL) {
- if (wp == (struct weak_pointer*)where) {
- break;
- }
- wp = wp->next;
- }
- if (wp == NULL) {
- /* Add it to the start of the list. */
- wp = (struct weak_pointer*)where;
- if (wp->next != weak_pointers) {
- wp->next = weak_pointers;