guile18/libguile/fluids.c

   1 /* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008 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
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful,
   9  * but 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 02110-1301 USA
  16  */
  17
  18 #ifdef HAVE_CONFIG_H
  19 # include <config.h>
  20 #endif
  21
  22 #include <stdio.h>
  23 #include <string.h>
  24
  25 #include "libguile/_scm.h"
  26 #include "libguile/print.h"
  27 #include "libguile/smob.h"
  28 #include "libguile/dynwind.h"
  29 #include "libguile/fluids.h"
  30 #include "libguile/alist.h"
  31 #include "libguile/eval.h"
  32 #include "libguile/ports.h"
  33 #include "libguile/deprecation.h"
  34 #include "libguile/lang.h"
  35 #include "libguile/validate.h"
  36
  37 #define FLUID_GROW 20
  38
  39 /* A lot of the complexity below stems from the desire to reuse fluid
  40    slots.  Normally, fluids should be pretty global and long-lived
  41    things, so that reusing their slots should not be overly critical,
  42    but it is the right thing to do nevertheless.  The code therefore
  43    puts the burdon on allocating and collection fluids and keeps
  44    accessing fluids lock free.  This is achieved by manipulating the
  45    global state of the fluid machinery mostly in single threaded
  46    sections.
  47
  48    Reusing a fluid slot means that it must be reset to #f in all
  49    dynamic states.  We do this by maintaining a weak list of all
  50    dynamic states, which is used after a GC to do the resetting.
  51
  52    Also, the fluid vectors in the dynamic states need to grow from
  53    time to time when more fluids are created.  We do this in a single
  54    threaded section so that threads do not need to lock when accessing
  55    a fluid in the normal way.
  56 */
  57
  58 static scm_i_pthread_mutex_t fluid_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
  59
  60 /* Protected by fluid_admin_mutex, but also accessed during GC.  See
  61    next_fluid_num for a discussion of this.
  62  */
  63 static size_t allocated_fluids_len = 0;
  64 static size_t allocated_fluids_num = 0;
  65 static char *allocated_fluids = NULL;
  66
  67 static scm_t_bits tc16_fluid;
  68
  69 #define IS_FLUID(x)         SCM_SMOB_PREDICATE(tc16_fluid, (x))
  70 #define FLUID_NUM(x)        ((size_t)SCM_SMOB_DATA(x))
  71 #define FLUID_NEXT(x)       SCM_SMOB_OBJECT_2(x)
  72 #define FLUID_NEXT_LOC(x)       SCM_SMOB_OBJECT_2_LOC(x)
  73 #define SET_FLUID_NEXT(x,y) SCM_SET_SMOB_OBJECT_2((x), (y))
  74
  75 static scm_t_bits tc16_dynamic_state;
  76
  77 #define IS_DYNAMIC_STATE(x)        SCM_SMOB_PREDICATE(tc16_dynamic_state, (x))
  78 #define DYNAMIC_STATE_FLUIDS(x)        SCM_SMOB_OBJECT(x)
  79 #define SET_DYNAMIC_STATE_FLUIDS(x, y) SCM_SET_SMOB_OBJECT((x), (y))
  80 #define DYNAMIC_STATE_NEXT(x)          SCM_SMOB_OBJECT_2(x)
  81 #define DYNAMIC_STATE_NEXT_LOC(x)          SCM_SMOB_OBJECT_2_LOC(x)
  82 #define SET_DYNAMIC_STATE_NEXT(x, y)   SCM_SET_SMOB_OBJECT_2((x), (y))
  83
  84 /* Weak lists of all dynamic states and all fluids.
  85  */
  86 static SCM all_dynamic_states = SCM_EOL;
  87 static SCM all_fluids = SCM_EOL;
  88
  89 /* Make sure that all states have the right size.  This must be called
  90    while fluid_admin_mutex is held.
  91 */
  92 static void
  93 resize_all_states ()
  94 {
  95   SCM new_vectors, state;
  96
  97   /* Replacing the vector of a dynamic state must be done atomically:
  98      the old values must be copied into the new vector and the new
  99      vector must be installed without someone modifying the old vector
 100      concurrently.  Since accessing a fluid should be lock-free, we
 101      need to put all threads to sleep when replacing a vector.
 102      However, when being single threaded, it is best not to do much.
 103      Therefore, we allocate the new vectors before going single
 104      threaded.
 105   */
 106
 107   new_vectors = SCM_EOL;
 108   for (state = all_dynamic_states; !scm_is_null (state);
 109        state = DYNAMIC_STATE_NEXT (state))
 110     new_vectors = scm_cons (scm_c_make_vector (allocated_fluids_len,
 111                                                SCM_BOOL_F),
 112                             new_vectors);
 113
 114   scm_i_thread_put_to_sleep ();
 115   for (state = all_dynamic_states; !scm_is_null (state);
 116        state = DYNAMIC_STATE_NEXT (state))
 117     {
 118       SCM old_fluids = DYNAMIC_STATE_FLUIDS (state);
 119       SCM new_fluids = SCM_CAR (new_vectors);
 120       size_t i, old_len = SCM_SIMPLE_VECTOR_LENGTH (old_fluids);
 121
 122       for (i = 0; i < old_len; i++)
 123         SCM_SIMPLE_VECTOR_SET (new_fluids, i,
 124                                SCM_SIMPLE_VECTOR_REF (old_fluids, i));
 125       SET_DYNAMIC_STATE_FLUIDS (state, new_fluids);
 126       new_vectors = SCM_CDR (new_vectors);
 127     }
 128   scm_i_thread_wake_up ();
 129 }
 130
 131 /* This is called during GC, that is, while being single threaded.
 132    See next_fluid_num for a discussion why it is safe to access
 133    allocated_fluids here.
 134  */
 135 static void *
 136 scan_dynamic_states_and_fluids (void *dummy1 SCM_UNUSED,
 137                                 void *dummy2 SCM_UNUSED,
 138                                 void *dummy3 SCM_UNUSED)
 139 {
 140   SCM *statep, *fluidp;
 141
 142   /* Scan all fluids and deallocate the unmarked ones.
 143    */
 144   fluidp = &all_fluids;
 145   while (!scm_is_null (*fluidp))
 146     {
 147       if (!SCM_GC_MARK_P (*fluidp))
 148         {
 149           allocated_fluids_num -= 1;
 150           allocated_fluids[FLUID_NUM (*fluidp)] = 0;
 151           *fluidp = FLUID_NEXT (*fluidp);
 152         }
 153       else
 154         fluidp = FLUID_NEXT_LOC (*fluidp);
 155     }
 156
 157   /* Scan all dynamic states and remove the unmarked ones.  The live
 158      ones are updated for unallocated fluids.
 159   */
 160   statep = &all_dynamic_states;
 161   while (!scm_is_null (*statep))
 162     {
 163       if (!SCM_GC_MARK_P (*statep))
 164         *statep = DYNAMIC_STATE_NEXT (*statep);
 165       else
 166         {
 167           SCM fluids = DYNAMIC_STATE_FLUIDS (*statep);
 168           size_t len, i;
 169
 170           len = SCM_SIMPLE_VECTOR_LENGTH (fluids);
 171           for (i = 0; i < len && i < allocated_fluids_len; i++)
 172             if (allocated_fluids[i] == 0)
 173               SCM_SIMPLE_VECTOR_SET (fluids, i, SCM_BOOL_F);
 174
 175           statep = DYNAMIC_STATE_NEXT_LOC (*statep);
 176         }
 177     }
 178
 179   return NULL;
 180 }
 181
 182 static size_t
 183 fluid_free (SCM fluid)
 184 {
 185   /* The real work is done in scan_dynamic_states_and_fluids.  We can
 186      not touch allocated_fluids etc here since a smob free routine can
 187      be run at any time, in any thread.
 188   */
 189   return 0;
 190 }
 191
 192 static int
 193 fluid_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
 194 {
 195   scm_puts ("#<fluid ", port);
 196   scm_intprint ((int) FLUID_NUM (exp), 10, port);
 197   scm_putc ('>', port);
 198   return 1;
 199 }
 200
 201 static size_t
 202 next_fluid_num ()
 203 {
 204   size_t n;
 205
 206   scm_dynwind_begin (0);
 207   scm_i_dynwind_pthread_mutex_lock (&fluid_admin_mutex);
 208
 209   if ((allocated_fluids_len > 0) &&
 210       (allocated_fluids_num == allocated_fluids_len))
 211     {
 212       /* All fluid numbers are in use.  Run a GC to try to free some
 213          up.
 214       */
 215       scm_gc ();
 216     }
 217
 218   if (allocated_fluids_num < allocated_fluids_len)
 219     {
 220       for (n = 0; n < allocated_fluids_len; n++)
 221         if (allocated_fluids[n] == 0)
 222           break;
 223     }
 224   else
 225     {
 226       /* During the following call, the GC might run and elements of
 227          allocated_fluids might bet set to zero.  Also,
 228          allocated_fluids and allocated_fluids_len are used to scan
 229          all dynamic states during GC.  Thus we need to make sure that
 230          no GC can run while updating these two variables.
 231       */
 232
 233       char *prev_allocated_fluids;
 234       char *new_allocated_fluids =
 235         scm_malloc (allocated_fluids_len + FLUID_GROW);
 236
 237       /* Copy over old values and initialize rest.  GC can not run
 238          during these two operations since there is no safe point in
 239          them.
 240       */
 241       memcpy (new_allocated_fluids, allocated_fluids, allocated_fluids_len);
 242       memset (new_allocated_fluids + allocated_fluids_len, 0, FLUID_GROW);
 243       n = allocated_fluids_len;
 244
 245       prev_allocated_fluids = allocated_fluids;
 246       allocated_fluids = new_allocated_fluids;
 247       allocated_fluids_len += FLUID_GROW;
 248
 249       if (prev_allocated_fluids != NULL)
 250         free (prev_allocated_fluids);
 251
 252       /* Now allocated_fluids and allocated_fluids_len are valid again
 253          and we can allow GCs to occur.
 254       */
 255       resize_all_states ();
 256     }
 257
 258   allocated_fluids_num += 1;
 259   allocated_fluids[n] = 1;
 260
 261   scm_dynwind_end ();
 262   return n;
 263 }
 264
 265 SCM_DEFINE (scm_make_fluid, "make-fluid", 0, 0, 0,
 266             (),
 267             "Return a newly created fluid.\n"
 268             "Fluids are objects that can hold one\n"
 269             "value per dynamic state.  That is, modifications to this value are\n"
 270             "only visible to code that executes with the same dynamic state as\n"
 271             "the modifying code.  When a new dynamic state is constructed, it\n"
 272             "inherits the values from its parent.  Because each thread normally executes\n"
 273             "with its own dynamic state, you can use fluids for thread local storage.")
 274 #define FUNC_NAME s_scm_make_fluid
 275 {
 276   SCM fluid;
 277
 278   SCM_NEWSMOB2 (fluid, tc16_fluid,
 279                 (scm_t_bits) next_fluid_num (), SCM_UNPACK (SCM_EOL));
 280
 281   /* The GC must not run until the fluid is properly entered into the
 282      list.
 283   */
 284   scm_i_scm_pthread_mutex_lock (&fluid_admin_mutex);
 285   SET_FLUID_NEXT (fluid, all_fluids);
 286   all_fluids = fluid;
 287   scm_i_pthread_mutex_unlock (&fluid_admin_mutex);
 288
 289   return fluid;
 290 }
 291 #undef FUNC_NAME
 292
 293 SCM_DEFINE (scm_fluid_p, "fluid?", 1, 0, 0,
 294             (SCM obj),
 295             "Return @code{#t} iff @var{obj} is a fluid; otherwise, return\n"
 296             "@code{#f}.")
 297 #define FUNC_NAME s_scm_fluid_p
 298 {
 299   return scm_from_bool (IS_FLUID (obj));
 300 }
 301 #undef FUNC_NAME
 302
 303 int
 304 scm_is_fluid (SCM obj)
 305 {
 306   return IS_FLUID (obj);
 307 }
 308
 309 size_t
 310 scm_i_fluid_num (SCM fluid)
 311 {
 312   return FLUID_NUM (fluid);
 313 }
 314
 315 SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
 316             (SCM fluid),
 317             "Return the value associated with @var{fluid} in the current\n"
 318             "dynamic root.  If @var{fluid} has not been set, then return\n"
 319             "@code{#f}.")
 320 #define FUNC_NAME s_scm_fluid_ref
 321 {
 322   SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
 323
 324   SCM_VALIDATE_FLUID (1, fluid);
 325   return SCM_SIMPLE_VECTOR_REF (fluids, FLUID_NUM (fluid));
 326 }
 327 #undef FUNC_NAME
 328
 329 SCM
 330 scm_i_fast_fluid_ref (size_t n)
 331 {
 332   SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
 333   return SCM_SIMPLE_VECTOR_REF (fluids, n);
 334 }
 335
 336 SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
 337             (SCM fluid, SCM value),
 338             "Set the value associated with @var{fluid} in the current dynamic root.")
 339 #define FUNC_NAME s_scm_fluid_set_x
 340 {
 341   SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
 342
 343   SCM_VALIDATE_FLUID (1, fluid);
 344   SCM_SIMPLE_VECTOR_SET (fluids, FLUID_NUM (fluid), value);
 345   return SCM_UNSPECIFIED;
 346 }
 347 #undef FUNC_NAME
 348
 349 void
 350 scm_i_fast_fluid_set_x (size_t n, SCM value)
 351 {
 352   SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
 353   SCM_SIMPLE_VECTOR_SET (fluids, n, value);
 354 }
 355
 356 static void
 357 swap_fluids (SCM data)
 358 {
 359   SCM fluids = SCM_CAR (data), vals = SCM_CDR (data);
 360
 361   while (!SCM_NULL_OR_NIL_P (fluids))
 362     {
 363       SCM fl = SCM_CAR (fluids);
 364       SCM old_val = scm_fluid_ref (fl);
 365       scm_fluid_set_x (fl, SCM_CAR (vals));
 366       SCM_SETCAR (vals, old_val);
 367       fluids = SCM_CDR (fluids);
 368       vals = SCM_CDR (vals);
 369     }
 370 }
 371
 372 /* Swap the fluid values in reverse order.  This is important when the
 373    same fluid appears multiple times in the fluids list.
 374 */
 375
 376 static void
 377 swap_fluids_reverse_aux (SCM fluids, SCM vals)
 378 {
 379   if (!SCM_NULL_OR_NIL_P (fluids))
 380     {
 381       SCM fl, old_val;
 382
 383       swap_fluids_reverse_aux (SCM_CDR (fluids), SCM_CDR (vals));
 384       fl = SCM_CAR (fluids);
 385       old_val = scm_fluid_ref (fl);
 386       scm_fluid_set_x (fl, SCM_CAR (vals));
 387       SCM_SETCAR (vals, old_val);
 388     }
 389 }
 390
 391 static void
 392 swap_fluids_reverse (SCM data)
 393 {
 394   swap_fluids_reverse_aux (SCM_CAR (data), SCM_CDR (data));
 395 }
 396
 397 static SCM
 398 apply_thunk (void *thunk)
 399 {
 400   return scm_call_0 (SCM_PACK (thunk));
 401 }
 402
 403 SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0,
 404             (SCM fluids, SCM values, SCM thunk),
 405             "Set @var{fluids} to @var{values} temporary, and call @var{thunk}.\n"
 406             "@var{fluids} must be a list of fluids and @var{values} must be the same\n"
 407             "number of their values to be applied.  Each substitution is done\n"
 408             "one after another.  @var{thunk} must be a procedure with no argument.")
 409 #define FUNC_NAME s_scm_with_fluids
 410 {
 411   return scm_c_with_fluids (fluids, values,
 412                             apply_thunk, (void *) SCM_UNPACK (thunk));
 413 }
 414 #undef FUNC_NAME
 415
 416 SCM
 417 scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
 418 #define FUNC_NAME "scm_c_with_fluids"
 419 {
 420   SCM ans, data;
 421   long flen, vlen;
 422
 423   SCM_VALIDATE_LIST_COPYLEN (1, fluids, flen);
 424   SCM_VALIDATE_LIST_COPYLEN (2, values, vlen);
 425   if (flen != vlen)
 426     scm_out_of_range (s_scm_with_fluids, values);
 427
 428   if (flen == 1)
 429     return scm_c_with_fluid (SCM_CAR (fluids), SCM_CAR (values),
 430                              cproc, cdata);
 431
 432   data = scm_cons (fluids, values);
 433   scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
 434   scm_dynwind_rewind_handler_with_scm (swap_fluids, data,
 435                                      SCM_F_WIND_EXPLICITLY);
 436   scm_dynwind_unwind_handler_with_scm (swap_fluids_reverse, data,
 437                                      SCM_F_WIND_EXPLICITLY);
 438   ans = cproc (cdata);
 439   scm_dynwind_end ();
 440   return ans;
 441 }
 442 #undef FUNC_NAME
 443
 444 SCM_DEFINE (scm_with_fluid, "with-fluid*", 3, 0, 0,
 445             (SCM fluid, SCM value, SCM thunk),
 446             "Set @var{fluid} to @var{value} temporarily, and call @var{thunk}.\n"
 447             "@var{thunk} must be a procedure with no argument.")
 448 #define FUNC_NAME s_scm_with_fluid
 449 {
 450   return scm_c_with_fluid (fluid, value,
 451                            apply_thunk, (void *) SCM_UNPACK (thunk));
 452 }
 453 #undef FUNC_NAME
 454
 455 SCM
 456 scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata)
 457 #define FUNC_NAME "scm_c_with_fluid"
 458 {
 459   SCM ans;
 460
 461   scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
 462   scm_dynwind_fluid (fluid, value);
 463   ans = cproc (cdata);
 464   scm_dynwind_end ();
 465   return ans;
 466 }
 467 #undef FUNC_NAME
 468
 469 static void
 470 swap_fluid (SCM data)
 471 {
 472   SCM f = SCM_CAR (data);
 473   SCM t = scm_fluid_ref (f);
 474   scm_fluid_set_x (f, SCM_CDR (data));
 475   SCM_SETCDR (data, t);
 476 }
 477
 478 void
 479 scm_dynwind_fluid (SCM fluid, SCM value)
 480 {
 481   SCM data = scm_cons (fluid, value);
 482   scm_dynwind_rewind_handler_with_scm (swap_fluid, data, SCM_F_WIND_EXPLICITLY);
 483   scm_dynwind_unwind_handler_with_scm (swap_fluid, data, SCM_F_WIND_EXPLICITLY);
 484 }
 485
 486 SCM
 487 scm_i_make_initial_dynamic_state ()
 488 {
 489   SCM fluids = scm_c_make_vector (allocated_fluids_len, SCM_BOOL_F);
 490   SCM state;
 491   SCM_NEWSMOB2 (state, tc16_dynamic_state,
 492                 SCM_UNPACK (fluids), SCM_UNPACK (SCM_EOL));
 493   all_dynamic_states = state;
 494   return state;
 495 }
 496
 497 SCM_DEFINE (scm_make_dynamic_state, "make-dynamic-state", 0, 1, 0,
 498             (SCM parent),
 499             "Return a copy of the dynamic state object @var{parent}\n"
 500             "or of the current dynamic state when @var{parent} is omitted.")
 501 #define FUNC_NAME s_scm_make_dynamic_state
 502 {
 503   SCM fluids, state;
 504
 505   if (SCM_UNBNDP (parent))
 506     parent = scm_current_dynamic_state ();
 507
 508   scm_assert_smob_type (tc16_dynamic_state, parent);
 509   fluids = scm_vector_copy (DYNAMIC_STATE_FLUIDS (parent));
 510   SCM_NEWSMOB2 (state, tc16_dynamic_state,
 511                 SCM_UNPACK (fluids), SCM_UNPACK (SCM_EOL));
 512
 513   /* The GC must not run until the state is properly entered into the
 514      list.
 515   */
 516   scm_i_scm_pthread_mutex_lock (&fluid_admin_mutex);
 517   SET_DYNAMIC_STATE_NEXT (state, all_dynamic_states);
 518   all_dynamic_states = state;
 519   scm_i_pthread_mutex_unlock (&fluid_admin_mutex);
 520
 521   return state;
 522 }
 523 #undef FUNC_NAME
 524
 525 SCM_DEFINE (scm_dynamic_state_p, "dynamic-state?", 1, 0, 0,
 526             (SCM obj),
 527             "Return @code{#t} if @var{obj} is a dynamic state object;\n"
 528             "return @code{#f} otherwise")
 529 #define FUNC_NAME s_scm_dynamic_state_p
 530 {
 531   return scm_from_bool (IS_DYNAMIC_STATE (obj));
 532 }
 533 #undef FUNC_NAME
 534
 535 int
 536 scm_is_dynamic_state (SCM obj)
 537 {
 538   return IS_DYNAMIC_STATE (obj);
 539 }
 540
 541 SCM_DEFINE (scm_current_dynamic_state, "current-dynamic-state", 0, 0, 0,
 542             (),
 543             "Return the current dynamic state object.")
 544 #define FUNC_NAME s_scm_current_dynamic_state
 545 {
 546   return SCM_I_CURRENT_THREAD->dynamic_state;
 547 }
 548 #undef FUNC_NAME
 549
 550 SCM_DEFINE (scm_set_current_dynamic_state, "set-current-dynamic-state", 1,0,0,
 551             (SCM state),
 552             "Set the current dynamic state object to @var{state}\n"
 553             "and return the previous current dynamic state object.")
 554 #define FUNC_NAME s_scm_set_current_dynamic_state
 555 {
 556   scm_i_thread *t = SCM_I_CURRENT_THREAD;
 557   SCM old = t->dynamic_state;
 558   scm_assert_smob_type (tc16_dynamic_state, state);
 559   t->dynamic_state = state;
 560   return old;
 561 }
 562 #undef FUNC_NAME
 563
 564 static void
 565 swap_dynamic_state (SCM loc)
 566 {
 567   SCM_SETCAR (loc, scm_set_current_dynamic_state (SCM_CAR (loc)));
 568 }
 569
 570 void
 571 scm_dynwind_current_dynamic_state (SCM state)
 572 {
 573   SCM loc = scm_cons (state, SCM_EOL);
 574   scm_assert_smob_type (tc16_dynamic_state, state);
 575   scm_dynwind_rewind_handler_with_scm (swap_dynamic_state, loc,
 576                                      SCM_F_WIND_EXPLICITLY);
 577   scm_dynwind_unwind_handler_with_scm (swap_dynamic_state, loc,
 578                                      SCM_F_WIND_EXPLICITLY);
 579 }
 580
 581 void *
 582 scm_c_with_dynamic_state (SCM state, void *(*func)(void *), void *data)
 583 {
 584   void *result;
 585   scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
 586   scm_dynwind_current_dynamic_state (state);
 587   result = func (data);
 588   scm_dynwind_end ();
 589   return result;
 590 }
 591
 592 SCM_DEFINE (scm_with_dynamic_state, "with-dynamic-state", 2, 0, 0,
 593             (SCM state, SCM proc),
 594             "Call @var{proc} while @var{state} is the current dynamic\n"
 595             "state object.")
 596 #define FUNC_NAME s_scm_with_dynamic_state
 597 {
 598   SCM result;
 599   scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
 600   scm_dynwind_current_dynamic_state (state);
 601   result = scm_call_0 (proc);
 602   scm_dynwind_end ();
 603   return result;
 604 }
 605 #undef FUNC_NAME
 606
 607 void
 608 scm_fluids_prehistory ()
 609 {
 610   tc16_fluid = scm_make_smob_type ("fluid", 0);
 611   scm_set_smob_free (tc16_fluid, fluid_free);
 612   scm_set_smob_print (tc16_fluid, fluid_print);
 613
 614   tc16_dynamic_state = scm_make_smob_type ("dynamic-state", 0);
 615   scm_set_smob_mark (tc16_dynamic_state, scm_markcdr);
 616
 617   scm_c_hook_add (&scm_after_sweep_c_hook, scan_dynamic_states_and_fluids,
 618                   0, 0);
 619 }
 620
 621 void
 622 scm_init_fluids ()
 623 {
 624 #include "libguile/fluids.x"
 625 }
 626
 627 /*
 628   Local Variables:
 629   c-file-style: "gnu"
 630   End:
 631 */