summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2019-05-25 17:17:49 +0200
committerAndy Wingo <wingo@pobox.com>2019-05-25 17:17:49 +0200
commitd1c2d7de2fed73be83a6213dcbf13247e19e457d (patch)
treecee4277e3791606200cff9197a6dc47957651aa2 /libguile
parent8b8ce79e83d65c47866696221b0a47382a835873 (diff)
downloadguile-d1c2d7de2fed73be83a6213dcbf13247e19e457d.tar.gz
Switch to use atomic_compare_exchange_strong
* libguile/atomics-internal.h (scm_atomic_compare_and_swap_scm): Change to use same API as atomic-box-compare-and-swap!. * libguile/intrinsics.c (atomic_compare_and_swap_scm): Remove loop, as we're using the strong variant now. * libguile/async.c (scm_i_async_pop, scm_i_async_push): Adapt to new API of scm_atomic_compare_and_swap_scm.
Diffstat (limited to 'libguile')
-rw-r--r--libguile/async.c17
-rw-r--r--libguile/atomic.c16
-rw-r--r--libguile/atomics-internal.h26
-rw-r--r--libguile/intrinsics.c15
4 files changed, 27 insertions, 47 deletions
diff --git a/libguile/async.c b/libguile/async.c
index bd840762f..e10bc562b 100644
--- a/libguile/async.c
+++ b/libguile/async.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1998,2000-2002,2004,2006,2008-2011,2014,2018
+/* Copyright 1995-1998,2000-2002,2004,2006,2008-2011,2014,2018-2019
Free Software Foundation, Inc.
This file is part of Guile.
@@ -86,7 +86,7 @@ scm_i_async_push (scm_thread *t, SCM proc)
disable that newly-severed tail by setting its cdr to #f. Not so
nice, but oh well. */
asyncs = scm_atomic_ref_scm (&t->pending_asyncs);
- do
+ while (1)
{
/* Traverse the asyncs list atomically. */
SCM walk;
@@ -95,9 +95,13 @@ scm_i_async_push (scm_thread *t, SCM proc)
walk = scm_atomic_ref_scm (SCM_CDRLOC (walk)))
if (scm_is_eq (SCM_CAR (walk), proc))
return;
+
+ SCM expected = asyncs;
+ asyncs = scm_atomic_compare_and_swap_scm
+ (&t->pending_asyncs, asyncs, scm_cons (proc, asyncs));
+ if (scm_is_eq (asyncs, expected))
+ return;
}
- while (!scm_atomic_compare_and_swap_scm (&t->pending_asyncs, &asyncs,
- scm_cons (proc, asyncs)));
}
/* Precondition: there are pending asyncs. */
@@ -123,8 +127,9 @@ scm_i_async_pop (scm_thread *t)
/* Sever the tail. */
if (scm_is_false (penultimate_pair))
{
- if (!scm_atomic_compare_and_swap_scm (&t->pending_asyncs, &asyncs,
- SCM_EOL))
+ if (!scm_is_eq (asyncs,
+ scm_atomic_compare_and_swap_scm (&t->pending_asyncs,
+ asyncs, SCM_EOL)))
continue;
}
else
diff --git a/libguile/atomic.c b/libguile/atomic.c
index 174d26b76..adb2a0c4b 100644
--- a/libguile/atomic.c
+++ b/libguile/atomic.c
@@ -102,21 +102,9 @@ SCM_DEFINE (scm_atomic_box_compare_and_swap_x,
"if the return value is @code{eq?} to @var{expected}.")
#define FUNC_NAME s_scm_atomic_box_compare_and_swap_x
{
- SCM result = expected;
-
SCM_VALIDATE_ATOMIC_BOX (1, box);
- while (!scm_atomic_compare_and_swap_scm (scm_atomic_box_loc (box),
- &result, desired)
- && scm_is_eq (result, expected))
- {
- /* 'scm_atomic_compare_and_swap_scm' has spuriously failed,
- i.e. it has returned 0 to indicate failure, although the
- observed value is 'eq?' to EXPECTED. In this case, we *must*
- try again, because the API of 'atomic-box-compare-and-swap!'
- provides no way to indicate to the caller that the exchange
- failed when the observed value is 'eq?' to EXPECTED. */
- }
- return result;
+ return scm_atomic_compare_and_swap_scm (scm_atomic_box_loc (box),
+ expected, desired);
}
#undef FUNC_NAME
diff --git a/libguile/atomics-internal.h b/libguile/atomics-internal.h
index 7acc37f88..e15ea3564 100644
--- a/libguile/atomics-internal.h
+++ b/libguile/atomics-internal.h
@@ -1,7 +1,7 @@
#ifndef SCM_ATOMICS_INTERNAL_H
#define SCM_ATOMICS_INTERNAL_H
-/* Copyright 2016,2018
+/* Copyright 2016,2018-2019
Free Software Foundation, Inc.
This file is part of Guile.
@@ -75,13 +75,14 @@ scm_atomic_swap_scm (SCM *loc, SCM val)
atomic_uintptr_t *a_loc = (atomic_uintptr_t *) loc;
return SCM_PACK (atomic_exchange (a_loc, SCM_UNPACK (val)));
}
-static inline _Bool
-scm_atomic_compare_and_swap_scm (SCM *loc, SCM *expected, SCM desired)
+static inline SCM
+scm_atomic_compare_and_swap_scm (SCM *loc, SCM expected, SCM desired)
{
atomic_uintptr_t *a_loc = (atomic_uintptr_t *) loc;
- return atomic_compare_exchange_weak (a_loc,
- (uintptr_t *) expected,
- SCM_UNPACK (desired));
+ SCM result = expected;
+ atomic_compare_exchange_strong (a_loc, (uintptr_t *) &result,
+ SCM_UNPACK (desired));
+ return result;
}
#else /* HAVE_STDATOMIC_H */
@@ -161,20 +162,19 @@ scm_atomic_swap_scm (SCM *loc, SCM val)
scm_i_pthread_mutex_unlock (&atomics_lock);
return ret;
}
-static inline int
-scm_atomic_compare_and_swap_scm (SCM *loc, SCM *expected, SCM desired)
+static inline SCM
+scm_atomic_compare_and_swap_scm (SCM *loc, SCM expected, SCM desired)
{
- int ret;
+ SCM ret;
scm_i_pthread_mutex_lock (&atomics_lock);
- if (*loc == *expected)
+ if (*loc == expected)
{
*loc = desired;
- ret = 1;
+ ret = expected;
}
else
{
- *expected = *loc;
- ret = 0;
+ ret = *loc;
}
scm_i_pthread_mutex_unlock (&atomics_lock);
return ret;
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index 437441032..a8c6fa7bb 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -459,20 +459,7 @@ atomic_swap_scm (SCM *loc, SCM val)
static SCM
atomic_compare_and_swap_scm (SCM *loc, SCM expected, SCM desired)
{
- SCM result = expected;
-
- while (!scm_atomic_compare_and_swap_scm (loc, &result, desired)
- && scm_is_eq (result, expected))
- {
- /* 'scm_atomic_compare_and_swap_scm' has spuriously failed,
- i.e. it has returned 0 to indicate failure, although the
- observed value is 'eq?' to EXPECTED. In this case, we *must*
- try again, because the API of 'atomic-box-compare-and-swap!'
- provides no way to indicate to the caller that the exchange
- failed when the observed value is 'eq?' to EXPECTED. */
- }
-
- return result;
+ return scm_atomic_compare_and_swap_scm (loc, expected, desired);
}
void