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 "gc-internal.h"
46 #ifdef LISP_FEATURE_SPARC
47 #define LONG_FLOAT_SIZE 4
49 #ifdef LISP_FEATURE_X86
50 #define LONG_FLOAT_SIZE 3
55 forwarding_pointer_p(lispobj *pointer) {
56 lispobj first_word=*pointer;
57 #ifdef LISP_FEATURE_GENCGC
58 return (first_word == 0x01);
60 return (is_lisp_pointer(first_word)
61 && new_space_p(first_word));
65 static inline lispobj *
66 forwarding_pointer_value(lispobj *pointer) {
67 #ifdef LISP_FEATURE_GENCGC
68 return (lispobj *) ((pointer_sized_uint_t) pointer[1]);
70 return (lispobj *) ((pointer_sized_uint_t) pointer[0]);
74 set_forwarding_pointer(lispobj * pointer, lispobj newspace_copy) {
75 #ifdef LISP_FEATURE_GENCGC
77 pointer[1]=newspace_copy;
79 pointer[0]=newspace_copy;
84 int (*scavtab[256])(lispobj *where, lispobj object);
85 lispobj (*transother[256])(lispobj object);
86 int (*sizetab[256])(lispobj *where);
87 struct weak_pointer *weak_pointers;
89 unsigned long bytes_consed_between_gcs = 12*1024*1024;
96 /* to copy a boxed object */
98 copy_object(lispobj object, int nwords)
103 gc_assert(is_lisp_pointer(object));
104 gc_assert(from_space_p(object));
105 gc_assert((nwords & 0x01) == 0);
107 /* Get tag of object. */
108 tag = lowtag_of(object);
110 /* Allocate space. */
111 new = gc_general_alloc(nwords*N_WORD_BYTES,ALLOC_BOXED,ALLOC_QUICK);
113 /* Copy the object. */
114 memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
115 return make_lispobj(new,tag);
118 static int scav_lose(lispobj *where, lispobj object); /* forward decl */
120 /* FIXME: Most calls end up going to some trouble to compute an
121 * 'n_words' value for this function. The system might be a little
122 * simpler if this function used an 'end' parameter instead. */
124 scavenge(lispobj *start, long n_words)
126 lispobj *end = start + n_words;
128 int n_words_scavenged;
129 for (object_ptr = start;
131 object_ptr += n_words_scavenged) {
133 lispobj object = *object_ptr;
134 #ifdef LISP_FEATURE_GENCGC
135 gc_assert(!forwarding_pointer_p(object_ptr));
137 if (is_lisp_pointer(object)) {
138 if (from_space_p(object)) {
139 /* It currently points to old space. Check for a
140 * forwarding pointer. */
141 lispobj *ptr = native_pointer(object);
142 if (forwarding_pointer_p(ptr)) {
143 /* Yes, there's a forwarding pointer. */
144 *object_ptr = LOW_WORD(forwarding_pointer_value(ptr));
145 n_words_scavenged = 1;
147 /* Scavenge that pointer. */
149 (scavtab[widetag_of(object)])(object_ptr, object);
152 /* It points somewhere other than oldspace. Leave it
154 n_words_scavenged = 1;
157 #ifndef LISP_FEATURE_GENCGC
158 /* this workaround is probably not necessary for gencgc; at least, the
159 * behaviour it describes has never been reported */
160 else if (n_words==1) {
161 /* there are some situations where an
162 other-immediate may end up in a descriptor
163 register. I'm not sure whether this is
164 supposed to happen, but if it does then we
165 don't want to (a) barf or (b) scavenge over the
166 data-block, because there isn't one. So, if
167 we're checking a single word and it's anything
168 other than a pointer, just hush it up */
169 int type=widetag_of(object);
172 if ((scavtab[type]==scav_lose) ||
173 (((scavtab[type])(start,object))>1)) {
174 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",
179 else if (fixnump(object)) {
180 /* It's a fixnum: really easy.. */
181 n_words_scavenged = 1;
183 /* It's some sort of header object or another. */
185 (scavtab[widetag_of(object)])(object_ptr, object);
188 gc_assert(object_ptr == end);
191 static lispobj trans_fun_header(lispobj object); /* forward decls */
192 static lispobj trans_boxed(lispobj object);
195 scav_fun_pointer(lispobj *where, lispobj object)
197 lispobj *first_pointer;
200 gc_assert(is_lisp_pointer(object));
202 /* Object is a pointer into from_space - not a FP. */
203 first_pointer = (lispobj *) native_pointer(object);
205 /* must transport object -- object may point to either a function
206 * header, a closure function header, or to a closure header. */
208 switch (widetag_of(*first_pointer)) {
209 case SIMPLE_FUN_HEADER_WIDETAG:
210 copy = trans_fun_header(object);
213 copy = trans_boxed(object);
217 if (copy != object) {
218 /* Set forwarding pointer */
219 set_forwarding_pointer(first_pointer,copy);
222 gc_assert(is_lisp_pointer(copy));
223 gc_assert(!from_space_p(copy));
232 trans_code(struct code *code)
234 struct code *new_code;
235 lispobj first, l_code, l_new_code;
236 int nheader_words, ncode_words, nwords;
237 unsigned long displacement;
238 lispobj fheaderl, *prev_pointer;
240 /* if object has already been transported, just return pointer */
241 first = code->header;
242 if (forwarding_pointer_p((lispobj *)code)) {
244 printf("Was already transported\n");
246 return (struct code *) forwarding_pointer_value
247 ((lispobj *)((pointer_sized_uint_t) code));
250 gc_assert(widetag_of(first) == CODE_HEADER_WIDETAG);
252 /* prepare to transport the code vector */
253 l_code = (lispobj) LOW_WORD(code) | OTHER_POINTER_LOWTAG;
255 ncode_words = fixnum_value(code->code_size);
256 nheader_words = HeaderValue(code->header);
257 nwords = ncode_words + nheader_words;
258 nwords = CEILING(nwords, 2);
260 l_new_code = copy_object(l_code, nwords);
261 new_code = (struct code *) native_pointer(l_new_code);
263 #if defined(DEBUG_CODE_GC)
264 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
265 (unsigned long) code, (unsigned long) new_code);
266 printf("Code object is %d words long.\n", nwords);
269 #ifdef LISP_FEATURE_GENCGC
270 if (new_code == code)
274 displacement = l_new_code - l_code;
276 set_forwarding_pointer((lispobj *)code, l_new_code);
278 /* set forwarding pointers for all the function headers in the */
279 /* code object. also fix all self pointers */
281 fheaderl = code->entry_points;
282 prev_pointer = &new_code->entry_points;
284 while (fheaderl != NIL) {
285 struct simple_fun *fheaderp, *nfheaderp;
288 fheaderp = (struct simple_fun *) native_pointer(fheaderl);
289 gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
291 /* Calculate the new function pointer and the new */
292 /* function header. */
293 nfheaderl = fheaderl + displacement;
294 nfheaderp = (struct simple_fun *) native_pointer(nfheaderl);
297 printf("fheaderp->header (at %x) <- %x\n",
298 &(fheaderp->header) , nfheaderl);
300 set_forwarding_pointer((lispobj *)fheaderp, nfheaderl);
302 /* fix self pointer. */
304 #ifdef LISP_FEATURE_X86
305 FUN_RAW_ADDR_OFFSET +
309 *prev_pointer = nfheaderl;
311 fheaderl = fheaderp->next;
312 prev_pointer = &nfheaderp->next;
314 os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words),
315 ncode_words * sizeof(int));
316 #ifdef LISP_FEATURE_GENCGC
317 gencgc_apply_code_fixups(code, new_code);
323 scav_code_header(lispobj *where, lispobj object)
326 int n_header_words, n_code_words, n_words;
327 lispobj entry_point; /* tagged pointer to entry point */
328 struct simple_fun *function_ptr; /* untagged pointer to entry point */
330 code = (struct code *) where;
331 n_code_words = fixnum_value(code->code_size);
332 n_header_words = HeaderValue(object);
333 n_words = n_code_words + n_header_words;
334 n_words = CEILING(n_words, 2);
336 /* Scavenge the boxed section of the code data block. */
337 scavenge(where + 1, n_header_words - 1);
339 /* Scavenge the boxed section of each function object in the
340 * code data block. */
341 for (entry_point = code->entry_points;
343 entry_point = function_ptr->next) {
345 gc_assert(is_lisp_pointer(entry_point));
347 function_ptr = (struct simple_fun *) native_pointer(entry_point);
348 gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
350 scavenge(&function_ptr->name, 1);
351 scavenge(&function_ptr->arglist, 1);
352 scavenge(&function_ptr->type, 1);
359 trans_code_header(lispobj object)
363 ncode = trans_code((struct code *) native_pointer(object));
364 return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG;
369 size_code_header(lispobj *where)
372 int nheader_words, ncode_words, nwords;
374 code = (struct code *) where;
376 ncode_words = fixnum_value(code->code_size);
377 nheader_words = HeaderValue(code->header);
378 nwords = ncode_words + nheader_words;
379 nwords = CEILING(nwords, 2);
384 #ifndef LISP_FEATURE_X86
386 scav_return_pc_header(lispobj *where, lispobj object)
388 lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x",
389 (unsigned long) where,
390 (unsigned long) object);
391 return 0; /* bogus return value to satisfy static type checking */
393 #endif /* LISP_FEATURE_X86 */
396 trans_return_pc_header(lispobj object)
398 struct simple_fun *return_pc;
399 unsigned long offset;
400 struct code *code, *ncode;
402 return_pc = (struct simple_fun *) native_pointer(object);
403 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
404 offset = HeaderValue(return_pc->header) * N_WORD_BYTES;
406 /* Transport the whole code object */
407 code = (struct code *) ((unsigned long) return_pc - offset);
408 ncode = trans_code(code);
410 return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
413 /* On the 386, closures hold a pointer to the raw address instead of the
414 * function object, so we can use CALL [$FDEFN+const] to invoke
415 * the function without loading it into a register. Given that code
416 * objects don't move, we don't need to update anything, but we do
417 * have to figure out that the function is still live. */
419 #ifdef LISP_FEATURE_X86
421 scav_closure_header(lispobj *where, lispobj object)
423 struct closure *closure;
426 closure = (struct closure *)where;
427 fun = closure->fun - FUN_RAW_ADDR_OFFSET;
429 #ifdef LISP_FEATURE_GENCGC
430 /* The function may have moved so update the raw address. But
431 * don't write unnecessarily. */
432 if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
433 closure->fun = fun + FUN_RAW_ADDR_OFFSET;
439 #ifndef LISP_FEATURE_X86
441 scav_fun_header(lispobj *where, lispobj object)
443 lose("attempted to scavenge a function header where=0x%08x object=0x%08x",
444 (unsigned long) where,
445 (unsigned long) object);
446 return 0; /* bogus return value to satisfy static type checking */
448 #endif /* LISP_FEATURE_X86 */
451 trans_fun_header(lispobj object)
453 struct simple_fun *fheader;
454 unsigned long offset;
455 struct code *code, *ncode;
457 fheader = (struct simple_fun *) native_pointer(object);
458 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
459 offset = HeaderValue(fheader->header) * N_WORD_BYTES;
461 /* Transport the whole code object */
462 code = (struct code *) ((unsigned long) fheader - offset);
463 ncode = trans_code(code);
465 return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
474 scav_instance_pointer(lispobj *where, lispobj object)
476 lispobj copy, *first_pointer;
478 /* Object is a pointer into from space - not a FP. */
479 copy = trans_boxed(object);
481 #ifdef LISP_FEATURE_GENCGC
482 gc_assert(copy != object);
485 first_pointer = (lispobj *) native_pointer(object);
486 set_forwarding_pointer(first_pointer,copy);
497 static lispobj trans_list(lispobj object);
500 scav_list_pointer(lispobj *where, lispobj object)
502 lispobj first, *first_pointer;
504 gc_assert(is_lisp_pointer(object));
506 /* Object is a pointer into from space - not FP. */
507 first_pointer = (lispobj *) native_pointer(object);
509 first = trans_list(object);
510 gc_assert(first != object);
512 /* Set forwarding pointer */
513 set_forwarding_pointer(first_pointer, first);
515 gc_assert(is_lisp_pointer(first));
516 gc_assert(!from_space_p(first));
524 trans_list(lispobj object)
526 lispobj new_list_pointer;
527 struct cons *cons, *new_cons;
530 cons = (struct cons *) native_pointer(object);
533 new_cons = (struct cons *)
534 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
535 new_cons->car = cons->car;
536 new_cons->cdr = cons->cdr; /* updated later */
537 new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
539 /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC */
542 set_forwarding_pointer((lispobj *)cons, new_list_pointer);
544 /* Try to linearize the list in the cdr direction to help reduce
548 struct cons *cdr_cons, *new_cdr_cons;
550 if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
551 !from_space_p(cdr) ||
552 forwarding_pointer_p((lispobj *)native_pointer(cdr)))
555 cdr_cons = (struct cons *) native_pointer(cdr);
558 new_cdr_cons = (struct cons*)
559 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
560 new_cdr_cons->car = cdr_cons->car;
561 new_cdr_cons->cdr = cdr_cons->cdr;
562 new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
564 /* Grab the cdr before it is clobbered. */
566 set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
568 /* Update the cdr of the last cons copied into new space to
569 * keep the newspace scavenge from having to do it. */
570 new_cons->cdr = new_cdr;
572 new_cons = new_cdr_cons;
575 return new_list_pointer;
580 * scavenging and transporting other pointers
584 scav_other_pointer(lispobj *where, lispobj object)
586 lispobj first, *first_pointer;
588 gc_assert(is_lisp_pointer(object));
590 /* Object is a pointer into from space - not FP. */
591 first_pointer = (lispobj *) native_pointer(object);
592 first = (transother[widetag_of(*first_pointer)])(object);
594 if (first != object) {
595 set_forwarding_pointer(first_pointer, first);
596 #ifdef LISP_FEATURE_GENCGC
600 #ifndef LISP_FEATURE_GENCGC
603 gc_assert(is_lisp_pointer(first));
604 gc_assert(!from_space_p(first));
610 * immediate, boxed, and unboxed objects
614 size_pointer(lispobj *where)
620 scav_immediate(lispobj *where, lispobj object)
626 trans_immediate(lispobj object)
628 lose("trying to transport an immediate");
629 return NIL; /* bogus return value to satisfy static type checking */
633 size_immediate(lispobj *where)
640 scav_boxed(lispobj *where, lispobj object)
646 trans_boxed(lispobj object)
649 unsigned long length;
651 gc_assert(is_lisp_pointer(object));
653 header = *((lispobj *) native_pointer(object));
654 length = HeaderValue(header) + 1;
655 length = CEILING(length, 2);
657 return copy_object(object, length);
662 size_boxed(lispobj *where)
665 unsigned long length;
668 length = HeaderValue(header) + 1;
669 length = CEILING(length, 2);
674 /* Note: on the sparc we don't have to do anything special for fdefns, */
675 /* 'cause the raw-addr has a function lowtag. */
676 #ifndef LISP_FEATURE_SPARC
678 scav_fdefn(lispobj *where, lispobj object)
682 fdefn = (struct fdefn *)where;
684 /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
685 fdefn->fun, fdefn->raw_addr)); */
687 if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)
688 == (char *)((unsigned long)(fdefn->raw_addr))) {
689 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
691 /* Don't write unnecessarily. */
692 if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
693 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
694 /* gc.c has more casts here, which may be relevant or alternatively
695 may be compiler warning defeaters. try
696 fdefn->raw_addr = ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
698 return sizeof(struct fdefn) / sizeof(lispobj);
706 scav_unboxed(lispobj *where, lispobj object)
708 unsigned long length;
710 length = HeaderValue(object) + 1;
711 length = CEILING(length, 2);
717 trans_unboxed(lispobj object)
720 unsigned long length;
723 gc_assert(is_lisp_pointer(object));
725 header = *((lispobj *) native_pointer(object));
726 length = HeaderValue(header) + 1;
727 length = CEILING(length, 2);
729 return copy_unboxed_object(object, length);
733 size_unboxed(lispobj *where)
736 unsigned long length;
739 length = HeaderValue(header) + 1;
740 length = CEILING(length, 2);
746 /* vector-like objects */
748 scav_base_string(lispobj *where, lispobj object)
750 struct vector *vector;
753 /* NOTE: Strings contain one more byte of data than the length */
754 /* slot indicates. */
756 vector = (struct vector *) where;
757 length = fixnum_value(vector->length) + 1;
758 nwords = CEILING(NWORDS(length, 8) + 2, 2);
763 trans_base_string(lispobj object)
765 struct vector *vector;
768 gc_assert(is_lisp_pointer(object));
770 /* NOTE: A string contains one more byte of data (a terminating
771 * '\0' to help when interfacing with C functions) than indicated
772 * by the length slot. */
774 vector = (struct vector *) native_pointer(object);
775 length = fixnum_value(vector->length) + 1;
776 nwords = CEILING(NWORDS(length, 8) + 2, 2);
778 return copy_large_unboxed_object(object, nwords);
782 size_base_string(lispobj *where)
784 struct vector *vector;
787 /* NOTE: A string contains one more byte of data (a terminating
788 * '\0' to help when interfacing with C functions) than indicated
789 * by the length slot. */
791 vector = (struct vector *) where;
792 length = fixnum_value(vector->length) + 1;
793 nwords = CEILING(NWORDS(length, 8) + 2, 2);
799 trans_vector(lispobj object)
801 struct vector *vector;
804 gc_assert(is_lisp_pointer(object));
806 vector = (struct vector *) native_pointer(object);
808 length = fixnum_value(vector->length);
809 nwords = CEILING(length + 2, 2);
811 return copy_large_object(object, nwords);
815 size_vector(lispobj *where)
817 struct vector *vector;
820 vector = (struct vector *) where;
821 length = fixnum_value(vector->length);
822 nwords = CEILING(length + 2, 2);
828 scav_vector_nil(lispobj *where, lispobj object)
834 trans_vector_nil(lispobj object)
836 gc_assert(is_lisp_pointer(object));
837 return copy_unboxed_object(object, 2);
841 size_vector_nil(lispobj *where)
843 /* Just the header word and the length word */
848 scav_vector_bit(lispobj *where, lispobj object)
850 struct vector *vector;
853 vector = (struct vector *) where;
854 length = fixnum_value(vector->length);
855 nwords = CEILING(NWORDS(length, 1) + 2, 2);
861 trans_vector_bit(lispobj object)
863 struct vector *vector;
866 gc_assert(is_lisp_pointer(object));
868 vector = (struct vector *) native_pointer(object);
869 length = fixnum_value(vector->length);
870 nwords = CEILING(NWORDS(length, 1) + 2, 2);
872 return copy_large_unboxed_object(object, nwords);
876 size_vector_bit(lispobj *where)
878 struct vector *vector;
881 vector = (struct vector *) where;
882 length = fixnum_value(vector->length);
883 nwords = CEILING(NWORDS(length, 1) + 2, 2);
889 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
891 struct vector *vector;
894 vector = (struct vector *) where;
895 length = fixnum_value(vector->length);
896 nwords = CEILING(NWORDS(length, 2) + 2, 2);
902 trans_vector_unsigned_byte_2(lispobj object)
904 struct vector *vector;
907 gc_assert(is_lisp_pointer(object));
909 vector = (struct vector *) native_pointer(object);
910 length = fixnum_value(vector->length);
911 nwords = CEILING(NWORDS(length, 2) + 2, 2);
913 return copy_large_unboxed_object(object, nwords);
917 size_vector_unsigned_byte_2(lispobj *where)
919 struct vector *vector;
922 vector = (struct vector *) where;
923 length = fixnum_value(vector->length);
924 nwords = CEILING(NWORDS(length, 2) + 2, 2);
930 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
932 struct vector *vector;
935 vector = (struct vector *) where;
936 length = fixnum_value(vector->length);
937 nwords = CEILING(NWORDS(length, 4) + 2, 2);
943 trans_vector_unsigned_byte_4(lispobj object)
945 struct vector *vector;
948 gc_assert(is_lisp_pointer(object));
950 vector = (struct vector *) native_pointer(object);
951 length = fixnum_value(vector->length);
952 nwords = CEILING(NWORDS(length, 4) + 2, 2);
954 return copy_large_unboxed_object(object, nwords);
957 size_vector_unsigned_byte_4(lispobj *where)
959 struct vector *vector;
962 vector = (struct vector *) where;
963 length = fixnum_value(vector->length);
964 nwords = CEILING(NWORDS(length, 4) + 2, 2);
971 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
973 struct vector *vector;
976 vector = (struct vector *) where;
977 length = fixnum_value(vector->length);
978 nwords = CEILING(NWORDS(length, 8) + 2, 2);
983 /*********************/
988 trans_vector_unsigned_byte_8(lispobj object)
990 struct vector *vector;
993 gc_assert(is_lisp_pointer(object));
995 vector = (struct vector *) native_pointer(object);
996 length = fixnum_value(vector->length);
997 nwords = CEILING(NWORDS(length, 8) + 2, 2);
999 return copy_large_unboxed_object(object, nwords);
1003 size_vector_unsigned_byte_8(lispobj *where)
1005 struct vector *vector;
1008 vector = (struct vector *) where;
1009 length = fixnum_value(vector->length);
1010 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1017 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1019 struct vector *vector;
1022 vector = (struct vector *) where;
1023 length = fixnum_value(vector->length);
1024 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1030 trans_vector_unsigned_byte_16(lispobj object)
1032 struct vector *vector;
1035 gc_assert(is_lisp_pointer(object));
1037 vector = (struct vector *) native_pointer(object);
1038 length = fixnum_value(vector->length);
1039 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1041 return copy_large_unboxed_object(object, nwords);
1045 size_vector_unsigned_byte_16(lispobj *where)
1047 struct vector *vector;
1050 vector = (struct vector *) where;
1051 length = fixnum_value(vector->length);
1052 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1058 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1060 struct vector *vector;
1063 vector = (struct vector *) where;
1064 length = fixnum_value(vector->length);
1065 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1071 trans_vector_unsigned_byte_32(lispobj object)
1073 struct vector *vector;
1076 gc_assert(is_lisp_pointer(object));
1078 vector = (struct vector *) native_pointer(object);
1079 length = fixnum_value(vector->length);
1080 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1082 return copy_large_unboxed_object(object, nwords);
1086 size_vector_unsigned_byte_32(lispobj *where)
1088 struct vector *vector;
1091 vector = (struct vector *) where;
1092 length = fixnum_value(vector->length);
1093 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1098 #if N_WORD_BITS == 64
1100 scav_vector_unsigned_byte_64(lispobj *where, lispobj object)
1102 struct vector *vector;
1105 vector = (struct vector *) where;
1106 length = fixnum_value(vector->length);
1107 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1113 trans_vector_unsigned_byte_64(lispobj object)
1115 struct vector *vector;
1118 gc_assert(is_lisp_pointer(object));
1120 vector = (struct vector *) native_pointer(object);
1121 length = fixnum_value(vector->length);
1122 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1124 return copy_large_unboxed_object(object, nwords);
1128 size_vector_unsigned_byte_64(lispobj *where)
1130 struct vector *vector;
1133 vector = (struct vector *) where;
1134 length = fixnum_value(vector->length);
1135 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1142 scav_vector_single_float(lispobj *where, lispobj object)
1144 struct vector *vector;
1147 vector = (struct vector *) where;
1148 length = fixnum_value(vector->length);
1149 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1155 trans_vector_single_float(lispobj object)
1157 struct vector *vector;
1160 gc_assert(is_lisp_pointer(object));
1162 vector = (struct vector *) native_pointer(object);
1163 length = fixnum_value(vector->length);
1164 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1166 return copy_large_unboxed_object(object, nwords);
1170 size_vector_single_float(lispobj *where)
1172 struct vector *vector;
1175 vector = (struct vector *) where;
1176 length = fixnum_value(vector->length);
1177 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1183 scav_vector_double_float(lispobj *where, lispobj object)
1185 struct vector *vector;
1188 vector = (struct vector *) where;
1189 length = fixnum_value(vector->length);
1190 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1196 trans_vector_double_float(lispobj object)
1198 struct vector *vector;
1201 gc_assert(is_lisp_pointer(object));
1203 vector = (struct vector *) native_pointer(object);
1204 length = fixnum_value(vector->length);
1205 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1207 return copy_large_unboxed_object(object, nwords);
1211 size_vector_double_float(lispobj *where)
1213 struct vector *vector;
1216 vector = (struct vector *) where;
1217 length = fixnum_value(vector->length);
1218 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1223 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1225 scav_vector_long_float(lispobj *where, lispobj object)
1227 struct vector *vector;
1230 vector = (struct vector *) where;
1231 length = fixnum_value(vector->length);
1232 nwords = CEILING(length *
1239 trans_vector_long_float(lispobj object)
1241 struct vector *vector;
1244 gc_assert(is_lisp_pointer(object));
1246 vector = (struct vector *) native_pointer(object);
1247 length = fixnum_value(vector->length);
1248 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1250 return copy_large_unboxed_object(object, nwords);
1254 size_vector_long_float(lispobj *where)
1256 struct vector *vector;
1259 vector = (struct vector *) where;
1260 length = fixnum_value(vector->length);
1261 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1268 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1270 scav_vector_complex_single_float(lispobj *where, lispobj object)
1272 struct vector *vector;
1275 vector = (struct vector *) where;
1276 length = fixnum_value(vector->length);
1277 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1283 trans_vector_complex_single_float(lispobj object)
1285 struct vector *vector;
1288 gc_assert(is_lisp_pointer(object));
1290 vector = (struct vector *) native_pointer(object);
1291 length = fixnum_value(vector->length);
1292 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1294 return copy_large_unboxed_object(object, nwords);
1298 size_vector_complex_single_float(lispobj *where)
1300 struct vector *vector;
1303 vector = (struct vector *) where;
1304 length = fixnum_value(vector->length);
1305 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1311 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1313 scav_vector_complex_double_float(lispobj *where, lispobj object)
1315 struct vector *vector;
1318 vector = (struct vector *) where;
1319 length = fixnum_value(vector->length);
1320 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1326 trans_vector_complex_double_float(lispobj object)
1328 struct vector *vector;
1331 gc_assert(is_lisp_pointer(object));
1333 vector = (struct vector *) native_pointer(object);
1334 length = fixnum_value(vector->length);
1335 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1337 return copy_large_unboxed_object(object, nwords);
1341 size_vector_complex_double_float(lispobj *where)
1343 struct vector *vector;
1346 vector = (struct vector *) where;
1347 length = fixnum_value(vector->length);
1348 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1355 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1357 scav_vector_complex_long_float(lispobj *where, lispobj object)
1359 struct vector *vector;
1362 vector = (struct vector *) where;
1363 length = fixnum_value(vector->length);
1364 nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1370 trans_vector_complex_long_float(lispobj object)
1372 struct vector *vector;
1375 gc_assert(is_lisp_pointer(object));
1377 vector = (struct vector *) native_pointer(object);
1378 length = fixnum_value(vector->length);
1379 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1381 return copy_large_unboxed_object(object, nwords);
1385 size_vector_complex_long_float(lispobj *where)
1387 struct vector *vector;
1390 vector = (struct vector *) where;
1391 length = fixnum_value(vector->length);
1392 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1398 #define WEAK_POINTER_NWORDS \
1399 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1402 trans_weak_pointer(lispobj object)
1405 #ifndef LISP_FEATURE_GENCGC
1406 struct weak_pointer *wp;
1408 gc_assert(is_lisp_pointer(object));
1410 #if defined(DEBUG_WEAK)
1411 printf("Transporting weak pointer from 0x%08x\n", object);
1414 /* Need to remember where all the weak pointers are that have */
1415 /* been transported so they can be fixed up in a post-GC pass. */
1417 copy = copy_object(object, WEAK_POINTER_NWORDS);
1418 #ifndef LISP_FEATURE_GENCGC
1419 wp = (struct weak_pointer *) native_pointer(copy);
1421 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1422 /* Push the weak pointer onto the list of weak pointers. */
1423 wp->next = LOW_WORD(weak_pointers);
1430 size_weak_pointer(lispobj *where)
1432 return WEAK_POINTER_NWORDS;
1436 void scan_weak_pointers(void)
1438 struct weak_pointer *wp;
1439 for (wp = weak_pointers; wp != NULL;
1440 wp=(struct weak_pointer *)native_pointer(wp->next)) {
1441 lispobj value = wp->value;
1442 lispobj *first_pointer;
1443 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1444 if (!(is_lisp_pointer(value) && from_space_p(value)))
1447 /* Now, we need to check whether the object has been forwarded. If
1448 * it has been, the weak pointer is still good and needs to be
1449 * updated. Otherwise, the weak pointer needs to be nil'ed
1452 first_pointer = (lispobj *)native_pointer(value);
1454 if (forwarding_pointer_p(first_pointer)) {
1456 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1472 scav_lose(lispobj *where, lispobj object)
1474 lose("no scavenge function for object 0x%08x (widetag 0x%x)",
1475 (unsigned long)object,
1476 widetag_of(*(lispobj*)native_pointer(object)));
1478 return 0; /* bogus return value to satisfy static type checking */
1482 trans_lose(lispobj object)
1484 lose("no transport function for object 0x%08x (widetag 0x%x)",
1485 (unsigned long)object,
1486 widetag_of(*(lispobj*)native_pointer(object)));
1487 return NIL; /* bogus return value to satisfy static type checking */
1491 size_lose(lispobj *where)
1493 lose("no size function for object at 0x%08x (widetag 0x%x)",
1494 (unsigned long)where,
1495 widetag_of(LOW_WORD(where)));
1496 return 1; /* bogus return value to satisfy static type checking */
1505 gc_init_tables(void)
1509 /* Set default value in all slots of scavenge table. FIXME
1510 * replace this gnarly sizeof with something based on
1512 for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) {
1513 scavtab[i] = scav_lose;
1516 /* For each type which can be selected by the lowtag alone, set
1517 * multiple entries in our widetag scavenge table (one for each
1518 * possible value of the high bits).
1521 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1522 scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1523 scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1524 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1525 scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1526 scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1527 scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_instance_pointer;
1528 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1529 scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1532 /* Other-pointer types (those selected by all eight bits of the
1533 * tag) get one entry each in the scavenge table. */
1534 scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1535 scavtab[RATIO_WIDETAG] = scav_boxed;
1536 scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1537 scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1538 #ifdef LONG_FLOAT_WIDETAG
1539 scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1541 scavtab[COMPLEX_WIDETAG] = scav_boxed;
1542 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1543 scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1545 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1546 scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1548 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1549 scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
1551 scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
1552 scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
1553 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
1554 scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
1555 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1556 scav_vector_unsigned_byte_2;
1557 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1558 scav_vector_unsigned_byte_4;
1559 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1560 scav_vector_unsigned_byte_8;
1561 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1562 scav_vector_unsigned_byte_8;
1563 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1564 scav_vector_unsigned_byte_16;
1565 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1566 scav_vector_unsigned_byte_16;
1567 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1568 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1569 scav_vector_unsigned_byte_32;
1571 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1572 scav_vector_unsigned_byte_32;
1573 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1574 scav_vector_unsigned_byte_32;
1575 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1576 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1577 scav_vector_unsigned_byte_64;
1579 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1580 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1581 scav_vector_unsigned_byte_64;
1583 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1584 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1585 scav_vector_unsigned_byte_64;
1587 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1588 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
1590 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1591 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1592 scav_vector_unsigned_byte_16;
1594 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1595 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1596 scav_vector_unsigned_byte_32;
1598 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1599 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1600 scav_vector_unsigned_byte_32;
1602 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1603 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1604 scav_vector_unsigned_byte_64;
1606 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1607 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1608 scav_vector_unsigned_byte_64;
1610 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
1611 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
1612 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1613 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
1615 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1616 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1617 scav_vector_complex_single_float;
1619 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1620 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1621 scav_vector_complex_double_float;
1623 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1624 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1625 scav_vector_complex_long_float;
1627 scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
1628 scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
1629 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
1630 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
1631 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
1632 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
1633 #ifndef LISP_FEATURE_GENCGC /* FIXME ..._X86 ? */
1634 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
1635 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
1637 #ifdef LISP_FEATURE_X86
1638 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
1639 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
1641 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
1642 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
1644 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
1645 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
1646 scavtab[BASE_CHAR_WIDETAG] = scav_immediate;
1647 scavtab[SAP_WIDETAG] = scav_unboxed;
1648 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
1649 scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed;
1650 #ifdef LISP_FEATURE_SPARC
1651 scavtab[FDEFN_WIDETAG] = scav_boxed;
1653 scavtab[FDEFN_WIDETAG] = scav_fdefn;
1656 /* transport other table, initialized same way as scavtab */
1657 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
1658 transother[i] = trans_lose;
1659 transother[BIGNUM_WIDETAG] = trans_unboxed;
1660 transother[RATIO_WIDETAG] = trans_boxed;
1661 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1662 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1663 #ifdef LONG_FLOAT_WIDETAG
1664 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
1666 transother[COMPLEX_WIDETAG] = trans_boxed;
1667 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1668 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1670 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1671 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1673 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1674 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
1676 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
1677 transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
1678 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
1679 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
1680 transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
1681 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1682 trans_vector_unsigned_byte_2;
1683 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1684 trans_vector_unsigned_byte_4;
1685 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1686 trans_vector_unsigned_byte_8;
1687 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1688 trans_vector_unsigned_byte_8;
1689 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1690 trans_vector_unsigned_byte_16;
1691 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1692 trans_vector_unsigned_byte_16;
1693 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1694 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1695 trans_vector_unsigned_byte_32;
1697 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1698 trans_vector_unsigned_byte_32;
1699 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1700 trans_vector_unsigned_byte_32;
1701 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1702 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1703 trans_vector_unsigned_byte_64;
1705 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1706 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1707 trans_vector_unsigned_byte_64;
1709 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1710 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1711 trans_vector_unsigned_byte_64;
1713 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1714 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
1715 trans_vector_unsigned_byte_8;
1717 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1718 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1719 trans_vector_unsigned_byte_16;
1721 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1722 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1723 trans_vector_unsigned_byte_32;
1725 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1726 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1727 trans_vector_unsigned_byte_32;
1729 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1730 transother[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1731 trans_vector_unsigned_byte_64;
1733 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1734 transother[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1735 trans_vector_unsigned_byte_64;
1737 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
1738 trans_vector_single_float;
1739 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
1740 trans_vector_double_float;
1741 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1742 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
1743 trans_vector_long_float;
1745 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1746 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1747 trans_vector_complex_single_float;
1749 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1750 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1751 trans_vector_complex_double_float;
1753 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1754 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1755 trans_vector_complex_long_float;
1757 transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
1758 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
1759 transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
1760 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
1761 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
1762 transother[CODE_HEADER_WIDETAG] = trans_code_header;
1763 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
1764 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
1765 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
1766 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
1767 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
1768 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
1769 transother[BASE_CHAR_WIDETAG] = trans_immediate;
1770 transother[SAP_WIDETAG] = trans_unboxed;
1771 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
1772 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
1773 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
1774 transother[FDEFN_WIDETAG] = trans_boxed;
1776 /* size table, initialized the same way as scavtab */
1777 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
1778 sizetab[i] = size_lose;
1779 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1780 sizetab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
1781 sizetab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1782 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1783 sizetab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1784 sizetab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
1785 sizetab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1786 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1787 sizetab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1789 sizetab[BIGNUM_WIDETAG] = size_unboxed;
1790 sizetab[RATIO_WIDETAG] = size_boxed;
1791 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
1792 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1793 #ifdef LONG_FLOAT_WIDETAG
1794 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
1796 sizetab[COMPLEX_WIDETAG] = size_boxed;
1797 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1798 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
1800 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1801 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1803 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1804 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
1806 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
1807 sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
1808 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
1809 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
1810 sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
1811 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1812 size_vector_unsigned_byte_2;
1813 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1814 size_vector_unsigned_byte_4;
1815 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1816 size_vector_unsigned_byte_8;
1817 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1818 size_vector_unsigned_byte_8;
1819 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1820 size_vector_unsigned_byte_16;
1821 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1822 size_vector_unsigned_byte_16;
1823 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1824 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1825 size_vector_unsigned_byte_32;
1827 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1828 size_vector_unsigned_byte_32;
1829 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1830 size_vector_unsigned_byte_32;
1831 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1832 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1833 size_vector_unsigned_byte_64;
1835 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1836 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1837 size_vector_unsigned_byte_64;
1839 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1840 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1841 size_vector_unsigned_byte_64;
1843 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1844 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
1846 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1847 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1848 size_vector_unsigned_byte_16;
1850 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1851 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1852 size_vector_unsigned_byte_32;
1854 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1855 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1856 size_vector_unsigned_byte_32;
1858 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1859 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1860 size_vector_unsigned_byte_64;
1862 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1863 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1864 size_vector_unsigned_byte_64;
1866 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
1867 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
1868 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1869 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
1871 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1872 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1873 size_vector_complex_single_float;
1875 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1876 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1877 size_vector_complex_double_float;
1879 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1880 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1881 size_vector_complex_long_float;
1883 sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
1884 sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
1885 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
1886 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
1887 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
1888 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
1890 /* We shouldn't see these, so just lose if it happens. */
1891 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
1892 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
1894 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
1895 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
1896 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
1897 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
1898 sizetab[BASE_CHAR_WIDETAG] = size_immediate;
1899 sizetab[SAP_WIDETAG] = size_unboxed;
1900 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
1901 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
1902 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
1903 sizetab[FDEFN_WIDETAG] = size_boxed;
1907 /* Find the code object for the given pc, or return NULL on
1910 component_ptr_from_pc(lispobj *pc)
1912 lispobj *object = NULL;
1914 if ( (object = search_read_only_space(pc)) )
1916 else if ( (object = search_static_space(pc)) )
1919 object = search_dynamic_space(pc);
1921 if (object) /* if we found something */
1922 if (widetag_of(*object) == CODE_HEADER_WIDETAG)