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)
75 boolean from_space_p(lispobj object)
79 /* this can be called for untagged pointers as well as for
80 descriptors, so this assertion's not applicable
81 gc_assert(Pointerp(object));
83 ptr = (lispobj *) PTR(object);
85 return ((from_space <= ptr) &&
86 (ptr < from_space_free_pointer));
89 boolean new_space_p(lispobj object)
93 gc_assert(Pointerp(object));
95 ptr = (lispobj *) PTR(object);
97 return ((new_space <= ptr) &&
98 (ptr < new_space_free_pointer));
103 #define from_space_p(ptr) \
104 ((from_space <= ((lispobj *) ptr)) && \
105 (((lispobj *) ptr) < from_space_free_pointer))
107 #define new_space_p(ptr) \
108 ((new_space <= ((lispobj *) ptr)) && \
109 (((lispobj *) ptr) < new_space_free_pointer))
114 /* Copying Objects */
117 copy_object(lispobj object, int nwords)
121 lispobj *source, *dest;
123 gc_assert(Pointerp(object));
124 gc_assert(from_space_p(object));
125 gc_assert((nwords & 0x01) == 0);
127 /* get tag of object */
128 tag = LowtagOf(object);
131 new = new_space_free_pointer;
132 new_space_free_pointer += nwords;
135 source = (lispobj *) PTR(object);
137 #ifdef DEBUG_COPY_VERBOSE
138 fprintf(stderr,"Copying %d words from %p to %p\n", nwords,source,new);
141 /* copy the object */
149 /* return lisp pointer of new object */
150 return (lispobj)(LOW_WORD(new) | tag);
154 /* Collect Garbage */
157 static double tv_diff(struct timeval *x, struct timeval *y)
159 return (((double) x->tv_sec + (double) x->tv_usec * 1.0e-6) -
160 ((double) y->tv_sec + (double) y->tv_usec * 1.0e-6));
164 #define BYTES_ZERO_BEFORE_END (1<<12)
169 #define U32 unsigned long
171 static void zero_stack(void)
173 U32 *ptr = (U32 *)current_control_stack_pointer;
179 } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
184 } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
191 /* this is not generational. It's called with a last_gen arg, which we shun.
194 void collect_garbage(unsigned ignore)
197 struct timeval start_tv, stop_tv;
198 struct rusage start_rusage, stop_rusage;
199 double real_time, system_time, user_time;
200 double percent_retained, gc_rate;
201 unsigned long size_discarded;
202 unsigned long size_retained;
204 lispobj *current_static_space_free_pointer;
205 unsigned long static_space_size;
206 unsigned long control_stack_size, binding_stack_size;
210 printf("[Collecting garbage ... \n");
212 getrusage(RUSAGE_SELF, &start_rusage);
213 gettimeofday(&start_tv, (struct timezone *) 0);
217 sigaddset_blockable(&tmp);
218 sigprocmask(SIG_BLOCK, &tmp, &old);
220 current_static_space_free_pointer =
221 (lispobj *) ((unsigned long)
222 SymbolValue(STATIC_SPACE_FREE_POINTER));
225 /* Set up from space and new space pointers. */
227 from_space = current_dynamic_space;
229 from_space_free_pointer = dynamic_space_free_pointer;
231 from_space_free_pointer = (lispobj *)SymbolValue(ALLOCATION_POINTER);
234 fprintf(stderr,"from_space = %lx\n",
235 (unsigned long) current_dynamic_space);
236 if (current_dynamic_space == (lispobj *) DYNAMIC_0_SPACE_START)
237 new_space = (lispobj *)DYNAMIC_1_SPACE_START;
238 else if (current_dynamic_space == (lispobj *) DYNAMIC_1_SPACE_START)
239 new_space = (lispobj *) DYNAMIC_0_SPACE_START;
241 lose("GC lossage. Current dynamic space is bogus!\n");
243 new_space_free_pointer = new_space;
246 /* Initialize the weak pointer list. */
247 weak_pointers = (struct weak_pointer *) NULL;
250 /* Scavenge all of the roots. */
252 printf("Scavenging interrupt contexts ...\n");
254 scavenge_interrupt_contexts();
257 printf("Scavenging interrupt handlers (%d bytes) ...\n",
258 (int)sizeof(interrupt_handlers));
260 scavenge((lispobj *) interrupt_handlers,
261 sizeof(interrupt_handlers) / sizeof(lispobj));
263 /* _size quantities are in units of sizeof(lispobj) - i.e. 4 */
265 current_control_stack_pointer-
266 (lispobj *)CONTROL_STACK_START;
268 printf("Scavenging the control stack at %p (%ld words) ...\n",
269 ((lispobj *)CONTROL_STACK_START),
272 scavenge(((lispobj *)CONTROL_STACK_START), control_stack_size);
277 (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack;
280 current_binding_stack_pointer -
281 (lispobj *)BINDING_STACK_START;
284 printf("Scavenging the binding stack %x - %x (%d words) ...\n",
285 BINDING_STACK_START,current_binding_stack_pointer,
286 (int)(binding_stack_size));
288 scavenge(((lispobj *)BINDING_STACK_START), binding_stack_size);
291 current_static_space_free_pointer - (lispobj *) STATIC_SPACE_START;
293 printf("Scavenging static space %x - %x (%d words) ...\n",
294 STATIC_SPACE_START,current_static_space_free_pointer,
295 (int)(static_space_size));
297 scavenge(((lispobj *)STATIC_SPACE_START), static_space_size);
299 /* Scavenge newspace. */
301 printf("Scavenging new space (%d bytes) ...\n",
302 (int)((new_space_free_pointer - new_space) * sizeof(lispobj)));
307 #if defined(DEBUG_PRINT_GARBAGE)
308 print_garbage(from_space, from_space_free_pointer);
311 /* Scan the weak pointers. */
313 printf("Scanning weak pointers ...\n");
315 scan_weak_pointers();
320 printf("Flipping spaces ...\n");
323 os_zero((os_vm_address_t) current_dynamic_space,
324 (os_vm_size_t) DYNAMIC_SPACE_SIZE);
326 current_dynamic_space = new_space;
328 dynamic_space_free_pointer = new_space_free_pointer;
330 SetSymbolValue(ALLOCATION_POINTER, (lispobj)new_space_free_pointer);
334 size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj);
335 size_retained = (new_space_free_pointer - new_space) * sizeof(lispobj);
340 printf("Zeroing empty part of control stack ...\n");
344 sigprocmask(SIG_SETMASK, &old, 0);
348 gettimeofday(&stop_tv, (struct timezone *) 0);
349 getrusage(RUSAGE_SELF, &stop_rusage);
353 percent_retained = (((float) size_retained) /
354 ((float) size_discarded)) * 100.0;
356 printf("Total of %ld bytes out of %ld bytes retained (%3.2f%%).\n",
357 size_retained, size_discarded, percent_retained);
359 real_time = tv_diff(&stop_tv, &start_tv);
360 user_time = tv_diff(&stop_rusage.ru_utime, &start_rusage.ru_utime);
361 system_time = tv_diff(&stop_rusage.ru_stime, &start_rusage.ru_stime);
364 printf("Statistics:\n");
365 printf("%10.2f sec of real time\n", real_time);
366 printf("%10.2f sec of user time,\n", user_time);
367 printf("%10.2f sec of system time.\n", system_time);
369 printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n",
370 real_time, user_time, system_time);
373 gc_rate = ((float) size_retained / (float) (1<<20)) / real_time;
375 printf("%10.2f M bytes/sec collected.\n", gc_rate);
382 #define DIRECT_SCAV 0
385 scavenge(lispobj *start, u32 nwords)
389 int type, words_scavenged;
392 type = TypeOf(object);
394 #if defined(DEBUG_SCAVENGE_VERBOSE)
395 fprintf(stderr,"Scavenging object at 0x%08x, object = 0x%08x, type = %d\n",
396 (unsigned long) start, (unsigned long) object, type);
400 words_scavenged = (scavtab[type])(start, object);
402 if (Pointerp(object)) {
403 /* It be a pointer. */
404 if (from_space_p(object)) {
405 /* It currently points to old space. Check for a */
406 /* forwarding pointer. */
409 first_word = *((lispobj *)PTR(object));
410 if (Pointerp(first_word) && new_space_p(first_word)) {
411 /* Yep, there be a forwarding pointer. */
416 /* Scavenge that pointer. */
417 words_scavenged = (scavtab[type])(start, object);
421 /* It points somewhere other than oldspace. Leave */
427 /* there are some situations where an
428 other-immediate may end up in a descriptor
429 register. I'm not sure whether this is
430 supposed to happen, but if it does then we
431 don't want to (a) barf or (b) scavenge over the
432 data-block, because there isn't one. So, if
433 we're checking a single word and it's anything
434 other than a pointer, just hush it up */
437 if((scavtab[type]==scav_lose) ||
438 (((scavtab[type])(start,object))>1)) {
439 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",
443 else if ((object & 3) == 0) {
444 /* It's a fixnum. Real easy. */
448 /* It's some random header object. */
449 words_scavenged = (scavtab[type])(start, object);
453 start += words_scavenged;
454 nwords -= words_scavenged;
456 gc_assert(nwords == 0);
459 static void scavenge_newspace(void)
461 lispobj *here, *next;
464 while (here < new_space_free_pointer) {
465 /* printf("here=%lx, new_space_free_pointer=%lx\n",
466 here,new_space_free_pointer); */
467 next = new_space_free_pointer;
468 scavenge(here, next - here);
471 /* printf("done with newspace\n"); */
475 /* Scavenging Interrupt Contexts */
477 static int boxed_registers[] = BOXED_REGISTERS;
479 static void scavenge_interrupt_context(os_context_t *context)
484 unsigned long lip_offset;
485 int lip_register_pair;
487 unsigned long pc_code_offset;
489 unsigned long npc_code_offset;
492 /* Find the LIP's register pair and calculate its offset */
493 /* before we scavenge the context. */
495 lip = *os_context_register_addr(context, reg_LIP);
496 /* 0x7FFFFFFF or 0x7FFFFFFFFFFFFFFF ? */
497 lip_offset = 0x7FFFFFFF;
498 lip_register_pair = -1;
499 for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
504 index = boxed_registers[i];
505 reg = *os_context_register_addr(context, index);
506 /* would be using PTR if not for integer length issues */
507 if ((reg & ~((1L<<lowtag_Bits)-1)) <= lip) {
509 if (offset < lip_offset) {
511 lip_register_pair = index;
517 /* Compute the PC's offset from the start of the CODE */
519 pc_code_offset = *os_context_pc_addr(context) -
520 *os_context_register_addr(context, reg_CODE);
522 npc_code_offset = SC_NPC(context) - SC_REG(context, reg_CODE);
525 /* Scanvenge all boxed registers in the context. */
526 for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
530 index = boxed_registers[i];
531 foo = *os_context_register_addr(context,index);
532 scavenge((lispobj *) &foo, 1);
533 *os_context_register_addr(context,index) = foo;
535 /* this is unlikely to work as intended on bigendian
536 * 64 bit platforms */
539 os_context_register_addr(context, index), 1);
544 *os_context_register_addr(context, reg_LIP) =
545 *os_context_register_addr(context, lip_register_pair) + lip_offset;
548 /* Fix the PC if it was in from space */
549 if (from_space_p(*os_context_pc_addr(context)))
550 *os_context_pc_addr(context) =
551 *os_context_register_addr(context, reg_CODE) + pc_code_offset;
553 if (from_space_p(SC_NPC(context)))
554 SC_NPC(context) = SC_REG(context, reg_CODE) + npc_code_offset;
558 void scavenge_interrupt_contexts(void)
561 os_context_t *context;
563 index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX));
564 printf("Number of active contexts: %d\n", index);
566 for (i = 0; i < index; i++) {
567 context = lisp_interrupt_contexts[i];
568 scavenge_interrupt_context(context);
575 void print_garbage(lispobj *from_space, lispobj *from_space_free_pointer)
578 int total_words_not_copied;
580 printf("Scanning from space ...\n");
582 total_words_not_copied = 0;
584 while (start < from_space_free_pointer) {
586 int forwardp, type, nwords;
590 forwardp = Pointerp(object) && new_space_p(object);
596 tag = LowtagOf(object);
599 case type_ListPointer:
602 case type_InstancePointer:
603 printf("Don't know about instances yet!\n");
606 case type_FunctionPointer:
609 case type_OtherPointer:
610 pointer = (lispobj *) PTR(object);
612 type = TypeOf(header);
613 nwords = (sizetab[type])(pointer);
616 type = TypeOf(object);
617 nwords = (sizetab[type])(start);
618 total_words_not_copied += nwords;
619 printf("%4d words not copied at 0x%16lx; ",
620 nwords, (unsigned long) start);
621 printf("Header word is 0x%08x\n",
622 (unsigned int) object);
626 printf("%d total words not copied.\n", total_words_not_copied);
630 /* Code and Code-Related Objects */
632 #define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)
634 static lispobj trans_function_header(lispobj object);
635 static lispobj trans_boxed(lispobj object);
639 scav_function_pointer(lispobj *where, lispobj object)
641 gc_assert(Pointerp(object));
643 if (from_space_p(object)) {
644 lispobj first, *first_pointer;
646 /* object is a pointer into from space. check to see */
647 /* if it has been forwarded */
648 first_pointer = (lispobj *) PTR(object);
649 first = *first_pointer;
651 if (!(Pointerp(first) && new_space_p(first))) {
655 /* must transport object -- object may point */
656 /* to either a function header, a closure */
657 /* function header, or to a closure header. */
659 type = TypeOf(first);
661 case type_FunctionHeader:
662 case type_ClosureFunctionHeader:
663 copy = trans_function_header(object);
666 copy = trans_boxed(object);
670 first = *first_pointer = copy;
673 gc_assert(Pointerp(first));
674 gc_assert(!from_space_p(first));
682 scav_function_pointer(lispobj *where, lispobj object)
684 lispobj *first_pointer;
689 gc_assert(Pointerp(object));
691 /* object is a pointer into from space. Not a FP */
692 first_pointer = (lispobj *) PTR(object);
693 first = *first_pointer;
695 /* must transport object -- object may point */
696 /* to either a function header, a closure */
697 /* function header, or to a closure header. */
699 type = TypeOf(first);
701 case type_FunctionHeader:
702 case type_ClosureFunctionHeader:
703 copy = trans_function_header(object);
706 copy = trans_boxed(object);
710 first = *first_pointer = copy;
712 gc_assert(Pointerp(first));
713 gc_assert(!from_space_p(first));
721 trans_code(struct code *code)
723 struct code *new_code;
724 lispobj first, l_code, l_new_code;
725 int nheader_words, ncode_words, nwords;
726 unsigned long displacement;
727 lispobj fheaderl, *prev_pointer;
729 #if defined(DEBUG_CODE_GC)
730 printf("\nTransporting code object located at 0x%08x.\n",
731 (unsigned long) code);
734 /* if object has already been transported, just return pointer */
735 first = code->header;
736 if (Pointerp(first) && new_space_p(first)) {
738 printf("Was already transported\n");
740 return (struct code *) PTR(first);
743 gc_assert(TypeOf(first) == type_CodeHeader);
745 /* prepare to transport the code vector */
746 l_code = (lispobj) LOW_WORD(code) | type_OtherPointer;
748 ncode_words = fixnum_value(code->code_size);
749 nheader_words = HeaderValue(code->header);
750 nwords = ncode_words + nheader_words;
751 nwords = CEILING(nwords, 2);
753 l_new_code = copy_object(l_code, nwords);
754 new_code = (struct code *) PTR(l_new_code);
756 displacement = l_new_code - l_code;
758 #if defined(DEBUG_CODE_GC)
759 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
760 (unsigned long) code, (unsigned long) new_code);
761 printf("Code object is %d words long.\n", nwords);
764 /* set forwarding pointer */
765 code->header = l_new_code;
767 /* set forwarding pointers for all the function headers in the */
768 /* code object. also fix all self pointers */
770 fheaderl = code->entry_points;
771 prev_pointer = &new_code->entry_points;
773 while (fheaderl != NIL) {
774 struct function *fheaderp, *nfheaderp;
777 fheaderp = (struct function *) PTR(fheaderl);
778 gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
780 /* calcuate the new function pointer and the new */
781 /* function header */
782 nfheaderl = fheaderl + displacement;
783 nfheaderp = (struct function *) PTR(nfheaderl);
785 /* set forwarding pointer */
787 printf("fheaderp->header (at %x) <- %x\n",
788 &(fheaderp->header) , nfheaderl);
790 fheaderp->header = nfheaderl;
792 /* fix self pointer */
793 nfheaderp->self = nfheaderl;
795 *prev_pointer = nfheaderl;
797 fheaderl = fheaderp->next;
798 prev_pointer = &nfheaderp->next;
802 os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words),
803 ncode_words * sizeof(int));
809 scav_code_header(lispobj *where, lispobj object)
812 int nheader_words, ncode_words, nwords;
814 struct function *fheaderp;
816 code = (struct code *) where;
817 ncode_words = fixnum_value(code->code_size);
818 nheader_words = HeaderValue(object);
819 nwords = ncode_words + nheader_words;
820 nwords = CEILING(nwords, 2);
822 #if defined(DEBUG_CODE_GC)
823 printf("\nScavening code object at 0x%08x.\n",
824 (unsigned long) where);
825 printf("Code object is %d words long.\n", nwords);
826 printf("Scavenging boxed section of code data block (%d words).\n",
830 /* Scavenge the boxed section of the code data block */
831 scavenge(where + 1, nheader_words - 1);
833 /* Scavenge the boxed section of each function object in the */
834 /* code data block */
835 fheaderl = code->entry_points;
836 while (fheaderl != NIL) {
837 fheaderp = (struct function *) PTR(fheaderl);
838 gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
840 #if defined(DEBUG_CODE_GC)
841 printf("Scavenging boxed section of entry point located at 0x%08x.\n",
842 (unsigned long) PTR(fheaderl));
844 scavenge(&fheaderp->name, 1);
845 scavenge(&fheaderp->arglist, 1);
846 scavenge(&fheaderp->type, 1);
848 fheaderl = fheaderp->next;
855 trans_code_header(lispobj object)
859 ncode = trans_code((struct code *) PTR(object));
860 return (lispobj) LOW_WORD(ncode) | type_OtherPointer;
864 size_code_header(lispobj *where)
867 int nheader_words, ncode_words, nwords;
869 code = (struct code *) where;
871 ncode_words = fixnum_value(code->code_size);
872 nheader_words = HeaderValue(code->header);
873 nwords = ncode_words + nheader_words;
874 nwords = CEILING(nwords, 2);
881 scav_return_pc_header(lispobj *where, lispobj object)
883 fprintf(stderr, "GC lossage. Should not be scavenging a ");
884 fprintf(stderr, "Return PC Header.\n");
885 fprintf(stderr, "where = 0x%p, object = 0x%x", where, object);
891 trans_return_pc_header(lispobj object)
893 struct function *return_pc;
894 unsigned long offset;
895 struct code *code, *ncode;
897 return_pc = (struct function *) PTR(object);
898 offset = HeaderValue(return_pc->header) * 4 ;
900 /* Transport the whole code object */
901 code = (struct code *) ((unsigned long) return_pc - offset);
903 printf("trans_return_pc_header object=%x, code=%lx\n",object,code);
905 ncode = trans_code(code);
906 if(object==0x304748d7) {
909 ret= ((lispobj) LOW_WORD(ncode) + offset) | type_OtherPointer;
911 printf("trans_return_pc_header returning %x\n",ret);
916 /* On the 386, closures hold a pointer to the raw address instead of the
917 function object, so we can use CALL [$FDEFN+const] to invoke the function
918 without loading it into a register. Given that code objects don't move,
919 we don't need to update anything, but we do have to figure out that the
920 function is still live. */
923 scav_closure_header(where, object)
924 lispobj *where, object;
926 struct closure *closure;
929 closure = (struct closure *)where;
930 fun = closure->function - RAW_ADDR_OFFSET;
938 scav_function_header(lispobj *where, lispobj object)
940 fprintf(stderr, "GC lossage. Should not be scavenging a ");
941 fprintf(stderr, "Function Header.\n");
942 fprintf(stderr, "where = 0x%p, object = 0x%08x",
943 where, (unsigned int) object);
949 trans_function_header(lispobj object)
951 struct function *fheader;
952 unsigned long offset;
953 struct code *code, *ncode;
955 fheader = (struct function *) PTR(object);
956 offset = HeaderValue(fheader->header) * 4;
958 /* Transport the whole code object */
959 code = (struct code *) ((unsigned long) fheader - offset);
960 ncode = trans_code(code);
962 return ((lispobj) LOW_WORD(ncode) + offset) | type_FunctionPointer;
971 scav_instance_pointer(lispobj *where, lispobj object)
973 if (from_space_p(object)) {
974 lispobj first, *first_pointer;
976 /* object is a pointer into from space. check to see */
977 /* if it has been forwarded */
978 first_pointer = (lispobj *) PTR(object);
979 first = *first_pointer;
981 if (!(Pointerp(first) && new_space_p(first)))
982 first = *first_pointer = trans_boxed(object);
989 scav_instance_pointer(lispobj *where, lispobj object)
991 lispobj *first_pointer;
993 /* object is a pointer into from space. Not a FP */
994 first_pointer = (lispobj *) PTR(object);
996 *where = *first_pointer = trans_boxed(object);
1002 /* Lists and Conses */
1004 static lispobj trans_list(lispobj object);
1008 scav_list_pointer(lispobj *where, lispobj object)
1010 gc_assert(Pointerp(object));
1012 if (from_space_p(object)) {
1013 lispobj first, *first_pointer;
1015 /* object is a pointer into from space. check to see */
1016 /* if it has been forwarded */
1017 first_pointer = (lispobj *) PTR(object);
1018 first = *first_pointer;
1020 if (!(Pointerp(first) && new_space_p(first)))
1021 first = *first_pointer = trans_list(object);
1023 gc_assert(Pointerp(first));
1024 gc_assert(!from_space_p(first));
1032 scav_list_pointer(lispobj *where, lispobj object)
1034 lispobj first, *first_pointer;
1036 gc_assert(Pointerp(object));
1038 /* object is a pointer into from space. Not a FP. */
1039 first_pointer = (lispobj *) PTR(object);
1041 first = *first_pointer = trans_list(object);
1043 gc_assert(Pointerp(first));
1044 gc_assert(!from_space_p(first));
1052 trans_list(lispobj object)
1054 lispobj new_list_pointer;
1055 struct cons *cons, *new_cons;
1057 cons = (struct cons *) PTR(object);
1059 /* ### Don't use copy_object here. */
1060 new_list_pointer = copy_object(object, 2);
1061 new_cons = (struct cons *) PTR(new_list_pointer);
1063 /* Set forwarding pointer. */
1064 cons->car = new_list_pointer;
1066 /* Try to linearize the list in the cdr direction to help reduce */
1070 lispobj cdr, new_cdr, first;
1071 struct cons *cdr_cons, *new_cdr_cons;
1075 if (LowtagOf(cdr) != type_ListPointer ||
1076 !from_space_p(cdr) ||
1077 (Pointerp(first = *(lispobj *)PTR(cdr)) &&
1078 new_space_p(first)))
1081 cdr_cons = (struct cons *) PTR(cdr);
1083 /* ### Don't use copy_object here */
1084 new_cdr = copy_object(cdr, 2);
1085 new_cdr_cons = (struct cons *) PTR(new_cdr);
1087 /* Set forwarding pointer */
1088 cdr_cons->car = new_cdr;
1090 /* Update the cdr of the last cons copied into new */
1091 /* space to keep the newspace scavenge from having to */
1093 new_cons->cdr = new_cdr;
1096 new_cons = new_cdr_cons;
1099 return new_list_pointer;
1103 /* Scavenging and Transporting Other Pointers */
1107 scav_other_pointer(lispobj *where, lispobj object)
1109 gc_assert(Pointerp(object));
1111 if (from_space_p(object)) {
1112 lispobj first, *first_pointer;
1114 /* object is a pointer into from space. check to see */
1115 /* if it has been forwarded */
1116 first_pointer = (lispobj *) PTR(object);
1117 first = *first_pointer;
1119 if (!(Pointerp(first) && new_space_p(first)))
1120 first = *first_pointer =
1121 (transother[TypeOf(first)])(object);
1123 gc_assert(Pointerp(first));
1124 gc_assert(!from_space_p(first));
1132 scav_other_pointer(lispobj *where, lispobj object)
1134 lispobj first, *first_pointer;
1136 gc_assert(Pointerp(object));
1138 /* Object is a pointer into from space - not a FP */
1139 first_pointer = (lispobj *) PTR(object);
1140 first = *first_pointer = (transother[TypeOf(*first_pointer)])(object);
1142 gc_assert(Pointerp(first));
1143 gc_assert(!from_space_p(first));
1151 /* Immediate, Boxed, and Unboxed Objects */
1154 size_pointer(lispobj *where)
1160 scav_immediate(lispobj *where, lispobj object)
1166 trans_immediate(lispobj object)
1168 fprintf(stderr, "GC lossage. Trying to transport an immediate!?\n");
1174 size_immediate(lispobj *where)
1181 scav_boxed(lispobj *where, lispobj object)
1187 trans_boxed(lispobj object)
1190 unsigned long length;
1192 gc_assert(Pointerp(object));
1194 header = *((lispobj *) PTR(object));
1195 length = HeaderValue(header) + 1;
1196 length = CEILING(length, 2);
1198 return copy_object(object, length);
1202 size_boxed(lispobj *where)
1205 unsigned long length;
1208 length = HeaderValue(header) + 1;
1209 length = CEILING(length, 2);
1214 /* Note: on the sparc we don't have to do anything special for fdefns, */
1215 /* cause the raw-addr has a function lowtag. */
1218 scav_fdefn(lispobj *where, lispobj object)
1220 struct fdefn *fdefn;
1222 fdefn = (struct fdefn *)where;
1224 if ((char *)(fdefn->function + RAW_ADDR_OFFSET)
1225 == (char *)((unsigned long)(fdefn->raw_addr))) {
1226 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
1227 fdefn->raw_addr = (u32) ((char *) LOW_WORD(fdefn->function)) + RAW_ADDR_OFFSET;
1228 return sizeof(struct fdefn) / sizeof(lispobj);
1236 scav_unboxed(lispobj *where, lispobj object)
1238 unsigned long length;
1240 length = HeaderValue(object) + 1;
1241 length = CEILING(length, 2);
1247 trans_unboxed(lispobj object)
1250 unsigned long length;
1253 gc_assert(Pointerp(object));
1255 header = *((lispobj *) PTR(object));
1256 length = HeaderValue(header) + 1;
1257 length = CEILING(length, 2);
1259 return copy_object(object, length);
1263 size_unboxed(lispobj *where)
1266 unsigned long length;
1269 length = HeaderValue(header) + 1;
1270 length = CEILING(length, 2);
1276 /* Vector-Like Objects */
1278 #define NWORDS(x,y) (CEILING((x),(y)) / (y))
1281 scav_string(lispobj *where, lispobj object)
1283 struct vector *vector;
1286 /* NOTE: Strings contain one more byte of data than the length */
1287 /* slot indicates. */
1289 vector = (struct vector *) where;
1290 length = fixnum_value(vector->length) + 1;
1291 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1297 trans_string(lispobj object)
1299 struct vector *vector;
1302 gc_assert(Pointerp(object));
1304 /* NOTE: Strings contain one more byte of data than the length */
1305 /* slot indicates. */
1307 vector = (struct vector *) PTR(object);
1308 length = fixnum_value(vector->length) + 1;
1309 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1311 return copy_object(object, nwords);
1315 size_string(lispobj *where)
1317 struct vector *vector;
1320 /* NOTE: Strings contain one more byte of data than the length */
1321 /* slot indicates. */
1323 vector = (struct vector *) where;
1324 length = fixnum_value(vector->length) + 1;
1325 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1331 scav_vector(lispobj *where, lispobj object)
1333 if (HeaderValue(object) == subtype_VectorValidHashing)
1334 *where = (subtype_VectorMustRehash<<type_Bits) | type_SimpleVector;
1341 trans_vector(lispobj object)
1343 struct vector *vector;
1346 gc_assert(Pointerp(object));
1348 vector = (struct vector *) PTR(object);
1350 length = fixnum_value(vector->length);
1351 nwords = CEILING(length + 2, 2);
1353 return copy_object(object, nwords);
1357 size_vector(lispobj *where)
1359 struct vector *vector;
1362 vector = (struct vector *) where;
1363 length = fixnum_value(vector->length);
1364 nwords = CEILING(length + 2, 2);
1371 scav_vector_bit(lispobj *where, lispobj object)
1373 struct vector *vector;
1376 vector = (struct vector *) where;
1377 length = fixnum_value(vector->length);
1378 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1384 trans_vector_bit(lispobj object)
1386 struct vector *vector;
1389 gc_assert(Pointerp(object));
1391 vector = (struct vector *) PTR(object);
1392 length = fixnum_value(vector->length);
1393 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1395 return copy_object(object, nwords);
1399 size_vector_bit(lispobj *where)
1401 struct vector *vector;
1404 vector = (struct vector *) where;
1405 length = fixnum_value(vector->length);
1406 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1413 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
1415 struct vector *vector;
1418 vector = (struct vector *) where;
1419 length = fixnum_value(vector->length);
1420 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1426 trans_vector_unsigned_byte_2(lispobj object)
1428 struct vector *vector;
1431 gc_assert(Pointerp(object));
1433 vector = (struct vector *) PTR(object);
1434 length = fixnum_value(vector->length);
1435 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1437 return copy_object(object, nwords);
1441 size_vector_unsigned_byte_2(lispobj *where)
1443 struct vector *vector;
1446 vector = (struct vector *) where;
1447 length = fixnum_value(vector->length);
1448 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1455 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
1457 struct vector *vector;
1460 vector = (struct vector *) where;
1461 length = fixnum_value(vector->length);
1462 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1468 trans_vector_unsigned_byte_4(lispobj object)
1470 struct vector *vector;
1473 gc_assert(Pointerp(object));
1475 vector = (struct vector *) PTR(object);
1476 length = fixnum_value(vector->length);
1477 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1479 return copy_object(object, nwords);
1483 size_vector_unsigned_byte_4(lispobj *where)
1485 struct vector *vector;
1488 vector = (struct vector *) where;
1489 length = fixnum_value(vector->length);
1490 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1497 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
1499 struct vector *vector;
1502 vector = (struct vector *) where;
1503 length = fixnum_value(vector->length);
1504 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1510 trans_vector_unsigned_byte_8(lispobj object)
1512 struct vector *vector;
1515 gc_assert(Pointerp(object));
1517 vector = (struct vector *) PTR(object);
1518 length = fixnum_value(vector->length);
1519 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1521 return copy_object(object, nwords);
1525 size_vector_unsigned_byte_8(lispobj *where)
1527 struct vector *vector;
1530 vector = (struct vector *) where;
1531 length = fixnum_value(vector->length);
1532 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1539 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1541 struct vector *vector;
1544 vector = (struct vector *) where;
1545 length = fixnum_value(vector->length);
1546 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1552 trans_vector_unsigned_byte_16(lispobj object)
1554 struct vector *vector;
1557 gc_assert(Pointerp(object));
1559 vector = (struct vector *) PTR(object);
1560 length = fixnum_value(vector->length);
1561 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1563 return copy_object(object, nwords);
1567 size_vector_unsigned_byte_16(lispobj *where)
1569 struct vector *vector;
1572 vector = (struct vector *) where;
1573 length = fixnum_value(vector->length);
1574 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1581 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1583 struct vector *vector;
1586 vector = (struct vector *) where;
1587 length = fixnum_value(vector->length);
1588 nwords = CEILING(length + 2, 2);
1594 trans_vector_unsigned_byte_32(lispobj object)
1596 struct vector *vector;
1599 gc_assert(Pointerp(object));
1601 vector = (struct vector *) PTR(object);
1602 length = fixnum_value(vector->length);
1603 nwords = CEILING(length + 2, 2);
1605 return copy_object(object, nwords);
1609 size_vector_unsigned_byte_32(lispobj *where)
1611 struct vector *vector;
1614 vector = (struct vector *) where;
1615 length = fixnum_value(vector->length);
1616 nwords = CEILING(length + 2, 2);
1623 scav_vector_single_float(lispobj *where, lispobj object)
1625 struct vector *vector;
1628 vector = (struct vector *) where;
1629 length = fixnum_value(vector->length);
1630 nwords = CEILING(length + 2, 2);
1636 trans_vector_single_float(lispobj object)
1638 struct vector *vector;
1641 gc_assert(Pointerp(object));
1643 vector = (struct vector *) PTR(object);
1644 length = fixnum_value(vector->length);
1645 nwords = CEILING(length + 2, 2);
1647 return copy_object(object, nwords);
1651 size_vector_single_float(lispobj *where)
1653 struct vector *vector;
1656 vector = (struct vector *) where;
1657 length = fixnum_value(vector->length);
1658 nwords = CEILING(length + 2, 2);
1665 scav_vector_double_float(lispobj *where, lispobj object)
1667 struct vector *vector;
1670 vector = (struct vector *) where;
1671 length = fixnum_value(vector->length);
1672 nwords = CEILING(length * 2 + 2, 2);
1678 trans_vector_double_float(lispobj object)
1680 struct vector *vector;
1683 gc_assert(Pointerp(object));
1685 vector = (struct vector *) PTR(object);
1686 length = fixnum_value(vector->length);
1687 nwords = CEILING(length * 2 + 2, 2);
1689 return copy_object(object, nwords);
1693 size_vector_double_float(lispobj *where)
1695 struct vector *vector;
1698 vector = (struct vector *) where;
1699 length = fixnum_value(vector->length);
1700 nwords = CEILING(length * 2 + 2, 2);
1706 #ifdef type_SimpleArrayLongFloat
1708 scav_vector_long_float(lispobj *where, lispobj object)
1710 struct vector *vector;
1713 vector = (struct vector *) where;
1714 length = fixnum_value(vector->length);
1716 nwords = CEILING(length * 4 + 2, 2);
1723 trans_vector_long_float(lispobj object)
1725 struct vector *vector;
1728 gc_assert(Pointerp(object));
1730 vector = (struct vector *) PTR(object);
1731 length = fixnum_value(vector->length);
1733 nwords = CEILING(length * 4 + 2, 2);
1736 return copy_object(object, nwords);
1740 size_vector_long_float(lispobj *where)
1742 struct vector *vector;
1745 vector = (struct vector *) where;
1746 length = fixnum_value(vector->length);
1748 nwords = CEILING(length * 4 + 2, 2);
1756 #ifdef type_SimpleArrayComplexSingleFloat
1758 scav_vector_complex_single_float(lispobj *where, lispobj object)
1760 struct vector *vector;
1763 vector = (struct vector *) where;
1764 length = fixnum_value(vector->length);
1765 nwords = CEILING(length * 2 + 2, 2);
1771 trans_vector_complex_single_float(lispobj object)
1773 struct vector *vector;
1776 gc_assert(Pointerp(object));
1778 vector = (struct vector *) PTR(object);
1779 length = fixnum_value(vector->length);
1780 nwords = CEILING(length * 2 + 2, 2);
1782 return copy_object(object, nwords);
1786 size_vector_complex_single_float(lispobj *where)
1788 struct vector *vector;
1791 vector = (struct vector *) where;
1792 length = fixnum_value(vector->length);
1793 nwords = CEILING(length * 2 + 2, 2);
1799 #ifdef type_SimpleArrayComplexDoubleFloat
1801 scav_vector_complex_double_float(lispobj *where, lispobj object)
1803 struct vector *vector;
1806 vector = (struct vector *) where;
1807 length = fixnum_value(vector->length);
1808 nwords = CEILING(length * 4 + 2, 2);
1814 trans_vector_complex_double_float(lispobj object)
1816 struct vector *vector;
1819 gc_assert(Pointerp(object));
1821 vector = (struct vector *) PTR(object);
1822 length = fixnum_value(vector->length);
1823 nwords = CEILING(length * 4 + 2, 2);
1825 return copy_object(object, nwords);
1829 size_vector_complex_double_float(lispobj *where)
1831 struct vector *vector;
1834 vector = (struct vector *) where;
1835 length = fixnum_value(vector->length);
1836 nwords = CEILING(length * 4 + 2, 2);
1842 #ifdef type_SimpleArrayComplexLongFloat
1844 scav_vector_complex_long_float(lispobj *where, lispobj object)
1846 struct vector *vector;
1849 vector = (struct vector *) where;
1850 length = fixnum_value(vector->length);
1852 nwords = CEILING(length * 8 + 2, 2);
1859 trans_vector_complex_long_float(lispobj object)
1861 struct vector *vector;
1864 gc_assert(Pointerp(object));
1866 vector = (struct vector *) PTR(object);
1867 length = fixnum_value(vector->length);
1869 nwords = CEILING(length * 8 + 2, 2);
1872 return copy_object(object, nwords);
1876 size_vector_complex_long_float(lispobj *where)
1878 struct vector *vector;
1881 vector = (struct vector *) where;
1882 length = fixnum_value(vector->length);
1884 nwords = CEILING(length * 8 + 2, 2);
1894 #define WEAK_POINTER_NWORDS \
1895 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1898 scav_weak_pointer(lispobj *where, lispobj object)
1900 /* Do not let GC scavenge the value slot of the weak pointer */
1901 /* (that is why it is a weak pointer). Note: we could use */
1902 /* the scav_unboxed method here. */
1904 return WEAK_POINTER_NWORDS;
1908 trans_weak_pointer(lispobj object)
1911 struct weak_pointer *wp;
1913 gc_assert(Pointerp(object));
1915 #if defined(DEBUG_WEAK)
1916 printf("Transporting weak pointer from 0x%08x\n", object);
1919 /* Need to remember where all the weak pointers are that have */
1920 /* been transported so they can be fixed up in a post-GC pass. */
1922 copy = copy_object(object, WEAK_POINTER_NWORDS);
1923 wp = (struct weak_pointer *) PTR(copy);
1926 /* Push the weak pointer onto the list of weak pointers. */
1927 wp->next = LOW_WORD(weak_pointers);
1934 size_weak_pointer(lispobj *where)
1936 return WEAK_POINTER_NWORDS;
1939 void scan_weak_pointers(void)
1941 struct weak_pointer *wp;
1943 for (wp = weak_pointers; wp != (struct weak_pointer *) NULL;
1944 wp = (struct weak_pointer *)((unsigned long)wp->next)) {
1946 lispobj first, *first_pointer;
1950 #if defined(DEBUG_WEAK)
1951 printf("Weak pointer at 0x%p\n", wp);
1952 printf("Value: 0x%08x\n", (unsigned int) value);
1955 if (!(Pointerp(value) && from_space_p(value)))
1958 /* Now, we need to check if the object has been */
1959 /* forwarded. If it has been, the weak pointer is */
1960 /* still good and needs to be updated. Otherwise, the */
1961 /* weak pointer needs to be nil'ed out. */
1963 first_pointer = (lispobj *) PTR(value);
1964 first = *first_pointer;
1966 #if defined(DEBUG_WEAK)
1967 printf("First: 0x%08x\n", (unsigned long) first);
1970 if (Pointerp(first) && new_space_p(first))
1981 /* Initialization */
1984 scav_lose(lispobj *where, lispobj object)
1986 fprintf(stderr, "GC lossage. No scavenge function for object 0x%08x (at 0x%016lx)\n",
1987 (unsigned int) object, (unsigned long)where);
1993 trans_lose(lispobj object)
1995 fprintf(stderr, "GC lossage. No transport function for object 0x%08x\n",
1996 (unsigned int)object);
2002 size_lose(lispobj *where)
2004 fprintf(stderr, "Size lossage. No size function for object at 0x%p\n",
2006 fprintf(stderr, "First word of object: 0x%08x\n",
2015 /* Scavenge Table */
2016 for (i = 0; i < 256; i++)
2017 scavtab[i] = scav_lose;
2018 /* scavtab[i] = scav_immediate; */
2020 for (i = 0; i < 32; i++) {
2021 scavtab[type_EvenFixnum|(i<<3)] = scav_immediate;
2022 scavtab[type_FunctionPointer|(i<<3)] = scav_function_pointer;
2023 /* OtherImmediate0 */
2024 scavtab[type_ListPointer|(i<<3)] = scav_list_pointer;
2025 scavtab[type_OddFixnum|(i<<3)] = scav_immediate;
2026 scavtab[type_InstancePointer|(i<<3)] = scav_instance_pointer;
2027 /* OtherImmediate1 */
2028 scavtab[type_OtherPointer|(i<<3)] = scav_other_pointer;
2031 scavtab[type_Bignum] = scav_unboxed;
2032 scavtab[type_Ratio] = scav_boxed;
2033 scavtab[type_SingleFloat] = scav_unboxed;
2034 scavtab[type_DoubleFloat] = scav_unboxed;
2035 #ifdef type_LongFloat
2036 scavtab[type_LongFloat] = scav_unboxed;
2038 scavtab[type_Complex] = scav_boxed;
2039 #ifdef type_ComplexSingleFloat
2040 scavtab[type_ComplexSingleFloat] = scav_unboxed;
2042 #ifdef type_ComplexDoubleFloat
2043 scavtab[type_ComplexDoubleFloat] = scav_unboxed;
2045 #ifdef type_ComplexLongFloat
2046 scavtab[type_ComplexLongFloat] = scav_unboxed;
2048 scavtab[type_SimpleArray] = scav_boxed;
2049 scavtab[type_SimpleString] = scav_string;
2050 scavtab[type_SimpleBitVector] = scav_vector_bit;
2051 scavtab[type_SimpleVector] = scav_vector;
2052 scavtab[type_SimpleArrayUnsignedByte2] = scav_vector_unsigned_byte_2;
2053 scavtab[type_SimpleArrayUnsignedByte4] = scav_vector_unsigned_byte_4;
2054 scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8;
2055 scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16;
2056 scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32;
2057 #ifdef type_SimpleArraySignedByte8
2058 scavtab[type_SimpleArraySignedByte8] = scav_vector_unsigned_byte_8;
2060 #ifdef type_SimpleArraySignedByte16
2061 scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16;
2063 #ifdef type_SimpleArraySignedByte30
2064 scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32;
2066 #ifdef type_SimpleArraySignedByte32
2067 scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32;
2069 scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float;
2070 scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float;
2071 #ifdef type_SimpleArrayLongFloat
2072 scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float;
2074 #ifdef type_SimpleArrayComplexSingleFloat
2075 scavtab[type_SimpleArrayComplexSingleFloat] = scav_vector_complex_single_float;
2077 #ifdef type_SimpleArrayComplexDoubleFloat
2078 scavtab[type_SimpleArrayComplexDoubleFloat] = scav_vector_complex_double_float;
2080 #ifdef type_SimpleArrayComplexLongFloat
2081 scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float;
2083 scavtab[type_ComplexString] = scav_boxed;
2084 scavtab[type_ComplexBitVector] = scav_boxed;
2085 scavtab[type_ComplexVector] = scav_boxed;
2086 scavtab[type_ComplexArray] = scav_boxed;
2087 scavtab[type_CodeHeader] = scav_code_header;
2088 scavtab[type_FunctionHeader] = scav_function_header;
2089 scavtab[type_ClosureFunctionHeader] = scav_function_header;
2090 scavtab[type_ReturnPcHeader] = scav_return_pc_header;
2092 scavtab[type_ClosureHeader] = scav_closure_header;
2093 scavtab[type_FuncallableInstanceHeader] = scav_closure_header;
2094 scavtab[type_ByteCodeFunction] = scav_closure_header;
2095 scavtab[type_ByteCodeClosure] = scav_closure_header;
2096 /* scavtab[type_DylanFunctionHeader] = scav_closure_header; */
2098 scavtab[type_ClosureHeader] = scav_boxed;
2099 scavtab[type_FuncallableInstanceHeader] = scav_boxed;
2100 scavtab[type_ByteCodeFunction] = scav_boxed;
2101 scavtab[type_ByteCodeClosure] = scav_boxed;
2102 /* scavtab[type_DylanFunctionHeader] = scav_boxed; */
2104 scavtab[type_ValueCellHeader] = scav_boxed;
2105 scavtab[type_SymbolHeader] = scav_boxed;
2106 scavtab[type_BaseChar] = scav_immediate;
2107 scavtab[type_Sap] = scav_unboxed;
2108 scavtab[type_UnboundMarker] = scav_immediate;
2109 scavtab[type_WeakPointer] = scav_weak_pointer;
2110 scavtab[type_InstanceHeader] = scav_boxed;
2112 scavtab[type_Fdefn] = scav_fdefn;
2114 scavtab[type_Fdefn] = scav_boxed;
2117 /* Transport Other Table */
2118 for (i = 0; i < 256; i++)
2119 transother[i] = trans_lose;
2121 transother[type_Bignum] = trans_unboxed;
2122 transother[type_Ratio] = trans_boxed;
2123 transother[type_SingleFloat] = trans_unboxed;
2124 transother[type_DoubleFloat] = trans_unboxed;
2125 #ifdef type_LongFloat
2126 transother[type_LongFloat] = trans_unboxed;
2128 transother[type_Complex] = trans_boxed;
2129 #ifdef type_ComplexSingleFloat
2130 transother[type_ComplexSingleFloat] = trans_unboxed;
2132 #ifdef type_ComplexDoubleFloat
2133 transother[type_ComplexDoubleFloat] = trans_unboxed;
2135 #ifdef type_ComplexLongFloat
2136 transother[type_ComplexLongFloat] = trans_unboxed;
2138 transother[type_SimpleArray] = trans_boxed;
2139 transother[type_SimpleString] = trans_string;
2140 transother[type_SimpleBitVector] = trans_vector_bit;
2141 transother[type_SimpleVector] = trans_vector;
2142 transother[type_SimpleArrayUnsignedByte2] = trans_vector_unsigned_byte_2;
2143 transother[type_SimpleArrayUnsignedByte4] = trans_vector_unsigned_byte_4;
2144 transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8;
2145 transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16;
2146 transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32;
2147 #ifdef type_SimpleArraySignedByte8
2148 transother[type_SimpleArraySignedByte8] = trans_vector_unsigned_byte_8;
2150 #ifdef type_SimpleArraySignedByte16
2151 transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16;
2153 #ifdef type_SimpleArraySignedByte30
2154 transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32;
2156 #ifdef type_SimpleArraySignedByte32
2157 transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32;
2159 transother[type_SimpleArraySingleFloat] = trans_vector_single_float;
2160 transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float;
2161 #ifdef type_SimpleArrayLongFloat
2162 transother[type_SimpleArrayLongFloat] = trans_vector_long_float;
2164 #ifdef type_SimpleArrayComplexSingleFloat
2165 transother[type_SimpleArrayComplexSingleFloat] = trans_vector_complex_single_float;
2167 #ifdef type_SimpleArrayComplexDoubleFloat
2168 transother[type_SimpleArrayComplexDoubleFloat] = trans_vector_complex_double_float;
2170 #ifdef type_SimpleArrayComplexLongFloat
2171 transother[type_SimpleArrayComplexLongFloat] = trans_vector_complex_long_float;
2173 transother[type_ComplexString] = trans_boxed;
2174 transother[type_ComplexBitVector] = trans_boxed;
2175 transother[type_ComplexVector] = trans_boxed;
2176 transother[type_ComplexArray] = trans_boxed;
2177 transother[type_CodeHeader] = trans_code_header;
2178 transother[type_FunctionHeader] = trans_function_header;
2179 transother[type_ClosureFunctionHeader] = trans_function_header;
2180 transother[type_ReturnPcHeader] = trans_return_pc_header;
2181 transother[type_ClosureHeader] = trans_boxed;
2182 transother[type_FuncallableInstanceHeader] = trans_boxed;
2183 transother[type_ByteCodeFunction] = trans_boxed;
2184 transother[type_ByteCodeClosure] = trans_boxed;
2185 transother[type_ValueCellHeader] = trans_boxed;
2186 transother[type_SymbolHeader] = trans_boxed;
2187 transother[type_BaseChar] = trans_immediate;
2188 transother[type_Sap] = trans_unboxed;
2189 transother[type_UnboundMarker] = trans_immediate;
2190 transother[type_WeakPointer] = trans_weak_pointer;
2191 transother[type_InstanceHeader] = trans_boxed;
2192 transother[type_Fdefn] = trans_boxed;
2196 for (i = 0; i < 256; i++)
2197 sizetab[i] = size_lose;
2199 for (i = 0; i < 32; i++) {
2200 sizetab[type_EvenFixnum|(i<<3)] = size_immediate;
2201 sizetab[type_FunctionPointer|(i<<3)] = size_pointer;
2202 /* OtherImmediate0 */
2203 sizetab[type_ListPointer|(i<<3)] = size_pointer;
2204 sizetab[type_OddFixnum|(i<<3)] = size_immediate;
2205 sizetab[type_InstancePointer|(i<<3)] = size_pointer;
2206 /* OtherImmediate1 */
2207 sizetab[type_OtherPointer|(i<<3)] = size_pointer;
2210 sizetab[type_Bignum] = size_unboxed;
2211 sizetab[type_Ratio] = size_boxed;
2212 sizetab[type_SingleFloat] = size_unboxed;
2213 sizetab[type_DoubleFloat] = size_unboxed;
2214 #ifdef type_LongFloat
2215 sizetab[type_LongFloat] = size_unboxed;
2217 sizetab[type_Complex] = size_boxed;
2218 #ifdef type_ComplexSingleFloat
2219 sizetab[type_ComplexSingleFloat] = size_unboxed;
2221 #ifdef type_ComplexDoubleFloat
2222 sizetab[type_ComplexDoubleFloat] = size_unboxed;
2224 #ifdef type_ComplexLongFloat
2225 sizetab[type_ComplexLongFloat] = size_unboxed;
2227 sizetab[type_SimpleArray] = size_boxed;
2228 sizetab[type_SimpleString] = size_string;
2229 sizetab[type_SimpleBitVector] = size_vector_bit;
2230 sizetab[type_SimpleVector] = size_vector;
2231 sizetab[type_SimpleArrayUnsignedByte2] = size_vector_unsigned_byte_2;
2232 sizetab[type_SimpleArrayUnsignedByte4] = size_vector_unsigned_byte_4;
2233 sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8;
2234 sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16;
2235 sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32;
2236 #ifdef type_SimpleArraySignedByte8
2237 sizetab[type_SimpleArraySignedByte8] = size_vector_unsigned_byte_8;
2239 #ifdef type_SimpleArraySignedByte16
2240 sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16;
2242 #ifdef type_SimpleArraySignedByte30
2243 sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32;
2245 #ifdef type_SimpleArraySignedByte32
2246 sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32;
2248 sizetab[type_SimpleArraySingleFloat] = size_vector_single_float;
2249 sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float;
2250 #ifdef type_SimpleArrayLongFloat
2251 sizetab[type_SimpleArrayLongFloat] = size_vector_long_float;
2253 #ifdef type_SimpleArrayComplexSingleFloat
2254 sizetab[type_SimpleArrayComplexSingleFloat] = size_vector_complex_single_float;
2256 #ifdef type_SimpleArrayComplexDoubleFloat
2257 sizetab[type_SimpleArrayComplexDoubleFloat] = size_vector_complex_double_float;
2259 #ifdef type_SimpleArrayComplexLongFloat
2260 sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float;
2262 sizetab[type_ComplexString] = size_boxed;
2263 sizetab[type_ComplexBitVector] = size_boxed;
2264 sizetab[type_ComplexVector] = size_boxed;
2265 sizetab[type_ComplexArray] = size_boxed;
2266 sizetab[type_CodeHeader] = size_code_header;
2268 /* Shouldn't see these so just lose if it happens */
2269 sizetab[type_FunctionHeader] = size_function_header;
2270 sizetab[type_ClosureFunctionHeader] = size_function_header;
2271 sizetab[type_ReturnPcHeader] = size_return_pc_header;
2273 sizetab[type_ClosureHeader] = size_boxed;
2274 sizetab[type_FuncallableInstanceHeader] = size_boxed;
2275 sizetab[type_ValueCellHeader] = size_boxed;
2276 sizetab[type_SymbolHeader] = size_boxed;
2277 sizetab[type_BaseChar] = size_immediate;
2278 sizetab[type_Sap] = size_unboxed;
2279 sizetab[type_UnboundMarker] = size_immediate;
2280 sizetab[type_WeakPointer] = size_weak_pointer;
2281 sizetab[type_InstanceHeader] = size_boxed;
2282 sizetab[type_Fdefn] = size_boxed;
2287 /* Noise to manipulate the gc trigger stuff. */
2291 void set_auto_gc_trigger(os_vm_size_t dynamic_usage)
2293 os_vm_address_t addr=(os_vm_address_t)current_dynamic_space +
2296 DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
2298 if(addr < (os_vm_address_t)dynamic_space_free_pointer) {
2300 "set_auto_gc_trigger: tried to set gc trigger too low! (%d < %p)\n",
2301 (unsigned int)dynamic_usage,
2302 (os_vm_address_t)dynamic_space_free_pointer
2303 - (os_vm_address_t)current_dynamic_space);
2306 else if (length < 0) {
2308 "set_auto_gc_trigger: tried to set gc trigger too high! (%p)\n",
2313 addr=os_round_up_to_page(addr);
2314 length=os_trunc_size_to_page(length);
2316 #if defined(SUNOS) || defined(SOLARIS)
2317 os_invalidate(addr,length);
2319 os_protect(addr, length, 0);
2322 current_auto_gc_trigger = (lispobj *)addr;
2325 void clear_auto_gc_trigger(void)
2327 if(current_auto_gc_trigger!=NULL){
2328 #if defined(SUNOS) || defined(SOLARIS)/* don't want to force whole space into swapping mode... */
2329 os_vm_address_t addr=(os_vm_address_t)current_auto_gc_trigger;
2330 os_vm_size_t length=
2331 DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
2333 os_validate(addr,length);
2335 os_protect((os_vm_address_t)current_dynamic_space,
2340 current_auto_gc_trigger = NULL;