Menu
▾
▴
clisp-cvs Digest, Vol 38, Issue 3
|
From: <cli...@li...> - 2009-06-07 12:03:38
|
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.6874, 1.6875 lispbibl.d, 1.871, 1.872 spvw.d, 1.492, 1.493 xthread.d, 1.26, 1.27 zthread.d, 1.47, 1.48 (Vladimir Tzankov) 2. clisp/tests ChangeLog,1.621,1.622 mt.tst,1.6,1.7 (Vladimir Tzankov) ---------------------------------------------------------------------- Message: 1 Date: Sat, 06 Jun 2009 22:21:50 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/src ChangeLog, 1.6874, 1.6875 lispbibl.d, 1.871, 1.872 spvw.d, 1.492, 1.493 xthread.d, 1.26, 1.27 zthread.d, 1.47, 1.48 To: cli...@li... Message-ID: <E1M...@dd...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv11737/src Modified Files: ChangeLog lispbibl.d spvw.d xthread.d zthread.d Log Message: [MULTITHREAD]: add partial support for thread interruption on WIN32 Index: spvw.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw.d,v retrieving revision 1.492 retrieving revision 1.493 diff -u -d -r1.492 -r1.493 --- spvw.d 5 Jun 2009 19:54:34 -0000 1.492 +++ spvw.d 6 Jun 2009 22:21:48 -0000 1.493 @@ -304,6 +304,7 @@ #else /* forward decalration of MT signal handler */ +local void install_async_signal_handlers(); local void *signal_handler_thread(void *arg); /* Mutex protecting the set of threads. */ @@ -318,7 +319,7 @@ #define MAXNTHREADS 128 local uintC nthreads = 0; local clisp_thread_t* allthreads[MAXNTHREADS]; -global xthread_t thr_signal_handler; /* the id of the signal handling thread */ +local xthread_t thr_signal_handler; /* the id of the signal handling thread */ /* the first index in _ptr_symvalues used for per thread symbol bindings */ #define FIRST_SYMVALUE_INDEX 1 @@ -3864,11 +3865,8 @@ #else #ifdef HAVE_SIGNALS install_sigcld_handler(); - install_async_signal_handlers(); - #endif - #ifdef WIN32_NATIVE - #warning "thread-interrupt and "signal" handlers for WIN32_THREADS are still not implemented." #endif + install_async_signal_handlers(); #endif #if defined(GENERATIONAL_GC) /* insatll Page-Fault-Handler: */ @@ -4341,6 +4339,11 @@ WIN32_THREADS*/ #ifdef HAVE_SIGNALS +/* SIGUSR1 is used for thread interrupt */ +#define SIG_THREAD_INTERRUPT SIGUSR1 +/* SIGUSR2 WILL BE used for CALL-WITH-TIMEOUT */ +#define SIG_TIMEOUT_CALL SIGUSR2 + /* UP: creates mask of signals that we do not want to be delivered directly to threads. The same signals are handled by special non lisp thread */ @@ -4377,6 +4380,36 @@ return sigblock_mask; } +/* UP: waits for a signal and returns it + < returns signal number */ +local int signal_wait() +{ + var int sig; + var sigset_t sig_mask=async_signal_mask(); + while (sigwait(&sig_mask, &sig)) { + /* strange - no way to have bad mask but it happens sometimes + (observed on 32 bit debian during (disaseemble 'car) and + CTRL-Z and "fg" later) */ + } + return sig; +} + +/* UP: signals that new CALL-WITH-TIMEOUT has been issued + and it is the first to expire + < returns 0 on success */ +global int signal_timeout_call() +{ + return xthread_signal(thr_signal_handler,SIG_TIMEOUT_CALL); +} + +/* UP: schedules the next SIGALRM - for the timeout call that is in the + beginning of timeout_call_chain. Called from signal handler thread. + > useconds: duration after which we want SIGARLM */ +local useconds_t schedule_alarm(uintL useconds) +{ + return ualarm(useconds,0); +} + /* UP: SIG_THREAD_INTERRUPT handler > sig: always equals to SIG_THREAD_INTERRUPT */ local void interrupt_thread_signal_handler (int sig) { @@ -4399,6 +4432,100 @@ GC_SAFE_REGION_BEGIN(); /* restore GC safe region */ } } + +local void install_async_signal_handlers() +{ + /* 1. disable all async signals + 2. install SIG_THREAD_INTERRUPT handler */ + var sigset_t sigblock_mask=async_signal_mask(); + /* since we are called from the main thread - all threads + in the process will inherit this mask !!*/ + sigprocmask(SIG_BLOCK,&sigblock_mask,NULL); + /* install SIG_THREAD_INTERRUPT */ + SIGNAL(SIG_THREAD_INTERRUPT,&interrupt_thread_signal_handler); +} + +#else /* WIN32_THREADS */ + +/* define missing signals IDs - since we use the same + signal handler code fot both POSIX and WIN32*/ +#define SIGALRM 1 +#define SIGINT 2 +#define SIG_TIMEOUT_CALL 3 +#define SIGBREAK 4 + +local DWORD wait_timeout=INFINITE; +local HANDLE sigint_semaphore, sigbreak_event; +local HANDLE timeout_call_semaphore; + +/* UP: ConsoleCtrlHandler for Win32 */ +local BOOL WINAPI console_handler(DWORD CtrlType) +{ + if (CtrlType == CTRL_C_EVENT || CtrlType == CTRL_BREAK_EVENT) { + /* Send an event to the sigint_thread. */ + if (CtrlType == CTRL_C_EVENT) + ReleaseSemaphore(sigint_semaphore,2,NULL); + else if (CtrlType == CTRL_BREAK_EVENT) + SetEvent(sigbreak_event); + /* Don't invoke the other handlers */ + return TRUE; + } else /* Do invoke the other handlers. */ + return FALSE; +} + +/* UP: installs "async" signal handler on Win32 */ +local void install_async_signal_handlers() +{ + wait_timeout=INFINITE; + sigint_semaphore=CreateSemaphore(NULL,0,MAXNTHREADS,NULL); + sigbreak_event=CreateEvent(NULL,TRUE,FALSE,NULL); + timeout_call_semaphore=CreateSemaphore(NULL,0,MAXNTHREADS,NULL); + SetConsoleCtrlHandler((PHANDLER_ROUTINE)console_handler,true); +} + +/* UP: waits for a signal and returns it + < returns signal number */ +local int signal_wait() +{ + var HANDLE sems[]={sigint_semaphore, timeout_call_semaphore, sigbreak_event}; + retry: + /* TODO: have to update the wait_timeout !!! */ + wait_timeout = INFINITE; + switch (WaitForMultipleObjects(3,sems,FALSE,wait_timeout)) { + case WAIT_OBJECT_0: + return SIGINT; + case WAIT_TIMEOUT: + case WAIT_OBJECT_0 + 1: + wait_timeout=INFINITE; /* in any case */ + return SIG_TIMEOUT_CALL; + case WAIT_OBJECT_0 + 2: + return SIGBREAK; + default: + /* hmm, not good ?? */ + goto retry; + } +} +/* UP: signals that new CALL-WITH-TIMEOUT has been issued + and it is the first to expire + < returns 0 on success. */ +global int signal_timeout_call() +{ + ReleaseSemaphore(timeout_call_semaphore,1,NULL); + return 0; +} + +/* UP: schedules the next SIGALRM - for the timeout call that is in the + beginning of timeout_call_chain. Called from signal handler thread. + > useconds: duration after which we want SIGARLM + should be called only from signal_handler_thread() */ +local useconds_t schedule_alarm(uintL useconds) +{ + wait_timeout = useconds / 1000; /* in milliseconds */ + return 0; +} + +#endif + /* UP: handles any pending interrupt (currently just one). arguments are on the STACK It is always called in the context of the thread that has to handle the @@ -4447,6 +4574,7 @@ xcondition_broadcast(&(thr->_wait_mutex->_c)); xmutex_raw_unlock(&(thr->_wait_mutex->_m)); } else { + #ifdef POSIX_THREADS /* the thread may wait on it's gc_suspend_lock or in system re-entrant call*/ if (xthread_signal(TheThread(thr->_lthread)->xth_system, @@ -4455,6 +4583,12 @@ spinlock_release(&thr->_signal_reenter_ok); return false; } + #else /* WIN32_THREADS */ + /* TODO: implement it. for now - very trivial - wait for the end of the + blocked called */ + /* in all cases - release the re-enter spinlock */ + spinlock_release(&thr->_signal_reenter_ok); + #endif } return true; } @@ -4469,15 +4603,8 @@ > arg: not used. */ local void *signal_handler_thread(void *arg) { - int sig; - var sigset_t sig_mask=async_signal_mask(); while (1) { - if (sigwait(&sig_mask, &sig)) { - /* strange - no way to have bad mask but it happens sometimes - (observed on 32 bit debian during (disaseemble 'car) and - CTRL-Z and "fg" later) */ - continue; - } + var int sig = signal_wait(); /* before proceeding we have to be sure that there is no GC in progress at the moment. This is the only situation in which we have to delay the signal. */ @@ -4537,8 +4664,8 @@ never delivered !!!. This is strange since according to POSIX no errors are defined for ualarm. If this is the case - just ask for something less than a second */ - if (ualarm(wait,0) == (useconds_t)-1) - ualarm(999999,0); + if (schedule_alarm(wait) == (useconds_t)-1) + schedule_alarm(999999); } /* release the chain spinlock */ spinlock_release(&timeout_call_chain_lock); @@ -4612,36 +4739,4 @@ #undef ENABLE_DUMMY_ALLOCCOUNT -global void install_async_signal_handlers() -{ - /* 1. disable all async signals - 2. install SIG_THREAD_INTERRUPT handler */ - var sigset_t sigblock_mask=async_signal_mask(); - /* since we are called from the main thread - all threads - in the process will inherit this mask !!*/ - sigprocmask(SIG_BLOCK,&sigblock_mask,NULL); - /* install SIG_THREAD_INTERRUPT */ - SIGNAL(SIG_THREAD_INTERRUPT,&interrupt_thread_signal_handler); -} -#else /* !HAVE_SIGNALS i.e. WIN32_THREAD*/ - -/* UP: this thread will deal with CTRL-C/CTRL-BREAK events and - CALL-WITH-TIMEOUT calls. - > arg: not used - */ -local void *signal_handler_thread(void *arg) -{ - /* TODO: implement (together with missing THREAD-INTERRUPT and - CALL-WITH-TIMEOUT. */ - while (1) Sleep(1); - return NULL; -} - -global maygc void handle_pending_interrupts() -{ - /* TODO: implement */ -} - -#endif /* HAVE_SIGNALS */ - -#endif +#endif /* MULTITHREAD */ Index: zthread.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/zthread.d,v retrieving revision 1.47 retrieving revision 1.48 diff -u -d -r1.47 -r1.48 --- zthread.d 5 Jun 2009 19:54:34 -0000 1.47 +++ zthread.d 6 Jun 2009 22:21:48 -0000 1.48 @@ -348,7 +348,6 @@ in our signal handling thread and the body is executed. If the timeout elapses - the signal handling thread will interrupt the body and the timeout function will be executed. */ -#ifdef HAVE_SIGNALS var struct timeval tv; var struct timeval *tvp = sec_usec(STACK_2,unbound,&tv); if (tvp) { @@ -384,9 +383,7 @@ }); /* insert in sorted chain and signal if needed */ if (insert_timeout_call(&tc)) { - begin_system_call(); - xthread_signal(thr_signal_handler,SIG_TIMEOUT_CALL); - end_system_call(); + begin_system_call(); signal_timeout_call(); end_system_call(); } spinlock_release(&timeout_call_chain_lock); /* release the lock */ funcall(STACK_5,0); /* call the body function */ @@ -398,9 +395,6 @@ funcall(STACK_1,0); } skipSTACK(3); -#else /* WIN32 has to wait */ - NOTREACHED; -#endif } LISPFUNN(thread_yield,0) @@ -421,7 +415,6 @@ LISPFUN(thread_interrupt,seclass_default,2,0,rest,nokey,0,NIL) { /* (THREAD-INTERRUPT thread function &rest arguments) */ -#ifdef HAVE_SIGNALS var bool signal_sent=false; STACK_(argcount+1) = check_thread(STACK_(argcount+1)); if (TheThread(STACK_(argcount+1))->xth_globals == current_thread()) { @@ -452,9 +445,6 @@ /* return the thread and whether it was really interrupted */ VALUES2(STACK_1,signal_sent ? T : NIL); skipSTACK(2); /* thread + function */ -#else - NOTREACHED; /* win32 not implemented */ -#endif } LISPFUNN(threadp,1) @@ -903,7 +893,7 @@ } else { r = pthread_cond_wait(&l->_c,&l->_m); } - #else / WIN32 **/ + #else /* WIN32 */ r = win32_xcondition_wait(&l->_c,&l->_m,timeout); #endif if (r != 0) break; Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6874 retrieving revision 1.6875 diff -u -d -r1.6874 -r1.6875 --- ChangeLog 5 Jun 2009 19:54:34 -0000 1.6874 +++ ChangeLog 6 Jun 2009 22:21:48 -0000 1.6875 @@ -1,3 +1,27 @@ +2009-06-07 Vladimir Tzankov <vtz...@gm...> + + [MULTITHREAD]: add partial support for thread interruption on WIN32 + * lispbibl.d (GC_SAFE_REGION_END_i): handle pending interrupts depending + on thread's flavour + (install_async_signal_handlers, thr_signal_handler, SIG_THREAD_INTERRUPT) + (SIG_TIMEOUT_CALL): make them local in spvw.d + (signal_timeout_call): function to announce new timeout call. used by + CALL-WITH-TIMEOUT + * zthread.d (CALL-WITH-TIMEOUT): enable WIN32_THREADS. use + signal_timeout_call() for queuing timeout call + (THREAD-INTERRUPT): enable WIN32_THREADS + * xthread.d (xthread_sigmask, xthread_signal) [WIN32_THREADS]: remove + * spvw.d: unify POSIX and WIN32 signal handling + (signal_wait): waits for asynchronous signal + (signal_timeout_call): announce (WIN32 and POSIX) new timeout call + (schedule_alarm): schedule next timeout call. NB: to be called only from + signal handler thread + (console_handler): CTRL-C handler for WIN32_THREADS + (interrupt_thread) [WIN32_THREADS]: delay handling in case we are in + blocking system call. the interrupt will be executed after the call + returns + (signal_handler_thread): use signal_wait() and schedule_alarm(). + 2009-06-05 Vladimir Tzankov <vtz...@gm...> [MULTITHREAD]: add timed wait on mutexes and exemptions Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.871 retrieving revision 1.872 diff -u -d -r1.871 -r1.872 --- lispbibl.d 24 May 2009 21:25:23 -0000 1.871 +++ lispbibl.d 6 Jun 2009 22:21:48 -0000 1.872 @@ -9460,6 +9460,17 @@ SET_SP_BEFORE_SUSPEND(thr); /* debug only */ \ spinlock_release(&thr->_gc_suspend_ack); \ }while(0) +/* following two macroses are workarround for differences between WIN32 and + POSIX "signal" handling. With POSIX signals we really interrupt thread, + while with WIN32 threads we should deffer the handling after system call + returns */ + #ifdef HAVE_SIGNALS /* POSIX_THREADS */ + #define _thr_ptb_(s) s + #define _thr_pta_(s) + #else /* WIN32_THREADS */ + #define _thr_ptb_(s) + #define _thr_pta_(s) s + #endif /* If we cannot get the suspend ack lock again - it means there is/was GC - so try to wait for it's end if it is not already finished. */ #define GC_SAFE_REGION_END_i(statement) \ @@ -9472,8 +9483,9 @@ spinlock_acquire(&thr->_gc_suspend_ack); \ xmutex_raw_unlock(&thr->_gc_suspend_lock); \ thr->_raw_wait_mutex = NULL; \ - statement; \ + _thr_ptb_(statement); \ } \ + _thr_pta_(statement); \ }while(0) #define GC_SAFE_REGION_END() \ GC_SAFE_REGION_END_i(HANDLE_PENDING_INTERRUPTS(thr)) @@ -16961,10 +16973,8 @@ uintC _index; /* this thread's index in allthreads[] */ /* moved here from pathname.d */ bool _running_handle_directory_encoding_error; - #ifdef HAVE_SIGNALS /* do not rely on SA_NODEFER for signal nesting */ spinlock_t _signal_reenter_ok; - #endif /* Following are related to thread interruption */ /* condvar on which thread waits currently (in GC_SAFE way) */ xcondition_t *_wait_condition; @@ -17349,6 +17359,9 @@ Caller should hold the thread _signal_reenter_ok. On failure (or when the thread will not be signalled) it will be released here*/ global bool interrupt_thread(clisp_thread_t *thr); +/* UP: signals that there is new timeout call (CALL-WITH-TIMEOUT) + handles both POSIX and WIN32 threads */ +global int signal_timeout_call(); /* UP: handles any pending interrupt (currently just one). arguments are on the STACK */ global maygc void handle_pending_interrupts(); @@ -17406,21 +17419,6 @@ /* returns true if p1 is before p2 */ global bool timeval_less(struct timeval *p1, struct timeval *p2); -#if defined(HAVE_SIGNALS) - /* SIGUSR1 is used for thread interrupt */ - #define SIG_THREAD_INTERRUPT SIGUSR1 - /* SIGUSR2 WILL BE used for CALL-WITH-TIMEOUT */ - #define SIG_TIMEOUT_CALL SIGUSR2 - /* installs the global "synchronous" signal handler for async - POSIX signals. */ - global void install_async_signal_handlers(); - /* the id of the signal handling thread. - on linux raise(sig) does not deliver the signal with pthreads. - pthread_kill()/xthread_signal() work fine. - */ - extern xthread_t thr_signal_handler; -#endif - #define GC_STOP_WORLD(lock_heap) \ gc_suspend_all_threads(lock_heap) #define GC_RESUME_WORLD(unlock_heap) \ Index: xthread.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/xthread.d,v retrieving revision 1.26 retrieving revision 1.27 diff -u -d -r1.26 -r1.27 --- xthread.d 5 Jun 2009 19:54:34 -0000 1.26 +++ xthread.d 6 Jun 2009 22:21:48 -0000 1.27 @@ -171,11 +171,7 @@ #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 */ - +/* xthread_sigmask() and xthread_signal() are not needed here */ #define xcondition_init(c) \ (InitializeCriticalSection(&(c)->cs), \ (c)->sem=CreateSemaphore(NULL,0,MAX_SEMAPHORE_COUNT,NULL), \ ------------------------------ Message: 2 Date: Sat, 06 Jun 2009 22:27:17 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/tests ChangeLog,1.621,1.622 mt.tst,1.6,1.7 To: cli...@li... Message-ID: <E1M...@dd...> Update of /cvsroot/clisp/clisp/tests In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv12136/tests Modified Files: ChangeLog mt.tst Log Message: [MULTITHREAD]: adjust WITH-TIMEOUT test for WIN32 Index: mt.tst =================================================================== RCS file: /cvsroot/clisp/clisp/tests/mt.tst,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- mt.tst 5 Jun 2009 19:57:36 -0000 1.6 +++ mt.tst 6 Jun 2009 22:27:15 -0000 1.7 @@ -1,7 +1,7 @@ ;; -*- Lisp -*- vim:filetype=lisp (with-timeout (10 t) nil) NIL -(with-timeout (1 t) (sleep 100)) T +(with-timeout (1 t) (sleep 2)) T (y-or-n-p-timeout 1 t "y or n") T (yes-or-no-p-timeout 0.5 nil "yes or no") NIL (times Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v retrieving revision 1.621 retrieving revision 1.622 diff -u -d -r1.621 -r1.622 --- ChangeLog 5 Jun 2009 19:57:36 -0000 1.621 +++ ChangeLog 6 Jun 2009 22:27:15 -0000 1.622 @@ -1,3 +1,8 @@ +2009-06-07 Vladimir Tzankov <vtz...@gm...> + + * mt.tst: reduce the timeout for WITH-TIMEOUT test. Currently on WIN32 + it will fail anyway - 100 seconds are too much to wait for it + 2009-06-05 Vladimir Tzankov <vtz...@gm...> * mt.tst: add tests for timed mutex wait. fix mutex tests that ------------------------------ ------------------------------------------------------------------------------ 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 3 **************************************** |