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*4,ALLOC_BOXED,ALLOC_QUICK);
112 /* Copy the object. */
113 memcpy(new,native_pointer(object),nwords*4);
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 ((object & 3) == 0) {
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 offset = HeaderValue(return_pc->header) * 4 ;
404 /* Transport the whole code object */
405 code = (struct code *) ((unsigned long) return_pc - offset);
406 ncode = trans_code(code);
408 return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
411 /* On the 386, closures hold a pointer to the raw address instead of the
412 * function object, so we can use CALL [$FDEFN+const] to invoke
413 * the function without loading it into a register. Given that code
414 * objects don't move, we don't need to update anything, but we do
415 * have to figure out that the function is still live. */
417 #ifdef LISP_FEATURE_X86
419 scav_closure_header(lispobj *where, lispobj object)
421 struct closure *closure;
424 closure = (struct closure *)where;
425 fun = closure->fun - FUN_RAW_ADDR_OFFSET;
427 #ifdef LISP_FEATURE_GENCGC
428 /* The function may have moved so update the raw address. But
429 * don't write unnecessarily. */
430 if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
431 closure->fun = fun + FUN_RAW_ADDR_OFFSET;
437 #ifndef LISP_FEATURE_X86
439 scav_fun_header(lispobj *where, lispobj object)
441 lose("attempted to scavenge a function header where=0x%08x object=0x%08x",
442 (unsigned long) where,
443 (unsigned long) object);
444 return 0; /* bogus return value to satisfy static type checking */
446 #endif /* LISP_FEATURE_X86 */
449 trans_fun_header(lispobj object)
451 struct simple_fun *fheader;
452 unsigned long offset;
453 struct code *code, *ncode;
455 fheader = (struct simple_fun *) native_pointer(object);
456 offset = HeaderValue(fheader->header) * 4;
458 /* Transport the whole code object */
459 code = (struct code *) ((unsigned long) fheader - offset);
460 ncode = trans_code(code);
462 return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
471 scav_instance_pointer(lispobj *where, lispobj object)
473 lispobj copy, *first_pointer;
475 /* Object is a pointer into from space - not a FP. */
476 copy = trans_boxed(object);
478 #ifdef LISP_FEATURE_GENCGC
479 gc_assert(copy != object);
482 first_pointer = (lispobj *) native_pointer(object);
483 set_forwarding_pointer(first_pointer,copy);
494 static lispobj trans_list(lispobj object);
497 scav_list_pointer(lispobj *where, lispobj object)
499 lispobj first, *first_pointer;
501 gc_assert(is_lisp_pointer(object));
503 /* Object is a pointer into from space - not FP. */
504 first_pointer = (lispobj *) native_pointer(object);
506 first = trans_list(object);
507 gc_assert(first != object);
509 /* Set forwarding pointer */
510 set_forwarding_pointer(first_pointer, first);
512 gc_assert(is_lisp_pointer(first));
513 gc_assert(!from_space_p(first));
521 trans_list(lispobj object)
523 lispobj new_list_pointer;
524 struct cons *cons, *new_cons;
527 cons = (struct cons *) native_pointer(object);
530 new_cons = (struct cons *)
531 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
532 new_cons->car = cons->car;
533 new_cons->cdr = cons->cdr; /* updated later */
534 new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
536 /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC */
539 set_forwarding_pointer((lispobj *)cons, new_list_pointer);
541 /* Try to linearize the list in the cdr direction to help reduce
545 struct cons *cdr_cons, *new_cdr_cons;
547 if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
548 !from_space_p(cdr) ||
549 forwarding_pointer_p((lispobj *)native_pointer(cdr)))
552 cdr_cons = (struct cons *) native_pointer(cdr);
555 new_cdr_cons = (struct cons*)
556 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
557 new_cdr_cons->car = cdr_cons->car;
558 new_cdr_cons->cdr = cdr_cons->cdr;
559 new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
561 /* Grab the cdr before it is clobbered. */
563 set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
565 /* Update the cdr of the last cons copied into new space to
566 * keep the newspace scavenge from having to do it. */
567 new_cons->cdr = new_cdr;
569 new_cons = new_cdr_cons;
572 return new_list_pointer;
577 * scavenging and transporting other pointers
581 scav_other_pointer(lispobj *where, lispobj object)
583 lispobj first, *first_pointer;
585 gc_assert(is_lisp_pointer(object));
587 /* Object is a pointer into from space - not FP. */
588 first_pointer = (lispobj *) native_pointer(object);
589 first = (transother[widetag_of(*first_pointer)])(object);
591 if (first != object) {
592 set_forwarding_pointer(first_pointer, first);
593 #ifdef LISP_FEATURE_GENCGC
597 #ifndef LISP_FEATURE_GENCGC
600 gc_assert(is_lisp_pointer(first));
601 gc_assert(!from_space_p(first));
607 * immediate, boxed, and unboxed objects
611 size_pointer(lispobj *where)
617 scav_immediate(lispobj *where, lispobj object)
623 trans_immediate(lispobj object)
625 lose("trying to transport an immediate");
626 return NIL; /* bogus return value to satisfy static type checking */
630 size_immediate(lispobj *where)
637 scav_boxed(lispobj *where, lispobj object)
643 trans_boxed(lispobj object)
646 unsigned long length;
648 gc_assert(is_lisp_pointer(object));
650 header = *((lispobj *) native_pointer(object));
651 length = HeaderValue(header) + 1;
652 length = CEILING(length, 2);
654 return copy_object(object, length);
659 size_boxed(lispobj *where)
662 unsigned long length;
665 length = HeaderValue(header) + 1;
666 length = CEILING(length, 2);
671 /* Note: on the sparc we don't have to do anything special for fdefns, */
672 /* 'cause the raw-addr has a function lowtag. */
673 #ifndef LISP_FEATURE_SPARC
675 scav_fdefn(lispobj *where, lispobj object)
679 fdefn = (struct fdefn *)where;
681 /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
682 fdefn->fun, fdefn->raw_addr)); */
684 if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)
685 == (char *)((unsigned long)(fdefn->raw_addr))) {
686 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
688 /* Don't write unnecessarily. */
689 if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
690 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
691 /* gc.c has more casts here, which may be relevant or alternatively
692 may be compiler warning defeaters. try
694 (u32) ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
696 return sizeof(struct fdefn) / sizeof(lispobj);
704 scav_unboxed(lispobj *where, lispobj object)
706 unsigned long length;
708 length = HeaderValue(object) + 1;
709 length = CEILING(length, 2);
715 trans_unboxed(lispobj object)
718 unsigned long length;
721 gc_assert(is_lisp_pointer(object));
723 header = *((lispobj *) native_pointer(object));
724 length = HeaderValue(header) + 1;
725 length = CEILING(length, 2);
727 return copy_unboxed_object(object, length);
731 size_unboxed(lispobj *where)
734 unsigned long length;
737 length = HeaderValue(header) + 1;
738 length = CEILING(length, 2);
744 /* vector-like objects */
746 #define NWORDS(x,y) (CEILING((x),(y)) / (y))
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, 4) + 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, 4) + 2, 2);
778 return copy_large_unboxed_object(object, nwords);
782 size_base_string(lispobj *where)
784 struct vector *vector;
787 /* NOTE: A string contains one more byte of data (a terminating
788 * '\0' to help when interfacing with C functions) than indicated
789 * by the length slot. */
791 vector = (struct vector *) where;
792 length = fixnum_value(vector->length) + 1;
793 nwords = CEILING(NWORDS(length, 4) + 2, 2);
799 trans_vector(lispobj object)
801 struct vector *vector;
804 gc_assert(is_lisp_pointer(object));
806 vector = (struct vector *) native_pointer(object);
808 length = fixnum_value(vector->length);
809 nwords = CEILING(length + 2, 2);
811 return copy_large_object(object, nwords);
815 size_vector(lispobj *where)
817 struct vector *vector;
820 vector = (struct vector *) where;
821 length = fixnum_value(vector->length);
822 nwords = CEILING(length + 2, 2);
828 scav_vector_nil(lispobj *where, lispobj object)
834 trans_vector_nil(lispobj object)
836 gc_assert(is_lisp_pointer(object));
837 return copy_unboxed_object(object, 2);
841 size_vector_nil(lispobj *where)
843 /* Just the header word and the length word */
848 scav_vector_bit(lispobj *where, lispobj object)
850 struct vector *vector;
853 vector = (struct vector *) where;
854 length = fixnum_value(vector->length);
855 nwords = CEILING(NWORDS(length, 32) + 2, 2);
861 trans_vector_bit(lispobj object)
863 struct vector *vector;
866 gc_assert(is_lisp_pointer(object));
868 vector = (struct vector *) native_pointer(object);
869 length = fixnum_value(vector->length);
870 nwords = CEILING(NWORDS(length, 32) + 2, 2);
872 return copy_large_unboxed_object(object, nwords);
876 size_vector_bit(lispobj *where)
878 struct vector *vector;
881 vector = (struct vector *) where;
882 length = fixnum_value(vector->length);
883 nwords = CEILING(NWORDS(length, 32) + 2, 2);
889 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
891 struct vector *vector;
894 vector = (struct vector *) where;
895 length = fixnum_value(vector->length);
896 nwords = CEILING(NWORDS(length, 16) + 2, 2);
902 trans_vector_unsigned_byte_2(lispobj object)
904 struct vector *vector;
907 gc_assert(is_lisp_pointer(object));
909 vector = (struct vector *) native_pointer(object);
910 length = fixnum_value(vector->length);
911 nwords = CEILING(NWORDS(length, 16) + 2, 2);
913 return copy_large_unboxed_object(object, nwords);
917 size_vector_unsigned_byte_2(lispobj *where)
919 struct vector *vector;
922 vector = (struct vector *) where;
923 length = fixnum_value(vector->length);
924 nwords = CEILING(NWORDS(length, 16) + 2, 2);
930 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
932 struct vector *vector;
935 vector = (struct vector *) where;
936 length = fixnum_value(vector->length);
937 nwords = CEILING(NWORDS(length, 8) + 2, 2);
943 trans_vector_unsigned_byte_4(lispobj object)
945 struct vector *vector;
948 gc_assert(is_lisp_pointer(object));
950 vector = (struct vector *) native_pointer(object);
951 length = fixnum_value(vector->length);
952 nwords = CEILING(NWORDS(length, 8) + 2, 2);
954 return copy_large_unboxed_object(object, nwords);
957 size_vector_unsigned_byte_4(lispobj *where)
959 struct vector *vector;
962 vector = (struct vector *) where;
963 length = fixnum_value(vector->length);
964 nwords = CEILING(NWORDS(length, 8) + 2, 2);
971 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
973 struct vector *vector;
976 vector = (struct vector *) where;
977 length = fixnum_value(vector->length);
978 nwords = CEILING(NWORDS(length, 4) + 2, 2);
983 /*********************/
988 trans_vector_unsigned_byte_8(lispobj object)
990 struct vector *vector;
993 gc_assert(is_lisp_pointer(object));
995 vector = (struct vector *) native_pointer(object);
996 length = fixnum_value(vector->length);
997 nwords = CEILING(NWORDS(length, 4) + 2, 2);
999 return copy_large_unboxed_object(object, nwords);
1003 size_vector_unsigned_byte_8(lispobj *where)
1005 struct vector *vector;
1008 vector = (struct vector *) where;
1009 length = fixnum_value(vector->length);
1010 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1017 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1019 struct vector *vector;
1022 vector = (struct vector *) where;
1023 length = fixnum_value(vector->length);
1024 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1030 trans_vector_unsigned_byte_16(lispobj object)
1032 struct vector *vector;
1035 gc_assert(is_lisp_pointer(object));
1037 vector = (struct vector *) native_pointer(object);
1038 length = fixnum_value(vector->length);
1039 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1041 return copy_large_unboxed_object(object, nwords);
1045 size_vector_unsigned_byte_16(lispobj *where)
1047 struct vector *vector;
1050 vector = (struct vector *) where;
1051 length = fixnum_value(vector->length);
1052 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1058 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1060 struct vector *vector;
1063 vector = (struct vector *) where;
1064 length = fixnum_value(vector->length);
1065 nwords = CEILING(length + 2, 2);
1071 trans_vector_unsigned_byte_32(lispobj object)
1073 struct vector *vector;
1076 gc_assert(is_lisp_pointer(object));
1078 vector = (struct vector *) native_pointer(object);
1079 length = fixnum_value(vector->length);
1080 nwords = CEILING(length + 2, 2);
1082 return copy_large_unboxed_object(object, nwords);
1086 size_vector_unsigned_byte_32(lispobj *where)
1088 struct vector *vector;
1091 vector = (struct vector *) where;
1092 length = fixnum_value(vector->length);
1093 nwords = CEILING(length + 2, 2);
1099 scav_vector_single_float(lispobj *where, lispobj object)
1101 struct vector *vector;
1104 vector = (struct vector *) where;
1105 length = fixnum_value(vector->length);
1106 nwords = CEILING(length + 2, 2);
1112 trans_vector_single_float(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(length + 2, 2);
1123 return copy_large_unboxed_object(object, nwords);
1127 size_vector_single_float(lispobj *where)
1129 struct vector *vector;
1132 vector = (struct vector *) where;
1133 length = fixnum_value(vector->length);
1134 nwords = CEILING(length + 2, 2);
1140 scav_vector_double_float(lispobj *where, lispobj object)
1142 struct vector *vector;
1145 vector = (struct vector *) where;
1146 length = fixnum_value(vector->length);
1147 nwords = CEILING(length * 2 + 2, 2);
1153 trans_vector_double_float(lispobj object)
1155 struct vector *vector;
1158 gc_assert(is_lisp_pointer(object));
1160 vector = (struct vector *) native_pointer(object);
1161 length = fixnum_value(vector->length);
1162 nwords = CEILING(length * 2 + 2, 2);
1164 return copy_large_unboxed_object(object, nwords);
1168 size_vector_double_float(lispobj *where)
1170 struct vector *vector;
1173 vector = (struct vector *) where;
1174 length = fixnum_value(vector->length);
1175 nwords = CEILING(length * 2 + 2, 2);
1180 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1182 scav_vector_long_float(lispobj *where, lispobj object)
1184 struct vector *vector;
1187 vector = (struct vector *) where;
1188 length = fixnum_value(vector->length);
1189 nwords = CEILING(length *
1196 trans_vector_long_float(lispobj object)
1198 struct vector *vector;
1201 gc_assert(is_lisp_pointer(object));
1203 vector = (struct vector *) native_pointer(object);
1204 length = fixnum_value(vector->length);
1205 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1207 return copy_large_unboxed_object(object, nwords);
1211 size_vector_long_float(lispobj *where)
1213 struct vector *vector;
1216 vector = (struct vector *) where;
1217 length = fixnum_value(vector->length);
1218 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1225 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1227 scav_vector_complex_single_float(lispobj *where, lispobj object)
1229 struct vector *vector;
1232 vector = (struct vector *) where;
1233 length = fixnum_value(vector->length);
1234 nwords = CEILING(length * 2 + 2, 2);
1240 trans_vector_complex_single_float(lispobj object)
1242 struct vector *vector;
1245 gc_assert(is_lisp_pointer(object));
1247 vector = (struct vector *) native_pointer(object);
1248 length = fixnum_value(vector->length);
1249 nwords = CEILING(length * 2 + 2, 2);
1251 return copy_large_unboxed_object(object, nwords);
1255 size_vector_complex_single_float(lispobj *where)
1257 struct vector *vector;
1260 vector = (struct vector *) where;
1261 length = fixnum_value(vector->length);
1262 nwords = CEILING(length * 2 + 2, 2);
1268 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1270 scav_vector_complex_double_float(lispobj *where, lispobj object)
1272 struct vector *vector;
1275 vector = (struct vector *) where;
1276 length = fixnum_value(vector->length);
1277 nwords = CEILING(length * 4 + 2, 2);
1283 trans_vector_complex_double_float(lispobj object)
1285 struct vector *vector;
1288 gc_assert(is_lisp_pointer(object));
1290 vector = (struct vector *) native_pointer(object);
1291 length = fixnum_value(vector->length);
1292 nwords = CEILING(length * 4 + 2, 2);
1294 return copy_large_unboxed_object(object, nwords);
1298 size_vector_complex_double_float(lispobj *where)
1300 struct vector *vector;
1303 vector = (struct vector *) where;
1304 length = fixnum_value(vector->length);
1305 nwords = CEILING(length * 4 + 2, 2);
1312 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1314 scav_vector_complex_long_float(lispobj *where, lispobj object)
1316 struct vector *vector;
1319 vector = (struct vector *) where;
1320 length = fixnum_value(vector->length);
1321 nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1327 trans_vector_complex_long_float(lispobj object)
1329 struct vector *vector;
1332 gc_assert(is_lisp_pointer(object));
1334 vector = (struct vector *) native_pointer(object);
1335 length = fixnum_value(vector->length);
1336 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1338 return copy_large_unboxed_object(object, nwords);
1342 size_vector_complex_long_float(lispobj *where)
1344 struct vector *vector;
1347 vector = (struct vector *) where;
1348 length = fixnum_value(vector->length);
1349 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1355 #define WEAK_POINTER_NWORDS \
1356 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1359 trans_weak_pointer(lispobj object)
1362 #ifndef LISP_FEATURE_GENCGC
1363 struct weak_pointer *wp;
1365 gc_assert(is_lisp_pointer(object));
1367 #if defined(DEBUG_WEAK)
1368 printf("Transporting weak pointer from 0x%08x\n", object);
1371 /* Need to remember where all the weak pointers are that have */
1372 /* been transported so they can be fixed up in a post-GC pass. */
1374 copy = copy_object(object, WEAK_POINTER_NWORDS);
1375 #ifndef LISP_FEATURE_GENCGC
1376 wp = (struct weak_pointer *) native_pointer(copy);
1378 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1379 /* Push the weak pointer onto the list of weak pointers. */
1380 wp->next = LOW_WORD(weak_pointers);
1387 size_weak_pointer(lispobj *where)
1389 return WEAK_POINTER_NWORDS;
1393 void scan_weak_pointers(void)
1395 struct weak_pointer *wp;
1396 for (wp = weak_pointers; wp != NULL;
1397 wp=(struct weak_pointer *)native_pointer(wp->next)) {
1398 lispobj value = wp->value;
1399 lispobj *first_pointer;
1400 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1401 if (!(is_lisp_pointer(value) && from_space_p(value)))
1404 /* Now, we need to check whether the object has been forwarded. If
1405 * it has been, the weak pointer is still good and needs to be
1406 * updated. Otherwise, the weak pointer needs to be nil'ed
1409 first_pointer = (lispobj *)native_pointer(value);
1411 if (forwarding_pointer_p(first_pointer)) {
1413 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1429 scav_lose(lispobj *where, lispobj object)
1431 lose("no scavenge function for object 0x%08x (widetag 0x%x)",
1432 (unsigned long)object,
1433 widetag_of(*(lispobj*)native_pointer(object)));
1434 return 0; /* bogus return value to satisfy static type checking */
1438 trans_lose(lispobj object)
1440 lose("no transport function for object 0x%08x (widetag 0x%x)",
1441 (unsigned long)object,
1442 widetag_of(*(lispobj*)native_pointer(object)));
1443 return NIL; /* bogus return value to satisfy static type checking */
1447 size_lose(lispobj *where)
1449 lose("no size function for object at 0x%08x (widetag 0x%x)",
1450 (unsigned long)where,
1451 widetag_of(LOW_WORD(where)));
1452 return 1; /* bogus return value to satisfy static type checking */
1461 gc_init_tables(void)
1465 /* Set default value in all slots of scavenge table. FIXME
1466 * replace this gnarly sizeof with something based on
1468 for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) {
1469 scavtab[i] = scav_lose;
1472 /* For each type which can be selected by the lowtag alone, set
1473 * multiple entries in our widetag scavenge table (one for each
1474 * possible value of the high bits).
1477 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1478 scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1479 scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1480 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1481 scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1482 scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1483 scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_instance_pointer;
1484 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1485 scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1488 /* Other-pointer types (those selected by all eight bits of the
1489 * tag) get one entry each in the scavenge table. */
1490 scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1491 scavtab[RATIO_WIDETAG] = scav_boxed;
1492 scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1493 scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1494 #ifdef LONG_FLOAT_WIDETAG
1495 scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1497 scavtab[COMPLEX_WIDETAG] = scav_boxed;
1498 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1499 scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1501 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1502 scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1504 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1505 scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
1507 scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
1508 scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
1509 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
1510 scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
1511 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1512 scav_vector_unsigned_byte_2;
1513 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1514 scav_vector_unsigned_byte_4;
1515 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1516 scav_vector_unsigned_byte_8;
1517 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1518 scav_vector_unsigned_byte_8;
1519 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1520 scav_vector_unsigned_byte_16;
1521 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1522 scav_vector_unsigned_byte_16;
1523 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1524 scav_vector_unsigned_byte_32;
1525 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1526 scav_vector_unsigned_byte_32;
1527 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1528 scav_vector_unsigned_byte_32;
1529 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1530 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
1532 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1533 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1534 scav_vector_unsigned_byte_16;
1536 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1537 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1538 scav_vector_unsigned_byte_32;
1540 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1541 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1542 scav_vector_unsigned_byte_32;
1544 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
1545 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
1546 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1547 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
1549 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1550 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1551 scav_vector_complex_single_float;
1553 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1554 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1555 scav_vector_complex_double_float;
1557 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1558 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1559 scav_vector_complex_long_float;
1561 scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
1562 scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
1563 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
1564 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
1565 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
1566 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
1567 #ifndef LISP_FEATURE_GENCGC /* FIXME ..._X86 ? */
1568 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
1569 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
1571 #ifdef LISP_FEATURE_X86
1572 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
1573 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
1575 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
1576 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
1578 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
1579 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
1580 scavtab[BASE_CHAR_WIDETAG] = scav_immediate;
1581 scavtab[SAP_WIDETAG] = scav_unboxed;
1582 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
1583 scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed;
1584 #ifdef LISP_FEATURE_SPARC
1585 scavtab[FDEFN_WIDETAG] = scav_boxed;
1587 scavtab[FDEFN_WIDETAG] = scav_fdefn;
1590 /* transport other table, initialized same way as scavtab */
1591 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
1592 transother[i] = trans_lose;
1593 transother[BIGNUM_WIDETAG] = trans_unboxed;
1594 transother[RATIO_WIDETAG] = trans_boxed;
1595 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1596 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1597 #ifdef LONG_FLOAT_WIDETAG
1598 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
1600 transother[COMPLEX_WIDETAG] = trans_boxed;
1601 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1602 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1604 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1605 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1607 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1608 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
1610 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
1611 transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
1612 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
1613 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
1614 transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
1615 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1616 trans_vector_unsigned_byte_2;
1617 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1618 trans_vector_unsigned_byte_4;
1619 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1620 trans_vector_unsigned_byte_8;
1621 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1622 trans_vector_unsigned_byte_8;
1623 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1624 trans_vector_unsigned_byte_16;
1625 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1626 trans_vector_unsigned_byte_16;
1627 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1628 trans_vector_unsigned_byte_32;
1629 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1630 trans_vector_unsigned_byte_32;
1631 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1632 trans_vector_unsigned_byte_32;
1633 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1634 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
1635 trans_vector_unsigned_byte_8;
1637 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1638 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1639 trans_vector_unsigned_byte_16;
1641 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1642 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1643 trans_vector_unsigned_byte_32;
1645 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1646 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1647 trans_vector_unsigned_byte_32;
1649 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
1650 trans_vector_single_float;
1651 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
1652 trans_vector_double_float;
1653 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1654 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
1655 trans_vector_long_float;
1657 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1658 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1659 trans_vector_complex_single_float;
1661 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1662 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1663 trans_vector_complex_double_float;
1665 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1666 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1667 trans_vector_complex_long_float;
1669 transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
1670 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
1671 transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
1672 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
1673 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
1674 transother[CODE_HEADER_WIDETAG] = trans_code_header;
1675 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
1676 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
1677 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
1678 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
1679 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
1680 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
1681 transother[BASE_CHAR_WIDETAG] = trans_immediate;
1682 transother[SAP_WIDETAG] = trans_unboxed;
1683 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
1684 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
1685 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
1686 transother[FDEFN_WIDETAG] = trans_boxed;
1688 /* size table, initialized the same way as scavtab */
1689 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
1690 sizetab[i] = size_lose;
1691 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1692 sizetab[EVEN_FIXNUM_LOWTAG|(i<<3)] = size_immediate;
1693 sizetab[FUN_POINTER_LOWTAG|(i<<3)] = size_pointer;
1694 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1695 sizetab[LIST_POINTER_LOWTAG|(i<<3)] = size_pointer;
1696 sizetab[ODD_FIXNUM_LOWTAG|(i<<3)] = size_immediate;
1697 sizetab[INSTANCE_POINTER_LOWTAG|(i<<3)] = size_pointer;
1698 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1699 sizetab[OTHER_POINTER_LOWTAG|(i<<3)] = size_pointer;
1701 sizetab[BIGNUM_WIDETAG] = size_unboxed;
1702 sizetab[RATIO_WIDETAG] = size_boxed;
1703 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
1704 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1705 #ifdef LONG_FLOAT_WIDETAG
1706 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
1708 sizetab[COMPLEX_WIDETAG] = size_boxed;
1709 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1710 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
1712 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1713 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1715 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1716 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
1718 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
1719 sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
1720 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
1721 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
1722 sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
1723 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1724 size_vector_unsigned_byte_2;
1725 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1726 size_vector_unsigned_byte_4;
1727 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1728 size_vector_unsigned_byte_8;
1729 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1730 size_vector_unsigned_byte_8;
1731 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1732 size_vector_unsigned_byte_16;
1733 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1734 size_vector_unsigned_byte_16;
1735 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1736 size_vector_unsigned_byte_32;
1737 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1738 size_vector_unsigned_byte_32;
1739 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1740 size_vector_unsigned_byte_32;
1741 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1742 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
1744 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1745 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1746 size_vector_unsigned_byte_16;
1748 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1749 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1750 size_vector_unsigned_byte_32;
1752 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1753 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1754 size_vector_unsigned_byte_32;
1756 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
1757 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
1758 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1759 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
1761 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1762 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1763 size_vector_complex_single_float;
1765 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1766 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1767 size_vector_complex_double_float;
1769 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1770 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1771 size_vector_complex_long_float;
1773 sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
1774 sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
1775 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
1776 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
1777 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
1778 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
1780 /* We shouldn't see these, so just lose if it happens. */
1781 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
1782 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
1784 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
1785 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
1786 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
1787 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
1788 sizetab[BASE_CHAR_WIDETAG] = size_immediate;
1789 sizetab[SAP_WIDETAG] = size_unboxed;
1790 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
1791 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
1792 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
1793 sizetab[FDEFN_WIDETAG] = size_boxed;
1797 /* Find the code object for the given pc, or return NULL on
1800 component_ptr_from_pc(lispobj *pc)
1802 lispobj *object = NULL;
1804 if ( (object = search_read_only_space(pc)) )
1806 else if ( (object = search_static_space(pc)) )
1809 object = search_dynamic_space(pc);
1811 if (object) /* if we found something */
1812 if (widetag_of(*object) == CODE_HEADER_WIDETAG)