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 os_flush_icache((os_vm_address_t) (((long *)new_code) + nheader_words),
318 ncode_words * sizeof(long));
319 #ifdef LISP_FEATURE_GENCGC
320 gencgc_apply_code_fixups(code, new_code);
326 scav_code_header(lispobj *where, lispobj object)
329 long n_header_words, n_code_words, n_words;
330 lispobj entry_point; /* tagged pointer to entry point */
331 struct simple_fun *function_ptr; /* untagged pointer to entry point */
333 code = (struct code *) where;
334 n_code_words = fixnum_value(code->code_size);
335 n_header_words = HeaderValue(object);
336 n_words = n_code_words + n_header_words;
337 n_words = CEILING(n_words, 2);
339 /* Scavenge the boxed section of the code data block. */
340 scavenge(where + 1, n_header_words - 1);
342 /* Scavenge the boxed section of each function object in the
343 * code data block. */
344 for (entry_point = code->entry_points;
346 entry_point = function_ptr->next) {
348 gc_assert_verbose(is_lisp_pointer(entry_point), "Entry point %lx\n",
351 function_ptr = (struct simple_fun *) native_pointer(entry_point);
352 gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
354 scavenge(&function_ptr->name, 1);
355 scavenge(&function_ptr->arglist, 1);
356 scavenge(&function_ptr->type, 1);
363 trans_code_header(lispobj object)
367 ncode = trans_code((struct code *) native_pointer(object));
368 return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG;
373 size_code_header(lispobj *where)
376 long nheader_words, ncode_words, nwords;
378 code = (struct code *) where;
380 ncode_words = fixnum_value(code->code_size);
381 nheader_words = HeaderValue(code->header);
382 nwords = ncode_words + nheader_words;
383 nwords = CEILING(nwords, 2);
388 #if !defined(LISP_FEATURE_X86) && ! defined(LISP_FEATURE_X86_64)
390 scav_return_pc_header(lispobj *where, lispobj object)
392 lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x\n",
393 (unsigned long) where,
394 (unsigned long) object);
395 return 0; /* bogus return value to satisfy static type checking */
397 #endif /* LISP_FEATURE_X86 */
400 trans_return_pc_header(lispobj object)
402 struct simple_fun *return_pc;
403 unsigned long offset;
404 struct code *code, *ncode;
406 return_pc = (struct simple_fun *) native_pointer(object);
407 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
408 offset = HeaderValue(return_pc->header) * N_WORD_BYTES;
410 /* Transport the whole code object */
411 code = (struct code *) ((unsigned long) return_pc - offset);
412 ncode = trans_code(code);
414 return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
417 /* On the 386, closures hold a pointer to the raw address instead of the
418 * function object, so we can use CALL [$FDEFN+const] to invoke
419 * the function without loading it into a register. Given that code
420 * objects don't move, we don't need to update anything, but we do
421 * have to figure out that the function is still live. */
423 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
425 scav_closure_header(lispobj *where, lispobj object)
427 struct closure *closure;
430 closure = (struct closure *)where;
431 fun = closure->fun - FUN_RAW_ADDR_OFFSET;
433 #ifdef LISP_FEATURE_GENCGC
434 /* The function may have moved so update the raw address. But
435 * don't write unnecessarily. */
436 if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
437 closure->fun = fun + FUN_RAW_ADDR_OFFSET;
443 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
445 scav_fun_header(lispobj *where, lispobj object)
447 lose("attempted to scavenge a function header where=0x%08x object=0x%08x\n",
448 (unsigned long) where,
449 (unsigned long) object);
450 return 0; /* bogus return value to satisfy static type checking */
452 #endif /* LISP_FEATURE_X86 */
455 trans_fun_header(lispobj object)
457 struct simple_fun *fheader;
458 unsigned long offset;
459 struct code *code, *ncode;
461 fheader = (struct simple_fun *) native_pointer(object);
462 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
463 offset = HeaderValue(fheader->header) * N_WORD_BYTES;
465 /* Transport the whole code object */
466 code = (struct code *) ((unsigned long) fheader - offset);
467 ncode = trans_code(code);
469 return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
478 scav_instance_pointer(lispobj *where, lispobj object)
480 lispobj copy, *first_pointer;
482 /* Object is a pointer into from space - not a FP. */
483 copy = trans_boxed(object);
485 #ifdef LISP_FEATURE_GENCGC
486 gc_assert(copy != object);
489 first_pointer = (lispobj *) native_pointer(object);
490 set_forwarding_pointer(first_pointer,copy);
501 static lispobj trans_list(lispobj object);
504 scav_list_pointer(lispobj *where, lispobj object)
506 lispobj first, *first_pointer;
508 gc_assert(is_lisp_pointer(object));
510 /* Object is a pointer into from space - not FP. */
511 first_pointer = (lispobj *) native_pointer(object);
513 first = trans_list(object);
514 gc_assert(first != object);
516 /* Set forwarding pointer */
517 set_forwarding_pointer(first_pointer, first);
519 gc_assert(is_lisp_pointer(first));
520 gc_assert(!from_space_p(first));
528 trans_list(lispobj object)
530 lispobj new_list_pointer;
531 struct cons *cons, *new_cons;
534 cons = (struct cons *) native_pointer(object);
537 new_cons = (struct cons *)
538 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
539 new_cons->car = cons->car;
540 new_cons->cdr = cons->cdr; /* updated later */
541 new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
543 /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC */
546 set_forwarding_pointer((lispobj *)cons, new_list_pointer);
548 /* Try to linearize the list in the cdr direction to help reduce
552 struct cons *cdr_cons, *new_cdr_cons;
554 if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
555 !from_space_p(cdr) ||
556 forwarding_pointer_p((lispobj *)native_pointer(cdr)))
559 cdr_cons = (struct cons *) native_pointer(cdr);
562 new_cdr_cons = (struct cons*)
563 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
564 new_cdr_cons->car = cdr_cons->car;
565 new_cdr_cons->cdr = cdr_cons->cdr;
566 new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
568 /* Grab the cdr before it is clobbered. */
570 set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
572 /* Update the cdr of the last cons copied into new space to
573 * keep the newspace scavenge from having to do it. */
574 new_cons->cdr = new_cdr;
576 new_cons = new_cdr_cons;
579 return new_list_pointer;
584 * scavenging and transporting other pointers
588 scav_other_pointer(lispobj *where, lispobj object)
590 lispobj first, *first_pointer;
592 gc_assert(is_lisp_pointer(object));
594 /* Object is a pointer into from space - not FP. */
595 first_pointer = (lispobj *) native_pointer(object);
596 first = (transother[widetag_of(*first_pointer)])(object);
598 if (first != object) {
599 set_forwarding_pointer(first_pointer, first);
600 #ifdef LISP_FEATURE_GENCGC
604 #ifndef LISP_FEATURE_GENCGC
607 gc_assert(is_lisp_pointer(first));
608 gc_assert(!from_space_p(first));
614 * immediate, boxed, and unboxed objects
618 size_pointer(lispobj *where)
624 scav_immediate(lispobj *where, lispobj object)
630 trans_immediate(lispobj object)
632 lose("trying to transport an immediate\n");
633 return NIL; /* bogus return value to satisfy static type checking */
637 size_immediate(lispobj *where)
644 scav_boxed(lispobj *where, lispobj object)
650 scav_instance(lispobj *where, lispobj object)
653 long ntotal = HeaderValue(object);
654 lispobj layout = ((struct instance *)where)->slots[0];
658 if (forwarding_pointer_p(native_pointer(layout)))
659 layout = (lispobj) forwarding_pointer_value(native_pointer(layout));
661 nuntagged = ((struct layout *)native_pointer(layout))->n_untagged_slots;
662 scavenge(where + 1, ntotal - fixnum_value(nuntagged));
668 trans_boxed(lispobj object)
671 unsigned long length;
673 gc_assert(is_lisp_pointer(object));
675 header = *((lispobj *) native_pointer(object));
676 length = HeaderValue(header) + 1;
677 length = CEILING(length, 2);
679 return copy_object(object, length);
684 size_boxed(lispobj *where)
687 unsigned long length;
690 length = HeaderValue(header) + 1;
691 length = CEILING(length, 2);
696 /* Note: on the sparc we don't have to do anything special for fdefns, */
697 /* 'cause the raw-addr has a function lowtag. */
698 #ifndef LISP_FEATURE_SPARC
700 scav_fdefn(lispobj *where, lispobj object)
704 fdefn = (struct fdefn *)where;
706 /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
707 fdefn->fun, fdefn->raw_addr)); */
709 if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)
710 == (char *)((unsigned long)(fdefn->raw_addr))) {
711 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
713 /* Don't write unnecessarily. */
714 if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
715 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
716 /* gc.c has more casts here, which may be relevant or alternatively
717 may be compiler warning defeaters. try
718 fdefn->raw_addr = ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
720 return sizeof(struct fdefn) / sizeof(lispobj);
728 scav_unboxed(lispobj *where, lispobj object)
730 unsigned long length;
732 length = HeaderValue(object) + 1;
733 length = CEILING(length, 2);
739 trans_unboxed(lispobj object)
742 unsigned long length;
745 gc_assert(is_lisp_pointer(object));
747 header = *((lispobj *) native_pointer(object));
748 length = HeaderValue(header) + 1;
749 length = CEILING(length, 2);
751 return copy_unboxed_object(object, length);
755 size_unboxed(lispobj *where)
758 unsigned long length;
761 length = HeaderValue(header) + 1;
762 length = CEILING(length, 2);
768 /* vector-like objects */
770 scav_base_string(lispobj *where, lispobj object)
772 struct vector *vector;
775 /* NOTE: Strings contain one more byte of data than the length */
776 /* slot indicates. */
778 vector = (struct vector *) where;
779 length = fixnum_value(vector->length) + 1;
780 nwords = CEILING(NWORDS(length, 8) + 2, 2);
785 trans_base_string(lispobj object)
787 struct vector *vector;
790 gc_assert(is_lisp_pointer(object));
792 /* NOTE: A string contains one more byte of data (a terminating
793 * '\0' to help when interfacing with C functions) than indicated
794 * by the length slot. */
796 vector = (struct vector *) native_pointer(object);
797 length = fixnum_value(vector->length) + 1;
798 nwords = CEILING(NWORDS(length, 8) + 2, 2);
800 return copy_large_unboxed_object(object, nwords);
804 size_base_string(lispobj *where)
806 struct vector *vector;
809 /* NOTE: A string contains one more byte of data (a terminating
810 * '\0' to help when interfacing with C functions) than indicated
811 * by the length slot. */
813 vector = (struct vector *) where;
814 length = fixnum_value(vector->length) + 1;
815 nwords = CEILING(NWORDS(length, 8) + 2, 2);
821 scav_character_string(lispobj *where, lispobj object)
823 struct vector *vector;
826 /* NOTE: Strings contain one more byte of data than the length */
827 /* slot indicates. */
829 vector = (struct vector *) where;
830 length = fixnum_value(vector->length) + 1;
831 nwords = CEILING(NWORDS(length, 32) + 2, 2);
836 trans_character_string(lispobj object)
838 struct vector *vector;
841 gc_assert(is_lisp_pointer(object));
843 /* NOTE: A string contains one more byte of data (a terminating
844 * '\0' to help when interfacing with C functions) than indicated
845 * by the length slot. */
847 vector = (struct vector *) native_pointer(object);
848 length = fixnum_value(vector->length) + 1;
849 nwords = CEILING(NWORDS(length, 32) + 2, 2);
851 return copy_large_unboxed_object(object, nwords);
855 size_character_string(lispobj *where)
857 struct vector *vector;
860 /* NOTE: A string contains one more byte of data (a terminating
861 * '\0' to help when interfacing with C functions) than indicated
862 * by the length slot. */
864 vector = (struct vector *) where;
865 length = fixnum_value(vector->length) + 1;
866 nwords = CEILING(NWORDS(length, 32) + 2, 2);
872 trans_vector(lispobj object)
874 struct vector *vector;
877 gc_assert(is_lisp_pointer(object));
879 vector = (struct vector *) native_pointer(object);
881 length = fixnum_value(vector->length);
882 nwords = CEILING(length + 2, 2);
884 return copy_large_object(object, nwords);
888 size_vector(lispobj *where)
890 struct vector *vector;
893 vector = (struct vector *) where;
894 length = fixnum_value(vector->length);
895 nwords = CEILING(length + 2, 2);
901 scav_vector_nil(lispobj *where, lispobj object)
907 trans_vector_nil(lispobj object)
909 gc_assert(is_lisp_pointer(object));
910 return copy_unboxed_object(object, 2);
914 size_vector_nil(lispobj *where)
916 /* Just the header word and the length word */
921 scav_vector_bit(lispobj *where, lispobj object)
923 struct vector *vector;
926 vector = (struct vector *) where;
927 length = fixnum_value(vector->length);
928 nwords = CEILING(NWORDS(length, 1) + 2, 2);
934 trans_vector_bit(lispobj object)
936 struct vector *vector;
939 gc_assert(is_lisp_pointer(object));
941 vector = (struct vector *) native_pointer(object);
942 length = fixnum_value(vector->length);
943 nwords = CEILING(NWORDS(length, 1) + 2, 2);
945 return copy_large_unboxed_object(object, nwords);
949 size_vector_bit(lispobj *where)
951 struct vector *vector;
954 vector = (struct vector *) where;
955 length = fixnum_value(vector->length);
956 nwords = CEILING(NWORDS(length, 1) + 2, 2);
962 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
964 struct vector *vector;
967 vector = (struct vector *) where;
968 length = fixnum_value(vector->length);
969 nwords = CEILING(NWORDS(length, 2) + 2, 2);
975 trans_vector_unsigned_byte_2(lispobj object)
977 struct vector *vector;
980 gc_assert(is_lisp_pointer(object));
982 vector = (struct vector *) native_pointer(object);
983 length = fixnum_value(vector->length);
984 nwords = CEILING(NWORDS(length, 2) + 2, 2);
986 return copy_large_unboxed_object(object, nwords);
990 size_vector_unsigned_byte_2(lispobj *where)
992 struct vector *vector;
995 vector = (struct vector *) where;
996 length = fixnum_value(vector->length);
997 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1003 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
1005 struct vector *vector;
1006 long length, nwords;
1008 vector = (struct vector *) where;
1009 length = fixnum_value(vector->length);
1010 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1016 trans_vector_unsigned_byte_4(lispobj object)
1018 struct vector *vector;
1019 long length, nwords;
1021 gc_assert(is_lisp_pointer(object));
1023 vector = (struct vector *) native_pointer(object);
1024 length = fixnum_value(vector->length);
1025 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1027 return copy_large_unboxed_object(object, nwords);
1030 size_vector_unsigned_byte_4(lispobj *where)
1032 struct vector *vector;
1033 long length, nwords;
1035 vector = (struct vector *) where;
1036 length = fixnum_value(vector->length);
1037 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1044 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
1046 struct vector *vector;
1047 long length, nwords;
1049 vector = (struct vector *) where;
1050 length = fixnum_value(vector->length);
1051 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1056 /*********************/
1061 trans_vector_unsigned_byte_8(lispobj object)
1063 struct vector *vector;
1064 long length, nwords;
1066 gc_assert(is_lisp_pointer(object));
1068 vector = (struct vector *) native_pointer(object);
1069 length = fixnum_value(vector->length);
1070 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1072 return copy_large_unboxed_object(object, nwords);
1076 size_vector_unsigned_byte_8(lispobj *where)
1078 struct vector *vector;
1079 long length, nwords;
1081 vector = (struct vector *) where;
1082 length = fixnum_value(vector->length);
1083 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1090 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1092 struct vector *vector;
1093 long length, nwords;
1095 vector = (struct vector *) where;
1096 length = fixnum_value(vector->length);
1097 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1103 trans_vector_unsigned_byte_16(lispobj object)
1105 struct vector *vector;
1106 long length, nwords;
1108 gc_assert(is_lisp_pointer(object));
1110 vector = (struct vector *) native_pointer(object);
1111 length = fixnum_value(vector->length);
1112 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1114 return copy_large_unboxed_object(object, nwords);
1118 size_vector_unsigned_byte_16(lispobj *where)
1120 struct vector *vector;
1121 long length, nwords;
1123 vector = (struct vector *) where;
1124 length = fixnum_value(vector->length);
1125 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1131 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1133 struct vector *vector;
1134 long length, nwords;
1136 vector = (struct vector *) where;
1137 length = fixnum_value(vector->length);
1138 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1144 trans_vector_unsigned_byte_32(lispobj object)
1146 struct vector *vector;
1147 long length, nwords;
1149 gc_assert(is_lisp_pointer(object));
1151 vector = (struct vector *) native_pointer(object);
1152 length = fixnum_value(vector->length);
1153 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1155 return copy_large_unboxed_object(object, nwords);
1159 size_vector_unsigned_byte_32(lispobj *where)
1161 struct vector *vector;
1162 long length, nwords;
1164 vector = (struct vector *) where;
1165 length = fixnum_value(vector->length);
1166 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1171 #if N_WORD_BITS == 64
1173 scav_vector_unsigned_byte_64(lispobj *where, lispobj object)
1175 struct vector *vector;
1176 long length, nwords;
1178 vector = (struct vector *) where;
1179 length = fixnum_value(vector->length);
1180 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1186 trans_vector_unsigned_byte_64(lispobj object)
1188 struct vector *vector;
1189 long length, nwords;
1191 gc_assert(is_lisp_pointer(object));
1193 vector = (struct vector *) native_pointer(object);
1194 length = fixnum_value(vector->length);
1195 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1197 return copy_large_unboxed_object(object, nwords);
1201 size_vector_unsigned_byte_64(lispobj *where)
1203 struct vector *vector;
1204 long length, nwords;
1206 vector = (struct vector *) where;
1207 length = fixnum_value(vector->length);
1208 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1215 scav_vector_single_float(lispobj *where, lispobj object)
1217 struct vector *vector;
1218 long length, nwords;
1220 vector = (struct vector *) where;
1221 length = fixnum_value(vector->length);
1222 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1228 trans_vector_single_float(lispobj object)
1230 struct vector *vector;
1231 long length, nwords;
1233 gc_assert(is_lisp_pointer(object));
1235 vector = (struct vector *) native_pointer(object);
1236 length = fixnum_value(vector->length);
1237 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1239 return copy_large_unboxed_object(object, nwords);
1243 size_vector_single_float(lispobj *where)
1245 struct vector *vector;
1246 long length, nwords;
1248 vector = (struct vector *) where;
1249 length = fixnum_value(vector->length);
1250 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1256 scav_vector_double_float(lispobj *where, lispobj object)
1258 struct vector *vector;
1259 long length, nwords;
1261 vector = (struct vector *) where;
1262 length = fixnum_value(vector->length);
1263 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1269 trans_vector_double_float(lispobj object)
1271 struct vector *vector;
1272 long length, nwords;
1274 gc_assert(is_lisp_pointer(object));
1276 vector = (struct vector *) native_pointer(object);
1277 length = fixnum_value(vector->length);
1278 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1280 return copy_large_unboxed_object(object, nwords);
1284 size_vector_double_float(lispobj *where)
1286 struct vector *vector;
1287 long length, nwords;
1289 vector = (struct vector *) where;
1290 length = fixnum_value(vector->length);
1291 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1296 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1298 scav_vector_long_float(lispobj *where, lispobj object)
1300 struct vector *vector;
1301 long length, nwords;
1303 vector = (struct vector *) where;
1304 length = fixnum_value(vector->length);
1305 nwords = CEILING(length *
1312 trans_vector_long_float(lispobj object)
1314 struct vector *vector;
1315 long length, nwords;
1317 gc_assert(is_lisp_pointer(object));
1319 vector = (struct vector *) native_pointer(object);
1320 length = fixnum_value(vector->length);
1321 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1323 return copy_large_unboxed_object(object, nwords);
1327 size_vector_long_float(lispobj *where)
1329 struct vector *vector;
1330 long length, nwords;
1332 vector = (struct vector *) where;
1333 length = fixnum_value(vector->length);
1334 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1341 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1343 scav_vector_complex_single_float(lispobj *where, lispobj object)
1345 struct vector *vector;
1346 long length, nwords;
1348 vector = (struct vector *) where;
1349 length = fixnum_value(vector->length);
1350 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1356 trans_vector_complex_single_float(lispobj object)
1358 struct vector *vector;
1359 long length, nwords;
1361 gc_assert(is_lisp_pointer(object));
1363 vector = (struct vector *) native_pointer(object);
1364 length = fixnum_value(vector->length);
1365 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1367 return copy_large_unboxed_object(object, nwords);
1371 size_vector_complex_single_float(lispobj *where)
1373 struct vector *vector;
1374 long length, nwords;
1376 vector = (struct vector *) where;
1377 length = fixnum_value(vector->length);
1378 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1384 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1386 scav_vector_complex_double_float(lispobj *where, lispobj object)
1388 struct vector *vector;
1389 long length, nwords;
1391 vector = (struct vector *) where;
1392 length = fixnum_value(vector->length);
1393 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1399 trans_vector_complex_double_float(lispobj object)
1401 struct vector *vector;
1402 long length, nwords;
1404 gc_assert(is_lisp_pointer(object));
1406 vector = (struct vector *) native_pointer(object);
1407 length = fixnum_value(vector->length);
1408 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1410 return copy_large_unboxed_object(object, nwords);
1414 size_vector_complex_double_float(lispobj *where)
1416 struct vector *vector;
1417 long length, nwords;
1419 vector = (struct vector *) where;
1420 length = fixnum_value(vector->length);
1421 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1428 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1430 scav_vector_complex_long_float(lispobj *where, lispobj object)
1432 struct vector *vector;
1433 long length, nwords;
1435 vector = (struct vector *) where;
1436 length = fixnum_value(vector->length);
1437 nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1443 trans_vector_complex_long_float(lispobj object)
1445 struct vector *vector;
1446 long length, nwords;
1448 gc_assert(is_lisp_pointer(object));
1450 vector = (struct vector *) native_pointer(object);
1451 length = fixnum_value(vector->length);
1452 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1454 return copy_large_unboxed_object(object, nwords);
1458 size_vector_complex_long_float(lispobj *where)
1460 struct vector *vector;
1461 long length, nwords;
1463 vector = (struct vector *) where;
1464 length = fixnum_value(vector->length);
1465 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1471 #define WEAK_POINTER_NWORDS \
1472 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1475 trans_weak_pointer(lispobj object)
1478 #ifndef LISP_FEATURE_GENCGC
1479 struct weak_pointer *wp;
1481 gc_assert(is_lisp_pointer(object));
1483 #if defined(DEBUG_WEAK)
1484 printf("Transporting weak pointer from 0x%08x\n", object);
1487 /* Need to remember where all the weak pointers are that have */
1488 /* been transported so they can be fixed up in a post-GC pass. */
1490 copy = copy_object(object, WEAK_POINTER_NWORDS);
1491 #ifndef LISP_FEATURE_GENCGC
1492 wp = (struct weak_pointer *) native_pointer(copy);
1494 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1495 /* Push the weak pointer onto the list of weak pointers. */
1496 wp->next = (struct weak_pointer *)LOW_WORD(weak_pointers);
1503 size_weak_pointer(lispobj *where)
1505 return WEAK_POINTER_NWORDS;
1509 void scan_weak_pointers(void)
1511 struct weak_pointer *wp;
1512 for (wp = weak_pointers; wp != NULL; wp=wp->next) {
1513 lispobj value = wp->value;
1514 lispobj *first_pointer;
1515 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1516 if (!(is_lisp_pointer(value) && from_space_p(value)))
1519 /* Now, we need to check whether the object has been forwarded. If
1520 * it has been, the weak pointer is still good and needs to be
1521 * updated. Otherwise, the weak pointer needs to be nil'ed
1524 first_pointer = (lispobj *)native_pointer(value);
1526 if (forwarding_pointer_p(first_pointer)) {
1528 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1544 scav_lose(lispobj *where, lispobj object)
1546 lose("no scavenge function for object 0x%08x (widetag 0x%x)\n",
1547 (unsigned long)object,
1548 widetag_of(*(lispobj*)native_pointer(object)));
1550 return 0; /* bogus return value to satisfy static type checking */
1554 trans_lose(lispobj object)
1556 lose("no transport function for object 0x%08x (widetag 0x%x)\n",
1557 (unsigned long)object,
1558 widetag_of(*(lispobj*)native_pointer(object)));
1559 return NIL; /* bogus return value to satisfy static type checking */
1563 size_lose(lispobj *where)
1565 lose("no size function for object at 0x%08x (widetag 0x%x)\n",
1566 (unsigned long)where,
1567 widetag_of(LOW_WORD(where)));
1568 return 1; /* bogus return value to satisfy static type checking */
1577 gc_init_tables(void)
1581 /* Set default value in all slots of scavenge table. FIXME
1582 * replace this gnarly sizeof with something based on
1584 for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) {
1585 scavtab[i] = scav_lose;
1588 /* For each type which can be selected by the lowtag alone, set
1589 * multiple entries in our widetag scavenge table (one for each
1590 * possible value of the high bits).
1593 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1594 scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1595 scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1596 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1597 scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1598 scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1599 scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_instance_pointer;
1600 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1601 scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1604 /* Other-pointer types (those selected by all eight bits of the
1605 * tag) get one entry each in the scavenge table. */
1606 scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1607 scavtab[RATIO_WIDETAG] = scav_boxed;
1608 #if N_WORD_BITS == 64
1609 scavtab[SINGLE_FLOAT_WIDETAG] = scav_immediate;
1611 scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1613 scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1614 #ifdef LONG_FLOAT_WIDETAG
1615 scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1617 scavtab[COMPLEX_WIDETAG] = scav_boxed;
1618 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1619 scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1621 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1622 scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1624 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1625 scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
1627 scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
1628 scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
1629 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1630 scavtab[SIMPLE_CHARACTER_STRING_WIDETAG] = scav_character_string;
1632 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
1633 scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
1634 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1635 scav_vector_unsigned_byte_2;
1636 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1637 scav_vector_unsigned_byte_4;
1638 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1639 scav_vector_unsigned_byte_8;
1640 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1641 scav_vector_unsigned_byte_8;
1642 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1643 scav_vector_unsigned_byte_16;
1644 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1645 scav_vector_unsigned_byte_16;
1646 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1647 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1648 scav_vector_unsigned_byte_32;
1650 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1651 scav_vector_unsigned_byte_32;
1652 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1653 scav_vector_unsigned_byte_32;
1654 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1655 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1656 scav_vector_unsigned_byte_64;
1658 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1659 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1660 scav_vector_unsigned_byte_64;
1662 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1663 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1664 scav_vector_unsigned_byte_64;
1666 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1667 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
1669 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1670 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1671 scav_vector_unsigned_byte_16;
1673 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1674 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1675 scav_vector_unsigned_byte_32;
1677 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1678 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1679 scav_vector_unsigned_byte_32;
1681 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1682 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1683 scav_vector_unsigned_byte_64;
1685 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1686 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1687 scav_vector_unsigned_byte_64;
1689 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
1690 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
1691 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1692 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
1694 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1695 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1696 scav_vector_complex_single_float;
1698 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1699 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1700 scav_vector_complex_double_float;
1702 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1703 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1704 scav_vector_complex_long_float;
1706 scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
1707 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1708 scavtab[COMPLEX_CHARACTER_STRING_WIDETAG] = scav_boxed;
1710 scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
1711 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
1712 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
1713 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
1714 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
1715 #ifndef LISP_FEATURE_GENCGC /* FIXME ..._X86 ? */
1716 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
1717 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
1719 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
1720 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
1721 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
1723 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
1724 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
1726 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
1727 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
1728 scavtab[CHARACTER_WIDETAG] = scav_immediate;
1729 scavtab[SAP_WIDETAG] = scav_unboxed;
1730 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
1731 scavtab[NO_TLS_VALUE_MARKER_WIDETAG] = scav_immediate;
1732 scavtab[INSTANCE_HEADER_WIDETAG] = scav_instance;
1733 #ifdef LISP_FEATURE_SPARC
1734 scavtab[FDEFN_WIDETAG] = scav_boxed;
1736 scavtab[FDEFN_WIDETAG] = scav_fdefn;
1739 /* transport other table, initialized same way as scavtab */
1740 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
1741 transother[i] = trans_lose;
1742 transother[BIGNUM_WIDETAG] = trans_unboxed;
1743 transother[RATIO_WIDETAG] = trans_boxed;
1745 #if N_WORD_BITS == 64
1746 transother[SINGLE_FLOAT_WIDETAG] = trans_immediate;
1748 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1750 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1751 #ifdef LONG_FLOAT_WIDETAG
1752 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
1754 transother[COMPLEX_WIDETAG] = trans_boxed;
1755 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1756 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1758 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1759 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1761 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1762 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
1764 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
1765 transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
1766 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1767 transother[SIMPLE_CHARACTER_STRING_WIDETAG] = trans_character_string;
1769 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
1770 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
1771 transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
1772 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1773 trans_vector_unsigned_byte_2;
1774 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1775 trans_vector_unsigned_byte_4;
1776 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1777 trans_vector_unsigned_byte_8;
1778 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1779 trans_vector_unsigned_byte_8;
1780 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1781 trans_vector_unsigned_byte_16;
1782 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1783 trans_vector_unsigned_byte_16;
1784 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1785 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1786 trans_vector_unsigned_byte_32;
1788 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1789 trans_vector_unsigned_byte_32;
1790 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1791 trans_vector_unsigned_byte_32;
1792 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1793 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1794 trans_vector_unsigned_byte_64;
1796 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1797 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1798 trans_vector_unsigned_byte_64;
1800 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1801 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1802 trans_vector_unsigned_byte_64;
1804 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1805 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
1806 trans_vector_unsigned_byte_8;
1808 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1809 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1810 trans_vector_unsigned_byte_16;
1812 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1813 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1814 trans_vector_unsigned_byte_32;
1816 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1817 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1818 trans_vector_unsigned_byte_32;
1820 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1821 transother[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1822 trans_vector_unsigned_byte_64;
1824 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1825 transother[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1826 trans_vector_unsigned_byte_64;
1828 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
1829 trans_vector_single_float;
1830 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
1831 trans_vector_double_float;
1832 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1833 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
1834 trans_vector_long_float;
1836 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1837 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1838 trans_vector_complex_single_float;
1840 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1841 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1842 trans_vector_complex_double_float;
1844 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1845 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1846 trans_vector_complex_long_float;
1848 transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
1849 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1850 transother[COMPLEX_CHARACTER_STRING_WIDETAG] = trans_boxed;
1852 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
1853 transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
1854 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
1855 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
1856 transother[CODE_HEADER_WIDETAG] = trans_code_header;
1857 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
1858 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
1859 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
1860 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
1861 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
1862 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
1863 transother[CHARACTER_WIDETAG] = trans_immediate;
1864 transother[SAP_WIDETAG] = trans_unboxed;
1865 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
1866 transother[NO_TLS_VALUE_MARKER_WIDETAG] = trans_immediate;
1867 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
1868 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
1869 transother[FDEFN_WIDETAG] = trans_boxed;
1871 /* size table, initialized the same way as scavtab */
1872 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
1873 sizetab[i] = size_lose;
1874 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1875 sizetab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
1876 sizetab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1877 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1878 sizetab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1879 sizetab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
1880 sizetab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1881 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1882 sizetab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1884 sizetab[BIGNUM_WIDETAG] = size_unboxed;
1885 sizetab[RATIO_WIDETAG] = size_boxed;
1886 #if N_WORD_BITS == 64
1887 sizetab[SINGLE_FLOAT_WIDETAG] = size_immediate;
1889 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
1891 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1892 #ifdef LONG_FLOAT_WIDETAG
1893 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
1895 sizetab[COMPLEX_WIDETAG] = size_boxed;
1896 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1897 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
1899 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1900 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1902 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1903 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
1905 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
1906 sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
1907 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1908 sizetab[SIMPLE_CHARACTER_STRING_WIDETAG] = size_character_string;
1910 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
1911 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
1912 sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
1913 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1914 size_vector_unsigned_byte_2;
1915 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1916 size_vector_unsigned_byte_4;
1917 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1918 size_vector_unsigned_byte_8;
1919 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1920 size_vector_unsigned_byte_8;
1921 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1922 size_vector_unsigned_byte_16;
1923 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1924 size_vector_unsigned_byte_16;
1925 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1926 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1927 size_vector_unsigned_byte_32;
1929 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1930 size_vector_unsigned_byte_32;
1931 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1932 size_vector_unsigned_byte_32;
1933 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1934 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1935 size_vector_unsigned_byte_64;
1937 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1938 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1939 size_vector_unsigned_byte_64;
1941 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1942 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1943 size_vector_unsigned_byte_64;
1945 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1946 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
1948 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1949 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1950 size_vector_unsigned_byte_16;
1952 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1953 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1954 size_vector_unsigned_byte_32;
1956 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1957 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1958 size_vector_unsigned_byte_32;
1960 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1961 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1962 size_vector_unsigned_byte_64;
1964 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1965 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1966 size_vector_unsigned_byte_64;
1968 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
1969 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
1970 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1971 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
1973 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1974 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1975 size_vector_complex_single_float;
1977 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1978 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1979 size_vector_complex_double_float;
1981 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1982 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1983 size_vector_complex_long_float;
1985 sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
1986 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1987 sizetab[COMPLEX_CHARACTER_STRING_WIDETAG] = size_boxed;
1989 sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
1990 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
1991 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
1992 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
1993 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
1995 /* We shouldn't see these, so just lose if it happens. */
1996 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
1997 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
1999 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
2000 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
2001 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
2002 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
2003 sizetab[CHARACTER_WIDETAG] = size_immediate;
2004 sizetab[SAP_WIDETAG] = size_unboxed;
2005 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
2006 sizetab[NO_TLS_VALUE_MARKER_WIDETAG] = size_immediate;
2007 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
2008 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
2009 sizetab[FDEFN_WIDETAG] = size_boxed;
2013 /* Find the code object for the given pc, or return NULL on
2016 component_ptr_from_pc(lispobj *pc)
2018 lispobj *object = NULL;
2020 if ( (object = search_read_only_space(pc)) )
2022 else if ( (object = search_static_space(pc)) )
2025 object = search_dynamic_space(pc);
2027 if (object) /* if we found something */
2028 if (widetag_of(*object) == CODE_HEADER_WIDETAG)
2034 /* Scan an area looking for an object which encloses the given pointer.
2035 * Return the object start on success or NULL on failure. */
2037 gc_search_space(lispobj *start, size_t words, lispobj *pointer)
2041 lispobj thing = *start;
2043 /* If thing is an immediate then this is a cons. */
2044 if (is_lisp_pointer(thing)
2046 || (widetag_of(thing) == CHARACTER_WIDETAG)
2047 #if N_WORD_BITS == 64
2048 || (widetag_of(thing) == SINGLE_FLOAT_WIDETAG)
2050 || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG))
2053 count = (sizetab[widetag_of(thing)])(start);
2055 /* Check whether the pointer is within this object. */
2056 if ((pointer >= start) && (pointer < (start+count))) {
2058 /*FSHOW((stderr,"/found %x in %x %x\n", pointer, start, thing));*/
2062 /* Round up the count. */
2063 count = CEILING(count,2);