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 * GENerational Conservative Garbage Collector for SBCL x86
22 * This software is part of the SBCL system. See the README file for
25 * This software is derived from the CMU CL system, which was
26 * written at Carnegie Mellon University and released into the
27 * public domain. The software is in the public domain and is
28 * provided with absolutely no warranty. See the COPYING and CREDITS
29 * files for more information.
33 * For a review of garbage collection techniques (e.g. generational
34 * GC) and terminology (e.g. "scavenging") see Paul R. Wilson,
35 * "Uniprocessor Garbage Collection Techniques". As of 20000618, this
36 * had been accepted for _ACM Computing Surveys_ and was available
37 * as a PostScript preprint through
38 * <http://www.cs.utexas.edu/users/oops/papers.html>
40 * <ftp://ftp.cs.utexas.edu/pub/garbage/bigsurv.ps>.
50 #include "interrupt.h"
55 #include "genesis/primitive-objects.h"
56 #include "genesis/static-symbols.h"
57 #include "gc-internal.h"
59 #ifdef LISP_FEATURE_SPARC
60 #define LONG_FLOAT_SIZE 4
62 #ifdef LISP_FEATURE_X86
63 #define LONG_FLOAT_SIZE 3
68 forwarding_pointer_p(lispobj *pointer) {
69 lispobj first_word=*pointer;
70 #ifdef LISP_FEATURE_GENCGC
71 return (first_word == 0x01);
73 return (is_lisp_pointer(first_word)
74 && new_space_p(first_word));
78 static inline lispobj *
79 forwarding_pointer_value(lispobj *pointer) {
80 #ifdef LISP_FEATURE_GENCGC
81 return (lispobj *) ((pointer_sized_uint_t) pointer[1]);
83 return (lispobj *) ((pointer_sized_uint_t) pointer[0]);
87 set_forwarding_pointer(lispobj * pointer, lispobj newspace_copy) {
88 #ifdef LISP_FEATURE_GENCGC
90 pointer[1]=newspace_copy;
92 pointer[0]=newspace_copy;
97 int (*scavtab[256])(lispobj *where, lispobj object);
98 lispobj (*transother[256])(lispobj object);
99 int (*sizetab[256])(lispobj *where);
100 struct weak_pointer *weak_pointers;
102 unsigned long bytes_consed_between_gcs = 12*1024*1024;
109 /* to copy a boxed object */
111 copy_object(lispobj object, int nwords)
115 lispobj *source, *dest;
117 gc_assert(is_lisp_pointer(object));
118 gc_assert(from_space_p(object));
119 gc_assert((nwords & 0x01) == 0);
121 /* Get tag of object. */
122 tag = lowtag_of(object);
124 /* Allocate space. */
125 new = gc_general_alloc(nwords*4,ALLOC_BOXED,ALLOC_QUICK);
128 source = (lispobj *) native_pointer(object);
130 /* Copy the object. */
139 return make_lispobj(new,tag);
142 static int scav_lose(lispobj *where, lispobj object); /* forward decl */
144 /* FIXME: Most calls end up going to some trouble to compute an
145 * 'n_words' value for this function. The system might be a little
146 * simpler if this function used an 'end' parameter instead. */
149 scavenge(lispobj *start, long n_words)
151 lispobj *end = start + n_words;
153 int n_words_scavenged;
155 for (object_ptr = start;
157 object_ptr += n_words_scavenged) {
159 lispobj object = *object_ptr;
160 #ifdef LISP_FEATURE_GENCGC
161 gc_assert(!forwarding_pointer_p(object_ptr));
163 if (is_lisp_pointer(object)) {
164 if (from_space_p(object)) {
165 /* It currently points to old space. Check for a
166 * forwarding pointer. */
167 lispobj *ptr = native_pointer(object);
168 if (forwarding_pointer_p(ptr)) {
169 /* Yes, there's a forwarding pointer. */
170 *object_ptr = LOW_WORD(forwarding_pointer_value(ptr));
171 n_words_scavenged = 1;
173 /* Scavenge that pointer. */
175 (scavtab[widetag_of(object)])(object_ptr, object);
178 /* It points somewhere other than oldspace. Leave it
180 n_words_scavenged = 1;
183 #ifndef LISP_FEATURE_GENCGC
184 /* this workaround is probably not necessary for gencgc; at least, the
185 * behaviour it describes has never been reported */
186 else if (n_words==1) {
187 /* there are some situations where an
188 other-immediate may end up in a descriptor
189 register. I'm not sure whether this is
190 supposed to happen, but if it does then we
191 don't want to (a) barf or (b) scavenge over the
192 data-block, because there isn't one. So, if
193 we're checking a single word and it's anything
194 other than a pointer, just hush it up */
195 int type=widetag_of(object);
198 if ((scavtab[type]==scav_lose) ||
199 (((scavtab[type])(start,object))>1)) {
200 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",
205 else if ((object & 3) == 0) {
206 /* It's a fixnum: really easy.. */
207 n_words_scavenged = 1;
209 /* It's some sort of header object or another. */
211 (scavtab[widetag_of(object)])(object_ptr, object);
214 gc_assert(object_ptr == end);
217 static lispobj trans_fun_header(lispobj object); /* forward decls */
218 static lispobj trans_boxed(lispobj object);
221 scav_fun_pointer(lispobj *where, lispobj object)
223 lispobj *first_pointer;
226 gc_assert(is_lisp_pointer(object));
228 /* Object is a pointer into from_space - not a FP. */
229 first_pointer = (lispobj *) native_pointer(object);
231 /* must transport object -- object may point to either a function
232 * header, a closure function header, or to a closure header. */
234 switch (widetag_of(*first_pointer)) {
235 case SIMPLE_FUN_HEADER_WIDETAG:
236 copy = trans_fun_header(object);
239 copy = trans_boxed(object);
243 if (copy != object) {
244 /* Set forwarding pointer */
245 set_forwarding_pointer(first_pointer,copy);
248 gc_assert(is_lisp_pointer(copy));
249 gc_assert(!from_space_p(copy));
258 trans_code(struct code *code)
260 struct code *new_code;
261 lispobj first, l_code, l_new_code;
262 int nheader_words, ncode_words, nwords;
263 unsigned long displacement;
264 lispobj fheaderl, *prev_pointer;
266 /* if object has already been transported, just return pointer */
267 first = code->header;
268 if (forwarding_pointer_p((lispobj *)code)) {
270 printf("Was already transported\n");
272 return (struct code *) forwarding_pointer_value
273 ((lispobj *)((pointer_sized_uint_t) code));
276 gc_assert(widetag_of(first) == CODE_HEADER_WIDETAG);
278 /* prepare to transport the code vector */
279 l_code = (lispobj) LOW_WORD(code) | OTHER_POINTER_LOWTAG;
281 ncode_words = fixnum_value(code->code_size);
282 nheader_words = HeaderValue(code->header);
283 nwords = ncode_words + nheader_words;
284 nwords = CEILING(nwords, 2);
286 l_new_code = copy_object(l_code, nwords);
287 new_code = (struct code *) native_pointer(l_new_code);
289 #if defined(DEBUG_CODE_GC)
290 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
291 (unsigned long) code, (unsigned long) new_code);
292 printf("Code object is %d words long.\n", nwords);
295 #ifdef LISP_FEATURE_GENCGC
296 if (new_code == code)
300 displacement = l_new_code - l_code;
302 set_forwarding_pointer((lispobj *)code, l_new_code);
304 /* set forwarding pointers for all the function headers in the */
305 /* code object. also fix all self pointers */
307 fheaderl = code->entry_points;
308 prev_pointer = &new_code->entry_points;
310 while (fheaderl != NIL) {
311 struct simple_fun *fheaderp, *nfheaderp;
314 fheaderp = (struct simple_fun *) native_pointer(fheaderl);
315 gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
317 /* Calculate the new function pointer and the new */
318 /* function header. */
319 nfheaderl = fheaderl + displacement;
320 nfheaderp = (struct simple_fun *) native_pointer(nfheaderl);
323 printf("fheaderp->header (at %x) <- %x\n",
324 &(fheaderp->header) , nfheaderl);
326 set_forwarding_pointer((lispobj *)fheaderp, nfheaderl);
328 /* fix self pointer. */
330 #ifdef LISP_FEATURE_GENCGC /* GENCGC? Maybe x86 is better conditional */
331 FUN_RAW_ADDR_OFFSET +
335 *prev_pointer = nfheaderl;
337 fheaderl = fheaderp->next;
338 prev_pointer = &nfheaderp->next;
340 os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words),
341 ncode_words * sizeof(int));
342 #ifdef LISP_FEATURE_GENCGC
343 gencgc_apply_code_fixups(code, new_code);
349 scav_code_header(lispobj *where, lispobj object)
352 int n_header_words, n_code_words, n_words;
353 lispobj entry_point; /* tagged pointer to entry point */
354 struct simple_fun *function_ptr; /* untagged pointer to entry point */
356 code = (struct code *) where;
357 n_code_words = fixnum_value(code->code_size);
358 n_header_words = HeaderValue(object);
359 n_words = n_code_words + n_header_words;
360 n_words = CEILING(n_words, 2);
362 /* Scavenge the boxed section of the code data block. */
363 scavenge(where + 1, n_header_words - 1);
365 /* Scavenge the boxed section of each function object in the
366 * code data block. */
367 for (entry_point = code->entry_points;
369 entry_point = function_ptr->next) {
371 gc_assert(is_lisp_pointer(entry_point));
373 function_ptr = (struct simple_fun *) native_pointer(entry_point);
374 gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
376 scavenge(&function_ptr->name, 1);
377 scavenge(&function_ptr->arglist, 1);
378 scavenge(&function_ptr->type, 1);
385 trans_code_header(lispobj object)
389 ncode = trans_code((struct code *) native_pointer(object));
390 return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG;
395 size_code_header(lispobj *where)
398 int nheader_words, ncode_words, nwords;
400 code = (struct code *) where;
402 ncode_words = fixnum_value(code->code_size);
403 nheader_words = HeaderValue(code->header);
404 nwords = ncode_words + nheader_words;
405 nwords = CEILING(nwords, 2);
411 scav_return_pc_header(lispobj *where, lispobj object)
413 lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x",
414 (unsigned long) where,
415 (unsigned long) object);
416 return 0; /* bogus return value to satisfy static type checking */
420 trans_return_pc_header(lispobj object)
422 struct simple_fun *return_pc;
423 unsigned long offset;
424 struct code *code, *ncode;
426 return_pc = (struct simple_fun *) native_pointer(object);
427 offset = HeaderValue(return_pc->header) * 4 ;
429 /* Transport the whole code object */
430 code = (struct code *) ((unsigned long) return_pc - offset);
431 ncode = trans_code(code);
433 return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
436 /* On the 386, closures hold a pointer to the raw address instead of the
437 * function object, so we can use CALL [$FDEFN+const] to invoke
438 * the function without loading it into a register. Given that code
439 * objects don't move, we don't need to update anything, but we do
440 * have to figure out that the function is still live. */
442 #ifdef LISP_FEATURE_X86
444 scav_closure_header(lispobj *where, lispobj object)
446 struct closure *closure;
449 closure = (struct closure *)where;
450 fun = closure->fun - FUN_RAW_ADDR_OFFSET;
452 #ifdef LISP_FEATURE_GENCGC
453 /* The function may have moved so update the raw address. But
454 * don't write unnecessarily. */
455 if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
456 closure->fun = fun + FUN_RAW_ADDR_OFFSET;
463 scav_fun_header(lispobj *where, lispobj object)
465 lose("attempted to scavenge a function header where=0x%08x object=0x%08x",
466 (unsigned long) where,
467 (unsigned long) object);
468 return 0; /* bogus return value to satisfy static type checking */
472 trans_fun_header(lispobj object)
474 struct simple_fun *fheader;
475 unsigned long offset;
476 struct code *code, *ncode;
478 fheader = (struct simple_fun *) native_pointer(object);
479 offset = HeaderValue(fheader->header) * 4;
481 /* Transport the whole code object */
482 code = (struct code *) ((unsigned long) fheader - offset);
483 ncode = trans_code(code);
485 return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
494 scav_instance_pointer(lispobj *where, lispobj object)
496 lispobj copy, *first_pointer;
498 /* Object is a pointer into from space - not a FP. */
499 copy = trans_boxed(object);
501 #ifdef LISP_FEATURE_GENCGC
502 gc_assert(copy != object);
505 first_pointer = (lispobj *) native_pointer(object);
506 set_forwarding_pointer(first_pointer,copy);
517 static lispobj trans_list(lispobj object);
520 scav_list_pointer(lispobj *where, lispobj object)
522 lispobj first, *first_pointer;
524 gc_assert(is_lisp_pointer(object));
526 /* Object is a pointer into from space - not FP. */
527 first_pointer = (lispobj *) native_pointer(object);
529 first = trans_list(object);
530 gc_assert(first != object);
532 /* Set forwarding pointer */
533 set_forwarding_pointer(first_pointer, first);
535 gc_assert(is_lisp_pointer(first));
536 gc_assert(!from_space_p(first));
544 trans_list(lispobj object)
546 lispobj new_list_pointer;
547 struct cons *cons, *new_cons;
550 cons = (struct cons *) native_pointer(object);
553 new_cons = (struct cons *)
554 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
555 new_cons->car = cons->car;
556 new_cons->cdr = cons->cdr; /* updated later */
557 new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
559 /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC */
562 set_forwarding_pointer((lispobj *)cons, new_list_pointer);
564 /* Try to linearize the list in the cdr direction to help reduce
568 struct cons *cdr_cons, *new_cdr_cons;
570 if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
571 !from_space_p(cdr) ||
572 forwarding_pointer_p((lispobj *)native_pointer(cdr)))
575 cdr_cons = (struct cons *) native_pointer(cdr);
578 new_cdr_cons = (struct cons*)
579 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
580 new_cdr_cons->car = cdr_cons->car;
581 new_cdr_cons->cdr = cdr_cons->cdr;
582 new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
584 /* Grab the cdr before it is clobbered. */
586 set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
588 /* Update the cdr of the last cons copied into new space to
589 * keep the newspace scavenge from having to do it. */
590 new_cons->cdr = new_cdr;
592 new_cons = new_cdr_cons;
595 return new_list_pointer;
600 * scavenging and transporting other pointers
604 scav_other_pointer(lispobj *where, lispobj object)
606 lispobj first, *first_pointer;
608 gc_assert(is_lisp_pointer(object));
610 /* Object is a pointer into from space - not FP. */
611 first_pointer = (lispobj *) native_pointer(object);
612 first = (transother[widetag_of(*first_pointer)])(object);
614 if (first != object) {
615 set_forwarding_pointer(first_pointer, first);
616 #ifdef LISP_FEATURE_GENCGC
620 #ifndef LISP_FEATURE_GENCGC
623 gc_assert(is_lisp_pointer(first));
624 gc_assert(!from_space_p(first));
630 * immediate, boxed, and unboxed objects
634 size_pointer(lispobj *where)
640 scav_immediate(lispobj *where, lispobj object)
646 trans_immediate(lispobj object)
648 lose("trying to transport an immediate");
649 return NIL; /* bogus return value to satisfy static type checking */
653 size_immediate(lispobj *where)
660 scav_boxed(lispobj *where, lispobj object)
666 trans_boxed(lispobj object)
669 unsigned long length;
671 gc_assert(is_lisp_pointer(object));
673 header = *((lispobj *) native_pointer(object));
674 length = HeaderValue(header) + 1;
675 length = CEILING(length, 2);
677 return copy_object(object, length);
682 size_boxed(lispobj *where)
685 unsigned long length;
688 length = HeaderValue(header) + 1;
689 length = CEILING(length, 2);
694 /* Note: on the sparc we don't have to do anything special for fdefns, */
695 /* 'cause the raw-addr has a function lowtag. */
696 #ifndef LISP_FEATURE_SPARC
698 scav_fdefn(lispobj *where, lispobj object)
702 fdefn = (struct fdefn *)where;
704 /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
705 fdefn->fun, fdefn->raw_addr)); */
707 if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)
708 == (char *)((unsigned long)(fdefn->raw_addr))) {
709 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
711 /* Don't write unnecessarily. */
712 if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
713 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
714 /* gc.c has more casts here, which may be relevant or alternatively
715 may be compiler warning defeaters. try
717 (u32) ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
719 return sizeof(struct fdefn) / sizeof(lispobj);
727 scav_unboxed(lispobj *where, lispobj object)
729 unsigned long length;
731 length = HeaderValue(object) + 1;
732 length = CEILING(length, 2);
738 trans_unboxed(lispobj object)
741 unsigned long length;
744 gc_assert(is_lisp_pointer(object));
746 header = *((lispobj *) native_pointer(object));
747 length = HeaderValue(header) + 1;
748 length = CEILING(length, 2);
750 return copy_unboxed_object(object, length);
754 size_unboxed(lispobj *where)
757 unsigned long length;
760 length = HeaderValue(header) + 1;
761 length = CEILING(length, 2);
767 /* vector-like objects */
769 #define NWORDS(x,y) (CEILING((x),(y)) / (y))
771 scav_base_string(lispobj *where, lispobj object)
773 struct vector *vector;
776 /* NOTE: Strings contain one more byte of data than the length */
777 /* slot indicates. */
779 vector = (struct vector *) where;
780 length = fixnum_value(vector->length) + 1;
781 nwords = CEILING(NWORDS(length, 4) + 2, 2);
786 trans_base_string(lispobj object)
788 struct vector *vector;
791 gc_assert(is_lisp_pointer(object));
793 /* NOTE: A string contains one more byte of data (a terminating
794 * '\0' to help when interfacing with C functions) than indicated
795 * by the length slot. */
797 vector = (struct vector *) native_pointer(object);
798 length = fixnum_value(vector->length) + 1;
799 nwords = CEILING(NWORDS(length, 4) + 2, 2);
801 return copy_large_unboxed_object(object, nwords);
805 size_base_string(lispobj *where)
807 struct vector *vector;
810 /* NOTE: A string contains one more byte of data (a terminating
811 * '\0' to help when interfacing with C functions) than indicated
812 * by the length slot. */
814 vector = (struct vector *) where;
815 length = fixnum_value(vector->length) + 1;
816 nwords = CEILING(NWORDS(length, 4) + 2, 2);
822 trans_vector(lispobj object)
824 struct vector *vector;
827 gc_assert(is_lisp_pointer(object));
829 vector = (struct vector *) native_pointer(object);
831 length = fixnum_value(vector->length);
832 nwords = CEILING(length + 2, 2);
834 return copy_large_object(object, nwords);
838 size_vector(lispobj *where)
840 struct vector *vector;
843 vector = (struct vector *) where;
844 length = fixnum_value(vector->length);
845 nwords = CEILING(length + 2, 2);
851 scav_vector_nil(lispobj *where, lispobj object)
857 trans_vector_nil(lispobj object)
859 gc_assert(is_lisp_pointer(object));
860 return copy_unboxed_object(object, 2);
864 size_vector_nil(lispobj *where)
866 /* Just the header word and the length word */
871 scav_vector_bit(lispobj *where, lispobj object)
873 struct vector *vector;
876 vector = (struct vector *) where;
877 length = fixnum_value(vector->length);
878 nwords = CEILING(NWORDS(length, 32) + 2, 2);
884 trans_vector_bit(lispobj object)
886 struct vector *vector;
889 gc_assert(is_lisp_pointer(object));
891 vector = (struct vector *) native_pointer(object);
892 length = fixnum_value(vector->length);
893 nwords = CEILING(NWORDS(length, 32) + 2, 2);
895 return copy_large_unboxed_object(object, nwords);
899 size_vector_bit(lispobj *where)
901 struct vector *vector;
904 vector = (struct vector *) where;
905 length = fixnum_value(vector->length);
906 nwords = CEILING(NWORDS(length, 32) + 2, 2);
912 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
914 struct vector *vector;
917 vector = (struct vector *) where;
918 length = fixnum_value(vector->length);
919 nwords = CEILING(NWORDS(length, 16) + 2, 2);
925 trans_vector_unsigned_byte_2(lispobj object)
927 struct vector *vector;
930 gc_assert(is_lisp_pointer(object));
932 vector = (struct vector *) native_pointer(object);
933 length = fixnum_value(vector->length);
934 nwords = CEILING(NWORDS(length, 16) + 2, 2);
936 return copy_large_unboxed_object(object, nwords);
940 size_vector_unsigned_byte_2(lispobj *where)
942 struct vector *vector;
945 vector = (struct vector *) where;
946 length = fixnum_value(vector->length);
947 nwords = CEILING(NWORDS(length, 16) + 2, 2);
953 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
955 struct vector *vector;
958 vector = (struct vector *) where;
959 length = fixnum_value(vector->length);
960 nwords = CEILING(NWORDS(length, 8) + 2, 2);
966 trans_vector_unsigned_byte_4(lispobj object)
968 struct vector *vector;
971 gc_assert(is_lisp_pointer(object));
973 vector = (struct vector *) native_pointer(object);
974 length = fixnum_value(vector->length);
975 nwords = CEILING(NWORDS(length, 8) + 2, 2);
977 return copy_large_unboxed_object(object, nwords);
980 size_vector_unsigned_byte_4(lispobj *where)
982 struct vector *vector;
985 vector = (struct vector *) where;
986 length = fixnum_value(vector->length);
987 nwords = CEILING(NWORDS(length, 8) + 2, 2);
994 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
996 struct vector *vector;
999 vector = (struct vector *) where;
1000 length = fixnum_value(vector->length);
1001 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1006 /*********************/
1011 trans_vector_unsigned_byte_8(lispobj object)
1013 struct vector *vector;
1016 gc_assert(is_lisp_pointer(object));
1018 vector = (struct vector *) native_pointer(object);
1019 length = fixnum_value(vector->length);
1020 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1022 return copy_large_unboxed_object(object, nwords);
1026 size_vector_unsigned_byte_8(lispobj *where)
1028 struct vector *vector;
1031 vector = (struct vector *) where;
1032 length = fixnum_value(vector->length);
1033 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1040 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1042 struct vector *vector;
1045 vector = (struct vector *) where;
1046 length = fixnum_value(vector->length);
1047 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1053 trans_vector_unsigned_byte_16(lispobj object)
1055 struct vector *vector;
1058 gc_assert(is_lisp_pointer(object));
1060 vector = (struct vector *) native_pointer(object);
1061 length = fixnum_value(vector->length);
1062 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1064 return copy_large_unboxed_object(object, nwords);
1068 size_vector_unsigned_byte_16(lispobj *where)
1070 struct vector *vector;
1073 vector = (struct vector *) where;
1074 length = fixnum_value(vector->length);
1075 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1081 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1083 struct vector *vector;
1086 vector = (struct vector *) where;
1087 length = fixnum_value(vector->length);
1088 nwords = CEILING(length + 2, 2);
1094 trans_vector_unsigned_byte_32(lispobj object)
1096 struct vector *vector;
1099 gc_assert(is_lisp_pointer(object));
1101 vector = (struct vector *) native_pointer(object);
1102 length = fixnum_value(vector->length);
1103 nwords = CEILING(length + 2, 2);
1105 return copy_large_unboxed_object(object, nwords);
1109 size_vector_unsigned_byte_32(lispobj *where)
1111 struct vector *vector;
1114 vector = (struct vector *) where;
1115 length = fixnum_value(vector->length);
1116 nwords = CEILING(length + 2, 2);
1122 scav_vector_single_float(lispobj *where, lispobj object)
1124 struct vector *vector;
1127 vector = (struct vector *) where;
1128 length = fixnum_value(vector->length);
1129 nwords = CEILING(length + 2, 2);
1135 trans_vector_single_float(lispobj object)
1137 struct vector *vector;
1140 gc_assert(is_lisp_pointer(object));
1142 vector = (struct vector *) native_pointer(object);
1143 length = fixnum_value(vector->length);
1144 nwords = CEILING(length + 2, 2);
1146 return copy_large_unboxed_object(object, nwords);
1150 size_vector_single_float(lispobj *where)
1152 struct vector *vector;
1155 vector = (struct vector *) where;
1156 length = fixnum_value(vector->length);
1157 nwords = CEILING(length + 2, 2);
1163 scav_vector_double_float(lispobj *where, lispobj object)
1165 struct vector *vector;
1168 vector = (struct vector *) where;
1169 length = fixnum_value(vector->length);
1170 nwords = CEILING(length * 2 + 2, 2);
1176 trans_vector_double_float(lispobj object)
1178 struct vector *vector;
1181 gc_assert(is_lisp_pointer(object));
1183 vector = (struct vector *) native_pointer(object);
1184 length = fixnum_value(vector->length);
1185 nwords = CEILING(length * 2 + 2, 2);
1187 return copy_large_unboxed_object(object, nwords);
1191 size_vector_double_float(lispobj *where)
1193 struct vector *vector;
1196 vector = (struct vector *) where;
1197 length = fixnum_value(vector->length);
1198 nwords = CEILING(length * 2 + 2, 2);
1203 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1205 scav_vector_long_float(lispobj *where, lispobj object)
1207 struct vector *vector;
1210 vector = (struct vector *) where;
1211 length = fixnum_value(vector->length);
1212 nwords = CEILING(length *
1219 trans_vector_long_float(lispobj object)
1221 struct vector *vector;
1224 gc_assert(is_lisp_pointer(object));
1226 vector = (struct vector *) native_pointer(object);
1227 length = fixnum_value(vector->length);
1228 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1230 return copy_large_unboxed_object(object, nwords);
1234 size_vector_long_float(lispobj *where)
1236 struct vector *vector;
1239 vector = (struct vector *) where;
1240 length = fixnum_value(vector->length);
1241 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1248 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1250 scav_vector_complex_single_float(lispobj *where, lispobj object)
1252 struct vector *vector;
1255 vector = (struct vector *) where;
1256 length = fixnum_value(vector->length);
1257 nwords = CEILING(length * 2 + 2, 2);
1263 trans_vector_complex_single_float(lispobj object)
1265 struct vector *vector;
1268 gc_assert(is_lisp_pointer(object));
1270 vector = (struct vector *) native_pointer(object);
1271 length = fixnum_value(vector->length);
1272 nwords = CEILING(length * 2 + 2, 2);
1274 return copy_large_unboxed_object(object, nwords);
1278 size_vector_complex_single_float(lispobj *where)
1280 struct vector *vector;
1283 vector = (struct vector *) where;
1284 length = fixnum_value(vector->length);
1285 nwords = CEILING(length * 2 + 2, 2);
1291 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1293 scav_vector_complex_double_float(lispobj *where, lispobj object)
1295 struct vector *vector;
1298 vector = (struct vector *) where;
1299 length = fixnum_value(vector->length);
1300 nwords = CEILING(length * 4 + 2, 2);
1306 trans_vector_complex_double_float(lispobj object)
1308 struct vector *vector;
1311 gc_assert(is_lisp_pointer(object));
1313 vector = (struct vector *) native_pointer(object);
1314 length = fixnum_value(vector->length);
1315 nwords = CEILING(length * 4 + 2, 2);
1317 return copy_large_unboxed_object(object, nwords);
1321 size_vector_complex_double_float(lispobj *where)
1323 struct vector *vector;
1326 vector = (struct vector *) where;
1327 length = fixnum_value(vector->length);
1328 nwords = CEILING(length * 4 + 2, 2);
1335 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1337 scav_vector_complex_long_float(lispobj *where, lispobj object)
1339 struct vector *vector;
1342 vector = (struct vector *) where;
1343 length = fixnum_value(vector->length);
1344 nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1350 trans_vector_complex_long_float(lispobj object)
1352 struct vector *vector;
1355 gc_assert(is_lisp_pointer(object));
1357 vector = (struct vector *) native_pointer(object);
1358 length = fixnum_value(vector->length);
1359 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1361 return copy_large_unboxed_object(object, nwords);
1365 size_vector_complex_long_float(lispobj *where)
1367 struct vector *vector;
1370 vector = (struct vector *) where;
1371 length = fixnum_value(vector->length);
1372 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1378 #define WEAK_POINTER_NWORDS \
1379 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1382 trans_weak_pointer(lispobj object)
1385 #ifndef LISP_FEATURE_GENCGC
1386 struct weak_pointer *wp;
1388 gc_assert(is_lisp_pointer(object));
1390 #if defined(DEBUG_WEAK)
1391 printf("Transporting weak pointer from 0x%08x\n", object);
1394 /* Need to remember where all the weak pointers are that have */
1395 /* been transported so they can be fixed up in a post-GC pass. */
1397 copy = copy_object(object, WEAK_POINTER_NWORDS);
1398 #ifndef LISP_FEATURE_GENCGC
1399 wp = (struct weak_pointer *) native_pointer(copy);
1401 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1402 /* Push the weak pointer onto the list of weak pointers. */
1403 wp->next = LOW_WORD(weak_pointers);
1410 size_weak_pointer(lispobj *where)
1412 return WEAK_POINTER_NWORDS;
1416 void scan_weak_pointers(void)
1418 struct weak_pointer *wp;
1419 for (wp = weak_pointers; wp != NULL;
1420 wp=(struct weak_pointer *)native_pointer(wp->next)) {
1421 lispobj value = wp->value;
1422 lispobj *first_pointer;
1423 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1424 if (!(is_lisp_pointer(value) && from_space_p(value)))
1427 /* Now, we need to check whether the object has been forwarded. If
1428 * it has been, the weak pointer is still good and needs to be
1429 * updated. Otherwise, the weak pointer needs to be nil'ed
1432 first_pointer = (lispobj *)native_pointer(value);
1434 if (forwarding_pointer_p(first_pointer)) {
1436 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1452 scav_lose(lispobj *where, lispobj object)
1454 lose("no scavenge function for object 0x%08x (widetag 0x%x)",
1455 (unsigned long)object,
1456 widetag_of(*(lispobj*)native_pointer(object)));
1457 return 0; /* bogus return value to satisfy static type checking */
1461 trans_lose(lispobj object)
1463 lose("no transport function for object 0x%08x (widetag 0x%x)",
1464 (unsigned long)object,
1465 widetag_of(*(lispobj*)native_pointer(object)));
1466 return NIL; /* bogus return value to satisfy static type checking */
1470 size_lose(lispobj *where)
1472 lose("no size function for object at 0x%08x (widetag 0x%x)",
1473 (unsigned long)where,
1474 widetag_of(LOW_WORD(where)));
1475 return 1; /* bogus return value to satisfy static type checking */
1484 gc_init_tables(void)
1488 /* Set default value in all slots of scavenge table. FIXME
1489 * replace this gnarly sizeof with something based on
1491 for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) {
1492 scavtab[i] = scav_lose;
1495 /* For each type which can be selected by the lowtag alone, set
1496 * multiple entries in our widetag scavenge table (one for each
1497 * possible value of the high bits).
1500 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1501 scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1502 scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1503 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1504 scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1505 scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1506 scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_instance_pointer;
1507 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1508 scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1511 /* Other-pointer types (those selected by all eight bits of the
1512 * tag) get one entry each in the scavenge table. */
1513 scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1514 scavtab[RATIO_WIDETAG] = scav_boxed;
1515 scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1516 scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1517 #ifdef LONG_FLOAT_WIDETAG
1518 scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1520 scavtab[COMPLEX_WIDETAG] = scav_boxed;
1521 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1522 scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1524 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1525 scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1527 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1528 scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
1530 scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
1531 scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
1532 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
1533 scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
1534 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1535 scav_vector_unsigned_byte_2;
1536 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1537 scav_vector_unsigned_byte_4;
1538 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1539 scav_vector_unsigned_byte_8;
1540 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1541 scav_vector_unsigned_byte_8;
1542 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1543 scav_vector_unsigned_byte_16;
1544 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1545 scav_vector_unsigned_byte_16;
1546 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1547 scav_vector_unsigned_byte_32;
1548 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1549 scav_vector_unsigned_byte_32;
1550 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1551 scav_vector_unsigned_byte_32;
1552 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1553 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
1555 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1556 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1557 scav_vector_unsigned_byte_16;
1559 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1560 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1561 scav_vector_unsigned_byte_32;
1563 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1564 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1565 scav_vector_unsigned_byte_32;
1567 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
1568 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
1569 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1570 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
1572 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1573 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1574 scav_vector_complex_single_float;
1576 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1577 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1578 scav_vector_complex_double_float;
1580 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1581 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1582 scav_vector_complex_long_float;
1584 scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
1585 scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
1586 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
1587 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
1588 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
1589 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
1590 #ifndef LISP_FEATURE_GENCGC /* FIXME ..._X86 ? */
1591 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
1592 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
1594 #ifdef LISP_FEATURE_X86
1595 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
1596 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
1598 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
1599 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
1601 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
1602 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
1603 scavtab[BASE_CHAR_WIDETAG] = scav_immediate;
1604 scavtab[SAP_WIDETAG] = scav_unboxed;
1605 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
1606 scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed;
1607 #ifdef LISP_FEATURE_SPARC
1608 scavtab[FDEFN_WIDETAG] = scav_boxed;
1610 scavtab[FDEFN_WIDETAG] = scav_fdefn;
1613 /* transport other table, initialized same way as scavtab */
1614 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
1615 transother[i] = trans_lose;
1616 transother[BIGNUM_WIDETAG] = trans_unboxed;
1617 transother[RATIO_WIDETAG] = trans_boxed;
1618 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1619 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1620 #ifdef LONG_FLOAT_WIDETAG
1621 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
1623 transother[COMPLEX_WIDETAG] = trans_boxed;
1624 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1625 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1627 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1628 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1630 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1631 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
1633 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
1634 transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
1635 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
1636 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
1637 transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
1638 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1639 trans_vector_unsigned_byte_2;
1640 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1641 trans_vector_unsigned_byte_4;
1642 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1643 trans_vector_unsigned_byte_8;
1644 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1645 trans_vector_unsigned_byte_8;
1646 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1647 trans_vector_unsigned_byte_16;
1648 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1649 trans_vector_unsigned_byte_16;
1650 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1651 trans_vector_unsigned_byte_32;
1652 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1653 trans_vector_unsigned_byte_32;
1654 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1655 trans_vector_unsigned_byte_32;
1656 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1657 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
1658 trans_vector_unsigned_byte_8;
1660 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1661 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1662 trans_vector_unsigned_byte_16;
1664 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1665 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1666 trans_vector_unsigned_byte_32;
1668 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1669 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1670 trans_vector_unsigned_byte_32;
1672 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
1673 trans_vector_single_float;
1674 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
1675 trans_vector_double_float;
1676 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1677 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
1678 trans_vector_long_float;
1680 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1681 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1682 trans_vector_complex_single_float;
1684 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1685 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1686 trans_vector_complex_double_float;
1688 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1689 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1690 trans_vector_complex_long_float;
1692 transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
1693 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
1694 transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
1695 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
1696 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
1697 transother[CODE_HEADER_WIDETAG] = trans_code_header;
1698 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
1699 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
1700 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
1701 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
1702 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
1703 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
1704 transother[BASE_CHAR_WIDETAG] = trans_immediate;
1705 transother[SAP_WIDETAG] = trans_unboxed;
1706 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
1707 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
1708 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
1709 transother[FDEFN_WIDETAG] = trans_boxed;
1711 /* size table, initialized the same way as scavtab */
1712 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
1713 sizetab[i] = size_lose;
1714 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1715 sizetab[EVEN_FIXNUM_LOWTAG|(i<<3)] = size_immediate;
1716 sizetab[FUN_POINTER_LOWTAG|(i<<3)] = size_pointer;
1717 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1718 sizetab[LIST_POINTER_LOWTAG|(i<<3)] = size_pointer;
1719 sizetab[ODD_FIXNUM_LOWTAG|(i<<3)] = size_immediate;
1720 sizetab[INSTANCE_POINTER_LOWTAG|(i<<3)] = size_pointer;
1721 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1722 sizetab[OTHER_POINTER_LOWTAG|(i<<3)] = size_pointer;
1724 sizetab[BIGNUM_WIDETAG] = size_unboxed;
1725 sizetab[RATIO_WIDETAG] = size_boxed;
1726 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
1727 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1728 #ifdef LONG_FLOAT_WIDETAG
1729 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
1731 sizetab[COMPLEX_WIDETAG] = size_boxed;
1732 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1733 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
1735 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1736 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1738 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1739 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
1741 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
1742 sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
1743 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
1744 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
1745 sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
1746 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1747 size_vector_unsigned_byte_2;
1748 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1749 size_vector_unsigned_byte_4;
1750 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1751 size_vector_unsigned_byte_8;
1752 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1753 size_vector_unsigned_byte_8;
1754 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1755 size_vector_unsigned_byte_16;
1756 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1757 size_vector_unsigned_byte_16;
1758 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1759 size_vector_unsigned_byte_32;
1760 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1761 size_vector_unsigned_byte_32;
1762 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1763 size_vector_unsigned_byte_32;
1764 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1765 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
1767 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1768 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1769 size_vector_unsigned_byte_16;
1771 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1772 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1773 size_vector_unsigned_byte_32;
1775 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1776 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1777 size_vector_unsigned_byte_32;
1779 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
1780 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
1781 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1782 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
1784 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1785 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1786 size_vector_complex_single_float;
1788 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1789 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1790 size_vector_complex_double_float;
1792 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1793 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1794 size_vector_complex_long_float;
1796 sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
1797 sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
1798 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
1799 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
1800 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
1801 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
1803 /* We shouldn't see these, so just lose if it happens. */
1804 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
1805 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
1807 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
1808 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
1809 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
1810 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
1811 sizetab[BASE_CHAR_WIDETAG] = size_immediate;
1812 sizetab[SAP_WIDETAG] = size_unboxed;
1813 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
1814 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
1815 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
1816 sizetab[FDEFN_WIDETAG] = size_boxed;