mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00
Code Activity

with-dynamic-state compiler and VM support

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2016-12-05 22:48:49 +01:00
parent aa84489d18
commit 7184c176b4
14 changed files with 260 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

51
libguile/dynstack.c
View file

@ -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]))
@ -230,6 +233,22 @@ dynstack_pop (scm_t_dynstack *dynstack, scm_t_bits **words)
return tag;
}
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)
{
@ -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: