[Guile-commits] 01/01: Fix 'atomic-box-compare-and-swap!'.

[Mark H. Weaver]

mhw pushed a commit to branch stable-2.2
in repository guile.

commit 2d09e0513fc11e2305077ba3653f6e4c2f266ddb
Author: Mark H Weaver <address@hidden>
Date:   Thu Sep 27 01:00:11 2018 -0400

    Fix 'atomic-box-compare-and-swap!'.
    
    Fixes <https://bugs.gnu.org/32786>.
    
    'scm_atomic_compare_and_swap_scm' is a thin wrapper around
    'atomic_compare_exchange_weak' (where available), and therefore it may
    spuriously fail on some platforms, leaving the atomic object unchanged
    even when the observed value is equal to the expected value.  Since
    'scm_atomic_compare_and_swap_scm' returns both a boolean result and the
    observed value, the caller is able to detect spurious failures when
    using that API.
    
    'atomic-box-compare-and-swap!' presents a simpler API, returning only
    the observed value.  The documentation advises callers to assume that
    the exchange succeeded if the observed value is 'eq?' to the expected
    value.  It's therefore not possible to report spurious failures with
    this API.
    
    'atomic-box-compare-and-swap!' uses 'scm_atomic_compare_and_swap_scm',
    and prior to this commit would simply ignore the boolean result and
    return the observed value.  In case of spurious failures, the caller
    would legitimately conclude that the exchange had succeeded.
    
    With this commit, 'atomic-box-compare-and-swap!' now retries in case of
    spurious failures.
    
    * libguile/atomic.c (scm_atomic_box_compare_and_swap_x): If
    'scm_atomic_compare_and_swap_scm' returns false and the observed value
    is equal to 'expected', then try again.
    * libguile/vm-engine.c (atomic-box-compare-and-swap!): Ditto.
---
 libguile/atomic.c    | 19 +++++++++++++++----
 libguile/vm-engine.c | 19 ++++++++++++++-----
 2 files changed, 29 insertions(+), 9 deletions(-)

diff --git a/libguile/atomic.c b/libguile/atomic.c
index 9508740..180622b 100644
--- a/libguile/atomic.c
+++ b/libguile/atomic.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2016 Free Software Foundation, Inc.
+/* Copyright (C) 2016, 2018 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
@@ -95,10 +95,21 @@ 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);
-  scm_atomic_compare_and_swap_scm (scm_atomic_box_loc (box),
-                                   &expected, desired);
-  return expected;
+  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;
 }
 #undef FUNC_NAME
 
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 19ff3e4..53d7f35 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -3868,16 +3868,25 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
     {
       scm_t_uint16 dst, box;
       scm_t_uint32 expected, desired;
-      SCM scm_box, scm_expected;
+      SCM scm_box, scm_expected, scm_result;
       UNPACK_12_12 (op, dst, box);
       UNPACK_24 (ip[1], expected);
       UNPACK_24 (ip[2], desired);
       scm_box = SP_REF (box);
       VM_VALIDATE_ATOMIC_BOX (scm_box, "atomic-box-compare-and-swap!");
-      scm_expected = SP_REF (expected);
-      scm_atomic_compare_and_swap_scm (scm_atomic_box_loc (scm_box),
-                                       &scm_expected, SP_REF (desired));
-      SP_SET (dst, scm_expected);
+      scm_result = scm_expected = SP_REF (expected);
+      while (!scm_atomic_compare_and_swap_scm (scm_atomic_box_loc (scm_box),
+                                               &scm_result, SP_REF (desired))
+             && scm_is_eq (scm_result, scm_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.  */
+        }
+      SP_SET (dst, scm_result);
       NEXT (3);
     }