suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

enable parallel futures under Windows (enabled by default)

Browse Source 
svn: r18395
This commit is contained in:
Matthew Flatt 2010-02-28 17:12:02 +00:00
parent bf409d7c5d
commit 2e0e4b8b95
18 changed files with 339 additions and 208 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/compiler/private/xform.ss
View File

@ -955,7 +955,7 @@
(define asm-commands
;; When outputting, add newline before these syms
;; (for __asm blocks in Windows)
'(mov shl shld shr shrd sar lock setc))
'(mov shl shld shr shrd sar lock setc add))
(define (get-constructor v)
(cond

14
src/mred/mrmain.cxx
View File

@ -315,6 +315,10 @@ int main(int argc, char *argv[])
static int wm_is_mred;
# ifdef MZ_PRECISE_GC
START_XFORM_SKIP;
# endif
static BOOL CALLBACK CheckWindow(HWND wnd, LPARAM param)
{
int i, len, gl;
@ -629,9 +633,10 @@ int APIENTRY WinMain_dlls_ready(HINSTANCE hInstance, HINSTANCE hPrevInstance, LP
return scheme_main_stack_setup(1, WinMain_after_stack, &wma);
}
# ifdef MZ_PRECISE_GC
START_XFORM_SKIP;
# endif
#ifdef IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS
extern "C" long _tls_index;
static __declspec(thread) void *tls_space;
#endif
int APIENTRY WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR ignored, int nCmdShow)
{
@ -642,6 +647,9 @@ int APIENTRY WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR ignored
load_delayed_dll(NULL, "libmzsch" DLL_3M_SUFFIX "xxxxxxx.dll");
load_delayed_dll(NULL, "libmred" DLL_3M_SUFFIX "xxxxxxx.dll");
record_dll_path();
# ifdef IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS
scheme_register_tls_space(&tls_space, _tls_index);
# endif
return WinMain_dlls_ready(hInstance, hPrevInstance, ignored, nCmdShow);
}

1
src/mzscheme/gc2/platforms.h
View File

@ -1,4 +1,5 @@
#ifdef _WIN32
# include <winsock2.h>
# include <windows.h>
# define bzero(m, s) memset(m, 0, s)
# define inline _inline

3
src/mzscheme/include/scheme.h
View File

@ -1776,6 +1776,9 @@ MZ_EXTERN int scheme_main_stack_setup(int no_auto_statics, Scheme_Nested_Main _m
typedef int (*Scheme_Env_Main)(Scheme_Env *env, int argc, char **argv);
MZ_EXTERN int scheme_main_setup(int no_auto_statics, Scheme_Env_Main _main, int argc, char **argv);
#ifdef IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS
MZ_EXTERN void scheme_register_tls_space(void *tls_space, int _tls_index);
#endif
MZ_EXTERN void scheme_register_static(void *ptr, long size);
#if defined(MUST_REGISTER_GLOBALS) || defined(GC_MIGHT_USE_REGISTERED_STATICS)

60
src/mzscheme/include/schthread.h
View File

@ -19,10 +19,17 @@
#ifndef SCHEME_THREADLOCAL_H
#define SCHEME_THREADLOCAL_H
#include "mzconfig.h"
# ifdef __cplusplus
extern "C" {
# endif
#if defined(MZ_USE_PLACES) || defined(MZ_USE_FUTURES)
# define USE_THREAD_LOCAL
# if _MSC_VER
# define THREAD_LOCAL __declspec(thread)
# define THREAD_LOCAL /* empty */
# define IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS
# elif defined(OS_X) || (defined(linux) && defined(MZ_USES_SHARED_LIB))
# define IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS
# if defined(__x86_64__) || defined(__i386__)
@ -96,10 +103,6 @@ typedef long objhead;
/* **************************************** */
#if MZ_USE_FUTURES
# include <pthread.h>
#endif
typedef struct Thread_Local_Variables {
void **GC_variable_stack_;
struct NewGC *GC_;
@ -152,7 +155,7 @@ typedef struct Thread_Local_Variables {
struct Scheme_Object *scheme_orig_stdout_port_;
struct Scheme_Object *scheme_orig_stderr_port_;
struct Scheme_Object *scheme_orig_stdin_port_;
struct fd_set *scheme_fd_set_;
struct mz_fd_set *scheme_fd_set_;
struct Scheme_Custodian *new_port_cust_;
int external_event_fd_;
int put_external_event_fd_;
@ -327,11 +330,50 @@ END_XFORM_SKIP;
XFORM_GC_VARIABLE_STACK_THROUGH_FUNCTION;
# endif
# endif
#elif defined(IMPLEMENT_THREAD_LOCAL_VIA_PROCEDURE)
/* Using external scheme_get_thread_local_variables() procedure */
MZ_EXTERN Thread_Local_Variables *scheme_get_thread_local_variables();
# ifdef MZ_XFORM
XFORM_GC_VARIABLE_STACK_THROUGH_FUNCTION;
# endif
#elif defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS)
# ifdef MZ_XFORM
START_XFORM_SKIP;
# endif
MZ_EXTERN Thread_Local_Variables *scheme_external_get_thread_local_variables();
# ifdef __mzscheme_private__
/* In the MzScheme DLL, need thread-local to be fast: */
MZ_EXTERN unsigned long scheme_tls_delta;
# ifdef MZ_USE_WIN_TLS_VIA_DLL
MZ_EXTERN int scheme_tls_index;
# endif
static __inline Thread_Local_Variables **scheme_get_thread_local_variables_ptr() {
__asm { mov eax, FS:[0x2C]
# ifdef MZ_USE_WIN_TLS_VIA_DLL
add eax, scheme_tls_index
# endif
mov eax, [eax]
add eax, scheme_tls_delta }
/* result is in eax */
}
static __inline Thread_Local_Variables *scheme_get_thread_local_variables() {
return *scheme_get_thread_local_variables_ptr();
}
# else
/* Outside the MzScheme DLL, slower thread-local is ok: */
static __inline Thread_Local_Variables *scheme_get_thread_local_variables() {
return scheme_external_get_thread_local_variables();
}
# endif
# ifdef MZ_XFORM
END_XFORM_SKIP;
XFORM_GC_VARIABLE_STACK_THROUGH_FUNCTION;
# endif
#else
/* Using `THREAD_LOCAL' variable: */
MZ_EXTERN THREAD_LOCAL Thread_Local_Variables scheme_thread_locals;
# define scheme_get_thread_local_variables() (&scheme_thread_locals)
#ifdef MZ_XFORM
# ifdef MZ_XFORM
XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
# endif
#endif
@ -534,4 +576,8 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
/* **************************************** */
# ifdef __cplusplus
}
# endif
#endif

8
src/mzscheme/main.c
View File

@ -222,6 +222,11 @@ static int main_after_stack(void *data);
START_XFORM_SKIP;
# endif
#ifdef IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS
extern long _tls_index;
static __declspec(thread) void *tls_space;
#endif
int MAIN(int argc, MAIN_char **MAIN_argv)
{
#ifdef DOS_FILE_SYSTEM
@ -231,6 +236,9 @@ int MAIN(int argc, MAIN_char **MAIN_argv)
# endif
load_delayed_dll(NULL, "libmzsch" DLL_3M_SUFFIX "xxxxxxx.dll");
record_dll_path();
# ifdef IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS
scheme_register_tls_space(&tls_space, _tls_index);
# endif
#endif
return main_after_dlls(argc, MAIN_argv);

23
src/mzscheme/src/file.c
View File

@ -2379,29 +2379,30 @@ Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, long fd, char *path)
#endif
#ifdef WINDOWS_FILE_HANDLES
BY_HANDLE_FILE_INFORMATION info;
HANDLE fdh = (HANDLE)fd;
errid = 0;
if (path) {
fd = CreateFileW(WIDE_PATH(path),
0, /* not even read access => just get info */
FILE_SHARE_READ | FILE_SHARE_WRITE,
NULL,
OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS,
NULL);
if (fd == INVALID_HANDLE_VALUE) {
fdh = CreateFileW(WIDE_PATH(path),
0, /* not even read access => just get info */
FILE_SHARE_READ | FILE_SHARE_WRITE,
NULL,
OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS,
NULL);
if (fdh == INVALID_HANDLE_VALUE) {
errid = GetLastError();
}
}
if (fd == INVALID_HANDLE_VALUE) {
if (fdh == INVALID_HANDLE_VALUE) {
/* errid is set */
} else {
if (!GetFileInformationByHandle((HANDLE)fd, &info))
if (!GetFileInformationByHandle(fdh, &info))
errid = GetLastError();
if (path)
CloseHandle(fd);
CloseHandle(fdh);
}
if (!errid) {

49
src/mzscheme/src/future.c
View File

@ -155,6 +155,43 @@ void scheme_init_futures(Scheme_Env *env)
#include <stdlib.h>
#include <string.h>
#ifdef DEBUG_FUTURES
#define DO_LOG(pr) do { pthread_t self; self = pthread_self(); fprintf(stderr, "%x:%s:%s:%d ", (unsigned) self, __FILE__, __FUNCTION__, __LINE__); pr; fprintf(stderr, "\n"); fflush(stdout); } while(0)
#define LOG0(t) DO_LOG(fprintf(stderr, t))
#define LOG(t, a) DO_LOG(fprintf(stderr, t, a))
#define LOG2(t, a, b) DO_LOG(fprintf(stderr, t, a, b))
#define LOG3(t, a, b, c) DO_LOG(fprintf(stderr, t, a, b, c))
#define LOG4(t, a, b, c, d) DO_LOG(fprintf(stderr, t, a, b, c, d))
#define LOG_THISCALL LOG(__FUNCTION__)
#else
#define LOG0(t)
#define LOG(t, a)
#define LOG2(t, a, b)
#define LOG3(t, a, b, c)
#define LOG4(t, a, b, c, d)
#define LOG_THISCALL
#endif
#define LOG_RTCALL_VOID_VOID_3ARGS(f) LOG("(function=%p)", f)
#define LOG_RTCALL_ALLOC(f) LOG("(function=%p)", f)
#define LOG_RTCALL_OBJ_INT_POBJ_OBJ(f,a,b,c) LOG4("(function = %p, a=%p, b=%d, c=%p)", f, a, b, c)
#define LOG_RTCALL_OBJ_INT_POBJ_VOID(a,b,c) LOG3("(%p, %d, %p)", a, b,c)
#define LOG_RTCALL_INT_OBJARR_OBJ(a,b) LOG2("(%d, %p)", a, b)
#define LOG_RTCALL_LONG_OBJ_OBJ(a,b) LOG2("(%ld, %p)", a, b)
#define LOG_RTCALL_OBJ_OBJ(a) LOG("(%p)", a)
#define LOG_RTCALL_OBJ_OBJ_OBJ(a,b) LOG2("(%p, %p)", a, b)
#define LOG_RTCALL_SNCD_OBJ(a) LOG("(%p)", a)
#define LOG_RTCALL_OBJ_VOID(a) LOG("(%p)", a)
#define LOG_RTCALL_LONG_OBJ(a) LOG("(%ld)", a)
#define LOG_RTCALL_BUCKET_OBJ_INT_VOID(a,b,c) LOG3("(%p, %p, %d)", a, b, c)
#define LOG_RTCALL_INT_INT_POBJ_VOID(a,b,c) LOG3("(%d, %d, %p)", a, b, c)
#define LOG_RTCALL_OBJ_OBJ_MZST(a,b) LOG2("(%p, %p)", a, b)
#define LOG_RTCALL_BUCKET_VOID(a) LOG("(%p)", a)
#define LOG_RTCALL_POBJ_LONG_OBJ(a,b) LOG2("(%p, %ld)", a, b)
#define LOG_RTCALL_INT_POBJ_INT_OBJ(a,b,c) LOG3("(%d, %p, %d)", a, b, c)
#define LOG_RTCALL_INT_POBJ_OBJ_OBJ(a,b,c) LOG3("(%d, %p, %p)", a, b, c)
#define LOG_RTCALL_ENV_ENV_VOID(a,b) LOG2("(%p, %p)", a, b)
static Scheme_Object *future(int argc, Scheme_Object *argv[]);
static Scheme_Object *touch(int argc, Scheme_Object *argv[]);
static Scheme_Object *processor_count(int argc, Scheme_Object *argv[]);
@ -451,7 +488,13 @@ void scheme_future_block_until_gc()
*(fs->pool_threads[i]->stack_boundary_pointer) += INITIAL_C_STACK_SIZE;
}
}
#ifdef _MSC_VER
__asm {
mfence
}
#else
asm("mfence");
#endif
mzrt_mutex_lock(fs->future_mutex);
while (fs->gc_not_ok) {
@ -660,9 +703,9 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[])
//Release the lock so other threads can manipulate the queue
//while the runtime call executes
mzrt_mutex_unlock(fs->future_mutex);
LOG("Invoking primitive %p on behalf of future %d...", ft->rt_prim, ft->id);
LOG2("Invoking primitive %p on behalf of future %d...", ft->rt_prim, ft->id);
invoke_rtcall(fs, ft);
LOG("done.\n");
LOG0("done.\n");
}
else
{
@ -778,7 +821,7 @@ void *worker_thread_future_loop(void *arg)
ft = get_pending_future(fs);
if (ft) {
LOG("Got a signal that a future is pending...");
LOG0("Got a signal that a future is pending...");
//Work is available for this thread
ft->status = RUNNING;

48
src/mzscheme/src/future.h
View File

@ -128,54 +128,6 @@ extern unsigned long scheme_rtcall_alloc(const char *who, int src_type);
#endif
#ifdef DEBUG_FUTURES
#define LOG(a...) do { pthread_t self; self = pthread_self(); fprintf(stderr, "%x:%s:%s:%d ", (unsigned) self, __FILE__, __FUNCTION__, __LINE__); fprintf(stderr, a); fprintf(stderr, "\n"); fflush(stdout); } while(0)
#define LOG_THISCALL LOG(__FUNCTION__)
#define LOG_RTCALL_VOID_VOID_3ARGS(f) LOG("(function=%p)", f)
#define LOG_RTCALL_ALLOC(f) LOG("(function=%p)", f)
#define LOG_RTCALL_OBJ_INT_POBJ_OBJ(f,a,b,c) LOG("(function = %p, a=%p, b=%d, c=%p)", f, a, b, c)
#define LOG_RTCALL_OBJ_INT_POBJ_VOID(a,b,c) LOG("(%p, %d, %p)", a, b,c)
#define LOG_RTCALL_INT_OBJARR_OBJ(a,b) LOG("(%d, %p)", a, b)
#define LOG_RTCALL_LONG_OBJ_OBJ(a,b) LOG("(%ld, %p)", a, b)
#define LOG_RTCALL_OBJ_OBJ(a) LOG("(%p)", a)
#define LOG_RTCALL_OBJ_OBJ_OBJ(a,b) LOG("(%p, %p)", a, b)
#define LOG_RTCALL_SNCD_OBJ(a) LOG("(%p)", a)
#define LOG_RTCALL_OBJ_VOID(a) LOG("(%p)", a)
#define LOG_RTCALL_LONG_OBJ(a) LOG("(%ld)", a)
#define LOG_RTCALL_BUCKET_OBJ_INT_VOID(a,b,c) LOG("(%p, %p, %d)", a, b, c)
#define LOG_RTCALL_INT_INT_POBJ_VOID(a,b,c) LOG("(%d, %d, %p)", a, b, c)
#define LOG_RTCALL_OBJ_OBJ_MZST(a,b) LOG("(%p, %p)", a, b)
#define LOG_RTCALL_BUCKET_VOID(a) LOG("(%p)", a)
#define LOG_RTCALL_POBJ_LONG_OBJ(a,b) LOG("(%p, %ld)", a, b)
#define LOG_RTCALL_INT_POBJ_INT_OBJ(a,b,c) LOG("(%d, %p, %d)", a, b, c)
#define LOG_RTCALL_INT_POBJ_OBJ_OBJ(a,b,c) LOG("(%d, %p, %p)", a, b, c)
#define LOG_RTCALL_ENV_ENV_VOID(a,b) LOG("(%p, %p)", a, b)
#else
#define LOG(a...)
#define LOG_THISCALL
#define LOG_RTCALL_VOID_VOID_3ARGS(f)
#define LOG_RTCALL_ALLOC(f)
#define LOG_RTCALL_OBJ_INT_POBJ_OBJ(f,a,b,c)
#define LOG_RTCALL_OBJ_INT_POBJ_VOID(a,b,c)
#define LOG_RTCALL_INT_OBJARR_OBJ(a,b)
#define LOG_RTCALL_LONG_OBJ_OBJ(a,b)
#define LOG_RTCALL_OBJ_OBJ(a)
#define LOG_RTCALL_OBJ_OBJ_OBJ(a,b)
#define LOG_RTCALL_SNCD_OBJ(a)
#define LOG_RTCALL_OBJ_VOID(a)
#define LOG_RTCALL_LONG_OBJ(a)
#define LOG_RTCALL_BUCKET_OBJ_INT_VOID(a,b,c)
#define LOG_RTCALL_INT_INT_POBJ_VOID(a,b,c)
#define LOG_RTCALL_OBJ_OBJ_MZST(a,b)
#define LOG_RTCALL_BUCKET_VOID(a)
#define LOG_RTCALL_POBJ_LONG_OBJ(a,b)
#define LOG_RTCALL_INT_POBJ_INT_OBJ(a,b,c)
#define LOG_RTCALL_INT_POBJ_OBJ_OBJ(a,b,c)
#define LOG_RTCALL_ENV_ENV_VOID(a,b)
#endif
extern void *scheme_on_demand_jit_code;
extern void scheme_on_demand_generate_lambda(Scheme_Native_Closure *nc, int argc, Scheme_Object **argv);

2
src/mzscheme/src/jit.c
View File

@ -12054,7 +12054,7 @@ static void on_demand_with_args(Scheme_Object **in_argv)
static void on_demand()
{
return on_demand_with_args(MZ_RUNSTACK);
on_demand_with_args(MZ_RUNSTACK);
}
static Scheme_Native_Closure_Data *create_native_lambda(Scheme_Closure_Data *data, int clear_code_after_jit,

16
src/mzscheme/src/list.c
View File

@ -1119,32 +1119,32 @@ length_prim (int argc, Scheme_Object *argv[])
}
Scheme_Object *
scheme_append (Scheme_Object *lst1, Scheme_Object *lst2)
scheme_append(Scheme_Object *l1, Scheme_Object *l2)
{
Scheme_Object *first, *last, *orig1, *v;
orig1 = lst1;
orig1 = l1;
first = last = NULL;
while (SCHEME_PAIRP(lst1)) {
v = cons(SCHEME_CAR(lst1), scheme_null);
while (SCHEME_PAIRP(l1)) {
v = cons(SCHEME_CAR(l1), scheme_null);
if (!first)
first = v;
else
SCHEME_CDR(last) = v;
last = v;
lst1 = SCHEME_CDR(lst1);
l1 = SCHEME_CDR(l1);
SCHEME_USE_FUEL(1);
}
if (!SCHEME_NULLP(lst1))
if (!SCHEME_NULLP(l1))
scheme_wrong_type("append", "proper list", -1, 0, &orig1);
if (!last)
return lst2;
return l2;
SCHEME_CDR(last) = lst2;
SCHEME_CDR(last) = l2;
return first;
}

225
src/mzscheme/src/mzrt.c
View File

@ -35,7 +35,7 @@ START_XFORM_SUSPEND;
# endif
#endif
#ifndef MZ_PRECISE_GC
#if !defined(MZ_PRECISE_GC) && !defined(WIN32)
int GC_pthread_join(pthread_t thread, void **retval);
int GC_pthread_create(pthread_t *thread, const pthread_attr_t *attr, void *(*start_routine)(void*), void * arg);
int GC_pthread_detach(pthread_t thread);
@ -84,12 +84,13 @@ static void rungdb() {
#endif
}
#ifndef WIN32
static void segfault_handler(int signal_num) {
pid_t pid = getpid();
fprintf(stderr, "sig# %i pid# %i\n", signal_num, pid);
rungdb();
}
#endif
void mzrt_set_segfault_debug_handler()
{
@ -118,10 +119,6 @@ void mzrt_sleep(int seconds)
#endif
}
#ifdef MZ_XFORM
END_XFORM_SUSPEND;
#endif
/***********************************************************************/
/* Atomic Ops */
/***********************************************************************/
@ -154,14 +151,14 @@ MZ_INLINE uint32_t mzrt_atomic_incr_32(volatile unsigned int *counter) {
/* Threads */
/***********************************************************************/
typedef struct mzrt_thread_stub_data {
void * (*start_proc)(void *);
mz_proc_thread_start start_proc;
void *data;
mz_proc_thread *thread;
} mzrt_thread_stub_data;
void *mzrt_thread_stub(void *data){
mzrt_thread_stub_data *stub_data = (mzrt_thread_stub_data*) data;
void * (*start_proc)(void *) = stub_data->start_proc;
mz_proc_thread_start start_proc = stub_data->start_proc;
void *start_proc_data = stub_data->data;
scheme_init_os_thread();
proc_thread_self = stub_data->thread;
@ -171,9 +168,17 @@ void *mzrt_thread_stub(void *data){
return start_proc(start_proc_data);
}
#ifdef WIN32
DWORD WINAPI mzrt_win_thread_stub(void *data)
{
return (DWORD)mzrt_thread_stub(data);
}
#endif
mzrt_thread_id mz_proc_thread_self() {
#ifdef WIN32
#error !!!mz_proc_thread_id not implemented!!!
return GetCurrentThread();
#else
return pthread_self();
#endif
@ -214,7 +219,7 @@ mz_proc_thread* mz_proc_thread_create_w_stacksize(mz_proc_thread_start start_pro
stub_data->data = data;
stub_data->thread = thread;
# ifdef WIN32
thread->threadid = CreateThread(NULL, stacksize, mzrt_thread_stub, stub_data, 0, NULL);
thread->threadid = CreateThread(NULL, stacksize, mzrt_win_thread_stub, stub_data, 0, NULL);
# else
pthread_create(&thread->threadid, attr, mzrt_thread_stub, stub_data);
# endif
@ -253,8 +258,7 @@ void * mz_proc_thread_wait(mz_proc_thread *thread) {
int mz_proc_thread_detach(mz_proc_thread *thread) {
#ifdef WIN32
DWORD rc;
return (void *) rc;
return CloseHandle(thread->threadid);
#else
int rc;
# ifndef MZ_PRECISE_GC
@ -286,10 +290,6 @@ void mz_proc_thread_exit(void *rc) {
#ifndef WIN32
#ifdef MZ_XFORM
START_XFORM_SUSPEND;
#endif
struct mzrt_rwlock {
pthread_rwlock_t lock;
};
@ -439,74 +439,12 @@ int mzrt_sema_destroy(mzrt_sema *s)
return 0;
}
/****************** PROCESS THREAD MAIL BOX *******************************/
pt_mbox *pt_mbox_create() {
pt_mbox *mbox = (pt_mbox *)malloc(sizeof(pt_mbox));
mbox->count = 0;
mbox->in = 0;
mbox->out = 0;
mzrt_mutex_create(&mbox->mutex);
mzrt_cond_create(&mbox->nonempty);
mzrt_cond_create(&mbox->nonfull);
return mbox;
}
void pt_mbox_send(pt_mbox *mbox, int type, void *payload, pt_mbox *origin) {
mzrt_mutex_lock(mbox->mutex);
while ( mbox->count == 5 ) {
mzrt_cond_wait(mbox->nonfull, mbox->mutex);
}
mbox->queue[mbox->in].type = type;
mbox->queue[mbox->in].payload = payload;
mbox->queue[mbox->in].origin = origin;
mbox->in = (mbox->in + 1) % 5;
mbox->count++;
mzrt_cond_signal(mbox->nonempty);
mzrt_mutex_unlock(mbox->mutex);
}
void pt_mbox_recv(pt_mbox *mbox, int *type, void **payload, pt_mbox **origin){
mzrt_mutex_lock(mbox->mutex);
while ( mbox->count == 0 ) {
mzrt_cond_wait(mbox->nonempty, mbox->mutex);
}
*type = mbox->queue[mbox->out].type;
*payload = mbox->queue[mbox->out].payload;
*origin = mbox->queue[mbox->out].origin;
mbox->out = (mbox->out + 1) % 5;
mbox->count--;
mzrt_cond_signal(mbox->nonfull);
mzrt_mutex_unlock(mbox->mutex);
}
void pt_mbox_send_recv(pt_mbox *mbox, int type, void *payload, pt_mbox *origin, int *return_type, void **return_payload) {
pt_mbox *return_origin;
pt_mbox_send(mbox, type, payload, origin);
pt_mbox_recv(origin, return_type, return_payload, &return_origin);
}
void pt_mbox_destroy(pt_mbox *mbox) {
mzrt_mutex_destroy(mbox->mutex);
mzrt_cond_destroy(mbox->nonempty);
mzrt_cond_destroy(mbox->nonfull);
free(mbox);
}
#ifdef MZ_XFORM
END_XFORM_SUSPEND;
#endif
#endif
/* Windows **************************************************************/
#ifdef WIN32
#ifdef MZ_XFORM
START_XFORM_SUSPEND;
#endif
typedef struct mzrt_rwlock {
HANDLE readEvent;
HANDLE writeMutex;
@ -617,63 +555,154 @@ int mzrt_mutex_create(mzrt_mutex **mutex) {
}
int mzrt_mutex_lock(mzrt_mutex *mutex) {
EnterCriticalSection(&(*mutex)->critical_section);
EnterCriticalSection(&mutex->critical_section);
return 0;
}
int mzrt_mutex_trylock(mzrt_mutex *mutex) {
if (!TryEnterCriticalSection(&(*mutex)->critical_section))
return 1;
/* FIXME: TryEnterCriticalSection() requires NT:
if (!TryEnterCriticalSection(&mutex->critical_section))
return 1; */
return 0;
}
int mzrt_mutex_unlock(mzrt_mutex *mutex) {
LeaveCriticalSection(&(*mutex)->critical_section);
LeaveCriticalSection(&mutex->critical_section);
return 0;
}
int mzrt_mutex_destroy(mzrt_mutex *mutex) {
DeleteCriticalSection(&(*mutex)->critical_section);
DeleteCriticalSection(&mutex->critical_section);
return 0;
}
struct mzrt_cond {
pthread_cond_t cond;
int nothing;
};
int mzrt_cond_create(mzrt_cond **cond) {
*cond = malloc(sizeof(mzrt_cond));
return pthread_cond_init(&(*cond)->cond, NULL);
return 0;
}
int mzrt_cond_wait(mzrt_cond *cond, mzrt_mutex *mutex) {
return pthread_cond_wait(&cond->cond, &mutex->mutex);
return 0;
}
int mzrt_cond_timedwait(mzrt_cond *cond, mzrt_mutex *mutex) {
return pthread_cond_timedwait(&cond->cond, &mutex->mutex);
int mzrt_cond_timedwait(mzrt_cond *cond, mzrt_mutex *mutex, long secs, long nsecs) {
return 0;
}
int mzrt_cond_signal(mzrt_cond *cond) {
return pthread_cond_signal(&cond->cond);
return 0;
}
int mzrt_cond_broadcast(mzrt_cond *cond) {
return pthread_cond_broadcast(&cond->cond);
return 0;
}
int mzrt_cond_destroy(mzrt_cond *cond) {
return pthread_cond_destroy(&cond->cond);
return 0;
}
struct mzrt_sema {
HANDLE ws;
};
int mzrt_sema_create(mzrt_sema **_s, int v)
{
mzrt_sema *s;
HANDLE ws;
s = (mzrt_sema *)malloc(sizeof(mzrt_sema));
ws = CreateSemaphore(NULL, v, 32000, NULL);
s->ws = ws;
*_s = s;
return 0;
}
int mzrt_sema_wait(mzrt_sema *s)
{
WaitForSingleObject(s->ws, INFINITE);
return 0;
}
int mzrt_sema_post(mzrt_sema *s)
{
ReleaseSemaphore(s->ws, 1, NULL);
return 0;
}
int mzrt_sema_destroy(mzrt_sema *s)
{
CloseHandle(s->ws);
free(s);
return 0;
}
#endif
/****************** PROCESS THREAD MAIL BOX *******************************/
pt_mbox *pt_mbox_create() {
pt_mbox *mbox = (pt_mbox *)malloc(sizeof(pt_mbox));
mbox->count = 0;
mbox->in = 0;
mbox->out = 0;
mzrt_mutex_create(&mbox->mutex);
mzrt_cond_create(&mbox->nonempty);
mzrt_cond_create(&mbox->nonfull);
return mbox;
}
void pt_mbox_send(pt_mbox *mbox, int type, void *payload, pt_mbox *origin) {
mzrt_mutex_lock(mbox->mutex);
while ( mbox->count == 5 ) {
mzrt_cond_wait(mbox->nonfull, mbox->mutex);
}
mbox->queue[mbox->in].type = type;
mbox->queue[mbox->in].payload = payload;
mbox->queue[mbox->in].origin = origin;
mbox->in = (mbox->in + 1) % 5;
mbox->count++;
mzrt_cond_signal(mbox->nonempty);
mzrt_mutex_unlock(mbox->mutex);
}
void pt_mbox_recv(pt_mbox *mbox, int *type, void **payload, pt_mbox **origin){
mzrt_mutex_lock(mbox->mutex);
while ( mbox->count == 0 ) {
mzrt_cond_wait(mbox->nonempty, mbox->mutex);
}
*type = mbox->queue[mbox->out].type;
*payload = mbox->queue[mbox->out].payload;
*origin = mbox->queue[mbox->out].origin;
mbox->out = (mbox->out + 1) % 5;
mbox->count--;
mzrt_cond_signal(mbox->nonfull);
mzrt_mutex_unlock(mbox->mutex);
}
void pt_mbox_send_recv(pt_mbox *mbox, int type, void *payload, pt_mbox *origin, int *return_type, void **return_payload) {
pt_mbox *return_origin;
pt_mbox_send(mbox, type, payload, origin);
pt_mbox_recv(origin, return_type, return_payload, &return_origin);
}
void pt_mbox_destroy(pt_mbox *mbox) {
mzrt_mutex_destroy(mbox->mutex);
mzrt_cond_destroy(mbox->nonempty);
mzrt_cond_destroy(mbox->nonfull);
free(mbox);
}
/************************************************************************/
/************************************************************************/
/************************************************************************/
#ifdef MZ_XFORM
END_XFORM_SUSPEND;
#endif
#endif
/************************************************************************/
/************************************************************************/
/************************************************************************/
#endif

18
src/mzscheme/src/mzrt.h
View File

@ -23,7 +23,9 @@ void mzrt_set_user_break_handler(void (*user_break_handler)(int));
/****************** PROCESS WEIGHT THREADS ********************************/
#ifdef WIN32
#if (defined(__WIN32__) || defined(WIN32) || defined(_WIN32))
# include <winsock2.h>
# include <windows.h>
typedef HANDLE mzrt_thread_id;
#else
typedef pthread_t mzrt_thread_id;
@ -36,15 +38,11 @@ typedef struct mz_proc_thread {
} mz_proc_thread;
#ifdef WIN32
typedef DWORD (WINAPI *mz_proc_thread_start)(void*);
#else
typedef void *(mz_proc_thread_start)(void*);
#endif
typedef void *(*mz_proc_thread_start)(void*);
mz_proc_thread* mzrt_proc_first_thread_init();
mz_proc_thread* mz_proc_thread_create(mz_proc_thread_start*, void* data);
mz_proc_thread* mz_proc_thread_create_w_stacksize(mz_proc_thread_start*, void* data, long stacksize);
mz_proc_thread* mz_proc_thread_create(mz_proc_thread_start, void* data);
mz_proc_thread* mz_proc_thread_create_w_stacksize(mz_proc_thread_start, void* data, long stacksize);
void *mz_proc_thread_wait(mz_proc_thread *thread);
int mz_proc_thread_detach(mz_proc_thread *thread);
void mz_proc_thread_exit(void *rc);
@ -112,7 +110,7 @@ void pt_mbox_recv(pt_mbox *mbox, int *type, void **payload, pt_mbox **origin);
void pt_mbox_send_recv(pt_mbox *mbox, int type, void *payload, pt_mbox *origin, int *return_type, void **return_payload);
void pt_mbox_destroy(pt_mbox *mbox);
static inline int mzrt_cas(volatile size_t *addr, size_t old, size_t new_val) {
static MZ_INLINE int mzrt_cas(volatile size_t *addr, size_t old, size_t new_val) {
#if defined(__GNUC__) && !defined(__INTEL_COMPILER)
# if defined(__i386__)
char result;
@ -181,7 +179,7 @@ static inline int mzrt_cas(volatile size_t *addr, size_t old, size_t new_val) {
#endif
}
static inline void mzrt_ensure_max_cas(unsigned long *atomic_val, unsigned long len) {
static MZ_INLINE void mzrt_ensure_max_cas(unsigned long *atomic_val, unsigned long len) {
int set = 0;
while(!set) {
unsigned long old_val = *atomic_val;

6
src/mzscheme/src/port.c
View File

@ -304,7 +304,7 @@ THREAD_LOCAL_DECL(Scheme_Object *scheme_orig_stdout_port);
THREAD_LOCAL_DECL(Scheme_Object *scheme_orig_stderr_port);
THREAD_LOCAL_DECL(Scheme_Object *scheme_orig_stdin_port);
THREAD_LOCAL_DECL(fd_set *scheme_fd_set);
THREAD_LOCAL_DECL(struct mz_fd_set *scheme_fd_set);
HOOK_SHARED_OK Scheme_Object *(*scheme_make_stdin)(void) = NULL;
HOOK_SHARED_OK Scheme_Object *(*scheme_make_stdout)(void) = NULL;
@ -680,7 +680,7 @@ Scheme_Object * scheme_make_eof (void)
void scheme_alloc_global_fdset() {
#ifdef USE_FAR_MZ_FDCALLS
REGISTER_SO(scheme_fd_set);
scheme_fd_set = scheme_alloc_fdset_array(3, 0);
scheme_fd_set = (struct mz_fd_set *)scheme_alloc_fdset_array(3, 0);
#endif
}
@ -8440,6 +8440,8 @@ static long ITimer(void)
{
WaitForSingleObject(itimer_semaphore, INFINITE);
scheme_init_os_thread();
while (1) {
if (WaitForSingleObject(itimer_semaphore, itimer_delay / 1000) == WAIT_TIMEOUT) {
scheme_fuel_counter = 0;

47
src/mzscheme/src/salloc.c
View File

@ -55,8 +55,13 @@ THREAD_LOCAL_DECL(static int *dgc_count);
THREAD_LOCAL_DECL(static int dgc_size);
#ifdef USE_THREAD_LOCAL
# ifdef IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS
# if defined(IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS)
pthread_key_t scheme_thread_local_key;
# elif defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS)
unsigned long scheme_tls_delta;
int scheme_tls_index;
# elif defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS_FUNC)
DWORD scheme_thread_local_key;
# else
SHARED_OK THREAD_LOCAL Thread_Local_Variables scheme_thread_locals;
# endif
@ -199,13 +204,15 @@ static int do_main_stack_setup(int no_auto_statics, Scheme_Nested_Main _main, vo
#if defined(IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS)
/* This allows for places gc unit tests to switch the Thread_Local_Variables and simulate places */
void scheme_set_thread_local_variables(Thread_Local_Variables *tlvs) {
void scheme_set_thread_local_variables(Thread_Local_Variables *tlvs) XFORM_SKIP_PROC
{
pthread_setspecific(scheme_thread_local_key, tlvs);
}
#endif
#if defined(IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS) && defined(INLINE_GETSPECIFIC_ASSEMBLY_CODE)
static void macosx_get_thread_local_key_for_assembly_code() {
static void macosx_get_thread_local_key_for_assembly_code() XFORM_SKIP_PROC
{
/* Our [highly questionable] strategy for inlining pthread_getspecific() is taken from
the Go implementation (see "http://golang.org/src/libcgo/darwin_386.c").
In brief, we assume that thread-local variables are going to be
@ -243,7 +250,20 @@ static void macosx_get_thread_local_key_for_assembly_code() {
}
#endif
void scheme_setup_thread_local_key_if_needed() {
#ifdef IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS
void scheme_register_tls_space(void *tls_space, int tls_index) XFORM_SKIP_PROC
{
scheme_tls_delta = (unsigned long)tls_space;
scheme_tls_index = tls_index;
}
Thread_Local_Variables *scheme_external_get_thread_local_variables() XFORM_SKIP_PROC
{
return scheme_get_thread_local_variables();
}
#endif
void scheme_setup_thread_local_key_if_needed() XFORM_SKIP_PROC
{
#ifdef IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS
# ifdef INLINE_GETSPECIFIC_ASSEMBLY_CODE
# if defined(linux)
@ -273,6 +293,17 @@ void scheme_setup_thread_local_key_if_needed() {
}
# endif
#endif
#ifdef IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS
{
void **base;
__asm { mov ecx, FS:[0x2C]
mov base, ecx }
scheme_tls_delta -= (unsigned long)base[scheme_tls_index];
scheme_tls_index *= sizeof(void*);
}
#endif
}
int scheme_main_stack_setup(int no_auto_statics, Scheme_Nested_Main _main, void *data) XFORM_SKIP_PROC
@ -336,11 +367,17 @@ void* scheme_dbg_get_thread_local_variables() XFORM_SKIP_PROC {
void scheme_init_os_thread() XFORM_SKIP_PROC
{
#ifdef IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS
#if defined(IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS) || defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS)
Thread_Local_Variables *vars;
vars = (Thread_Local_Variables *)malloc(sizeof(Thread_Local_Variables));
memset(vars, 0, sizeof(Thread_Local_Variables));
# ifdef IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS
pthread_setspecific(scheme_thread_local_key, vars);
# elif defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS)
*scheme_get_thread_local_variables_ptr() = vars;
# else
TlsSetValue(scheme_thread_local_key, vars);
# endif
#endif
#ifdef OS_X
# ifdef MZ_PRECISE_GC

15
src/mzscheme/src/schfd.h
View File

@ -1,15 +1,16 @@
#ifdef USE_FAR_MZ_FDCALLS
THREAD_LOCAL_DECL(extern fd_set *scheme_fd_set);
struct mz_fd_set { fd_set fd; };
THREAD_LOCAL_DECL(extern struct mz_fd_set *scheme_fd_set);
# define DECL_FDSET(n, c) fd_set *n
# define INIT_DECL_FDSET(r, w, e) { \
r = MZ_GET_FDSET(scheme_fd_set, 0 ); \
w = MZ_GET_FDSET(scheme_fd_set, 1 ); \
e = MZ_GET_FDSET(scheme_fd_set, 2 ); \
r = MZ_GET_FDSET(&scheme_fd_set->fd, 0 ); \
w = MZ_GET_FDSET(&scheme_fd_set->fd, 1 ); \
e = MZ_GET_FDSET(&scheme_fd_set->fd, 2 ); \
}
# define INIT_DECL_RD_FDSET(r) r = MZ_GET_FDSET(scheme_fd_set, 0 )
# define INIT_DECL_WR_FDSET(r) r = MZ_GET_FDSET(scheme_fd_set, 1 )
# define INIT_DECL_ER_FDSET(r) r = MZ_GET_FDSET(scheme_fd_set, 2 )
# define INIT_DECL_RD_FDSET(r) r = MZ_GET_FDSET(&scheme_fd_set->fd, 0 )
# define INIT_DECL_WR_FDSET(r) r = MZ_GET_FDSET(&scheme_fd_set->fd, 1 )
# define INIT_DECL_ER_FDSET(r) r = MZ_GET_FDSET(&scheme_fd_set->fd, 2 )
#else
# define DECL_FDSET(n, c) fd_set n[c]
# define INIT_DECL_FDSET(r, w, e) /* empty */

8
src/worksp/gc2/make.ss
View File

@ -208,12 +208,14 @@
(c-compile "../../mzscheme/gc2/gc2.c" "xsrc/gc2.obj"
(append
(list "../mzconfig.h")
(map (lambda (f) (build-path "../../mzscheme/" f))
'("include/scheme.h"
"include/schthread.h"
"src/schpriv.h"
"src/stypes.h"))
(map (lambda (f) (build-path "../../mzscheme/gc2/" f))
'("gc2.c"
"compact.c"
"newgc.c"
"vm_win.c"
"sighand.c"
@ -222,9 +224,7 @@
"gc2_obj.h")))
(string-append
"/D GC2_AS_EXPORT "
(if accounting-gc?
"/D NEWGC_BTC_ACCOUNT "
"/D USE_COMPACT_3M_GC ")
"/D NEWGC_BTC_ACCOUNT "
(if backtrace-gc?
"/D MZ_GC_BACKTRACE "
"")

2
src/worksp/mzconfig.h
View File

@ -34,5 +34,7 @@
/* whether getaddrinfo works */
#define HAVE_GETADDRINFO 1
/* Enable futures: */
#define MZ_USE_FUTURES
#endif