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 /* This does nothing. It's only to satisfy a reference from gc-common. */
51 char gc_coalesce_string_literals
= 0;
53 static void scavenge_newspace(void);
56 /* collecting garbage */
60 tv_diff(struct timeval
*x
, struct timeval
*y
)
62 return (((double) x
->tv_sec
+ (double) x
->tv_usec
* 1.0e-6) -
63 ((double) y
->tv_sec
+ (double) y
->tv_usec
* 1.0e-6));
68 gc_general_alloc(word_t bytes
, int page_type_flag
, int quick_p
) {
69 lispobj
*new=new_space_free_pointer
;
70 new_space_free_pointer
+=(bytes
/N_WORD_BYTES
);
74 lispobj
copy_large_unboxed_object(lispobj object
, sword_t nwords
) {
75 return copy_object(object
,nwords
);
77 lispobj
copy_unboxed_object(lispobj object
, sword_t nwords
) {
78 return copy_object(object
,nwords
);
80 lispobj
copy_large_object(lispobj object
, sword_t nwords
) {
81 return copy_object(object
,nwords
);
84 /* Note: The generic GC interface we're implementing passes us a
85 * last_generation argument. That's meaningless for us, since we're
86 * not a generational GC. So we ignore it. */
88 collect_garbage(generation_index_t ignore
)
91 struct timeval start_tv
, stop_tv
;
92 struct rusage start_rusage
, stop_rusage
;
93 double real_time
, system_time
, user_time
;
94 double percent_retained
, gc_rate
;
95 unsigned long size_discarded
;
97 unsigned long size_retained
;
98 lispobj
*current_static_space_free_pointer
;
100 struct thread
*th
=arch_os_get_current_thread();
103 printf("[Collecting garbage ... \n");
105 getrusage(RUSAGE_SELF
, &start_rusage
);
106 gettimeofday(&start_tv
, (struct timezone
*) 0);
109 /* it's possible that signals are blocked already if this was called
110 * from a signal handler (e.g. with the sigsegv gc_trigger stuff) */
111 block_blockable_signals(&old
);
113 current_static_space_free_pointer
= static_space_free_pointer
;
115 /* Set up from space and new space pointers. */
117 from_space
= current_dynamic_space
;
118 from_space_free_pointer
= dynamic_space_free_pointer
;
121 fprintf(stderr
,"from_space = %lx\n",
122 (unsigned long) current_dynamic_space
);
124 if (current_dynamic_space
== (lispobj
*) DYNAMIC_0_SPACE_START
)
125 new_space
= (lispobj
*)DYNAMIC_1_SPACE_START
;
126 else if (current_dynamic_space
== (lispobj
*) DYNAMIC_1_SPACE_START
)
127 new_space
= (lispobj
*) DYNAMIC_0_SPACE_START
;
129 lose("GC lossage. Current dynamic space is bogus!\n");
131 new_space_free_pointer
= new_space
;
133 /* Initialize the weak pointer list. */
134 weak_pointers
= (struct weak_pointer
*) NULL
;
137 /* Scavenge all of the roots. */
139 printf("Scavenging interrupt contexts ...\n");
141 scavenge_interrupt_contexts(th
);
144 printf("Scavenging interrupt handlers (%d bytes) ...\n",
145 (int)sizeof(interrupt_handlers
));
147 scavenge((lispobj
*) interrupt_handlers
,
148 sizeof(interrupt_handlers
) / sizeof(lispobj
));
151 printf("Scavenging the control stack ...\n");
153 scavenge_control_stack(th
);
155 scav_binding_stack((lispobj
*)th
->binding_stack_start
,
156 (lispobj
*)get_binding_stack_pointer(th
));
159 printf("Scavenging static space %p - %p (%d words) ...\n",
160 (void*)STATIC_SPACE_START
,
161 current_static_space_free_pointer
,
162 (int)(current_static_space_free_pointer
163 - (lispobj
*) STATIC_SPACE_START
));
165 heap_scavenge(((lispobj
*)STATIC_SPACE_START
),
166 current_static_space_free_pointer
);
168 /* Scavenge newspace. */
170 printf("Scavenging new space (%d bytes) ...\n",
171 (int)((new_space_free_pointer
- new_space
) * sizeof(lispobj
)));
176 #if defined(DEBUG_PRINT_GARBAGE)
177 print_garbage(from_space
, from_space_free_pointer
);
180 /* Scan the weak pointers. */
182 printf("Scanning weak hash tables ...\n");
184 scan_weak_hash_tables();
186 /* Scan the weak pointers. */
188 printf("Scanning weak pointers ...\n");
190 scan_weak_pointers();
194 printf("Flipping spaces ...\n");
197 /* Maybe FIXME: it's possible that we could significantly reduce
198 * RSS by zeroing the from_space or madvise(MADV_DONTNEED) or
199 * similar os-dependent tricks here */
200 #ifdef LISP_FEATURE_HPUX
201 /* hpux cant handle unmapping areas that are not 100% mapped */
202 clear_auto_gc_trigger();
204 os_zero((os_vm_address_t
) from_space
,
205 (os_vm_size_t
) dynamic_space_size
);
207 current_dynamic_space
= new_space
;
208 dynamic_space_free_pointer
= new_space_free_pointer
;
211 size_discarded
= (from_space_free_pointer
- from_space
) * sizeof(lispobj
);
213 size_retained
= (new_space_free_pointer
- new_space
) * sizeof(lispobj
);
215 os_flush_icache((os_vm_address_t
)new_space
, size_retained
);
219 printf("Zeroing empty part of control stack ...\n");
221 scrub_control_stack();
222 set_auto_gc_trigger(size_retained
+bytes_consed_between_gcs
);
223 thread_sigmask(SIG_SETMASK
, &old
, 0);
227 gettimeofday(&stop_tv
, (struct timezone
*) 0);
228 getrusage(RUSAGE_SELF
, &stop_rusage
);
232 percent_retained
= (((float) size_retained
) /
233 ((float) size_discarded
)) * 100.0;
235 printf("Total of %ld bytes out of %ld bytes retained (%3.2f%%).\n",
236 size_retained
, size_discarded
, percent_retained
);
238 real_time
= tv_diff(&stop_tv
, &start_tv
);
239 user_time
= tv_diff(&stop_rusage
.ru_utime
, &start_rusage
.ru_utime
);
240 system_time
= tv_diff(&stop_rusage
.ru_stime
, &start_rusage
.ru_stime
);
242 printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n",
243 real_time
, user_time
, system_time
);
245 gc_rate
= ((float) size_retained
/ (float) (1<<20)) / real_time
;
247 printf("%10.2f M bytes/sec collected.\n", gc_rate
);
255 scavenge_newspace(void)
257 lispobj
*here
, *next
;
260 while (here
< new_space_free_pointer
) {
261 /* printf("here=%lx, new_space_free_pointer=%lx\n",
262 here,new_space_free_pointer); */
263 next
= new_space_free_pointer
;
264 heap_scavenge(here
, next
);
265 scav_weak_hash_tables();
268 /* printf("done with newspace\n"); */
274 print_garbage(lispobj
*from_space
, lispobj
*from_space_free_pointer
)
277 int total_words_not_copied
;
279 printf("Scanning from space ...\n");
281 total_words_not_copied
= 0;
283 while (start
< from_space_free_pointer
) {
285 int forwardp
, type
, nwords
;
289 forwardp
= is_lisp_pointer(object
) && new_space_p(object
);
295 tag
= lowtag_of(object
);
298 case LIST_POINTER_LOWTAG
:
301 case INSTANCE_POINTER_LOWTAG
:
302 printf("Don't know about instances yet!\n");
305 case FUN_POINTER_LOWTAG
:
308 case OTHER_POINTER_LOWTAG
:
309 pointer
= native_pointer(object
);
311 type
= widetag_of(header
);
312 nwords
= (sizetab
[type
])(pointer
);
314 default: nwords
=1; /* shut yer whinging, gcc */
317 type
= widetag_of(object
);
318 nwords
= (sizetab
[type
])(start
);
319 total_words_not_copied
+= nwords
;
320 printf("%4d words not copied at 0x%16lx; ",
321 nwords
, (unsigned long) start
);
322 printf("Header word is 0x%08x\n",
323 (unsigned int) object
);
327 printf("%d total words not copied.\n", total_words_not_copied
);
334 scav_weak_pointer(lispobj
*where
, lispobj object
)
336 /* Do not let GC scavenge the value slot of the weak pointer */
337 /* (that is why it is a weak pointer). Note: we could use */
338 /* the scav_unboxed method here. */
340 return WEAK_POINTER_NWORDS
;
344 search_read_only_space(void *pointer
)
346 lispobj
* start
= (lispobj
*)READ_ONLY_SPACE_START
;
347 lispobj
* end
= read_only_space_free_pointer
;
348 if ((pointer
< (void *)start
) || (pointer
>= (void *)end
))
350 return gc_search_space(start
, pointer
);
354 search_static_space(void *pointer
)
356 lispobj
* start
= (lispobj
*)STATIC_SPACE_START
;
357 lispobj
* end
= static_space_free_pointer
;
358 if ((pointer
< (void *)start
) || (pointer
>= (void *)end
))
360 return gc_search_space(start
, pointer
);
364 search_dynamic_space(void *pointer
)
366 lispobj
*start
= (lispobj
*) current_dynamic_space
;
367 lispobj
*end
= (lispobj
*) dynamic_space_free_pointer
;
368 if ((pointer
< (void *)start
) || (pointer
>= (void *)end
))
370 return gc_search_space(start
, pointer
);
373 /* initialization. if gc_init can be moved to after core load, we could
374 * combine these two functions */
379 scavtab
[WEAK_POINTER_WIDETAG
] = scav_weak_pointer
;
383 gc_initialize_pointers(void)
385 /* FIXME: We do nothing here. We (briefly) misguidedly attempted
386 to set current_dynamic_space to DYNAMIC_0_SPACE_START here,
387 forgetting that (a) actually it could be the other and (b) it's
388 set in coreparse.c anyway. There's a FIXME note left here to
389 note that current_dynamic_space is a violation of OAOO: we can
390 tell which dynamic space we're currently in by looking at
391 dynamic_space_free_pointer. -- CSR, 2002-08-09 */
397 /* noise to manipulate the gc trigger stuff */
399 /* Functions that substantially change the dynamic space free pointer
400 * (collect_garbage, purify) are responsible also for resetting the
402 void set_auto_gc_trigger(os_vm_size_t dynamic_usage
)
404 os_vm_address_t addr
;
407 addr
= os_round_up_to_page((os_vm_address_t
)current_dynamic_space
409 if (addr
< (os_vm_address_t
)dynamic_space_free_pointer
)
410 lose("set_auto_gc_trigger: tried to set gc trigger too low! (%ld < 0x%08lx)\n",
411 (unsigned long)dynamic_usage
,
412 (unsigned long)((os_vm_address_t
)dynamic_space_free_pointer
413 - (os_vm_address_t
)current_dynamic_space
));
415 if (dynamic_usage
> dynamic_space_size
)
416 lose("set_auto_gc_trigger: tried to set gc trigger too high! (0x%08lx)\n",
417 (unsigned long)dynamic_usage
);
418 length
= os_trunc_size_to_page(dynamic_space_size
- dynamic_usage
);
420 #if defined(SUNOS) || defined(SOLARIS) || defined(LISP_FEATURE_HPUX)
421 os_invalidate(addr
, length
);
423 os_protect(addr
, length
, 0);
426 current_auto_gc_trigger
= (lispobj
*)addr
;
429 void clear_auto_gc_trigger(void)
431 os_vm_address_t addr
;
434 if (current_auto_gc_trigger
== NULL
)
437 addr
= (os_vm_address_t
)current_auto_gc_trigger
;
438 length
= dynamic_space_size
+ (os_vm_address_t
)current_dynamic_space
- addr
;
440 #if defined(SUNOS) || defined(SOLARIS) || defined(LISP_FEATURE_HPUX)
441 /* don't want to force whole space into swapping mode... */
442 os_validate(NOT_MOVABLE
, addr
, length
);
444 os_protect(addr
, length
, OS_VM_PROT_ALL
);
447 current_auto_gc_trigger
= NULL
;
451 gc_trigger_hit(void *addr
)
453 if (current_auto_gc_trigger
== NULL
)
456 return (addr
>= (void *)current_auto_gc_trigger
&&
457 (char*)addr
<((char *)current_dynamic_space
+ dynamic_space_size
));
462 cheneygc_handle_wp_violation(os_context_t
*context
, void *addr
)
464 if(!foreign_function_call_active
&& gc_trigger_hit(addr
)){
465 struct thread
*thread
=arch_os_get_current_thread();
466 clear_auto_gc_trigger();
467 /* Don't flood the system with interrupts if the need to gc is
468 * already noted. This can happen for example when SUB-GC
469 * allocates or after a gc triggered in a WITHOUT-GCING. */
470 if (SymbolValue(GC_PENDING
,thread
) == NIL
) {
471 if (SymbolValue(GC_INHIBIT
,thread
) == NIL
) {
472 if (arch_pseudo_atomic_atomic(context
)) {
473 /* set things up so that GC happens when we finish
475 SetSymbolValue(GC_PENDING
,T
,thread
);
476 arch_set_pseudo_atomic_interrupted(context
);
477 maybe_save_gc_mask_and_block_deferrables
478 (os_context_sigmask_addr(context
));
483 SetSymbolValue(GC_PENDING
,T
,thread
);