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(is_lisp_pointer(object));
84 ptr = (lispobj *) native_pointer(object);
86 return ((from_space <= ptr) &&
87 (ptr < from_space_free_pointer));
91 new_space_p(lispobj object)
95 gc_assert(is_lisp_pointer(object));
97 ptr = (lispobj *) native_pointer(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(is_lisp_pointer(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 *) native_pointer(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 (is_lisp_pointer(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 *)native_pointer(object));
399 if (is_lisp_pointer(first_word) &&
400 new_space_p(first_word)) {
401 /* Yep, there be a forwarding pointer. */
406 /* Scavenge that pointer. */
407 words_scavenged = (scavtab[type])(start, object);
411 /* It points somewhere other than oldspace. Leave */
417 /* there are some situations where an
418 other-immediate may end up in a descriptor
419 register. I'm not sure whether this is
420 supposed to happen, but if it does then we
421 don't want to (a) barf or (b) scavenge over the
422 data-block, because there isn't one. So, if
423 we're checking a single word and it's anything
424 other than a pointer, just hush it up */
427 if((scavtab[type]==scav_lose) ||
428 (((scavtab[type])(start,object))>1)) {
429 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",
433 else if ((object & 3) == 0) {
434 /* It's a fixnum. Real easy. */
438 /* It's some random header object. */
439 words_scavenged = (scavtab[type])(start, object);
443 start += words_scavenged;
444 nwords -= words_scavenged;
446 gc_assert(nwords == 0);
450 scavenge_newspace(void)
452 lispobj *here, *next;
455 while (here < new_space_free_pointer) {
456 /* printf("here=%lx, new_space_free_pointer=%lx\n",
457 here,new_space_free_pointer); */
458 next = new_space_free_pointer;
459 scavenge(here, next - here);
462 /* printf("done with newspace\n"); */
465 /* scavenging interrupt contexts */
467 static int boxed_registers[] = BOXED_REGISTERS;
470 scavenge_interrupt_context(os_context_t *context)
475 unsigned long lip_offset;
476 int lip_register_pair;
478 unsigned long pc_code_offset;
480 unsigned long npc_code_offset;
483 /* Find the LIP's register pair and calculate its offset */
484 /* before we scavenge the context. */
486 lip = *os_context_register_addr(context, reg_LIP);
487 /* 0x7FFFFFFF or 0x7FFFFFFFFFFFFFFF ? */
488 lip_offset = 0x7FFFFFFF;
489 lip_register_pair = -1;
490 for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
495 index = boxed_registers[i];
496 reg = *os_context_register_addr(context, index);
497 /* would be using PTR if not for integer length issues */
498 if ((reg & ~((1L<<lowtag_Bits)-1)) <= lip) {
500 if (offset < lip_offset) {
502 lip_register_pair = index;
508 /* Compute the PC's offset from the start of the CODE */
510 pc_code_offset = *os_context_pc_addr(context) -
511 *os_context_register_addr(context, reg_CODE);
513 npc_code_offset = SC_NPC(context) - SC_REG(context, reg_CODE);
516 /* Scanvenge all boxed registers in the context. */
517 for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
521 index = boxed_registers[i];
522 foo = *os_context_register_addr(context,index);
523 scavenge((lispobj *) &foo, 1);
524 *os_context_register_addr(context,index) = foo;
526 /* this is unlikely to work as intended on bigendian
527 * 64 bit platforms */
530 os_context_register_addr(context, index), 1);
535 *os_context_register_addr(context, reg_LIP) =
536 *os_context_register_addr(context, lip_register_pair) + lip_offset;
539 /* Fix the PC if it was in from space */
540 if (from_space_p(*os_context_pc_addr(context)))
541 *os_context_pc_addr(context) =
542 *os_context_register_addr(context, reg_CODE) + pc_code_offset;
544 if (from_space_p(SC_NPC(context)))
545 SC_NPC(context) = SC_REG(context, reg_CODE) + npc_code_offset;
549 void scavenge_interrupt_contexts(void)
552 os_context_t *context;
554 index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX));
556 for (i = 0; i < index; i++) {
557 context = lisp_interrupt_contexts[i];
558 scavenge_interrupt_context(context);
566 print_garbage(lispobj *from_space, lispobj *from_space_free_pointer)
569 int total_words_not_copied;
571 printf("Scanning from space ...\n");
573 total_words_not_copied = 0;
575 while (start < from_space_free_pointer) {
577 int forwardp, type, nwords;
581 forwardp = is_lisp_pointer(object) && new_space_p(object);
587 tag = LowtagOf(object);
590 case type_ListPointer:
593 case type_InstancePointer:
594 printf("Don't know about instances yet!\n");
597 case type_FunctionPointer:
600 case type_OtherPointer:
601 pointer = (lispobj *) native_pointer(object);
603 type = TypeOf(header);
604 nwords = (sizetab[type])(pointer);
607 type = TypeOf(object);
608 nwords = (sizetab[type])(start);
609 total_words_not_copied += nwords;
610 printf("%4d words not copied at 0x%16lx; ",
611 nwords, (unsigned long) start);
612 printf("Header word is 0x%08x\n",
613 (unsigned int) object);
617 printf("%d total words not copied.\n", total_words_not_copied);
621 /* code and code-related objects */
623 #define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)
625 static lispobj trans_function_header(lispobj object);
626 static lispobj trans_boxed(lispobj object);
629 scav_function_pointer(lispobj *where, lispobj object)
631 lispobj *first_pointer;
636 gc_assert(is_lisp_pointer(object));
638 /* object is a pointer into from space. Not a FP */
639 first_pointer = (lispobj *) native_pointer(object);
640 first = *first_pointer;
642 /* must transport object -- object may point */
643 /* to either a function header, a closure */
644 /* function header, or to a closure header. */
646 type = TypeOf(first);
648 case type_FunctionHeader:
649 case type_ClosureFunctionHeader:
650 copy = trans_function_header(object);
653 copy = trans_boxed(object);
657 first = *first_pointer = copy;
659 gc_assert(is_lisp_pointer(first));
660 gc_assert(!from_space_p(first));
667 trans_code(struct code *code)
669 struct code *new_code;
670 lispobj first, l_code, l_new_code;
671 int nheader_words, ncode_words, nwords;
672 unsigned long displacement;
673 lispobj fheaderl, *prev_pointer;
675 #if defined(DEBUG_CODE_GC)
676 printf("\nTransporting code object located at 0x%08x.\n",
677 (unsigned long) code);
680 /* if object has already been transported, just return pointer */
681 first = code->header;
682 if (is_lisp_pointer(first) && new_space_p(first)) {
684 printf("Was already transported\n");
686 return (struct code *) native_pointer(first);
689 gc_assert(TypeOf(first) == type_CodeHeader);
691 /* prepare to transport the code vector */
692 l_code = (lispobj) LOW_WORD(code) | type_OtherPointer;
694 ncode_words = fixnum_value(code->code_size);
695 nheader_words = HeaderValue(code->header);
696 nwords = ncode_words + nheader_words;
697 nwords = CEILING(nwords, 2);
699 l_new_code = copy_object(l_code, nwords);
700 new_code = (struct code *) native_pointer(l_new_code);
702 displacement = l_new_code - l_code;
704 #if defined(DEBUG_CODE_GC)
705 printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
706 (unsigned long) code, (unsigned long) new_code);
707 printf("Code object is %d words long.\n", nwords);
710 /* set forwarding pointer */
711 code->header = l_new_code;
713 /* set forwarding pointers for all the function headers in the */
714 /* code object. also fix all self pointers */
716 fheaderl = code->entry_points;
717 prev_pointer = &new_code->entry_points;
719 while (fheaderl != NIL) {
720 struct function *fheaderp, *nfheaderp;
723 fheaderp = (struct function *) native_pointer(fheaderl);
724 gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
726 /* calcuate the new function pointer and the new */
727 /* function header */
728 nfheaderl = fheaderl + displacement;
729 nfheaderp = (struct function *) native_pointer(nfheaderl);
731 /* set forwarding pointer */
733 printf("fheaderp->header (at %x) <- %x\n",
734 &(fheaderp->header) , nfheaderl);
736 fheaderp->header = nfheaderl;
738 /* fix self pointer */
739 nfheaderp->self = nfheaderl;
741 *prev_pointer = nfheaderl;
743 fheaderl = fheaderp->next;
744 prev_pointer = &nfheaderp->next;
748 os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words),
749 ncode_words * sizeof(int));
755 scav_code_header(lispobj *where, lispobj object)
758 int nheader_words, ncode_words, nwords;
760 struct function *fheaderp;
762 code = (struct code *) where;
763 ncode_words = fixnum_value(code->code_size);
764 nheader_words = HeaderValue(object);
765 nwords = ncode_words + nheader_words;
766 nwords = CEILING(nwords, 2);
768 #if defined(DEBUG_CODE_GC)
769 printf("\nScavening code object at 0x%08x.\n",
770 (unsigned long) where);
771 printf("Code object is %d words long.\n", nwords);
772 printf("Scavenging boxed section of code data block (%d words).\n",
776 /* Scavenge the boxed section of the code data block */
777 scavenge(where + 1, nheader_words - 1);
779 /* Scavenge the boxed section of each function object in the */
780 /* code data block */
781 fheaderl = code->entry_points;
782 while (fheaderl != NIL) {
783 fheaderp = (struct function *) native_pointer(fheaderl);
784 gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
786 #if defined(DEBUG_CODE_GC)
787 printf("Scavenging boxed section of entry point located at 0x%08x.\n",
788 (unsigned long) native_pointer(fheaderl));
790 scavenge(&fheaderp->name, 1);
791 scavenge(&fheaderp->arglist, 1);
792 scavenge(&fheaderp->type, 1);
794 fheaderl = fheaderp->next;
801 trans_code_header(lispobj object)
805 ncode = trans_code((struct code *) native_pointer(object));
806 return (lispobj) LOW_WORD(ncode) | type_OtherPointer;
810 size_code_header(lispobj *where)
813 int nheader_words, ncode_words, nwords;
815 code = (struct code *) where;
817 ncode_words = fixnum_value(code->code_size);
818 nheader_words = HeaderValue(code->header);
819 nwords = ncode_words + nheader_words;
820 nwords = CEILING(nwords, 2);
827 scav_return_pc_header(lispobj *where, lispobj object)
829 fprintf(stderr, "GC lossage. Should not be scavenging a ");
830 fprintf(stderr, "Return PC Header.\n");
831 fprintf(stderr, "where = 0x%p, object = 0x%x", where, object);
837 trans_return_pc_header(lispobj object)
839 struct function *return_pc;
840 unsigned long offset;
841 struct code *code, *ncode;
843 return_pc = (struct function *) native_pointer(object);
844 offset = HeaderValue(return_pc->header) * 4 ;
846 /* Transport the whole code object */
847 code = (struct code *) ((unsigned long) return_pc - offset);
849 printf("trans_return_pc_header object=%x, code=%lx\n",object,code);
851 ncode = trans_code(code);
852 if(object==0x304748d7) {
853 /* monitor_or_something(); */
855 ret= ((lispobj) LOW_WORD(ncode) + offset) | type_OtherPointer;
857 printf("trans_return_pc_header returning %x\n",ret);
862 /* On the 386, closures hold a pointer to the raw address instead of
863 * the function object, so we can use CALL [$FDEFN+const] to invoke
864 * the function without loading it into a register. Given that code
865 * objects don't move, we don't need to update anything, but we do
866 * have to figure out that the function is still live. */
869 scav_closure_header(where, object)
870 lispobj *where, object;
872 struct closure *closure;
875 closure = (struct closure *)where;
876 fun = closure->function - RAW_ADDR_OFFSET;
884 scav_function_header(lispobj *where, lispobj object)
886 fprintf(stderr, "GC lossage. Should not be scavenging a ");
887 fprintf(stderr, "Function Header.\n");
888 fprintf(stderr, "where = 0x%p, object = 0x%08x",
889 where, (unsigned int) object);
895 trans_function_header(lispobj object)
897 struct function *fheader;
898 unsigned long offset;
899 struct code *code, *ncode;
901 fheader = (struct function *) native_pointer(object);
902 offset = HeaderValue(fheader->header) * 4;
904 /* Transport the whole code object */
905 code = (struct code *) ((unsigned long) fheader - offset);
906 ncode = trans_code(code);
908 return ((lispobj) LOW_WORD(ncode) + offset) | type_FunctionPointer;
916 scav_instance_pointer(lispobj *where, lispobj object)
918 lispobj *first_pointer;
920 /* object is a pointer into from space. Not a FP */
921 first_pointer = (lispobj *) native_pointer(object);
923 *where = *first_pointer = trans_boxed(object);
928 /* lists and conses */
930 static lispobj trans_list(lispobj object);
933 scav_list_pointer(lispobj *where, lispobj object)
935 lispobj first, *first_pointer;
937 gc_assert(is_lisp_pointer(object));
939 /* object is a pointer into from space. Not a FP. */
940 first_pointer = (lispobj *) native_pointer(object);
942 first = *first_pointer = trans_list(object);
944 gc_assert(is_lisp_pointer(first));
945 gc_assert(!from_space_p(first));
952 trans_list(lispobj object)
954 lispobj new_list_pointer;
955 struct cons *cons, *new_cons;
957 cons = (struct cons *) native_pointer(object);
959 /* ### Don't use copy_object here. */
960 new_list_pointer = copy_object(object, 2);
961 new_cons = (struct cons *) native_pointer(new_list_pointer);
963 /* Set forwarding pointer. */
964 cons->car = new_list_pointer;
966 /* Try to linearize the list in the cdr direction to help reduce */
970 lispobj cdr, new_cdr, first;
971 struct cons *cdr_cons, *new_cdr_cons;
975 if (LowtagOf(cdr) != type_ListPointer ||
976 !from_space_p(cdr) ||
977 (is_lisp_pointer(first = *(lispobj *)native_pointer(cdr))
978 && new_space_p(first)))
981 cdr_cons = (struct cons *) native_pointer(cdr);
983 /* ### Don't use copy_object here */
984 new_cdr = copy_object(cdr, 2);
985 new_cdr_cons = (struct cons *) native_pointer(new_cdr);
987 /* Set forwarding pointer */
988 cdr_cons->car = new_cdr;
990 /* Update the cdr of the last cons copied into new */
991 /* space to keep the newspace scavenge from having to */
993 new_cons->cdr = new_cdr;
996 new_cons = new_cdr_cons;
999 return new_list_pointer;
1003 /* scavenging and transporting other pointers */
1006 scav_other_pointer(lispobj *where, lispobj object)
1008 lispobj first, *first_pointer;
1010 gc_assert(is_lisp_pointer(object));
1012 /* Object is a pointer into from space - not a FP */
1013 first_pointer = (lispobj *) native_pointer(object);
1014 first = *first_pointer = (transother[TypeOf(*first_pointer)])(object);
1016 gc_assert(is_lisp_pointer(first));
1017 gc_assert(!from_space_p(first));
1024 /* immediate, boxed, and unboxed objects */
1027 size_pointer(lispobj *where)
1033 scav_immediate(lispobj *where, lispobj object)
1039 trans_immediate(lispobj object)
1041 fprintf(stderr, "GC lossage. Trying to transport an immediate!?\n");
1047 size_immediate(lispobj *where)
1054 scav_boxed(lispobj *where, lispobj object)
1060 trans_boxed(lispobj object)
1063 unsigned long length;
1065 gc_assert(is_lisp_pointer(object));
1067 header = *((lispobj *) native_pointer(object));
1068 length = HeaderValue(header) + 1;
1069 length = CEILING(length, 2);
1071 return copy_object(object, length);
1075 size_boxed(lispobj *where)
1078 unsigned long length;
1081 length = HeaderValue(header) + 1;
1082 length = CEILING(length, 2);
1087 /* Note: on the sparc we don't have to do anything special for fdefns, */
1088 /* 'cause the raw-addr has a function lowtag. */
1091 scav_fdefn(lispobj *where, lispobj object)
1093 struct fdefn *fdefn;
1095 fdefn = (struct fdefn *)where;
1097 if ((char *)(fdefn->function + RAW_ADDR_OFFSET)
1098 == (char *)((unsigned long)(fdefn->raw_addr))) {
1099 scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
1100 fdefn->raw_addr = (u32) ((char *) LOW_WORD(fdefn->function)) + RAW_ADDR_OFFSET;
1101 return sizeof(struct fdefn) / sizeof(lispobj);
1109 scav_unboxed(lispobj *where, lispobj object)
1111 unsigned long length;
1113 length = HeaderValue(object) + 1;
1114 length = CEILING(length, 2);
1120 trans_unboxed(lispobj object)
1123 unsigned long length;
1126 gc_assert(is_lisp_pointer(object));
1128 header = *((lispobj *) native_pointer(object));
1129 length = HeaderValue(header) + 1;
1130 length = CEILING(length, 2);
1132 return copy_object(object, length);
1136 size_unboxed(lispobj *where)
1139 unsigned long length;
1142 length = HeaderValue(header) + 1;
1143 length = CEILING(length, 2);
1149 /* vector-like objects */
1151 #define NWORDS(x,y) (CEILING((x),(y)) / (y))
1154 scav_string(lispobj *where, lispobj object)
1156 struct vector *vector;
1159 /* NOTE: Strings contain one more byte of data than the length */
1160 /* slot indicates. */
1162 vector = (struct vector *) where;
1163 length = fixnum_value(vector->length) + 1;
1164 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1170 trans_string(lispobj object)
1172 struct vector *vector;
1175 gc_assert(is_lisp_pointer(object));
1177 /* NOTE: Strings contain one more byte of data than the length */
1178 /* slot indicates. */
1180 vector = (struct vector *) native_pointer(object);
1181 length = fixnum_value(vector->length) + 1;
1182 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1184 return copy_object(object, nwords);
1188 size_string(lispobj *where)
1190 struct vector *vector;
1193 /* NOTE: Strings contain one more byte of data than the length */
1194 /* slot indicates. */
1196 vector = (struct vector *) where;
1197 length = fixnum_value(vector->length) + 1;
1198 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1204 scav_vector(lispobj *where, lispobj object)
1206 if (HeaderValue(object) == subtype_VectorValidHashing)
1207 *where = (subtype_VectorMustRehash<<type_Bits) | type_SimpleVector;
1214 trans_vector(lispobj object)
1216 struct vector *vector;
1219 gc_assert(is_lisp_pointer(object));
1221 vector = (struct vector *) native_pointer(object);
1223 length = fixnum_value(vector->length);
1224 nwords = CEILING(length + 2, 2);
1226 return copy_object(object, nwords);
1230 size_vector(lispobj *where)
1232 struct vector *vector;
1235 vector = (struct vector *) where;
1236 length = fixnum_value(vector->length);
1237 nwords = CEILING(length + 2, 2);
1244 scav_vector_bit(lispobj *where, lispobj object)
1246 struct vector *vector;
1249 vector = (struct vector *) where;
1250 length = fixnum_value(vector->length);
1251 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1257 trans_vector_bit(lispobj object)
1259 struct vector *vector;
1262 gc_assert(is_lisp_pointer(object));
1264 vector = (struct vector *) native_pointer(object);
1265 length = fixnum_value(vector->length);
1266 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1268 return copy_object(object, nwords);
1272 size_vector_bit(lispobj *where)
1274 struct vector *vector;
1277 vector = (struct vector *) where;
1278 length = fixnum_value(vector->length);
1279 nwords = CEILING(NWORDS(length, 32) + 2, 2);
1286 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
1288 struct vector *vector;
1291 vector = (struct vector *) where;
1292 length = fixnum_value(vector->length);
1293 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1299 trans_vector_unsigned_byte_2(lispobj object)
1301 struct vector *vector;
1304 gc_assert(is_lisp_pointer(object));
1306 vector = (struct vector *) native_pointer(object);
1307 length = fixnum_value(vector->length);
1308 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1310 return copy_object(object, nwords);
1314 size_vector_unsigned_byte_2(lispobj *where)
1316 struct vector *vector;
1319 vector = (struct vector *) where;
1320 length = fixnum_value(vector->length);
1321 nwords = CEILING(NWORDS(length, 16) + 2, 2);
1328 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
1330 struct vector *vector;
1333 vector = (struct vector *) where;
1334 length = fixnum_value(vector->length);
1335 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1341 trans_vector_unsigned_byte_4(lispobj object)
1343 struct vector *vector;
1346 gc_assert(is_lisp_pointer(object));
1348 vector = (struct vector *) native_pointer(object);
1349 length = fixnum_value(vector->length);
1350 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1352 return copy_object(object, nwords);
1356 size_vector_unsigned_byte_4(lispobj *where)
1358 struct vector *vector;
1361 vector = (struct vector *) where;
1362 length = fixnum_value(vector->length);
1363 nwords = CEILING(NWORDS(length, 8) + 2, 2);
1370 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
1372 struct vector *vector;
1375 vector = (struct vector *) where;
1376 length = fixnum_value(vector->length);
1377 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1383 trans_vector_unsigned_byte_8(lispobj object)
1385 struct vector *vector;
1388 gc_assert(is_lisp_pointer(object));
1390 vector = (struct vector *) native_pointer(object);
1391 length = fixnum_value(vector->length);
1392 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1394 return copy_object(object, nwords);
1398 size_vector_unsigned_byte_8(lispobj *where)
1400 struct vector *vector;
1403 vector = (struct vector *) where;
1404 length = fixnum_value(vector->length);
1405 nwords = CEILING(NWORDS(length, 4) + 2, 2);
1412 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1414 struct vector *vector;
1417 vector = (struct vector *) where;
1418 length = fixnum_value(vector->length);
1419 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1425 trans_vector_unsigned_byte_16(lispobj object)
1427 struct vector *vector;
1430 gc_assert(is_lisp_pointer(object));
1432 vector = (struct vector *) native_pointer(object);
1433 length = fixnum_value(vector->length);
1434 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1436 return copy_object(object, nwords);
1440 size_vector_unsigned_byte_16(lispobj *where)
1442 struct vector *vector;
1445 vector = (struct vector *) where;
1446 length = fixnum_value(vector->length);
1447 nwords = CEILING(NWORDS(length, 2) + 2, 2);
1454 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1456 struct vector *vector;
1459 vector = (struct vector *) where;
1460 length = fixnum_value(vector->length);
1461 nwords = CEILING(length + 2, 2);
1467 trans_vector_unsigned_byte_32(lispobj object)
1469 struct vector *vector;
1472 gc_assert(is_lisp_pointer(object));
1474 vector = (struct vector *) native_pointer(object);
1475 length = fixnum_value(vector->length);
1476 nwords = CEILING(length + 2, 2);
1478 return copy_object(object, nwords);
1482 size_vector_unsigned_byte_32(lispobj *where)
1484 struct vector *vector;
1487 vector = (struct vector *) where;
1488 length = fixnum_value(vector->length);
1489 nwords = CEILING(length + 2, 2);
1496 scav_vector_single_float(lispobj *where, lispobj object)
1498 struct vector *vector;
1501 vector = (struct vector *) where;
1502 length = fixnum_value(vector->length);
1503 nwords = CEILING(length + 2, 2);
1509 trans_vector_single_float(lispobj object)
1511 struct vector *vector;
1514 gc_assert(is_lisp_pointer(object));
1516 vector = (struct vector *) native_pointer(object);
1517 length = fixnum_value(vector->length);
1518 nwords = CEILING(length + 2, 2);
1520 return copy_object(object, nwords);
1524 size_vector_single_float(lispobj *where)
1526 struct vector *vector;
1529 vector = (struct vector *) where;
1530 length = fixnum_value(vector->length);
1531 nwords = CEILING(length + 2, 2);
1538 scav_vector_double_float(lispobj *where, lispobj object)
1540 struct vector *vector;
1543 vector = (struct vector *) where;
1544 length = fixnum_value(vector->length);
1545 nwords = CEILING(length * 2 + 2, 2);
1551 trans_vector_double_float(lispobj object)
1553 struct vector *vector;
1556 gc_assert(is_lisp_pointer(object));
1558 vector = (struct vector *) native_pointer(object);
1559 length = fixnum_value(vector->length);
1560 nwords = CEILING(length * 2 + 2, 2);
1562 return copy_object(object, nwords);
1566 size_vector_double_float(lispobj *where)
1568 struct vector *vector;
1571 vector = (struct vector *) where;
1572 length = fixnum_value(vector->length);
1573 nwords = CEILING(length * 2 + 2, 2);
1579 #ifdef type_SimpleArrayLongFloat
1581 scav_vector_long_float(lispobj *where, lispobj object)
1583 struct vector *vector;
1586 vector = (struct vector *) where;
1587 length = fixnum_value(vector->length);
1589 nwords = CEILING(length * 4 + 2, 2);
1596 trans_vector_long_float(lispobj object)
1598 struct vector *vector;
1601 gc_assert(is_lisp_pointer(object));
1603 vector = (struct vector *) native_pointer(object);
1604 length = fixnum_value(vector->length);
1606 nwords = CEILING(length * 4 + 2, 2);
1609 return copy_object(object, nwords);
1613 size_vector_long_float(lispobj *where)
1615 struct vector *vector;
1618 vector = (struct vector *) where;
1619 length = fixnum_value(vector->length);
1621 nwords = CEILING(length * 4 + 2, 2);
1629 #ifdef type_SimpleArrayComplexSingleFloat
1631 scav_vector_complex_single_float(lispobj *where, lispobj object)
1633 struct vector *vector;
1636 vector = (struct vector *) where;
1637 length = fixnum_value(vector->length);
1638 nwords = CEILING(length * 2 + 2, 2);
1644 trans_vector_complex_single_float(lispobj object)
1646 struct vector *vector;
1649 gc_assert(is_lisp_pointer(object));
1651 vector = (struct vector *) native_pointer(object);
1652 length = fixnum_value(vector->length);
1653 nwords = CEILING(length * 2 + 2, 2);
1655 return copy_object(object, nwords);
1659 size_vector_complex_single_float(lispobj *where)
1661 struct vector *vector;
1664 vector = (struct vector *) where;
1665 length = fixnum_value(vector->length);
1666 nwords = CEILING(length * 2 + 2, 2);
1672 #ifdef type_SimpleArrayComplexDoubleFloat
1674 scav_vector_complex_double_float(lispobj *where, lispobj object)
1676 struct vector *vector;
1679 vector = (struct vector *) where;
1680 length = fixnum_value(vector->length);
1681 nwords = CEILING(length * 4 + 2, 2);
1687 trans_vector_complex_double_float(lispobj object)
1689 struct vector *vector;
1692 gc_assert(is_lisp_pointer(object));
1694 vector = (struct vector *) native_pointer(object);
1695 length = fixnum_value(vector->length);
1696 nwords = CEILING(length * 4 + 2, 2);
1698 return copy_object(object, nwords);
1702 size_vector_complex_double_float(lispobj *where)
1704 struct vector *vector;
1707 vector = (struct vector *) where;
1708 length = fixnum_value(vector->length);
1709 nwords = CEILING(length * 4 + 2, 2);
1715 #ifdef type_SimpleArrayComplexLongFloat
1717 scav_vector_complex_long_float(lispobj *where, lispobj object)
1719 struct vector *vector;
1722 vector = (struct vector *) where;
1723 length = fixnum_value(vector->length);
1725 nwords = CEILING(length * 8 + 2, 2);
1732 trans_vector_complex_long_float(lispobj object)
1734 struct vector *vector;
1737 gc_assert(is_lisp_pointer(object));
1739 vector = (struct vector *) native_pointer(object);
1740 length = fixnum_value(vector->length);
1742 nwords = CEILING(length * 8 + 2, 2);
1745 return copy_object(object, nwords);
1749 size_vector_complex_long_float(lispobj *where)
1751 struct vector *vector;
1754 vector = (struct vector *) where;
1755 length = fixnum_value(vector->length);
1757 nwords = CEILING(length * 8 + 2, 2);
1767 #define WEAK_POINTER_NWORDS \
1768 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1771 scav_weak_pointer(lispobj *where, lispobj object)
1773 /* Do not let GC scavenge the value slot of the weak pointer */
1774 /* (that is why it is a weak pointer). Note: we could use */
1775 /* the scav_unboxed method here. */
1777 return WEAK_POINTER_NWORDS;
1781 trans_weak_pointer(lispobj object)
1784 struct weak_pointer *wp;
1786 gc_assert(is_lisp_pointer(object));
1788 #if defined(DEBUG_WEAK)
1789 printf("Transporting weak pointer from 0x%08x\n", object);
1792 /* Need to remember where all the weak pointers are that have */
1793 /* been transported so they can be fixed up in a post-GC pass. */
1795 copy = copy_object(object, WEAK_POINTER_NWORDS);
1796 wp = (struct weak_pointer *) native_pointer(copy);
1799 /* Push the weak pointer onto the list of weak pointers. */
1800 wp->next = LOW_WORD(weak_pointers);
1807 size_weak_pointer(lispobj *where)
1809 return WEAK_POINTER_NWORDS;
1812 void scan_weak_pointers(void)
1814 struct weak_pointer *wp;
1816 for (wp = weak_pointers; wp != (struct weak_pointer *) NULL;
1817 wp = (struct weak_pointer *)((unsigned long)wp->next)) {
1819 lispobj first, *first_pointer;
1823 #if defined(DEBUG_WEAK)
1824 printf("Weak pointer at 0x%p\n", wp);
1825 printf("Value: 0x%08x\n", (unsigned int) value);
1828 if (!(is_lisp_pointer(value) && from_space_p(value)))
1831 /* Now, we need to check if the object has been */
1832 /* forwarded. If it has been, the weak pointer is */
1833 /* still good and needs to be updated. Otherwise, the */
1834 /* weak pointer needs to be nil'ed out. */
1836 first_pointer = (lispobj *) native_pointer(value);
1837 first = *first_pointer;
1839 #if defined(DEBUG_WEAK)
1840 printf("First: 0x%08x\n", (unsigned long) first);
1843 if (is_lisp_pointer(first) && new_space_p(first))
1854 /* initialization */
1857 scav_lose(lispobj *where, lispobj object)
1859 fprintf(stderr, "GC lossage. No scavenge function for object 0x%08x (at 0x%016lx)\n",
1860 (unsigned int) object, (unsigned long)where);
1866 trans_lose(lispobj object)
1868 fprintf(stderr, "GC lossage. No transport function for object 0x%08x\n",
1869 (unsigned int)object);
1875 size_lose(lispobj *where)
1877 fprintf(stderr, "Size lossage. No size function for object at 0x%p\n",
1879 fprintf(stderr, "First word of object: 0x%08x\n",
1884 /* KLUDGE: SBCL already has two GC implementations, and if someday the
1885 * precise generational GC is revived, it might have three. It would
1886 * be nice to share the scavtab[] data set up here, and perhaps other
1887 * things too, between all of them, rather than trying to maintain
1888 * multiple copies. -- WHN 2001-05-09 */
1894 /* scavenge table */
1895 for (i = 0; i < 256; i++)
1896 scavtab[i] = scav_lose;
1897 /* scavtab[i] = scav_immediate; */
1899 for (i = 0; i < 32; i++) {
1900 scavtab[type_EvenFixnum|(i<<3)] = scav_immediate;
1901 scavtab[type_FunctionPointer|(i<<3)] = scav_function_pointer;
1902 /* OtherImmediate0 */
1903 scavtab[type_ListPointer|(i<<3)] = scav_list_pointer;
1904 scavtab[type_OddFixnum|(i<<3)] = scav_immediate;
1905 scavtab[type_InstancePointer|(i<<3)] = scav_instance_pointer;
1906 /* OtherImmediate1 */
1907 scavtab[type_OtherPointer|(i<<3)] = scav_other_pointer;
1910 scavtab[type_Bignum] = scav_unboxed;
1911 scavtab[type_Ratio] = scav_boxed;
1912 scavtab[type_SingleFloat] = scav_unboxed;
1913 scavtab[type_DoubleFloat] = scav_unboxed;
1914 #ifdef type_LongFloat
1915 scavtab[type_LongFloat] = scav_unboxed;
1917 scavtab[type_Complex] = scav_boxed;
1918 #ifdef type_ComplexSingleFloat
1919 scavtab[type_ComplexSingleFloat] = scav_unboxed;
1921 #ifdef type_ComplexDoubleFloat
1922 scavtab[type_ComplexDoubleFloat] = scav_unboxed;
1924 #ifdef type_ComplexLongFloat
1925 scavtab[type_ComplexLongFloat] = scav_unboxed;
1927 scavtab[type_SimpleArray] = scav_boxed;
1928 scavtab[type_SimpleString] = scav_string;
1929 scavtab[type_SimpleBitVector] = scav_vector_bit;
1930 scavtab[type_SimpleVector] = scav_vector;
1931 scavtab[type_SimpleArrayUnsignedByte2] = scav_vector_unsigned_byte_2;
1932 scavtab[type_SimpleArrayUnsignedByte4] = scav_vector_unsigned_byte_4;
1933 scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8;
1934 scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16;
1935 scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32;
1936 #ifdef type_SimpleArraySignedByte8
1937 scavtab[type_SimpleArraySignedByte8] = scav_vector_unsigned_byte_8;
1939 #ifdef type_SimpleArraySignedByte16
1940 scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16;
1942 #ifdef type_SimpleArraySignedByte30
1943 scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32;
1945 #ifdef type_SimpleArraySignedByte32
1946 scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32;
1948 scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float;
1949 scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float;
1950 #ifdef type_SimpleArrayLongFloat
1951 scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float;
1953 #ifdef type_SimpleArrayComplexSingleFloat
1954 scavtab[type_SimpleArrayComplexSingleFloat] = scav_vector_complex_single_float;
1956 #ifdef type_SimpleArrayComplexDoubleFloat
1957 scavtab[type_SimpleArrayComplexDoubleFloat] = scav_vector_complex_double_float;
1959 #ifdef type_SimpleArrayComplexLongFloat
1960 scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float;
1962 scavtab[type_ComplexString] = scav_boxed;
1963 scavtab[type_ComplexBitVector] = scav_boxed;
1964 scavtab[type_ComplexVector] = scav_boxed;
1965 scavtab[type_ComplexArray] = scav_boxed;
1966 scavtab[type_CodeHeader] = scav_code_header;
1967 scavtab[type_FunctionHeader] = scav_function_header;
1968 scavtab[type_ClosureFunctionHeader] = scav_function_header;
1969 scavtab[type_ReturnPcHeader] = scav_return_pc_header;
1971 scavtab[type_ClosureHeader] = scav_closure_header;
1972 scavtab[type_FuncallableInstanceHeader] = scav_closure_header;
1973 scavtab[type_ByteCodeFunction] = scav_closure_header;
1974 scavtab[type_ByteCodeClosure] = scav_closure_header;
1975 /* scavtab[type_DylanFunctionHeader] = scav_closure_header; */
1977 scavtab[type_ClosureHeader] = scav_boxed;
1978 scavtab[type_FuncallableInstanceHeader] = scav_boxed;
1979 scavtab[type_ByteCodeFunction] = scav_boxed;
1980 scavtab[type_ByteCodeClosure] = scav_boxed;
1981 /* scavtab[type_DylanFunctionHeader] = scav_boxed; */
1983 scavtab[type_ValueCellHeader] = scav_boxed;
1984 scavtab[type_SymbolHeader] = scav_boxed;
1985 scavtab[type_BaseChar] = scav_immediate;
1986 scavtab[type_Sap] = scav_unboxed;
1987 scavtab[type_UnboundMarker] = scav_immediate;
1988 scavtab[type_WeakPointer] = scav_weak_pointer;
1989 scavtab[type_InstanceHeader] = scav_boxed;
1991 scavtab[type_Fdefn] = scav_fdefn;
1993 scavtab[type_Fdefn] = scav_boxed;
1996 /* Transport Other Table */
1997 for (i = 0; i < 256; i++)
1998 transother[i] = trans_lose;
2000 transother[type_Bignum] = trans_unboxed;
2001 transother[type_Ratio] = trans_boxed;
2002 transother[type_SingleFloat] = trans_unboxed;
2003 transother[type_DoubleFloat] = trans_unboxed;
2004 #ifdef type_LongFloat
2005 transother[type_LongFloat] = trans_unboxed;
2007 transother[type_Complex] = trans_boxed;
2008 #ifdef type_ComplexSingleFloat
2009 transother[type_ComplexSingleFloat] = trans_unboxed;
2011 #ifdef type_ComplexDoubleFloat
2012 transother[type_ComplexDoubleFloat] = trans_unboxed;
2014 #ifdef type_ComplexLongFloat
2015 transother[type_ComplexLongFloat] = trans_unboxed;
2017 transother[type_SimpleArray] = trans_boxed;
2018 transother[type_SimpleString] = trans_string;
2019 transother[type_SimpleBitVector] = trans_vector_bit;
2020 transother[type_SimpleVector] = trans_vector;
2021 transother[type_SimpleArrayUnsignedByte2] = trans_vector_unsigned_byte_2;
2022 transother[type_SimpleArrayUnsignedByte4] = trans_vector_unsigned_byte_4;
2023 transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8;
2024 transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16;
2025 transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32;
2026 #ifdef type_SimpleArraySignedByte8
2027 transother[type_SimpleArraySignedByte8] = trans_vector_unsigned_byte_8;
2029 #ifdef type_SimpleArraySignedByte16
2030 transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16;
2032 #ifdef type_SimpleArraySignedByte30
2033 transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32;
2035 #ifdef type_SimpleArraySignedByte32
2036 transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32;
2038 transother[type_SimpleArraySingleFloat] = trans_vector_single_float;
2039 transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float;
2040 #ifdef type_SimpleArrayLongFloat
2041 transother[type_SimpleArrayLongFloat] = trans_vector_long_float;
2043 #ifdef type_SimpleArrayComplexSingleFloat
2044 transother[type_SimpleArrayComplexSingleFloat] = trans_vector_complex_single_float;
2046 #ifdef type_SimpleArrayComplexDoubleFloat
2047 transother[type_SimpleArrayComplexDoubleFloat] = trans_vector_complex_double_float;
2049 #ifdef type_SimpleArrayComplexLongFloat
2050 transother[type_SimpleArrayComplexLongFloat] = trans_vector_complex_long_float;
2052 transother[type_ComplexString] = trans_boxed;
2053 transother[type_ComplexBitVector] = trans_boxed;
2054 transother[type_ComplexVector] = trans_boxed;
2055 transother[type_ComplexArray] = trans_boxed;
2056 transother[type_CodeHeader] = trans_code_header;
2057 transother[type_FunctionHeader] = trans_function_header;
2058 transother[type_ClosureFunctionHeader] = trans_function_header;
2059 transother[type_ReturnPcHeader] = trans_return_pc_header;
2060 transother[type_ClosureHeader] = trans_boxed;
2061 transother[type_FuncallableInstanceHeader] = trans_boxed;
2062 transother[type_ByteCodeFunction] = trans_boxed;
2063 transother[type_ByteCodeClosure] = trans_boxed;
2064 transother[type_ValueCellHeader] = trans_boxed;
2065 transother[type_SymbolHeader] = trans_boxed;
2066 transother[type_BaseChar] = trans_immediate;
2067 transother[type_Sap] = trans_unboxed;
2068 transother[type_UnboundMarker] = trans_immediate;
2069 transother[type_WeakPointer] = trans_weak_pointer;
2070 transother[type_InstanceHeader] = trans_boxed;
2071 transother[type_Fdefn] = trans_boxed;
2075 for (i = 0; i < 256; i++)
2076 sizetab[i] = size_lose;
2078 for (i = 0; i < 32; i++) {
2079 sizetab[type_EvenFixnum|(i<<3)] = size_immediate;
2080 sizetab[type_FunctionPointer|(i<<3)] = size_pointer;
2081 /* OtherImmediate0 */
2082 sizetab[type_ListPointer|(i<<3)] = size_pointer;
2083 sizetab[type_OddFixnum|(i<<3)] = size_immediate;
2084 sizetab[type_InstancePointer|(i<<3)] = size_pointer;
2085 /* OtherImmediate1 */
2086 sizetab[type_OtherPointer|(i<<3)] = size_pointer;
2089 sizetab[type_Bignum] = size_unboxed;
2090 sizetab[type_Ratio] = size_boxed;
2091 sizetab[type_SingleFloat] = size_unboxed;
2092 sizetab[type_DoubleFloat] = size_unboxed;
2093 #ifdef type_LongFloat
2094 sizetab[type_LongFloat] = size_unboxed;
2096 sizetab[type_Complex] = size_boxed;
2097 #ifdef type_ComplexSingleFloat
2098 sizetab[type_ComplexSingleFloat] = size_unboxed;
2100 #ifdef type_ComplexDoubleFloat
2101 sizetab[type_ComplexDoubleFloat] = size_unboxed;
2103 #ifdef type_ComplexLongFloat
2104 sizetab[type_ComplexLongFloat] = size_unboxed;
2106 sizetab[type_SimpleArray] = size_boxed;
2107 sizetab[type_SimpleString] = size_string;
2108 sizetab[type_SimpleBitVector] = size_vector_bit;
2109 sizetab[type_SimpleVector] = size_vector;
2110 sizetab[type_SimpleArrayUnsignedByte2] = size_vector_unsigned_byte_2;
2111 sizetab[type_SimpleArrayUnsignedByte4] = size_vector_unsigned_byte_4;
2112 sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8;
2113 sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16;
2114 sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32;
2115 #ifdef type_SimpleArraySignedByte8
2116 sizetab[type_SimpleArraySignedByte8] = size_vector_unsigned_byte_8;
2118 #ifdef type_SimpleArraySignedByte16
2119 sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16;
2121 #ifdef type_SimpleArraySignedByte30
2122 sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32;
2124 #ifdef type_SimpleArraySignedByte32
2125 sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32;
2127 sizetab[type_SimpleArraySingleFloat] = size_vector_single_float;
2128 sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float;
2129 #ifdef type_SimpleArrayLongFloat
2130 sizetab[type_SimpleArrayLongFloat] = size_vector_long_float;
2132 #ifdef type_SimpleArrayComplexSingleFloat
2133 sizetab[type_SimpleArrayComplexSingleFloat] = size_vector_complex_single_float;
2135 #ifdef type_SimpleArrayComplexDoubleFloat
2136 sizetab[type_SimpleArrayComplexDoubleFloat] = size_vector_complex_double_float;
2138 #ifdef type_SimpleArrayComplexLongFloat
2139 sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float;
2141 sizetab[type_ComplexString] = size_boxed;
2142 sizetab[type_ComplexBitVector] = size_boxed;
2143 sizetab[type_ComplexVector] = size_boxed;
2144 sizetab[type_ComplexArray] = size_boxed;
2145 sizetab[type_CodeHeader] = size_code_header;
2147 /* Shouldn't see these so just lose if it happens */
2148 sizetab[type_FunctionHeader] = size_function_header;
2149 sizetab[type_ClosureFunctionHeader] = size_function_header;
2150 sizetab[type_ReturnPcHeader] = size_return_pc_header;
2152 sizetab[type_ClosureHeader] = size_boxed;
2153 sizetab[type_FuncallableInstanceHeader] = size_boxed;
2154 sizetab[type_ValueCellHeader] = size_boxed;
2155 sizetab[type_SymbolHeader] = size_boxed;
2156 sizetab[type_BaseChar] = size_immediate;
2157 sizetab[type_Sap] = size_unboxed;
2158 sizetab[type_UnboundMarker] = size_immediate;
2159 sizetab[type_WeakPointer] = size_weak_pointer;
2160 sizetab[type_InstanceHeader] = size_boxed;
2161 sizetab[type_Fdefn] = size_boxed;
2164 /* noise to manipulate the gc trigger stuff */
2166 void set_auto_gc_trigger(os_vm_size_t dynamic_usage)
2168 os_vm_address_t addr=(os_vm_address_t)current_dynamic_space +
2171 DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
2173 if(addr < (os_vm_address_t)dynamic_space_free_pointer) {
2175 "set_auto_gc_trigger: tried to set gc trigger too low! (%d < %p)\n",
2176 (unsigned int)dynamic_usage,
2177 (os_vm_address_t)dynamic_space_free_pointer
2178 - (os_vm_address_t)current_dynamic_space);
2181 else if (length < 0) {
2183 "set_auto_gc_trigger: tried to set gc trigger too high! (%p)\n",
2188 addr=os_round_up_to_page(addr);
2189 length=os_trunc_size_to_page(length);
2191 #if defined(SUNOS) || defined(SOLARIS)
2192 os_invalidate(addr,length);
2194 os_protect(addr, length, 0);
2197 current_auto_gc_trigger = (lispobj *)addr;
2200 void clear_auto_gc_trigger(void)
2202 if(current_auto_gc_trigger!=NULL){
2203 #if defined(SUNOS) || defined(SOLARIS)/* don't want to force whole space into swapping mode... */
2204 os_vm_address_t addr=(os_vm_address_t)current_auto_gc_trigger;
2205 os_vm_size_t length=
2206 DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
2208 os_validate(addr,length);
2210 os_protect((os_vm_address_t)current_dynamic_space,
2215 current_auto_gc_trigger = NULL;