From 2e0e4b8b95cb41d59d0716c896df3272ee2ebc5c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 28 Feb 2010 17:12:02 +0000 Subject: [PATCH] enable parallel futures under Windows (enabled by default) svn: r18395 --- collects/compiler/private/xform.ss | 2 +- src/mred/mrmain.cxx | 14 +- src/mzscheme/gc2/platforms.h | 1 + src/mzscheme/include/scheme.h | 3 + src/mzscheme/include/schthread.h | 60 +++++++- src/mzscheme/main.c | 8 + src/mzscheme/src/file.c | 23 +-- src/mzscheme/src/future.c | 49 ++++++- src/mzscheme/src/future.h | 48 ------ src/mzscheme/src/jit.c | 2 +- src/mzscheme/src/list.c | 16 +- src/mzscheme/src/mzrt.c | 225 ++++++++++++++++------------- src/mzscheme/src/mzrt.h | 18 +-- src/mzscheme/src/port.c | 6 +- src/mzscheme/src/salloc.c | 47 +++++- src/mzscheme/src/schfd.h | 15 +- src/worksp/gc2/make.ss | 8 +- src/worksp/mzconfig.h | 2 + 18 files changed, 339 insertions(+), 208 deletions(-) diff --git a/collects/compiler/private/xform.ss b/collects/compiler/private/xform.ss index fe8f5f7d39..df4aba601d 100644 --- a/collects/compiler/private/xform.ss +++ b/collects/compiler/private/xform.ss @@ -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 diff --git a/src/mred/mrmain.cxx b/src/mred/mrmain.cxx index 0b4f437157..9f63f174f9 100644 --- a/src/mred/mrmain.cxx +++ b/src/mred/mrmain.cxx @@ -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); } diff --git a/src/mzscheme/gc2/platforms.h b/src/mzscheme/gc2/platforms.h index 86775de409..3e76a6e3ec 100644 --- a/src/mzscheme/gc2/platforms.h +++ b/src/mzscheme/gc2/platforms.h @@ -1,4 +1,5 @@ #ifdef _WIN32 +# include # include # define bzero(m, s) memset(m, 0, s) # define inline _inline diff --git a/src/mzscheme/include/scheme.h b/src/mzscheme/include/scheme.h index 6f4e1a5554..0eb1897e38 100644 --- a/src/mzscheme/include/scheme.h +++ b/src/mzscheme/include/scheme.h @@ -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) diff --git a/src/mzscheme/include/schthread.h b/src/mzscheme/include/schthread.h index b21438887c..ed4de17e31 100644 --- a/src/mzscheme/include/schthread.h +++ b/src/mzscheme/include/schthread.h @@ -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 -#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 diff --git a/src/mzscheme/main.c b/src/mzscheme/main.c index ad0981a494..fbe5024c3f 100644 --- a/src/mzscheme/main.c +++ b/src/mzscheme/main.c @@ -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); diff --git a/src/mzscheme/src/file.c b/src/mzscheme/src/file.c index eb2ad06a5e..366da757bb 100644 --- a/src/mzscheme/src/file.c +++ b/src/mzscheme/src/file.c @@ -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) { diff --git a/src/mzscheme/src/future.c b/src/mzscheme/src/future.c index ff8b692f3f..48ec143797 100644 --- a/src/mzscheme/src/future.c +++ b/src/mzscheme/src/future.c @@ -155,6 +155,43 @@ void scheme_init_futures(Scheme_Env *env) #include #include +#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; diff --git a/src/mzscheme/src/future.h b/src/mzscheme/src/future.h index 3652806522..7e6a9b494f 100644 --- a/src/mzscheme/src/future.h +++ b/src/mzscheme/src/future.h @@ -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); diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index 593a7ee31a..0fd62e38a4 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -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, diff --git a/src/mzscheme/src/list.c b/src/mzscheme/src/list.c index d7ab8d0772..6e5d42ff84 100644 --- a/src/mzscheme/src/list.c +++ b/src/mzscheme/src/list.c @@ -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; } diff --git a/src/mzscheme/src/mzrt.c b/src/mzscheme/src/mzrt.c index a7b9cef979..eb5cc1c6de 100644 --- a/src/mzscheme/src/mzrt.c +++ b/src/mzscheme/src/mzrt.c @@ -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 diff --git a/src/mzscheme/src/mzrt.h b/src/mzscheme/src/mzrt.h index 954d77dc60..0b15c8cd43 100644 --- a/src/mzscheme/src/mzrt.h +++ b/src/mzscheme/src/mzrt.h @@ -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 +# include 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; diff --git a/src/mzscheme/src/port.c b/src/mzscheme/src/port.c index 17395f6f29..fcac020859 100644 --- a/src/mzscheme/src/port.c +++ b/src/mzscheme/src/port.c @@ -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; diff --git a/src/mzscheme/src/salloc.c b/src/mzscheme/src/salloc.c index acfc22b3b1..29911d9d3f 100644 --- a/src/mzscheme/src/salloc.c +++ b/src/mzscheme/src/salloc.c @@ -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 diff --git a/src/mzscheme/src/schfd.h b/src/mzscheme/src/schfd.h index 63638f9724..2172b311a3 100644 --- a/src/mzscheme/src/schfd.h +++ b/src/mzscheme/src/schfd.h @@ -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 */ diff --git a/src/worksp/gc2/make.ss b/src/worksp/gc2/make.ss index a0b450098d..b6623d4aa9 100644 --- a/src/worksp/gc2/make.ss +++ b/src/worksp/gc2/make.ss @@ -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 " "") diff --git a/src/worksp/mzconfig.h b/src/worksp/mzconfig.h index b32b30f50f..46eb42583d 100644 --- a/src/worksp/mzconfig.h +++ b/src/worksp/mzconfig.h @@ -34,5 +34,7 @@ /* whether getaddrinfo works */ #define HAVE_GETADDRINFO 1 +/* Enable futures: */ +#define MZ_USE_FUTURES #endif