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_character_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, 32) + 2, 2);
798 scav_character_string(lispobj *where, lispobj object)
800 struct vector *vector;
803 /* NOTE: Strings contain one more byte of data than the length */
804 /* slot indicates. */
806 vector = (struct vector *) where;
807 length = fixnum_value(vector->length) + 1;
808 nwords = CEILING(NWORDS(length, 32) + 2, 2);
813 trans_character_string(lispobj object)
815 struct vector *vector;
818 gc_assert(is_lisp_pointer(object));
820 /* NOTE: A string contains one more byte of data (a terminating
821 * '\0' to help when interfacing with C functions) than indicated
822 * by the length slot. */
824 vector = (struct vector *) native_pointer(object);
825 length = fixnum_value(vector->length) + 1;
826 nwords = CEILING(NWORDS(length, 32) + 2, 2);
828 return copy_large_unboxed_object(object, nwords);
832 size_base_string(lispobj *where)
834 struct vector *vector;
837 /* NOTE: A string contains one more byte of data (a terminating
838 * '\0' to help when interfacing with C functions) than indicated
839 * by the length slot. */
841 vector = (struct vector *) where;
842 length = fixnum_value(vector->length) + 1;
843 nwords = CEILING(NWORDS(length, 8) + 2, 2);
849 trans_vector(lispobj object)
851 struct vector *vector;
854 gc_assert(is_lisp_pointer(object));
856 vector = (struct vector *) native_pointer(object);
858 length = fixnum_value(vector->length);
859 nwords = CEILING(length + 2, 2);
861 return copy_large_object(object, nwords);
865 size_vector(lispobj *where)
867 struct vector *vector;
870 vector = (struct vector *) where;
871 length = fixnum_value(vector->length);
872 nwords = CEILING(length + 2, 2);
878 scav_vector_nil(lispobj *where, lispobj object)
884 trans_vector_nil(lispobj object)
886 gc_assert(is_lisp_pointer(object));
887 return copy_unboxed_object(object, 2);
891 size_vector_nil(lispobj *where)
893 /* Just the header word and the length word */
898 scav_vector_bit(lispobj *where, lispobj object)
900 struct vector *vector;
903 vector = (struct vector *) where;
904 length = fixnum_value(vector->length);
905 nwords = CEILING(NWORDS(length, 1) + 2, 2);
911 trans_vector_bit(lispobj object)
913 struct vector *vector;
916 gc_assert(is_lisp_pointer(object));
918 vector = (struct vector *) native_pointer(object);
919 length = fixnum_value(vector->length);
920 nwords = CEILING(NWORDS(length, 1) + 2, 2);
922 return copy_large_unboxed_object(object, nwords);
926 size_vector_bit(lispobj *where)
928 struct vector *vector;
931 vector = (struct vector *) where;
932 length = fixnum_value(vector->length);
933 nwords = CEILING(NWORDS(length, 1) + 2, 2);
939 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
941 struct vector *vector;
944 vector = (struct vector *) where;
945 length = fixnum_value(vector->length);
946 nwords = CEILING(NWORDS(length, 2) + 2, 2);
952 trans_vector_unsigned_byte_2(lispobj object)
954 struct vector *vector;
957 gc_assert(is_lisp_pointer(object));
959 vector = (struct vector *) native_pointer(object);
960 length = fixnum_value(vector->length);
961 nwords = CEILING(NWORDS(length, 2) + 2, 2);
963 return copy_large_unboxed_object(object, nwords);
967 size_vector_unsigned_byte_2(lispobj *where)
969 struct vector *vector;
972 vector = (struct vector *) where;
973 length = fixnum_value(vector->length);
974 nwords = CEILING(NWORDS(length, 2) + 2, 2);
980 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
982 struct vector *vector;
985 vector = (struct vector *) where;
986 length = fixnum_value(vector->length);
987 nwords = CEILING(NWORDS(length, 4) + 2, 2);
993 trans_vector_unsigned_byte_4(lispobj object)
995 struct vector *vector;
998 gc_assert(is_lisp_pointer(object));
1000 vector = (struct vector *) native_pointer(object);
1001 length = fixnum_value(vector->length);
1002 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1004 return copy_large_unboxed_object(object, nwords);
1007 size_vector_unsigned_byte_4(lispobj *where)
1009 struct vector *vector;
1012 vector = (struct vector *) where;
1013 length = fixnum_value(vector->length);
1014 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1021 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
1023 struct vector *vector;
1026 vector = (struct vector *) where;
1027 length = fixnum_value(vector->length);
1028 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1033 /*********************/
1038 trans_vector_unsigned_byte_8(lispobj object)
1040 struct vector *vector;
1043 gc_assert(is_lisp_pointer(object));
1045 vector = (struct vector *) native_pointer(object);
1046 length = fixnum_value(vector->length);
1047 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1049 return copy_large_unboxed_object(object, nwords);
1053 size_vector_unsigned_byte_8(lispobj *where)
1055 struct vector *vector;
1058 vector = (struct vector *) where;
1059 length = fixnum_value(vector->length);
1060 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1067 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1069 struct vector *vector;
1072 vector = (struct vector *) where;
1073 length = fixnum_value(vector->length);
1074 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1080 trans_vector_unsigned_byte_16(lispobj object)
1082 struct vector *vector;
1085 gc_assert(is_lisp_pointer(object));
1087 vector = (struct vector *) native_pointer(object);
1088 length = fixnum_value(vector->length);
1089 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1091 return copy_large_unboxed_object(object, nwords);
1095 size_vector_unsigned_byte_16(lispobj *where)
1097 struct vector *vector;
1100 vector = (struct vector *) where;
1101 length = fixnum_value(vector->length);
1102 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1108 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1110 struct vector *vector;
1113 vector = (struct vector *) where;
1114 length = fixnum_value(vector->length);
1115 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1121 trans_vector_unsigned_byte_32(lispobj object)
1123 struct vector *vector;
1126 gc_assert(is_lisp_pointer(object));
1128 vector = (struct vector *) native_pointer(object);
1129 length = fixnum_value(vector->length);
1130 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1132 return copy_large_unboxed_object(object, nwords);
1136 size_vector_unsigned_byte_32(lispobj *where)
1138 struct vector *vector;
1141 vector = (struct vector *) where;
1142 length = fixnum_value(vector->length);
1143 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1148 #if N_WORD_BITS == 64
1150 scav_vector_unsigned_byte_64(lispobj *where, lispobj object)
1152 struct vector *vector;
1155 vector = (struct vector *) where;
1156 length = fixnum_value(vector->length);
1157 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1163 trans_vector_unsigned_byte_64(lispobj object)
1165 struct vector *vector;
1168 gc_assert(is_lisp_pointer(object));
1170 vector = (struct vector *) native_pointer(object);
1171 length = fixnum_value(vector->length);
1172 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1174 return copy_large_unboxed_object(object, nwords);
1178 size_vector_unsigned_byte_64(lispobj *where)
1180 struct vector *vector;
1183 vector = (struct vector *) where;
1184 length = fixnum_value(vector->length);
1185 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1192 scav_vector_single_float(lispobj *where, lispobj object)
1194 struct vector *vector;
1197 vector = (struct vector *) where;
1198 length = fixnum_value(vector->length);
1199 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1205 trans_vector_single_float(lispobj object)
1207 struct vector *vector;
1210 gc_assert(is_lisp_pointer(object));
1212 vector = (struct vector *) native_pointer(object);
1213 length = fixnum_value(vector->length);
1214 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1216 return copy_large_unboxed_object(object, nwords);
1220 size_vector_single_float(lispobj *where)
1222 struct vector *vector;
1225 vector = (struct vector *) where;
1226 length = fixnum_value(vector->length);
1227 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1233 scav_vector_double_float(lispobj *where, lispobj object)
1235 struct vector *vector;
1238 vector = (struct vector *) where;
1239 length = fixnum_value(vector->length);
1240 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1246 trans_vector_double_float(lispobj object)
1248 struct vector *vector;
1251 gc_assert(is_lisp_pointer(object));
1253 vector = (struct vector *) native_pointer(object);
1254 length = fixnum_value(vector->length);
1255 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1257 return copy_large_unboxed_object(object, nwords);
1261 size_vector_double_float(lispobj *where)
1263 struct vector *vector;
1266 vector = (struct vector *) where;
1267 length = fixnum_value(vector->length);
1268 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1273 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1275 scav_vector_long_float(lispobj *where, lispobj object)
1277 struct vector *vector;
1280 vector = (struct vector *) where;
1281 length = fixnum_value(vector->length);
1282 nwords = CEILING(length *
1289 trans_vector_long_float(lispobj object)
1291 struct vector *vector;
1294 gc_assert(is_lisp_pointer(object));
1296 vector = (struct vector *) native_pointer(object);
1297 length = fixnum_value(vector->length);
1298 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1300 return copy_large_unboxed_object(object, nwords);
1304 size_vector_long_float(lispobj *where)
1306 struct vector *vector;
1309 vector = (struct vector *) where;
1310 length = fixnum_value(vector->length);
1311 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1318 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1320 scav_vector_complex_single_float(lispobj *where, lispobj object)
1322 struct vector *vector;
1325 vector = (struct vector *) where;
1326 length = fixnum_value(vector->length);
1327 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1333 trans_vector_complex_single_float(lispobj object)
1335 struct vector *vector;
1338 gc_assert(is_lisp_pointer(object));
1340 vector = (struct vector *) native_pointer(object);
1341 length = fixnum_value(vector->length);
1342 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1344 return copy_large_unboxed_object(object, nwords);
1348 size_vector_complex_single_float(lispobj *where)
1350 struct vector *vector;
1353 vector = (struct vector *) where;
1354 length = fixnum_value(vector->length);
1355 nwords = CEILING(NWORDS(length, 64) + 2, 2);
1361 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1363 scav_vector_complex_double_float(lispobj *where, lispobj object)
1365 struct vector *vector;
1368 vector = (struct vector *) where;
1369 length = fixnum_value(vector->length);
1370 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1376 trans_vector_complex_double_float(lispobj object)
1378 struct vector *vector;
1381 gc_assert(is_lisp_pointer(object));
1383 vector = (struct vector *) native_pointer(object);
1384 length = fixnum_value(vector->length);
1385 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1387 return copy_large_unboxed_object(object, nwords);
1391 size_vector_complex_double_float(lispobj *where)
1393 struct vector *vector;
1396 vector = (struct vector *) where;
1397 length = fixnum_value(vector->length);
1398 nwords = CEILING(NWORDS(length, 128) + 2, 2);
1405 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1407 scav_vector_complex_long_float(lispobj *where, lispobj object)
1409 struct vector *vector;
1412 vector = (struct vector *) where;
1413 length = fixnum_value(vector->length);
1414 nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1420 trans_vector_complex_long_float(lispobj object)
1422 struct vector *vector;
1425 gc_assert(is_lisp_pointer(object));
1427 vector = (struct vector *) native_pointer(object);
1428 length = fixnum_value(vector->length);
1429 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1431 return copy_large_unboxed_object(object, nwords);
1435 size_vector_complex_long_float(lispobj *where)
1437 struct vector *vector;
1440 vector = (struct vector *) where;
1441 length = fixnum_value(vector->length);
1442 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1448 #define WEAK_POINTER_NWORDS \
1449 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1452 trans_weak_pointer(lispobj object)
1455 #ifndef LISP_FEATURE_GENCGC
1456 struct weak_pointer *wp;
1458 gc_assert(is_lisp_pointer(object));
1460 #if defined(DEBUG_WEAK)
1461 printf("Transporting weak pointer from 0x%08x\n", object);
1464 /* Need to remember where all the weak pointers are that have */
1465 /* been transported so they can be fixed up in a post-GC pass. */
1467 copy = copy_object(object, WEAK_POINTER_NWORDS);
1468 #ifndef LISP_FEATURE_GENCGC
1469 wp = (struct weak_pointer *) native_pointer(copy);
1471 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1472 /* Push the weak pointer onto the list of weak pointers. */
1473 wp->next = LOW_WORD(weak_pointers);
1480 size_weak_pointer(lispobj *where)
1482 return WEAK_POINTER_NWORDS;
1486 void scan_weak_pointers(void)
1488 struct weak_pointer *wp;
1489 for (wp = weak_pointers; wp != NULL;
1490 wp=(struct weak_pointer *)native_pointer(wp->next)) {
1491 lispobj value = wp->value;
1492 lispobj *first_pointer;
1493 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1494 if (!(is_lisp_pointer(value) && from_space_p(value)))
1497 /* Now, we need to check whether the object has been forwarded. If
1498 * it has been, the weak pointer is still good and needs to be
1499 * updated. Otherwise, the weak pointer needs to be nil'ed
1502 first_pointer = (lispobj *)native_pointer(value);
1504 if (forwarding_pointer_p(first_pointer)) {
1506 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1522 scav_lose(lispobj *where, lispobj object)
1524 lose("no scavenge function for object 0x%08x (widetag 0x%x)",
1525 (unsigned long)object,
1526 widetag_of(*(lispobj*)native_pointer(object)));
1528 return 0; /* bogus return value to satisfy static type checking */
1532 trans_lose(lispobj object)
1534 lose("no transport function for object 0x%08x (widetag 0x%x)",
1535 (unsigned long)object,
1536 widetag_of(*(lispobj*)native_pointer(object)));
1537 return NIL; /* bogus return value to satisfy static type checking */
1541 size_lose(lispobj *where)
1543 lose("no size function for object at 0x%08x (widetag 0x%x)",
1544 (unsigned long)where,
1545 widetag_of(LOW_WORD(where)));
1546 return 1; /* bogus return value to satisfy static type checking */
1555 gc_init_tables(void)
1559 /* Set default value in all slots of scavenge table. FIXME
1560 * replace this gnarly sizeof with something based on
1562 for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) {
1563 scavtab[i] = scav_lose;
1566 /* For each type which can be selected by the lowtag alone, set
1567 * multiple entries in our widetag scavenge table (one for each
1568 * possible value of the high bits).
1571 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1572 scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1573 scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1574 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1575 scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1576 scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1577 scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_instance_pointer;
1578 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1579 scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1582 /* Other-pointer types (those selected by all eight bits of the
1583 * tag) get one entry each in the scavenge table. */
1584 scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1585 scavtab[RATIO_WIDETAG] = scav_boxed;
1586 scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1587 scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1588 #ifdef LONG_FLOAT_WIDETAG
1589 scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1591 scavtab[COMPLEX_WIDETAG] = scav_boxed;
1592 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1593 scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1595 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1596 scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1598 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1599 scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
1601 scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
1602 scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
1603 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1604 scavtab[SIMPLE_CHARACTER_STRING_WIDETAG] = scav_character_string;
1606 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
1607 scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
1608 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1609 scav_vector_unsigned_byte_2;
1610 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1611 scav_vector_unsigned_byte_4;
1612 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1613 scav_vector_unsigned_byte_8;
1614 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1615 scav_vector_unsigned_byte_8;
1616 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1617 scav_vector_unsigned_byte_16;
1618 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1619 scav_vector_unsigned_byte_16;
1620 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1621 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1622 scav_vector_unsigned_byte_32;
1624 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1625 scav_vector_unsigned_byte_32;
1626 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1627 scav_vector_unsigned_byte_32;
1628 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1629 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1630 scav_vector_unsigned_byte_64;
1632 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1633 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1634 scav_vector_unsigned_byte_64;
1636 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1637 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1638 scav_vector_unsigned_byte_64;
1640 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1641 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
1643 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1644 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1645 scav_vector_unsigned_byte_16;
1647 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1648 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1649 scav_vector_unsigned_byte_32;
1651 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1652 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1653 scav_vector_unsigned_byte_32;
1655 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1656 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1657 scav_vector_unsigned_byte_64;
1659 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1660 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1661 scav_vector_unsigned_byte_64;
1663 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
1664 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
1665 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1666 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
1668 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1669 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1670 scav_vector_complex_single_float;
1672 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1673 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1674 scav_vector_complex_double_float;
1676 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1677 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1678 scav_vector_complex_long_float;
1680 scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
1681 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1682 scavtab[COMPLEX_CHARACTER_STRING_WIDETAG] = scav_boxed;
1684 scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
1685 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
1686 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
1687 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
1688 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
1689 #ifndef LISP_FEATURE_GENCGC /* FIXME ..._X86 ? */
1690 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
1691 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
1693 #ifdef LISP_FEATURE_X86
1694 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
1695 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
1697 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
1698 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
1700 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
1701 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
1702 scavtab[CHARACTER_WIDETAG] = scav_immediate;
1703 scavtab[SAP_WIDETAG] = scav_unboxed;
1704 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
1705 scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed;
1706 #ifdef LISP_FEATURE_SPARC
1707 scavtab[FDEFN_WIDETAG] = scav_boxed;
1709 scavtab[FDEFN_WIDETAG] = scav_fdefn;
1712 /* transport other table, initialized same way as scavtab */
1713 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
1714 transother[i] = trans_lose;
1715 transother[BIGNUM_WIDETAG] = trans_unboxed;
1716 transother[RATIO_WIDETAG] = trans_boxed;
1717 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1718 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1719 #ifdef LONG_FLOAT_WIDETAG
1720 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
1722 transother[COMPLEX_WIDETAG] = trans_boxed;
1723 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1724 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1726 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1727 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1729 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1730 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
1732 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
1733 transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
1734 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1735 transother[SIMPLE_CHARACTER_STRING_WIDETAG] = trans_character_string;
1737 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
1738 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
1739 transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
1740 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1741 trans_vector_unsigned_byte_2;
1742 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1743 trans_vector_unsigned_byte_4;
1744 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1745 trans_vector_unsigned_byte_8;
1746 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1747 trans_vector_unsigned_byte_8;
1748 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1749 trans_vector_unsigned_byte_16;
1750 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1751 trans_vector_unsigned_byte_16;
1752 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1753 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1754 trans_vector_unsigned_byte_32;
1756 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1757 trans_vector_unsigned_byte_32;
1758 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1759 trans_vector_unsigned_byte_32;
1760 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1761 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1762 trans_vector_unsigned_byte_64;
1764 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1765 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1766 trans_vector_unsigned_byte_64;
1768 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1769 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1770 trans_vector_unsigned_byte_64;
1772 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1773 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
1774 trans_vector_unsigned_byte_8;
1776 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1777 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1778 trans_vector_unsigned_byte_16;
1780 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1781 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1782 trans_vector_unsigned_byte_32;
1784 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1785 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1786 trans_vector_unsigned_byte_32;
1788 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1789 transother[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1790 trans_vector_unsigned_byte_64;
1792 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1793 transother[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1794 trans_vector_unsigned_byte_64;
1796 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
1797 trans_vector_single_float;
1798 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
1799 trans_vector_double_float;
1800 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1801 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
1802 trans_vector_long_float;
1804 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1805 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1806 trans_vector_complex_single_float;
1808 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1809 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1810 trans_vector_complex_double_float;
1812 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1813 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1814 trans_vector_complex_long_float;
1816 transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
1817 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1818 transother[COMPLEX_CHARACTER_STRING_WIDETAG] = trans_boxed;
1820 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
1821 transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
1822 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
1823 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
1824 transother[CODE_HEADER_WIDETAG] = trans_code_header;
1825 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
1826 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
1827 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
1828 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
1829 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
1830 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
1831 transother[CHARACTER_WIDETAG] = trans_immediate;
1832 transother[SAP_WIDETAG] = trans_unboxed;
1833 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
1834 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
1835 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
1836 transother[FDEFN_WIDETAG] = trans_boxed;
1838 /* size table, initialized the same way as scavtab */
1839 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
1840 sizetab[i] = size_lose;
1841 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1842 sizetab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
1843 sizetab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1844 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1845 sizetab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1846 sizetab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
1847 sizetab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1848 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1849 sizetab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1851 sizetab[BIGNUM_WIDETAG] = size_unboxed;
1852 sizetab[RATIO_WIDETAG] = size_boxed;
1853 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
1854 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1855 #ifdef LONG_FLOAT_WIDETAG
1856 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
1858 sizetab[COMPLEX_WIDETAG] = size_boxed;
1859 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1860 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
1862 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1863 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1865 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1866 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
1868 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
1869 sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
1870 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1871 sizetab[SIMPLE_CHARACTER_STRING_WIDETAG] = size_character_string;
1873 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
1874 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
1875 sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
1876 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1877 size_vector_unsigned_byte_2;
1878 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1879 size_vector_unsigned_byte_4;
1880 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1881 size_vector_unsigned_byte_8;
1882 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1883 size_vector_unsigned_byte_8;
1884 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1885 size_vector_unsigned_byte_16;
1886 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1887 size_vector_unsigned_byte_16;
1888 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1889 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1890 size_vector_unsigned_byte_32;
1892 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1893 size_vector_unsigned_byte_32;
1894 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1895 size_vector_unsigned_byte_32;
1896 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1897 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1898 size_vector_unsigned_byte_64;
1900 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1901 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1902 size_vector_unsigned_byte_64;
1904 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1905 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1906 size_vector_unsigned_byte_64;
1908 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1909 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
1911 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1912 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1913 size_vector_unsigned_byte_16;
1915 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1916 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1917 size_vector_unsigned_byte_32;
1919 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1920 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1921 size_vector_unsigned_byte_32;
1923 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1924 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1925 size_vector_unsigned_byte_64;
1927 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1928 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1929 size_vector_unsigned_byte_64;
1931 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
1932 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
1933 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1934 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
1936 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1937 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1938 size_vector_complex_single_float;
1940 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1941 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1942 size_vector_complex_double_float;
1944 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1945 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1946 size_vector_complex_long_float;
1948 sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
1949 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1950 sizetab[COMPLEX_CHARACTER_STRING_WIDETAG] = size_boxed;
1952 sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
1953 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
1954 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
1955 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
1956 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
1958 /* We shouldn't see these, so just lose if it happens. */
1959 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
1960 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
1962 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
1963 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
1964 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
1965 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
1966 sizetab[CHARACTER_WIDETAG] = size_immediate;
1967 sizetab[SAP_WIDETAG] = size_unboxed;
1968 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
1969 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
1970 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
1971 sizetab[FDEFN_WIDETAG] = size_boxed;
1975 /* Find the code object for the given pc, or return NULL on
1978 component_ptr_from_pc(lispobj *pc)
1980 lispobj *object = NULL;
1982 if ( (object = search_read_only_space(pc)) )
1984 else if ( (object = search_static_space(pc)) )
1987 object = search_dynamic_space(pc);
1989 if (object) /* if we found something */
1990 if (widetag_of(*object) == CODE_HEADER_WIDETAG)