Menu
▾
▴
clisp-cvs Digest, Vol 38, Issue 4
|
From: <cli...@li...> - 2009-06-09 12:03:13
|
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.6875, 1.6876 constsym.d, 1.381, 1.382 spvw.d, 1.493, 1.494 threads.lisp, 1.14, 1.15 zthread.d, 1.48, 1.49 (Vladimir Tzankov) ---------------------------------------------------------------------- Message: 1 Date: Mon, 08 Jun 2009 21:32:49 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/src ChangeLog, 1.6875, 1.6876 constsym.d, 1.381, 1.382 spvw.d, 1.493, 1.494 threads.lisp, 1.14, 1.15 zthread.d, 1.48, 1.49 To: cli...@li... Message-ID: <E1M...@dd...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv19763/src Modified Files: ChangeLog constsym.d spvw.d threads.lisp zthread.d Log Message: [MULTITHREAD]: add WITH-DEFERRED-INTERRUPTS (i.e. WITHOUT-INTERRUPTS) Index: spvw.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw.d,v retrieving revision 1.493 retrieving revision 1.494 diff -u -d -r1.493 -r1.494 --- spvw.d 6 Jun 2009 22:21:48 -0000 1.493 +++ spvw.d 8 Jun 2009 21:32:47 -0000 1.494 @@ -3723,6 +3723,9 @@ me->_SP_anchor=(void*)SP(); /* reinitialize the system thread id */ TheThread(me->_lthread)->xth_system = xthread_self(); + /* initialize deferred interrupts */ + Symbol_thread_value(S(defer_interrupts)) = NIL; + Symbol_thread_value(S(deferred_interrupts)) = NIL; /* now we are ready to start main_actions()*/ main_actions(args); thread_cleanup(); @@ -4535,15 +4538,29 @@ var clisp_thread_t *thr = current_thread(); var uintC pend = thr->_pending_interrupts; thr->_pending_interrupts = 0; /* we got all of them */ - while (pend--) { - var object intrfun=popSTACK(); /* interrupt function */ - var uintC argc=posfixnum_to_V(popSTACK()); /* arguments count */ - /* on non-local exit from the interrupt function and nested - pending interrupts - some of them will not be handled. - In most implementations such non-local exits have undefined - behavior and should not be used (actually thread-interrupt is - discouraged). */ - funcall(intrfun,argc); + /* It is fine to use Symbol_value() instead of Symbol_thread_value() since + we always have per-thread value for defer_interrupts and + deferred_interrupts */ + if (eq(Symbol_thread_value(S(defer_interrupts)), NIL)) { + while (pend--) { + var uintC argc=posfixnum_to_V(popSTACK()); /* arguments count */ + var object intrfun=popSTACK(); /* interrupt function */ + /* on non-local exit from the interrupt function and nested + pending interrupts - some of them will not be handled. + In most implementations such non-local exits have undefined + behavior and should not be used (actually thread-interrupt is + discouraged). */ + funcall(intrfun,argc); + } + } else { /* we should defer interrupts */ + while (pend--) { + var uintC argc=posfixnum_to_V(popSTACK()); /* arguments count */ + pushSTACK(nreverse(listof(argc+1))); + var object kons = allocate_cons(); + Car(kons) = popSTACK(); + Cdr(kons) = Symbol_thread_value(S(deferred_interrupts)); + Symbol_thread_value(S(deferred_interrupts)) = kons; + } } } @@ -4635,8 +4652,8 @@ 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)); + NC_pushSTACK(chain->thread->_STACK,posfixnum(1)); if (!interrupt_thread(chain->thread)) { /* hmm - signal send failed. restore the stack and mark the timeout as failed. The next time when we come here we will retry it - if @@ -4681,8 +4698,8 @@ /* 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 */ + NC_pushSTACK(thread->_STACK,posfixnum(2)); /* two arguments */ if (!(signal_sent = interrupt_thread(thread))) { thread->_STACK=saved_stack; } else @@ -4720,8 +4737,8 @@ /* 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 */ + NC_pushSTACK(thread->_STACK,posfixnum(1)); /* 1 argument */ some_failed &= interrupt_thread(thread); }); if (some_failed) { Index: zthread.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/zthread.d,v retrieving revision 1.48 retrieving revision 1.49 diff -u -d -r1.48 -r1.49 --- zthread.d 6 Jun 2009 22:21:48 -0000 1.48 +++ zthread.d 8 Jun 2009 21:32:47 -0000 1.49 @@ -191,6 +191,10 @@ *initial_bindings = Cdr(*initial_bindings); } } + /* to be on the safe side - always set *defer-interrupts* to nil and + *deferred-interrupts* to empty list - user may pass bad initial bindings*/ + Symbol_thread_value(S(defer_interrupts)) = NIL; + Symbol_thread_value(S(deferred_interrupts)) = NIL; funcall(*funptr,0); /* call fun */ reset(0); /* unwind what we have till now */ } @@ -432,8 +436,8 @@ 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 */ + NC_pushSTACK(clt->_STACK,posfixnum(argcount)); if (!(signal_sent = interrupt_thread(clt))) { /* for some reason we were unable to send the signal */ clt->_STACK=saved_stack; Index: constsym.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/constsym.d,v retrieving revision 1.381 retrieving revision 1.382 diff -u -d -r1.381 -r1.382 --- constsym.d 5 Jun 2009 19:54:34 -0000 1.381 +++ constsym.d 8 Jun 2009 21:32:47 -0000 1.382 @@ -1214,14 +1214,19 @@ LISPSYM(default_special_bindings,"*DEFAULT-SPECIAL-BINDINGS*",mt) LISPSYM(default_control_stack_size,"*DEFAULT-CONTROL-STACK-SIZE*",mt) LISPSYM(default_value_stack_size,"*DEFAULT-VALUE-STACK-SIZE*",mt) +LISPSYM(defer_interrupts,"*DEFER-INTERRUPTS*",mt) +LISPSYM(deferred_interrupts,"*DEFERRED-INTERRUPTS*",mt) LISPSYM(Kinitial_bindings,"INITIAL-BINDINGS",keyword) 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) + #error MULTITHREAD requires SOCKET_STREAMS +/* actually two things are needed: :TIMEOUT and sec_usec() function from + streams.d. The former can be easily defined. The latter - maybe it is + good to move it out of SOCKET_STREAMS? + Anyway SOCKET_STREAMS are quite important and probably will/are always + available. */ #endif LISPSYM(mutex,"MUTEX",mt) /* type for MUTEX */ LISPSYM(mutexp,"MUTEXP",mt) Index: threads.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/threads.lisp,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- threads.lisp 2 Apr 2009 18:58:22 -0000 1.14 +++ threads.lisp 8 Jun 2009 21:32:47 -0000 1.15 @@ -11,7 +11,8 @@ "EXEMPTION" "EXEMPTIONP" "MAKE-EXEMPTION" "EXEMPTION-SIGNAL" "EXEMPTION-WAIT" "EXEMPTION-BROADCAST" "Y-OR-N-P-TIMEOUT" "YES-OR-NO-P-TIMEOUT" "WITH-TIMEOUT" - "SYMBOL-VALUE-THREAD" "*DEFAULT-SPECIAL-BINDINGS*")) + "SYMBOL-VALUE-THREAD" "*DEFAULT-SPECIAL-BINDINGS*" + "WITH-DEFERRED-INTERRUPTS")) (in-package "MT") @@ -29,10 +30,17 @@ ;; the value will be initialized from the runtime (defvar *DEFAULT-VALUE-STACK-SIZE*) +;; deferred interrupts. +;; in other implementations it is called without-interrupts +(defvar *defer-interrupts* nil) +(defvar *deferred-interrupts* '()) ; list of pending interrupts + ;; TODO: add more variables (something should done about the ;; standartd input/output streams. (defvar *DEFAULT-SPECIAL-BINDINGS* - '((*random-state* . (make-random-state nil)) + '((*random-state* . (make-random-state t)) + (*defer-interrupts* . nil) + (*deferred-interrupts* . nil) (*gensym-counter* . 0) (ext::*command-index* . 0) (*print-base* . 10) @@ -48,6 +56,13 @@ (*read-default-float-format* . 'single-float) (*readtable* . (copy-readtable nil)))) +(defmacro with-deferred-interrupts (&body body) + `(let ((*defer-interrupts* t) + (*deferred-interrupts* '())) + (unwind-protect (progn ,@body) + (dolist (i *deferred-interrupts*) + (apply (car i) (cdr i)))))) + (defsetf SYMBOL-VALUE-THREAD MT::SET-SYMBOL-VALUE-THREAD) (defmacro with-timeout ((seconds &body timeout-forms) &body body) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6875 retrieving revision 1.6876 diff -u -d -r1.6875 -r1.6876 --- ChangeLog 6 Jun 2009 22:21:48 -0000 1.6875 +++ ChangeLog 8 Jun 2009 21:32:47 -0000 1.6876 @@ -1,3 +1,20 @@ +2009-06-09 Vladimir Tzankov <vtz...@gm...> + + [MULTITHREAD]: add WITH-DEFERRED-INTERRUPTS (i.e. WITHOUT-INTERRUPTS) + * constsym.d (*DEFER-INTERRUPTS*, *DEFERRED-INTERRUPTS*): declare + * threads.lisp (*DEFER-INTERRUPTS*, *DEFERRED-INTERRUPTS*): ditto. also + initialize them with *DEFAULT-SPECIAL-BINDINGS* + (WITH-DEFERRED-INTERRUPTS): add and export it + * zthread.d (thread_stub): initialize per thread values of + *DEFER-INTERRUPTS* and *DEFERRED-INTERRUPTS* in case user use some "bad" + initial bindings + (THREAD-INTERRUPT): reorder the arguments on the foreign stack + * spvw.d (mt_main_actions): initialize per thread values of + *DEFER-INTERRUPTS* and *DEFERRED-INTERRUPTS* + (handle_pending_interrupts): in case we should defer interrupt - add it + *DEFERRED-INTERRUPTS*. handle new stack order + (signal_handler_thread): reorder the arguments on the foreign stack + 2009-06-07 Vladimir Tzankov <vtz...@gm...> [MULTITHREAD]: add partial support for thread interruption on WIN32 ------------------------------ ------------------------------------------------------------------------------ Crystal Reports - New Free Runtime and 30 Day Trial Check out the new simplified licensing option that enables unlimited royalty-free distribution of the report engine for externally facing server and web deployment. http://p.sf.net/sfu/businessobjects ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 38, Issue 4 **************************************** |