Menu
▾
▴
clisp-cvs Digest, Vol 38, Issue 2
|
From: <cli...@li...> - 2009-06-06 12:03:31
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/src ChangeLog, 1.6872, 1.6873 spvw_garcol.d, 1.132, 1.133 spvw_genera1.d, 1.41, 1.42 (Vladimir Tzankov) 2. clisp/src ChangeLog, 1.6873, 1.6874 constsym.d, 1.380, 1.381 spvw.d, 1.491, 1.492 subr.d, 1.263, 1.264 subrkw.d, 1.63, 1.64 xthread.d, 1.25, 1.26 zthread.d, 1.46, 1.47 (Vladimir Tzankov) 3. clisp/tests ChangeLog,1.620,1.621 mt.tst,1.5,1.6 (Vladimir Tzankov) ---------------------------------------------------------------------- Message: 1 Date: Fri, 05 Jun 2009 19:29:04 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/src ChangeLog, 1.6872, 1.6873 spvw_garcol.d, 1.132, 1.133 spvw_genera1.d, 1.41, 1.42 To: cli...@li... Message-ID: <E1M...@dd...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv17825/src Modified Files: ChangeLog spvw_garcol.d spvw_genera1.d Log Message: [MULTITHREAD]: do not use MIN()/MAX() macroses Index: spvw_garcol.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw_garcol.d,v retrieving revision 1.132 retrieving revision 1.133 diff -u -d -r1.132 -r1.133 --- spvw_garcol.d 22 May 2009 20:09:42 -0000 1.132 +++ spvw_garcol.d 5 Jun 2009 19:29:02 -0000 1.133 @@ -1409,14 +1409,6 @@ } while (count!=0) #endif -/* on mingw there are no MIN()/MAX() defined */ -#ifndef MAX -#define MAX(a,b) ((a)>(b)?(a):(b)) -#endif -#ifndef MIN -#define MIN(a,b) ((a)<(b)?(a):(b)) -#endif - /* the objects of variable length are moved into the preordained new places. */ #ifdef SPVW_PURE @@ -1509,7 +1501,7 @@ } else { /* else only advance: */ p1 += count; p2 += count; } - fill_end=MAX(fill_end,p2); /* too slow.*/ + fill_end= fill_end > p2 ? fill_end : p2; /* MAX(fill_end,p2); */ } else { p1 = (aint)pointer_was_object(*(gcv_object_t*)p1); /* with pointer (typeinfo=0) to the next marked object */ } Index: spvw_genera1.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw_genera1.d,v retrieving revision 1.41 retrieving revision 1.42 diff -u -d -r1.41 -r1.42 --- spvw_genera1.d 27 Feb 2009 13:24:27 -0000 1.41 +++ spvw_genera1.d 5 Jun 2009 19:29:02 -0000 1.42 @@ -439,7 +439,7 @@ rwarea++; /* advance */ var aint ce=(rwarea-1)->size + (rwarea-1)->start; /* current end */ var aint ne=rwarea->size + rwarea->start; /* next end */ - rwarea->size = MAX(ce,ne) - (rwarea-1)->start; + rwarea->size = (ce>ne?ce:ne)/*MAX(ce,ne)*/ - (rwarea-1)->start; rwarea->start = (rwarea-1)->start; } end = rwarea->start + rwarea->size; Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6872 retrieving revision 1.6873 diff -u -d -r1.6872 -r1.6873 --- ChangeLog 1 Jun 2009 19:44:24 -0000 1.6872 +++ ChangeLog 5 Jun 2009 19:29:02 -0000 1.6873 @@ -1,3 +1,10 @@ +2009-06-05 Vladimir Tzankov <vtz...@gm...> + + [MULTITHREAD]: do not use MIN()/MAX() macroses + * spvw_garcol.d: remove MIN()/MAX() macro definitions + (gc_sweep2_varobject_page): do not use MAX() macro + * spvw_genera1.d (build_old_generation_cache): ditto + 2009-06-01 Vladimir Tzankov <vtz...@gm...> [MULTITHREAD]: fix SIGSEGV on nested interrupts with non-local exit ------------------------------ Message: 2 Date: Fri, 05 Jun 2009 19:54:36 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/src ChangeLog, 1.6873, 1.6874 constsym.d, 1.380, 1.381 spvw.d, 1.491, 1.492 subr.d, 1.263, 1.264 subrkw.d, 1.63, 1.64 xthread.d, 1.25, 1.26 zthread.d, 1.46, 1.47 To: cli...@li... Message-ID: <E1M...@dd...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv21226/src Modified Files: ChangeLog constsym.d spvw.d subr.d subrkw.d xthread.d zthread.d Log Message: [MULTITHREAD]: add timed wait on mutexes and exemptions Index: zthread.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/zthread.d,v retrieving revision 1.46 retrieving revision 1.47 diff -u -d -r1.46 -r1.47 --- zthread.d 1 Jun 2009 19:44:24 -0000 1.46 +++ zthread.d 5 Jun 2009 19:54:34 -0000 1.47 @@ -598,51 +598,63 @@ VALUES1(popSTACK()); } -LISPFUNN(mutex_lock,1) -{ /* (MUTEX-LOCK object) */ - STACK_0 = check_mutex(STACK_0); +LISPFUN(mutex_lock,seclass_default,1,0,norest,key,1, + (kw(timeout))) +{ /* (MUTEX-LOCK mutex [:timeout]) */ + var struct timeval tv; + var struct timeval *tvp = sec_usec(popSTACK(),unbound,&tv); + var gcv_object_t *mxrec = &STACK_0; /* mutex record */ + *mxrec = check_mutex(*mxrec); /* do we already hold the mutex */ - if (eq(TheMutex(STACK_0)->xmu_owner, current_thread()->_lthread)) { - if (!mutex_recursivep(STACK_0)) { + if (eq(TheMutex(*mxrec)->xmu_owner, current_thread()->_lthread)) { + if (!mutex_recursivep(*mxrec)) { /* non-recursive mutex already owned by the current thread. signal error */ - var object mx = STACK_0; + var object mx = *mxrec; pushSTACK(mx); /* CELL-ERROR Slot NAME */ pushSTACK(current_thread()->_lthread); pushSTACK(mx); pushSTACK(S(mutex_lock)); error(control_error,GETTEXT("~S: non-recursive mutex ~S is already owned by thread ~S")); } else { /* just increase the recurse counter */ - TheMutex(STACK_0)->xmu_recurse_count++; + TheMutex(*mxrec)->xmu_recurse_count++; + VALUES1(T); } } else { /* obtain the lock */ var clisp_thread_t *thr = current_thread(); - var gcv_object_t *mxrec = &STACK_0; /* in case of interrupt */ - var xmutex_t *m = TheMutex(STACK_0)->xmu_system; - + var xmutex_t *m = TheMutex(*mxrec)->xmu_system; + var int res = 0; /* following is like GC_SAFE_MUTEX_LOCK() but does not possibly handle the pending interrupts at the end */ thr->_wait_mutex = m; begin_system_call(); GC_SAFE_REGION_BEGIN(); - xmutex_lock(m); + if (!tvp) + res = xmutex_lock(m); + else + res = xmutex_timedlock(m,tvp->tv_sec*1000 + tvp->tv_usec/1000); thr->_wait_mutex = NULL; /* do not (possibly) handle pending interrupts here since on non-local exit from interrupt we may leave the mutex object in inconsistent state*/ GC_SAFE_REGION_END_WITHOUT_INTERRUPTS(); end_system_call(); - TheMutex(*mxrec)->xmu_owner = current_thread()->_lthread; - ASSERT(TheMutex(*mxrec)->xmu_recurse_count == 0); - TheMutex(*mxrec)->xmu_recurse_count++; + if (!res) { /* if we got the mutex */ + TheMutex(*mxrec)->xmu_owner = current_thread()->_lthread; + ASSERT(TheMutex(*mxrec)->xmu_recurse_count == 0); + TheMutex(*mxrec)->xmu_recurse_count++; + } /* now the mutex record is in consistent state - handle pending interrupts (if any) */ HANDLE_PENDING_INTERRUPTS(thr); + /* TODO: here we assume the only error we may get is ETIMEDOUT. + in case of other errors we have to signal an error */ + VALUES1(res ? NIL : T); } - VALUES1(popSTACK()); + skipSTACK(1); } LISPFUNN(mutex_unlock,1) -{ /* (MUTEX-UNLOCK object) */ +{ /* (MUTEX-UNLOCK mutex) */ STACK_0 = check_mutex(STACK_0); /* do we own the mutex ? */ if (!eq(TheMutex(STACK_0)->xmu_owner, current_thread()->_lthread)) { @@ -660,7 +672,8 @@ TheMutex(STACK_0)->xmu_owner = NIL; GC_SAFE_MUTEX_UNLOCK(TheMutex(STACK_0)->xmu_system); } - VALUES1(popSTACK()); + skipSTACK(1); + VALUES0; } LISPFUNN(mutex_recursive_p,1) @@ -700,8 +713,12 @@ VALUES1(popSTACK()); } -LISPFUNN(exemption_wait,2) + +LISPFUN(exemption_wait,seclass_default,2,0,norest,key,1, + (kw(timeout))) { /* (EXEMPTION-WAIT exemption mutex) */ + var struct timeval tv; + var struct timeval *tvp = sec_usec(popSTACK(),unbound,&tv); STACK_0 = check_mutex(STACK_0); STACK_1 = check_exemption(STACK_1); if (!eq(TheMutex(STACK_0)->xmu_owner, current_thread()->_lthread)) { @@ -734,7 +751,10 @@ thr->_wait_condition = c; begin_system_call(); GC_SAFE_REGION_BEGIN(); - res = xcondition_wait(c,m); + if (tvp) + res = xcondition_timedwait(c,m,tvp->tv_sec*1000 + tvp->tv_usec/1000); + else + res = xcondition_wait(c,m); thr->_wait_condition = NULL; /* do not (possibly) handle pending interrupts here since on non-local exit from interrupt we may leave the mutex object in inconsistent state*/ @@ -745,17 +765,17 @@ TheMutex(*mxrec)->xmu_recurse_count = 1; /* handle (if any) interrupts */ HANDLE_PENDING_INTERRUPTS(thr); - skipSTACK(1); - VALUES1(popSTACK()); + skipSTACK(2); + VALUES1(res ? NIL : T); } -#define EXEMPTION_OP_ON_STACK_0(op) \ - do { \ - STACK_0 = check_exemption(STACK_0); \ - begin_system_call(); \ - op(TheExemption(STACK_0)->xco_system); \ - end_system_call(); \ - VALUES1(popSTACK()); \ +#define EXEMPTION_OP_ON_STACK_0(op) \ + do { \ + STACK_0 = check_exemption(STACK_0); \ + begin_system_call(); \ + op(TheExemption(STACK_0)->xco_system); \ + end_system_call(); \ + VALUES1(popSTACK()); \ } while(0) @@ -774,8 +794,6 @@ /* TODO: not the right place to put these stuff. separate file is better ? */ #if defined(POSIX_THREADS) -/* under Linux and OSX getting a signal while in pthread_cond_wait causes - spurious wake-up. so no need for polling */ /* UP: fills timespec with millis milliseconds form "now" <> r: timespec to be filled @@ -787,20 +805,43 @@ r->tv_nsec = 1000 * ((tv.tv_usec + millis*1000) % 1000000); } + +#else /* WIN32_THREADS */ + +/* UP: helper function for waiting on a condition associated with "raw" mutex + > c: condition object + > m: xmutex_raw_t object + > millis: timeout in milliseconds + < returns 0 if the condition was signaled, 1 on timeout */ +local inline int win32_xcondition_wait(xcondition_t *c,xmutex_raw_t *m, + uintL millis) +{ + EnterCriticalSection(&(c)->cs); + (c)->waiting_count++; + LeaveCriticalSection(&(c)->cs); + LeaveCriticalSection(m); + var DWORD timeout = millis == THREAD_WAIT_INFINITE ? INFINITE : millis; + var DWORD r = WaitForSingleObject((c)->sem,timeout); + EnterCriticalSection(m); + return r == WAIT_OBJECT_0 ? 0 : 1; +} + +#endif + /* UP: initializes xlock_t <> l: the lock < Returns 0 on success, oherwise the error code returnd from pthreads */ int xlock_init(xlock_t *l) { var int r; - if (r=pthread_mutex_init(&l->_m,NULL)) return r; - if (r=pthread_mutex_init(&l->_mr,NULL)) { - pthread_mutex_destroy(&l->_m); + if (r=xmutex_raw_init(&l->_m)) return r; + if (r=xmutex_raw_init(&l->_mr)) { + xmutex_raw_destroy(&l->_m); return r; } - if (r=pthread_cond_init(&l->_c,NULL)) { - pthread_mutex_destroy(&l->_m); - pthread_mutex_destroy(&l->_mr); + if (r=xcondition_init(&l->_c)) { + xmutex_raw_destroy(&l->_m); + xmutex_raw_destroy(&l->_mr); return r; } l->_owner = NULL; /* hmmm */ @@ -813,9 +854,9 @@ < returns always 0 (TODO: error checking - but what can it help?) */ int xlock_destroy(xlock_t *l) { - pthread_mutex_destroy(&l->_m); - pthread_mutex_destroy(&l->_mr); - pthread_cond_destroy(&l->_c); + xmutex_raw_destroy(&l->_m); + xmutex_raw_destroy(&l->_mr); + xcondition_destroy(&l->_c); return 0; /* no error checking :( */ } @@ -830,49 +871,55 @@ int xlock_lock_helper(xlock_t *l, uintL timeout,bool lock_real) { var int r = 0; - if (pthread_equal(l->_owner,pthread_self())) { + if (xthread_equal(l->_owner,xthread_self())) { l->_count++; } else { /* we will never wait here (at least not for a long time) */ - pthread_mutex_lock(&l->_m); + xmutex_raw_lock(&l->_m); if (lock_real) { - var struct timespec ww; var clisp_thread_t *thr = current_thread(); + #ifdef POSIX_THREADS + var struct timespec ww; if (timeout != THREAD_WAIT_INFINITE) { get_abs_timeout(&ww,timeout); } + #endif /* while we cannot get the real lock */ - while (r = pthread_mutex_trylock(&l->_mr)) { + while (r = xmutex_raw_trylock(&l->_mr)) { /* check for interrupts before waiting */ - if (current_thread()->_pending_interrupts) { + if (thr->_pending_interrupts) { /* handle them */ - pthread_mutex_unlock(&l->_m); - current_thread()->_wait_mutex=NULL; + xmutex_raw_unlock(&l->_m); + thr->_wait_mutex=NULL; GC_SAFE_REGION_END_WITHOUT_INTERRUPTS(); handle_pending_interrupts(); - current_thread()->_wait_mutex=l; + thr->_wait_mutex=l; GC_SAFE_REGION_BEGIN(); - pthread_mutex_lock(&l->_m); + xmutex_raw_lock(&l->_m); } + #ifdef POSIX_THREADS if (timeout != THREAD_WAIT_INFINITE) { r = pthread_cond_timedwait(&l->_c,&l->_m,&ww); } else { r = pthread_cond_wait(&l->_c,&l->_m); } + #else / WIN32 **/ + r = win32_xcondition_wait(&l->_c,&l->_m,timeout); + #endif if (r != 0) break; } if (r == 0) { ASSERT(l->_owner == NULL); - l->_owner = pthread_self(); + l->_owner = xthread_self(); l->_count=1; } } else { /* if is not real lock - we own the the real mutex + guarding one */ ASSERT(!l->_owner); - l->_owner = pthread_self(); + l->_owner = xthread_self(); l->_count=1; } - pthread_mutex_unlock(&l->_m); + xmutex_raw_unlock(&l->_m); } return r; } @@ -887,15 +934,15 @@ process. */ int xlock_unlock_helper(xlock_t *l, bool unlock_real) { - if (pthread_equal(l->_owner,pthread_self())) { + if (xthread_equal(l->_owner,xthread_self())) { if (!--l->_count) { /* we will never wait here (at least not for a long time) */ - pthread_mutex_lock(&l->_m); + xmutex_raw_lock(&l->_m); if (unlock_real) - pthread_mutex_unlock(&l->_mr); + xmutex_raw_unlock(&l->_mr); l->_owner = NULL; /* hmm */ - pthread_mutex_unlock(&l->_m); /* before signal */ - pthread_cond_signal(&l->_c); + xmutex_raw_unlock(&l->_m); /* before signal */ + xcondition_signal(&l->_c); } return 0; } @@ -915,6 +962,7 @@ /* mutex is owned by us and it is locked just once. our caller assures this */ xlock_unlock_helper(m,false); /* mark as unlocked */ +#ifdef POSIX_THREADS if (timeout != THREAD_WAIT_INFINITE) { var struct timespec ww; get_abs_timeout(&ww,timeout); @@ -922,12 +970,12 @@ } else { r = pthread_cond_wait(c,&m->_m); } +#else /* WIN32 */ + r = win32_xcondition_wait(c,&m->_m,timeout); +#endif /* mark again the mutex as ours */ xlock_lock_helper(m,0,false); return r; } -#endif /* POSIX_THREADS */ - - #endif /* MULTITHREAD */ Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6873 retrieving revision 1.6874 diff -u -d -r1.6873 -r1.6874 --- ChangeLog 5 Jun 2009 19:29:02 -0000 1.6873 +++ ChangeLog 5 Jun 2009 19:54:34 -0000 1.6874 @@ -1,5 +1,27 @@ 2009-06-05 Vladimir Tzankov <vtz...@gm...> + [MULTITHREAD]: add timed wait on mutexes and exemptions + * constsym.d: add :TIMEOUT symbol if SOCKET_STREAMS is not defined + * spvw.d (interrupt_thread) [POSIX_THREADS]: use xmutex_raw_xxxx() + functions instead of pthreads ones. WIN32 will use soon the same + function + (handle_pending_interrupts) [WIN32_THREADS]: add dummy one. not + implemented + * subr.d, subrkw.d: (MUTEX-LOCK, EXEMPTION-WAIT): add :TIMEOUT keyword + parameter + * xthread.d (xlock_t): use it in both - WIN32_THREADS and POSIX_THREADS + (xmutex_raw_trylock): added + * zthread.d (MUTEX-LOCK, EXEMPTION-WAIT): add :TIMEOUT parameter. + Return T on mutex lock/signaled exemption and NIL on timeout + (MUTEX-UNLOCK): do not return any value + (win32_xcondition_wait) [WIN32_THREADS]: implements timed wait on + exemption + (xlock_init, xlock_destroy, xlock_lock_helper, xlock_unlock_helper) + (xcondition_wait_helper): implement the for both WIN32_THREADS and + POSIX_THREADS + +2009-06-05 Vladimir Tzankov <vtz...@gm...> + [MULTITHREAD]: do not use MIN()/MAX() macroses * spvw_garcol.d: remove MIN()/MAX() macro definitions (gc_sweep2_varobject_page): do not use MAX() macro Index: subrkw.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/subrkw.d,v retrieving revision 1.63 retrieving revision 1.64 diff -u -d -r1.63 -r1.64 --- subrkw.d 21 Nov 2008 11:46:06 -0000 1.63 +++ subrkw.d 5 Jun 2009 19:54:34 -0000 1.64 @@ -220,8 +220,12 @@ s(make_thread) v(2, (kw(name),kw(recursive_p))) s(make_mutex) +v(1, (kw(timeout))) +s(mutex_lock) v(1, (kw(name))) s(make_exemption) +v(1, (kw(timeout))) +s(exemption_wait) #endif v(7, (kw(name),kw(code),kw(constants),kw(seclass),kw(lambda_list),kw(documentation),kw(jitc_p)) ) s(make_closure) Index: constsym.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/constsym.d,v retrieving revision 1.380 retrieving revision 1.381 diff -u -d -r1.380 -r1.381 --- constsym.d 24 May 2009 21:30:47 -0000 1.380 +++ constsym.d 5 Jun 2009 19:54:34 -0000 1.381 @@ -1218,6 +1218,11 @@ LISPSYM(Kcstack_size,"CSTACK-SIZE",keyword) LISPSYM(Kvstack_size,"VSTACK-SIZE",keyword) LISPSYM(Krecursive_p,"RECURSIVE-P",keyword) +#ifndef SOCKET_STREAMS +/* socket streams declare :timeout. if for some reason we build without socket + streams and with threads we declare it here.*/ +LISPSYM(Ktimeout,"TIMEOUT",keyword) +#endif LISPSYM(mutex,"MUTEX",mt) /* type for MUTEX */ LISPSYM(mutexp,"MUTEXP",mt) LISPSYM(make_mutex,"MAKE-MUTEX",mt) Index: xthread.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/xthread.d,v retrieving revision 1.25 retrieving revision 1.26 diff -u -d -r1.25 -r1.26 --- xthread.d 20 May 2009 22:28:00 -0000 1.25 +++ xthread.d 5 Jun 2009 19:54:34 -0000 1.26 @@ -97,42 +97,14 @@ #if defined(POSIX_THREADS) -/* The default pthreads mutex is not recursive. This is not a problem however - the Win32 critical section (used for mutex) is recursive and there is no way - to disable this behavior. In order the xmutex_t to be cosistent across - platforms we use recursive POSIX mutexes as well */ - #include <pthread.h> #include <sched.h> -/* this is the mutex that we are going to use */ -typedef struct xlock_t { - /* all lock() op-s will use these two */ - pthread_mutex_t _m; /* guarding the internals - never wait really on it */ - pthread_cond_t _c; /* condition to wait on */ - pthread_mutex_t _mr; /* real mutex */ - pthread_t _owner; /* who owns the lock */ - int _count; /* how many times we own the object */ -} xlock_t; - #define xthread_t pthread_t -#define xcondition_t pthread_cond_t -#define xthread_key_t pthread_key_t +#define xcondition_t pthread_cond_t +#define xthread_key_t pthread_key_t /* raw mutex used for thread suspension/resume */ -#define xmutex_raw_t pthread_mutex_t -/* lisp space mutex */ -#define xmutex_t xlock_t - -/* wait forever timeout */ -#define THREAD_WAIT_INFINITE ((uintL)-1) - -/* global functions for managing xlock_t. implementations and descriptions are - in zthread.d */ -int xlock_init(xlock_t *l); -int xlock_destroy(xlock_t *l); -int xlock_lock_helper(xlock_t *l, uintL timeout, bool lock_real); -int xlock_unlock_helper(xlock_t *l, bool unlock_real); -int xcondition_wait_helper(xcondition_t *c,xlock_t *m, uintL timeout); +#define xmutex_raw_t pthread_mutex_t #define xthread_init() #define xthread_self() pthread_self() @@ -153,26 +125,18 @@ #define xthread_exit(v) pthread_exit(v) #define xthread_yield() sched_yield() #define xthread_equal(t1,t2) pthread_equal(t1,t2) -#define xthread_signal(t,sig) pthread_kill(t,sig) -#define xthread_sigmask(how,iset,oset) pthread_sigmask(how,iset,oset) +#define xthread_signal(t,sig) pthread_kill(t,sig) +#define xthread_sigmask(how,iset,oset) pthread_sigmask(how,iset,oset) #define xcondition_init(c) pthread_cond_init(c,NULL) #define xcondition_destroy(c) pthread_cond_destroy(c) -#define xcondition_wait(c,m) xcondition_wait_helper(c,m,THREAD_WAIT_INFINITE) -#define xcondition_timedwait(c,m,millis) xcondition_wait_helper(c,m,millis) #define xcondition_signal(c) pthread_cond_signal(c) #define xcondition_broadcast(c) pthread_cond_broadcast(c) -#define xmutex_init(m) xlock_init(m) -#define xmutex_destroy(m) xlock_destroy(m) -#define xmutex_lock(m) xlock_lock_helper(m,THREAD_WAIT_INFINITE,true) -#define xmutex_timedlock(m,millis) xlock_lock_helper(m,millis,true) -#define xmutex_trylock(m) xlock_lock_helper(m,0,true) -#define xmutex_unlock(m) xlock_unlock_helper(m,true) - #define xmutex_raw_init(m) pthread_mutex_init(m,NULL) #define xmutex_raw_destroy(m) pthread_mutex_destroy(m) -#define xmutex_raw_lock(m) pthread_mutex_lock(m) +#define xmutex_raw_lock(m) pthread_mutex_lock(m) +#define xmutex_raw_trylock(m) pthread_mutex_trylock(m) #define xmutex_raw_unlock(m) pthread_mutex_unlock(m) #define xthread_key_create(key) pthread_key_create(key,NULL) @@ -185,16 +149,17 @@ #if defined(WIN32_THREADS) /* include <windows.h> -- already included by win32.d */ -#define MAX_SEMAPHORE_COUNT 128 +#define MAX_SEMAPHORE_COUNT 0x7fff #define xthread_t DWORD +/* this is inefficient implementation of condition variables on win32. + TODO: make it better */ typedef struct _xcondition { CRITICAL_SECTION cs; HANDLE sem; int waiting_count; } _xcondition; #define xcondition_t _xcondition -#define xmutex_t CRITICAL_SECTION #define xmutex_raw_t CRITICAL_SECTION #define xthread_key_t DWORD @@ -206,6 +171,10 @@ #define xthread_exit(v) ExitThread((DWORD)(v)) #define xthread_yield() Sleep(0) #define xthread_equal(t1,t2) ((t1)==(t2)) +/* sigmask: nothing to do here - no signals */ +#define xthread_sigmask(how,iset,oset) +#define xthread_signal(c) FIXME /* this should just cancel any pending IO - + not easy on XP but fine on latter */ #define xcondition_init(c) \ (InitializeCriticalSection(&(c)->cs), \ @@ -217,14 +186,8 @@ CloseHandle((c)->sem); \ } while (0) -#define xcondition_wait(c,m) do { \ - EnterCriticalSection(&(c)->cs); \ - (c)->waiting_count++; \ - LeaveCriticalSection(&(c)->cs); \ - LeaveCriticalSection(m); \ - WaitForSingleObject((c)->sem,INFINITE); \ - EnterCriticalSection(m); \ - } while(0) +/* NB: waiting on xcondition_t is implemented in zthread.d */ + #define xcondition_signal(c) do { \ EnterCriticalSection(&(c)->cs); \ if ((c)->waiting_count > 0) { \ @@ -244,16 +207,11 @@ /* critical section functions do not return values and do not set last error */ -#define xmutex_init(m) (InitializeCriticalSection(m),0) -#define xmutex_destroy(m) (DeleteCriticalSection(m),0) -#define xmutex_lock(m) (EnterCriticalSection(m),0) -#define xmutex_trylock(m) (TryEnterCriticalSection(m)!=0) -#define xmutex_unlock(m) (LeaveCriticalSection(m),0) - -#define xmutex_raw_init(m) xmutex_init(m) -#define xmutex_raw_destroy(m) xmutex_destroy(m) -#define xmutex_raw_lock(m) xmutex_lock(m) -#define xmutex_raw_unlock(m) xmutex_unlock(m) +#define xmutex_raw_init(m) (InitializeCriticalSection(m),0) +#define xmutex_raw_destroy(m) (DeleteCriticalSection(m),0) +#define xmutex_raw_lock(m) (EnterCriticalSection(m),0) +#define xmutex_raw_trylock(m) (TryEnterCriticalSection(m)==0) +#define xmutex_raw_unlock(m) (LeaveCriticalSection(m),0) #define xthread_key_create(key) (*(key) = TlsAlloc()) #define xthread_key_delete(key) TlsFree(key) @@ -262,6 +220,43 @@ #endif /* WIN32_THREADS */ +/* this is the mutex that we are going to use */ +typedef struct xlock_t { + /* all lock() op-s will use these two */ + xmutex_raw_t _m; /* guarding the internals - never wait really on it */ + xcondition_t _c; /* condition to wait on */ + xmutex_raw_t _mr; /* real mutex */ + xthread_t _owner; /* who owns the lock */ + int _count; /* how many times we own the object */ +} xlock_t; + +/* infinite wait */ +#define THREAD_WAIT_INFINITE ((uintL)-1) + +/* global functions for managing xlock_t. implementations and descriptions are + in zthread.d */ +int xlock_init(xlock_t *l); +int xlock_destroy(xlock_t *l); +int xlock_lock_helper(xlock_t *l, uintL timeout, bool lock_real); +int xlock_unlock_helper(xlock_t *l, bool unlock_real); +int xcondition_wait_helper(xcondition_t *c,xlock_t *m, uintL timeout); + +/* our lisp space mutex */ +#define xmutex_t xlock_t + +/* xmutex_t opertions*/ +#define xmutex_init(m) xlock_init(m) +#define xmutex_destroy(m) xlock_destroy(m) +#define xmutex_lock(m) xlock_lock_helper(m,THREAD_WAIT_INFINITE,true) +#define xmutex_timedlock(m,millis) xlock_lock_helper(m,millis,true) +#define xmutex_trylock(m) xlock_lock_helper(m,0,true) +#define xmutex_unlock(m) xlock_unlock_helper(m,true) + +/* and some xcondition_t operations */ +#define xcondition_wait(c,m) xcondition_wait_helper(c,m,THREAD_WAIT_INFINITE) +#define xcondition_timedwait(c,m,millis) xcondition_wait_helper(c,m,millis) + + /* ========================================================================== Spin-locks. Index: subr.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/subr.d,v retrieving revision 1.263 retrieving revision 1.264 diff -u -d -r1.263 -r1.264 --- subr.d 2 Apr 2009 18:58:22 -0000 1.263 +++ subr.d 5 Jun 2009 19:54:34 -0000 1.264 @@ -1436,13 +1436,15 @@ LISPFUNN(mutexp,1) LISPFUN(make_mutex,seclass_default,0,0,norest,key,2, (kw(name),kw(recursive_p))) -LISPFUNN(mutex_lock,1) +LISPFUN(mutex_lock,seclass_default,1,0,norest,key,1, + (kw(timeout))) LISPFUNN(mutex_recursive_p,1) LISPFUNN(mutex_owner,1) LISPFUNN(mutex_unlock,1) LISPFUNN(exemptionp,1) LISPFUN(make_exemption,seclass_default,0,0,norest,key,1,(kw(name))) LISPFUNN(exemption_signal,1) -LISPFUNN(exemption_wait,2) +LISPFUN(exemption_wait,seclass_default,2,0,norest,key,1, + (kw(timeout))) LISPFUNN(exemption_broadcast,1) #endif Index: spvw.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw.d,v retrieving revision 1.491 retrieving revision 1.492 diff -u -d -r1.491 -r1.492 --- spvw.d 1 Jun 2009 19:44:24 -0000 1.491 +++ spvw.d 5 Jun 2009 19:54:34 -0000 1.492 @@ -4442,10 +4442,10 @@ /* release the lock - we are not going to send signal really */ spinlock_release(&thr->_signal_reenter_ok); /* waiting on mutex - here the things are more complicated */ - pthread_mutex_lock(&(thr->_wait_mutex->_m)); /* lock the internal mutex */ + xmutex_raw_lock(&(thr->_wait_mutex->_m)); /* lock the internal mutex */ /* wake up all threads on this condition */ xcondition_broadcast(&(thr->_wait_mutex->_c)); - pthread_mutex_unlock(&(thr->_wait_mutex->_m)); + xmutex_raw_unlock(&(thr->_wait_mutex->_m)); } else { /* the thread may wait on it's gc_suspend_lock or in system re-entrant call*/ @@ -4637,6 +4637,11 @@ return NULL; } +global maygc void handle_pending_interrupts() +{ + /* TODO: implement */ +} + #endif /* HAVE_SIGNALS */ #endif ------------------------------ Message: 3 Date: Fri, 05 Jun 2009 19:57:38 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/tests ChangeLog,1.620,1.621 mt.tst,1.5,1.6 To: cli...@li... Message-ID: <E1M...@dd...> Update of /cvsroot/clisp/clisp/tests In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv22554/tests Modified Files: ChangeLog mt.tst Log Message: add tests for timed mutex wait. fix mutex tests that were using MUTEX-LOCK/MUTEX-UNLOCK return value Index: mt.tst =================================================================== RCS file: /cvsroot/clisp/clisp/tests/mt.tst,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- mt.tst 27 Feb 2009 13:56:32 -0000 1.5 +++ mt.tst 5 Jun 2009 19:57:36 -0000 1.6 @@ -12,20 +12,19 @@ ;; non-recursive mutex (mutex-owner (setf m1 (make-mutex :name "m1"))) NIL -(eq (mutex-lock m1) m1) T +(mutex-lock m1) T (mutex-lock m1) ERROR (eq (mutex-owner m1) (current-thread)) T -(eq (mutex-unlock m1) m1) T +(progn (mutex-unlock m1) (mutex-owner m1)) NIL (mutex-unlock m1) ERROR -(mutex-owner m1) NIL ;; recursive mutex (mutex-owner (setf m2 (make-mutex :name "m2" :recursive-p t))) NIL -(eq (mutex-lock m2) m2) T -(eq (mutex-lock m2) m2) T +(mutex-lock m2) T +(mutex-lock m2) T (eq (mutex-owner m2) (current-thread)) T -(eq (mutex-unlock (mutex-unlock m2)) m2) T +(progn (mutex-unlock m2) (mutex-unlock m2) (mutex-owner m2)) NIL (mutex-unlock m2) ERROR -(mutex-owner m2) NIL + (defvar *thread-special* 1) *thread-special* ;; thread-interrupt & mutexes @@ -49,12 +48,15 @@ *thread-special* 2 ;; get global symbol value (symbol-value-thread '*thread-special* nil) 2 -(eq (mutex-owner m1) th) t +(eq (mutex-owner m1) th) T +;; check timed wait on mutex +(mutex-lock m1 :timeout 0.5) NIL +(mutex-lock m1 :timeout 0) NIL ;; check thread-interrupt (thread-active-p (thread-interrupt th #'mutex-unlock m1)) T ;; thread is interrupted - wait for the mutex m1 to be unlocked and grab it -(eq (mutex-owner (mutex-lock m1)) (current-thread)) T -(eq (mutex-unlock m1) m1) T +(mutex-lock m1) T +(progn (mutex-unlock m1) (mutex-owner m1)) NIL (eq (mutex-owner m2) th) T (thread-active-p @@ -79,4 +81,8 @@ (eq (thread-kill (thread-kill (thread-kill th))) th) T (progn (sleep 1) (thread-active-p th)) NIL -(symbol-cleanup '*thread-special*) T \ No newline at end of file +(symbol-cleanup '*thread-special*) T +(symbol-cleanup 'm1) T +(symbol-cleanup 'm2) T +(symbol-cleanup 'th) T +(symbol-cleanup 'th2) T Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v retrieving revision 1.620 retrieving revision 1.621 diff -u -d -r1.620 -r1.621 --- ChangeLog 17 May 2009 05:09:43 -0000 1.620 +++ ChangeLog 5 Jun 2009 19:57:36 -0000 1.621 @@ -1,3 +1,8 @@ +2009-06-05 Vladimir Tzankov <vtz...@gm...> + + * mt.tst: add tests for timed mutex wait. fix mutex tests that + were using MUTEX-LOCK/MUTEX-UNLOCK return value + 2009-05-17 Sam Steingold <sd...@gn...> * strings.tst: add a test for trim-if ------------------------------ ------------------------------------------------------------------------------ OpenSolaris 2009.06 is a cutting edge operating system for enterprises looking to deploy the next generation of Solaris that includes the latest innovations from Sun and the OpenSource community. Download a copy and enjoy capabilities such as Networking, Storage and Virtualization. Go to: http://p.sf.net/sfu/opensolaris-get ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 38, Issue 2 **************************************** |