2 * Stop and Copy GC based on Cheney's algorithm.
6 * Written by Christopher Hoover.
12 #include <sys/resource.h>
19 #include "interrupt.h"
25 #define DEBUG_SPACE_PREDICATES
26 #define DEBUG_SCAVENGE_VERBOSE
27 #define DEBUG_COPY_VERBOSE
31 static lispobj *from_space;
32 static lispobj *from_space_free_pointer;
34 static lispobj *new_space;
35 static lispobj *new_space_free_pointer;
37 static int (*scavtab[256])(lispobj *where, lispobj object);
38 static lispobj (*transother[256])(lispobj object);
39 static int (*sizetab[256])(lispobj *where);
41 static struct weak_pointer *weak_pointers;
43 static void scavenge(lispobj *start, u32 nwords);
44 static void scavenge_newspace(void);
45 static void scavenge_interrupt_contexts(void);
46 static void scan_weak_pointers(void);
47 static int scav_lose(lispobj *where, lispobj object);
49 #define gc_abort() lose("GC invariant lost! File \"%s\", line %d\n", \
53 #define gc_assert(ex) do { \
54 if (!(ex)) gc_abort(); \
60 #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
65 #if defined(DEBUG_SPACE_PREDICATES)
67 boolean from_space_p(lispobj object)
71 /* this can be called for untagged pointers as well as for
72 descriptors, so this assertion's not applicable
73 gc_assert(Pointerp(object));
75 ptr = (lispobj *) PTR(object);
77 return ((from_space <= ptr) &&
78 (ptr < from_space_free_pointer));
81 boolean new_space_p(lispobj object)
85 gc_assert(Pointerp(object));
87 ptr = (lispobj *) PTR(object);
89 return ((new_space <= ptr) &&
90 (ptr < new_space_free_pointer));
95 #define from_space_p(ptr) \
96 ((from_space <= ((lispobj *) ptr)) && \
97 (((lispobj *) ptr) < from_space_free_pointer))
99 #define new_space_p(ptr) \
100 ((new_space <= ((lispobj *) ptr)) && \
101 (((lispobj *) ptr) < new_space_free_pointer))
106 /* Copying Objects */
109 copy_object(lispobj object, int nwords)
113 lispobj *source, *dest;
115 gc_assert(Pointerp(object));
116 gc_assert(from_space_p(object));
117 gc_assert((nwords & 0x01) == 0);
119 /* get tag of object */
120 tag = LowtagOf(object);
123 new = new_space_free_pointer;
124 new_space_free_pointer += nwords;
127 source = (lispobj *) PTR(object);
129 #ifdef DEBUG_COPY_VERBOSE
130 fprintf(stderr,"Copying %d words from %p to %p\n", nwords,source,new);
133 /* copy the object */
141 /* return lisp pointer of new object */
142 return (lispobj)(LOW_WORD(new) | tag);
146 /* Collect Garbage */
149 static double tv_diff(struct timeval *x, struct timeval *y)
151 return (((double) x->tv_sec + (double) x->tv_usec * 1.0e-6) -
152 ((double) y->tv_sec + (double) y->tv_usec * 1.0e-6));
156 #define BYTES_ZERO_BEFORE_END (1<<12)
161 #define U32 unsigned long
163 static void zero_stack(void)
165 U32 *ptr = (U32 *)current_control_stack_pointer;
171 } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
176 } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
183 /* this is not generational. It's called with a last_gen arg, which we shun.
186 void collect_garbage(unsigned ignore)
189 struct timeval start_tv, stop_tv;
190 struct rusage start_rusage, stop_rusage;
191 double real_time, system_time, user_time;
192 double percent_retained, gc_rate;
193 unsigned long size_discarded;
194 unsigned long size_retained;
196 lispobj *current_static_space_free_pointer;
197 unsigned long static_space_size;
198 unsigned long control_stack_size, binding_stack_size;
202 printf("[Collecting garbage ... \n");
204 getrusage(RUSAGE_SELF, &start_rusage);
205 gettimeofday(&start_tv, (struct timezone *) 0);
209 sigaddset_blockable(&tmp);
210 sigprocmask(SIG_BLOCK, &tmp, &old);
212 current_static_space_free_pointer =
213 (lispobj *) ((unsigned long)
214 SymbolValue(STATIC_SPACE_FREE_POINTER));
217 /* Set up from space and new space pointers. */
219 from_space = current_dynamic_space;
221 from_space_free_pointer = dynamic_space_free_pointer;
223 from_space_free_pointer = (lispobj *)SymbolValue(ALLOCATION_POINTER);
226 fprintf(stderr,"from_space = %lx\n",
227 (unsigned long) current_dynamic_space);
228 if (current_dynamic_space == (lispobj *) DYNAMIC_0_SPACE_START)
229 new_space = (lispobj *)DYNAMIC_1_SPACE_START;
230 else if (current_dynamic_space == (lispobj *) DYNAMIC_1_SPACE_START)
231 new_space = (lispobj *) DYNAMIC_0_SPACE_START;
233 lose("GC lossage. Current dynamic space is bogus!\n");
235 new_space_free_pointer = new_space;
238 /* Initialize the weak pointer list. */
239 weak_pointers = (struct weak_pointer *) NULL;
242 /* Scavenge all of the roots. */
244 printf("Scavenging interrupt contexts ...\n");
246 scavenge_interrupt_contexts();
249 printf("Scavenging interrupt handlers (%d bytes) ...\n",
250 (int)sizeof(interrupt_handlers));
252 scavenge((lispobj *) interrupt_handlers,
253 sizeof(interrupt_handlers) / sizeof(lispobj));
255 /* _size quantities are in units of sizeof(lispobj) - i.e. 4 */
257 current_control_stack_pointer-
258 (lispobj *)CONTROL_STACK_START;
260 printf("Scavenging the control stack at %p (%ld words) ...\n",
261 ((lispobj *)CONTROL_STACK_START),
264 scavenge(((lispobj *)CONTROL_STACK_START), control_stack_size);
269 (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack;
272 current_binding_stack_pointer -
273 (lispobj *)BINDING_STACK_START;
276 printf("Scavenging the binding stack %x - %x (%d words) ...\n",
277 BINDING_STACK_START,current_binding_stack_pointer,
278 (int)(binding_stack_size));
280 scavenge(((lispobj *)BINDING_STACK_START), binding_stack_size);
283 current_static_space_free_pointer - (lispobj *) STATIC_SPACE_START;
285 printf("Scavenging static space %x - %x (%d words) ...\n",
286 STATIC_SPACE_START,current_static_space_free_pointer,
287 (int)(static_space_size));
289 scavenge(((lispobj *)STATIC_SPACE_START), static_space_size);
291 /* Scavenge newspace. */
293 printf("Scavenging new space (%d bytes) ...\n",
294 (int)((new_space_free_pointer - new_space) * sizeof(lispobj)));
299 #if defined(DEBUG_PRINT_GARBAGE)
300 print_garbage(from_space, from_space_free_pointer);
303 /* Scan the weak pointers. */
305 printf("Scanning weak pointers ...\n");
307 scan_weak_pointers();
312 printf("Flipping spaces ...\n");
315 os_zero((os_vm_address_t) current_dynamic_space,
316 (os_vm_size_t) DYNAMIC_SPACE_SIZE);
318 current_dynamic_space = new_space;
320 dynamic_space_free_pointer = new_space_free_pointer;
322 SetSymbolValue(ALLOCATION_POINTER, (lispobj)new_space_free_pointer);
326 size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj);
327 size_retained = (new_space_free_pointer - new_space) * sizeof(lispobj);
332 printf("Zeroing empty part of control stack ...\n");
336 sigprocmask(SIG_SETMASK, &old, 0);
340 gettimeofday(&stop_tv, (struct timezone *) 0);
341 getrusage(RUSAGE_SELF, &stop_rusage);
345 percent_retained = (((float) size_retained) /
346 ((float) size_discarded)) * 100.0;
348 printf("Total of %ld bytes out of %ld bytes retained (%3.2f%%).\n",
349 size_retained, size_discarded, percent_retained);
351 real_time = tv_diff(&stop_tv, &start_tv);
352 user_time = tv_diff(&stop_rusage.ru_utime, &start_rusage.ru_utime);
353 system_time = tv_diff(&stop_rusage.ru_stime, &start_rusage.ru_stime);
356 printf("Statistics:\n");
357 printf("%10.2f sec of real time\n", real_time);
358 printf("%10.2f sec of user time,\n", user_time);
359 printf("%10.2f sec of system time.\n", system_time);
361 printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n",
362 real_time, user_time, system_time);
365 gc_rate = ((float) size_retained / (float) (1<<20)) / real_time;
367 printf("%10.2f M bytes/sec collected.\n", gc_rate);
374 #define DIRECT_SCAV 0
377 scavenge(lispobj *start, u32 nwords)
381 int type, words_scavenged;
384 type = TypeOf(object);
386 #if defined(DEBUG_SCAVENGE_VERBOSE)
387 fprintf(stderr,"Scavenging object at 0x%08x, object = 0x%08x, type = %d\n",
388 (unsigned long) start, (unsigned long) object, type);
392 words_scavenged = (scavtab[type])(start, object);
394 if (Pointerp(object)) {
395 /* It be a pointer. */
396 if (from_space_p(object)) {
397 /* It currently points to old space. Check for a */
398 /* forwarding pointer. */
401 first_word = *((lispobj *)PTR(object));
402 if (Pointerp(first_word) && new_space_p(first_word)) {
403 /* Yep, there be a forwarding pointer. */
408 /* Scavenge that pointer. */
409 words_scavenged = (scavtab[type])(start, object);
413 /* It points somewhere other than oldspace. Leave */
419 /* there are some situations where an
420 other-immediate may end up in a descriptor
421 register. I'm not sure whether this is
422 supposed to happen, but if it does then we
423 don't want to (a) barf or (b) scavenge over the
424 data-block, because there isn't one. So, if
425 we're checking a single word and it's anything
426 other than a pointer, just hush it up */
429 if((scavtab[type]==scav_lose) ||
430 (((scavtab[type])(start,object))>1)) {
431 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",
435 else if ((object & 3) == 0) {
436 /* It's a fixnum. Real easy. */
440 /* It's some random header object. */
441 words_scavenged = (scavtab[type])(start, object);
445 start += words_scavenged;
446 nwords -= words_scavenged;
448 gc_assert(nwords == 0);
451 static void scavenge_newspace(void)
453 lispobj *here, *next;
456 while (here < new_space_free_pointer) {
457 /* printf("here=%lx, new_space_free_pointer=%lx\n",
458 here,new_space_free_pointer); */
459 next = new_space_free_pointer;
460 scavenge(here, next - here);
463 /* printf("done with newspace\n"); */
467 /* Scavenging Interrupt Contexts */
469 static int boxed_registers[] = BOXED_REGISTERS;
471 static void scavenge_interrupt_context(os_context_t *context)
476 unsigned long lip_offset;
477 int lip_register_pair;
479 unsigned long pc_code_offset;
481 unsigned long npc_code_offset;
484 /* Find the LIP's register pair and calculate its offset */
485 /* before we scavenge the context. */
487 lip = *os_context_register_addr(context, reg_LIP);
488 /* 0x7FFFFFFF or 0x7FFFFFFFFFFFFFFF ? */
489 lip_offset = 0x7FFFFFFF;
490 lip_register_pair = -1;
491 for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
496 index = boxed_registers[i];
497 reg = *os_context_register_addr(context, index);
498 /* would be using PTR if not for integer length issues */
499 if ((reg & ~((1L<<lowtag_Bits)-1)) <= lip) {
501 if (offset < lip_offset) {
503 lip_register_pair = index;
509 /* Compute the PC's offset from the start of the CODE */
511 pc_code_offset = *os_context_pc_addr(context) -
512 *os_context_register_addr(context, reg_CODE);
514 npc_code_offset = SC_NPC(context) - SC_REG(context, reg_CODE);
517 /* Scanvenge all boxed registers in the context. */
518 for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
522 index = boxed_registers[i];
523 foo = *os_context_register_addr(context,index);
524 scavenge((lispobj *) &foo, 1);
525 *os_context_register_addr(context,index) = foo;
527 /* this is unlikely to work as intended on bigendian
528 * 64 bit platforms */
531 os_context_register_addr(context, index), 1);
536 *os_context_register_addr(context, reg_LIP) =
537 *os_context_register_addr(context, lip_register_pair) + lip_offset;
540 /* Fix the PC if it was in from space */
541 if (from_space_p(*os_context_pc_addr(context)))
542 *os_context_pc_addr(context) =
543 *os_context_register_addr(context, reg_CODE) + pc_code_offset;
545 if (from_space_p(SC_NPC(context)))
546 SC_NPC(context) = SC_REG(context, reg_CODE) + npc_code_offset;
550 void scavenge_interrupt_contexts(void)
553 os_context_t *context;
555 index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX));
556 printf("Number of active contexts: %d\n", index);
558 for (i = 0; i < index; i++) {
559 context = lisp_interrupt_contexts[i];
560 scavenge_interrupt_context(context);
567 void print_garbage(lispobj *from_space, lispobj *from_space_free_pointer)
570 int total_words_not_copied;
572 printf("Scanning from space ...\n");
574 total_words_not_copied = 0;
576 while (start < from_space_free_pointer) {
578 int forwardp, type, nwords;
582 forwardp = Pointerp(object) && new_space_p(object);
588 tag = LowtagOf(object);
591 case type_ListPointer:
594 case type_InstancePointer:
595 printf("Don't know about instances yet!\n");
598 case type_FunctionPointer:
601 case type_OtherPointer:
602 pointer = (lispobj *) PTR(object);
604 type = TypeOf(header);
605 nwords = (sizetab[type])(pointer);
608 type = TypeOf(object);
609 nwords = (sizetab[type])(start);
610 total_words_not_copied += nwords;
611 printf("%4d words not copied at 0x%16lx; ",
612 nwords, (unsigned long) start);
613 printf("Header word is 0x%08x\n",
614 (unsigned int) object);
618 printf("%d total words not copied.\n", total_words_not_copied);
622 /* Code and Code-Related Objects */
624 #define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)
626 static lispobj trans_function_header(lispobj object);
627 static lispobj trans_boxed(lispobj object);
631 scav_function_pointer(lispobj *where, lispobj object)
633 gc_assert(Pointerp(object));
635 if (from_space_p(object)) {
636 lispobj first, *first_pointer;
638 /* object is a pointer into from space. check to see */
639 /* if it has been forwarded */
640 first_pointer = (lispobj *) PTR(object);
641 first = *first_pointer;
643 if (!(Pointerp(first) && new_space_p(first))) {
647 /* must transport object -- object may point */
648 /* to either a function header, a closure */
649 /* function header, or to a closure header. */
651 type = TypeOf(first);
653 case type_FunctionHeader:
654 case type_ClosureFunctionHeader:
655 copy = trans_function_header(object);
658 copy = trans_boxed(object);
662 first = *first_pointer = copy;
665 gc_assert(Pointerp(first));
666 gc_assert(!from_space_p(first));
674 scav_function_pointer(lispobj *where, lispobj object)
676 lispobj *first_pointer;
681 gc_assert(Pointerp(object));
683 /* object is a pointer into from space. Not a FP */
684 first_pointer = (lispobj *) PTR(object);
685 first = *first_pointer;
687 /* must transport object -- object may point */
688 /* to either a function header, a closure */
689 /* function header, or to a closure header. */
691 type = TypeOf(first);
693 case type_FunctionHeader:
694 case type_ClosureFunctionHeader:
695 copy = trans_function_header(object);
698 copy = trans_boxed(object);
702 first = *first_pointer = copy;
704 gc_assert(Pointerp(first));
705 gc_assert(!from_space_p(first));
713 trans_code(struct code *code)
715 struct code *new_code;
716 lispobj first, l_code, l_new_code;
717 int nheader_words, ncode_words, nwords;
718 unsigned long displacement;
719 lispobj fheaderl, *prev_pointer;
721 #if defined(DEBUG_CODE_GC)
722 printf("\nTransporting code object located at 0x%08x.\n",
723 (unsigned long) code);
726 /* if object has already been transported, just return pointer */
727 first = code->header;
728 if (Pointerp(first) && new_space_p(first)) {
730 printf("Was already transported\n");
732 return (struct code *) PTR(first);
735 gc_assert(TypeOf(first) == type_CodeHeader);
737 /* prepare to transport the code vector */
738 l_code = (lispobj) LOW_WORD(code) | type_OtherPointer;
740 ncode_words = fixnum_value(code->code_size);
741 nheader_words = HeaderValue(code->header);
742 nwords = ncode_words + nheader_words;
743 nwords = CEILING(nwords, 2);
745 l_new_code = copy_object(l_code, nwords);
746 new_code = (struct code *) PTR(l_new_code);
748 displacement = l_new_code - l_code;
750 #if defined(DEBUG_CODE_GC)
751 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
752 (unsigned long) code, (unsigned long) new_code);
753 printf("Code object is %d words long.\n", nwords);
756 /* set forwarding pointer */
757 code->header = l_new_code;
759 /* set forwarding pointers for all the function headers in the */
760 /* code object. also fix all self pointers */
762 fheaderl = code->entry_points;
763 prev_pointer = &new_code->entry_points;
765 while (fheaderl != NIL) {
766 struct function *fheaderp, *nfheaderp;
769 fheaderp = (struct function *) PTR(fheaderl);
770 gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
772 /* calcuate the new function pointer and the new */
773 /* function header */
774 nfheaderl = fheaderl + displacement;
775 nfheaderp = (struct function *) PTR(nfheaderl);
777 /* set forwarding pointer */
779 printf("fheaderp->header (at %x) <- %x\n",
780 &(fheaderp->header) , nfheaderl);
782 fheaderp->header = nfheaderl;
784 /* fix self pointer */
785 nfheaderp->self = nfheaderl;
787 *prev_pointer = nfheaderl;
789 fheaderl = fheaderp->next;
790 prev_pointer = &nfheaderp->next;
794 os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words),
795 ncode_words * sizeof(int));
801 scav_code_header(lispobj *where, lispobj object)
804 int nheader_words, ncode_words, nwords;
806 struct function *fheaderp;
808 code = (struct code *) where;
809 ncode_words = fixnum_value(code->code_size);
810 nheader_words = HeaderValue(object);
811 nwords = ncode_words + nheader_words;
812 nwords = CEILING(nwords, 2);
814 #if defined(DEBUG_CODE_GC)
815 printf("\nScavening code object at 0x%08x.\n",
816 (unsigned long) where);
817 printf("Code object is %d words long.\n", nwords);
818 printf("Scavenging boxed section of code data block (%d words).\n",
822 /* Scavenge the boxed section of the code data block */
823 scavenge(where + 1, nheader_words - 1);
825 /* Scavenge the boxed section of each function object in the */
826 /* code data block */
827 fheaderl = code->entry_points;
828 while (fheaderl != NIL) {
829 fheaderp = (struct function *) PTR(fheaderl);
830 gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
832 #if defined(DEBUG_CODE_GC)
833 printf("Scavenging boxed section of entry point located at 0x%08x.\n",
834 (unsigned long) PTR(fheaderl));
836 scavenge(&fheaderp->name, 1);
837 scavenge(&fheaderp->arglist, 1);
838 scavenge(&fheaderp->type, 1);
840 fheaderl = fheaderp->next;
847 trans_code_header(lispobj object)
851 ncode = trans_code((struct code *) PTR(object));
852 return (lispobj) LOW_WORD(ncode) | type_OtherPointer;
856 size_code_header(lispobj *where)
859 int nheader_words, ncode_words, nwords;
861 code = (struct code *) where;
863 ncode_words = fixnum_value(code->code_size);
864 nheader_words = HeaderValue(code->header);
865 nwords = ncode_words + nheader_words;
866 nwords = CEILING(nwords, 2);
873 scav_return_pc_header(lispobj *where, lispobj object)
875 fprintf(stderr, "GC lossage. Should not be scavenging a ");
876 fprintf(stderr, "Return PC Header.\n");
877 fprintf(stderr, "where = 0x%p, object = 0x%x", where, object);
883 trans_return_pc_header(lispobj object)
885 struct function *return_pc;
886 unsigned long offset;
887 struct code *code, *ncode;
889 return_pc = (struct function *) PTR(object);
890 offset = HeaderValue(return_pc->header) * 4 ;
892 /* Transport the whole code object */
893 code = (struct code *) ((unsigned long) return_pc - offset);
895 printf("trans_return_pc_header object=%x, code=%lx\n",object,code);
897 ncode = trans_code(code);
898 if(object==0x304748d7) {
901 ret= ((lispobj) LOW_WORD(ncode) + offset) | type_OtherPointer;
903 printf("trans_return_pc_header returning %x\n",ret);
908 /* On the 386, closures hold a pointer to the raw address instead of the
909 function object, so we can use CALL [$FDEFN+const] to invoke the function
910 without loading it into a register. Given that code objects don't move,
911 we don't need to update anything, but we do have to figure out that the
912 function is still live. */
915 scav_closure_header(where, object)
916 lispobj *where, object;
918 struct closure *closure;
921 closure = (struct closure *)where;
922 fun = closure->function - RAW_ADDR_OFFSET;
930 scav_function_header(lispobj *where, lispobj object)
932 fprintf(stderr, "GC lossage. Should not be scavenging a ");
933 fprintf(stderr, "Function Header.\n");
934 fprintf(stderr, "where = 0x%p, object = 0x%08x",
935 where, (unsigned int) object);
941 trans_function_header(lispobj object)
943 struct function *fheader;
944 unsigned long offset;
945 struct code *code, *ncode;
947 fheader = (struct function *) PTR(object);
948 offset = HeaderValue(fheader->header) * 4;
950 /* Transport the whole code object */
951 code = (struct code *) ((unsigned long) fheader - offset);
952 ncode = trans_code(code);
954 return ((lispobj) LOW_WORD(ncode) + offset) | type_FunctionPointer;
963 scav_instance_pointer(lispobj *where, lispobj object)
965 if (from_space_p(object)) {
966 lispobj first, *first_pointer;
968 /* object is a pointer into from space. check to see */
969 /* if it has been forwarded */
970 first_pointer = (lispobj *) PTR(object);
971 first = *first_pointer;
973 if (!(Pointerp(first) && new_space_p(first)))
974 first = *first_pointer = trans_boxed(object);
981 scav_instance_pointer(lispobj *where, lispobj object)
983 lispobj *first_pointer;
985 /* object is a pointer into from space. Not a FP */
986 first_pointer = (lispobj *) PTR(object);
988 *where = *first_pointer = trans_boxed(object);
994 /* Lists and Conses */
996 static lispobj trans_list(lispobj object);
1000 scav_list_pointer(lispobj *where, lispobj object)
1002 gc_assert(Pointerp(object));
1004 if (from_space_p(object)) {
1005 lispobj first, *first_pointer;
1007 /* object is a pointer into from space. check to see */
1008 /* if it has been forwarded */
1009 first_pointer = (lispobj *) PTR(object);
1010 first = *first_pointer;
1012 if (!(Pointerp(first) && new_space_p(first)))
1013 first = *first_pointer = trans_list(object);
1015 gc_assert(Pointerp(first));
1016 gc_assert(!from_space_p(first));
1024 scav_list_pointer(lispobj *where, lispobj object)
1026 lispobj first, *first_pointer;
1028 gc_assert(Pointerp(object));
1030 /* object is a pointer into from space. Not a FP. */
1031 first_pointer = (lispobj *) PTR(object);
1033 first = *first_pointer = trans_list(object);
1035 gc_assert(Pointerp(first));
1036 gc_assert(!from_space_p(first));
1044 trans_list(lispobj object)
1046 lispobj new_list_pointer;
1047 struct cons *cons, *new_cons;
1049 cons = (struct cons *) PTR(object);
1051 /* ### Don't use copy_object here. */
1052 new_list_pointer = copy_object(object, 2);
1053 new_cons = (struct cons *) PTR(new_list_pointer);
1055 /* Set forwarding pointer. */
1056 cons->car = new_list_pointer;
1058 /* Try to linearize the list in the cdr direction to help reduce */
1062 lispobj cdr, new_cdr, first;
1063 struct cons *cdr_cons, *new_cdr_cons;
1067 if (LowtagOf(cdr) != type_ListPointer ||
1068 !from_space_p(cdr) ||
1069 (Pointerp(first = *(lispobj *)PTR(cdr)) &&
1070 new_space_p(first)))
1073 cdr_cons = (struct cons *) PTR(cdr);
1075 /* ### Don't use copy_object here */
1076 new_cdr = copy_object(cdr, 2);
1077 new_cdr_cons = (struct cons *) PTR(new_cdr);
1079 /* Set forwarding pointer */
1080 cdr_cons->car = new_cdr;
1082 /* Update the cdr of the last cons copied into new */
1083 /* space to keep the newspace scavenge from having to */
1085 new_cons->cdr = new_cdr;
1088 new_cons = new_cdr_cons;
1091 return new_list_pointer;
1095 /* Scavenging and Transporting Other Pointers */
1099 scav_other_pointer(lispobj *where, lispobj object)
1101 gc_assert(Pointerp(object));
1103 if (from_space_p(object)) {
1104 lispobj first, *first_pointer;
1106 /* object is a pointer into from space. check to see */
1107 /* if it has been forwarded */
1108 first_pointer = (lispobj *) PTR(object);
1109 first = *first_pointer;
1111 if (!(Pointerp(first) && new_space_p(first)))
1112 first = *first_pointer =
1113 (transother[TypeOf(first)])(object);
1115 gc_assert(Pointerp(first));
1116 gc_assert(!from_space_p(first));
1124 scav_other_pointer(lispobj *where, lispobj object)
1126 lispobj first, *first_pointer;
1128 gc_assert(Pointerp(object));
1130 /* Object is a pointer into from space - not a FP */
1131 first_pointer = (lispobj *) PTR(object);
1132 first = *first_pointer = (transother[TypeOf(*first_pointer)])(object);
1134 gc_assert(Pointerp(first));
1135 gc_assert(!from_space_p(first));
1143 /* Immediate, Boxed, and Unboxed Objects */
1146 size_pointer(lispobj *where)
1152 scav_immediate(lispobj *where, lispobj object)
1158 trans_immediate(lispobj object)
1160 fprintf(stderr, "GC lossage. Trying to transport an immediate!?\n");
1166 size_immediate(lispobj *where)
1173 scav_boxed(lispobj *where, lispobj object)
1179 trans_boxed(lispobj object)
1182 unsigned long length;
1184 gc_assert(Pointerp(object));
1186 header = *((lispobj *) PTR(object));
1187 length = HeaderValue(header) + 1;
1188 length = CEILING(length, 2);
1190 return copy_object(object, length);
1194 size_boxed(lispobj *where)
1197 unsigned long length;
1200 length = HeaderValue(header) + 1;
1201 length = CEILING(length, 2);
1206 /* Note: on the sparc we don't have to do anything special for fdefns, */
1207 /* cause the raw-addr has a function lowtag. */
1210 scav_fdefn(lispobj *where, lispobj object)
1212 struct fdefn *fdefn;
1214 fdefn = (struct fdefn *)where;
1216 if ((char *)(fdefn->function + RAW_ADDR_OFFSET)
1217 == (char *)((unsigned long)(fdefn->raw_addr))) {
1218 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
1219 fdefn->raw_addr = (u32) ((char *) LOW_WORD(fdefn->function)) + RAW_ADDR_OFFSET;
1220 return sizeof(struct fdefn) / sizeof(lispobj);
1228 scav_unboxed(lispobj *where, lispobj object)
1230 unsigned long length;
1232 length = HeaderValue(object) + 1;
1233 length = CEILING(length, 2);
1239 trans_unboxed(lispobj object)
1242 unsigned long length;
1245 gc_assert(Pointerp(object));
1247 header = *((lispobj *) PTR(object));
1248 length = HeaderValue(header) + 1;
1249 length = CEILING(length, 2);
1251 return copy_object(object, length);
1255 size_unboxed(lispobj *where)
1258 unsigned long length;
1261 length = HeaderValue(header) + 1;
1262 length = CEILING(length, 2);
1268 /* Vector-Like Objects */
1270 #define NWORDS(x,y) (CEILING((x),(y)) / (y))
1273 scav_string(lispobj *where, lispobj object)
1275 struct vector *vector;
1278 /* NOTE: Strings contain one more byte of data than the length */
1279 /* slot indicates. */
1281 vector = (struct vector *) where;
1282 length = fixnum_value(vector->length) + 1;
1283 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1289 trans_string(lispobj object)
1291 struct vector *vector;
1294 gc_assert(Pointerp(object));
1296 /* NOTE: Strings contain one more byte of data than the length */
1297 /* slot indicates. */
1299 vector = (struct vector *) PTR(object);
1300 length = fixnum_value(vector->length) + 1;
1301 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1303 return copy_object(object, nwords);
1307 size_string(lispobj *where)
1309 struct vector *vector;
1312 /* NOTE: Strings contain one more byte of data than the length */
1313 /* slot indicates. */
1315 vector = (struct vector *) where;
1316 length = fixnum_value(vector->length) + 1;
1317 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1323 scav_vector(lispobj *where, lispobj object)
1325 if (HeaderValue(object) == subtype_VectorValidHashing)
1326 *where = (subtype_VectorMustRehash<<type_Bits) | type_SimpleVector;
1333 trans_vector(lispobj object)
1335 struct vector *vector;
1338 gc_assert(Pointerp(object));
1340 vector = (struct vector *) PTR(object);
1342 length = fixnum_value(vector->length);
1343 nwords = CEILING(length + 2, 2);
1345 return copy_object(object, nwords);
1349 size_vector(lispobj *where)
1351 struct vector *vector;
1354 vector = (struct vector *) where;
1355 length = fixnum_value(vector->length);
1356 nwords = CEILING(length + 2, 2);
1363 scav_vector_bit(lispobj *where, lispobj object)
1365 struct vector *vector;
1368 vector = (struct vector *) where;
1369 length = fixnum_value(vector->length);
1370 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1376 trans_vector_bit(lispobj object)
1378 struct vector *vector;
1381 gc_assert(Pointerp(object));
1383 vector = (struct vector *) PTR(object);
1384 length = fixnum_value(vector->length);
1385 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1387 return copy_object(object, nwords);
1391 size_vector_bit(lispobj *where)
1393 struct vector *vector;
1396 vector = (struct vector *) where;
1397 length = fixnum_value(vector->length);
1398 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1405 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
1407 struct vector *vector;
1410 vector = (struct vector *) where;
1411 length = fixnum_value(vector->length);
1412 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1418 trans_vector_unsigned_byte_2(lispobj object)
1420 struct vector *vector;
1423 gc_assert(Pointerp(object));
1425 vector = (struct vector *) PTR(object);
1426 length = fixnum_value(vector->length);
1427 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1429 return copy_object(object, nwords);
1433 size_vector_unsigned_byte_2(lispobj *where)
1435 struct vector *vector;
1438 vector = (struct vector *) where;
1439 length = fixnum_value(vector->length);
1440 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1447 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
1449 struct vector *vector;
1452 vector = (struct vector *) where;
1453 length = fixnum_value(vector->length);
1454 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1460 trans_vector_unsigned_byte_4(lispobj object)
1462 struct vector *vector;
1465 gc_assert(Pointerp(object));
1467 vector = (struct vector *) PTR(object);
1468 length = fixnum_value(vector->length);
1469 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1471 return copy_object(object, nwords);
1475 size_vector_unsigned_byte_4(lispobj *where)
1477 struct vector *vector;
1480 vector = (struct vector *) where;
1481 length = fixnum_value(vector->length);
1482 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1489 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
1491 struct vector *vector;
1494 vector = (struct vector *) where;
1495 length = fixnum_value(vector->length);
1496 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1502 trans_vector_unsigned_byte_8(lispobj object)
1504 struct vector *vector;
1507 gc_assert(Pointerp(object));
1509 vector = (struct vector *) PTR(object);
1510 length = fixnum_value(vector->length);
1511 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1513 return copy_object(object, nwords);
1517 size_vector_unsigned_byte_8(lispobj *where)
1519 struct vector *vector;
1522 vector = (struct vector *) where;
1523 length = fixnum_value(vector->length);
1524 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1531 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1533 struct vector *vector;
1536 vector = (struct vector *) where;
1537 length = fixnum_value(vector->length);
1538 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1544 trans_vector_unsigned_byte_16(lispobj object)
1546 struct vector *vector;
1549 gc_assert(Pointerp(object));
1551 vector = (struct vector *) PTR(object);
1552 length = fixnum_value(vector->length);
1553 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1555 return copy_object(object, nwords);
1559 size_vector_unsigned_byte_16(lispobj *where)
1561 struct vector *vector;
1564 vector = (struct vector *) where;
1565 length = fixnum_value(vector->length);
1566 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1573 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1575 struct vector *vector;
1578 vector = (struct vector *) where;
1579 length = fixnum_value(vector->length);
1580 nwords = CEILING(length + 2, 2);
1586 trans_vector_unsigned_byte_32(lispobj object)
1588 struct vector *vector;
1591 gc_assert(Pointerp(object));
1593 vector = (struct vector *) PTR(object);
1594 length = fixnum_value(vector->length);
1595 nwords = CEILING(length + 2, 2);
1597 return copy_object(object, nwords);
1601 size_vector_unsigned_byte_32(lispobj *where)
1603 struct vector *vector;
1606 vector = (struct vector *) where;
1607 length = fixnum_value(vector->length);
1608 nwords = CEILING(length + 2, 2);
1615 scav_vector_single_float(lispobj *where, lispobj object)
1617 struct vector *vector;
1620 vector = (struct vector *) where;
1621 length = fixnum_value(vector->length);
1622 nwords = CEILING(length + 2, 2);
1628 trans_vector_single_float(lispobj object)
1630 struct vector *vector;
1633 gc_assert(Pointerp(object));
1635 vector = (struct vector *) PTR(object);
1636 length = fixnum_value(vector->length);
1637 nwords = CEILING(length + 2, 2);
1639 return copy_object(object, nwords);
1643 size_vector_single_float(lispobj *where)
1645 struct vector *vector;
1648 vector = (struct vector *) where;
1649 length = fixnum_value(vector->length);
1650 nwords = CEILING(length + 2, 2);
1657 scav_vector_double_float(lispobj *where, lispobj object)
1659 struct vector *vector;
1662 vector = (struct vector *) where;
1663 length = fixnum_value(vector->length);
1664 nwords = CEILING(length * 2 + 2, 2);
1670 trans_vector_double_float(lispobj object)
1672 struct vector *vector;
1675 gc_assert(Pointerp(object));
1677 vector = (struct vector *) PTR(object);
1678 length = fixnum_value(vector->length);
1679 nwords = CEILING(length * 2 + 2, 2);
1681 return copy_object(object, nwords);
1685 size_vector_double_float(lispobj *where)
1687 struct vector *vector;
1690 vector = (struct vector *) where;
1691 length = fixnum_value(vector->length);
1692 nwords = CEILING(length * 2 + 2, 2);
1698 #ifdef type_SimpleArrayLongFloat
1700 scav_vector_long_float(lispobj *where, lispobj object)
1702 struct vector *vector;
1705 vector = (struct vector *) where;
1706 length = fixnum_value(vector->length);
1708 nwords = CEILING(length * 4 + 2, 2);
1715 trans_vector_long_float(lispobj object)
1717 struct vector *vector;
1720 gc_assert(Pointerp(object));
1722 vector = (struct vector *) PTR(object);
1723 length = fixnum_value(vector->length);
1725 nwords = CEILING(length * 4 + 2, 2);
1728 return copy_object(object, nwords);
1732 size_vector_long_float(lispobj *where)
1734 struct vector *vector;
1737 vector = (struct vector *) where;
1738 length = fixnum_value(vector->length);
1740 nwords = CEILING(length * 4 + 2, 2);
1748 #ifdef type_SimpleArrayComplexSingleFloat
1750 scav_vector_complex_single_float(lispobj *where, lispobj object)
1752 struct vector *vector;
1755 vector = (struct vector *) where;
1756 length = fixnum_value(vector->length);
1757 nwords = CEILING(length * 2 + 2, 2);
1763 trans_vector_complex_single_float(lispobj object)
1765 struct vector *vector;
1768 gc_assert(Pointerp(object));
1770 vector = (struct vector *) PTR(object);
1771 length = fixnum_value(vector->length);
1772 nwords = CEILING(length * 2 + 2, 2);
1774 return copy_object(object, nwords);
1778 size_vector_complex_single_float(lispobj *where)
1780 struct vector *vector;
1783 vector = (struct vector *) where;
1784 length = fixnum_value(vector->length);
1785 nwords = CEILING(length * 2 + 2, 2);
1791 #ifdef type_SimpleArrayComplexDoubleFloat
1793 scav_vector_complex_double_float(lispobj *where, lispobj object)
1795 struct vector *vector;
1798 vector = (struct vector *) where;
1799 length = fixnum_value(vector->length);
1800 nwords = CEILING(length * 4 + 2, 2);
1806 trans_vector_complex_double_float(lispobj object)
1808 struct vector *vector;
1811 gc_assert(Pointerp(object));
1813 vector = (struct vector *) PTR(object);
1814 length = fixnum_value(vector->length);
1815 nwords = CEILING(length * 4 + 2, 2);
1817 return copy_object(object, nwords);
1821 size_vector_complex_double_float(lispobj *where)
1823 struct vector *vector;
1826 vector = (struct vector *) where;
1827 length = fixnum_value(vector->length);
1828 nwords = CEILING(length * 4 + 2, 2);
1834 #ifdef type_SimpleArrayComplexLongFloat
1836 scav_vector_complex_long_float(lispobj *where, lispobj object)
1838 struct vector *vector;
1841 vector = (struct vector *) where;
1842 length = fixnum_value(vector->length);
1844 nwords = CEILING(length * 8 + 2, 2);
1851 trans_vector_complex_long_float(lispobj object)
1853 struct vector *vector;
1856 gc_assert(Pointerp(object));
1858 vector = (struct vector *) PTR(object);
1859 length = fixnum_value(vector->length);
1861 nwords = CEILING(length * 8 + 2, 2);
1864 return copy_object(object, nwords);
1868 size_vector_complex_long_float(lispobj *where)
1870 struct vector *vector;
1873 vector = (struct vector *) where;
1874 length = fixnum_value(vector->length);
1876 nwords = CEILING(length * 8 + 2, 2);
1886 #define WEAK_POINTER_NWORDS \
1887 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1890 scav_weak_pointer(lispobj *where, lispobj object)
1892 /* Do not let GC scavenge the value slot of the weak pointer */
1893 /* (that is why it is a weak pointer). Note: we could use */
1894 /* the scav_unboxed method here. */
1896 return WEAK_POINTER_NWORDS;
1900 trans_weak_pointer(lispobj object)
1903 struct weak_pointer *wp;
1905 gc_assert(Pointerp(object));
1907 #if defined(DEBUG_WEAK)
1908 printf("Transporting weak pointer from 0x%08x\n", object);
1911 /* Need to remember where all the weak pointers are that have */
1912 /* been transported so they can be fixed up in a post-GC pass. */
1914 copy = copy_object(object, WEAK_POINTER_NWORDS);
1915 wp = (struct weak_pointer *) PTR(copy);
1918 /* Push the weak pointer onto the list of weak pointers. */
1919 wp->next = LOW_WORD(weak_pointers);
1926 size_weak_pointer(lispobj *where)
1928 return WEAK_POINTER_NWORDS;
1931 void scan_weak_pointers(void)
1933 struct weak_pointer *wp;
1935 for (wp = weak_pointers; wp != (struct weak_pointer *) NULL;
1936 wp = (struct weak_pointer *)((unsigned long)wp->next)) {
1938 lispobj first, *first_pointer;
1942 #if defined(DEBUG_WEAK)
1943 printf("Weak pointer at 0x%p\n", wp);
1944 printf("Value: 0x%08x\n", (unsigned int) value);
1947 if (!(Pointerp(value) && from_space_p(value)))
1950 /* Now, we need to check if the object has been */
1951 /* forwarded. If it has been, the weak pointer is */
1952 /* still good and needs to be updated. Otherwise, the */
1953 /* weak pointer needs to be nil'ed out. */
1955 first_pointer = (lispobj *) PTR(value);
1956 first = *first_pointer;
1958 #if defined(DEBUG_WEAK)
1959 printf("First: 0x%08x\n", (unsigned long) first);
1962 if (Pointerp(first) && new_space_p(first))
1973 /* Initialization */
1976 scav_lose(lispobj *where, lispobj object)
1978 fprintf(stderr, "GC lossage. No scavenge function for object 0x%08x (at 0x%016lx)\n",
1979 (unsigned int) object, (unsigned long)where);
1985 trans_lose(lispobj object)
1987 fprintf(stderr, "GC lossage. No transport function for object 0x%08x\n",
1988 (unsigned int)object);
1994 size_lose(lispobj *where)
1996 fprintf(stderr, "Size lossage. No size function for object at 0x%p\n",
1998 fprintf(stderr, "First word of object: 0x%08x\n",
2007 /* Scavenge Table */
2008 for (i = 0; i < 256; i++)
2009 scavtab[i] = scav_lose;
2010 /* scavtab[i] = scav_immediate; */
2012 for (i = 0; i < 32; i++) {
2013 scavtab[type_EvenFixnum|(i<<3)] = scav_immediate;
2014 scavtab[type_FunctionPointer|(i<<3)] = scav_function_pointer;
2015 /* OtherImmediate0 */
2016 scavtab[type_ListPointer|(i<<3)] = scav_list_pointer;
2017 scavtab[type_OddFixnum|(i<<3)] = scav_immediate;
2018 scavtab[type_InstancePointer|(i<<3)] = scav_instance_pointer;
2019 /* OtherImmediate1 */
2020 scavtab[type_OtherPointer|(i<<3)] = scav_other_pointer;
2023 scavtab[type_Bignum] = scav_unboxed;
2024 scavtab[type_Ratio] = scav_boxed;
2025 scavtab[type_SingleFloat] = scav_unboxed;
2026 scavtab[type_DoubleFloat] = scav_unboxed;
2027 #ifdef type_LongFloat
2028 scavtab[type_LongFloat] = scav_unboxed;
2030 scavtab[type_Complex] = scav_boxed;
2031 #ifdef type_ComplexSingleFloat
2032 scavtab[type_ComplexSingleFloat] = scav_unboxed;
2034 #ifdef type_ComplexDoubleFloat
2035 scavtab[type_ComplexDoubleFloat] = scav_unboxed;
2037 #ifdef type_ComplexLongFloat
2038 scavtab[type_ComplexLongFloat] = scav_unboxed;
2040 scavtab[type_SimpleArray] = scav_boxed;
2041 scavtab[type_SimpleString] = scav_string;
2042 scavtab[type_SimpleBitVector] = scav_vector_bit;
2043 scavtab[type_SimpleVector] = scav_vector;
2044 scavtab[type_SimpleArrayUnsignedByte2] = scav_vector_unsigned_byte_2;
2045 scavtab[type_SimpleArrayUnsignedByte4] = scav_vector_unsigned_byte_4;
2046 scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8;
2047 scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16;
2048 scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32;
2049 #ifdef type_SimpleArraySignedByte8
2050 scavtab[type_SimpleArraySignedByte8] = scav_vector_unsigned_byte_8;
2052 #ifdef type_SimpleArraySignedByte16
2053 scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16;
2055 #ifdef type_SimpleArraySignedByte30
2056 scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32;
2058 #ifdef type_SimpleArraySignedByte32
2059 scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32;
2061 scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float;
2062 scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float;
2063 #ifdef type_SimpleArrayLongFloat
2064 scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float;
2066 #ifdef type_SimpleArrayComplexSingleFloat
2067 scavtab[type_SimpleArrayComplexSingleFloat] = scav_vector_complex_single_float;
2069 #ifdef type_SimpleArrayComplexDoubleFloat
2070 scavtab[type_SimpleArrayComplexDoubleFloat] = scav_vector_complex_double_float;
2072 #ifdef type_SimpleArrayComplexLongFloat
2073 scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float;
2075 scavtab[type_ComplexString] = scav_boxed;
2076 scavtab[type_ComplexBitVector] = scav_boxed;
2077 scavtab[type_ComplexVector] = scav_boxed;
2078 scavtab[type_ComplexArray] = scav_boxed;
2079 scavtab[type_CodeHeader] = scav_code_header;
2080 scavtab[type_FunctionHeader] = scav_function_header;
2081 scavtab[type_ClosureFunctionHeader] = scav_function_header;
2082 scavtab[type_ReturnPcHeader] = scav_return_pc_header;
2084 scavtab[type_ClosureHeader] = scav_closure_header;
2085 scavtab[type_FuncallableInstanceHeader] = scav_closure_header;
2086 scavtab[type_ByteCodeFunction] = scav_closure_header;
2087 scavtab[type_ByteCodeClosure] = scav_closure_header;
2088 /* scavtab[type_DylanFunctionHeader] = scav_closure_header; */
2090 scavtab[type_ClosureHeader] = scav_boxed;
2091 scavtab[type_FuncallableInstanceHeader] = scav_boxed;
2092 scavtab[type_ByteCodeFunction] = scav_boxed;
2093 scavtab[type_ByteCodeClosure] = scav_boxed;
2094 /* scavtab[type_DylanFunctionHeader] = scav_boxed; */
2096 scavtab[type_ValueCellHeader] = scav_boxed;
2097 scavtab[type_SymbolHeader] = scav_boxed;
2098 scavtab[type_BaseChar] = scav_immediate;
2099 scavtab[type_Sap] = scav_unboxed;
2100 scavtab[type_UnboundMarker] = scav_immediate;
2101 scavtab[type_WeakPointer] = scav_weak_pointer;
2102 scavtab[type_InstanceHeader] = scav_boxed;
2104 scavtab[type_Fdefn] = scav_fdefn;
2106 scavtab[type_Fdefn] = scav_boxed;
2109 /* Transport Other Table */
2110 for (i = 0; i < 256; i++)
2111 transother[i] = trans_lose;
2113 transother[type_Bignum] = trans_unboxed;
2114 transother[type_Ratio] = trans_boxed;
2115 transother[type_SingleFloat] = trans_unboxed;
2116 transother[type_DoubleFloat] = trans_unboxed;
2117 #ifdef type_LongFloat
2118 transother[type_LongFloat] = trans_unboxed;
2120 transother[type_Complex] = trans_boxed;
2121 #ifdef type_ComplexSingleFloat
2122 transother[type_ComplexSingleFloat] = trans_unboxed;
2124 #ifdef type_ComplexDoubleFloat
2125 transother[type_ComplexDoubleFloat] = trans_unboxed;
2127 #ifdef type_ComplexLongFloat
2128 transother[type_ComplexLongFloat] = trans_unboxed;
2130 transother[type_SimpleArray] = trans_boxed;
2131 transother[type_SimpleString] = trans_string;
2132 transother[type_SimpleBitVector] = trans_vector_bit;
2133 transother[type_SimpleVector] = trans_vector;
2134 transother[type_SimpleArrayUnsignedByte2] = trans_vector_unsigned_byte_2;
2135 transother[type_SimpleArrayUnsignedByte4] = trans_vector_unsigned_byte_4;
2136 transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8;
2137 transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16;
2138 transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32;
2139 #ifdef type_SimpleArraySignedByte8
2140 transother[type_SimpleArraySignedByte8] = trans_vector_unsigned_byte_8;
2142 #ifdef type_SimpleArraySignedByte16
2143 transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16;
2145 #ifdef type_SimpleArraySignedByte30
2146 transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32;
2148 #ifdef type_SimpleArraySignedByte32
2149 transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32;
2151 transother[type_SimpleArraySingleFloat] = trans_vector_single_float;
2152 transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float;
2153 #ifdef type_SimpleArrayLongFloat
2154 transother[type_SimpleArrayLongFloat] = trans_vector_long_float;
2156 #ifdef type_SimpleArrayComplexSingleFloat
2157 transother[type_SimpleArrayComplexSingleFloat] = trans_vector_complex_single_float;
2159 #ifdef type_SimpleArrayComplexDoubleFloat
2160 transother[type_SimpleArrayComplexDoubleFloat] = trans_vector_complex_double_float;
2162 #ifdef type_SimpleArrayComplexLongFloat
2163 transother[type_SimpleArrayComplexLongFloat] = trans_vector_complex_long_float;
2165 transother[type_ComplexString] = trans_boxed;
2166 transother[type_ComplexBitVector] = trans_boxed;
2167 transother[type_ComplexVector] = trans_boxed;
2168 transother[type_ComplexArray] = trans_boxed;
2169 transother[type_CodeHeader] = trans_code_header;
2170 transother[type_FunctionHeader] = trans_function_header;
2171 transother[type_ClosureFunctionHeader] = trans_function_header;
2172 transother[type_ReturnPcHeader] = trans_return_pc_header;
2173 transother[type_ClosureHeader] = trans_boxed;
2174 transother[type_FuncallableInstanceHeader] = trans_boxed;
2175 transother[type_ByteCodeFunction] = trans_boxed;
2176 transother[type_ByteCodeClosure] = trans_boxed;
2177 transother[type_ValueCellHeader] = trans_boxed;
2178 transother[type_SymbolHeader] = trans_boxed;
2179 transother[type_BaseChar] = trans_immediate;
2180 transother[type_Sap] = trans_unboxed;
2181 transother[type_UnboundMarker] = trans_immediate;
2182 transother[type_WeakPointer] = trans_weak_pointer;
2183 transother[type_InstanceHeader] = trans_boxed;
2184 transother[type_Fdefn] = trans_boxed;
2188 for (i = 0; i < 256; i++)
2189 sizetab[i] = size_lose;
2191 for (i = 0; i < 32; i++) {
2192 sizetab[type_EvenFixnum|(i<<3)] = size_immediate;
2193 sizetab[type_FunctionPointer|(i<<3)] = size_pointer;
2194 /* OtherImmediate0 */
2195 sizetab[type_ListPointer|(i<<3)] = size_pointer;
2196 sizetab[type_OddFixnum|(i<<3)] = size_immediate;
2197 sizetab[type_InstancePointer|(i<<3)] = size_pointer;
2198 /* OtherImmediate1 */
2199 sizetab[type_OtherPointer|(i<<3)] = size_pointer;
2202 sizetab[type_Bignum] = size_unboxed;
2203 sizetab[type_Ratio] = size_boxed;
2204 sizetab[type_SingleFloat] = size_unboxed;
2205 sizetab[type_DoubleFloat] = size_unboxed;
2206 #ifdef type_LongFloat
2207 sizetab[type_LongFloat] = size_unboxed;
2209 sizetab[type_Complex] = size_boxed;
2210 #ifdef type_ComplexSingleFloat
2211 sizetab[type_ComplexSingleFloat] = size_unboxed;
2213 #ifdef type_ComplexDoubleFloat
2214 sizetab[type_ComplexDoubleFloat] = size_unboxed;
2216 #ifdef type_ComplexLongFloat
2217 sizetab[type_ComplexLongFloat] = size_unboxed;
2219 sizetab[type_SimpleArray] = size_boxed;
2220 sizetab[type_SimpleString] = size_string;
2221 sizetab[type_SimpleBitVector] = size_vector_bit;
2222 sizetab[type_SimpleVector] = size_vector;
2223 sizetab[type_SimpleArrayUnsignedByte2] = size_vector_unsigned_byte_2;
2224 sizetab[type_SimpleArrayUnsignedByte4] = size_vector_unsigned_byte_4;
2225 sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8;
2226 sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16;
2227 sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32;
2228 #ifdef type_SimpleArraySignedByte8
2229 sizetab[type_SimpleArraySignedByte8] = size_vector_unsigned_byte_8;
2231 #ifdef type_SimpleArraySignedByte16
2232 sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16;
2234 #ifdef type_SimpleArraySignedByte30
2235 sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32;
2237 #ifdef type_SimpleArraySignedByte32
2238 sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32;
2240 sizetab[type_SimpleArraySingleFloat] = size_vector_single_float;
2241 sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float;
2242 #ifdef type_SimpleArrayLongFloat
2243 sizetab[type_SimpleArrayLongFloat] = size_vector_long_float;
2245 #ifdef type_SimpleArrayComplexSingleFloat
2246 sizetab[type_SimpleArrayComplexSingleFloat] = size_vector_complex_single_float;
2248 #ifdef type_SimpleArrayComplexDoubleFloat
2249 sizetab[type_SimpleArrayComplexDoubleFloat] = size_vector_complex_double_float;
2251 #ifdef type_SimpleArrayComplexLongFloat
2252 sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float;
2254 sizetab[type_ComplexString] = size_boxed;
2255 sizetab[type_ComplexBitVector] = size_boxed;
2256 sizetab[type_ComplexVector] = size_boxed;
2257 sizetab[type_ComplexArray] = size_boxed;
2258 sizetab[type_CodeHeader] = size_code_header;
2260 /* Shouldn't see these so just lose if it happens */
2261 sizetab[type_FunctionHeader] = size_function_header;
2262 sizetab[type_ClosureFunctionHeader] = size_function_header;
2263 sizetab[type_ReturnPcHeader] = size_return_pc_header;
2265 sizetab[type_ClosureHeader] = size_boxed;
2266 sizetab[type_FuncallableInstanceHeader] = size_boxed;
2267 sizetab[type_ValueCellHeader] = size_boxed;
2268 sizetab[type_SymbolHeader] = size_boxed;
2269 sizetab[type_BaseChar] = size_immediate;
2270 sizetab[type_Sap] = size_unboxed;
2271 sizetab[type_UnboundMarker] = size_immediate;
2272 sizetab[type_WeakPointer] = size_weak_pointer;
2273 sizetab[type_InstanceHeader] = size_boxed;
2274 sizetab[type_Fdefn] = size_boxed;
2279 /* Noise to manipulate the gc trigger stuff. */
2283 void set_auto_gc_trigger(os_vm_size_t dynamic_usage)
2285 os_vm_address_t addr=(os_vm_address_t)current_dynamic_space +
2288 DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
2290 if(addr < (os_vm_address_t)dynamic_space_free_pointer) {
2292 "set_auto_gc_trigger: tried to set gc trigger too low! (%d < %p)\n",
2293 (unsigned int)dynamic_usage,
2294 (os_vm_address_t)dynamic_space_free_pointer
2295 - (os_vm_address_t)current_dynamic_space);
2298 else if (length < 0) {
2300 "set_auto_gc_trigger: tried to set gc trigger too high! (%p)\n",
2305 addr=os_round_up_to_page(addr);
2306 length=os_trunc_size_to_page(length);
2308 #if defined(SUNOS) || defined(SOLARIS)
2309 os_invalidate(addr,length);
2311 os_protect(addr, length, 0);
2314 current_auto_gc_trigger = (lispobj *)addr;
2317 void clear_auto_gc_trigger(void)
2319 if(current_auto_gc_trigger!=NULL){
2320 #if defined(SUNOS) || defined(SOLARIS)/* don't want to force whole space into swapping mode... */
2321 os_vm_address_t addr=(os_vm_address_t)current_auto_gc_trigger;
2322 os_vm_size_t length=
2323 DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
2325 os_validate(addr,length);
2327 os_protect((os_vm_address_t)current_dynamic_space,
2332 current_auto_gc_trigger = NULL;