From 89fda6da60b54ed606c67a7e4cc07c8f01a67b6b Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 29 Apr 2018 10:41:24 +0200 Subject: [PATCH] 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. --- libguile/intrinsics.c | 16 +++++++++++++ libguile/intrinsics.h | 5 +++- libguile/vm-engine.c | 29 ++++++++++++++---------- module/language/cps/reify-primitives.scm | 3 ++- module/system/vm/assembler.scm | 15 ++++++++---- 5 files changed, 49 insertions(+), 19 deletions(-) diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c index 24d82c081..4395148af 100644 --- a/libguile/intrinsics.c +++ b/libguile/intrinsics.c @@ -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", diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index 7b4fb6e4f..b845769a4 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -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 diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 67fd767f3..17eca96b6 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -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, diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm index f3da8ef8c..1d354d5bf 100644 --- a/module/language/cps/reify-primitives.scm +++ b/module/language/cps/reify-primitives.scm @@ -237,7 +237,8 @@ cached-toplevel-box cached-module-box wind unwind - push-fluid pop-fluid fluid-ref fluid-set!)) + push-fluid pop-fluid fluid-ref fluid-set! + push-dynamic-state pop-dynamic-state)) (let ((table (make-hash-table))) (for-each (match-lambda ((inst . _) (hashq-set! table inst #t))) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 7144a9e71..2bbcdd2f5 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -218,6 +218,8 @@ emit-pop-fluid emit-fluid-ref emit-fluid-set! + emit-push-dynamic-state + emit-pop-dynamic-state emit-call emit-call-label @@ -244,8 +246,6 @@ emit-toplevel-box emit-module-box emit-prompt - emit-push-dynamic-state - emit-pop-dynamic-state emit-current-thread emit-lsh emit-rsh @@ -1321,12 +1321,15 @@ returned instead." (define-syntax-rule (define-scm<-s64-intrinsic name) (define-macro-assembler (name asm dst src) (emit-call-scm<-s64 asm dst src (intrinsic-name->index 'name)))) -(define-syntax-rule (define-thread-scm-scm-intrinsic name) - (define-macro-assembler (name asm a b) - (emit-call-thread-scm-scm asm a b (intrinsic-name->index 'name)))) (define-syntax-rule (define-thread-intrinsic name) (define-macro-assembler (name asm) (emit-call-thread asm (intrinsic-name->index 'name)))) +(define-syntax-rule (define-thread-scm-intrinsic name) + (define-macro-assembler (name asm a) + (emit-call-thread-scm asm a (intrinsic-name->index 'name)))) +(define-syntax-rule (define-thread-scm-scm-intrinsic name) + (define-macro-assembler (name asm a b) + (emit-call-thread-scm-scm asm a b (intrinsic-name->index 'name)))) (define-syntax-rule (define-scm<-thread-scm-intrinsic name) (define-macro-assembler (name asm dst src) (emit-call-scm<-thread-scm asm dst src (intrinsic-name->index 'name)))) @@ -1361,6 +1364,8 @@ returned instead." (define-thread-intrinsic pop-fluid) (define-scm<-thread-scm-intrinsic fluid-ref) (define-thread-scm-scm-intrinsic fluid-set!) +(define-thread-scm-intrinsic push-dynamic-state) +(define-thread-intrinsic pop-dynamic-state) (define-macro-assembler (begin-program asm label properties) (emit-label asm label)