[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 04/05: push and pop dynamic state via intrinsics
From: |
Andy Wingo |
Subject: |
[Guile-commits] 04/05: push and pop dynamic state via intrinsics |
Date: |
Sun, 29 Apr 2018 04:48:01 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 89fda6da60b54ed606c67a7e4cc07c8f01a67b6b
Author: Andy Wingo <address@hidden>
Date: Sun Apr 29 10:41:24 2018 +0200
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 24d82c0..4395148 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 7b4fb6e..b845769 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 67fd767..17eca96 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 f3da8ef..1d354d5 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 7144a9e..2bbcdd2 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)