mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-02 07:40:30 +02:00
Code Activity

Convert tc16_catch_handler to be subrs

Browse source 
* libguile/throw.c (call_catch_handler): Rework to expect closure to be
program.
(scm_i_make_catch_handler): Rework to make closures.
(scm_init_throw): Rework to allocate trampoline code.
This commit is contained in:
Andy Wingo 2025-06-11 16:12:35 +02:00
parent 7ddcb48224
commit 690845fa1e
1 changed files with 24 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

39
libguile/throw.c
View file

@ -1,4 +1,4 @@
/* Copyright 1995-1998,2000-2001,2003-2004,2006,2008,2009-2014,2017-2019
/* Copyright 1995-1998,2000-2001,2003-2004,2006,2008,2009-2014,2017-2019,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -34,7 +34,8 @@
#include "eval.h"
#include "exceptions.h"
#include "fluids.h"
#include "gsubr.h"
#include "foreign.h"
#include "gsubr-internal.h"
#include "init.h"
#include "list.h"
#include "modules.h"
@ -42,7 +43,7 @@
#include "pairs.h"
#include "ports.h"
#include "private-options.h"
#include "smob.h"
#include "programs.h"
#include "stackchk.h"
#include "stacks.h"
#include "strings.h"
@ -268,20 +269,27 @@ scm_throw (SCM key, SCM args)
/* Now some support for C bodies and catch handlers */
static scm_t_bits tc16_catch_handler;
static const uint32_t *call_catch_handler_code;
static SCM
call_catch_handler (SCM clo, SCM key, SCM args)
{
struct scm_program *p = scm_to_program (clo);
scm_t_catch_handler handler =
scm_to_pointer (scm_program_free_variable_ref (p, 0));
void *data = scm_to_pointer (scm_program_free_variable_ref (p, 1));
return handler (data, key, args);
}
SCM
scm_i_make_catch_handler (scm_t_catch_handler handler, void *data)
{
SCM_RETURN_NEWSMOB2 (tc16_catch_handler, handler, data);
}
static SCM
apply_catch_handler (SCM clo, SCM args)
{
scm_t_catch_handler handler = (void*)SCM_SMOB_DATA (clo);
void *data = (void*)SCM_SMOB_DATA_2 (clo);
return handler (data, scm_car (args), scm_cdr (args));
struct scm_program *ret =
scm_make_subr_from_code (SCM_I_CURRENT_THREAD, call_catch_handler_code,
SCM_F_PROGRAM_IS_PRIMITIVE, 2);
scm_program_free_variable_set_x (ret, 0, scm_from_pointer (handler, NULL));
scm_program_free_variable_set_x (ret, 1, scm_from_pointer (data, NULL));
return scm_from_program (ret);
}
@ -460,8 +468,9 @@ scm_ithrow (SCM key, SCM args, int no_return SCM_UNUSED)
void
scm_init_throw ()
{
tc16_catch_handler = scm_make_smob_type ("catch-handler", 0);
scm_set_smob_apply (tc16_catch_handler, apply_catch_handler, 0, 0, 1);
call_catch_handler_code =
scm_allocate_subr_code (scm_from_utf8_symbol ("exception-handler"), 1, 0, 1,
call_catch_handler, SCM_F_SUBR_CLOSURE);
throw_var = scm_c_define ("throw", SCM_BOOL_F);