Commit 4d633465 authored by Gabor Melis's avatar Gabor Melis
Browse files

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.
parent f7873f9a

src/runtime/x86-64-arch.h

+6 −3
Original line number Diff line number Diff line
@@ -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");

src/runtime/x86-arch.h

+4 −4
Original line number Diff line number Diff line
@@ -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");

tests/swap-lispobjs.c

0 → 100644
+22 −0
Original line number Diff line number Diff line 
#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

tests/swap-lispobjs.impure.lisp

0 → 100644
+52 −0
Original line number Diff line number Diff line 
;;;; 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")

version.lisp-expr

+1 −1
Original line number Diff line number Diff line
@@ -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"