mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

Deprecate arbiters

Browse source 
* libguile/arbiters.c:
* libguile/arbiters.h:
* test-suite/tests/arbiters.test: Delete files.
* libguile/deprecated.c:
* libguile/deprecated.h: Move arbiters code here.
* doc/ref/api-scheduling.texi: Remove section on arbiters.
* libguile.h:
* libguile/Makefile.am:
* libguile/init.c:
* module/oop/goops.scm:
* test-suite/Makefile.am: Remove mention of arbiters.
* NEWS: Update.
This commit is contained in:
Andy Wingo 2016-10-17 21:25:18 +02:00
parent e61017afa8
commit 56d8d9a257
12 changed files with 112 additions and 365 deletions
Download patch file Download diff file Expand all files Collapse all files

7
NEWS
View file

@ -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

38
doc/ref/api-scheduling.texi
View file

@ -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

1
libguile.h
View file

@ -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"

4
libguile/Makefile.am
View file

@ -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 \

174
libguile/arbiters.c
View file

@ -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:
*/

41
libguile/arbiters.h
View file

@ -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:
*/

95
libguile/deprecated.c
View file

@ -485,11 +485,106 @@ 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"
}

6
libguile/deprecated.h
View file

@ -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

2
libguile/init.c
View file

@ -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 ();

6
module/oop/goops.scm
View file

@ -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>))

1
test-suite/Makefile.am
View file

@ -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 \

102
test-suite/tests/arbiters.test
View file

@ -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)))))