X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/bfa974f0a4a506888ada92ce362b3eeddde4689b..c96d76b88dcb7805311d14e6e408d064211fde20:/libguile/fluids.c

diff --git a/libguile/fluids.c b/libguile/fluids.c
index 425956d41..7901e2231 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -1,4 +1,4 @@
-/*	Copyright (C) 1996, 1997, 2000 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
@@ -39,8 +39,6 @@
  * whether to permit this exception to apply to your modifications.
  * If you do not wish that, delete this exception notice.  */
 
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
-   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
 
 
 #include "libguile/_scm.h"
@@ -51,29 +49,30 @@
 #include "libguile/alist.h"
 #include "libguile/eval.h"
 #include "libguile/ports.h"
+#include "libguile/deprecation.h"
+#include "libguile/lang.h"
 
 #define INITIAL_FLUIDS 10
 #include "libguile/validate.h"
 
-static volatile int n_fluids;
-long scm_tc16_fluid;
+static volatile long n_fluids;
+scm_t_bits 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;
+  long old_length, i;
 
   old_fluids = root_state->fluids;
   old_length = SCM_VECTOR_LENGTH (old_fluids);
-  new_fluids = scm_make_vector (SCM_MAKINUM (new_length), SCM_BOOL_F);
+  new_fluids = scm_c_make_vector (new_length, SCM_BOOL_F);
   i = 0;
   while (i < old_length)
     {
@@ -96,7 +95,7 @@ scm_copy_fluids (scm_root_state *root_state)
 }
 
 static int
-print_fluid (SCM exp, SCM port, scm_print_state *pstate)
+fluid_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
   scm_puts ("#<fluid ", port);
   scm_intprint ((int) SCM_FLUID_NUM (exp), 10, port);
@@ -104,17 +103,13 @@ print_fluid (SCM exp, SCM port, scm_print_state *pstate)
   return 1;
 }
 
-static int
+static long
 next_fluid_num ()
 {
-  int n;
-#ifdef USE_THREADS
-  SCM_THREAD_CRITICAL_SECTION_START;
-#endif
+  long n;
+  SCM_CRITICAL_SECTION_START;
   n = n_fluids++;
-#ifdef USE_THREADS
-  SCM_THREAD_CRITICAL_SECTION_END;
-#endif
+  SCM_CRITICAL_SECTION_END;
   return n;
 }
 
@@ -129,9 +124,8 @@ SCM_DEFINE (scm_make_fluid, "make-fluid", 0, 0, 0,
 	    "in its own dynamic root, you can use fluids for thread local storage.")
 #define FUNC_NAME s_scm_make_fluid
 {
-  int n;
+  long n;
 
-  SCM_DEFER_INTS;
   n = next_fluid_num ();
   SCM_RETURN_NEWSMOB (scm_tc16_fluid, n);
 }
@@ -139,7 +133,8 @@ SCM_DEFINE (scm_make_fluid, "make-fluid", 0, 0, 0,
 
 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));
@@ -148,14 +143,14 @@ SCM_DEFINE (scm_fluid_p, "fluid?", 1, 0, 0,
 
 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;
+  unsigned long int n;
 
   SCM_VALIDATE_FLUID (1, fluid);
-
   n = SCM_FLUID_NUM (fluid);
 
   if (SCM_VECTOR_LENGTH (scm_root->fluids) <= n)
@@ -169,7 +164,7 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
 	    "Set the value associated with @var{fluid} in the current dynamic root.")
 #define FUNC_NAME s_scm_fluid_set_x
 {
-  int n;
+  unsigned long int n;
 
   SCM_VALIDATE_FLUID (1, fluid);
   n = SCM_FLUID_NUM (fluid);
@@ -184,7 +179,7 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
 void
 scm_swap_fluids (SCM fluids, SCM vals)
 {
-  while (SCM_NIMP (fluids))
+  while (!SCM_NULL_OR_NIL_P (fluids))
     {
       SCM fl = SCM_CAR (fluids);
       SCM old_val = scm_fluid_ref (fl);
@@ -201,7 +196,7 @@ same fluid appears multiple times in the fluids list. */
 void
 scm_swap_fluids_reverse (SCM fluids, SCM vals)
 {
-  if (SCM_NIMP (fluids))
+  if (!SCM_NULL_OR_NIL_P (fluids))
     {
       SCM fl, old_val;
 
@@ -217,7 +212,7 @@ scm_swap_fluids_reverse (SCM fluids, SCM vals)
 static SCM
 apply_thunk (void *thunk)
 {
-  return scm_apply (SCM_PACK (thunk), SCM_EOL, SCM_EOL);
+  return scm_call_0 (SCM_PACK (thunk));
 }
 
 SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0, 
@@ -228,16 +223,16 @@ 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 *) SCM_UNPACK (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;
+  long flen, vlen;
 
   SCM_VALIDATE_LIST_COPYLEN (1, fluids, flen);
   SCM_VALIDATE_LIST_COPYLEN (2, values, vlen);
@@ -253,14 +248,23 @@ scm_internal_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
 }
 #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_list_1 (fluid), scm_list_1 (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);
+  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
 }
 
 /*