From: <cli...@li...> - 2009-02-27 13:57:10
|
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.6829, 1.6830 lispbibl.d, 1.861, 1.862 spvw.d, 1.482, 1.483 spvw_garcol.d, 1.128, 1.129 spvw_global.d, 1.33, 1.34 zthread.d, 1.37, 1.38 (Vladimir Tzankov) 2. clisp/src ChangeLog,1.6830,1.6831 spvw_genera1.d,1.40,1.41 (Vladimir Tzankov) 3. clisp/src ChangeLog,1.6831,1.6832 eval.d,1.268,1.269 (Vladimir Tzankov) 4. clisp/tests ChangeLog,1.617,1.618 mt.tst,1.4,1.5 (Vladimir Tzankov) ---------------------------------------------------------------------- Message: 1 Date: Fri, 27 Feb 2009 12:28:46 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/src ChangeLog, 1.6829, 1.6830 lispbibl.d, 1.861, 1.862 spvw.d, 1.482, 1.483 spvw_garcol.d, 1.128, 1.129 spvw_global.d, 1.33, 1.34 zthread.d, 1.37, 1.38 To: cli...@li... Message-ID: <E1L...@dd...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv25927/src Modified Files: ChangeLog lispbibl.d spvw.d spvw_garcol.d spvw_global.d zthread.d Log Message: [MULTITHREAD]: release all thread resources upon termination Index: zthread.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/zthread.d,v retrieving revision 1.37 retrieving revision 1.38 diff -u -d -r1.37 -r1.38 --- zthread.d 22 Feb 2009 14:30:48 -0000 1.37 +++ zthread.d 27 Feb 2009 12:28:44 -0000 1.38 @@ -61,14 +61,16 @@ /* releases the clisp_thread_t memory of the list of Thread records */ global void release_threads (object list) { + /* Nothing to do here actually. In the past the memory of some + thread allocated objects was released after the thread records has + been GC-ed. Now everything is released upon thread termination. + However this may be useful in future - when we will have threads + created from foreign code callbacks (maybe). So it is left here. */ + /* while (!endp(list)) { - clisp_thread_t *thread = TheThread(Car(list))->xth_globals; - begin_system_call(); - free(thread->_ptr_symvalues); - free(thread); - end_system_call(); list = Cdr(list); } + */ } /* releases the OS mutexes for mutex objects in the list */ @@ -191,10 +193,9 @@ /* we should always have empty stack - this is an error. */ NOTREACHED; } + me->_thread_exit_tag = NULL; /* prevent double killing while in cleanup */ thread_cleanup(); - /* just unregister it from the active threads. the allocated memory - will be released during GC (if there are no references to thread object)*/ - delete_thread(me,false); + delete_thread(me); xthread_exit(0); return NULL; } @@ -266,7 +267,7 @@ if (register_thread(new_thread)<0) { /* total failure */ unlock_threads(); - delete_thread(new_thread,true); + delete_thread(new_thread); VALUES1(NIL); skipSTACK(5); return; @@ -286,14 +287,10 @@ /* create the OS thread */ if (xthread_create(&TheThread(lthr)->xth_system, &thread_stub,new_thread,cstack_size)) { - /* side effect - we return NIL but the not started thread is present in - all_threads (will not survive GC since no references to it). */ - pushSTACK(lthr); - delete_thread(new_thread,false); - lthr=popSTACK(); - VALUES1(NIL); - } else - VALUES1(lthr); + delete_thread(new_thread); + lthr = NIL;; + } + VALUES1(lthr); } /* lock for the timeout_call_chain */ @@ -325,7 +322,12 @@ should be called without holding timeout_scheduler_lock (acquires it) */ local maygc void remove_timeout_call(timeout_call *tc) { - GC_SAFE_SPINLOCK_ACQUIRE(&timeout_call_chain_lock); + /* we do not use GC safe version here since we want to prevent + thread interruption when unwiding the stack. If we do not this + it will be possible to be interrupted here and current thread killed. + this will leave bad pointer in the chain and will cause SIGSEGV in + signal handling thread */ + spinlock_acquire(&timeout_call_chain_lock); timeout_call **lastnextp=&timeout_call_chain,*chain=timeout_call_chain; while (chain != NULL && chain != tc) { lastnextp=&chain->next; chain=chain->next; @@ -430,11 +432,11 @@ lock_threads(); end_blocking_call(); var object thr=STACK_0; /* thread */ - /* exit throw tag */ - var gcv_object_t *exit_tag=(TheThread(thr)->xth_globals->_thread_exit_tag); - if (exit_tag) { /* thread is alive */ + if (TheThread(thr)->xth_globals && + TheThread(thr)->xth_globals->_thread_exit_tag) { /* thread is alive */ + /* call (thread-interrupt thread #'%throw-tag exit-tag) */ pushSTACK(S(thread_throw_tag)); - pushSTACK(*exit_tag); + pushSTACK(*(TheThread(thr)->xth_globals->_thread_exit_tag)); unlock_threads(); funcall(L(thread_interrupt),3); } else { /* thread has gone */ @@ -449,43 +451,47 @@ #ifdef HAVE_SIGNALS var object thr=check_thread(STACK_(argcount+1)); var xthread_t systhr=TheThread(thr)->xth_system; - var clisp_thread_t *clt=TheThread(thr)->xth_globals; var bool signal_sent=false; if (TheThread(thr)->xth_globals == current_thread()) { /* we want to interrupt ourselves ? strange but let's do it */ - funcall(Before(rest_args_pointer),argcount); skipSTACK(2); + funcall(Before(rest_args_pointer),argcount); signal_sent=true; } else { /* we want ot interrupt different thread. */ STACK_(argcount+1)=thr; /* gc may happen */ - /* TODO: may be check that the function argument can be funcall-ed, - since it is not very nice to get errors in interrupted thread - (but basically this is not a problem)*/ - WITH_STOPPED_THREAD(clt,true,{ + /* lock the threads - we do not want thread to exit while we try + to interrupt it. */ + begin_blocking_call(); lock_threads(); end_blocking_call(); + thr = STACK_(argcount+1); + var clisp_thread_t *clt = TheThread(thr)->xth_globals; + if (clt) { /* still alive ? */ + /* threads lock is laready owned by us and it is recursive */ + suspend_thread(clt,true); + /* unlock threads - allows GC and prevents deadlock with it */ + unlock_threads(); var gcv_object_t *saved_stack=clt->_STACK; - if (clt->_STACK != NULL) { /* thread is alive ? */ - /* be sure that the signal we send will be received */ - spinlock_acquire(&clt->_signal_reenter_ok); - while (rest_args_pointer != args_end_pointer) { - var object arg = NEXT(rest_args_pointer); - NC_pushSTACK(clt->_STACK,arg); - } - NC_pushSTACK(clt->_STACK,posfixnum(argcount)); - NC_pushSTACK(clt->_STACK,STACK_(argcount)); /* function */ - signal_sent = (0 == xthread_signal(systhr,SIG_THREAD_INTERRUPT)); - if (!signal_sent) { - /* for some reason we were unable to send the signal */ - clt->_STACK=saved_stack; - spinlock_release(&clt->_signal_reenter_ok); - } + /* be sure that the signal we send will be received */ + spinlock_acquire(&clt->_signal_reenter_ok); + while (rest_args_pointer != args_end_pointer) { + var object arg = NEXT(rest_args_pointer); + NC_pushSTACK(clt->_STACK,arg); } - }); - skipSTACK(2 + (uintL)argcount); - /* TODO: may be signal an error if we try to interrupt - terminated thread ???*/ + NC_pushSTACK(clt->_STACK,posfixnum(argcount)); + NC_pushSTACK(clt->_STACK,STACK_(argcount)); /* function */ + signal_sent = (0 == xthread_signal(systhr,SIG_THREAD_INTERRUPT)); + if (!signal_sent) { + /* for some reason we were unable to send the signal */ + clt->_STACK=saved_stack; + spinlock_release(&clt->_signal_reenter_ok); + } + resume_thread(clt,true); + } else + unlock_threads(); + skipSTACK((uintL)argcount); /* skip &rest arguments */ } /* return the thread and whether it was really interrupted */ - VALUES2(clt->_lthread,signal_sent ? T : NIL); + VALUES2(STACK_1,signal_sent ? T : NIL); + skipSTACK(2); /* thread + function */ #else NOTREACHED; /* win32 not implemented */ #endif @@ -506,7 +512,7 @@ LISPFUNN(thread_active_p,1) { /* (THREAD-ACTIVE-P thread) */ var object obj=check_thread(popSTACK()); - VALUES_IF(TheThread(obj)->xth_globals->_STACK != NULL); + VALUES_IF(TheThread(obj)->xth_globals != NULL); } LISPFUNN(thread_state,1) @@ -557,7 +563,12 @@ *thread=check_thread(*thread); sym = popSTACK(); thr=TheThread(*thread)->xth_globals; + if (!thr) + return NULL; /* thread has terminated */ } + /* thread is alive? */ + if (!thr || !thr->_ptr_symvalues) + return NULL; *thread=thr->_lthread; /* for error reporting if needed */ var uintL idx=TheSymbol(sym)->tls_index; if (idx == SYMBOL_TLS_INDEX_NONE || @@ -569,19 +580,25 @@ LISPFUNNR(symbol_value_thread,2) { /* (MT:SYMBOL-VALUE-THREAD symbol thread) */ - gcv_object_t *symval=thread_symbol_place(&STACK_1, &STACK_0); + /* lock threads - so thread cannot exit meanwhile (if running at all) */ + begin_blocking_call(); lock_threads(); end_blocking_call(); + var gcv_object_t *symval=thread_symbol_place(&STACK_1, &STACK_0); if (!symval || eq(unbound,*symval)) { VALUES2(NIL,NIL); /* not bound */ } else { VALUES2(*symval,T); } + unlock_threads(); skipSTACK(2); } LISPFUNN(set_symbol_value_thread,3) { /* (SETF (MT:SYMBOL-VALUE-THREAD symbol thread) value) */ - gcv_object_t *symval=thread_symbol_place(&STACK_2, &STACK_1); + /* lock threads - so thread cannot exit meanwhile (if running at all) */ + begin_blocking_call(); lock_threads(); end_blocking_call(); + var gcv_object_t *symval=thread_symbol_place(&STACK_2, &STACK_1); if (!symval) { + unlock_threads(); var object symbol=STACK_2; var object thread=STACK_1; pushSTACK(symbol); /* CELL-ERROR Slot NAME */ @@ -592,11 +609,10 @@ *symval=STACK_0; VALUES1(*symval); } + unlock_threads(); skipSTACK(3); } - - LISPFUNN(mutexp,1) { /* (MUTEXP object) */ var object obj = popSTACK(); Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6829 retrieving revision 1.6830 diff -u -d -r1.6829 -r1.6830 --- ChangeLog 26 Feb 2009 09:20:19 -0000 1.6829 +++ ChangeLog 27 Feb 2009 12:28:43 -0000 1.6830 @@ -1,3 +1,31 @@ +2009-02-27 Vladimir Tzankov <vtz...@gm...> + + [MULTITHREAD]: release all thread resources upon termination + * lispbibl.d (WITH_STOPPED_THREAD): remove (was used only by + THREAD-INTERRUPT and is not suitable anymore) + (GC_SAFE_POINT_IF): add GCTRIGGER() in case of suspension + (delete_thread): remove "full" parameter. all resources are released + always + * spvw.d (create_thread): initialize _index field of the new thread with + invalid value + (delete_thread): remove "full" parameter. release all allocated memory. + (signal_handler_thread): do not check whether thread to be interrupted + is alive (since it is). + * spvw_global.d (suspend_thread, resume_thread): ditto + * spvw_garcol.d (gar_col_normal): change the condition for checking + whether thread is running or terminated + (gar_col_done): update new references only of alive threads + * zthread.d (release_threads): do nothing (everything is freed by + delete_thread). left since in future may be useful + (thread_stub): prevent killing while running in thread_cleanup() + (remove_timeout_call): do not allow to be interrupted (by not using + "GC safe" way for spinlock acquiring + (THREAD-KILL): change thread alive check + (THREAD-ACTIVE-P): ditto + (THREAD-INTERRUPT): reimplement + (SYMBOL-VALUE-THREAD, SET-SYMBOL-VALUE-THREAD): lock the threads. + prevents thread termination while working with it's symvalues + 2009-02-26 Vladimir Tzankov <vtz...@gm...> * eval.d (interpret_bytecode_ JMP) [MULTITHREAD]: preserve mv_space Index: spvw_global.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw_global.d,v retrieving revision 1.33 retrieving revision 1.34 diff -u -d -r1.33 -r1.34 --- spvw_global.d 6 Feb 2009 16:32:24 -0000 1.33 +++ spvw_global.d 27 Feb 2009 12:28:44 -0000 1.34 @@ -663,16 +663,14 @@ /* we do not want the thread that we try try to suspend to exit (if running at all) until we finish the whole process. So lock threads.*/ lock_threads(); /* blocks the GC - but not a problem */ - if (thr->_STACK != NULL) { /* only if thread is alive */ - if (!thr->_suspend_count) { /* first suspend ? */ - xmutex_lock(&thr->_gc_suspend_lock); /* enable thread waiting */ - spinlock_release(&thr->_gc_suspend_request); /* request */ - /* wait for the thread to come to safe point. */ - while (!spinlock_tryacquire(&thr->_gc_suspend_ack)) - xthread_yield(); - } - thr->_suspend_count++; + if (!thr->_suspend_count) { /* first suspend ? */ + xmutex_lock(&thr->_gc_suspend_lock); /* enable thread waiting */ + spinlock_release(&thr->_gc_suspend_request); /* request */ + /* wait for the thread to come to safe point. */ + while (!spinlock_tryacquire(&thr->_gc_suspend_ack)) + xthread_yield(); } + thr->_suspend_count++; unlock_threads(); if (lock_heap) RELEASE_HEAP_LOCK(); } @@ -687,11 +685,9 @@ ASSERT(thr != current_thread()); if (lock_heap) ACQUIRE_HEAP_LOCK(); lock_threads(); /* blocks the GC - but not a problem */ - if (thr->_STACK != NULL) { /* only if thread is alive */ - if (! --thr->_suspend_count) { /* only if suspend count goes to zero */ - spinlock_release(&thr->_gc_suspend_ack); /* release the ACK lock*/ - xmutex_unlock(&thr->_gc_suspend_lock); /* enable thread */ - } + if (! --thr->_suspend_count) { /* only if suspend count goes to zero */ + spinlock_release(&thr->_gc_suspend_ack); /* release the ACK lock*/ + xmutex_unlock(&thr->_gc_suspend_lock); /* enable thread */ } unlock_threads(); if (lock_heap) RELEASE_HEAP_LOCK(); Index: spvw.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw.d,v retrieving revision 1.482 retrieving revision 1.483 diff -u -d -r1.482 -r1.483 --- spvw.d 11 Feb 2009 10:43:25 -0000 1.482 +++ spvw.d 27 Feb 2009 12:28:43 -0000 1.483 @@ -707,18 +707,12 @@ 2. threads lock - while waiting for all threads to get suspended at safe points - we do not want new thread(s) to be spawned. - There are 3 places where lock_threads() is used without possibly blocking + There are 2 places where lock_threads() is used without possibly blocking "enclosure": 1. In gc_suspend_all_threads() - after we already own the heap lock - in order to prevent new threads spawning. 2. suspend_thread() - in order to be sure that the thread will not exit while we try to suspend it (or it already has exited). - 3. delete_thread() - it is called from a thread that terminates or for a - thread that will never be started. The first thing that delete_thread() - does is to ensure that anybody interested in this particular thread (and - those are the two functions above - for suspending) - will consider it as - already suspended - so even if we block here - it will not cause any harm - to the GC. All other places enclose the lock_threads() in begin_blocking_call(). Also note that while the threads are locked - no heap allocation should @@ -767,6 +761,7 @@ if (!thread) return NULL; begin_system_call(); memset(thread,0,sizeof(clisp_thread_t)); /* zero-up everything */ + thread->_index = MAXNTHREADS + 1; /* set to invalid value */ /* init _symvalues "proxy" */ thread->_ptr_symvalues = (gcv_object_t *)malloc(sizeof(gcv_object_t)* maxnum_symvalues); @@ -818,18 +813,16 @@ return thread; } -/* UP: Releases current_thread resources - > thread: the clisp thread object to be released - > full: if true, also release self and thread-local symbol table */ -global void delete_thread (clisp_thread_t *thread, bool full) { - /* first give up any locks that the thread holds. - if GC is suspending threads - we do not want to block it - anyway we are going away.*/ +/* UP: removes the current_thread from the list (array) of threads. + Also frees any allocated resource. + > thread: thread to be removed */ +global void delete_thread (clisp_thread_t *thread) { + /* lock the threads mutex. we are going to change allthreads[] */ + begin_blocking_call(); lock_threads(); end_blocking_call(); + /* destroy OS mutex */ begin_system_call(); xmutex_destroy(&thread->_gc_suspend_lock); end_system_call(); - spinlock_release(&thread->_gc_suspend_ack); - lock_threads(); /* lock all threads */ if (nthreads==1) { /* this was the last LISP thread in the process - we are quiting */ @@ -837,36 +830,28 @@ quit(); return; /* quit will unwind the stack and call hooks */ } - - ASSERT(thread->_index < nthreads); - ASSERT(allthreads[thread->_index] == thread); - allthreads[nthreads-1]->_index = thread->_index;; - allthreads[thread->_index] = allthreads[nthreads-1]; - nthreads--; - thread->_index=MAXNTHREADS+1; /* mark as exitted */ + if (thread->_index < nthreads) { /* only if registered */ + ASSERT(allthreads[thread->_index] == thread); + allthreads[nthreads-1]->_index = thread->_index;; + allthreads[thread->_index] = allthreads[nthreads-1]; + nthreads--; + /* no globals for this thread record anymore */ + TheThread(thread->_lthread)->xth_globals = NULL; + /* DO NOT remove from global list of all threads. */ + /* O(all_threads) = deleteq(O(all_threads), thread->_lthread); */ + } /* The LISP stack should be unwound so no interesting stuff on it. Let's deallocate it.*/ begin_system_call(); if (thread->_own_stack) free(THREAD_LISP_STACK_START(thread)); - thread->_STACK = NULL; /* marks thread as non active */ - thread->_thread_exit_tag = NULL; - /* clisp_thread_t itself will be deallocated during finalization - phase of GC - when the thread record is discarded. why? - (somebody may want to inspect the mv_space for "thread return value") - sds: mv_space does not survive a GC, so there is nothing to inspect. - vtz: per thread symvalues are available - SYMBOL-VALUE-THREAD works on - terminated threads. this may be helpful for diagnostic purposes. - if you think it's not - let's free everything here. */ - if (full) { - free(thread->_ptr_symvalues); - free(thread); - } + free(thread->_ptr_symvalues); /* free per trread special var bindings */ + free(thread); end_system_call(); unlock_threads(); } #define for_all_threads(statement) \ - do { var clisp_thread_t** _pthread = &allthreads[0]; \ + do { var clisp_thread_t** _pthread = &allthreads[0]; \ var clisp_thread_t **endt=&allthreads[nthreads]; \ while (_pthread != endt) \ { var clisp_thread_t* thread = *_pthread++; statement; } \ @@ -3744,7 +3729,7 @@ /* now we are ready to start main_actions()*/ main_actions(args); thread_cleanup(); - delete_thread(me,false); /* just delete ourselves */ + delete_thread(me); /* just delete ourselves */ /* NB: the LISP stack is "leaked" - in a sense nobody will ever use it anymore !!!*/ xthread_exit(0); @@ -4478,22 +4463,20 @@ #ifndef DEBUG_GCSAFETY suspend_thread(chain->thread,false); #endif - if (chain->thread->_STACK) { /* alive ? */ - spinlock_acquire(&chain->thread->_signal_reenter_ok); - gcv_object_t *saved_stack=chain->thread->_STACK; - NC_pushSTACK(chain->thread->_STACK,*chain->throw_tag); - NC_pushSTACK(chain->thread->_STACK,posfixnum(1)); - NC_pushSTACK(chain->thread->_STACK,S(thread_throw_tag)); - if (xthread_signal(TheThread(chain->thread->_lthread)->xth_system, - SIG_THREAD_INTERRUPT)) { - /* hmm - signal send failed. restore the stack and spinlock, - and mark the timeout as failed. The next time when we come - here we will retry it - if not reported as warning to the - user. The user will always get a warning. */ - chain->failed=true; - chain->thread->_STACK=saved_stack; - spinlock_release(&chain->thread->_signal_reenter_ok); - } + spinlock_acquire(&chain->thread->_signal_reenter_ok); + gcv_object_t *saved_stack=chain->thread->_STACK; + NC_pushSTACK(chain->thread->_STACK,*chain->throw_tag); + NC_pushSTACK(chain->thread->_STACK,posfixnum(1)); + NC_pushSTACK(chain->thread->_STACK,S(thread_throw_tag)); + if (xthread_signal(TheThread(chain->thread->_lthread)->xth_system, + SIG_THREAD_INTERRUPT)) { + /* hmm - signal send failed. restore the stack and spinlock, + and mark the timeout as failed. The next time when we come + here we will retry it - if not reported as warning to the + user. The user will always get a warning. */ + chain->failed=true; + chain->thread->_STACK=saved_stack; + spinlock_release(&chain->thread->_signal_reenter_ok); } #ifndef DEBUG_GCSAFETY resume_thread(chain->thread,false); @@ -4526,23 +4509,21 @@ var bool signal_sent=false; ENABLE_DUMMY_ALLOCCOUNT(true); for_all_threads({ - if (thread->_STACK) { /* still alive ?*/ - spinlock_acquire(&thread->_signal_reenter_ok); - gcv_object_t *saved_stack=thread->_STACK; - /* line below is not needed but detects bugs */ - NC_pushSTACK(thread->_STACK,O(thread_break_description)); - NC_pushSTACK(thread->_STACK,S(interrupt_condition)); /* arg */ - NC_pushSTACK(thread->_STACK,posfixnum(2)); /* two arguments */ - NC_pushSTACK(thread->_STACK,S(cerror)); /* function */ - signal_sent = - (0 == xthread_signal(TheThread(thread->_lthread)->xth_system, - SIG_THREAD_INTERRUPT)); - if (!signal_sent) { - thread->_STACK=saved_stack; - spinlock_release(&thread->_signal_reenter_ok); - } else - break; - } + spinlock_acquire(&thread->_signal_reenter_ok); + gcv_object_t *saved_stack=thread->_STACK; + /* line below is not needed but detects bugs */ + NC_pushSTACK(thread->_STACK,O(thread_break_description)); + NC_pushSTACK(thread->_STACK,S(interrupt_condition)); /* arg */ + NC_pushSTACK(thread->_STACK,posfixnum(2)); /* two arguments */ + NC_pushSTACK(thread->_STACK,S(cerror)); /* function */ + signal_sent = + (0 == xthread_signal(TheThread(thread->_lthread)->xth_system, + SIG_THREAD_INTERRUPT)); + if (!signal_sent) { + thread->_STACK=saved_stack; + spinlock_release(&thread->_signal_reenter_ok); + } else + break; }); if (!signal_sent) { fputs("*** SIGINT will be missed.\n",stderr); abort(); @@ -4573,16 +4554,14 @@ var bool some_failed=false; ENABLE_DUMMY_ALLOCCOUNT(true); for_all_threads({ - if (thread->_STACK) { - /* be sure the signal handler can be reentered */ - spinlock_acquire(&thread->_signal_reenter_ok); - NC_pushSTACK(thread->_STACK,thread->_lthread); /* thread object */ - NC_pushSTACK(thread->_STACK,posfixnum(1)); /* 1 argument */ - NC_pushSTACK(thread->_STACK,S(thread_kill)); /* THREAD-KILL */ - some_failed |= - (0!=xthread_signal(TheThread(thread->_lthread)->xth_system, - SIG_THREAD_INTERRUPT)); - } + /* be sure the signal handler can be reentered */ + spinlock_acquire(&thread->_signal_reenter_ok); + NC_pushSTACK(thread->_STACK,thread->_lthread); /* thread object */ + NC_pushSTACK(thread->_STACK,posfixnum(1)); /* 1 argument */ + NC_pushSTACK(thread->_STACK,S(thread_kill)); /* THREAD-KILL */ + some_failed |= + (0!=xthread_signal(TheThread(thread->_lthread)->xth_system, + SIG_THREAD_INTERRUPT)); }); if (some_failed) { fputs("*** some threads were not signaled to terminate.",stderr); Index: spvw_garcol.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw_garcol.d,v retrieving revision 1.128 retrieving revision 1.129 diff -u -d -r1.128 -r1.129 --- spvw_garcol.d 12 Feb 2009 20:05:23 -0000 1.128 +++ spvw_garcol.d 27 Feb 2009 12:28:43 -0000 1.129 @@ -1972,7 +1972,7 @@ #if defined(MULTITHREAD) /* prepare for release terminated, non-referenced threads */ SPLIT_REF_LISTS(threads_to_go,O(all_threads),O(threads_to_release),TheThread, - (TheThread(Car(Lu))->xth_globals->_index < MAXNTHREADS)); + (TheThread(Car(Lu))->xth_globals != NULL)); gc_mark(O(all_threads)); gc_mark(O(threads_to_release)); /* prepare for release non-referenced mutexes */ SPLIT_REF_LISTS(mutexes_to_go,O(all_mutexes),O(mutexes_to_release),TheMutex,false); @@ -2465,7 +2465,8 @@ { var object list=O(all_threads); while (!endp(list)) { - TheThread(Car(list))->xth_globals->_lthread=Car(list); + if (TheThread(Car(list))->xth_globals) /* only if alive */ + TheThread(Car(list))->xth_globals->_lthread=Car(list); list=Cdr(list); } } Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.861 retrieving revision 1.862 diff -u -d -r1.861 -r1.862 --- lispbibl.d 24 Feb 2009 10:03:19 -0000 1.861 +++ lispbibl.d 27 Feb 2009 12:28:43 -0000 1.862 @@ -9437,7 +9437,7 @@ #define GC_SAFE_POINT_IF(gc,no_gc) \ do{ \ if (spinlock_tryacquire(&(current_thread()->_gc_suspend_request))) \ - {gc;} else {no_gc;} \ + {GCTRIGGER();gc;} else {no_gc;} \ }while(0) #define GC_SAFE_POINT() GC_SAFE_POINT_IF(GC_SAFE_ACK_SUSPEND_REQUEST_(), ;) /* Giving up suspend ack while we are in system call. @@ -17258,9 +17258,10 @@ Does not register it in the global thread array. When called the global thread lock should be held.*/ global clisp_thread_t* create_thread(uintM lisp_stack_size); -/* removes the current_thread from the list (array) of threads. - Also frees any allocated resource. */ -global void delete_thread(clisp_thread_t *thread, bool full); +/* UP: removes the current_thread from the list (array) of threads. + Also frees any allocated resource. + > thread: thread to be removed */ +global void delete_thread(clisp_thread_t *thread); /* register a clisp-thread_t in global thread array thread - the new allocated thread. When called the global thread lock should be held. */ @@ -17357,14 +17358,6 @@ extern xthread_t thr_signal_handler; #endif -#define WITH_STOPPED_THREAD(thread,lock_heap,statement) \ - do { \ - var bool lh=lock_heap; \ - suspend_thread(thread,lh); \ - statement; \ - resume_thread(thread,lh); \ - } while(0) - #define GC_STOP_WORLD(lock_heap) \ gc_suspend_all_threads(lock_heap) #define GC_RESUME_WORLD(unlock_heap) \ ------------------------------ Message: 2 Date: Fri, 27 Feb 2009 13:24:29 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/src ChangeLog,1.6830,1.6831 spvw_genera1.d,1.40,1.41 To: cli...@li... Message-ID: <E1L...@dd...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv9351/src Modified Files: ChangeLog spvw_genera1.d Log Message: (build_old_generation_cache) [MULTITHREAD]: merge PROT_READ_WRITE areas Index: spvw_genera1.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw_genera1.d,v retrieving revision 1.40 retrieving revision 1.41 diff -u -d -r1.40 -r1.41 --- spvw_genera1.d 11 Feb 2009 10:43:27 -0000 1.40 +++ spvw_genera1.d 27 Feb 2009 13:24:27 -0000 1.41 @@ -431,20 +431,19 @@ end = rwarea->start; } else { /* PROT_READ_WRITE */ DEBUG_SPVW_ASSERT(start == rwarea->start); - end = rwarea->start + rwarea->size; /* advance rwarea. it is possible to have few pinned objects - (and so PROT_READ_WRITE areas) in singe physical page. In this - case we have "duplicated" rwarea items. skip not relevant ones - (or parts of them). */ - rwarea++; - while (rwarea->start == (rwarea-1)->start) { - if (rwarea->size != (rwarea-1)->size) { - /* shrink it */ - rwarea->start += (rwarea-1)->size; - rwarea->size -= (rwarea-1)->size; - } else - rwarea++; + (and so PROT_READ_WRITE areas) in singe physical page. merge + regions. */ + while (((rwarea+1)->start != 0) && + (rwarea->start + rwarea->size >= (rwarea+1)->start)) { + 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->start = (rwarea-1)->start; } + end = rwarea->start + rwarea->size; + rwarea++; } } } while (1); Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6830 retrieving revision 1.6831 diff -u -d -r1.6830 -r1.6831 --- ChangeLog 27 Feb 2009 12:28:43 -0000 1.6830 +++ ChangeLog 27 Feb 2009 13:24:21 -0000 1.6831 @@ -1,5 +1,11 @@ 2009-02-27 Vladimir Tzankov <vtz...@gm...> + * spvw_genera1.d (build_old_generation_cache) [MULTITHREAD]: merge + PROT_READ_WRITE areas. fixes corner cases with pinned objects that + share physical memory pages + +2009-02-27 Vladimir Tzankov <vtz...@gm...> + [MULTITHREAD]: release all thread resources upon termination * lispbibl.d (WITH_STOPPED_THREAD): remove (was used only by THREAD-INTERRUPT and is not suitable anymore) ------------------------------ Message: 3 Date: Fri, 27 Feb 2009 13:51:12 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/src ChangeLog,1.6831,1.6832 eval.d,1.268,1.269 To: cli...@li... Message-ID: <E1L...@dd...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv16205/src Modified Files: ChangeLog eval.d Log Message: (interpret_bytecode_ JMP) [MULTITHREAD]: remove GC safe points at JMP instructions. currently this damages heap Index: eval.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/eval.d,v retrieving revision 1.268 retrieving revision 1.269 diff -u -d -r1.268 -r1.269 --- eval.d 26 Feb 2009 09:20:24 -0000 1.268 +++ eval.d 27 Feb 2009 13:51:09 -0000 1.269 @@ -6540,15 +6540,8 @@ skipSTACK(n); funcall(value1,r); } goto finished; /* return (jump) to caller */ } - /* GC_SAFE_POINT_IF() expands to nothing in single thread builds */ #define JMP() \ - {GC_SAFE_POINT_IF( \ - with_saved_context( \ - {var uintC cnt=mv_count; mv_to_STACK(); \ - GC_SAFE_ACK_SUSPEND_REQUEST_(); \ - STACK_to_mv(cnt); \ - }),;); \ - var const uintB* label_byteptr; \ + {var const uintB* label_byteptr; \ L_operand(label_byteptr); \ DEBUG_CHECK_BYTEPTR(label_byteptr); \ byteptr = label_byteptr; \ Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6831 retrieving revision 1.6832 diff -u -d -r1.6831 -r1.6832 --- ChangeLog 27 Feb 2009 13:24:21 -0000 1.6831 +++ ChangeLog 27 Feb 2009 13:51:08 -0000 1.6832 @@ -1,5 +1,10 @@ 2009-02-27 Vladimir Tzankov <vtz...@gm...> + * eval.d (interpret_bytecode_ JMP) [MULTITHREAD]: remove GC safe + points at JMP instructions. currently this damages heap + +2009-02-27 Vladimir Tzankov <vtz...@gm...> + * spvw_genera1.d (build_old_generation_cache) [MULTITHREAD]: merge PROT_READ_WRITE areas. fixes corner cases with pinned objects that share physical memory pages ------------------------------ Message: 4 Date: Fri, 27 Feb 2009 13:56:35 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/tests ChangeLog,1.617,1.618 mt.tst,1.4,1.5 To: cli...@li... Message-ID: <E1L...@dd...> Update of /cvsroot/clisp/clisp/tests In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv18415/tests Modified Files: ChangeLog mt.tst Log Message: mt.tst: fix thread-interrupt test Index: mt.tst =================================================================== RCS file: /cvsroot/clisp/clisp/tests/mt.tst,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- mt.tst 19 Feb 2009 22:21:00 -0000 1.4 +++ mt.tst 27 Feb 2009 13:56:32 -0000 1.5 @@ -52,7 +52,9 @@ (eq (mutex-owner m1) th) t ;; check thread-interrupt (thread-active-p (thread-interrupt th #'mutex-unlock m1)) T -(mutex-owner m1) NIL +;; 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 (eq (mutex-owner m2) th) T (thread-active-p Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v retrieving revision 1.617 retrieving revision 1.618 diff -u -d -r1.617 -r1.618 --- ChangeLog 19 Feb 2009 22:21:00 -0000 1.617 +++ ChangeLog 27 Feb 2009 13:56:32 -0000 1.618 @@ -1,3 +1,9 @@ +2009-02-27 Vladimir Tzankov <vtz...@gm...> + + * mt.tst: fix thread-interrupt test (upon return from it - it is no + guaranteed that the function has finished it's execution in the + interrupted thread) + 2009-02-20 Vladimir Tzankov <vtz...@gm...> * mt.tst: add tests for mutexes, per thread bindings of special ------------------------------ ------------------------------------------------------------------------------ Open Source Business Conference (OSBC), March 24-25, 2009, San Francisco, CA -OSBC tackles the biggest issue in open source: Open Sourcing the Enterprise -Strategies to boost innovation and cut costs with open source participation -Receive a $600 discount off the registration fee with the source code: SFAD http://p.sf.net/sfu/XcvMzF8H ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 34, Issue 20 ***************************************** |