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(word_t 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
, sword_t nwords
) {
72 return copy_object(object
,nwords
);
74 lispobj
copy_unboxed_object(lispobj object
, sword_t nwords
) {
75 return copy_object(object
,nwords
);
77 lispobj
copy_large_object(lispobj object
, sword_t 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 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(&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(th
);
146 printf("Scavenging interrupt handlers (%d bytes) ...\n",
147 (int)sizeof(interrupt_handlers
));
149 scavenge((lispobj
*) interrupt_handlers
,
150 sizeof(interrupt_handlers
) / sizeof(lispobj
));
153 printf("Scavenging the control stack ...\n");
155 scavenge_control_stack(th
);
159 (lispobj
*)get_binding_stack_pointer(th
) -
160 (lispobj
*)th
->binding_stack_start
;
162 printf("Scavenging the binding stack %x - %x (%d words) ...\n",
163 th
->binding_stack_start
,get_binding_stack_pointer(th
),
164 (int)(binding_stack_size
));
166 scavenge(((lispobj
*)th
->binding_stack_start
), binding_stack_size
);
169 current_static_space_free_pointer
- (lispobj
*) STATIC_SPACE_START
;
171 printf("Scavenging static space %x - %x (%d words) ...\n",
172 STATIC_SPACE_START
,current_static_space_free_pointer
,
173 (int)(static_space_size
));
175 scavenge(((lispobj
*)STATIC_SPACE_START
), static_space_size
);
177 /* Scavenge newspace. */
179 printf("Scavenging new space (%d bytes) ...\n",
180 (int)((new_space_free_pointer
- new_space
) * sizeof(lispobj
)));
185 #if defined(DEBUG_PRINT_GARBAGE)
186 print_garbage(from_space
, from_space_free_pointer
);
189 /* Scan the weak pointers. */
191 printf("Scanning weak hash tables ...\n");
193 scan_weak_hash_tables();
195 /* Scan the weak pointers. */
197 printf("Scanning weak pointers ...\n");
199 scan_weak_pointers();
203 printf("Flipping spaces ...\n");
206 /* Maybe FIXME: it's possible that we could significantly reduce
207 * RSS by zeroing the from_space or madvise(MADV_DONTNEED) or
208 * similar os-dependent tricks here */
209 #ifdef LISP_FEATURE_HPUX
210 /* hpux cant handle unmapping areas that are not 100% mapped */
211 clear_auto_gc_trigger();
213 os_zero((os_vm_address_t
) from_space
,
214 (os_vm_size_t
) dynamic_space_size
);
216 current_dynamic_space
= new_space
;
217 dynamic_space_free_pointer
= new_space_free_pointer
;
220 size_discarded
= (from_space_free_pointer
- from_space
) * sizeof(lispobj
);
222 size_retained
= (new_space_free_pointer
- new_space
) * sizeof(lispobj
);
224 os_flush_icache((os_vm_address_t
)new_space
, size_retained
);
228 printf("Zeroing empty part of control stack ...\n");
230 scrub_control_stack();
231 set_auto_gc_trigger(size_retained
+bytes_consed_between_gcs
);
232 thread_sigmask(SIG_SETMASK
, &old
, 0);
236 gettimeofday(&stop_tv
, (struct timezone
*) 0);
237 getrusage(RUSAGE_SELF
, &stop_rusage
);
241 percent_retained
= (((float) size_retained
) /
242 ((float) size_discarded
)) * 100.0;
244 printf("Total of %ld bytes out of %ld bytes retained (%3.2f%%).\n",
245 size_retained
, size_discarded
, percent_retained
);
247 real_time
= tv_diff(&stop_tv
, &start_tv
);
248 user_time
= tv_diff(&stop_rusage
.ru_utime
, &start_rusage
.ru_utime
);
249 system_time
= tv_diff(&stop_rusage
.ru_stime
, &start_rusage
.ru_stime
);
251 printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n",
252 real_time
, user_time
, system_time
);
254 gc_rate
= ((float) size_retained
/ (float) (1<<20)) / real_time
;
256 printf("%10.2f M bytes/sec collected.\n", gc_rate
);
264 scavenge_newspace(void)
266 lispobj
*here
, *next
;
269 while (here
< new_space_free_pointer
) {
270 /* printf("here=%lx, new_space_free_pointer=%lx\n",
271 here,new_space_free_pointer); */
272 next
= new_space_free_pointer
;
273 scavenge(here
, next
- here
);
274 scav_weak_hash_tables();
277 /* printf("done with newspace\n"); */
283 print_garbage(lispobj
*from_space
, lispobj
*from_space_free_pointer
)
286 int total_words_not_copied
;
288 printf("Scanning from space ...\n");
290 total_words_not_copied
= 0;
292 while (start
< from_space_free_pointer
) {
294 int forwardp
, type
, nwords
;
298 forwardp
= is_lisp_pointer(object
) && new_space_p(object
);
304 tag
= lowtag_of(object
);
307 case LIST_POINTER_LOWTAG
:
310 case INSTANCE_POINTER_LOWTAG
:
311 printf("Don't know about instances yet!\n");
314 case FUN_POINTER_LOWTAG
:
317 case OTHER_POINTER_LOWTAG
:
318 pointer
= native_pointer(object
);
320 type
= widetag_of(header
);
321 nwords
= (sizetab
[type
])(pointer
);
323 default: nwords
=1; /* shut yer whinging, gcc */
326 type
= widetag_of(object
);
327 nwords
= (sizetab
[type
])(start
);
328 total_words_not_copied
+= nwords
;
329 printf("%4d words not copied at 0x%16lx; ",
330 nwords
, (unsigned long) start
);
331 printf("Header word is 0x%08x\n",
332 (unsigned int) object
);
336 printf("%d total words not copied.\n", total_words_not_copied
);
343 scav_weak_pointer(lispobj
*where
, lispobj object
)
345 /* Do not let GC scavenge the value slot of the weak pointer */
346 /* (that is why it is a weak pointer). Note: we could use */
347 /* the scav_unboxed method here. */
349 return WEAK_POINTER_NWORDS
;
353 search_read_only_space(void *pointer
)
355 lispobj
* start
= (lispobj
*)READ_ONLY_SPACE_START
;
356 lispobj
* end
= (lispobj
*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER
,0);
357 if ((pointer
< (void *)start
) || (pointer
>= (void *)end
))
359 return gc_search_space(start
, pointer
);
363 search_static_space(void *pointer
)
365 lispobj
* start
= (lispobj
*)STATIC_SPACE_START
;
366 lispobj
* end
= (lispobj
*)SymbolValue(STATIC_SPACE_FREE_POINTER
,0);
367 if ((pointer
< (void *)start
) || (pointer
>= (void *)end
))
369 return gc_search_space(start
, pointer
);
373 search_dynamic_space(void *pointer
)
375 lispobj
*start
= (lispobj
*) current_dynamic_space
;
376 lispobj
*end
= (lispobj
*) dynamic_space_free_pointer
;
377 if ((pointer
< (void *)start
) || (pointer
>= (void *)end
))
379 return gc_search_space(start
, pointer
);
382 /* initialization. if gc_init can be moved to after core load, we could
383 * combine these two functions */
388 scavtab
[WEAK_POINTER_WIDETAG
] = scav_weak_pointer
;
392 gc_initialize_pointers(void)
394 /* FIXME: We do nothing here. We (briefly) misguidedly attempted
395 to set current_dynamic_space to DYNAMIC_0_SPACE_START here,
396 forgetting that (a) actually it could be the other and (b) it's
397 set in coreparse.c anyway. There's a FIXME note left here to
398 note that current_dynamic_space is a violation of OAOO: we can
399 tell which dynamic space we're currently in by looking at
400 dynamic_space_free_pointer. -- CSR, 2002-08-09 */
406 /* noise to manipulate the gc trigger stuff */
408 /* Functions that substantially change the dynamic space free pointer
409 * (collect_garbage, purify) are responsible also for resetting the
411 void set_auto_gc_trigger(os_vm_size_t dynamic_usage
)
413 os_vm_address_t addr
;
416 addr
= os_round_up_to_page((os_vm_address_t
)current_dynamic_space
418 if (addr
< (os_vm_address_t
)dynamic_space_free_pointer
)
419 lose("set_auto_gc_trigger: tried to set gc trigger too low! (%ld < 0x%08lx)\n",
420 (unsigned long)dynamic_usage
,
421 (unsigned long)((os_vm_address_t
)dynamic_space_free_pointer
422 - (os_vm_address_t
)current_dynamic_space
));
424 if (dynamic_usage
> dynamic_space_size
)
425 lose("set_auto_gc_trigger: tried to set gc trigger too high! (0x%08lx)\n",
426 (unsigned long)dynamic_usage
);
427 length
= os_trunc_size_to_page(dynamic_space_size
- dynamic_usage
);
429 #if defined(SUNOS) || defined(SOLARIS) || defined(LISP_FEATURE_HPUX)
430 os_invalidate(addr
, length
);
432 os_protect(addr
, length
, 0);
435 current_auto_gc_trigger
= (lispobj
*)addr
;
438 void clear_auto_gc_trigger(void)
440 os_vm_address_t addr
;
443 if (current_auto_gc_trigger
== NULL
)
446 addr
= (os_vm_address_t
)current_auto_gc_trigger
;
447 length
= dynamic_space_size
+ (os_vm_address_t
)current_dynamic_space
- addr
;
449 #if defined(SUNOS) || defined(SOLARIS) || defined(LISP_FEATURE_HPUX)
450 /* don't want to force whole space into swapping mode... */
451 os_validate(addr
, length
);
453 os_protect(addr
, length
, OS_VM_PROT_ALL
);
456 current_auto_gc_trigger
= NULL
;
460 gc_trigger_hit(void *addr
)
462 if (current_auto_gc_trigger
== NULL
)
465 return (addr
>= (void *)current_auto_gc_trigger
&&
466 addr
<((void *)current_dynamic_space
+ dynamic_space_size
));
471 cheneygc_handle_wp_violation(os_context_t
*context
, void *addr
)
473 if(!foreign_function_call_active
&& gc_trigger_hit(addr
)){
474 struct thread
*thread
=arch_os_get_current_thread();
475 clear_auto_gc_trigger();
476 /* Don't flood the system with interrupts if the need to gc is
477 * already noted. This can happen for example when SUB-GC
478 * allocates or after a gc triggered in a WITHOUT-GCING. */
479 if (SymbolValue(GC_PENDING
,thread
) == NIL
) {
480 if (SymbolValue(GC_INHIBIT
,thread
) == NIL
) {
481 if (arch_pseudo_atomic_atomic(context
)) {
482 /* set things up so that GC happens when we finish
484 SetSymbolValue(GC_PENDING
,T
,thread
);
485 arch_set_pseudo_atomic_interrupted(context
);
486 maybe_save_gc_mask_and_block_deferrables
487 (os_context_sigmask_addr(context
));
492 SetSymbolValue(GC_PENDING
,T
,thread
);