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), "Entry point %lx\n",
364 function_ptr = (struct simple_fun *) native_pointer(entry_point);
365 gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
367 scavenge(&function_ptr->name, 1);
368 scavenge(&function_ptr->arglist, 1);
369 scavenge(&function_ptr->type, 1);
376 trans_code_header(lispobj object)
380 ncode = trans_code((struct code *) native_pointer(object));
381 return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG;
386 size_code_header(lispobj *where)
389 long nheader_words, ncode_words, nwords;
391 code = (struct code *) where;
393 ncode_words = fixnum_value(code->code_size);
394 nheader_words = HeaderValue(code->header);
395 nwords = ncode_words + nheader_words;
396 nwords = CEILING(nwords, 2);
401 #if !defined(LISP_FEATURE_X86) && ! defined(LISP_FEATURE_X86_64)
403 scav_return_pc_header(lispobj *where, lispobj object)
405 lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x\n",
406 (unsigned long) where,
407 (unsigned long) object);
408 return 0; /* bogus return value to satisfy static type checking */
410 #endif /* LISP_FEATURE_X86 */
413 trans_return_pc_header(lispobj object)
415 struct simple_fun *return_pc;
416 unsigned long offset;
417 struct code *code, *ncode;
419 return_pc = (struct simple_fun *) native_pointer(object);
420 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
421 offset = HeaderValue(return_pc->header) * N_WORD_BYTES;
423 /* Transport the whole code object */
424 code = (struct code *) ((unsigned long) return_pc - offset);
425 ncode = trans_code(code);
427 return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
430 /* On the 386, closures hold a pointer to the raw address instead of the
431 * function object, so we can use CALL [$FDEFN+const] to invoke
432 * the function without loading it into a register. Given that code
433 * objects don't move, we don't need to update anything, but we do
434 * have to figure out that the function is still live. */
436 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
438 scav_closure_header(lispobj *where, lispobj object)
440 struct closure *closure;
443 closure = (struct closure *)where;
444 fun = closure->fun - FUN_RAW_ADDR_OFFSET;
446 #ifdef LISP_FEATURE_GENCGC
447 /* The function may have moved so update the raw address. But
448 * don't write unnecessarily. */
449 if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
450 closure->fun = fun + FUN_RAW_ADDR_OFFSET;
456 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
458 scav_fun_header(lispobj *where, lispobj object)
460 lose("attempted to scavenge a function header where=0x%08x object=0x%08x\n",
461 (unsigned long) where,
462 (unsigned long) object);
463 return 0; /* bogus return value to satisfy static type checking */
465 #endif /* LISP_FEATURE_X86 */
468 trans_fun_header(lispobj object)
470 struct simple_fun *fheader;
471 unsigned long offset;
472 struct code *code, *ncode;
474 fheader = (struct simple_fun *) native_pointer(object);
475 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
476 offset = HeaderValue(fheader->header) * N_WORD_BYTES;
478 /* Transport the whole code object */
479 code = (struct code *) ((unsigned long) fheader - offset);
480 ncode = trans_code(code);
482 return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
491 scav_instance_pointer(lispobj *where, lispobj object)
493 lispobj copy, *first_pointer;
495 /* Object is a pointer into from space - not a FP. */
496 copy = trans_boxed(object);
498 #ifdef LISP_FEATURE_GENCGC
499 gc_assert(copy != object);
502 first_pointer = (lispobj *) native_pointer(object);
503 set_forwarding_pointer(first_pointer,copy);
514 static lispobj trans_list(lispobj object);
517 scav_list_pointer(lispobj *where, lispobj object)
519 lispobj first, *first_pointer;
521 gc_assert(is_lisp_pointer(object));
523 /* Object is a pointer into from space - not FP. */
524 first_pointer = (lispobj *) native_pointer(object);
526 first = trans_list(object);
527 gc_assert(first != object);
529 /* Set forwarding pointer */
530 set_forwarding_pointer(first_pointer, first);
532 gc_assert(is_lisp_pointer(first));
533 gc_assert(!from_space_p(first));
541 trans_list(lispobj object)
543 lispobj new_list_pointer;
544 struct cons *cons, *new_cons;
547 cons = (struct cons *) native_pointer(object);
550 new_cons = (struct cons *)
551 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
552 new_cons->car = cons->car;
553 new_cons->cdr = cons->cdr; /* updated later */
554 new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
556 /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC */
559 set_forwarding_pointer((lispobj *)cons, new_list_pointer);
561 /* Try to linearize the list in the cdr direction to help reduce
565 struct cons *cdr_cons, *new_cdr_cons;
567 if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
568 !from_space_p(cdr) ||
569 forwarding_pointer_p((lispobj *)native_pointer(cdr)))
572 cdr_cons = (struct cons *) native_pointer(cdr);
575 new_cdr_cons = (struct cons*)
576 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
577 new_cdr_cons->car = cdr_cons->car;
578 new_cdr_cons->cdr = cdr_cons->cdr;
579 new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
581 /* Grab the cdr before it is clobbered. */
583 set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
585 /* Update the cdr of the last cons copied into new space to
586 * keep the newspace scavenge from having to do it. */
587 new_cons->cdr = new_cdr;
589 new_cons = new_cdr_cons;
592 return new_list_pointer;
597 * scavenging and transporting other pointers
601 scav_other_pointer(lispobj *where, lispobj object)
603 lispobj first, *first_pointer;
605 gc_assert(is_lisp_pointer(object));
607 /* Object is a pointer into from space - not FP. */
608 first_pointer = (lispobj *) native_pointer(object);
609 first = (transother[widetag_of(*first_pointer)])(object);
611 if (first != object) {
612 set_forwarding_pointer(first_pointer, first);
613 #ifdef LISP_FEATURE_GENCGC
617 #ifndef LISP_FEATURE_GENCGC
620 gc_assert(is_lisp_pointer(first));
621 gc_assert(!from_space_p(first));
627 * immediate, boxed, and unboxed objects
631 size_pointer(lispobj *where)
637 scav_immediate(lispobj *where, lispobj object)
643 trans_immediate(lispobj object)
645 lose("trying to transport an immediate\n");
646 return NIL; /* bogus return value to satisfy static type checking */
650 size_immediate(lispobj *where)
657 scav_boxed(lispobj *where, lispobj object)
663 scav_instance(lispobj *where, lispobj object)
666 long ntotal = HeaderValue(object);
667 lispobj layout = ((struct instance *)where)->slots[0];
671 if (forwarding_pointer_p(native_pointer(layout)))
672 layout = (lispobj) forwarding_pointer_value(native_pointer(layout));
674 nuntagged = ((struct layout *)native_pointer(layout))->n_untagged_slots;
675 scavenge(where + 1, ntotal - fixnum_value(nuntagged));
681 trans_boxed(lispobj object)
684 unsigned long length;
686 gc_assert(is_lisp_pointer(object));
688 header = *((lispobj *) native_pointer(object));
689 length = HeaderValue(header) + 1;
690 length = CEILING(length, 2);
692 return copy_object(object, length);
697 size_boxed(lispobj *where)
700 unsigned long length;
703 length = HeaderValue(header) + 1;
704 length = CEILING(length, 2);
709 /* Note: on the sparc we don't have to do anything special for fdefns, */
710 /* 'cause the raw-addr has a function lowtag. */
711 #if !defined(LISP_FEATURE_SPARC)
713 scav_fdefn(lispobj *where, lispobj object)
717 fdefn = (struct fdefn *)where;
719 /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
720 fdefn->fun, fdefn->raw_addr)); */
722 if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)
723 == (char *)((unsigned long)(fdefn->raw_addr))) {
724 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
726 /* Don't write unnecessarily. */
727 if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
728 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
729 /* gc.c has more casts here, which may be relevant or alternatively
730 may be compiler warning defeaters. try
731 fdefn->raw_addr = ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
733 return sizeof(struct fdefn) / sizeof(lispobj);
741 scav_unboxed(lispobj *where, lispobj object)
743 unsigned long length;
745 length = HeaderValue(object) + 1;
746 length = CEILING(length, 2);
752 trans_unboxed(lispobj object)
755 unsigned long length;
758 gc_assert(is_lisp_pointer(object));
760 header = *((lispobj *) native_pointer(object));
761 length = HeaderValue(header) + 1;
762 length = CEILING(length, 2);
764 return copy_unboxed_object(object, length);
768 size_unboxed(lispobj *where)
771 unsigned long length;
774 length = HeaderValue(header) + 1;
775 length = CEILING(length, 2);
781 /* vector-like objects */
783 scav_base_string(lispobj *where, lispobj object)
785 struct vector *vector;
788 /* NOTE: Strings contain one more byte of data than the length */
789 /* slot indicates. */
791 vector = (struct vector *) where;
792 length = fixnum_value(vector->length) + 1;
793 nwords = CEILING(NWORDS(length, 8) + 2, 2);
798 trans_base_string(lispobj object)
800 struct vector *vector;
803 gc_assert(is_lisp_pointer(object));
805 /* NOTE: A string contains one more byte of data (a terminating
806 * '\0' to help when interfacing with C functions) than indicated
807 * by the length slot. */
809 vector = (struct vector *) native_pointer(object);
810 length = fixnum_value(vector->length) + 1;
811 nwords = CEILING(NWORDS(length, 8) + 2, 2);
813 return copy_large_unboxed_object(object, nwords);
817 size_base_string(lispobj *where)
819 struct vector *vector;
822 /* NOTE: A string contains one more byte of data (a terminating
823 * '\0' to help when interfacing with C functions) than indicated
824 * by the length slot. */
826 vector = (struct vector *) where;
827 length = fixnum_value(vector->length) + 1;
828 nwords = CEILING(NWORDS(length, 8) + 2, 2);
834 scav_character_string(lispobj *where, lispobj object)
836 struct vector *vector;
839 /* NOTE: Strings contain one more byte of data than the length */
840 /* slot indicates. */
842 vector = (struct vector *) where;
843 length = fixnum_value(vector->length) + 1;
844 nwords = CEILING(NWORDS(length, 32) + 2, 2);
849 trans_character_string(lispobj object)
851 struct vector *vector;
854 gc_assert(is_lisp_pointer(object));
856 /* NOTE: A string contains one more byte of data (a terminating
857 * '\0' to help when interfacing with C functions) than indicated
858 * by the length slot. */
860 vector = (struct vector *) native_pointer(object);
861 length = fixnum_value(vector->length) + 1;
862 nwords = CEILING(NWORDS(length, 32) + 2, 2);
864 return copy_large_unboxed_object(object, nwords);
868 size_character_string(lispobj *where)
870 struct vector *vector;
873 /* NOTE: A string contains one more byte of data (a terminating
874 * '\0' to help when interfacing with C functions) than indicated
875 * by the length slot. */
877 vector = (struct vector *) where;
878 length = fixnum_value(vector->length) + 1;
879 nwords = CEILING(NWORDS(length, 32) + 2, 2);
885 trans_vector(lispobj object)
887 struct vector *vector;
890 gc_assert(is_lisp_pointer(object));
892 vector = (struct vector *) native_pointer(object);
894 length = fixnum_value(vector->length);
895 nwords = CEILING(length + 2, 2);
897 return copy_large_object(object, nwords);
901 size_vector(lispobj *where)
903 struct vector *vector;
906 vector = (struct vector *) where;
907 length = fixnum_value(vector->length);
908 nwords = CEILING(length + 2, 2);
914 scav_vector_nil(lispobj *where, lispobj object)
920 trans_vector_nil(lispobj object)
922 gc_assert(is_lisp_pointer(object));
923 return copy_unboxed_object(object, 2);
927 size_vector_nil(lispobj *where)
929 /* Just the header word and the length word */
934 scav_vector_bit(lispobj *where, lispobj object)
936 struct vector *vector;
939 vector = (struct vector *) where;
940 length = fixnum_value(vector->length);
941 nwords = CEILING(NWORDS(length, 1) + 2, 2);
947 trans_vector_bit(lispobj object)
949 struct vector *vector;
952 gc_assert(is_lisp_pointer(object));
954 vector = (struct vector *) native_pointer(object);
955 length = fixnum_value(vector->length);
956 nwords = CEILING(NWORDS(length, 1) + 2, 2);
958 return copy_large_unboxed_object(object, nwords);
962 size_vector_bit(lispobj *where)
964 struct vector *vector;
967 vector = (struct vector *) where;
968 length = fixnum_value(vector->length);
969 nwords = CEILING(NWORDS(length, 1) + 2, 2);
975 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
977 struct vector *vector;
980 vector = (struct vector *) where;
981 length = fixnum_value(vector->length);
982 nwords = CEILING(NWORDS(length, 2) + 2, 2);
988 trans_vector_unsigned_byte_2(lispobj object)
990 struct vector *vector;
993 gc_assert(is_lisp_pointer(object));
995 vector = (struct vector *) native_pointer(object);
996 length = fixnum_value(vector->length);
997 nwords = CEILING(NWORDS(length, 2) + 2, 2);
999 return copy_large_unboxed_object(object, nwords);
1003 size_vector_unsigned_byte_2(lispobj *where)
1005 struct vector *vector;
1006 long length, nwords;
1008 vector = (struct vector *) where;
1009 length = fixnum_value(vector->length);
1010 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1016 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
1018 struct vector *vector;
1019 long length, nwords;
1021 vector = (struct vector *) where;
1022 length = fixnum_value(vector->length);
1023 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1029 trans_vector_unsigned_byte_4(lispobj object)
1031 struct vector *vector;
1032 long length, nwords;
1034 gc_assert(is_lisp_pointer(object));
1036 vector = (struct vector *) native_pointer(object);
1037 length = fixnum_value(vector->length);
1038 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1040 return copy_large_unboxed_object(object, nwords);
1043 size_vector_unsigned_byte_4(lispobj *where)
1045 struct vector *vector;
1046 long length, nwords;
1048 vector = (struct vector *) where;
1049 length = fixnum_value(vector->length);
1050 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1057 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
1059 struct vector *vector;
1060 long length, nwords;
1062 vector = (struct vector *) where;
1063 length = fixnum_value(vector->length);
1064 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1069 /*********************/
1074 trans_vector_unsigned_byte_8(lispobj object)
1076 struct vector *vector;
1077 long length, nwords;
1079 gc_assert(is_lisp_pointer(object));
1081 vector = (struct vector *) native_pointer(object);
1082 length = fixnum_value(vector->length);
1083 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1085 return copy_large_unboxed_object(object, nwords);
1089 size_vector_unsigned_byte_8(lispobj *where)
1091 struct vector *vector;
1092 long length, nwords;
1094 vector = (struct vector *) where;
1095 length = fixnum_value(vector->length);
1096 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1103 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1105 struct vector *vector;
1106 long length, nwords;
1108 vector = (struct vector *) where;
1109 length = fixnum_value(vector->length);
1110 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1116 trans_vector_unsigned_byte_16(lispobj object)
1118 struct vector *vector;
1119 long length, nwords;
1121 gc_assert(is_lisp_pointer(object));
1123 vector = (struct vector *) native_pointer(object);
1124 length = fixnum_value(vector->length);
1125 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1127 return copy_large_unboxed_object(object, nwords);
1131 size_vector_unsigned_byte_16(lispobj *where)
1133 struct vector *vector;
1134 long length, nwords;
1136 vector = (struct vector *) where;
1137 length = fixnum_value(vector->length);
1138 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1144 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1146 struct vector *vector;
1147 long length, nwords;
1149 vector = (struct vector *) where;
1150 length = fixnum_value(vector->length);
1151 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1157 trans_vector_unsigned_byte_32(lispobj object)
1159 struct vector *vector;
1160 long length, nwords;
1162 gc_assert(is_lisp_pointer(object));
1164 vector = (struct vector *) native_pointer(object);
1165 length = fixnum_value(vector->length);
1166 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1168 return copy_large_unboxed_object(object, nwords);
1172 size_vector_unsigned_byte_32(lispobj *where)
1174 struct vector *vector;
1175 long length, nwords;
1177 vector = (struct vector *) where;
1178 length = fixnum_value(vector->length);
1179 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1184 #if N_WORD_BITS == 64
1186 scav_vector_unsigned_byte_64(lispobj *where, lispobj object)
1188 struct vector *vector;
1189 long length, nwords;
1191 vector = (struct vector *) where;
1192 length = fixnum_value(vector->length);
1193 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1199 trans_vector_unsigned_byte_64(lispobj object)
1201 struct vector *vector;
1202 long length, nwords;
1204 gc_assert(is_lisp_pointer(object));
1206 vector = (struct vector *) native_pointer(object);
1207 length = fixnum_value(vector->length);
1208 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1210 return copy_large_unboxed_object(object, nwords);
1214 size_vector_unsigned_byte_64(lispobj *where)
1216 struct vector *vector;
1217 long length, nwords;
1219 vector = (struct vector *) where;
1220 length = fixnum_value(vector->length);
1221 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1228 scav_vector_single_float(lispobj *where, lispobj object)
1230 struct vector *vector;
1231 long length, nwords;
1233 vector = (struct vector *) where;
1234 length = fixnum_value(vector->length);
1235 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1241 trans_vector_single_float(lispobj object)
1243 struct vector *vector;
1244 long length, nwords;
1246 gc_assert(is_lisp_pointer(object));
1248 vector = (struct vector *) native_pointer(object);
1249 length = fixnum_value(vector->length);
1250 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1252 return copy_large_unboxed_object(object, nwords);
1256 size_vector_single_float(lispobj *where)
1258 struct vector *vector;
1259 long length, nwords;
1261 vector = (struct vector *) where;
1262 length = fixnum_value(vector->length);
1263 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1269 scav_vector_double_float(lispobj *where, lispobj object)
1271 struct vector *vector;
1272 long length, nwords;
1274 vector = (struct vector *) where;
1275 length = fixnum_value(vector->length);
1276 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1282 trans_vector_double_float(lispobj object)
1284 struct vector *vector;
1285 long length, nwords;
1287 gc_assert(is_lisp_pointer(object));
1289 vector = (struct vector *) native_pointer(object);
1290 length = fixnum_value(vector->length);
1291 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1293 return copy_large_unboxed_object(object, nwords);
1297 size_vector_double_float(lispobj *where)
1299 struct vector *vector;
1300 long length, nwords;
1302 vector = (struct vector *) where;
1303 length = fixnum_value(vector->length);
1304 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1309 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1311 scav_vector_long_float(lispobj *where, lispobj object)
1313 struct vector *vector;
1314 long length, nwords;
1316 vector = (struct vector *) where;
1317 length = fixnum_value(vector->length);
1318 nwords = CEILING(length *
1325 trans_vector_long_float(lispobj object)
1327 struct vector *vector;
1328 long length, nwords;
1330 gc_assert(is_lisp_pointer(object));
1332 vector = (struct vector *) native_pointer(object);
1333 length = fixnum_value(vector->length);
1334 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1336 return copy_large_unboxed_object(object, nwords);
1340 size_vector_long_float(lispobj *where)
1342 struct vector *vector;
1343 long length, nwords;
1345 vector = (struct vector *) where;
1346 length = fixnum_value(vector->length);
1347 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1354 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1356 scav_vector_complex_single_float(lispobj *where, lispobj object)
1358 struct vector *vector;
1359 long length, nwords;
1361 vector = (struct vector *) where;
1362 length = fixnum_value(vector->length);
1363 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1369 trans_vector_complex_single_float(lispobj object)
1371 struct vector *vector;
1372 long length, nwords;
1374 gc_assert(is_lisp_pointer(object));
1376 vector = (struct vector *) native_pointer(object);
1377 length = fixnum_value(vector->length);
1378 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1380 return copy_large_unboxed_object(object, nwords);
1384 size_vector_complex_single_float(lispobj *where)
1386 struct vector *vector;
1387 long length, nwords;
1389 vector = (struct vector *) where;
1390 length = fixnum_value(vector->length);
1391 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1397 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1399 scav_vector_complex_double_float(lispobj *where, lispobj object)
1401 struct vector *vector;
1402 long length, nwords;
1404 vector = (struct vector *) where;
1405 length = fixnum_value(vector->length);
1406 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1412 trans_vector_complex_double_float(lispobj object)
1414 struct vector *vector;
1415 long length, nwords;
1417 gc_assert(is_lisp_pointer(object));
1419 vector = (struct vector *) native_pointer(object);
1420 length = fixnum_value(vector->length);
1421 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1423 return copy_large_unboxed_object(object, nwords);
1427 size_vector_complex_double_float(lispobj *where)
1429 struct vector *vector;
1430 long length, nwords;
1432 vector = (struct vector *) where;
1433 length = fixnum_value(vector->length);
1434 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1441 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1443 scav_vector_complex_long_float(lispobj *where, lispobj object)
1445 struct vector *vector;
1446 long length, nwords;
1448 vector = (struct vector *) where;
1449 length = fixnum_value(vector->length);
1450 nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1456 trans_vector_complex_long_float(lispobj object)
1458 struct vector *vector;
1459 long length, nwords;
1461 gc_assert(is_lisp_pointer(object));
1463 vector = (struct vector *) native_pointer(object);
1464 length = fixnum_value(vector->length);
1465 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1467 return copy_large_unboxed_object(object, nwords);
1471 size_vector_complex_long_float(lispobj *where)
1473 struct vector *vector;
1474 long length, nwords;
1476 vector = (struct vector *) where;
1477 length = fixnum_value(vector->length);
1478 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1484 #define WEAK_POINTER_NWORDS \
1485 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1488 trans_weak_pointer(lispobj object)
1491 #ifndef LISP_FEATURE_GENCGC
1492 struct weak_pointer *wp;
1494 gc_assert(is_lisp_pointer(object));
1496 #if defined(DEBUG_WEAK)
1497 printf("Transporting weak pointer from 0x%08x\n", object);
1500 /* Need to remember where all the weak pointers are that have */
1501 /* been transported so they can be fixed up in a post-GC pass. */
1503 copy = copy_object(object, WEAK_POINTER_NWORDS);
1504 #ifndef LISP_FEATURE_GENCGC
1505 wp = (struct weak_pointer *) native_pointer(copy);
1507 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1508 /* Push the weak pointer onto the list of weak pointers. */
1509 wp->next = (struct weak_pointer *)LOW_WORD(weak_pointers);
1516 size_weak_pointer(lispobj *where)
1518 return WEAK_POINTER_NWORDS;
1522 void scan_weak_pointers(void)
1524 struct weak_pointer *wp;
1525 for (wp = weak_pointers; wp != NULL; wp=wp->next) {
1526 lispobj value = wp->value;
1527 lispobj *first_pointer;
1528 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1529 if (!(is_lisp_pointer(value) && from_space_p(value)))
1532 /* Now, we need to check whether the object has been forwarded. If
1533 * it has been, the weak pointer is still good and needs to be
1534 * updated. Otherwise, the weak pointer needs to be nil'ed
1537 first_pointer = (lispobj *)native_pointer(value);
1539 if (forwarding_pointer_p(first_pointer)) {
1541 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1553 #if N_WORD_BITS == 32
1554 #define EQ_HASH_MASK 0x1fffffff
1555 #elif N_WORD_BITS == 64
1556 #define EQ_HASH_MASK 0x1fffffffffffffff
1559 /* Compute the EQ-hash of KEY. This must match POINTER-HASH in
1560 * target-hash-table.lisp. */
1561 #define EQ_HASH(key) ((key) & EQ_HASH_MASK)
1563 /* List of weak hash tables chained through their NEXT-WEAK-HASH-TABLE
1564 * slot. Set to NULL at the end of a collection.
1566 * This is not optimal because, when a table is tenured, it won't be
1567 * processed automatically; only the yougest generation is GC'd by
1568 * default. On the other hand, all applications will need an
1569 * occasional full GC anyway, so it's not that bad either. */
1570 struct hash_table *weak_hash_tables = NULL;
1572 /* Return true if OBJ has already survived the current GC. */
1574 survived_gc_yet (lispobj obj)
1576 return (!is_lisp_pointer(obj) || !from_space_p(obj) ||
1577 forwarding_pointer_p(native_pointer(obj)));
1581 weak_hash_entry_alivep (lispobj weakness, lispobj key, lispobj value)
1585 return survived_gc_yet(key);
1587 return survived_gc_yet(value);
1589 return (survived_gc_yet(key) || survived_gc_yet(value));
1591 return (survived_gc_yet(key) && survived_gc_yet(value));
1594 /* Shut compiler up. */
1599 /* Return the beginning of data in ARRAY (skipping the header and the
1600 * length) or NULL if it isn't an array of the specified widetag after
1602 static inline lispobj *
1603 get_array_data (lispobj array, int widetag, unsigned long *length)
1605 if (is_lisp_pointer(array) &&
1606 (widetag_of(*(lispobj *)native_pointer(array)) == widetag)) {
1608 *length = fixnum_value(((lispobj *)native_pointer(array))[1]);
1609 return ((lispobj *)native_pointer(array)) + 2;
1615 /* Only need to worry about scavenging the _real_ entries in the
1616 * table. Phantom entries such as the hash table itself at index 0 and
1617 * the empty marker at index 1 were scavenged by scav_vector that
1618 * either called this function directly or arranged for it to be
1619 * called later by pushing the hash table onto weak_hash_tables. */
1621 scav_hash_table_entries (struct hash_table *hash_table)
1624 unsigned long kv_length;
1625 lispobj *index_vector;
1626 unsigned long length;
1627 lispobj *next_vector;
1628 unsigned long next_vector_length;
1629 lispobj *hash_vector;
1630 unsigned long hash_vector_length;
1631 lispobj empty_symbol;
1632 lispobj weakness = hash_table->weakness;
1635 kv_vector = get_array_data(hash_table->table,
1636 SIMPLE_VECTOR_WIDETAG, &kv_length);
1637 if (kv_vector == NULL)
1638 lose("invalid kv_vector %x\n", hash_table->table);
1640 index_vector = get_array_data(hash_table->index_vector,
1641 SIMPLE_ARRAY_WORD_WIDETAG, &length);
1642 if (index_vector == NULL)
1643 lose("invalid index_vector %x\n", hash_table->index_vector);
1645 next_vector = get_array_data(hash_table->next_vector,
1646 SIMPLE_ARRAY_WORD_WIDETAG,
1647 &next_vector_length);
1648 if (next_vector == NULL)
1649 lose("invalid next_vector %x\n", hash_table->next_vector);
1651 hash_vector = get_array_data(hash_table->hash_vector,
1652 SIMPLE_ARRAY_WORD_WIDETAG,
1653 &hash_vector_length);
1654 if (hash_vector != NULL)
1655 gc_assert(hash_vector_length == next_vector_length);
1657 /* These lengths could be different as the index_vector can be a
1658 * different length from the others, a larger index_vector could
1659 * help reduce collisions. */
1660 gc_assert(next_vector_length*2 == kv_length);
1662 empty_symbol = kv_vector[1];
1663 /* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/
1664 if (widetag_of(*(lispobj *)native_pointer(empty_symbol)) !=
1665 SYMBOL_HEADER_WIDETAG) {
1666 lose("not a symbol where empty-hash-table-slot symbol expected: %x\n",
1667 *(lispobj *)native_pointer(empty_symbol));
1670 /* Work through the KV vector. */
1671 for (i = 1; i < next_vector_length; i++) {
1672 lispobj old_key = kv_vector[2*i];
1673 lispobj value = kv_vector[2*i+1];
1674 if ((weakness == NIL) ||
1675 weak_hash_entry_alivep(weakness, old_key, value)) {
1677 /* Scavenge the key and value. */
1678 scavenge(&kv_vector[2*i],2);
1680 /* Rehashing of EQ based keys. */
1681 if ((!hash_vector) ||
1682 (hash_vector[i] == MAGIC_HASH_VECTOR_VALUE)) {
1683 #ifndef LISP_FEATURE_GENCGC
1684 /* For GENCGC scav_hash_table_entries only rehashes
1685 * the entries whose keys were moved. Cheneygc always
1686 * moves the objects so here we let the lisp side know
1687 * that rehashing is needed for the whole table. */
1688 *(kv_vector - 2) = (subtype_VectorMustRehash<<N_WIDETAG_BITS) |
1689 SIMPLE_VECTOR_WIDETAG;
1691 unsigned long old_index = EQ_HASH(old_key)%length;
1692 lispobj new_key = kv_vector[2*i];
1693 unsigned long new_index = EQ_HASH(new_key)%length;
1694 /* Check whether the key has moved. */
1695 if ((old_index != new_index) &&
1696 (new_key != empty_symbol)) {
1697 gc_assert(kv_vector[2*i+1] != empty_symbol);
1700 "* EQ key %d moved from %x to %x; index %d to %d\n",
1701 i, old_key, new_key, old_index, new_index));*/
1703 /* Unlink the key from the old_index chain. */
1704 if (!index_vector[old_index]) {
1705 /* It's not here, must be on the
1706 * needing_rehash chain. */
1707 } else if (index_vector[old_index] == i) {
1708 /*FSHOW((stderr, "/P2a %d\n", next_vector[i]));*/
1709 index_vector[old_index] = next_vector[i];
1710 /* Link it into the needing rehash chain. */
1712 fixnum_value(hash_table->needing_rehash);
1713 hash_table->needing_rehash = make_fixnum(i);
1716 unsigned long prior = index_vector[old_index];
1717 unsigned long next = next_vector[prior];
1719 /*FSHOW((stderr, "/P3a %d %d\n", prior, next));*/
1722 /*FSHOW((stderr, "/P3b %d %d\n", prior, next));*/
1725 next_vector[prior] = next_vector[next];
1726 /* Link it into the needing rehash
1729 fixnum_value(hash_table->needing_rehash);
1730 hash_table->needing_rehash = make_fixnum(next);
1735 next = next_vector[next];
1746 scav_vector (lispobj *where, lispobj object)
1748 unsigned long kv_length;
1750 struct hash_table *hash_table;
1752 /* SB-VM:VECTOR-VALID-HASHING-SUBTYPE is set for EQ-based and weak
1753 * hash tables in the Lisp HASH-TABLE code to indicate need for
1754 * special GC support. */
1755 if (HeaderValue(object) == subtype_VectorNormal)
1758 kv_length = fixnum_value(where[1]);
1759 kv_vector = where + 2; /* Skip the header and length. */
1760 /*FSHOW((stderr,"/kv_length = %d\n", kv_length));*/
1762 /* Scavenge element 0, which may be a hash-table structure. */
1763 scavenge(where+2, 1);
1764 if (!is_lisp_pointer(where[2])) {
1765 lose("no pointer at %x in hash table\n", where[2]);
1767 hash_table = (struct hash_table *)native_pointer(where[2]);
1768 /*FSHOW((stderr,"/hash_table = %x\n", hash_table));*/
1769 if (widetag_of(hash_table->header) != INSTANCE_HEADER_WIDETAG) {
1770 lose("hash table not instance (%x at %x)\n",
1775 /* Scavenge element 1, which should be some internal symbol that
1776 * the hash table code reserves for marking empty slots. */
1777 scavenge(where+3, 1);
1778 if (!is_lisp_pointer(where[3])) {
1779 lose("not empty-hash-table-slot symbol pointer: %x\n", where[3]);
1782 /* Scavenge hash table, which will fix the positions of the other
1783 * needed objects. */
1784 scavenge((lispobj *)hash_table,
1785 sizeof(struct hash_table) / sizeof(lispobj));
1787 /* Cross-check the kv_vector. */
1788 if (where != (lispobj *)native_pointer(hash_table->table)) {
1789 lose("hash_table table!=this table %x\n", hash_table->table);
1792 if (hash_table->weakness == NIL) {
1793 scav_hash_table_entries(hash_table);
1795 /* Delay scavenging of this table by pushing it onto
1796 * weak_hash_tables (if it's not there already) for the weak
1798 if (hash_table->next_weak_hash_table == NIL) {
1799 hash_table->next_weak_hash_table = (lispobj)weak_hash_tables;
1800 weak_hash_tables = hash_table;
1804 return (CEILING(kv_length + 2, 2));
1808 scav_weak_hash_tables (void)
1810 struct hash_table *table;
1812 /* Scavenge entries whose triggers are known to survive. */
1813 for (table = weak_hash_tables; table != NULL;
1814 table = (struct hash_table *)table->next_weak_hash_table) {
1815 scav_hash_table_entries(table);
1819 /* Walk through the chain whose first element is *FIRST and remove
1820 * dead weak entries. */
1822 scan_weak_hash_table_chain (struct hash_table *hash_table, lispobj *prev,
1823 lispobj *kv_vector, lispobj *index_vector,
1824 lispobj *next_vector, lispobj *hash_vector,
1825 lispobj empty_symbol, lispobj weakness)
1827 unsigned index = *prev;
1829 unsigned next = next_vector[index];
1830 lispobj key = kv_vector[2 * index];
1831 lispobj value = kv_vector[2 * index + 1];
1832 gc_assert(key != empty_symbol);
1833 gc_assert(value != empty_symbol);
1834 if (!weak_hash_entry_alivep(weakness, key, value)) {
1835 unsigned count = fixnum_value(hash_table->number_entries);
1836 gc_assert(count > 0);
1838 hash_table->number_entries = make_fixnum(count - 1);
1839 next_vector[index] = fixnum_value(hash_table->next_free_kv);
1840 hash_table->next_free_kv = make_fixnum(index);
1841 kv_vector[2 * index] = empty_symbol;
1842 kv_vector[2 * index + 1] = empty_symbol;
1844 hash_vector[index] = MAGIC_HASH_VECTOR_VALUE;
1846 prev = &next_vector[index];
1853 scan_weak_hash_table (struct hash_table *hash_table)
1856 lispobj *index_vector;
1857 unsigned long length = 0; /* prevent warning */
1858 lispobj *next_vector;
1859 unsigned long next_vector_length = 0; /* prevent warning */
1860 lispobj *hash_vector;
1861 lispobj empty_symbol;
1862 lispobj weakness = hash_table->weakness;
1865 kv_vector = get_array_data(hash_table->table,
1866 SIMPLE_VECTOR_WIDETAG, NULL);
1867 index_vector = get_array_data(hash_table->index_vector,
1868 SIMPLE_ARRAY_WORD_WIDETAG, &length);
1869 next_vector = get_array_data(hash_table->next_vector,
1870 SIMPLE_ARRAY_WORD_WIDETAG,
1871 &next_vector_length);
1872 hash_vector = get_array_data(hash_table->hash_vector,
1873 SIMPLE_ARRAY_WORD_WIDETAG, NULL);
1874 empty_symbol = kv_vector[1];
1876 for (i = 0; i < length; i++) {
1877 scan_weak_hash_table_chain(hash_table, &index_vector[i],
1878 kv_vector, index_vector, next_vector,
1879 hash_vector, empty_symbol, weakness);
1882 lispobj first = fixnum_value(hash_table->needing_rehash);
1883 scan_weak_hash_table_chain(hash_table, &first,
1884 kv_vector, index_vector, next_vector,
1885 hash_vector, empty_symbol, weakness);
1886 hash_table->needing_rehash = make_fixnum(first);
1890 /* Remove dead entries from weak hash tables. */
1892 scan_weak_hash_tables (void)
1894 struct hash_table *table, *next;
1896 for (table = weak_hash_tables; table != NULL; table = next) {
1897 next = (struct hash_table *)table->next_weak_hash_table;
1898 table->next_weak_hash_table = NIL;
1899 scan_weak_hash_table(table);
1902 weak_hash_tables = NULL;
1911 scav_lose(lispobj *where, lispobj object)
1913 lose("no scavenge function for object 0x%08x (widetag 0x%x)\n",
1914 (unsigned long)object,
1915 widetag_of(*(lispobj*)native_pointer(object)));
1917 return 0; /* bogus return value to satisfy static type checking */
1921 trans_lose(lispobj object)
1923 lose("no transport function for object 0x%08x (widetag 0x%x)\n",
1924 (unsigned long)object,
1925 widetag_of(*(lispobj*)native_pointer(object)));
1926 return NIL; /* bogus return value to satisfy static type checking */
1930 size_lose(lispobj *where)
1932 lose("no size function for object at 0x%08x (widetag 0x%x)\n",
1933 (unsigned long)where,
1934 widetag_of(LOW_WORD(where)));
1935 return 1; /* bogus return value to satisfy static type checking */
1944 gc_init_tables(void)
1948 /* Set default value in all slots of scavenge table. FIXME
1949 * replace this gnarly sizeof with something based on
1951 for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) {
1952 scavtab[i] = scav_lose;
1955 /* For each type which can be selected by the lowtag alone, set
1956 * multiple entries in our widetag scavenge table (one for each
1957 * possible value of the high bits).
1960 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1961 scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1962 scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1963 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1964 scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1965 scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1966 scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_instance_pointer;
1967 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1968 scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1971 /* Other-pointer types (those selected by all eight bits of the
1972 * tag) get one entry each in the scavenge table. */
1973 scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1974 scavtab[RATIO_WIDETAG] = scav_boxed;
1975 #if N_WORD_BITS == 64
1976 scavtab[SINGLE_FLOAT_WIDETAG] = scav_immediate;
1978 scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1980 scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1981 #ifdef LONG_FLOAT_WIDETAG
1982 scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1984 scavtab[COMPLEX_WIDETAG] = scav_boxed;
1985 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1986 scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1988 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1989 scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1991 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1992 scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
1994 scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
1995 scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
1996 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1997 scavtab[SIMPLE_CHARACTER_STRING_WIDETAG] = scav_character_string;
1999 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
2000 scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
2001 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
2002 scav_vector_unsigned_byte_2;
2003 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
2004 scav_vector_unsigned_byte_4;
2005 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
2006 scav_vector_unsigned_byte_8;
2007 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
2008 scav_vector_unsigned_byte_8;
2009 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
2010 scav_vector_unsigned_byte_16;
2011 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
2012 scav_vector_unsigned_byte_16;
2013 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
2014 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
2015 scav_vector_unsigned_byte_32;
2017 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
2018 scav_vector_unsigned_byte_32;
2019 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
2020 scav_vector_unsigned_byte_32;
2021 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
2022 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
2023 scav_vector_unsigned_byte_64;
2025 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
2026 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
2027 scav_vector_unsigned_byte_64;
2029 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
2030 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
2031 scav_vector_unsigned_byte_64;
2033 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
2034 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
2036 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
2037 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
2038 scav_vector_unsigned_byte_16;
2040 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
2041 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
2042 scav_vector_unsigned_byte_32;
2044 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2045 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
2046 scav_vector_unsigned_byte_32;
2048 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
2049 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
2050 scav_vector_unsigned_byte_64;
2052 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
2053 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
2054 scav_vector_unsigned_byte_64;
2056 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
2057 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
2058 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2059 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
2061 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2062 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
2063 scav_vector_complex_single_float;
2065 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2066 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
2067 scav_vector_complex_double_float;
2069 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2070 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
2071 scav_vector_complex_long_float;
2073 scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
2074 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
2075 scavtab[COMPLEX_CHARACTER_STRING_WIDETAG] = scav_boxed;
2077 scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
2078 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
2079 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
2080 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
2081 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
2082 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
2083 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
2084 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
2086 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
2087 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
2088 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
2090 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
2092 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
2093 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
2094 scavtab[CHARACTER_WIDETAG] = scav_immediate;
2095 scavtab[SAP_WIDETAG] = scav_unboxed;
2096 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
2097 scavtab[NO_TLS_VALUE_MARKER_WIDETAG] = scav_immediate;
2098 scavtab[INSTANCE_HEADER_WIDETAG] = scav_instance;
2099 #if defined(LISP_FEATURE_SPARC)
2100 scavtab[FDEFN_WIDETAG] = scav_boxed;
2102 scavtab[FDEFN_WIDETAG] = scav_fdefn;
2104 scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector;
2106 /* transport other table, initialized same way as scavtab */
2107 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
2108 transother[i] = trans_lose;
2109 transother[BIGNUM_WIDETAG] = trans_unboxed;
2110 transother[RATIO_WIDETAG] = trans_boxed;
2112 #if N_WORD_BITS == 64
2113 transother[SINGLE_FLOAT_WIDETAG] = trans_immediate;
2115 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
2117 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
2118 #ifdef LONG_FLOAT_WIDETAG
2119 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
2121 transother[COMPLEX_WIDETAG] = trans_boxed;
2122 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
2123 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
2125 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
2126 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
2128 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
2129 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
2131 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
2132 transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
2133 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
2134 transother[SIMPLE_CHARACTER_STRING_WIDETAG] = trans_character_string;
2136 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
2137 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
2138 transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
2139 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
2140 trans_vector_unsigned_byte_2;
2141 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
2142 trans_vector_unsigned_byte_4;
2143 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
2144 trans_vector_unsigned_byte_8;
2145 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
2146 trans_vector_unsigned_byte_8;
2147 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
2148 trans_vector_unsigned_byte_16;
2149 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
2150 trans_vector_unsigned_byte_16;
2151 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
2152 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
2153 trans_vector_unsigned_byte_32;
2155 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
2156 trans_vector_unsigned_byte_32;
2157 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
2158 trans_vector_unsigned_byte_32;
2159 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
2160 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
2161 trans_vector_unsigned_byte_64;
2163 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
2164 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
2165 trans_vector_unsigned_byte_64;
2167 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
2168 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
2169 trans_vector_unsigned_byte_64;
2171 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
2172 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
2173 trans_vector_unsigned_byte_8;
2175 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
2176 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
2177 trans_vector_unsigned_byte_16;
2179 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
2180 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
2181 trans_vector_unsigned_byte_32;
2183 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2184 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
2185 trans_vector_unsigned_byte_32;
2187 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
2188 transother[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
2189 trans_vector_unsigned_byte_64;
2191 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
2192 transother[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
2193 trans_vector_unsigned_byte_64;
2195 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
2196 trans_vector_single_float;
2197 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
2198 trans_vector_double_float;
2199 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2200 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
2201 trans_vector_long_float;
2203 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2204 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
2205 trans_vector_complex_single_float;
2207 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2208 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
2209 trans_vector_complex_double_float;
2211 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2212 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
2213 trans_vector_complex_long_float;
2215 transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
2216 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
2217 transother[COMPLEX_CHARACTER_STRING_WIDETAG] = trans_boxed;
2219 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
2220 transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
2221 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
2222 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
2223 transother[CODE_HEADER_WIDETAG] = trans_code_header;
2224 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
2225 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
2226 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
2227 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
2228 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
2229 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
2230 transother[CHARACTER_WIDETAG] = trans_immediate;
2231 transother[SAP_WIDETAG] = trans_unboxed;
2232 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
2233 transother[NO_TLS_VALUE_MARKER_WIDETAG] = trans_immediate;
2234 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
2235 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
2236 transother[FDEFN_WIDETAG] = trans_boxed;
2238 /* size table, initialized the same way as scavtab */
2239 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
2240 sizetab[i] = size_lose;
2241 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
2242 sizetab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
2243 sizetab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2244 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
2245 sizetab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2246 sizetab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
2247 sizetab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2248 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
2249 sizetab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2251 sizetab[BIGNUM_WIDETAG] = size_unboxed;
2252 sizetab[RATIO_WIDETAG] = size_boxed;
2253 #if N_WORD_BITS == 64
2254 sizetab[SINGLE_FLOAT_WIDETAG] = size_immediate;
2256 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
2258 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
2259 #ifdef LONG_FLOAT_WIDETAG
2260 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
2262 sizetab[COMPLEX_WIDETAG] = size_boxed;
2263 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
2264 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
2266 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
2267 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
2269 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
2270 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
2272 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
2273 sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
2274 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
2275 sizetab[SIMPLE_CHARACTER_STRING_WIDETAG] = size_character_string;
2277 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
2278 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
2279 sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
2280 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
2281 size_vector_unsigned_byte_2;
2282 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
2283 size_vector_unsigned_byte_4;
2284 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
2285 size_vector_unsigned_byte_8;
2286 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
2287 size_vector_unsigned_byte_8;
2288 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
2289 size_vector_unsigned_byte_16;
2290 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
2291 size_vector_unsigned_byte_16;
2292 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
2293 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
2294 size_vector_unsigned_byte_32;
2296 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
2297 size_vector_unsigned_byte_32;
2298 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
2299 size_vector_unsigned_byte_32;
2300 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
2301 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
2302 size_vector_unsigned_byte_64;
2304 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
2305 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
2306 size_vector_unsigned_byte_64;
2308 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
2309 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
2310 size_vector_unsigned_byte_64;
2312 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
2313 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
2315 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
2316 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
2317 size_vector_unsigned_byte_16;
2319 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
2320 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
2321 size_vector_unsigned_byte_32;
2323 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2324 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
2325 size_vector_unsigned_byte_32;
2327 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
2328 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
2329 size_vector_unsigned_byte_64;
2331 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
2332 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
2333 size_vector_unsigned_byte_64;
2335 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
2336 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
2337 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2338 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
2340 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2341 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
2342 size_vector_complex_single_float;
2344 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2345 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
2346 size_vector_complex_double_float;
2348 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2349 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
2350 size_vector_complex_long_float;
2352 sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
2353 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
2354 sizetab[COMPLEX_CHARACTER_STRING_WIDETAG] = size_boxed;
2356 sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
2357 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
2358 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
2359 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
2360 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
2362 /* We shouldn't see these, so just lose if it happens. */
2363 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
2364 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
2366 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
2367 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
2368 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
2369 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
2370 sizetab[CHARACTER_WIDETAG] = size_immediate;
2371 sizetab[SAP_WIDETAG] = size_unboxed;
2372 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
2373 sizetab[NO_TLS_VALUE_MARKER_WIDETAG] = size_immediate;
2374 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
2375 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
2376 sizetab[FDEFN_WIDETAG] = size_boxed;
2380 /* Find the code object for the given pc, or return NULL on
2383 component_ptr_from_pc(lispobj *pc)
2385 lispobj *object = NULL;
2387 if ( (object = search_read_only_space(pc)) )
2389 else if ( (object = search_static_space(pc)) )
2392 object = search_dynamic_space(pc);
2394 if (object) /* if we found something */
2395 if (widetag_of(*object) == CODE_HEADER_WIDETAG)
2401 /* Scan an area looking for an object which encloses the given pointer.
2402 * Return the object start on success or NULL on failure. */
2404 gc_search_space(lispobj *start, size_t words, lispobj *pointer)
2408 lispobj thing = *start;
2410 /* If thing is an immediate then this is a cons. */
2411 if (is_lisp_pointer(thing)
2413 || (widetag_of(thing) == CHARACTER_WIDETAG)
2414 #if N_WORD_BITS == 64
2415 || (widetag_of(thing) == SINGLE_FLOAT_WIDETAG)
2417 || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG))
2420 count = (sizetab[widetag_of(thing)])(start);
2422 /* Check whether the pointer is within this object. */
2423 if ((pointer >= start) && (pointer < (start+count))) {
2425 /*FSHOW((stderr,"/found %x in %x %x\n", pointer, start, thing));*/
2429 /* Round up the count. */
2430 count = CEILING(count,2);