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.

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,
+          if (!scm_is_eq (asyncs,
-                                                SCM_EOL))
+                          scm_atomic_compare_and_swap_scm (&t->pending_asyncs,
+                                                           asyncs, SCM_EOL)))
             continue;
         }
       else

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),
+  return scm_atomic_compare_and_swap_scm (scm_atomic_box_loc (box),
-                                           &result, desired)
+                                          expected, 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;
 }
 #undef FUNC_NAME
 

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
+static inline SCM
-scm_atomic_compare_and_swap_scm (SCM *loc, SCM *expected, SCM desired)
+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,
+  SCM result = expected;
-                                       (uintptr_t *) expected,
+  atomic_compare_exchange_strong (a_loc, (uintptr_t *) &result,
-                                       SCM_UNPACK (desired));
+                                  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
+static inline SCM
-scm_atomic_compare_and_swap_scm (SCM *loc, SCM *expected, SCM desired)
+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 = *loc;
-      ret = 0;
     }
   scm_i_pthread_mutex_unlock (&atomics_lock);
   return ret;

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;
+  return scm_atomic_compare_and_swap_scm (loc, expected, desired);
-
-  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;
 }
 
 void