2 * stop and copy GC based on Cheney's algorithm
6 * This software is part of the SBCL system. See the README file for
9 * This software is derived from the CMU CL system, which was
10 * written at Carnegie Mellon University and released into the
11 * public domain. The software is in the public domain and is
12 * provided with absolutely no warranty. See the COPYING and CREDITS
13 * files for more information.
18 #include <sys/resource.h>
25 #include "interrupt.h"
30 /* So you need to debug? */
33 #define DEBUG_SPACE_PREDICATES
34 #define DEBUG_SCAVENGE_VERBOSE
35 #define DEBUG_COPY_VERBOSE
39 static lispobj *from_space;
40 static lispobj *from_space_free_pointer;
42 static lispobj *new_space;
43 static lispobj *new_space_free_pointer;
45 static int (*scavtab[256])(lispobj *where, lispobj object);
46 static lispobj (*transother[256])(lispobj object);
47 static int (*sizetab[256])(lispobj *where);
49 static struct weak_pointer *weak_pointers;
51 static void scavenge(lispobj *start, u32 nwords);
52 static void scavenge_newspace(void);
53 static void scavenge_interrupt_contexts(void);
54 static void scan_weak_pointers(void);
55 static int scav_lose(lispobj *where, lispobj object);
57 #define gc_abort() lose("GC invariant lost! File \"%s\", line %d\n", \
61 #define gc_assert(ex) do { \
62 if (!(ex)) gc_abort(); \
68 #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
73 #if defined(DEBUG_SPACE_PREDICATES)
76 from_space_p(lispobj object)
80 /* this can be called for untagged pointers as well as for
81 descriptors, so this assertion's not applicable
82 gc_assert(Pointerp(object));
84 ptr = (lispobj *) PTR(object);
86 return ((from_space <= ptr) &&
87 (ptr < from_space_free_pointer));
91 new_space_p(lispobj object)
95 gc_assert(Pointerp(object));
97 ptr = (lispobj *) PTR(object);
99 return ((new_space <= ptr) &&
100 (ptr < new_space_free_pointer));
105 #define from_space_p(ptr) \
106 ((from_space <= ((lispobj *) ptr)) && \
107 (((lispobj *) ptr) < from_space_free_pointer))
109 #define new_space_p(ptr) \
110 ((new_space <= ((lispobj *) ptr)) && \
111 (((lispobj *) ptr) < new_space_free_pointer))
116 /* copying objects */
119 copy_object(lispobj object, int nwords)
123 lispobj *source, *dest;
125 gc_assert(Pointerp(object));
126 gc_assert(from_space_p(object));
127 gc_assert((nwords & 0x01) == 0);
129 /* get tag of object */
130 tag = LowtagOf(object);
133 new = new_space_free_pointer;
134 new_space_free_pointer += nwords;
137 source = (lispobj *) PTR(object);
139 #ifdef DEBUG_COPY_VERBOSE
140 fprintf(stderr,"Copying %d words from %p to %p\n", nwords,source,new);
143 /* copy the object */
151 /* return lisp pointer of new object */
152 return (lispobj)(LOW_WORD(new) | tag);
156 /* collecting garbage */
160 tv_diff(struct timeval *x, struct timeval *y)
162 return (((double) x->tv_sec + (double) x->tv_usec * 1.0e-6) -
163 ((double) y->tv_sec + (double) y->tv_usec * 1.0e-6));
167 #define BYTES_ZERO_BEFORE_END (1<<12)
172 #define U32 unsigned long
177 U32 *ptr = (U32 *)current_control_stack_pointer;
183 } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
188 } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
195 /* Note: The generic GC interface we're implementing passes us a
196 * last_generation argument. That's meaningless for us, since we're
197 * not a generational GC. So we ignore it. */
199 collect_garbage(unsigned ignore)
202 struct timeval start_tv, stop_tv;
203 struct rusage start_rusage, stop_rusage;
204 double real_time, system_time, user_time;
205 double percent_retained, gc_rate;
206 unsigned long size_discarded;
207 unsigned long size_retained;
209 lispobj *current_static_space_free_pointer;
210 unsigned long static_space_size;
211 unsigned long control_stack_size, binding_stack_size;
215 printf("[Collecting garbage ... \n");
217 getrusage(RUSAGE_SELF, &start_rusage);
218 gettimeofday(&start_tv, (struct timezone *) 0);
222 sigaddset_blockable(&tmp);
223 sigprocmask(SIG_BLOCK, &tmp, &old);
225 current_static_space_free_pointer =
226 (lispobj *) ((unsigned long)
227 SymbolValue(STATIC_SPACE_FREE_POINTER));
230 /* Set up from space and new space pointers. */
232 from_space = current_dynamic_space;
233 from_space_free_pointer = dynamic_space_free_pointer;
236 fprintf(stderr,"from_space = %lx\n",
237 (unsigned long) current_dynamic_space);
239 if (current_dynamic_space == (lispobj *) DYNAMIC_0_SPACE_START)
240 new_space = (lispobj *)DYNAMIC_1_SPACE_START;
241 else if (current_dynamic_space == (lispobj *) DYNAMIC_1_SPACE_START)
242 new_space = (lispobj *) DYNAMIC_0_SPACE_START;
244 lose("GC lossage. Current dynamic space is bogus!\n");
246 new_space_free_pointer = new_space;
249 /* Initialize the weak pointer list. */
250 weak_pointers = (struct weak_pointer *) NULL;
253 /* Scavenge all of the roots. */
255 printf("Scavenging interrupt contexts ...\n");
257 scavenge_interrupt_contexts();
260 printf("Scavenging interrupt handlers (%d bytes) ...\n",
261 (int)sizeof(interrupt_handlers));
263 scavenge((lispobj *) interrupt_handlers,
264 sizeof(interrupt_handlers) / sizeof(lispobj));
266 /* _size quantities are in units of sizeof(lispobj) - i.e. 4 */
268 current_control_stack_pointer-
269 (lispobj *)CONTROL_STACK_START;
271 printf("Scavenging the control stack at %p (%ld words) ...\n",
272 ((lispobj *)CONTROL_STACK_START),
275 scavenge(((lispobj *)CONTROL_STACK_START), control_stack_size);
279 current_binding_stack_pointer -
280 (lispobj *)BINDING_STACK_START;
282 printf("Scavenging the binding stack %x - %x (%d words) ...\n",
283 BINDING_STACK_START,current_binding_stack_pointer,
284 (int)(binding_stack_size));
286 scavenge(((lispobj *)BINDING_STACK_START), binding_stack_size);
289 current_static_space_free_pointer - (lispobj *) STATIC_SPACE_START;
291 printf("Scavenging static space %x - %x (%d words) ...\n",
292 STATIC_SPACE_START,current_static_space_free_pointer,
293 (int)(static_space_size));
295 scavenge(((lispobj *)STATIC_SPACE_START), static_space_size);
297 /* Scavenge newspace. */
299 printf("Scavenging new space (%d bytes) ...\n",
300 (int)((new_space_free_pointer - new_space) * sizeof(lispobj)));
305 #if defined(DEBUG_PRINT_GARBAGE)
306 print_garbage(from_space, from_space_free_pointer);
309 /* Scan the weak pointers. */
311 printf("Scanning weak pointers ...\n");
313 scan_weak_pointers();
318 printf("Flipping spaces ...\n");
321 os_zero((os_vm_address_t) current_dynamic_space,
322 (os_vm_size_t) DYNAMIC_SPACE_SIZE);
324 current_dynamic_space = new_space;
325 dynamic_space_free_pointer = new_space_free_pointer;
328 size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj);
329 size_retained = (new_space_free_pointer - new_space) * sizeof(lispobj);
334 printf("Zeroing empty part of control stack ...\n");
338 sigprocmask(SIG_SETMASK, &old, 0);
342 gettimeofday(&stop_tv, (struct timezone *) 0);
343 getrusage(RUSAGE_SELF, &stop_rusage);
347 percent_retained = (((float) size_retained) /
348 ((float) size_discarded)) * 100.0;
350 printf("Total of %ld bytes out of %ld bytes retained (%3.2f%%).\n",
351 size_retained, size_discarded, percent_retained);
353 real_time = tv_diff(&stop_tv, &start_tv);
354 user_time = tv_diff(&stop_rusage.ru_utime, &start_rusage.ru_utime);
355 system_time = tv_diff(&stop_rusage.ru_stime, &start_rusage.ru_stime);
358 printf("Statistics:\n");
359 printf("%10.2f sec of real time\n", real_time);
360 printf("%10.2f sec of user time,\n", user_time);
361 printf("%10.2f sec of system time.\n", system_time);
363 printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n",
364 real_time, user_time, system_time);
367 gc_rate = ((float) size_retained / (float) (1<<20)) / real_time;
369 printf("%10.2f M bytes/sec collected.\n", gc_rate);
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);
391 if (Pointerp(object)) {
392 /* It be a pointer. */
393 if (from_space_p(object)) {
394 /* It currently points to old space. Check for a */
395 /* forwarding pointer. */
398 first_word = *((lispobj *)PTR(object));
399 if (Pointerp(first_word) && new_space_p(first_word)) {
400 /* Yep, there be a forwarding pointer. */
405 /* Scavenge that pointer. */
406 words_scavenged = (scavtab[type])(start, object);
410 /* It points somewhere other than oldspace. Leave */
416 /* there are some situations where an
417 other-immediate may end up in a descriptor
418 register. I'm not sure whether this is
419 supposed to happen, but if it does then we
420 don't want to (a) barf or (b) scavenge over the
421 data-block, because there isn't one. So, if
422 we're checking a single word and it's anything
423 other than a pointer, just hush it up */
426 if((scavtab[type]==scav_lose) ||
427 (((scavtab[type])(start,object))>1)) {
428 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",
432 else if ((object & 3) == 0) {
433 /* It's a fixnum. Real easy. */
437 /* It's some random header object. */
438 words_scavenged = (scavtab[type])(start, object);
442 start += words_scavenged;
443 nwords -= words_scavenged;
445 gc_assert(nwords == 0);
449 scavenge_newspace(void)
451 lispobj *here, *next;
454 while (here < new_space_free_pointer) {
455 /* printf("here=%lx, new_space_free_pointer=%lx\n",
456 here,new_space_free_pointer); */
457 next = new_space_free_pointer;
458 scavenge(here, next - here);
461 /* printf("done with newspace\n"); */
464 /* scavenging interrupt contexts */
466 static int boxed_registers[] = BOXED_REGISTERS;
469 scavenge_interrupt_context(os_context_t *context)
474 unsigned long lip_offset;
475 int lip_register_pair;
477 unsigned long pc_code_offset;
479 unsigned long npc_code_offset;
482 /* Find the LIP's register pair and calculate its offset */
483 /* before we scavenge the context. */
485 lip = *os_context_register_addr(context, reg_LIP);
486 /* 0x7FFFFFFF or 0x7FFFFFFFFFFFFFFF ? */
487 lip_offset = 0x7FFFFFFF;
488 lip_register_pair = -1;
489 for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
494 index = boxed_registers[i];
495 reg = *os_context_register_addr(context, index);
496 /* would be using PTR if not for integer length issues */
497 if ((reg & ~((1L<<lowtag_Bits)-1)) <= lip) {
499 if (offset < lip_offset) {
501 lip_register_pair = index;
507 /* Compute the PC's offset from the start of the CODE */
509 pc_code_offset = *os_context_pc_addr(context) -
510 *os_context_register_addr(context, reg_CODE);
512 npc_code_offset = SC_NPC(context) - SC_REG(context, reg_CODE);
515 /* Scanvenge all boxed registers in the context. */
516 for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
520 index = boxed_registers[i];
521 foo = *os_context_register_addr(context,index);
522 scavenge((lispobj *) &foo, 1);
523 *os_context_register_addr(context,index) = foo;
525 /* this is unlikely to work as intended on bigendian
526 * 64 bit platforms */
529 os_context_register_addr(context, index), 1);
534 *os_context_register_addr(context, reg_LIP) =
535 *os_context_register_addr(context, lip_register_pair) + lip_offset;
538 /* Fix the PC if it was in from space */
539 if (from_space_p(*os_context_pc_addr(context)))
540 *os_context_pc_addr(context) =
541 *os_context_register_addr(context, reg_CODE) + pc_code_offset;
543 if (from_space_p(SC_NPC(context)))
544 SC_NPC(context) = SC_REG(context, reg_CODE) + npc_code_offset;
548 void scavenge_interrupt_contexts(void)
551 os_context_t *context;
553 index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX));
555 for (i = 0; i < index; i++) {
556 context = lisp_interrupt_contexts[i];
557 scavenge_interrupt_context(context);
565 print_garbage(lispobj *from_space, lispobj *from_space_free_pointer)
568 int total_words_not_copied;
570 printf("Scanning from space ...\n");
572 total_words_not_copied = 0;
574 while (start < from_space_free_pointer) {
576 int forwardp, type, nwords;
580 forwardp = Pointerp(object) && new_space_p(object);
586 tag = LowtagOf(object);
589 case type_ListPointer:
592 case type_InstancePointer:
593 printf("Don't know about instances yet!\n");
596 case type_FunctionPointer:
599 case type_OtherPointer:
600 pointer = (lispobj *) PTR(object);
602 type = TypeOf(header);
603 nwords = (sizetab[type])(pointer);
606 type = TypeOf(object);
607 nwords = (sizetab[type])(start);
608 total_words_not_copied += nwords;
609 printf("%4d words not copied at 0x%16lx; ",
610 nwords, (unsigned long) start);
611 printf("Header word is 0x%08x\n",
612 (unsigned int) object);
616 printf("%d total words not copied.\n", total_words_not_copied);
620 /* code and code-related objects */
622 #define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)
624 static lispobj trans_function_header(lispobj object);
625 static lispobj trans_boxed(lispobj object);
628 scav_function_pointer(lispobj *where, lispobj object)
630 lispobj *first_pointer;
635 gc_assert(Pointerp(object));
637 /* object is a pointer into from space. Not a FP */
638 first_pointer = (lispobj *) PTR(object);
639 first = *first_pointer;
641 /* must transport object -- object may point */
642 /* to either a function header, a closure */
643 /* function header, or to a closure header. */
645 type = TypeOf(first);
647 case type_FunctionHeader:
648 case type_ClosureFunctionHeader:
649 copy = trans_function_header(object);
652 copy = trans_boxed(object);
656 first = *first_pointer = copy;
658 gc_assert(Pointerp(first));
659 gc_assert(!from_space_p(first));
666 trans_code(struct code *code)
668 struct code *new_code;
669 lispobj first, l_code, l_new_code;
670 int nheader_words, ncode_words, nwords;
671 unsigned long displacement;
672 lispobj fheaderl, *prev_pointer;
674 #if defined(DEBUG_CODE_GC)
675 printf("\nTransporting code object located at 0x%08x.\n",
676 (unsigned long) code);
679 /* if object has already been transported, just return pointer */
680 first = code->header;
681 if (Pointerp(first) && new_space_p(first)) {
683 printf("Was already transported\n");
685 return (struct code *) PTR(first);
688 gc_assert(TypeOf(first) == type_CodeHeader);
690 /* prepare to transport the code vector */
691 l_code = (lispobj) LOW_WORD(code) | type_OtherPointer;
693 ncode_words = fixnum_value(code->code_size);
694 nheader_words = HeaderValue(code->header);
695 nwords = ncode_words + nheader_words;
696 nwords = CEILING(nwords, 2);
698 l_new_code = copy_object(l_code, nwords);
699 new_code = (struct code *) PTR(l_new_code);
701 displacement = l_new_code - l_code;
703 #if defined(DEBUG_CODE_GC)
704 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
705 (unsigned long) code, (unsigned long) new_code);
706 printf("Code object is %d words long.\n", nwords);
709 /* set forwarding pointer */
710 code->header = l_new_code;
712 /* set forwarding pointers for all the function headers in the */
713 /* code object. also fix all self pointers */
715 fheaderl = code->entry_points;
716 prev_pointer = &new_code->entry_points;
718 while (fheaderl != NIL) {
719 struct function *fheaderp, *nfheaderp;
722 fheaderp = (struct function *) PTR(fheaderl);
723 gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
725 /* calcuate the new function pointer and the new */
726 /* function header */
727 nfheaderl = fheaderl + displacement;
728 nfheaderp = (struct function *) PTR(nfheaderl);
730 /* set forwarding pointer */
732 printf("fheaderp->header (at %x) <- %x\n",
733 &(fheaderp->header) , nfheaderl);
735 fheaderp->header = nfheaderl;
737 /* fix self pointer */
738 nfheaderp->self = nfheaderl;
740 *prev_pointer = nfheaderl;
742 fheaderl = fheaderp->next;
743 prev_pointer = &nfheaderp->next;
747 os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words),
748 ncode_words * sizeof(int));
754 scav_code_header(lispobj *where, lispobj object)
757 int nheader_words, ncode_words, nwords;
759 struct function *fheaderp;
761 code = (struct code *) where;
762 ncode_words = fixnum_value(code->code_size);
763 nheader_words = HeaderValue(object);
764 nwords = ncode_words + nheader_words;
765 nwords = CEILING(nwords, 2);
767 #if defined(DEBUG_CODE_GC)
768 printf("\nScavening code object at 0x%08x.\n",
769 (unsigned long) where);
770 printf("Code object is %d words long.\n", nwords);
771 printf("Scavenging boxed section of code data block (%d words).\n",
775 /* Scavenge the boxed section of the code data block */
776 scavenge(where + 1, nheader_words - 1);
778 /* Scavenge the boxed section of each function object in the */
779 /* code data block */
780 fheaderl = code->entry_points;
781 while (fheaderl != NIL) {
782 fheaderp = (struct function *) PTR(fheaderl);
783 gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
785 #if defined(DEBUG_CODE_GC)
786 printf("Scavenging boxed section of entry point located at 0x%08x.\n",
787 (unsigned long) PTR(fheaderl));
789 scavenge(&fheaderp->name, 1);
790 scavenge(&fheaderp->arglist, 1);
791 scavenge(&fheaderp->type, 1);
793 fheaderl = fheaderp->next;
800 trans_code_header(lispobj object)
804 ncode = trans_code((struct code *) PTR(object));
805 return (lispobj) LOW_WORD(ncode) | type_OtherPointer;
809 size_code_header(lispobj *where)
812 int nheader_words, ncode_words, nwords;
814 code = (struct code *) where;
816 ncode_words = fixnum_value(code->code_size);
817 nheader_words = HeaderValue(code->header);
818 nwords = ncode_words + nheader_words;
819 nwords = CEILING(nwords, 2);
826 scav_return_pc_header(lispobj *where, lispobj object)
828 fprintf(stderr, "GC lossage. Should not be scavenging a ");
829 fprintf(stderr, "Return PC Header.\n");
830 fprintf(stderr, "where = 0x%p, object = 0x%x", where, object);
836 trans_return_pc_header(lispobj object)
838 struct function *return_pc;
839 unsigned long offset;
840 struct code *code, *ncode;
842 return_pc = (struct function *) PTR(object);
843 offset = HeaderValue(return_pc->header) * 4 ;
845 /* Transport the whole code object */
846 code = (struct code *) ((unsigned long) return_pc - offset);
848 printf("trans_return_pc_header object=%x, code=%lx\n",object,code);
850 ncode = trans_code(code);
851 if(object==0x304748d7) {
854 ret= ((lispobj) LOW_WORD(ncode) + offset) | type_OtherPointer;
856 printf("trans_return_pc_header returning %x\n",ret);
861 /* On the 386, closures hold a pointer to the raw address instead of
862 * the function object, so we can use CALL [$FDEFN+const] to invoke
863 * the function without loading it into a register. Given that code
864 * objects don't move, we don't need to update anything, but we do
865 * have to figure out that the function is still live. */
868 scav_closure_header(where, object)
869 lispobj *where, object;
871 struct closure *closure;
874 closure = (struct closure *)where;
875 fun = closure->function - RAW_ADDR_OFFSET;
883 scav_function_header(lispobj *where, lispobj object)
885 fprintf(stderr, "GC lossage. Should not be scavenging a ");
886 fprintf(stderr, "Function Header.\n");
887 fprintf(stderr, "where = 0x%p, object = 0x%08x",
888 where, (unsigned int) object);
894 trans_function_header(lispobj object)
896 struct function *fheader;
897 unsigned long offset;
898 struct code *code, *ncode;
900 fheader = (struct function *) PTR(object);
901 offset = HeaderValue(fheader->header) * 4;
903 /* Transport the whole code object */
904 code = (struct code *) ((unsigned long) fheader - offset);
905 ncode = trans_code(code);
907 return ((lispobj) LOW_WORD(ncode) + offset) | type_FunctionPointer;
915 scav_instance_pointer(lispobj *where, lispobj object)
917 lispobj *first_pointer;
919 /* object is a pointer into from space. Not a FP */
920 first_pointer = (lispobj *) PTR(object);
922 *where = *first_pointer = trans_boxed(object);
927 /* lists and conses */
929 static lispobj trans_list(lispobj object);
932 scav_list_pointer(lispobj *where, lispobj object)
934 lispobj first, *first_pointer;
936 gc_assert(Pointerp(object));
938 /* object is a pointer into from space. Not a FP. */
939 first_pointer = (lispobj *) PTR(object);
941 first = *first_pointer = trans_list(object);
943 gc_assert(Pointerp(first));
944 gc_assert(!from_space_p(first));
951 trans_list(lispobj object)
953 lispobj new_list_pointer;
954 struct cons *cons, *new_cons;
956 cons = (struct cons *) PTR(object);
958 /* ### Don't use copy_object here. */
959 new_list_pointer = copy_object(object, 2);
960 new_cons = (struct cons *) PTR(new_list_pointer);
962 /* Set forwarding pointer. */
963 cons->car = new_list_pointer;
965 /* Try to linearize the list in the cdr direction to help reduce */
969 lispobj cdr, new_cdr, first;
970 struct cons *cdr_cons, *new_cdr_cons;
974 if (LowtagOf(cdr) != type_ListPointer ||
975 !from_space_p(cdr) ||
976 (Pointerp(first = *(lispobj *)PTR(cdr)) &&
980 cdr_cons = (struct cons *) PTR(cdr);
982 /* ### Don't use copy_object here */
983 new_cdr = copy_object(cdr, 2);
984 new_cdr_cons = (struct cons *) PTR(new_cdr);
986 /* Set forwarding pointer */
987 cdr_cons->car = new_cdr;
989 /* Update the cdr of the last cons copied into new */
990 /* space to keep the newspace scavenge from having to */
992 new_cons->cdr = new_cdr;
995 new_cons = new_cdr_cons;
998 return new_list_pointer;
1002 /* scavenging and transporting other pointers */
1005 scav_other_pointer(lispobj *where, lispobj object)
1007 lispobj first, *first_pointer;
1009 gc_assert(Pointerp(object));
1011 /* Object is a pointer into from space - not a FP */
1012 first_pointer = (lispobj *) PTR(object);
1013 first = *first_pointer = (transother[TypeOf(*first_pointer)])(object);
1015 gc_assert(Pointerp(first));
1016 gc_assert(!from_space_p(first));
1023 /* immediate, boxed, and unboxed objects */
1026 size_pointer(lispobj *where)
1032 scav_immediate(lispobj *where, lispobj object)
1038 trans_immediate(lispobj object)
1040 fprintf(stderr, "GC lossage. Trying to transport an immediate!?\n");
1046 size_immediate(lispobj *where)
1053 scav_boxed(lispobj *where, lispobj object)
1059 trans_boxed(lispobj object)
1062 unsigned long length;
1064 gc_assert(Pointerp(object));
1066 header = *((lispobj *) PTR(object));
1067 length = HeaderValue(header) + 1;
1068 length = CEILING(length, 2);
1070 return copy_object(object, length);
1074 size_boxed(lispobj *where)
1077 unsigned long length;
1080 length = HeaderValue(header) + 1;
1081 length = CEILING(length, 2);
1086 /* Note: on the sparc we don't have to do anything special for fdefns, */
1087 /* 'cause the raw-addr has a function lowtag. */
1090 scav_fdefn(lispobj *where, lispobj object)
1092 struct fdefn *fdefn;
1094 fdefn = (struct fdefn *)where;
1096 if ((char *)(fdefn->function + RAW_ADDR_OFFSET)
1097 == (char *)((unsigned long)(fdefn->raw_addr))) {
1098 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
1099 fdefn->raw_addr = (u32) ((char *) LOW_WORD(fdefn->function)) + RAW_ADDR_OFFSET;
1100 return sizeof(struct fdefn) / sizeof(lispobj);
1108 scav_unboxed(lispobj *where, lispobj object)
1110 unsigned long length;
1112 length = HeaderValue(object) + 1;
1113 length = CEILING(length, 2);
1119 trans_unboxed(lispobj object)
1122 unsigned long length;
1125 gc_assert(Pointerp(object));
1127 header = *((lispobj *) PTR(object));
1128 length = HeaderValue(header) + 1;
1129 length = CEILING(length, 2);
1131 return copy_object(object, length);
1135 size_unboxed(lispobj *where)
1138 unsigned long length;
1141 length = HeaderValue(header) + 1;
1142 length = CEILING(length, 2);
1148 /* vector-like objects */
1150 #define NWORDS(x,y) (CEILING((x),(y)) / (y))
1153 scav_string(lispobj *where, lispobj object)
1155 struct vector *vector;
1158 /* NOTE: Strings contain one more byte of data than the length */
1159 /* slot indicates. */
1161 vector = (struct vector *) where;
1162 length = fixnum_value(vector->length) + 1;
1163 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1169 trans_string(lispobj object)
1171 struct vector *vector;
1174 gc_assert(Pointerp(object));
1176 /* NOTE: Strings contain one more byte of data than the length */
1177 /* slot indicates. */
1179 vector = (struct vector *) PTR(object);
1180 length = fixnum_value(vector->length) + 1;
1181 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1183 return copy_object(object, nwords);
1187 size_string(lispobj *where)
1189 struct vector *vector;
1192 /* NOTE: Strings contain one more byte of data than the length */
1193 /* slot indicates. */
1195 vector = (struct vector *) where;
1196 length = fixnum_value(vector->length) + 1;
1197 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1203 scav_vector(lispobj *where, lispobj object)
1205 if (HeaderValue(object) == subtype_VectorValidHashing)
1206 *where = (subtype_VectorMustRehash<<type_Bits) | type_SimpleVector;
1213 trans_vector(lispobj object)
1215 struct vector *vector;
1218 gc_assert(Pointerp(object));
1220 vector = (struct vector *) PTR(object);
1222 length = fixnum_value(vector->length);
1223 nwords = CEILING(length + 2, 2);
1225 return copy_object(object, nwords);
1229 size_vector(lispobj *where)
1231 struct vector *vector;
1234 vector = (struct vector *) where;
1235 length = fixnum_value(vector->length);
1236 nwords = CEILING(length + 2, 2);
1243 scav_vector_bit(lispobj *where, lispobj object)
1245 struct vector *vector;
1248 vector = (struct vector *) where;
1249 length = fixnum_value(vector->length);
1250 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1256 trans_vector_bit(lispobj object)
1258 struct vector *vector;
1261 gc_assert(Pointerp(object));
1263 vector = (struct vector *) PTR(object);
1264 length = fixnum_value(vector->length);
1265 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1267 return copy_object(object, nwords);
1271 size_vector_bit(lispobj *where)
1273 struct vector *vector;
1276 vector = (struct vector *) where;
1277 length = fixnum_value(vector->length);
1278 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1285 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
1287 struct vector *vector;
1290 vector = (struct vector *) where;
1291 length = fixnum_value(vector->length);
1292 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1298 trans_vector_unsigned_byte_2(lispobj object)
1300 struct vector *vector;
1303 gc_assert(Pointerp(object));
1305 vector = (struct vector *) PTR(object);
1306 length = fixnum_value(vector->length);
1307 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1309 return copy_object(object, nwords);
1313 size_vector_unsigned_byte_2(lispobj *where)
1315 struct vector *vector;
1318 vector = (struct vector *) where;
1319 length = fixnum_value(vector->length);
1320 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1327 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
1329 struct vector *vector;
1332 vector = (struct vector *) where;
1333 length = fixnum_value(vector->length);
1334 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1340 trans_vector_unsigned_byte_4(lispobj object)
1342 struct vector *vector;
1345 gc_assert(Pointerp(object));
1347 vector = (struct vector *) PTR(object);
1348 length = fixnum_value(vector->length);
1349 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1351 return copy_object(object, nwords);
1355 size_vector_unsigned_byte_4(lispobj *where)
1357 struct vector *vector;
1360 vector = (struct vector *) where;
1361 length = fixnum_value(vector->length);
1362 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1369 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
1371 struct vector *vector;
1374 vector = (struct vector *) where;
1375 length = fixnum_value(vector->length);
1376 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1382 trans_vector_unsigned_byte_8(lispobj object)
1384 struct vector *vector;
1387 gc_assert(Pointerp(object));
1389 vector = (struct vector *) PTR(object);
1390 length = fixnum_value(vector->length);
1391 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1393 return copy_object(object, nwords);
1397 size_vector_unsigned_byte_8(lispobj *where)
1399 struct vector *vector;
1402 vector = (struct vector *) where;
1403 length = fixnum_value(vector->length);
1404 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1411 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1413 struct vector *vector;
1416 vector = (struct vector *) where;
1417 length = fixnum_value(vector->length);
1418 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1424 trans_vector_unsigned_byte_16(lispobj object)
1426 struct vector *vector;
1429 gc_assert(Pointerp(object));
1431 vector = (struct vector *) PTR(object);
1432 length = fixnum_value(vector->length);
1433 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1435 return copy_object(object, nwords);
1439 size_vector_unsigned_byte_16(lispobj *where)
1441 struct vector *vector;
1444 vector = (struct vector *) where;
1445 length = fixnum_value(vector->length);
1446 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1453 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1455 struct vector *vector;
1458 vector = (struct vector *) where;
1459 length = fixnum_value(vector->length);
1460 nwords = CEILING(length + 2, 2);
1466 trans_vector_unsigned_byte_32(lispobj object)
1468 struct vector *vector;
1471 gc_assert(Pointerp(object));
1473 vector = (struct vector *) PTR(object);
1474 length = fixnum_value(vector->length);
1475 nwords = CEILING(length + 2, 2);
1477 return copy_object(object, nwords);
1481 size_vector_unsigned_byte_32(lispobj *where)
1483 struct vector *vector;
1486 vector = (struct vector *) where;
1487 length = fixnum_value(vector->length);
1488 nwords = CEILING(length + 2, 2);
1495 scav_vector_single_float(lispobj *where, lispobj object)
1497 struct vector *vector;
1500 vector = (struct vector *) where;
1501 length = fixnum_value(vector->length);
1502 nwords = CEILING(length + 2, 2);
1508 trans_vector_single_float(lispobj object)
1510 struct vector *vector;
1513 gc_assert(Pointerp(object));
1515 vector = (struct vector *) PTR(object);
1516 length = fixnum_value(vector->length);
1517 nwords = CEILING(length + 2, 2);
1519 return copy_object(object, nwords);
1523 size_vector_single_float(lispobj *where)
1525 struct vector *vector;
1528 vector = (struct vector *) where;
1529 length = fixnum_value(vector->length);
1530 nwords = CEILING(length + 2, 2);
1537 scav_vector_double_float(lispobj *where, lispobj object)
1539 struct vector *vector;
1542 vector = (struct vector *) where;
1543 length = fixnum_value(vector->length);
1544 nwords = CEILING(length * 2 + 2, 2);
1550 trans_vector_double_float(lispobj object)
1552 struct vector *vector;
1555 gc_assert(Pointerp(object));
1557 vector = (struct vector *) PTR(object);
1558 length = fixnum_value(vector->length);
1559 nwords = CEILING(length * 2 + 2, 2);
1561 return copy_object(object, nwords);
1565 size_vector_double_float(lispobj *where)
1567 struct vector *vector;
1570 vector = (struct vector *) where;
1571 length = fixnum_value(vector->length);
1572 nwords = CEILING(length * 2 + 2, 2);
1578 #ifdef type_SimpleArrayLongFloat
1580 scav_vector_long_float(lispobj *where, lispobj object)
1582 struct vector *vector;
1585 vector = (struct vector *) where;
1586 length = fixnum_value(vector->length);
1588 nwords = CEILING(length * 4 + 2, 2);
1595 trans_vector_long_float(lispobj object)
1597 struct vector *vector;
1600 gc_assert(Pointerp(object));
1602 vector = (struct vector *) PTR(object);
1603 length = fixnum_value(vector->length);
1605 nwords = CEILING(length * 4 + 2, 2);
1608 return copy_object(object, nwords);
1612 size_vector_long_float(lispobj *where)
1614 struct vector *vector;
1617 vector = (struct vector *) where;
1618 length = fixnum_value(vector->length);
1620 nwords = CEILING(length * 4 + 2, 2);
1628 #ifdef type_SimpleArrayComplexSingleFloat
1630 scav_vector_complex_single_float(lispobj *where, lispobj object)
1632 struct vector *vector;
1635 vector = (struct vector *) where;
1636 length = fixnum_value(vector->length);
1637 nwords = CEILING(length * 2 + 2, 2);
1643 trans_vector_complex_single_float(lispobj object)
1645 struct vector *vector;
1648 gc_assert(Pointerp(object));
1650 vector = (struct vector *) PTR(object);
1651 length = fixnum_value(vector->length);
1652 nwords = CEILING(length * 2 + 2, 2);
1654 return copy_object(object, nwords);
1658 size_vector_complex_single_float(lispobj *where)
1660 struct vector *vector;
1663 vector = (struct vector *) where;
1664 length = fixnum_value(vector->length);
1665 nwords = CEILING(length * 2 + 2, 2);
1671 #ifdef type_SimpleArrayComplexDoubleFloat
1673 scav_vector_complex_double_float(lispobj *where, lispobj object)
1675 struct vector *vector;
1678 vector = (struct vector *) where;
1679 length = fixnum_value(vector->length);
1680 nwords = CEILING(length * 4 + 2, 2);
1686 trans_vector_complex_double_float(lispobj object)
1688 struct vector *vector;
1691 gc_assert(Pointerp(object));
1693 vector = (struct vector *) PTR(object);
1694 length = fixnum_value(vector->length);
1695 nwords = CEILING(length * 4 + 2, 2);
1697 return copy_object(object, nwords);
1701 size_vector_complex_double_float(lispobj *where)
1703 struct vector *vector;
1706 vector = (struct vector *) where;
1707 length = fixnum_value(vector->length);
1708 nwords = CEILING(length * 4 + 2, 2);
1714 #ifdef type_SimpleArrayComplexLongFloat
1716 scav_vector_complex_long_float(lispobj *where, lispobj object)
1718 struct vector *vector;
1721 vector = (struct vector *) where;
1722 length = fixnum_value(vector->length);
1724 nwords = CEILING(length * 8 + 2, 2);
1731 trans_vector_complex_long_float(lispobj object)
1733 struct vector *vector;
1736 gc_assert(Pointerp(object));
1738 vector = (struct vector *) PTR(object);
1739 length = fixnum_value(vector->length);
1741 nwords = CEILING(length * 8 + 2, 2);
1744 return copy_object(object, nwords);
1748 size_vector_complex_long_float(lispobj *where)
1750 struct vector *vector;
1753 vector = (struct vector *) where;
1754 length = fixnum_value(vector->length);
1756 nwords = CEILING(length * 8 + 2, 2);
1766 #define WEAK_POINTER_NWORDS \
1767 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1770 scav_weak_pointer(lispobj *where, lispobj object)
1772 /* Do not let GC scavenge the value slot of the weak pointer */
1773 /* (that is why it is a weak pointer). Note: we could use */
1774 /* the scav_unboxed method here. */
1776 return WEAK_POINTER_NWORDS;
1780 trans_weak_pointer(lispobj object)
1783 struct weak_pointer *wp;
1785 gc_assert(Pointerp(object));
1787 #if defined(DEBUG_WEAK)
1788 printf("Transporting weak pointer from 0x%08x\n", object);
1791 /* Need to remember where all the weak pointers are that have */
1792 /* been transported so they can be fixed up in a post-GC pass. */
1794 copy = copy_object(object, WEAK_POINTER_NWORDS);
1795 wp = (struct weak_pointer *) PTR(copy);
1798 /* Push the weak pointer onto the list of weak pointers. */
1799 wp->next = LOW_WORD(weak_pointers);
1806 size_weak_pointer(lispobj *where)
1808 return WEAK_POINTER_NWORDS;
1811 void scan_weak_pointers(void)
1813 struct weak_pointer *wp;
1815 for (wp = weak_pointers; wp != (struct weak_pointer *) NULL;
1816 wp = (struct weak_pointer *)((unsigned long)wp->next)) {
1818 lispobj first, *first_pointer;
1822 #if defined(DEBUG_WEAK)
1823 printf("Weak pointer at 0x%p\n", wp);
1824 printf("Value: 0x%08x\n", (unsigned int) value);
1827 if (!(Pointerp(value) && from_space_p(value)))
1830 /* Now, we need to check if the object has been */
1831 /* forwarded. If it has been, the weak pointer is */
1832 /* still good and needs to be updated. Otherwise, the */
1833 /* weak pointer needs to be nil'ed out. */
1835 first_pointer = (lispobj *) PTR(value);
1836 first = *first_pointer;
1838 #if defined(DEBUG_WEAK)
1839 printf("First: 0x%08x\n", (unsigned long) first);
1842 if (Pointerp(first) && new_space_p(first))
1853 /* initialization */
1856 scav_lose(lispobj *where, lispobj object)
1858 fprintf(stderr, "GC lossage. No scavenge function for object 0x%08x (at 0x%016lx)\n",
1859 (unsigned int) object, (unsigned long)where);
1865 trans_lose(lispobj object)
1867 fprintf(stderr, "GC lossage. No transport function for object 0x%08x\n",
1868 (unsigned int)object);
1874 size_lose(lispobj *where)
1876 fprintf(stderr, "Size lossage. No size function for object at 0x%p\n",
1878 fprintf(stderr, "First word of object: 0x%08x\n",
1883 /* KLUDGE: SBCL already has two GC implementations, and if someday the
1884 * precise generational GC is revived, it might have three. It would
1885 * be nice to share the scavtab[] data set up here, and perhaps other
1886 * things too, between all of them, rather than trying to maintain
1887 * multiple copies. -- WHN 2001-05-09 */
1893 /* scavenge table */
1894 for (i = 0; i < 256; i++)
1895 scavtab[i] = scav_lose;
1896 /* scavtab[i] = scav_immediate; */
1898 for (i = 0; i < 32; i++) {
1899 scavtab[type_EvenFixnum|(i<<3)] = scav_immediate;
1900 scavtab[type_FunctionPointer|(i<<3)] = scav_function_pointer;
1901 /* OtherImmediate0 */
1902 scavtab[type_ListPointer|(i<<3)] = scav_list_pointer;
1903 scavtab[type_OddFixnum|(i<<3)] = scav_immediate;
1904 scavtab[type_InstancePointer|(i<<3)] = scav_instance_pointer;
1905 /* OtherImmediate1 */
1906 scavtab[type_OtherPointer|(i<<3)] = scav_other_pointer;
1909 scavtab[type_Bignum] = scav_unboxed;
1910 scavtab[type_Ratio] = scav_boxed;
1911 scavtab[type_SingleFloat] = scav_unboxed;
1912 scavtab[type_DoubleFloat] = scav_unboxed;
1913 #ifdef type_LongFloat
1914 scavtab[type_LongFloat] = scav_unboxed;
1916 scavtab[type_Complex] = scav_boxed;
1917 #ifdef type_ComplexSingleFloat
1918 scavtab[type_ComplexSingleFloat] = scav_unboxed;
1920 #ifdef type_ComplexDoubleFloat
1921 scavtab[type_ComplexDoubleFloat] = scav_unboxed;
1923 #ifdef type_ComplexLongFloat
1924 scavtab[type_ComplexLongFloat] = scav_unboxed;
1926 scavtab[type_SimpleArray] = scav_boxed;
1927 scavtab[type_SimpleString] = scav_string;
1928 scavtab[type_SimpleBitVector] = scav_vector_bit;
1929 scavtab[type_SimpleVector] = scav_vector;
1930 scavtab[type_SimpleArrayUnsignedByte2] = scav_vector_unsigned_byte_2;
1931 scavtab[type_SimpleArrayUnsignedByte4] = scav_vector_unsigned_byte_4;
1932 scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8;
1933 scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16;
1934 scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32;
1935 #ifdef type_SimpleArraySignedByte8
1936 scavtab[type_SimpleArraySignedByte8] = scav_vector_unsigned_byte_8;
1938 #ifdef type_SimpleArraySignedByte16
1939 scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16;
1941 #ifdef type_SimpleArraySignedByte30
1942 scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32;
1944 #ifdef type_SimpleArraySignedByte32
1945 scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32;
1947 scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float;
1948 scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float;
1949 #ifdef type_SimpleArrayLongFloat
1950 scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float;
1952 #ifdef type_SimpleArrayComplexSingleFloat
1953 scavtab[type_SimpleArrayComplexSingleFloat] = scav_vector_complex_single_float;
1955 #ifdef type_SimpleArrayComplexDoubleFloat
1956 scavtab[type_SimpleArrayComplexDoubleFloat] = scav_vector_complex_double_float;
1958 #ifdef type_SimpleArrayComplexLongFloat
1959 scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float;
1961 scavtab[type_ComplexString] = scav_boxed;
1962 scavtab[type_ComplexBitVector] = scav_boxed;
1963 scavtab[type_ComplexVector] = scav_boxed;
1964 scavtab[type_ComplexArray] = scav_boxed;
1965 scavtab[type_CodeHeader] = scav_code_header;
1966 scavtab[type_FunctionHeader] = scav_function_header;
1967 scavtab[type_ClosureFunctionHeader] = scav_function_header;
1968 scavtab[type_ReturnPcHeader] = scav_return_pc_header;
1970 scavtab[type_ClosureHeader] = scav_closure_header;
1971 scavtab[type_FuncallableInstanceHeader] = scav_closure_header;
1972 scavtab[type_ByteCodeFunction] = scav_closure_header;
1973 scavtab[type_ByteCodeClosure] = scav_closure_header;
1974 /* scavtab[type_DylanFunctionHeader] = scav_closure_header; */
1976 scavtab[type_ClosureHeader] = scav_boxed;
1977 scavtab[type_FuncallableInstanceHeader] = scav_boxed;
1978 scavtab[type_ByteCodeFunction] = scav_boxed;
1979 scavtab[type_ByteCodeClosure] = scav_boxed;
1980 /* scavtab[type_DylanFunctionHeader] = scav_boxed; */
1982 scavtab[type_ValueCellHeader] = scav_boxed;
1983 scavtab[type_SymbolHeader] = scav_boxed;
1984 scavtab[type_BaseChar] = scav_immediate;
1985 scavtab[type_Sap] = scav_unboxed;
1986 scavtab[type_UnboundMarker] = scav_immediate;
1987 scavtab[type_WeakPointer] = scav_weak_pointer;
1988 scavtab[type_InstanceHeader] = scav_boxed;
1990 scavtab[type_Fdefn] = scav_fdefn;
1992 scavtab[type_Fdefn] = scav_boxed;
1995 /* Transport Other Table */
1996 for (i = 0; i < 256; i++)
1997 transother[i] = trans_lose;
1999 transother[type_Bignum] = trans_unboxed;
2000 transother[type_Ratio] = trans_boxed;
2001 transother[type_SingleFloat] = trans_unboxed;
2002 transother[type_DoubleFloat] = trans_unboxed;
2003 #ifdef type_LongFloat
2004 transother[type_LongFloat] = trans_unboxed;
2006 transother[type_Complex] = trans_boxed;
2007 #ifdef type_ComplexSingleFloat
2008 transother[type_ComplexSingleFloat] = trans_unboxed;
2010 #ifdef type_ComplexDoubleFloat
2011 transother[type_ComplexDoubleFloat] = trans_unboxed;
2013 #ifdef type_ComplexLongFloat
2014 transother[type_ComplexLongFloat] = trans_unboxed;
2016 transother[type_SimpleArray] = trans_boxed;
2017 transother[type_SimpleString] = trans_string;
2018 transother[type_SimpleBitVector] = trans_vector_bit;
2019 transother[type_SimpleVector] = trans_vector;
2020 transother[type_SimpleArrayUnsignedByte2] = trans_vector_unsigned_byte_2;
2021 transother[type_SimpleArrayUnsignedByte4] = trans_vector_unsigned_byte_4;
2022 transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8;
2023 transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16;
2024 transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32;
2025 #ifdef type_SimpleArraySignedByte8
2026 transother[type_SimpleArraySignedByte8] = trans_vector_unsigned_byte_8;
2028 #ifdef type_SimpleArraySignedByte16
2029 transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16;
2031 #ifdef type_SimpleArraySignedByte30
2032 transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32;
2034 #ifdef type_SimpleArraySignedByte32
2035 transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32;
2037 transother[type_SimpleArraySingleFloat] = trans_vector_single_float;
2038 transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float;
2039 #ifdef type_SimpleArrayLongFloat
2040 transother[type_SimpleArrayLongFloat] = trans_vector_long_float;
2042 #ifdef type_SimpleArrayComplexSingleFloat
2043 transother[type_SimpleArrayComplexSingleFloat] = trans_vector_complex_single_float;
2045 #ifdef type_SimpleArrayComplexDoubleFloat
2046 transother[type_SimpleArrayComplexDoubleFloat] = trans_vector_complex_double_float;
2048 #ifdef type_SimpleArrayComplexLongFloat
2049 transother[type_SimpleArrayComplexLongFloat] = trans_vector_complex_long_float;
2051 transother[type_ComplexString] = trans_boxed;
2052 transother[type_ComplexBitVector] = trans_boxed;
2053 transother[type_ComplexVector] = trans_boxed;
2054 transother[type_ComplexArray] = trans_boxed;
2055 transother[type_CodeHeader] = trans_code_header;
2056 transother[type_FunctionHeader] = trans_function_header;
2057 transother[type_ClosureFunctionHeader] = trans_function_header;
2058 transother[type_ReturnPcHeader] = trans_return_pc_header;
2059 transother[type_ClosureHeader] = trans_boxed;
2060 transother[type_FuncallableInstanceHeader] = trans_boxed;
2061 transother[type_ByteCodeFunction] = trans_boxed;
2062 transother[type_ByteCodeClosure] = trans_boxed;
2063 transother[type_ValueCellHeader] = trans_boxed;
2064 transother[type_SymbolHeader] = trans_boxed;
2065 transother[type_BaseChar] = trans_immediate;
2066 transother[type_Sap] = trans_unboxed;
2067 transother[type_UnboundMarker] = trans_immediate;
2068 transother[type_WeakPointer] = trans_weak_pointer;
2069 transother[type_InstanceHeader] = trans_boxed;
2070 transother[type_Fdefn] = trans_boxed;
2074 for (i = 0; i < 256; i++)
2075 sizetab[i] = size_lose;
2077 for (i = 0; i < 32; i++) {
2078 sizetab[type_EvenFixnum|(i<<3)] = size_immediate;
2079 sizetab[type_FunctionPointer|(i<<3)] = size_pointer;
2080 /* OtherImmediate0 */
2081 sizetab[type_ListPointer|(i<<3)] = size_pointer;
2082 sizetab[type_OddFixnum|(i<<3)] = size_immediate;
2083 sizetab[type_InstancePointer|(i<<3)] = size_pointer;
2084 /* OtherImmediate1 */
2085 sizetab[type_OtherPointer|(i<<3)] = size_pointer;
2088 sizetab[type_Bignum] = size_unboxed;
2089 sizetab[type_Ratio] = size_boxed;
2090 sizetab[type_SingleFloat] = size_unboxed;
2091 sizetab[type_DoubleFloat] = size_unboxed;
2092 #ifdef type_LongFloat
2093 sizetab[type_LongFloat] = size_unboxed;
2095 sizetab[type_Complex] = size_boxed;
2096 #ifdef type_ComplexSingleFloat
2097 sizetab[type_ComplexSingleFloat] = size_unboxed;
2099 #ifdef type_ComplexDoubleFloat
2100 sizetab[type_ComplexDoubleFloat] = size_unboxed;
2102 #ifdef type_ComplexLongFloat
2103 sizetab[type_ComplexLongFloat] = size_unboxed;
2105 sizetab[type_SimpleArray] = size_boxed;
2106 sizetab[type_SimpleString] = size_string;
2107 sizetab[type_SimpleBitVector] = size_vector_bit;
2108 sizetab[type_SimpleVector] = size_vector;
2109 sizetab[type_SimpleArrayUnsignedByte2] = size_vector_unsigned_byte_2;
2110 sizetab[type_SimpleArrayUnsignedByte4] = size_vector_unsigned_byte_4;
2111 sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8;
2112 sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16;
2113 sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32;
2114 #ifdef type_SimpleArraySignedByte8
2115 sizetab[type_SimpleArraySignedByte8] = size_vector_unsigned_byte_8;
2117 #ifdef type_SimpleArraySignedByte16
2118 sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16;
2120 #ifdef type_SimpleArraySignedByte30
2121 sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32;
2123 #ifdef type_SimpleArraySignedByte32
2124 sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32;
2126 sizetab[type_SimpleArraySingleFloat] = size_vector_single_float;
2127 sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float;
2128 #ifdef type_SimpleArrayLongFloat
2129 sizetab[type_SimpleArrayLongFloat] = size_vector_long_float;
2131 #ifdef type_SimpleArrayComplexSingleFloat
2132 sizetab[type_SimpleArrayComplexSingleFloat] = size_vector_complex_single_float;
2134 #ifdef type_SimpleArrayComplexDoubleFloat
2135 sizetab[type_SimpleArrayComplexDoubleFloat] = size_vector_complex_double_float;
2137 #ifdef type_SimpleArrayComplexLongFloat
2138 sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float;
2140 sizetab[type_ComplexString] = size_boxed;
2141 sizetab[type_ComplexBitVector] = size_boxed;
2142 sizetab[type_ComplexVector] = size_boxed;
2143 sizetab[type_ComplexArray] = size_boxed;
2144 sizetab[type_CodeHeader] = size_code_header;
2146 /* Shouldn't see these so just lose if it happens */
2147 sizetab[type_FunctionHeader] = size_function_header;
2148 sizetab[type_ClosureFunctionHeader] = size_function_header;
2149 sizetab[type_ReturnPcHeader] = size_return_pc_header;
2151 sizetab[type_ClosureHeader] = size_boxed;
2152 sizetab[type_FuncallableInstanceHeader] = size_boxed;
2153 sizetab[type_ValueCellHeader] = size_boxed;
2154 sizetab[type_SymbolHeader] = size_boxed;
2155 sizetab[type_BaseChar] = size_immediate;
2156 sizetab[type_Sap] = size_unboxed;
2157 sizetab[type_UnboundMarker] = size_immediate;
2158 sizetab[type_WeakPointer] = size_weak_pointer;
2159 sizetab[type_InstanceHeader] = size_boxed;
2160 sizetab[type_Fdefn] = size_boxed;
2163 /* noise to manipulate the gc trigger stuff */
2165 void set_auto_gc_trigger(os_vm_size_t dynamic_usage)
2167 os_vm_address_t addr=(os_vm_address_t)current_dynamic_space +
2170 DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
2172 if(addr < (os_vm_address_t)dynamic_space_free_pointer) {
2174 "set_auto_gc_trigger: tried to set gc trigger too low! (%d < %p)\n",
2175 (unsigned int)dynamic_usage,
2176 (os_vm_address_t)dynamic_space_free_pointer
2177 - (os_vm_address_t)current_dynamic_space);
2180 else if (length < 0) {
2182 "set_auto_gc_trigger: tried to set gc trigger too high! (%p)\n",
2187 addr=os_round_up_to_page(addr);
2188 length=os_trunc_size_to_page(length);
2190 #if defined(SUNOS) || defined(SOLARIS)
2191 os_invalidate(addr,length);
2193 os_protect(addr, length, 0);
2196 current_auto_gc_trigger = (lispobj *)addr;
2199 void clear_auto_gc_trigger(void)
2201 if(current_auto_gc_trigger!=NULL){
2202 #if defined(SUNOS) || defined(SOLARIS)/* don't want to force whole space into swapping mode... */
2203 os_vm_address_t addr=(os_vm_address_t)current_auto_gc_trigger;
2204 os_vm_size_t length=
2205 DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
2207 os_validate(addr,length);
2209 os_protect((os_vm_address_t)current_dynamic_space,
2214 current_auto_gc_trigger = NULL;