diff options
author | Marius Vollmer <mvo@zagadka.de> | 1997-07-18 16:26:47 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 1997-07-18 16:26:47 +0000 |
commit | 9482a297ecdd22480467849dfda20ffe81042a75 (patch) | |
tree | a08d730781c833f4533093cf490ae08eecda3ff1 | |
parent | 7f47d2d877c6164f85fc9c35835e96b0266ea45e (diff) | |
download | guile-9482a297ecdd22480467849dfda20ffe81042a75.tar.gz |
*** empty log message ***
-rw-r--r-- | libguile/fluids.c | 188 | ||||
-rw-r--r-- | libguile/fluids.h | 99 |
2 files changed, 287 insertions, 0 deletions
diff --git a/libguile/fluids.c b/libguile/fluids.c new file mode 100644 index 000000000..fdb107863 --- /dev/null +++ b/libguile/fluids.c @@ -0,0 +1,188 @@ +/* Copyright (C) 1996 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 + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + +#include <assert.h> + +#include "_scm.h" +#include "print.h" +#include "smob.h" +#include "fluids.h" + +#define INITIAL_FLUIDS 10 + +static volatile int n_fluids; +long scm_tc16_fluid; + +SCM +scm_make_initial_fluids () +{ + return scm_make_vector (SCM_MAKINUM (INITIAL_FLUIDS), + SCM_BOOL_F, SCM_BOOL_F); +} + +static void grow_fluids SCM_P ((scm_root_state *, int new_length)); +static void +grow_fluids (root_state, new_length) + scm_root_state *root_state; + int new_length; +{ + SCM old_fluids, new_fluids; + int old_length, i; + + old_fluids = root_state->fluids; + assert (SCM_NIMP (old_fluids) && SCM_VECTORP (old_fluids)); + old_length = SCM_LENGTH (old_fluids); + assert (old_length <= new_length); + new_fluids = scm_make_vector (SCM_MAKINUM (new_length), + SCM_BOOL_F, SCM_BOOL_F); + i = 0; + while (i < old_length) + { + SCM_VELTS(new_fluids)[i] = SCM_VELTS(old_fluids)[i]; + i++; + } + while (i < new_length) + { + SCM_VELTS(new_fluids)[i] = SCM_BOOL_F; + i++; + } + + root_state->fluids = new_fluids; +} + +void +scm_copy_fluids (root_state) + scm_root_state *root_state; +{ + grow_fluids (root_state, SCM_LENGTH(root_state->fluids)); +} + +static int print_fluid SCM_P ((SCM exp, SCM port, scm_print_state *pstate)); +static int +print_fluid (exp, port, pstate) + SCM exp; + SCM port; + scm_print_state *pstate; +{ + scm_gen_puts (scm_regular_string, "#<fluid ", port); + scm_intprint (SCM_FLUID_NUM (exp), 10, port); + scm_gen_putc ('>', port); + return 1; +} + +static scm_smobfuns fluid_smob = { + scm_mark0, + scm_free0, + print_fluid +}; + +static +int next_fluid_num () +{ + int n; + SCM_THREAD_CRITICAL_SECTION_START; + n = n_fluids++; + SCM_THREAD_CRITICAL_SECTION_END; + return n; +} + +SCM_PROC (s_make_fluid, "make-fluid", 0, 0, 0, scm_make_fluid); + +SCM +scm_make_fluid () +{ + SCM z; + int n; + + SCM_DEFER_INTS; + n = next_fluid_num (); + SCM_NEWCELL (z); + SCM_SETCAR (z, scm_tc16_fluid); + SCM_SETCDR (z, n); + SCM_ALLOW_INTS; + + return z; +} + +SCM_PROC (s_fluid_ref, "fluid-ref", 1, 0, 0, scm_fluid_ref); + +SCM +scm_fluid_ref (fl) + SCM fl; +{ + int n; + + SCM_ASSERT (SCM_NIMP (fl) && SCM_FLUIDP (fl), SCM_ARG1, fl, s_fluid_ref); + + n = SCM_FLUID_NUM (fl); + assert (n >= 0 && n < n_fluids); + + if (SCM_LENGTH (scm_root->fluids) <= n) + grow_fluids (scm_root, n+1); + return SCM_VELTS(scm_root->fluids)[n]; +} + +SCM_PROC (s_fluid_set_x, "fluid-set!", 2, 0, 0, scm_fluid_set_x); + +SCM +scm_fluid_set_x (fl, val) + SCM fl; + SCM val; +{ + int n; + + SCM_ASSERT (SCM_NIMP (fl) && SCM_FLUIDP (fl), SCM_ARG1, fl, s_fluid_set_x); + + n = SCM_FLUID_NUM (fl); + assert (n >= 0 && n < n_fluids); + + if (SCM_LENGTH (scm_root->fluids) <= n) + grow_fluids (scm_root, n+1); + SCM_VELTS(scm_root->fluids)[n] = val; + return val; +} + +void +scm_init_fluids () +{ + scm_tc16_fluid = scm_newsmob(&fluid_smob); +#include "fluids.x" +} diff --git a/libguile/fluids.h b/libguile/fluids.h new file mode 100644 index 000000000..6972e0bc0 --- /dev/null +++ b/libguile/fluids.h @@ -0,0 +1,99 @@ +/* classes: h_files */ + +#ifndef FLUIDSH +#define FLUIDSH + +/* Copyright (C) 1996 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 + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + +#include "libguile/__scm.h" +#include "libguile/root.h" +#include "libguile/vectors.h" + +/* Fluids. + + Fluids are objects of a certain type (a smob) that can hold one SCM + value per dynamic root. That is, modifications to this value are + only visible to code that executes within the same dynamic root as + the modifying code. When a new dynamic root is constructed, it + inherits the values from its parent. Because each thread executes + in its own dynamic root, you can use fluids for thread local + storage. + + Each fluid is identified by a small integer. This integer is used + to index a vector that holds the values of all fluids. Each root + has its own vector. + + Currently, you can't get rid a certain fluid if you don't use any + longer. The slot that has been allocated for it in the fluid + vector will not be reused for other fluids. Therefore, only use + SCM_MAKE_FLUID or it Scheme variant `make-fluid' in initialization + code that is only run once. Nevertheless, it should be possible to + implement a more lightweight version of fluids on top of this basic + mechanism. */ + +extern long scm_tc16_fluid; + +#define SCM_FLUIDP(x) (SCM_CAR(x) == scm_tc16_fluid) +#define SCM_FLUID_NUM(x) SCM_CDR(x) + +/* The fastest way to acces/modify the value of a fluid. These macros +does no error checking at all. You should only use them when you know +that the relevant fluid already exists in the current dynamic root. +The easiest way to ensure this is to execute a SCM_FLUID_SET_X in the +topmost root, for example right after SCM_MAKE_FLUID in your +SCM_INIT_MUMBLE routine that gets called from SCM_BOOT_GUILE_1. The +first argument is the index number of the fluid, obtained via +SCM_FLUID_NUM, not the fluid itself. */ + +#define SCM_FAST_FLUID_REF(n) (SCM_VELTS(scm_root->fluids)[n]) +#define SCM_FAST_FLUID_SET_X(n, val) (SCM_VELTS(scm_root->fluids)[n] = val) + +SCM scm_make_fluid SCM_P ((void)); +SCM scm_fluid_ref SCM_P ((SCM fluid)); +SCM scm_fluid_set_x SCM_P ((SCM fluid, SCM value)); + +SCM scm_make_initial_fluids SCM_P ((void)); +void scm_copy_fluids SCM_P ((scm_root_state *)); + +void scm_init_fluids SCM_P ((void)); + +#endif /* !FLUIDSH */ |