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, end %p\n",
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));
323 gencgc_apply_code_fixups(code, new_code);
329 scav_code_header(lispobj *where, lispobj object)
332 long n_header_words, n_code_words, n_words;
333 lispobj entry_point; /* tagged pointer to entry point */
334 struct simple_fun *function_ptr; /* untagged pointer to entry point */
336 code = (struct code *) where;
337 n_code_words = fixnum_value(code->code_size);
338 n_header_words = HeaderValue(object);
339 n_words = n_code_words + n_header_words;
340 n_words = CEILING(n_words, 2);
342 /* Scavenge the boxed section of the code data block. */
343 scavenge(where + 1, n_header_words - 1);
345 /* Scavenge the boxed section of each function object in the
346 * code data block. */
347 for (entry_point = code->entry_points;
349 entry_point = function_ptr->next) {
351 gc_assert_verbose(is_lisp_pointer(entry_point), "Entry point %lx\n",
354 function_ptr = (struct simple_fun *) native_pointer(entry_point);
355 gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
357 scavenge(&function_ptr->name, 1);
358 scavenge(&function_ptr->arglist, 1);
359 scavenge(&function_ptr->type, 1);
366 trans_code_header(lispobj object)
370 ncode = trans_code((struct code *) native_pointer(object));
371 return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG;
376 size_code_header(lispobj *where)
379 long nheader_words, ncode_words, nwords;
381 code = (struct code *) where;
383 ncode_words = fixnum_value(code->code_size);
384 nheader_words = HeaderValue(code->header);
385 nwords = ncode_words + nheader_words;
386 nwords = CEILING(nwords, 2);
391 #if !defined(LISP_FEATURE_X86) && ! defined(LISP_FEATURE_X86_64)
393 scav_return_pc_header(lispobj *where, lispobj object)
395 lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x\n",
396 (unsigned long) where,
397 (unsigned long) object);
398 return 0; /* bogus return value to satisfy static type checking */
400 #endif /* LISP_FEATURE_X86 */
403 trans_return_pc_header(lispobj object)
405 struct simple_fun *return_pc;
406 unsigned long offset;
407 struct code *code, *ncode;
409 return_pc = (struct simple_fun *) native_pointer(object);
410 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
411 offset = HeaderValue(return_pc->header) * N_WORD_BYTES;
413 /* Transport the whole code object */
414 code = (struct code *) ((unsigned long) return_pc - offset);
415 ncode = trans_code(code);
417 return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
420 /* On the 386, closures hold a pointer to the raw address instead of the
421 * function object, so we can use CALL [$FDEFN+const] to invoke
422 * the function without loading it into a register. Given that code
423 * objects don't move, we don't need to update anything, but we do
424 * have to figure out that the function is still live. */
426 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
428 scav_closure_header(lispobj *where, lispobj object)
430 struct closure *closure;
433 closure = (struct closure *)where;
434 fun = closure->fun - FUN_RAW_ADDR_OFFSET;
436 #ifdef LISP_FEATURE_GENCGC
437 /* The function may have moved so update the raw address. But
438 * don't write unnecessarily. */
439 if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
440 closure->fun = fun + FUN_RAW_ADDR_OFFSET;
446 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
448 scav_fun_header(lispobj *where, lispobj object)
450 lose("attempted to scavenge a function header where=0x%08x object=0x%08x\n",
451 (unsigned long) where,
452 (unsigned long) object);
453 return 0; /* bogus return value to satisfy static type checking */
455 #endif /* LISP_FEATURE_X86 */
458 trans_fun_header(lispobj object)
460 struct simple_fun *fheader;
461 unsigned long offset;
462 struct code *code, *ncode;
464 fheader = (struct simple_fun *) native_pointer(object);
465 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
466 offset = HeaderValue(fheader->header) * N_WORD_BYTES;
468 /* Transport the whole code object */
469 code = (struct code *) ((unsigned long) fheader - offset);
470 ncode = trans_code(code);
472 return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
481 scav_instance_pointer(lispobj *where, lispobj object)
483 lispobj copy, *first_pointer;
485 /* Object is a pointer into from space - not a FP. */
486 copy = trans_boxed(object);
488 #ifdef LISP_FEATURE_GENCGC
489 gc_assert(copy != object);
492 first_pointer = (lispobj *) native_pointer(object);
493 set_forwarding_pointer(first_pointer,copy);
504 static lispobj trans_list(lispobj object);
507 scav_list_pointer(lispobj *where, lispobj object)
509 lispobj first, *first_pointer;
511 gc_assert(is_lisp_pointer(object));
513 /* Object is a pointer into from space - not FP. */
514 first_pointer = (lispobj *) native_pointer(object);
516 first = trans_list(object);
517 gc_assert(first != object);
519 /* Set forwarding pointer */
520 set_forwarding_pointer(first_pointer, first);
522 gc_assert(is_lisp_pointer(first));
523 gc_assert(!from_space_p(first));
531 trans_list(lispobj object)
533 lispobj new_list_pointer;
534 struct cons *cons, *new_cons;
537 cons = (struct cons *) native_pointer(object);
540 new_cons = (struct cons *)
541 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
542 new_cons->car = cons->car;
543 new_cons->cdr = cons->cdr; /* updated later */
544 new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
546 /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC */
549 set_forwarding_pointer((lispobj *)cons, new_list_pointer);
551 /* Try to linearize the list in the cdr direction to help reduce
555 struct cons *cdr_cons, *new_cdr_cons;
557 if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
558 !from_space_p(cdr) ||
559 forwarding_pointer_p((lispobj *)native_pointer(cdr)))
562 cdr_cons = (struct cons *) native_pointer(cdr);
565 new_cdr_cons = (struct cons*)
566 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
567 new_cdr_cons->car = cdr_cons->car;
568 new_cdr_cons->cdr = cdr_cons->cdr;
569 new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
571 /* Grab the cdr before it is clobbered. */
573 set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
575 /* Update the cdr of the last cons copied into new space to
576 * keep the newspace scavenge from having to do it. */
577 new_cons->cdr = new_cdr;
579 new_cons = new_cdr_cons;
582 return new_list_pointer;
587 * scavenging and transporting other pointers
591 scav_other_pointer(lispobj *where, lispobj object)
593 lispobj first, *first_pointer;
595 gc_assert(is_lisp_pointer(object));
597 /* Object is a pointer into from space - not FP. */
598 first_pointer = (lispobj *) native_pointer(object);
599 first = (transother[widetag_of(*first_pointer)])(object);
601 if (first != object) {
602 set_forwarding_pointer(first_pointer, first);
603 #ifdef LISP_FEATURE_GENCGC
607 #ifndef LISP_FEATURE_GENCGC
610 gc_assert(is_lisp_pointer(first));
611 gc_assert(!from_space_p(first));
617 * immediate, boxed, and unboxed objects
621 size_pointer(lispobj *where)
627 scav_immediate(lispobj *where, lispobj object)
633 trans_immediate(lispobj object)
635 lose("trying to transport an immediate\n");
636 return NIL; /* bogus return value to satisfy static type checking */
640 size_immediate(lispobj *where)
647 scav_boxed(lispobj *where, lispobj object)
653 scav_instance(lispobj *where, lispobj object)
656 long ntotal = HeaderValue(object);
657 lispobj layout = ((struct instance *)where)->slots[0];
661 if (forwarding_pointer_p(native_pointer(layout)))
662 layout = (lispobj) forwarding_pointer_value(native_pointer(layout));
664 nuntagged = ((struct layout *)native_pointer(layout))->n_untagged_slots;
665 scavenge(where + 1, ntotal - fixnum_value(nuntagged));
671 trans_boxed(lispobj object)
674 unsigned long length;
676 gc_assert(is_lisp_pointer(object));
678 header = *((lispobj *) native_pointer(object));
679 length = HeaderValue(header) + 1;
680 length = CEILING(length, 2);
682 return copy_object(object, length);
687 size_boxed(lispobj *where)
690 unsigned long length;
693 length = HeaderValue(header) + 1;
694 length = CEILING(length, 2);
699 /* Note: on the sparc we don't have to do anything special for fdefns, */
700 /* 'cause the raw-addr has a function lowtag. */
701 #ifndef LISP_FEATURE_SPARC
703 scav_fdefn(lispobj *where, lispobj object)
707 fdefn = (struct fdefn *)where;
709 /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
710 fdefn->fun, fdefn->raw_addr)); */
712 if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)
713 == (char *)((unsigned long)(fdefn->raw_addr))) {
714 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
716 /* Don't write unnecessarily. */
717 if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
718 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
719 /* gc.c has more casts here, which may be relevant or alternatively
720 may be compiler warning defeaters. try
721 fdefn->raw_addr = ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
723 return sizeof(struct fdefn) / sizeof(lispobj);
731 scav_unboxed(lispobj *where, lispobj object)
733 unsigned long length;
735 length = HeaderValue(object) + 1;
736 length = CEILING(length, 2);
742 trans_unboxed(lispobj object)
745 unsigned long length;
748 gc_assert(is_lisp_pointer(object));
750 header = *((lispobj *) native_pointer(object));
751 length = HeaderValue(header) + 1;
752 length = CEILING(length, 2);
754 return copy_unboxed_object(object, length);
758 size_unboxed(lispobj *where)
761 unsigned long length;
764 length = HeaderValue(header) + 1;
765 length = CEILING(length, 2);
771 /* vector-like objects */
773 scav_base_string(lispobj *where, lispobj object)
775 struct vector *vector;
778 /* NOTE: Strings contain one more byte of data than the length */
779 /* slot indicates. */
781 vector = (struct vector *) where;
782 length = fixnum_value(vector->length) + 1;
783 nwords = CEILING(NWORDS(length, 8) + 2, 2);
788 trans_base_string(lispobj object)
790 struct vector *vector;
793 gc_assert(is_lisp_pointer(object));
795 /* NOTE: A string contains one more byte of data (a terminating
796 * '\0' to help when interfacing with C functions) than indicated
797 * by the length slot. */
799 vector = (struct vector *) native_pointer(object);
800 length = fixnum_value(vector->length) + 1;
801 nwords = CEILING(NWORDS(length, 8) + 2, 2);
803 return copy_large_unboxed_object(object, nwords);
807 size_base_string(lispobj *where)
809 struct vector *vector;
812 /* NOTE: A string contains one more byte of data (a terminating
813 * '\0' to help when interfacing with C functions) than indicated
814 * by the length slot. */
816 vector = (struct vector *) where;
817 length = fixnum_value(vector->length) + 1;
818 nwords = CEILING(NWORDS(length, 8) + 2, 2);
824 scav_character_string(lispobj *where, lispobj object)
826 struct vector *vector;
829 /* NOTE: Strings contain one more byte of data than the length */
830 /* slot indicates. */
832 vector = (struct vector *) where;
833 length = fixnum_value(vector->length) + 1;
834 nwords = CEILING(NWORDS(length, 32) + 2, 2);
839 trans_character_string(lispobj object)
841 struct vector *vector;
844 gc_assert(is_lisp_pointer(object));
846 /* NOTE: A string contains one more byte of data (a terminating
847 * '\0' to help when interfacing with C functions) than indicated
848 * by the length slot. */
850 vector = (struct vector *) native_pointer(object);
851 length = fixnum_value(vector->length) + 1;
852 nwords = CEILING(NWORDS(length, 32) + 2, 2);
854 return copy_large_unboxed_object(object, nwords);
858 size_character_string(lispobj *where)
860 struct vector *vector;
863 /* NOTE: A string contains one more byte of data (a terminating
864 * '\0' to help when interfacing with C functions) than indicated
865 * by the length slot. */
867 vector = (struct vector *) where;
868 length = fixnum_value(vector->length) + 1;
869 nwords = CEILING(NWORDS(length, 32) + 2, 2);
875 trans_vector(lispobj object)
877 struct vector *vector;
880 gc_assert(is_lisp_pointer(object));
882 vector = (struct vector *) native_pointer(object);
884 length = fixnum_value(vector->length);
885 nwords = CEILING(length + 2, 2);
887 return copy_large_object(object, nwords);
891 size_vector(lispobj *where)
893 struct vector *vector;
896 vector = (struct vector *) where;
897 length = fixnum_value(vector->length);
898 nwords = CEILING(length + 2, 2);
904 scav_vector_nil(lispobj *where, lispobj object)
910 trans_vector_nil(lispobj object)
912 gc_assert(is_lisp_pointer(object));
913 return copy_unboxed_object(object, 2);
917 size_vector_nil(lispobj *where)
919 /* Just the header word and the length word */
924 scav_vector_bit(lispobj *where, lispobj object)
926 struct vector *vector;
929 vector = (struct vector *) where;
930 length = fixnum_value(vector->length);
931 nwords = CEILING(NWORDS(length, 1) + 2, 2);
937 trans_vector_bit(lispobj object)
939 struct vector *vector;
942 gc_assert(is_lisp_pointer(object));
944 vector = (struct vector *) native_pointer(object);
945 length = fixnum_value(vector->length);
946 nwords = CEILING(NWORDS(length, 1) + 2, 2);
948 return copy_large_unboxed_object(object, nwords);
952 size_vector_bit(lispobj *where)
954 struct vector *vector;
957 vector = (struct vector *) where;
958 length = fixnum_value(vector->length);
959 nwords = CEILING(NWORDS(length, 1) + 2, 2);
965 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
967 struct vector *vector;
970 vector = (struct vector *) where;
971 length = fixnum_value(vector->length);
972 nwords = CEILING(NWORDS(length, 2) + 2, 2);
978 trans_vector_unsigned_byte_2(lispobj object)
980 struct vector *vector;
983 gc_assert(is_lisp_pointer(object));
985 vector = (struct vector *) native_pointer(object);
986 length = fixnum_value(vector->length);
987 nwords = CEILING(NWORDS(length, 2) + 2, 2);
989 return copy_large_unboxed_object(object, nwords);
993 size_vector_unsigned_byte_2(lispobj *where)
995 struct vector *vector;
998 vector = (struct vector *) where;
999 length = fixnum_value(vector->length);
1000 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1006 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
1008 struct vector *vector;
1009 long length, nwords;
1011 vector = (struct vector *) where;
1012 length = fixnum_value(vector->length);
1013 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1019 trans_vector_unsigned_byte_4(lispobj object)
1021 struct vector *vector;
1022 long length, nwords;
1024 gc_assert(is_lisp_pointer(object));
1026 vector = (struct vector *) native_pointer(object);
1027 length = fixnum_value(vector->length);
1028 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1030 return copy_large_unboxed_object(object, nwords);
1033 size_vector_unsigned_byte_4(lispobj *where)
1035 struct vector *vector;
1036 long length, nwords;
1038 vector = (struct vector *) where;
1039 length = fixnum_value(vector->length);
1040 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1047 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
1049 struct vector *vector;
1050 long length, nwords;
1052 vector = (struct vector *) where;
1053 length = fixnum_value(vector->length);
1054 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1059 /*********************/
1064 trans_vector_unsigned_byte_8(lispobj object)
1066 struct vector *vector;
1067 long length, nwords;
1069 gc_assert(is_lisp_pointer(object));
1071 vector = (struct vector *) native_pointer(object);
1072 length = fixnum_value(vector->length);
1073 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1075 return copy_large_unboxed_object(object, nwords);
1079 size_vector_unsigned_byte_8(lispobj *where)
1081 struct vector *vector;
1082 long length, nwords;
1084 vector = (struct vector *) where;
1085 length = fixnum_value(vector->length);
1086 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1093 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1095 struct vector *vector;
1096 long length, nwords;
1098 vector = (struct vector *) where;
1099 length = fixnum_value(vector->length);
1100 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1106 trans_vector_unsigned_byte_16(lispobj object)
1108 struct vector *vector;
1109 long length, nwords;
1111 gc_assert(is_lisp_pointer(object));
1113 vector = (struct vector *) native_pointer(object);
1114 length = fixnum_value(vector->length);
1115 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1117 return copy_large_unboxed_object(object, nwords);
1121 size_vector_unsigned_byte_16(lispobj *where)
1123 struct vector *vector;
1124 long length, nwords;
1126 vector = (struct vector *) where;
1127 length = fixnum_value(vector->length);
1128 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1134 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1136 struct vector *vector;
1137 long length, nwords;
1139 vector = (struct vector *) where;
1140 length = fixnum_value(vector->length);
1141 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1147 trans_vector_unsigned_byte_32(lispobj object)
1149 struct vector *vector;
1150 long length, nwords;
1152 gc_assert(is_lisp_pointer(object));
1154 vector = (struct vector *) native_pointer(object);
1155 length = fixnum_value(vector->length);
1156 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1158 return copy_large_unboxed_object(object, nwords);
1162 size_vector_unsigned_byte_32(lispobj *where)
1164 struct vector *vector;
1165 long length, nwords;
1167 vector = (struct vector *) where;
1168 length = fixnum_value(vector->length);
1169 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1174 #if N_WORD_BITS == 64
1176 scav_vector_unsigned_byte_64(lispobj *where, lispobj object)
1178 struct vector *vector;
1179 long length, nwords;
1181 vector = (struct vector *) where;
1182 length = fixnum_value(vector->length);
1183 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1189 trans_vector_unsigned_byte_64(lispobj object)
1191 struct vector *vector;
1192 long length, nwords;
1194 gc_assert(is_lisp_pointer(object));
1196 vector = (struct vector *) native_pointer(object);
1197 length = fixnum_value(vector->length);
1198 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1200 return copy_large_unboxed_object(object, nwords);
1204 size_vector_unsigned_byte_64(lispobj *where)
1206 struct vector *vector;
1207 long length, nwords;
1209 vector = (struct vector *) where;
1210 length = fixnum_value(vector->length);
1211 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1218 scav_vector_single_float(lispobj *where, lispobj object)
1220 struct vector *vector;
1221 long length, nwords;
1223 vector = (struct vector *) where;
1224 length = fixnum_value(vector->length);
1225 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1231 trans_vector_single_float(lispobj object)
1233 struct vector *vector;
1234 long length, nwords;
1236 gc_assert(is_lisp_pointer(object));
1238 vector = (struct vector *) native_pointer(object);
1239 length = fixnum_value(vector->length);
1240 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1242 return copy_large_unboxed_object(object, nwords);
1246 size_vector_single_float(lispobj *where)
1248 struct vector *vector;
1249 long length, nwords;
1251 vector = (struct vector *) where;
1252 length = fixnum_value(vector->length);
1253 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1259 scav_vector_double_float(lispobj *where, lispobj object)
1261 struct vector *vector;
1262 long length, nwords;
1264 vector = (struct vector *) where;
1265 length = fixnum_value(vector->length);
1266 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1272 trans_vector_double_float(lispobj object)
1274 struct vector *vector;
1275 long length, nwords;
1277 gc_assert(is_lisp_pointer(object));
1279 vector = (struct vector *) native_pointer(object);
1280 length = fixnum_value(vector->length);
1281 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1283 return copy_large_unboxed_object(object, nwords);
1287 size_vector_double_float(lispobj *where)
1289 struct vector *vector;
1290 long length, nwords;
1292 vector = (struct vector *) where;
1293 length = fixnum_value(vector->length);
1294 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1299 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1301 scav_vector_long_float(lispobj *where, lispobj object)
1303 struct vector *vector;
1304 long length, nwords;
1306 vector = (struct vector *) where;
1307 length = fixnum_value(vector->length);
1308 nwords = CEILING(length *
1315 trans_vector_long_float(lispobj object)
1317 struct vector *vector;
1318 long length, nwords;
1320 gc_assert(is_lisp_pointer(object));
1322 vector = (struct vector *) native_pointer(object);
1323 length = fixnum_value(vector->length);
1324 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1326 return copy_large_unboxed_object(object, nwords);
1330 size_vector_long_float(lispobj *where)
1332 struct vector *vector;
1333 long length, nwords;
1335 vector = (struct vector *) where;
1336 length = fixnum_value(vector->length);
1337 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1344 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1346 scav_vector_complex_single_float(lispobj *where, lispobj object)
1348 struct vector *vector;
1349 long length, nwords;
1351 vector = (struct vector *) where;
1352 length = fixnum_value(vector->length);
1353 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1359 trans_vector_complex_single_float(lispobj object)
1361 struct vector *vector;
1362 long length, nwords;
1364 gc_assert(is_lisp_pointer(object));
1366 vector = (struct vector *) native_pointer(object);
1367 length = fixnum_value(vector->length);
1368 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1370 return copy_large_unboxed_object(object, nwords);
1374 size_vector_complex_single_float(lispobj *where)
1376 struct vector *vector;
1377 long length, nwords;
1379 vector = (struct vector *) where;
1380 length = fixnum_value(vector->length);
1381 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1387 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1389 scav_vector_complex_double_float(lispobj *where, lispobj object)
1391 struct vector *vector;
1392 long length, nwords;
1394 vector = (struct vector *) where;
1395 length = fixnum_value(vector->length);
1396 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1402 trans_vector_complex_double_float(lispobj object)
1404 struct vector *vector;
1405 long length, nwords;
1407 gc_assert(is_lisp_pointer(object));
1409 vector = (struct vector *) native_pointer(object);
1410 length = fixnum_value(vector->length);
1411 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1413 return copy_large_unboxed_object(object, nwords);
1417 size_vector_complex_double_float(lispobj *where)
1419 struct vector *vector;
1420 long length, nwords;
1422 vector = (struct vector *) where;
1423 length = fixnum_value(vector->length);
1424 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1431 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1433 scav_vector_complex_long_float(lispobj *where, lispobj object)
1435 struct vector *vector;
1436 long length, nwords;
1438 vector = (struct vector *) where;
1439 length = fixnum_value(vector->length);
1440 nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1446 trans_vector_complex_long_float(lispobj object)
1448 struct vector *vector;
1449 long length, nwords;
1451 gc_assert(is_lisp_pointer(object));
1453 vector = (struct vector *) native_pointer(object);
1454 length = fixnum_value(vector->length);
1455 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1457 return copy_large_unboxed_object(object, nwords);
1461 size_vector_complex_long_float(lispobj *where)
1463 struct vector *vector;
1464 long length, nwords;
1466 vector = (struct vector *) where;
1467 length = fixnum_value(vector->length);
1468 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1474 #define WEAK_POINTER_NWORDS \
1475 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1478 trans_weak_pointer(lispobj object)
1481 #ifndef LISP_FEATURE_GENCGC
1482 struct weak_pointer *wp;
1484 gc_assert(is_lisp_pointer(object));
1486 #if defined(DEBUG_WEAK)
1487 printf("Transporting weak pointer from 0x%08x\n", object);
1490 /* Need to remember where all the weak pointers are that have */
1491 /* been transported so they can be fixed up in a post-GC pass. */
1493 copy = copy_object(object, WEAK_POINTER_NWORDS);
1494 #ifndef LISP_FEATURE_GENCGC
1495 wp = (struct weak_pointer *) native_pointer(copy);
1497 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1498 /* Push the weak pointer onto the list of weak pointers. */
1499 wp->next = (struct weak_pointer *)LOW_WORD(weak_pointers);
1506 size_weak_pointer(lispobj *where)
1508 return WEAK_POINTER_NWORDS;
1512 void scan_weak_pointers(void)
1514 struct weak_pointer *wp;
1515 for (wp = weak_pointers; wp != NULL; wp=wp->next) {
1516 lispobj value = wp->value;
1517 lispobj *first_pointer;
1518 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1519 if (!(is_lisp_pointer(value) && from_space_p(value)))
1522 /* Now, we need to check whether the object has been forwarded. If
1523 * it has been, the weak pointer is still good and needs to be
1524 * updated. Otherwise, the weak pointer needs to be nil'ed
1527 first_pointer = (lispobj *)native_pointer(value);
1529 if (forwarding_pointer_p(first_pointer)) {
1531 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1547 scav_lose(lispobj *where, lispobj object)
1549 lose("no scavenge function for object 0x%08x (widetag 0x%x)\n",
1550 (unsigned long)object,
1551 widetag_of(*(lispobj*)native_pointer(object)));
1553 return 0; /* bogus return value to satisfy static type checking */
1557 trans_lose(lispobj object)
1559 lose("no transport function for object 0x%08x (widetag 0x%x)\n",
1560 (unsigned long)object,
1561 widetag_of(*(lispobj*)native_pointer(object)));
1562 return NIL; /* bogus return value to satisfy static type checking */
1566 size_lose(lispobj *where)
1568 lose("no size function for object at 0x%08x (widetag 0x%x)\n",
1569 (unsigned long)where,
1570 widetag_of(LOW_WORD(where)));
1571 return 1; /* bogus return value to satisfy static type checking */
1580 gc_init_tables(void)
1584 /* Set default value in all slots of scavenge table. FIXME
1585 * replace this gnarly sizeof with something based on
1587 for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) {
1588 scavtab[i] = scav_lose;
1591 /* For each type which can be selected by the lowtag alone, set
1592 * multiple entries in our widetag scavenge table (one for each
1593 * possible value of the high bits).
1596 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1597 scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1598 scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1599 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1600 scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1601 scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1602 scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_instance_pointer;
1603 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1604 scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1607 /* Other-pointer types (those selected by all eight bits of the
1608 * tag) get one entry each in the scavenge table. */
1609 scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1610 scavtab[RATIO_WIDETAG] = scav_boxed;
1611 #if N_WORD_BITS == 64
1612 scavtab[SINGLE_FLOAT_WIDETAG] = scav_immediate;
1614 scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1616 scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1617 #ifdef LONG_FLOAT_WIDETAG
1618 scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1620 scavtab[COMPLEX_WIDETAG] = scav_boxed;
1621 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1622 scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1624 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1625 scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1627 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1628 scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
1630 scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
1631 scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
1632 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1633 scavtab[SIMPLE_CHARACTER_STRING_WIDETAG] = scav_character_string;
1635 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
1636 scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
1637 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1638 scav_vector_unsigned_byte_2;
1639 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1640 scav_vector_unsigned_byte_4;
1641 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1642 scav_vector_unsigned_byte_8;
1643 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1644 scav_vector_unsigned_byte_8;
1645 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1646 scav_vector_unsigned_byte_16;
1647 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1648 scav_vector_unsigned_byte_16;
1649 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1650 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1651 scav_vector_unsigned_byte_32;
1653 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1654 scav_vector_unsigned_byte_32;
1655 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1656 scav_vector_unsigned_byte_32;
1657 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1658 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1659 scav_vector_unsigned_byte_64;
1661 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1662 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1663 scav_vector_unsigned_byte_64;
1665 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1666 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1667 scav_vector_unsigned_byte_64;
1669 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1670 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
1672 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1673 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1674 scav_vector_unsigned_byte_16;
1676 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1677 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1678 scav_vector_unsigned_byte_32;
1680 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1681 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1682 scav_vector_unsigned_byte_32;
1684 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1685 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1686 scav_vector_unsigned_byte_64;
1688 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1689 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1690 scav_vector_unsigned_byte_64;
1692 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
1693 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
1694 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1695 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
1697 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1698 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1699 scav_vector_complex_single_float;
1701 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1702 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1703 scav_vector_complex_double_float;
1705 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1706 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1707 scav_vector_complex_long_float;
1709 scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
1710 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1711 scavtab[COMPLEX_CHARACTER_STRING_WIDETAG] = scav_boxed;
1713 scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
1714 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
1715 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
1716 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
1717 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
1718 #ifndef LISP_FEATURE_GENCGC /* FIXME ..._X86 ? */
1719 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
1720 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
1722 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
1723 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
1724 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
1726 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
1727 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
1729 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
1730 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
1731 scavtab[CHARACTER_WIDETAG] = scav_immediate;
1732 scavtab[SAP_WIDETAG] = scav_unboxed;
1733 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
1734 scavtab[NO_TLS_VALUE_MARKER_WIDETAG] = scav_immediate;
1735 scavtab[INSTANCE_HEADER_WIDETAG] = scav_instance;
1736 #ifdef LISP_FEATURE_SPARC
1737 scavtab[FDEFN_WIDETAG] = scav_boxed;
1739 scavtab[FDEFN_WIDETAG] = scav_fdefn;
1742 /* transport other table, initialized same way as scavtab */
1743 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
1744 transother[i] = trans_lose;
1745 transother[BIGNUM_WIDETAG] = trans_unboxed;
1746 transother[RATIO_WIDETAG] = trans_boxed;
1748 #if N_WORD_BITS == 64
1749 transother[SINGLE_FLOAT_WIDETAG] = trans_immediate;
1751 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1753 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1754 #ifdef LONG_FLOAT_WIDETAG
1755 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
1757 transother[COMPLEX_WIDETAG] = trans_boxed;
1758 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1759 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1761 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1762 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1764 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1765 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
1767 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
1768 transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
1769 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1770 transother[SIMPLE_CHARACTER_STRING_WIDETAG] = trans_character_string;
1772 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
1773 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
1774 transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
1775 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1776 trans_vector_unsigned_byte_2;
1777 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1778 trans_vector_unsigned_byte_4;
1779 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1780 trans_vector_unsigned_byte_8;
1781 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1782 trans_vector_unsigned_byte_8;
1783 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1784 trans_vector_unsigned_byte_16;
1785 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1786 trans_vector_unsigned_byte_16;
1787 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1788 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1789 trans_vector_unsigned_byte_32;
1791 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1792 trans_vector_unsigned_byte_32;
1793 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1794 trans_vector_unsigned_byte_32;
1795 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1796 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1797 trans_vector_unsigned_byte_64;
1799 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1800 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1801 trans_vector_unsigned_byte_64;
1803 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1804 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1805 trans_vector_unsigned_byte_64;
1807 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1808 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
1809 trans_vector_unsigned_byte_8;
1811 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1812 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1813 trans_vector_unsigned_byte_16;
1815 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1816 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1817 trans_vector_unsigned_byte_32;
1819 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1820 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1821 trans_vector_unsigned_byte_32;
1823 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1824 transother[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1825 trans_vector_unsigned_byte_64;
1827 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1828 transother[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1829 trans_vector_unsigned_byte_64;
1831 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
1832 trans_vector_single_float;
1833 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
1834 trans_vector_double_float;
1835 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1836 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
1837 trans_vector_long_float;
1839 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1840 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1841 trans_vector_complex_single_float;
1843 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1844 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1845 trans_vector_complex_double_float;
1847 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1848 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1849 trans_vector_complex_long_float;
1851 transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
1852 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1853 transother[COMPLEX_CHARACTER_STRING_WIDETAG] = trans_boxed;
1855 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
1856 transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
1857 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
1858 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
1859 transother[CODE_HEADER_WIDETAG] = trans_code_header;
1860 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
1861 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
1862 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
1863 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
1864 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
1865 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
1866 transother[CHARACTER_WIDETAG] = trans_immediate;
1867 transother[SAP_WIDETAG] = trans_unboxed;
1868 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
1869 transother[NO_TLS_VALUE_MARKER_WIDETAG] = trans_immediate;
1870 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
1871 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
1872 transother[FDEFN_WIDETAG] = trans_boxed;
1874 /* size table, initialized the same way as scavtab */
1875 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
1876 sizetab[i] = size_lose;
1877 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1878 sizetab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
1879 sizetab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1880 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1881 sizetab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1882 sizetab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
1883 sizetab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1884 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1885 sizetab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1887 sizetab[BIGNUM_WIDETAG] = size_unboxed;
1888 sizetab[RATIO_WIDETAG] = size_boxed;
1889 #if N_WORD_BITS == 64
1890 sizetab[SINGLE_FLOAT_WIDETAG] = size_immediate;
1892 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
1894 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1895 #ifdef LONG_FLOAT_WIDETAG
1896 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
1898 sizetab[COMPLEX_WIDETAG] = size_boxed;
1899 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1900 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
1902 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1903 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1905 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1906 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
1908 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
1909 sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
1910 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1911 sizetab[SIMPLE_CHARACTER_STRING_WIDETAG] = size_character_string;
1913 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
1914 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
1915 sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
1916 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1917 size_vector_unsigned_byte_2;
1918 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1919 size_vector_unsigned_byte_4;
1920 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1921 size_vector_unsigned_byte_8;
1922 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1923 size_vector_unsigned_byte_8;
1924 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1925 size_vector_unsigned_byte_16;
1926 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1927 size_vector_unsigned_byte_16;
1928 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1929 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1930 size_vector_unsigned_byte_32;
1932 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1933 size_vector_unsigned_byte_32;
1934 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1935 size_vector_unsigned_byte_32;
1936 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1937 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1938 size_vector_unsigned_byte_64;
1940 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1941 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1942 size_vector_unsigned_byte_64;
1944 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1945 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1946 size_vector_unsigned_byte_64;
1948 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1949 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
1951 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1952 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1953 size_vector_unsigned_byte_16;
1955 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1956 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1957 size_vector_unsigned_byte_32;
1959 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1960 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1961 size_vector_unsigned_byte_32;
1963 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1964 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1965 size_vector_unsigned_byte_64;
1967 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1968 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1969 size_vector_unsigned_byte_64;
1971 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
1972 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
1973 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1974 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
1976 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1977 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1978 size_vector_complex_single_float;
1980 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1981 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1982 size_vector_complex_double_float;
1984 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1985 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1986 size_vector_complex_long_float;
1988 sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
1989 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1990 sizetab[COMPLEX_CHARACTER_STRING_WIDETAG] = size_boxed;
1992 sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
1993 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
1994 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
1995 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
1996 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
1998 /* We shouldn't see these, so just lose if it happens. */
1999 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
2000 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
2002 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
2003 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
2004 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
2005 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
2006 sizetab[CHARACTER_WIDETAG] = size_immediate;
2007 sizetab[SAP_WIDETAG] = size_unboxed;
2008 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
2009 sizetab[NO_TLS_VALUE_MARKER_WIDETAG] = size_immediate;
2010 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
2011 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
2012 sizetab[FDEFN_WIDETAG] = size_boxed;
2016 /* Find the code object for the given pc, or return NULL on
2019 component_ptr_from_pc(lispobj *pc)
2021 lispobj *object = NULL;
2023 if ( (object = search_read_only_space(pc)) )
2025 else if ( (object = search_static_space(pc)) )
2028 object = search_dynamic_space(pc);
2030 if (object) /* if we found something */
2031 if (widetag_of(*object) == CODE_HEADER_WIDETAG)
2037 /* Scan an area looking for an object which encloses the given pointer.
2038 * Return the object start on success or NULL on failure. */
2040 gc_search_space(lispobj *start, size_t words, lispobj *pointer)
2044 lispobj thing = *start;
2046 /* If thing is an immediate then this is a cons. */
2047 if (is_lisp_pointer(thing)
2049 || (widetag_of(thing) == CHARACTER_WIDETAG)
2050 #if N_WORD_BITS == 64
2051 || (widetag_of(thing) == SINGLE_FLOAT_WIDETAG)
2053 || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG))
2056 count = (sizetab[widetag_of(thing)])(start);
2058 /* Check whether the pointer is within this object. */
2059 if ((pointer >= start) && (pointer < (start+count))) {
2061 /*FSHOW((stderr,"/found %x in %x %x\n", pointer, start, thing));*/
2065 /* Round up the count. */
2066 count = CEILING(count,2);