2 * Garbage Collection common functions for scavenging, moving and sizing
3 * objects. These are for use with both GC (stop & copy GC) and GENCGC
7 * This software is part of the SBCL system. See the README file for
10 * This software is derived from the CMU CL system, which was
11 * written at Carnegie Mellon University and released into the
12 * public domain. The software is in the public domain and is
13 * provided with absolutely no warranty. See the COPYING and CREDITS
14 * files for more information.
18 * For a review of garbage collection techniques (e.g. generational
19 * GC) and terminology (e.g. "scavenging") see Paul R. Wilson,
20 * "Uniprocessor Garbage Collection Techniques". As of 20000618, this
21 * had been accepted for _ACM Computing Surveys_ and was available
22 * as a PostScript preprint through
23 * <http://www.cs.utexas.edu/users/oops/papers.html>
25 * <ftp://ftp.cs.utexas.edu/pub/garbage/bigsurv.ps>.
36 #include "interrupt.h"
41 #include "genesis/primitive-objects.h"
42 #include "genesis/static-symbols.h"
43 #include "gc-internal.h"
45 #ifdef LISP_FEATURE_SPARC
46 #define LONG_FLOAT_SIZE 4
48 #ifdef LISP_FEATURE_X86
49 #define LONG_FLOAT_SIZE 3
54 forwarding_pointer_p(lispobj *pointer) {
55 lispobj first_word=*pointer;
56 #ifdef LISP_FEATURE_GENCGC
57 return (first_word == 0x01);
59 return (is_lisp_pointer(first_word)
60 && new_space_p(first_word));
64 static inline lispobj *
65 forwarding_pointer_value(lispobj *pointer) {
66 #ifdef LISP_FEATURE_GENCGC
67 return (lispobj *) ((pointer_sized_uint_t) pointer[1]);
69 return (lispobj *) ((pointer_sized_uint_t) pointer[0]);
73 set_forwarding_pointer(lispobj * pointer, lispobj newspace_copy) {
74 #ifdef LISP_FEATURE_GENCGC
76 pointer[1]=newspace_copy;
78 pointer[0]=newspace_copy;
83 int (*scavtab[256])(lispobj *where, lispobj object);
84 lispobj (*transother[256])(lispobj object);
85 int (*sizetab[256])(lispobj *where);
86 struct weak_pointer *weak_pointers;
88 unsigned long bytes_consed_between_gcs = 12*1024*1024;
95 /* to copy a boxed object */
97 copy_object(lispobj object, int nwords)
102 gc_assert(is_lisp_pointer(object));
103 gc_assert(from_space_p(object));
104 gc_assert((nwords & 0x01) == 0);
106 /* Get tag of object. */
107 tag = lowtag_of(object);
109 /* Allocate space. */
110 new = gc_general_alloc(nwords*N_WORD_BYTES,ALLOC_BOXED,ALLOC_QUICK);
112 /* Copy the object. */
113 memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
114 return make_lispobj(new,tag);
117 static int scav_lose(lispobj *where, lispobj object); /* forward decl */
119 /* FIXME: Most calls end up going to some trouble to compute an
120 * 'n_words' value for this function. The system might be a little
121 * simpler if this function used an 'end' parameter instead. */
123 scavenge(lispobj *start, long n_words)
125 lispobj *end = start + n_words;
127 int n_words_scavenged;
128 for (object_ptr = start;
130 object_ptr += n_words_scavenged) {
132 lispobj object = *object_ptr;
133 #ifdef LISP_FEATURE_GENCGC
134 gc_assert(!forwarding_pointer_p(object_ptr));
136 if (is_lisp_pointer(object)) {
137 if (from_space_p(object)) {
138 /* It currently points to old space. Check for a
139 * forwarding pointer. */
140 lispobj *ptr = native_pointer(object);
141 if (forwarding_pointer_p(ptr)) {
142 /* Yes, there's a forwarding pointer. */
143 *object_ptr = LOW_WORD(forwarding_pointer_value(ptr));
144 n_words_scavenged = 1;
146 /* Scavenge that pointer. */
148 (scavtab[widetag_of(object)])(object_ptr, object);
151 /* It points somewhere other than oldspace. Leave it
153 n_words_scavenged = 1;
156 #ifndef LISP_FEATURE_GENCGC
157 /* this workaround is probably not necessary for gencgc; at least, the
158 * behaviour it describes has never been reported */
159 else if (n_words==1) {
160 /* there are some situations where an
161 other-immediate may end up in a descriptor
162 register. I'm not sure whether this is
163 supposed to happen, but if it does then we
164 don't want to (a) barf or (b) scavenge over the
165 data-block, because there isn't one. So, if
166 we're checking a single word and it's anything
167 other than a pointer, just hush it up */
168 int type=widetag_of(object);
171 if ((scavtab[type]==scav_lose) ||
172 (((scavtab[type])(start,object))>1)) {
173 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",
178 else if (fixnump(object)) {
179 /* It's a fixnum: really easy.. */
180 n_words_scavenged = 1;
182 /* It's some sort of header object or another. */
184 (scavtab[widetag_of(object)])(object_ptr, object);
187 gc_assert(object_ptr == end);
190 static lispobj trans_fun_header(lispobj object); /* forward decls */
191 static lispobj trans_boxed(lispobj object);
194 scav_fun_pointer(lispobj *where, lispobj object)
196 lispobj *first_pointer;
199 gc_assert(is_lisp_pointer(object));
201 /* Object is a pointer into from_space - not a FP. */
202 first_pointer = (lispobj *) native_pointer(object);
204 /* must transport object -- object may point to either a function
205 * header, a closure function header, or to a closure header. */
207 switch (widetag_of(*first_pointer)) {
208 case SIMPLE_FUN_HEADER_WIDETAG:
209 copy = trans_fun_header(object);
212 copy = trans_boxed(object);
216 if (copy != object) {
217 /* Set forwarding pointer */
218 set_forwarding_pointer(first_pointer,copy);
221 gc_assert(is_lisp_pointer(copy));
222 gc_assert(!from_space_p(copy));
231 trans_code(struct code *code)
233 struct code *new_code;
234 lispobj first, l_code, l_new_code;
235 int nheader_words, ncode_words, nwords;
236 unsigned long displacement;
237 lispobj fheaderl, *prev_pointer;
239 /* if object has already been transported, just return pointer */
240 first = code->header;
241 if (forwarding_pointer_p((lispobj *)code)) {
243 printf("Was already transported\n");
245 return (struct code *) forwarding_pointer_value
246 ((lispobj *)((pointer_sized_uint_t) code));
249 gc_assert(widetag_of(first) == CODE_HEADER_WIDETAG);
251 /* prepare to transport the code vector */
252 l_code = (lispobj) LOW_WORD(code) | OTHER_POINTER_LOWTAG;
254 ncode_words = fixnum_value(code->code_size);
255 nheader_words = HeaderValue(code->header);
256 nwords = ncode_words + nheader_words;
257 nwords = CEILING(nwords, 2);
259 l_new_code = copy_object(l_code, nwords);
260 new_code = (struct code *) native_pointer(l_new_code);
262 #if defined(DEBUG_CODE_GC)
263 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
264 (unsigned long) code, (unsigned long) new_code);
265 printf("Code object is %d words long.\n", nwords);
268 #ifdef LISP_FEATURE_GENCGC
269 if (new_code == code)
273 displacement = l_new_code - l_code;
275 set_forwarding_pointer((lispobj *)code, l_new_code);
277 /* set forwarding pointers for all the function headers in the */
278 /* code object. also fix all self pointers */
280 fheaderl = code->entry_points;
281 prev_pointer = &new_code->entry_points;
283 while (fheaderl != NIL) {
284 struct simple_fun *fheaderp, *nfheaderp;
287 fheaderp = (struct simple_fun *) native_pointer(fheaderl);
288 gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
290 /* Calculate the new function pointer and the new */
291 /* function header. */
292 nfheaderl = fheaderl + displacement;
293 nfheaderp = (struct simple_fun *) native_pointer(nfheaderl);
296 printf("fheaderp->header (at %x) <- %x\n",
297 &(fheaderp->header) , nfheaderl);
299 set_forwarding_pointer((lispobj *)fheaderp, nfheaderl);
301 /* fix self pointer. */
303 #ifdef LISP_FEATURE_X86
304 FUN_RAW_ADDR_OFFSET +
308 *prev_pointer = nfheaderl;
310 fheaderl = fheaderp->next;
311 prev_pointer = &nfheaderp->next;
313 os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words),
314 ncode_words * sizeof(int));
315 #ifdef LISP_FEATURE_GENCGC
316 gencgc_apply_code_fixups(code, new_code);
322 scav_code_header(lispobj *where, lispobj object)
325 int n_header_words, n_code_words, n_words;
326 lispobj entry_point; /* tagged pointer to entry point */
327 struct simple_fun *function_ptr; /* untagged pointer to entry point */
329 code = (struct code *) where;
330 n_code_words = fixnum_value(code->code_size);
331 n_header_words = HeaderValue(object);
332 n_words = n_code_words + n_header_words;
333 n_words = CEILING(n_words, 2);
335 /* Scavenge the boxed section of the code data block. */
336 scavenge(where + 1, n_header_words - 1);
338 /* Scavenge the boxed section of each function object in the
339 * code data block. */
340 for (entry_point = code->entry_points;
342 entry_point = function_ptr->next) {
344 gc_assert(is_lisp_pointer(entry_point));
346 function_ptr = (struct simple_fun *) native_pointer(entry_point);
347 gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
349 scavenge(&function_ptr->name, 1);
350 scavenge(&function_ptr->arglist, 1);
351 scavenge(&function_ptr->type, 1);
358 trans_code_header(lispobj object)
362 ncode = trans_code((struct code *) native_pointer(object));
363 return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG;
368 size_code_header(lispobj *where)
371 int nheader_words, ncode_words, nwords;
373 code = (struct code *) where;
375 ncode_words = fixnum_value(code->code_size);
376 nheader_words = HeaderValue(code->header);
377 nwords = ncode_words + nheader_words;
378 nwords = CEILING(nwords, 2);
383 #ifndef LISP_FEATURE_X86
385 scav_return_pc_header(lispobj *where, lispobj object)
387 lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x",
388 (unsigned long) where,
389 (unsigned long) object);
390 return 0; /* bogus return value to satisfy static type checking */
392 #endif /* LISP_FEATURE_X86 */
395 trans_return_pc_header(lispobj object)
397 struct simple_fun *return_pc;
398 unsigned long offset;
399 struct code *code, *ncode;
401 return_pc = (struct simple_fun *) native_pointer(object);
402 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
403 offset = HeaderValue(return_pc->header) * N_WORD_BYTES;
405 /* Transport the whole code object */
406 code = (struct code *) ((unsigned long) return_pc - offset);
407 ncode = trans_code(code);
409 return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
412 /* On the 386, closures hold a pointer to the raw address instead of the
413 * function object, so we can use CALL [$FDEFN+const] to invoke
414 * the function without loading it into a register. Given that code
415 * objects don't move, we don't need to update anything, but we do
416 * have to figure out that the function is still live. */
418 #ifdef LISP_FEATURE_X86
420 scav_closure_header(lispobj *where, lispobj object)
422 struct closure *closure;
425 closure = (struct closure *)where;
426 fun = closure->fun - FUN_RAW_ADDR_OFFSET;
428 #ifdef LISP_FEATURE_GENCGC
429 /* The function may have moved so update the raw address. But
430 * don't write unnecessarily. */
431 if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
432 closure->fun = fun + FUN_RAW_ADDR_OFFSET;
438 #ifndef LISP_FEATURE_X86
440 scav_fun_header(lispobj *where, lispobj object)
442 lose("attempted to scavenge a function header where=0x%08x object=0x%08x",
443 (unsigned long) where,
444 (unsigned long) object);
445 return 0; /* bogus return value to satisfy static type checking */
447 #endif /* LISP_FEATURE_X86 */
450 trans_fun_header(lispobj object)
452 struct simple_fun *fheader;
453 unsigned long offset;
454 struct code *code, *ncode;
456 fheader = (struct simple_fun *) native_pointer(object);
457 /* FIXME: was times 4, should it really be N_WORD_BYTES? */
458 offset = HeaderValue(fheader->header) * N_WORD_BYTES;
460 /* Transport the whole code object */
461 code = (struct code *) ((unsigned long) fheader - offset);
462 ncode = trans_code(code);
464 return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
473 scav_instance_pointer(lispobj *where, lispobj object)
475 lispobj copy, *first_pointer;
477 /* Object is a pointer into from space - not a FP. */
478 copy = trans_boxed(object);
480 #ifdef LISP_FEATURE_GENCGC
481 gc_assert(copy != object);
484 first_pointer = (lispobj *) native_pointer(object);
485 set_forwarding_pointer(first_pointer,copy);
496 static lispobj trans_list(lispobj object);
499 scav_list_pointer(lispobj *where, lispobj object)
501 lispobj first, *first_pointer;
503 gc_assert(is_lisp_pointer(object));
505 /* Object is a pointer into from space - not FP. */
506 first_pointer = (lispobj *) native_pointer(object);
508 first = trans_list(object);
509 gc_assert(first != object);
511 /* Set forwarding pointer */
512 set_forwarding_pointer(first_pointer, first);
514 gc_assert(is_lisp_pointer(first));
515 gc_assert(!from_space_p(first));
523 trans_list(lispobj object)
525 lispobj new_list_pointer;
526 struct cons *cons, *new_cons;
529 cons = (struct cons *) native_pointer(object);
532 new_cons = (struct cons *)
533 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
534 new_cons->car = cons->car;
535 new_cons->cdr = cons->cdr; /* updated later */
536 new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
538 /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC */
541 set_forwarding_pointer((lispobj *)cons, new_list_pointer);
543 /* Try to linearize the list in the cdr direction to help reduce
547 struct cons *cdr_cons, *new_cdr_cons;
549 if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
550 !from_space_p(cdr) ||
551 forwarding_pointer_p((lispobj *)native_pointer(cdr)))
554 cdr_cons = (struct cons *) native_pointer(cdr);
557 new_cdr_cons = (struct cons*)
558 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
559 new_cdr_cons->car = cdr_cons->car;
560 new_cdr_cons->cdr = cdr_cons->cdr;
561 new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
563 /* Grab the cdr before it is clobbered. */
565 set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
567 /* Update the cdr of the last cons copied into new space to
568 * keep the newspace scavenge from having to do it. */
569 new_cons->cdr = new_cdr;
571 new_cons = new_cdr_cons;
574 return new_list_pointer;
579 * scavenging and transporting other pointers
583 scav_other_pointer(lispobj *where, lispobj object)
585 lispobj first, *first_pointer;
587 gc_assert(is_lisp_pointer(object));
589 /* Object is a pointer into from space - not FP. */
590 first_pointer = (lispobj *) native_pointer(object);
591 first = (transother[widetag_of(*first_pointer)])(object);
593 if (first != object) {
594 set_forwarding_pointer(first_pointer, first);
595 #ifdef LISP_FEATURE_GENCGC
599 #ifndef LISP_FEATURE_GENCGC
602 gc_assert(is_lisp_pointer(first));
603 gc_assert(!from_space_p(first));
609 * immediate, boxed, and unboxed objects
613 size_pointer(lispobj *where)
619 scav_immediate(lispobj *where, lispobj object)
625 trans_immediate(lispobj object)
627 lose("trying to transport an immediate");
628 return NIL; /* bogus return value to satisfy static type checking */
632 size_immediate(lispobj *where)
639 scav_boxed(lispobj *where, lispobj object)
645 trans_boxed(lispobj object)
648 unsigned long length;
650 gc_assert(is_lisp_pointer(object));
652 header = *((lispobj *) native_pointer(object));
653 length = HeaderValue(header) + 1;
654 length = CEILING(length, 2);
656 return copy_object(object, length);
661 size_boxed(lispobj *where)
664 unsigned long length;
667 length = HeaderValue(header) + 1;
668 length = CEILING(length, 2);
673 /* Note: on the sparc we don't have to do anything special for fdefns, */
674 /* 'cause the raw-addr has a function lowtag. */
675 #ifndef LISP_FEATURE_SPARC
677 scav_fdefn(lispobj *where, lispobj object)
681 fdefn = (struct fdefn *)where;
683 /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
684 fdefn->fun, fdefn->raw_addr)); */
686 if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)
687 == (char *)((unsigned long)(fdefn->raw_addr))) {
688 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
690 /* Don't write unnecessarily. */
691 if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
692 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
693 /* gc.c has more casts here, which may be relevant or alternatively
694 may be compiler warning defeaters. try
695 fdefn->raw_addr = ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
697 return sizeof(struct fdefn) / sizeof(lispobj);
705 scav_unboxed(lispobj *where, lispobj object)
707 unsigned long length;
709 length = HeaderValue(object) + 1;
710 length = CEILING(length, 2);
716 trans_unboxed(lispobj object)
719 unsigned long length;
722 gc_assert(is_lisp_pointer(object));
724 header = *((lispobj *) native_pointer(object));
725 length = HeaderValue(header) + 1;
726 length = CEILING(length, 2);
728 return copy_unboxed_object(object, length);
732 size_unboxed(lispobj *where)
735 unsigned long length;
738 length = HeaderValue(header) + 1;
739 length = CEILING(length, 2);
745 /* vector-like objects */
747 scav_base_string(lispobj *where, lispobj object)
749 struct vector *vector;
752 /* NOTE: Strings contain one more byte of data than the length */
753 /* slot indicates. */
755 vector = (struct vector *) where;
756 length = fixnum_value(vector->length) + 1;
757 nwords = CEILING(NWORDS(length, 8) + 2, 2);
762 trans_base_string(lispobj object)
764 struct vector *vector;
767 gc_assert(is_lisp_pointer(object));
769 /* NOTE: A string contains one more byte of data (a terminating
770 * '\0' to help when interfacing with C functions) than indicated
771 * by the length slot. */
773 vector = (struct vector *) native_pointer(object);
774 length = fixnum_value(vector->length) + 1;
775 nwords = CEILING(NWORDS(length, 8) + 2, 2);
777 return copy_large_unboxed_object(object, nwords);
781 size_base_string(lispobj *where)
783 struct vector *vector;
786 /* NOTE: A string contains one more byte of data (a terminating
787 * '\0' to help when interfacing with C functions) than indicated
788 * by the length slot. */
790 vector = (struct vector *) where;
791 length = fixnum_value(vector->length) + 1;
792 nwords = CEILING(NWORDS(length, 8) + 2, 2);
798 trans_vector(lispobj object)
800 struct vector *vector;
803 gc_assert(is_lisp_pointer(object));
805 vector = (struct vector *) native_pointer(object);
807 length = fixnum_value(vector->length);
808 nwords = CEILING(length + 2, 2);
810 return copy_large_object(object, nwords);
814 size_vector(lispobj *where)
816 struct vector *vector;
819 vector = (struct vector *) where;
820 length = fixnum_value(vector->length);
821 nwords = CEILING(length + 2, 2);
827 scav_vector_nil(lispobj *where, lispobj object)
833 trans_vector_nil(lispobj object)
835 gc_assert(is_lisp_pointer(object));
836 return copy_unboxed_object(object, 2);
840 size_vector_nil(lispobj *where)
842 /* Just the header word and the length word */
847 scav_vector_bit(lispobj *where, lispobj object)
849 struct vector *vector;
852 vector = (struct vector *) where;
853 length = fixnum_value(vector->length);
854 nwords = CEILING(NWORDS(length, 1) + 2, 2);
860 trans_vector_bit(lispobj object)
862 struct vector *vector;
865 gc_assert(is_lisp_pointer(object));
867 vector = (struct vector *) native_pointer(object);
868 length = fixnum_value(vector->length);
869 nwords = CEILING(NWORDS(length, 1) + 2, 2);
871 return copy_large_unboxed_object(object, nwords);
875 size_vector_bit(lispobj *where)
877 struct vector *vector;
880 vector = (struct vector *) where;
881 length = fixnum_value(vector->length);
882 nwords = CEILING(NWORDS(length, 1) + 2, 2);
888 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
890 struct vector *vector;
893 vector = (struct vector *) where;
894 length = fixnum_value(vector->length);
895 nwords = CEILING(NWORDS(length, 2) + 2, 2);
901 trans_vector_unsigned_byte_2(lispobj object)
903 struct vector *vector;
906 gc_assert(is_lisp_pointer(object));
908 vector = (struct vector *) native_pointer(object);
909 length = fixnum_value(vector->length);
910 nwords = CEILING(NWORDS(length, 2) + 2, 2);
912 return copy_large_unboxed_object(object, nwords);
916 size_vector_unsigned_byte_2(lispobj *where)
918 struct vector *vector;
921 vector = (struct vector *) where;
922 length = fixnum_value(vector->length);
923 nwords = CEILING(NWORDS(length, 2) + 2, 2);
929 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
931 struct vector *vector;
934 vector = (struct vector *) where;
935 length = fixnum_value(vector->length);
936 nwords = CEILING(NWORDS(length, 4) + 2, 2);
942 trans_vector_unsigned_byte_4(lispobj object)
944 struct vector *vector;
947 gc_assert(is_lisp_pointer(object));
949 vector = (struct vector *) native_pointer(object);
950 length = fixnum_value(vector->length);
951 nwords = CEILING(NWORDS(length, 4) + 2, 2);
953 return copy_large_unboxed_object(object, nwords);
956 size_vector_unsigned_byte_4(lispobj *where)
958 struct vector *vector;
961 vector = (struct vector *) where;
962 length = fixnum_value(vector->length);
963 nwords = CEILING(NWORDS(length, 4) + 2, 2);
970 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
972 struct vector *vector;
975 vector = (struct vector *) where;
976 length = fixnum_value(vector->length);
977 nwords = CEILING(NWORDS(length, 8) + 2, 2);
982 /*********************/
987 trans_vector_unsigned_byte_8(lispobj object)
989 struct vector *vector;
992 gc_assert(is_lisp_pointer(object));
994 vector = (struct vector *) native_pointer(object);
995 length = fixnum_value(vector->length);
996 nwords = CEILING(NWORDS(length, 8) + 2, 2);
998 return copy_large_unboxed_object(object, nwords);
1002 size_vector_unsigned_byte_8(lispobj *where)
1004 struct vector *vector;
1007 vector = (struct vector *) where;
1008 length = fixnum_value(vector->length);
1009 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1016 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1018 struct vector *vector;
1021 vector = (struct vector *) where;
1022 length = fixnum_value(vector->length);
1023 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1029 trans_vector_unsigned_byte_16(lispobj object)
1031 struct vector *vector;
1034 gc_assert(is_lisp_pointer(object));
1036 vector = (struct vector *) native_pointer(object);
1037 length = fixnum_value(vector->length);
1038 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1040 return copy_large_unboxed_object(object, nwords);
1044 size_vector_unsigned_byte_16(lispobj *where)
1046 struct vector *vector;
1049 vector = (struct vector *) where;
1050 length = fixnum_value(vector->length);
1051 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1057 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1059 struct vector *vector;
1062 vector = (struct vector *) where;
1063 length = fixnum_value(vector->length);
1064 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1070 trans_vector_unsigned_byte_32(lispobj object)
1072 struct vector *vector;
1075 gc_assert(is_lisp_pointer(object));
1077 vector = (struct vector *) native_pointer(object);
1078 length = fixnum_value(vector->length);
1079 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1081 return copy_large_unboxed_object(object, nwords);
1085 size_vector_unsigned_byte_32(lispobj *where)
1087 struct vector *vector;
1090 vector = (struct vector *) where;
1091 length = fixnum_value(vector->length);
1092 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1097 #if N_WORD_BITS == 64
1099 scav_vector_unsigned_byte_64(lispobj *where, lispobj object)
1101 struct vector *vector;
1104 vector = (struct vector *) where;
1105 length = fixnum_value(vector->length);
1106 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1112 trans_vector_unsigned_byte_64(lispobj object)
1114 struct vector *vector;
1117 gc_assert(is_lisp_pointer(object));
1119 vector = (struct vector *) native_pointer(object);
1120 length = fixnum_value(vector->length);
1121 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1123 return copy_large_unboxed_object(object, nwords);
1127 size_vector_unsigned_byte_64(lispobj *where)
1129 struct vector *vector;
1132 vector = (struct vector *) where;
1133 length = fixnum_value(vector->length);
1134 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1141 scav_vector_single_float(lispobj *where, lispobj object)
1143 struct vector *vector;
1146 vector = (struct vector *) where;
1147 length = fixnum_value(vector->length);
1148 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1154 trans_vector_single_float(lispobj object)
1156 struct vector *vector;
1159 gc_assert(is_lisp_pointer(object));
1161 vector = (struct vector *) native_pointer(object);
1162 length = fixnum_value(vector->length);
1163 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1165 return copy_large_unboxed_object(object, nwords);
1169 size_vector_single_float(lispobj *where)
1171 struct vector *vector;
1174 vector = (struct vector *) where;
1175 length = fixnum_value(vector->length);
1176 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1182 scav_vector_double_float(lispobj *where, lispobj object)
1184 struct vector *vector;
1187 vector = (struct vector *) where;
1188 length = fixnum_value(vector->length);
1189 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1195 trans_vector_double_float(lispobj object)
1197 struct vector *vector;
1200 gc_assert(is_lisp_pointer(object));
1202 vector = (struct vector *) native_pointer(object);
1203 length = fixnum_value(vector->length);
1204 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1206 return copy_large_unboxed_object(object, nwords);
1210 size_vector_double_float(lispobj *where)
1212 struct vector *vector;
1215 vector = (struct vector *) where;
1216 length = fixnum_value(vector->length);
1217 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1222 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1224 scav_vector_long_float(lispobj *where, lispobj object)
1226 struct vector *vector;
1229 vector = (struct vector *) where;
1230 length = fixnum_value(vector->length);
1231 nwords = CEILING(length *
1238 trans_vector_long_float(lispobj object)
1240 struct vector *vector;
1243 gc_assert(is_lisp_pointer(object));
1245 vector = (struct vector *) native_pointer(object);
1246 length = fixnum_value(vector->length);
1247 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1249 return copy_large_unboxed_object(object, nwords);
1253 size_vector_long_float(lispobj *where)
1255 struct vector *vector;
1258 vector = (struct vector *) where;
1259 length = fixnum_value(vector->length);
1260 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1267 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1269 scav_vector_complex_single_float(lispobj *where, lispobj object)
1271 struct vector *vector;
1274 vector = (struct vector *) where;
1275 length = fixnum_value(vector->length);
1276 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1282 trans_vector_complex_single_float(lispobj object)
1284 struct vector *vector;
1287 gc_assert(is_lisp_pointer(object));
1289 vector = (struct vector *) native_pointer(object);
1290 length = fixnum_value(vector->length);
1291 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1293 return copy_large_unboxed_object(object, nwords);
1297 size_vector_complex_single_float(lispobj *where)
1299 struct vector *vector;
1302 vector = (struct vector *) where;
1303 length = fixnum_value(vector->length);
1304 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1310 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1312 scav_vector_complex_double_float(lispobj *where, lispobj object)
1314 struct vector *vector;
1317 vector = (struct vector *) where;
1318 length = fixnum_value(vector->length);
1319 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1325 trans_vector_complex_double_float(lispobj object)
1327 struct vector *vector;
1330 gc_assert(is_lisp_pointer(object));
1332 vector = (struct vector *) native_pointer(object);
1333 length = fixnum_value(vector->length);
1334 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1336 return copy_large_unboxed_object(object, nwords);
1340 size_vector_complex_double_float(lispobj *where)
1342 struct vector *vector;
1345 vector = (struct vector *) where;
1346 length = fixnum_value(vector->length);
1347 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1354 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1356 scav_vector_complex_long_float(lispobj *where, lispobj object)
1358 struct vector *vector;
1361 vector = (struct vector *) where;
1362 length = fixnum_value(vector->length);
1363 nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1369 trans_vector_complex_long_float(lispobj object)
1371 struct vector *vector;
1374 gc_assert(is_lisp_pointer(object));
1376 vector = (struct vector *) native_pointer(object);
1377 length = fixnum_value(vector->length);
1378 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1380 return copy_large_unboxed_object(object, nwords);
1384 size_vector_complex_long_float(lispobj *where)
1386 struct vector *vector;
1389 vector = (struct vector *) where;
1390 length = fixnum_value(vector->length);
1391 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1397 #define WEAK_POINTER_NWORDS \
1398 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1401 trans_weak_pointer(lispobj object)
1404 #ifndef LISP_FEATURE_GENCGC
1405 struct weak_pointer *wp;
1407 gc_assert(is_lisp_pointer(object));
1409 #if defined(DEBUG_WEAK)
1410 printf("Transporting weak pointer from 0x%08x\n", object);
1413 /* Need to remember where all the weak pointers are that have */
1414 /* been transported so they can be fixed up in a post-GC pass. */
1416 copy = copy_object(object, WEAK_POINTER_NWORDS);
1417 #ifndef LISP_FEATURE_GENCGC
1418 wp = (struct weak_pointer *) native_pointer(copy);
1420 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1421 /* Push the weak pointer onto the list of weak pointers. */
1422 wp->next = LOW_WORD(weak_pointers);
1429 size_weak_pointer(lispobj *where)
1431 return WEAK_POINTER_NWORDS;
1435 void scan_weak_pointers(void)
1437 struct weak_pointer *wp;
1438 for (wp = weak_pointers; wp != NULL;
1439 wp=(struct weak_pointer *)native_pointer(wp->next)) {
1440 lispobj value = wp->value;
1441 lispobj *first_pointer;
1442 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1443 if (!(is_lisp_pointer(value) && from_space_p(value)))
1446 /* Now, we need to check whether the object has been forwarded. If
1447 * it has been, the weak pointer is still good and needs to be
1448 * updated. Otherwise, the weak pointer needs to be nil'ed
1451 first_pointer = (lispobj *)native_pointer(value);
1453 if (forwarding_pointer_p(first_pointer)) {
1455 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1471 scav_lose(lispobj *where, lispobj object)
1473 lose("no scavenge function for object 0x%08x (widetag 0x%x)",
1474 (unsigned long)object,
1475 widetag_of(*(lispobj*)native_pointer(object)));
1477 return 0; /* bogus return value to satisfy static type checking */
1481 trans_lose(lispobj object)
1483 lose("no transport function for object 0x%08x (widetag 0x%x)",
1484 (unsigned long)object,
1485 widetag_of(*(lispobj*)native_pointer(object)));
1486 return NIL; /* bogus return value to satisfy static type checking */
1490 size_lose(lispobj *where)
1492 lose("no size function for object at 0x%08x (widetag 0x%x)",
1493 (unsigned long)where,
1494 widetag_of(LOW_WORD(where)));
1495 return 1; /* bogus return value to satisfy static type checking */
1504 gc_init_tables(void)
1508 /* Set default value in all slots of scavenge table. FIXME
1509 * replace this gnarly sizeof with something based on
1511 for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) {
1512 scavtab[i] = scav_lose;
1515 /* For each type which can be selected by the lowtag alone, set
1516 * multiple entries in our widetag scavenge table (one for each
1517 * possible value of the high bits).
1520 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1521 scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1522 scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1523 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1524 scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1525 scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1526 scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_instance_pointer;
1527 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1528 scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1531 /* Other-pointer types (those selected by all eight bits of the
1532 * tag) get one entry each in the scavenge table. */
1533 scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1534 scavtab[RATIO_WIDETAG] = scav_boxed;
1535 scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1536 scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1537 #ifdef LONG_FLOAT_WIDETAG
1538 scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1540 scavtab[COMPLEX_WIDETAG] = scav_boxed;
1541 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1542 scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1544 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1545 scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1547 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1548 scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
1550 scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
1551 scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
1552 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
1553 scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
1554 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1555 scav_vector_unsigned_byte_2;
1556 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1557 scav_vector_unsigned_byte_4;
1558 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1559 scav_vector_unsigned_byte_8;
1560 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1561 scav_vector_unsigned_byte_8;
1562 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1563 scav_vector_unsigned_byte_16;
1564 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1565 scav_vector_unsigned_byte_16;
1566 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1567 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1568 scav_vector_unsigned_byte_32;
1570 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1571 scav_vector_unsigned_byte_32;
1572 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1573 scav_vector_unsigned_byte_32;
1574 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1575 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1576 scav_vector_unsigned_byte_64;
1578 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1579 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1580 scav_vector_unsigned_byte_64;
1582 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1583 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1584 scav_vector_unsigned_byte_64;
1586 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1587 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
1589 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1590 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1591 scav_vector_unsigned_byte_16;
1593 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1594 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1595 scav_vector_unsigned_byte_32;
1597 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1598 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1599 scav_vector_unsigned_byte_32;
1601 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1602 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1603 scav_vector_unsigned_byte_64;
1605 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1606 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1607 scav_vector_unsigned_byte_64;
1609 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
1610 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
1611 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1612 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
1614 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1615 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1616 scav_vector_complex_single_float;
1618 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1619 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1620 scav_vector_complex_double_float;
1622 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1623 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1624 scav_vector_complex_long_float;
1626 scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
1627 scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
1628 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
1629 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
1630 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
1631 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
1632 #ifndef LISP_FEATURE_GENCGC /* FIXME ..._X86 ? */
1633 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
1634 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
1636 #ifdef LISP_FEATURE_X86
1637 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
1638 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
1640 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
1641 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
1643 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
1644 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
1645 scavtab[BASE_CHAR_WIDETAG] = scav_immediate;
1646 scavtab[SAP_WIDETAG] = scav_unboxed;
1647 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
1648 scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed;
1649 #ifdef LISP_FEATURE_SPARC
1650 scavtab[FDEFN_WIDETAG] = scav_boxed;
1652 scavtab[FDEFN_WIDETAG] = scav_fdefn;
1655 /* transport other table, initialized same way as scavtab */
1656 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
1657 transother[i] = trans_lose;
1658 transother[BIGNUM_WIDETAG] = trans_unboxed;
1659 transother[RATIO_WIDETAG] = trans_boxed;
1660 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1661 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1662 #ifdef LONG_FLOAT_WIDETAG
1663 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
1665 transother[COMPLEX_WIDETAG] = trans_boxed;
1666 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1667 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1669 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1670 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1672 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1673 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
1675 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
1676 transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
1677 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
1678 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
1679 transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
1680 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1681 trans_vector_unsigned_byte_2;
1682 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1683 trans_vector_unsigned_byte_4;
1684 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1685 trans_vector_unsigned_byte_8;
1686 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1687 trans_vector_unsigned_byte_8;
1688 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1689 trans_vector_unsigned_byte_16;
1690 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1691 trans_vector_unsigned_byte_16;
1692 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1693 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1694 trans_vector_unsigned_byte_32;
1696 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1697 trans_vector_unsigned_byte_32;
1698 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1699 trans_vector_unsigned_byte_32;
1700 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1701 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1702 trans_vector_unsigned_byte_64;
1704 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1705 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1706 trans_vector_unsigned_byte_64;
1708 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1709 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1710 trans_vector_unsigned_byte_64;
1712 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1713 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
1714 trans_vector_unsigned_byte_8;
1716 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1717 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1718 trans_vector_unsigned_byte_16;
1720 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1721 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1722 trans_vector_unsigned_byte_32;
1724 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1725 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1726 trans_vector_unsigned_byte_32;
1728 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1729 transother[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1730 trans_vector_unsigned_byte_64;
1732 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1733 transother[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1734 trans_vector_unsigned_byte_64;
1736 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
1737 trans_vector_single_float;
1738 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
1739 trans_vector_double_float;
1740 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1741 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
1742 trans_vector_long_float;
1744 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1745 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1746 trans_vector_complex_single_float;
1748 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1749 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1750 trans_vector_complex_double_float;
1752 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1753 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1754 trans_vector_complex_long_float;
1756 transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
1757 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
1758 transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
1759 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
1760 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
1761 transother[CODE_HEADER_WIDETAG] = trans_code_header;
1762 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
1763 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
1764 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
1765 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
1766 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
1767 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
1768 transother[BASE_CHAR_WIDETAG] = trans_immediate;
1769 transother[SAP_WIDETAG] = trans_unboxed;
1770 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
1771 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
1772 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
1773 transother[FDEFN_WIDETAG] = trans_boxed;
1775 /* size table, initialized the same way as scavtab */
1776 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
1777 sizetab[i] = size_lose;
1778 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1779 sizetab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
1780 sizetab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1781 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1782 sizetab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1783 sizetab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
1784 sizetab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1785 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1786 sizetab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1788 sizetab[BIGNUM_WIDETAG] = size_unboxed;
1789 sizetab[RATIO_WIDETAG] = size_boxed;
1790 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
1791 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1792 #ifdef LONG_FLOAT_WIDETAG
1793 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
1795 sizetab[COMPLEX_WIDETAG] = size_boxed;
1796 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1797 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
1799 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1800 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1802 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1803 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
1805 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
1806 sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
1807 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
1808 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
1809 sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
1810 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1811 size_vector_unsigned_byte_2;
1812 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1813 size_vector_unsigned_byte_4;
1814 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1815 size_vector_unsigned_byte_8;
1816 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1817 size_vector_unsigned_byte_8;
1818 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1819 size_vector_unsigned_byte_16;
1820 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1821 size_vector_unsigned_byte_16;
1822 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1823 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1824 size_vector_unsigned_byte_32;
1826 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1827 size_vector_unsigned_byte_32;
1828 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1829 size_vector_unsigned_byte_32;
1830 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1831 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1832 size_vector_unsigned_byte_64;
1834 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1835 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1836 size_vector_unsigned_byte_64;
1838 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1839 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1840 size_vector_unsigned_byte_64;
1842 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1843 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
1845 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1846 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1847 size_vector_unsigned_byte_16;
1849 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1850 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1851 size_vector_unsigned_byte_32;
1853 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1854 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1855 size_vector_unsigned_byte_32;
1857 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1858 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1859 size_vector_unsigned_byte_64;
1861 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1862 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1863 size_vector_unsigned_byte_64;
1865 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
1866 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
1867 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1868 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
1870 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1871 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1872 size_vector_complex_single_float;
1874 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1875 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1876 size_vector_complex_double_float;
1878 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1879 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1880 size_vector_complex_long_float;
1882 sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
1883 sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
1884 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
1885 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
1886 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
1887 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
1889 /* We shouldn't see these, so just lose if it happens. */
1890 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
1891 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
1893 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
1894 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
1895 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
1896 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
1897 sizetab[BASE_CHAR_WIDETAG] = size_immediate;
1898 sizetab[SAP_WIDETAG] = size_unboxed;
1899 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
1900 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
1901 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
1902 sizetab[FDEFN_WIDETAG] = size_boxed;
1906 /* Find the code object for the given pc, or return NULL on
1909 component_ptr_from_pc(lispobj *pc)
1911 lispobj *object = NULL;
1913 if ( (object = search_read_only_space(pc)) )
1915 else if ( (object = search_static_space(pc)) )
1918 object = search_dynamic_space(pc);
1920 if (object) /* if we found something */
1921 if (widetag_of(*object) == CODE_HEADER_WIDETAG)