fix problems related to futures and is-list flags on pairs
Although a future thread used an atomic compare-and-swap to set "is a list" or "not a list" flag on pairs via the JIT-implemented `list?', the hashing function in the runtime thread did not; as a result, it might be possible to lose a hash code due to cache inconsistency (although I'm not sure it's actually possible, and I couldn't trigger a problem with a test). Most of the changes are related to using an atomic compare-and-swap when setting a hash code, as well as clean-ups to related code. Processor-count tests avoid using atomic compare-and-swap on uniprocessors, which might not support the relevant machine instructions. As significantly, the compare-and-swap operation for the JIT-implemented `list?' did not actually set flags on a pair that has a hash code. This could lead to `list?' tests that were not constant time (but only if the relevant pair's `eq?' hash code had been used previously).
This commit is contained in:
Matthew Flatt
parent
b644e335d9
commit
ec27cbfd90
30
collects/tests/future/list-flags.rkt
Normal file
30
collects/tests/future/list-flags.rkt
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
#lang racket
|
||||
(require racket/future)
|
||||
|
||||
;; This test tries to trigger race conditions between computing an eq
|
||||
;; hash code in the runtime thread and setting "is a list" flags in a
|
||||
;; future thread. It also effectively checks that `list?' is a
|
||||
;; constant-time operation (i.e., that "is a list" flags are set
|
||||
;; correctly), since it uses a long chain of pairs.
|
||||
|
||||
(define N 1000000)
|
||||
|
||||
(define v (make-vector N null))
|
||||
(for ([i N])
|
||||
(vector-set! v i (cons i (vector-ref v (max 0 (sub1 i))))))
|
||||
|
||||
(define v2 (make-vector (vector-length v)))
|
||||
(define f (future (lambda ()
|
||||
(for/and ([a (in-vector v)])
|
||||
(and (car a) (list? a))))))
|
||||
|
||||
(for ([i (vector-length v)])
|
||||
(let ([a (vector-ref v i)])
|
||||
(when (car a)
|
||||
(vector-set! v2 i (eq-hash-code a)))))
|
||||
|
||||
(unless (touch f) (error "future fail?"))
|
||||
|
||||
(for ([i (vector-length v)])
|
||||
(unless (eq? (vector-ref v2 i) (eq-hash-code (vector-ref v i)))
|
||||
(error "fail")))
|
||||
|
|
@ -174,7 +174,8 @@ xobjects: $(OBJS) main.@LTO@
|
|||
XFORMDEP = $(srcdir)/gc2.h $(srcdir)/gc2_obj.h $(srcdir)/xform.rkt $(srcdir)/xform-mod.rkt \
|
||||
$(srcdir)/precomp.c $(srcdir)/../src/schpriv.h $(srcdir)/../include/scheme.h \
|
||||
$(srcdir)/../sconfig.h ../mzconfig.h $(srcdir)/../uconfig.h $(srcdir)/../src/schemef.h \
|
||||
$(srcdir)/../src/stypes.h $(srcdir)/../include/schthread.h $(srcdir)/../src/mzrt.h
|
||||
$(srcdir)/../src/stypes.h $(srcdir)/../include/schthread.h $(srcdir)/../src/mzrt.h \
|
||||
$(srcdir)/../src/mzrt_cas.inc
|
||||
|
||||
LIGHTNINGDEP = $(srcdir)/../src/lightning/i386/core.h $(srcdir)/../src/lightning/i386/core-common.h \
|
||||
$(srcdir)/../src/lightning/i386/asm.h $(srcdir)/../src/lightning/i386/asm-common.h \
|
||||
|
|
|
|||
|
|
@ -1684,6 +1684,9 @@ extern void *scheme_malloc_envunbox(size_t);
|
|||
# define MZ_GC_REG() (__gc_var_stack__[0] = GC_variable_stack, \
|
||||
GC_variable_stack = __gc_var_stack__)
|
||||
# define MZ_GC_UNREG() (GC_variable_stack = (void **)__gc_var_stack__[0])
|
||||
# ifndef MZ_XFORM
|
||||
# define XFORM_SKIP_PROC /* empty */
|
||||
# endif
|
||||
#else
|
||||
# define MZ_GC_DECL_REG(size) /* empty */
|
||||
# define MZ_GC_VAR_IN_REG(x, v) /* empty */
|
||||
|
|
|
|||
|
|
@ -292,7 +292,7 @@ SCONFIG = $(srcdir)/../sconfig.h $(srcdir)/../uconfig.h ../mzconfig.h
|
|||
# More dependencies
|
||||
|
||||
COMMON_HEADERS = $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
|
||||
$(srcdir)/../include/schthread.h
|
||||
$(srcdir)/../include/schthread.h $(srcdir)/mzrt.h $(srcdir)/mzrt_cas.inc
|
||||
JIT_HEADERS = $(srcdir)/../src/jit.h \
|
||||
$(srcdir)/../src/stypes.h \
|
||||
$(srcdir)/lightning/i386/core.h $(srcdir)/lightning/i386/core-common.h \
|
||||
|
|
@ -324,7 +324,7 @@ complex.@LTO@: $(COMMON_HEADERS) \
|
|||
dynext.@LTO@: $(COMMON_HEADERS) \
|
||||
$(srcdir)/../src/stypes.h $(srcdir)/../src/schemex.h \
|
||||
$(srcdir)/schvers.h $(srcdir)/../gc/gc.h $(srcdir)/schemex.h
|
||||
env.@LTO@: $(COMMON_HEADERS) \
|
||||
env.@LTO@: $(COMMON_HEADERS) \
|
||||
$(srcdir)/../src/stypes.h $(srcdir)/schminc.h $(srcdir)/mzmark_env.inc
|
||||
error.@LTO@: $(COMMON_HEADERS) \
|
||||
$(srcdir)/../src/stypes.h
|
||||
|
|
@ -338,7 +338,7 @@ fun.@LTO@: $(COMMON_HEADERS) \
|
|||
$(srcdir)/../src/stypes.h $(srcdir)/mzmark_fun.inc $(srcdir)/schmap.inc \
|
||||
$(srcdir)/future.h
|
||||
future.@LTO@: $(COMMON_HEADERS) $(srcdir)/future.h $(SCONFIG) \
|
||||
$(srcdir)/../src/stypes.h $(srcdir)/mzmark_future.inc $(srcdir)/mzrt.h \
|
||||
$(srcdir)/../src/stypes.h $(srcdir)/mzmark_future.inc \
|
||||
$(srcdir)/jit_ts_future_glue.c $(srcdir)/jit_ts_runtime_glue.c $(srcdir)/jit_ts_protos.h
|
||||
hash.@LTO@: $(COMMON_HEADERS) \
|
||||
$(srcdir)/../src/stypes.h $(srcdir)/mzmark_hash.inc
|
||||
|
|
|
|||
|
|
@ -28,7 +28,6 @@
|
|||
initialization sequence (filling the initial namespace). */
|
||||
|
||||
#include "schpriv.h"
|
||||
#include "mzrt.h"
|
||||
#include "schminc.h"
|
||||
#include "schmach.h"
|
||||
#include "schexpobs.h"
|
||||
|
|
|
|||
|
|
@ -147,6 +147,11 @@ static Scheme_Object *processor_count(int argc, Scheme_Object *argv[])
|
|||
return scheme_make_integer(1);
|
||||
}
|
||||
|
||||
int scheme_is_multiprocessor(int now)
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
|
||||
Scheme_Object *scheme_current_future(int argc, Scheme_Object *argv[])
|
||||
{
|
||||
future_t *ft = scheme_current_thread->current_ft;
|
||||
|
|
@ -1909,19 +1914,33 @@ static void init_cpucount(void)
|
|||
size_t size = sizeof(cpucount);
|
||||
|
||||
if (sysctlbyname("hw.ncpu", &cpucount, &size, NULL, 0))
|
||||
{
|
||||
cpucount = 1;
|
||||
}
|
||||
cpucount = 2;
|
||||
#elif defined(DOS_FILE_SYSTEM)
|
||||
SYSTEM_INFO sysinfo;
|
||||
GetSystemInfo(&sysinfo);
|
||||
cpucount = sysinfo.dwNumberOfProcessors;
|
||||
#else
|
||||
/* Conservative guess! */
|
||||
cpucount = 1;
|
||||
/* A result of 1 is not conservative, because claiming a
|
||||
uniprocessor means that atomic cmpxchg operations are not used
|
||||
for setting pair flags and hash codes. */
|
||||
cpucount = 2;
|
||||
#endif
|
||||
}
|
||||
|
||||
int scheme_is_multiprocessor(int now)
|
||||
{
|
||||
if (cpucount > 1) {
|
||||
if (!now)
|
||||
return 1;
|
||||
else {
|
||||
Scheme_Future_State *fs = scheme_future_state;
|
||||
return (fs && fs->future_threads_created);
|
||||
}
|
||||
} else
|
||||
return 0;
|
||||
}
|
||||
|
||||
Scheme_Object *processor_count(int argc, Scheme_Object *argv[])
|
||||
/* Called in runtime thread */
|
||||
{
|
||||
|
|
|
|||
|
|
@ -25,7 +25,6 @@
|
|||
|
||||
#include "schpriv.h"
|
||||
#include "schmach.h"
|
||||
#include <string.h>
|
||||
#include <ctype.h>
|
||||
#include <math.h>
|
||||
#include "../gc2/gc2_obj.h"
|
||||
|
|
@ -53,11 +52,17 @@ static void register_traversers(void);
|
|||
#define to_unsigned_hash(v) ((uintptr_t)v)
|
||||
|
||||
#ifdef MZ_PRECISE_GC
|
||||
/* keygen race conditions below are ok, because keygen is randomness used
|
||||
to create a hashkey. (Make sure that only one thread at a time sets
|
||||
a hash code in a specific object, though.) */
|
||||
/* keygen race conditions below are "ok", because keygen is randomness
|
||||
used to create a hashkey. Technically, a race condition allows
|
||||
undefined behavior by some C standards, but we don't expect
|
||||
compilers to actually impose a "catch fire" semantics. Make sure
|
||||
that only one thread at a time sets a hash code in a specific
|
||||
object, though, and watch out for a race with JIT-generated code
|
||||
running in a future and setting flags on pairs. */
|
||||
SHARED_OK static uintptr_t keygen;
|
||||
|
||||
XFORM_NONGCING extern int scheme_is_multiprocessor();
|
||||
|
||||
XFORM_NONGCING static MZ_INLINE
|
||||
uintptr_t PTR_TO_LONG(Scheme_Object *o)
|
||||
{
|
||||
|
|
@ -86,7 +91,16 @@ uintptr_t PTR_TO_LONG(Scheme_Object *o)
|
|||
v &= ~0x4000;
|
||||
#endif
|
||||
if (!v) v = 0x1AD0;
|
||||
o->keyex = v;
|
||||
#ifdef MZ_USE_FUTURES
|
||||
if (SCHEME_PAIRP(o) && scheme_is_multiprocessor(1)) {
|
||||
/* Use CAS to avoid losing a hash code due to a conflict with
|
||||
JIT-generated `list?' test, which itself uses CAS to set "is
|
||||
a list" or "not a list" flags on pairs. */
|
||||
while (!mzrt_cas16(&o->keyex, o->keyex, v)) {
|
||||
}
|
||||
} else
|
||||
#endif
|
||||
o->keyex = v;
|
||||
keygen += 4;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -2239,21 +2239,23 @@ static int common7(mz_jit_state *jitter, void *_data)
|
|||
|
||||
jit_ldxi_s(JIT_R2, JIT_R1, &MZ_OPT_HASH_KEY(&((Scheme_Stx *)0x0)->iso));
|
||||
#ifdef MZ_USE_FUTURES
|
||||
/* Need an atomic update in case another thread is setting
|
||||
a hash code on the target pair. */
|
||||
/* Assumes little-endian and that a short hash follows a short type tag: */
|
||||
ref5 = jit_bmsi_i(jit_forward(), JIT_R2, PAIR_IS_LIST);
|
||||
jit_rshi_i(JIT_R0, JIT_R2, 16);
|
||||
jit_ori_i(JIT_R0, JIT_R0, scheme_pair_type);
|
||||
jit_ori_i(JIT_R2, JIT_R0, (PAIR_IS_LIST << 16));
|
||||
/* In the unlikely case that the compare-and-swap fails, then it's ok to
|
||||
lose the caching of the list bit: */
|
||||
jit_lock_cmpxchgr_i(JIT_R1, JIT_R2);
|
||||
mz_patch_branch(ref5);
|
||||
#else
|
||||
jit_ori_i(JIT_R2, JIT_R2, PAIR_IS_LIST);
|
||||
jit_stxi_s(&MZ_OPT_HASH_KEY(&((Scheme_Stx *)0x0)->iso), JIT_R1, JIT_R2);
|
||||
if (scheme_is_multiprocessor(0)) {
|
||||
/* Need an atomic update in case another thread is setting
|
||||
a hash code on the target pair. */
|
||||
ref5 = jit_bmsi_i(jit_forward(), JIT_R2, PAIR_IS_LIST);
|
||||
jit_movr_i(JIT_R0, JIT_R2);
|
||||
jit_ori_i(JIT_R2, JIT_R2, PAIR_IS_LIST);
|
||||
jit_addi_p(JIT_R1, JIT_R1, &MZ_OPT_HASH_KEY(&((Scheme_Stx *)0x0)->iso));
|
||||
/* In the unlikely case that the compare-and-swap fails, then it's ok to
|
||||
lose the caching of the list bit: */
|
||||
jit_lock_cmpxchgr_s(JIT_R1, JIT_R2); /* implicitly uses JIT_R0 */
|
||||
mz_patch_branch(ref5);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
jit_ori_i(JIT_R2, JIT_R2, PAIR_IS_LIST);
|
||||
jit_stxi_s(&MZ_OPT_HASH_KEY(&((Scheme_Stx *)0x0)->iso), JIT_R1, JIT_R2);
|
||||
}
|
||||
|
||||
__END_SHORT_JUMPS__(1);
|
||||
CHECK_LIMIT();
|
||||
|
|
@ -2274,16 +2276,19 @@ static int common7(mz_jit_state *jitter, void *_data)
|
|||
jit_ldxi_s(JIT_R2, JIT_R1, &MZ_OPT_HASH_KEY(&((Scheme_Stx *)0x0)->iso));
|
||||
#ifdef MZ_USE_FUTURES
|
||||
/* As above: */
|
||||
ref5 = jit_bmsi_i(jit_forward(), JIT_R2, PAIR_IS_NON_LIST);
|
||||
jit_rshi_i(JIT_R0, JIT_R2, 16);
|
||||
jit_ori_i(JIT_R0, JIT_R0, scheme_pair_type);
|
||||
jit_ori_i(JIT_R2, JIT_R0, (PAIR_IS_NON_LIST << 16));
|
||||
jit_lock_cmpxchgr_i(JIT_R1, JIT_R2);
|
||||
mz_patch_branch(ref5);
|
||||
#else
|
||||
jit_ori_i(JIT_R2, JIT_R2, PAIR_IS_NON_LIST);
|
||||
jit_stxi_s(&MZ_OPT_HASH_KEY(&((Scheme_Stx *)0x0)->iso), JIT_R1, JIT_R2);
|
||||
if (scheme_is_multiprocessor(0)) {
|
||||
ref5 = jit_bmsi_i(jit_forward(), JIT_R2, PAIR_IS_NON_LIST);
|
||||
jit_movr_i(JIT_R0, JIT_R2);
|
||||
jit_ori_i(JIT_R2, JIT_R2, PAIR_IS_NON_LIST);
|
||||
jit_addi_p(JIT_R1, JIT_R1, &MZ_OPT_HASH_KEY(&((Scheme_Stx *)0x0)->iso));
|
||||
jit_lock_cmpxchgr_s(JIT_R1, JIT_R2); /* implicitly uses JIT_R0 */
|
||||
mz_patch_branch(ref5);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
jit_ori_i(JIT_R2, JIT_R2, PAIR_IS_NON_LIST);
|
||||
jit_stxi_s(&MZ_OPT_HASH_KEY(&((Scheme_Stx *)0x0)->iso), JIT_R1, JIT_R2);
|
||||
}
|
||||
CHECK_LIMIT();
|
||||
|
||||
__END_SHORT_JUMPS__(1);
|
||||
|
|
|
|||
|
|
@ -457,6 +457,11 @@ typedef _uc jit_insn;
|
|||
#define CMPXCHGLrr(RS,RD) _OO_Mrm (0x0fb1 ,_b11,_r4(RS),_r4(RD) )
|
||||
#define CMPXCHGLrm(RS,MD,MB,MI,MS) _OO_r_X (0x0fb1 ,_r4(RS) ,MD,MB,MI,MS )
|
||||
|
||||
/* Above variants don't seem to work */
|
||||
#define CMPXCHGr(RS, RD) (_jit_B(0xF), _O_r_X(0xb1 ,_r4(RD) ,0,RS,0,0 ))
|
||||
#define CMPXCHGWr(RS, RD) (_d16(), _jit_B(0xF), _O_r_X(0xb1 ,_r4(RD) ,0,RS,0,0 ))
|
||||
|
||||
#define LOCK_PREFIX(i) (_jit_B(0xf0), i)
|
||||
|
||||
#define DECBr(RD) _O_Mrm (0xfe ,_b11,_b001 ,_r1(RD) )
|
||||
#define DECBm(MD,MB,MI,MS) _O_r_X (0xfe ,_b001 ,MD,MB,MI,MS )
|
||||
|
|
@ -709,9 +714,6 @@ typedef _uc jit_insn;
|
|||
|
||||
#define MOVSWQmr(MD, MB, MI, MS, RD) _qOO_r_X (0x0fbf ,_r1(RD) ,MD,MB,MI,MS )
|
||||
|
||||
#define CMPXCHGr(RS, RD) (_jit_B(0xF), _O_r_X(0xb1 ,_r4(RD) ,0,RS,0,0 ))
|
||||
#define LOCK_PREFIX(i) (_jit_B(0xf0), i)
|
||||
|
||||
#define MULBr(RS) _O_Mrm (0xf6 ,_b11,_b100 ,_r1(RS) )
|
||||
#define MULBm(MD,MB,MI,MS) _O_r_X (0xf6 ,_b100 ,MD,MB,MI,MS )
|
||||
|
||||
|
|
|
|||
|
|
@ -687,6 +687,7 @@ static intptr_t _CHECK_TINY(intptr_t diff) { if ((diff < -128) || (diff > 127))
|
|||
#endif
|
||||
|
||||
# define jit_lock_cmpxchgr_i(rd, rs) LOCK_PREFIX(CMPXCHGr(rd, rs))
|
||||
# define jit_lock_cmpxchgr_s(rd, rs) LOCK_PREFIX(CMPXCHGWr(rd, rs))
|
||||
|
||||
/* Extra */
|
||||
#define jit_nop() NOP_()
|
||||
|
|
|
|||
|
|
@ -1109,6 +1109,9 @@ int scheme_is_list(Scheme_Object *obj1)
|
|||
}
|
||||
|
||||
/* Propagate info further up the chain. */
|
||||
/* We could have a race with JIT-generated code, but the worst
|
||||
should be that we lose a flag setting (dangerous in principle,
|
||||
but not in practice). */
|
||||
SCHEME_PAIR_FLAGS(obj2) |= (flags & PAIR_FLAG_MASK);
|
||||
|
||||
return (flags & PAIR_IS_LIST);
|
||||
|
|
|
|||
|
|
@ -25,7 +25,6 @@
|
|||
bindings. */
|
||||
|
||||
#include "schpriv.h"
|
||||
#include "mzrt.h"
|
||||
#include "schmach.h"
|
||||
#include "schexpobs.h"
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,23 @@
|
|||
/*
|
||||
Racket
|
||||
Copyright (c) 2009-2011 PLT Scheme Inc.
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Library General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2 of the License, or (at your option) any later version.
|
||||
|
||||
This library is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
Library General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public
|
||||
License along with this library; if not, write to the Free
|
||||
Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
Boston, MA 02110-1301 USA.
|
||||
*/
|
||||
|
||||
#include "schpriv.h"
|
||||
|
||||
#ifdef MZ_USE_MZRT
|
||||
|
|
@ -5,8 +25,6 @@
|
|||
/************************************************************************/
|
||||
/************************************************************************/
|
||||
/************************************************************************/
|
||||
#define MZRT_INTERNAL
|
||||
#include "mzrt.h"
|
||||
#include "schgc.h"
|
||||
|
||||
THREAD_LOCAL_DECL(mz_proc_thread *proc_thread_self);
|
||||
|
|
|
|||
|
|
@ -85,68 +85,36 @@ int mzrt_sema_destroy(mzrt_sema *sema);
|
|||
|
||||
/****************** Compare and Swap *******************************/
|
||||
|
||||
static MZ_INLINE int mzrt_cas(volatile size_t *addr, size_t old, size_t new_val) {
|
||||
#if defined(__GNUC__) && !defined(__INTEL_COMPILER) && __GNUC__ <= 4 && __GNUC_MINOR__ < 1
|
||||
# if defined(__i386__)
|
||||
char result;
|
||||
__asm__ __volatile__("lock; cmpxchgl %3, %0; setz %1"
|
||||
: "=m"(*addr), "=q"(result)
|
||||
: "m"(*addr), "r" (new_val), "a"(old)
|
||||
: "memory");
|
||||
return (int) result;
|
||||
# elif defined(__x86_64__)
|
||||
char result;
|
||||
__asm__ __volatile__("lock; cmpxchgq %3, %0; setz %1"
|
||||
: "=m"(*addr), "=q"(result)
|
||||
: "m"(*addr), "r" (new_val), "a"(old)
|
||||
: "memory");
|
||||
return (int) result;
|
||||
# elif defined(__POWERPC__) || defined(__powerpc__) || defined(__ppc__) || defined(__PPC__) \
|
||||
|| defined(__powerpc64__) || defined(__ppc64__)
|
||||
size_t oldval;
|
||||
int result = 0;
|
||||
# if defined(__powerpc64__) || defined(__ppc64__) || defined(__64BIT__)
|
||||
# define CAS_I_SIZE "d"
|
||||
# else
|
||||
# define CAS_I_SIZE "w"
|
||||
# endif
|
||||
/* This code is based on Boehm GC's libatomic */
|
||||
__asm__ __volatile__(
|
||||
"1:l" CAS_I_SIZE "arx %0,0,%2\n" /* load and reserve */
|
||||
"cmpw %0, %4\n" /* if load is not equal to */
|
||||
"bne 2f\n" /* old, fail */
|
||||
"st" CAS_I_SIZE "cx. %3,0,%2\n" /* else store conditional */
|
||||
"bne- 1b\n" /* retry if lost reservation */
|
||||
"li %1,1\n" /* result = 1; */
|
||||
"2:\n"
|
||||
: "=&r"(oldval), "=&r"(result)
|
||||
: "r"(addr), "r"(new_val), "r"(old), "1"(result)
|
||||
: "memory", "cc");
|
||||
|
||||
return result;
|
||||
# else
|
||||
# error mzrt_cas not defined on this platform
|
||||
# endif
|
||||
|
||||
#elif defined(__GNUC__) && !defined(__INTEL_COMPILER)
|
||||
return __sync_bool_compare_and_swap(addr, old, new_val);
|
||||
#elif defined(_MSC_VER)
|
||||
# if defined(_AMD64_)
|
||||
return _InterlockedCompareExchange64((LONGLONG volatile *)addr, (LONGLONG)new_val, (LONGLONG)old) == (LONGLONG)old;
|
||||
# elif _M_IX86 >= 400
|
||||
return _InterlockedCompareExchange((LONG volatile *)addr, (LONG)new_val, (LONG)old) == (LONG)old;
|
||||
# endif
|
||||
#define mz_CAS_T uintptr_t
|
||||
#ifdef SIXTY_FOUR_BIT_INTEGERS
|
||||
# define mz_CAS_64
|
||||
#else
|
||||
# error mzrt_cas not defined on this platform
|
||||
# define mz_CAS_32
|
||||
#endif
|
||||
}
|
||||
#define mz_MZRT_CAS mzrt_cas
|
||||
#include "mzrt_cas.inc"
|
||||
#undef mz_CAS_T
|
||||
#ifdef SIXTY_FOUR_BIT_INTEGERS
|
||||
# undef mz_CAS_64
|
||||
#else
|
||||
# undef mz_CAS_32
|
||||
#endif
|
||||
#undef mz_MZRT_CAS
|
||||
|
||||
#define mz_CAS_T short
|
||||
#define mz_CAS_16
|
||||
#define mz_MZRT_CAS mzrt_cas16
|
||||
#include "mzrt_cas.inc"
|
||||
#undef mz_CAS_T
|
||||
#undef mz_CAS_16
|
||||
#undef mz_MZRT_CAS
|
||||
|
||||
static MZ_INLINE void mzrt_ensure_max_cas(uintptr_t *atomic_val, uintptr_t len) {
|
||||
int set = 0;
|
||||
while(!set) {
|
||||
uintptr_t old_val = *atomic_val;
|
||||
if (len > old_val) {
|
||||
set = !mzrt_cas((size_t *)atomic_val, old_val, len);
|
||||
set = !mzrt_cas(atomic_val, old_val, len);
|
||||
}
|
||||
else {
|
||||
set = 1;
|
||||
|
|
|
|||
63
src/racket/src/mzrt_cas.inc
Normal file
63
src/racket/src/mzrt_cas.inc
Normal file
|
|
@ -0,0 +1,63 @@
|
|||
XFORM_NONGCING static MZ_INLINE int mz_MZRT_CAS(volatile mz_CAS_T *addr, mz_CAS_T old, mz_CAS_T new_val)
|
||||
XFORM_SKIP_PROC
|
||||
{
|
||||
#if defined(__GNUC__) && !defined(__INTEL_COMPILER) && ((__GNUC__ <= 3) || (__GNUC__ == 4 && __GNUC_MINOR__ < 1))
|
||||
# if defined(__i386__) || defined(__x86_64__)
|
||||
# ifdef mz_CAS_64
|
||||
# define CAS_I_SIZE "q"
|
||||
# elif defined(mz_CAS_16)
|
||||
# define CAS_I_SIZE ""
|
||||
# elif defined(mz_CAS_32)
|
||||
# define CAS_I_SIZE "l"
|
||||
# endif
|
||||
char result;
|
||||
__asm__ __volatile__("lock; cmpxchg" CAS_I_SIZE " %3, %0; setz %1"
|
||||
: "=m"(*addr), "=q"(result)
|
||||
: "m"(*addr), "r" (new_val), "a"(old)
|
||||
: "memory");
|
||||
return (int) result;
|
||||
# undef CAS_I_SIZE
|
||||
# elif defined(__POWERPC__) || defined(__powerpc__) || defined(__ppc__) || defined(__PPC__) \
|
||||
|| defined(__powerpc64__) || defined(__ppc64__)
|
||||
# ifdef mz_CAS_64
|
||||
# define CAS_I_SIZE "d"
|
||||
# elif defined(mz_CAS_16)
|
||||
# define CAS_I_SIZE "h"
|
||||
# elif defined(mz_CAS_32)
|
||||
# define CAS_I_SIZE "w"
|
||||
# endif
|
||||
mz_CAS_T oldval;
|
||||
int result = 0;
|
||||
/* This code is based on Boehm GC's libatomic */
|
||||
__asm__ __volatile__(
|
||||
"1:l" CAS_I_SIZE "arx %0,0,%2\n" /* load and reserve */
|
||||
"cmp" CAS_I_SIZE " %0, %4\n" /* if load is not equal to */
|
||||
"bne 2f\n" /* old, fail */
|
||||
"st" CAS_I_SIZE "cx. %3,0,%2\n" /* else store conditional */
|
||||
"bne- 1b\n" /* retry if lost reservation */
|
||||
"li %1,1\n" /* result = 1; */
|
||||
"2:\n"
|
||||
: "=&r"(oldval), "=&r"(result)
|
||||
: "r"(addr), "r"(new_val), "r"(old), "1"(result)
|
||||
: "memory", "cc");
|
||||
|
||||
return result;
|
||||
# undef CAS_I_SIZE
|
||||
# else
|
||||
# error mzrt_cas not defined on this platform
|
||||
# endif
|
||||
|
||||
#elif defined(__GNUC__) && !defined(__INTEL_COMPILER)
|
||||
return __sync_bool_compare_and_swap(addr, old, new_val);
|
||||
#elif defined(_MSC_VER)
|
||||
# ifdef mz_CAS_64
|
||||
return _InterlockedCompareExchange64((__int64 *)addr, (__int64)new_val, (__int64)old) == (__int64)old;
|
||||
# elif defined(mz_CAS_16)
|
||||
return _InterlockedCompareExchange16((short *)addr, (short)new_val, (short)old) == (short)old;
|
||||
# else
|
||||
return _InterlockedCompareExchange((long *)addr, (long)new_val, (long)old) == (long)old;
|
||||
# endif
|
||||
#else
|
||||
# error mzrt_cas not defined on this platform
|
||||
#endif
|
||||
}
|
||||
|
|
@ -1,3 +1,23 @@
|
|||
/*
|
||||
Racket
|
||||
Copyright (c) 2009-2011 PLT Scheme Inc.
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Library General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2 of the License, or (at your option) any later version.
|
||||
|
||||
This library is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
Library General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public
|
||||
License along with this library; if not, write to the Free
|
||||
Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
Boston, MA 02110-1301 USA.
|
||||
*/
|
||||
|
||||
#include "schpriv.h"
|
||||
|
||||
static Scheme_Object* scheme_place_enabled(int argc, Scheme_Object *args[]);
|
||||
|
|
@ -7,7 +27,6 @@ THREAD_LOCAL_DECL(int scheme_current_place_id);
|
|||
|
||||
#ifdef MZ_USE_PLACES
|
||||
|
||||
#include "mzrt.h"
|
||||
#ifdef UNIX_PROCESSES
|
||||
# include <unistd.h>
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -292,6 +292,8 @@ void register_network_evts();
|
|||
void scheme_free_dynamic_extensions(void);
|
||||
void scheme_free_all_code(void);
|
||||
|
||||
XFORM_NONGCING int scheme_is_multiprocessor(int now);
|
||||
|
||||
/* Type readers & writers for compiled code data */
|
||||
typedef Scheme_Object *(*Scheme_Type_Reader)(Scheme_Object *list);
|
||||
typedef Scheme_Object *(*Scheme_Type_Writer)(Scheme_Object *obj);
|
||||
|
|
@ -445,7 +447,7 @@ THREAD_LOCAL_DECL(extern Scheme_Thread *scheme_main_thread);
|
|||
#endif
|
||||
|
||||
#ifdef MZ_USE_MZRT
|
||||
#include "mzrt.h"
|
||||
# include "mzrt.h"
|
||||
#endif
|
||||
|
||||
#ifdef MZ_USE_PLACES
|
||||
|
|
|
|||
|
|
@ -29,7 +29,6 @@
|
|||
#endif
|
||||
|
||||
#include "schpriv.h"
|
||||
#include "mzrt.h"
|
||||
#include <string.h>
|
||||
#include <ctype.h>
|
||||
#include "schgc.h"
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user