diff options
author | Andy Wingo <wingo@pobox.com> | 2016-12-05 22:48:49 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-12-05 22:57:29 +0100 |
commit | 7184c176b40db274a92ae14eed1f7d71a0c26e8b (patch) | |
tree | dd42a2d278fed8aed8af812fdc377599d09e6328 /libguile/dynstack.c | |
parent | aa84489d18320df086e08554554d6f3b92c45893 (diff) | |
download | guile-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.c | 51 |
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: |