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;
59 forwarding_pointer_p(lispobj *pointer) {
60 lispobj first_word=*pointer;
61 #ifdef LISP_FEATURE_GENCGC
62 return (first_word == 0x01);
64 return (is_lisp_pointer(first_word)
65 && new_space_p(first_word));
69 static inline lispobj *
70 forwarding_pointer_value(lispobj *pointer) {
71 #ifdef LISP_FEATURE_GENCGC
72 return (lispobj *) ((pointer_sized_uint_t) pointer[1]);
74 return (lispobj *) ((pointer_sized_uint_t) pointer[0]);
78 set_forwarding_pointer(lispobj * pointer, lispobj newspace_copy) {
79 #ifdef LISP_FEATURE_GENCGC
81 pointer[1]=newspace_copy;
83 pointer[0]=newspace_copy;
88 long (*scavtab[256])(lispobj *where, lispobj object);
89 lispobj (*transother[256])(lispobj object);
90 long (*sizetab[256])(lispobj *where);
91 struct weak_pointer *weak_pointers;
93 unsigned long bytes_consed_between_gcs = 12*1024*1024;
100 /* to copy a boxed object */
102 copy_object(lispobj object, long nwords)
107 gc_assert(is_lisp_pointer(object));
108 gc_assert(from_space_p(object));
109 gc_assert((nwords & 0x01) == 0);
111 /* Get tag of object. */
112 tag = lowtag_of(object);
114 /* Allocate space. */
115 new = gc_general_alloc(nwords*N_WORD_BYTES,ALLOC_BOXED,ALLOC_QUICK);
117 /* Copy the object. */
118 memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
119 return make_lispobj(new,tag);
122 static long scav_lose(lispobj *where, lispobj object); /* forward decl */
124 /* FIXME: Most calls end up going to some trouble to compute an
125 * 'n_words' value for this function. The system might be a little
126 * simpler if this function used an 'end' parameter instead. */
128 scavenge(lispobj *start, long n_words)
130 lispobj *end = start + n_words;
132 long n_words_scavenged;
134 for (object_ptr = start;
136 object_ptr += n_words_scavenged) {
138 lispobj object = *object_ptr;
139 #ifdef LISP_FEATURE_GENCGC
140 gc_assert(!forwarding_pointer_p(object_ptr));
142 if (is_lisp_pointer(object)) {
143 if (from_space_p(object)) {
144 /* It currently points to old space. Check for a
145 * forwarding pointer. */
146 lispobj *ptr = native_pointer(object);
147 if (forwarding_pointer_p(ptr)) {
148 /* Yes, there's a forwarding pointer. */
149 *object_ptr = LOW_WORD(forwarding_pointer_value(ptr));
150 n_words_scavenged = 1;
152 /* Scavenge that pointer. */
154 (scavtab[widetag_of(object)])(object_ptr, object);
157 /* It points somewhere other than oldspace. Leave it
159 n_words_scavenged = 1;
162 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
163 /* This workaround is probably not needed for those ports
164 which don't have a partitioned register set (and therefore
165 scan the stack conservatively for roots). */
166 else if (n_words == 1) {
167 /* there are some situations where an other-immediate may
168 end up in a descriptor register. I'm not sure whether
169 this is supposed to happen, but if it does then we
170 don't want to (a) barf or (b) scavenge over the
171 data-block, because there isn't one. So, if we're
172 checking a single word and it's anything other than a
173 pointer, just hush it up */
174 int widetag = widetag_of(object);
175 n_words_scavenged = 1;
177 if ((scavtab[widetag] == scav_lose) ||
178 (((sizetab[widetag])(object_ptr)) > 1)) {
179 fprintf(stderr,"warning: \
180 attempted to scavenge non-descriptor value %x at %p.\n\n\
181 If you can reproduce this warning, please send a bug report\n\
182 (see manual page for details).\n",
187 else if (fixnump(object)) {
188 /* It's a fixnum: really easy.. */
189 n_words_scavenged = 1;
191 /* It's some sort of header object or another. */
193 (scavtab[widetag_of(object)])(object_ptr, object);
196 gc_assert_verbose(object_ptr == end, "Final object pointer %p, start %p, end %p\n",
197 object_ptr, start, end);
200 static lispobj trans_fun_header(lispobj object); /* forward decls */
201 static lispobj trans_boxed(lispobj object);
204 scav_fun_pointer(lispobj *where, lispobj object)
206 lispobj *first_pointer;
209 gc_assert(is_lisp_pointer(object));
211 /* Object is a pointer into from_space - not a FP. */
212 first_pointer = (lispobj *) native_pointer(object);
214 /* must transport object -- object may point to either a function
215 * header, a closure function header, or to a closure header. */
217 switch (widetag_of(*first_pointer)) {
218 case SIMPLE_FUN_HEADER_WIDETAG:
219 copy = trans_fun_header(object);
222 copy = trans_boxed(object);
226 if (copy != object) {
227 /* Set forwarding pointer */
228 set_forwarding_pointer(first_pointer,copy);
231 gc_assert(is_lisp_pointer(copy));
232 gc_assert(!from_space_p(copy));
241 trans_code(struct code *code)
243 struct code *new_code;
244 lispobj first, l_code, l_new_code;
245 long nheader_words, ncode_words, nwords;
246 unsigned long displacement;
247 lispobj fheaderl, *prev_pointer;
249 /* if object has already been transported, just return pointer */
250 first = code->header;
251 if (forwarding_pointer_p((lispobj *)code)) {
253 printf("Was already transported\n");
255 return (struct code *) forwarding_pointer_value
256 ((lispobj *)((pointer_sized_uint_t) code));
259 gc_assert(widetag_of(first) == CODE_HEADER_WIDETAG);
261 /* prepare to transport the code vector */
262 l_code = (lispobj) LOW_WORD(code) | OTHER_POINTER_LOWTAG;
264 ncode_words = fixnum_value(code->code_size);
265 nheader_words = HeaderValue(code->header);
266 nwords = ncode_words + nheader_words;
267 nwords = CEILING(nwords, 2);
269 l_new_code = copy_object(l_code, nwords);
270 new_code = (struct code *) native_pointer(l_new_code);
272 #if defined(DEBUG_CODE_GC)
273 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
274 (unsigned long) code, (unsigned long) new_code);
275 printf("Code object is %d words long.\n", nwords);
278 #ifdef LISP_FEATURE_GENCGC
279 if (new_code == code)
283 displacement = l_new_code - l_code;
285 set_forwarding_pointer((lispobj *)code, l_new_code);
287 /* set forwarding pointers for all the function headers in the */
288 /* code object. also fix all self pointers */
290 fheaderl = code->entry_points;
291 prev_pointer = &new_code->entry_points;
293 while (fheaderl != NIL) {
294 struct simple_fun *fheaderp, *nfheaderp;
297 fheaderp = (struct simple_fun *) native_pointer(fheaderl);
298 gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
300 /* Calculate the new function pointer and the new */
301 /* function header. */
302 nfheaderl = fheaderl + displacement;
303 nfheaderp = (struct simple_fun *) native_pointer(nfheaderl);
306 printf("fheaderp->header (at %x) <- %x\n",
307 &(fheaderp->header) , nfheaderl);
309 set_forwarding_pointer((lispobj *)fheaderp, nfheaderl);
311 /* fix self pointer. */
313 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
314 FUN_RAW_ADDR_OFFSET +
318 *prev_pointer = nfheaderl;
320 fheaderl = fheaderp->next;
321 prev_pointer = &nfheaderp->next;
323 #ifdef LISP_FEATURE_GENCGC
324 /* Cheneygc doesn't need this os_flush_icache, it flushes the whole
325 spaces once when all copying is done. */
326 os_flush_icache((os_vm_address_t) (((long *)new_code) + nheader_words),
327 ncode_words * sizeof(long));
331 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
332 gencgc_apply_code_fixups(code, new_code);
339 scav_code_header(lispobj *where, lispobj object)
342 long n_header_words, n_code_words, n_words;
343 lispobj entry_point; /* tagged pointer to entry point */
344 struct simple_fun *function_ptr; /* untagged pointer to entry point */
346 code = (struct code *) where;
347 n_code_words = fixnum_value(code->code_size);
348 n_header_words = HeaderValue(object);
349 n_words = n_code_words + n_header_words;
350 n_words = CEILING(n_words, 2);
352 /* Scavenge the boxed section of the code data block. */
353 scavenge(where + 1, n_header_words - 1);
355 /* Scavenge the boxed section of each function object in the
356 * code data block. */
357 for (entry_point = code->entry_points;
359 entry_point = function_ptr->next) {
361 gc_assert_verbose(is_lisp_pointer(entry_point),
362 "Entry point %lx\n is not a lisp pointer.",
365 function_ptr = (struct simple_fun *) native_pointer(entry_point);
366 gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
368 scavenge(&function_ptr->name, 1);
369 scavenge(&function_ptr->arglist, 1);
370 scavenge(&function_ptr->type, 1);
371 scavenge(&function_ptr->xrefs, 1);
378 trans_code_header(lispobj object)
382 ncode = trans_code((struct code *) native_pointer(object));
383 return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG;
388 size_code_header(lispobj *where)
391 long nheader_words, ncode_words, nwords;
393 code = (struct code *) where;
395 ncode_words = fixnum_value(code->code_size);
396 nheader_words = HeaderValue(code->header);
397 nwords = ncode_words + nheader_words;
398 nwords = CEILING(nwords, 2);
403 #if !defined(LISP_FEATURE_X86) && ! defined(LISP_FEATURE_X86_64)
405 scav_return_pc_header(lispobj *where, lispobj object)
407 lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x\n",
408 (unsigned long) where,
409 (unsigned long) object);
410 return 0; /* bogus return value to satisfy static type checking */
412 #endif /* LISP_FEATURE_X86 */
415 trans_return_pc_header(lispobj object)
417 struct simple_fun *return_pc;
418 unsigned long offset;
419 struct code *code, *ncode;
421 return_pc = (struct simple_fun *) native_pointer(object);
422 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
423 offset = HeaderValue(return_pc->header) * N_WORD_BYTES;
425 /* Transport the whole code object */
426 code = (struct code *) ((unsigned long) return_pc - offset);
427 ncode = trans_code(code);
429 return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
432 /* On the 386, closures hold a pointer to the raw address instead of the
433 * function object, so we can use CALL [$FDEFN+const] to invoke
434 * the function without loading it into a register. Given that code
435 * objects don't move, we don't need to update anything, but we do
436 * have to figure out that the function is still live. */
438 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
440 scav_closure_header(lispobj *where, lispobj object)
442 struct closure *closure;
445 closure = (struct closure *)where;
446 fun = closure->fun - FUN_RAW_ADDR_OFFSET;
448 #ifdef LISP_FEATURE_GENCGC
449 /* The function may have moved so update the raw address. But
450 * don't write unnecessarily. */
451 if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
452 closure->fun = fun + FUN_RAW_ADDR_OFFSET;
458 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
460 scav_fun_header(lispobj *where, lispobj object)
462 lose("attempted to scavenge a function header where=0x%08x object=0x%08x\n",
463 (unsigned long) where,
464 (unsigned long) object);
465 return 0; /* bogus return value to satisfy static type checking */
467 #endif /* LISP_FEATURE_X86 */
470 trans_fun_header(lispobj object)
472 struct simple_fun *fheader;
473 unsigned long offset;
474 struct code *code, *ncode;
476 fheader = (struct simple_fun *) native_pointer(object);
477 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
478 offset = HeaderValue(fheader->header) * N_WORD_BYTES;
480 /* Transport the whole code object */
481 code = (struct code *) ((unsigned long) fheader - offset);
482 ncode = trans_code(code);
484 return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
493 scav_instance_pointer(lispobj *where, lispobj object)
495 lispobj copy, *first_pointer;
497 /* Object is a pointer into from space - not a FP. */
498 copy = trans_boxed(object);
500 #ifdef LISP_FEATURE_GENCGC
501 gc_assert(copy != object);
504 first_pointer = (lispobj *) native_pointer(object);
505 set_forwarding_pointer(first_pointer,copy);
516 static lispobj trans_list(lispobj object);
519 scav_list_pointer(lispobj *where, lispobj object)
521 lispobj first, *first_pointer;
523 gc_assert(is_lisp_pointer(object));
525 /* Object is a pointer into from space - not FP. */
526 first_pointer = (lispobj *) native_pointer(object);
528 first = trans_list(object);
529 gc_assert(first != object);
531 /* Set forwarding pointer */
532 set_forwarding_pointer(first_pointer, first);
534 gc_assert(is_lisp_pointer(first));
535 gc_assert(!from_space_p(first));
543 trans_list(lispobj object)
545 lispobj new_list_pointer;
546 struct cons *cons, *new_cons;
549 cons = (struct cons *) native_pointer(object);
552 new_cons = (struct cons *)
553 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
554 new_cons->car = cons->car;
555 new_cons->cdr = cons->cdr; /* updated later */
556 new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
558 /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC */
561 set_forwarding_pointer((lispobj *)cons, new_list_pointer);
563 /* Try to linearize the list in the cdr direction to help reduce
567 struct cons *cdr_cons, *new_cdr_cons;
569 if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
570 !from_space_p(cdr) ||
571 forwarding_pointer_p((lispobj *)native_pointer(cdr)))
574 cdr_cons = (struct cons *) native_pointer(cdr);
577 new_cdr_cons = (struct cons*)
578 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
579 new_cdr_cons->car = cdr_cons->car;
580 new_cdr_cons->cdr = cdr_cons->cdr;
581 new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
583 /* Grab the cdr before it is clobbered. */
585 set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
587 /* Update the cdr of the last cons copied into new space to
588 * keep the newspace scavenge from having to do it. */
589 new_cons->cdr = new_cdr;
591 new_cons = new_cdr_cons;
594 return new_list_pointer;
599 * scavenging and transporting other pointers
603 scav_other_pointer(lispobj *where, lispobj object)
605 lispobj first, *first_pointer;
607 gc_assert(is_lisp_pointer(object));
609 /* Object is a pointer into from space - not FP. */
610 first_pointer = (lispobj *) native_pointer(object);
611 first = (transother[widetag_of(*first_pointer)])(object);
613 if (first != object) {
614 set_forwarding_pointer(first_pointer, first);
615 #ifdef LISP_FEATURE_GENCGC
619 #ifndef LISP_FEATURE_GENCGC
622 gc_assert(is_lisp_pointer(first));
623 gc_assert(!from_space_p(first));
629 * immediate, boxed, and unboxed objects
633 size_pointer(lispobj *where)
639 scav_immediate(lispobj *where, lispobj object)
645 trans_immediate(lispobj object)
647 lose("trying to transport an immediate\n");
648 return NIL; /* bogus return value to satisfy static type checking */
652 size_immediate(lispobj *where)
659 scav_boxed(lispobj *where, lispobj object)
665 scav_instance(lispobj *where, lispobj object)
668 long ntotal = HeaderValue(object);
669 lispobj layout = ((struct instance *)where)->slots[0];
673 if (forwarding_pointer_p(native_pointer(layout)))
674 layout = (lispobj) forwarding_pointer_value(native_pointer(layout));
676 nuntagged = ((struct layout *)native_pointer(layout))->n_untagged_slots;
677 scavenge(where + 1, ntotal - fixnum_value(nuntagged));
683 trans_boxed(lispobj object)
686 unsigned long length;
688 gc_assert(is_lisp_pointer(object));
690 header = *((lispobj *) native_pointer(object));
691 length = HeaderValue(header) + 1;
692 length = CEILING(length, 2);
694 return copy_object(object, length);
699 size_boxed(lispobj *where)
702 unsigned long length;
705 length = HeaderValue(header) + 1;
706 length = CEILING(length, 2);
711 /* Note: on the sparc we don't have to do anything special for fdefns, */
712 /* 'cause the raw-addr has a function lowtag. */
713 #if !defined(LISP_FEATURE_SPARC)
715 scav_fdefn(lispobj *where, lispobj object)
719 fdefn = (struct fdefn *)where;
721 /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
722 fdefn->fun, fdefn->raw_addr)); */
724 if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)
725 == (char *)((unsigned long)(fdefn->raw_addr))) {
726 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
728 /* Don't write unnecessarily. */
729 if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
730 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
731 /* gc.c has more casts here, which may be relevant or alternatively
732 may be compiler warning defeaters. try
733 fdefn->raw_addr = ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
735 return sizeof(struct fdefn) / sizeof(lispobj);
743 scav_unboxed(lispobj *where, lispobj object)
745 unsigned long length;
747 length = HeaderValue(object) + 1;
748 length = CEILING(length, 2);
754 trans_unboxed(lispobj object)
757 unsigned long length;
760 gc_assert(is_lisp_pointer(object));
762 header = *((lispobj *) native_pointer(object));
763 length = HeaderValue(header) + 1;
764 length = CEILING(length, 2);
766 return copy_unboxed_object(object, length);
770 size_unboxed(lispobj *where)
773 unsigned long length;
776 length = HeaderValue(header) + 1;
777 length = CEILING(length, 2);
783 /* vector-like objects */
785 scav_base_string(lispobj *where, lispobj object)
787 struct vector *vector;
790 /* NOTE: Strings contain one more byte of data than the length */
791 /* slot indicates. */
793 vector = (struct vector *) where;
794 length = fixnum_value(vector->length) + 1;
795 nwords = CEILING(NWORDS(length, 8) + 2, 2);
800 trans_base_string(lispobj object)
802 struct vector *vector;
805 gc_assert(is_lisp_pointer(object));
807 /* NOTE: A string contains one more byte of data (a terminating
808 * '\0' to help when interfacing with C functions) than indicated
809 * by the length slot. */
811 vector = (struct vector *) native_pointer(object);
812 length = fixnum_value(vector->length) + 1;
813 nwords = CEILING(NWORDS(length, 8) + 2, 2);
815 return copy_large_unboxed_object(object, nwords);
819 size_base_string(lispobj *where)
821 struct vector *vector;
824 /* NOTE: A string contains one more byte of data (a terminating
825 * '\0' to help when interfacing with C functions) than indicated
826 * by the length slot. */
828 vector = (struct vector *) where;
829 length = fixnum_value(vector->length) + 1;
830 nwords = CEILING(NWORDS(length, 8) + 2, 2);
836 scav_character_string(lispobj *where, lispobj object)
838 struct vector *vector;
841 /* NOTE: Strings contain one more byte of data than the length */
842 /* slot indicates. */
844 vector = (struct vector *) where;
845 length = fixnum_value(vector->length) + 1;
846 nwords = CEILING(NWORDS(length, 32) + 2, 2);
851 trans_character_string(lispobj object)
853 struct vector *vector;
856 gc_assert(is_lisp_pointer(object));
858 /* NOTE: A string contains one more byte of data (a terminating
859 * '\0' to help when interfacing with C functions) than indicated
860 * by the length slot. */
862 vector = (struct vector *) native_pointer(object);
863 length = fixnum_value(vector->length) + 1;
864 nwords = CEILING(NWORDS(length, 32) + 2, 2);
866 return copy_large_unboxed_object(object, nwords);
870 size_character_string(lispobj *where)
872 struct vector *vector;
875 /* NOTE: A string contains one more byte of data (a terminating
876 * '\0' to help when interfacing with C functions) than indicated
877 * by the length slot. */
879 vector = (struct vector *) where;
880 length = fixnum_value(vector->length) + 1;
881 nwords = CEILING(NWORDS(length, 32) + 2, 2);
887 trans_vector(lispobj object)
889 struct vector *vector;
892 gc_assert(is_lisp_pointer(object));
894 vector = (struct vector *) native_pointer(object);
896 length = fixnum_value(vector->length);
897 nwords = CEILING(length + 2, 2);
899 return copy_large_object(object, nwords);
903 size_vector(lispobj *where)
905 struct vector *vector;
908 vector = (struct vector *) where;
909 length = fixnum_value(vector->length);
910 nwords = CEILING(length + 2, 2);
916 scav_vector_nil(lispobj *where, lispobj object)
922 trans_vector_nil(lispobj object)
924 gc_assert(is_lisp_pointer(object));
925 return copy_unboxed_object(object, 2);
929 size_vector_nil(lispobj *where)
931 /* Just the header word and the length word */
936 scav_vector_bit(lispobj *where, lispobj object)
938 struct vector *vector;
941 vector = (struct vector *) where;
942 length = fixnum_value(vector->length);
943 nwords = CEILING(NWORDS(length, 1) + 2, 2);
949 trans_vector_bit(lispobj object)
951 struct vector *vector;
954 gc_assert(is_lisp_pointer(object));
956 vector = (struct vector *) native_pointer(object);
957 length = fixnum_value(vector->length);
958 nwords = CEILING(NWORDS(length, 1) + 2, 2);
960 return copy_large_unboxed_object(object, nwords);
964 size_vector_bit(lispobj *where)
966 struct vector *vector;
969 vector = (struct vector *) where;
970 length = fixnum_value(vector->length);
971 nwords = CEILING(NWORDS(length, 1) + 2, 2);
977 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
979 struct vector *vector;
982 vector = (struct vector *) where;
983 length = fixnum_value(vector->length);
984 nwords = CEILING(NWORDS(length, 2) + 2, 2);
990 trans_vector_unsigned_byte_2(lispobj object)
992 struct vector *vector;
995 gc_assert(is_lisp_pointer(object));
997 vector = (struct vector *) native_pointer(object);
998 length = fixnum_value(vector->length);
999 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1001 return copy_large_unboxed_object(object, nwords);
1005 size_vector_unsigned_byte_2(lispobj *where)
1007 struct vector *vector;
1008 long length, nwords;
1010 vector = (struct vector *) where;
1011 length = fixnum_value(vector->length);
1012 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1018 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
1020 struct vector *vector;
1021 long length, nwords;
1023 vector = (struct vector *) where;
1024 length = fixnum_value(vector->length);
1025 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1031 trans_vector_unsigned_byte_4(lispobj object)
1033 struct vector *vector;
1034 long length, nwords;
1036 gc_assert(is_lisp_pointer(object));
1038 vector = (struct vector *) native_pointer(object);
1039 length = fixnum_value(vector->length);
1040 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1042 return copy_large_unboxed_object(object, nwords);
1045 size_vector_unsigned_byte_4(lispobj *where)
1047 struct vector *vector;
1048 long length, nwords;
1050 vector = (struct vector *) where;
1051 length = fixnum_value(vector->length);
1052 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1059 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
1061 struct vector *vector;
1062 long length, nwords;
1064 vector = (struct vector *) where;
1065 length = fixnum_value(vector->length);
1066 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1071 /*********************/
1076 trans_vector_unsigned_byte_8(lispobj object)
1078 struct vector *vector;
1079 long length, nwords;
1081 gc_assert(is_lisp_pointer(object));
1083 vector = (struct vector *) native_pointer(object);
1084 length = fixnum_value(vector->length);
1085 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1087 return copy_large_unboxed_object(object, nwords);
1091 size_vector_unsigned_byte_8(lispobj *where)
1093 struct vector *vector;
1094 long length, nwords;
1096 vector = (struct vector *) where;
1097 length = fixnum_value(vector->length);
1098 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1105 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1107 struct vector *vector;
1108 long length, nwords;
1110 vector = (struct vector *) where;
1111 length = fixnum_value(vector->length);
1112 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1118 trans_vector_unsigned_byte_16(lispobj object)
1120 struct vector *vector;
1121 long length, nwords;
1123 gc_assert(is_lisp_pointer(object));
1125 vector = (struct vector *) native_pointer(object);
1126 length = fixnum_value(vector->length);
1127 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1129 return copy_large_unboxed_object(object, nwords);
1133 size_vector_unsigned_byte_16(lispobj *where)
1135 struct vector *vector;
1136 long length, nwords;
1138 vector = (struct vector *) where;
1139 length = fixnum_value(vector->length);
1140 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1146 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1148 struct vector *vector;
1149 long length, nwords;
1151 vector = (struct vector *) where;
1152 length = fixnum_value(vector->length);
1153 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1159 trans_vector_unsigned_byte_32(lispobj object)
1161 struct vector *vector;
1162 long length, nwords;
1164 gc_assert(is_lisp_pointer(object));
1166 vector = (struct vector *) native_pointer(object);
1167 length = fixnum_value(vector->length);
1168 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1170 return copy_large_unboxed_object(object, nwords);
1174 size_vector_unsigned_byte_32(lispobj *where)
1176 struct vector *vector;
1177 long length, nwords;
1179 vector = (struct vector *) where;
1180 length = fixnum_value(vector->length);
1181 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1186 #if N_WORD_BITS == 64
1188 scav_vector_unsigned_byte_64(lispobj *where, lispobj object)
1190 struct vector *vector;
1191 long length, nwords;
1193 vector = (struct vector *) where;
1194 length = fixnum_value(vector->length);
1195 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1201 trans_vector_unsigned_byte_64(lispobj object)
1203 struct vector *vector;
1204 long length, nwords;
1206 gc_assert(is_lisp_pointer(object));
1208 vector = (struct vector *) native_pointer(object);
1209 length = fixnum_value(vector->length);
1210 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1212 return copy_large_unboxed_object(object, nwords);
1216 size_vector_unsigned_byte_64(lispobj *where)
1218 struct vector *vector;
1219 long length, nwords;
1221 vector = (struct vector *) where;
1222 length = fixnum_value(vector->length);
1223 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1230 scav_vector_single_float(lispobj *where, lispobj object)
1232 struct vector *vector;
1233 long length, nwords;
1235 vector = (struct vector *) where;
1236 length = fixnum_value(vector->length);
1237 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1243 trans_vector_single_float(lispobj object)
1245 struct vector *vector;
1246 long length, nwords;
1248 gc_assert(is_lisp_pointer(object));
1250 vector = (struct vector *) native_pointer(object);
1251 length = fixnum_value(vector->length);
1252 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1254 return copy_large_unboxed_object(object, nwords);
1258 size_vector_single_float(lispobj *where)
1260 struct vector *vector;
1261 long length, nwords;
1263 vector = (struct vector *) where;
1264 length = fixnum_value(vector->length);
1265 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1271 scav_vector_double_float(lispobj *where, lispobj object)
1273 struct vector *vector;
1274 long length, nwords;
1276 vector = (struct vector *) where;
1277 length = fixnum_value(vector->length);
1278 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1284 trans_vector_double_float(lispobj object)
1286 struct vector *vector;
1287 long length, nwords;
1289 gc_assert(is_lisp_pointer(object));
1291 vector = (struct vector *) native_pointer(object);
1292 length = fixnum_value(vector->length);
1293 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1295 return copy_large_unboxed_object(object, nwords);
1299 size_vector_double_float(lispobj *where)
1301 struct vector *vector;
1302 long length, nwords;
1304 vector = (struct vector *) where;
1305 length = fixnum_value(vector->length);
1306 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1311 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1313 scav_vector_long_float(lispobj *where, lispobj object)
1315 struct vector *vector;
1316 long length, nwords;
1318 vector = (struct vector *) where;
1319 length = fixnum_value(vector->length);
1320 nwords = CEILING(length *
1327 trans_vector_long_float(lispobj object)
1329 struct vector *vector;
1330 long length, nwords;
1332 gc_assert(is_lisp_pointer(object));
1334 vector = (struct vector *) native_pointer(object);
1335 length = fixnum_value(vector->length);
1336 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1338 return copy_large_unboxed_object(object, nwords);
1342 size_vector_long_float(lispobj *where)
1344 struct vector *vector;
1345 long length, nwords;
1347 vector = (struct vector *) where;
1348 length = fixnum_value(vector->length);
1349 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1356 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1358 scav_vector_complex_single_float(lispobj *where, lispobj object)
1360 struct vector *vector;
1361 long length, nwords;
1363 vector = (struct vector *) where;
1364 length = fixnum_value(vector->length);
1365 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1371 trans_vector_complex_single_float(lispobj object)
1373 struct vector *vector;
1374 long length, nwords;
1376 gc_assert(is_lisp_pointer(object));
1378 vector = (struct vector *) native_pointer(object);
1379 length = fixnum_value(vector->length);
1380 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1382 return copy_large_unboxed_object(object, nwords);
1386 size_vector_complex_single_float(lispobj *where)
1388 struct vector *vector;
1389 long length, nwords;
1391 vector = (struct vector *) where;
1392 length = fixnum_value(vector->length);
1393 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1399 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1401 scav_vector_complex_double_float(lispobj *where, lispobj object)
1403 struct vector *vector;
1404 long length, nwords;
1406 vector = (struct vector *) where;
1407 length = fixnum_value(vector->length);
1408 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1414 trans_vector_complex_double_float(lispobj object)
1416 struct vector *vector;
1417 long length, nwords;
1419 gc_assert(is_lisp_pointer(object));
1421 vector = (struct vector *) native_pointer(object);
1422 length = fixnum_value(vector->length);
1423 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1425 return copy_large_unboxed_object(object, nwords);
1429 size_vector_complex_double_float(lispobj *where)
1431 struct vector *vector;
1432 long length, nwords;
1434 vector = (struct vector *) where;
1435 length = fixnum_value(vector->length);
1436 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1443 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1445 scav_vector_complex_long_float(lispobj *where, lispobj object)
1447 struct vector *vector;
1448 long length, nwords;
1450 vector = (struct vector *) where;
1451 length = fixnum_value(vector->length);
1452 nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1458 trans_vector_complex_long_float(lispobj object)
1460 struct vector *vector;
1461 long length, nwords;
1463 gc_assert(is_lisp_pointer(object));
1465 vector = (struct vector *) native_pointer(object);
1466 length = fixnum_value(vector->length);
1467 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1469 return copy_large_unboxed_object(object, nwords);
1473 size_vector_complex_long_float(lispobj *where)
1475 struct vector *vector;
1476 long length, nwords;
1478 vector = (struct vector *) where;
1479 length = fixnum_value(vector->length);
1480 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1486 #define WEAK_POINTER_NWORDS \
1487 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1490 trans_weak_pointer(lispobj object)
1493 #ifndef LISP_FEATURE_GENCGC
1494 struct weak_pointer *wp;
1496 gc_assert(is_lisp_pointer(object));
1498 #if defined(DEBUG_WEAK)
1499 printf("Transporting weak pointer from 0x%08x\n", object);
1502 /* Need to remember where all the weak pointers are that have */
1503 /* been transported so they can be fixed up in a post-GC pass. */
1505 copy = copy_object(object, WEAK_POINTER_NWORDS);
1506 #ifndef LISP_FEATURE_GENCGC
1507 wp = (struct weak_pointer *) native_pointer(copy);
1509 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1510 /* Push the weak pointer onto the list of weak pointers. */
1511 wp->next = (struct weak_pointer *)LOW_WORD(weak_pointers);
1518 size_weak_pointer(lispobj *where)
1520 return WEAK_POINTER_NWORDS;
1524 void scan_weak_pointers(void)
1526 struct weak_pointer *wp, *next_wp;
1527 for (wp = weak_pointers, next_wp = NULL; wp != NULL; wp = next_wp) {
1528 lispobj value = wp->value;
1529 lispobj *first_pointer;
1530 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1534 if (next_wp == wp) /* gencgc uses a ref to self for end of list */
1537 if (!(is_lisp_pointer(value) && from_space_p(value)))
1540 /* Now, we need to check whether the object has been forwarded. If
1541 * it has been, the weak pointer is still good and needs to be
1542 * updated. Otherwise, the weak pointer needs to be nil'ed
1545 first_pointer = (lispobj *)native_pointer(value);
1547 if (forwarding_pointer_p(first_pointer)) {
1549 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1561 #if N_WORD_BITS == 32
1562 #define EQ_HASH_MASK 0x1fffffff
1563 #elif N_WORD_BITS == 64
1564 #define EQ_HASH_MASK 0x1fffffffffffffff
1567 /* Compute the EQ-hash of KEY. This must match POINTER-HASH in
1568 * target-hash-table.lisp. */
1569 #define EQ_HASH(key) ((key) & EQ_HASH_MASK)
1571 /* List of weak hash tables chained through their NEXT-WEAK-HASH-TABLE
1572 * slot. Set to NULL at the end of a collection.
1574 * This is not optimal because, when a table is tenured, it won't be
1575 * processed automatically; only the yougest generation is GC'd by
1576 * default. On the other hand, all applications will need an
1577 * occasional full GC anyway, so it's not that bad either. */
1578 struct hash_table *weak_hash_tables = NULL;
1580 /* Return true if OBJ has already survived the current GC. */
1582 survived_gc_yet (lispobj obj)
1584 return (!is_lisp_pointer(obj) || !from_space_p(obj) ||
1585 forwarding_pointer_p(native_pointer(obj)));
1589 weak_hash_entry_alivep (lispobj weakness, lispobj key, lispobj value)
1593 return survived_gc_yet(key);
1595 return survived_gc_yet(value);
1597 return (survived_gc_yet(key) || survived_gc_yet(value));
1599 return (survived_gc_yet(key) && survived_gc_yet(value));
1602 /* Shut compiler up. */
1607 /* Return the beginning of data in ARRAY (skipping the header and the
1608 * length) or NULL if it isn't an array of the specified widetag after
1610 static inline lispobj *
1611 get_array_data (lispobj array, int widetag, unsigned long *length)
1613 if (is_lisp_pointer(array) &&
1614 (widetag_of(*(lispobj *)native_pointer(array)) == widetag)) {
1616 *length = fixnum_value(((lispobj *)native_pointer(array))[1]);
1617 return ((lispobj *)native_pointer(array)) + 2;
1623 /* Only need to worry about scavenging the _real_ entries in the
1624 * table. Phantom entries such as the hash table itself at index 0 and
1625 * the empty marker at index 1 were scavenged by scav_vector that
1626 * either called this function directly or arranged for it to be
1627 * called later by pushing the hash table onto weak_hash_tables. */
1629 scav_hash_table_entries (struct hash_table *hash_table)
1632 unsigned long kv_length;
1633 lispobj *index_vector;
1634 unsigned long length;
1635 lispobj *next_vector;
1636 unsigned long next_vector_length;
1637 lispobj *hash_vector;
1638 unsigned long hash_vector_length;
1639 lispobj empty_symbol;
1640 lispobj weakness = hash_table->weakness;
1643 kv_vector = get_array_data(hash_table->table,
1644 SIMPLE_VECTOR_WIDETAG, &kv_length);
1645 if (kv_vector == NULL)
1646 lose("invalid kv_vector %x\n", hash_table->table);
1648 index_vector = get_array_data(hash_table->index_vector,
1649 SIMPLE_ARRAY_WORD_WIDETAG, &length);
1650 if (index_vector == NULL)
1651 lose("invalid index_vector %x\n", hash_table->index_vector);
1653 next_vector = get_array_data(hash_table->next_vector,
1654 SIMPLE_ARRAY_WORD_WIDETAG,
1655 &next_vector_length);
1656 if (next_vector == NULL)
1657 lose("invalid next_vector %x\n", hash_table->next_vector);
1659 hash_vector = get_array_data(hash_table->hash_vector,
1660 SIMPLE_ARRAY_WORD_WIDETAG,
1661 &hash_vector_length);
1662 if (hash_vector != NULL)
1663 gc_assert(hash_vector_length == next_vector_length);
1665 /* These lengths could be different as the index_vector can be a
1666 * different length from the others, a larger index_vector could
1667 * help reduce collisions. */
1668 gc_assert(next_vector_length*2 == kv_length);
1670 empty_symbol = kv_vector[1];
1671 /* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/
1672 if (widetag_of(*(lispobj *)native_pointer(empty_symbol)) !=
1673 SYMBOL_HEADER_WIDETAG) {
1674 lose("not a symbol where empty-hash-table-slot symbol expected: %x\n",
1675 *(lispobj *)native_pointer(empty_symbol));
1678 /* Work through the KV vector. */
1679 for (i = 1; i < next_vector_length; i++) {
1680 lispobj old_key = kv_vector[2*i];
1681 lispobj value = kv_vector[2*i+1];
1682 if ((weakness == NIL) ||
1683 weak_hash_entry_alivep(weakness, old_key, value)) {
1685 /* Scavenge the key and value. */
1686 scavenge(&kv_vector[2*i],2);
1688 /* Rehashing of EQ based keys. */
1689 if ((!hash_vector) ||
1690 (hash_vector[i] == MAGIC_HASH_VECTOR_VALUE)) {
1691 #ifndef LISP_FEATURE_GENCGC
1692 /* For GENCGC scav_hash_table_entries only rehashes
1693 * the entries whose keys were moved. Cheneygc always
1694 * moves the objects so here we let the lisp side know
1695 * that rehashing is needed for the whole table. */
1696 *(kv_vector - 2) = (subtype_VectorMustRehash<<N_WIDETAG_BITS) |
1697 SIMPLE_VECTOR_WIDETAG;
1699 unsigned long old_index = EQ_HASH(old_key)%length;
1700 lispobj new_key = kv_vector[2*i];
1701 unsigned long new_index = EQ_HASH(new_key)%length;
1702 /* Check whether the key has moved. */
1703 if ((old_index != new_index) &&
1704 (new_key != empty_symbol)) {
1705 gc_assert(kv_vector[2*i+1] != empty_symbol);
1708 "* EQ key %d moved from %x to %x; index %d to %d\n",
1709 i, old_key, new_key, old_index, new_index));*/
1711 /* Unlink the key from the old_index chain. */
1712 if (!index_vector[old_index]) {
1713 /* It's not here, must be on the
1714 * needing_rehash chain. */
1715 } else if (index_vector[old_index] == i) {
1716 /*FSHOW((stderr, "/P2a %d\n", next_vector[i]));*/
1717 index_vector[old_index] = next_vector[i];
1718 /* Link it into the needing rehash chain. */
1720 fixnum_value(hash_table->needing_rehash);
1721 hash_table->needing_rehash = make_fixnum(i);
1724 unsigned long prior = index_vector[old_index];
1725 unsigned long next = next_vector[prior];
1727 /*FSHOW((stderr, "/P3a %d %d\n", prior, next));*/
1730 /*FSHOW((stderr, "/P3b %d %d\n", prior, next));*/
1733 next_vector[prior] = next_vector[next];
1734 /* Link it into the needing rehash
1737 fixnum_value(hash_table->needing_rehash);
1738 hash_table->needing_rehash = make_fixnum(next);
1743 next = next_vector[next];
1754 scav_vector (lispobj *where, lispobj object)
1756 unsigned long kv_length;
1758 struct hash_table *hash_table;
1760 /* SB-VM:VECTOR-VALID-HASHING-SUBTYPE is set for EQ-based and weak
1761 * hash tables in the Lisp HASH-TABLE code to indicate need for
1762 * special GC support. */
1763 if (HeaderValue(object) == subtype_VectorNormal)
1766 kv_length = fixnum_value(where[1]);
1767 kv_vector = where + 2; /* Skip the header and length. */
1768 /*FSHOW((stderr,"/kv_length = %d\n", kv_length));*/
1770 /* Scavenge element 0, which may be a hash-table structure. */
1771 scavenge(where+2, 1);
1772 if (!is_lisp_pointer(where[2])) {
1773 lose("no pointer at %x in hash table\n", where[2]);
1775 hash_table = (struct hash_table *)native_pointer(where[2]);
1776 /*FSHOW((stderr,"/hash_table = %x\n", hash_table));*/
1777 if (widetag_of(hash_table->header) != INSTANCE_HEADER_WIDETAG) {
1778 lose("hash table not instance (%x at %x)\n",
1783 /* Scavenge element 1, which should be some internal symbol that
1784 * the hash table code reserves for marking empty slots. */
1785 scavenge(where+3, 1);
1786 if (!is_lisp_pointer(where[3])) {
1787 lose("not empty-hash-table-slot symbol pointer: %x\n", where[3]);
1790 /* Scavenge hash table, which will fix the positions of the other
1791 * needed objects. */
1792 scavenge((lispobj *)hash_table,
1793 sizeof(struct hash_table) / sizeof(lispobj));
1795 /* Cross-check the kv_vector. */
1796 if (where != (lispobj *)native_pointer(hash_table->table)) {
1797 lose("hash_table table!=this table %x\n", hash_table->table);
1800 if (hash_table->weakness == NIL) {
1801 scav_hash_table_entries(hash_table);
1803 /* Delay scavenging of this table by pushing it onto
1804 * weak_hash_tables (if it's not there already) for the weak
1806 if (hash_table->next_weak_hash_table == NIL) {
1807 hash_table->next_weak_hash_table = (lispobj)weak_hash_tables;
1808 weak_hash_tables = hash_table;
1812 return (CEILING(kv_length + 2, 2));
1816 scav_weak_hash_tables (void)
1818 struct hash_table *table;
1820 /* Scavenge entries whose triggers are known to survive. */
1821 for (table = weak_hash_tables; table != NULL;
1822 table = (struct hash_table *)table->next_weak_hash_table) {
1823 scav_hash_table_entries(table);
1827 /* Walk through the chain whose first element is *FIRST and remove
1828 * dead weak entries. */
1830 scan_weak_hash_table_chain (struct hash_table *hash_table, lispobj *prev,
1831 lispobj *kv_vector, lispobj *index_vector,
1832 lispobj *next_vector, lispobj *hash_vector,
1833 lispobj empty_symbol, lispobj weakness)
1835 unsigned index = *prev;
1837 unsigned next = next_vector[index];
1838 lispobj key = kv_vector[2 * index];
1839 lispobj value = kv_vector[2 * index + 1];
1840 gc_assert(key != empty_symbol);
1841 gc_assert(value != empty_symbol);
1842 if (!weak_hash_entry_alivep(weakness, key, value)) {
1843 unsigned count = fixnum_value(hash_table->number_entries);
1844 gc_assert(count > 0);
1846 hash_table->number_entries = make_fixnum(count - 1);
1847 next_vector[index] = fixnum_value(hash_table->next_free_kv);
1848 hash_table->next_free_kv = make_fixnum(index);
1849 kv_vector[2 * index] = empty_symbol;
1850 kv_vector[2 * index + 1] = empty_symbol;
1852 hash_vector[index] = MAGIC_HASH_VECTOR_VALUE;
1854 prev = &next_vector[index];
1861 scan_weak_hash_table (struct hash_table *hash_table)
1864 lispobj *index_vector;
1865 unsigned long length = 0; /* prevent warning */
1866 lispobj *next_vector;
1867 unsigned long next_vector_length = 0; /* prevent warning */
1868 lispobj *hash_vector;
1869 lispobj empty_symbol;
1870 lispobj weakness = hash_table->weakness;
1873 kv_vector = get_array_data(hash_table->table,
1874 SIMPLE_VECTOR_WIDETAG, NULL);
1875 index_vector = get_array_data(hash_table->index_vector,
1876 SIMPLE_ARRAY_WORD_WIDETAG, &length);
1877 next_vector = get_array_data(hash_table->next_vector,
1878 SIMPLE_ARRAY_WORD_WIDETAG,
1879 &next_vector_length);
1880 hash_vector = get_array_data(hash_table->hash_vector,
1881 SIMPLE_ARRAY_WORD_WIDETAG, NULL);
1882 empty_symbol = kv_vector[1];
1884 for (i = 0; i < length; i++) {
1885 scan_weak_hash_table_chain(hash_table, &index_vector[i],
1886 kv_vector, index_vector, next_vector,
1887 hash_vector, empty_symbol, weakness);
1890 lispobj first = fixnum_value(hash_table->needing_rehash);
1891 scan_weak_hash_table_chain(hash_table, &first,
1892 kv_vector, index_vector, next_vector,
1893 hash_vector, empty_symbol, weakness);
1894 hash_table->needing_rehash = make_fixnum(first);
1898 /* Remove dead entries from weak hash tables. */
1900 scan_weak_hash_tables (void)
1902 struct hash_table *table, *next;
1904 for (table = weak_hash_tables; table != NULL; table = next) {
1905 next = (struct hash_table *)table->next_weak_hash_table;
1906 table->next_weak_hash_table = NIL;
1907 scan_weak_hash_table(table);
1910 weak_hash_tables = NULL;
1919 scav_lose(lispobj *where, lispobj object)
1921 lose("no scavenge function for object 0x%08x (widetag 0x%x)\n",
1922 (unsigned long)object,
1923 widetag_of(*(lispobj*)native_pointer(object)));
1925 return 0; /* bogus return value to satisfy static type checking */
1929 trans_lose(lispobj object)
1931 lose("no transport function for object 0x%08x (widetag 0x%x)\n",
1932 (unsigned long)object,
1933 widetag_of(*(lispobj*)native_pointer(object)));
1934 return NIL; /* bogus return value to satisfy static type checking */
1938 size_lose(lispobj *where)
1940 lose("no size function for object at 0x%08x (widetag 0x%x)\n",
1941 (unsigned long)where,
1942 widetag_of(LOW_WORD(where)));
1943 return 1; /* bogus return value to satisfy static type checking */
1952 gc_init_tables(void)
1956 /* Set default value in all slots of scavenge table. FIXME
1957 * replace this gnarly sizeof with something based on
1959 for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) {
1960 scavtab[i] = scav_lose;
1963 /* For each type which can be selected by the lowtag alone, set
1964 * multiple entries in our widetag scavenge table (one for each
1965 * possible value of the high bits).
1968 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1969 scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1970 scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1971 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1972 scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1973 scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1974 scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_instance_pointer;
1975 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1976 scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1979 /* Other-pointer types (those selected by all eight bits of the
1980 * tag) get one entry each in the scavenge table. */
1981 scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1982 scavtab[RATIO_WIDETAG] = scav_boxed;
1983 #if N_WORD_BITS == 64
1984 scavtab[SINGLE_FLOAT_WIDETAG] = scav_immediate;
1986 scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1988 scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1989 #ifdef LONG_FLOAT_WIDETAG
1990 scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1992 scavtab[COMPLEX_WIDETAG] = scav_boxed;
1993 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1994 scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1996 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1997 scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1999 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
2000 scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
2002 scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
2003 scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
2004 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
2005 scavtab[SIMPLE_CHARACTER_STRING_WIDETAG] = scav_character_string;
2007 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
2008 scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
2009 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
2010 scav_vector_unsigned_byte_2;
2011 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
2012 scav_vector_unsigned_byte_4;
2013 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
2014 scav_vector_unsigned_byte_8;
2015 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
2016 scav_vector_unsigned_byte_8;
2017 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
2018 scav_vector_unsigned_byte_16;
2019 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
2020 scav_vector_unsigned_byte_16;
2021 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
2022 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
2023 scav_vector_unsigned_byte_32;
2025 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
2026 scav_vector_unsigned_byte_32;
2027 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
2028 scav_vector_unsigned_byte_32;
2029 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
2030 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
2031 scav_vector_unsigned_byte_64;
2033 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
2034 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
2035 scav_vector_unsigned_byte_64;
2037 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
2038 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
2039 scav_vector_unsigned_byte_64;
2041 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
2042 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
2044 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
2045 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
2046 scav_vector_unsigned_byte_16;
2048 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
2049 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
2050 scav_vector_unsigned_byte_32;
2052 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2053 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
2054 scav_vector_unsigned_byte_32;
2056 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
2057 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
2058 scav_vector_unsigned_byte_64;
2060 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
2061 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
2062 scav_vector_unsigned_byte_64;
2064 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
2065 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
2066 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2067 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
2069 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2070 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
2071 scav_vector_complex_single_float;
2073 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2074 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
2075 scav_vector_complex_double_float;
2077 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2078 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
2079 scav_vector_complex_long_float;
2081 scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
2082 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
2083 scavtab[COMPLEX_CHARACTER_STRING_WIDETAG] = scav_boxed;
2085 scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
2086 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
2087 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
2088 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
2089 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
2090 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
2091 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
2092 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
2094 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
2095 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
2096 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
2098 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
2100 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
2101 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
2102 scavtab[CHARACTER_WIDETAG] = scav_immediate;
2103 scavtab[SAP_WIDETAG] = scav_unboxed;
2104 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
2105 scavtab[NO_TLS_VALUE_MARKER_WIDETAG] = scav_immediate;
2106 scavtab[INSTANCE_HEADER_WIDETAG] = scav_instance;
2107 #if defined(LISP_FEATURE_SPARC)
2108 scavtab[FDEFN_WIDETAG] = scav_boxed;
2110 scavtab[FDEFN_WIDETAG] = scav_fdefn;
2112 scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector;
2114 /* transport other table, initialized same way as scavtab */
2115 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
2116 transother[i] = trans_lose;
2117 transother[BIGNUM_WIDETAG] = trans_unboxed;
2118 transother[RATIO_WIDETAG] = trans_boxed;
2120 #if N_WORD_BITS == 64
2121 transother[SINGLE_FLOAT_WIDETAG] = trans_immediate;
2123 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
2125 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
2126 #ifdef LONG_FLOAT_WIDETAG
2127 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
2129 transother[COMPLEX_WIDETAG] = trans_boxed;
2130 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
2131 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
2133 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
2134 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
2136 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
2137 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
2139 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
2140 transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
2141 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
2142 transother[SIMPLE_CHARACTER_STRING_WIDETAG] = trans_character_string;
2144 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
2145 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
2146 transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
2147 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
2148 trans_vector_unsigned_byte_2;
2149 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
2150 trans_vector_unsigned_byte_4;
2151 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
2152 trans_vector_unsigned_byte_8;
2153 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
2154 trans_vector_unsigned_byte_8;
2155 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
2156 trans_vector_unsigned_byte_16;
2157 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
2158 trans_vector_unsigned_byte_16;
2159 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
2160 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
2161 trans_vector_unsigned_byte_32;
2163 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
2164 trans_vector_unsigned_byte_32;
2165 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
2166 trans_vector_unsigned_byte_32;
2167 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
2168 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
2169 trans_vector_unsigned_byte_64;
2171 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
2172 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
2173 trans_vector_unsigned_byte_64;
2175 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
2176 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
2177 trans_vector_unsigned_byte_64;
2179 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
2180 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
2181 trans_vector_unsigned_byte_8;
2183 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
2184 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
2185 trans_vector_unsigned_byte_16;
2187 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
2188 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
2189 trans_vector_unsigned_byte_32;
2191 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2192 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
2193 trans_vector_unsigned_byte_32;
2195 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
2196 transother[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
2197 trans_vector_unsigned_byte_64;
2199 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
2200 transother[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
2201 trans_vector_unsigned_byte_64;
2203 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
2204 trans_vector_single_float;
2205 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
2206 trans_vector_double_float;
2207 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2208 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
2209 trans_vector_long_float;
2211 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2212 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
2213 trans_vector_complex_single_float;
2215 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2216 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
2217 trans_vector_complex_double_float;
2219 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2220 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
2221 trans_vector_complex_long_float;
2223 transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
2224 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
2225 transother[COMPLEX_CHARACTER_STRING_WIDETAG] = trans_boxed;
2227 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
2228 transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
2229 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
2230 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
2231 transother[CODE_HEADER_WIDETAG] = trans_code_header;
2232 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
2233 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
2234 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
2235 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
2236 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
2237 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
2238 transother[CHARACTER_WIDETAG] = trans_immediate;
2239 transother[SAP_WIDETAG] = trans_unboxed;
2240 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
2241 transother[NO_TLS_VALUE_MARKER_WIDETAG] = trans_immediate;
2242 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
2243 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
2244 transother[FDEFN_WIDETAG] = trans_boxed;
2246 /* size table, initialized the same way as scavtab */
2247 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
2248 sizetab[i] = size_lose;
2249 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
2250 sizetab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
2251 sizetab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2252 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
2253 sizetab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2254 sizetab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
2255 sizetab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2256 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
2257 sizetab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2259 sizetab[BIGNUM_WIDETAG] = size_unboxed;
2260 sizetab[RATIO_WIDETAG] = size_boxed;
2261 #if N_WORD_BITS == 64
2262 sizetab[SINGLE_FLOAT_WIDETAG] = size_immediate;
2264 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
2266 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
2267 #ifdef LONG_FLOAT_WIDETAG
2268 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
2270 sizetab[COMPLEX_WIDETAG] = size_boxed;
2271 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
2272 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
2274 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
2275 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
2277 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
2278 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
2280 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
2281 sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
2282 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
2283 sizetab[SIMPLE_CHARACTER_STRING_WIDETAG] = size_character_string;
2285 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
2286 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
2287 sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
2288 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
2289 size_vector_unsigned_byte_2;
2290 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
2291 size_vector_unsigned_byte_4;
2292 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
2293 size_vector_unsigned_byte_8;
2294 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
2295 size_vector_unsigned_byte_8;
2296 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
2297 size_vector_unsigned_byte_16;
2298 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
2299 size_vector_unsigned_byte_16;
2300 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
2301 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
2302 size_vector_unsigned_byte_32;
2304 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
2305 size_vector_unsigned_byte_32;
2306 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
2307 size_vector_unsigned_byte_32;
2308 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
2309 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
2310 size_vector_unsigned_byte_64;
2312 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
2313 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
2314 size_vector_unsigned_byte_64;
2316 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
2317 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
2318 size_vector_unsigned_byte_64;
2320 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
2321 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
2323 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
2324 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
2325 size_vector_unsigned_byte_16;
2327 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
2328 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
2329 size_vector_unsigned_byte_32;
2331 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2332 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
2333 size_vector_unsigned_byte_32;
2335 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
2336 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
2337 size_vector_unsigned_byte_64;
2339 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
2340 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
2341 size_vector_unsigned_byte_64;
2343 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
2344 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
2345 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2346 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
2348 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2349 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
2350 size_vector_complex_single_float;
2352 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2353 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
2354 size_vector_complex_double_float;
2356 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2357 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
2358 size_vector_complex_long_float;
2360 sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
2361 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
2362 sizetab[COMPLEX_CHARACTER_STRING_WIDETAG] = size_boxed;
2364 sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
2365 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
2366 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
2367 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
2368 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
2370 /* We shouldn't see these, so just lose if it happens. */
2371 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
2372 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
2374 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
2375 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
2376 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
2377 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
2378 sizetab[CHARACTER_WIDETAG] = size_immediate;
2379 sizetab[SAP_WIDETAG] = size_unboxed;
2380 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
2381 sizetab[NO_TLS_VALUE_MARKER_WIDETAG] = size_immediate;
2382 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
2383 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
2384 sizetab[FDEFN_WIDETAG] = size_boxed;
2388 /* Find the code object for the given pc, or return NULL on
2391 component_ptr_from_pc(lispobj *pc)
2393 lispobj *object = NULL;
2395 if ( (object = search_read_only_space(pc)) )
2397 else if ( (object = search_static_space(pc)) )
2400 object = search_dynamic_space(pc);
2402 if (object) /* if we found something */
2403 if (widetag_of(*object) == CODE_HEADER_WIDETAG)
2409 /* Scan an area looking for an object which encloses the given pointer.
2410 * Return the object start on success or NULL on failure. */
2412 gc_search_space(lispobj *start, size_t words, lispobj *pointer)
2416 lispobj thing = *start;
2418 /* If thing is an immediate then this is a cons. */
2419 if (is_lisp_pointer(thing)
2421 || (widetag_of(thing) == CHARACTER_WIDETAG)
2422 #if N_WORD_BITS == 64
2423 || (widetag_of(thing) == SINGLE_FLOAT_WIDETAG)
2425 || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG))
2428 count = (sizetab[widetag_of(thing)])(start);
2430 /* Check whether the pointer is within this object. */
2431 if ((pointer >= start) && (pointer < (start+count))) {
2433 /*FSHOW((stderr,"/found %x in %x %x\n", pointer, start, thing));*/
2437 /* Round up the count. */
2438 count = CEILING(count,2);
2447 maybe_gc(os_context_t *context)
2449 #ifndef LISP_FEATURE_WIN32
2450 struct thread *thread = arch_os_get_current_thread();
2453 fake_foreign_function_call(context);
2454 /* SUB-GC may return without GCing if *GC-INHIBIT* is set, in
2455 * which case we will be running with no gc trigger barrier
2456 * thing for a while. But it shouldn't be long until the end
2459 * FIXME: It would be good to protect the end of dynamic space for
2460 * CheneyGC and signal a storage condition from there.
2463 /* Restore the signal mask from the interrupted context before
2464 * calling into Lisp if interrupts are enabled. Why not always?
2466 * Suppose there is a WITHOUT-INTERRUPTS block far, far out. If an
2467 * interrupt hits while in SUB-GC, it is deferred and the
2468 * os_context_sigmask of that interrupt is set to block further
2469 * deferrable interrupts (until the first one is
2470 * handled). Unfortunately, that context refers to this place and
2471 * when we return from here the signals will not be blocked.
2473 * A kludgy alternative is to propagate the sigmask change to the
2476 #ifndef LISP_FEATURE_WIN32
2477 if(SymbolValue(INTERRUPTS_ENABLED,thread)!=NIL) {
2478 sigset_t *context_sigmask = os_context_sigmask_addr(context);
2479 #ifdef LISP_FEATURE_SB_THREAD
2480 /* What if the context we'd like to restore has GC signals
2481 * blocked? Just skip the GC: we can't set GC_PENDING, because
2482 * that would block the next attempt, and we don't know when
2483 * we'd next check for it -- and it's hard to be sure that
2484 * unblocking would be safe.
2486 * FIXME: This is not actually much better: we may already have
2487 * GC_PENDING set, and presumably our caller assumes that we will
2488 * clear it. Perhaps we should, even though we don't actually GC? */
2489 if (sigismember(context_sigmask,SIG_STOP_FOR_GC)) {
2490 undo_fake_foreign_function_call(context);
2494 thread_sigmask(SIG_SETMASK, context_sigmask, 0);
2497 unblock_gc_signals();
2499 /* SIG_STOP_FOR_GC needs to be enabled before we can call lisp:
2500 * otherwise two threads racing here may deadlock: the other will
2501 * wait on the GC lock, and the other cannot stop the first one... */
2502 funcall0(SymbolFunction(SUB_GC));
2503 undo_fake_foreign_function_call(context);