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)
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");
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)
{
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");
--- /dev/null
+#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
--- /dev/null
+;;;; 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")
;;; 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"