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>.
51 #include "interrupt.h"
56 #include "genesis/primitive-objects.h"
57 #include "genesis/static-symbols.h"
58 #include "gc-internal.h"
60 #ifdef LISP_FEATURE_SPARC
61 #define LONG_FLOAT_SIZE 4
63 #ifdef LISP_FEATURE_X86
64 #define LONG_FLOAT_SIZE 3
69 forwarding_pointer_p(lispobj *pointer) {
70 lispobj first_word=*pointer;
71 #ifdef LISP_FEATURE_GENCGC
72 return (first_word == 0x01);
74 return (is_lisp_pointer(first_word)
75 && new_space_p(first_word));
79 static inline lispobj *
80 forwarding_pointer_value(lispobj *pointer) {
81 #ifdef LISP_FEATURE_GENCGC
82 return (lispobj *) ((pointer_sized_uint_t) pointer[1]);
84 return (lispobj *) ((pointer_sized_uint_t) pointer[0]);
88 set_forwarding_pointer(lispobj * pointer, lispobj newspace_copy) {
89 #ifdef LISP_FEATURE_GENCGC
91 pointer[1]=newspace_copy;
93 pointer[0]=newspace_copy;
98 int (*scavtab[256])(lispobj *where, lispobj object);
99 lispobj (*transother[256])(lispobj object);
100 int (*sizetab[256])(lispobj *where);
101 struct weak_pointer *weak_pointers;
103 unsigned long bytes_consed_between_gcs = 12*1024*1024;
110 /* to copy a boxed object */
112 copy_object(lispobj object, int nwords)
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);
127 /* Copy the object. */
128 memcpy(new,native_pointer(object),nwords*4);
129 return make_lispobj(new,tag);
132 static int scav_lose(lispobj *where, lispobj object); /* forward decl */
134 /* FIXME: Most calls end up going to some trouble to compute an
135 * 'n_words' value for this function. The system might be a little
136 * simpler if this function used an 'end' parameter instead. */
138 scavenge(lispobj *start, long n_words)
140 lispobj *end = start + n_words;
142 int n_words_scavenged;
143 for (object_ptr = start;
145 object_ptr += n_words_scavenged) {
147 lispobj object = *object_ptr;
148 #ifdef LISP_FEATURE_GENCGC
149 gc_assert(!forwarding_pointer_p(object_ptr));
151 if (is_lisp_pointer(object)) {
152 if (from_space_p(object)) {
153 /* It currently points to old space. Check for a
154 * forwarding pointer. */
155 lispobj *ptr = native_pointer(object);
156 if (forwarding_pointer_p(ptr)) {
157 /* Yes, there's a forwarding pointer. */
158 *object_ptr = LOW_WORD(forwarding_pointer_value(ptr));
159 n_words_scavenged = 1;
161 /* Scavenge that pointer. */
163 (scavtab[widetag_of(object)])(object_ptr, object);
166 /* It points somewhere other than oldspace. Leave it
168 n_words_scavenged = 1;
171 #ifndef LISP_FEATURE_GENCGC
172 /* this workaround is probably not necessary for gencgc; at least, the
173 * behaviour it describes has never been reported */
174 else if (n_words==1) {
175 /* there are some situations where an
176 other-immediate may end up in a descriptor
177 register. I'm not sure whether this is
178 supposed to happen, but if it does then we
179 don't want to (a) barf or (b) scavenge over the
180 data-block, because there isn't one. So, if
181 we're checking a single word and it's anything
182 other than a pointer, just hush it up */
183 int type=widetag_of(object);
186 if ((scavtab[type]==scav_lose) ||
187 (((scavtab[type])(start,object))>1)) {
188 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",
193 else if ((object & 3) == 0) {
194 /* It's a fixnum: really easy.. */
195 n_words_scavenged = 1;
197 /* It's some sort of header object or another. */
199 (scavtab[widetag_of(object)])(object_ptr, object);
202 gc_assert(object_ptr == end);
205 static lispobj trans_fun_header(lispobj object); /* forward decls */
206 static lispobj trans_boxed(lispobj object);
209 scav_fun_pointer(lispobj *where, lispobj object)
211 lispobj *first_pointer;
214 gc_assert(is_lisp_pointer(object));
216 /* Object is a pointer into from_space - not a FP. */
217 first_pointer = (lispobj *) native_pointer(object);
219 /* must transport object -- object may point to either a function
220 * header, a closure function header, or to a closure header. */
222 switch (widetag_of(*first_pointer)) {
223 case SIMPLE_FUN_HEADER_WIDETAG:
224 copy = trans_fun_header(object);
227 copy = trans_boxed(object);
231 if (copy != object) {
232 /* Set forwarding pointer */
233 set_forwarding_pointer(first_pointer,copy);
236 gc_assert(is_lisp_pointer(copy));
237 gc_assert(!from_space_p(copy));
246 trans_code(struct code *code)
248 struct code *new_code;
249 lispobj first, l_code, l_new_code;
250 int nheader_words, ncode_words, nwords;
251 unsigned long displacement;
252 lispobj fheaderl, *prev_pointer;
254 /* if object has already been transported, just return pointer */
255 first = code->header;
256 if (forwarding_pointer_p((lispobj *)code)) {
258 printf("Was already transported\n");
260 return (struct code *) forwarding_pointer_value
261 ((lispobj *)((pointer_sized_uint_t) code));
264 gc_assert(widetag_of(first) == CODE_HEADER_WIDETAG);
266 /* prepare to transport the code vector */
267 l_code = (lispobj) LOW_WORD(code) | OTHER_POINTER_LOWTAG;
269 ncode_words = fixnum_value(code->code_size);
270 nheader_words = HeaderValue(code->header);
271 nwords = ncode_words + nheader_words;
272 nwords = CEILING(nwords, 2);
274 l_new_code = copy_object(l_code, nwords);
275 new_code = (struct code *) native_pointer(l_new_code);
277 #if defined(DEBUG_CODE_GC)
278 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
279 (unsigned long) code, (unsigned long) new_code);
280 printf("Code object is %d words long.\n", nwords);
283 #ifdef LISP_FEATURE_GENCGC
284 if (new_code == code)
288 displacement = l_new_code - l_code;
290 set_forwarding_pointer((lispobj *)code, l_new_code);
292 /* set forwarding pointers for all the function headers in the */
293 /* code object. also fix all self pointers */
295 fheaderl = code->entry_points;
296 prev_pointer = &new_code->entry_points;
298 while (fheaderl != NIL) {
299 struct simple_fun *fheaderp, *nfheaderp;
302 fheaderp = (struct simple_fun *) native_pointer(fheaderl);
303 gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
305 /* Calculate the new function pointer and the new */
306 /* function header. */
307 nfheaderl = fheaderl + displacement;
308 nfheaderp = (struct simple_fun *) native_pointer(nfheaderl);
311 printf("fheaderp->header (at %x) <- %x\n",
312 &(fheaderp->header) , nfheaderl);
314 set_forwarding_pointer((lispobj *)fheaderp, nfheaderl);
316 /* fix self pointer. */
318 #ifdef LISP_FEATURE_X86
319 FUN_RAW_ADDR_OFFSET +
323 *prev_pointer = nfheaderl;
325 fheaderl = fheaderp->next;
326 prev_pointer = &nfheaderp->next;
328 os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words),
329 ncode_words * sizeof(int));
330 #ifdef LISP_FEATURE_GENCGC
331 gencgc_apply_code_fixups(code, new_code);
337 scav_code_header(lispobj *where, lispobj object)
340 int n_header_words, n_code_words, n_words;
341 lispobj entry_point; /* tagged pointer to entry point */
342 struct simple_fun *function_ptr; /* untagged pointer to entry point */
344 code = (struct code *) where;
345 n_code_words = fixnum_value(code->code_size);
346 n_header_words = HeaderValue(object);
347 n_words = n_code_words + n_header_words;
348 n_words = CEILING(n_words, 2);
350 /* Scavenge the boxed section of the code data block. */
351 scavenge(where + 1, n_header_words - 1);
353 /* Scavenge the boxed section of each function object in the
354 * code data block. */
355 for (entry_point = code->entry_points;
357 entry_point = function_ptr->next) {
359 gc_assert(is_lisp_pointer(entry_point));
361 function_ptr = (struct simple_fun *) native_pointer(entry_point);
362 gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
364 scavenge(&function_ptr->name, 1);
365 scavenge(&function_ptr->arglist, 1);
366 scavenge(&function_ptr->type, 1);
373 trans_code_header(lispobj object)
377 ncode = trans_code((struct code *) native_pointer(object));
378 return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG;
383 size_code_header(lispobj *where)
386 int nheader_words, ncode_words, nwords;
388 code = (struct code *) where;
390 ncode_words = fixnum_value(code->code_size);
391 nheader_words = HeaderValue(code->header);
392 nwords = ncode_words + nheader_words;
393 nwords = CEILING(nwords, 2);
398 #ifndef LISP_FEATURE_X86
400 scav_return_pc_header(lispobj *where, lispobj object)
402 lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x",
403 (unsigned long) where,
404 (unsigned long) object);
405 return 0; /* bogus return value to satisfy static type checking */
407 #endif /* LISP_FEATURE_X86 */
410 trans_return_pc_header(lispobj object)
412 struct simple_fun *return_pc;
413 unsigned long offset;
414 struct code *code, *ncode;
416 return_pc = (struct simple_fun *) native_pointer(object);
417 offset = HeaderValue(return_pc->header) * 4 ;
419 /* Transport the whole code object */
420 code = (struct code *) ((unsigned long) return_pc - offset);
421 ncode = trans_code(code);
423 return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
426 /* On the 386, closures hold a pointer to the raw address instead of the
427 * function object, so we can use CALL [$FDEFN+const] to invoke
428 * the function without loading it into a register. Given that code
429 * objects don't move, we don't need to update anything, but we do
430 * have to figure out that the function is still live. */
432 #ifdef LISP_FEATURE_X86
434 scav_closure_header(lispobj *where, lispobj object)
436 struct closure *closure;
439 closure = (struct closure *)where;
440 fun = closure->fun - FUN_RAW_ADDR_OFFSET;
442 #ifdef LISP_FEATURE_GENCGC
443 /* The function may have moved so update the raw address. But
444 * don't write unnecessarily. */
445 if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
446 closure->fun = fun + FUN_RAW_ADDR_OFFSET;
452 #ifndef LISP_FEATURE_X86
454 scav_fun_header(lispobj *where, lispobj object)
456 lose("attempted to scavenge a function header where=0x%08x object=0x%08x",
457 (unsigned long) where,
458 (unsigned long) object);
459 return 0; /* bogus return value to satisfy static type checking */
461 #endif /* LISP_FEATURE_X86 */
464 trans_fun_header(lispobj object)
466 struct simple_fun *fheader;
467 unsigned long offset;
468 struct code *code, *ncode;
470 fheader = (struct simple_fun *) native_pointer(object);
471 offset = HeaderValue(fheader->header) * 4;
473 /* Transport the whole code object */
474 code = (struct code *) ((unsigned long) fheader - offset);
475 ncode = trans_code(code);
477 return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
486 scav_instance_pointer(lispobj *where, lispobj object)
488 lispobj copy, *first_pointer;
490 /* Object is a pointer into from space - not a FP. */
491 copy = trans_boxed(object);
493 #ifdef LISP_FEATURE_GENCGC
494 gc_assert(copy != object);
497 first_pointer = (lispobj *) native_pointer(object);
498 set_forwarding_pointer(first_pointer,copy);
509 static lispobj trans_list(lispobj object);
512 scav_list_pointer(lispobj *where, lispobj object)
514 lispobj first, *first_pointer;
516 gc_assert(is_lisp_pointer(object));
518 /* Object is a pointer into from space - not FP. */
519 first_pointer = (lispobj *) native_pointer(object);
521 first = trans_list(object);
522 gc_assert(first != object);
524 /* Set forwarding pointer */
525 set_forwarding_pointer(first_pointer, first);
527 gc_assert(is_lisp_pointer(first));
528 gc_assert(!from_space_p(first));
536 trans_list(lispobj object)
538 lispobj new_list_pointer;
539 struct cons *cons, *new_cons;
542 cons = (struct cons *) native_pointer(object);
545 new_cons = (struct cons *)
546 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
547 new_cons->car = cons->car;
548 new_cons->cdr = cons->cdr; /* updated later */
549 new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
551 /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC */
554 set_forwarding_pointer((lispobj *)cons, new_list_pointer);
556 /* Try to linearize the list in the cdr direction to help reduce
560 struct cons *cdr_cons, *new_cdr_cons;
562 if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
563 !from_space_p(cdr) ||
564 forwarding_pointer_p((lispobj *)native_pointer(cdr)))
567 cdr_cons = (struct cons *) native_pointer(cdr);
570 new_cdr_cons = (struct cons*)
571 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
572 new_cdr_cons->car = cdr_cons->car;
573 new_cdr_cons->cdr = cdr_cons->cdr;
574 new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
576 /* Grab the cdr before it is clobbered. */
578 set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
580 /* Update the cdr of the last cons copied into new space to
581 * keep the newspace scavenge from having to do it. */
582 new_cons->cdr = new_cdr;
584 new_cons = new_cdr_cons;
587 return new_list_pointer;
592 * scavenging and transporting other pointers
596 scav_other_pointer(lispobj *where, lispobj object)
598 lispobj first, *first_pointer;
600 gc_assert(is_lisp_pointer(object));
602 /* Object is a pointer into from space - not FP. */
603 first_pointer = (lispobj *) native_pointer(object);
604 first = (transother[widetag_of(*first_pointer)])(object);
606 if (first != object) {
607 set_forwarding_pointer(first_pointer, first);
608 #ifdef LISP_FEATURE_GENCGC
612 #ifndef LISP_FEATURE_GENCGC
615 gc_assert(is_lisp_pointer(first));
616 gc_assert(!from_space_p(first));
622 * immediate, boxed, and unboxed objects
626 size_pointer(lispobj *where)
632 scav_immediate(lispobj *where, lispobj object)
638 trans_immediate(lispobj object)
640 lose("trying to transport an immediate");
641 return NIL; /* bogus return value to satisfy static type checking */
645 size_immediate(lispobj *where)
652 scav_boxed(lispobj *where, lispobj object)
658 trans_boxed(lispobj object)
661 unsigned long length;
663 gc_assert(is_lisp_pointer(object));
665 header = *((lispobj *) native_pointer(object));
666 length = HeaderValue(header) + 1;
667 length = CEILING(length, 2);
669 return copy_object(object, length);
674 size_boxed(lispobj *where)
677 unsigned long length;
680 length = HeaderValue(header) + 1;
681 length = CEILING(length, 2);
686 /* Note: on the sparc we don't have to do anything special for fdefns, */
687 /* 'cause the raw-addr has a function lowtag. */
688 #ifndef LISP_FEATURE_SPARC
690 scav_fdefn(lispobj *where, lispobj object)
694 fdefn = (struct fdefn *)where;
696 /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
697 fdefn->fun, fdefn->raw_addr)); */
699 if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)
700 == (char *)((unsigned long)(fdefn->raw_addr))) {
701 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
703 /* Don't write unnecessarily. */
704 if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
705 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
706 /* gc.c has more casts here, which may be relevant or alternatively
707 may be compiler warning defeaters. try
709 (u32) ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
711 return sizeof(struct fdefn) / sizeof(lispobj);
719 scav_unboxed(lispobj *where, lispobj object)
721 unsigned long length;
723 length = HeaderValue(object) + 1;
724 length = CEILING(length, 2);
730 trans_unboxed(lispobj object)
733 unsigned long length;
736 gc_assert(is_lisp_pointer(object));
738 header = *((lispobj *) native_pointer(object));
739 length = HeaderValue(header) + 1;
740 length = CEILING(length, 2);
742 return copy_unboxed_object(object, length);
746 size_unboxed(lispobj *where)
749 unsigned long length;
752 length = HeaderValue(header) + 1;
753 length = CEILING(length, 2);
759 /* vector-like objects */
761 #define NWORDS(x,y) (CEILING((x),(y)) / (y))
763 scav_base_string(lispobj *where, lispobj object)
765 struct vector *vector;
768 /* NOTE: Strings contain one more byte of data than the length */
769 /* slot indicates. */
771 vector = (struct vector *) where;
772 length = fixnum_value(vector->length) + 1;
773 nwords = CEILING(NWORDS(length, 4) + 2, 2);
778 trans_base_string(lispobj object)
780 struct vector *vector;
783 gc_assert(is_lisp_pointer(object));
785 /* NOTE: A string contains one more byte of data (a terminating
786 * '\0' to help when interfacing with C functions) than indicated
787 * by the length slot. */
789 vector = (struct vector *) native_pointer(object);
790 length = fixnum_value(vector->length) + 1;
791 nwords = CEILING(NWORDS(length, 4) + 2, 2);
793 return copy_large_unboxed_object(object, nwords);
797 size_base_string(lispobj *where)
799 struct vector *vector;
802 /* NOTE: A string contains one more byte of data (a terminating
803 * '\0' to help when interfacing with C functions) than indicated
804 * by the length slot. */
806 vector = (struct vector *) where;
807 length = fixnum_value(vector->length) + 1;
808 nwords = CEILING(NWORDS(length, 4) + 2, 2);
814 trans_vector(lispobj object)
816 struct vector *vector;
819 gc_assert(is_lisp_pointer(object));
821 vector = (struct vector *) native_pointer(object);
823 length = fixnum_value(vector->length);
824 nwords = CEILING(length + 2, 2);
826 return copy_large_object(object, nwords);
830 size_vector(lispobj *where)
832 struct vector *vector;
835 vector = (struct vector *) where;
836 length = fixnum_value(vector->length);
837 nwords = CEILING(length + 2, 2);
843 scav_vector_nil(lispobj *where, lispobj object)
849 trans_vector_nil(lispobj object)
851 gc_assert(is_lisp_pointer(object));
852 return copy_unboxed_object(object, 2);
856 size_vector_nil(lispobj *where)
858 /* Just the header word and the length word */
863 scav_vector_bit(lispobj *where, lispobj object)
865 struct vector *vector;
868 vector = (struct vector *) where;
869 length = fixnum_value(vector->length);
870 nwords = CEILING(NWORDS(length, 32) + 2, 2);
876 trans_vector_bit(lispobj object)
878 struct vector *vector;
881 gc_assert(is_lisp_pointer(object));
883 vector = (struct vector *) native_pointer(object);
884 length = fixnum_value(vector->length);
885 nwords = CEILING(NWORDS(length, 32) + 2, 2);
887 return copy_large_unboxed_object(object, nwords);
891 size_vector_bit(lispobj *where)
893 struct vector *vector;
896 vector = (struct vector *) where;
897 length = fixnum_value(vector->length);
898 nwords = CEILING(NWORDS(length, 32) + 2, 2);
904 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
906 struct vector *vector;
909 vector = (struct vector *) where;
910 length = fixnum_value(vector->length);
911 nwords = CEILING(NWORDS(length, 16) + 2, 2);
917 trans_vector_unsigned_byte_2(lispobj object)
919 struct vector *vector;
922 gc_assert(is_lisp_pointer(object));
924 vector = (struct vector *) native_pointer(object);
925 length = fixnum_value(vector->length);
926 nwords = CEILING(NWORDS(length, 16) + 2, 2);
928 return copy_large_unboxed_object(object, nwords);
932 size_vector_unsigned_byte_2(lispobj *where)
934 struct vector *vector;
937 vector = (struct vector *) where;
938 length = fixnum_value(vector->length);
939 nwords = CEILING(NWORDS(length, 16) + 2, 2);
945 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
947 struct vector *vector;
950 vector = (struct vector *) where;
951 length = fixnum_value(vector->length);
952 nwords = CEILING(NWORDS(length, 8) + 2, 2);
958 trans_vector_unsigned_byte_4(lispobj object)
960 struct vector *vector;
963 gc_assert(is_lisp_pointer(object));
965 vector = (struct vector *) native_pointer(object);
966 length = fixnum_value(vector->length);
967 nwords = CEILING(NWORDS(length, 8) + 2, 2);
969 return copy_large_unboxed_object(object, nwords);
972 size_vector_unsigned_byte_4(lispobj *where)
974 struct vector *vector;
977 vector = (struct vector *) where;
978 length = fixnum_value(vector->length);
979 nwords = CEILING(NWORDS(length, 8) + 2, 2);
986 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
988 struct vector *vector;
991 vector = (struct vector *) where;
992 length = fixnum_value(vector->length);
993 nwords = CEILING(NWORDS(length, 4) + 2, 2);
998 /*********************/
1003 trans_vector_unsigned_byte_8(lispobj object)
1005 struct vector *vector;
1008 gc_assert(is_lisp_pointer(object));
1010 vector = (struct vector *) native_pointer(object);
1011 length = fixnum_value(vector->length);
1012 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1014 return copy_large_unboxed_object(object, nwords);
1018 size_vector_unsigned_byte_8(lispobj *where)
1020 struct vector *vector;
1023 vector = (struct vector *) where;
1024 length = fixnum_value(vector->length);
1025 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1032 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1034 struct vector *vector;
1037 vector = (struct vector *) where;
1038 length = fixnum_value(vector->length);
1039 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1045 trans_vector_unsigned_byte_16(lispobj object)
1047 struct vector *vector;
1050 gc_assert(is_lisp_pointer(object));
1052 vector = (struct vector *) native_pointer(object);
1053 length = fixnum_value(vector->length);
1054 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1056 return copy_large_unboxed_object(object, nwords);
1060 size_vector_unsigned_byte_16(lispobj *where)
1062 struct vector *vector;
1065 vector = (struct vector *) where;
1066 length = fixnum_value(vector->length);
1067 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1073 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1075 struct vector *vector;
1078 vector = (struct vector *) where;
1079 length = fixnum_value(vector->length);
1080 nwords = CEILING(length + 2, 2);
1086 trans_vector_unsigned_byte_32(lispobj object)
1088 struct vector *vector;
1091 gc_assert(is_lisp_pointer(object));
1093 vector = (struct vector *) native_pointer(object);
1094 length = fixnum_value(vector->length);
1095 nwords = CEILING(length + 2, 2);
1097 return copy_large_unboxed_object(object, nwords);
1101 size_vector_unsigned_byte_32(lispobj *where)
1103 struct vector *vector;
1106 vector = (struct vector *) where;
1107 length = fixnum_value(vector->length);
1108 nwords = CEILING(length + 2, 2);
1114 scav_vector_single_float(lispobj *where, lispobj object)
1116 struct vector *vector;
1119 vector = (struct vector *) where;
1120 length = fixnum_value(vector->length);
1121 nwords = CEILING(length + 2, 2);
1127 trans_vector_single_float(lispobj object)
1129 struct vector *vector;
1132 gc_assert(is_lisp_pointer(object));
1134 vector = (struct vector *) native_pointer(object);
1135 length = fixnum_value(vector->length);
1136 nwords = CEILING(length + 2, 2);
1138 return copy_large_unboxed_object(object, nwords);
1142 size_vector_single_float(lispobj *where)
1144 struct vector *vector;
1147 vector = (struct vector *) where;
1148 length = fixnum_value(vector->length);
1149 nwords = CEILING(length + 2, 2);
1155 scav_vector_double_float(lispobj *where, lispobj object)
1157 struct vector *vector;
1160 vector = (struct vector *) where;
1161 length = fixnum_value(vector->length);
1162 nwords = CEILING(length * 2 + 2, 2);
1168 trans_vector_double_float(lispobj object)
1170 struct vector *vector;
1173 gc_assert(is_lisp_pointer(object));
1175 vector = (struct vector *) native_pointer(object);
1176 length = fixnum_value(vector->length);
1177 nwords = CEILING(length * 2 + 2, 2);
1179 return copy_large_unboxed_object(object, nwords);
1183 size_vector_double_float(lispobj *where)
1185 struct vector *vector;
1188 vector = (struct vector *) where;
1189 length = fixnum_value(vector->length);
1190 nwords = CEILING(length * 2 + 2, 2);
1195 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1197 scav_vector_long_float(lispobj *where, lispobj object)
1199 struct vector *vector;
1202 vector = (struct vector *) where;
1203 length = fixnum_value(vector->length);
1204 nwords = CEILING(length *
1211 trans_vector_long_float(lispobj object)
1213 struct vector *vector;
1216 gc_assert(is_lisp_pointer(object));
1218 vector = (struct vector *) native_pointer(object);
1219 length = fixnum_value(vector->length);
1220 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1222 return copy_large_unboxed_object(object, nwords);
1226 size_vector_long_float(lispobj *where)
1228 struct vector *vector;
1231 vector = (struct vector *) where;
1232 length = fixnum_value(vector->length);
1233 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1240 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1242 scav_vector_complex_single_float(lispobj *where, lispobj object)
1244 struct vector *vector;
1247 vector = (struct vector *) where;
1248 length = fixnum_value(vector->length);
1249 nwords = CEILING(length * 2 + 2, 2);
1255 trans_vector_complex_single_float(lispobj object)
1257 struct vector *vector;
1260 gc_assert(is_lisp_pointer(object));
1262 vector = (struct vector *) native_pointer(object);
1263 length = fixnum_value(vector->length);
1264 nwords = CEILING(length * 2 + 2, 2);
1266 return copy_large_unboxed_object(object, nwords);
1270 size_vector_complex_single_float(lispobj *where)
1272 struct vector *vector;
1275 vector = (struct vector *) where;
1276 length = fixnum_value(vector->length);
1277 nwords = CEILING(length * 2 + 2, 2);
1283 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1285 scav_vector_complex_double_float(lispobj *where, lispobj object)
1287 struct vector *vector;
1290 vector = (struct vector *) where;
1291 length = fixnum_value(vector->length);
1292 nwords = CEILING(length * 4 + 2, 2);
1298 trans_vector_complex_double_float(lispobj object)
1300 struct vector *vector;
1303 gc_assert(is_lisp_pointer(object));
1305 vector = (struct vector *) native_pointer(object);
1306 length = fixnum_value(vector->length);
1307 nwords = CEILING(length * 4 + 2, 2);
1309 return copy_large_unboxed_object(object, nwords);
1313 size_vector_complex_double_float(lispobj *where)
1315 struct vector *vector;
1318 vector = (struct vector *) where;
1319 length = fixnum_value(vector->length);
1320 nwords = CEILING(length * 4 + 2, 2);
1327 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1329 scav_vector_complex_long_float(lispobj *where, lispobj object)
1331 struct vector *vector;
1334 vector = (struct vector *) where;
1335 length = fixnum_value(vector->length);
1336 nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1342 trans_vector_complex_long_float(lispobj object)
1344 struct vector *vector;
1347 gc_assert(is_lisp_pointer(object));
1349 vector = (struct vector *) native_pointer(object);
1350 length = fixnum_value(vector->length);
1351 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1353 return copy_large_unboxed_object(object, nwords);
1357 size_vector_complex_long_float(lispobj *where)
1359 struct vector *vector;
1362 vector = (struct vector *) where;
1363 length = fixnum_value(vector->length);
1364 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1370 #define WEAK_POINTER_NWORDS \
1371 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1374 trans_weak_pointer(lispobj object)
1377 #ifndef LISP_FEATURE_GENCGC
1378 struct weak_pointer *wp;
1380 gc_assert(is_lisp_pointer(object));
1382 #if defined(DEBUG_WEAK)
1383 printf("Transporting weak pointer from 0x%08x\n", object);
1386 /* Need to remember where all the weak pointers are that have */
1387 /* been transported so they can be fixed up in a post-GC pass. */
1389 copy = copy_object(object, WEAK_POINTER_NWORDS);
1390 #ifndef LISP_FEATURE_GENCGC
1391 wp = (struct weak_pointer *) native_pointer(copy);
1393 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1394 /* Push the weak pointer onto the list of weak pointers. */
1395 wp->next = LOW_WORD(weak_pointers);
1402 size_weak_pointer(lispobj *where)
1404 return WEAK_POINTER_NWORDS;
1408 void scan_weak_pointers(void)
1410 struct weak_pointer *wp;
1411 for (wp = weak_pointers; wp != NULL;
1412 wp=(struct weak_pointer *)native_pointer(wp->next)) {
1413 lispobj value = wp->value;
1414 lispobj *first_pointer;
1415 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1416 if (!(is_lisp_pointer(value) && from_space_p(value)))
1419 /* Now, we need to check whether the object has been forwarded. If
1420 * it has been, the weak pointer is still good and needs to be
1421 * updated. Otherwise, the weak pointer needs to be nil'ed
1424 first_pointer = (lispobj *)native_pointer(value);
1426 if (forwarding_pointer_p(first_pointer)) {
1428 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1444 scav_lose(lispobj *where, lispobj object)
1446 lose("no scavenge function for object 0x%08x (widetag 0x%x)",
1447 (unsigned long)object,
1448 widetag_of(*(lispobj*)native_pointer(object)));
1449 return 0; /* bogus return value to satisfy static type checking */
1453 trans_lose(lispobj object)
1455 lose("no transport function for object 0x%08x (widetag 0x%x)",
1456 (unsigned long)object,
1457 widetag_of(*(lispobj*)native_pointer(object)));
1458 return NIL; /* bogus return value to satisfy static type checking */
1462 size_lose(lispobj *where)
1464 lose("no size function for object at 0x%08x (widetag 0x%x)",
1465 (unsigned long)where,
1466 widetag_of(LOW_WORD(where)));
1467 return 1; /* bogus return value to satisfy static type checking */
1476 gc_init_tables(void)
1480 /* Set default value in all slots of scavenge table. FIXME
1481 * replace this gnarly sizeof with something based on
1483 for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) {
1484 scavtab[i] = scav_lose;
1487 /* For each type which can be selected by the lowtag alone, set
1488 * multiple entries in our widetag scavenge table (one for each
1489 * possible value of the high bits).
1492 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1493 scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1494 scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1495 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1496 scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1497 scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1498 scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_instance_pointer;
1499 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1500 scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1503 /* Other-pointer types (those selected by all eight bits of the
1504 * tag) get one entry each in the scavenge table. */
1505 scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1506 scavtab[RATIO_WIDETAG] = scav_boxed;
1507 scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1508 scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1509 #ifdef LONG_FLOAT_WIDETAG
1510 scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1512 scavtab[COMPLEX_WIDETAG] = scav_boxed;
1513 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1514 scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1516 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1517 scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1519 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1520 scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
1522 scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
1523 scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
1524 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
1525 scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
1526 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1527 scav_vector_unsigned_byte_2;
1528 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1529 scav_vector_unsigned_byte_4;
1530 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1531 scav_vector_unsigned_byte_8;
1532 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1533 scav_vector_unsigned_byte_8;
1534 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1535 scav_vector_unsigned_byte_16;
1536 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1537 scav_vector_unsigned_byte_16;
1538 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1539 scav_vector_unsigned_byte_32;
1540 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1541 scav_vector_unsigned_byte_32;
1542 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1543 scav_vector_unsigned_byte_32;
1544 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1545 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
1547 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1548 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1549 scav_vector_unsigned_byte_16;
1551 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1552 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1553 scav_vector_unsigned_byte_32;
1555 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1556 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1557 scav_vector_unsigned_byte_32;
1559 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
1560 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
1561 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1562 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
1564 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1565 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1566 scav_vector_complex_single_float;
1568 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1569 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1570 scav_vector_complex_double_float;
1572 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1573 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1574 scav_vector_complex_long_float;
1576 scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
1577 scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
1578 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
1579 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
1580 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
1581 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
1582 #ifndef LISP_FEATURE_GENCGC /* FIXME ..._X86 ? */
1583 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
1584 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
1586 #ifdef LISP_FEATURE_X86
1587 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
1588 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
1590 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
1591 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
1593 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
1594 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
1595 scavtab[BASE_CHAR_WIDETAG] = scav_immediate;
1596 scavtab[SAP_WIDETAG] = scav_unboxed;
1597 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
1598 scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed;
1599 #ifdef LISP_FEATURE_SPARC
1600 scavtab[FDEFN_WIDETAG] = scav_boxed;
1602 scavtab[FDEFN_WIDETAG] = scav_fdefn;
1605 /* transport other table, initialized same way as scavtab */
1606 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
1607 transother[i] = trans_lose;
1608 transother[BIGNUM_WIDETAG] = trans_unboxed;
1609 transother[RATIO_WIDETAG] = trans_boxed;
1610 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1611 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1612 #ifdef LONG_FLOAT_WIDETAG
1613 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
1615 transother[COMPLEX_WIDETAG] = trans_boxed;
1616 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1617 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1619 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1620 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1622 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1623 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
1625 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
1626 transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
1627 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
1628 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
1629 transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
1630 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1631 trans_vector_unsigned_byte_2;
1632 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1633 trans_vector_unsigned_byte_4;
1634 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1635 trans_vector_unsigned_byte_8;
1636 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1637 trans_vector_unsigned_byte_8;
1638 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1639 trans_vector_unsigned_byte_16;
1640 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1641 trans_vector_unsigned_byte_16;
1642 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1643 trans_vector_unsigned_byte_32;
1644 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1645 trans_vector_unsigned_byte_32;
1646 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1647 trans_vector_unsigned_byte_32;
1648 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1649 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
1650 trans_vector_unsigned_byte_8;
1652 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1653 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1654 trans_vector_unsigned_byte_16;
1656 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1657 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1658 trans_vector_unsigned_byte_32;
1660 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1661 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1662 trans_vector_unsigned_byte_32;
1664 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
1665 trans_vector_single_float;
1666 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
1667 trans_vector_double_float;
1668 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1669 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
1670 trans_vector_long_float;
1672 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1673 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1674 trans_vector_complex_single_float;
1676 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1677 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1678 trans_vector_complex_double_float;
1680 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1681 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1682 trans_vector_complex_long_float;
1684 transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
1685 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
1686 transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
1687 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
1688 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
1689 transother[CODE_HEADER_WIDETAG] = trans_code_header;
1690 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
1691 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
1692 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
1693 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
1694 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
1695 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
1696 transother[BASE_CHAR_WIDETAG] = trans_immediate;
1697 transother[SAP_WIDETAG] = trans_unboxed;
1698 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
1699 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
1700 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
1701 transother[FDEFN_WIDETAG] = trans_boxed;
1703 /* size table, initialized the same way as scavtab */
1704 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
1705 sizetab[i] = size_lose;
1706 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1707 sizetab[EVEN_FIXNUM_LOWTAG|(i<<3)] = size_immediate;
1708 sizetab[FUN_POINTER_LOWTAG|(i<<3)] = size_pointer;
1709 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1710 sizetab[LIST_POINTER_LOWTAG|(i<<3)] = size_pointer;
1711 sizetab[ODD_FIXNUM_LOWTAG|(i<<3)] = size_immediate;
1712 sizetab[INSTANCE_POINTER_LOWTAG|(i<<3)] = size_pointer;
1713 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1714 sizetab[OTHER_POINTER_LOWTAG|(i<<3)] = size_pointer;
1716 sizetab[BIGNUM_WIDETAG] = size_unboxed;
1717 sizetab[RATIO_WIDETAG] = size_boxed;
1718 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
1719 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1720 #ifdef LONG_FLOAT_WIDETAG
1721 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
1723 sizetab[COMPLEX_WIDETAG] = size_boxed;
1724 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1725 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
1727 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1728 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1730 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1731 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
1733 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
1734 sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
1735 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
1736 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
1737 sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
1738 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1739 size_vector_unsigned_byte_2;
1740 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1741 size_vector_unsigned_byte_4;
1742 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1743 size_vector_unsigned_byte_8;
1744 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1745 size_vector_unsigned_byte_8;
1746 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1747 size_vector_unsigned_byte_16;
1748 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1749 size_vector_unsigned_byte_16;
1750 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1751 size_vector_unsigned_byte_32;
1752 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1753 size_vector_unsigned_byte_32;
1754 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1755 size_vector_unsigned_byte_32;
1756 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1757 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
1759 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1760 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1761 size_vector_unsigned_byte_16;
1763 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1764 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1765 size_vector_unsigned_byte_32;
1767 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1768 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1769 size_vector_unsigned_byte_32;
1771 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
1772 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
1773 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1774 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
1776 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1777 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1778 size_vector_complex_single_float;
1780 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1781 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1782 size_vector_complex_double_float;
1784 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1785 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1786 size_vector_complex_long_float;
1788 sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
1789 sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
1790 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
1791 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
1792 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
1793 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
1795 /* We shouldn't see these, so just lose if it happens. */
1796 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
1797 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
1799 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
1800 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
1801 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
1802 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
1803 sizetab[BASE_CHAR_WIDETAG] = size_immediate;
1804 sizetab[SAP_WIDETAG] = size_unboxed;
1805 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
1806 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
1807 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
1808 sizetab[FDEFN_WIDETAG] = size_boxed;