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 "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
56 forwarding_pointer_p(lispobj *pointer) {
57 lispobj first_word=*pointer;
58 #ifdef LISP_FEATURE_GENCGC
59 return (first_word == 0x01);
61 return (is_lisp_pointer(first_word)
62 && new_space_p(first_word));
66 static inline lispobj *
67 forwarding_pointer_value(lispobj *pointer) {
68 #ifdef LISP_FEATURE_GENCGC
69 return (lispobj *) ((pointer_sized_uint_t) pointer[1]);
71 return (lispobj *) ((pointer_sized_uint_t) pointer[0]);
75 set_forwarding_pointer(lispobj * pointer, lispobj newspace_copy) {
76 #ifdef LISP_FEATURE_GENCGC
78 pointer[1]=newspace_copy;
80 pointer[0]=newspace_copy;
85 long (*scavtab[256])(lispobj *where, lispobj object);
86 lispobj (*transother[256])(lispobj object);
87 long (*sizetab[256])(lispobj *where);
88 struct weak_pointer *weak_pointers;
90 unsigned long bytes_consed_between_gcs = 12*1024*1024;
97 /* to copy a boxed object */
99 copy_object(lispobj object, long nwords)
104 gc_assert(is_lisp_pointer(object));
105 gc_assert(from_space_p(object));
106 gc_assert((nwords & 0x01) == 0);
108 /* Get tag of object. */
109 tag = lowtag_of(object);
111 /* Allocate space. */
112 new = gc_general_alloc(nwords*N_WORD_BYTES,ALLOC_BOXED,ALLOC_QUICK);
114 /* Copy the object. */
115 memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
116 return make_lispobj(new,tag);
119 static long scav_lose(lispobj *where, lispobj object); /* forward decl */
121 /* FIXME: Most calls end up going to some trouble to compute an
122 * 'n_words' value for this function. The system might be a little
123 * simpler if this function used an 'end' parameter instead. */
125 scavenge(lispobj *start, long n_words)
127 lispobj *end = start + n_words;
129 long n_words_scavenged;
131 for (object_ptr = start;
133 object_ptr += n_words_scavenged) {
135 lispobj object = *object_ptr;
136 #ifdef LISP_FEATURE_GENCGC
137 gc_assert(!forwarding_pointer_p(object_ptr));
139 if (is_lisp_pointer(object)) {
140 if (from_space_p(object)) {
141 /* It currently points to old space. Check for a
142 * forwarding pointer. */
143 lispobj *ptr = native_pointer(object);
144 if (forwarding_pointer_p(ptr)) {
145 /* Yes, there's a forwarding pointer. */
146 *object_ptr = LOW_WORD(forwarding_pointer_value(ptr));
147 n_words_scavenged = 1;
149 /* Scavenge that pointer. */
151 (scavtab[widetag_of(object)])(object_ptr, object);
154 /* It points somewhere other than oldspace. Leave it
156 n_words_scavenged = 1;
159 #ifndef LISP_FEATURE_GENCGC
160 /* this workaround is probably not necessary for gencgc; at least, the
161 * behaviour it describes has never been reported */
162 else if (n_words==1) {
163 /* there are some situations where an
164 other-immediate may end up in a descriptor
165 register. I'm not sure whether this is
166 supposed to happen, but if it does then we
167 don't want to (a) barf or (b) scavenge over the
168 data-block, because there isn't one. So, if
169 we're checking a single word and it's anything
170 other than a pointer, just hush it up */
171 int type=widetag_of(object);
174 if ((scavtab[type]==scav_lose) ||
175 (((scavtab[type])(start,object))>1)) {
176 fprintf(stderr,"warning: attempted to scavenge non-descriptor value %x at %p. If you can\nreproduce this warning, send a bug report (see manual page for details)\n",
181 else if (fixnump(object)) {
182 /* It's a fixnum: really easy.. */
183 n_words_scavenged = 1;
185 /* It's some sort of header object or another. */
187 (scavtab[widetag_of(object)])(object_ptr, object);
190 gc_assert_verbose(object_ptr == end, "Final object pointer %p, start %p, end %p\n",
191 object_ptr, start, end);
194 static lispobj trans_fun_header(lispobj object); /* forward decls */
195 static lispobj trans_boxed(lispobj object);
198 scav_fun_pointer(lispobj *where, lispobj object)
200 lispobj *first_pointer;
203 gc_assert(is_lisp_pointer(object));
205 /* Object is a pointer into from_space - not a FP. */
206 first_pointer = (lispobj *) native_pointer(object);
208 /* must transport object -- object may point to either a function
209 * header, a closure function header, or to a closure header. */
211 switch (widetag_of(*first_pointer)) {
212 case SIMPLE_FUN_HEADER_WIDETAG:
213 copy = trans_fun_header(object);
216 copy = trans_boxed(object);
220 if (copy != object) {
221 /* Set forwarding pointer */
222 set_forwarding_pointer(first_pointer,copy);
225 gc_assert(is_lisp_pointer(copy));
226 gc_assert(!from_space_p(copy));
235 trans_code(struct code *code)
237 struct code *new_code;
238 lispobj first, l_code, l_new_code;
239 long nheader_words, ncode_words, nwords;
240 unsigned long displacement;
241 lispobj fheaderl, *prev_pointer;
243 /* if object has already been transported, just return pointer */
244 first = code->header;
245 if (forwarding_pointer_p((lispobj *)code)) {
247 printf("Was already transported\n");
249 return (struct code *) forwarding_pointer_value
250 ((lispobj *)((pointer_sized_uint_t) code));
253 gc_assert(widetag_of(first) == CODE_HEADER_WIDETAG);
255 /* prepare to transport the code vector */
256 l_code = (lispobj) LOW_WORD(code) | OTHER_POINTER_LOWTAG;
258 ncode_words = fixnum_value(code->code_size);
259 nheader_words = HeaderValue(code->header);
260 nwords = ncode_words + nheader_words;
261 nwords = CEILING(nwords, 2);
263 l_new_code = copy_object(l_code, nwords);
264 new_code = (struct code *) native_pointer(l_new_code);
266 #if defined(DEBUG_CODE_GC)
267 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
268 (unsigned long) code, (unsigned long) new_code);
269 printf("Code object is %d words long.\n", nwords);
272 #ifdef LISP_FEATURE_GENCGC
273 if (new_code == code)
277 displacement = l_new_code - l_code;
279 set_forwarding_pointer((lispobj *)code, l_new_code);
281 /* set forwarding pointers for all the function headers in the */
282 /* code object. also fix all self pointers */
284 fheaderl = code->entry_points;
285 prev_pointer = &new_code->entry_points;
287 while (fheaderl != NIL) {
288 struct simple_fun *fheaderp, *nfheaderp;
291 fheaderp = (struct simple_fun *) native_pointer(fheaderl);
292 gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
294 /* Calculate the new function pointer and the new */
295 /* function header. */
296 nfheaderl = fheaderl + displacement;
297 nfheaderp = (struct simple_fun *) native_pointer(nfheaderl);
300 printf("fheaderp->header (at %x) <- %x\n",
301 &(fheaderp->header) , nfheaderl);
303 set_forwarding_pointer((lispobj *)fheaderp, nfheaderl);
305 /* fix self pointer. */
307 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
308 FUN_RAW_ADDR_OFFSET +
312 *prev_pointer = nfheaderl;
314 fheaderl = fheaderp->next;
315 prev_pointer = &nfheaderp->next;
317 #ifdef LISP_FEATURE_GENCGC
318 /* Cheneygc doesn't need this os_flush_icache, it flushes the whole
319 spaces once when all copying is done. */
320 os_flush_icache((os_vm_address_t) (((long *)new_code) + nheader_words),
321 ncode_words * sizeof(long));
325 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
326 gencgc_apply_code_fixups(code, new_code);
333 scav_code_header(lispobj *where, lispobj object)
336 long n_header_words, n_code_words, n_words;
337 lispobj entry_point; /* tagged pointer to entry point */
338 struct simple_fun *function_ptr; /* untagged pointer to entry point */
340 code = (struct code *) where;
341 n_code_words = fixnum_value(code->code_size);
342 n_header_words = HeaderValue(object);
343 n_words = n_code_words + n_header_words;
344 n_words = CEILING(n_words, 2);
346 /* Scavenge the boxed section of the code data block. */
347 scavenge(where + 1, n_header_words - 1);
349 /* Scavenge the boxed section of each function object in the
350 * code data block. */
351 for (entry_point = code->entry_points;
353 entry_point = function_ptr->next) {
355 gc_assert_verbose(is_lisp_pointer(entry_point), "Entry point %lx\n",
358 function_ptr = (struct simple_fun *) native_pointer(entry_point);
359 gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
361 scavenge(&function_ptr->name, 1);
362 scavenge(&function_ptr->arglist, 1);
363 scavenge(&function_ptr->type, 1);
370 trans_code_header(lispobj object)
374 ncode = trans_code((struct code *) native_pointer(object));
375 return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG;
380 size_code_header(lispobj *where)
383 long nheader_words, ncode_words, nwords;
385 code = (struct code *) where;
387 ncode_words = fixnum_value(code->code_size);
388 nheader_words = HeaderValue(code->header);
389 nwords = ncode_words + nheader_words;
390 nwords = CEILING(nwords, 2);
395 #if !defined(LISP_FEATURE_X86) && ! defined(LISP_FEATURE_X86_64)
397 scav_return_pc_header(lispobj *where, lispobj object)
399 lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x\n",
400 (unsigned long) where,
401 (unsigned long) object);
402 return 0; /* bogus return value to satisfy static type checking */
404 #endif /* LISP_FEATURE_X86 */
407 trans_return_pc_header(lispobj object)
409 struct simple_fun *return_pc;
410 unsigned long offset;
411 struct code *code, *ncode;
413 return_pc = (struct simple_fun *) native_pointer(object);
414 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
415 offset = HeaderValue(return_pc->header) * N_WORD_BYTES;
417 /* Transport the whole code object */
418 code = (struct code *) ((unsigned long) return_pc - offset);
419 ncode = trans_code(code);
421 return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
424 /* On the 386, closures hold a pointer to the raw address instead of the
425 * function object, so we can use CALL [$FDEFN+const] to invoke
426 * the function without loading it into a register. Given that code
427 * objects don't move, we don't need to update anything, but we do
428 * have to figure out that the function is still live. */
430 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
432 scav_closure_header(lispobj *where, lispobj object)
434 struct closure *closure;
437 closure = (struct closure *)where;
438 fun = closure->fun - FUN_RAW_ADDR_OFFSET;
440 #ifdef LISP_FEATURE_GENCGC
441 /* The function may have moved so update the raw address. But
442 * don't write unnecessarily. */
443 if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
444 closure->fun = fun + FUN_RAW_ADDR_OFFSET;
450 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
452 scav_fun_header(lispobj *where, lispobj object)
454 lose("attempted to scavenge a function header where=0x%08x object=0x%08x\n",
455 (unsigned long) where,
456 (unsigned long) object);
457 return 0; /* bogus return value to satisfy static type checking */
459 #endif /* LISP_FEATURE_X86 */
462 trans_fun_header(lispobj object)
464 struct simple_fun *fheader;
465 unsigned long offset;
466 struct code *code, *ncode;
468 fheader = (struct simple_fun *) native_pointer(object);
469 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
470 offset = HeaderValue(fheader->header) * N_WORD_BYTES;
472 /* Transport the whole code object */
473 code = (struct code *) ((unsigned long) fheader - offset);
474 ncode = trans_code(code);
476 return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
485 scav_instance_pointer(lispobj *where, lispobj object)
487 lispobj copy, *first_pointer;
489 /* Object is a pointer into from space - not a FP. */
490 copy = trans_boxed(object);
492 #ifdef LISP_FEATURE_GENCGC
493 gc_assert(copy != object);
496 first_pointer = (lispobj *) native_pointer(object);
497 set_forwarding_pointer(first_pointer,copy);
508 static lispobj trans_list(lispobj object);
511 scav_list_pointer(lispobj *where, lispobj object)
513 lispobj first, *first_pointer;
515 gc_assert(is_lisp_pointer(object));
517 /* Object is a pointer into from space - not FP. */
518 first_pointer = (lispobj *) native_pointer(object);
520 first = trans_list(object);
521 gc_assert(first != object);
523 /* Set forwarding pointer */
524 set_forwarding_pointer(first_pointer, first);
526 gc_assert(is_lisp_pointer(first));
527 gc_assert(!from_space_p(first));
535 trans_list(lispobj object)
537 lispobj new_list_pointer;
538 struct cons *cons, *new_cons;
541 cons = (struct cons *) native_pointer(object);
544 new_cons = (struct cons *)
545 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
546 new_cons->car = cons->car;
547 new_cons->cdr = cons->cdr; /* updated later */
548 new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
550 /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC */
553 set_forwarding_pointer((lispobj *)cons, new_list_pointer);
555 /* Try to linearize the list in the cdr direction to help reduce
559 struct cons *cdr_cons, *new_cdr_cons;
561 if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
562 !from_space_p(cdr) ||
563 forwarding_pointer_p((lispobj *)native_pointer(cdr)))
566 cdr_cons = (struct cons *) native_pointer(cdr);
569 new_cdr_cons = (struct cons*)
570 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
571 new_cdr_cons->car = cdr_cons->car;
572 new_cdr_cons->cdr = cdr_cons->cdr;
573 new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
575 /* Grab the cdr before it is clobbered. */
577 set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
579 /* Update the cdr of the last cons copied into new space to
580 * keep the newspace scavenge from having to do it. */
581 new_cons->cdr = new_cdr;
583 new_cons = new_cdr_cons;
586 return new_list_pointer;
591 * scavenging and transporting other pointers
595 scav_other_pointer(lispobj *where, lispobj object)
597 lispobj first, *first_pointer;
599 gc_assert(is_lisp_pointer(object));
601 /* Object is a pointer into from space - not FP. */
602 first_pointer = (lispobj *) native_pointer(object);
603 first = (transother[widetag_of(*first_pointer)])(object);
605 if (first != object) {
606 set_forwarding_pointer(first_pointer, first);
607 #ifdef LISP_FEATURE_GENCGC
611 #ifndef LISP_FEATURE_GENCGC
614 gc_assert(is_lisp_pointer(first));
615 gc_assert(!from_space_p(first));
621 * immediate, boxed, and unboxed objects
625 size_pointer(lispobj *where)
631 scav_immediate(lispobj *where, lispobj object)
637 trans_immediate(lispobj object)
639 lose("trying to transport an immediate\n");
640 return NIL; /* bogus return value to satisfy static type checking */
644 size_immediate(lispobj *where)
651 scav_boxed(lispobj *where, lispobj object)
657 scav_instance(lispobj *where, lispobj object)
660 long ntotal = HeaderValue(object);
661 lispobj layout = ((struct instance *)where)->slots[0];
665 if (forwarding_pointer_p(native_pointer(layout)))
666 layout = (lispobj) forwarding_pointer_value(native_pointer(layout));
668 nuntagged = ((struct layout *)native_pointer(layout))->n_untagged_slots;
669 scavenge(where + 1, ntotal - fixnum_value(nuntagged));
675 trans_boxed(lispobj object)
678 unsigned long length;
680 gc_assert(is_lisp_pointer(object));
682 header = *((lispobj *) native_pointer(object));
683 length = HeaderValue(header) + 1;
684 length = CEILING(length, 2);
686 return copy_object(object, length);
691 size_boxed(lispobj *where)
694 unsigned long length;
697 length = HeaderValue(header) + 1;
698 length = CEILING(length, 2);
703 /* Note: on the sparc we don't have to do anything special for fdefns, */
704 /* 'cause the raw-addr has a function lowtag. */
705 #if !defined(LISP_FEATURE_SPARC)
707 scav_fdefn(lispobj *where, lispobj object)
711 fdefn = (struct fdefn *)where;
713 /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
714 fdefn->fun, fdefn->raw_addr)); */
716 if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)
717 == (char *)((unsigned long)(fdefn->raw_addr))) {
718 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
720 /* Don't write unnecessarily. */
721 if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
722 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
723 /* gc.c has more casts here, which may be relevant or alternatively
724 may be compiler warning defeaters. try
725 fdefn->raw_addr = ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
727 return sizeof(struct fdefn) / sizeof(lispobj);
735 scav_unboxed(lispobj *where, lispobj object)
737 unsigned long length;
739 length = HeaderValue(object) + 1;
740 length = CEILING(length, 2);
746 trans_unboxed(lispobj object)
749 unsigned long length;
752 gc_assert(is_lisp_pointer(object));
754 header = *((lispobj *) native_pointer(object));
755 length = HeaderValue(header) + 1;
756 length = CEILING(length, 2);
758 return copy_unboxed_object(object, length);
762 size_unboxed(lispobj *where)
765 unsigned long length;
768 length = HeaderValue(header) + 1;
769 length = CEILING(length, 2);
775 /* vector-like objects */
777 scav_base_string(lispobj *where, lispobj object)
779 struct vector *vector;
782 /* NOTE: Strings contain one more byte of data than the length */
783 /* slot indicates. */
785 vector = (struct vector *) where;
786 length = fixnum_value(vector->length) + 1;
787 nwords = CEILING(NWORDS(length, 8) + 2, 2);
792 trans_base_string(lispobj object)
794 struct vector *vector;
797 gc_assert(is_lisp_pointer(object));
799 /* NOTE: A string contains one more byte of data (a terminating
800 * '\0' to help when interfacing with C functions) than indicated
801 * by the length slot. */
803 vector = (struct vector *) native_pointer(object);
804 length = fixnum_value(vector->length) + 1;
805 nwords = CEILING(NWORDS(length, 8) + 2, 2);
807 return copy_large_unboxed_object(object, nwords);
811 size_base_string(lispobj *where)
813 struct vector *vector;
816 /* NOTE: A string contains one more byte of data (a terminating
817 * '\0' to help when interfacing with C functions) than indicated
818 * by the length slot. */
820 vector = (struct vector *) where;
821 length = fixnum_value(vector->length) + 1;
822 nwords = CEILING(NWORDS(length, 8) + 2, 2);
828 scav_character_string(lispobj *where, lispobj object)
830 struct vector *vector;
833 /* NOTE: Strings contain one more byte of data than the length */
834 /* slot indicates. */
836 vector = (struct vector *) where;
837 length = fixnum_value(vector->length) + 1;
838 nwords = CEILING(NWORDS(length, 32) + 2, 2);
843 trans_character_string(lispobj object)
845 struct vector *vector;
848 gc_assert(is_lisp_pointer(object));
850 /* NOTE: A string contains one more byte of data (a terminating
851 * '\0' to help when interfacing with C functions) than indicated
852 * by the length slot. */
854 vector = (struct vector *) native_pointer(object);
855 length = fixnum_value(vector->length) + 1;
856 nwords = CEILING(NWORDS(length, 32) + 2, 2);
858 return copy_large_unboxed_object(object, nwords);
862 size_character_string(lispobj *where)
864 struct vector *vector;
867 /* NOTE: A string contains one more byte of data (a terminating
868 * '\0' to help when interfacing with C functions) than indicated
869 * by the length slot. */
871 vector = (struct vector *) where;
872 length = fixnum_value(vector->length) + 1;
873 nwords = CEILING(NWORDS(length, 32) + 2, 2);
879 trans_vector(lispobj object)
881 struct vector *vector;
884 gc_assert(is_lisp_pointer(object));
886 vector = (struct vector *) native_pointer(object);
888 length = fixnum_value(vector->length);
889 nwords = CEILING(length + 2, 2);
891 return copy_large_object(object, nwords);
895 size_vector(lispobj *where)
897 struct vector *vector;
900 vector = (struct vector *) where;
901 length = fixnum_value(vector->length);
902 nwords = CEILING(length + 2, 2);
908 scav_vector_nil(lispobj *where, lispobj object)
914 trans_vector_nil(lispobj object)
916 gc_assert(is_lisp_pointer(object));
917 return copy_unboxed_object(object, 2);
921 size_vector_nil(lispobj *where)
923 /* Just the header word and the length word */
928 scav_vector_bit(lispobj *where, lispobj object)
930 struct vector *vector;
933 vector = (struct vector *) where;
934 length = fixnum_value(vector->length);
935 nwords = CEILING(NWORDS(length, 1) + 2, 2);
941 trans_vector_bit(lispobj object)
943 struct vector *vector;
946 gc_assert(is_lisp_pointer(object));
948 vector = (struct vector *) native_pointer(object);
949 length = fixnum_value(vector->length);
950 nwords = CEILING(NWORDS(length, 1) + 2, 2);
952 return copy_large_unboxed_object(object, nwords);
956 size_vector_bit(lispobj *where)
958 struct vector *vector;
961 vector = (struct vector *) where;
962 length = fixnum_value(vector->length);
963 nwords = CEILING(NWORDS(length, 1) + 2, 2);
969 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
971 struct vector *vector;
974 vector = (struct vector *) where;
975 length = fixnum_value(vector->length);
976 nwords = CEILING(NWORDS(length, 2) + 2, 2);
982 trans_vector_unsigned_byte_2(lispobj object)
984 struct vector *vector;
987 gc_assert(is_lisp_pointer(object));
989 vector = (struct vector *) native_pointer(object);
990 length = fixnum_value(vector->length);
991 nwords = CEILING(NWORDS(length, 2) + 2, 2);
993 return copy_large_unboxed_object(object, nwords);
997 size_vector_unsigned_byte_2(lispobj *where)
999 struct vector *vector;
1000 long length, nwords;
1002 vector = (struct vector *) where;
1003 length = fixnum_value(vector->length);
1004 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1010 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
1012 struct vector *vector;
1013 long length, nwords;
1015 vector = (struct vector *) where;
1016 length = fixnum_value(vector->length);
1017 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1023 trans_vector_unsigned_byte_4(lispobj object)
1025 struct vector *vector;
1026 long length, nwords;
1028 gc_assert(is_lisp_pointer(object));
1030 vector = (struct vector *) native_pointer(object);
1031 length = fixnum_value(vector->length);
1032 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1034 return copy_large_unboxed_object(object, nwords);
1037 size_vector_unsigned_byte_4(lispobj *where)
1039 struct vector *vector;
1040 long length, nwords;
1042 vector = (struct vector *) where;
1043 length = fixnum_value(vector->length);
1044 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1051 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
1053 struct vector *vector;
1054 long length, nwords;
1056 vector = (struct vector *) where;
1057 length = fixnum_value(vector->length);
1058 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1063 /*********************/
1068 trans_vector_unsigned_byte_8(lispobj object)
1070 struct vector *vector;
1071 long length, nwords;
1073 gc_assert(is_lisp_pointer(object));
1075 vector = (struct vector *) native_pointer(object);
1076 length = fixnum_value(vector->length);
1077 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1079 return copy_large_unboxed_object(object, nwords);
1083 size_vector_unsigned_byte_8(lispobj *where)
1085 struct vector *vector;
1086 long length, nwords;
1088 vector = (struct vector *) where;
1089 length = fixnum_value(vector->length);
1090 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1097 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1099 struct vector *vector;
1100 long length, nwords;
1102 vector = (struct vector *) where;
1103 length = fixnum_value(vector->length);
1104 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1110 trans_vector_unsigned_byte_16(lispobj object)
1112 struct vector *vector;
1113 long length, nwords;
1115 gc_assert(is_lisp_pointer(object));
1117 vector = (struct vector *) native_pointer(object);
1118 length = fixnum_value(vector->length);
1119 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1121 return copy_large_unboxed_object(object, nwords);
1125 size_vector_unsigned_byte_16(lispobj *where)
1127 struct vector *vector;
1128 long length, nwords;
1130 vector = (struct vector *) where;
1131 length = fixnum_value(vector->length);
1132 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1138 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1140 struct vector *vector;
1141 long length, nwords;
1143 vector = (struct vector *) where;
1144 length = fixnum_value(vector->length);
1145 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1151 trans_vector_unsigned_byte_32(lispobj object)
1153 struct vector *vector;
1154 long length, nwords;
1156 gc_assert(is_lisp_pointer(object));
1158 vector = (struct vector *) native_pointer(object);
1159 length = fixnum_value(vector->length);
1160 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1162 return copy_large_unboxed_object(object, nwords);
1166 size_vector_unsigned_byte_32(lispobj *where)
1168 struct vector *vector;
1169 long length, nwords;
1171 vector = (struct vector *) where;
1172 length = fixnum_value(vector->length);
1173 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1178 #if N_WORD_BITS == 64
1180 scav_vector_unsigned_byte_64(lispobj *where, lispobj object)
1182 struct vector *vector;
1183 long length, nwords;
1185 vector = (struct vector *) where;
1186 length = fixnum_value(vector->length);
1187 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1193 trans_vector_unsigned_byte_64(lispobj object)
1195 struct vector *vector;
1196 long length, nwords;
1198 gc_assert(is_lisp_pointer(object));
1200 vector = (struct vector *) native_pointer(object);
1201 length = fixnum_value(vector->length);
1202 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1204 return copy_large_unboxed_object(object, nwords);
1208 size_vector_unsigned_byte_64(lispobj *where)
1210 struct vector *vector;
1211 long length, nwords;
1213 vector = (struct vector *) where;
1214 length = fixnum_value(vector->length);
1215 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1222 scav_vector_single_float(lispobj *where, lispobj object)
1224 struct vector *vector;
1225 long length, nwords;
1227 vector = (struct vector *) where;
1228 length = fixnum_value(vector->length);
1229 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1235 trans_vector_single_float(lispobj object)
1237 struct vector *vector;
1238 long length, nwords;
1240 gc_assert(is_lisp_pointer(object));
1242 vector = (struct vector *) native_pointer(object);
1243 length = fixnum_value(vector->length);
1244 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1246 return copy_large_unboxed_object(object, nwords);
1250 size_vector_single_float(lispobj *where)
1252 struct vector *vector;
1253 long length, nwords;
1255 vector = (struct vector *) where;
1256 length = fixnum_value(vector->length);
1257 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1263 scav_vector_double_float(lispobj *where, lispobj object)
1265 struct vector *vector;
1266 long length, nwords;
1268 vector = (struct vector *) where;
1269 length = fixnum_value(vector->length);
1270 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1276 trans_vector_double_float(lispobj object)
1278 struct vector *vector;
1279 long length, nwords;
1281 gc_assert(is_lisp_pointer(object));
1283 vector = (struct vector *) native_pointer(object);
1284 length = fixnum_value(vector->length);
1285 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1287 return copy_large_unboxed_object(object, nwords);
1291 size_vector_double_float(lispobj *where)
1293 struct vector *vector;
1294 long length, nwords;
1296 vector = (struct vector *) where;
1297 length = fixnum_value(vector->length);
1298 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1303 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1305 scav_vector_long_float(lispobj *where, lispobj object)
1307 struct vector *vector;
1308 long length, nwords;
1310 vector = (struct vector *) where;
1311 length = fixnum_value(vector->length);
1312 nwords = CEILING(length *
1319 trans_vector_long_float(lispobj object)
1321 struct vector *vector;
1322 long length, nwords;
1324 gc_assert(is_lisp_pointer(object));
1326 vector = (struct vector *) native_pointer(object);
1327 length = fixnum_value(vector->length);
1328 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1330 return copy_large_unboxed_object(object, nwords);
1334 size_vector_long_float(lispobj *where)
1336 struct vector *vector;
1337 long length, nwords;
1339 vector = (struct vector *) where;
1340 length = fixnum_value(vector->length);
1341 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1348 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1350 scav_vector_complex_single_float(lispobj *where, lispobj object)
1352 struct vector *vector;
1353 long length, nwords;
1355 vector = (struct vector *) where;
1356 length = fixnum_value(vector->length);
1357 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1363 trans_vector_complex_single_float(lispobj object)
1365 struct vector *vector;
1366 long length, nwords;
1368 gc_assert(is_lisp_pointer(object));
1370 vector = (struct vector *) native_pointer(object);
1371 length = fixnum_value(vector->length);
1372 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1374 return copy_large_unboxed_object(object, nwords);
1378 size_vector_complex_single_float(lispobj *where)
1380 struct vector *vector;
1381 long length, nwords;
1383 vector = (struct vector *) where;
1384 length = fixnum_value(vector->length);
1385 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1391 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1393 scav_vector_complex_double_float(lispobj *where, lispobj object)
1395 struct vector *vector;
1396 long length, nwords;
1398 vector = (struct vector *) where;
1399 length = fixnum_value(vector->length);
1400 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1406 trans_vector_complex_double_float(lispobj object)
1408 struct vector *vector;
1409 long length, nwords;
1411 gc_assert(is_lisp_pointer(object));
1413 vector = (struct vector *) native_pointer(object);
1414 length = fixnum_value(vector->length);
1415 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1417 return copy_large_unboxed_object(object, nwords);
1421 size_vector_complex_double_float(lispobj *where)
1423 struct vector *vector;
1424 long length, nwords;
1426 vector = (struct vector *) where;
1427 length = fixnum_value(vector->length);
1428 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1435 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1437 scav_vector_complex_long_float(lispobj *where, lispobj object)
1439 struct vector *vector;
1440 long length, nwords;
1442 vector = (struct vector *) where;
1443 length = fixnum_value(vector->length);
1444 nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1450 trans_vector_complex_long_float(lispobj object)
1452 struct vector *vector;
1453 long length, nwords;
1455 gc_assert(is_lisp_pointer(object));
1457 vector = (struct vector *) native_pointer(object);
1458 length = fixnum_value(vector->length);
1459 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1461 return copy_large_unboxed_object(object, nwords);
1465 size_vector_complex_long_float(lispobj *where)
1467 struct vector *vector;
1468 long length, nwords;
1470 vector = (struct vector *) where;
1471 length = fixnum_value(vector->length);
1472 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1478 #define WEAK_POINTER_NWORDS \
1479 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1482 trans_weak_pointer(lispobj object)
1485 #ifndef LISP_FEATURE_GENCGC
1486 struct weak_pointer *wp;
1488 gc_assert(is_lisp_pointer(object));
1490 #if defined(DEBUG_WEAK)
1491 printf("Transporting weak pointer from 0x%08x\n", object);
1494 /* Need to remember where all the weak pointers are that have */
1495 /* been transported so they can be fixed up in a post-GC pass. */
1497 copy = copy_object(object, WEAK_POINTER_NWORDS);
1498 #ifndef LISP_FEATURE_GENCGC
1499 wp = (struct weak_pointer *) native_pointer(copy);
1501 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1502 /* Push the weak pointer onto the list of weak pointers. */
1503 wp->next = (struct weak_pointer *)LOW_WORD(weak_pointers);
1510 size_weak_pointer(lispobj *where)
1512 return WEAK_POINTER_NWORDS;
1516 void scan_weak_pointers(void)
1518 struct weak_pointer *wp;
1519 for (wp = weak_pointers; wp != NULL; wp=wp->next) {
1520 lispobj value = wp->value;
1521 lispobj *first_pointer;
1522 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1523 if (!(is_lisp_pointer(value) && from_space_p(value)))
1526 /* Now, we need to check whether the object has been forwarded. If
1527 * it has been, the weak pointer is still good and needs to be
1528 * updated. Otherwise, the weak pointer needs to be nil'ed
1531 first_pointer = (lispobj *)native_pointer(value);
1533 if (forwarding_pointer_p(first_pointer)) {
1535 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1551 scav_lose(lispobj *where, lispobj object)
1553 lose("no scavenge function for object 0x%08x (widetag 0x%x)\n",
1554 (unsigned long)object,
1555 widetag_of(*(lispobj*)native_pointer(object)));
1557 return 0; /* bogus return value to satisfy static type checking */
1561 trans_lose(lispobj object)
1563 lose("no transport function for object 0x%08x (widetag 0x%x)\n",
1564 (unsigned long)object,
1565 widetag_of(*(lispobj*)native_pointer(object)));
1566 return NIL; /* bogus return value to satisfy static type checking */
1570 size_lose(lispobj *where)
1572 lose("no size function for object at 0x%08x (widetag 0x%x)\n",
1573 (unsigned long)where,
1574 widetag_of(LOW_WORD(where)));
1575 return 1; /* bogus return value to satisfy static type checking */
1584 gc_init_tables(void)
1588 /* Set default value in all slots of scavenge table. FIXME
1589 * replace this gnarly sizeof with something based on
1591 for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) {
1592 scavtab[i] = scav_lose;
1595 /* For each type which can be selected by the lowtag alone, set
1596 * multiple entries in our widetag scavenge table (one for each
1597 * possible value of the high bits).
1600 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1601 scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1602 scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1603 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1604 scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1605 scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1606 scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_instance_pointer;
1607 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1608 scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1611 /* Other-pointer types (those selected by all eight bits of the
1612 * tag) get one entry each in the scavenge table. */
1613 scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1614 scavtab[RATIO_WIDETAG] = scav_boxed;
1615 #if N_WORD_BITS == 64
1616 scavtab[SINGLE_FLOAT_WIDETAG] = scav_immediate;
1618 scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1620 scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1621 #ifdef LONG_FLOAT_WIDETAG
1622 scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1624 scavtab[COMPLEX_WIDETAG] = scav_boxed;
1625 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1626 scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1628 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1629 scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1631 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1632 scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
1634 scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
1635 scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
1636 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1637 scavtab[SIMPLE_CHARACTER_STRING_WIDETAG] = scav_character_string;
1639 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
1640 scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
1641 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1642 scav_vector_unsigned_byte_2;
1643 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1644 scav_vector_unsigned_byte_4;
1645 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1646 scav_vector_unsigned_byte_8;
1647 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1648 scav_vector_unsigned_byte_8;
1649 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1650 scav_vector_unsigned_byte_16;
1651 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1652 scav_vector_unsigned_byte_16;
1653 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1654 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1655 scav_vector_unsigned_byte_32;
1657 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1658 scav_vector_unsigned_byte_32;
1659 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1660 scav_vector_unsigned_byte_32;
1661 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1662 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1663 scav_vector_unsigned_byte_64;
1665 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1666 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1667 scav_vector_unsigned_byte_64;
1669 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1670 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1671 scav_vector_unsigned_byte_64;
1673 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1674 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
1676 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1677 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1678 scav_vector_unsigned_byte_16;
1680 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1681 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1682 scav_vector_unsigned_byte_32;
1684 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1685 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1686 scav_vector_unsigned_byte_32;
1688 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1689 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1690 scav_vector_unsigned_byte_64;
1692 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1693 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1694 scav_vector_unsigned_byte_64;
1696 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
1697 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
1698 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1699 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
1701 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1702 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1703 scav_vector_complex_single_float;
1705 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1706 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1707 scav_vector_complex_double_float;
1709 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1710 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1711 scav_vector_complex_long_float;
1713 scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
1714 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1715 scavtab[COMPLEX_CHARACTER_STRING_WIDETAG] = scav_boxed;
1717 scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
1718 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
1719 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
1720 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
1721 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
1722 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
1723 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
1724 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
1726 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
1727 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
1728 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
1730 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
1731 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
1733 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
1734 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
1735 scavtab[CHARACTER_WIDETAG] = scav_immediate;
1736 scavtab[SAP_WIDETAG] = scav_unboxed;
1737 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
1738 scavtab[NO_TLS_VALUE_MARKER_WIDETAG] = scav_immediate;
1739 scavtab[INSTANCE_HEADER_WIDETAG] = scav_instance;
1740 #if defined(LISP_FEATURE_SPARC)
1741 scavtab[FDEFN_WIDETAG] = scav_boxed;
1743 scavtab[FDEFN_WIDETAG] = scav_fdefn;
1746 /* transport other table, initialized same way as scavtab */
1747 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
1748 transother[i] = trans_lose;
1749 transother[BIGNUM_WIDETAG] = trans_unboxed;
1750 transother[RATIO_WIDETAG] = trans_boxed;
1752 #if N_WORD_BITS == 64
1753 transother[SINGLE_FLOAT_WIDETAG] = trans_immediate;
1755 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1757 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1758 #ifdef LONG_FLOAT_WIDETAG
1759 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
1761 transother[COMPLEX_WIDETAG] = trans_boxed;
1762 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1763 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1765 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1766 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1768 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1769 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
1771 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
1772 transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
1773 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1774 transother[SIMPLE_CHARACTER_STRING_WIDETAG] = trans_character_string;
1776 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
1777 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
1778 transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
1779 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1780 trans_vector_unsigned_byte_2;
1781 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1782 trans_vector_unsigned_byte_4;
1783 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1784 trans_vector_unsigned_byte_8;
1785 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1786 trans_vector_unsigned_byte_8;
1787 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1788 trans_vector_unsigned_byte_16;
1789 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1790 trans_vector_unsigned_byte_16;
1791 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1792 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1793 trans_vector_unsigned_byte_32;
1795 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1796 trans_vector_unsigned_byte_32;
1797 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1798 trans_vector_unsigned_byte_32;
1799 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1800 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1801 trans_vector_unsigned_byte_64;
1803 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1804 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1805 trans_vector_unsigned_byte_64;
1807 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1808 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1809 trans_vector_unsigned_byte_64;
1811 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1812 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
1813 trans_vector_unsigned_byte_8;
1815 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1816 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1817 trans_vector_unsigned_byte_16;
1819 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1820 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1821 trans_vector_unsigned_byte_32;
1823 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1824 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1825 trans_vector_unsigned_byte_32;
1827 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1828 transother[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1829 trans_vector_unsigned_byte_64;
1831 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1832 transother[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1833 trans_vector_unsigned_byte_64;
1835 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
1836 trans_vector_single_float;
1837 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
1838 trans_vector_double_float;
1839 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1840 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
1841 trans_vector_long_float;
1843 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1844 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1845 trans_vector_complex_single_float;
1847 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1848 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1849 trans_vector_complex_double_float;
1851 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1852 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1853 trans_vector_complex_long_float;
1855 transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
1856 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1857 transother[COMPLEX_CHARACTER_STRING_WIDETAG] = trans_boxed;
1859 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
1860 transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
1861 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
1862 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
1863 transother[CODE_HEADER_WIDETAG] = trans_code_header;
1864 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
1865 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
1866 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
1867 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
1868 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
1869 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
1870 transother[CHARACTER_WIDETAG] = trans_immediate;
1871 transother[SAP_WIDETAG] = trans_unboxed;
1872 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
1873 transother[NO_TLS_VALUE_MARKER_WIDETAG] = trans_immediate;
1874 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
1875 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
1876 transother[FDEFN_WIDETAG] = trans_boxed;
1878 /* size table, initialized the same way as scavtab */
1879 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
1880 sizetab[i] = size_lose;
1881 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1882 sizetab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
1883 sizetab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1884 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1885 sizetab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1886 sizetab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
1887 sizetab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1888 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1889 sizetab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1891 sizetab[BIGNUM_WIDETAG] = size_unboxed;
1892 sizetab[RATIO_WIDETAG] = size_boxed;
1893 #if N_WORD_BITS == 64
1894 sizetab[SINGLE_FLOAT_WIDETAG] = size_immediate;
1896 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
1898 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1899 #ifdef LONG_FLOAT_WIDETAG
1900 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
1902 sizetab[COMPLEX_WIDETAG] = size_boxed;
1903 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1904 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
1906 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1907 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1909 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1910 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
1912 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
1913 sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
1914 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1915 sizetab[SIMPLE_CHARACTER_STRING_WIDETAG] = size_character_string;
1917 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
1918 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
1919 sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
1920 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1921 size_vector_unsigned_byte_2;
1922 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1923 size_vector_unsigned_byte_4;
1924 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1925 size_vector_unsigned_byte_8;
1926 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1927 size_vector_unsigned_byte_8;
1928 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1929 size_vector_unsigned_byte_16;
1930 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1931 size_vector_unsigned_byte_16;
1932 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1933 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1934 size_vector_unsigned_byte_32;
1936 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1937 size_vector_unsigned_byte_32;
1938 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1939 size_vector_unsigned_byte_32;
1940 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1941 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1942 size_vector_unsigned_byte_64;
1944 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1945 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1946 size_vector_unsigned_byte_64;
1948 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1949 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1950 size_vector_unsigned_byte_64;
1952 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1953 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
1955 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1956 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1957 size_vector_unsigned_byte_16;
1959 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1960 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1961 size_vector_unsigned_byte_32;
1963 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1964 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1965 size_vector_unsigned_byte_32;
1967 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1968 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1969 size_vector_unsigned_byte_64;
1971 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1972 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1973 size_vector_unsigned_byte_64;
1975 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
1976 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
1977 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1978 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
1980 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1981 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1982 size_vector_complex_single_float;
1984 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1985 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1986 size_vector_complex_double_float;
1988 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1989 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1990 size_vector_complex_long_float;
1992 sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
1993 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1994 sizetab[COMPLEX_CHARACTER_STRING_WIDETAG] = size_boxed;
1996 sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
1997 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
1998 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
1999 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
2000 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
2002 /* We shouldn't see these, so just lose if it happens. */
2003 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
2004 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
2006 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
2007 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
2008 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
2009 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
2010 sizetab[CHARACTER_WIDETAG] = size_immediate;
2011 sizetab[SAP_WIDETAG] = size_unboxed;
2012 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
2013 sizetab[NO_TLS_VALUE_MARKER_WIDETAG] = size_immediate;
2014 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
2015 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
2016 sizetab[FDEFN_WIDETAG] = size_boxed;
2020 /* Find the code object for the given pc, or return NULL on
2023 component_ptr_from_pc(lispobj *pc)
2025 lispobj *object = NULL;
2027 if ( (object = search_read_only_space(pc)) )
2029 else if ( (object = search_static_space(pc)) )
2032 object = search_dynamic_space(pc);
2034 if (object) /* if we found something */
2035 if (widetag_of(*object) == CODE_HEADER_WIDETAG)
2041 /* Scan an area looking for an object which encloses the given pointer.
2042 * Return the object start on success or NULL on failure. */
2044 gc_search_space(lispobj *start, size_t words, lispobj *pointer)
2048 lispobj thing = *start;
2050 /* If thing is an immediate then this is a cons. */
2051 if (is_lisp_pointer(thing)
2053 || (widetag_of(thing) == CHARACTER_WIDETAG)
2054 #if N_WORD_BITS == 64
2055 || (widetag_of(thing) == SINGLE_FLOAT_WIDETAG)
2057 || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG))
2060 count = (sizetab[widetag_of(thing)])(start);
2062 /* Check whether the pointer is within this object. */
2063 if ((pointer >= start) && (pointer < (start+count))) {
2065 /*FSHOW((stderr,"/found %x in %x %x\n", pointer, start, thing));*/
2069 /* Round up the count. */
2070 count = CEILING(count,2);