-/* Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
-#include "_scm.h"
-#include "print.h"
-#include "smob.h"
-#include "dynwind.h"
-#include "fluids.h"
-#include "alist.h"
-#include "eval.h"
-#include "ports.h"
+#include "libguile/_scm.h"
+#include "libguile/print.h"
+#include "libguile/smob.h"
+#include "libguile/dynwind.h"
+#include "libguile/fluids.h"
+#include "libguile/alist.h"
+#include "libguile/eval.h"
+#include "libguile/ports.h"
+#include "libguile/deprecation.h"
#define INITIAL_FLUIDS 10
-#include "validate.h"
+#include "libguile/validate.h"
-static volatile int n_fluids;
-long scm_tc16_fluid;
+static volatile scm_bits_t n_fluids;
+scm_bits_t scm_tc16_fluid;
SCM
scm_make_initial_fluids ()
{
- return scm_make_vector (SCM_MAKINUM (INITIAL_FLUIDS),
- SCM_BOOL_F);
+ return scm_c_make_vector (INITIAL_FLUIDS, SCM_BOOL_F);
}
static void
grow_fluids (scm_root_state *root_state, int new_length)
{
SCM old_fluids, new_fluids;
- int old_length, i;
+ scm_bits_t old_length, i;
old_fluids = root_state->fluids;
- old_length = SCM_LENGTH (old_fluids);
- new_fluids = scm_make_vector (SCM_MAKINUM (new_length), SCM_BOOL_F);
+ old_length = SCM_VECTOR_LENGTH (old_fluids);
+ new_fluids = scm_c_make_vector (new_length, SCM_BOOL_F);
i = 0;
while (i < old_length)
{
void
scm_copy_fluids (scm_root_state *root_state)
{
- grow_fluids (root_state, SCM_LENGTH(root_state->fluids));
+ grow_fluids (root_state, SCM_VECTOR_LENGTH (root_state->fluids));
}
static int
-print_fluid (SCM exp, SCM port, scm_print_state *pstate)
+fluid_print (SCM exp, SCM port, scm_print_state *pstate)
{
scm_puts ("#<fluid ", port);
scm_intprint ((int) SCM_FLUID_NUM (exp), 10, port);
return 1;
}
-static int
+static scm_bits_t
next_fluid_num ()
{
- int n;
-#ifdef USE_THREADS
- SCM_THREAD_CRITICAL_SECTION_START;
-#endif
+ scm_bits_t n;
+ SCM_CRITICAL_SECTION_START;
n = n_fluids++;
-#ifdef USE_THREADS
- SCM_THREAD_CRITICAL_SECTION_END;
-#endif
+ SCM_CRITICAL_SECTION_END;
return n;
}
"in its own dynamic root, you can use fluids for thread local storage.")
#define FUNC_NAME s_scm_make_fluid
{
- int n;
+ scm_bits_t n;
- SCM_DEFER_INTS;
n = next_fluid_num ();
SCM_RETURN_NEWSMOB (scm_tc16_fluid, n);
}
SCM_DEFINE (scm_fluid_p, "fluid?", 1, 0, 0,
(SCM obj),
- "Return #t iff @var{obj} is a fluid; otherwise, return #f.")
+ "Return @code{#t} iff @var{obj} is a fluid; otherwise, return\n"
+ "@code{#f}.")
#define FUNC_NAME s_scm_fluid_p
{
return SCM_BOOL(SCM_FLUIDP (obj));
SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
(SCM fluid),
- "Return the value associated with @var{fluid} in the current dynamic root.\n"
- "If @var{fluid} has not been set, then this returns #f.")
+ "Return the value associated with @var{fluid} in the current\n"
+ "dynamic root. If @var{fluid} has not been set, then return\n"
+ "@code{#f}.")
#define FUNC_NAME s_scm_fluid_ref
{
- int n;
+ scm_bits_t n;
SCM_VALIDATE_FLUID (1, fluid);
n = SCM_FLUID_NUM (fluid);
- if (SCM_LENGTH (scm_root->fluids) <= n)
+ if (SCM_VECTOR_LENGTH (scm_root->fluids) <= n)
grow_fluids (scm_root, n+1);
- return SCM_VELTS(scm_root->fluids)[n];
+ return SCM_VELTS (scm_root->fluids)[n];
}
#undef FUNC_NAME
"Set the value associated with @var{fluid} in the current dynamic root.")
#define FUNC_NAME s_scm_fluid_set_x
{
- int n;
+ scm_bits_t n;
SCM_VALIDATE_FLUID (1, fluid);
n = SCM_FLUID_NUM (fluid);
- if (SCM_LENGTH (scm_root->fluids) <= n)
+ if (SCM_VECTOR_LENGTH (scm_root->fluids) <= n)
grow_fluids (scm_root, n+1);
- SCM_VELTS(scm_root->fluids)[n] = value;
- return value;
+ SCM_VELTS (scm_root->fluids)[n] = value;
+ return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
void
scm_swap_fluids (SCM fluids, SCM vals)
{
- while (SCM_NIMP (fluids))
+ while (!SCM_NULLP (fluids))
{
SCM fl = SCM_CAR (fluids);
SCM old_val = scm_fluid_ref (fl);
void
scm_swap_fluids_reverse (SCM fluids, SCM vals)
{
- if (SCM_NIMP (fluids))
+ if (!SCM_NULLP (fluids))
{
SCM fl, old_val;
static SCM
apply_thunk (void *thunk)
{
- return scm_apply ((SCM) thunk, SCM_EOL, SCM_EOL);
+ return scm_apply (SCM_PACK (thunk), SCM_EOL, SCM_EOL);
}
SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0,
"one after another. @var{thunk} must be a procedure with no argument.")
#define FUNC_NAME s_scm_with_fluids
{
- return scm_internal_with_fluids (fluids, values, apply_thunk, (void *)thunk);
+ return scm_c_with_fluids (fluids, values, apply_thunk, (void *) SCM_UNPACK (thunk));
}
#undef FUNC_NAME
SCM
-scm_internal_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
-#define FUNC_NAME "scm_internal_with_fluids"
+scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
+#define FUNC_NAME "scm_c_with_fluids"
{
SCM ans;
- int flen, vlen;
+ scm_bits_t flen, vlen;
SCM_VALIDATE_LIST_COPYLEN (1, fluids, flen);
SCM_VALIDATE_LIST_COPYLEN (2, values, vlen);
}
#undef FUNC_NAME
-
+SCM
+scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata)
+#define FUNC_NAME "scm_c_with_fluid"
+{
+ return scm_c_with_fluids (SCM_LIST1 (fluid), SCM_LIST1 (value),
+ cproc, cdata);
+}
+#undef FUNC_NAME
void
scm_init_fluids ()
{
- scm_tc16_fluid = scm_make_smob_type_mfpe ("fluid", 0,
- NULL, NULL, print_fluid, NULL);
-#include "fluids.x"
+ scm_tc16_fluid = scm_make_smob_type ("fluid", 0);
+ scm_set_smob_print (scm_tc16_fluid, fluid_print);
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/fluids.x"
+#endif
+}
+
+#if SCM_DEBUG_DEPRECATED == 0
+
+SCM
+scm_internal_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
+{
+ scm_c_issue_deprecation_warning ("`scm_internal_with_fluids' is deprecated. "
+ "Use `scm_c_with_fluids' instead.");
+
+ return scm_c_with_fluids (fluids, values, cproc, cdata);
}
+
+#endif
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/