[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Backtrace and enhanced catch
From: |
Neil Jerram |
Subject: |
Re: Backtrace and enhanced catch |
Date: |
Sat, 14 Jan 2006 12:41:43 +0000 |
User-agent: |
Gnus/5.1007 (Gnus v5.10.7) Emacs/21.4 (gnu/linux) |
Neil Jerram <address@hidden> writes:
> We can solve both problems by merging the semantics of catch and
> lazy-catch into a single form, an enhanced catch:
>
> -- Scheme Procedure: catch key thunk handler [lazy-handler]
The main part of this patch is appended below, and I would appreciate
any comments that anyone may have before I finish it off (by
deprecating the old APIs, replacing uses of lazy-catch, and so on).
One point is that I have removed the "SCM_API" from the declaration of
scm_i_with_continuation_barrier. My understanding is that
scm_i_with_continuation_barrier (like scm_i_* functions in general) is
a libguile-internal function and so does not need to be exported from
the libguile DLL in a Windows build (which is what SCM_API is for).
With this patch, I get the following results running g.scm with and
without --debug ...
address@hidden:~$ guile-local --debug g.scm
Backtrace:
In unknown file:
?: 0* [primitive-load "g.scm"]
In g.scm:
8: 1* [g #<procedure f (x)>]
6: 2 [f]
g.scm:6:3: In procedure f in expression (x):
g.scm:6:3: Wrong number of arguments to #<procedure f (x)>
address@hidden:~$ guile-local g.scm
ERROR: Wrong number of arguments to #<procedure f (x)>
address@hidden:~$
... which I believe is what is wanted.
Regards,
Neil
cvs diff: Diffing libguile
Index: libguile/continuations.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/continuations.c,v
retrieving revision 1.60
diff -u -u -r1.60 continuations.c
--- libguile/continuations.c 23 May 2005 19:57:20 -0000 1.60
+++ libguile/continuations.c 14 Jan 2006 12:43:30 -0000
@@ -312,7 +312,9 @@
scm_i_with_continuation_barrier (scm_t_catch_body body,
void *body_data,
scm_t_catch_handler handler,
- void *handler_data)
+ void *handler_data,
+ scm_t_catch_handler lazy_handler,
+ void *lazy_handler_data)
{
SCM_STACKITEM stack_item;
scm_i_thread *thread = SCM_I_CURRENT_THREAD;
@@ -333,9 +335,10 @@
/* Call FUNC inside a catch all. This is now guaranteed to return
directly and exactly once.
*/
- result = scm_internal_catch (SCM_BOOL_T,
- body, body_data,
- handler, handler_data);
+ result = scm_c_catch (SCM_BOOL_T,
+ body, body_data,
+ handler, handler_data,
+ lazy_handler, lazy_handler_data);
/* Return to old continuation root.
*/
@@ -364,7 +367,6 @@
c_handler (void *d, SCM tag, SCM args)
{
struct c_data *data = (struct c_data *)d;
- scm_handle_by_message_noexit (NULL, tag, args);
data->result = NULL;
return SCM_UNSPECIFIED;
}
@@ -376,7 +378,8 @@
c_data.func = func;
c_data.data = data;
scm_i_with_continuation_barrier (c_body, &c_data,
- c_handler, &c_data);
+ c_handler, &c_data,
+ scm_handle_by_message_noexit, NULL);
return c_data.result;
}
@@ -394,7 +397,6 @@
static SCM
scm_handler (void *d, SCM tag, SCM args)
{
- scm_handle_by_message_noexit (NULL, tag, args);
return SCM_BOOL_F;
}
@@ -415,7 +417,8 @@
struct scm_data scm_data;
scm_data.proc = proc;
return scm_i_with_continuation_barrier (scm_body, &scm_data,
- scm_handler, &scm_data);
+ scm_handler, &scm_data,
+ scm_handle_by_message_noexit, NULL);
}
#undef FUNC_NAME
Index: libguile/continuations.h
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/continuations.h,v
retrieving revision 1.34
diff -u -u -r1.34 continuations.h
--- libguile/continuations.h 23 May 2005 19:57:20 -0000 1.34
+++ libguile/continuations.h 14 Jan 2006 12:43:30 -0000
@@ -92,10 +92,12 @@
SCM_API void *scm_c_with_continuation_barrier (void *(*func)(void*), void *);
SCM_API SCM scm_with_continuation_barrier (SCM proc);
-SCM_API SCM scm_i_with_continuation_barrier (scm_t_catch_body body,
- void *body_data,
- scm_t_catch_handler handler,
- void *handler_data);
+SCM scm_i_with_continuation_barrier (scm_t_catch_body body,
+ void *body_data,
+ scm_t_catch_handler handler,
+ void *handler_data,
+ scm_t_catch_handler lazy_handler,
+ void *lazy_handler_data);
SCM_API void scm_init_continuations (void);
Index: libguile/root.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/root.c,v
retrieving revision 1.78
diff -u -u -r1.78 root.c
--- libguile/root.c 23 May 2005 19:57:21 -0000 1.78
+++ libguile/root.c 14 Jan 2006 12:43:31 -0000
@@ -121,7 +121,8 @@
my_handler_data.run_handler = 0;
answer = scm_i_with_continuation_barrier (body, body_data,
- cwdr_handler, &my_handler_data);
+ cwdr_handler, &my_handler_data,
+ NULL, NULL);
scm_frame_end ();
Index: libguile/throw.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/throw.c,v
retrieving revision 1.107
diff -u -u -r1.107 throw.c
--- libguile/throw.c 23 May 2005 19:57:21 -0000 1.107
+++ libguile/throw.c 14 Jan 2006 12:43:32 -0000
@@ -54,6 +54,8 @@
#define SETJBJMPBUF(x, v) (SCM_SET_CELL_WORD_1 ((x), (scm_t_bits) (v)))
#define SCM_JBDFRAME(x) ((scm_t_debug_frame *) SCM_CELL_WORD_2 (x))
#define SCM_SETJBDFRAME(x, v) (SCM_SET_CELL_WORD_2 ((x), (scm_t_bits) (v)))
+#define SCM_JBLAZY(x) ((struct lazy_catch *) SCM_CELL_WORD_3 (x))
+#define SCM_SETJBLAZY(x, v) (SCM_SET_CELL_WORD_3 ((x), (scm_t_bits) (v)))
static int
jmpbuffer_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
@@ -80,7 +82,7 @@
}
-/* scm_internal_catch (the guts of catch) */
+/* scm_c_catch (the guts of catch) */
struct jmp_buf_and_retval /* use only on the stack, in scm_catch */
{
@@ -89,10 +91,25 @@
SCM retval;
};
+/* This is the structure we use to store lazy handling information for
+ a regular catch, and put on the wind list for a lazy catch. It
+ stores the lazy handler function to call, and the data pointer to
+ pass through to it. It's not a Scheme closure, but it is a
+ function with data, so the term "closure" is appropriate in its
+ broader sense.
+
+ (We don't need anything like this to run the "eager" catch handler,
+ because the same C frame runs both the body and the handler.) */
+
+struct lazy_catch {
+ scm_t_catch_handler handler;
+ void *handler_data;
+};
-/* scm_internal_catch is the guts of catch. It handles all the
- mechanics of setting up a catch target, invoking the catch body,
- and perhaps invoking the handler if the body does a throw.
+
+/* scm_c_catch is the guts of catch. It handles all the mechanics of
+ setting up a catch target, invoking the catch body, and perhaps
+ invoking the handler if the body does a throw.
The function is designed to be usable from C code, but is general
enough to implement all the semantics Guile Scheme expects from
@@ -138,17 +155,26 @@
will be found. */
SCM
-scm_internal_catch (SCM tag, scm_t_catch_body body, void *body_data,
scm_t_catch_handler handler, void *handler_data)
+scm_c_catch (SCM tag,
+ scm_t_catch_body body, void *body_data,
+ scm_t_catch_handler handler, void *handler_data,
+ scm_t_catch_handler lazy_handler, void *lazy_handler_data)
{
struct jmp_buf_and_retval jbr;
SCM jmpbuf;
SCM answer;
+ struct lazy_catch lazy;
jmpbuf = make_jmpbuf ();
answer = SCM_EOL;
scm_i_set_dynwinds (scm_acons (tag, jmpbuf, scm_i_dynwinds ()));
SETJBJMPBUF(jmpbuf, &jbr.buf);
SCM_SETJBDFRAME(jmpbuf, scm_i_last_debug_frame ());
+
+ lazy.handler = lazy_handler;
+ lazy.handler_data = lazy_handler_data;
+ SCM_SETJBLAZY(jmpbuf, &lazy);
+
if (setjmp (jbr.buf))
{
SCM throw_tag;
@@ -179,6 +205,17 @@
return answer;
}
+SCM
+scm_internal_catch (SCM tag,
+ scm_t_catch_body body, void *body_data,
+ scm_t_catch_handler handler, void *handler_data)
+{
+ return scm_c_catch(tag,
+ body, body_data,
+ handler, handler_data,
+ NULL, NULL);
+}
+
/* scm_internal_lazy_catch (the guts of lazy catching) */
@@ -186,19 +223,6 @@
/* The smob tag for lazy_catch smobs. */
static scm_t_bits tc16_lazy_catch;
-/* This is the structure we put on the wind list for a lazy catch. It
- stores the handler function to call, and the data pointer to pass
- through to it. It's not a Scheme closure, but it is a function
- with data, so the term "closure" is appropriate in its broader
- sense.
-
- (We don't need anything like this in the "eager" catch code,
- because the same C frame runs both the body and the handler.) */
-struct lazy_catch {
- scm_t_catch_handler handler;
- void *handler_data;
-};
-
/* Strictly speaking, we could just pass a zero for our print
function, because we don't need to print them. They should never
appear in normal data structures, only in the wind list. However,
@@ -490,8 +514,8 @@
/* the Scheme-visible CATCH and LAZY-CATCH functions */
-SCM_DEFINE (scm_catch, "catch", 3, 0, 0,
- (SCM key, SCM thunk, SCM handler),
+SCM_DEFINE (scm_catch_with_lazy_handler, "catch", 3, 1, 0,
+ (SCM key, SCM thunk, SCM handler, SCM lazy_handler),
"Invoke @var{thunk} in the dynamic context of @var{handler} for\n"
"exceptions matching @var{key}. If thunk throws to the symbol\n"
"@var{key}, then @var{handler} is invoked this way:\n"
@@ -509,8 +533,19 @@
"from further up the call chain is invoked.\n"
"\n"
"If the key is @code{#t}, then a throw to @emph{any} symbol will\n"
- "match this call to @code{catch}.")
-#define FUNC_NAME s_scm_catch
+ "match this call to @code{catch}.\n"
+ "\n"
+ "If a @var{lazy-handler} is given and @var{thunk} throws an\n"
+ "exception that matches @var{key}, Guile calls the\n"
+ "@var{lazy-handler} before unwinding the dynamic state and\n"
+ "invoking the main @var{handler}. @var{lazy-handler} should\n"
+ "be a procedure with the same signature as @var{handler}, that\n"
+ "is @code{(lambda (key . args))}, and should return normally, in\n"
+ "other words not call @code{throw} or a continuation. It is\n"
+ "typically used to save the stack at the point where the\n"
+ "exception occurred, but can also query other parts of the\n"
+ "dynamic state at that point, such as fluid values.")
+#define FUNC_NAME s_scm_catch_with_lazy_handler
{
struct scm_body_thunk_data c;
@@ -520,17 +555,29 @@
c.tag = key;
c.body_proc = thunk;
- /* scm_internal_catch takes care of all the mechanics of setting up
- a catch key; we tell it to call scm_body_thunk to run the body,
- and scm_handle_by_proc to deal with any throws to this catch.
- The former receives a pointer to c, telling it how to behave.
- The latter receives a pointer to HANDLER, so it knows who to call. */
- return scm_internal_catch (key,
- scm_body_thunk, &c,
- scm_handle_by_proc, &handler);
+ /* scm_c_catch takes care of all the mechanics of setting up a catch
+ key; we tell it to call scm_body_thunk to run the body, and
+ scm_handle_by_proc to deal with any throws to this catch. The
+ former receives a pointer to c, telling it how to behave. The
+ latter receives a pointer to HANDLER, so it knows who to
+ call. */
+ return scm_c_catch (key,
+ scm_body_thunk, &c,
+ scm_handle_by_proc, &handler,
+ SCM_UNBNDP (lazy_handler) ? NULL : scm_handle_by_proc,
+ &lazy_handler);
}
#undef FUNC_NAME
+/* The following function exists to provide backwards compatibility
+ for the C scm_catch API. Otherwise we could just change
+ "scm_catch_with_lazy_handler" above to "scm_catch". */
+SCM
+scm_catch (SCM key, SCM thunk, SCM handler)
+{
+ return scm_catch_with_lazy_handler (key, thunk, handler, SCM_UNDEFINED);
+}
+
SCM_DEFINE (scm_lazy_catch, "lazy-catch", 3, 0, 0,
(SCM key, SCM thunk, SCM handler),
@@ -646,7 +693,16 @@
/* Otherwise, it's a normal catch. */
else if (SCM_JMPBUFP (jmpbuf))
{
+ struct lazy_catch * lazy;
struct jmp_buf_and_retval * jbr;
+
+ /* Before unwinding anything, run the lazy handler if there is
+ one. */
+ lazy = SCM_JBLAZY (jmpbuf);
+ if (lazy->handler)
+ (lazy->handler) (lazy->handler_data, key, args);
+
+ /* Now unwind and jump. */
scm_dowinds (wind_goal, (scm_ilength (scm_i_dynwinds ())
- scm_ilength (wind_goal)));
jbr = (struct jmp_buf_and_retval *)JBJMPBUF (jmpbuf);
Index: libguile/throw.h
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/throw.h,v
retrieving revision 1.26
diff -u -u -r1.26 throw.h
--- libguile/throw.h 23 May 2005 19:57:21 -0000 1.26
+++ libguile/throw.h 14 Jan 2006 12:43:32 -0000
@@ -30,6 +30,14 @@
typedef SCM (*scm_t_catch_handler) (void *data,
SCM tag, SCM throw_args);
+SCM_API SCM scm_c_catch (SCM tag,
+ scm_t_catch_body body,
+ void *body_data,
+ scm_t_catch_handler handler,
+ void *handler_data,
+ scm_t_catch_handler lazy_handler,
+ void *lazy_handler_data);
+
SCM_API SCM scm_internal_catch (SCM tag,
scm_t_catch_body body,
void *body_data,
@@ -72,6 +80,7 @@
SCM_API SCM scm_handle_by_throw (void *, SCM, SCM);
SCM_API int scm_exit_status (SCM args);
+SCM_API SCM scm_catch_with_lazy_handler (SCM tag, SCM thunk, SCM handler, SCM
lazy_handler);
SCM_API SCM scm_catch (SCM tag, SCM thunk, SCM handler);
SCM_API SCM scm_lazy_catch (SCM tag, SCM thunk, SCM handler);
SCM_API SCM scm_ithrow (SCM key, SCM args, int noreturn);
cvs diff: Diffing libguile-ltdl
cvs diff: Diffing libguile-ltdl/upstream
cvs diff: Diffing libltdl
cvs diff: Diffing oop
cvs diff: Diffing oop/goops
cvs diff: Diffing qt
cvs diff: Diffing qt/md
cvs diff: Diffing qt/time
cvs diff: Diffing scripts
cvs diff: Diffing srfi
cvs diff: Diffing test-suite
cvs diff: Diffing test-suite/standalone
cvs diff: Diffing test-suite/tests
Index: test-suite/tests/exceptions.test
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/test-suite/tests/exceptions.test,v
retrieving revision 1.11
diff -u -u -r1.11 exceptions.test
--- test-suite/tests/exceptions.test 23 May 2005 19:57:22 -0000 1.11
+++ test-suite/tests/exceptions.test 14 Jan 2006 12:43:32 -0000
@@ -60,7 +60,25 @@
exception:wrong-num-args
(catch 'a
(lambda () (throw 'a))
- (lambda (x y . rest) #f)))))
+ (lambda (x y . rest) #f))))
+
+ (with-test-prefix "with lazy handler"
+
+ (pass-if "lazy fluid state"
+ (equal? '(inner outer arg)
+ (let ((fluid-parm (make-fluid))
+ (inner-val #f))
+ (fluid-set! fluid-parm 'outer)
+ (catch 'misc-exc
+ (lambda ()
+ (with-fluids ((fluid-parm 'inner))
+ (throw 'misc-exc 'arg)))
+ (lambda (key . args)
+ (list inner-val
+ (fluid-ref fluid-parm)
+ (car args)))
+ (lambda (key . args)
+ (set! inner-val (fluid-ref fluid-parm)))))))))
(with-test-prefix "false-if-exception"
- Re: No way out., Han-Wen Nienhuys, 2006/01/01
- Message not available
- Re: No way out., Han-Wen Nienhuys, 2006/01/01
- Re: No way out., Neil Jerram, 2006/01/02
- Re: No way out., Neil Jerram, 2006/01/02
- Backtrace and enhanced catch, Neil Jerram, 2006/01/04
- Re: Backtrace and enhanced catch,
Neil Jerram <=
- Re: Backtrace and enhanced catch, Marius Vollmer, 2006/01/22
- Re: Backtrace and enhanced catch, Neil Jerram, 2006/01/23
- Re: Backtrace and enhanced catch, Marius Vollmer, 2006/01/24
- Re: Backtrace and enhanced catch, Ludovic Courtès, 2006/01/16
- Re: Backtrace and enhanced catch, Neil Jerram, 2006/01/18
- Re: Backtrace and enhanced catch, Ludovic Courtès, 2006/01/19
- Re: Backtrace and enhanced catch, Neil Jerram, 2006/01/21
- Re: Backtrace and enhanced catch, Kevin Ryde, 2006/01/26
- Re: Backtrace and enhanced catch, Neil Jerram, 2006/01/27
- Re: Backtrace and enhanced catch, Kevin Ryde, 2006/01/31