2 * Garbage Collection common functions for scavenging, moving and sizing
3 * objects. These are for use with both GC (stop & copy GC) and GENCGC
7 * This software is part of the SBCL system. See the README file for
10 * This software is derived from the CMU CL system, which was
11 * written at Carnegie Mellon University and released into the
12 * public domain. The software is in the public domain and is
13 * provided with absolutely no warranty. See the COPYING and CREDITS
14 * files for more information.
18 * For a review of garbage collection techniques (e.g. generational
19 * GC) and terminology (e.g. "scavenging") see Paul R. Wilson,
20 * "Uniprocessor Garbage Collection Techniques". As of 20000618, this
21 * had been accepted for _ACM Computing Surveys_ and was available
22 * as a PostScript preprint through
23 * <http://www.cs.utexas.edu/users/oops/papers.html>
25 * <ftp://ftp.cs.utexas.edu/pub/garbage/bigsurv.ps>.
36 #include "interrupt.h"
42 #include "genesis/primitive-objects.h"
43 #include "genesis/static-symbols.h"
44 #include "genesis/layout.h"
45 #include "genesis/hash-table.h"
46 #include "gc-internal.h"
48 #ifdef LISP_FEATURE_SPARC
49 #define LONG_FLOAT_SIZE 4
51 #ifdef LISP_FEATURE_X86
52 #define LONG_FLOAT_SIZE 3
56 size_t dynamic_space_size = DEFAULT_DYNAMIC_SPACE_SIZE;
57 size_t thread_control_stack_size = DEFAULT_CONTROL_STACK_SIZE;
60 forwarding_pointer_p(lispobj *pointer) {
61 lispobj first_word=*pointer;
62 #ifdef LISP_FEATURE_GENCGC
63 return (first_word == 0x01);
65 return (is_lisp_pointer(first_word)
66 && new_space_p(first_word));
70 static inline lispobj *
71 forwarding_pointer_value(lispobj *pointer) {
72 #ifdef LISP_FEATURE_GENCGC
73 return (lispobj *) ((pointer_sized_uint_t) pointer[1]);
75 return (lispobj *) ((pointer_sized_uint_t) pointer[0]);
79 set_forwarding_pointer(lispobj * pointer, lispobj newspace_copy) {
80 #ifdef LISP_FEATURE_GENCGC
82 pointer[1]=newspace_copy;
84 pointer[0]=newspace_copy;
89 long (*scavtab[256])(lispobj *where, lispobj object);
90 lispobj (*transother[256])(lispobj object);
91 long (*sizetab[256])(lispobj *where);
92 struct weak_pointer *weak_pointers;
94 unsigned long bytes_consed_between_gcs = 12*1024*1024;
101 /* to copy a boxed object */
103 copy_object(lispobj object, long nwords)
108 gc_assert(is_lisp_pointer(object));
109 gc_assert(from_space_p(object));
110 gc_assert((nwords & 0x01) == 0);
112 /* Get tag of object. */
113 tag = lowtag_of(object);
115 /* Allocate space. */
116 new = gc_general_alloc(nwords*N_WORD_BYTES,ALLOC_BOXED,ALLOC_QUICK);
118 /* Copy the object. */
119 memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
120 return make_lispobj(new,tag);
123 static long scav_lose(lispobj *where, lispobj object); /* forward decl */
125 /* FIXME: Most calls end up going to some trouble to compute an
126 * 'n_words' value for this function. The system might be a little
127 * simpler if this function used an 'end' parameter instead. */
129 scavenge(lispobj *start, long n_words)
131 lispobj *end = start + n_words;
133 long n_words_scavenged;
135 for (object_ptr = start;
137 object_ptr += n_words_scavenged) {
139 lispobj object = *object_ptr;
140 #ifdef LISP_FEATURE_GENCGC
141 if (forwarding_pointer_p(object_ptr))
142 lose("unexpect forwarding pointer in scavenge: %p, start=%p, n=%l\n",
143 object_ptr, start, n_words);
145 if (is_lisp_pointer(object)) {
146 if (from_space_p(object)) {
147 /* It currently points to old space. Check for a
148 * forwarding pointer. */
149 lispobj *ptr = native_pointer(object);
150 if (forwarding_pointer_p(ptr)) {
151 /* Yes, there's a forwarding pointer. */
152 *object_ptr = LOW_WORD(forwarding_pointer_value(ptr));
153 n_words_scavenged = 1;
155 /* Scavenge that pointer. */
157 (scavtab[widetag_of(object)])(object_ptr, object);
160 /* It points somewhere other than oldspace. Leave it
162 n_words_scavenged = 1;
165 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
166 /* This workaround is probably not needed for those ports
167 which don't have a partitioned register set (and therefore
168 scan the stack conservatively for roots). */
169 else if (n_words == 1) {
170 /* there are some situations where an other-immediate may
171 end up in a descriptor register. I'm not sure whether
172 this is supposed to happen, but if it does then we
173 don't want to (a) barf or (b) scavenge over the
174 data-block, because there isn't one. So, if we're
175 checking a single word and it's anything other than a
176 pointer, just hush it up */
177 int widetag = widetag_of(object);
178 n_words_scavenged = 1;
180 if ((scavtab[widetag] == scav_lose) ||
181 (((sizetab[widetag])(object_ptr)) > 1)) {
182 fprintf(stderr,"warning: \
183 attempted to scavenge non-descriptor value %x at %p.\n\n\
184 If you can reproduce this warning, please send a bug report\n\
185 (see manual page for details).\n",
190 else if (fixnump(object)) {
191 /* It's a fixnum: really easy.. */
192 n_words_scavenged = 1;
194 /* It's some sort of header object or another. */
196 (scavtab[widetag_of(object)])(object_ptr, object);
199 gc_assert_verbose(object_ptr == end, "Final object pointer %p, start %p, end %p\n",
200 object_ptr, start, end);
203 static lispobj trans_fun_header(lispobj object); /* forward decls */
204 static lispobj trans_boxed(lispobj object);
207 scav_fun_pointer(lispobj *where, lispobj object)
209 lispobj *first_pointer;
212 gc_assert(is_lisp_pointer(object));
214 /* Object is a pointer into from_space - not a FP. */
215 first_pointer = (lispobj *) native_pointer(object);
217 /* must transport object -- object may point to either a function
218 * header, a closure function header, or to a closure header. */
220 switch (widetag_of(*first_pointer)) {
221 case SIMPLE_FUN_HEADER_WIDETAG:
222 copy = trans_fun_header(object);
225 copy = trans_boxed(object);
229 if (copy != object) {
230 /* Set forwarding pointer */
231 set_forwarding_pointer(first_pointer,copy);
234 gc_assert(is_lisp_pointer(copy));
235 gc_assert(!from_space_p(copy));
244 trans_code(struct code *code)
246 struct code *new_code;
247 lispobj first, l_code, l_new_code;
248 long nheader_words, ncode_words, nwords;
249 unsigned long displacement;
250 lispobj fheaderl, *prev_pointer;
252 /* if object has already been transported, just return pointer */
253 first = code->header;
254 if (forwarding_pointer_p((lispobj *)code)) {
256 printf("Was already transported\n");
258 return (struct code *) forwarding_pointer_value
259 ((lispobj *)((pointer_sized_uint_t) code));
262 gc_assert(widetag_of(first) == CODE_HEADER_WIDETAG);
264 /* prepare to transport the code vector */
265 l_code = (lispobj) LOW_WORD(code) | OTHER_POINTER_LOWTAG;
267 ncode_words = fixnum_value(code->code_size);
268 nheader_words = HeaderValue(code->header);
269 nwords = ncode_words + nheader_words;
270 nwords = CEILING(nwords, 2);
272 l_new_code = copy_object(l_code, nwords);
273 new_code = (struct code *) native_pointer(l_new_code);
275 #if defined(DEBUG_CODE_GC)
276 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
277 (unsigned long) code, (unsigned long) new_code);
278 printf("Code object is %d words long.\n", nwords);
281 #ifdef LISP_FEATURE_GENCGC
282 if (new_code == code)
286 displacement = l_new_code - l_code;
288 set_forwarding_pointer((lispobj *)code, l_new_code);
290 /* set forwarding pointers for all the function headers in the */
291 /* code object. also fix all self pointers */
293 fheaderl = code->entry_points;
294 prev_pointer = &new_code->entry_points;
296 while (fheaderl != NIL) {
297 struct simple_fun *fheaderp, *nfheaderp;
300 fheaderp = (struct simple_fun *) native_pointer(fheaderl);
301 gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
303 /* Calculate the new function pointer and the new */
304 /* function header. */
305 nfheaderl = fheaderl + displacement;
306 nfheaderp = (struct simple_fun *) native_pointer(nfheaderl);
309 printf("fheaderp->header (at %x) <- %x\n",
310 &(fheaderp->header) , nfheaderl);
312 set_forwarding_pointer((lispobj *)fheaderp, nfheaderl);
314 /* fix self pointer. */
316 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
317 FUN_RAW_ADDR_OFFSET +
321 *prev_pointer = nfheaderl;
323 fheaderl = fheaderp->next;
324 prev_pointer = &nfheaderp->next;
326 #ifdef LISP_FEATURE_GENCGC
327 /* Cheneygc doesn't need this os_flush_icache, it flushes the whole
328 spaces once when all copying is done. */
329 os_flush_icache((os_vm_address_t) (((long *)new_code) + nheader_words),
330 ncode_words * sizeof(long));
334 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
335 gencgc_apply_code_fixups(code, new_code);
342 scav_code_header(lispobj *where, lispobj object)
345 long n_header_words, n_code_words, n_words;
346 lispobj entry_point; /* tagged pointer to entry point */
347 struct simple_fun *function_ptr; /* untagged pointer to entry point */
349 code = (struct code *) where;
350 n_code_words = fixnum_value(code->code_size);
351 n_header_words = HeaderValue(object);
352 n_words = n_code_words + n_header_words;
353 n_words = CEILING(n_words, 2);
355 /* Scavenge the boxed section of the code data block. */
356 scavenge(where + 1, n_header_words - 1);
358 /* Scavenge the boxed section of each function object in the
359 * code data block. */
360 for (entry_point = code->entry_points;
362 entry_point = function_ptr->next) {
364 gc_assert_verbose(is_lisp_pointer(entry_point),
365 "Entry point %lx\n is not a lisp pointer.",
368 function_ptr = (struct simple_fun *) native_pointer(entry_point);
369 gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
371 scavenge(&function_ptr->name, 1);
372 scavenge(&function_ptr->arglist, 1);
373 scavenge(&function_ptr->type, 1);
374 scavenge(&function_ptr->xrefs, 1);
381 trans_code_header(lispobj object)
385 ncode = trans_code((struct code *) native_pointer(object));
386 return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG;
391 size_code_header(lispobj *where)
394 long nheader_words, ncode_words, nwords;
396 code = (struct code *) where;
398 ncode_words = fixnum_value(code->code_size);
399 nheader_words = HeaderValue(code->header);
400 nwords = ncode_words + nheader_words;
401 nwords = CEILING(nwords, 2);
406 #if !defined(LISP_FEATURE_X86) && ! defined(LISP_FEATURE_X86_64)
408 scav_return_pc_header(lispobj *where, lispobj object)
410 lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x\n",
411 (unsigned long) where,
412 (unsigned long) object);
413 return 0; /* bogus return value to satisfy static type checking */
415 #endif /* LISP_FEATURE_X86 */
418 trans_return_pc_header(lispobj object)
420 struct simple_fun *return_pc;
421 unsigned long offset;
422 struct code *code, *ncode;
424 return_pc = (struct simple_fun *) native_pointer(object);
425 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
426 offset = HeaderValue(return_pc->header) * N_WORD_BYTES;
428 /* Transport the whole code object */
429 code = (struct code *) ((unsigned long) return_pc - offset);
430 ncode = trans_code(code);
432 return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
435 /* On the 386, closures hold a pointer to the raw address instead of the
436 * function object, so we can use CALL [$FDEFN+const] to invoke
437 * the function without loading it into a register. Given that code
438 * objects don't move, we don't need to update anything, but we do
439 * have to figure out that the function is still live. */
441 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
443 scav_closure_header(lispobj *where, lispobj object)
445 struct closure *closure;
448 closure = (struct closure *)where;
449 fun = closure->fun - FUN_RAW_ADDR_OFFSET;
451 #ifdef LISP_FEATURE_GENCGC
452 /* The function may have moved so update the raw address. But
453 * don't write unnecessarily. */
454 if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
455 closure->fun = fun + FUN_RAW_ADDR_OFFSET;
461 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
463 scav_fun_header(lispobj *where, lispobj object)
465 lose("attempted to scavenge a function header where=0x%08x object=0x%08x\n",
466 (unsigned long) where,
467 (unsigned long) object);
468 return 0; /* bogus return value to satisfy static type checking */
470 #endif /* LISP_FEATURE_X86 */
473 trans_fun_header(lispobj object)
475 struct simple_fun *fheader;
476 unsigned long offset;
477 struct code *code, *ncode;
479 fheader = (struct simple_fun *) native_pointer(object);
480 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
481 offset = HeaderValue(fheader->header) * N_WORD_BYTES;
483 /* Transport the whole code object */
484 code = (struct code *) ((unsigned long) fheader - offset);
485 ncode = trans_code(code);
487 return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
496 scav_instance_pointer(lispobj *where, lispobj object)
498 lispobj copy, *first_pointer;
500 /* Object is a pointer into from space - not a FP. */
501 copy = trans_boxed(object);
503 #ifdef LISP_FEATURE_GENCGC
504 gc_assert(copy != object);
507 first_pointer = (lispobj *) native_pointer(object);
508 set_forwarding_pointer(first_pointer,copy);
519 static lispobj trans_list(lispobj object);
522 scav_list_pointer(lispobj *where, lispobj object)
524 lispobj first, *first_pointer;
526 gc_assert(is_lisp_pointer(object));
528 /* Object is a pointer into from space - not FP. */
529 first_pointer = (lispobj *) native_pointer(object);
531 first = trans_list(object);
532 gc_assert(first != object);
534 /* Set forwarding pointer */
535 set_forwarding_pointer(first_pointer, first);
537 gc_assert(is_lisp_pointer(first));
538 gc_assert(!from_space_p(first));
546 trans_list(lispobj object)
548 lispobj new_list_pointer;
549 struct cons *cons, *new_cons;
552 cons = (struct cons *) native_pointer(object);
555 new_cons = (struct cons *)
556 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
557 new_cons->car = cons->car;
558 new_cons->cdr = cons->cdr; /* updated later */
559 new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
561 /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC */
564 set_forwarding_pointer((lispobj *)cons, new_list_pointer);
566 /* Try to linearize the list in the cdr direction to help reduce
570 struct cons *cdr_cons, *new_cdr_cons;
572 if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
573 !from_space_p(cdr) ||
574 forwarding_pointer_p((lispobj *)native_pointer(cdr)))
577 cdr_cons = (struct cons *) native_pointer(cdr);
580 new_cdr_cons = (struct cons*)
581 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
582 new_cdr_cons->car = cdr_cons->car;
583 new_cdr_cons->cdr = cdr_cons->cdr;
584 new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
586 /* Grab the cdr before it is clobbered. */
588 set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
590 /* Update the cdr of the last cons copied into new space to
591 * keep the newspace scavenge from having to do it. */
592 new_cons->cdr = new_cdr;
594 new_cons = new_cdr_cons;
597 return new_list_pointer;
602 * scavenging and transporting other pointers
606 scav_other_pointer(lispobj *where, lispobj object)
608 lispobj first, *first_pointer;
610 gc_assert(is_lisp_pointer(object));
612 /* Object is a pointer into from space - not FP. */
613 first_pointer = (lispobj *) native_pointer(object);
614 first = (transother[widetag_of(*first_pointer)])(object);
616 if (first != object) {
617 set_forwarding_pointer(first_pointer, first);
618 #ifdef LISP_FEATURE_GENCGC
622 #ifndef LISP_FEATURE_GENCGC
625 gc_assert(is_lisp_pointer(first));
626 gc_assert(!from_space_p(first));
632 * immediate, boxed, and unboxed objects
636 size_pointer(lispobj *where)
642 scav_immediate(lispobj *where, lispobj object)
648 trans_immediate(lispobj object)
650 lose("trying to transport an immediate\n");
651 return NIL; /* bogus return value to satisfy static type checking */
655 size_immediate(lispobj *where)
662 scav_boxed(lispobj *where, lispobj object)
668 scav_instance(lispobj *where, lispobj object)
671 long ntotal = HeaderValue(object);
672 lispobj layout = ((struct instance *)where)->slots[0];
676 if (forwarding_pointer_p(native_pointer(layout)))
677 layout = (lispobj) forwarding_pointer_value(native_pointer(layout));
679 nuntagged = ((struct layout *)native_pointer(layout))->n_untagged_slots;
680 scavenge(where + 1, ntotal - fixnum_value(nuntagged));
686 trans_boxed(lispobj object)
689 unsigned long length;
691 gc_assert(is_lisp_pointer(object));
693 header = *((lispobj *) native_pointer(object));
694 length = HeaderValue(header) + 1;
695 length = CEILING(length, 2);
697 return copy_object(object, length);
702 size_boxed(lispobj *where)
705 unsigned long length;
708 length = HeaderValue(header) + 1;
709 length = CEILING(length, 2);
714 /* Note: on the sparc we don't have to do anything special for fdefns, */
715 /* 'cause the raw-addr has a function lowtag. */
716 #if !defined(LISP_FEATURE_SPARC)
718 scav_fdefn(lispobj *where, lispobj object)
722 fdefn = (struct fdefn *)where;
724 /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
725 fdefn->fun, fdefn->raw_addr)); */
727 if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)
728 == (char *)((unsigned long)(fdefn->raw_addr))) {
729 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
731 /* Don't write unnecessarily. */
732 if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
733 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
734 /* gc.c has more casts here, which may be relevant or alternatively
735 may be compiler warning defeaters. try
736 fdefn->raw_addr = ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
738 return sizeof(struct fdefn) / sizeof(lispobj);
746 scav_unboxed(lispobj *where, lispobj object)
748 unsigned long length;
750 length = HeaderValue(object) + 1;
751 length = CEILING(length, 2);
757 trans_unboxed(lispobj object)
760 unsigned long length;
763 gc_assert(is_lisp_pointer(object));
765 header = *((lispobj *) native_pointer(object));
766 length = HeaderValue(header) + 1;
767 length = CEILING(length, 2);
769 return copy_unboxed_object(object, length);
773 size_unboxed(lispobj *where)
776 unsigned long length;
779 length = HeaderValue(header) + 1;
780 length = CEILING(length, 2);
786 /* vector-like objects */
788 scav_base_string(lispobj *where, lispobj object)
790 struct vector *vector;
793 /* NOTE: Strings contain one more byte of data than the length */
794 /* slot indicates. */
796 vector = (struct vector *) where;
797 length = fixnum_value(vector->length) + 1;
798 nwords = CEILING(NWORDS(length, 8) + 2, 2);
803 trans_base_string(lispobj object)
805 struct vector *vector;
808 gc_assert(is_lisp_pointer(object));
810 /* NOTE: A string contains one more byte of data (a terminating
811 * '\0' to help when interfacing with C functions) than indicated
812 * by the length slot. */
814 vector = (struct vector *) native_pointer(object);
815 length = fixnum_value(vector->length) + 1;
816 nwords = CEILING(NWORDS(length, 8) + 2, 2);
818 return copy_large_unboxed_object(object, nwords);
822 size_base_string(lispobj *where)
824 struct vector *vector;
827 /* NOTE: A string contains one more byte of data (a terminating
828 * '\0' to help when interfacing with C functions) than indicated
829 * by the length slot. */
831 vector = (struct vector *) where;
832 length = fixnum_value(vector->length) + 1;
833 nwords = CEILING(NWORDS(length, 8) + 2, 2);
839 scav_character_string(lispobj *where, lispobj object)
841 struct vector *vector;
844 /* NOTE: Strings contain one more byte of data than the length */
845 /* slot indicates. */
847 vector = (struct vector *) where;
848 length = fixnum_value(vector->length) + 1;
849 nwords = CEILING(NWORDS(length, 32) + 2, 2);
854 trans_character_string(lispobj object)
856 struct vector *vector;
859 gc_assert(is_lisp_pointer(object));
861 /* NOTE: A string contains one more byte of data (a terminating
862 * '\0' to help when interfacing with C functions) than indicated
863 * by the length slot. */
865 vector = (struct vector *) native_pointer(object);
866 length = fixnum_value(vector->length) + 1;
867 nwords = CEILING(NWORDS(length, 32) + 2, 2);
869 return copy_large_unboxed_object(object, nwords);
873 size_character_string(lispobj *where)
875 struct vector *vector;
878 /* NOTE: A string contains one more byte of data (a terminating
879 * '\0' to help when interfacing with C functions) than indicated
880 * by the length slot. */
882 vector = (struct vector *) where;
883 length = fixnum_value(vector->length) + 1;
884 nwords = CEILING(NWORDS(length, 32) + 2, 2);
890 trans_vector(lispobj object)
892 struct vector *vector;
895 gc_assert(is_lisp_pointer(object));
897 vector = (struct vector *) native_pointer(object);
899 length = fixnum_value(vector->length);
900 nwords = CEILING(length + 2, 2);
902 return copy_large_object(object, nwords);
906 size_vector(lispobj *where)
908 struct vector *vector;
911 vector = (struct vector *) where;
912 length = fixnum_value(vector->length);
913 nwords = CEILING(length + 2, 2);
919 scav_vector_nil(lispobj *where, lispobj object)
925 trans_vector_nil(lispobj object)
927 gc_assert(is_lisp_pointer(object));
928 return copy_unboxed_object(object, 2);
932 size_vector_nil(lispobj *where)
934 /* Just the header word and the length word */
939 scav_vector_bit(lispobj *where, lispobj object)
941 struct vector *vector;
944 vector = (struct vector *) where;
945 length = fixnum_value(vector->length);
946 nwords = CEILING(NWORDS(length, 1) + 2, 2);
952 trans_vector_bit(lispobj object)
954 struct vector *vector;
957 gc_assert(is_lisp_pointer(object));
959 vector = (struct vector *) native_pointer(object);
960 length = fixnum_value(vector->length);
961 nwords = CEILING(NWORDS(length, 1) + 2, 2);
963 return copy_large_unboxed_object(object, nwords);
967 size_vector_bit(lispobj *where)
969 struct vector *vector;
972 vector = (struct vector *) where;
973 length = fixnum_value(vector->length);
974 nwords = CEILING(NWORDS(length, 1) + 2, 2);
980 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
982 struct vector *vector;
985 vector = (struct vector *) where;
986 length = fixnum_value(vector->length);
987 nwords = CEILING(NWORDS(length, 2) + 2, 2);
993 trans_vector_unsigned_byte_2(lispobj object)
995 struct vector *vector;
998 gc_assert(is_lisp_pointer(object));
1000 vector = (struct vector *) native_pointer(object);
1001 length = fixnum_value(vector->length);
1002 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1004 return copy_large_unboxed_object(object, nwords);
1008 size_vector_unsigned_byte_2(lispobj *where)
1010 struct vector *vector;
1011 long length, nwords;
1013 vector = (struct vector *) where;
1014 length = fixnum_value(vector->length);
1015 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1021 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
1023 struct vector *vector;
1024 long length, nwords;
1026 vector = (struct vector *) where;
1027 length = fixnum_value(vector->length);
1028 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1034 trans_vector_unsigned_byte_4(lispobj object)
1036 struct vector *vector;
1037 long length, nwords;
1039 gc_assert(is_lisp_pointer(object));
1041 vector = (struct vector *) native_pointer(object);
1042 length = fixnum_value(vector->length);
1043 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1045 return copy_large_unboxed_object(object, nwords);
1048 size_vector_unsigned_byte_4(lispobj *where)
1050 struct vector *vector;
1051 long length, nwords;
1053 vector = (struct vector *) where;
1054 length = fixnum_value(vector->length);
1055 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1062 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
1064 struct vector *vector;
1065 long length, nwords;
1067 vector = (struct vector *) where;
1068 length = fixnum_value(vector->length);
1069 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1074 /*********************/
1079 trans_vector_unsigned_byte_8(lispobj object)
1081 struct vector *vector;
1082 long length, nwords;
1084 gc_assert(is_lisp_pointer(object));
1086 vector = (struct vector *) native_pointer(object);
1087 length = fixnum_value(vector->length);
1088 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1090 return copy_large_unboxed_object(object, nwords);
1094 size_vector_unsigned_byte_8(lispobj *where)
1096 struct vector *vector;
1097 long length, nwords;
1099 vector = (struct vector *) where;
1100 length = fixnum_value(vector->length);
1101 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1108 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1110 struct vector *vector;
1111 long length, nwords;
1113 vector = (struct vector *) where;
1114 length = fixnum_value(vector->length);
1115 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1121 trans_vector_unsigned_byte_16(lispobj object)
1123 struct vector *vector;
1124 long length, nwords;
1126 gc_assert(is_lisp_pointer(object));
1128 vector = (struct vector *) native_pointer(object);
1129 length = fixnum_value(vector->length);
1130 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1132 return copy_large_unboxed_object(object, nwords);
1136 size_vector_unsigned_byte_16(lispobj *where)
1138 struct vector *vector;
1139 long length, nwords;
1141 vector = (struct vector *) where;
1142 length = fixnum_value(vector->length);
1143 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1149 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1151 struct vector *vector;
1152 long length, nwords;
1154 vector = (struct vector *) where;
1155 length = fixnum_value(vector->length);
1156 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1162 trans_vector_unsigned_byte_32(lispobj object)
1164 struct vector *vector;
1165 long length, nwords;
1167 gc_assert(is_lisp_pointer(object));
1169 vector = (struct vector *) native_pointer(object);
1170 length = fixnum_value(vector->length);
1171 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1173 return copy_large_unboxed_object(object, nwords);
1177 size_vector_unsigned_byte_32(lispobj *where)
1179 struct vector *vector;
1180 long length, nwords;
1182 vector = (struct vector *) where;
1183 length = fixnum_value(vector->length);
1184 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1189 #if N_WORD_BITS == 64
1191 scav_vector_unsigned_byte_64(lispobj *where, lispobj object)
1193 struct vector *vector;
1194 long length, nwords;
1196 vector = (struct vector *) where;
1197 length = fixnum_value(vector->length);
1198 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1204 trans_vector_unsigned_byte_64(lispobj object)
1206 struct vector *vector;
1207 long length, nwords;
1209 gc_assert(is_lisp_pointer(object));
1211 vector = (struct vector *) native_pointer(object);
1212 length = fixnum_value(vector->length);
1213 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1215 return copy_large_unboxed_object(object, nwords);
1219 size_vector_unsigned_byte_64(lispobj *where)
1221 struct vector *vector;
1222 long length, nwords;
1224 vector = (struct vector *) where;
1225 length = fixnum_value(vector->length);
1226 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1233 scav_vector_single_float(lispobj *where, lispobj object)
1235 struct vector *vector;
1236 long length, nwords;
1238 vector = (struct vector *) where;
1239 length = fixnum_value(vector->length);
1240 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1246 trans_vector_single_float(lispobj object)
1248 struct vector *vector;
1249 long length, nwords;
1251 gc_assert(is_lisp_pointer(object));
1253 vector = (struct vector *) native_pointer(object);
1254 length = fixnum_value(vector->length);
1255 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1257 return copy_large_unboxed_object(object, nwords);
1261 size_vector_single_float(lispobj *where)
1263 struct vector *vector;
1264 long length, nwords;
1266 vector = (struct vector *) where;
1267 length = fixnum_value(vector->length);
1268 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1274 scav_vector_double_float(lispobj *where, lispobj object)
1276 struct vector *vector;
1277 long length, nwords;
1279 vector = (struct vector *) where;
1280 length = fixnum_value(vector->length);
1281 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1287 trans_vector_double_float(lispobj object)
1289 struct vector *vector;
1290 long length, nwords;
1292 gc_assert(is_lisp_pointer(object));
1294 vector = (struct vector *) native_pointer(object);
1295 length = fixnum_value(vector->length);
1296 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1298 return copy_large_unboxed_object(object, nwords);
1302 size_vector_double_float(lispobj *where)
1304 struct vector *vector;
1305 long length, nwords;
1307 vector = (struct vector *) where;
1308 length = fixnum_value(vector->length);
1309 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1314 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1316 scav_vector_long_float(lispobj *where, lispobj object)
1318 struct vector *vector;
1319 long length, nwords;
1321 vector = (struct vector *) where;
1322 length = fixnum_value(vector->length);
1323 nwords = CEILING(length *
1330 trans_vector_long_float(lispobj object)
1332 struct vector *vector;
1333 long length, nwords;
1335 gc_assert(is_lisp_pointer(object));
1337 vector = (struct vector *) native_pointer(object);
1338 length = fixnum_value(vector->length);
1339 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1341 return copy_large_unboxed_object(object, nwords);
1345 size_vector_long_float(lispobj *where)
1347 struct vector *vector;
1348 long length, nwords;
1350 vector = (struct vector *) where;
1351 length = fixnum_value(vector->length);
1352 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1359 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1361 scav_vector_complex_single_float(lispobj *where, lispobj object)
1363 struct vector *vector;
1364 long length, nwords;
1366 vector = (struct vector *) where;
1367 length = fixnum_value(vector->length);
1368 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1374 trans_vector_complex_single_float(lispobj object)
1376 struct vector *vector;
1377 long length, nwords;
1379 gc_assert(is_lisp_pointer(object));
1381 vector = (struct vector *) native_pointer(object);
1382 length = fixnum_value(vector->length);
1383 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1385 return copy_large_unboxed_object(object, nwords);
1389 size_vector_complex_single_float(lispobj *where)
1391 struct vector *vector;
1392 long length, nwords;
1394 vector = (struct vector *) where;
1395 length = fixnum_value(vector->length);
1396 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1402 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1404 scav_vector_complex_double_float(lispobj *where, lispobj object)
1406 struct vector *vector;
1407 long length, nwords;
1409 vector = (struct vector *) where;
1410 length = fixnum_value(vector->length);
1411 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1417 trans_vector_complex_double_float(lispobj object)
1419 struct vector *vector;
1420 long length, nwords;
1422 gc_assert(is_lisp_pointer(object));
1424 vector = (struct vector *) native_pointer(object);
1425 length = fixnum_value(vector->length);
1426 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1428 return copy_large_unboxed_object(object, nwords);
1432 size_vector_complex_double_float(lispobj *where)
1434 struct vector *vector;
1435 long length, nwords;
1437 vector = (struct vector *) where;
1438 length = fixnum_value(vector->length);
1439 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1446 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1448 scav_vector_complex_long_float(lispobj *where, lispobj object)
1450 struct vector *vector;
1451 long length, nwords;
1453 vector = (struct vector *) where;
1454 length = fixnum_value(vector->length);
1455 nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1461 trans_vector_complex_long_float(lispobj object)
1463 struct vector *vector;
1464 long length, nwords;
1466 gc_assert(is_lisp_pointer(object));
1468 vector = (struct vector *) native_pointer(object);
1469 length = fixnum_value(vector->length);
1470 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1472 return copy_large_unboxed_object(object, nwords);
1476 size_vector_complex_long_float(lispobj *where)
1478 struct vector *vector;
1479 long length, nwords;
1481 vector = (struct vector *) where;
1482 length = fixnum_value(vector->length);
1483 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1489 #define WEAK_POINTER_NWORDS \
1490 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1493 trans_weak_pointer(lispobj object)
1496 #ifndef LISP_FEATURE_GENCGC
1497 struct weak_pointer *wp;
1499 gc_assert(is_lisp_pointer(object));
1501 #if defined(DEBUG_WEAK)
1502 printf("Transporting weak pointer from 0x%08x\n", object);
1505 /* Need to remember where all the weak pointers are that have */
1506 /* been transported so they can be fixed up in a post-GC pass. */
1508 copy = copy_object(object, WEAK_POINTER_NWORDS);
1509 #ifndef LISP_FEATURE_GENCGC
1510 wp = (struct weak_pointer *) native_pointer(copy);
1512 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1513 /* Push the weak pointer onto the list of weak pointers. */
1514 wp->next = (struct weak_pointer *)LOW_WORD(weak_pointers);
1521 size_weak_pointer(lispobj *where)
1523 return WEAK_POINTER_NWORDS;
1527 void scan_weak_pointers(void)
1529 struct weak_pointer *wp, *next_wp;
1530 for (wp = weak_pointers, next_wp = NULL; wp != NULL; wp = next_wp) {
1531 lispobj value = wp->value;
1532 lispobj *first_pointer;
1533 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1537 if (next_wp == wp) /* gencgc uses a ref to self for end of list */
1540 if (!(is_lisp_pointer(value) && from_space_p(value)))
1543 /* Now, we need to check whether the object has been forwarded. If
1544 * it has been, the weak pointer is still good and needs to be
1545 * updated. Otherwise, the weak pointer needs to be nil'ed
1548 first_pointer = (lispobj *)native_pointer(value);
1550 if (forwarding_pointer_p(first_pointer)) {
1552 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1564 #if N_WORD_BITS == 32
1565 #define EQ_HASH_MASK 0x1fffffff
1566 #elif N_WORD_BITS == 64
1567 #define EQ_HASH_MASK 0x1fffffffffffffff
1570 /* Compute the EQ-hash of KEY. This must match POINTER-HASH in
1571 * target-hash-table.lisp. */
1572 #define EQ_HASH(key) ((key) & EQ_HASH_MASK)
1574 /* List of weak hash tables chained through their NEXT-WEAK-HASH-TABLE
1575 * slot. Set to NULL at the end of a collection.
1577 * This is not optimal because, when a table is tenured, it won't be
1578 * processed automatically; only the yougest generation is GC'd by
1579 * default. On the other hand, all applications will need an
1580 * occasional full GC anyway, so it's not that bad either. */
1581 struct hash_table *weak_hash_tables = NULL;
1583 /* Return true if OBJ has already survived the current GC. */
1585 survived_gc_yet (lispobj obj)
1587 return (!is_lisp_pointer(obj) || !from_space_p(obj) ||
1588 forwarding_pointer_p(native_pointer(obj)));
1592 weak_hash_entry_alivep (lispobj weakness, lispobj key, lispobj value)
1596 return survived_gc_yet(key);
1598 return survived_gc_yet(value);
1600 return (survived_gc_yet(key) || survived_gc_yet(value));
1602 return (survived_gc_yet(key) && survived_gc_yet(value));
1605 /* Shut compiler up. */
1610 /* Return the beginning of data in ARRAY (skipping the header and the
1611 * length) or NULL if it isn't an array of the specified widetag after
1613 static inline lispobj *
1614 get_array_data (lispobj array, int widetag, unsigned long *length)
1616 if (is_lisp_pointer(array) &&
1617 (widetag_of(*(lispobj *)native_pointer(array)) == widetag)) {
1619 *length = fixnum_value(((lispobj *)native_pointer(array))[1]);
1620 return ((lispobj *)native_pointer(array)) + 2;
1626 /* Only need to worry about scavenging the _real_ entries in the
1627 * table. Phantom entries such as the hash table itself at index 0 and
1628 * the empty marker at index 1 were scavenged by scav_vector that
1629 * either called this function directly or arranged for it to be
1630 * called later by pushing the hash table onto weak_hash_tables. */
1632 scav_hash_table_entries (struct hash_table *hash_table)
1635 unsigned long kv_length;
1636 lispobj *index_vector;
1637 unsigned long length;
1638 lispobj *next_vector;
1639 unsigned long next_vector_length;
1640 lispobj *hash_vector;
1641 unsigned long hash_vector_length;
1642 lispobj empty_symbol;
1643 lispobj weakness = hash_table->weakness;
1646 kv_vector = get_array_data(hash_table->table,
1647 SIMPLE_VECTOR_WIDETAG, &kv_length);
1648 if (kv_vector == NULL)
1649 lose("invalid kv_vector %x\n", hash_table->table);
1651 index_vector = get_array_data(hash_table->index_vector,
1652 SIMPLE_ARRAY_WORD_WIDETAG, &length);
1653 if (index_vector == NULL)
1654 lose("invalid index_vector %x\n", hash_table->index_vector);
1656 next_vector = get_array_data(hash_table->next_vector,
1657 SIMPLE_ARRAY_WORD_WIDETAG,
1658 &next_vector_length);
1659 if (next_vector == NULL)
1660 lose("invalid next_vector %x\n", hash_table->next_vector);
1662 hash_vector = get_array_data(hash_table->hash_vector,
1663 SIMPLE_ARRAY_WORD_WIDETAG,
1664 &hash_vector_length);
1665 if (hash_vector != NULL)
1666 gc_assert(hash_vector_length == next_vector_length);
1668 /* These lengths could be different as the index_vector can be a
1669 * different length from the others, a larger index_vector could
1670 * help reduce collisions. */
1671 gc_assert(next_vector_length*2 == kv_length);
1673 empty_symbol = kv_vector[1];
1674 /* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/
1675 if (widetag_of(*(lispobj *)native_pointer(empty_symbol)) !=
1676 SYMBOL_HEADER_WIDETAG) {
1677 lose("not a symbol where empty-hash-table-slot symbol expected: %x\n",
1678 *(lispobj *)native_pointer(empty_symbol));
1681 /* Work through the KV vector. */
1682 for (i = 1; i < next_vector_length; i++) {
1683 lispobj old_key = kv_vector[2*i];
1684 lispobj value = kv_vector[2*i+1];
1685 if ((weakness == NIL) ||
1686 weak_hash_entry_alivep(weakness, old_key, value)) {
1688 /* Scavenge the key and value. */
1689 scavenge(&kv_vector[2*i],2);
1691 /* If an EQ-based key has moved, mark the hash-table for
1693 if (!hash_vector || hash_vector[i] == MAGIC_HASH_VECTOR_VALUE) {
1694 lispobj new_key = kv_vector[2*i];
1696 if (old_key != new_key && new_key != empty_symbol) {
1697 hash_table->needs_rehash_p = T;
1705 scav_vector (lispobj *where, lispobj object)
1707 unsigned long kv_length;
1709 struct hash_table *hash_table;
1711 /* SB-VM:VECTOR-VALID-HASHING-SUBTYPE is set for EQ-based and weak
1712 * hash tables in the Lisp HASH-TABLE code to indicate need for
1713 * special GC support. */
1714 if (HeaderValue(object) == subtype_VectorNormal)
1717 kv_length = fixnum_value(where[1]);
1718 kv_vector = where + 2; /* Skip the header and length. */
1719 /*FSHOW((stderr,"/kv_length = %d\n", kv_length));*/
1721 /* Scavenge element 0, which may be a hash-table structure. */
1722 scavenge(where+2, 1);
1723 if (!is_lisp_pointer(where[2])) {
1724 /* This'll happen when REHASH clears the header of old-kv-vector
1725 * and fills it with zero, but some other thread simulatenously
1726 * sets the header in %%PUTHASH.
1729 "Warning: no pointer at %lx in hash table: this indicates "
1730 "non-fatal corruption caused by concurrent access to a "
1731 "hash-table from multiple threads. Any accesses to "
1732 "hash-tables shared between threads should be protected "
1733 "by locks.\n", (unsigned long)&where[2]);
1734 // We've scavenged three words.
1737 hash_table = (struct hash_table *)native_pointer(where[2]);
1738 /*FSHOW((stderr,"/hash_table = %x\n", hash_table));*/
1739 if (widetag_of(hash_table->header) != INSTANCE_HEADER_WIDETAG) {
1740 lose("hash table not instance (%x at %x)\n",
1745 /* Scavenge element 1, which should be some internal symbol that
1746 * the hash table code reserves for marking empty slots. */
1747 scavenge(where+3, 1);
1748 if (!is_lisp_pointer(where[3])) {
1749 lose("not empty-hash-table-slot symbol pointer: %x\n", where[3]);
1752 /* Scavenge hash table, which will fix the positions of the other
1753 * needed objects. */
1754 scavenge((lispobj *)hash_table,
1755 sizeof(struct hash_table) / sizeof(lispobj));
1757 /* Cross-check the kv_vector. */
1758 if (where != (lispobj *)native_pointer(hash_table->table)) {
1759 lose("hash_table table!=this table %x\n", hash_table->table);
1762 if (hash_table->weakness == NIL) {
1763 scav_hash_table_entries(hash_table);
1765 /* Delay scavenging of this table by pushing it onto
1766 * weak_hash_tables (if it's not there already) for the weak
1768 if (hash_table->next_weak_hash_table == NIL) {
1769 hash_table->next_weak_hash_table = (lispobj)weak_hash_tables;
1770 weak_hash_tables = hash_table;
1774 return (CEILING(kv_length + 2, 2));
1778 scav_weak_hash_tables (void)
1780 struct hash_table *table;
1782 /* Scavenge entries whose triggers are known to survive. */
1783 for (table = weak_hash_tables; table != NULL;
1784 table = (struct hash_table *)table->next_weak_hash_table) {
1785 scav_hash_table_entries(table);
1789 /* Walk through the chain whose first element is *FIRST and remove
1790 * dead weak entries. */
1792 scan_weak_hash_table_chain (struct hash_table *hash_table, lispobj *prev,
1793 lispobj *kv_vector, lispobj *index_vector,
1794 lispobj *next_vector, lispobj *hash_vector,
1795 lispobj empty_symbol, lispobj weakness)
1797 unsigned index = *prev;
1799 unsigned next = next_vector[index];
1800 lispobj key = kv_vector[2 * index];
1801 lispobj value = kv_vector[2 * index + 1];
1802 gc_assert(key != empty_symbol);
1803 gc_assert(value != empty_symbol);
1804 if (!weak_hash_entry_alivep(weakness, key, value)) {
1805 unsigned count = fixnum_value(hash_table->number_entries);
1806 gc_assert(count > 0);
1808 hash_table->number_entries = make_fixnum(count - 1);
1809 next_vector[index] = fixnum_value(hash_table->next_free_kv);
1810 hash_table->next_free_kv = make_fixnum(index);
1811 kv_vector[2 * index] = empty_symbol;
1812 kv_vector[2 * index + 1] = empty_symbol;
1814 hash_vector[index] = MAGIC_HASH_VECTOR_VALUE;
1816 prev = &next_vector[index];
1823 scan_weak_hash_table (struct hash_table *hash_table)
1826 lispobj *index_vector;
1827 unsigned long length = 0; /* prevent warning */
1828 lispobj *next_vector;
1829 unsigned long next_vector_length = 0; /* prevent warning */
1830 lispobj *hash_vector;
1831 lispobj empty_symbol;
1832 lispobj weakness = hash_table->weakness;
1835 kv_vector = get_array_data(hash_table->table,
1836 SIMPLE_VECTOR_WIDETAG, NULL);
1837 index_vector = get_array_data(hash_table->index_vector,
1838 SIMPLE_ARRAY_WORD_WIDETAG, &length);
1839 next_vector = get_array_data(hash_table->next_vector,
1840 SIMPLE_ARRAY_WORD_WIDETAG,
1841 &next_vector_length);
1842 hash_vector = get_array_data(hash_table->hash_vector,
1843 SIMPLE_ARRAY_WORD_WIDETAG, NULL);
1844 empty_symbol = kv_vector[1];
1846 for (i = 0; i < length; i++) {
1847 scan_weak_hash_table_chain(hash_table, &index_vector[i],
1848 kv_vector, index_vector, next_vector,
1849 hash_vector, empty_symbol, weakness);
1853 /* Remove dead entries from weak hash tables. */
1855 scan_weak_hash_tables (void)
1857 struct hash_table *table, *next;
1859 for (table = weak_hash_tables; table != NULL; table = next) {
1860 next = (struct hash_table *)table->next_weak_hash_table;
1861 table->next_weak_hash_table = NIL;
1862 scan_weak_hash_table(table);
1865 weak_hash_tables = NULL;
1874 scav_lose(lispobj *where, lispobj object)
1876 lose("no scavenge function for object 0x%08x (widetag 0x%x)\n",
1877 (unsigned long)object,
1878 widetag_of(*(lispobj*)native_pointer(object)));
1880 return 0; /* bogus return value to satisfy static type checking */
1884 trans_lose(lispobj object)
1886 lose("no transport function for object 0x%08x (widetag 0x%x)\n",
1887 (unsigned long)object,
1888 widetag_of(*(lispobj*)native_pointer(object)));
1889 return NIL; /* bogus return value to satisfy static type checking */
1893 size_lose(lispobj *where)
1895 lose("no size function for object at 0x%08x (widetag 0x%x)\n",
1896 (unsigned long)where,
1897 widetag_of(LOW_WORD(where)));
1898 return 1; /* bogus return value to satisfy static type checking */
1907 gc_init_tables(void)
1911 /* Set default value in all slots of scavenge table. FIXME
1912 * replace this gnarly sizeof with something based on
1914 for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) {
1915 scavtab[i] = scav_lose;
1918 /* For each type which can be selected by the lowtag alone, set
1919 * multiple entries in our widetag scavenge table (one for each
1920 * possible value of the high bits).
1923 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1924 scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1925 scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1926 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1927 scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1928 scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1929 scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_instance_pointer;
1930 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1931 scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1934 /* Other-pointer types (those selected by all eight bits of the
1935 * tag) get one entry each in the scavenge table. */
1936 scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1937 scavtab[RATIO_WIDETAG] = scav_boxed;
1938 #if N_WORD_BITS == 64
1939 scavtab[SINGLE_FLOAT_WIDETAG] = scav_immediate;
1941 scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1943 scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1944 #ifdef LONG_FLOAT_WIDETAG
1945 scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1947 scavtab[COMPLEX_WIDETAG] = scav_boxed;
1948 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1949 scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1951 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1952 scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1954 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1955 scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
1957 scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
1958 scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
1959 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1960 scavtab[SIMPLE_CHARACTER_STRING_WIDETAG] = scav_character_string;
1962 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
1963 scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
1964 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1965 scav_vector_unsigned_byte_2;
1966 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1967 scav_vector_unsigned_byte_4;
1968 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1969 scav_vector_unsigned_byte_8;
1970 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1971 scav_vector_unsigned_byte_8;
1972 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1973 scav_vector_unsigned_byte_16;
1974 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1975 scav_vector_unsigned_byte_16;
1976 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1977 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1978 scav_vector_unsigned_byte_32;
1980 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1981 scav_vector_unsigned_byte_32;
1982 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1983 scav_vector_unsigned_byte_32;
1984 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1985 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1986 scav_vector_unsigned_byte_64;
1988 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1989 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1990 scav_vector_unsigned_byte_64;
1992 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1993 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1994 scav_vector_unsigned_byte_64;
1996 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1997 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
1999 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
2000 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
2001 scav_vector_unsigned_byte_16;
2003 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
2004 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
2005 scav_vector_unsigned_byte_32;
2007 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2008 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
2009 scav_vector_unsigned_byte_32;
2011 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
2012 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
2013 scav_vector_unsigned_byte_64;
2015 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
2016 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
2017 scav_vector_unsigned_byte_64;
2019 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
2020 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
2021 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2022 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
2024 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2025 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
2026 scav_vector_complex_single_float;
2028 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2029 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
2030 scav_vector_complex_double_float;
2032 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2033 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
2034 scav_vector_complex_long_float;
2036 scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
2037 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
2038 scavtab[COMPLEX_CHARACTER_STRING_WIDETAG] = scav_boxed;
2040 scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
2041 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
2042 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
2043 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
2044 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
2045 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
2046 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
2047 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
2049 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
2050 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
2051 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
2053 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
2055 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
2056 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
2057 scavtab[CHARACTER_WIDETAG] = scav_immediate;
2058 scavtab[SAP_WIDETAG] = scav_unboxed;
2059 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
2060 scavtab[NO_TLS_VALUE_MARKER_WIDETAG] = scav_immediate;
2061 scavtab[INSTANCE_HEADER_WIDETAG] = scav_instance;
2062 #if defined(LISP_FEATURE_SPARC)
2063 scavtab[FDEFN_WIDETAG] = scav_boxed;
2065 scavtab[FDEFN_WIDETAG] = scav_fdefn;
2067 scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector;
2069 /* transport other table, initialized same way as scavtab */
2070 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
2071 transother[i] = trans_lose;
2072 transother[BIGNUM_WIDETAG] = trans_unboxed;
2073 transother[RATIO_WIDETAG] = trans_boxed;
2075 #if N_WORD_BITS == 64
2076 transother[SINGLE_FLOAT_WIDETAG] = trans_immediate;
2078 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
2080 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
2081 #ifdef LONG_FLOAT_WIDETAG
2082 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
2084 transother[COMPLEX_WIDETAG] = trans_boxed;
2085 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
2086 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
2088 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
2089 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
2091 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
2092 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
2094 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
2095 transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
2096 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
2097 transother[SIMPLE_CHARACTER_STRING_WIDETAG] = trans_character_string;
2099 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
2100 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
2101 transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
2102 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
2103 trans_vector_unsigned_byte_2;
2104 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
2105 trans_vector_unsigned_byte_4;
2106 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
2107 trans_vector_unsigned_byte_8;
2108 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
2109 trans_vector_unsigned_byte_8;
2110 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
2111 trans_vector_unsigned_byte_16;
2112 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
2113 trans_vector_unsigned_byte_16;
2114 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
2115 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
2116 trans_vector_unsigned_byte_32;
2118 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
2119 trans_vector_unsigned_byte_32;
2120 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
2121 trans_vector_unsigned_byte_32;
2122 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
2123 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
2124 trans_vector_unsigned_byte_64;
2126 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
2127 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
2128 trans_vector_unsigned_byte_64;
2130 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
2131 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
2132 trans_vector_unsigned_byte_64;
2134 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
2135 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
2136 trans_vector_unsigned_byte_8;
2138 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
2139 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
2140 trans_vector_unsigned_byte_16;
2142 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
2143 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
2144 trans_vector_unsigned_byte_32;
2146 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2147 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
2148 trans_vector_unsigned_byte_32;
2150 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
2151 transother[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
2152 trans_vector_unsigned_byte_64;
2154 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
2155 transother[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
2156 trans_vector_unsigned_byte_64;
2158 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
2159 trans_vector_single_float;
2160 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
2161 trans_vector_double_float;
2162 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2163 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
2164 trans_vector_long_float;
2166 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2167 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
2168 trans_vector_complex_single_float;
2170 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2171 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
2172 trans_vector_complex_double_float;
2174 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2175 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
2176 trans_vector_complex_long_float;
2178 transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
2179 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
2180 transother[COMPLEX_CHARACTER_STRING_WIDETAG] = trans_boxed;
2182 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
2183 transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
2184 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
2185 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
2186 transother[CODE_HEADER_WIDETAG] = trans_code_header;
2187 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
2188 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
2189 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
2190 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
2191 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
2192 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
2193 transother[CHARACTER_WIDETAG] = trans_immediate;
2194 transother[SAP_WIDETAG] = trans_unboxed;
2195 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
2196 transother[NO_TLS_VALUE_MARKER_WIDETAG] = trans_immediate;
2197 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
2198 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
2199 transother[FDEFN_WIDETAG] = trans_boxed;
2201 /* size table, initialized the same way as scavtab */
2202 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
2203 sizetab[i] = size_lose;
2204 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
2205 sizetab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
2206 sizetab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2207 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
2208 sizetab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2209 sizetab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
2210 sizetab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2211 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
2212 sizetab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2214 sizetab[BIGNUM_WIDETAG] = size_unboxed;
2215 sizetab[RATIO_WIDETAG] = size_boxed;
2216 #if N_WORD_BITS == 64
2217 sizetab[SINGLE_FLOAT_WIDETAG] = size_immediate;
2219 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
2221 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
2222 #ifdef LONG_FLOAT_WIDETAG
2223 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
2225 sizetab[COMPLEX_WIDETAG] = size_boxed;
2226 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
2227 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
2229 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
2230 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
2232 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
2233 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
2235 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
2236 sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
2237 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
2238 sizetab[SIMPLE_CHARACTER_STRING_WIDETAG] = size_character_string;
2240 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
2241 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
2242 sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
2243 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
2244 size_vector_unsigned_byte_2;
2245 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
2246 size_vector_unsigned_byte_4;
2247 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
2248 size_vector_unsigned_byte_8;
2249 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
2250 size_vector_unsigned_byte_8;
2251 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
2252 size_vector_unsigned_byte_16;
2253 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
2254 size_vector_unsigned_byte_16;
2255 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
2256 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
2257 size_vector_unsigned_byte_32;
2259 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
2260 size_vector_unsigned_byte_32;
2261 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
2262 size_vector_unsigned_byte_32;
2263 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
2264 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
2265 size_vector_unsigned_byte_64;
2267 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
2268 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
2269 size_vector_unsigned_byte_64;
2271 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
2272 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
2273 size_vector_unsigned_byte_64;
2275 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
2276 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
2278 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
2279 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
2280 size_vector_unsigned_byte_16;
2282 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
2283 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
2284 size_vector_unsigned_byte_32;
2286 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2287 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
2288 size_vector_unsigned_byte_32;
2290 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
2291 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
2292 size_vector_unsigned_byte_64;
2294 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
2295 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
2296 size_vector_unsigned_byte_64;
2298 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
2299 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
2300 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2301 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
2303 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2304 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
2305 size_vector_complex_single_float;
2307 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2308 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
2309 size_vector_complex_double_float;
2311 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2312 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
2313 size_vector_complex_long_float;
2315 sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
2316 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
2317 sizetab[COMPLEX_CHARACTER_STRING_WIDETAG] = size_boxed;
2319 sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
2320 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
2321 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
2322 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
2323 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
2325 /* We shouldn't see these, so just lose if it happens. */
2326 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
2327 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
2329 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
2330 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
2331 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
2332 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
2333 sizetab[CHARACTER_WIDETAG] = size_immediate;
2334 sizetab[SAP_WIDETAG] = size_unboxed;
2335 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
2336 sizetab[NO_TLS_VALUE_MARKER_WIDETAG] = size_immediate;
2337 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
2338 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
2339 sizetab[FDEFN_WIDETAG] = size_boxed;
2343 /* Find the code object for the given pc, or return NULL on
2346 component_ptr_from_pc(lispobj *pc)
2348 lispobj *object = NULL;
2350 if ( (object = search_read_only_space(pc)) )
2352 else if ( (object = search_static_space(pc)) )
2355 object = search_dynamic_space(pc);
2357 if (object) /* if we found something */
2358 if (widetag_of(*object) == CODE_HEADER_WIDETAG)
2364 /* Scan an area looking for an object which encloses the given pointer.
2365 * Return the object start on success or NULL on failure. */
2367 gc_search_space(lispobj *start, size_t words, lispobj *pointer)
2371 lispobj thing = *start;
2373 /* If thing is an immediate then this is a cons. */
2374 if (is_lisp_pointer(thing)
2376 || (widetag_of(thing) == CHARACTER_WIDETAG)
2377 #if N_WORD_BITS == 64
2378 || (widetag_of(thing) == SINGLE_FLOAT_WIDETAG)
2380 || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG))
2383 count = (sizetab[widetag_of(thing)])(start);
2385 /* Check whether the pointer is within this object. */
2386 if ((pointer >= start) && (pointer < (start+count))) {
2388 /*FSHOW((stderr,"/found %x in %x %x\n", pointer, start, thing));*/
2392 /* Round up the count. */
2393 count = CEILING(count,2);
2402 maybe_gc(os_context_t *context)
2404 #ifndef LISP_FEATURE_WIN32
2405 struct thread *thread = arch_os_get_current_thread();
2408 fake_foreign_function_call(context);
2409 /* SUB-GC may return without GCing if *GC-INHIBIT* is set, in
2410 * which case we will be running with no gc trigger barrier
2411 * thing for a while. But it shouldn't be long until the end
2414 * FIXME: It would be good to protect the end of dynamic space for
2415 * CheneyGC and signal a storage condition from there.
2418 /* Restore the signal mask from the interrupted context before
2419 * calling into Lisp if interrupts are enabled. Why not always?
2421 * Suppose there is a WITHOUT-INTERRUPTS block far, far out. If an
2422 * interrupt hits while in SUB-GC, it is deferred and the
2423 * os_context_sigmask of that interrupt is set to block further
2424 * deferrable interrupts (until the first one is
2425 * handled). Unfortunately, that context refers to this place and
2426 * when we return from here the signals will not be blocked.
2428 * A kludgy alternative is to propagate the sigmask change to the
2431 #ifndef LISP_FEATURE_WIN32
2432 if(SymbolValue(INTERRUPTS_ENABLED,thread)!=NIL) {
2433 sigset_t *context_sigmask = os_context_sigmask_addr(context);
2434 #ifdef LISP_FEATURE_SB_THREAD
2435 /* What if the context we'd like to restore has GC signals
2436 * blocked? Just skip the GC: we can't set GC_PENDING, because
2437 * that would block the next attempt, and we don't know when
2438 * we'd next check for it -- and it's hard to be sure that
2439 * unblocking would be safe.
2441 * FIXME: This is not actually much better: we may already have
2442 * GC_PENDING set, and presumably our caller assumes that we will
2443 * clear it. Perhaps we should, even though we don't actually GC? */
2444 if (sigismember(context_sigmask,SIG_STOP_FOR_GC)) {
2445 undo_fake_foreign_function_call(context);
2449 thread_sigmask(SIG_SETMASK, context_sigmask, 0);
2452 unblock_gc_signals();
2454 /* SIG_STOP_FOR_GC needs to be enabled before we can call lisp:
2455 * otherwise two threads racing here may deadlock: the other will
2456 * wait on the GC lock, and the other cannot stop the first one... */
2457 funcall0(StaticSymbolFunction(SUB_GC));
2458 undo_fake_foreign_function_call(context);