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_thunk, tc16_exception_handler to be subrs

Browse source 
* libguile/exceptions.c (call_thunk):
(call_exception_handler): Rework to expect closure to be program.
(scm_c_make_thunk):
(scm_c_make_exception_handler): Rework to make closures.
(scm_init_exceptions): Rework to allocate trampoline code.
This commit is contained in:
Andy Wingo 2025-06-11 16:01:22 +02:00
parent 6389acf192
commit 7ddcb48224
1 changed files with 40 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

66
libguile/exceptions.c
View file

@ -32,7 +32,8 @@
#include "eq.h"
#include "eval.h"
#include "fluids.h"
#include "gsubr.h"
#include "foreign.h"
#include "gsubr-internal.h"
#include "init.h"
#include "keywords.h"
#include "list.h"
@ -40,7 +41,7 @@
#include "numbers.h"
#include "pairs.h"
#include "ports.h"
#include "smob.h"
#include "programs.h"
#include "stackchk.h"
#include "stacks.h"
#include "strings.h"
@ -67,39 +68,51 @@
/* First, some support for C bodies and exception handlers. */
static scm_t_bits tc16_thunk;
static scm_t_bits tc16_exception_handler;
SCM
scm_c_make_thunk (scm_t_thunk thunk, void *data)
{
SCM_RETURN_NEWSMOB2 (tc16_thunk, thunk, data);
}
SCM
scm_c_make_exception_handler (scm_t_exception_handler handler, void *data)
{
SCM_RETURN_NEWSMOB2 (tc16_exception_handler, handler, data);
}
static const uint32_t *call_thunk_code;
static const uint32_t *call_exception_handler_code;
static SCM
call_thunk (SCM clo)
{
scm_t_thunk thunk = (void*)SCM_SMOB_DATA (clo);
void *data = (void*)SCM_SMOB_DATA_2 (clo);
struct scm_program *p = scm_to_program (clo);
scm_t_thunk thunk = scm_to_pointer (scm_program_free_variable_ref (p, 0));
void *data = scm_to_pointer (scm_program_free_variable_ref (p, 1));
return thunk (data);
}
static SCM
call_exception_handler (SCM clo, SCM exn)
{
scm_t_exception_handler handler = (void*)SCM_SMOB_DATA (clo);
void *data = (void*)SCM_SMOB_DATA_2 (clo);
struct scm_program *p = scm_to_program (clo);
scm_t_exception_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, exn);
}
SCM
scm_c_make_thunk (scm_t_thunk thunk, void *data)
{
struct scm_program *ret =
scm_make_subr_from_code (SCM_I_CURRENT_THREAD, call_thunk_code,
SCM_F_PROGRAM_IS_PRIMITIVE, 2);
scm_program_free_variable_set_x (ret, 0, scm_from_pointer (thunk, NULL));
scm_program_free_variable_set_x (ret, 1, scm_from_pointer (data, NULL));
return scm_from_program (ret);
}
SCM
scm_c_make_exception_handler (scm_t_exception_handler handler, void *data)
{
struct scm_program *ret =
scm_make_subr_from_code (SCM_I_CURRENT_THREAD, call_exception_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);
}
@ -493,11 +506,12 @@ sys_init_exceptions_x (SCM compound_exception_type,
void
scm_init_exceptions ()
{
tc16_thunk = scm_make_smob_type ("thunk", 0);
scm_set_smob_apply (tc16_thunk, call_thunk, 0, 0, 0);
tc16_exception_handler = scm_make_smob_type ("exception-handler", 0);
scm_set_smob_apply (tc16_exception_handler, call_exception_handler, 1, 0, 0);
call_thunk_code =
scm_allocate_subr_code (scm_from_utf8_symbol ("thunk"), 0, 0, 0,
call_thunk, SCM_F_SUBR_CLOSURE);
call_exception_handler_code =
scm_allocate_subr_code (scm_from_utf8_symbol ("exception-handler"), 1, 0, 0,
call_exception_handler, SCM_F_SUBR_CLOSURE);
exception_handler_fluid = scm_make_thread_local_fluid (SCM_BOOL_F);
exception_epoch_fluid = scm_make_fluid_with_default (SCM_INUM1);