diff options
| -rw-r--r-- | NEWS | 7 | ||||
| -rw-r--r-- | doc/ref/api-scheduling.texi | 38 | ||||
| -rw-r--r-- | libguile.h | 1 | ||||
| -rw-r--r-- | libguile/Makefile.am | 4 | ||||
| -rw-r--r-- | libguile/arbiters.c | 174 | ||||
| -rw-r--r-- | libguile/arbiters.h | 41 | ||||
| -rw-r--r-- | libguile/deprecated.c | 95 | ||||
| -rw-r--r-- | libguile/deprecated.h | 6 | ||||
| -rw-r--r-- | libguile/init.c | 2 | ||||
| -rw-r--r-- | module/oop/goops.scm | 6 | ||||
| -rw-r--r-- | test-suite/Makefile.am | 1 | ||||
| -rw-r--r-- | test-suite/tests/arbiters.test | 102 |
12 files changed, 112 insertions, 365 deletions
@@ -12,6 +12,13 @@ Changes in 2.1.5 (changes since the 2.1.4 alpha release): * New interfaces * Performance improvements * Incompatible changes +* New deprecations +** Arbiters deprecated + +Arbiters were an experimental mutual exclusion facility from 20 years +ago that didn't survive the test of time. Use mutexes or atomic boxes +instead. + * Bug fixes diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi index 38f5ac4a2..de076374d 100644 --- a/doc/ref/api-scheduling.texi +++ b/doc/ref/api-scheduling.texi @@ -8,7 +8,6 @@ @section Threads, Mutexes, Asyncs and Dynamic Roots @menu -* Arbiters:: Synchronization primitives. * Asyncs:: Asynchronous procedure invocation. * Atomics:: Atomic references. * Threads:: Multiple threads of execution. @@ -22,43 +21,6 @@ @end menu -@node Arbiters -@subsection Arbiters -@cindex arbiters - -Arbiters are synchronization objects, they can be used by threads to -control access to a shared resource. An arbiter can be locked to -indicate a resource is in use, and unlocked when done. - -An arbiter is like a light-weight mutex (@pxref{Mutexes and Condition -Variables}). It uses less memory and may be faster, but there's no -way for a thread to block waiting on an arbiter, it can only test and -get the status returned. - -@deffn {Scheme Procedure} make-arbiter name -@deffnx {C Function} scm_make_arbiter (name) -Return an object of type arbiter and name @var{name}. Its -state is initially unlocked. Arbiters are a way to achieve -process synchronization. -@end deffn - -@deffn {Scheme Procedure} try-arbiter arb -@deffnx {C Function} scm_try_arbiter (arb) -If @var{arb} is unlocked, then lock it and return @code{#t}. -If @var{arb} is already locked, then do nothing and return -@code{#f}. -@end deffn - -@deffn {Scheme Procedure} release-arbiter arb -@deffnx {C Function} scm_release_arbiter (arb) -If @var{arb} is locked, then unlock it and return @code{#t}. If -@var{arb} is already unlocked, then do nothing and return @code{#f}. - -Typical usage is for the thread which locked an arbiter to later -release it, but that's not required, any thread can release it. -@end deffn - - @node Asyncs @subsection Asyncs diff --git a/libguile.h b/libguile.h index 8354e7cca..0a1f0dcd6 100644 --- a/libguile.h +++ b/libguile.h @@ -30,7 +30,6 @@ extern "C" { #include "libguile/__scm.h" #include "libguile/alist.h" -#include "libguile/arbiters.h" #include "libguile/array-handle.h" #include "libguile/array-map.h" #include "libguile/arrays.h" diff --git a/libguile/Makefile.am b/libguile/Makefile.am index e5011da91..31cff7587 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -120,7 +120,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS) libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \ alist.c \ - arbiters.c \ array-handle.c \ array-map.c \ arrays.c \ @@ -231,7 +230,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \ DOT_X_FILES = \ alist.x \ - arbiters.x \ array-handle.x \ array-map.x \ arrays.x \ @@ -339,7 +337,6 @@ EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@ DOT_DOC_FILES = \ alist.doc \ - arbiters.doc \ array-handle.doc \ array-map.doc \ arrays.doc \ @@ -567,7 +564,6 @@ modincludedir = $(pkgincludedir)/$(GUILE_EFFECTIVE_VERSION)/libguile modinclude_HEADERS = \ __scm.h \ alist.h \ - arbiters.h \ array-handle.h \ array-map.h \ arrays.h \ diff --git a/libguile/arbiters.c b/libguile/arbiters.c deleted file mode 100644 index f1ace572d..000000000 --- a/libguile/arbiters.c +++ /dev/null @@ -1,174 +0,0 @@ -/* Copyright (C) 1995,1996, 1997, 2000, 2001, 2004, 2005, 2006, 2008, 2011 Free Software Foundation, Inc. - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public License - * as published by the Free Software Foundation; either version 3 of - * the License, or (at your option) any later version. - * - * This library 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 - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA - * 02110-1301 USA - */ - - - -#ifdef HAVE_CONFIG_H -# include <config.h> -#endif - -#include "libguile/_scm.h" -#include "libguile/ports.h" -#include "libguile/smob.h" - -#include "libguile/validate.h" -#include "libguile/arbiters.h" - - -/* FETCH_STORE sets "fet" to the value fetched from "mem" and then stores - "sto" there. The fetch and store are done atomically, so once the fetch - has been done no other thread or processor can fetch from there before - the store is done. - - The operands are scm_t_bits, fet and sto are plain variables, mem is a - memory location (ie. an lvalue). - - ENHANCE-ME: Add more cpu-specifics. glibc atomicity.h has some of the - sort of thing required. FETCH_STORE could become some sort of - compare-and-store if that better suited what various cpus do. */ - -#if defined (__GNUC__) && defined (i386) && SIZEOF_SCM_T_BITS == 4 -/* This is for i386 with the normal 32-bit scm_t_bits. The xchg instruction - is atomic on a single processor, and it automatically asserts the "lock" - bus signal so it's atomic on a multi-processor (no need for the lock - prefix on the instruction). - - The mem operand is read-write but "+" is not used since old gcc - (eg. 2.7.2) doesn't support that. "1" for the mem input doesn't work - (eg. gcc 3.3) when mem is a pointer dereference like current usage below. - Having mem as a plain input should be ok though. It tells gcc the value - is live, but as an "m" gcc won't fetch it itself (though that would be - harmless). */ - -#define FETCH_STORE(fet,mem,sto) \ - do { \ - asm ("xchg %0, %1" \ - : "=r" (fet), "=m" (mem) \ - : "0" (sto), "m" (mem)); \ - } while (0) -#endif - -#ifndef FETCH_STORE -/* This is a generic version, with a mutex to ensure the operation is - atomic. Unfortunately this approach probably makes arbiters no faster - than mutexes (though still using less memory of course), so some - CPU-specifics are highly desirable. */ -#define FETCH_STORE(fet,mem,sto) \ - do { \ - scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex); \ - (fet) = (mem); \ - (mem) = (sto); \ - scm_i_pthread_mutex_unlock (&scm_i_misc_mutex); \ - } while (0) -#endif - - -static scm_t_bits scm_tc16_arbiter; - - -#define SCM_LOCK_VAL (scm_tc16_arbiter | (1L << 16)) -#define SCM_UNLOCK_VAL scm_tc16_arbiter -#define SCM_ARB_LOCKED(arb) ((SCM_CELL_WORD_0 (arb)) & (1L << 16)) - - -static int -arbiter_print (SCM exp, SCM port, scm_print_state *pstate) -{ - scm_puts ("#<arbiter ", port); - if (SCM_ARB_LOCKED (exp)) - scm_puts ("locked ", port); - scm_iprin1 (SCM_PACK (SCM_SMOB_DATA (exp)), port, pstate); - scm_putc ('>', port); - return !0; -} - -SCM_DEFINE (scm_make_arbiter, "make-arbiter", 1, 0, 0, - (SCM name), - "Return an arbiter object, initially unlocked. Currently\n" - "@var{name} is only used for diagnostic output.") -#define FUNC_NAME s_scm_make_arbiter -{ - SCM_RETURN_NEWSMOB (scm_tc16_arbiter, SCM_UNPACK (name)); -} -#undef FUNC_NAME - - -/* The atomic FETCH_STORE here is so two threads can't both see the arbiter - unlocked and return #t. The arbiter itself wouldn't be corrupted by - this, but two threads both getting #t would be contrary to the intended - semantics. */ - -SCM_DEFINE (scm_try_arbiter, "try-arbiter", 1, 0, 0, - (SCM arb), - "If @var{arb} is unlocked, then lock it and return @code{#t}.\n" - "If @var{arb} is already locked, then do nothing and return\n" - "@code{#f}.") -#define FUNC_NAME s_scm_try_arbiter -{ - scm_t_bits old; - scm_t_bits *loc; - SCM_VALIDATE_SMOB (1, arb, arbiter); - loc = (scm_t_bits*)SCM_SMOB_OBJECT_N_LOC (arb, 0); - FETCH_STORE (old, *loc, SCM_LOCK_VAL); - return scm_from_bool (old == SCM_UNLOCK_VAL); -} -#undef FUNC_NAME - - -/* The atomic FETCH_STORE here is so two threads can't both see the arbiter - locked and return #t. The arbiter itself wouldn't be corrupted by this, - but we don't want two threads both thinking they were the unlocker. The - intended usage is for the code which locked to be responsible for - unlocking, but we guarantee the return value even if multiple threads - compete. */ - -SCM_DEFINE (scm_release_arbiter, "release-arbiter", 1, 0, 0, - (SCM arb), - "If @var{arb} is locked, then unlock it and return @code{#t}.\n" - "If @var{arb} is already unlocked, then do nothing and return\n" - "@code{#f}.\n" - "\n" - "Typical usage is for the thread which locked an arbiter to\n" - "later release it, but that's not required, any thread can\n" - "release it.") -#define FUNC_NAME s_scm_release_arbiter -{ - scm_t_bits old; - scm_t_bits *loc; - SCM_VALIDATE_SMOB (1, arb, arbiter); - loc = (scm_t_bits*)SCM_SMOB_OBJECT_N_LOC (arb, 0); - FETCH_STORE (old, *loc, SCM_UNLOCK_VAL); - return scm_from_bool (old == SCM_LOCK_VAL); -} -#undef FUNC_NAME - - - -void -scm_init_arbiters () -{ - scm_tc16_arbiter = scm_make_smob_type ("arbiter", 0); - scm_set_smob_print (scm_tc16_arbiter, arbiter_print); -#include "libguile/arbiters.x" -} - -/* - Local Variables: - c-file-style: "gnu" - End: -*/ diff --git a/libguile/arbiters.h b/libguile/arbiters.h deleted file mode 100644 index 214e92a34..000000000 --- a/libguile/arbiters.h +++ /dev/null @@ -1,41 +0,0 @@ -/* classes: h_files */ - -#ifndef SCM_ARBITERS_H -#define SCM_ARBITERS_H - -/* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc. - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public License - * as published by the Free Software Foundation; either version 3 of - * the License, or (at your option) any later version. - * - * This library 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 - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA - * 02110-1301 USA - */ - - - -#include "libguile/__scm.h" - - - -SCM_API SCM scm_make_arbiter (SCM name); -SCM_API SCM scm_try_arbiter (SCM arb); -SCM_API SCM scm_release_arbiter (SCM arb); -SCM_INTERNAL void scm_init_arbiters (void); - -#endif /* SCM_ARBITERS_H */ - -/* - Local Variables: - c-file-style: "gnu" - End: -*/ diff --git a/libguile/deprecated.c b/libguile/deprecated.c index af7643487..bae4ed449 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -486,10 +486,105 @@ scm_slot_exists_using_class_p (SCM class, SCM obj, SCM slot_name) +#define FETCH_STORE(fet,mem,sto) \ + do { \ + scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex); \ + (fet) = (mem); \ + (mem) = (sto); \ + scm_i_pthread_mutex_unlock (&scm_i_misc_mutex); \ + } while (0) + +static scm_t_bits scm_tc16_arbiter; + + +#define SCM_LOCK_VAL (scm_tc16_arbiter | (1L << 16)) +#define SCM_UNLOCK_VAL scm_tc16_arbiter +#define SCM_ARB_LOCKED(arb) ((SCM_CELL_WORD_0 (arb)) & (1L << 16)) + + +static int +arbiter_print (SCM exp, SCM port, scm_print_state *pstate) +{ + scm_puts ("#<arbiter ", port); + if (SCM_ARB_LOCKED (exp)) + scm_puts ("locked ", port); + scm_iprin1 (SCM_PACK (SCM_SMOB_DATA (exp)), port, pstate); + scm_putc ('>', port); + return !0; +} + +SCM_DEFINE (scm_make_arbiter, "make-arbiter", 1, 0, 0, + (SCM name), + "Return an arbiter object, initially unlocked. Currently\n" + "@var{name} is only used for diagnostic output.") +#define FUNC_NAME s_scm_make_arbiter +{ + scm_c_issue_deprecation_warning + ("Arbiters are deprecated. " + "Use mutexes or atomic variables instead."); + + SCM_RETURN_NEWSMOB (scm_tc16_arbiter, SCM_UNPACK (name)); +} +#undef FUNC_NAME + + +/* The atomic FETCH_STORE here is so two threads can't both see the arbiter + unlocked and return #t. The arbiter itself wouldn't be corrupted by + this, but two threads both getting #t would be contrary to the intended + semantics. */ + +SCM_DEFINE (scm_try_arbiter, "try-arbiter", 1, 0, 0, + (SCM arb), + "If @var{arb} is unlocked, then lock it and return @code{#t}.\n" + "If @var{arb} is already locked, then do nothing and return\n" + "@code{#f}.") +#define FUNC_NAME s_scm_try_arbiter +{ + scm_t_bits old; + scm_t_bits *loc; + SCM_VALIDATE_SMOB (1, arb, arbiter); + loc = (scm_t_bits*)SCM_SMOB_OBJECT_N_LOC (arb, 0); + FETCH_STORE (old, *loc, SCM_LOCK_VAL); + return scm_from_bool (old == SCM_UNLOCK_VAL); +} +#undef FUNC_NAME + + +/* The atomic FETCH_STORE here is so two threads can't both see the arbiter + locked and return #t. The arbiter itself wouldn't be corrupted by this, + but we don't want two threads both thinking they were the unlocker. The + intended usage is for the code which locked to be responsible for + unlocking, but we guarantee the return value even if multiple threads + compete. */ + +SCM_DEFINE (scm_release_arbiter, "release-arbiter", 1, 0, 0, + (SCM arb), + "If @var{arb} is locked, then unlock it and return @code{#t}.\n" + "If @var{arb} is already unlocked, then do nothing and return\n" + "@code{#f}.\n" + "\n" + "Typical usage is for the thread which locked an arbiter to\n" + "later release it, but that's not required, any thread can\n" + "release it.") +#define FUNC_NAME s_scm_release_arbiter +{ + scm_t_bits old; + scm_t_bits *loc; + SCM_VALIDATE_SMOB (1, arb, arbiter); + loc = (scm_t_bits*)SCM_SMOB_OBJECT_N_LOC (arb, 0); + FETCH_STORE (old, *loc, SCM_UNLOCK_VAL); + return scm_from_bool (old == SCM_LOCK_VAL); +} +#undef FUNC_NAME + + + void scm_i_init_deprecated () { + scm_tc16_arbiter = scm_make_smob_type ("arbiter", 0); + scm_set_smob_print (scm_tc16_arbiter, arbiter_print); #include "libguile/deprecated.x" } diff --git a/libguile/deprecated.h b/libguile/deprecated.h index 592dc98d5..5e8e8f819 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -217,6 +217,12 @@ SCM_DEPRECATED SCM scm_slot_exists_using_class_p (SCM cls, SCM obj, SCM slot_nam +SCM_DEPRECATED SCM scm_make_arbiter (SCM name); +SCM_DEPRECATED SCM scm_try_arbiter (SCM arb); +SCM_DEPRECATED SCM scm_release_arbiter (SCM arb); + + + void scm_i_init_deprecated (void); #endif diff --git a/libguile/init.c b/libguile/init.c index 3738538ae..31363c69b 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -35,7 +35,6 @@ /* Everybody has an init function. */ #include "libguile/alist.h" -#include "libguile/arbiters.h" #include "libguile/async.h" #include "libguile/atomic.h" #include "libguile/backtrace.h" @@ -419,7 +418,6 @@ scm_i_init_guile (void *base) scm_init_thread_procs (); /* requires gsubrs */ scm_init_procprop (); scm_init_alist (); - scm_init_arbiters (); /* requires smob_prehistory */ scm_init_async (); /* requires smob_prehistory */ scm_init_boolean (); scm_init_chars (); diff --git a/module/oop/goops.scm b/module/oop/goops.scm index 6dae45418..1d56cc7e1 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -74,7 +74,7 @@ ;; corresponding classes, which may be obtained via class-of, ;; once you have an instance. Perhaps FIXME to provide a ;; smob-type-name->class procedure. - <arbiter> <promise> <thread> <mutex> <condition-variable> + <promise> <thread> <mutex> <condition-variable> <regexp> <hook> <bitvector> <random-state> <async> <directory> <array> <character-set> <dynamic-object> <guardian> <macro> @@ -3096,7 +3096,9 @@ var{initargs}." ;;; {SMOB and port classes} ;;; -(define <arbiter> (find-subclass <top> '<arbiter>)) +(begin-deprecated + (define-public <arbiter> (find-subclass <top> '<arbiter>))) + (define <promise> (find-subclass <top> '<promise>)) (define <thread> (find-subclass <top> '<thread>)) (define <mutex> (find-subclass <top> '<mutex>)) diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 3c88405cb..f940d78c7 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -26,7 +26,6 @@ SCM_TESTS = tests/00-initial-env.test \ tests/00-socket.test \ tests/alist.test \ tests/and-let-star.test \ - tests/arbiters.test \ tests/arrays.test \ tests/bit-operations.test \ tests/bitvectors.test \ diff --git a/test-suite/tests/arbiters.test b/test-suite/tests/arbiters.test deleted file mode 100644 index 36dc7edbd..000000000 --- a/test-suite/tests/arbiters.test +++ /dev/null @@ -1,102 +0,0 @@ -;;;; arbiters.test --- test arbiters functions -*- scheme -*- -;;;; -;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc. -;;;; -;;;; This library is free software; you can redistribute it and/or -;;;; modify it under the terms of the GNU Lesser General Public -;;;; License as published by the Free Software Foundation; either -;;;; version 3 of the License, or (at your option) any later version. -;;;; -;;;; This library 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 -;;;; Lesser General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU Lesser General Public -;;;; License along with this library; if not, write to the Free Software -;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - -(define-module (test-suite test-arbiters) - #:use-module (test-suite lib)) - -;;; -;;; arbiter display -;;; - -(with-test-prefix "arbiter display" - ;; nothing fancy, just exercise the printing code - - (pass-if "never locked" - (let ((arb (make-arbiter "foo")) - (port (open-output-string))) - (display arb port) - #t)) - - (pass-if "locked" - (let ((arb (make-arbiter "foo")) - (port (open-output-string))) - (try-arbiter arb) - (display arb port) - #t)) - - (pass-if "unlocked" - (let ((arb (make-arbiter "foo")) - (port (open-output-string))) - (try-arbiter arb) - (release-arbiter arb) - (display arb port) - #t))) - -;;; -;;; try-arbiter -;;; - -(with-test-prefix "try-arbiter" - - (pass-if "lock" - (let ((arb (make-arbiter "foo"))) - (try-arbiter arb))) - - (pass-if "already locked" - (let ((arb (make-arbiter "foo"))) - (try-arbiter arb) - (not (try-arbiter arb)))) - - (pass-if "already locked twice" - (let ((arb (make-arbiter "foo"))) - (try-arbiter arb) - (try-arbiter arb) - (not (try-arbiter arb))))) - -;;; -;;; release-arbiter -;;; - -(with-test-prefix "release-arbiter" - - (pass-if "lock" - (let ((arb (make-arbiter "foo"))) - (try-arbiter arb) - (release-arbiter arb))) - - (pass-if "never locked" - (let ((arb (make-arbiter "foo"))) - (not (release-arbiter arb)))) - - (pass-if "never locked twice" - (let ((arb (make-arbiter "foo"))) - (release-arbiter arb) - (not (release-arbiter arb)))) - - (pass-if "already unlocked" - (let ((arb (make-arbiter "foo"))) - (try-arbiter arb) - (release-arbiter arb) - (not (release-arbiter arb)))) - - (pass-if "already unlocked twice" - (let ((arb (make-arbiter "foo"))) - (try-arbiter arb) - (release-arbiter arb) - (release-arbiter arb) - (not (release-arbiter arb))))) |