[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-811-g48c2a53
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-811-g48c2a53 |
|
Date: |
Mon, 17 Mar 2014 09:13:22 +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=48c2a5395ab647e61fb8f22c344beeded02b8218
The branch, master has been updated
via 48c2a5395ab647e61fb8f22c344beeded02b8218 (commit)
via f883ae59a021065798f5a60799cf44966df751fb (commit)
via ed59b70a541bae95f1ff81f37eb083e791e98124 (commit)
via f87a7327a54e10ec3ed77a6192a0cd38fed3a9c9 (commit)
via c2379a5b45a493c35ea90d64857a59e7832466be (commit)
via 9d3aa47b6124d1d4b532a8f97f9fdeae3a8032c3 (commit)
via bf7e38643d5143d0e37960e4439bfc466699e29a (commit)
via 22806c244a624d3fd801ba739ca0670702815a6e (commit)
via f57d4316c2048f0c58a47c56b63d25d10511f98f (commit)
via 4189a5c0bd4c235c383b043bef69dc66a7ef64d0 (commit)
via f764e2590fa1dbcafc5f188e1acc085e6fc6337b (commit)
from 3c3de73d4da32d2ae6371134a26449302524b8e0 (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 48c2a5395ab647e61fb8f22c344beeded02b8218
Author: Andy Wingo <address@hidden>
Date: Mon Mar 17 10:10:36 2014 +0100
DFG inlines uses of for-each
* module/language/cps/dfg.scm (for-each, for-each/2): Define inline
versions of these. Adapt callers.
commit f883ae59a021065798f5a60799cf44966df751fb
Author: Andy Wingo <address@hidden>
Date: Sun Mar 16 19:58:30 2014 +0100
Optimize srfi-1 for-each with two lists.
* module/srfi/srfi-1.scm (for-each): Optimize for the two-list case.
commit ed59b70a541bae95f1ff81f37eb083e791e98124
Author: Andy Wingo <address@hidden>
Date: Sun Mar 16 19:48:48 2014 +0100
Simplify boot-9 for-each with two lists
* module/ice-9/boot-9.scm (for-each): Simplify the two-argument case in
the same way as the one-argument case.
commit f87a7327a54e10ec3ed77a6192a0cd38fed3a9c9
Author: Andy Wingo <address@hidden>
Date: Sun Mar 2 12:38:32 2014 +0100
More for-each micro-optimizations
* module/ice-9/boot-9.scm (for-each):
* module/srfi/srfi-1.scm (for-each): Re-implement one-list case using an
explicit check for list? instead of the tortoise-hare thing. Seems to
be faster!
commit c2379a5b45a493c35ea90d64857a59e7832466be
Author: Andy Wingo <address@hidden>
Date: Sun Mar 16 16:28:28 2014 +0100
Doc and NEWS updates
* NEWS: Update section on dynamic stacks. Add link for intptr
interfaces.
* doc/ref/api-data.texi (Integers): Add intptr interfaces.
commit 9d3aa47b6124d1d4b532a8f97f9fdeae3a8032c3
Author: Andy Wingo <address@hidden>
Date: Sun Mar 16 15:50:27 2014 +0100
Debug options doc fix.
* doc/ref/api-debug.texi (Debug Options): Fix.
commit bf7e38643d5143d0e37960e4439bfc466699e29a
Author: Andy Wingo <address@hidden>
Date: Sun Mar 16 15:46:28 2014 +0100
Refine unwind-only exception message.
* libguile/throw.c (throw_without_pre_unwind): Refine warning message.
commit 22806c244a624d3fd801ba739ca0670702815a6e
Author: Andy Wingo <address@hidden>
Date: Sun Mar 16 15:27:26 2014 +0100
Document stack-overflow handlers, limits, and unwind-only exceptions
* module/system/repl/error-handling.scm (call-with-error-handling): Add
#:report-keys kwarg, so that unwind-only exceptions (stack-overflow in
particular) get reported.
* doc/ref/api-debug.texi (Pre-Unwind Debugging): Add documentation for
#:report-keys kwarg of call-with-error-handling.
(Stack Overflow): New subsubsection.
(Debug Options): Remove discussion of stack overflow.
commit f57d4316c2048f0c58a47c56b63d25d10511f98f
Author: Andy Wingo <address@hidden>
Date: Sat Mar 15 19:30:26 2014 +0100
Add call-with-stack-overflow-handler tests
* test-suite/tests/eval.test ("stack overflow handlers"): Add
call-with-stack-overflow-handler tests, replacing the old stack
overflow test.
commit 4189a5c0bd4c235c383b043bef69dc66a7ef64d0
Author: Andy Wingo <address@hidden>
Date: Sat Mar 15 18:56:18 2014 +0100
Add stack overflow test
* libguile/throw.c (throw_without_pre_unwind): Newline after the
unwind-only warning.
* test-suite/standalone/Makefile.am:
* test-suite/standalone/test-stack-overflow: New test to handle
mmap/malloc failure.
commit f764e2590fa1dbcafc5f188e1acc085e6fc6337b
Author: Andy Wingo <address@hidden>
Date: Wed Mar 12 17:18:13 2014 +0100
Remove default soft stack limit; add call-with-stack-overflow-handler
* libguile/vm.h:
* libguile/vm.c (default_max_stack_size, initialize_default_stack_size):
Remove the default stack limit. In this way, programs run from the
command line or outside of the REPL will have no soft stack limit.
(make_vm): Change `max_stack_size' field to be a stack of limits and
handlers.
(current_overflow_size, should_handle_stack_overflow)
(reset_stack_limit, wind_overflow_handler, unwind_overflow_handler)
(vm_expand_stack): If the stack surpasses a user-set limit, call the
user-specified handler within its outer stack limit.
(call-with-stack-overflow-handler): New interface.
* module/system/vm/vm.scm: Export call-with-stack-overflow-handler.
-----------------------------------------------------------------------
Summary of changes:
NEWS | 13 +-
doc/ref/api-data.texi | 4 +
doc/ref/api-debug.texi | 242 ++++++++++++++++++++++-------
libguile/throw.c | 10 +-
libguile/vm.c | 187 +++++++++++++++++-----
libguile/vm.h | 5 +-
module/ice-9/boot-9.scm | 57 ++-----
module/language/cps/dfg.scm | 31 +++-
module/srfi/srfi-1.scm | 38 +++--
module/system/repl/error-handling.scm | 48 +++---
module/system/vm/vm.scm | 3 +-
test-suite/standalone/Makefile.am | 5 +-
test-suite/standalone/test-stack-overflow | 38 +++++
test-suite/tests/eval.test | 93 ++++++++++-
14 files changed, 563 insertions(+), 211 deletions(-)
create mode 100755 test-suite/standalone/test-stack-overflow
diff --git a/NEWS b/NEWS
index 1808dcb..c807155 100644
--- a/NEWS
+++ b/NEWS
@@ -52,12 +52,13 @@ in the same way as the editor we know and love.
** Dynamically expandable stacks
Instead of allocating fixed stack sizes for running Scheme code, Guile
-now starts off each thread with only one or two pages of stack, and
-expands it dynamically as needed. Guile will throw an exception for
-stack overflows at some user-defined limit. See the manual for
-documentation on the GUILE_STACK_SIZE environment variable.
+now starts off each thread with only one page of stack, and expands and
+shrinks it dynamically as needed. Guile will throw an exception for
+stack overflows if growing the stack fails. It is also possible to
+impose a stack limit during the extent of a function call. See "Stack
+Overflow" in the manual, for more.
-This allows users to write programs that use the stack as a data
+This change allows users to write programs that use the stack as a data
structure for pending computations, as it was meant to be, without
reifying that data out to the heap. Where you would previously make a
loop that collect its results in reverse order only to re-reverse them
@@ -143,7 +144,7 @@ See the "Guile Implementation" chapter in the manual for
all details.
** New functions: `scm_to_intptr_t', `scm_from_intptr_t'
** New functions: `scm_to_uintptr_t', `scm_from_uintptr_t'
-See XXX in the manual.
+See "Integers" in the manual, for more.
** New thread-safe port API
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index c73a703..ba00603 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -445,6 +445,8 @@ function will always succeed and will always return an
exact number.
@deftypefnx {C Function} scm_t_uint64 scm_to_uint64 (SCM x)
@deftypefnx {C Function} scm_t_intmax scm_to_intmax (SCM x)
@deftypefnx {C Function} scm_t_uintmax scm_to_uintmax (SCM x)
address@hidden {C Function} scm_t_intptr scm_to_intptr_t (SCM x)
address@hidden {C Function} scm_t_uintptr scm_to_uintptr_t (SCM x)
When @var{x} represents an exact integer that fits into the indicated
C type, return that integer. Else signal an error, either a
`wrong-type' error when @var{x} is not an exact integer, or an
@@ -479,6 +481,8 @@ the corresponding types are.
@deftypefnx {C Function} SCM scm_from_uint64 (scm_t_uint64 x)
@deftypefnx {C Function} SCM scm_from_intmax (scm_t_intmax x)
@deftypefnx {C Function} SCM scm_from_uintmax (scm_t_uintmax x)
address@hidden {C Function} SCM scm_from_intptr_t (scm_t_intptr x)
address@hidden {C Function} SCM scm_from_uintptr_t (scm_t_uintptr x)
Return the @code{SCM} value that represents the integer @var{x}.
These functions will always succeed and will always return an exact
number.
diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi
index 32f32ca..5dabb84 100644
--- a/doc/ref/api-debug.texi
+++ b/doc/ref/api-debug.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007,
2010, 2011, 2012, 2013
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007,
2010, 2011, 2012, 2013, 2014
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -341,6 +341,7 @@ library, or from Guile itself.
* Catching Exceptions:: Handling errors after the stack is unwound.
* Capturing Stacks:: Capturing the stack at the time of error.
* Pre-Unwind Debugging:: Debugging before the exception is thrown.
+* Stack Overflow:: Detecting and handling runaway recursion.
* Debug Options:: A historical interface to debugging.
@end menu
@@ -599,10 +600,12 @@ These procedures are available for use by user programs,
in the
@deffn {Scheme Procedure} call-with-error-handling thunk @
[#:on-error on-error='debug] [#:post-error post-error='catch] @
- [#:pass-keys pass-keys='(quit)] [#:trap-handler trap-handler='debug]
+ [#:pass-keys pass-keys='(quit)] @
+ [#:report-keys report-keys='(stack-overflow)] @
+ [#:trap-handler trap-handler='debug]
Call a thunk in a context in which errors are handled.
-There are four keyword arguments:
+There are five keyword arguments:
@table @var
@item on-error
@@ -629,9 +632,185 @@ traps entirely. @xref{Traps}, for more information.
@item pass-keys
A set of keys to ignore, as a list.
+
address@hidden report-keys
+A set of keys to always report even if the post-error handler is
address@hidden, as a list.
@end table
@end deffn
address@hidden Stack Overflow
address@hidden Stack Overflow
+
address@hidden overflow, stack
address@hidden stack overflow
+Every time a Scheme program makes a call that is not in tail position,
+it pushes a new frame onto the stack. Returning a value from a function
+pops the top frame off the stack. Stack frames take up memory, and as
+nobody has an infinite amount of memory, deep recursion could cause
+Guile to run out of memory. Running out of stack memory is called
address@hidden overflow}.
+
address@hidden Stack Limits
+
+Most languages have a terrible stack overflow story. For example, in C,
+if you use too much stack, your program will exhibit ``undefined
+behavior'', which if you are lucky means that it will crash. It's
+especially bad in C, as you neither know ahead of time how much stack
+your functions use, nor the stack limit imposed by the user's system,
+and the stack limit is often quite small relative to the total memory
+size.
+
+Managed languages like Python have a better error story, as they are
+defined to raise an exception on stack overflow -- but like C, Python
+and most dynamic languages still have a fixed stack size limit that is
+usually much smaller than the heap.
+
+Arbitrary stack limits would have an unfortunate effect on Guile
+programs. For example, the following implementation of the inner loop
+of @code{map} is clean and elegant:
+
address@hidden
+(define (map f l)
+ (if (pair? l)
+ (cons (f (car l))
+ (map f (cdr l)))
+ '()))
address@hidden example
+
+However, if there were a stack limit, that would limit the size of lists
+that can be processed with this @code{map}. Eventually, you would have
+to rewrite it to use iteration with an accumulator:
+
address@hidden
+(define (map f l)
+ (let lp ((l l) (out '()))
+ (if (pair? l)
+ (lp (cdr l) (cons (f (car l)) out))
+ (reverse out))))
address@hidden example
+
+This second version is sadly not as clear, and it also allocates more
+heap memory (once to build the list in reverse, and then again to
+reverse the list). You would be tempted to use the destructive
address@hidden to save memory and time, but then your code would not be
+continuation-safe -- if @var{f} returned again after the map had
+finished, it would see an @var{out} list that had already been
+reversed. The recursive @code{map} has none of these problems.
+
+Guile has no stack limit for Scheme code. When a thread makes its first
+Guile call, a small stack is allocated -- just one page of memory.
+Whenever that memory limit would be reached, Guile arranges to grow the
+stack by a factor of two. When garbage collection happens, Guile
+arranges to return the unused part of the stack to the operating system,
+but without causing the stack to shrink. In this way, the stack can
+grow to consume up to all memory available to the Guile process, and
+when the recursive computation eventually finishes, that stack memory is
+returned to the system.
+
address@hidden Exceptional Situations
+
+Of course, it's still possible to run out of stack memory. The most
+common cause of this is program bugs that cause unbounded recursion, as
+in:
+
address@hidden
+(define (faulty-map f l)
+ (if (pair? l)
+ (cons (f (car l)) (faulty-map f l))
+ '()))
address@hidden example
+
+Did you spot the bug? The recursive call to @code{faulty-map} recursed
+on @var{l}, not @code{(cdr @var{l})}. Running this program would cause
+Guile to use up all memory in your system, and eventually Guile would
+fail to grow the stack. At that point you have a problem: Guile needs
+to raise an exception to unwind the stack and return memory to the
+system, but the user might have throw handlers in place (@pxref{Throw
+Handlers}) that want to run before the stack is unwound, and we don't
+have any stack in which to run them.
+
+Therefore in this case, Guile throws an unwind-only exception that does
+not run pre-unwind handlers. Because this is such an odd case, Guile
+prints out a message on the console, in case the user was expecting to
+be able to get a backtrace from any pre-unwind handler.
+
address@hidden Runaway Recursion
+
+Still, this failure mode is not so nice. If you are running an
+environment in which you are interactively building a program while it
+is running, such as at a REPL, you might want to impose an artificial
+stack limit on the part of your program that you are building to detect
+accidental runaway recursion. For that purpose, there is
address@hidden, from @code{(system vm vm)}.
+
address@hidden
+(use-module (system vm vm))
address@hidden example
+
address@hidden {Scheme Procedure} call-with-stack-overflow-handler limit thunk
handler
+Call @var{thunk} in an environment in which the stack limit has been
+reduced to @var{limit} additional words. If the limit is reached,
address@hidden (a thunk) will be invoked in the dynamic environment of
+the error. For the extent of the call to @var{handler}, the stack limit
+and handler are restored to the values that were in place when
address@hidden was called.
+
+Usually, @var{handler} should raise an exception or abort to an outer
+prompt. However if @var{handler} does return, it should return a number
+of additional words of stack space to allow to the inner environment.
address@hidden deffn
+
+A stack overflow handler may only ever ``credit'' the inner thunk with
+stack space that was available when the handler was instated. When
+Guile first starts, there is no stack limit in place, so the outer
+handler may allow the inner thunk an arbitrary amount of space, but any
+nested stack overflow handler will not be able to consume more than its
+limit.
+
+Unlike the unwind-only exception that is thrown if Guile is unable to
+grow its stack, any exception thrown by a stack overflow handler might
+invoke pre-unwind handlers. Indeed, the stack overflow handler is
+itself a pre-unwind handler of sorts. If the code imposing the stack
+limit wants to protect itself against malicious pre-unwind handlers from
+the inner thunk, it should abort to a prompt of its own making instead
+of throwing an exception that might be caught by the inner thunk.
+
address@hidden C Stack Usage
+
+It is also possible for Guile to run out of space on the C stack. If
+you call a primitive procedure which then calls a Scheme procedure in a
+loop, you will consume C stack space. Guile tries to detect excessive
+consumption of C stack space, throwing an error when you have hit 80% of
+the process' available stack (as allocated by the operating system), or
+160 kilowords in the absence of a strict limit.
+
+For example, looping through @code{call-with-vm}, a primitive that calls
+a thunk, gives us the following:
+
address@hidden
+scheme@@(guile-user)> (use-modules (system vm vm))
+scheme@@(guile-user)> (let lp () (call-with-vm lp))
+ERROR: Stack overflow
address@hidden lisp
+
+Unfortunately, that's all the information we get. Overrunning the C
+stack will throw an unwind-only exception, because it's not safe to
+do very much when you are close to the C stack limit.
+
+If you get an error like this, you can either try rewriting your code to
+use less stack space, or increase the maximum stack size. To increase
+the maximum stack size, use @code{debug-set!}, for example:
+
address@hidden
+(debug-set! stack 200000)
address@hidden lisp
+
+The next section describes @code{debug-set!} more thoroughly. Of course
+the best thing is to have your code operate without so much resource
+consumption by avoiding loops through C trampolines.
+
+
@node Debug Options
@subsubsection Debug options
@@ -665,8 +844,8 @@ warn-deprecated no Warn when deprecated features are
used.
@end smallexample
The boolean options may be toggled with @code{debug-enable} and
address@hidden The non-boolean @code{keywords} option must be set
-using @code{debug-set!}.
address@hidden The non-boolean options must be set using
address@hidden
@deffn {Scheme Procedure} debug-enable option-name
@deffnx {Scheme Procedure} debug-disable option-name
@@ -679,59 +858,6 @@ to historical oddities, it is a macro that expects an
unquoted option
name.
@end deffn
address@hidden Stack overflow
-
address@hidden overflow, stack
address@hidden stack overflow
-Stack overflow errors are caused by a computation trying to use more
-stack space than has been enabled by the @code{stack} option. There are
-actually two kinds of stack that can overflow, the C stack and the
-Scheme stack.
-
-Scheme stack overflows can occur if Scheme procedures recurse too far
-deeply. An example would be the following recursive loop:
-
address@hidden
-scheme@@(guile-user)> (let lp () (+ 1 (lp)))
-<unnamed port>:8:17: In procedure vm-run:
-<unnamed port>:8:17: VM: Stack overflow
address@hidden lisp
-
-The default stack size should allow for about 10000 frames or so, so one
-usually doesn't hit this level of recursion. Unfortunately there is no
-way currently to make a VM with a bigger stack. If you are in this
-unfortunate situation, please file a bug, and in the meantime, rewrite
-your code to be tail-recursive (@pxref{Tail Calls}).
-
-The other limit you might hit would be C stack overflows. If you call a
-primitive procedure which then calls a Scheme procedure in a loop, you
-will consume C stack space. Guile tries to detect excessive consumption
-of C stack space, throwing an error when you have hit 80% of the
-process' available stack (as allocated by the operating system), or 160
-kilowords in the absence of a strict limit.
-
-For example, looping through @code{call-with-vm}, a primitive that calls
-a thunk, gives us the following:
-
address@hidden
-scheme@@(guile-user)> (use-modules (system vm vm))
-scheme@@(guile-user)> (debug-set! stack 10000)
-scheme@@(guile-user)> (let lp () (call-with-vm lp))
-ERROR: In procedure call-with-vm:
-ERROR: Stack overflow
address@hidden lisp
-
-If you get an error like this, you can either try rewriting your code to
-use less stack space, or increase the maximum stack size. To increase
-the maximum stack size, use @code{debug-set!}, for example:
-
address@hidden
-(debug-set! stack 200000)
address@hidden lisp
-
-But of course it's better to have your code operate without so much
-resource consumption, avoiding loops through C trampolines.
-
@node Traps
@subsection Traps
diff --git a/libguile/throw.c b/libguile/throw.c
index 98149a1..bef1ecf 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -184,8 +184,14 @@ throw_without_pre_unwind (SCM tag, SCM args)
continue;
if (scm_is_true (scm_c_vector_ref (eh, 3)))
- fprintf (stderr, "\nWarning: unwind-only exception, perhaps due to "
- "stack overflow; not running pre-unwind handlers.");
+ {
+ char *key_chars;
+
+ key_chars = scm_to_locale_string (scm_symbol_to_string (tag));
+ fprintf (stderr, "Warning: Unwind-only `%s' exception; "
+ "skipping pre-unwind handler.\n", key_chars);
+ free (key_chars);
+ }
prompt_tag = scm_c_vector_ref (eh, 2);
if (scm_is_true (prompt_tag))
diff --git a/libguile/vm.c b/libguile/vm.c
index d24ff97..88c75fd 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -58,6 +58,9 @@ static SCM sym_keyword_argument_error;
static SCM sym_regular;
static SCM sym_debug;
+/* The page size. */
+static size_t page_size;
+
/* The VM has a number of internal assertions that shouldn't normally be
necessary, but might be if you think you found a bug in the VM. */
/* #define VM_ENABLE_ASSERTIONS */
@@ -751,29 +754,6 @@ scm_i_call_with_current_continuation (SCM proc)
* VM
*/
-/* The page size. */
-static size_t page_size;
-
-/* Initial stack size. Defaults to one page. */
-static size_t initial_stack_size;
-
-/* 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)
-{
- initial_stack_size = page_size / sizeof (SCM);
-
- {
- int size;
- 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;
- }
-}
-
#define VM_NAME vm_regular_engine
#define VM_USE_HOOKS 0
#define FUNC_NAME "vm-regular-engine"
@@ -880,7 +860,7 @@ make_vm (void)
vp = scm_gc_malloc (sizeof (struct scm_vm), "vm");
- vp->stack_size = initial_stack_size;
+ vp->stack_size = page_size / sizeof (SCM);
vp->stack_base = allocate_stack (vp->stack_size);
if (!vp->stack_base)
/* As in expand_stack, we don't have any way to throw an exception
@@ -888,7 +868,7 @@ make_vm (void)
handle it. For now, abort. */
abort ();
vp->stack_limit = vp->stack_base + vp->stack_size;
- vp->max_stack_size = default_max_stack_size;
+ vp->overflow_handler_stack = SCM_EOL;
vp->ip = NULL;
vp->sp = vp->stack_base - 1;
vp->fp = NULL;
@@ -1083,6 +1063,56 @@ vm_expand_stack_inner (void *data_ptr)
return new_stack;
}
+static scm_t_ptrdiff
+current_overflow_size (struct scm_vm *vp)
+{
+ if (scm_is_pair (vp->overflow_handler_stack))
+ return scm_to_ptrdiff_t (scm_caar (vp->overflow_handler_stack));
+ return -1;
+}
+
+static int
+should_handle_stack_overflow (struct scm_vm *vp, scm_t_ptrdiff stack_size)
+{
+ scm_t_ptrdiff overflow_size = current_overflow_size (vp);
+ return overflow_size >= 0 && stack_size >= overflow_size;
+}
+
+static void
+reset_stack_limit (struct scm_vm *vp)
+{
+ if (should_handle_stack_overflow (vp, vp->stack_size))
+ vp->stack_limit = vp->stack_base + current_overflow_size (vp);
+ else
+ vp->stack_limit = vp->stack_base + vp->stack_size;
+}
+
+struct overflow_handler_data
+{
+ struct scm_vm *vp;
+ SCM overflow_handler_stack;
+};
+
+static void
+wind_overflow_handler (void *ptr)
+{
+ struct overflow_handler_data *data = ptr;
+
+ data->vp->overflow_handler_stack = data->overflow_handler_stack;
+
+ reset_stack_limit (data->vp);
+}
+
+static void
+unwind_overflow_handler (void *ptr)
+{
+ struct overflow_handler_data *data = ptr;
+
+ data->vp->overflow_handler_stack = scm_cdr (data->overflow_handler_stack);
+
+ reset_stack_limit (data->vp);
+}
+
static void
vm_expand_stack (struct scm_vm *vp, SCM *new_sp)
{
@@ -1097,6 +1127,7 @@ vm_expand_stack (struct scm_vm *vp, SCM *new_sp)
data.new_sp = new_sp;
if (!GC_call_with_alloc_lock (vm_expand_stack_inner, &data))
+ /* Throw an unwind-only exception. */
scm_report_stack_overflow ();
new_sp = data.new_sp;
@@ -1104,26 +1135,45 @@ vm_expand_stack (struct scm_vm *vp, SCM *new_sp)
vp->sp_max_since_gc = vp->sp = new_sp;
- if (stack_size >= vp->max_stack_size)
+ if (should_handle_stack_overflow (vp, stack_size))
{
- /* Expand the soft limit by 256K entries to give us space to
- handle the error. */
- vp->max_stack_size += 256 * 1024;
+ SCM more_stack, new_limit;
+
+ struct overflow_handler_data data;
+ data.vp = vp;
+ data.overflow_handler_stack = vp->overflow_handler_stack;
- /* 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;
+ scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
- /* Finally, reset the limit, to catch further overflows. */
- vp->stack_limit = vp->stack_base + vp->max_stack_size;
+ scm_dynwind_rewind_handler (unwind_overflow_handler, &data,
+ SCM_F_WIND_EXPLICITLY);
+ scm_dynwind_unwind_handler (wind_overflow_handler, &data,
+ SCM_F_WIND_EXPLICITLY);
- /* FIXME: Use scm_report_stack_overflow, but in a mode that allows
- pre-unwind handlers to run. */
- vm_error ("VM: Stack overflow", SCM_UNDEFINED);
- }
+ /* Call the overflow handler. */
+ more_stack = scm_call_0 (scm_cdar (data.overflow_handler_stack));
+
+ /* If the overflow handler returns, its return value should be an
+ integral number of words from the outer stack limit to transfer
+ to the inner limit. */
+ if (scm_to_ptrdiff_t (more_stack) <= 0)
+ scm_out_of_range (NULL, more_stack);
+ new_limit = scm_sum (scm_caar (data.overflow_handler_stack), more_stack);
+ if (scm_is_pair (scm_cdr (data.overflow_handler_stack)))
+ new_limit = scm_min (new_limit,
+ scm_caadr (data.overflow_handler_stack));
+
+ /* Ensure the new limit is in range. */
+ scm_to_ptrdiff_t (new_limit);
+
+ /* Increase the limit that we will restore. */
+ scm_set_car_x (scm_car (data.overflow_handler_stack), new_limit);
- /* Otherwise continue, with the new enlarged stack. */
+ scm_dynwind_end ();
+
+ /* Recurse */
+ return vm_expand_stack (vp, new_sp);
+ }
}
static struct scm_vm *
@@ -1365,6 +1415,61 @@ SCM_DEFINE (scm_call_with_vm, "call-with-vm", 1, 0, 1,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_call_with_stack_overflow_handler,
+ "call-with-stack-overflow-handler", 3, 0, 0,
+ (SCM limit, SCM thunk, SCM handler),
+ "Call @var{thunk} in an environment in which the stack limit has\n"
+ "been reduced to @var{limit} additional words. If the limit is\n"
+ "reached, @var{handler} (a thunk) will be invoked in the dynamic\n"
+ "environment of the error. For the extent of the call to\n"
+ "@var{handler}, the stack limit and handler are restored to the\n"
+ "values that were in place when\n"
+ "@code{call-with-stack-overflow-handler} was called.")
+#define FUNC_NAME s_scm_call_with_stack_overflow_handler
+{
+ struct scm_vm *vp;
+ scm_t_ptrdiff c_limit, stack_size;
+ struct overflow_handler_data data;
+ SCM new_limit, ret;
+
+ vp = scm_the_vm ();
+ stack_size = vp->sp - vp->stack_base;
+
+ c_limit = scm_to_ptrdiff_t (limit);
+ if (c_limit <= 0)
+ scm_out_of_range (FUNC_NAME, limit);
+
+ new_limit = scm_sum (scm_from_ptrdiff_t (stack_size), limit);
+ if (scm_is_pair (vp->overflow_handler_stack))
+ new_limit = scm_min (new_limit, scm_caar (vp->overflow_handler_stack));
+
+ /* Hacky check that the current stack depth plus the limit is within
+ the range of a ptrdiff_t. */
+ scm_to_ptrdiff_t (new_limit);
+
+ data.vp = vp;
+ data.overflow_handler_stack =
+ scm_acons (limit, handler, vp->overflow_handler_stack);
+
+ scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
+
+ scm_dynwind_rewind_handler (wind_overflow_handler, &data,
+ SCM_F_WIND_EXPLICITLY);
+ scm_dynwind_unwind_handler (unwind_overflow_handler, &data,
+ SCM_F_WIND_EXPLICITLY);
+
+ /* Reset vp->sp_max_since_gc so that the VM checks actually
+ trigger. */
+ return_unused_stack_to_os (vp);
+
+ ret = scm_call_0 (thunk);
+
+ scm_dynwind_end ();
+
+ return ret;
+}
+#undef FUNC_NAME
+
/*
* Initialize
@@ -1415,8 +1520,6 @@ scm_bootstrap_vm (void)
if (page_size & (page_size - 1))
abort ();
- initialize_default_stack_size ();
-
sym_vm_run = scm_from_latin1_symbol ("vm-run");
sym_vm_error = scm_from_latin1_symbol ("vm-error");
sym_keyword_argument_error = scm_from_latin1_symbol
("keyword-argument-error");
diff --git a/libguile/vm.h b/libguile/vm.h
index 9edced1..4029c5c 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -44,7 +44,7 @@ struct scm_vm {
SCM *sp_max_since_gc; /* highest sp since last gc */
size_t stack_size; /* stack size */
SCM *stack_base; /* stack base address */
- size_t max_stack_size;
+ SCM overflow_handler_stack; /* alist of max-stack-size -> thunk */
SCM hooks[SCM_VM_NUM_HOOKS]; /* hooks */
int engine; /* which vm engine we're using */
};
@@ -52,6 +52,9 @@ struct scm_vm {
SCM_INTERNAL struct scm_vm *scm_the_vm (void);
SCM_API SCM scm_call_with_vm (SCM proc, SCM args);
+SCM_API SCM scm_call_with_stack_overflow_handler (SCM limit, SCM thunk,
+ SCM handler);
+
SCM_API SCM scm_vm_apply_hook (void);
SCM_API SCM scm_vm_push_continuation_hook (void);
SCM_API SCM scm_vm_pop_continuation_hook (void);
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index f9a7c1f..9c1bdc4 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -912,52 +912,21 @@ for key @var{k}, then invoke @var{thunk}."
(define for-each
(case-lambda
((f l)
- (let for-each1 ((hare l) (tortoise l))
- (if (pair? hare)
- (begin
- (f (car hare))
- (let ((hare (cdr hare)))
- (if (pair? hare)
- (begin
- (when (eq? tortoise hare)
- (scm-error 'wrong-type-arg "for-each" "Circular list:
~S"
- (list l) #f))
- (f (car hare))
- (for-each1 (cdr hare) (cdr tortoise)))
- (for-each1 hare tortoise))))
- (if (not (null? hare))
- (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
- (list l) #f)))))
+ (unless (list? l)
+ (scm-error 'wrong-type-arg "for-each" "Not a list: ~S" (list l) #f))
+ (let for-each1 ((l l))
+ (unless (null? l)
+ (f (car l))
+ (for-each1 (cdr l)))))
((f l1 l2)
- (let for-each2 ((h1 l1) (h2 l2) (t1 l1) (t2 l2) (move? #f))
- (cond
- ((and (pair? h1) (pair? h2))
- (cond
- ((not move?)
- (f (car h1) (car h2))
- (for-each2 (cdr h1) (cdr h2) t1 t2 #t))
- ((eq? t1 h1)
- (scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
- (list l1) #f))
- ((eq? t2 h2)
- (scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
- (list l2) #f))
- (else
- (f (car h1) (car h2))
- (for-each2 (cdr h1) (cdr h2) (cdr t1) (cdr t2) #f))))
-
- ((if (null? h1)
- (or (null? h2) (pair? h2))
- (and (pair? h1) (null? h2)))
- (if #f #f))
-
- ((list? h1)
- (scm-error 'wrong-type-arg "for-each" "Unexpected tail: ~S"
- (list h2) #f))
- (else
- (scm-error 'wrong-type-arg "for-each" "Unexpected tail: ~S"
- (list h1) #f)))))
+ (unless (= (length l1) (length l2))
+ (scm-error 'wrong-type-arg "for-each" "List of wrong length: ~S"
+ (list l2) #f))
+ (let for-each2 ((l1 l1) (l2 l2))
+ (unless (null? l1)
+ (f (car l1) (car l2))
+ (for-each2 (cdr l1) (cdr l2)))))
((f l1 . rest)
(let ((len (length l1)))
diff --git a/module/language/cps/dfg.scm b/module/language/cps/dfg.scm
index 551b80e..c1e670a 100644
--- a/module/language/cps/dfg.scm
+++ b/module/language/cps/dfg.scm
@@ -72,6 +72,25 @@
dfa-var-idx dfa-var-name dfa-var-sym dfa-var-count
print-dfa))
+;; These definitions are here because currently we don't do cross-module
+;; inlining. They can be removed once that restriction is gone.
+(define-inlinable (for-each f l)
+ (unless (list? l)
+ (scm-error 'wrong-type-arg "for-each" "Not a list: ~S" (list l) #f))
+ (let for-each1 ((l l))
+ (unless (null? l)
+ (f (car l))
+ (for-each1 (cdr l)))))
+
+(define-inlinable (for-each/2 f l1 l2)
+ (unless (= (length l1) (length l2))
+ (scm-error 'wrong-type-arg "for-each" "List of wrong length: ~S"
+ (list l2) #f))
+ (let for-each2 ((l1 l1) (l2 l2))
+ (unless (null? l1)
+ (f (car l1) (car l2))
+ (for-each2 (cdr l1) (cdr l2)))))
+
(define (build-cont-table fun)
(fold-conts (lambda (k cont table)
(hashq-set! table k cont)
@@ -808,14 +827,14 @@ BODY for each body continuation in the prompt."
(match exp
(($ $letk (($ $cont k cont) ...) body)
;; Set up recursive environment before visiting cont bodies.
- (for-each (lambda (cont k)
- (declare-block! k cont exp-k))
- cont k)
- (for-each visit cont k)
+ (for-each/2 (lambda (cont k)
+ (declare-block! k cont exp-k))
+ cont k)
+ (for-each/2 visit cont k)
(recur body))
(($ $kargs names syms body)
- (for-each def! names syms)
+ (for-each/2 def! names syms)
(recur body))
(($ $kif kt kf)
@@ -828,7 +847,7 @@ BODY for each body continuation in the prompt."
(($ $letrec names syms funs body)
(unless global?
(error "$letrec should not be present when building a local DFG"))
- (for-each def! names syms)
+ (for-each/2 def! names syms)
(for-each (cut visit-fun <> conts blocks use-maps global?) funs)
(visit body exp-k))
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index 74b01bc..c7c1f8d 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -606,24 +606,28 @@ has just one element then that's the return value."
(case-lambda
((f l)
(check-arg procedure? f for-each)
- (let for-each1 ((hare l) (tortoise l))
- (if (pair? hare)
- (begin
- (f (car hare))
- (let ((hare (cdr hare)))
- (if (pair? hare)
- (begin
- (when (eq? tortoise hare)
- (scm-error 'wrong-type-arg "for-each" "Circular list:
~S"
- (list l) #f))
- (f (car hare))
- (for-each1 (cdr hare) (cdr tortoise)))
- (for-each1 hare tortoise))))
- (if (not (null? hare))
- (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
- (list l) #f)))))
+ (check-arg list? l for-each)
+ (let for-each1 ((l l))
+ (unless (null? l)
+ (f (car l))
+ (for-each1 (cdr l)))))
+
+ ((f l1 l2)
+ (check-arg procedure? f for-each)
+ (let* ((len1 (length+ l1))
+ (len2 (length+ l2))
+ (len (if (and len1 len2)
+ (min len1 len2)
+ (or len1 len2))))
+ (unless len
+ (scm-error 'wrong-type-arg "for-each"
+ "Args do not contain a proper (finite) list: ~S"
+ (list (list l1 l2)) #f))
+ (let for-each2 ((l1 l1) (l2 l2) (len len))
+ (unless (zero? len)
+ (f (car l1) (car l2))
+ (for-each2 (cdr l1) (cdr l2) (1- len))))))
-
((f l1 . rest)
(check-arg procedure? f for-each)
(let ((len (fold (lambda (ls len)
diff --git a/module/system/repl/error-handling.scm
b/module/system/repl/error-handling.scm
index d0d7967..eea7b97 100644
--- a/module/system/repl/error-handling.scm
+++ b/module/system/repl/error-handling.scm
@@ -1,6 +1,6 @@
;;; Error handling in the REPL
-;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation,
Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 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
@@ -42,7 +42,8 @@
(define* (call-with-error-handling thunk #:key
(on-error 'debug) (post-error 'catch)
- (pass-keys '(quit)) (trap-handler 'debug))
+ (pass-keys '(quit)) (trap-handler 'debug)
+ (report-keys '(stack-overflow)))
(let ((in (current-input-port))
(out (current-output-port))
(err (current-error-port)))
@@ -92,6 +93,14 @@
((disabled) #f)
(else (error "Unknown trap-handler strategy" trap-handler))))
+ (define (report-error key args)
+ (with-saved-ports
+ (lambda ()
+ (run-hook before-error-hook)
+ (print-exception err #f key args)
+ (run-hook after-error-hook)
+ (force-output err))))
+
(catch #t
(lambda ()
(with-default-trap-handler le-trap-handler
@@ -103,17 +112,15 @@
(if (memq key pass-keys)
(apply throw key args)
(begin
- (with-saved-ports
- (lambda ()
- (run-hook before-error-hook)
- (print-exception err #f key args)
- (run-hook after-error-hook)
- (force-output err)))
+ (report-error key args)
(if #f #f)))))
((catch)
(lambda (key . args)
- (if (memq key pass-keys)
- (apply throw key args))))
+ (when (memq key pass-keys)
+ (apply throw key args))
+ (when (memq key report-keys)
+ (report-error key args))
+ (if #f #f)))
(else
(if (procedure? post-error)
(lambda (k . args)
@@ -147,15 +154,9 @@
((@ (system repl repl) start-repl) #:debug debug)))))))
((report)
(lambda (key . args)
- (if (not (memq key pass-keys))
- (begin
- (with-saved-ports
- (lambda ()
- (run-hook before-error-hook)
- (print-exception err #f key args)
- (run-hook after-error-hook)
- (force-output err)))
- (if #f #f)))))
+ (unless (memq key pass-keys)
+ (report-error key args))
+ (if #f #f)))
((backtrace)
(lambda (key . args)
(if (not (memq key pass-keys))
@@ -165,13 +166,8 @@
(make-stack #t)
;; Narrow as above, for the debugging case.
3 tag 0 (and tag 1))))
- (with-saved-ports
- (lambda ()
- (print-frames frames)
- (run-hook before-error-hook)
- (print-exception err #f key args)
- (run-hook after-error-hook)
- (force-output err)))
+ (with-saved-ports (lambda () (print-frames frames)))
+ (report-error key args)
(if #f #f)))))
((pass)
(lambda (key . args)
diff --git a/module/system/vm/vm.scm b/module/system/vm/vm.scm
index 33bcbf1..5274684 100644
--- a/module/system/vm/vm.scm
+++ b/module/system/vm/vm.scm
@@ -1,6 +1,6 @@
;;; Guile VM core
-;;; Copyright (C) 2001, 2009, 2010, 2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009, 2010, 2013, 2014 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
@@ -20,6 +20,7 @@
(define-module (system vm vm)
#:export (call-with-vm
+ call-with-stack-overflow-handler
vm-trace-level set-vm-trace-level!
vm-engine set-vm-engine! set-default-vm-engine!
vm-push-continuation-hook vm-pop-continuation-hook
diff --git a/test-suite/standalone/Makefile.am
b/test-suite/standalone/Makefile.am
index 5c0c6a7..6f252f4 100644
--- a/test-suite/standalone/Makefile.am
+++ b/test-suite/standalone/Makefile.am
@@ -1,7 +1,7 @@
## Process this file with automake to produce Makefile.in.
##
## Copyright 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
-## 2011, 2012, 2013 Free Software Foundation, Inc.
+## 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -264,4 +264,7 @@ test_smob_mark_LDADD = $(LIBGUILE_LDADD)
check_PROGRAMS += test-smob-mark
TESTS += test-smob-mark
+check_SCRIPTS += test-stack-overflow
+TESTS += test-stack-overflow
+
EXTRA_DIST += ${check_SCRIPTS}
diff --git a/test-suite/standalone/test-stack-overflow
b/test-suite/standalone/test-stack-overflow
new file mode 100755
index 0000000..5a0b777
--- /dev/null
+++ b/test-suite/standalone/test-stack-overflow
@@ -0,0 +1,38 @@
+#!/bin/sh
+exec guile -q -s "$0" "$@"
+!#
+
+(unless (defined? 'setrlimit)
+ ;; Without an rlimit, this test can take down your system, as it
+ ;; consumes all of your memory in stack space. That doesn't seem like
+ ;; something we should run as part of an automated test suite.
+ (exit 0))
+
+;; 100 MB.
+(define *limit* (* 100 1024 1024))
+
+(call-with-values (lambda () (getrlimit 'as))
+ (lambda (soft hard)
+ (unless (and soft (< soft *limit*))
+ (setrlimit 'as (if hard (min *limit* hard) *limit*) hard))))
+
+(define (test)
+ (catch 'stack-overflow
+ (lambda ()
+ (let lp ()
+ (lp)
+ (error "should not be reached")))
+ (lambda _
+ #t)))
+
+;; Run the test a few times. The stack will only be enlarged and
+;; relocated on the first one.
+(test)
+(test)
+(test)
+(test)
+(test)
+
+;; Local Variables:
+;; mode: scheme
+;; End:
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index 3fc1d94..10d2669 100644
--- a/test-suite/tests/eval.test
+++ b/test-suite/tests/eval.test
@@ -18,7 +18,7 @@
(define-module (test-suite test-eval)
:use-module (test-suite lib)
:use-module ((srfi srfi-1) :select (unfold count))
- :use-module ((system vm vm) :select (call-with-vm))
+ :use-module ((system vm vm) :select (call-with-stack-overflow-handler))
:use-module (ice-9 documentation)
:use-module (ice-9 local-eval))
@@ -442,13 +442,92 @@
;;; stack overflow handling
;;;
-(with-test-prefix "stack overflow"
+(with-test-prefix "stack overflow handlers"
+ (define (trigger-overflow)
+ (trigger-overflow)
+ (error "not reached"))
+
+ (define (dynwind-test n)
+ (catch 'foo
+ (lambda ()
+ (call-with-stack-overflow-handler n
+ (lambda ()
+ (dynamic-wind (lambda () #t)
+ trigger-overflow
+ trigger-overflow))
+ (lambda ()
+ (throw 'foo))))
+ (lambda _ #t)))
+
+ (pass-if-exception "limit should be number"
+ exception:wrong-type-arg
+ (call-with-stack-overflow-handler #t
+ trigger-overflow trigger-overflow))
- ;; FIXME: this test does not test what it is intending to test
- (pass-if-exception "exception raised"
- exception:vm-error
- (let ((thunk (let loop () (cons 's (loop)))))
- (call-with-vm thunk))))
+ (pass-if-exception "limit should be exact integer"
+ exception:wrong-type-arg
+ (call-with-stack-overflow-handler 2.0
+ trigger-overflow trigger-overflow))
+
+ (pass-if-exception "limit should be nonnegative"
+ exception:out-of-range
+ (call-with-stack-overflow-handler -1
+ trigger-overflow trigger-overflow))
+
+ (pass-if-exception "limit should be positive"
+ exception:out-of-range
+ (call-with-stack-overflow-handler 0
+ trigger-overflow trigger-overflow))
+
+ (pass-if-exception "limit should be within address space"
+ exception:out-of-range
+ (call-with-stack-overflow-handler (ash 1 64)
+ trigger-overflow trigger-overflow))
+
+ (pass-if "exception on overflow"
+ (catch 'foo
+ (lambda ()
+ (call-with-stack-overflow-handler 10000
+ trigger-overflow
+ (lambda ()
+ (throw 'foo))))
+ (lambda _ #t)))
+
+ (pass-if "exception on overflow with dynwind"
+ ;; Try all limits between 1 and 200 words.
+ (let lp ((n 1))
+ (or (= n 200)
+ (and (dynwind-test n)
+ (lp (1+ n))))))
+
+ (pass-if-exception "overflow handler should return number"
+ exception:wrong-type-arg
+ (call-with-stack-overflow-handler 1000
+ trigger-overflow
+ (lambda () #t)))
+ (pass-if-exception "overflow handler should return exact integer"
+ exception:wrong-type-arg
+ (call-with-stack-overflow-handler 1000
+ trigger-overflow
+ (lambda () 2.0)))
+ (pass-if-exception "overflow handler should be nonnegative"
+ exception:out-of-range
+ (call-with-stack-overflow-handler 1000
+ trigger-overflow
+ (lambda () -1)))
+ (pass-if-exception "overflow handler should be positive"
+ exception:out-of-range
+ (call-with-stack-overflow-handler 1000
+ trigger-overflow
+ (lambda () 0)))
+
+ (letrec ((fac (lambda (n)
+ (if (zero? n) 1 (* n (fac (1- n)))))))
+ (pass-if-equal "overflow handler can allow recursion to continue"
+ (fac 10)
+ (call-with-stack-overflow-handler 1
+ (lambda () (fac 10))
+ (lambda () 1)))))
;;;
;;; docstrings
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-811-g48c2a53,
Andy Wingo <=