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 "primitive-objects.h"
56 #include "gc-internal.h"
58 #ifdef LISP_FEATURE_SPARC
59 #define LONG_FLOAT_SIZE 4
61 #ifdef LISP_FEATURE_X86
62 #define LONG_FLOAT_SIZE 3
67 forwarding_pointer_p(lispobj *pointer) {
68 lispobj first_word=*pointer;
69 #ifdef LISP_FEATURE_GENCGC
70 return (first_word == 0x01);
72 return (is_lisp_pointer(first_word)
73 && new_space_p(first_word));
77 static inline lispobj *
78 forwarding_pointer_value(lispobj *pointer) {
79 #ifdef LISP_FEATURE_GENCGC
80 return (lispobj *) ((pointer_sized_uint_t) pointer[1]);
82 return (lispobj *) ((pointer_sized_uint_t) pointer[0]);
86 set_forwarding_pointer(lispobj * pointer, lispobj newspace_copy) {
87 #ifdef LISP_FEATURE_GENCGC
89 pointer[1]=newspace_copy;
91 pointer[0]=newspace_copy;
96 int (*scavtab[256])(lispobj *where, lispobj object);
97 lispobj (*transother[256])(lispobj object);
98 int (*sizetab[256])(lispobj *where);
99 struct weak_pointer *weak_pointers;
105 /* to copy a boxed object */
107 copy_object(lispobj object, int nwords)
111 lispobj *source, *dest;
113 gc_assert(is_lisp_pointer(object));
114 gc_assert(from_space_p(object));
115 gc_assert((nwords & 0x01) == 0);
117 /* Get tag of object. */
118 tag = lowtag_of(object);
120 /* Allocate space. */
121 new = gc_general_alloc(nwords*4,ALLOC_BOXED,ALLOC_QUICK);
124 source = (lispobj *) native_pointer(object);
126 /* Copy the object. */
135 return make_lispobj(new,tag);
138 static int scav_lose(lispobj *where, lispobj object); /* forward decl */
140 /* FIXME: Most calls end up going to some trouble to compute an
141 * 'n_words' value for this function. The system might be a little
142 * simpler if this function used an 'end' parameter instead. */
145 scavenge(lispobj *start, long n_words)
147 lispobj *end = start + n_words;
149 int n_words_scavenged;
151 for (object_ptr = start;
153 object_ptr += n_words_scavenged) {
155 lispobj object = *object_ptr;
156 #ifdef LISP_FEATURE_GENCGC
157 gc_assert(!forwarding_pointer_p(object_ptr));
159 if (is_lisp_pointer(object)) {
160 if (from_space_p(object)) {
161 /* It currently points to old space. Check for a
162 * forwarding pointer. */
163 lispobj *ptr = native_pointer(object);
164 if (forwarding_pointer_p(ptr)) {
165 /* Yes, there's a forwarding pointer. */
166 *object_ptr = LOW_WORD(forwarding_pointer_value(ptr));
167 n_words_scavenged = 1;
169 /* Scavenge that pointer. */
171 (scavtab[widetag_of(object)])(object_ptr, object);
174 /* It points somewhere other than oldspace. Leave it
176 n_words_scavenged = 1;
179 #ifndef LISP_FEATURE_GENCGC
180 /* this workaround is probably not necessary for gencgc; at least, the
181 * behaviour it describes has never been reported */
182 else if (n_words==1) {
183 /* there are some situations where an
184 other-immediate may end up in a descriptor
185 register. I'm not sure whether this is
186 supposed to happen, but if it does then we
187 don't want to (a) barf or (b) scavenge over the
188 data-block, because there isn't one. So, if
189 we're checking a single word and it's anything
190 other than a pointer, just hush it up */
191 int type=widetag_of(object);
194 if ((scavtab[type]==scav_lose) ||
195 (((scavtab[type])(start,object))>1)) {
196 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",
201 else if ((object & 3) == 0) {
202 /* It's a fixnum: really easy.. */
203 n_words_scavenged = 1;
205 /* It's some sort of header object or another. */
207 (scavtab[widetag_of(object)])(object_ptr, object);
210 gc_assert(object_ptr == end);
213 static lispobj trans_fun_header(lispobj object); /* forward decls */
214 static lispobj trans_boxed(lispobj object);
217 scav_fun_pointer(lispobj *where, lispobj object)
219 lispobj *first_pointer;
222 gc_assert(is_lisp_pointer(object));
224 /* Object is a pointer into from_space - not a FP. */
225 first_pointer = (lispobj *) native_pointer(object);
227 /* must transport object -- object may point to either a function
228 * header, a closure function header, or to a closure header. */
230 switch (widetag_of(*first_pointer)) {
231 case SIMPLE_FUN_HEADER_WIDETAG:
232 case CLOSURE_FUN_HEADER_WIDETAG:
233 copy = trans_fun_header(object);
236 copy = trans_boxed(object);
240 if (copy != object) {
241 /* Set forwarding pointer */
242 set_forwarding_pointer(first_pointer,copy);
245 gc_assert(is_lisp_pointer(copy));
246 gc_assert(!from_space_p(copy));
255 trans_code(struct code *code)
257 struct code *new_code;
258 lispobj first, l_code, l_new_code;
259 int nheader_words, ncode_words, nwords;
260 unsigned long displacement;
261 lispobj fheaderl, *prev_pointer;
263 /* if object has already been transported, just return pointer */
264 first = code->header;
265 if (forwarding_pointer_p((lispobj *)code)) {
267 printf("Was already transported\n");
269 return (struct code *) forwarding_pointer_value
270 ((lispobj *)((pointer_sized_uint_t) code));
273 gc_assert(widetag_of(first) == CODE_HEADER_WIDETAG);
275 /* prepare to transport the code vector */
276 l_code = (lispobj) LOW_WORD(code) | OTHER_POINTER_LOWTAG;
278 ncode_words = fixnum_value(code->code_size);
279 nheader_words = HeaderValue(code->header);
280 nwords = ncode_words + nheader_words;
281 nwords = CEILING(nwords, 2);
283 l_new_code = copy_object(l_code, nwords);
284 new_code = (struct code *) native_pointer(l_new_code);
286 #if defined(DEBUG_CODE_GC)
287 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
288 (unsigned long) code, (unsigned long) new_code);
289 printf("Code object is %d words long.\n", nwords);
292 #ifdef LISP_FEATURE_GENCGC
293 if (new_code == code)
297 displacement = l_new_code - l_code;
299 set_forwarding_pointer((lispobj *)code, l_new_code);
301 /* set forwarding pointers for all the function headers in the */
302 /* code object. also fix all self pointers */
304 fheaderl = code->entry_points;
305 prev_pointer = &new_code->entry_points;
307 while (fheaderl != NIL) {
308 struct simple_fun *fheaderp, *nfheaderp;
311 fheaderp = (struct simple_fun *) native_pointer(fheaderl);
312 gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
314 /* Calculate the new function pointer and the new */
315 /* function header. */
316 nfheaderl = fheaderl + displacement;
317 nfheaderp = (struct simple_fun *) native_pointer(nfheaderl);
320 printf("fheaderp->header (at %x) <- %x\n",
321 &(fheaderp->header) , nfheaderl);
323 set_forwarding_pointer((lispobj *)fheaderp, nfheaderl);
325 /* fix self pointer. */
327 #ifdef LISP_FEATURE_GENCGC /* GENCGC? Maybe x86 is better conditional */
328 FUN_RAW_ADDR_OFFSET +
332 *prev_pointer = nfheaderl;
334 fheaderl = fheaderp->next;
335 prev_pointer = &nfheaderp->next;
337 os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words),
338 ncode_words * sizeof(int));
339 #ifdef LISP_FEATURE_GENCGC
340 gencgc_apply_code_fixups(code, new_code);
346 scav_code_header(lispobj *where, lispobj object)
349 int n_header_words, n_code_words, n_words;
350 lispobj entry_point; /* tagged pointer to entry point */
351 struct simple_fun *function_ptr; /* untagged pointer to entry point */
353 code = (struct code *) where;
354 n_code_words = fixnum_value(code->code_size);
355 n_header_words = HeaderValue(object);
356 n_words = n_code_words + n_header_words;
357 n_words = CEILING(n_words, 2);
359 /* Scavenge the boxed section of the code data block. */
360 scavenge(where + 1, n_header_words - 1);
362 /* Scavenge the boxed section of each function object in the
363 * code data block. */
364 for (entry_point = code->entry_points;
366 entry_point = function_ptr->next) {
368 gc_assert(is_lisp_pointer(entry_point));
370 function_ptr = (struct simple_fun *) native_pointer(entry_point);
371 gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
373 scavenge(&function_ptr->name, 1);
374 scavenge(&function_ptr->arglist, 1);
375 scavenge(&function_ptr->type, 1);
382 trans_code_header(lispobj object)
386 ncode = trans_code((struct code *) native_pointer(object));
387 return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG;
392 size_code_header(lispobj *where)
395 int nheader_words, ncode_words, nwords;
397 code = (struct code *) where;
399 ncode_words = fixnum_value(code->code_size);
400 nheader_words = HeaderValue(code->header);
401 nwords = ncode_words + nheader_words;
402 nwords = CEILING(nwords, 2);
408 scav_return_pc_header(lispobj *where, lispobj object)
410 lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x",
411 (unsigned long) where,
412 (unsigned long) object);
413 return 0; /* bogus return value to satisfy static type checking */
417 trans_return_pc_header(lispobj object)
419 struct simple_fun *return_pc;
420 unsigned long offset;
421 struct code *code, *ncode;
423 return_pc = (struct simple_fun *) native_pointer(object);
424 offset = HeaderValue(return_pc->header) * 4 ;
426 /* Transport the whole code object */
427 code = (struct code *) ((unsigned long) return_pc - offset);
428 ncode = trans_code(code);
430 return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
433 /* On the 386, closures hold a pointer to the raw address instead of the
434 * function object, so we can use CALL [$FDEFN+const] to invoke
435 * the function without loading it into a register. Given that code
436 * objects don't move, we don't need to update anything, but we do
437 * have to figure out that the function is still live. */
439 #ifdef LISP_FEATURE_X86
441 scav_closure_header(lispobj *where, lispobj object)
443 struct closure *closure;
446 closure = (struct closure *)where;
447 fun = closure->fun - FUN_RAW_ADDR_OFFSET;
449 #ifdef LISP_FEATURE_GENCGC
450 /* The function may have moved so update the raw address. But
451 * don't write unnecessarily. */
452 if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
453 closure->fun = fun + FUN_RAW_ADDR_OFFSET;
460 scav_fun_header(lispobj *where, lispobj object)
462 lose("attempted to scavenge a function header where=0x%08x object=0x%08x",
463 (unsigned long) where,
464 (unsigned long) object);
465 return 0; /* bogus return value to satisfy static type checking */
469 trans_fun_header(lispobj object)
471 struct simple_fun *fheader;
472 unsigned long offset;
473 struct code *code, *ncode;
475 fheader = (struct simple_fun *) native_pointer(object);
476 offset = HeaderValue(fheader->header) * 4;
478 /* Transport the whole code object */
479 code = (struct code *) ((unsigned long) fheader - offset);
480 ncode = trans_code(code);
482 return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
491 scav_instance_pointer(lispobj *where, lispobj object)
493 lispobj copy, *first_pointer;
495 /* Object is a pointer into from space - not a FP. */
496 copy = trans_boxed(object);
498 #ifdef LISP_FEATURE_GENCGC
499 gc_assert(copy != object);
502 first_pointer = (lispobj *) native_pointer(object);
503 set_forwarding_pointer(first_pointer,copy);
514 static lispobj trans_list(lispobj object);
517 scav_list_pointer(lispobj *where, lispobj object)
519 lispobj first, *first_pointer;
521 gc_assert(is_lisp_pointer(object));
523 /* Object is a pointer into from space - not FP. */
524 first_pointer = (lispobj *) native_pointer(object);
526 first = trans_list(object);
527 gc_assert(first != object);
529 /* Set forwarding pointer */
530 set_forwarding_pointer(first_pointer, first);
532 gc_assert(is_lisp_pointer(first));
533 gc_assert(!from_space_p(first));
541 trans_list(lispobj object)
543 lispobj new_list_pointer;
544 struct cons *cons, *new_cons;
547 cons = (struct cons *) native_pointer(object);
550 new_cons = (struct cons *)
551 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
552 new_cons->car = cons->car;
553 new_cons->cdr = cons->cdr; /* updated later */
554 new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
556 /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC */
559 set_forwarding_pointer((lispobj *)cons, new_list_pointer);
561 /* Try to linearize the list in the cdr direction to help reduce
565 struct cons *cdr_cons, *new_cdr_cons;
567 if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
568 !from_space_p(cdr) ||
569 forwarding_pointer_p((lispobj *)native_pointer(cdr)))
572 cdr_cons = (struct cons *) native_pointer(cdr);
575 new_cdr_cons = (struct cons*)
576 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
577 new_cdr_cons->car = cdr_cons->car;
578 new_cdr_cons->cdr = cdr_cons->cdr;
579 new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
581 /* Grab the cdr before it is clobbered. */
583 set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
585 /* Update the cdr of the last cons copied into new space to
586 * keep the newspace scavenge from having to do it. */
587 new_cons->cdr = new_cdr;
589 new_cons = new_cdr_cons;
592 return new_list_pointer;
597 * scavenging and transporting other pointers
601 scav_other_pointer(lispobj *where, lispobj object)
603 lispobj first, *first_pointer;
605 gc_assert(is_lisp_pointer(object));
607 /* Object is a pointer into from space - not FP. */
608 first_pointer = (lispobj *) native_pointer(object);
609 first = (transother[widetag_of(*first_pointer)])(object);
611 if (first != object) {
612 set_forwarding_pointer(first_pointer, first);
613 #ifdef LISP_FEATURE_GENCGC
617 #ifndef LISP_FEATURE_GENCGC
620 gc_assert(is_lisp_pointer(first));
621 gc_assert(!from_space_p(first));
627 * immediate, boxed, and unboxed objects
631 size_pointer(lispobj *where)
637 scav_immediate(lispobj *where, lispobj object)
643 trans_immediate(lispobj object)
645 lose("trying to transport an immediate");
646 return NIL; /* bogus return value to satisfy static type checking */
650 size_immediate(lispobj *where)
657 scav_boxed(lispobj *where, lispobj object)
663 trans_boxed(lispobj object)
666 unsigned long length;
668 gc_assert(is_lisp_pointer(object));
670 header = *((lispobj *) native_pointer(object));
671 length = HeaderValue(header) + 1;
672 length = CEILING(length, 2);
674 return copy_object(object, length);
679 size_boxed(lispobj *where)
682 unsigned long length;
685 length = HeaderValue(header) + 1;
686 length = CEILING(length, 2);
691 /* Note: on the sparc we don't have to do anything special for fdefns, */
692 /* 'cause the raw-addr has a function lowtag. */
693 #ifndef LISP_FEATURE_SPARC
695 scav_fdefn(lispobj *where, lispobj object)
699 fdefn = (struct fdefn *)where;
701 /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
702 fdefn->fun, fdefn->raw_addr)); */
704 if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)
705 == (char *)((unsigned long)(fdefn->raw_addr))) {
706 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
708 /* Don't write unnecessarily. */
709 if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
710 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
711 /* gc.c has more casts here, which may be relevant or alternatively
712 may be compiler warning defeaters. try
714 (u32) ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
716 return sizeof(struct fdefn) / sizeof(lispobj);
724 scav_unboxed(lispobj *where, lispobj object)
726 unsigned long length;
728 length = HeaderValue(object) + 1;
729 length = CEILING(length, 2);
735 trans_unboxed(lispobj object)
738 unsigned long length;
741 gc_assert(is_lisp_pointer(object));
743 header = *((lispobj *) native_pointer(object));
744 length = HeaderValue(header) + 1;
745 length = CEILING(length, 2);
747 return copy_unboxed_object(object, length);
751 size_unboxed(lispobj *where)
754 unsigned long length;
757 length = HeaderValue(header) + 1;
758 length = CEILING(length, 2);
764 /* vector-like objects */
766 #define NWORDS(x,y) (CEILING((x),(y)) / (y))
768 scav_string(lispobj *where, lispobj object)
770 struct vector *vector;
773 /* NOTE: Strings contain one more byte of data than the length */
774 /* slot indicates. */
776 vector = (struct vector *) where;
777 length = fixnum_value(vector->length) + 1;
778 nwords = CEILING(NWORDS(length, 4) + 2, 2);
783 trans_string(lispobj object)
785 struct vector *vector;
788 gc_assert(is_lisp_pointer(object));
790 /* NOTE: A string contains one more byte of data (a terminating
791 * '\0' to help when interfacing with C functions) than indicated
792 * by the length slot. */
794 vector = (struct vector *) native_pointer(object);
795 length = fixnum_value(vector->length) + 1;
796 nwords = CEILING(NWORDS(length, 4) + 2, 2);
798 return copy_large_unboxed_object(object, nwords);
802 size_string(lispobj *where)
804 struct vector *vector;
807 /* NOTE: A string contains one more byte of data (a terminating
808 * '\0' to help when interfacing with C functions) than indicated
809 * by the length slot. */
811 vector = (struct vector *) where;
812 length = fixnum_value(vector->length) + 1;
813 nwords = CEILING(NWORDS(length, 4) + 2, 2);
819 trans_vector(lispobj object)
821 struct vector *vector;
824 gc_assert(is_lisp_pointer(object));
826 vector = (struct vector *) native_pointer(object);
828 length = fixnum_value(vector->length);
829 nwords = CEILING(length + 2, 2);
831 return copy_large_object(object, nwords);
835 size_vector(lispobj *where)
837 struct vector *vector;
840 vector = (struct vector *) where;
841 length = fixnum_value(vector->length);
842 nwords = CEILING(length + 2, 2);
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_STRING_WIDETAG] = scav_string;
1509 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
1510 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1511 scav_vector_unsigned_byte_2;
1512 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1513 scav_vector_unsigned_byte_4;
1514 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1515 scav_vector_unsigned_byte_8;
1516 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1517 scav_vector_unsigned_byte_16;
1518 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1519 scav_vector_unsigned_byte_32;
1520 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1521 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
1523 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1524 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1525 scav_vector_unsigned_byte_16;
1527 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1528 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1529 scav_vector_unsigned_byte_32;
1531 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1532 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1533 scav_vector_unsigned_byte_32;
1535 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
1536 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
1537 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1538 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
1540 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1541 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1542 scav_vector_complex_single_float;
1544 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1545 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1546 scav_vector_complex_double_float;
1548 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1549 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1550 scav_vector_complex_long_float;
1552 scavtab[COMPLEX_STRING_WIDETAG] = scav_boxed;
1553 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
1554 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
1555 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
1556 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
1557 #ifndef LISP_FEATURE_GENCGC /* FIXME ..._X86 ? */
1558 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
1559 scavtab[CLOSURE_FUN_HEADER_WIDETAG] = scav_fun_header;
1560 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
1562 #ifdef LISP_FEATURE_X86
1563 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
1564 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
1566 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
1567 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
1569 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
1570 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
1571 scavtab[BASE_CHAR_WIDETAG] = scav_immediate;
1572 scavtab[SAP_WIDETAG] = scav_unboxed;
1573 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
1574 scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed;
1575 #ifdef LISP_FEATURE_SPARC
1576 scavtab[FDEFN_WIDETAG] = scav_boxed;
1578 scavtab[FDEFN_WIDETAG] = scav_fdefn;
1581 /* transport other table, initialized same way as scavtab */
1582 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
1583 transother[i] = trans_lose;
1584 transother[BIGNUM_WIDETAG] = trans_unboxed;
1585 transother[RATIO_WIDETAG] = trans_boxed;
1586 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1587 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1588 #ifdef LONG_FLOAT_WIDETAG
1589 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
1591 transother[COMPLEX_WIDETAG] = trans_boxed;
1592 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1593 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1595 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1596 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1598 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1599 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
1601 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
1602 transother[SIMPLE_STRING_WIDETAG] = trans_string;
1603 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
1604 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
1605 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1606 trans_vector_unsigned_byte_2;
1607 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1608 trans_vector_unsigned_byte_4;
1609 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1610 trans_vector_unsigned_byte_8;
1611 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1612 trans_vector_unsigned_byte_16;
1613 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1614 trans_vector_unsigned_byte_32;
1615 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1616 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
1617 trans_vector_unsigned_byte_8;
1619 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1620 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1621 trans_vector_unsigned_byte_16;
1623 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1624 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1625 trans_vector_unsigned_byte_32;
1627 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1628 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1629 trans_vector_unsigned_byte_32;
1631 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
1632 trans_vector_single_float;
1633 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
1634 trans_vector_double_float;
1635 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1636 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
1637 trans_vector_long_float;
1639 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1640 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1641 trans_vector_complex_single_float;
1643 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1644 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1645 trans_vector_complex_double_float;
1647 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1648 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1649 trans_vector_complex_long_float;
1651 transother[COMPLEX_STRING_WIDETAG] = trans_boxed;
1652 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
1653 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
1654 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
1655 transother[CODE_HEADER_WIDETAG] = trans_code_header;
1656 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
1657 transother[CLOSURE_FUN_HEADER_WIDETAG] = trans_fun_header;
1658 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
1659 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
1660 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
1661 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
1662 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
1663 transother[BASE_CHAR_WIDETAG] = trans_immediate;
1664 transother[SAP_WIDETAG] = trans_unboxed;
1665 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
1666 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
1667 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
1668 transother[FDEFN_WIDETAG] = trans_boxed;
1670 /* size table, initialized the same way as scavtab */
1671 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
1672 sizetab[i] = size_lose;
1673 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1674 sizetab[EVEN_FIXNUM_LOWTAG|(i<<3)] = size_immediate;
1675 sizetab[FUN_POINTER_LOWTAG|(i<<3)] = size_pointer;
1676 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1677 sizetab[LIST_POINTER_LOWTAG|(i<<3)] = size_pointer;
1678 sizetab[ODD_FIXNUM_LOWTAG|(i<<3)] = size_immediate;
1679 sizetab[INSTANCE_POINTER_LOWTAG|(i<<3)] = size_pointer;
1680 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1681 sizetab[OTHER_POINTER_LOWTAG|(i<<3)] = size_pointer;
1683 sizetab[BIGNUM_WIDETAG] = size_unboxed;
1684 sizetab[RATIO_WIDETAG] = size_boxed;
1685 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
1686 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1687 #ifdef LONG_FLOAT_WIDETAG
1688 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
1690 sizetab[COMPLEX_WIDETAG] = size_boxed;
1691 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1692 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
1694 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1695 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1697 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1698 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
1700 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
1701 sizetab[SIMPLE_STRING_WIDETAG] = size_string;
1702 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
1703 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
1704 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1705 size_vector_unsigned_byte_2;
1706 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1707 size_vector_unsigned_byte_4;
1708 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1709 size_vector_unsigned_byte_8;
1710 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1711 size_vector_unsigned_byte_16;
1712 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1713 size_vector_unsigned_byte_32;
1714 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1715 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
1717 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1718 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1719 size_vector_unsigned_byte_16;
1721 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1722 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1723 size_vector_unsigned_byte_32;
1725 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1726 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1727 size_vector_unsigned_byte_32;
1729 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
1730 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
1731 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1732 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
1734 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1735 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1736 size_vector_complex_single_float;
1738 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1739 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1740 size_vector_complex_double_float;
1742 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1743 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1744 size_vector_complex_long_float;
1746 sizetab[COMPLEX_STRING_WIDETAG] = size_boxed;
1747 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
1748 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
1749 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
1750 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
1752 /* We shouldn't see these, so just lose if it happens. */
1753 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
1754 sizetab[CLOSURE_FUN_HEADER_WIDETAG] = size_function_header;
1755 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
1757 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
1758 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
1759 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
1760 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
1761 sizetab[BASE_CHAR_WIDETAG] = size_immediate;
1762 sizetab[SAP_WIDETAG] = size_unboxed;
1763 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
1764 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
1765 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
1766 sizetab[FDEFN_WIDETAG] = size_boxed;