1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 01:30:27 +02:00

push and pop dynamic state via intrinsics

* libguile/intrinsics.c (push_dynamic_state, pop_dynamic_state): New
  intrinsics.
  (scm_bootstrap_intrinsics): Add new intrinsics.
* libguile/intrinsics.h: Declare new intrinsics.
* libguile/vm-engine.c (call-thread-scm): New intrinsic caller.
  (push-dynamic-state, pop-dynamic-state): Disable.
* module/language/cps/reify-primitives.scm (compute-known-primitives):
  Add new intrinsics.
* module/system/vm/assembler.scm (push-dynamic-state)
  (pop-dynamic-state): Emit as intrinsics.
This commit is contained in:
Andy Wingo 2018-04-29 10:41:24 +02:00
parent 2eb9c755d1
commit 89fda6da60
5 changed files with 49 additions and 19 deletions

View file

@ -148,6 +148,20 @@ fluid_set_x (scm_i_thread *thread, SCM fluid, SCM value)
scm_fluid_set_x (fluid, value);
}
static void
push_dynamic_state (scm_i_thread *thread, SCM state)
{
scm_dynstack_push_dynamic_state (&thread->dynstack, state,
thread->dynamic_state);
}
static void
pop_dynamic_state (scm_i_thread *thread)
{
scm_dynstack_unwind_dynamic_state (&thread->dynstack,
thread->dynamic_state);
}
void
scm_bootstrap_intrinsics (void)
{
@ -181,6 +195,8 @@ scm_bootstrap_intrinsics (void)
scm_vm_intrinsics.pop_fluid = pop_fluid;
scm_vm_intrinsics.fluid_ref = fluid_ref;
scm_vm_intrinsics.fluid_set_x = fluid_set_x;
scm_vm_intrinsics.push_dynamic_state = push_dynamic_state;
scm_vm_intrinsics.pop_dynamic_state = pop_dynamic_state;
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_intrinsics",

View file

@ -32,8 +32,9 @@ typedef scm_t_uint64 (*scm_t_u64_from_scm_intrinsic) (SCM);
typedef scm_t_int64 (*scm_t_s64_from_scm_intrinsic) (SCM);
typedef SCM (*scm_t_scm_from_u64_intrinsic) (scm_t_uint64);
typedef SCM (*scm_t_scm_from_s64_intrinsic) (scm_t_int64);
typedef void (*scm_t_thread_scm_scm_intrinsic) (scm_i_thread*, SCM, SCM);
typedef void (*scm_t_thread_intrinsic) (scm_i_thread*);
typedef void (*scm_t_thread_scm_intrinsic) (scm_i_thread*, SCM);
typedef void (*scm_t_thread_scm_scm_intrinsic) (scm_i_thread*, SCM, SCM);
typedef SCM (*scm_t_scm_from_thread_scm_intrinsic) (scm_i_thread*, SCM);
#define SCM_FOR_ALL_VM_INTRINSICS(M) \
@ -67,6 +68,8 @@ typedef SCM (*scm_t_scm_from_thread_scm_intrinsic) (scm_i_thread*, SCM);
M(thread, pop_fluid, "pop-fluid", POP_FLUID) \
M(scm_from_thread_scm, fluid_ref, "fluid-ref", FLUID_REF) \
M(thread_scm_scm, fluid_set_x, "fluid-set!", FLUID_SET_X) \
M(thread_scm, push_dynamic_state, "push-dynamic-state", PUSH_DYNAMIC_STATE) \
M(thread, pop_dynamic_state, "pop-dynamic-state", POP_DYNAMIC_STATE) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
enum scm_vm_intrinsic

View file

@ -2271,7 +2271,21 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (2);
}
VM_DEFINE_OP (90, unused_90, NULL, NOP)
VM_DEFINE_OP (90, call_thread_scm, "call-thread-scm", OP2 (X8_S24, C32))
{
scm_t_uint32 a;
scm_t_thread_scm_intrinsic intrinsic;
UNPACK_24 (op, a);
intrinsic = intrinsics[ip[1]];
SYNC_IP ();
intrinsic (thread, SP_REF (a));
CACHE_SP ();
NEXT (2);
}
VM_DEFINE_OP (91, unused_91, NULL, NOP)
VM_DEFINE_OP (92, unused_92, NULL, NOP)
VM_DEFINE_OP (93, unused_93, NULL, NOP)
@ -2808,12 +2822,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (0);
}
/* push-dynamic-state state:24
*
* Save the current fluid bindings on the dynamic stack, and use STATE
* instead.
*/
VM_DEFINE_OP (185, push_dynamic_state, "push-dynamic-state", OP1 (X8_S24))
VM_DEFINE_OP (185, unused_185, NULL, NOP)
{
scm_t_uint32 state;
@ -2825,11 +2834,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (1);
}
/* pop-dynamic-state _:24
*
* Restore the saved fluid bindings from the dynamic stack.
*/
VM_DEFINE_OP (186, pop_dynamic_state, "pop-dynamic-state", OP1 (X32))
VM_DEFINE_OP (186, unused_186, NULL, NOP)
{
SYNC_IP ();
scm_dynstack_unwind_dynamic_state (&thread->dynstack,