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>
24 #include "gc-internal.h"
26 #include "interrupt.h"
30 #include "genesis/static-symbols.h"
31 #include "genesis/primitive-objects.h"
35 /* So you need to debug? */
38 #define DEBUG_SPACE_PREDICATES
39 #define DEBUG_SCAVENGE_VERBOSE
40 #define DEBUG_COPY_VERBOSE
45 lispobj
*from_space_free_pointer
;
48 lispobj
*new_space_free_pointer
;
50 static void scavenge_newspace(void);
53 /* collecting garbage */
57 tv_diff(struct timeval
*x
, struct timeval
*y
)
59 return (((double) x
->tv_sec
+ (double) x
->tv_usec
* 1.0e-6) -
60 ((double) y
->tv_sec
+ (double) y
->tv_usec
* 1.0e-6));
65 gc_general_alloc(long bytes
, int page_type_flag
, int quick_p
) {
66 lispobj
*new=new_space_free_pointer
;
67 new_space_free_pointer
+=(bytes
/N_WORD_BYTES
);
71 lispobj
copy_large_unboxed_object(lispobj object
, long nwords
) {
72 return copy_object(object
,nwords
);
74 lispobj
copy_unboxed_object(lispobj object
, long nwords
) {
75 return copy_object(object
,nwords
);
77 lispobj
copy_large_object(lispobj object
, long nwords
) {
78 return copy_object(object
,nwords
);
81 /* Note: The generic GC interface we're implementing passes us a
82 * last_generation argument. That's meaningless for us, since we're
83 * not a generational GC. So we ignore it. */
85 collect_garbage(generation_index_t ignore
)
88 struct timeval start_tv
, stop_tv
;
89 struct rusage start_rusage
, stop_rusage
;
90 double real_time
, system_time
, user_time
;
91 double percent_retained
, gc_rate
;
92 unsigned long size_discarded
;
94 unsigned long size_retained
;
95 lispobj
*current_static_space_free_pointer
;
96 unsigned long static_space_size
;
97 unsigned long control_stack_size
, binding_stack_size
;
99 struct thread
*th
=arch_os_get_current_thread();
102 printf("[Collecting garbage ... \n");
104 getrusage(RUSAGE_SELF
, &start_rusage
);
105 gettimeofday(&start_tv
, (struct timezone
*) 0);
108 /* it's possible that signals are blocked already if this was called
109 * from a signal handler (e.g. with the sigsegv gc_trigger stuff) */
110 block_blockable_signals(0, &old
);
112 current_static_space_free_pointer
=
113 (lispobj
*) ((unsigned long)
114 SymbolValue(STATIC_SPACE_FREE_POINTER
,0));
117 /* Set up from space and new space pointers. */
119 from_space
= current_dynamic_space
;
120 from_space_free_pointer
= dynamic_space_free_pointer
;
123 fprintf(stderr
,"from_space = %lx\n",
124 (unsigned long) current_dynamic_space
);
126 if (current_dynamic_space
== (lispobj
*) DYNAMIC_0_SPACE_START
)
127 new_space
= (lispobj
*)DYNAMIC_1_SPACE_START
;
128 else if (current_dynamic_space
== (lispobj
*) DYNAMIC_1_SPACE_START
)
129 new_space
= (lispobj
*) DYNAMIC_0_SPACE_START
;
131 lose("GC lossage. Current dynamic space is bogus!\n");
133 new_space_free_pointer
= new_space
;
135 /* Initialize the weak pointer list. */
136 weak_pointers
= (struct weak_pointer
*) NULL
;
139 /* Scavenge all of the roots. */
141 printf("Scavenging interrupt contexts ...\n");
143 scavenge_interrupt_contexts();
146 printf("Scavenging interrupt handlers (%d bytes) ...\n",
147 (int)sizeof(interrupt_handlers
));
149 scavenge((lispobj
*) interrupt_handlers
,
150 sizeof(interrupt_handlers
) / sizeof(lispobj
));
152 /* _size quantities are in units of sizeof(lispobj) - i.e. 4 */
154 current_control_stack_pointer
-
155 (lispobj
*)th
->control_stack_start
;
157 printf("Scavenging the control stack at %p (%ld words) ...\n",
158 ((lispobj
*)th
->control_stack_start
),
161 scavenge(((lispobj
*)th
->control_stack_start
), control_stack_size
);
165 current_binding_stack_pointer
-
166 (lispobj
*)th
->binding_stack_start
;
168 printf("Scavenging the binding stack %x - %x (%d words) ...\n",
169 th
->binding_stack_start
,current_binding_stack_pointer
,
170 (int)(binding_stack_size
));
172 scavenge(((lispobj
*)th
->binding_stack_start
), binding_stack_size
);
175 current_static_space_free_pointer
- (lispobj
*) STATIC_SPACE_START
;
177 printf("Scavenging static space %x - %x (%d words) ...\n",
178 STATIC_SPACE_START
,current_static_space_free_pointer
,
179 (int)(static_space_size
));
181 scavenge(((lispobj
*)STATIC_SPACE_START
), static_space_size
);
183 /* Scavenge newspace. */
185 printf("Scavenging new space (%d bytes) ...\n",
186 (int)((new_space_free_pointer
- new_space
) * sizeof(lispobj
)));
191 #if defined(DEBUG_PRINT_GARBAGE)
192 print_garbage(from_space
, from_space_free_pointer
);
195 /* Scan the weak pointers. */
197 printf("Scanning weak hash tables ...\n");
199 scan_weak_hash_tables();
201 /* Scan the weak pointers. */
203 printf("Scanning weak pointers ...\n");
205 scan_weak_pointers();
209 printf("Flipping spaces ...\n");
212 /* Maybe FIXME: it's possible that we could significantly reduce
213 * RSS by zeroing the from_space or madvise(MADV_DONTNEED) or
214 * similar os-dependent tricks here */
215 #ifdef LISP_FEATURE_HPUX
216 /* hpux cant handle unmapping areas that are not 100% mapped */
217 clear_auto_gc_trigger();
219 os_zero((os_vm_address_t
) from_space
,
220 (os_vm_size_t
) dynamic_space_size
);
222 current_dynamic_space
= new_space
;
223 dynamic_space_free_pointer
= new_space_free_pointer
;
226 size_discarded
= (from_space_free_pointer
- from_space
) * sizeof(lispobj
);
228 size_retained
= (new_space_free_pointer
- new_space
) * sizeof(lispobj
);
230 os_flush_icache((os_vm_address_t
)new_space
, size_retained
);
234 printf("Zeroing empty part of control stack ...\n");
236 scrub_control_stack();
237 set_auto_gc_trigger(size_retained
+bytes_consed_between_gcs
);
238 thread_sigmask(SIG_SETMASK
, &old
, 0);
242 gettimeofday(&stop_tv
, (struct timezone
*) 0);
243 getrusage(RUSAGE_SELF
, &stop_rusage
);
247 percent_retained
= (((float) size_retained
) /
248 ((float) size_discarded
)) * 100.0;
250 printf("Total of %ld bytes out of %ld bytes retained (%3.2f%%).\n",
251 size_retained
, size_discarded
, percent_retained
);
253 real_time
= tv_diff(&stop_tv
, &start_tv
);
254 user_time
= tv_diff(&stop_rusage
.ru_utime
, &start_rusage
.ru_utime
);
255 system_time
= tv_diff(&stop_rusage
.ru_stime
, &start_rusage
.ru_stime
);
257 printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n",
258 real_time
, user_time
, system_time
);
260 gc_rate
= ((float) size_retained
/ (float) (1<<20)) / real_time
;
262 printf("%10.2f M bytes/sec collected.\n", gc_rate
);
270 scavenge_newspace(void)
272 lispobj
*here
, *next
;
275 while (here
< new_space_free_pointer
) {
276 /* printf("here=%lx, new_space_free_pointer=%lx\n",
277 here,new_space_free_pointer); */
278 next
= new_space_free_pointer
;
279 scavenge(here
, next
- here
);
280 scav_weak_hash_tables();
283 /* printf("done with newspace\n"); */
286 /* scavenging interrupt contexts */
288 static int boxed_registers
[] = BOXED_REGISTERS
;
291 scavenge_interrupt_context(os_context_t
*context
)
296 unsigned long lip_offset
;
297 int lip_register_pair
;
299 unsigned long pc_code_offset
;
300 #ifdef ARCH_HAS_LINK_REGISTER
301 unsigned long lr_code_offset
;
303 #ifdef ARCH_HAS_NPC_REGISTER
304 unsigned long npc_code_offset
;
306 #ifdef DEBUG_SCAVENGE_VERBOSE
307 fprintf(stderr
, "Scavenging interrupt context at 0x%x\n",context
);
309 /* Find the LIP's register pair and calculate its offset */
310 /* before we scavenge the context. */
312 lip
= *os_context_register_addr(context
, reg_LIP
);
313 /* 0x7FFFFFFF on 32-bit platforms;
314 0x7FFFFFFFFFFFFFFF on 64-bit platforms */
315 lip_offset
= (((unsigned long)1) << (N_WORD_BITS
- 1)) - 1;
316 lip_register_pair
= -1;
317 for (i
= 0; i
< (int)(sizeof(boxed_registers
) / sizeof(int)); i
++) {
319 unsigned long offset
;
322 index
= boxed_registers
[i
];
323 reg
= *os_context_register_addr(context
, index
);
324 /* would be using PTR if not for integer length issues */
325 if ((reg
& ~((1L<<N_LOWTAG_BITS
)-1)) <= lip
) {
327 if (offset
< lip_offset
) {
329 lip_register_pair
= index
;
335 /* Compute the PC's offset from the start of the CODE */
338 *os_context_pc_addr(context
) -
339 *os_context_register_addr(context
, reg_CODE
);
340 #ifdef ARCH_HAS_NPC_REGISTER
342 *os_context_npc_addr(context
) -
343 *os_context_register_addr(context
, reg_CODE
);
345 #ifdef ARCH_HAS_LINK_REGISTER
347 *os_context_lr_addr(context
) -
348 *os_context_register_addr(context
, reg_CODE
);
351 /* Scavenge all boxed registers in the context. */
352 for (i
= 0; i
< (int)(sizeof(boxed_registers
) / sizeof(int)); i
++) {
356 index
= boxed_registers
[i
];
357 foo
= *os_context_register_addr(context
,index
);
358 scavenge((lispobj
*) &foo
, 1);
359 *os_context_register_addr(context
,index
) = foo
;
361 /* this is unlikely to work as intended on bigendian
362 * 64 bit platforms */
365 os_context_register_addr(context
, index
), 1);
370 *os_context_register_addr(context
, reg_LIP
) =
371 *os_context_register_addr(context
, lip_register_pair
) + lip_offset
;
374 /* Fix the PC if it was in from space */
375 if (from_space_p(*os_context_pc_addr(context
)))
376 *os_context_pc_addr(context
) =
377 *os_context_register_addr(context
, reg_CODE
) + pc_code_offset
;
378 #ifdef ARCH_HAS_LINK_REGISTER
379 /* Fix the LR ditto; important if we're being called from
380 * an assembly routine that expects to return using blr, otherwise
382 if (from_space_p(*os_context_lr_addr(context
)))
383 *os_context_lr_addr(context
) =
384 *os_context_register_addr(context
, reg_CODE
) + lr_code_offset
;
387 #ifdef ARCH_HAS_NPC_REGISTER
388 if (from_space_p(*os_context_npc_addr(context
)))
389 *os_context_npc_addr(context
) =
390 *os_context_register_addr(context
, reg_CODE
) + npc_code_offset
;
394 void scavenge_interrupt_contexts(void)
397 os_context_t
*context
;
399 struct thread
*th
=arch_os_get_current_thread();
401 index
= fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX
,0));
404 #ifdef DEBUG_SCAVENGE_VERBOSE
405 fprintf(stderr
, "%d interrupt contexts to scan\n",index
);
407 for (i
= 0; i
< index
; i
++) {
408 context
= th
->interrupt_contexts
[i
];
409 scavenge_interrupt_context(context
);
417 print_garbage(lispobj
*from_space
, lispobj
*from_space_free_pointer
)
420 int total_words_not_copied
;
422 printf("Scanning from space ...\n");
424 total_words_not_copied
= 0;
426 while (start
< from_space_free_pointer
) {
428 int forwardp
, type
, nwords
;
432 forwardp
= is_lisp_pointer(object
) && new_space_p(object
);
438 tag
= lowtag_of(object
);
441 case LIST_POINTER_LOWTAG
:
444 case INSTANCE_POINTER_LOWTAG
:
445 printf("Don't know about instances yet!\n");
448 case FUN_POINTER_LOWTAG
:
451 case OTHER_POINTER_LOWTAG
:
452 pointer
= (lispobj
*) native_pointer(object
);
454 type
= widetag_of(header
);
455 nwords
= (sizetab
[type
])(pointer
);
457 default: nwords
=1; /* shut yer whinging, gcc */
460 type
= widetag_of(object
);
461 nwords
= (sizetab
[type
])(start
);
462 total_words_not_copied
+= nwords
;
463 printf("%4d words not copied at 0x%16lx; ",
464 nwords
, (unsigned long) start
);
465 printf("Header word is 0x%08x\n",
466 (unsigned int) object
);
470 printf("%d total words not copied.\n", total_words_not_copied
);
476 #define WEAK_POINTER_NWORDS \
477 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
480 scav_weak_pointer(lispobj
*where
, lispobj object
)
482 /* Do not let GC scavenge the value slot of the weak pointer */
483 /* (that is why it is a weak pointer). Note: we could use */
484 /* the scav_unboxed method here. */
486 return WEAK_POINTER_NWORDS
;
490 search_read_only_space(void *pointer
)
492 lispobj
* start
= (lispobj
*)READ_ONLY_SPACE_START
;
493 lispobj
* end
= (lispobj
*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER
,0);
494 if ((pointer
< (void *)start
) || (pointer
>= (void *)end
))
496 return (gc_search_space(start
,
497 (((lispobj
*)pointer
)+2)-start
,
498 (lispobj
*)pointer
));
502 search_static_space(void *pointer
)
504 lispobj
* start
= (lispobj
*)STATIC_SPACE_START
;
505 lispobj
* end
= (lispobj
*)SymbolValue(STATIC_SPACE_FREE_POINTER
,0);
506 if ((pointer
< (void *)start
) || (pointer
>= (void *)end
))
508 return (gc_search_space(start
,
509 (((lispobj
*)pointer
)+2)-start
,
510 (lispobj
*)pointer
));
514 search_dynamic_space(void *pointer
)
516 lispobj
*start
= (lispobj
*) current_dynamic_space
;
517 lispobj
*end
= (lispobj
*) dynamic_space_free_pointer
;
518 if ((pointer
< (void *)start
) || (pointer
>= (void *)end
))
520 return (gc_search_space(start
,
521 (((lispobj
*)pointer
)+2)-start
,
522 (lispobj
*)pointer
));
525 /* initialization. if gc_init can be moved to after core load, we could
526 * combine these two functions */
532 scavtab
[WEAK_POINTER_WIDETAG
] = scav_weak_pointer
;
536 gc_initialize_pointers(void)
538 /* FIXME: We do nothing here. We (briefly) misguidedly attempted
539 to set current_dynamic_space to DYNAMIC_0_SPACE_START here,
540 forgetting that (a) actually it could be the other and (b) it's
541 set in coreparse.c anyway. There's a FIXME note left here to
542 note that current_dynamic_space is a violation of OAOO: we can
543 tell which dynamic space we're currently in by looking at
544 dynamic_space_free_pointer. -- CSR, 2002-08-09 */
550 /* noise to manipulate the gc trigger stuff */
552 /* Functions that substantially change the dynamic space free pointer
553 * (collect_garbage, purify) are responsible also for resetting the
555 void set_auto_gc_trigger(os_vm_size_t dynamic_usage
)
557 os_vm_address_t addr
;
560 addr
= os_round_up_to_page((os_vm_address_t
)current_dynamic_space
562 if (addr
< (os_vm_address_t
)dynamic_space_free_pointer
)
563 lose("set_auto_gc_trigger: tried to set gc trigger too low! (%ld < 0x%08lx)\n",
564 (unsigned long)dynamic_usage
,
565 (unsigned long)((os_vm_address_t
)dynamic_space_free_pointer
566 - (os_vm_address_t
)current_dynamic_space
));
568 length
= os_trunc_size_to_page(dynamic_space_size
- dynamic_usage
);
570 lose("set_auto_gc_trigger: tried to set gc trigger too high! (0x%08lx)\n",
571 (unsigned long)dynamic_usage
);
573 #if defined(SUNOS) || defined(SOLARIS) || defined(LISP_FEATURE_HPUX)
574 os_invalidate(addr
, length
);
576 os_protect(addr
, length
, 0);
579 current_auto_gc_trigger
= (lispobj
*)addr
;
582 void clear_auto_gc_trigger(void)
584 os_vm_address_t addr
;
587 if (current_auto_gc_trigger
== NULL
)
590 addr
= (os_vm_address_t
)current_auto_gc_trigger
;
591 length
= dynamic_space_size
+ (os_vm_address_t
)current_dynamic_space
- addr
;
593 #if defined(SUNOS) || defined(SOLARIS) || defined(LISP_FEATURE_HPUX)
594 /* don't want to force whole space into swapping mode... */
595 os_validate(addr
, length
);
597 os_protect(addr
, length
, OS_VM_PROT_ALL
);
600 current_auto_gc_trigger
= NULL
;
604 gc_trigger_hit(void *addr
)
606 if (current_auto_gc_trigger
== NULL
)
609 return (addr
>= (void *)current_auto_gc_trigger
&&
610 addr
<((void *)current_dynamic_space
+ dynamic_space_size
));
615 cheneygc_handle_wp_violation(os_context_t
*context
, void *addr
)
617 if(!foreign_function_call_active
&& gc_trigger_hit(addr
)){
618 struct thread
*thread
=arch_os_get_current_thread();
619 clear_auto_gc_trigger();
620 /* Don't flood the system with interrupts if the need to gc is
621 * already noted. This can happen for example when SUB-GC
622 * allocates or after a gc triggered in a WITHOUT-GCING. */
623 if (SymbolValue(GC_PENDING
,thread
) == NIL
) {
624 if (SymbolValue(GC_INHIBIT
,thread
) == NIL
) {
625 if (arch_pseudo_atomic_atomic(context
)) {
626 /* set things up so that GC happens when we finish
628 SetSymbolValue(GC_PENDING
,T
,thread
);
629 arch_set_pseudo_atomic_interrupted(context
);
630 maybe_save_gc_mask_and_block_deferrables
631 (os_context_sigmask_addr(context
));
636 SetSymbolValue(GC_PENDING
,T
,thread
);