summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
Diffstat (limited to 'libguile')
-rw-r--r--libguile/__scm.h4
-rw-r--r--libguile/eval.c170
-rw-r--r--libguile/evalext.c5
-rw-r--r--libguile/list.c59
-rw-r--r--libguile/srfi-1.c229
-rw-r--r--libguile/srfi-1.h2
-rw-r--r--libguile/vm-engine.c2
-rw-r--r--libguile/vm-engine.h2
-rw-r--r--libguile/vm-i-system.c8
9 files changed, 75 insertions, 406 deletions
diff --git a/libguile/__scm.h b/libguile/__scm.h
index 2bfb4f694..f5551ad7a 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -536,10 +536,10 @@ SCM_API void scm_async_tick (void);
while (0)
/* SCM_ASYNC_TICK_WITH_CODE is only available to Guile itself */
-# define SCM_ASYNC_TICK_WITH_CODE(stmt) \
+# define SCM_ASYNC_TICK_WITH_CODE(thr, stmt) \
do \
{ \
- if (SCM_UNLIKELY (SCM_I_CURRENT_THREAD->pending_asyncs)) \
+ if (SCM_UNLIKELY (thr->pending_asyncs)) \
{ \
stmt; \
scm_async_click (); \
diff --git a/libguile/eval.c b/libguile/eval.c
index f830e0099..009f3790b 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -596,171 +596,31 @@ SCM_DEFINE (scm_nconc2last, "apply:nconc2last", 1, 0, 0,
#undef FUNC_NAME
-
-/* Typechecking for multi-argument MAP and FOR-EACH.
-
- Verify that each element of the vector ARGV, except for the first,
- is a proper list whose length is LEN. Attribute errors to WHO,
- and claim that the i'th element of ARGV is WHO's i+2'th argument. */
-static inline void
-check_map_args (SCM argv,
- long len,
- SCM gf,
- SCM proc,
- SCM args,
- const char *who)
-{
- long i;
-
- for (i = SCM_SIMPLE_VECTOR_LENGTH (argv) - 1; i >= 1; i--)
- {
- SCM elt = SCM_SIMPLE_VECTOR_REF (argv, i);
- long elt_len = scm_ilength (elt);
-
- if (elt_len < 0)
- {
- if (gf)
- scm_apply_generic (gf, scm_cons (proc, args));
- else
- scm_wrong_type_arg (who, i + 2, elt);
- }
-
- if (elt_len != len)
- scm_out_of_range_pos (who, elt, scm_from_long (i + 2));
- }
-}
-
-
-SCM_GPROC (s_map, "map", 2, 0, 1, scm_map, g_map);
-
-/* Note: Currently, scm_map applies PROC to the argument list(s)
- sequentially, starting with the first element(s). This is used in
- evalext.c where the Scheme procedure `map-in-order', which guarantees
- sequential behaviour, is implemented using scm_map. If the
- behaviour changes, we need to update `map-in-order'.
-*/
-
SCM
scm_map (SCM proc, SCM arg1, SCM args)
-#define FUNC_NAME s_map
{
- long i, len;
- SCM res = SCM_EOL;
- SCM *pres = &res;
-
- len = scm_ilength (arg1);
- SCM_GASSERTn (len >= 0,
- g_map, scm_cons2 (proc, arg1, args), SCM_ARG2, s_map);
- SCM_VALIDATE_REST_ARGUMENT (args);
- if (scm_is_null (args))
- {
- SCM_GASSERT2 (scm_is_true (scm_procedure_p (proc)), g_map, proc, arg1, SCM_ARG1, s_map);
- while (SCM_NIMP (arg1))
- {
- *pres = scm_list_1 (scm_call_1 (proc, SCM_CAR (arg1)));
- pres = SCM_CDRLOC (*pres);
- arg1 = SCM_CDR (arg1);
- }
- return res;
- }
- if (scm_is_null (SCM_CDR (args)))
- {
- SCM arg2 = SCM_CAR (args);
- int len2 = scm_ilength (arg2);
- SCM_GASSERTn (scm_is_true (scm_procedure_p (proc)), g_map,
- scm_cons2 (proc, arg1, args), SCM_ARG1, s_map);
- SCM_GASSERTn (len2 >= 0,
- g_map, scm_cons2 (proc, arg1, args), SCM_ARG3, s_map);
- if (len2 != len)
- SCM_OUT_OF_RANGE (3, arg2);
- while (SCM_NIMP (arg1))
- {
- *pres = scm_list_1 (scm_call_2 (proc, SCM_CAR (arg1), SCM_CAR (arg2)));
- pres = SCM_CDRLOC (*pres);
- arg1 = SCM_CDR (arg1);
- arg2 = SCM_CDR (arg2);
- }
- return res;
- }
- arg1 = scm_cons (arg1, args);
- args = scm_vector (arg1);
- check_map_args (args, len, g_map, proc, arg1, s_map);
- while (1)
- {
- arg1 = SCM_EOL;
- for (i = SCM_SIMPLE_VECTOR_LENGTH (args) - 1; i >= 0; i--)
- {
- SCM elt = SCM_SIMPLE_VECTOR_REF (args, i);
- if (SCM_IMP (elt))
- return res;
- arg1 = scm_cons (SCM_CAR (elt), arg1);
- SCM_SIMPLE_VECTOR_SET (args, i, SCM_CDR (elt));
- }
- *pres = scm_list_1 (scm_apply (proc, arg1, SCM_EOL));
- pres = SCM_CDRLOC (*pres);
- }
-}
-#undef FUNC_NAME
+ static SCM var = SCM_BOOL_F;
+ if (scm_is_false (var))
+ var = scm_private_variable (scm_the_root_module (),
+ scm_from_latin1_symbol ("map"));
-SCM_GPROC (s_for_each, "for-each", 2, 0, 1, scm_for_each, g_for_each);
+ return scm_apply (scm_variable_ref (var),
+ scm_cons (proc, scm_cons (arg1, args)), SCM_EOL);
+}
SCM
scm_for_each (SCM proc, SCM arg1, SCM args)
-#define FUNC_NAME s_for_each
{
- long i, len;
- len = scm_ilength (arg1);
- SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args),
- SCM_ARG2, s_for_each);
- SCM_VALIDATE_REST_ARGUMENT (args);
- if (scm_is_null (args))
- {
- SCM_GASSERT2 (scm_is_true (scm_procedure_p (proc)), g_for_each,
- proc, arg1, SCM_ARG1, s_for_each);
- while (SCM_NIMP (arg1))
- {
- scm_call_1 (proc, SCM_CAR (arg1));
- arg1 = SCM_CDR (arg1);
- }
- return SCM_UNSPECIFIED;
- }
- if (scm_is_null (SCM_CDR (args)))
- {
- SCM arg2 = SCM_CAR (args);
- int len2 = scm_ilength (arg2);
- SCM_GASSERTn (scm_is_true (scm_procedure_p (proc)), g_for_each,
- scm_cons2 (proc, arg1, args), SCM_ARG1, s_for_each);
- SCM_GASSERTn (len2 >= 0, g_for_each,
- scm_cons2 (proc, arg1, args), SCM_ARG3, s_for_each);
- if (len2 != len)
- SCM_OUT_OF_RANGE (3, arg2);
- while (SCM_NIMP (arg1))
- {
- scm_call_2 (proc, SCM_CAR (arg1), SCM_CAR (arg2));
- arg1 = SCM_CDR (arg1);
- arg2 = SCM_CDR (arg2);
- }
- return SCM_UNSPECIFIED;
- }
- arg1 = scm_cons (arg1, args);
- args = scm_vector (arg1);
- check_map_args (args, len, g_for_each, proc, arg1, s_for_each);
- while (1)
- {
- arg1 = SCM_EOL;
- for (i = SCM_SIMPLE_VECTOR_LENGTH (args) - 1; i >= 0; i--)
- {
- SCM elt = SCM_SIMPLE_VECTOR_REF (args, i);
- if (SCM_IMP (elt))
- return SCM_UNSPECIFIED;
- arg1 = scm_cons (SCM_CAR (elt), arg1);
- SCM_SIMPLE_VECTOR_SET (args, i, SCM_CDR (elt));
- }
- scm_apply (proc, arg1, SCM_EOL);
- }
+ static SCM var = SCM_BOOL_F;
+
+ if (scm_is_false (var))
+ var = scm_private_variable (scm_the_root_module (),
+ scm_from_latin1_symbol ("for-each"));
+
+ return scm_apply (scm_variable_ref (var),
+ scm_cons (proc, scm_cons (arg1, args)), SCM_EOL);
}
-#undef FUNC_NAME
static SCM
diff --git a/libguile/evalext.c b/libguile/evalext.c
index ff2ff0ec0..1e5bd6822 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -55,9 +55,6 @@ SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0,
#undef FUNC_NAME
-SCM_REGISTER_PROC (s_map_in_order, "map-in-order", 2, 0, 1, scm_map);
-
-
SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
(SCM obj),
"Return #t for objects which Guile considers self-evaluating")
diff --git a/libguile/list.c b/libguile/list.c
index 23ef40407..704151519 100644
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2008,2009,2010
+/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2008,2009,2010,2011
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@ -617,8 +617,32 @@ SCM_DEFINE (scm_memq, "memq", 2, 0, 0,
"returned.")
#define FUNC_NAME s_scm_memq
{
- SCM_VALIDATE_LIST (2, lst);
- return scm_c_memq (x, lst);
+ SCM hare = lst, tortoise = lst;
+
+ while (scm_is_pair (hare))
+ {
+ if (scm_is_eq (SCM_CAR (hare), x))
+ return hare;
+ else
+ hare = SCM_CDR (hare);
+
+ if (!scm_is_pair (hare))
+ break;
+
+ if (scm_is_eq (SCM_CAR (hare), x))
+ return hare;
+ else
+ hare = SCM_CDR (hare);
+
+ tortoise = SCM_CDR (tortoise);
+ if (SCM_UNLIKELY (scm_is_eq (hare, tortoise)))
+ break;
+ }
+
+ if (SCM_LIKELY (scm_is_null (hare)))
+ return SCM_BOOL_F;
+ else
+ scm_wrong_type_arg_msg (FUNC_NAME, 2, lst, "list");
}
#undef FUNC_NAME
@@ -633,13 +657,32 @@ SCM_DEFINE (scm_memv, "memv", 2, 0, 0,
"returned.")
#define FUNC_NAME s_scm_memv
{
- SCM_VALIDATE_LIST (2, lst);
- for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst))
+ SCM hare = lst, tortoise = lst;
+
+ while (scm_is_pair (hare))
{
- if (! scm_is_false (scm_eqv_p (SCM_CAR (lst), x)))
- return lst;
+ if (scm_is_true (scm_eqv_p (SCM_CAR (hare), x)))
+ return hare;
+ else
+ hare = SCM_CDR (hare);
+
+ if (!scm_is_pair (hare))
+ break;
+
+ if (scm_is_true (scm_eqv_p (SCM_CAR (hare), x)))
+ return hare;
+ else
+ hare = SCM_CDR (hare);
+
+ tortoise = SCM_CDR (tortoise);
+ if (SCM_UNLIKELY (scm_is_eq (hare, tortoise)))
+ break;
}
- return SCM_BOOL_F;
+
+ if (SCM_LIKELY (scm_is_null (hare)))
+ return SCM_BOOL_F;
+ else
+ scm_wrong_type_arg_msg (FUNC_NAME, 2, lst, "list");
}
#undef FUNC_NAME
diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c
index f67e60082..37441f788 100644
--- a/libguile/srfi-1.c
+++ b/libguile/srfi-1.c
@@ -44,32 +44,6 @@
*/
-static long
-srfi1_ilength (SCM sx)
-{
- long i = 0;
- SCM tortoise = sx;
- SCM hare = sx;
-
- do {
- if (SCM_NULL_OR_NIL_P(hare)) return i;
- if (!scm_is_pair (hare)) return -2;
- hare = SCM_CDR(hare);
- i++;
- if (SCM_NULL_OR_NIL_P(hare)) return i;
- if (!scm_is_pair (hare)) return -2;
- hare = SCM_CDR(hare);
- i++;
- /* For every two steps the hare takes, the tortoise takes one. */
- tortoise = SCM_CDR(tortoise);
- }
- while (! scm_is_eq (hare, tortoise));
-
- /* If the tortoise ever catches the hare, then the list must contain
- a cycle. */
- return -1;
-}
-
static SCM
equal_trampoline (SCM proc, SCM arg1, SCM arg2)
{
@@ -760,202 +734,6 @@ SCM_DEFINE (scm_srfi1_lset_difference_x, "lset-difference!", 2, 0, 1,
#undef FUNC_NAME
-/* Typechecking for multi-argument MAP and FOR-EACH.
-
- Verify that each element of the vector ARGV, except for the first,
- is a list and return minimum length. Attribute errors to WHO,
- and claim that the i'th element of ARGV is WHO's i+2'th argument. */
-static inline int
-check_map_args (SCM argv,
- long len,
- SCM gf,
- SCM proc,
- SCM args,
- const char *who)
-{
- long i;
- SCM elt;
-
- for (i = SCM_SIMPLE_VECTOR_LENGTH (argv) - 1; i >= 1; i--)
- {
- long elt_len;
- elt = SCM_SIMPLE_VECTOR_REF (argv, i);
-
- if (!(scm_is_null (elt) || scm_is_pair (elt)))
- goto check_map_error;
-
- elt_len = srfi1_ilength (elt);
- if (elt_len < -1)
- goto check_map_error;
-
- if (len < 0 || (elt_len >= 0 && elt_len < len))
- len = elt_len;
- }
-
- if (len < 0)
- {
- /* i == 0 */
- elt = SCM_EOL;
- check_map_error:
- if (gf)
- scm_apply_generic (gf, scm_cons (proc, args));
- else
- scm_wrong_type_arg (who, i + 2, elt);
- }
-
- scm_remember_upto_here_1 (argv);
- return len;
-}
-
-
-SCM_GPROC (s_srfi1_map, "map", 2, 0, 1, scm_srfi1_map, g_srfi1_map);
-
-/* Note: Currently, scm_srfi1_map applies PROC to the argument list(s)
- sequentially, starting with the first element(s). This is used in
- the Scheme procedure `map-in-order', which guarantees sequential
- behaviour, is implemented using scm_map. If the behaviour changes,
- we need to update `map-in-order'.
-*/
-
-SCM
-scm_srfi1_map (SCM proc, SCM arg1, SCM args)
-#define FUNC_NAME s_srfi1_map
-{
- long i, len;
- SCM res = SCM_EOL;
- SCM *pres = &res;
-
- len = srfi1_ilength (arg1);
- SCM_GASSERTn ((scm_is_null (arg1) || scm_is_pair (arg1)) && len >= -1,
- g_srfi1_map,
- scm_cons2 (proc, arg1, args), SCM_ARG2, s_srfi1_map);
- SCM_VALIDATE_REST_ARGUMENT (args);
- if (scm_is_null (args))
- {
- SCM_GASSERT2 (scm_is_true (scm_procedure_p (proc)), g_srfi1_map,
- proc, arg1, SCM_ARG1, s_srfi1_map);
- SCM_GASSERT2 (len >= 0, g_srfi1_map, proc, arg1, SCM_ARG2, s_srfi1_map);
- while (SCM_NIMP (arg1))
- {
- *pres = scm_list_1 (scm_call_1 (proc, SCM_CAR (arg1)));
- pres = SCM_CDRLOC (*pres);
- arg1 = SCM_CDR (arg1);
- }
- return res;
- }
- if (scm_is_null (SCM_CDR (args)))
- {
- SCM arg2 = SCM_CAR (args);
- int len2 = srfi1_ilength (arg2);
- SCM_GASSERTn (scm_is_true (scm_procedure_p (proc)), g_srfi1_map,
- scm_cons2 (proc, arg1, args), SCM_ARG1, s_srfi1_map);
- if (len < 0 || (len2 >= 0 && len2 < len))
- len = len2;
- SCM_GASSERTn ((scm_is_null (arg2) || scm_is_pair (arg2))
- && len >= 0 && len2 >= -1,
- g_srfi1_map,
- scm_cons2 (proc, arg1, args),
- len2 >= 0 ? SCM_ARG2 : SCM_ARG3,
- s_srfi1_map);
- while (len > 0)
- {
- *pres = scm_list_1 (scm_call_2 (proc, SCM_CAR (arg1), SCM_CAR (arg2)));
- pres = SCM_CDRLOC (*pres);
- arg1 = SCM_CDR (arg1);
- arg2 = SCM_CDR (arg2);
- --len;
- }
- return res;
- }
- args = scm_vector (arg1 = scm_cons (arg1, args));
- len = check_map_args (args, len, g_srfi1_map, proc, arg1, s_srfi1_map);
- while (len > 0)
- {
- arg1 = SCM_EOL;
- for (i = SCM_SIMPLE_VECTOR_LENGTH (args) - 1; i >= 0; i--)
- {
- SCM elt = SCM_SIMPLE_VECTOR_REF (args, i);
- arg1 = scm_cons (SCM_CAR (elt), arg1);
- SCM_SIMPLE_VECTOR_SET (args, i, SCM_CDR (elt));
- }
- *pres = scm_list_1 (scm_apply (proc, arg1, SCM_EOL));
- pres = SCM_CDRLOC (*pres);
- --len;
- }
- return res;
-}
-#undef FUNC_NAME
-
-SCM_REGISTER_PROC (s_srfi1_map_in_order, "map-in-order", 2, 0, 1, scm_srfi1_map);
-
-SCM_GPROC (s_srfi1_for_each, "for-each", 2, 0, 1, scm_srfi1_for_each, g_srfi1_for_each);
-
-SCM
-scm_srfi1_for_each (SCM proc, SCM arg1, SCM args)
-#define FUNC_NAME s_srfi1_for_each
-{
- long i, len;
- len = srfi1_ilength (arg1);
- SCM_GASSERTn ((scm_is_null (arg1) || scm_is_pair (arg1)) && len >= -1,
- g_srfi1_for_each, scm_cons2 (proc, arg1, args),
- SCM_ARG2, s_srfi1_for_each);
- SCM_VALIDATE_REST_ARGUMENT (args);
- if (scm_is_null (args))
- {
- SCM_GASSERT2 (scm_is_true (scm_procedure_p (proc)), g_srfi1_for_each,
- proc, arg1, SCM_ARG1, s_srfi1_for_each);
- SCM_GASSERT2 (len >= 0, g_srfi1_for_each, proc, arg1,
- SCM_ARG2, s_srfi1_map);
- while (SCM_NIMP (arg1))
- {
- scm_call_1 (proc, SCM_CAR (arg1));
- arg1 = SCM_CDR (arg1);
- }
- return SCM_UNSPECIFIED;
- }
- if (scm_is_null (SCM_CDR (args)))
- {
- SCM arg2 = SCM_CAR (args);
- int len2 = srfi1_ilength (arg2);
- SCM_GASSERTn (scm_is_true (scm_procedure_p (proc)), g_srfi1_for_each,
- scm_cons2 (proc, arg1, args), SCM_ARG1, s_srfi1_for_each);
- if (len < 0 || (len2 >= 0 && len2 < len))
- len = len2;
- SCM_GASSERTn ((scm_is_null (arg2) || scm_is_pair (arg2))
- && len >= 0 && len2 >= -1,
- g_srfi1_for_each,
- scm_cons2 (proc, arg1, args),
- len2 >= 0 ? SCM_ARG2 : SCM_ARG3,
- s_srfi1_for_each);
- while (len > 0)
- {
- scm_call_2 (proc, SCM_CAR (arg1), SCM_CAR (arg2));
- arg1 = SCM_CDR (arg1);
- arg2 = SCM_CDR (arg2);
- --len;
- }
- return SCM_UNSPECIFIED;
- }
- args = scm_vector (arg1 = scm_cons (arg1, args));
- len = check_map_args (args, len, g_srfi1_for_each, proc, arg1,
- s_srfi1_for_each);
- while (len > 0)
- {
- arg1 = SCM_EOL;
- for (i = SCM_SIMPLE_VECTOR_LENGTH (args) - 1; i >= 0; i--)
- {
- SCM elt = SCM_SIMPLE_VECTOR_REF (args, i);
- arg1 = scm_cons (SCM_CAR (elt), arg1);
- SCM_SIMPLE_VECTOR_SET (args, i, SCM_CDR (elt));
- }
- scm_apply (proc, arg1, SCM_EOL);
- --len;
- }
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
SCM_DEFINE (scm_srfi1_assoc, "assoc", 2, 1, 0,
(SCM key, SCM alist, SCM pred),
"Behaves like @code{assq} but uses third argument @var{pred?}\n"
@@ -1175,16 +953,9 @@ scm_register_srfi_1 (void)
void
scm_init_srfi_1 (void)
{
- SCM the_root_module = scm_lookup_closure_module (SCM_BOOL_F);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/srfi-1.x"
#endif
- scm_c_extend_primitive_generic
- (SCM_VARIABLE_REF (scm_c_module_lookup (the_root_module, "map")),
- SCM_VARIABLE_REF (scm_c_lookup ("map")));
- scm_c_extend_primitive_generic
- (SCM_VARIABLE_REF (scm_c_module_lookup (the_root_module, "for-each")),
- SCM_VARIABLE_REF (scm_c_lookup ("for-each")));
}
/* End of srfi-1.c. */
diff --git a/libguile/srfi-1.h b/libguile/srfi-1.h
index 85aa65d0c..13ab067bd 100644
--- a/libguile/srfi-1.h
+++ b/libguile/srfi-1.h
@@ -39,8 +39,6 @@ SCM_INTERNAL SCM scm_srfi1_find_tail (SCM pred, SCM lst);
SCM_INTERNAL SCM scm_srfi1_length_plus (SCM lst);
SCM_INTERNAL SCM scm_srfi1_lset_difference_x (SCM equal, SCM lst, SCM rest);
SCM_INTERNAL SCM scm_srfi1_list_copy (SCM lst);
-SCM_INTERNAL SCM scm_srfi1_map (SCM proc, SCM arg1, SCM args);
-SCM_INTERNAL SCM scm_srfi1_for_each (SCM proc, SCM arg1, SCM args);
SCM_INTERNAL SCM scm_srfi1_assoc (SCM key, SCM alist, SCM pred);
SCM_INTERNAL SCM scm_srfi1_partition (SCM pred, SCM list);
SCM_INTERNAL SCM scm_srfi1_partition_x (SCM pred, SCM list);
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index bfa848967..e449b4372 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -52,7 +52,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
#endif
SCM *stack_limit = vp->stack_limit; /* stack limit address */
- SCM dynstate = SCM_I_CURRENT_THREAD->dynamic_state;
+ scm_i_thread *current_thread = SCM_I_CURRENT_THREAD;
scm_t_int64 vm_cookie = vp->cookie++;
/* Internal variables */
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index abbc11077..146931eb6 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -244,7 +244,7 @@
RUN_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK)
#define VM_HANDLE_INTERRUPTS \
- SCM_ASYNC_TICK_WITH_CODE (SYNC_REGISTER ())
+ SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
/*
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index ea00fc920..0ff411f9a 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1635,7 +1635,7 @@ VM_DEFINE_INSTRUCTION (89, wind_fluids, "wind-fluids", 1, -1, 0)
wf = scm_i_make_with_fluids (n, sp + 1, sp + 1 + n);
NULLSTACK (2 * n);
- scm_i_swap_with_fluids (wf, dynstate);
+ scm_i_swap_with_fluids (wf, current_thread->dynamic_state);
scm_i_set_dynwinds (scm_cons (wf, scm_i_dynwinds ()));
NEXT;
}
@@ -1645,7 +1645,7 @@ VM_DEFINE_INSTRUCTION (90, unwind_fluids, "unwind-fluids", 0, 0, 0)
SCM wf;
wf = scm_car (scm_i_dynwinds ());
scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ()));
- scm_i_swap_with_fluids (wf, dynstate);
+ scm_i_swap_with_fluids (wf, current_thread->dynamic_state);
NEXT;
}
@@ -1655,7 +1655,7 @@ VM_DEFINE_INSTRUCTION (91, fluid_ref, "fluid-ref", 0, 1, 1)
SCM fluids;
CHECK_UNDERFLOW ();
- fluids = SCM_I_DYNAMIC_STATE_FLUIDS (dynstate);
+ fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state);
if (SCM_UNLIKELY (!SCM_FLUID_P (*sp))
|| ((num = SCM_I_FLUID_NUM (*sp)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
{
@@ -1683,7 +1683,7 @@ VM_DEFINE_INSTRUCTION (92, fluid_set, "fluid-set", 0, 2, 0)
SCM val, fluid, fluids;
POP2 (val, fluid);
- fluids = SCM_I_DYNAMIC_STATE_FLUIDS (dynstate);
+ fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state);
if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
|| ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
{