From: Gabor Melis <mega@hotpop.com>
Date: Fri, 9 Jan 2009 16:42:09 +0000 (+0000)
Subject: 1.0.24.25: add volatile after asm in spinlock and swap_lispobjs
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=inline;h=4d633465231c79adeb3e4e59bf30c011d1d0e9dd;p=sbcl.git

1.0.24.25: add volatile after asm in spinlock and swap_lispobjs

... to prevent the compiler from optimizing away certain calls or
maybe reorder them. Test for swap_lispobj.
---

diff --git a/src/runtime/x86-64-arch.h b/src/runtime/x86-64-arch.h
index 10df5d8..4c5d1a7 100644
--- a/src/runtime/x86-64-arch.h
+++ b/src/runtime/x86-64-arch.h
@@ -29,13 +29,15 @@ get_spinlock(volatile lispobj *word,long value)
         lose("recursive get_spinlock: 0x%x,%ld\n",word,value);
     do {
 #if defined(LISP_FEATURE_DARWIN)
-        asm ("xor %0,%0\n\
+        asm volatile
+            ("xor %0,%0\n\
               lock/cmpxchg %1,%2"
              : "=a" (rax)
              : "r" (value), "m" (*word)
              : "memory", "cc");
 #else
-        asm ("xor %0,%0\n\
+        asm volatile
+            ("xor %0,%0\n\
               lock cmpxchg %1,%2"
              : "=a" (rax)
              : "r" (value), "m" (*word)
@@ -57,7 +59,8 @@ static inline lispobj
 swap_lispobjs(volatile lispobj *dest, lispobj value)
 {
     lispobj old_value;
-    asm ("lock xchg %0,(%1)"
+    asm volatile
+        ("lock xchg %0,(%1)"
          : "=r" (old_value)
          : "r" (dest), "0" (value)
          : "memory");
diff --git a/src/runtime/x86-arch.h b/src/runtime/x86-arch.h
index 30363db..1a51e6b 100644
--- a/src/runtime/x86-arch.h
+++ b/src/runtime/x86-arch.h
@@ -29,13 +29,13 @@ get_spinlock(volatile lispobj *word, unsigned long value)
         lose("recursive get_spinlock: 0x%x,%ld\n",word,value);
     do {
 #if defined(LISP_FEATURE_DARWIN)
-        asm ("xor %0,%0;\n\
+        asm volatile ("xor %0,%0;\n\
               lock/cmpxchg %1,%2"
              : "=a" (eax)
              : "r" (value), "m" (*word)
              : "memory", "cc");
 #else
-        asm ("xor %0,%0\n\
+        asm volatile ("xor %0,%0\n\
               lock cmpxchg %1,%2"
              : "=a" (eax)
              : "r" (value), "m" (*word)
@@ -61,12 +61,12 @@ swap_lispobjs(volatile lispobj *dest, lispobj value)
 {
     lispobj old_value;
 #if defined(LISP_FEATURE_DARWIN)
-    asm ("lock/xchg %0,(%1)"
+    asm volatile ("lock/xchg %0,(%1)"
          : "=r" (old_value)
          : "r" (dest), "0" (value)
          : "memory");
 #else
-    asm ("lock xchg %0,(%1)"
+    asm volatile ("lock xchg %0,(%1)"
          : "=r" (old_value)
          : "r" (dest), "0" (value)
          : "memory");
diff --git a/tests/swap-lispobjs.c b/tests/swap-lispobjs.c
new file mode 100644
index 0000000..853042c
--- /dev/null
+++ b/tests/swap-lispobjs.c
@@ -0,0 +1,22 @@
+#include "arch.h"
+#include "genesis/config.h"
+#include "genesis/constants.h"
+#include "runtime.h"
+#include "target-arch.h"
+
+#if defined(LISP_FEATURE_X86) || defined (LISP_FEATURE_X86_64)
+
+int
+try_to_zero_with_swap_lispobjs(volatile lispobj *word)
+{
+    /* GCC with high enough optimization settings optimizes away the
+     * whole assembly if it is not marked as volatile. */
+    swap_lispobjs(word,0);
+    if (*word==0) {
+        return 0;
+    } else {
+        return 1;
+    }
+}
+
+#endif
diff --git a/tests/swap-lispobjs.impure.lisp b/tests/swap-lispobjs.impure.lisp
new file mode 100644
index 0000000..c3cf6f5
--- /dev/null
+++ b/tests/swap-lispobjs.impure.lisp
@@ -0,0 +1,52 @@
+;;;; Testing swap_lispobjs.
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+(use-package :sb-alien)
+
+#-(or x86 x86-64)
+(sb-ext:quit :unix-status 104)
+
+(defun run (program &rest arguments)
+  (let* ((proc nil)
+         (output
+          (with-output-to-string (s)
+            (setf proc (run-program program arguments
+                                    :search (not (eql #\. (char program 0)))
+                                    :output s)))))
+    (unless (zerop (process-exit-code proc))
+      (error "Bad exit code: ~S~%Output:~% ~S"
+             (process-exit-code proc)
+             output))
+    output))
+
+(run "cc" "-O3"
+     "-I" "../src/runtime/"
+     "swap-lispobjs.c"
+     #+(and (or linux freebsd) (or x86-64 ppc mips)) "-fPIC"
+     #+(and x86-64 darwin) "-arch" #+(and x86-64 darwin) "x86_64"
+     #+darwin "-bundle" #-darwin "-shared"
+     "-o" "swap-lispobjs.so")
+
+(load-shared-object (truename "swap-lispobjs.so"))
+
+(define-alien-routine try-to-zero-with-swap-lispobjs int
+  (lispobj-adress unsigned-long))
+
+(with-test (:name :swap-lispobjs)
+  (let ((x (cons 13 27)))
+    (try-to-zero-with-swap-lispobjs
+     (logandc2 (sb-kernel:get-lisp-obj-address x)
+               sb-vm:lowtag-mask))
+    (assert (equal x (cons 0 27)))))
+
+(delete-file "swap-lispobjs.so")
diff --git a/version.lisp-expr b/version.lisp-expr
index f3f53a5..3120660 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.24.24"
+"1.0.24.25"