[Sbcl-commits] CVS: sbcl/tests swap-lispobjs.c, NONE, 1.1 swap-lispobjs.impure.lisp, NONE, 1.1

[Gábor M. <me...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv21872/tests

Added Files:
	swap-lispobjs.c swap-lispobjs.impure.lisp 
Log Message:
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.


--- NEW FILE: swap-lispobjs.c ---
#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

--- NEW FILE: swap-lispobjs.impure.lisp ---
;;;; 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")