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"
41 #include "genesis/primitive-objects.h"
42 #include "genesis/static-symbols.h"
43 #include "genesis/layout.h"
44 #include "genesis/hash-table.h"
45 #include "gc-internal.h"
47 #ifdef LISP_FEATURE_SPARC
48 #define LONG_FLOAT_SIZE 4
50 #ifdef LISP_FEATURE_X86
51 #define LONG_FLOAT_SIZE 3
55 size_t dynamic_space_size = DEFAULT_DYNAMIC_SPACE_SIZE;
56 size_t thread_control_stack_size = DEFAULT_CONTROL_STACK_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 if (forwarding_pointer_p(object_ptr))
141 lose("unexpect forwarding pointer in scavenge: %p, start=%p, n=%l\n",
142 object_ptr, start, n_words);
144 if (is_lisp_pointer(object)) {
145 if (from_space_p(object)) {
146 /* It currently points to old space. Check for a
147 * forwarding pointer. */
148 lispobj *ptr = native_pointer(object);
149 if (forwarding_pointer_p(ptr)) {
150 /* Yes, there's a forwarding pointer. */
151 *object_ptr = LOW_WORD(forwarding_pointer_value(ptr));
152 n_words_scavenged = 1;
154 /* Scavenge that pointer. */
156 (scavtab[widetag_of(object)])(object_ptr, object);
159 /* It points somewhere other than oldspace. Leave it
161 n_words_scavenged = 1;
164 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
165 /* This workaround is probably not needed for those ports
166 which don't have a partitioned register set (and therefore
167 scan the stack conservatively for roots). */
168 else if (n_words == 1) {
169 /* there are some situations where an other-immediate may
170 end up in a descriptor register. I'm not sure whether
171 this is supposed to happen, but if it does then we
172 don't want to (a) barf or (b) scavenge over the
173 data-block, because there isn't one. So, if we're
174 checking a single word and it's anything other than a
175 pointer, just hush it up */
176 int widetag = widetag_of(object);
177 n_words_scavenged = 1;
179 if ((scavtab[widetag] == scav_lose) ||
180 (((sizetab[widetag])(object_ptr)) > 1)) {
181 fprintf(stderr,"warning: \
182 attempted to scavenge non-descriptor value %x at %p.\n\n\
183 If you can reproduce this warning, please send a bug report\n\
184 (see manual page for details).\n",
189 else if (fixnump(object)) {
190 /* It's a fixnum: really easy.. */
191 n_words_scavenged = 1;
193 /* It's some sort of header object or another. */
195 (scavtab[widetag_of(object)])(object_ptr, object);
198 gc_assert_verbose(object_ptr == end, "Final object pointer %p, start %p, end %p\n",
199 object_ptr, start, end);
202 static lispobj trans_fun_header(lispobj object); /* forward decls */
203 static lispobj trans_boxed(lispobj object);
206 scav_fun_pointer(lispobj *where, lispobj object)
208 lispobj *first_pointer;
211 gc_assert(is_lisp_pointer(object));
213 /* Object is a pointer into from_space - not a FP. */
214 first_pointer = (lispobj *) native_pointer(object);
216 /* must transport object -- object may point to either a function
217 * header, a closure function header, or to a closure header. */
219 switch (widetag_of(*first_pointer)) {
220 case SIMPLE_FUN_HEADER_WIDETAG:
221 copy = trans_fun_header(object);
224 copy = trans_boxed(object);
228 if (copy != object) {
229 /* Set forwarding pointer */
230 set_forwarding_pointer(first_pointer,copy);
233 gc_assert(is_lisp_pointer(copy));
234 gc_assert(!from_space_p(copy));
243 trans_code(struct code *code)
245 struct code *new_code;
246 lispobj first, l_code, l_new_code;
247 long nheader_words, ncode_words, nwords;
248 unsigned long displacement;
249 lispobj fheaderl, *prev_pointer;
251 /* if object has already been transported, just return pointer */
252 first = code->header;
253 if (forwarding_pointer_p((lispobj *)code)) {
255 printf("Was already transported\n");
257 return (struct code *) forwarding_pointer_value
258 ((lispobj *)((pointer_sized_uint_t) code));
261 gc_assert(widetag_of(first) == CODE_HEADER_WIDETAG);
263 /* prepare to transport the code vector */
264 l_code = (lispobj) LOW_WORD(code) | OTHER_POINTER_LOWTAG;
266 ncode_words = fixnum_value(code->code_size);
267 nheader_words = HeaderValue(code->header);
268 nwords = ncode_words + nheader_words;
269 nwords = CEILING(nwords, 2);
271 l_new_code = copy_object(l_code, nwords);
272 new_code = (struct code *) native_pointer(l_new_code);
274 #if defined(DEBUG_CODE_GC)
275 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
276 (unsigned long) code, (unsigned long) new_code);
277 printf("Code object is %d words long.\n", nwords);
280 #ifdef LISP_FEATURE_GENCGC
281 if (new_code == code)
285 displacement = l_new_code - l_code;
287 set_forwarding_pointer((lispobj *)code, l_new_code);
289 /* set forwarding pointers for all the function headers in the */
290 /* code object. also fix all self pointers */
292 fheaderl = code->entry_points;
293 prev_pointer = &new_code->entry_points;
295 while (fheaderl != NIL) {
296 struct simple_fun *fheaderp, *nfheaderp;
299 fheaderp = (struct simple_fun *) native_pointer(fheaderl);
300 gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
302 /* Calculate the new function pointer and the new */
303 /* function header. */
304 nfheaderl = fheaderl + displacement;
305 nfheaderp = (struct simple_fun *) native_pointer(nfheaderl);
308 printf("fheaderp->header (at %x) <- %x\n",
309 &(fheaderp->header) , nfheaderl);
311 set_forwarding_pointer((lispobj *)fheaderp, nfheaderl);
313 /* fix self pointer. */
315 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
316 FUN_RAW_ADDR_OFFSET +
320 *prev_pointer = nfheaderl;
322 fheaderl = fheaderp->next;
323 prev_pointer = &nfheaderp->next;
325 #ifdef LISP_FEATURE_GENCGC
326 /* Cheneygc doesn't need this os_flush_icache, it flushes the whole
327 spaces once when all copying is done. */
328 os_flush_icache((os_vm_address_t) (((long *)new_code) + nheader_words),
329 ncode_words * sizeof(long));
333 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
334 gencgc_apply_code_fixups(code, new_code);
341 scav_code_header(lispobj *where, lispobj object)
344 long n_header_words, n_code_words, n_words;
345 lispobj entry_point; /* tagged pointer to entry point */
346 struct simple_fun *function_ptr; /* untagged pointer to entry point */
348 code = (struct code *) where;
349 n_code_words = fixnum_value(code->code_size);
350 n_header_words = HeaderValue(object);
351 n_words = n_code_words + n_header_words;
352 n_words = CEILING(n_words, 2);
354 /* Scavenge the boxed section of the code data block. */
355 scavenge(where + 1, n_header_words - 1);
357 /* Scavenge the boxed section of each function object in the
358 * code data block. */
359 for (entry_point = code->entry_points;
361 entry_point = function_ptr->next) {
363 gc_assert_verbose(is_lisp_pointer(entry_point),
364 "Entry point %lx\n is not a lisp pointer.",
367 function_ptr = (struct simple_fun *) native_pointer(entry_point);
368 gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
370 scavenge(&function_ptr->name, 1);
371 scavenge(&function_ptr->arglist, 1);
372 scavenge(&function_ptr->type, 1);
373 scavenge(&function_ptr->xrefs, 1);
380 trans_code_header(lispobj object)
384 ncode = trans_code((struct code *) native_pointer(object));
385 return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG;
390 size_code_header(lispobj *where)
393 long nheader_words, ncode_words, nwords;
395 code = (struct code *) where;
397 ncode_words = fixnum_value(code->code_size);
398 nheader_words = HeaderValue(code->header);
399 nwords = ncode_words + nheader_words;
400 nwords = CEILING(nwords, 2);
405 #if !defined(LISP_FEATURE_X86) && ! defined(LISP_FEATURE_X86_64)
407 scav_return_pc_header(lispobj *where, lispobj object)
409 lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x\n",
410 (unsigned long) where,
411 (unsigned long) object);
412 return 0; /* bogus return value to satisfy static type checking */
414 #endif /* LISP_FEATURE_X86 */
417 trans_return_pc_header(lispobj object)
419 struct simple_fun *return_pc;
420 unsigned long offset;
421 struct code *code, *ncode;
423 return_pc = (struct simple_fun *) native_pointer(object);
424 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
425 offset = HeaderValue(return_pc->header) * N_WORD_BYTES;
427 /* Transport the whole code object */
428 code = (struct code *) ((unsigned long) return_pc - offset);
429 ncode = trans_code(code);
431 return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
434 /* On the 386, closures hold a pointer to the raw address instead of the
435 * function object, so we can use CALL [$FDEFN+const] to invoke
436 * the function without loading it into a register. Given that code
437 * objects don't move, we don't need to update anything, but we do
438 * have to figure out that the function is still live. */
440 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
442 scav_closure_header(lispobj *where, lispobj object)
444 struct closure *closure;
447 closure = (struct closure *)where;
448 fun = closure->fun - FUN_RAW_ADDR_OFFSET;
450 #ifdef LISP_FEATURE_GENCGC
451 /* The function may have moved so update the raw address. But
452 * don't write unnecessarily. */
453 if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
454 closure->fun = fun + FUN_RAW_ADDR_OFFSET;
460 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
462 scav_fun_header(lispobj *where, lispobj object)
464 lose("attempted to scavenge a function header where=0x%08x object=0x%08x\n",
465 (unsigned long) where,
466 (unsigned long) object);
467 return 0; /* bogus return value to satisfy static type checking */
469 #endif /* LISP_FEATURE_X86 */
472 trans_fun_header(lispobj object)
474 struct simple_fun *fheader;
475 unsigned long offset;
476 struct code *code, *ncode;
478 fheader = (struct simple_fun *) native_pointer(object);
479 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
480 offset = HeaderValue(fheader->header) * N_WORD_BYTES;
482 /* Transport the whole code object */
483 code = (struct code *) ((unsigned long) fheader - offset);
484 ncode = trans_code(code);
486 return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
495 scav_instance_pointer(lispobj *where, lispobj object)
497 lispobj copy, *first_pointer;
499 /* Object is a pointer into from space - not a FP. */
500 copy = trans_boxed(object);
502 #ifdef LISP_FEATURE_GENCGC
503 gc_assert(copy != object);
506 first_pointer = (lispobj *) native_pointer(object);
507 set_forwarding_pointer(first_pointer,copy);
518 static lispobj trans_list(lispobj object);
521 scav_list_pointer(lispobj *where, lispobj object)
523 lispobj first, *first_pointer;
525 gc_assert(is_lisp_pointer(object));
527 /* Object is a pointer into from space - not FP. */
528 first_pointer = (lispobj *) native_pointer(object);
530 first = trans_list(object);
531 gc_assert(first != object);
533 /* Set forwarding pointer */
534 set_forwarding_pointer(first_pointer, first);
536 gc_assert(is_lisp_pointer(first));
537 gc_assert(!from_space_p(first));
545 trans_list(lispobj object)
547 lispobj new_list_pointer;
548 struct cons *cons, *new_cons;
551 cons = (struct cons *) native_pointer(object);
554 new_cons = (struct cons *)
555 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
556 new_cons->car = cons->car;
557 new_cons->cdr = cons->cdr; /* updated later */
558 new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
560 /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC */
563 set_forwarding_pointer((lispobj *)cons, new_list_pointer);
565 /* Try to linearize the list in the cdr direction to help reduce
569 struct cons *cdr_cons, *new_cdr_cons;
571 if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
572 !from_space_p(cdr) ||
573 forwarding_pointer_p((lispobj *)native_pointer(cdr)))
576 cdr_cons = (struct cons *) native_pointer(cdr);
579 new_cdr_cons = (struct cons*)
580 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
581 new_cdr_cons->car = cdr_cons->car;
582 new_cdr_cons->cdr = cdr_cons->cdr;
583 new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
585 /* Grab the cdr before it is clobbered. */
587 set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
589 /* Update the cdr of the last cons copied into new space to
590 * keep the newspace scavenge from having to do it. */
591 new_cons->cdr = new_cdr;
593 new_cons = new_cdr_cons;
596 return new_list_pointer;
601 * scavenging and transporting other pointers
605 scav_other_pointer(lispobj *where, lispobj object)
607 lispobj first, *first_pointer;
609 gc_assert(is_lisp_pointer(object));
611 /* Object is a pointer into from space - not FP. */
612 first_pointer = (lispobj *) native_pointer(object);
613 first = (transother[widetag_of(*first_pointer)])(object);
615 if (first != object) {
616 set_forwarding_pointer(first_pointer, first);
617 #ifdef LISP_FEATURE_GENCGC
621 #ifndef LISP_FEATURE_GENCGC
624 gc_assert(is_lisp_pointer(first));
625 gc_assert(!from_space_p(first));
631 * immediate, boxed, and unboxed objects
635 size_pointer(lispobj *where)
641 scav_immediate(lispobj *where, lispobj object)
647 trans_immediate(lispobj object)
649 lose("trying to transport an immediate\n");
650 return NIL; /* bogus return value to satisfy static type checking */
654 size_immediate(lispobj *where)
661 scav_boxed(lispobj *where, lispobj object)
667 scav_instance(lispobj *where, lispobj object)
670 long ntotal = HeaderValue(object);
671 lispobj layout = ((struct instance *)where)->slots[0];
675 if (forwarding_pointer_p(native_pointer(layout)))
676 layout = (lispobj) forwarding_pointer_value(native_pointer(layout));
678 nuntagged = ((struct layout *)native_pointer(layout))->n_untagged_slots;
679 scavenge(where + 1, ntotal - fixnum_value(nuntagged));
685 trans_boxed(lispobj object)
688 unsigned long length;
690 gc_assert(is_lisp_pointer(object));
692 header = *((lispobj *) native_pointer(object));
693 length = HeaderValue(header) + 1;
694 length = CEILING(length, 2);
696 return copy_object(object, length);
701 size_boxed(lispobj *where)
704 unsigned long length;
707 length = HeaderValue(header) + 1;
708 length = CEILING(length, 2);
713 /* Note: on the sparc we don't have to do anything special for fdefns, */
714 /* 'cause the raw-addr has a function lowtag. */
715 #if !defined(LISP_FEATURE_SPARC)
717 scav_fdefn(lispobj *where, lispobj object)
721 fdefn = (struct fdefn *)where;
723 /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
724 fdefn->fun, fdefn->raw_addr)); */
726 if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET) == fdefn->raw_addr) {
727 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
729 /* Don't write unnecessarily. */
730 if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
731 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
732 /* gc.c has more casts here, which may be relevant or alternatively
733 may be compiler warning defeaters. try
734 fdefn->raw_addr = ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
736 return sizeof(struct fdefn) / sizeof(lispobj);
744 scav_unboxed(lispobj *where, lispobj object)
746 unsigned long length;
748 length = HeaderValue(object) + 1;
749 length = CEILING(length, 2);
755 trans_unboxed(lispobj object)
758 unsigned long length;
761 gc_assert(is_lisp_pointer(object));
763 header = *((lispobj *) native_pointer(object));
764 length = HeaderValue(header) + 1;
765 length = CEILING(length, 2);
767 return copy_unboxed_object(object, length);
771 size_unboxed(lispobj *where)
774 unsigned long length;
777 length = HeaderValue(header) + 1;
778 length = CEILING(length, 2);
784 /* vector-like objects */
786 scav_base_string(lispobj *where, lispobj object)
788 struct vector *vector;
791 /* NOTE: Strings contain one more byte of data than the length */
792 /* slot indicates. */
794 vector = (struct vector *) where;
795 length = fixnum_value(vector->length) + 1;
796 nwords = CEILING(NWORDS(length, 8) + 2, 2);
801 trans_base_string(lispobj object)
803 struct vector *vector;
806 gc_assert(is_lisp_pointer(object));
808 /* NOTE: A string contains one more byte of data (a terminating
809 * '\0' to help when interfacing with C functions) than indicated
810 * by the length slot. */
812 vector = (struct vector *) native_pointer(object);
813 length = fixnum_value(vector->length) + 1;
814 nwords = CEILING(NWORDS(length, 8) + 2, 2);
816 return copy_large_unboxed_object(object, nwords);
820 size_base_string(lispobj *where)
822 struct vector *vector;
825 /* NOTE: A string contains one more byte of data (a terminating
826 * '\0' to help when interfacing with C functions) than indicated
827 * by the length slot. */
829 vector = (struct vector *) where;
830 length = fixnum_value(vector->length) + 1;
831 nwords = CEILING(NWORDS(length, 8) + 2, 2);
837 scav_character_string(lispobj *where, lispobj object)
839 struct vector *vector;
842 /* NOTE: Strings contain one more byte of data than the length */
843 /* slot indicates. */
845 vector = (struct vector *) where;
846 length = fixnum_value(vector->length) + 1;
847 nwords = CEILING(NWORDS(length, 32) + 2, 2);
852 trans_character_string(lispobj object)
854 struct vector *vector;
857 gc_assert(is_lisp_pointer(object));
859 /* NOTE: A string contains one more byte of data (a terminating
860 * '\0' to help when interfacing with C functions) than indicated
861 * by the length slot. */
863 vector = (struct vector *) native_pointer(object);
864 length = fixnum_value(vector->length) + 1;
865 nwords = CEILING(NWORDS(length, 32) + 2, 2);
867 return copy_large_unboxed_object(object, nwords);
871 size_character_string(lispobj *where)
873 struct vector *vector;
876 /* NOTE: A string contains one more byte of data (a terminating
877 * '\0' to help when interfacing with C functions) than indicated
878 * by the length slot. */
880 vector = (struct vector *) where;
881 length = fixnum_value(vector->length) + 1;
882 nwords = CEILING(NWORDS(length, 32) + 2, 2);
888 trans_vector(lispobj object)
890 struct vector *vector;
893 gc_assert(is_lisp_pointer(object));
895 vector = (struct vector *) native_pointer(object);
897 length = fixnum_value(vector->length);
898 nwords = CEILING(length + 2, 2);
900 return copy_large_object(object, nwords);
904 size_vector(lispobj *where)
906 struct vector *vector;
909 vector = (struct vector *) where;
910 length = fixnum_value(vector->length);
911 nwords = CEILING(length + 2, 2);
917 scav_vector_nil(lispobj *where, lispobj object)
923 trans_vector_nil(lispobj object)
925 gc_assert(is_lisp_pointer(object));
926 return copy_unboxed_object(object, 2);
930 size_vector_nil(lispobj *where)
932 /* Just the header word and the length word */
937 scav_vector_bit(lispobj *where, lispobj object)
939 struct vector *vector;
942 vector = (struct vector *) where;
943 length = fixnum_value(vector->length);
944 nwords = CEILING(NWORDS(length, 1) + 2, 2);
950 trans_vector_bit(lispobj object)
952 struct vector *vector;
955 gc_assert(is_lisp_pointer(object));
957 vector = (struct vector *) native_pointer(object);
958 length = fixnum_value(vector->length);
959 nwords = CEILING(NWORDS(length, 1) + 2, 2);
961 return copy_large_unboxed_object(object, nwords);
965 size_vector_bit(lispobj *where)
967 struct vector *vector;
970 vector = (struct vector *) where;
971 length = fixnum_value(vector->length);
972 nwords = CEILING(NWORDS(length, 1) + 2, 2);
978 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
980 struct vector *vector;
983 vector = (struct vector *) where;
984 length = fixnum_value(vector->length);
985 nwords = CEILING(NWORDS(length, 2) + 2, 2);
991 trans_vector_unsigned_byte_2(lispobj object)
993 struct vector *vector;
996 gc_assert(is_lisp_pointer(object));
998 vector = (struct vector *) native_pointer(object);
999 length = fixnum_value(vector->length);
1000 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1002 return copy_large_unboxed_object(object, nwords);
1006 size_vector_unsigned_byte_2(lispobj *where)
1008 struct vector *vector;
1009 long length, nwords;
1011 vector = (struct vector *) where;
1012 length = fixnum_value(vector->length);
1013 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1019 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
1021 struct vector *vector;
1022 long length, nwords;
1024 vector = (struct vector *) where;
1025 length = fixnum_value(vector->length);
1026 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1032 trans_vector_unsigned_byte_4(lispobj object)
1034 struct vector *vector;
1035 long length, nwords;
1037 gc_assert(is_lisp_pointer(object));
1039 vector = (struct vector *) native_pointer(object);
1040 length = fixnum_value(vector->length);
1041 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1043 return copy_large_unboxed_object(object, nwords);
1046 size_vector_unsigned_byte_4(lispobj *where)
1048 struct vector *vector;
1049 long length, nwords;
1051 vector = (struct vector *) where;
1052 length = fixnum_value(vector->length);
1053 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1060 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
1062 struct vector *vector;
1063 long length, nwords;
1065 vector = (struct vector *) where;
1066 length = fixnum_value(vector->length);
1067 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1072 /*********************/
1077 trans_vector_unsigned_byte_8(lispobj object)
1079 struct vector *vector;
1080 long length, nwords;
1082 gc_assert(is_lisp_pointer(object));
1084 vector = (struct vector *) native_pointer(object);
1085 length = fixnum_value(vector->length);
1086 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1088 return copy_large_unboxed_object(object, nwords);
1092 size_vector_unsigned_byte_8(lispobj *where)
1094 struct vector *vector;
1095 long length, nwords;
1097 vector = (struct vector *) where;
1098 length = fixnum_value(vector->length);
1099 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1106 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1108 struct vector *vector;
1109 long length, nwords;
1111 vector = (struct vector *) where;
1112 length = fixnum_value(vector->length);
1113 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1119 trans_vector_unsigned_byte_16(lispobj object)
1121 struct vector *vector;
1122 long length, nwords;
1124 gc_assert(is_lisp_pointer(object));
1126 vector = (struct vector *) native_pointer(object);
1127 length = fixnum_value(vector->length);
1128 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1130 return copy_large_unboxed_object(object, nwords);
1134 size_vector_unsigned_byte_16(lispobj *where)
1136 struct vector *vector;
1137 long length, nwords;
1139 vector = (struct vector *) where;
1140 length = fixnum_value(vector->length);
1141 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1147 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1149 struct vector *vector;
1150 long length, nwords;
1152 vector = (struct vector *) where;
1153 length = fixnum_value(vector->length);
1154 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1160 trans_vector_unsigned_byte_32(lispobj object)
1162 struct vector *vector;
1163 long length, nwords;
1165 gc_assert(is_lisp_pointer(object));
1167 vector = (struct vector *) native_pointer(object);
1168 length = fixnum_value(vector->length);
1169 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1171 return copy_large_unboxed_object(object, nwords);
1175 size_vector_unsigned_byte_32(lispobj *where)
1177 struct vector *vector;
1178 long length, nwords;
1180 vector = (struct vector *) where;
1181 length = fixnum_value(vector->length);
1182 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1187 #if N_WORD_BITS == 64
1189 scav_vector_unsigned_byte_64(lispobj *where, lispobj object)
1191 struct vector *vector;
1192 long length, nwords;
1194 vector = (struct vector *) where;
1195 length = fixnum_value(vector->length);
1196 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1202 trans_vector_unsigned_byte_64(lispobj object)
1204 struct vector *vector;
1205 long length, nwords;
1207 gc_assert(is_lisp_pointer(object));
1209 vector = (struct vector *) native_pointer(object);
1210 length = fixnum_value(vector->length);
1211 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1213 return copy_large_unboxed_object(object, nwords);
1217 size_vector_unsigned_byte_64(lispobj *where)
1219 struct vector *vector;
1220 long length, nwords;
1222 vector = (struct vector *) where;
1223 length = fixnum_value(vector->length);
1224 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1231 scav_vector_single_float(lispobj *where, lispobj object)
1233 struct vector *vector;
1234 long length, nwords;
1236 vector = (struct vector *) where;
1237 length = fixnum_value(vector->length);
1238 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1244 trans_vector_single_float(lispobj object)
1246 struct vector *vector;
1247 long length, nwords;
1249 gc_assert(is_lisp_pointer(object));
1251 vector = (struct vector *) native_pointer(object);
1252 length = fixnum_value(vector->length);
1253 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1255 return copy_large_unboxed_object(object, nwords);
1259 size_vector_single_float(lispobj *where)
1261 struct vector *vector;
1262 long length, nwords;
1264 vector = (struct vector *) where;
1265 length = fixnum_value(vector->length);
1266 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1272 scav_vector_double_float(lispobj *where, lispobj object)
1274 struct vector *vector;
1275 long length, nwords;
1277 vector = (struct vector *) where;
1278 length = fixnum_value(vector->length);
1279 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1285 trans_vector_double_float(lispobj object)
1287 struct vector *vector;
1288 long length, nwords;
1290 gc_assert(is_lisp_pointer(object));
1292 vector = (struct vector *) native_pointer(object);
1293 length = fixnum_value(vector->length);
1294 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1296 return copy_large_unboxed_object(object, nwords);
1300 size_vector_double_float(lispobj *where)
1302 struct vector *vector;
1303 long length, nwords;
1305 vector = (struct vector *) where;
1306 length = fixnum_value(vector->length);
1307 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1312 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1314 scav_vector_long_float(lispobj *where, lispobj object)
1316 struct vector *vector;
1317 long length, nwords;
1319 vector = (struct vector *) where;
1320 length = fixnum_value(vector->length);
1321 nwords = CEILING(length *
1328 trans_vector_long_float(lispobj object)
1330 struct vector *vector;
1331 long length, nwords;
1333 gc_assert(is_lisp_pointer(object));
1335 vector = (struct vector *) native_pointer(object);
1336 length = fixnum_value(vector->length);
1337 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1339 return copy_large_unboxed_object(object, nwords);
1343 size_vector_long_float(lispobj *where)
1345 struct vector *vector;
1346 long length, nwords;
1348 vector = (struct vector *) where;
1349 length = fixnum_value(vector->length);
1350 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1357 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1359 scav_vector_complex_single_float(lispobj *where, lispobj object)
1361 struct vector *vector;
1362 long length, nwords;
1364 vector = (struct vector *) where;
1365 length = fixnum_value(vector->length);
1366 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1372 trans_vector_complex_single_float(lispobj object)
1374 struct vector *vector;
1375 long length, nwords;
1377 gc_assert(is_lisp_pointer(object));
1379 vector = (struct vector *) native_pointer(object);
1380 length = fixnum_value(vector->length);
1381 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1383 return copy_large_unboxed_object(object, nwords);
1387 size_vector_complex_single_float(lispobj *where)
1389 struct vector *vector;
1390 long length, nwords;
1392 vector = (struct vector *) where;
1393 length = fixnum_value(vector->length);
1394 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1400 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1402 scav_vector_complex_double_float(lispobj *where, lispobj object)
1404 struct vector *vector;
1405 long length, nwords;
1407 vector = (struct vector *) where;
1408 length = fixnum_value(vector->length);
1409 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1415 trans_vector_complex_double_float(lispobj object)
1417 struct vector *vector;
1418 long length, nwords;
1420 gc_assert(is_lisp_pointer(object));
1422 vector = (struct vector *) native_pointer(object);
1423 length = fixnum_value(vector->length);
1424 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1426 return copy_large_unboxed_object(object, nwords);
1430 size_vector_complex_double_float(lispobj *where)
1432 struct vector *vector;
1433 long length, nwords;
1435 vector = (struct vector *) where;
1436 length = fixnum_value(vector->length);
1437 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1444 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1446 scav_vector_complex_long_float(lispobj *where, lispobj object)
1448 struct vector *vector;
1449 long length, nwords;
1451 vector = (struct vector *) where;
1452 length = fixnum_value(vector->length);
1453 nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1459 trans_vector_complex_long_float(lispobj object)
1461 struct vector *vector;
1462 long length, nwords;
1464 gc_assert(is_lisp_pointer(object));
1466 vector = (struct vector *) native_pointer(object);
1467 length = fixnum_value(vector->length);
1468 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1470 return copy_large_unboxed_object(object, nwords);
1474 size_vector_complex_long_float(lispobj *where)
1476 struct vector *vector;
1477 long length, nwords;
1479 vector = (struct vector *) where;
1480 length = fixnum_value(vector->length);
1481 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1487 #define WEAK_POINTER_NWORDS \
1488 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1491 trans_weak_pointer(lispobj object)
1494 #ifndef LISP_FEATURE_GENCGC
1495 struct weak_pointer *wp;
1497 gc_assert(is_lisp_pointer(object));
1499 #if defined(DEBUG_WEAK)
1500 printf("Transporting weak pointer from 0x%08x\n", object);
1503 /* Need to remember where all the weak pointers are that have */
1504 /* been transported so they can be fixed up in a post-GC pass. */
1506 copy = copy_object(object, WEAK_POINTER_NWORDS);
1507 #ifndef LISP_FEATURE_GENCGC
1508 wp = (struct weak_pointer *) native_pointer(copy);
1510 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1511 /* Push the weak pointer onto the list of weak pointers. */
1512 wp->next = (struct weak_pointer *)LOW_WORD(weak_pointers);
1519 size_weak_pointer(lispobj *where)
1521 return WEAK_POINTER_NWORDS;
1525 void scan_weak_pointers(void)
1527 struct weak_pointer *wp, *next_wp;
1528 for (wp = weak_pointers, next_wp = NULL; wp != NULL; wp = next_wp) {
1529 lispobj value = wp->value;
1530 lispobj *first_pointer;
1531 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1535 if (next_wp == wp) /* gencgc uses a ref to self for end of list */
1538 if (!(is_lisp_pointer(value) && from_space_p(value)))
1541 /* Now, we need to check whether the object has been forwarded. If
1542 * it has been, the weak pointer is still good and needs to be
1543 * updated. Otherwise, the weak pointer needs to be nil'ed
1546 first_pointer = (lispobj *)native_pointer(value);
1548 if (forwarding_pointer_p(first_pointer)) {
1550 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1562 #if N_WORD_BITS == 32
1563 #define EQ_HASH_MASK 0x1fffffff
1564 #elif N_WORD_BITS == 64
1565 #define EQ_HASH_MASK 0x1fffffffffffffff
1568 /* Compute the EQ-hash of KEY. This must match POINTER-HASH in
1569 * target-hash-table.lisp. */
1570 #define EQ_HASH(key) ((key) & EQ_HASH_MASK)
1572 /* List of weak hash tables chained through their NEXT-WEAK-HASH-TABLE
1573 * slot. Set to NULL at the end of a collection.
1575 * This is not optimal because, when a table is tenured, it won't be
1576 * processed automatically; only the yougest generation is GC'd by
1577 * default. On the other hand, all applications will need an
1578 * occasional full GC anyway, so it's not that bad either. */
1579 struct hash_table *weak_hash_tables = NULL;
1581 /* Return true if OBJ has already survived the current GC. */
1583 survived_gc_yet (lispobj obj)
1585 return (!is_lisp_pointer(obj) || !from_space_p(obj) ||
1586 forwarding_pointer_p(native_pointer(obj)));
1590 weak_hash_entry_alivep (lispobj weakness, lispobj key, lispobj value)
1594 return survived_gc_yet(key);
1596 return survived_gc_yet(value);
1598 return (survived_gc_yet(key) || survived_gc_yet(value));
1600 return (survived_gc_yet(key) && survived_gc_yet(value));
1603 /* Shut compiler up. */
1608 /* Return the beginning of data in ARRAY (skipping the header and the
1609 * length) or NULL if it isn't an array of the specified widetag after
1611 static inline lispobj *
1612 get_array_data (lispobj array, int widetag, unsigned long *length)
1614 if (is_lisp_pointer(array) &&
1615 (widetag_of(*(lispobj *)native_pointer(array)) == widetag)) {
1617 *length = fixnum_value(((lispobj *)native_pointer(array))[1]);
1618 return ((lispobj *)native_pointer(array)) + 2;
1624 /* Only need to worry about scavenging the _real_ entries in the
1625 * table. Phantom entries such as the hash table itself at index 0 and
1626 * the empty marker at index 1 were scavenged by scav_vector that
1627 * either called this function directly or arranged for it to be
1628 * called later by pushing the hash table onto weak_hash_tables. */
1630 scav_hash_table_entries (struct hash_table *hash_table)
1633 unsigned long kv_length;
1634 lispobj *index_vector;
1635 unsigned long length;
1636 lispobj *next_vector;
1637 unsigned long next_vector_length;
1638 lispobj *hash_vector;
1639 unsigned long hash_vector_length;
1640 lispobj empty_symbol;
1641 lispobj weakness = hash_table->weakness;
1644 kv_vector = get_array_data(hash_table->table,
1645 SIMPLE_VECTOR_WIDETAG, &kv_length);
1646 if (kv_vector == NULL)
1647 lose("invalid kv_vector %x\n", hash_table->table);
1649 index_vector = get_array_data(hash_table->index_vector,
1650 SIMPLE_ARRAY_WORD_WIDETAG, &length);
1651 if (index_vector == NULL)
1652 lose("invalid index_vector %x\n", hash_table->index_vector);
1654 next_vector = get_array_data(hash_table->next_vector,
1655 SIMPLE_ARRAY_WORD_WIDETAG,
1656 &next_vector_length);
1657 if (next_vector == NULL)
1658 lose("invalid next_vector %x\n", hash_table->next_vector);
1660 hash_vector = get_array_data(hash_table->hash_vector,
1661 SIMPLE_ARRAY_WORD_WIDETAG,
1662 &hash_vector_length);
1663 if (hash_vector != NULL)
1664 gc_assert(hash_vector_length == next_vector_length);
1666 /* These lengths could be different as the index_vector can be a
1667 * different length from the others, a larger index_vector could
1668 * help reduce collisions. */
1669 gc_assert(next_vector_length*2 == kv_length);
1671 empty_symbol = kv_vector[1];
1672 /* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/
1673 if (widetag_of(*(lispobj *)native_pointer(empty_symbol)) !=
1674 SYMBOL_HEADER_WIDETAG) {
1675 lose("not a symbol where empty-hash-table-slot symbol expected: %x\n",
1676 *(lispobj *)native_pointer(empty_symbol));
1679 /* Work through the KV vector. */
1680 for (i = 1; i < next_vector_length; i++) {
1681 lispobj old_key = kv_vector[2*i];
1682 lispobj value = kv_vector[2*i+1];
1683 if ((weakness == NIL) ||
1684 weak_hash_entry_alivep(weakness, old_key, value)) {
1686 /* Scavenge the key and value. */
1687 scavenge(&kv_vector[2*i],2);
1689 /* If an EQ-based key has moved, mark the hash-table for
1691 if (!hash_vector || hash_vector[i] == MAGIC_HASH_VECTOR_VALUE) {
1692 lispobj new_key = kv_vector[2*i];
1694 if (old_key != new_key && new_key != empty_symbol) {
1695 hash_table->needs_rehash_p = T;
1703 scav_vector (lispobj *where, lispobj object)
1705 unsigned long kv_length;
1707 struct hash_table *hash_table;
1709 /* SB-VM:VECTOR-VALID-HASHING-SUBTYPE is set for EQ-based and weak
1710 * hash tables in the Lisp HASH-TABLE code to indicate need for
1711 * special GC support. */
1712 if (HeaderValue(object) == subtype_VectorNormal)
1715 kv_length = fixnum_value(where[1]);
1716 kv_vector = where + 2; /* Skip the header and length. */
1717 /*FSHOW((stderr,"/kv_length = %d\n", kv_length));*/
1719 /* Scavenge element 0, which may be a hash-table structure. */
1720 scavenge(where+2, 1);
1721 if (!is_lisp_pointer(where[2])) {
1722 /* This'll happen when REHASH clears the header of old-kv-vector
1723 * and fills it with zero, but some other thread simulatenously
1724 * sets the header in %%PUTHASH.
1727 "Warning: no pointer at %lx in hash table: this indicates "
1728 "non-fatal corruption caused by concurrent access to a "
1729 "hash-table from multiple threads. Any accesses to "
1730 "hash-tables shared between threads should be protected "
1731 "by locks.\n", (unsigned long)&where[2]);
1732 // We've scavenged three words.
1735 hash_table = (struct hash_table *)native_pointer(where[2]);
1736 /*FSHOW((stderr,"/hash_table = %x\n", hash_table));*/
1737 if (widetag_of(hash_table->header) != INSTANCE_HEADER_WIDETAG) {
1738 lose("hash table not instance (%x at %x)\n",
1743 /* Scavenge element 1, which should be some internal symbol that
1744 * the hash table code reserves for marking empty slots. */
1745 scavenge(where+3, 1);
1746 if (!is_lisp_pointer(where[3])) {
1747 lose("not empty-hash-table-slot symbol pointer: %x\n", where[3]);
1750 /* Scavenge hash table, which will fix the positions of the other
1751 * needed objects. */
1752 scavenge((lispobj *)hash_table,
1753 sizeof(struct hash_table) / sizeof(lispobj));
1755 /* Cross-check the kv_vector. */
1756 if (where != (lispobj *)native_pointer(hash_table->table)) {
1757 lose("hash_table table!=this table %x\n", hash_table->table);
1760 if (hash_table->weakness == NIL) {
1761 scav_hash_table_entries(hash_table);
1763 /* Delay scavenging of this table by pushing it onto
1764 * weak_hash_tables (if it's not there already) for the weak
1766 if (hash_table->next_weak_hash_table == NIL) {
1767 hash_table->next_weak_hash_table = (lispobj)weak_hash_tables;
1768 weak_hash_tables = hash_table;
1772 return (CEILING(kv_length + 2, 2));
1776 scav_weak_hash_tables (void)
1778 struct hash_table *table;
1780 /* Scavenge entries whose triggers are known to survive. */
1781 for (table = weak_hash_tables; table != NULL;
1782 table = (struct hash_table *)table->next_weak_hash_table) {
1783 scav_hash_table_entries(table);
1787 /* Walk through the chain whose first element is *FIRST and remove
1788 * dead weak entries. */
1790 scan_weak_hash_table_chain (struct hash_table *hash_table, lispobj *prev,
1791 lispobj *kv_vector, lispobj *index_vector,
1792 lispobj *next_vector, lispobj *hash_vector,
1793 lispobj empty_symbol, lispobj weakness)
1795 unsigned index = *prev;
1797 unsigned next = next_vector[index];
1798 lispobj key = kv_vector[2 * index];
1799 lispobj value = kv_vector[2 * index + 1];
1800 gc_assert(key != empty_symbol);
1801 gc_assert(value != empty_symbol);
1802 if (!weak_hash_entry_alivep(weakness, key, value)) {
1803 unsigned count = fixnum_value(hash_table->number_entries);
1804 gc_assert(count > 0);
1806 hash_table->number_entries = make_fixnum(count - 1);
1807 next_vector[index] = fixnum_value(hash_table->next_free_kv);
1808 hash_table->next_free_kv = make_fixnum(index);
1809 kv_vector[2 * index] = empty_symbol;
1810 kv_vector[2 * index + 1] = empty_symbol;
1812 hash_vector[index] = MAGIC_HASH_VECTOR_VALUE;
1814 prev = &next_vector[index];
1821 scan_weak_hash_table (struct hash_table *hash_table)
1824 lispobj *index_vector;
1825 unsigned long length = 0; /* prevent warning */
1826 lispobj *next_vector;
1827 unsigned long next_vector_length = 0; /* prevent warning */
1828 lispobj *hash_vector;
1829 lispobj empty_symbol;
1830 lispobj weakness = hash_table->weakness;
1833 kv_vector = get_array_data(hash_table->table,
1834 SIMPLE_VECTOR_WIDETAG, NULL);
1835 index_vector = get_array_data(hash_table->index_vector,
1836 SIMPLE_ARRAY_WORD_WIDETAG, &length);
1837 next_vector = get_array_data(hash_table->next_vector,
1838 SIMPLE_ARRAY_WORD_WIDETAG,
1839 &next_vector_length);
1840 hash_vector = get_array_data(hash_table->hash_vector,
1841 SIMPLE_ARRAY_WORD_WIDETAG, NULL);
1842 empty_symbol = kv_vector[1];
1844 for (i = 0; i < length; i++) {
1845 scan_weak_hash_table_chain(hash_table, &index_vector[i],
1846 kv_vector, index_vector, next_vector,
1847 hash_vector, empty_symbol, weakness);
1851 /* Remove dead entries from weak hash tables. */
1853 scan_weak_hash_tables (void)
1855 struct hash_table *table, *next;
1857 for (table = weak_hash_tables; table != NULL; table = next) {
1858 next = (struct hash_table *)table->next_weak_hash_table;
1859 table->next_weak_hash_table = NIL;
1860 scan_weak_hash_table(table);
1863 weak_hash_tables = NULL;
1872 scav_lose(lispobj *where, lispobj object)
1874 lose("no scavenge function for object 0x%08x (widetag 0x%x)\n",
1875 (unsigned long)object,
1876 widetag_of(*(lispobj*)native_pointer(object)));
1878 return 0; /* bogus return value to satisfy static type checking */
1882 trans_lose(lispobj object)
1884 lose("no transport function for object 0x%08x (widetag 0x%x)\n",
1885 (unsigned long)object,
1886 widetag_of(*(lispobj*)native_pointer(object)));
1887 return NIL; /* bogus return value to satisfy static type checking */
1891 size_lose(lispobj *where)
1893 lose("no size function for object at 0x%08x (widetag 0x%x)\n",
1894 (unsigned long)where,
1895 widetag_of(LOW_WORD(where)));
1896 return 1; /* bogus return value to satisfy static type checking */
1905 gc_init_tables(void)
1909 /* Set default value in all slots of scavenge table. FIXME
1910 * replace this gnarly sizeof with something based on
1912 for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) {
1913 scavtab[i] = scav_lose;
1916 /* For each type which can be selected by the lowtag alone, set
1917 * multiple entries in our widetag scavenge table (one for each
1918 * possible value of the high bits).
1921 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1922 scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1923 scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1924 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1925 scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1926 scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1927 scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] =
1928 scav_instance_pointer;
1929 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1930 scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1933 /* Other-pointer types (those selected by all eight bits of the
1934 * tag) get one entry each in the scavenge table. */
1935 scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1936 scavtab[RATIO_WIDETAG] = scav_boxed;
1937 #if N_WORD_BITS == 64
1938 scavtab[SINGLE_FLOAT_WIDETAG] = scav_immediate;
1940 scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1942 scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1943 #ifdef LONG_FLOAT_WIDETAG
1944 scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1946 scavtab[COMPLEX_WIDETAG] = scav_boxed;
1947 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1948 scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1950 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1951 scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1953 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1954 scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
1956 scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
1957 scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
1958 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1959 scavtab[SIMPLE_CHARACTER_STRING_WIDETAG] = scav_character_string;
1961 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
1962 scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
1963 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1964 scav_vector_unsigned_byte_2;
1965 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1966 scav_vector_unsigned_byte_4;
1967 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1968 scav_vector_unsigned_byte_8;
1969 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1970 scav_vector_unsigned_byte_8;
1971 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1972 scav_vector_unsigned_byte_16;
1973 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1974 scav_vector_unsigned_byte_16;
1975 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1976 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1977 scav_vector_unsigned_byte_32;
1979 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1980 scav_vector_unsigned_byte_32;
1981 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1982 scav_vector_unsigned_byte_32;
1983 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1984 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1985 scav_vector_unsigned_byte_64;
1987 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1988 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1989 scav_vector_unsigned_byte_64;
1991 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1992 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1993 scav_vector_unsigned_byte_64;
1995 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1996 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
1998 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1999 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
2000 scav_vector_unsigned_byte_16;
2002 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
2003 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
2004 scav_vector_unsigned_byte_32;
2006 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2007 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
2008 scav_vector_unsigned_byte_32;
2010 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
2011 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
2012 scav_vector_unsigned_byte_64;
2014 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
2015 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
2016 scav_vector_unsigned_byte_64;
2018 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
2019 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
2020 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2021 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
2023 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2024 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
2025 scav_vector_complex_single_float;
2027 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2028 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
2029 scav_vector_complex_double_float;
2031 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2032 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
2033 scav_vector_complex_long_float;
2035 scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
2036 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
2037 scavtab[COMPLEX_CHARACTER_STRING_WIDETAG] = scav_boxed;
2039 scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
2040 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
2041 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
2042 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
2043 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
2044 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
2045 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
2046 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
2048 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
2049 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
2050 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
2052 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
2054 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
2055 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
2056 scavtab[CHARACTER_WIDETAG] = scav_immediate;
2057 scavtab[SAP_WIDETAG] = scav_unboxed;
2058 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
2059 scavtab[NO_TLS_VALUE_MARKER_WIDETAG] = scav_immediate;
2060 scavtab[INSTANCE_HEADER_WIDETAG] = scav_instance;
2061 #if defined(LISP_FEATURE_SPARC)
2062 scavtab[FDEFN_WIDETAG] = scav_boxed;
2064 scavtab[FDEFN_WIDETAG] = scav_fdefn;
2066 scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector;
2068 /* transport other table, initialized same way as scavtab */
2069 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
2070 transother[i] = trans_lose;
2071 transother[BIGNUM_WIDETAG] = trans_unboxed;
2072 transother[RATIO_WIDETAG] = trans_boxed;
2074 #if N_WORD_BITS == 64
2075 transother[SINGLE_FLOAT_WIDETAG] = trans_immediate;
2077 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
2079 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
2080 #ifdef LONG_FLOAT_WIDETAG
2081 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
2083 transother[COMPLEX_WIDETAG] = trans_boxed;
2084 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
2085 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
2087 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
2088 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
2090 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
2091 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
2093 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
2094 transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
2095 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
2096 transother[SIMPLE_CHARACTER_STRING_WIDETAG] = trans_character_string;
2098 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
2099 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
2100 transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
2101 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
2102 trans_vector_unsigned_byte_2;
2103 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
2104 trans_vector_unsigned_byte_4;
2105 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
2106 trans_vector_unsigned_byte_8;
2107 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
2108 trans_vector_unsigned_byte_8;
2109 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
2110 trans_vector_unsigned_byte_16;
2111 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
2112 trans_vector_unsigned_byte_16;
2113 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
2114 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
2115 trans_vector_unsigned_byte_32;
2117 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
2118 trans_vector_unsigned_byte_32;
2119 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
2120 trans_vector_unsigned_byte_32;
2121 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
2122 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
2123 trans_vector_unsigned_byte_64;
2125 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
2126 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
2127 trans_vector_unsigned_byte_64;
2129 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
2130 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
2131 trans_vector_unsigned_byte_64;
2133 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
2134 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
2135 trans_vector_unsigned_byte_8;
2137 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
2138 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
2139 trans_vector_unsigned_byte_16;
2141 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
2142 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
2143 trans_vector_unsigned_byte_32;
2145 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2146 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
2147 trans_vector_unsigned_byte_32;
2149 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
2150 transother[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
2151 trans_vector_unsigned_byte_64;
2153 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
2154 transother[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
2155 trans_vector_unsigned_byte_64;
2157 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
2158 trans_vector_single_float;
2159 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
2160 trans_vector_double_float;
2161 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2162 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
2163 trans_vector_long_float;
2165 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2166 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
2167 trans_vector_complex_single_float;
2169 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2170 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
2171 trans_vector_complex_double_float;
2173 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2174 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
2175 trans_vector_complex_long_float;
2177 transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
2178 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
2179 transother[COMPLEX_CHARACTER_STRING_WIDETAG] = trans_boxed;
2181 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
2182 transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
2183 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
2184 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
2185 transother[CODE_HEADER_WIDETAG] = trans_code_header;
2186 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
2187 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
2188 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
2189 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
2190 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
2191 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
2192 transother[CHARACTER_WIDETAG] = trans_immediate;
2193 transother[SAP_WIDETAG] = trans_unboxed;
2194 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
2195 transother[NO_TLS_VALUE_MARKER_WIDETAG] = trans_immediate;
2196 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
2197 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
2198 transother[FDEFN_WIDETAG] = trans_boxed;
2200 /* size table, initialized the same way as scavtab */
2201 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
2202 sizetab[i] = size_lose;
2203 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
2204 sizetab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
2205 sizetab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2206 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
2207 sizetab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2208 sizetab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
2209 sizetab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2210 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
2211 sizetab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
2213 sizetab[BIGNUM_WIDETAG] = size_unboxed;
2214 sizetab[RATIO_WIDETAG] = size_boxed;
2215 #if N_WORD_BITS == 64
2216 sizetab[SINGLE_FLOAT_WIDETAG] = size_immediate;
2218 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
2220 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
2221 #ifdef LONG_FLOAT_WIDETAG
2222 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
2224 sizetab[COMPLEX_WIDETAG] = size_boxed;
2225 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
2226 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
2228 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
2229 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
2231 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
2232 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
2234 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
2235 sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
2236 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
2237 sizetab[SIMPLE_CHARACTER_STRING_WIDETAG] = size_character_string;
2239 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
2240 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
2241 sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
2242 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
2243 size_vector_unsigned_byte_2;
2244 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
2245 size_vector_unsigned_byte_4;
2246 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
2247 size_vector_unsigned_byte_8;
2248 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
2249 size_vector_unsigned_byte_8;
2250 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
2251 size_vector_unsigned_byte_16;
2252 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
2253 size_vector_unsigned_byte_16;
2254 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
2255 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
2256 size_vector_unsigned_byte_32;
2258 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
2259 size_vector_unsigned_byte_32;
2260 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
2261 size_vector_unsigned_byte_32;
2262 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
2263 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
2264 size_vector_unsigned_byte_64;
2266 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
2267 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
2268 size_vector_unsigned_byte_64;
2270 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
2271 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
2272 size_vector_unsigned_byte_64;
2274 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
2275 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
2277 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
2278 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
2279 size_vector_unsigned_byte_16;
2281 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
2282 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
2283 size_vector_unsigned_byte_32;
2285 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2286 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
2287 size_vector_unsigned_byte_32;
2289 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
2290 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
2291 size_vector_unsigned_byte_64;
2293 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
2294 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
2295 size_vector_unsigned_byte_64;
2297 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
2298 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
2299 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2300 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
2302 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2303 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
2304 size_vector_complex_single_float;
2306 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2307 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
2308 size_vector_complex_double_float;
2310 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2311 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
2312 size_vector_complex_long_float;
2314 sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
2315 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
2316 sizetab[COMPLEX_CHARACTER_STRING_WIDETAG] = size_boxed;
2318 sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
2319 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
2320 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
2321 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
2322 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
2324 /* We shouldn't see these, so just lose if it happens. */
2325 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
2326 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
2328 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
2329 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
2330 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
2331 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
2332 sizetab[CHARACTER_WIDETAG] = size_immediate;
2333 sizetab[SAP_WIDETAG] = size_unboxed;
2334 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
2335 sizetab[NO_TLS_VALUE_MARKER_WIDETAG] = size_immediate;
2336 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
2337 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
2338 sizetab[FDEFN_WIDETAG] = size_boxed;
2342 /* Find the code object for the given pc, or return NULL on
2345 component_ptr_from_pc(lispobj *pc)
2347 lispobj *object = NULL;
2349 if ( (object = search_read_only_space(pc)) )
2351 else if ( (object = search_static_space(pc)) )
2354 object = search_dynamic_space(pc);
2356 if (object) /* if we found something */
2357 if (widetag_of(*object) == CODE_HEADER_WIDETAG)
2363 /* Scan an area looking for an object which encloses the given pointer.
2364 * Return the object start on success or NULL on failure. */
2366 gc_search_space(lispobj *start, size_t words, lispobj *pointer)
2370 lispobj thing = *start;
2372 /* If thing is an immediate then this is a cons. */
2373 if (is_lisp_pointer(thing) || is_lisp_immediate(thing))
2376 count = (sizetab[widetag_of(thing)])(start);
2378 /* Check whether the pointer is within this object. */
2379 if ((pointer >= start) && (pointer < (start+count))) {
2381 /*FSHOW((stderr,"/found %x in %x %x\n", pointer, start, thing));*/
2385 /* Round up the count. */
2386 count = CEILING(count,2);
2395 maybe_gc(os_context_t *context)
2397 #ifndef LISP_FEATURE_WIN32
2398 struct thread *thread = arch_os_get_current_thread();
2401 fake_foreign_function_call(context);
2402 /* SUB-GC may return without GCing if *GC-INHIBIT* is set, in
2403 * which case we will be running with no gc trigger barrier
2404 * thing for a while. But it shouldn't be long until the end
2407 * FIXME: It would be good to protect the end of dynamic space for
2408 * CheneyGC and signal a storage condition from there.
2411 /* Restore the signal mask from the interrupted context before
2412 * calling into Lisp if interrupts are enabled. Why not always?
2414 * Suppose there is a WITHOUT-INTERRUPTS block far, far out. If an
2415 * interrupt hits while in SUB-GC, it is deferred and the
2416 * os_context_sigmask of that interrupt is set to block further
2417 * deferrable interrupts (until the first one is
2418 * handled). Unfortunately, that context refers to this place and
2419 * when we return from here the signals will not be blocked.
2421 * A kludgy alternative is to propagate the sigmask change to the
2424 #ifndef LISP_FEATURE_WIN32
2425 if(SymbolValue(INTERRUPTS_ENABLED,thread)!=NIL) {
2426 sigset_t *context_sigmask = os_context_sigmask_addr(context);
2427 #ifdef LISP_FEATURE_SB_THREAD
2428 /* What if the context we'd like to restore has GC signals
2429 * blocked? Just skip the GC: we can't set GC_PENDING, because
2430 * that would block the next attempt, and we don't know when
2431 * we'd next check for it -- and it's hard to be sure that
2432 * unblocking would be safe.
2434 * FIXME: This is not actually much better: we may already have
2435 * GC_PENDING set, and presumably our caller assumes that we will
2436 * clear it. Perhaps we should, even though we don't actually GC? */
2437 if (sigismember(context_sigmask,SIG_STOP_FOR_GC)) {
2438 undo_fake_foreign_function_call(context);
2442 thread_sigmask(SIG_SETMASK, context_sigmask, 0);
2445 unblock_gc_signals();
2447 /* SIG_STOP_FOR_GC needs to be enabled before we can call lisp:
2448 * otherwise two threads racing here may deadlock: the other will
2449 * wait on the GC lock, and the other cannot stop the first one... */
2450 funcall0(StaticSymbolFunction(SUB_GC));
2451 undo_fake_foreign_function_call(context);