summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMarius Vollmer <mvo@zagadka.de>1997-07-18 16:26:47 +0000
committerMarius Vollmer <mvo@zagadka.de>1997-07-18 16:26:47 +0000
commit9482a297ecdd22480467849dfda20ffe81042a75 (patch)
treea08d730781c833f4533093cf490ae08eecda3ff1
parent7f47d2d877c6164f85fc9c35835e96b0266ea45e (diff)
downloadguile-9482a297ecdd22480467849dfda20ffe81042a75.tar.gz
*** empty log message ***
-rw-r--r--libguile/fluids.c188
-rw-r--r--libguile/fluids.h99
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 */