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