From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Neil Jerram Newsgroups: gmane.lisp.guile.devel Subject: Re: Backtrace and enhanced catch Date: Sat, 14 Jan 2006 12:41:43 +0000 Message-ID: <87oe2foubc.fsf@ossau.uklinux.net> References: <200511301616.22258.bkorb@gnu.org> <87wthpkyan.fsf@ossau.uklinux.net> <43B69F41.6030509@xs4all.nl> <87hd8pb8o7.fsf@ossau.uklinux.net> <87lkxy3abo.fsf@ossau.uklinux.net> <877j9i31gc.fsf@ossau.uklinux.net> <87acebhf1o.fsf@ossau.uklinux.net> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: sea.gmane.org 1137246929 19968 80.91.229.2 (14 Jan 2006 13:55:29 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sat, 14 Jan 2006 13:55:29 +0000 (UTC) Cc: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sat Jan 14 14:55:25 2006 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by ciao.gmane.org with esmtp (Exim 4.43) id 1ExlsK-0005PT-EI for guile-devel@m.gmane.org; Sat, 14 Jan 2006 14:55:24 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1ExluQ-0006qj-TH for guile-devel@m.gmane.org; Sat, 14 Jan 2006 08:57:36 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1Exkne-000520-DW for guile-devel@gnu.org; Sat, 14 Jan 2006 07:46:30 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1ExknY-00050B-8q for guile-devel@gnu.org; Sat, 14 Jan 2006 07:46:28 -0500 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1ExknW-0004zz-VG for guile-devel@gnu.org; Sat, 14 Jan 2006 07:46:23 -0500 Original-Received: from [80.84.72.33] (helo=mail3.uklinux.net) by monty-python.gnu.org with esmtp (Exim 4.34) id 1Exkqc-0006ol-PM for guile-devel@gnu.org; Sat, 14 Jan 2006 07:49:38 -0500 Original-Received: from laruns (host86-129-132-201.range86-129.btcentralplus.com [86.129.132.201]) by mail3.uklinux.net (Postfix) with ESMTP id 1E03D40A048; Sat, 14 Jan 2006 12:44:01 +0000 (UTC) Original-Received: from laruns (laruns [127.0.0.1]) by laruns (Postfix) with ESMTP id 7962F9F92B; Sat, 14 Jan 2006 12:41:44 +0000 (GMT) Original-To: hanwen@xs4all.nl In-Reply-To: <87acebhf1o.fsf@ossau.uklinux.net> (Neil Jerram's message of "Wed, 04 Jan 2006 21:13:55 +0000") User-Agent: Gnus/5.1007 (Gnus v5.10.7) Emacs/21.4 (gnu/linux) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:5590 Archived-At: Neil Jerram 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 #] 6: 2 [f] g.scm:6:3: In procedure f in expression (x): g.scm:6:3: Wrong number of arguments to # neil@laruns:~$ guile-local g.scm ERROR: Wrong number of arguments to # 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 @@ } -/* 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" _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://lists.gnu.org/mailman/listinfo/guile-devel