[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-457-g22d425e
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-457-g22d425e |
|
Date: |
Fri, 22 Nov 2013 18:17:06 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=22d425ec551f265a8c700d224c3d0953a98b14bf
The branch, master has been updated
via 22d425ec551f265a8c700d224c3d0953a98b14bf (commit)
via 4a1ce0169db0f767fd13e4deba17732e444e72ee (commit)
via 56280be9838db09465c1449cd3345e54236fbc85 (commit)
via 1cdf9b788ea12eadccd9c4cac1a9e88cb9d46a5f (commit)
via 5f18bc8450511e3616588ce20548cc365b2a81e0 (commit)
via 7af0c3b395fda906b5635323d28dd80482357aa7 (commit)
via 9ebf79460736bbeaa75b1a86bfcd7ec23418c4ff (commit)
via 03d1294977333b23b91e24c3b0b7ddf9cab26cfc (commit)
from d86682ba2c555961eb14bed7ae3227c855158d55 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 22d425ec551f265a8c700d224c3d0953a98b14bf
Author: Andy Wingo <address@hidden>
Date: Fri Nov 22 17:31:07 2013 +0100
Expandable stacks.
* libguile/vm-engine.c (CHECK_OVERFLOW): Call vm_expand_stack, not
vm_error_stack_overflow.
* libguile/vm.c (hard_max_stack_size, default_max_stack_size): Recast
#defines as locals. Have both hard and soft stack limits.
(initialize_default_stack_size): Set soft stack limit from
GUILE_STACK_SIZE.
(expand_stack, vm_expand_stack): Support for expanding stacks as
needed. Whee!
(make_vm): Adapt limits.
(scm_call_n): Expand stack if needed.
* libguile/vm.h (struct scm_vm): Add max_stack_size member.
commit 4a1ce0169db0f767fd13e4deba17732e444e72ee
Author: Andy Wingo <address@hidden>
Date: Fri Nov 22 18:35:02 2013 +0100
VM copes with moving FP
* libguile/_scm.h (SCM_ASYNC_TICK_WITH_GUARD_CODE): New macro.
* libguile/vm-engine.c (VM_HANDLE_INTERRUPTS): Restore FP after
ticking.
(CACHE_FP): New macro.
(CHECK_OVERFLOW): Use CACHE_FP.
(BR_ARITHMETIC, RETURN_EXP, RETURN_ONE_VALUE, BINARY_INTEGER_OP):
(call, return-values, subr-call, foreign-call)
(resolve, define!, toplevel-box, module-box): Restore the FP from the
vp where needed.
commit 56280be9838db09465c1449cd3345e54236fbc85
Author: Andy Wingo <address@hidden>
Date: Fri Nov 22 18:06:35 2013 +0100
Simplify state sync in VM before potential bailout.
* libguile/vm-engine.c (SYNC_IP): Remove calls to SYNC_BEFORE_GC, a
no-op. Replace SYNC_REGISTER / SYNC_ALL calls with just SYNC_IP.
commit 1cdf9b788ea12eadccd9c4cac1a9e88cb9d46a5f
Author: Andy Wingo <address@hidden>
Date: Fri Nov 22 15:02:17 2013 +0100
More precise stack marking.
* libguile/vm.c (scm_i_vm_mark_stack): Mark the stack more precisely.
commit 5f18bc8450511e3616588ce20548cc365b2a81e0
Author: Andy Wingo <address@hidden>
Date: Fri Nov 22 14:41:19 2013 +0100
Allocate stacks using mmap, and mark them via the thread marker
* libguile/threads.c (thread_mark): Mark the VM stack, if we have one.
(on_thread_exit): Free the VM stack here.
* libguile/vm.c (make_vm): Allocate the VM stack using mmap, and arrange
for it to be marked by the thread marker.
(scm_i_vm_mark_stack, scm_i_vm_free_stack): New internal interfaces.
(allocate_stack, free_stack): New helpers.
commit 7af0c3b395fda906b5635323d28dd80482357aa7
Author: Andy Wingo <address@hidden>
Date: Fri Nov 22 13:01:53 2013 +0100
Add thread mark procedure
* libguile/threads.c (thread_mark): A mark procedure for threads.
Eventually will mark the stack.
(guilify_self_1): Move initialization of VP earlier. Allocate thread
using thread_gc_kind.
(scm_threads_prehistory): Initialize thread_gc_kind.
commit 9ebf79460736bbeaa75b1a86bfcd7ec23418c4ff
Author: Andy Wingo <address@hidden>
Date: Fri Nov 22 10:59:14 2013 +0100
Remove unused scm_i_thread fields
* libguile/threads.h (scm_i_thread):
* libguile/threads.c (guilify_self_1): Remove unused mark stack fields.
commit 03d1294977333b23b91e24c3b0b7ddf9cab26cfc
Author: Andy Wingo <address@hidden>
Date: Fri Nov 22 10:51:56 2013 +0100
Remove tests and shims for pre-7.2 bdw-gc.
* configure.ac: Remove checks for symbols present in bdw-gc 7.2.
* libguile/finalizers.c:
* libguile/gc-malloc.c:
* libguile/gc.c:
* libguile/guardians.c:
* libguile/scmsigs.c:
* libguile/threads.c: Remove shims.
-----------------------------------------------------------------------
Summary of changes:
configure.ac | 33 +------
libguile/_scm.h | 18 ++--
libguile/finalizers.c | 11 --
libguile/gc-malloc.c | 6 +-
libguile/gc.c | 12 --
libguile/guardians.c | 6 -
libguile/scmsigs.c | 22 ----
libguile/threads.c | 226 ++++++++----------------------------------
libguile/threads.h | 5 -
libguile/vm-engine.c | 106 ++++++++++----------
libguile/vm.c | 266 ++++++++++++++++++++++++++++++++++---------------
libguile/vm.h | 7 ++
12 files changed, 297 insertions(+), 421 deletions(-)
diff --git a/configure.ac b/configure.ac
index 3cbd960..92dcb1e 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1246,36 +1246,11 @@ save_LIBS="$LIBS"
LIBS="$BDW_GC_LIBS $LIBS"
CFLAGS="$BDW_GC_CFLAGS $CFLAGS"
-AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active GC_pthread_exit \
- GC_pthread_cancel GC_allow_register_threads GC_pthread_sigmask \
- GC_set_start_callback GC_get_suspend_signal GC_move_disappearing_link
\
- GC_get_heap_usage_safe GC_get_free_space_divisor \
- GC_gcollect_and_unmap GC_get_unmapped_bytes GC_set_finalizer_notifier
\
- GC_set_finalize_on_demand GC_set_all_interior_pointers GC_get_gc_no \
- GC_set_java_finalization])
-
-# Though the `GC_do_blocking ()' symbol is present in GC 7.1, it is not
-# declared, and has a different type (returning void instead of
-# void*).
-AC_CHECK_DECL([GC_do_blocking],
- [AC_DEFINE([HAVE_DECL_GC_DO_BLOCKING], [1],
- [Define this if the `GC_do_blocking ()' function is declared])],
- [],
- [#include <gc/gc.h>])
-
-# `GC_fn_type' is not available in GC 7.1 and earlier.
-AC_CHECK_TYPE([GC_fn_type],
- [AC_DEFINE([HAVE_GC_FN_TYPE], [1],
- [Define this if the `GC_fn_type' type is available.])],
- [],
- [#include <gc/gc.h>])
+# Functions that might not be defined, depending on configuration.
+AC_CHECK_FUNCS([GC_pthread_exit GC_pthread_cancel GC_pthread_sigmask])
-# `GC_stack_base' is not available in GC 7.1 and earlier.
-AC_CHECK_TYPE([struct GC_stack_base],
- [AC_DEFINE([HAVE_GC_STACK_BASE], [1],
- [Define this if the `GC_stack_base' type is available.])],
- [],
- [#include <gc/gc.h>])
+# Functions from GC 7.3.
+AC_CHECK_FUNCS([GC_move_disappearing_link])
LIBS="$save_LIBS"
diff --git a/libguile/_scm.h b/libguile/_scm.h
index ee37fc3..4298612 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -225,25 +225,23 @@ void scm_ia64_longjmp (scm_i_jmp_buf *, int);
-#define SCM_ASYNC_TICK \
- do \
- { \
- if (SCM_UNLIKELY (SCM_I_CURRENT_THREAD->pending_asyncs)) \
- scm_async_tick (); \
- } \
- while (0)
-
-#define SCM_ASYNC_TICK_WITH_CODE(thr, stmt) \
+#define SCM_ASYNC_TICK_WITH_GUARD_CODE(thr, pre, post) \
do \
{ \
if (SCM_UNLIKELY (thr->pending_asyncs)) \
{ \
- stmt; \
+ pre; \
scm_async_tick (); \
+ post; \
} \
} \
while (0)
+#define SCM_ASYNC_TICK_WITH_CODE(thr, stmt) \
+ SCM_ASYNC_TICK_WITH_GUARD_CODE (thr, stmt, (void) 0)
+#define SCM_ASYNC_TICK \
+ SCM_ASYNC_TICK_WITH_CODE (SCM_I_CURRENT_THREAD, (void) 0)
+
diff --git a/libguile/finalizers.c b/libguile/finalizers.c
index db4e4c4..eaea139 100644
--- a/libguile/finalizers.c
+++ b/libguile/finalizers.c
@@ -43,17 +43,6 @@ static size_t finalization_count;
-#ifndef HAVE_GC_SET_FINALIZER_NOTIFIER
-static void
-GC_set_finalizer_notifier (void (*notifier) (void))
-{
- GC_finalizer_notifier = notifier;
-}
-#endif
-
-
-
-
void
scm_i_set_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
{
diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c
index 179558f..994f222 100644
--- a/libguile/gc-malloc.c
+++ b/libguile/gc-malloc.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- * 2004, 2006, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+ * 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation,
Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -134,11 +134,7 @@ scm_realloc (void *mem, size_t size)
return ptr;
/* Time is hard: trigger a full, ``stop-the-world'' GC, and try again. */
-#ifdef HAVE_GC_GCOLLECT_AND_UNMAP
GC_gcollect_and_unmap ();
-#else
- GC_gcollect ();
-#endif
ptr = do_realloc (mem, size);
if (ptr)
diff --git a/libguile/gc.c b/libguile/gc.c
index 927b170..5a14fb7 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -282,13 +282,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
GC_get_heap_usage_safe (&heap_size, &free_bytes, &unmapped_bytes,
&bytes_since_gc, &total_bytes);
-#ifdef HAVE_GC_GET_GC_NO
- /* This function was added in 7.2alpha2 (June 2009). */
gc_times = GC_get_gc_no ();
-#else
- /* This symbol is deprecated as of 7.3. */
- gc_times = GC_gc_no;
-#endif
answer =
scm_list_n (scm_cons (sym_gc_time_taken, scm_from_long (gc_time_taken)),
@@ -589,13 +583,7 @@ scm_getenv_int (const char *var, int def)
void
scm_storage_prehistory ()
{
-#ifdef HAVE_GC_SET_ALL_INTERIOR_POINTERS
- /* This function was added in 7.2alpha2 (June 2009). */
GC_set_all_interior_pointers (0);
-#else
- /* This symbol is deprecated in 7.3. */
- GC_all_interior_pointers = 0;
-#endif
free_space_divisor = scm_getenv_int ("GC_FREE_SPACE_DIVISOR", 3);
minimum_free_space_divisor = free_space_divisor;
diff --git a/libguile/guardians.c b/libguile/guardians.c
index 49d7cba..7619acf 100644
--- a/libguile/guardians.c
+++ b/libguile/guardians.c
@@ -355,13 +355,7 @@ void
scm_init_guardians ()
{
/* We use unordered finalization `a la Java. */
-#ifdef HAVE_GC_SET_JAVA_FINALIZATION
- /* This function was added in 7.2alpha2 (June 2009). */
GC_set_java_finalization (1);
-#else
- /* This symbol is deprecated as of 7.3. */
- GC_java_finalization = 1;
-#endif
tc16_guardian = scm_make_smob_type ("guardian", 0);
diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
index 497da2f..9fefa83 100644
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@@ -142,28 +142,6 @@ struct signal_pipe_data
int err;
};
-#ifndef HAVE_GC_GET_SUSPEND_SIGNAL
-static int
-GC_get_suspend_signal (void)
-{
-#if defined SIG_SUSPEND
- return SIG_SUSPEND;
-#elif defined SIGPWR
- return SIGPWR;
-#elif defined SIGLOST
- return SIGLOST;
-#elif defined _SIGRTMIN
- return _SIGRTMIN + 6;
-#elif defined SIGRTMIN
- return SIGRTMIN + 6;
-#elif defined __GLIBC__
- return 32+6;
-#else
- return SIGUSR1;
-#endif
-}
-#endif /* HAVE_GC_GET_SUSPEND_SIGNAL */
-
static void*
read_signal_pipe_data (void * data)
{
diff --git a/libguile/threads.c b/libguile/threads.c
index 994cf2c..a67f30b 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -25,6 +25,7 @@
#endif
#include "libguile/bdw-gc.h"
+#include <gc/gc_mark.h>
#include "libguile/_scm.h"
#include <stdlib.h>
@@ -65,199 +66,42 @@
#include "libguile/init.h"
#include "libguile/scmsigs.h"
#include "libguile/strings.h"
+#include "libguile/vm.h"
#include <full-read.h>
-/* First some libgc shims. */
+/* The GC "kind" for threads that allow them to mark their VM
+ stacks. */
+static int thread_gc_kind;
-/* Make sure GC_fn_type is defined; it is missing from the public
- headers of GC 7.1 and earlier. */
-#ifndef HAVE_GC_FN_TYPE
-typedef void * (* GC_fn_type) (void *);
-#endif
-
-
-#ifndef GC_SUCCESS
-#define GC_SUCCESS 0
-#endif
-
-#ifndef GC_UNIMPLEMENTED
-#define GC_UNIMPLEMENTED 3
-#endif
-
-/* Likewise struct GC_stack_base is missing before 7.1. */
-#ifndef HAVE_GC_STACK_BASE
-struct GC_stack_base {
- void * mem_base; /* Base of memory stack. */
-#ifdef __ia64__
- void * reg_base; /* Base of separate register stack. */
-#endif
-};
-
-static int
-GC_register_my_thread (struct GC_stack_base *stack_base)
-{
- return GC_UNIMPLEMENTED;
-}
-
-static void
-GC_unregister_my_thread ()
-{
-}
-
-#if !SCM_USE_PTHREAD_THREADS
-/* No threads; we can just use GC_stackbottom. */
-static void *
-get_thread_stack_base ()
-{
- return GC_stackbottom;
-}
-
-#elif defined HAVE_PTHREAD_ATTR_GETSTACK && defined HAVE_PTHREAD_GETATTR_NP \
- && defined PTHREAD_ATTR_GETSTACK_WORKS
-/* This method for GNU/Linux and perhaps some other systems.
- It's not for MacOS X or Solaris 10, since pthread_getattr_np is not
- available on them. */
-static void *
-get_thread_stack_base ()
-{
- pthread_attr_t attr;
- void *start, *end;
- size_t size;
-
- pthread_getattr_np (pthread_self (), &attr);
- pthread_attr_getstack (&attr, &start, &size);
- end = (char *)start + size;
-
-#if SCM_STACK_GROWS_UP
- return start;
-#else
- return end;
-#endif
-}
-
-#elif defined HAVE_PTHREAD_GET_STACKADDR_NP
-/* This method for MacOS X.
- It'd be nice if there was some documentation on pthread_get_stackaddr_np,
- but as of 2006 there's nothing obvious at apple.com. */
-static void *
-get_thread_stack_base ()
+static struct GC_ms_entry *
+thread_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
+ struct GC_ms_entry *mark_stack_limit, GC_word env)
{
- return pthread_get_stackaddr_np (pthread_self ());
-}
+ int word;
+ const struct scm_i_thread *t = (struct scm_i_thread *) addr;
-#elif HAVE_PTHREAD_ATTR_GET_NP
-/* This one is for FreeBSD 9. */
-static void *
-get_thread_stack_base ()
-{
- pthread_attr_t attr;
- void *start, *end;
- size_t size;
+ if (SCM_UNPACK (t->handle) == 0)
+ /* T must be on the free-list; ignore. (See warning in
+ gc_mark.h.) */
+ return mark_stack_ptr;
- pthread_attr_init (&attr);
- pthread_attr_get_np (pthread_self (), &attr);
- pthread_attr_getstack (&attr, &start, &size);
- pthread_attr_destroy (&attr);
+ /* Mark T. We could be more precise, but it doesn't matter. */
+ for (word = 0; word * sizeof (*addr) < sizeof (*t); word++)
+ mark_stack_ptr = GC_MARK_AND_PUSH ((void *) addr[word],
+ mark_stack_ptr, mark_stack_limit,
+ NULL);
- end = (char *)start + size;
+ if (t->vp)
+ mark_stack_ptr = scm_i_vm_mark_stack (t->vp, mark_stack_ptr,
+ mark_stack_limit);
-#if SCM_STACK_GROWS_UP
- return start;
-#else
- return end;
-#endif
+ return mark_stack_ptr;
}
-#else
-#error Threads enabled with old BDW-GC, but missing get_thread_stack_base
impl. Please upgrade to libgc >= 7.1.
-#endif
-
-static int
-GC_get_stack_base (struct GC_stack_base *stack_base)
-{
- stack_base->mem_base = get_thread_stack_base ();
-#ifdef __ia64__
- /* Calculate and store off the base of this thread's register
- backing store (RBS). Unfortunately our implementation(s) of
- scm_ia64_register_backing_store_base are only reliable for the
- main thread. For other threads, therefore, find out the current
- top of the RBS, and use that as a maximum. */
- stack_base->reg_base = scm_ia64_register_backing_store_base ();
- {
- ucontext_t ctx;
- void *bsp;
- getcontext (&ctx);
- bsp = scm_ia64_ar_bsp (&ctx);
- if (stack_base->reg_base > bsp)
- stack_base->reg_base = bsp;
- }
-#endif
- return GC_SUCCESS;
-}
-
-static void *
-GC_call_with_stack_base(void * (*fn) (struct GC_stack_base*, void*), void *arg)
-{
- struct GC_stack_base stack_base;
-
- stack_base.mem_base = (void*)&stack_base;
-#ifdef __ia64__
- /* FIXME: Untested. */
- {
- ucontext_t ctx;
- getcontext (&ctx);
- stack_base.reg_base = scm_ia64_ar_bsp (&ctx);
- }
-#endif
-
- return fn (&stack_base, arg);
-}
-#endif /* HAVE_GC_STACK_BASE */
-
-
-/* Now define with_gc_active and with_gc_inactive. */
-
-#if (defined(HAVE_GC_DO_BLOCKING) && defined (HAVE_DECL_GC_DO_BLOCKING) &&
defined (HAVE_GC_CALL_WITH_GC_ACTIVE))
-
-/* We have a sufficiently new libgc (7.2 or newer). */
-
-static void*
-with_gc_inactive (GC_fn_type func, void *data)
-{
- return GC_do_blocking (func, data);
-}
-
-static void*
-with_gc_active (GC_fn_type func, void *data)
-{
- return GC_call_with_gc_active (func, data);
-}
-
-#else
-
-/* libgc not new enough, so never actually deactivate GC.
-
- Note that though GC 7.1 does have a GC_do_blocking, it doesn't have
- GC_call_with_gc_active. */
-
-static void*
-with_gc_inactive (GC_fn_type func, void *data)
-{
- return func (data);
-}
-
-static void*
-with_gc_active (GC_fn_type func, void *data)
-{
- return func (data);
-}
-
-#endif /* HAVE_GC_DO_BLOCKING */
-
static void
@@ -278,6 +122,7 @@ to_timespec (SCM t, scm_t_timespec *waittime)
}
}
+
/*** Queues */
@@ -562,6 +407,7 @@ guilify_self_1 (struct GC_stack_base *base)
t.sleep_mutex = NULL;
t.sleep_object = SCM_BOOL_F;
t.sleep_fd = -1;
+ t.vp = NULL;
if (pipe2 (t.sleep_pipe, O_CLOEXEC) != 0)
/* FIXME: Error conditions during the initialization phase are handled
@@ -570,8 +416,6 @@ guilify_self_1 (struct GC_stack_base *base)
abort ();
scm_i_pthread_mutex_init (&t.admin_mutex, NULL);
- t.current_mark_stack_ptr = NULL;
- t.current_mark_stack_limit = NULL;
t.canceled = 0;
t.exited = 0;
t.guile_mode = 0;
@@ -581,7 +425,7 @@ guilify_self_1 (struct GC_stack_base *base)
scm_i_thread *t_ptr = &t;
GC_disable ();
- t_ptr = GC_malloc (sizeof (scm_i_thread));
+ t_ptr = GC_generic_malloc (sizeof (*t_ptr), thread_gc_kind);
memcpy (t_ptr, &t, sizeof t);
scm_i_pthread_setspecific (scm_i_thread_key, t_ptr);
@@ -614,7 +458,6 @@ guilify_self_2 (SCM parent)
t->continuation_root = scm_cons (t->handle, SCM_EOL);
t->continuation_base = t->base;
- t->vp = NULL;
if (scm_is_true (parent))
t->dynamic_state = scm_make_dynamic_state (parent);
@@ -781,6 +624,12 @@ on_thread_exit (void *v)
scm_i_pthread_setspecific (scm_i_thread_key, NULL);
+ if (t->vp)
+ {
+ scm_i_vm_free_stack (t->vp);
+ t->vp = NULL;
+ }
+
#if SCM_USE_PTHREAD_THREADS
GC_unregister_my_thread ();
#endif
@@ -835,7 +684,7 @@ scm_i_init_thread_for_guile (struct GC_stack_base *base,
SCM parent)
*/
scm_i_init_guile (base);
-#if defined (HAVE_GC_ALLOW_REGISTER_THREADS) && SCM_USE_PTHREAD_THREADS
+#if SCM_USE_PTHREAD_THREADS
/* Allow other threads to come in later. */
GC_allow_register_threads ();
#endif
@@ -934,7 +783,7 @@ with_guile_and_parent (struct GC_stack_base *base, void
*data)
#endif
t->guile_mode = 1;
- res = with_gc_active (with_guile_trampoline, args);
+ res = GC_call_with_gc_active (with_guile_trampoline, args);
t->guile_mode = 0;
}
return res;
@@ -968,7 +817,7 @@ scm_without_guile (void *(*func)(void *), void *data)
if (t->guile_mode)
{
SCM_I_CURRENT_THREAD->guile_mode = 0;
- result = with_gc_inactive (func, data);
+ result = GC_do_blocking (func, data);
SCM_I_CURRENT_THREAD->guile_mode = 1;
}
else
@@ -2189,6 +2038,11 @@ scm_threads_prehistory (void *base)
scm_i_pthread_mutex_init (&scm_i_misc_mutex, NULL);
scm_i_pthread_cond_init (&wake_up_cond, NULL);
+ thread_gc_kind =
+ GC_new_kind (GC_new_free_list (),
+ GC_MAKE_PROC (GC_new_proc (thread_mark), 0),
+ 0, 1);
+
guilify_self_1 ((struct GC_stack_base *) base);
}
diff --git a/libguile/threads.h b/libguile/threads.h
index 3b67aac..d34e1ab 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -72,11 +72,6 @@ typedef struct scm_i_thread {
scm_i_pthread_cond_t sleep_cond;
int sleep_fd, sleep_pipe[2];
- /* XXX: These two fields used to hold information about the BDW-GC
- mark stack during the mark phase. They are no longer used. */
- void *current_mark_stack_ptr;
- void *current_mark_stack_limit;
-
/* Other thread local things.
*/
SCM dynamic_state;
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 34d2090..4ae2aa7 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -88,7 +88,7 @@
do { \
if (SCM_UNLIKELY (!(condition))) \
{ \
- SYNC_ALL(); \
+ SYNC_IP(); \
handler; \
} \
} while (0)
@@ -104,8 +104,9 @@
do { \
if (SCM_UNLIKELY (vp->trace_level > 0)) \
{ \
- SYNC_REGISTER (); \
+ SYNC_IP (); \
exp; \
+ CACHE_FP (); \
} \
} while (0)
#else
@@ -128,7 +129,7 @@
RUN_HOOK0 (restore_continuation)
#define VM_HANDLE_INTERRUPTS \
- SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
+ SCM_ASYNC_TICK_WITH_GUARD_CODE (current_thread, SYNC_IP (), CACHE_FP ())
/* Virtual Machine
@@ -157,16 +158,23 @@
whenever we would need to know the IP of the top frame. In practice,
we need to SYNC_IP whenever we call out of the VM to a function that
would like to walk the stack, perhaps as the result of an
- exception. */
+ exception.
+
+ One more thing. We allow the stack to move, when it expands.
+ Therefore if you call out to a C procedure that could call Scheme
+ code, or otherwise push anything on the stack, you will need to
+ CACHE_FP afterwards to restore the possibly-changed FP. */
+
+#define SYNC_IP() vp->ip = (ip)
+
+#define CACHE_FP() fp = (vp->fp)
+#define CACHE_REGISTER() \
+ do { \
+ ip = vp->ip; \
+ fp = vp->fp; \
+ } while (0)
-#define SYNC_IP() \
- vp->ip = (ip)
-#define SYNC_REGISTER() \
- SYNC_IP()
-#define SYNC_BEFORE_GC() /* Only SP and FP needed to trace GC */
-#define SYNC_ALL() /* FP already saved */ \
- SYNC_IP()
/* After advancing vp->sp, but before writing any stack slots, check
that it is actually in bounds. If it is not in bounds, currently we
@@ -177,8 +185,9 @@
do { \
if (SCM_UNLIKELY (vp->sp >= vp->stack_limit)) \
{ \
- vm_error_stack_overflow (vp); \
- CACHE_REGISTER(); \
+ SYNC_IP (); \
+ vm_expand_stack (vp); \
+ CACHE_FP (); \
} \
} while (0)
@@ -212,12 +221,6 @@
} while (0)
-#define CACHE_REGISTER() \
- do { \
- ip = vp->ip; \
- fp = vp->fp; \
- } while (0)
-
#ifdef HAVE_LABELS_AS_VALUES
# define BEGIN_DISPATCH_SWITCH /* */
# define END_DISPATCH_SWITCH /* */
@@ -264,8 +267,9 @@
#define RETURN_ONE_VALUE(ret) \
do { \
SCM val = ret; \
- SCM *old_fp = fp; \
+ SCM *old_fp; \
VM_HANDLE_INTERRUPTS; \
+ old_fp = fp; \
ip = SCM_FRAME_RETURN_ADDRESS (fp); \
fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); \
/* Clear frame. */ \
@@ -360,6 +364,7 @@
SCM res; \
SYNC_IP (); \
res = srel (x, y); \
+ CACHE_FP (); \
if ((ip[1] & 0x1) ? scm_is_false (res) : scm_is_true (res)) \
{ \
scm_t_int32 offset = ip[1]; \
@@ -385,6 +390,8 @@
a2 = LOCAL_REF (src2)
#define RETURN(x) \
do { LOCAL_SET (dst, x); NEXT (1); } while (0)
+#define RETURN_EXP(exp) \
+ do { SCM __x; SYNC_IP (); __x = exp; CACHE_FP (); RETURN (__x); } while (0)
/* The maximum/minimum tagged integers. */
#define INUM_MAX \
@@ -404,8 +411,7 @@
if (SCM_FIXABLE (n)) \
RETURN (SCM_I_MAKINUM (n)); \
} \
- SYNC_IP (); \
- RETURN (SFUNC (x, y)); \
+ RETURN_EXP (SFUNC (x, y)); \
}
#define VM_VALIDATE_PAIR(x, proc) \
@@ -518,7 +524,6 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
{
scm_t_uint32 n;
ret = SCM_EOL;
- SYNC_BEFORE_GC();
for (n = nvals; n > 0; n--)
ret = scm_cons (LOCAL_REF (4 + n - 1), ret);
ret = scm_values (ret);
@@ -547,13 +552,14 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
VM_DEFINE_OP (1, call, "call", OP2 (U8_U24, X8_U24))
{
scm_t_uint32 proc, nlocals;
- SCM *old_fp = fp;
+ SCM *old_fp;
UNPACK_24 (op, proc);
UNPACK_24 (ip[1], nlocals);
VM_HANDLE_INTERRUPTS;
+ old_fp = fp;
fp = vp->fp = old_fp + proc;
SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
SCM_FRAME_SET_RETURN_ADDRESS (fp, ip + 2);
@@ -688,9 +694,11 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
*/
VM_DEFINE_OP (7, return_values, "return-values", OP1 (U8_X24))
{
- SCM *old_fp = fp;
+ SCM *old_fp;
VM_HANDLE_INTERRUPTS;
+
+ old_fp = fp;
ip = SCM_FRAME_RETURN_ADDRESS (fp);
fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
@@ -770,7 +778,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
abort ();
}
- // NULLSTACK_FOR_NONLOCAL_EXIT ();
+ CACHE_FP ();
if (SCM_UNLIKELY (SCM_VALUESP (ret)))
/* multiple values returned to continuation */
@@ -804,7 +812,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
// FIXME: separate args
ret = scm_i_foreign_call (scm_cons (cif, pointer), LOCAL_ADDRESS (1));
- // NULLSTACK_FOR_NONLOCAL_EXIT ();
+ CACHE_FP ();
if (SCM_UNLIKELY (SCM_VALUESP (ret)))
/* multiple values returned to continuation */
@@ -1395,7 +1403,8 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
* If the value in A is equal? to the value in B, add OFFSET, a signed
* 24-bit number, to the current instruction pointer.
*/
- // FIXME: should sync_ip before calling out?
+ // FIXME: Should sync_ip before calling out and cache_fp before coming
+ // back! Another reason to remove this opcode!
VM_DEFINE_OP (38, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, B1_X7_L24))
{
BR_BINARY (x, y,
@@ -1809,6 +1818,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
SYNC_IP ();
var = scm_lookup (LOCAL_REF (sym));
+ CACHE_FP ();
if (ip[1] & 0x1)
VM_ASSERT (VARIABLE_BOUNDP (var),
vm_error_unbound (fp[0], LOCAL_REF (sym)));
@@ -1828,6 +1838,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
UNPACK_12_12 (op, sym, val);
SYNC_IP ();
scm_define (LOCAL_REF (sym), LOCAL_REF (val));
+ CACHE_FP ();
NEXT (1);
}
@@ -1887,6 +1898,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
mod = scm_the_root_module ();
var = scm_module_lookup (mod, sym);
+ CACHE_FP ();
if (ip[4] & 0x1)
VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[0], sym));
@@ -1949,6 +1961,8 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
else
var = scm_private_lookup (SCM_CDR (modname), sym);
+ CACHE_FP ();
+
if (ip[4] & 0x1)
VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[0], sym));
@@ -2310,8 +2324,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
RETURN (result);
}
- SYNC_IP ();
- RETURN (scm_sum (x, SCM_I_MAKINUM (1)));
+ RETURN_EXP (scm_sum (x, SCM_I_MAKINUM (1)));
}
/* sub dst:8 a:8 b:8
@@ -2344,8 +2357,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
RETURN (result);
}
- SYNC_IP ();
- RETURN (scm_difference (x, SCM_I_MAKINUM (1)));
+ RETURN_EXP (scm_difference (x, SCM_I_MAKINUM (1)));
}
/* mul dst:8 a:8 b:8
@@ -2355,8 +2367,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
VM_DEFINE_OP (83, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
- SYNC_IP ();
- RETURN (scm_product (x, y));
+ RETURN_EXP (scm_product (x, y));
}
/* div dst:8 a:8 b:8
@@ -2366,8 +2377,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
VM_DEFINE_OP (84, div, "div", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
- SYNC_IP ();
- RETURN (scm_divide (x, y));
+ RETURN_EXP (scm_divide (x, y));
}
/* quo dst:8 a:8 b:8
@@ -2377,8 +2387,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
VM_DEFINE_OP (85, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
- SYNC_IP ();
- RETURN (scm_quotient (x, y));
+ RETURN_EXP (scm_quotient (x, y));
}
/* rem dst:8 a:8 b:8
@@ -2388,8 +2397,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
VM_DEFINE_OP (86, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
- SYNC_IP ();
- RETURN (scm_remainder (x, y));
+ RETURN_EXP (scm_remainder (x, y));
}
/* mod dst:8 a:8 b:8
@@ -2399,8 +2407,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
VM_DEFINE_OP (87, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
- SYNC_IP ();
- RETURN (scm_modulo (x, y));
+ RETURN_EXP (scm_modulo (x, y));
}
/* ash dst:8 a:8 b:8
@@ -2435,8 +2442,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
}
/* fall through */
}
- SYNC_IP ();
- RETURN (scm_ash (x, y));
+ RETURN_EXP (scm_ash (x, y));
}
/* logand dst:8 a:8 b:8
@@ -2449,8 +2455,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
/* Compute bitwise AND without untagging */
RETURN (SCM_PACK (SCM_UNPACK (x) & SCM_UNPACK (y)));
- SYNC_IP ();
- RETURN (scm_logand (x, y));
+ RETURN_EXP (scm_logand (x, y));
}
/* logior dst:8 a:8 b:8
@@ -2463,8 +2468,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
/* Compute bitwise OR without untagging */
RETURN (SCM_PACK (SCM_UNPACK (x) | SCM_UNPACK (y)));
- SYNC_IP ();
- RETURN (scm_logior (x, y));
+ RETURN_EXP (scm_logior (x, y));
}
/* logxor dst:8 a:8 b:8
@@ -2476,8 +2480,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
ARGS2 (x, y);
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) ^ SCM_I_INUM (y)));
- SYNC_IP ();
- RETURN (scm_logxor (x, y));
+ RETURN_EXP (scm_logxor (x, y));
}
/* make-vector/immediate dst:8 length:8 init:8
@@ -3232,10 +3235,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
#undef RUN_HOOK
#undef RUN_HOOK0
#undef RUN_HOOK1
-#undef SYNC_ALL
-#undef SYNC_BEFORE_GC
#undef SYNC_IP
-#undef SYNC_REGISTER
#undef UNPACK_8_8_8
#undef UNPACK_8_16
#undef UNPACK_16_8
diff --git a/libguile/vm.c b/libguile/vm.c
index 3c28c17..0ccc9f1 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -16,6 +16,9 @@
* 02110-1301 USA
*/
+/* For mremap(2) on GNU/Linux systems. */
+#define _GNU_SOURCE
+
#if HAVE_CONFIG_H
# include <config.h>
#endif
@@ -26,6 +29,10 @@
#include <string.h>
#include <stdint.h>
+#ifdef HAVE_SYS_MMAN_H
+#include <sys/mman.h>
+#endif
+
#include "libguile/bdw-gc.h"
#include <gc/gc_mark.h>
@@ -56,16 +63,6 @@ static SCM sym_debug;
/* #define VM_ENABLE_PARANOID_ASSERTIONS */
-/* When defined, arrange so that the GC doesn't scan the VM stack beyond its
- current SP. This should help avoid excess data retention. See
-
http://thread.gmane.org/gmane.comp.programming.garbage-collection.boehmgc/3001
- for a discussion. */
-#define VM_ENABLE_PRECISE_STACK_GC_SCAN
-
-/* Size in SCM objects of the stack reserve. The reserve is used to run
- exception handling code in case of a VM stack overflow. */
-#define VM_STACK_RESERVE_SIZE 512
-
/*
@@ -383,7 +380,6 @@ static void vm_error_kwargs_unrecognized_keyword (SCM proc,
SCM kw) SCM_NORETURN
static void vm_error_too_many_args (int nargs) SCM_NORETURN SCM_NOINLINE;
static void vm_error_wrong_num_args (SCM proc) SCM_NORETURN SCM_NOINLINE;
static void vm_error_wrong_type_apply (SCM proc) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_stack_overflow (struct scm_vm *vp) SCM_NORETURN
SCM_NOINLINE;
static void vm_error_stack_underflow (void) SCM_NORETURN SCM_NOINLINE;
static void vm_error_improper_list (SCM x) SCM_NORETURN SCM_NOINLINE;
static void vm_error_not_a_pair (const char *subr, SCM x) SCM_NORETURN
SCM_NOINLINE;
@@ -484,20 +480,6 @@ vm_error_wrong_type_apply (SCM proc)
}
static void
-vm_error_stack_overflow (struct scm_vm *vp)
-{
- if (vp->stack_limit < vp->stack_base + vp->stack_size)
- /* There are VM_STACK_RESERVE_SIZE bytes left. Make them available so
- that `throw' below can run on this VM. */
- vp->stack_limit = vp->stack_base + vp->stack_size;
- else
- /* There is no space left on the stack. FIXME: Do something more
- sensible here! */
- abort ();
- vm_error ("VM: Stack overflow", SCM_UNDEFINED);
-}
-
-static void
vm_error_stack_underflow (void)
{
vm_error ("VM: Stack underflow", SCM_UNDEFINED);
@@ -678,18 +660,25 @@ scm_i_call_with_current_continuation (SCM proc)
* VM
*/
-#define VM_MIN_STACK_SIZE (1024)
-#define VM_DEFAULT_STACK_SIZE (256 * 1024)
-static size_t vm_stack_size = VM_DEFAULT_STACK_SIZE;
+/* Hard stack limit is 512M words: 2 gigabytes on 32-bit machines, 4 on
+ 64-bit machines. */
+static const size_t hard_max_stack_size = 512 * 1024 * 1024;
+
+/* Initial stack size: 4 or 8 kB. */
+static const size_t initial_stack_size = 1024;
+
+/* Default soft stack limit is 1M words (4 or 8 megabytes). */
+static size_t default_max_stack_size = 1024 * 1024;
static void
initialize_default_stack_size (void)
{
- int size = scm_getenv_int ("GUILE_STACK_SIZE", vm_stack_size);
- if (size >= VM_MIN_STACK_SIZE)
- vm_stack_size = size;
+ int size = scm_getenv_int ("GUILE_STACK_SIZE", (int) default_max_stack_size);
+ if (size >= initial_stack_size && (size_t) size < ((size_t) -1) /
sizeof(SCM))
+ default_max_stack_size = size;
}
+static void vm_expand_stack (struct scm_vm *vp) SCM_NOINLINE;
#define VM_NAME vm_regular_engine
#define VM_USE_HOOKS 0
#define FUNC_NAME "vm-regular-engine"
@@ -712,12 +701,73 @@ typedef SCM (*scm_t_vm_engine) (scm_i_thread
*current_thread, struct scm_vm *vp,
static const scm_t_vm_engine vm_engines[SCM_VM_NUM_ENGINES] =
{ vm_regular_engine, vm_debug_engine };
-#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
+static SCM*
+allocate_stack (size_t size)
+#define FUNC_NAME "make_vm"
+{
+ void *ret;
+
+ if (size >= ((size_t) -1) / sizeof (SCM))
+ abort ();
+
+ size *= sizeof (SCM);
+
+#if HAVE_SYS_MMAN_H
+ ret = mmap (NULL, size, PROT_READ | PROT_WRITE,
+ MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
+ if (ret == MAP_FAILED)
+ SCM_SYSERROR;
+#else
+ ret = malloc (size);
+ if (!ret)
+ SCM_SYSERROR;
+#endif
+
+ return (SCM *) ret;
+}
+#undef FUNC_NAME
+
+static void
+free_stack (SCM *stack, size_t size)
+{
+ size *= sizeof (SCM);
+
+#if HAVE_SYS_MMAN_H
+ munmap (stack, size);
+#else
+ free (stack);
+#endif
+}
+
+static SCM*
+expand_stack (SCM *old_stack, size_t old_size, size_t new_size)
+#define FUNC_NAME "expand_stack"
+{
+#if defined MREMAP_MAYMOVE
+ void *new_stack;
+
+ if (new_size >= ((size_t) -1) / sizeof (SCM))
+ abort ();
+
+ old_size *= sizeof (SCM);
+ new_size *= sizeof (SCM);
+
+ new_stack = mremap (old_stack, old_size, new_size, MREMAP_MAYMOVE);
+ if (new_stack == MAP_FAILED)
+ SCM_SYSERROR;
-/* The GC "kind" for the VM stack. */
-static int vm_stack_gc_kind;
+ return (SCM *) new_stack;
+#else
+ SCM *new_stack;
+
+ new_stack = allocate_stack (new_size);
+ memcpy (new_stack, old_stack, old_size * sizeof (SCM));
+ free_stack (old_stack, old_size);
+ return new_stack;
#endif
+}
+#undef FUNC_NAME
static struct scm_vm *
make_vm (void)
@@ -728,23 +778,10 @@ make_vm (void)
vp = scm_gc_malloc (sizeof (struct scm_vm), "vm");
- vp->stack_size= vm_stack_size;
-
-#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
- vp->stack_base = (SCM *)
- GC_generic_malloc (vp->stack_size * sizeof (SCM), vm_stack_gc_kind);
-
- /* Keep a pointer to VP so that `vm_stack_mark ()' can know what the stack
- top is. */
- *vp->stack_base = SCM_PACK_POINTER (vp);
- vp->stack_base++;
- vp->stack_size--;
-#else
- vp->stack_base = scm_gc_malloc (vp->stack_size * sizeof (SCM),
- "stack-base");
-#endif
-
- vp->stack_limit = vp->stack_base + vp->stack_size - VM_STACK_RESERVE_SIZE;
+ vp->stack_size = initial_stack_size;
+ vp->stack_base = allocate_stack (vp->stack_size);
+ vp->stack_limit = vp->stack_base + vp->stack_size;
+ vp->max_stack_size = default_max_stack_size;
vp->ip = NULL;
vp->sp = vp->stack_base - 1;
vp->fp = NULL;
@@ -757,36 +794,109 @@ make_vm (void)
}
#undef FUNC_NAME
-#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
-
/* Mark the VM stack region between its base and its current top. */
-static struct GC_ms_entry *
-vm_stack_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
- struct GC_ms_entry *mark_stack_limit, GC_word env)
+struct GC_ms_entry *
+scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry *mark_stack_ptr,
+ struct GC_ms_entry *mark_stack_limit)
{
- GC_word *word;
- const struct scm_vm *vm;
+ SCM *sp, *fp;
- /* The first word of the VM stack should contain a pointer to the
- corresponding VM. */
- vm = * ((struct scm_vm **) addr);
-
- if (vm == NULL
- || (SCM *) addr != vm->stack_base - 1)
- /* ADDR must be a pointer to a free-list element, which we must ignore
- (see warning in <gc/gc_mark.h>). */
- return mark_stack_ptr;
-
- for (word = (GC_word *) vm->stack_base; word <= (GC_word *) vm->sp; word++)
- mark_stack_ptr = GC_MARK_AND_PUSH ((* (GC_word **) word),
- mark_stack_ptr, mark_stack_limit,
- NULL);
+ for (fp = vp->fp, sp = vp->sp; fp; fp = SCM_FRAME_DYNAMIC_LINK (fp))
+ {
+ for (; sp >= &SCM_FRAME_LOCAL (fp, 0); sp--)
+ {
+ SCM elt = *sp;
+ if (SCM_NIMP (elt))
+ mark_stack_ptr = GC_MARK_AND_PUSH ((GC_word *) elt,
+ mark_stack_ptr,
mark_stack_limit,
+ NULL);
+ }
+ sp = SCM_FRAME_PREVIOUS_SP (fp);
+ }
return mark_stack_ptr;
}
-#endif /* VM_ENABLE_PRECISE_STACK_GC_SCAN */
+/* Free the VM stack, as this thread is exiting. */
+void
+scm_i_vm_free_stack (struct scm_vm *vp)
+{
+ free_stack (vp->stack_base, vp->stack_size);
+ vp->stack_base = vp->stack_limit = NULL;
+ vp->stack_size = 0;
+}
+static void
+vm_expand_stack (struct scm_vm *vp)
+{
+ scm_t_ptrdiff stack_size = vp->sp + 1 - vp->stack_base;
+
+ if (stack_size > hard_max_stack_size)
+ {
+ /* We have expanded the soft limit to the point that we reached a
+ hard limit. There is nothing sensible to do. */
+ fprintf (stderr, "Hard stack size limit (%zu words) reached;
aborting.\n",
+ hard_max_stack_size);
+ abort ();
+ }
+
+ if (stack_size > vp->stack_size)
+ {
+ SCM *old_stack;
+ size_t new_size;
+ scm_t_ptrdiff reloc;
+
+ new_size = vp->stack_size;
+ while (new_size < stack_size)
+ new_size *= 2;
+ old_stack = vp->stack_base;
+ vp->stack_base = expand_stack (old_stack, vp->stack_size, new_size);
+ vp->stack_size = new_size;
+ vp->stack_limit = vp->stack_base + new_size;
+ reloc = vp->stack_base - old_stack;
+
+ if (reloc)
+ {
+ SCM *fp;
+ vp->fp += reloc;
+ vp->sp += reloc;
+ fp = vp->fp;
+ while (fp)
+ {
+ SCM *next_fp = SCM_FRAME_DYNAMIC_LINK (fp);
+ if (next_fp)
+ {
+ next_fp += reloc;
+ SCM_FRAME_SET_DYNAMIC_LINK (fp, next_fp);
+ }
+ fp = next_fp;
+ }
+ }
+ }
+
+ if (stack_size >= vp->max_stack_size)
+ {
+ /* Expand the soft limit by 256K entries to give us space to
+ handle the error. */
+ vp->max_stack_size += 256 * 1024;
+
+ /* If it's still not big enough... it's quite improbable, but go
+ ahead and set to the full available stack size. */
+ if (vp->max_stack_size < stack_size)
+ vp->max_stack_size = vp->stack_size;
+
+ /* But don't exceed the hard maximum. */
+ if (vp->max_stack_size > hard_max_stack_size)
+ vp->max_stack_size = hard_max_stack_size;
+
+ /* Finally, reset the limit, to catch further overflows. */
+ vp->stack_limit = vp->stack_base + vp->max_stack_size;
+
+ vm_error ("VM: Stack overflow", SCM_UNDEFINED);
+ }
+
+ /* Otherwise continue, with the new enlarged stack. */
+}
static struct scm_vm *
thread_vm (scm_i_thread *t)
@@ -825,7 +935,7 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
base_frame_size = 3 + 3 + nargs + 3;
vp->sp += base_frame_size;
if (vp->sp >= vp->stack_limit)
- vm_error_stack_overflow (vp);
+ vm_expand_stack (vp);
base = vp->sp + 1 - base_frame_size;
/* Since it's possible to receive the arguments on the stack itself,
@@ -1102,14 +1212,6 @@ scm_bootstrap_vm (void)
vm_builtin_##builtin = scm_i_make_program (vm_builtin_##builtin##_code);
FOR_EACH_VM_BUILTIN (DEFINE_BUILTIN);
#undef DEFINE_BUILTIN
-
-#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
- vm_stack_gc_kind =
- GC_new_kind (GC_new_free_list (),
- GC_MAKE_PROC (GC_new_proc (vm_stack_mark), 0),
- 0, 1);
-
-#endif
}
void
diff --git a/libguile/vm.h b/libguile/vm.h
index 12481e1..387e0b8 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -44,6 +44,7 @@ struct scm_vm {
SCM *stack_base; /* stack base address */
SCM *stack_limit; /* stack limit address */
int trace_level; /* traces enabled if trace_level > 0 */
+ size_t max_stack_size;
SCM hooks[SCM_VM_NUM_HOOKS]; /* hooks */
int engine; /* which vm engine we're using */
};
@@ -65,6 +66,12 @@ SCM_API SCM scm_set_default_vm_engine_x (SCM engine);
SCM_API void scm_c_set_vm_engine_x (int engine);
SCM_API void scm_c_set_default_vm_engine_x (int engine);
+struct GC_ms_entry;
+SCM_INTERNAL struct GC_ms_entry * scm_i_vm_mark_stack (struct scm_vm *,
+ struct GC_ms_entry *,
+ struct GC_ms_entry *);
+SCM_INTERNAL void scm_i_vm_free_stack (struct scm_vm *vp);
+
#define SCM_F_VM_CONT_PARTIAL 0x1
#define SCM_F_VM_CONT_REWINDABLE 0x2
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-457-g22d425e,
Andy Wingo <=