Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/runtime cheneygc.c,1.5,1.6 gc-common.c,1.5,1.6 gencgc.c,1.32,1.33 interrupt.c,1.36,1.37 purify.c,1.27,1.28 runtime.c,1.25,1.26
|
From: Daniel B. <da...@us...> - 2003-05-05 23:27:14
|
Update of /cvsroot/sbcl/sbcl/src/runtime
In directory sc8-pr-cvs1:/tmp/cvs-serv9007/src/runtime
Modified Files:
cheneygc.c gc-common.c gencgc.c interrupt.c purify.c runtime.c
Log Message:
0.8alpha.0.14
Merge thread-gc-branch.
Summary: move time-to-gc-p logic entirely into C. Delete a
lot of Lisp stuff no longer necessary. Make SUB-GC
thread-safe or at least thread-tolerant. Some hooks and
variables that were previously available but not apparently
used for much are now no longer present.
Index: cheneygc.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/cheneygc.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- cheneygc.c 3 Apr 2003 18:27:24 -0000 1.5
+++ cheneygc.c 5 May 2003 23:27:08 -0000 1.6
@@ -50,6 +50,8 @@
static void scavenge_interrupt_contexts(void);
extern struct interrupt_data * global_interrupt_data;
+extern unsigned long bytes_consed_between_gcs;
+
/* collecting garbage */
@@ -116,8 +118,8 @@
double real_time, system_time, user_time;
double percent_retained, gc_rate;
unsigned long size_discarded;
- unsigned long size_retained;
#endif
+ unsigned long size_retained;
lispobj *current_static_space_free_pointer;
unsigned long static_space_size;
unsigned long control_stack_size, binding_stack_size;
@@ -241,15 +243,15 @@
#ifdef PRINTNOISE
size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj);
- size_retained = (new_space_free_pointer - new_space) * sizeof(lispobj);
#endif
+ size_retained = (new_space_free_pointer - new_space) * sizeof(lispobj);
/* Zero stack. */
#ifdef PRINTNOISE
printf("Zeroing empty part of control stack ...\n");
#endif
zero_stack();
-
+ set_auto_gc_trigger(size_retained+bytes_consed_between_gcs);
sigprocmask(SIG_SETMASK, &old, 0);
@@ -595,11 +597,13 @@
/* noise to manipulate the gc trigger stuff */
+/* Functions that substantially change the dynamic space free pointer
+ * (collect_garbage, purify) are responsible also for resettting the
+ * auto_gc_trigger */
void set_auto_gc_trigger(os_vm_size_t dynamic_usage)
{
os_vm_address_t addr=(os_vm_address_t)current_dynamic_space
+ dynamic_usage;
-
long length = DYNAMIC_SPACE_SIZE - dynamic_usage;
if (addr < (os_vm_address_t)dynamic_space_free_pointer) {
Index: gc-common.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/gc-common.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- gc-common.c 10 Mar 2003 14:54:29 -0000 1.5
+++ gc-common.c 5 May 2003 23:27:08 -0000 1.6
@@ -99,6 +99,9 @@
int (*sizetab[256])(lispobj *where);
struct weak_pointer *weak_pointers;
+unsigned long bytes_consed_between_gcs = 4*1024*1024;
+
+
/*
* copying objects
*/
Index: gencgc.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/gencgc.c,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -d -r1.32 -r1.33
--- gencgc.c 25 Apr 2003 23:43:08 -0000 1.32
+++ gencgc.c 5 May 2003 23:27:08 -0000 1.33
@@ -129,7 +129,8 @@
/* the total bytes allocated. These are seen by Lisp DYNAMIC-USAGE. */
unsigned long bytes_allocated = 0;
-static unsigned long auto_gc_trigger = 0;
+extern unsigned long bytes_consed_between_gcs; /* gc-common.c */
+unsigned long auto_gc_trigger = 0;
/* the source and destination generations. These are set before a GC starts
* scavenging. */
@@ -2146,7 +2147,8 @@
/* Is there any possibility that pointer is a valid Lisp object
* reference, and/or something else (e.g. subroutine call return
- * address) which should prevent us from moving the referred-to thing? */
+ * address) which should prevent us from moving the referred-to thing?
+ * This is called from preserve_pointers() */
static int
possibly_valid_dynamic_space_pointer(lispobj *pointer)
{
@@ -2173,23 +2175,6 @@
/* Check that the object pointed to is consistent with the pointer
* low tag.
- *
- * FIXME: It's not safe to rely on the result from this check
- * before an object is initialized. Thus, if we were interrupted
- * just as an object had been allocated but not initialized, the
- * GC relying on this result could bogusly reclaim the memory.
- * However, we can't really afford to do without this check. So
- * we should make it safe somehow.
- * (1) Perhaps just review the code to make sure
- * that WITHOUT-GCING or WITHOUT-INTERRUPTS or some such
- * thing is wrapped around critical sections where allocated
- * memory type bits haven't been set.
- * (2) Perhaps find some other hack to protect against this, e.g.
- * recording the result of the last call to allocate-lisp-memory,
- * and returning true from this function when *pointer is
- * a reference to that result.
- *
- * (surely pseudo-atomic is supposed to be used for exactly this?)
*/
switch (lowtag_of((lispobj)pointer)) {
case FUN_POINTER_LOWTAG:
@@ -2587,7 +2572,7 @@
* (or, as a special case which also requires dont_move, a return
* address referring to something in a CodeObject). This is
* expensive but important, since it vastly reduces the
- * probability that random garbage will be bogusly interpreter as
+ * probability that random garbage will be bogusly interpreted as
* a pointer which prevents a page from moving. */
if (!(possibly_valid_dynamic_space_pointer(addr)))
return;
@@ -3984,7 +3969,10 @@
gc_alloc_generation = 0;
update_x86_dynamic_space_free_pointer();
-
+ auto_gc_trigger = bytes_allocated + bytes_consed_between_gcs;
+ if(gencgc_verbose)
+ fprintf(stderr,"Next gc when %d bytes have been consed\n",
+ auto_gc_trigger);
SHOW("returning from collect_garbage");
}
@@ -4220,7 +4208,6 @@
* we should GC in the near future
*/
if (auto_gc_trigger && bytes_allocated > auto_gc_trigger) {
- auto_gc_trigger *= 2;
/* set things up so that GC happens when we finish the PA
* section. */
maybe_gc_pending=1;
@@ -4230,22 +4217,6 @@
return (new_obj);
}
-
-/*
- * noise to manipulate the gc trigger stuff
- */
-
-void
-set_auto_gc_trigger(os_vm_size_t dynamic_usage)
-{
- auto_gc_trigger += dynamic_usage;
-}
-
-void
-clear_auto_gc_trigger(void)
-{
- auto_gc_trigger = 0;
-}
/* Find the code object for the given pc, or return NULL on failure.
*
Index: interrupt.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/interrupt.c,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -d -r1.36 -r1.37
--- interrupt.c 21 Apr 2003 21:06:37 -0000 1.36
+++ interrupt.c 5 May 2003 23:27:09 -0000 1.37
@@ -562,11 +562,13 @@
else return 0;
}
-#ifndef LISP_FEATURE_X86
+#ifndef LISP_FEATURE_GENCGC
/* This function gets called from the SIGSEGV (for e.g. Linux or
* OpenBSD) or SIGBUS (for e.g. FreeBSD) handler. Here we check
* whether the signal was due to treading on the mprotect()ed zone -
* and if so, arrange for a GC to happen. */
+extern unsigned long bytes_consed_between_gcs; /* gc-common.c */
+
boolean
interrupt_maybe_gc(int signal, siginfo_t *info, void *void_context)
{
@@ -575,16 +577,8 @@
struct interrupt_data *data=
th ? th->interrupt_data : global_interrupt_data;
- if (!foreign_function_call_active
-#ifndef LISP_FEATURE_GENCGC
- /* nb: GENCGC on non-x86? I really don't think so. This
- * happens every time */
- && gc_trigger_hit(signal, info, context)
-#endif
- ) {
-#ifndef LISP_FEATURE_GENCGC
+ if(!foreign_function_call_active && gc_trigger_hit(signal, info, context)){
clear_auto_gc_trigger();
-#endif
if (arch_pseudo_atomic_atomic(context)) {
/* don't GC during an atomic operation. Instead, copy the
@@ -604,18 +598,13 @@
arch_set_pseudo_atomic_interrupted(context);
}
else {
- lispobj *old_free_space=current_dynamic_space;
fake_foreign_function_call(context);
+ /* SUB-GC may return without GCing if *GC-INHIBIT* is set,
+ * in which case we will be running with no gc trigger
+ * barrier thing for a while. But it shouldn't be long
+ * until the end of WITHOUT-GCING. */
funcall0(SymbolFunction(SUB_GC));
undo_fake_foreign_function_call(context);
- if(current_dynamic_space==old_free_space)
- /* MAYBE-GC (as the name suggest) might not. If it
- * doesn't, it won't reset the GC trigger either, so we
- * have to do it ourselves. Put it near the end of
- * dynamic space so we're not running into it continually
- */
- set_auto_gc_trigger(DYNAMIC_SPACE_SIZE
- -(u32)os_vm_page_size);
}
return 1;
} else {
Index: purify.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/purify.c,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- purify.c 7 Apr 2003 13:17:06 -0000 1.27
+++ purify.c 5 May 2003 23:27:09 -0000 1.28
@@ -45,6 +45,7 @@
*/
static lispobj *dynamic_space_free_pointer;
#endif
+extern unsigned long bytes_consed_between_gcs;
#define gc_abort() \
lose("GC invariant lost, file \"%s\", line %d", __FILE__, __LINE__)
@@ -132,17 +133,11 @@
static unsigned pointer_filter_verbose = 0;
-/* FIXME: This is substantially the same code as in gencgc.c. (There
- * are some differences, at least (1) the gencgc.c code needs to worry
- * about return addresses on the stack pinning code objects, (2) the
- * gencgc.c code needs to worry about the GC maybe happening in an
- * interrupt service routine when the main thread of control was
- * interrupted just as it had allocated memory and before it
- * initialized it, while PURIFY needn't worry about that, and (3) the
- * gencgc.c code has mutated more under maintenance since the fork
- * from CMU CL than the code here has.) The two versions should be
- * made to explicitly share common code, instead of just two different
- * cut-and-pasted versions. */
+/* FIXME: This is substantially the same code as
+ * possibly_valid_dynamic_space_pointer in gencgc.c. The only
+ * relevant difference seems to be that the gencgc code also checks
+ * for raw pointers into Code objects */
+
static int
valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr)
{
@@ -1063,7 +1058,7 @@
gc_assert(!dynamic_pointer_p(func));
#ifdef __i386__
- /* Temporarly convert the self pointer to a real function
+ /* Temporarily convert the self pointer to a real function
* pointer. */
((struct simple_fun *)native_pointer(func))->self
-= FUN_RAW_ADDR_OFFSET;
@@ -1488,6 +1483,7 @@
#if !defined(__i386__)
dynamic_space_free_pointer = current_dynamic_space;
+ set_auto_gc_trigger(bytes_consed_between_gcs);
#else
#if defined LISP_FEATURE_GENCGC
gc_free_heap();
@@ -1500,6 +1496,5 @@
printf(" done]\n");
fflush(stdout);
#endif
-
return 0;
}
Index: runtime.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/runtime.c,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- runtime.c 19 Apr 2003 20:11:31 -0000 1.25
+++ runtime.c 5 May 2003 23:27:10 -0000 1.26
@@ -418,8 +418,10 @@
* finished being pseudo_atomic. once there it will
* signal itself SIGSTOP, which will give us another
* event to wait for */
+#if 0
fprintf(stderr, "%d was pseudo-atomic, letting it resume \n",
th->pid);
+#endif
SetTlSymbolValue(PSEUDO_ATOMIC_INTERRUPTED,make_fixnum(1),th);
if(ptrace(PTRACE_CONT,th->pid,0,0))
perror("PTRACE_CONT");
@@ -431,7 +433,6 @@
collect_garbage(maybe_gc_pending-1);
maybe_gc_pending=0;
stop_the_world=0;
- /* fprintf(stderr, "gc done\n"); */
for_each_thread(th)
if(ptrace(PTRACE_DETACH,th->pid,0,0))
perror("PTRACE_DETACH");
@@ -442,6 +443,7 @@
struct sigaction sa;
sigset_t sigset;
int status;
+ pid_t pid=0;
sigemptyset(&sigset);
@@ -463,29 +465,26 @@
while(!all_threads) {
sched_yield();
}
-
- while(all_threads) {
- pid_t pid=0;
- while(pid=waitpid(-1,&status,__WALL|WUNTRACED)) {
- struct thread *th;
- if(pid==-1) {
- if(errno == EINTR) {
- if(maybe_gc_pending) parent_do_garbage_collect();
- continue;
- }
- if(errno == ECHILD) break;
- fprintf(stderr,"waitpid: %s\n",strerror(errno));
+ maybe_gc_pending=0;
+ while(all_threads && (pid=waitpid(-1,&status,__WALL|WUNTRACED))) {
+ struct thread *th;
+ while(maybe_gc_pending) parent_do_garbage_collect();
+ if(pid==-1) {
+ if(errno == EINTR) {
continue;
}
- th=find_thread_by_pid(pid);
- if(!th) continue;
- if(WIFEXITED(status) || WIFSIGNALED(status)) {
- fprintf(stderr,"waitpid : child %d %x exited \n", pid,th);
- destroy_thread(th);
- /* FIXME arrange to call or fake (free-mutex *session-lock*)
- * if necessary */
- if(!all_threads) break;
- }
+ if(errno == ECHILD) break;
+ fprintf(stderr,"waitpid: %s\n",strerror(errno));
+ continue;
+ }
+ th=find_thread_by_pid(pid);
+ if(!th) continue;
+ if(WIFEXITED(status) || WIFSIGNALED(status)) {
+ fprintf(stderr,"waitpid : child %d %x exited \n", pid,th);
+ destroy_thread(th);
+ /* FIXME arrange to call or fake (free-mutex *session-lock*)
+ * if necessary */
+ if(!all_threads) break;
}
}
exit(WEXITSTATUS(status));
|