From 5d20fd49fe53c2520e36e8bf983c7b7214b0ad2a Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 19 Feb 2014 21:56:48 +0100 Subject: [PATCH] %exception-handler fluid refactor * libguile/throw.c (scm_init_throw): Define %exception-handler here. * module/ice-9/boot-9.scm (%eh): Use the incoming %exception-handler, and then delete it. This way we should be able to do unwind-only exceptions from C. --- libguile/throw.c | 9 ++++++++- module/ice-9/boot-9.scm | 14 ++++++-------- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/libguile/throw.c b/libguile/throw.c index e10695a0a..37be4cd3f 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 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 License @@ -57,6 +57,8 @@ static SCM catch_var, throw_var, with_throw_handler_var; +static SCM exception_handler_fluid; + SCM scm_catch (SCM key, SCM thunk, SCM handler) { @@ -546,6 +548,11 @@ scm_init_throw () tc16_catch_closure = scm_make_smob_type ("catch-closure", 0); scm_set_smob_apply (tc16_catch_closure, apply_catch_closure, 0, 0, 1); + exception_handler_fluid = scm_make_fluid_with_default (SCM_BOOL_F); + /* This binding is later removed when the Scheme definitions of catch, + throw, and with-throw-handler are created in boot-9.scm. */ + scm_c_define ("%exception-handler", exception_handler_fluid); + catch_var = scm_c_define ("catch", scm_c_make_gsubr ("catch", 3, 1, 0, pre_init_catch)); throw_var = scm_c_define ("throw", scm_c_make_gsubr ("throw", 1, 0, 1, diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 23f2d5b93..928990230 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -706,10 +706,9 @@ information is unavailable." ;; shared fluid. Hide the helpers in a lexical contour. (define with-throw-handler #f) -(let () - (define %exception-handler (make-fluid #f)) +(let ((%eh (module-ref (current-module) '%exception-handler))) (define (make-exception-handler catch-key prompt-tag pre-unwind) - (vector (fluid-ref %exception-handler) catch-key prompt-tag pre-unwind)) + (vector (fluid-ref %eh) catch-key prompt-tag pre-unwind)) (define (exception-handler-prev handler) (vector-ref handler 0)) (define (exception-handler-catch-key handler) (vector-ref handler 1)) (define (exception-handler-prompt-tag handler) (vector-ref handler 2)) @@ -762,7 +761,7 @@ If there is no handler at all, Guile prints an error and then exits." (unless (symbol? key) (throw 'wrong-type-arg "throw" "Wrong type argument in position ~a: ~a" (list 1 key) (list key))) - (dispatch-exception (fluid-ref %exception-handler) key args)) + (dispatch-exception (fluid-ref %eh) key args)) (define* (catch k thunk handler #:optional pre-unwind-handler) "Invoke @var{thunk} in the dynamic context of @var{handler} for @@ -806,8 +805,7 @@ non-locally, that exit determines the continuation." (call-with-prompt tag (lambda () - (with-fluid* %exception-handler - (make-exception-handler k tag pre-unwind-handler) + (with-fluid* %eh (make-exception-handler k tag pre-unwind-handler) thunk)) (lambda (cont k . args) (apply handler k args))))) @@ -819,10 +817,10 @@ for key @var{k}, then invoke @var{thunk}." (scm-error 'wrong-type-arg "with-throw-handler" "Wrong type argument in position ~a: ~a" (list 1 k) (list k))) - (with-fluid* %exception-handler - (make-exception-handler k #f pre-unwind-handler) + (with-fluid* %eh (make-exception-handler k #f pre-unwind-handler) thunk)) + (hashq-remove! (%get-pre-modules-obarray) '%exception-handler) (define! 'catch catch) (define! 'with-throw-handler with-throw-handler) (define! 'throw throw))