1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-03 08:10:31 +02:00

VM "hooks" actually are just lists

* libguile/vm.c (vm_hook_compute_enabled):
(invoke_hook):
(scm_i_vm_prepare_stack):
(VM_ADD_HOOK):
(VM_REMOVE_HOOK): Since we don't actually expose the hook objects, we
can just use lists; it's clearer and will let us move hook objects to
Scheme.
This commit is contained in:
Andy Wingo 2025-06-16 08:51:47 +02:00
parent 0d1171afe9
commit 2554e69f78

View file

@ -221,8 +221,7 @@ vm_hook_compute_enabled (scm_thread *thread, SCM hook, uint8_t *enabled)
{
if (thread->vm.trace_level <= 0
|| thread->vm.engine == SCM_VM_REGULAR_ENGINE
|| scm_is_false (hook)
|| scm_is_true (scm_hook_empty_p (hook)))
|| scm_is_null (hook))
*enabled = 0;
else
*enabled = 1;
@ -281,7 +280,7 @@ invoke_hook (scm_thread *thread, SCM hook)
int saved_trace_level;
uint8_t saved_compare_result;
if (scm_is_false (hook) || scm_is_null (SCM_HOOK_PROCEDURES (hook)))
if (scm_is_null (hook))
return;
saved_trace_level = set_vm_trace_level (thread, 0);
@ -305,7 +304,8 @@ invoke_hook (scm_thread *thread, SCM hook)
frame->frame.ip = vp->ip;
scm_frame = SCM_PACK_POINTER (frame);
scm_c_run_hookn (hook, &scm_frame, 1);
for (; scm_is_pair (hook); hook = scm_cdr (hook))
scm_call_1 (scm_car (hook), scm_frame);
vp->compare_result = saved_compare_result;
set_vm_trace_level (thread, saved_trace_level);
@ -639,7 +639,7 @@ scm_i_vm_prepare_stack (struct scm_vm *vp)
vp->compare_result = SCM_F_COMPARE_NONE;
vp->engine = vm_default_engine;
vp->trace_level = 0;
#define INIT_HOOK(h) vp->h##_hook = SCM_BOOL_F;
#define INIT_HOOK(h) vp->h##_hook = SCM_EOL;
FOR_EACH_HOOK (INIT_HOOK)
#undef INIT_HOOK
}
@ -1585,11 +1585,8 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
#define VM_ADD_HOOK(h, f) \
{ \
scm_thread *t = SCM_I_CURRENT_THREAD; \
SCM hook = t->vm.h##_hook; \
if (scm_is_false (hook)) \
hook = t->vm.h##_hook = scm_make_hook (SCM_I_MAKINUM (1)); \
scm_add_hook_x (hook, f, SCM_UNDEFINED); \
vm_hook_compute_enabled (t, hook, &t->vm.h##_hook_enabled); \
t->vm.h##_hook = scm_cons (f, scm_delq_x (f, t->vm.h##_hook)); \
vm_hook_compute_enabled (t, t->vm.h##_hook, &t->vm.h##_hook_enabled); \
vm_recompute_disable_mcode (t); \
return SCM_UNSPECIFIED; \
}
@ -1597,10 +1594,8 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
#define VM_REMOVE_HOOK(h, f) \
{ \
scm_thread *t = SCM_I_CURRENT_THREAD; \
SCM hook = t->vm.h##_hook; \
if (scm_is_true (hook)) \
scm_remove_hook_x (hook, f); \
vm_hook_compute_enabled (t, hook, &t->vm.h##_hook_enabled); \
t->vm.h##_hook = scm_delq_x (f, t->vm.h##_hook); \
vm_hook_compute_enabled (t, t->vm.h##_hook, &t->vm.h##_hook_enabled); \
vm_recompute_disable_mcode (t); \
return SCM_UNSPECIFIED; \
}