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. */
137 #define PAGE_SIZE 4096
139 scavenge(lispobj *start, long n_words)
141 lispobj *end = start + n_words;
143 int n_words_scavenged;
144 if((((unsigned int)start & (PAGE_SIZE-1))==0) &&
145 (n_words>(PAGE_SIZE/4))) {
146 madvise(start, n_words*4, MADV_SEQUENTIAL|MADV_WILLNEED);
148 for (object_ptr = start;
150 object_ptr += n_words_scavenged) {
152 lispobj object = *object_ptr;
153 #ifdef LISP_FEATURE_GENCGC
154 gc_assert(!forwarding_pointer_p(object_ptr));
156 if (is_lisp_pointer(object)) {
157 if (from_space_p(object)) {
158 /* It currently points to old space. Check for a
159 * forwarding pointer. */
160 lispobj *ptr = native_pointer(object);
161 if (forwarding_pointer_p(ptr)) {
162 /* Yes, there's a forwarding pointer. */
163 *object_ptr = LOW_WORD(forwarding_pointer_value(ptr));
164 n_words_scavenged = 1;
166 /* Scavenge that pointer. */
168 (scavtab[widetag_of(object)])(object_ptr, object);
171 /* It points somewhere other than oldspace. Leave it
173 n_words_scavenged = 1;
176 #ifndef LISP_FEATURE_GENCGC
177 /* this workaround is probably not necessary for gencgc; at least, the
178 * behaviour it describes has never been reported */
179 else if (n_words==1) {
180 /* there are some situations where an
181 other-immediate may end up in a descriptor
182 register. I'm not sure whether this is
183 supposed to happen, but if it does then we
184 don't want to (a) barf or (b) scavenge over the
185 data-block, because there isn't one. So, if
186 we're checking a single word and it's anything
187 other than a pointer, just hush it up */
188 int type=widetag_of(object);
191 if ((scavtab[type]==scav_lose) ||
192 (((scavtab[type])(start,object))>1)) {
193 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",
198 else if ((object & 3) == 0) {
199 /* It's a fixnum: really easy.. */
200 n_words_scavenged = 1;
202 /* It's some sort of header object or another. */
204 (scavtab[widetag_of(object)])(object_ptr, object);
207 gc_assert(object_ptr == end);
210 static lispobj trans_fun_header(lispobj object); /* forward decls */
211 static lispobj trans_boxed(lispobj object);
214 scav_fun_pointer(lispobj *where, lispobj object)
216 lispobj *first_pointer;
219 gc_assert(is_lisp_pointer(object));
221 /* Object is a pointer into from_space - not a FP. */
222 first_pointer = (lispobj *) native_pointer(object);
224 /* must transport object -- object may point to either a function
225 * header, a closure function header, or to a closure header. */
227 switch (widetag_of(*first_pointer)) {
228 case SIMPLE_FUN_HEADER_WIDETAG:
229 copy = trans_fun_header(object);
232 copy = trans_boxed(object);
236 if (copy != object) {
237 /* Set forwarding pointer */
238 set_forwarding_pointer(first_pointer,copy);
241 gc_assert(is_lisp_pointer(copy));
242 gc_assert(!from_space_p(copy));
251 trans_code(struct code *code)
253 struct code *new_code;
254 lispobj first, l_code, l_new_code;
255 int nheader_words, ncode_words, nwords;
256 unsigned long displacement;
257 lispobj fheaderl, *prev_pointer;
259 /* if object has already been transported, just return pointer */
260 first = code->header;
261 if (forwarding_pointer_p((lispobj *)code)) {
263 printf("Was already transported\n");
265 return (struct code *) forwarding_pointer_value
266 ((lispobj *)((pointer_sized_uint_t) code));
269 gc_assert(widetag_of(first) == CODE_HEADER_WIDETAG);
271 /* prepare to transport the code vector */
272 l_code = (lispobj) LOW_WORD(code) | OTHER_POINTER_LOWTAG;
274 ncode_words = fixnum_value(code->code_size);
275 nheader_words = HeaderValue(code->header);
276 nwords = ncode_words + nheader_words;
277 nwords = CEILING(nwords, 2);
279 l_new_code = copy_object(l_code, nwords);
280 new_code = (struct code *) native_pointer(l_new_code);
282 #if defined(DEBUG_CODE_GC)
283 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
284 (unsigned long) code, (unsigned long) new_code);
285 printf("Code object is %d words long.\n", nwords);
288 #ifdef LISP_FEATURE_GENCGC
289 if (new_code == code)
293 displacement = l_new_code - l_code;
295 set_forwarding_pointer((lispobj *)code, l_new_code);
297 /* set forwarding pointers for all the function headers in the */
298 /* code object. also fix all self pointers */
300 fheaderl = code->entry_points;
301 prev_pointer = &new_code->entry_points;
303 while (fheaderl != NIL) {
304 struct simple_fun *fheaderp, *nfheaderp;
307 fheaderp = (struct simple_fun *) native_pointer(fheaderl);
308 gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
310 /* Calculate the new function pointer and the new */
311 /* function header. */
312 nfheaderl = fheaderl + displacement;
313 nfheaderp = (struct simple_fun *) native_pointer(nfheaderl);
316 printf("fheaderp->header (at %x) <- %x\n",
317 &(fheaderp->header) , nfheaderl);
319 set_forwarding_pointer((lispobj *)fheaderp, nfheaderl);
321 /* fix self pointer. */
323 #ifdef LISP_FEATURE_X86
324 FUN_RAW_ADDR_OFFSET +
328 *prev_pointer = nfheaderl;
330 fheaderl = fheaderp->next;
331 prev_pointer = &nfheaderp->next;
333 os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words),
334 ncode_words * sizeof(int));
335 #ifdef LISP_FEATURE_GENCGC
336 gencgc_apply_code_fixups(code, new_code);
342 scav_code_header(lispobj *where, lispobj object)
345 int n_header_words, n_code_words, n_words;
346 lispobj entry_point; /* tagged pointer to entry point */
347 struct simple_fun *function_ptr; /* untagged pointer to entry point */
349 code = (struct code *) where;
350 n_code_words = fixnum_value(code->code_size);
351 n_header_words = HeaderValue(object);
352 n_words = n_code_words + n_header_words;
353 n_words = CEILING(n_words, 2);
355 /* Scavenge the boxed section of the code data block. */
356 scavenge(where + 1, n_header_words - 1);
358 /* Scavenge the boxed section of each function object in the
359 * code data block. */
360 for (entry_point = code->entry_points;
362 entry_point = function_ptr->next) {
364 gc_assert(is_lisp_pointer(entry_point));
366 function_ptr = (struct simple_fun *) native_pointer(entry_point);
367 gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
369 scavenge(&function_ptr->name, 1);
370 scavenge(&function_ptr->arglist, 1);
371 scavenge(&function_ptr->type, 1);
378 trans_code_header(lispobj object)
382 ncode = trans_code((struct code *) native_pointer(object));
383 return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG;
388 size_code_header(lispobj *where)
391 int nheader_words, ncode_words, nwords;
393 code = (struct code *) where;
395 ncode_words = fixnum_value(code->code_size);
396 nheader_words = HeaderValue(code->header);
397 nwords = ncode_words + nheader_words;
398 nwords = CEILING(nwords, 2);
404 scav_return_pc_header(lispobj *where, lispobj object)
406 lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x",
407 (unsigned long) where,
408 (unsigned long) object);
409 return 0; /* bogus return value to satisfy static type checking */
413 trans_return_pc_header(lispobj object)
415 struct simple_fun *return_pc;
416 unsigned long offset;
417 struct code *code, *ncode;
419 return_pc = (struct simple_fun *) native_pointer(object);
420 offset = HeaderValue(return_pc->header) * 4 ;
422 /* Transport the whole code object */
423 code = (struct code *) ((unsigned long) return_pc - offset);
424 ncode = trans_code(code);
426 return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
429 /* On the 386, closures hold a pointer to the raw address instead of the
430 * function object, so we can use CALL [$FDEFN+const] to invoke
431 * the function without loading it into a register. Given that code
432 * objects don't move, we don't need to update anything, but we do
433 * have to figure out that the function is still live. */
435 #ifdef LISP_FEATURE_X86
437 scav_closure_header(lispobj *where, lispobj object)
439 struct closure *closure;
442 closure = (struct closure *)where;
443 fun = closure->fun - FUN_RAW_ADDR_OFFSET;
445 #ifdef LISP_FEATURE_GENCGC
446 /* The function may have moved so update the raw address. But
447 * don't write unnecessarily. */
448 if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
449 closure->fun = fun + FUN_RAW_ADDR_OFFSET;
456 scav_fun_header(lispobj *where, lispobj object)
458 lose("attempted to scavenge a function header where=0x%08x object=0x%08x",
459 (unsigned long) where,
460 (unsigned long) object);
461 return 0; /* bogus return value to satisfy static type checking */
465 trans_fun_header(lispobj object)
467 struct simple_fun *fheader;
468 unsigned long offset;
469 struct code *code, *ncode;
471 fheader = (struct simple_fun *) native_pointer(object);
472 offset = HeaderValue(fheader->header) * 4;
474 /* Transport the whole code object */
475 code = (struct code *) ((unsigned long) fheader - offset);
476 ncode = trans_code(code);
478 return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
487 scav_instance_pointer(lispobj *where, lispobj object)
489 lispobj copy, *first_pointer;
491 /* Object is a pointer into from space - not a FP. */
492 copy = trans_boxed(object);
494 #ifdef LISP_FEATURE_GENCGC
495 gc_assert(copy != object);
498 first_pointer = (lispobj *) native_pointer(object);
499 set_forwarding_pointer(first_pointer,copy);
510 static lispobj trans_list(lispobj object);
513 scav_list_pointer(lispobj *where, lispobj object)
515 lispobj first, *first_pointer;
517 gc_assert(is_lisp_pointer(object));
519 /* Object is a pointer into from space - not FP. */
520 first_pointer = (lispobj *) native_pointer(object);
522 first = trans_list(object);
523 gc_assert(first != object);
525 /* Set forwarding pointer */
526 set_forwarding_pointer(first_pointer, first);
528 gc_assert(is_lisp_pointer(first));
529 gc_assert(!from_space_p(first));
537 trans_list(lispobj object)
539 lispobj new_list_pointer;
540 struct cons *cons, *new_cons;
543 cons = (struct cons *) native_pointer(object);
546 new_cons = (struct cons *)
547 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
548 new_cons->car = cons->car;
549 new_cons->cdr = cons->cdr; /* updated later */
550 new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
552 /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC */
555 set_forwarding_pointer((lispobj *)cons, new_list_pointer);
557 /* Try to linearize the list in the cdr direction to help reduce
561 struct cons *cdr_cons, *new_cdr_cons;
563 if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
564 !from_space_p(cdr) ||
565 forwarding_pointer_p((lispobj *)native_pointer(cdr)))
568 cdr_cons = (struct cons *) native_pointer(cdr);
571 new_cdr_cons = (struct cons*)
572 gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
573 new_cdr_cons->car = cdr_cons->car;
574 new_cdr_cons->cdr = cdr_cons->cdr;
575 new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
577 /* Grab the cdr before it is clobbered. */
579 set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
581 /* Update the cdr of the last cons copied into new space to
582 * keep the newspace scavenge from having to do it. */
583 new_cons->cdr = new_cdr;
585 new_cons = new_cdr_cons;
588 return new_list_pointer;
593 * scavenging and transporting other pointers
597 scav_other_pointer(lispobj *where, lispobj object)
599 lispobj first, *first_pointer;
601 gc_assert(is_lisp_pointer(object));
603 /* Object is a pointer into from space - not FP. */
604 first_pointer = (lispobj *) native_pointer(object);
605 first = (transother[widetag_of(*first_pointer)])(object);
607 if (first != object) {
608 set_forwarding_pointer(first_pointer, first);
609 #ifdef LISP_FEATURE_GENCGC
613 #ifndef LISP_FEATURE_GENCGC
616 gc_assert(is_lisp_pointer(first));
617 gc_assert(!from_space_p(first));
623 * immediate, boxed, and unboxed objects
627 size_pointer(lispobj *where)
633 scav_immediate(lispobj *where, lispobj object)
639 trans_immediate(lispobj object)
641 lose("trying to transport an immediate");
642 return NIL; /* bogus return value to satisfy static type checking */
646 size_immediate(lispobj *where)
653 scav_boxed(lispobj *where, lispobj object)
659 trans_boxed(lispobj object)
662 unsigned long length;
664 gc_assert(is_lisp_pointer(object));
666 header = *((lispobj *) native_pointer(object));
667 length = HeaderValue(header) + 1;
668 length = CEILING(length, 2);
670 return copy_object(object, length);
675 size_boxed(lispobj *where)
678 unsigned long length;
681 length = HeaderValue(header) + 1;
682 length = CEILING(length, 2);
687 /* Note: on the sparc we don't have to do anything special for fdefns, */
688 /* 'cause the raw-addr has a function lowtag. */
689 #ifndef LISP_FEATURE_SPARC
691 scav_fdefn(lispobj *where, lispobj object)
695 fdefn = (struct fdefn *)where;
697 /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n",
698 fdefn->fun, fdefn->raw_addr)); */
700 if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)
701 == (char *)((unsigned long)(fdefn->raw_addr))) {
702 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
704 /* Don't write unnecessarily. */
705 if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
706 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
707 /* gc.c has more casts here, which may be relevant or alternatively
708 may be compiler warning defeaters. try
710 (u32) ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
712 return sizeof(struct fdefn) / sizeof(lispobj);
720 scav_unboxed(lispobj *where, lispobj object)
722 unsigned long length;
724 length = HeaderValue(object) + 1;
725 length = CEILING(length, 2);
731 trans_unboxed(lispobj object)
734 unsigned long length;
737 gc_assert(is_lisp_pointer(object));
739 header = *((lispobj *) native_pointer(object));
740 length = HeaderValue(header) + 1;
741 length = CEILING(length, 2);
743 return copy_unboxed_object(object, length);
747 size_unboxed(lispobj *where)
750 unsigned long length;
753 length = HeaderValue(header) + 1;
754 length = CEILING(length, 2);
760 /* vector-like objects */
762 #define NWORDS(x,y) (CEILING((x),(y)) / (y))
764 scav_base_string(lispobj *where, lispobj object)
766 struct vector *vector;
769 /* NOTE: Strings contain one more byte of data than the length */
770 /* slot indicates. */
772 vector = (struct vector *) where;
773 length = fixnum_value(vector->length) + 1;
774 nwords = CEILING(NWORDS(length, 4) + 2, 2);
779 trans_base_string(lispobj object)
781 struct vector *vector;
784 gc_assert(is_lisp_pointer(object));
786 /* NOTE: A string contains one more byte of data (a terminating
787 * '\0' to help when interfacing with C functions) than indicated
788 * by the length slot. */
790 vector = (struct vector *) native_pointer(object);
791 length = fixnum_value(vector->length) + 1;
792 nwords = CEILING(NWORDS(length, 4) + 2, 2);
794 return copy_large_unboxed_object(object, nwords);
798 size_base_string(lispobj *where)
800 struct vector *vector;
803 /* NOTE: A string contains one more byte of data (a terminating
804 * '\0' to help when interfacing with C functions) than indicated
805 * by the length slot. */
807 vector = (struct vector *) where;
808 length = fixnum_value(vector->length) + 1;
809 nwords = CEILING(NWORDS(length, 4) + 2, 2);
815 trans_vector(lispobj object)
817 struct vector *vector;
820 gc_assert(is_lisp_pointer(object));
822 vector = (struct vector *) native_pointer(object);
824 length = fixnum_value(vector->length);
825 nwords = CEILING(length + 2, 2);
827 return copy_large_object(object, nwords);
831 size_vector(lispobj *where)
833 struct vector *vector;
836 vector = (struct vector *) where;
837 length = fixnum_value(vector->length);
838 nwords = CEILING(length + 2, 2);
844 scav_vector_nil(lispobj *where, lispobj object)
850 trans_vector_nil(lispobj object)
852 gc_assert(is_lisp_pointer(object));
853 return copy_unboxed_object(object, 2);
857 size_vector_nil(lispobj *where)
859 /* Just the header word and the length word */
864 scav_vector_bit(lispobj *where, lispobj object)
866 struct vector *vector;
869 vector = (struct vector *) where;
870 length = fixnum_value(vector->length);
871 nwords = CEILING(NWORDS(length, 32) + 2, 2);
877 trans_vector_bit(lispobj object)
879 struct vector *vector;
882 gc_assert(is_lisp_pointer(object));
884 vector = (struct vector *) native_pointer(object);
885 length = fixnum_value(vector->length);
886 nwords = CEILING(NWORDS(length, 32) + 2, 2);
888 return copy_large_unboxed_object(object, nwords);
892 size_vector_bit(lispobj *where)
894 struct vector *vector;
897 vector = (struct vector *) where;
898 length = fixnum_value(vector->length);
899 nwords = CEILING(NWORDS(length, 32) + 2, 2);
905 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
907 struct vector *vector;
910 vector = (struct vector *) where;
911 length = fixnum_value(vector->length);
912 nwords = CEILING(NWORDS(length, 16) + 2, 2);
918 trans_vector_unsigned_byte_2(lispobj object)
920 struct vector *vector;
923 gc_assert(is_lisp_pointer(object));
925 vector = (struct vector *) native_pointer(object);
926 length = fixnum_value(vector->length);
927 nwords = CEILING(NWORDS(length, 16) + 2, 2);
929 return copy_large_unboxed_object(object, nwords);
933 size_vector_unsigned_byte_2(lispobj *where)
935 struct vector *vector;
938 vector = (struct vector *) where;
939 length = fixnum_value(vector->length);
940 nwords = CEILING(NWORDS(length, 16) + 2, 2);
946 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
948 struct vector *vector;
951 vector = (struct vector *) where;
952 length = fixnum_value(vector->length);
953 nwords = CEILING(NWORDS(length, 8) + 2, 2);
959 trans_vector_unsigned_byte_4(lispobj object)
961 struct vector *vector;
964 gc_assert(is_lisp_pointer(object));
966 vector = (struct vector *) native_pointer(object);
967 length = fixnum_value(vector->length);
968 nwords = CEILING(NWORDS(length, 8) + 2, 2);
970 return copy_large_unboxed_object(object, nwords);
973 size_vector_unsigned_byte_4(lispobj *where)
975 struct vector *vector;
978 vector = (struct vector *) where;
979 length = fixnum_value(vector->length);
980 nwords = CEILING(NWORDS(length, 8) + 2, 2);
987 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
989 struct vector *vector;
992 vector = (struct vector *) where;
993 length = fixnum_value(vector->length);
994 nwords = CEILING(NWORDS(length, 4) + 2, 2);
999 /*********************/
1004 trans_vector_unsigned_byte_8(lispobj object)
1006 struct vector *vector;
1009 gc_assert(is_lisp_pointer(object));
1011 vector = (struct vector *) native_pointer(object);
1012 length = fixnum_value(vector->length);
1013 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1015 return copy_large_unboxed_object(object, nwords);
1019 size_vector_unsigned_byte_8(lispobj *where)
1021 struct vector *vector;
1024 vector = (struct vector *) where;
1025 length = fixnum_value(vector->length);
1026 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1033 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1035 struct vector *vector;
1038 vector = (struct vector *) where;
1039 length = fixnum_value(vector->length);
1040 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1046 trans_vector_unsigned_byte_16(lispobj object)
1048 struct vector *vector;
1051 gc_assert(is_lisp_pointer(object));
1053 vector = (struct vector *) native_pointer(object);
1054 length = fixnum_value(vector->length);
1055 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1057 return copy_large_unboxed_object(object, nwords);
1061 size_vector_unsigned_byte_16(lispobj *where)
1063 struct vector *vector;
1066 vector = (struct vector *) where;
1067 length = fixnum_value(vector->length);
1068 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1074 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1076 struct vector *vector;
1079 vector = (struct vector *) where;
1080 length = fixnum_value(vector->length);
1081 nwords = CEILING(length + 2, 2);
1087 trans_vector_unsigned_byte_32(lispobj object)
1089 struct vector *vector;
1092 gc_assert(is_lisp_pointer(object));
1094 vector = (struct vector *) native_pointer(object);
1095 length = fixnum_value(vector->length);
1096 nwords = CEILING(length + 2, 2);
1098 return copy_large_unboxed_object(object, nwords);
1102 size_vector_unsigned_byte_32(lispobj *where)
1104 struct vector *vector;
1107 vector = (struct vector *) where;
1108 length = fixnum_value(vector->length);
1109 nwords = CEILING(length + 2, 2);
1115 scav_vector_single_float(lispobj *where, lispobj object)
1117 struct vector *vector;
1120 vector = (struct vector *) where;
1121 length = fixnum_value(vector->length);
1122 nwords = CEILING(length + 2, 2);
1128 trans_vector_single_float(lispobj object)
1130 struct vector *vector;
1133 gc_assert(is_lisp_pointer(object));
1135 vector = (struct vector *) native_pointer(object);
1136 length = fixnum_value(vector->length);
1137 nwords = CEILING(length + 2, 2);
1139 return copy_large_unboxed_object(object, nwords);
1143 size_vector_single_float(lispobj *where)
1145 struct vector *vector;
1148 vector = (struct vector *) where;
1149 length = fixnum_value(vector->length);
1150 nwords = CEILING(length + 2, 2);
1156 scav_vector_double_float(lispobj *where, lispobj object)
1158 struct vector *vector;
1161 vector = (struct vector *) where;
1162 length = fixnum_value(vector->length);
1163 nwords = CEILING(length * 2 + 2, 2);
1169 trans_vector_double_float(lispobj object)
1171 struct vector *vector;
1174 gc_assert(is_lisp_pointer(object));
1176 vector = (struct vector *) native_pointer(object);
1177 length = fixnum_value(vector->length);
1178 nwords = CEILING(length * 2 + 2, 2);
1180 return copy_large_unboxed_object(object, nwords);
1184 size_vector_double_float(lispobj *where)
1186 struct vector *vector;
1189 vector = (struct vector *) where;
1190 length = fixnum_value(vector->length);
1191 nwords = CEILING(length * 2 + 2, 2);
1196 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1198 scav_vector_long_float(lispobj *where, lispobj object)
1200 struct vector *vector;
1203 vector = (struct vector *) where;
1204 length = fixnum_value(vector->length);
1205 nwords = CEILING(length *
1212 trans_vector_long_float(lispobj object)
1214 struct vector *vector;
1217 gc_assert(is_lisp_pointer(object));
1219 vector = (struct vector *) native_pointer(object);
1220 length = fixnum_value(vector->length);
1221 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1223 return copy_large_unboxed_object(object, nwords);
1227 size_vector_long_float(lispobj *where)
1229 struct vector *vector;
1232 vector = (struct vector *) where;
1233 length = fixnum_value(vector->length);
1234 nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1241 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1243 scav_vector_complex_single_float(lispobj *where, lispobj object)
1245 struct vector *vector;
1248 vector = (struct vector *) where;
1249 length = fixnum_value(vector->length);
1250 nwords = CEILING(length * 2 + 2, 2);
1256 trans_vector_complex_single_float(lispobj object)
1258 struct vector *vector;
1261 gc_assert(is_lisp_pointer(object));
1263 vector = (struct vector *) native_pointer(object);
1264 length = fixnum_value(vector->length);
1265 nwords = CEILING(length * 2 + 2, 2);
1267 return copy_large_unboxed_object(object, nwords);
1271 size_vector_complex_single_float(lispobj *where)
1273 struct vector *vector;
1276 vector = (struct vector *) where;
1277 length = fixnum_value(vector->length);
1278 nwords = CEILING(length * 2 + 2, 2);
1284 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1286 scav_vector_complex_double_float(lispobj *where, lispobj object)
1288 struct vector *vector;
1291 vector = (struct vector *) where;
1292 length = fixnum_value(vector->length);
1293 nwords = CEILING(length * 4 + 2, 2);
1299 trans_vector_complex_double_float(lispobj object)
1301 struct vector *vector;
1304 gc_assert(is_lisp_pointer(object));
1306 vector = (struct vector *) native_pointer(object);
1307 length = fixnum_value(vector->length);
1308 nwords = CEILING(length * 4 + 2, 2);
1310 return copy_large_unboxed_object(object, nwords);
1314 size_vector_complex_double_float(lispobj *where)
1316 struct vector *vector;
1319 vector = (struct vector *) where;
1320 length = fixnum_value(vector->length);
1321 nwords = CEILING(length * 4 + 2, 2);
1328 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1330 scav_vector_complex_long_float(lispobj *where, lispobj object)
1332 struct vector *vector;
1335 vector = (struct vector *) where;
1336 length = fixnum_value(vector->length);
1337 nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1343 trans_vector_complex_long_float(lispobj object)
1345 struct vector *vector;
1348 gc_assert(is_lisp_pointer(object));
1350 vector = (struct vector *) native_pointer(object);
1351 length = fixnum_value(vector->length);
1352 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1354 return copy_large_unboxed_object(object, nwords);
1358 size_vector_complex_long_float(lispobj *where)
1360 struct vector *vector;
1363 vector = (struct vector *) where;
1364 length = fixnum_value(vector->length);
1365 nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1371 #define WEAK_POINTER_NWORDS \
1372 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1375 trans_weak_pointer(lispobj object)
1378 #ifndef LISP_FEATURE_GENCGC
1379 struct weak_pointer *wp;
1381 gc_assert(is_lisp_pointer(object));
1383 #if defined(DEBUG_WEAK)
1384 printf("Transporting weak pointer from 0x%08x\n", object);
1387 /* Need to remember where all the weak pointers are that have */
1388 /* been transported so they can be fixed up in a post-GC pass. */
1390 copy = copy_object(object, WEAK_POINTER_NWORDS);
1391 #ifndef LISP_FEATURE_GENCGC
1392 wp = (struct weak_pointer *) native_pointer(copy);
1394 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1395 /* Push the weak pointer onto the list of weak pointers. */
1396 wp->next = LOW_WORD(weak_pointers);
1403 size_weak_pointer(lispobj *where)
1405 return WEAK_POINTER_NWORDS;
1409 void scan_weak_pointers(void)
1411 struct weak_pointer *wp;
1412 for (wp = weak_pointers; wp != NULL;
1413 wp=(struct weak_pointer *)native_pointer(wp->next)) {
1414 lispobj value = wp->value;
1415 lispobj *first_pointer;
1416 gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1417 if (!(is_lisp_pointer(value) && from_space_p(value)))
1420 /* Now, we need to check whether the object has been forwarded. If
1421 * it has been, the weak pointer is still good and needs to be
1422 * updated. Otherwise, the weak pointer needs to be nil'ed
1425 first_pointer = (lispobj *)native_pointer(value);
1427 if (forwarding_pointer_p(first_pointer)) {
1429 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1445 scav_lose(lispobj *where, lispobj object)
1447 lose("no scavenge function for object 0x%08x (widetag 0x%x)",
1448 (unsigned long)object,
1449 widetag_of(*(lispobj*)native_pointer(object)));
1450 return 0; /* bogus return value to satisfy static type checking */
1454 trans_lose(lispobj object)
1456 lose("no transport function for object 0x%08x (widetag 0x%x)",
1457 (unsigned long)object,
1458 widetag_of(*(lispobj*)native_pointer(object)));
1459 return NIL; /* bogus return value to satisfy static type checking */
1463 size_lose(lispobj *where)
1465 lose("no size function for object at 0x%08x (widetag 0x%x)",
1466 (unsigned long)where,
1467 widetag_of(LOW_WORD(where)));
1468 return 1; /* bogus return value to satisfy static type checking */
1477 gc_init_tables(void)
1481 /* Set default value in all slots of scavenge table. FIXME
1482 * replace this gnarly sizeof with something based on
1484 for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) {
1485 scavtab[i] = scav_lose;
1488 /* For each type which can be selected by the lowtag alone, set
1489 * multiple entries in our widetag scavenge table (one for each
1490 * possible value of the high bits).
1493 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1494 scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1495 scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1496 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1497 scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1498 scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1499 scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_instance_pointer;
1500 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1501 scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1504 /* Other-pointer types (those selected by all eight bits of the
1505 * tag) get one entry each in the scavenge table. */
1506 scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1507 scavtab[RATIO_WIDETAG] = scav_boxed;
1508 scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1509 scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1510 #ifdef LONG_FLOAT_WIDETAG
1511 scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1513 scavtab[COMPLEX_WIDETAG] = scav_boxed;
1514 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1515 scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1517 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1518 scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1520 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1521 scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
1523 scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
1524 scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
1525 scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
1526 scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
1527 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1528 scav_vector_unsigned_byte_2;
1529 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1530 scav_vector_unsigned_byte_4;
1531 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1532 scav_vector_unsigned_byte_8;
1533 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1534 scav_vector_unsigned_byte_8;
1535 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1536 scav_vector_unsigned_byte_16;
1537 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1538 scav_vector_unsigned_byte_16;
1539 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1540 scav_vector_unsigned_byte_32;
1541 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1542 scav_vector_unsigned_byte_32;
1543 scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1544 scav_vector_unsigned_byte_32;
1545 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1546 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
1548 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1549 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1550 scav_vector_unsigned_byte_16;
1552 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1553 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1554 scav_vector_unsigned_byte_32;
1556 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1557 scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1558 scav_vector_unsigned_byte_32;
1560 scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
1561 scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
1562 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1563 scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
1565 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1566 scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1567 scav_vector_complex_single_float;
1569 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1570 scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1571 scav_vector_complex_double_float;
1573 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1574 scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1575 scav_vector_complex_long_float;
1577 scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
1578 scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
1579 scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
1580 scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
1581 scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
1582 scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
1583 #ifndef LISP_FEATURE_GENCGC /* FIXME ..._X86 ? */
1584 scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
1585 scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
1587 #ifdef LISP_FEATURE_X86
1588 scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
1589 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
1591 scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
1592 scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
1594 scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
1595 scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
1596 scavtab[BASE_CHAR_WIDETAG] = scav_immediate;
1597 scavtab[SAP_WIDETAG] = scav_unboxed;
1598 scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
1599 scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed;
1600 #ifdef LISP_FEATURE_SPARC
1601 scavtab[FDEFN_WIDETAG] = scav_boxed;
1603 scavtab[FDEFN_WIDETAG] = scav_fdefn;
1606 /* transport other table, initialized same way as scavtab */
1607 for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
1608 transother[i] = trans_lose;
1609 transother[BIGNUM_WIDETAG] = trans_unboxed;
1610 transother[RATIO_WIDETAG] = trans_boxed;
1611 transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1612 transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1613 #ifdef LONG_FLOAT_WIDETAG
1614 transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
1616 transother[COMPLEX_WIDETAG] = trans_boxed;
1617 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1618 transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1620 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1621 transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1623 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1624 transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
1626 transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
1627 transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
1628 transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
1629 transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
1630 transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
1631 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1632 trans_vector_unsigned_byte_2;
1633 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1634 trans_vector_unsigned_byte_4;
1635 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1636 trans_vector_unsigned_byte_8;
1637 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1638 trans_vector_unsigned_byte_8;
1639 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1640 trans_vector_unsigned_byte_16;
1641 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1642 trans_vector_unsigned_byte_16;
1643 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1644 trans_vector_unsigned_byte_32;
1645 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1646 trans_vector_unsigned_byte_32;
1647 transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1648 trans_vector_unsigned_byte_32;
1649 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1650 transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
1651 trans_vector_unsigned_byte_8;
1653 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1654 transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1655 trans_vector_unsigned_byte_16;
1657 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1658 transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1659 trans_vector_unsigned_byte_32;
1661 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1662 transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1663 trans_vector_unsigned_byte_32;
1665 transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
1666 trans_vector_single_float;
1667 transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
1668 trans_vector_double_float;
1669 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1670 transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
1671 trans_vector_long_float;
1673 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1674 transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1675 trans_vector_complex_single_float;
1677 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1678 transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1679 trans_vector_complex_double_float;
1681 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1682 transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1683 trans_vector_complex_long_float;
1685 transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
1686 transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
1687 transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
1688 transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
1689 transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
1690 transother[CODE_HEADER_WIDETAG] = trans_code_header;
1691 transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
1692 transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
1693 transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
1694 transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
1695 transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
1696 transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
1697 transother[BASE_CHAR_WIDETAG] = trans_immediate;
1698 transother[SAP_WIDETAG] = trans_unboxed;
1699 transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
1700 transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
1701 transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
1702 transother[FDEFN_WIDETAG] = trans_boxed;
1704 /* size table, initialized the same way as scavtab */
1705 for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
1706 sizetab[i] = size_lose;
1707 for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1708 sizetab[EVEN_FIXNUM_LOWTAG|(i<<3)] = size_immediate;
1709 sizetab[FUN_POINTER_LOWTAG|(i<<3)] = size_pointer;
1710 /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1711 sizetab[LIST_POINTER_LOWTAG|(i<<3)] = size_pointer;
1712 sizetab[ODD_FIXNUM_LOWTAG|(i<<3)] = size_immediate;
1713 sizetab[INSTANCE_POINTER_LOWTAG|(i<<3)] = size_pointer;
1714 /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1715 sizetab[OTHER_POINTER_LOWTAG|(i<<3)] = size_pointer;
1717 sizetab[BIGNUM_WIDETAG] = size_unboxed;
1718 sizetab[RATIO_WIDETAG] = size_boxed;
1719 sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
1720 sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1721 #ifdef LONG_FLOAT_WIDETAG
1722 sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
1724 sizetab[COMPLEX_WIDETAG] = size_boxed;
1725 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1726 sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
1728 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1729 sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1731 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1732 sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
1734 sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
1735 sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
1736 sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
1737 sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
1738 sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
1739 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1740 size_vector_unsigned_byte_2;
1741 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1742 size_vector_unsigned_byte_4;
1743 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1744 size_vector_unsigned_byte_8;
1745 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1746 size_vector_unsigned_byte_8;
1747 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1748 size_vector_unsigned_byte_16;
1749 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1750 size_vector_unsigned_byte_16;
1751 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1752 size_vector_unsigned_byte_32;
1753 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1754 size_vector_unsigned_byte_32;
1755 sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1756 size_vector_unsigned_byte_32;
1757 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1758 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
1760 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1761 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1762 size_vector_unsigned_byte_16;
1764 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1765 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1766 size_vector_unsigned_byte_32;
1768 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1769 sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1770 size_vector_unsigned_byte_32;
1772 sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
1773 sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
1774 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1775 sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
1777 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1778 sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1779 size_vector_complex_single_float;
1781 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1782 sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1783 size_vector_complex_double_float;
1785 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1786 sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1787 size_vector_complex_long_float;
1789 sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
1790 sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
1791 sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
1792 sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
1793 sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
1794 sizetab[CODE_HEADER_WIDETAG] = size_code_header;
1796 /* We shouldn't see these, so just lose if it happens. */
1797 sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
1798 sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
1800 sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
1801 sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
1802 sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
1803 sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
1804 sizetab[BASE_CHAR_WIDETAG] = size_immediate;
1805 sizetab[SAP_WIDETAG] = size_unboxed;
1806 sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
1807 sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
1808 sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
1809 sizetab[FDEFN_WIDETAG] = size_boxed;