2 * stop and copy GC based on Cheney's algorithm
6 * This software is part of the SBCL system. See the README file for
9 * This software is derived from the CMU CL system, which was
10 * written at Carnegie Mellon University and released into the
11 * public domain. The software is in the public domain and is
12 * provided with absolutely no warranty. See the COPYING and CREDITS
13 * files for more information.
18 #include <sys/resource.h>
25 #include "interrupt.h"
30 /* So you need to debug? */
33 #define DEBUG_SPACE_PREDICATES
34 #define DEBUG_SCAVENGE_VERBOSE
35 #define DEBUG_COPY_VERBOSE
39 static lispobj *from_space;
40 static lispobj *from_space_free_pointer;
42 static lispobj *new_space;
43 static lispobj *new_space_free_pointer;
45 static int (*scavtab[256])(lispobj *where, lispobj object);
46 static lispobj (*transother[256])(lispobj object);
47 static int (*sizetab[256])(lispobj *where);
49 static struct weak_pointer *weak_pointers;
51 static void scavenge(lispobj *start, u32 nwords);
52 static void scavenge_newspace(void);
53 static void scavenge_interrupt_contexts(void);
54 static void scan_weak_pointers(void);
55 static int scav_lose(lispobj *where, lispobj object);
57 #define gc_abort() lose("GC invariant lost! File \"%s\", line %d\n", \
61 #define gc_assert(ex) do { \
62 if (!(ex)) gc_abort(); \
68 #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
73 #if defined(DEBUG_SPACE_PREDICATES)
76 from_space_p(lispobj object)
80 /* this can be called for untagged pointers as well as for
81 descriptors, so this assertion's not applicable
82 gc_assert(Pointerp(object));
84 ptr = (lispobj *) PTR(object);
86 return ((from_space <= ptr) &&
87 (ptr < from_space_free_pointer));
91 new_space_p(lispobj object)
95 gc_assert(Pointerp(object));
97 ptr = (lispobj *) PTR(object);
99 return ((new_space <= ptr) &&
100 (ptr < new_space_free_pointer));
105 #define from_space_p(ptr) \
106 ((from_space <= ((lispobj *) ptr)) && \
107 (((lispobj *) ptr) < from_space_free_pointer))
109 #define new_space_p(ptr) \
110 ((new_space <= ((lispobj *) ptr)) && \
111 (((lispobj *) ptr) < new_space_free_pointer))
116 /* copying objects */
119 copy_object(lispobj object, int nwords)
123 lispobj *source, *dest;
125 gc_assert(Pointerp(object));
126 gc_assert(from_space_p(object));
127 gc_assert((nwords & 0x01) == 0);
129 /* get tag of object */
130 tag = LowtagOf(object);
133 new = new_space_free_pointer;
134 new_space_free_pointer += nwords;
137 source = (lispobj *) PTR(object);
139 #ifdef DEBUG_COPY_VERBOSE
140 fprintf(stderr,"Copying %d words from %p to %p\n", nwords,source,new);
143 /* copy the object */
151 /* return lisp pointer of new object */
152 return (lispobj)(LOW_WORD(new) | tag);
156 /* collecting garbage */
160 tv_diff(struct timeval *x, struct timeval *y)
162 return (((double) x->tv_sec + (double) x->tv_usec * 1.0e-6) -
163 ((double) y->tv_sec + (double) y->tv_usec * 1.0e-6));
167 #define BYTES_ZERO_BEFORE_END (1<<12)
172 #define U32 unsigned long
177 U32 *ptr = (U32 *)current_control_stack_pointer;
183 } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
188 } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
195 /* Note: The generic GC interface we're implementing passes us a
196 * last_generation argument. That's meaningless for us, since we're
197 * not a generational GC. So we ignore it. */
199 collect_garbage(unsigned ignore)
202 struct timeval start_tv, stop_tv;
203 struct rusage start_rusage, stop_rusage;
204 double real_time, system_time, user_time;
205 double percent_retained, gc_rate;
206 unsigned long size_discarded;
207 unsigned long size_retained;
209 lispobj *current_static_space_free_pointer;
210 unsigned long static_space_size;
211 unsigned long control_stack_size, binding_stack_size;
215 printf("[Collecting garbage ... \n");
217 getrusage(RUSAGE_SELF, &start_rusage);
218 gettimeofday(&start_tv, (struct timezone *) 0);
222 sigaddset_blockable(&tmp);
223 sigprocmask(SIG_BLOCK, &tmp, &old);
225 current_static_space_free_pointer =
226 (lispobj *) ((unsigned long)
227 SymbolValue(STATIC_SPACE_FREE_POINTER));
230 /* Set up from space and new space pointers. */
232 from_space = current_dynamic_space;
234 from_space_free_pointer = dynamic_space_free_pointer;
236 from_space_free_pointer = (lispobj *)SymbolValue(ALLOCATION_POINTER);
240 fprintf(stderr,"from_space = %lx\n",
241 (unsigned long) current_dynamic_space);
243 if (current_dynamic_space == (lispobj *) DYNAMIC_0_SPACE_START)
244 new_space = (lispobj *)DYNAMIC_1_SPACE_START;
245 else if (current_dynamic_space == (lispobj *) DYNAMIC_1_SPACE_START)
246 new_space = (lispobj *) DYNAMIC_0_SPACE_START;
248 lose("GC lossage. Current dynamic space is bogus!\n");
250 new_space_free_pointer = new_space;
253 /* Initialize the weak pointer list. */
254 weak_pointers = (struct weak_pointer *) NULL;
257 /* Scavenge all of the roots. */
259 printf("Scavenging interrupt contexts ...\n");
261 scavenge_interrupt_contexts();
264 printf("Scavenging interrupt handlers (%d bytes) ...\n",
265 (int)sizeof(interrupt_handlers));
267 scavenge((lispobj *) interrupt_handlers,
268 sizeof(interrupt_handlers) / sizeof(lispobj));
270 /* _size quantities are in units of sizeof(lispobj) - i.e. 4 */
272 current_control_stack_pointer-
273 (lispobj *)CONTROL_STACK_START;
275 printf("Scavenging the control stack at %p (%ld words) ...\n",
276 ((lispobj *)CONTROL_STACK_START),
279 scavenge(((lispobj *)CONTROL_STACK_START), control_stack_size);
284 (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack;
287 current_binding_stack_pointer -
288 (lispobj *)BINDING_STACK_START;
291 printf("Scavenging the binding stack %x - %x (%d words) ...\n",
292 BINDING_STACK_START,current_binding_stack_pointer,
293 (int)(binding_stack_size));
295 scavenge(((lispobj *)BINDING_STACK_START), binding_stack_size);
298 current_static_space_free_pointer - (lispobj *) STATIC_SPACE_START;
300 printf("Scavenging static space %x - %x (%d words) ...\n",
301 STATIC_SPACE_START,current_static_space_free_pointer,
302 (int)(static_space_size));
304 scavenge(((lispobj *)STATIC_SPACE_START), static_space_size);
306 /* Scavenge newspace. */
308 printf("Scavenging new space (%d bytes) ...\n",
309 (int)((new_space_free_pointer - new_space) * sizeof(lispobj)));
314 #if defined(DEBUG_PRINT_GARBAGE)
315 print_garbage(from_space, from_space_free_pointer);
318 /* Scan the weak pointers. */
320 printf("Scanning weak pointers ...\n");
322 scan_weak_pointers();
327 printf("Flipping spaces ...\n");
330 os_zero((os_vm_address_t) current_dynamic_space,
331 (os_vm_size_t) DYNAMIC_SPACE_SIZE);
333 current_dynamic_space = new_space;
335 dynamic_space_free_pointer = new_space_free_pointer;
337 SetSymbolValue(ALLOCATION_POINTER, (lispobj)new_space_free_pointer);
341 size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj);
342 size_retained = (new_space_free_pointer - new_space) * sizeof(lispobj);
347 printf("Zeroing empty part of control stack ...\n");
351 sigprocmask(SIG_SETMASK, &old, 0);
355 gettimeofday(&stop_tv, (struct timezone *) 0);
356 getrusage(RUSAGE_SELF, &stop_rusage);
360 percent_retained = (((float) size_retained) /
361 ((float) size_discarded)) * 100.0;
363 printf("Total of %ld bytes out of %ld bytes retained (%3.2f%%).\n",
364 size_retained, size_discarded, percent_retained);
366 real_time = tv_diff(&stop_tv, &start_tv);
367 user_time = tv_diff(&stop_rusage.ru_utime, &start_rusage.ru_utime);
368 system_time = tv_diff(&stop_rusage.ru_stime, &start_rusage.ru_stime);
371 printf("Statistics:\n");
372 printf("%10.2f sec of real time\n", real_time);
373 printf("%10.2f sec of user time,\n", user_time);
374 printf("%10.2f sec of system time.\n", system_time);
376 printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n",
377 real_time, user_time, system_time);
380 gc_rate = ((float) size_retained / (float) (1<<20)) / real_time;
382 printf("%10.2f M bytes/sec collected.\n", gc_rate);
389 #define DIRECT_SCAV 0
392 scavenge(lispobj *start, u32 nwords)
396 int type, words_scavenged;
399 type = TypeOf(object);
401 #if defined(DEBUG_SCAVENGE_VERBOSE)
402 fprintf(stderr,"Scavenging object at 0x%08x, object = 0x%08x, type = %d\n",
403 (unsigned long) start, (unsigned long) object, type);
407 words_scavenged = (scavtab[type])(start, object);
409 if (Pointerp(object)) {
410 /* It be a pointer. */
411 if (from_space_p(object)) {
412 /* It currently points to old space. Check for a */
413 /* forwarding pointer. */
416 first_word = *((lispobj *)PTR(object));
417 if (Pointerp(first_word) && new_space_p(first_word)) {
418 /* Yep, there be a forwarding pointer. */
423 /* Scavenge that pointer. */
424 words_scavenged = (scavtab[type])(start, object);
428 /* It points somewhere other than oldspace. Leave */
434 /* there are some situations where an
435 other-immediate may end up in a descriptor
436 register. I'm not sure whether this is
437 supposed to happen, but if it does then we
438 don't want to (a) barf or (b) scavenge over the
439 data-block, because there isn't one. So, if
440 we're checking a single word and it's anything
441 other than a pointer, just hush it up */
444 if((scavtab[type]==scav_lose) ||
445 (((scavtab[type])(start,object))>1)) {
446 fprintf(stderr,"warning: attempted to scavenge non-descriptor value %x at %p. If you can\nreproduce this warning, send a test case to sbcl-devel@lists.sourceforge.net\n",
450 else if ((object & 3) == 0) {
451 /* It's a fixnum. Real easy. */
455 /* It's some random header object. */
456 words_scavenged = (scavtab[type])(start, object);
460 start += words_scavenged;
461 nwords -= words_scavenged;
463 gc_assert(nwords == 0);
467 scavenge_newspace(void)
469 lispobj *here, *next;
472 while (here < new_space_free_pointer) {
473 /* printf("here=%lx, new_space_free_pointer=%lx\n",
474 here,new_space_free_pointer); */
475 next = new_space_free_pointer;
476 scavenge(here, next - here);
479 /* printf("done with newspace\n"); */
482 /* scavenging interrupt contexts */
484 static int boxed_registers[] = BOXED_REGISTERS;
487 scavenge_interrupt_context(os_context_t *context)
492 unsigned long lip_offset;
493 int lip_register_pair;
495 unsigned long pc_code_offset;
497 unsigned long npc_code_offset;
500 /* Find the LIP's register pair and calculate its offset */
501 /* before we scavenge the context. */
503 lip = *os_context_register_addr(context, reg_LIP);
504 /* 0x7FFFFFFF or 0x7FFFFFFFFFFFFFFF ? */
505 lip_offset = 0x7FFFFFFF;
506 lip_register_pair = -1;
507 for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
512 index = boxed_registers[i];
513 reg = *os_context_register_addr(context, index);
514 /* would be using PTR if not for integer length issues */
515 if ((reg & ~((1L<<lowtag_Bits)-1)) <= lip) {
517 if (offset < lip_offset) {
519 lip_register_pair = index;
525 /* Compute the PC's offset from the start of the CODE */
527 pc_code_offset = *os_context_pc_addr(context) -
528 *os_context_register_addr(context, reg_CODE);
530 npc_code_offset = SC_NPC(context) - SC_REG(context, reg_CODE);
533 /* Scanvenge all boxed registers in the context. */
534 for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
538 index = boxed_registers[i];
539 foo = *os_context_register_addr(context,index);
540 scavenge((lispobj *) &foo, 1);
541 *os_context_register_addr(context,index) = foo;
543 /* this is unlikely to work as intended on bigendian
544 * 64 bit platforms */
547 os_context_register_addr(context, index), 1);
552 *os_context_register_addr(context, reg_LIP) =
553 *os_context_register_addr(context, lip_register_pair) + lip_offset;
556 /* Fix the PC if it was in from space */
557 if (from_space_p(*os_context_pc_addr(context)))
558 *os_context_pc_addr(context) =
559 *os_context_register_addr(context, reg_CODE) + pc_code_offset;
561 if (from_space_p(SC_NPC(context)))
562 SC_NPC(context) = SC_REG(context, reg_CODE) + npc_code_offset;
566 void scavenge_interrupt_contexts(void)
569 os_context_t *context;
571 index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX));
573 for (i = 0; i < index; i++) {
574 context = lisp_interrupt_contexts[i];
575 scavenge_interrupt_context(context);
583 print_garbage(lispobj *from_space, lispobj *from_space_free_pointer)
586 int total_words_not_copied;
588 printf("Scanning from space ...\n");
590 total_words_not_copied = 0;
592 while (start < from_space_free_pointer) {
594 int forwardp, type, nwords;
598 forwardp = Pointerp(object) && new_space_p(object);
604 tag = LowtagOf(object);
607 case type_ListPointer:
610 case type_InstancePointer:
611 printf("Don't know about instances yet!\n");
614 case type_FunctionPointer:
617 case type_OtherPointer:
618 pointer = (lispobj *) PTR(object);
620 type = TypeOf(header);
621 nwords = (sizetab[type])(pointer);
624 type = TypeOf(object);
625 nwords = (sizetab[type])(start);
626 total_words_not_copied += nwords;
627 printf("%4d words not copied at 0x%16lx; ",
628 nwords, (unsigned long) start);
629 printf("Header word is 0x%08x\n",
630 (unsigned int) object);
634 printf("%d total words not copied.\n", total_words_not_copied);
638 /* code and code-related objects */
640 #define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)
642 static lispobj trans_function_header(lispobj object);
643 static lispobj trans_boxed(lispobj object);
647 scav_function_pointer(lispobj *where, lispobj object)
649 gc_assert(Pointerp(object));
651 if (from_space_p(object)) {
652 lispobj first, *first_pointer;
654 /* object is a pointer into from space. check to see */
655 /* if it has been forwarded */
656 first_pointer = (lispobj *) PTR(object);
657 first = *first_pointer;
659 if (!(Pointerp(first) && new_space_p(first))) {
663 /* must transport object -- object may point */
664 /* to either a function header, a closure */
665 /* function header, or to a closure header. */
667 type = TypeOf(first);
669 case type_FunctionHeader:
670 case type_ClosureFunctionHeader:
671 copy = trans_function_header(object);
674 copy = trans_boxed(object);
678 first = *first_pointer = copy;
681 gc_assert(Pointerp(first));
682 gc_assert(!from_space_p(first));
690 scav_function_pointer(lispobj *where, lispobj object)
692 lispobj *first_pointer;
697 gc_assert(Pointerp(object));
699 /* object is a pointer into from space. Not a FP */
700 first_pointer = (lispobj *) PTR(object);
701 first = *first_pointer;
703 /* must transport object -- object may point */
704 /* to either a function header, a closure */
705 /* function header, or to a closure header. */
707 type = TypeOf(first);
709 case type_FunctionHeader:
710 case type_ClosureFunctionHeader:
711 copy = trans_function_header(object);
714 copy = trans_boxed(object);
718 first = *first_pointer = copy;
720 gc_assert(Pointerp(first));
721 gc_assert(!from_space_p(first));
729 trans_code(struct code *code)
731 struct code *new_code;
732 lispobj first, l_code, l_new_code;
733 int nheader_words, ncode_words, nwords;
734 unsigned long displacement;
735 lispobj fheaderl, *prev_pointer;
737 #if defined(DEBUG_CODE_GC)
738 printf("\nTransporting code object located at 0x%08x.\n",
739 (unsigned long) code);
742 /* if object has already been transported, just return pointer */
743 first = code->header;
744 if (Pointerp(first) && new_space_p(first)) {
746 printf("Was already transported\n");
748 return (struct code *) PTR(first);
751 gc_assert(TypeOf(first) == type_CodeHeader);
753 /* prepare to transport the code vector */
754 l_code = (lispobj) LOW_WORD(code) | type_OtherPointer;
756 ncode_words = fixnum_value(code->code_size);
757 nheader_words = HeaderValue(code->header);
758 nwords = ncode_words + nheader_words;
759 nwords = CEILING(nwords, 2);
761 l_new_code = copy_object(l_code, nwords);
762 new_code = (struct code *) PTR(l_new_code);
764 displacement = l_new_code - l_code;
766 #if defined(DEBUG_CODE_GC)
767 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
768 (unsigned long) code, (unsigned long) new_code);
769 printf("Code object is %d words long.\n", nwords);
772 /* set forwarding pointer */
773 code->header = l_new_code;
775 /* set forwarding pointers for all the function headers in the */
776 /* code object. also fix all self pointers */
778 fheaderl = code->entry_points;
779 prev_pointer = &new_code->entry_points;
781 while (fheaderl != NIL) {
782 struct function *fheaderp, *nfheaderp;
785 fheaderp = (struct function *) PTR(fheaderl);
786 gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
788 /* calcuate the new function pointer and the new */
789 /* function header */
790 nfheaderl = fheaderl + displacement;
791 nfheaderp = (struct function *) PTR(nfheaderl);
793 /* set forwarding pointer */
795 printf("fheaderp->header (at %x) <- %x\n",
796 &(fheaderp->header) , nfheaderl);
798 fheaderp->header = nfheaderl;
800 /* fix self pointer */
801 nfheaderp->self = nfheaderl;
803 *prev_pointer = nfheaderl;
805 fheaderl = fheaderp->next;
806 prev_pointer = &nfheaderp->next;
810 os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words),
811 ncode_words * sizeof(int));
817 scav_code_header(lispobj *where, lispobj object)
820 int nheader_words, ncode_words, nwords;
822 struct function *fheaderp;
824 code = (struct code *) where;
825 ncode_words = fixnum_value(code->code_size);
826 nheader_words = HeaderValue(object);
827 nwords = ncode_words + nheader_words;
828 nwords = CEILING(nwords, 2);
830 #if defined(DEBUG_CODE_GC)
831 printf("\nScavening code object at 0x%08x.\n",
832 (unsigned long) where);
833 printf("Code object is %d words long.\n", nwords);
834 printf("Scavenging boxed section of code data block (%d words).\n",
838 /* Scavenge the boxed section of the code data block */
839 scavenge(where + 1, nheader_words - 1);
841 /* Scavenge the boxed section of each function object in the */
842 /* code data block */
843 fheaderl = code->entry_points;
844 while (fheaderl != NIL) {
845 fheaderp = (struct function *) PTR(fheaderl);
846 gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
848 #if defined(DEBUG_CODE_GC)
849 printf("Scavenging boxed section of entry point located at 0x%08x.\n",
850 (unsigned long) PTR(fheaderl));
852 scavenge(&fheaderp->name, 1);
853 scavenge(&fheaderp->arglist, 1);
854 scavenge(&fheaderp->type, 1);
856 fheaderl = fheaderp->next;
863 trans_code_header(lispobj object)
867 ncode = trans_code((struct code *) PTR(object));
868 return (lispobj) LOW_WORD(ncode) | type_OtherPointer;
872 size_code_header(lispobj *where)
875 int nheader_words, ncode_words, nwords;
877 code = (struct code *) where;
879 ncode_words = fixnum_value(code->code_size);
880 nheader_words = HeaderValue(code->header);
881 nwords = ncode_words + nheader_words;
882 nwords = CEILING(nwords, 2);
889 scav_return_pc_header(lispobj *where, lispobj object)
891 fprintf(stderr, "GC lossage. Should not be scavenging a ");
892 fprintf(stderr, "Return PC Header.\n");
893 fprintf(stderr, "where = 0x%p, object = 0x%x", where, object);
899 trans_return_pc_header(lispobj object)
901 struct function *return_pc;
902 unsigned long offset;
903 struct code *code, *ncode;
905 return_pc = (struct function *) PTR(object);
906 offset = HeaderValue(return_pc->header) * 4 ;
908 /* Transport the whole code object */
909 code = (struct code *) ((unsigned long) return_pc - offset);
911 printf("trans_return_pc_header object=%x, code=%lx\n",object,code);
913 ncode = trans_code(code);
914 if(object==0x304748d7) {
917 ret= ((lispobj) LOW_WORD(ncode) + offset) | type_OtherPointer;
919 printf("trans_return_pc_header returning %x\n",ret);
924 /* On the 386, closures hold a pointer to the raw address instead of
925 * the function object, so we can use CALL [$FDEFN+const] to invoke
926 * the function without loading it into a register. Given that code
927 * objects don't move, we don't need to update anything, but we do
928 * have to figure out that the function is still live. */
931 scav_closure_header(where, object)
932 lispobj *where, object;
934 struct closure *closure;
937 closure = (struct closure *)where;
938 fun = closure->function - RAW_ADDR_OFFSET;
946 scav_function_header(lispobj *where, lispobj object)
948 fprintf(stderr, "GC lossage. Should not be scavenging a ");
949 fprintf(stderr, "Function Header.\n");
950 fprintf(stderr, "where = 0x%p, object = 0x%08x",
951 where, (unsigned int) object);
957 trans_function_header(lispobj object)
959 struct function *fheader;
960 unsigned long offset;
961 struct code *code, *ncode;
963 fheader = (struct function *) PTR(object);
964 offset = HeaderValue(fheader->header) * 4;
966 /* Transport the whole code object */
967 code = (struct code *) ((unsigned long) fheader - offset);
968 ncode = trans_code(code);
970 return ((lispobj) LOW_WORD(ncode) + offset) | type_FunctionPointer;
979 scav_instance_pointer(lispobj *where, lispobj object)
981 if (from_space_p(object)) {
982 lispobj first, *first_pointer;
984 /* object is a pointer into from space. check to see */
985 /* if it has been forwarded */
986 first_pointer = (lispobj *) PTR(object);
987 first = *first_pointer;
989 if (!(Pointerp(first) && new_space_p(first)))
990 first = *first_pointer = trans_boxed(object);
997 scav_instance_pointer(lispobj *where, lispobj object)
999 lispobj *first_pointer;
1001 /* object is a pointer into from space. Not a FP */
1002 first_pointer = (lispobj *) PTR(object);
1004 *where = *first_pointer = trans_boxed(object);
1010 /* lists and conses */
1012 static lispobj trans_list(lispobj object);
1016 scav_list_pointer(lispobj *where, lispobj object)
1018 gc_assert(Pointerp(object));
1020 if (from_space_p(object)) {
1021 lispobj first, *first_pointer;
1023 /* object is a pointer into from space. check to see */
1024 /* if it has been forwarded */
1025 first_pointer = (lispobj *) PTR(object);
1026 first = *first_pointer;
1028 if (!(Pointerp(first) && new_space_p(first)))
1029 first = *first_pointer = trans_list(object);
1031 gc_assert(Pointerp(first));
1032 gc_assert(!from_space_p(first));
1040 scav_list_pointer(lispobj *where, lispobj object)
1042 lispobj first, *first_pointer;
1044 gc_assert(Pointerp(object));
1046 /* object is a pointer into from space. Not a FP. */
1047 first_pointer = (lispobj *) PTR(object);
1049 first = *first_pointer = trans_list(object);
1051 gc_assert(Pointerp(first));
1052 gc_assert(!from_space_p(first));
1060 trans_list(lispobj object)
1062 lispobj new_list_pointer;
1063 struct cons *cons, *new_cons;
1065 cons = (struct cons *) PTR(object);
1067 /* ### Don't use copy_object here. */
1068 new_list_pointer = copy_object(object, 2);
1069 new_cons = (struct cons *) PTR(new_list_pointer);
1071 /* Set forwarding pointer. */
1072 cons->car = new_list_pointer;
1074 /* Try to linearize the list in the cdr direction to help reduce */
1078 lispobj cdr, new_cdr, first;
1079 struct cons *cdr_cons, *new_cdr_cons;
1083 if (LowtagOf(cdr) != type_ListPointer ||
1084 !from_space_p(cdr) ||
1085 (Pointerp(first = *(lispobj *)PTR(cdr)) &&
1086 new_space_p(first)))
1089 cdr_cons = (struct cons *) PTR(cdr);
1091 /* ### Don't use copy_object here */
1092 new_cdr = copy_object(cdr, 2);
1093 new_cdr_cons = (struct cons *) PTR(new_cdr);
1095 /* Set forwarding pointer */
1096 cdr_cons->car = new_cdr;
1098 /* Update the cdr of the last cons copied into new */
1099 /* space to keep the newspace scavenge from having to */
1101 new_cons->cdr = new_cdr;
1104 new_cons = new_cdr_cons;
1107 return new_list_pointer;
1111 /* scavenging and transporting other pointers */
1115 scav_other_pointer(lispobj *where, lispobj object)
1117 gc_assert(Pointerp(object));
1119 if (from_space_p(object)) {
1120 lispobj first, *first_pointer;
1122 /* object is a pointer into from space. check to see */
1123 /* if it has been forwarded */
1124 first_pointer = (lispobj *) PTR(object);
1125 first = *first_pointer;
1127 if (!(Pointerp(first) && new_space_p(first)))
1128 first = *first_pointer =
1129 (transother[TypeOf(first)])(object);
1131 gc_assert(Pointerp(first));
1132 gc_assert(!from_space_p(first));
1140 scav_other_pointer(lispobj *where, lispobj object)
1142 lispobj first, *first_pointer;
1144 gc_assert(Pointerp(object));
1146 /* Object is a pointer into from space - not a FP */
1147 first_pointer = (lispobj *) PTR(object);
1148 first = *first_pointer = (transother[TypeOf(*first_pointer)])(object);
1150 gc_assert(Pointerp(first));
1151 gc_assert(!from_space_p(first));
1159 /* immediate, boxed, and unboxed objects */
1162 size_pointer(lispobj *where)
1168 scav_immediate(lispobj *where, lispobj object)
1174 trans_immediate(lispobj object)
1176 fprintf(stderr, "GC lossage. Trying to transport an immediate!?\n");
1182 size_immediate(lispobj *where)
1189 scav_boxed(lispobj *where, lispobj object)
1195 trans_boxed(lispobj object)
1198 unsigned long length;
1200 gc_assert(Pointerp(object));
1202 header = *((lispobj *) PTR(object));
1203 length = HeaderValue(header) + 1;
1204 length = CEILING(length, 2);
1206 return copy_object(object, length);
1210 size_boxed(lispobj *where)
1213 unsigned long length;
1216 length = HeaderValue(header) + 1;
1217 length = CEILING(length, 2);
1222 /* Note: on the sparc we don't have to do anything special for fdefns, */
1223 /* 'cause the raw-addr has a function lowtag. */
1226 scav_fdefn(lispobj *where, lispobj object)
1228 struct fdefn *fdefn;
1230 fdefn = (struct fdefn *)where;
1232 if ((char *)(fdefn->function + RAW_ADDR_OFFSET)
1233 == (char *)((unsigned long)(fdefn->raw_addr))) {
1234 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
1235 fdefn->raw_addr = (u32) ((char *) LOW_WORD(fdefn->function)) + RAW_ADDR_OFFSET;
1236 return sizeof(struct fdefn) / sizeof(lispobj);
1244 scav_unboxed(lispobj *where, lispobj object)
1246 unsigned long length;
1248 length = HeaderValue(object) + 1;
1249 length = CEILING(length, 2);
1255 trans_unboxed(lispobj object)
1258 unsigned long length;
1261 gc_assert(Pointerp(object));
1263 header = *((lispobj *) PTR(object));
1264 length = HeaderValue(header) + 1;
1265 length = CEILING(length, 2);
1267 return copy_object(object, length);
1271 size_unboxed(lispobj *where)
1274 unsigned long length;
1277 length = HeaderValue(header) + 1;
1278 length = CEILING(length, 2);
1284 /* vector-like objects */
1286 #define NWORDS(x,y) (CEILING((x),(y)) / (y))
1289 scav_string(lispobj *where, lispobj object)
1291 struct vector *vector;
1294 /* NOTE: Strings contain one more byte of data than the length */
1295 /* slot indicates. */
1297 vector = (struct vector *) where;
1298 length = fixnum_value(vector->length) + 1;
1299 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1305 trans_string(lispobj object)
1307 struct vector *vector;
1310 gc_assert(Pointerp(object));
1312 /* NOTE: Strings contain one more byte of data than the length */
1313 /* slot indicates. */
1315 vector = (struct vector *) PTR(object);
1316 length = fixnum_value(vector->length) + 1;
1317 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1319 return copy_object(object, nwords);
1323 size_string(lispobj *where)
1325 struct vector *vector;
1328 /* NOTE: Strings contain one more byte of data than the length */
1329 /* slot indicates. */
1331 vector = (struct vector *) where;
1332 length = fixnum_value(vector->length) + 1;
1333 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1339 scav_vector(lispobj *where, lispobj object)
1341 if (HeaderValue(object) == subtype_VectorValidHashing)
1342 *where = (subtype_VectorMustRehash<<type_Bits) | type_SimpleVector;
1349 trans_vector(lispobj object)
1351 struct vector *vector;
1354 gc_assert(Pointerp(object));
1356 vector = (struct vector *) PTR(object);
1358 length = fixnum_value(vector->length);
1359 nwords = CEILING(length + 2, 2);
1361 return copy_object(object, nwords);
1365 size_vector(lispobj *where)
1367 struct vector *vector;
1370 vector = (struct vector *) where;
1371 length = fixnum_value(vector->length);
1372 nwords = CEILING(length + 2, 2);
1379 scav_vector_bit(lispobj *where, lispobj object)
1381 struct vector *vector;
1384 vector = (struct vector *) where;
1385 length = fixnum_value(vector->length);
1386 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1392 trans_vector_bit(lispobj object)
1394 struct vector *vector;
1397 gc_assert(Pointerp(object));
1399 vector = (struct vector *) PTR(object);
1400 length = fixnum_value(vector->length);
1401 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1403 return copy_object(object, nwords);
1407 size_vector_bit(lispobj *where)
1409 struct vector *vector;
1412 vector = (struct vector *) where;
1413 length = fixnum_value(vector->length);
1414 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1421 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
1423 struct vector *vector;
1426 vector = (struct vector *) where;
1427 length = fixnum_value(vector->length);
1428 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1434 trans_vector_unsigned_byte_2(lispobj object)
1436 struct vector *vector;
1439 gc_assert(Pointerp(object));
1441 vector = (struct vector *) PTR(object);
1442 length = fixnum_value(vector->length);
1443 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1445 return copy_object(object, nwords);
1449 size_vector_unsigned_byte_2(lispobj *where)
1451 struct vector *vector;
1454 vector = (struct vector *) where;
1455 length = fixnum_value(vector->length);
1456 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1463 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
1465 struct vector *vector;
1468 vector = (struct vector *) where;
1469 length = fixnum_value(vector->length);
1470 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1476 trans_vector_unsigned_byte_4(lispobj object)
1478 struct vector *vector;
1481 gc_assert(Pointerp(object));
1483 vector = (struct vector *) PTR(object);
1484 length = fixnum_value(vector->length);
1485 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1487 return copy_object(object, nwords);
1491 size_vector_unsigned_byte_4(lispobj *where)
1493 struct vector *vector;
1496 vector = (struct vector *) where;
1497 length = fixnum_value(vector->length);
1498 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1505 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
1507 struct vector *vector;
1510 vector = (struct vector *) where;
1511 length = fixnum_value(vector->length);
1512 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1518 trans_vector_unsigned_byte_8(lispobj object)
1520 struct vector *vector;
1523 gc_assert(Pointerp(object));
1525 vector = (struct vector *) PTR(object);
1526 length = fixnum_value(vector->length);
1527 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1529 return copy_object(object, nwords);
1533 size_vector_unsigned_byte_8(lispobj *where)
1535 struct vector *vector;
1538 vector = (struct vector *) where;
1539 length = fixnum_value(vector->length);
1540 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1547 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1549 struct vector *vector;
1552 vector = (struct vector *) where;
1553 length = fixnum_value(vector->length);
1554 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1560 trans_vector_unsigned_byte_16(lispobj object)
1562 struct vector *vector;
1565 gc_assert(Pointerp(object));
1567 vector = (struct vector *) PTR(object);
1568 length = fixnum_value(vector->length);
1569 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1571 return copy_object(object, nwords);
1575 size_vector_unsigned_byte_16(lispobj *where)
1577 struct vector *vector;
1580 vector = (struct vector *) where;
1581 length = fixnum_value(vector->length);
1582 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1589 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1591 struct vector *vector;
1594 vector = (struct vector *) where;
1595 length = fixnum_value(vector->length);
1596 nwords = CEILING(length + 2, 2);
1602 trans_vector_unsigned_byte_32(lispobj object)
1604 struct vector *vector;
1607 gc_assert(Pointerp(object));
1609 vector = (struct vector *) PTR(object);
1610 length = fixnum_value(vector->length);
1611 nwords = CEILING(length + 2, 2);
1613 return copy_object(object, nwords);
1617 size_vector_unsigned_byte_32(lispobj *where)
1619 struct vector *vector;
1622 vector = (struct vector *) where;
1623 length = fixnum_value(vector->length);
1624 nwords = CEILING(length + 2, 2);
1631 scav_vector_single_float(lispobj *where, lispobj object)
1633 struct vector *vector;
1636 vector = (struct vector *) where;
1637 length = fixnum_value(vector->length);
1638 nwords = CEILING(length + 2, 2);
1644 trans_vector_single_float(lispobj object)
1646 struct vector *vector;
1649 gc_assert(Pointerp(object));
1651 vector = (struct vector *) PTR(object);
1652 length = fixnum_value(vector->length);
1653 nwords = CEILING(length + 2, 2);
1655 return copy_object(object, nwords);
1659 size_vector_single_float(lispobj *where)
1661 struct vector *vector;
1664 vector = (struct vector *) where;
1665 length = fixnum_value(vector->length);
1666 nwords = CEILING(length + 2, 2);
1673 scav_vector_double_float(lispobj *where, lispobj object)
1675 struct vector *vector;
1678 vector = (struct vector *) where;
1679 length = fixnum_value(vector->length);
1680 nwords = CEILING(length * 2 + 2, 2);
1686 trans_vector_double_float(lispobj object)
1688 struct vector *vector;
1691 gc_assert(Pointerp(object));
1693 vector = (struct vector *) PTR(object);
1694 length = fixnum_value(vector->length);
1695 nwords = CEILING(length * 2 + 2, 2);
1697 return copy_object(object, nwords);
1701 size_vector_double_float(lispobj *where)
1703 struct vector *vector;
1706 vector = (struct vector *) where;
1707 length = fixnum_value(vector->length);
1708 nwords = CEILING(length * 2 + 2, 2);
1714 #ifdef type_SimpleArrayLongFloat
1716 scav_vector_long_float(lispobj *where, lispobj object)
1718 struct vector *vector;
1721 vector = (struct vector *) where;
1722 length = fixnum_value(vector->length);
1724 nwords = CEILING(length * 4 + 2, 2);
1731 trans_vector_long_float(lispobj object)
1733 struct vector *vector;
1736 gc_assert(Pointerp(object));
1738 vector = (struct vector *) PTR(object);
1739 length = fixnum_value(vector->length);
1741 nwords = CEILING(length * 4 + 2, 2);
1744 return copy_object(object, nwords);
1748 size_vector_long_float(lispobj *where)
1750 struct vector *vector;
1753 vector = (struct vector *) where;
1754 length = fixnum_value(vector->length);
1756 nwords = CEILING(length * 4 + 2, 2);
1764 #ifdef type_SimpleArrayComplexSingleFloat
1766 scav_vector_complex_single_float(lispobj *where, lispobj object)
1768 struct vector *vector;
1771 vector = (struct vector *) where;
1772 length = fixnum_value(vector->length);
1773 nwords = CEILING(length * 2 + 2, 2);
1779 trans_vector_complex_single_float(lispobj object)
1781 struct vector *vector;
1784 gc_assert(Pointerp(object));
1786 vector = (struct vector *) PTR(object);
1787 length = fixnum_value(vector->length);
1788 nwords = CEILING(length * 2 + 2, 2);
1790 return copy_object(object, nwords);
1794 size_vector_complex_single_float(lispobj *where)
1796 struct vector *vector;
1799 vector = (struct vector *) where;
1800 length = fixnum_value(vector->length);
1801 nwords = CEILING(length * 2 + 2, 2);
1807 #ifdef type_SimpleArrayComplexDoubleFloat
1809 scav_vector_complex_double_float(lispobj *where, lispobj object)
1811 struct vector *vector;
1814 vector = (struct vector *) where;
1815 length = fixnum_value(vector->length);
1816 nwords = CEILING(length * 4 + 2, 2);
1822 trans_vector_complex_double_float(lispobj object)
1824 struct vector *vector;
1827 gc_assert(Pointerp(object));
1829 vector = (struct vector *) PTR(object);
1830 length = fixnum_value(vector->length);
1831 nwords = CEILING(length * 4 + 2, 2);
1833 return copy_object(object, nwords);
1837 size_vector_complex_double_float(lispobj *where)
1839 struct vector *vector;
1842 vector = (struct vector *) where;
1843 length = fixnum_value(vector->length);
1844 nwords = CEILING(length * 4 + 2, 2);
1850 #ifdef type_SimpleArrayComplexLongFloat
1852 scav_vector_complex_long_float(lispobj *where, lispobj object)
1854 struct vector *vector;
1857 vector = (struct vector *) where;
1858 length = fixnum_value(vector->length);
1860 nwords = CEILING(length * 8 + 2, 2);
1867 trans_vector_complex_long_float(lispobj object)
1869 struct vector *vector;
1872 gc_assert(Pointerp(object));
1874 vector = (struct vector *) PTR(object);
1875 length = fixnum_value(vector->length);
1877 nwords = CEILING(length * 8 + 2, 2);
1880 return copy_object(object, nwords);
1884 size_vector_complex_long_float(lispobj *where)
1886 struct vector *vector;
1889 vector = (struct vector *) where;
1890 length = fixnum_value(vector->length);
1892 nwords = CEILING(length * 8 + 2, 2);
1902 #define WEAK_POINTER_NWORDS \
1903 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1906 scav_weak_pointer(lispobj *where, lispobj object)
1908 /* Do not let GC scavenge the value slot of the weak pointer */
1909 /* (that is why it is a weak pointer). Note: we could use */
1910 /* the scav_unboxed method here. */
1912 return WEAK_POINTER_NWORDS;
1916 trans_weak_pointer(lispobj object)
1919 struct weak_pointer *wp;
1921 gc_assert(Pointerp(object));
1923 #if defined(DEBUG_WEAK)
1924 printf("Transporting weak pointer from 0x%08x\n", object);
1927 /* Need to remember where all the weak pointers are that have */
1928 /* been transported so they can be fixed up in a post-GC pass. */
1930 copy = copy_object(object, WEAK_POINTER_NWORDS);
1931 wp = (struct weak_pointer *) PTR(copy);
1934 /* Push the weak pointer onto the list of weak pointers. */
1935 wp->next = LOW_WORD(weak_pointers);
1942 size_weak_pointer(lispobj *where)
1944 return WEAK_POINTER_NWORDS;
1947 void scan_weak_pointers(void)
1949 struct weak_pointer *wp;
1951 for (wp = weak_pointers; wp != (struct weak_pointer *) NULL;
1952 wp = (struct weak_pointer *)((unsigned long)wp->next)) {
1954 lispobj first, *first_pointer;
1958 #if defined(DEBUG_WEAK)
1959 printf("Weak pointer at 0x%p\n", wp);
1960 printf("Value: 0x%08x\n", (unsigned int) value);
1963 if (!(Pointerp(value) && from_space_p(value)))
1966 /* Now, we need to check if the object has been */
1967 /* forwarded. If it has been, the weak pointer is */
1968 /* still good and needs to be updated. Otherwise, the */
1969 /* weak pointer needs to be nil'ed out. */
1971 first_pointer = (lispobj *) PTR(value);
1972 first = *first_pointer;
1974 #if defined(DEBUG_WEAK)
1975 printf("First: 0x%08x\n", (unsigned long) first);
1978 if (Pointerp(first) && new_space_p(first))
1989 /* initialization */
1992 scav_lose(lispobj *where, lispobj object)
1994 fprintf(stderr, "GC lossage. No scavenge function for object 0x%08x (at 0x%016lx)\n",
1995 (unsigned int) object, (unsigned long)where);
2001 trans_lose(lispobj object)
2003 fprintf(stderr, "GC lossage. No transport function for object 0x%08x\n",
2004 (unsigned int)object);
2010 size_lose(lispobj *where)
2012 fprintf(stderr, "Size lossage. No size function for object at 0x%p\n",
2014 fprintf(stderr, "First word of object: 0x%08x\n",
2019 /* KLUDGE: SBCL already has two GC implementations, and if someday the
2020 * precise generational GC is revived, it might have three. It would
2021 * be nice to share the scavtab[] data set up here, and perhaps other
2022 * things too, between all of them, rather than trying to maintain
2023 * multiple copies. -- WHN 2001-05-09 */
2029 /* scavenge table */
2030 for (i = 0; i < 256; i++)
2031 scavtab[i] = scav_lose;
2032 /* scavtab[i] = scav_immediate; */
2034 for (i = 0; i < 32; i++) {
2035 scavtab[type_EvenFixnum|(i<<3)] = scav_immediate;
2036 scavtab[type_FunctionPointer|(i<<3)] = scav_function_pointer;
2037 /* OtherImmediate0 */
2038 scavtab[type_ListPointer|(i<<3)] = scav_list_pointer;
2039 scavtab[type_OddFixnum|(i<<3)] = scav_immediate;
2040 scavtab[type_InstancePointer|(i<<3)] = scav_instance_pointer;
2041 /* OtherImmediate1 */
2042 scavtab[type_OtherPointer|(i<<3)] = scav_other_pointer;
2045 scavtab[type_Bignum] = scav_unboxed;
2046 scavtab[type_Ratio] = scav_boxed;
2047 scavtab[type_SingleFloat] = scav_unboxed;
2048 scavtab[type_DoubleFloat] = scav_unboxed;
2049 #ifdef type_LongFloat
2050 scavtab[type_LongFloat] = scav_unboxed;
2052 scavtab[type_Complex] = scav_boxed;
2053 #ifdef type_ComplexSingleFloat
2054 scavtab[type_ComplexSingleFloat] = scav_unboxed;
2056 #ifdef type_ComplexDoubleFloat
2057 scavtab[type_ComplexDoubleFloat] = scav_unboxed;
2059 #ifdef type_ComplexLongFloat
2060 scavtab[type_ComplexLongFloat] = scav_unboxed;
2062 scavtab[type_SimpleArray] = scav_boxed;
2063 scavtab[type_SimpleString] = scav_string;
2064 scavtab[type_SimpleBitVector] = scav_vector_bit;
2065 scavtab[type_SimpleVector] = scav_vector;
2066 scavtab[type_SimpleArrayUnsignedByte2] = scav_vector_unsigned_byte_2;
2067 scavtab[type_SimpleArrayUnsignedByte4] = scav_vector_unsigned_byte_4;
2068 scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8;
2069 scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16;
2070 scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32;
2071 #ifdef type_SimpleArraySignedByte8
2072 scavtab[type_SimpleArraySignedByte8] = scav_vector_unsigned_byte_8;
2074 #ifdef type_SimpleArraySignedByte16
2075 scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16;
2077 #ifdef type_SimpleArraySignedByte30
2078 scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32;
2080 #ifdef type_SimpleArraySignedByte32
2081 scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32;
2083 scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float;
2084 scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float;
2085 #ifdef type_SimpleArrayLongFloat
2086 scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float;
2088 #ifdef type_SimpleArrayComplexSingleFloat
2089 scavtab[type_SimpleArrayComplexSingleFloat] = scav_vector_complex_single_float;
2091 #ifdef type_SimpleArrayComplexDoubleFloat
2092 scavtab[type_SimpleArrayComplexDoubleFloat] = scav_vector_complex_double_float;
2094 #ifdef type_SimpleArrayComplexLongFloat
2095 scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float;
2097 scavtab[type_ComplexString] = scav_boxed;
2098 scavtab[type_ComplexBitVector] = scav_boxed;
2099 scavtab[type_ComplexVector] = scav_boxed;
2100 scavtab[type_ComplexArray] = scav_boxed;
2101 scavtab[type_CodeHeader] = scav_code_header;
2102 scavtab[type_FunctionHeader] = scav_function_header;
2103 scavtab[type_ClosureFunctionHeader] = scav_function_header;
2104 scavtab[type_ReturnPcHeader] = scav_return_pc_header;
2106 scavtab[type_ClosureHeader] = scav_closure_header;
2107 scavtab[type_FuncallableInstanceHeader] = scav_closure_header;
2108 scavtab[type_ByteCodeFunction] = scav_closure_header;
2109 scavtab[type_ByteCodeClosure] = scav_closure_header;
2110 /* scavtab[type_DylanFunctionHeader] = scav_closure_header; */
2112 scavtab[type_ClosureHeader] = scav_boxed;
2113 scavtab[type_FuncallableInstanceHeader] = scav_boxed;
2114 scavtab[type_ByteCodeFunction] = scav_boxed;
2115 scavtab[type_ByteCodeClosure] = scav_boxed;
2116 /* scavtab[type_DylanFunctionHeader] = scav_boxed; */
2118 scavtab[type_ValueCellHeader] = scav_boxed;
2119 scavtab[type_SymbolHeader] = scav_boxed;
2120 scavtab[type_BaseChar] = scav_immediate;
2121 scavtab[type_Sap] = scav_unboxed;
2122 scavtab[type_UnboundMarker] = scav_immediate;
2123 scavtab[type_WeakPointer] = scav_weak_pointer;
2124 scavtab[type_InstanceHeader] = scav_boxed;
2126 scavtab[type_Fdefn] = scav_fdefn;
2128 scavtab[type_Fdefn] = scav_boxed;
2131 /* Transport Other Table */
2132 for (i = 0; i < 256; i++)
2133 transother[i] = trans_lose;
2135 transother[type_Bignum] = trans_unboxed;
2136 transother[type_Ratio] = trans_boxed;
2137 transother[type_SingleFloat] = trans_unboxed;
2138 transother[type_DoubleFloat] = trans_unboxed;
2139 #ifdef type_LongFloat
2140 transother[type_LongFloat] = trans_unboxed;
2142 transother[type_Complex] = trans_boxed;
2143 #ifdef type_ComplexSingleFloat
2144 transother[type_ComplexSingleFloat] = trans_unboxed;
2146 #ifdef type_ComplexDoubleFloat
2147 transother[type_ComplexDoubleFloat] = trans_unboxed;
2149 #ifdef type_ComplexLongFloat
2150 transother[type_ComplexLongFloat] = trans_unboxed;
2152 transother[type_SimpleArray] = trans_boxed;
2153 transother[type_SimpleString] = trans_string;
2154 transother[type_SimpleBitVector] = trans_vector_bit;
2155 transother[type_SimpleVector] = trans_vector;
2156 transother[type_SimpleArrayUnsignedByte2] = trans_vector_unsigned_byte_2;
2157 transother[type_SimpleArrayUnsignedByte4] = trans_vector_unsigned_byte_4;
2158 transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8;
2159 transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16;
2160 transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32;
2161 #ifdef type_SimpleArraySignedByte8
2162 transother[type_SimpleArraySignedByte8] = trans_vector_unsigned_byte_8;
2164 #ifdef type_SimpleArraySignedByte16
2165 transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16;
2167 #ifdef type_SimpleArraySignedByte30
2168 transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32;
2170 #ifdef type_SimpleArraySignedByte32
2171 transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32;
2173 transother[type_SimpleArraySingleFloat] = trans_vector_single_float;
2174 transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float;
2175 #ifdef type_SimpleArrayLongFloat
2176 transother[type_SimpleArrayLongFloat] = trans_vector_long_float;
2178 #ifdef type_SimpleArrayComplexSingleFloat
2179 transother[type_SimpleArrayComplexSingleFloat] = trans_vector_complex_single_float;
2181 #ifdef type_SimpleArrayComplexDoubleFloat
2182 transother[type_SimpleArrayComplexDoubleFloat] = trans_vector_complex_double_float;
2184 #ifdef type_SimpleArrayComplexLongFloat
2185 transother[type_SimpleArrayComplexLongFloat] = trans_vector_complex_long_float;
2187 transother[type_ComplexString] = trans_boxed;
2188 transother[type_ComplexBitVector] = trans_boxed;
2189 transother[type_ComplexVector] = trans_boxed;
2190 transother[type_ComplexArray] = trans_boxed;
2191 transother[type_CodeHeader] = trans_code_header;
2192 transother[type_FunctionHeader] = trans_function_header;
2193 transother[type_ClosureFunctionHeader] = trans_function_header;
2194 transother[type_ReturnPcHeader] = trans_return_pc_header;
2195 transother[type_ClosureHeader] = trans_boxed;
2196 transother[type_FuncallableInstanceHeader] = trans_boxed;
2197 transother[type_ByteCodeFunction] = trans_boxed;
2198 transother[type_ByteCodeClosure] = trans_boxed;
2199 transother[type_ValueCellHeader] = trans_boxed;
2200 transother[type_SymbolHeader] = trans_boxed;
2201 transother[type_BaseChar] = trans_immediate;
2202 transother[type_Sap] = trans_unboxed;
2203 transother[type_UnboundMarker] = trans_immediate;
2204 transother[type_WeakPointer] = trans_weak_pointer;
2205 transother[type_InstanceHeader] = trans_boxed;
2206 transother[type_Fdefn] = trans_boxed;
2210 for (i = 0; i < 256; i++)
2211 sizetab[i] = size_lose;
2213 for (i = 0; i < 32; i++) {
2214 sizetab[type_EvenFixnum|(i<<3)] = size_immediate;
2215 sizetab[type_FunctionPointer|(i<<3)] = size_pointer;
2216 /* OtherImmediate0 */
2217 sizetab[type_ListPointer|(i<<3)] = size_pointer;
2218 sizetab[type_OddFixnum|(i<<3)] = size_immediate;
2219 sizetab[type_InstancePointer|(i<<3)] = size_pointer;
2220 /* OtherImmediate1 */
2221 sizetab[type_OtherPointer|(i<<3)] = size_pointer;
2224 sizetab[type_Bignum] = size_unboxed;
2225 sizetab[type_Ratio] = size_boxed;
2226 sizetab[type_SingleFloat] = size_unboxed;
2227 sizetab[type_DoubleFloat] = size_unboxed;
2228 #ifdef type_LongFloat
2229 sizetab[type_LongFloat] = size_unboxed;
2231 sizetab[type_Complex] = size_boxed;
2232 #ifdef type_ComplexSingleFloat
2233 sizetab[type_ComplexSingleFloat] = size_unboxed;
2235 #ifdef type_ComplexDoubleFloat
2236 sizetab[type_ComplexDoubleFloat] = size_unboxed;
2238 #ifdef type_ComplexLongFloat
2239 sizetab[type_ComplexLongFloat] = size_unboxed;
2241 sizetab[type_SimpleArray] = size_boxed;
2242 sizetab[type_SimpleString] = size_string;
2243 sizetab[type_SimpleBitVector] = size_vector_bit;
2244 sizetab[type_SimpleVector] = size_vector;
2245 sizetab[type_SimpleArrayUnsignedByte2] = size_vector_unsigned_byte_2;
2246 sizetab[type_SimpleArrayUnsignedByte4] = size_vector_unsigned_byte_4;
2247 sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8;
2248 sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16;
2249 sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32;
2250 #ifdef type_SimpleArraySignedByte8
2251 sizetab[type_SimpleArraySignedByte8] = size_vector_unsigned_byte_8;
2253 #ifdef type_SimpleArraySignedByte16
2254 sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16;
2256 #ifdef type_SimpleArraySignedByte30
2257 sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32;
2259 #ifdef type_SimpleArraySignedByte32
2260 sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32;
2262 sizetab[type_SimpleArraySingleFloat] = size_vector_single_float;
2263 sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float;
2264 #ifdef type_SimpleArrayLongFloat
2265 sizetab[type_SimpleArrayLongFloat] = size_vector_long_float;
2267 #ifdef type_SimpleArrayComplexSingleFloat
2268 sizetab[type_SimpleArrayComplexSingleFloat] = size_vector_complex_single_float;
2270 #ifdef type_SimpleArrayComplexDoubleFloat
2271 sizetab[type_SimpleArrayComplexDoubleFloat] = size_vector_complex_double_float;
2273 #ifdef type_SimpleArrayComplexLongFloat
2274 sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float;
2276 sizetab[type_ComplexString] = size_boxed;
2277 sizetab[type_ComplexBitVector] = size_boxed;
2278 sizetab[type_ComplexVector] = size_boxed;
2279 sizetab[type_ComplexArray] = size_boxed;
2280 sizetab[type_CodeHeader] = size_code_header;
2282 /* Shouldn't see these so just lose if it happens */
2283 sizetab[type_FunctionHeader] = size_function_header;
2284 sizetab[type_ClosureFunctionHeader] = size_function_header;
2285 sizetab[type_ReturnPcHeader] = size_return_pc_header;
2287 sizetab[type_ClosureHeader] = size_boxed;
2288 sizetab[type_FuncallableInstanceHeader] = size_boxed;
2289 sizetab[type_ValueCellHeader] = size_boxed;
2290 sizetab[type_SymbolHeader] = size_boxed;
2291 sizetab[type_BaseChar] = size_immediate;
2292 sizetab[type_Sap] = size_unboxed;
2293 sizetab[type_UnboundMarker] = size_immediate;
2294 sizetab[type_WeakPointer] = size_weak_pointer;
2295 sizetab[type_InstanceHeader] = size_boxed;
2296 sizetab[type_Fdefn] = size_boxed;
2299 /* noise to manipulate the gc trigger stuff */
2303 void set_auto_gc_trigger(os_vm_size_t dynamic_usage)
2305 os_vm_address_t addr=(os_vm_address_t)current_dynamic_space +
2308 DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
2310 if(addr < (os_vm_address_t)dynamic_space_free_pointer) {
2312 "set_auto_gc_trigger: tried to set gc trigger too low! (%d < %p)\n",
2313 (unsigned int)dynamic_usage,
2314 (os_vm_address_t)dynamic_space_free_pointer
2315 - (os_vm_address_t)current_dynamic_space);
2318 else if (length < 0) {
2320 "set_auto_gc_trigger: tried to set gc trigger too high! (%p)\n",
2325 addr=os_round_up_to_page(addr);
2326 length=os_trunc_size_to_page(length);
2328 #if defined(SUNOS) || defined(SOLARIS)
2329 os_invalidate(addr,length);
2331 os_protect(addr, length, 0);
2334 current_auto_gc_trigger = (lispobj *)addr;
2337 void clear_auto_gc_trigger(void)
2339 if(current_auto_gc_trigger!=NULL){
2340 #if defined(SUNOS) || defined(SOLARIS)/* don't want to force whole space into swapping mode... */
2341 os_vm_address_t addr=(os_vm_address_t)current_auto_gc_trigger;
2342 os_vm_size_t length=
2343 DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
2345 os_validate(addr,length);
2347 os_protect((os_vm_address_t)current_dynamic_space,
2352 current_auto_gc_trigger = NULL;