libguile/fluids.c

   1 /* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public License
   5  * as published by the Free Software Foundation; either version 3 of
   6  * the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  16  * 02110-1301 USA
  17  */
  18
  19 #ifdef HAVE_CONFIG_H
  20 # include <config.h>
  21 #endif
  22
  23 #include <alloca.h>
  24 #include <stdio.h>
  25 #include <string.h>
  26
  27 #include "libguile/_scm.h"
  28 #include "libguile/print.h"
  29 #include "libguile/dynwind.h"
  30 #include "libguile/fluids.h"
  31 #include "libguile/alist.h"
  32 #include "libguile/eval.h"
  33 #include "libguile/ports.h"
  34 #include "libguile/deprecation.h"
  35 #include "libguile/validate.h"
  36 #include "libguile/bdw-gc.h"
  37
  38 /* Number of additional slots to allocate when ALLOCATED_FLUIDS is full.  */
  39 #define FLUID_GROW 128
  40
  41 /* Vector of allocated fluids indexed by fluid numbers.  Access is protected by
  42    FLUID_ADMIN_MUTEX.  */
  43 static void **allocated_fluids = NULL;
  44 static size_t allocated_fluids_len = 0;
  45
  46 static scm_i_pthread_mutex_t fluid_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
  47
  48 #define IS_FLUID(x)         SCM_FLUID_P (x)
  49 #define FLUID_NUM(x)        SCM_I_FLUID_NUM (x)
  50
  51 #define IS_DYNAMIC_STATE(x) SCM_I_DYNAMIC_STATE_P (x)
  52 #define DYNAMIC_STATE_FLUIDS(x)        SCM_I_DYNAMIC_STATE_FLUIDS (x)
  53 #define SET_DYNAMIC_STATE_FLUIDS(x, y) SCM_SET_CELL_WORD_1 ((x), (SCM_UNPACK (y)))
  54
  55
  56 \f
  57 /* Grow STATE so that it can hold up to ALLOCATED_FLUIDS_LEN fluids.  This may
  58    be more than necessary since ALLOCATED_FLUIDS is sparse and the current
  59    thread may not access all the fluids anyway.  Memory usage could be improved
  60    by using a 2-level array as is done in glibc for pthread keys (TODO).  */
  61 static void
  62 grow_dynamic_state (SCM state)
  63 {
  64   SCM new_fluids;
  65   SCM old_fluids = DYNAMIC_STATE_FLUIDS (state);
  66   size_t i, len, old_len = SCM_SIMPLE_VECTOR_LENGTH (old_fluids);
  67
  68   /* Assume the assignment below is atomic.  */
  69   len = allocated_fluids_len;
  70
  71   new_fluids = scm_c_make_vector (len, SCM_UNDEFINED);
  72
  73   for (i = 0; i < old_len; i++)
  74     SCM_SIMPLE_VECTOR_SET (new_fluids, i,
  75                            SCM_SIMPLE_VECTOR_REF (old_fluids, i));
  76   SET_DYNAMIC_STATE_FLUIDS (state, new_fluids);
  77 }
  78
  79 void
  80 scm_i_fluid_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
  81 {
  82   scm_puts_unlocked ("#<fluid ", port);
  83   scm_intprint ((int) FLUID_NUM (exp), 10, port);
  84   scm_putc_unlocked ('>', port);
  85 }
  86
  87 void
  88 scm_i_dynamic_state_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
  89 {
  90   scm_puts_unlocked ("#<dynamic-state ", port);
  91   scm_intprint (SCM_UNPACK (exp), 16, port);
  92   scm_putc_unlocked ('>', port);
  93 }
  94
  95 void
  96 scm_i_with_fluids_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
  97 {
  98   scm_puts_unlocked ("#<with-fluids ", port);
  99   scm_intprint (SCM_UNPACK (exp), 16, port);
 100   scm_putc_unlocked ('>', port);
 101 }
 102
 103 \f
 104 /* Return a new fluid.  */
 105 static SCM
 106 new_fluid (SCM init)
 107 {
 108   SCM fluid;
 109   size_t trial, n;
 110
 111   /* Fluids hold the type tag and the fluid number in the first word,
 112      and the default value in the second word.  */
 113   fluid = scm_cell (scm_tc7_fluid, SCM_UNPACK (init));
 114   SCM_SET_CELL_TYPE (fluid, scm_tc7_fluid);
 115
 116   scm_dynwind_begin (0);
 117   scm_i_dynwind_pthread_mutex_lock (&fluid_admin_mutex);
 118
 119   for (trial = 0; trial < 2; trial++)
 120     {
 121       /* Look for a free fluid number.  */
 122       for (n = 0; n < allocated_fluids_len; n++)
 123         /* TODO: Use `__sync_bool_compare_and_swap' where available.  */
 124         if (allocated_fluids[n] == NULL)
 125           break;
 126
 127       if (trial == 0 && n >= allocated_fluids_len)
 128         /* All fluid numbers are in use.  Run a GC and retry.  Explicitly
 129            running the GC is costly and bad-style.  We only do this because
 130            dynamic state fluid vectors would grow unreasonably if fluid numbers
 131            weren't reused.  */
 132         scm_i_gc ("fluids");
 133     }
 134
 135   if (n >= allocated_fluids_len)
 136     {
 137       /* Grow the vector of allocated fluids.  */
 138       void **new_allocated_fluids =
 139         scm_gc_malloc_pointerless ((allocated_fluids_len + FLUID_GROW)
 140                                    * sizeof (*allocated_fluids),
 141                                    "allocated fluids");
 142
 143       /* Copy over old values and initialize rest.  GC can not run
 144          during these two operations since there is no safe point in
 145          them.  */
 146       memcpy (new_allocated_fluids, allocated_fluids,
 147               allocated_fluids_len * sizeof (*allocated_fluids));
 148       memset (new_allocated_fluids + allocated_fluids_len, 0,
 149               FLUID_GROW * sizeof (*allocated_fluids));
 150       n = allocated_fluids_len;
 151
 152       /* Update the vector of allocated fluids.  Dynamic states will
 153          eventually be lazily grown to accomodate the new value of
 154          ALLOCATED_FLUIDS_LEN in `fluid-ref' and `fluid-set!'.  */
 155       allocated_fluids = new_allocated_fluids;
 156       allocated_fluids_len += FLUID_GROW;
 157     }
 158
 159   allocated_fluids[n] = SCM_UNPACK_POINTER (fluid);
 160   SCM_SET_CELL_WORD_0 (fluid, (scm_tc7_fluid | (n << 8)));
 161
 162   GC_GENERAL_REGISTER_DISAPPEARING_LINK (&allocated_fluids[n],
 163                                          SCM_HEAP_OBJECT_BASE (fluid));
 164
 165   scm_dynwind_end ();
 166
 167   /* Now null out values.  We could (and probably should) do this when
 168      the fluid is collected instead of now.  */
 169   scm_i_reset_fluid (n);
 170
 171   return fluid;
 172 }
 173
 174 SCM
 175 scm_make_fluid (void)
 176 {
 177   return new_fluid (SCM_BOOL_F);
 178 }
 179
 180 SCM_DEFINE (scm_make_fluid_with_default, "make-fluid", 0, 1, 0,
 181             (SCM dflt),
 182             "Return a newly created fluid.\n"
 183             "Fluids are objects that can hold one\n"
 184             "value per dynamic state.  That is, modifications to this value are\n"
 185             "only visible to code that executes with the same dynamic state as\n"
 186             "the modifying code.  When a new dynamic state is constructed, it\n"
 187             "inherits the values from its parent.  Because each thread normally executes\n"
 188             "with its own dynamic state, you can use fluids for thread local storage.")
 189 #define FUNC_NAME s_scm_make_fluid_with_default
 190 {
 191   return new_fluid (SCM_UNBNDP (dflt) ? SCM_BOOL_F : dflt);
 192 }
 193 #undef FUNC_NAME
 194
 195 SCM_DEFINE (scm_make_unbound_fluid, "make-unbound-fluid", 0, 0, 0,
 196             (),
 197             "Make a fluid that is initially unbound.")
 198 #define FUNC_NAME s_scm_make_unbound_fluid
 199 {
 200   return new_fluid (SCM_UNDEFINED);
 201 }
 202 #undef FUNC_NAME
 203
 204 SCM_DEFINE (scm_fluid_p, "fluid?", 1, 0, 0,
 205             (SCM obj),
 206             "Return @code{#t} iff @var{obj} is a fluid; otherwise, return\n"
 207             "@code{#f}.")
 208 #define FUNC_NAME s_scm_fluid_p
 209 {
 210   return scm_from_bool (IS_FLUID (obj));
 211 }
 212 #undef FUNC_NAME
 213
 214 int
 215 scm_is_fluid (SCM obj)
 216 {
 217   return IS_FLUID (obj);
 218 }
 219
 220 /* Does not check type of `fluid'! */
 221 static SCM
 222 fluid_ref (SCM fluid)
 223 {
 224   SCM ret;
 225   SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
 226
 227   if (SCM_UNLIKELY (FLUID_NUM (fluid) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
 228     {
 229       /* Lazily grow the current thread's dynamic state.  */
 230       grow_dynamic_state (SCM_I_CURRENT_THREAD->dynamic_state);
 231
 232       fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
 233     }
 234
 235   ret = SCM_SIMPLE_VECTOR_REF (fluids, FLUID_NUM (fluid));
 236   if (SCM_UNBNDP (ret))
 237     return SCM_I_FLUID_DEFAULT (fluid);
 238   else
 239     return ret;
 240 }
 241
 242 SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
 243             (SCM fluid),
 244             "Return the value associated with @var{fluid} in the current\n"
 245             "dynamic root.  If @var{fluid} has not been set, then return\n"
 246             "@code{#f}.")
 247 #define FUNC_NAME s_scm_fluid_ref
 248 {
 249   SCM val;
 250   SCM_VALIDATE_FLUID (1, fluid);
 251   val = fluid_ref (fluid);
 252   if (SCM_UNBNDP (val))
 253     SCM_MISC_ERROR ("unbound fluid: ~S",
 254                     scm_list_1 (fluid));
 255   return val;
 256 }
 257 #undef FUNC_NAME
 258
 259 SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
 260             (SCM fluid, SCM value),
 261             "Set the value associated with @var{fluid} in the current dynamic root.")
 262 #define FUNC_NAME s_scm_fluid_set_x
 263 {
 264   SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
 265
 266   SCM_VALIDATE_FLUID (1, fluid);
 267
 268   if (SCM_UNLIKELY (FLUID_NUM (fluid) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
 269     {
 270       /* Lazily grow the current thread's dynamic state.  */
 271       grow_dynamic_state (SCM_I_CURRENT_THREAD->dynamic_state);
 272
 273       fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
 274     }
 275
 276   SCM_SIMPLE_VECTOR_SET (fluids, FLUID_NUM (fluid), value);
 277   return SCM_UNSPECIFIED;
 278 }
 279 #undef FUNC_NAME
 280
 281 SCM_DEFINE (scm_fluid_unset_x, "fluid-unset!", 1, 0, 0,
 282             (SCM fluid),
 283             "Unset the value associated with @var{fluid}.")
 284 #define FUNC_NAME s_scm_fluid_unset_x
 285 {
 286   /* FIXME: really unset the default value, too?  The current test
 287      suite demands it, but I would prefer not to.  */
 288   SCM_SET_CELL_OBJECT_1 (fluid, SCM_UNDEFINED);
 289   return scm_fluid_set_x (fluid, SCM_UNDEFINED);
 290 }
 291 #undef FUNC_NAME
 292
 293 SCM_DEFINE (scm_fluid_bound_p, "fluid-bound?", 1, 0, 0,
 294             (SCM fluid),
 295             "Return @code{#t} iff @var{fluid} is bound to a value.\n"
 296             "Throw an error if @var{fluid} is not a fluid.")
 297 #define FUNC_NAME s_scm_fluid_bound_p
 298 {
 299   SCM val;
 300   SCM_VALIDATE_FLUID (1, fluid);
 301   val = fluid_ref (fluid);
 302   return scm_from_bool (! (SCM_UNBNDP (val)));
 303 }
 304 #undef FUNC_NAME
 305
 306 static SCM
 307 apply_thunk (void *thunk)
 308 {
 309   return scm_call_0 (SCM_PACK (thunk));
 310 }
 311
 312 SCM
 313 scm_i_make_with_fluids (size_t n, SCM *fluids, SCM *vals)
 314 {
 315   SCM ret;
 316
 317   /* Ensure that there are no duplicates in the fluids set -- an N^2 operation,
 318      but N will usually be small, so perhaps that's OK. */
 319   {
 320     size_t i, j = n;
 321
 322     while (j--)
 323       for (i = 0; i < j; i++)
 324         if (scm_is_eq (fluids[i], fluids[j]))
 325           {
 326             vals[i] = vals[j]; /* later bindings win */
 327             n--;
 328             break;
 329           }
 330   }
 331
 332   ret = scm_words (scm_tc7_with_fluids | (n << 8), 1 + n*2);
 333   SCM_SET_CELL_WORD_1 (ret, n);
 334
 335   while (n--)
 336     {
 337       if (SCM_UNLIKELY (!IS_FLUID (fluids[n])))
 338         scm_wrong_type_arg ("with-fluids", 0, fluids[n]);
 339       SCM_SET_CELL_OBJECT (ret, 1 + n * 2, fluids[n]);
 340       SCM_SET_CELL_OBJECT (ret, 2 + n * 2, vals[n]);
 341     }
 342
 343   return ret;
 344 }
 345
 346 void
 347 scm_i_swap_with_fluids (SCM wf, SCM dynstate)
 348 {
 349   SCM fluids;
 350   size_t i, max = 0;
 351
 352   fluids = DYNAMIC_STATE_FLUIDS (dynstate);
 353
 354   /* We could cache the max in the with-fluids, but that would take more mem,
 355      and we're touching all the fluids anyway, so this per-swap traversal should
 356      be OK. */
 357   for (i = 0; i < SCM_WITH_FLUIDS_LEN (wf); i++)
 358     {
 359       size_t num = FLUID_NUM (SCM_WITH_FLUIDS_NTH_FLUID (wf, i));
 360       max = (max > num) ? max : num;
 361     }
 362
 363   if (SCM_UNLIKELY (max >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
 364     {
 365       /* Lazily grow the current thread's dynamic state.  */
 366       grow_dynamic_state (dynstate);
 367
 368       fluids = DYNAMIC_STATE_FLUIDS (dynstate);
 369     }
 370
 371   /* Bind the fluids. Order doesn't matter, as all fluids are distinct. */
 372   for (i = 0; i < SCM_WITH_FLUIDS_LEN (wf); i++)
 373     {
 374       size_t fluid_num;
 375       SCM x;
 376
 377       fluid_num = FLUID_NUM (SCM_WITH_FLUIDS_NTH_FLUID (wf, i));
 378       x = SCM_SIMPLE_VECTOR_REF (fluids, fluid_num);
 379       SCM_SIMPLE_VECTOR_SET (fluids, fluid_num,
 380                              SCM_WITH_FLUIDS_NTH_VAL (wf, i));
 381       SCM_WITH_FLUIDS_SET_NTH_VAL (wf, i, x);
 382     }
 383 }
 384
 385 SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0,
 386             (SCM fluids, SCM values, SCM thunk),
 387             "Set @var{fluids} to @var{values} temporary, and call @var{thunk}.\n"
 388             "@var{fluids} must be a list of fluids and @var{values} must be the same\n"
 389             "number of their values to be applied.  Each substitution is done\n"
 390             "one after another.  @var{thunk} must be a procedure with no argument.")
 391 #define FUNC_NAME s_scm_with_fluids
 392 {
 393   return scm_c_with_fluids (fluids, values,
 394                             apply_thunk, (void *) SCM_UNPACK (thunk));
 395 }
 396 #undef FUNC_NAME
 397
 398 SCM
 399 scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
 400 #define FUNC_NAME "scm_c_with_fluids"
 401 {
 402   SCM wf, ans;
 403   long flen, vlen, i;
 404   SCM *fluidsv, *valuesv;
 405
 406   SCM_VALIDATE_LIST_COPYLEN (1, fluids, flen);
 407   SCM_VALIDATE_LIST_COPYLEN (2, values, vlen);
 408   if (flen != vlen)
 409     scm_out_of_range (s_scm_with_fluids, values);
 410
 411   if (SCM_UNLIKELY (flen == 0))
 412     return cproc (cdata);
 413
 414   fluidsv = alloca (sizeof(SCM)*flen);
 415   valuesv = alloca (sizeof(SCM)*flen);
 416
 417   for (i = 0; i < flen; i++)
 418     {
 419       fluidsv[i] = SCM_CAR (fluids);
 420       fluids = SCM_CDR (fluids);
 421       valuesv[i] = SCM_CAR (values);
 422       values = SCM_CDR (values);
 423     }
 424
 425   wf = scm_i_make_with_fluids (flen, fluidsv, valuesv);
 426   scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state);
 427   scm_i_set_dynwinds (scm_cons (wf, scm_i_dynwinds ()));
 428   ans = cproc (cdata);
 429   scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state);
 430   scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ()));
 431
 432   return ans;
 433 }
 434 #undef FUNC_NAME
 435
 436 SCM_DEFINE (scm_with_fluid, "with-fluid*", 3, 0, 0,
 437             (SCM fluid, SCM value, SCM thunk),
 438             "Set @var{fluid} to @var{value} temporarily, and call @var{thunk}.\n"
 439             "@var{thunk} must be a procedure with no argument.")
 440 #define FUNC_NAME s_scm_with_fluid
 441 {
 442   return scm_c_with_fluid (fluid, value,
 443                            apply_thunk, (void *) SCM_UNPACK (thunk));
 444 }
 445 #undef FUNC_NAME
 446
 447 SCM
 448 scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata)
 449 #define FUNC_NAME "scm_c_with_fluid"
 450 {
 451   SCM ans, wf;
 452
 453   wf = scm_i_make_with_fluids (1, &fluid, &value);
 454   scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state);
 455   scm_i_set_dynwinds (scm_cons (wf, scm_i_dynwinds ()));
 456   ans = cproc (cdata);
 457   scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state);
 458   scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ()));
 459
 460   return ans;
 461 }
 462 #undef FUNC_NAME
 463
 464 static void
 465 swap_fluid (SCM data)
 466 {
 467   SCM f = SCM_CAR (data);
 468   SCM t = fluid_ref (f);
 469   scm_fluid_set_x (f, SCM_CDR (data));
 470   SCM_SETCDR (data, t);
 471 }
 472
 473 void
 474 scm_dynwind_fluid (SCM fluid, SCM value)
 475 {
 476   SCM data = scm_cons (fluid, value);
 477   scm_dynwind_rewind_handler_with_scm (swap_fluid, data, SCM_F_WIND_EXPLICITLY);
 478   scm_dynwind_unwind_handler_with_scm (swap_fluid, data, SCM_F_WIND_EXPLICITLY);
 479 }
 480
 481 SCM
 482 scm_i_make_initial_dynamic_state ()
 483 {
 484   SCM fluids = scm_c_make_vector (allocated_fluids_len, SCM_BOOL_F);
 485   return scm_cell (scm_tc7_dynamic_state, SCM_UNPACK (fluids));
 486 }
 487
 488 SCM_DEFINE (scm_make_dynamic_state, "make-dynamic-state", 0, 1, 0,
 489             (SCM parent),
 490             "Return a copy of the dynamic state object @var{parent}\n"
 491             "or of the current dynamic state when @var{parent} is omitted.")
 492 #define FUNC_NAME s_scm_make_dynamic_state
 493 {
 494   SCM fluids;
 495
 496   if (SCM_UNBNDP (parent))
 497     parent = scm_current_dynamic_state ();
 498
 499   SCM_ASSERT (IS_DYNAMIC_STATE (parent), parent, SCM_ARG1, FUNC_NAME);
 500   fluids = scm_vector_copy (DYNAMIC_STATE_FLUIDS (parent));
 501   return scm_cell (scm_tc7_dynamic_state, SCM_UNPACK (fluids));
 502 }
 503 #undef FUNC_NAME
 504
 505 SCM_DEFINE (scm_dynamic_state_p, "dynamic-state?", 1, 0, 0,
 506             (SCM obj),
 507             "Return @code{#t} if @var{obj} is a dynamic state object;\n"
 508             "return @code{#f} otherwise")
 509 #define FUNC_NAME s_scm_dynamic_state_p
 510 {
 511   return scm_from_bool (IS_DYNAMIC_STATE (obj));
 512 }
 513 #undef FUNC_NAME
 514
 515 int
 516 scm_is_dynamic_state (SCM obj)
 517 {
 518   return IS_DYNAMIC_STATE (obj);
 519 }
 520
 521 SCM_DEFINE (scm_current_dynamic_state, "current-dynamic-state", 0, 0, 0,
 522             (),
 523             "Return the current dynamic state object.")
 524 #define FUNC_NAME s_scm_current_dynamic_state
 525 {
 526   return SCM_I_CURRENT_THREAD->dynamic_state;
 527 }
 528 #undef FUNC_NAME
 529
 530 SCM_DEFINE (scm_set_current_dynamic_state, "set-current-dynamic-state", 1,0,0,
 531             (SCM state),
 532             "Set the current dynamic state object to @var{state}\n"
 533             "and return the previous current dynamic state object.")
 534 #define FUNC_NAME s_scm_set_current_dynamic_state
 535 {
 536   scm_i_thread *t = SCM_I_CURRENT_THREAD;
 537   SCM old = t->dynamic_state;
 538   SCM_ASSERT (IS_DYNAMIC_STATE (state), state, SCM_ARG1, FUNC_NAME);
 539   t->dynamic_state = state;
 540   return old;
 541 }
 542 #undef FUNC_NAME
 543
 544 static void
 545 swap_dynamic_state (SCM loc)
 546 {
 547   SCM_SETCAR (loc, scm_set_current_dynamic_state (SCM_CAR (loc)));
 548 }
 549
 550 void
 551 scm_dynwind_current_dynamic_state (SCM state)
 552 {
 553   SCM loc = scm_cons (state, SCM_EOL);
 554   SCM_ASSERT (IS_DYNAMIC_STATE (state), state, SCM_ARG1, NULL);
 555   scm_dynwind_rewind_handler_with_scm (swap_dynamic_state, loc,
 556                                      SCM_F_WIND_EXPLICITLY);
 557   scm_dynwind_unwind_handler_with_scm (swap_dynamic_state, loc,
 558                                      SCM_F_WIND_EXPLICITLY);
 559 }
 560
 561 void *
 562 scm_c_with_dynamic_state (SCM state, void *(*func)(void *), void *data)
 563 {
 564   void *result;
 565   scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
 566   scm_dynwind_current_dynamic_state (state);
 567   result = func (data);
 568   scm_dynwind_end ();
 569   return result;
 570 }
 571
 572 SCM_DEFINE (scm_with_dynamic_state, "with-dynamic-state", 2, 0, 0,
 573             (SCM state, SCM proc),
 574             "Call @var{proc} while @var{state} is the current dynamic\n"
 575             "state object.")
 576 #define FUNC_NAME s_scm_with_dynamic_state
 577 {
 578   SCM result;
 579   scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
 580   scm_dynwind_current_dynamic_state (state);
 581   result = scm_call_0 (proc);
 582   scm_dynwind_end ();
 583   return result;
 584 }
 585 #undef FUNC_NAME
 586
 587
 588 void
 589 scm_init_fluids ()
 590 {
 591 #include "libguile/fluids.x"
 592 }
 593
 594 /*
 595   Local Variables:
 596   c-file-style: "gnu"
 597   End:
 598 */