From: Neil Jerram <neil@ossau.uklinux.net>
Cc: guile-devel@gnu.org
Subject: Re: Backtrace and enhanced catch
Date: Sat, 14 Jan 2006 12:41:43 +0000 [thread overview]
Message-ID: <87oe2foubc.fsf@ossau.uklinux.net> (raw)
In-Reply-To: <87acebhf1o.fsf@ossau.uklinux.net> (Neil Jerram's message of "Wed, 04 Jan 2006 21:13:55 +0000")
Neil Jerram <neil@ossau.uklinux.net> 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 ...
neil@laruns:~$ 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)>
neil@laruns:~$ guile-local g.scm
ERROR: Wrong number of arguments to #<procedure f (x)>
neil@laruns:~$
... 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 @@
}
\f
-/* 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);
+}
+
\f
/* 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 @@
\f
/* 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"
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel
next prev parent reply other threads:[~2006-01-14 12:41 UTC|newest]
Thread overview: 32+ messages / expand[flat|nested] mbox.gz Atom feed top
2005-12-01 0:16 gh_inexact_p error in 1.7.x Bruce Korb
2005-12-01 0:44 ` Kevin Ryde
2005-12-05 4:08 ` No way out Bruce Korb
2005-12-05 4:35 ` Bruce Korb
2005-12-07 1:31 ` Marius Vollmer
2005-12-05 22:20 ` Kevin Ryde
2005-12-06 10:58 ` Han-Wen Nienhuys
2005-12-28 15:59 ` Neil Jerram
2005-12-31 15:09 ` Han-Wen Nienhuys
2005-12-31 15:14 ` Neil Jerram
2006-01-01 19:58 ` Han-Wen Nienhuys
2006-01-02 15:42 ` Neil Jerram
2006-01-02 18:54 ` Neil Jerram
2006-01-04 21:13 ` Backtrace and enhanced catch Neil Jerram
2006-01-14 12:41 ` Neil Jerram [this message]
2006-01-22 13:47 ` Marius Vollmer
2006-01-23 20:11 ` Neil Jerram
2006-01-24 21:34 ` Marius Vollmer
2006-01-16 8:38 ` Ludovic Courtès
2006-01-18 23:08 ` Neil Jerram
2006-01-19 9:38 ` Ludovic Courtès
2006-01-21 11:26 ` Neil Jerram
2006-01-26 23:29 ` Kevin Ryde
2006-01-27 19:30 ` Neil Jerram
2006-01-31 20:07 ` Kevin Ryde
2006-02-01 23:04 ` Neil Jerram
2006-02-04 0:46 ` Kevin Ryde
2006-02-04 15:41 ` Neil Jerram
2005-12-07 1:07 ` No way out Marius Vollmer
2005-12-07 1:55 ` Rob Browning
2005-12-13 20:32 ` Marius Vollmer
2005-12-28 16:09 ` Neil Jerram
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87oe2foubc.fsf@ossau.uklinux.net \
--to=neil@ossau.uklinux.net \
--cc=guile-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).