summaryrefslogtreecommitdiff
path: root/libguile/dynstack.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-12-05 22:48:49 +0100
committerAndy Wingo <wingo@pobox.com>2016-12-05 22:57:29 +0100
commit7184c176b40db274a92ae14eed1f7d71a0c26e8b (patch)
treedd42a2d278fed8aed8af812fdc377599d09e6328 /libguile/dynstack.c
parentaa84489d18320df086e08554554d6f3b92c45893 (diff)
downloadguile-7184c176b40db274a92ae14eed1f7d71a0c26e8b.tar.gz
with-dynamic-state compiler and VM support
* libguile/dynstack.h (SCM_DYNSTACK_TYPE_DYNAMIC_STATE): * libguile/dynstack.c (DYNAMIC_STATE_WORDS, DYNAMIC_STATE_STATE_BOX): (scm_dynstack_push_dynamic_state): (scm_dynstack_unwind_dynamic_state): New definitions. (scm_dynstack_unwind_1, scm_dynstack_wind_1): Add with-dynamic-state cases. * libguile/memoize.c (push_dynamic_state, pop_dynamic_state) (do_push_dynamic_state, do_pop_dynamic_state): New definitions. (memoize, scm_init_memoize): Handle push-dynamic-state and pop-dynamic-state. * libguile/vm-engine.c (push-dynamic-state, pop-dynamic-state): New opcodes. * module/ice-9/boot-9.scm (with-dynamic-state): New definition in Scheme so that the push-dynamic-state and pop-dynamic-state always run in the VM. * module/language/cps/compile-bytecode.scm (compile-function): * module/language/cps/effects-analysis.scm: * module/language/cps/types.scm: * module/language/tree-il/effects.scm (make-effects-analyzer): * module/language/tree-il/peval.scm (peval): * module/language/tree-il/primitives.scm (*interesting-primitive-names*): * module/system/vm/assembler.scm: Add support for with-dynamic-state to the compiler. * test-suite/tests/fluids.test ("dynamic states"): Add basic tests. * doc/ref/vm.texi (Dynamic Environment Instructions): Update.
Diffstat (limited to 'libguile/dynstack.c')
-rw-r--r--libguile/dynstack.c51
1 files changed, 51 insertions, 0 deletions
diff --git a/libguile/dynstack.c b/libguile/dynstack.c
index 7fb858391..ff57c430d 100644
--- a/libguile/dynstack.c
+++ b/libguile/dynstack.c
@@ -53,6 +53,9 @@
#define WITH_FLUID_FLUID(top) (SCM_PACK ((top)[0]))
#define WITH_FLUID_VALUE_BOX(top) (SCM_PACK ((top)[1]))
+#define DYNAMIC_STATE_WORDS 1
+#define DYNAMIC_STATE_STATE_BOX(top) (SCM_PACK ((top)[0]))
+
@@ -231,6 +234,22 @@ dynstack_pop (scm_t_dynstack *dynstack, scm_t_bits **words)
}
void
+scm_dynstack_push_dynamic_state (scm_t_dynstack *dynstack, SCM state,
+ scm_t_dynamic_state *dynamic_state)
+{
+ scm_t_bits *words;
+ SCM state_box;
+
+ if (SCM_UNLIKELY (scm_is_false (scm_dynamic_state_p (state))))
+ scm_wrong_type_arg ("with-dynamic-state", 0, state);
+
+ state_box = scm_make_variable (scm_set_current_dynamic_state (state));
+ words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_DYNAMIC_STATE, 0,
+ DYNAMIC_STATE_WORDS);
+ words[0] = SCM_UNPACK (state_box);
+}
+
+void
scm_dynstack_pop (scm_t_dynstack *dynstack)
{
scm_t_bits tag, *words;
@@ -305,6 +324,12 @@ scm_dynstack_wind_1 (scm_t_dynstack *dynstack, scm_t_bits *item)
scm_call_0 (DYNWIND_ENTER (item));
break;
+ case SCM_DYNSTACK_TYPE_DYNAMIC_STATE:
+ scm_variable_set_x (DYNAMIC_STATE_STATE_BOX (item),
+ scm_set_current_dynamic_state
+ (scm_variable_ref (DYNAMIC_STATE_STATE_BOX (item))));
+ break;
+
case SCM_DYNSTACK_TYPE_NONE:
default:
abort ();
@@ -362,6 +387,13 @@ scm_dynstack_unwind_1 (scm_t_dynstack *dynstack)
}
break;
+ case SCM_DYNSTACK_TYPE_DYNAMIC_STATE:
+ scm_variable_set_x (DYNAMIC_STATE_STATE_BOX (words),
+ scm_set_current_dynamic_state
+ (scm_variable_ref (DYNAMIC_STATE_STATE_BOX (words))));
+ clear_scm_t_bits (words, DYNAMIC_STATE_WORDS);
+ break;
+
case SCM_DYNSTACK_TYPE_NONE:
default:
abort ();
@@ -542,6 +574,25 @@ scm_dynstack_unwind_fluid (scm_t_dynstack *dynstack,
clear_scm_t_bits (words, len);
}
+void
+scm_dynstack_unwind_dynamic_state (scm_t_dynstack *dynstack,
+ scm_t_dynamic_state *dynamic_state)
+{
+ scm_t_bits tag, *words;
+ size_t len;
+
+ tag = dynstack_pop (dynstack, &words);
+ len = SCM_DYNSTACK_TAG_LEN (tag);
+
+ assert (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_DYNAMIC_STATE);
+ assert (len == DYNAMIC_STATE_WORDS);
+
+ scm_variable_set_x (DYNAMIC_STATE_STATE_BOX (words),
+ scm_set_current_dynamic_state
+ (scm_variable_ref (DYNAMIC_STATE_STATE_BOX (words))));
+ clear_scm_t_bits (words, len);
+}
+
/*
Local Variables: