From 68b32482437e05f0994c4dd0ab5b0c27d39f0f6d Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 15 Aug 2012 12:56:38 -0600 Subject: This introduces a thread-state object and moves various C globals there. It also introduces #defines for these globals to avoid a monster patch. The #defines mean that this patch also has to rename a few fields whose names clash with the defines. There is currently just a single "thread"; so this patch does not impact Emacs behavior in any significant way. --- src/thread.h | 140 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 140 insertions(+) create mode 100644 src/thread.h (limited to 'src/thread.h') diff --git a/src/thread.h b/src/thread.h new file mode 100644 index 00000000000..b2eb04d42e8 --- /dev/null +++ b/src/thread.h @@ -0,0 +1,140 @@ +/* Thread definitions + Copyright (C) 2012 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#ifndef THREAD_H +#define THREAD_H + +#include "regex.h" + +struct thread_state +{ + /* The buffer in which the last search was performed, or + Qt if the last search was done in a string; + Qnil if no searching has been done yet. */ + Lisp_Object m_last_thing_searched; +#define last_thing_searched (current_thread->m_last_thing_searched) + + Lisp_Object m_saved_last_thing_searched; +#define saved_last_thing_searched (current_thread->m_saved_last_thing_searched) + + /* m_gcprolist must be the first non-lisp field. */ + /* Recording what needs to be marked for gc. */ + struct gcpro *m_gcprolist; +#define gcprolist (current_thread->m_gcprolist) + + /* A list of currently active byte-code execution value stacks. + Fbyte_code adds an entry to the head of this list before it starts + processing byte-code, and it removed the entry again when it is + done. Signalling an error truncates the list analoguous to + gcprolist. */ + struct byte_stack *m_byte_stack_list; +#define byte_stack_list (current_thread->m_byte_stack_list) + + /* An address near the bottom of the stack. + Tells GC how to save a copy of the stack. */ + char *m_stack_bottom; +#define stack_bottom (current_thread->m_stack_bottom) + + /* An address near the top of the stack. */ + char *stack_top; + + struct backtrace *m_backtrace_list; +#define backtrace_list (current_thread->m_backtrace_list) + + struct catchtag *m_catchlist; +#define catchlist (current_thread->m_catchlist) + + /* Chain of condition handlers currently in effect. + The elements of this chain are contained in the stack frames + of Fcondition_case and internal_condition_case. + When an error is signaled (by calling Fsignal, below), + this chain is searched for an element that applies. */ + struct handler *m_handlerlist; +#define handlerlist (current_thread->m_handlerlist) + + /* Count levels of GCPRO to detect failure to UNGCPRO. */ + int m_gcpro_level; +#define gcpro_level (current_thread->m_gcpro_level) + + /* Current number of specbindings allocated in specpdl. */ + ptrdiff_t m_specpdl_size; +#define specpdl_size (current_thread->m_specpdl_size) + + /* Pointer to beginning of specpdl. */ + struct specbinding *m_specpdl; +#define specpdl (current_thread->m_specpdl) + + /* Pointer to first unused element in specpdl. */ + struct specbinding *m_specpdl_ptr; +#define specpdl_ptr (current_thread->m_specpdl_ptr) + + /* Depth in Lisp evaluations and function calls. */ + EMACS_INT m_lisp_eval_depth; +#define lisp_eval_depth (current_thread->m_lisp_eval_depth) + + /* This points to the current buffer. */ + struct buffer *m_current_buffer; +#define current_buffer (current_thread->m_current_buffer) + + /* Every call to re_match, etc., must pass &search_regs as the regs + argument unless you can show it is unnecessary (i.e., if re_match + is certainly going to be called again before region-around-match + can be called). + + Since the registers are now dynamically allocated, we need to make + sure not to refer to the Nth register before checking that it has + been allocated by checking search_regs.num_regs. + + The regex code keeps track of whether it has allocated the search + buffer using bits in the re_pattern_buffer. This means that whenever + you compile a new pattern, it completely forgets whether it has + allocated any registers, and will allocate new registers the next + time you call a searching or matching function. Therefore, we need + to call re_set_registers after compiling a new pattern or after + setting the match registers, so that the regex functions will be + able to free or re-allocate it properly. */ + struct re_registers m_search_regs; +#define search_regs (current_thread->m_search_regs) + + /* If non-zero the match data have been saved in saved_search_regs + during the execution of a sentinel or filter. */ + int m_search_regs_saved; +#define search_regs_saved (current_thread->m_search_regs_saved) + + struct re_registers m_saved_search_regs; +#define saved_search_regs (current_thread->m_saved_search_regs) + + /* This is the string or buffer in which we + are matching. It is used for looking up syntax properties. */ + Lisp_Object m_re_match_object; +#define re_match_object (current_thread->m_re_match_object) + + /* Set by `re_set_syntax' to the current regexp syntax to recognize. Can + also be assigned to arbitrarily: each pattern buffer stores its own + syntax, so it can be changed between regex compilations. */ + reg_syntax_t m_re_syntax_options; +#define re_syntax_options (current_thread->m_re_syntax_options) + + /* Regexp to use to replace spaces, or NULL meaning don't. */ + /*re_char*/ unsigned char *m_whitespace_regexp; +#define whitespace_regexp (current_thread->m_whitespace_regexp) +}; + +extern struct thread_state *current_thread; + +#endif /* THREAD_H */ -- cgit v1.2.3 From 2d525b793f1b0fd2b6f66881310bec8684bceffe Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 15 Aug 2012 13:01:36 -0600 Subject: This parameterizes the GC a bit to make it thread-ready. The basic idea is that whenever a thread "exits lisp" -- that is, releases the global lock in favor of another thread -- it must save its stack boundaries in the thread object. This way the boundaries are always available for marking. This is the purpose of flush_stack_call_func. I haven't tested this under all the possible GC configurations. There is a new FIXME in a spot that i didn't convert. Arguably all_threads should go in the previous patch. --- src/alloc.c | 78 +++++++++++++++++++-------------------------------------- src/bytecode.c | 11 +++----- src/eval.c | 13 ++++++++++ src/lisp.h | 18 +++++++++---- src/thread.c | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/thread.h | 5 ++++ 6 files changed, 140 insertions(+), 64 deletions(-) (limited to 'src/thread.h') diff --git a/src/alloc.c b/src/alloc.c index bdf7b24af04..dfae2d1ef67 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -387,7 +387,6 @@ static struct mem_node mem_z; static struct Lisp_Vector *allocate_vectorlike (ptrdiff_t); static void lisp_free (void *); -static void mark_stack (void); static int live_vector_p (struct mem_node *, void *); static int live_buffer_p (struct mem_node *, void *); static int live_string_p (struct mem_node *, void *); @@ -4865,8 +4864,27 @@ dump_zombies (void) would be necessary, each one starting with one byte more offset from the stack start. */ -static void -mark_stack (void) +void +mark_stack (char *bottom, char *end) +{ + /* This assumes that the stack is a contiguous region in memory. If + that's not the case, something has to be done here to iterate + over the stack segments. */ + mark_memory (bottom, end); + + /* Allow for marking a secondary stack, like the register stack on the + ia64. */ +#ifdef GC_MARK_SECONDARY_STACK + GC_MARK_SECONDARY_STACK (); +#endif + +#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS + check_gcpros (); +#endif +} + +void +flush_stack_call_func (void (*func) (void *arg), void *arg) { void *end; @@ -4922,20 +4940,8 @@ mark_stack (void) #endif /* not GC_SAVE_REGISTERS_ON_STACK */ #endif /* not HAVE___BUILTIN_UNWIND_INIT */ - /* This assumes that the stack is a contiguous region in memory. If - that's not the case, something has to be done here to iterate - over the stack segments. */ - mark_memory (stack_bottom, end); - - /* Allow for marking a secondary stack, like the register stack on the - ia64. */ -#ifdef GC_MARK_SECONDARY_STACK - GC_MARK_SECONDARY_STACK (); -#endif - -#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS - check_gcpros (); -#endif + current_thread->stack_top = end; + (*func) (arg); } #endif /* GC_MARK_STACK != 0 */ @@ -5457,11 +5463,7 @@ See Info node `(elisp)Garbage Collection'. */) for (i = 0; i < staticidx; i++) mark_object (*staticvec[i]); - for (bind = specpdl; bind != specpdl_ptr; bind++) - { - mark_object (bind->symbol); - mark_object (bind->old_value); - } + mark_threads (); mark_terminals (); mark_kboards (); mark_ttys (); @@ -5473,40 +5475,12 @@ See Info node `(elisp)Garbage Collection'. */) } #endif -#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \ - || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS) - mark_stack (); -#else - { - register struct gcpro *tail; - for (tail = gcprolist; tail; tail = tail->next) - for (i = 0; i < tail->nvars; i++) - mark_object (tail->var[i]); - } - mark_byte_stack (); - { - struct catchtag *catch; - struct handler *handler; - - for (catch = catchlist; catch; catch = catch->next) - { - mark_object (catch->tag); - mark_object (catch->val); - } - for (handler = handlerlist; handler; handler = handler->next) - { - mark_object (handler->handler); - mark_object (handler->var); - } - } - mark_backtrace (); -#endif - #ifdef HAVE_WINDOW_SYSTEM mark_fringe_data (); #endif #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES + FIXME; mark_stack (); #endif @@ -5556,7 +5530,7 @@ See Info node `(elisp)Garbage Collection'. */) /* Clear the mark bits that we set in certain root slots. */ - unmark_byte_stack (); + unmark_threads (); VECTOR_UNMARK (&buffer_defaults); VECTOR_UNMARK (&buffer_local_symbols); diff --git a/src/bytecode.c b/src/bytecode.c index 019459491e9..d61e37d7886 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -335,12 +335,11 @@ struct byte_stack #if BYTE_MARK_STACK void -mark_byte_stack (void) +mark_byte_stack (struct byte_stack *stack) { - struct byte_stack *stack; Lisp_Object *obj; - for (stack = byte_stack_list; stack; stack = stack->next) + for (; stack; stack = stack->next) { /* If STACK->top is null here, this means there's an opcode in Fbyte_code that wasn't expected to GC, but did. To find out @@ -364,11 +363,9 @@ mark_byte_stack (void) counters. Called when GC has completed. */ void -unmark_byte_stack (void) +unmark_byte_stack (struct byte_stack *stack) { - struct byte_stack *stack; - - for (stack = byte_stack_list; stack; stack = stack->next) + for (; stack; stack = stack->next) { if (stack->byte_string_start != SDATA (stack->byte_string)) { diff --git a/src/eval.c b/src/eval.c index 768cdc1a8f8..49ead499044 100644 --- a/src/eval.c +++ b/src/eval.c @@ -165,6 +165,19 @@ init_eval (void) when_entered_debugger = -1; } +#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \ + || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS) +void +mark_catchlist (struct catchtag *catch) +{ + for (; catch; catch = catch->next) + { + mark_object (catch->tag); + mark_object (catch->val); + } +} +#endif + /* Unwind-protect function used by call_debugger. */ static Lisp_Object diff --git a/src/lisp.h b/src/lisp.h index 0367d9938b7..a6665320da6 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2715,6 +2715,10 @@ extern void mark_object (Lisp_Object); #if defined REL_ALLOC && !defined SYSTEM_MALLOC extern void refill_memory_reserve (void); #endif +#if GC_MARK_STACK +extern void mark_stack (char *, char *); +#endif +extern void flush_stack_call_func (void (*func) (void *arg), void *arg); extern const char *pending_malloc_warning; extern Lisp_Object zero_vector; extern EMACS_INT consing_since_gc; @@ -2902,6 +2906,10 @@ extern Lisp_Object Vautoload_queue; extern Lisp_Object Vsignaling_function; extern Lisp_Object inhibit_lisp_code; extern int handling_signal; +#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \ + || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS) +extern void mark_catchlist (struct catchtag *); +#endif /* To run a normal hook, use the appropriate function from the list below. The calling convention: @@ -2951,11 +2959,11 @@ extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...); extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object); extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object); extern void init_eval (void); -#if BYTE_MARK_STACK -extern void mark_backtrace (void); -#endif extern void syms_of_eval (void); +/* Defined in thread.c. */ +extern void mark_threads (void); + /* Defined in editfns.c. */ extern Lisp_Object Qfield; extern void insert1 (Lisp_Object); @@ -3211,9 +3219,9 @@ extern int read_bytecode_char (int); extern Lisp_Object Qbytecode; extern void syms_of_bytecode (void); #if BYTE_MARK_STACK -extern void mark_byte_stack (void); +extern void mark_byte_stack (struct byte_stack *); #endif -extern void unmark_byte_stack (void); +extern void unmark_byte_stack (struct byte_stack *); extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, ptrdiff_t, Lisp_Object *); diff --git a/src/thread.c b/src/thread.c index 0bd97b4fd8e..ba2d66320fa 100644 --- a/src/thread.c +++ b/src/thread.c @@ -24,3 +24,82 @@ along with GNU Emacs. If not, see . */ struct thread_state the_only_thread; struct thread_state *current_thread = &the_only_thread; + +struct thread_state *all_threads = &the_only_thread; + +static void +mark_one_thread (struct thread_state *thread) +{ + register struct specbinding *bind; + struct handler *handler; + Lisp_Object tem; + + for (bind = thread->m_specpdl; bind != thread->m_specpdl_ptr; bind++) + { + mark_object (bind->symbol); + mark_object (bind->old_value); + } + +#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \ + || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS) + mark_stack (thread->m_stack_bottom, thread->stack_top); +#else + { + register struct gcpro *tail; + for (tail = thread->m_gcprolist; tail; tail = tail->next) + for (i = 0; i < tail->nvars; i++) + mark_object (tail->var[i]); + } + +#if BYTE_MARK_STACK + if (thread->m_byte_stack_list) + mark_byte_stack (thread->m_byte_stack_list); +#endif + + mark_catchlist (thread->m_catchlist); + + for (handler = thread->m_handlerlist; handler; handler = handler->next) + { + mark_object (handler->handler); + mark_object (handler->var); + } + + mark_backtrace (thread->m_backtrace_list); +#endif + + if (thread->m_current_buffer) + { + XSETBUFFER (tem, thread->m_current_buffer); + mark_object (tem); + } + + mark_object (thread->m_last_thing_searched); + + if (thread->m_saved_last_thing_searched) + mark_object (thread->m_saved_last_thing_searched); +} + +static void +mark_threads_callback (void *ignore) +{ + struct thread_state *iter; + + for (iter = all_threads; iter; iter = iter->next_thread) + mark_one_thread (iter); +} + +void +mark_threads (void) +{ + flush_stack_call_func (mark_threads_callback, NULL); +} + +void +unmark_threads (void) +{ + struct thread_state *iter; + + for (iter = all_threads; iter; iter = iter->next_thread) + if (iter->m_byte_stack_list) + unmark_byte_stack (iter->m_byte_stack_list); +} diff --git a/src/thread.h b/src/thread.h index b2eb04d42e8..6d61d0e5fcf 100644 --- a/src/thread.h +++ b/src/thread.h @@ -133,8 +133,13 @@ struct thread_state /* Regexp to use to replace spaces, or NULL meaning don't. */ /*re_char*/ unsigned char *m_whitespace_regexp; #define whitespace_regexp (current_thread->m_whitespace_regexp) + + /* Threads are kept on a linked list. */ + struct thread_state *next_thread; }; extern struct thread_state *current_thread; +extern void unmark_threads (void); + #endif /* THREAD_H */ -- cgit v1.2.3 From 14b3dc5e4f2cdefde1ba04ddd3525115e7ca7dce Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 15 Aug 2012 13:03:17 -0600 Subject: This introduces the low-level system threading support. It also adds the global lock. The low-level support is a bit over-eager, in that even at the end of the present series, it will not all be used. I think thiat is ok since I plan to use it all eventually -- in particular for the emacs lisp mutex implementation. I've only implemented the pthreads-based version. I think it should be relatively clear how to port this to other systems, though. I'd also like to do a "no threads" port that will turn most things into no-ops, and have thread-creation fail. I was thinking perhaps I'd make a future (provide 'threads) conditional on threads actually working. One other minor enhancement available here is to make it possible to set the name of the new thread at the OS layer. That way gdb, e.g., could display thread names. --- src/Makefile.in | 2 +- src/emacs.c | 1 + src/lisp.h | 2 + src/systhread.c | 189 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/systhread.h | 80 ++++++++++++++++++++++++ src/thread.c | 9 +++ src/thread.h | 4 ++ 7 files changed, 286 insertions(+), 1 deletion(-) create mode 100644 src/systhread.c create mode 100644 src/systhread.h (limited to 'src/thread.h') diff --git a/src/Makefile.in b/src/Makefile.in index 2d1bdd097ef..01034ca98d5 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -336,7 +336,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ eval.o floatfns.o fns.o font.o print.o lread.o \ syntax.o $(UNEXEC_OBJ) bytecode.o \ process.o gnutls.o callproc.o \ - region-cache.o sound.o atimer.o thread.o \ + region-cache.o sound.o atimer.o thread.o systhread.o \ doprnt.o intervals.o textprop.o composite.o xml.o \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) obj = $(base_obj) $(NS_OBJC_OBJ) diff --git a/src/emacs.c b/src/emacs.c index e1acd365e29..443fe594795 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1270,6 +1270,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem } init_alloc (); + init_threads (); if (do_initial_setlocale) { diff --git a/src/lisp.h b/src/lisp.h index a6665320da6..b0ed9be9f07 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -29,6 +29,8 @@ along with GNU Emacs. If not, see . */ #include +#include "systhread.h" + INLINE_HEADER_BEGIN #ifndef LISP_INLINE # define LISP_INLINE INLINE diff --git a/src/systhread.c b/src/systhread.c new file mode 100644 index 00000000000..b7147c4fc95 --- /dev/null +++ b/src/systhread.c @@ -0,0 +1,189 @@ +/* System thread definitions + Copyright (C) 2012 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include +#include +#include "lisp.h" + +#ifdef HAVE_PTHREAD + +#include + +void +sys_mutex_init (sys_mutex_t *mutex) +{ + pthread_mutex_init (mutex, NULL); +} + +void +sys_mutex_lock (sys_mutex_t *mutex) +{ + pthread_mutex_lock (mutex); +} + +void +sys_mutex_unlock (sys_mutex_t *mutex) +{ + pthread_mutex_unlock (mutex); +} + +void +sys_mutex_destroy (sys_mutex_t *mutex) +{ + pthread_mutex_destroy (mutex); +} + +void +sys_cond_init (sys_cond_t *cond) +{ + pthread_cond_init (cond, NULL); +} + +void +sys_cond_wait (sys_cond_t *cond, sys_mutex_t *mutex) +{ + pthread_cond_wait (cond, mutex); +} + +void +sys_cond_signal (sys_cond_t *cond) +{ + pthread_cond_signal (cond); +} + +void +sys_cond_broadcast (sys_cond_t *cond) +{ + pthread_cond_broadcast (cond); +} + +void +sys_cond_destroy (sys_cond_t *cond) +{ + pthread_cond_destroy (cond); +} + +void +lisp_mutex_init (lisp_mutex_t *mutex) +{ + mutex->owner = NULL; + mutex->count = 0; + /* A lisp "mutex" is really a condition variable. */ + pthread_cond_init (&mutex->condition, NULL); +} + +void +lisp_mutex_lock (lisp_mutex_t *mutex) +{ + struct thread_state *self; + + if (mutex->owner == NULL) + { + mutex->owner = current_thread; + mutex->count = 1; + return; + } + if (mutex->owner == current_thread) + { + ++mutex->count; + return; + } + + self = current_thread; + while (mutex->owner != NULL /* && EQ (self->error_symbol, Qnil) */) + pthread_cond_wait (&mutex->condition, &global_lock); + +#if 0 + if (!EQ (self->error_symbol, Qnil)) + { + Lisp_Object error_symbol = self->error_symbol; + Lisp_Object data = self->error_data; + self->error_symbol = Qnil; + self->error_data = Qnil; + Fsignal (error_symbol, error_data); + } +#endif + + mutex->owner = self; + mutex->count = 1; +} + +void +lisp_mutex_unlock (lisp_mutex_t *mutex) +{ + struct thread_state *self = current_thread; + + if (mutex->owner != current_thread) + error ("blah"); + + if (--mutex->count > 0) + return; + + mutex->owner = NULL; + pthread_cond_broadcast (&mutex->condition); + + post_acquire_global_lock (self); +} + +void +lisp_mutex_destroy (lisp_mutex_t *mutex) +{ + sys_cond_destroy (&mutex->condition); +} + +sys_thread_t +sys_thread_self (void) +{ + return pthread_self (); +} + +int +sys_thread_equal (sys_thread_t one, sys_thread_t two) +{ + return pthread_equal (one, two); +} + +int +sys_thread_create (sys_thread_t *thread_ptr, thread_creation_function *func, + void *arg) +{ + pthread_attr_t attr; + int result = 0; + + if (pthread_attr_init (&attr)) + return 0; + + if (!pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED)) + result = pthread_create (thread_ptr, &attr, func, arg) == 0; + + pthread_attr_destroy (&attr); + + return result; +} + +void +sys_thread_yield (void) +{ + sched_yield (); +} + +#else + +#error port me + +#endif diff --git a/src/systhread.h b/src/systhread.h new file mode 100644 index 00000000000..bf9358c21c6 --- /dev/null +++ b/src/systhread.h @@ -0,0 +1,80 @@ +/* System thread definitions + Copyright (C) 2012 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#ifndef SYSTHREAD_H +#define SYSTHREAD_H + +#ifdef HAVE_PTHREAD + +#include + +/* A mutex in lisp is represented by a pthread condition variable. + The pthread mutex associated with this condition variable is the + global lock. + + Using a condition variable lets us implement interruptibility for + lisp mutexes. */ +typedef struct +{ + struct thread_state *owner; + unsigned int count; + pthread_cond_t condition; +} lisp_mutex_t; + +/* A system mutex is just a pthread mutex. This is only used for the + GIL. */ +typedef pthread_mutex_t sys_mutex_t; + +typedef pthread_cond_t sys_cond_t; + +/* A system thread. */ +typedef pthread_t sys_thread_t; + +#else + +#error port me + +#endif + +typedef void *(thread_creation_function) (void *); + +extern void sys_mutex_init (sys_mutex_t *); +extern void sys_mutex_lock (sys_mutex_t *); +extern void sys_mutex_unlock (sys_mutex_t *); +extern void sys_mutex_destroy (sys_mutex_t *); + +extern void sys_cond_init (sys_cond_t *); +extern void sys_cond_wait (sys_cond_t *, sys_mutex_t *); +extern void sys_cond_signal (sys_cond_t *); +extern void sys_cond_broadcast (sys_cond_t *); +extern void sys_cond_destroy (sys_cond_t *); + +extern void lisp_mutex_init (lisp_mutex_t *); +extern void lisp_mutex_lock (lisp_mutex_t *); +extern void lisp_mutex_unlock (lisp_mutex_t *); +extern void lisp_mutex_destroy (lisp_mutex_t *); + +extern sys_thread_t sys_thread_self (void); +extern int sys_thread_equal (sys_thread_t, sys_thread_t); + +extern int sys_thread_create (sys_thread_t *, thread_creation_function *, + void *); + +extern void sys_thread_yield (void); + +#endif /* SYSTHREAD_H */ diff --git a/src/thread.c b/src/thread.c index ba2d66320fa..19faa1bafae 100644 --- a/src/thread.c +++ b/src/thread.c @@ -27,6 +27,8 @@ struct thread_state *current_thread = &the_only_thread; struct thread_state *all_threads = &the_only_thread; +sys_mutex_t global_lock; + static void mark_one_thread (struct thread_state *thread) { @@ -103,3 +105,10 @@ unmark_threads (void) if (iter->m_byte_stack_list) unmark_byte_stack (iter->m_byte_stack_list); } + +void +init_threads (void) +{ + sys_mutex_init (&global_lock); + sys_mutex_lock (&global_lock); +} diff --git a/src/thread.h b/src/thread.h index 6d61d0e5fcf..020346b9af2 100644 --- a/src/thread.h +++ b/src/thread.h @@ -140,6 +140,10 @@ struct thread_state extern struct thread_state *current_thread; +extern sys_mutex_t global_lock; + extern void unmark_threads (void); +extern void init_threads (void); + #endif /* THREAD_H */ -- cgit v1.2.3 From e160922c665ba65e1dba5b87a924927e61be43b9 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 15 Aug 2012 13:04:34 -0600 Subject: This introduces some new functions to handle the specpdl. The basic idea is that when a thread loses the interpreter lock, it will unbind the bindings it has put in place. Then when a thread acquires the lock, it will restore its bindings. This code reuses an existing empty slot in struct specbinding to store the current value when the thread is "swapped out". This approach performs worse than my previously planned approach. However, it was one I could implement with minimal time and brainpower. I hope that perhaps someone else could improve the code once it is in. --- src/eval.c | 165 ++++++++++++++++++++++++++++++++++++++++++++--------------- src/lisp.h | 4 +- src/thread.c | 1 + src/thread.h | 6 +++ 4 files changed, 134 insertions(+), 42 deletions(-) (limited to 'src/thread.h') diff --git a/src/eval.c b/src/eval.c index 49ead499044..f5f6fe7a808 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3102,6 +3102,52 @@ grow_specpdl (void) specpdl_ptr = specpdl + count; } +static Lisp_Object +binding_symbol (const struct specbinding *bind) +{ + if (!CONSP (bind->symbol)) + return bind->symbol; + return XCAR (bind->symbol); +} + +void +do_specbind (struct Lisp_Symbol *sym, struct specbinding *bind, + Lisp_Object value) +{ + switch (sym->redirect) + { + case SYMBOL_PLAINVAL: + if (!sym->constant) + SET_SYMBOL_VAL (sym, value); + else + set_internal (bind->symbol, value, Qnil, 1); + break; + + case SYMBOL_LOCALIZED: + case SYMBOL_FORWARDED: + if ((sym->redirect == SYMBOL_LOCALIZED + || BUFFER_OBJFWDP (SYMBOL_FWD (sym))) + && CONSP (bind->symbol)) + { + Lisp_Object where; + + where = XCAR (XCDR (bind->symbol)); + if (NILP (where) + && sym->redirect == SYMBOL_FORWARDED) + { + Fset_default (XCAR (bind->symbol), value); + return; + } + } + + set_internal (binding_symbol (bind), value, Qnil, 1); + break; + + default: + abort (); + } +} + /* `specpdl_ptr->symbol' is a field which describes which variable is let-bound, so it can be properly undone when we unbind_to. It can have the following two shapes: @@ -3140,11 +3186,9 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->symbol = symbol; specpdl_ptr->old_value = SYMBOL_VAL (sym); specpdl_ptr->func = NULL; + specpdl_ptr->saved_value = Qnil; ++specpdl_ptr; - if (!sym->constant) - SET_SYMBOL_VAL (sym, value); - else - set_internal (symbol, value, Qnil, 1); + do_specbind (sym, specpdl_ptr - 1, value); break; case SYMBOL_LOCALIZED: if (SYMBOL_BLV (sym)->frame_local) @@ -3199,7 +3243,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) { eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym))); ++specpdl_ptr; - Fset_default (symbol, value); + do_specbind (sym, specpdl_ptr - 1, value); return; } } @@ -3207,7 +3251,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->symbol = symbol; specpdl_ptr++; - set_internal (symbol, value, Qnil, 1); + do_specbind (sym, specpdl_ptr - 1, value); break; } default: abort (); @@ -3224,9 +3268,67 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) specpdl_ptr->func = function; specpdl_ptr->symbol = Qnil; specpdl_ptr->old_value = arg; + specpdl_ptr->saved_value = Qnil; specpdl_ptr++; } +void +rebind_for_thread_switch (void) +{ + struct specbinding *bind; + + for (bind = specpdl; bind != specpdl_ptr; ++bind) + { + if (bind->func == NULL) + { + Lisp_Object value = bind->saved_value; + + bind->saved_value = Qnil; + do_specbind (XSYMBOL (binding_symbol (bind)), bind, value); + } + } +} + +static void +do_one_unbind (const struct specbinding *this_binding, int unwinding) +{ + if (this_binding->func != 0) + (*this_binding->func) (this_binding->old_value); + /* If the symbol is a list, it is really (SYMBOL WHERE + . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a + frame. If WHERE is a buffer or frame, this indicates we + bound a variable that had a buffer-local or frame-local + binding. WHERE nil means that the variable had the default + value when it was bound. CURRENT-BUFFER is the buffer that + was current when the variable was bound. */ + else if (CONSP (this_binding->symbol)) + { + Lisp_Object symbol, where; + + symbol = XCAR (this_binding->symbol); + where = XCAR (XCDR (this_binding->symbol)); + + if (NILP (where)) + Fset_default (symbol, this_binding->old_value); + /* If `where' is non-nil, reset the value in the appropriate + local binding, but only if that binding still exists. */ + else if (BUFFERP (where) + ? !NILP (Flocal_variable_p (symbol, where)) + : !NILP (Fassq (symbol, XFRAME (where)->param_alist))) + set_internal (symbol, this_binding->old_value, where, 1); + } + /* If variable has a trivial value (no forwarding), we can + just set it. No need to check for constant symbols here, + since that was already done by specbind. */ + else if (XSYMBOL (this_binding->symbol)->redirect == SYMBOL_PLAINVAL) + SET_SYMBOL_VAL (XSYMBOL (this_binding->symbol), + this_binding->old_value); + else + /* NOTE: we only ever come here if make_local_foo was used for + the first time on this var within this let. */ + Fset_default (this_binding->symbol, this_binding->old_value); +} + Lisp_Object unbind_to (ptrdiff_t count, Lisp_Object value) { @@ -3247,41 +3349,7 @@ unbind_to (ptrdiff_t count, Lisp_Object value) struct specbinding this_binding; this_binding = *--specpdl_ptr; - if (this_binding.func != 0) - (*this_binding.func) (this_binding.old_value); - /* If the symbol is a list, it is really (SYMBOL WHERE - . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a - frame. If WHERE is a buffer or frame, this indicates we - bound a variable that had a buffer-local or frame-local - binding. WHERE nil means that the variable had the default - value when it was bound. CURRENT-BUFFER is the buffer that - was current when the variable was bound. */ - else if (CONSP (this_binding.symbol)) - { - Lisp_Object symbol, where; - - symbol = XCAR (this_binding.symbol); - where = XCAR (XCDR (this_binding.symbol)); - - if (NILP (where)) - Fset_default (symbol, this_binding.old_value); - /* If `where' is non-nil, reset the value in the appropriate - local binding, but only if that binding still exists. */ - else if (BUFFERP (where) - ? !NILP (Flocal_variable_p (symbol, where)) - : !NILP (Fassq (symbol, XFRAME (where)->param_alist))) - set_internal (symbol, this_binding.old_value, where, 1); - } - /* If variable has a trivial value (no forwarding), we can - just set it. No need to check for constant symbols here, - since that was already done by specbind. */ - else if (XSYMBOL (this_binding.symbol)->redirect == SYMBOL_PLAINVAL) - SET_SYMBOL_VAL (XSYMBOL (this_binding.symbol), - this_binding.old_value); - else - /* NOTE: we only ever come here if make_local_foo was used for - the first time on this var within this let. */ - Fset_default (this_binding.symbol, this_binding.old_value); + do_one_unbind (&this_binding, 1); } if (NILP (Vquit_flag) && !NILP (quitf)) @@ -3291,6 +3359,21 @@ unbind_to (ptrdiff_t count, Lisp_Object value) return value; } +void +unbind_for_thread_switch (void) +{ + struct specbinding *bind; + + for (bind = specpdl_ptr; bind != specpdl; --bind) + { + if (bind->func == NULL) + { + bind->saved_value = find_symbol_value (binding_symbol (bind)); + do_one_unbind (bind, 0); + } + } +} + DEFUN ("special-variable-p", Fspecial_variable_p, Sspecial_variable_p, 1, 1, 0, doc: /* Return non-nil if SYMBOL's global binding has been declared special. A special variable is one that will be bound dynamically, even in a diff --git a/src/lisp.h b/src/lisp.h index b0ed9be9f07..cbb5b51c783 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2014,7 +2014,9 @@ struct specbinding { Lisp_Object symbol, old_value; specbinding_func func; - Lisp_Object unused; /* Dividing by 16 is faster than by 12 */ + /* Normally this is unused; but it is to the symbol's current + value when a thread is swapped out. */ + Lisp_Object saved_value; }; #define SPECPDL_INDEX() (specpdl_ptr - specpdl) diff --git a/src/thread.c b/src/thread.c index 19faa1bafae..605a52cb2f9 100644 --- a/src/thread.c +++ b/src/thread.c @@ -40,6 +40,7 @@ mark_one_thread (struct thread_state *thread) { mark_object (bind->symbol); mark_object (bind->old_value); + mark_object (bind->saved_value); } #if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \ diff --git a/src/thread.h b/src/thread.h index 020346b9af2..def05fdaec9 100644 --- a/src/thread.h +++ b/src/thread.h @@ -83,6 +83,12 @@ struct thread_state struct specbinding *m_specpdl_ptr; #define specpdl_ptr (current_thread->m_specpdl_ptr) + /* Pointer to the first "saved" element in specpdl. When this + thread is swapped out, the current values of all specpdl bindings + are pushed onto the specpdl; then these are popped again when + switching back to this thread. */ + struct specbinding *m_saved_specpdl_ptr; + /* Depth in Lisp evaluations and function calls. */ EMACS_INT m_lisp_eval_depth; #define lisp_eval_depth (current_thread->m_lisp_eval_depth) -- cgit v1.2.3 From 60a9d2a7728895c1a5bfbc37c3bfa8fde35abe61 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 15 Aug 2012 13:07:04 -0600 Subject: This turns thread_state into a pseudovector and updates various bits of Emacs to cope. --- src/emacs.c | 1 + src/lisp.h | 3 +++ src/print.c | 12 ++++++++++++ src/thread.c | 22 +++++++++++++++++++--- src/thread.h | 3 +++ 5 files changed, 38 insertions(+), 3 deletions(-) (limited to 'src/thread.h') diff --git a/src/emacs.c b/src/emacs.c index 443fe594795..ca9f201e8f5 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1226,6 +1226,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (!initialized) { init_alloc_once (); + init_threads_once (); init_obarray (); init_eval_once (); init_charset_once (); diff --git a/src/lisp.h b/src/lisp.h index cbb5b51c783..2b3d40d3b29 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -365,6 +365,7 @@ enum pvec_type PVEC_WINDOW_CONFIGURATION, PVEC_SUBR, PVEC_OTHER, + PVEC_THREAD, /* These last 4 are special because we OR them in fns.c:internal_equal, so they have to use a disjoint bit pattern: if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE @@ -603,6 +604,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE)) #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) +#define XSETTHREAD(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_THREAD)) /* Convenience macros for dealing with Lisp arrays. */ @@ -1701,6 +1703,7 @@ typedef struct { #define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE) #define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR) #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME) +#define THREADP(x) PSEUDOVECTORP (x, PVEC_THREAD) /* Test for image (image . spec) */ #define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) diff --git a/src/print.c b/src/print.c index 23ad6c0a256..4537521b9fa 100644 --- a/src/print.c +++ b/src/print.c @@ -1943,6 +1943,18 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag } PRINTCHAR ('>'); } + else if (THREADP (obj)) + { + strout ("#name)) + print_string (XTHREAD (obj)->name, printcharfun); + else + { + int len = sprintf (buf, "%p", XTHREAD (obj)); + strout (buf, len, len, printcharfun); + } + PRINTCHAR ('>'); + } else { ptrdiff_t size = ASIZE (obj); diff --git a/src/thread.c b/src/thread.c index 605a52cb2f9..7d2f81ec9ce 100644 --- a/src/thread.c +++ b/src/thread.c @@ -32,7 +32,7 @@ sys_mutex_t global_lock; static void mark_one_thread (struct thread_state *thread) { - register struct specbinding *bind; + struct specbinding *bind; struct handler *handler; Lisp_Object tem; @@ -48,7 +48,7 @@ mark_one_thread (struct thread_state *thread) mark_stack (thread->m_stack_bottom, thread->stack_top); #else { - register struct gcpro *tail; + struct gcpro *tail; for (tail = thread->m_gcprolist; tail; tail = tail->next) for (i = 0; i < tail->nvars; i++) mark_object (tail->var[i]); @@ -88,7 +88,13 @@ mark_threads_callback (void *ignore) struct thread_state *iter; for (iter = all_threads; iter; iter = iter->next_thread) - mark_one_thread (iter); + { + Lisp_Object thread_obj; + + XSETTHREAD (thread_obj, iter); + mark_object (thread_obj); + mark_one_thread (iter); + } } void @@ -107,6 +113,16 @@ unmark_threads (void) unmark_byte_stack (iter->m_byte_stack_list); } +void +init_threads_once (void) +{ + the_only_thread.header.size + = PSEUDOVECSIZE (struct thread_state, m_gcprolist); + XSETPVECTYPE (&the_only_thread, PVEC_THREAD); + the_only_thread.m_last_thing_searched = Qnil; + the_only_thread.m_saved_last_thing_searched = Qnil; +} + void init_threads (void) { diff --git a/src/thread.h b/src/thread.h index def05fdaec9..df26b887d1f 100644 --- a/src/thread.h +++ b/src/thread.h @@ -23,6 +23,8 @@ along with GNU Emacs. If not, see . */ struct thread_state { + struct vectorlike_header header; + /* The buffer in which the last search was performed, or Qt if the last search was done in a string; Qnil if no searching has been done yet. */ @@ -150,6 +152,7 @@ extern sys_mutex_t global_lock; extern void unmark_threads (void); +extern void init_threads_once (void); extern void init_threads (void); #endif /* THREAD_H */ -- cgit v1.2.3 From 1dcacbc64721b1a4de58aa36460b0a39e766be63 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 15 Aug 2012 13:09:32 -0600 Subject: This adds most of the thread features visible to emacs lisp. I roughly followed the Bordeaux threads API: http://trac.common-lisp.net/bordeaux-threads/wiki/ApiDocumentation ... but not identically. In particular I chose not to implement interrupt-thread or destroy-thread, but instead a thread-signalling approach. I'm still undecided about *default-special-bindings* (which I did not implement). I think it would be more emacs-like to capture the let bindings at make-thread time, but IIRC Stefan didn't like this idea the first time around. There are one or two semantics issues pointed out in the patch where I could use some advice. --- src/alloc.c | 3 + src/data.c | 15 +++ src/emacs.c | 2 + src/lisp.h | 5 + src/systhread.c | 15 +-- src/thread.c | 354 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-- src/thread.h | 25 ++++ 7 files changed, 400 insertions(+), 19 deletions(-) (limited to 'src/thread.h') diff --git a/src/alloc.c b/src/alloc.c index dfae2d1ef67..69742a325d1 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3102,6 +3102,9 @@ sweep_vectors (void) ptrdiff_t nbytes = PSEUDOVECTOR_NBYTES (vector); ptrdiff_t total_bytes = nbytes; + if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_THREAD)) + finalize_one_thread ((struct thread_state *) vector); + next = ADVANCE (vector, nbytes); /* While NEXT is not marked, try to coalesce with VECTOR, diff --git a/src/data.c b/src/data.c index d0ef5734abc..fd2194fe1ae 100644 --- a/src/data.c +++ b/src/data.c @@ -94,6 +94,7 @@ static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; static Lisp_Object Qsubrp, Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; static Lisp_Object Qdefun; +Lisp_Object Qthread; Lisp_Object Qinteractive_form; @@ -211,6 +212,8 @@ for example, (type-of 1) returns `integer'. */) return Qfont_entity; if (FONT_OBJECT_P (object)) return Qfont_object; + if (THREADP (object)) + return Qthread; return Qvector; case Lisp_Float: @@ -458,6 +461,16 @@ DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0, return Qnil; } +DEFUN ("threadp", Fthreadp, Sthreadp, 1, 1, 0, + doc: /* Return t if OBJECT is a thread. */) + (Lisp_Object object) +{ + if (THREADP (object)) + return Qt; + else + return Qnil; +} + /* Extract and set components of lists */ @@ -3091,6 +3104,7 @@ syms_of_data (void) DEFSYM (Qchar_table, "char-table"); DEFSYM (Qbool_vector, "bool-vector"); DEFSYM (Qhash_table, "hash-table"); + DEFSYM (Qthread, "thread"); /* Used by Fgarbage_collect. */ DEFSYM (Qinterval, "interval"); DEFSYM (Qmisc, "misc"); @@ -3133,6 +3147,7 @@ syms_of_data (void) defsubr (&Ssubrp); defsubr (&Sbyte_code_function_p); defsubr (&Schar_or_string_p); + defsubr (&Sthreadp); defsubr (&Scar); defsubr (&Scdr); defsubr (&Scar_safe); diff --git a/src/emacs.c b/src/emacs.c index ca9f201e8f5..92552521413 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1552,6 +1552,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_ntterm (); #endif /* WINDOWSNT */ + syms_of_threads (); + keys_of_casefiddle (); keys_of_cmds (); keys_of_buffer (); diff --git a/src/lisp.h b/src/lisp.h index 2b3d40d3b29..52a523259db 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -554,6 +554,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) #define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \ ((struct Lisp_Bool_Vector *) \ XUNTAG (a, Lisp_Vectorlike))) +#define XTHREAD(a) (eassert (THREADP (a)), (struct thread_state *) XPNTR(a)) /* Construct a Lisp_Object from a value or address. */ @@ -1822,6 +1823,9 @@ typedef struct { #define CHECK_OVERLAY(x) \ CHECK_TYPE (OVERLAYP (x), Qoverlayp, x) +#define CHECK_THREAD(x) \ + CHECK_TYPE (THREADP (x), Qthreadp, x) + /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ #define CHECK_NUMBER_CAR(x) \ @@ -2444,6 +2448,7 @@ extern Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp; extern Lisp_Object Qbuffer_or_string_p; extern Lisp_Object Qfboundp; extern Lisp_Object Qchar_table_p, Qvector_or_char_table_p; +extern Lisp_Object Qthreadp; extern Lisp_Object Qcdr; diff --git a/src/systhread.c b/src/systhread.c index b7147c4fc95..968620bcd1c 100644 --- a/src/systhread.c +++ b/src/systhread.c @@ -105,19 +105,12 @@ lisp_mutex_lock (lisp_mutex_t *mutex) } self = current_thread; - while (mutex->owner != NULL /* && EQ (self->error_symbol, Qnil) */) + self->wait_condvar = &mutex->condition; + while (mutex->owner != NULL && EQ (self->error_symbol, Qnil)) pthread_cond_wait (&mutex->condition, &global_lock); + self->wait_condvar = NULL; -#if 0 - if (!EQ (self->error_symbol, Qnil)) - { - Lisp_Object error_symbol = self->error_symbol; - Lisp_Object data = self->error_data; - self->error_symbol = Qnil; - self->error_data = Qnil; - Fsignal (error_symbol, error_data); - } -#endif + post_acquire_global_lock (self); mutex->owner = self; mutex->count = 1; diff --git a/src/thread.c b/src/thread.c index 7d2f81ec9ce..5da2e10f1ae 100644 --- a/src/thread.c +++ b/src/thread.c @@ -20,15 +20,70 @@ along with GNU Emacs. If not, see . */ #include #include #include "lisp.h" +#include "character.h" +#include "buffer.h" -struct thread_state the_only_thread; +/* FIXME */ +extern void unbind_for_thread_switch (void); +extern void rebind_for_thread_switch (void); -struct thread_state *current_thread = &the_only_thread; +static struct thread_state primary_thread; -struct thread_state *all_threads = &the_only_thread; +struct thread_state *current_thread = &primary_thread; + +static struct thread_state *all_threads = &primary_thread; sys_mutex_t global_lock; +Lisp_Object Qthreadp; + + + +static void +release_global_lock (void) +{ + sys_mutex_unlock (&global_lock); +} + +/* You must call this after acquiring the global lock. + acquire_global_lock does it for you. */ +void +post_acquire_global_lock (struct thread_state *self) +{ + Lisp_Object buffer; + + if (self != current_thread) + { + unbind_for_thread_switch (); + current_thread = self; + rebind_for_thread_switch (); + } + + /* We need special handling to re-set the buffer. */ + XSETBUFFER (buffer, self->m_current_buffer); + self->m_current_buffer = 0; + set_buffer_internal (XBUFFER (buffer)); + + if (!EQ (current_thread->error_symbol, Qnil)) + { + Lisp_Object sym = current_thread->error_symbol; + Lisp_Object data = current_thread->error_data; + + current_thread->error_symbol = Qnil; + current_thread->error_data = Qnil; + Fsignal (sym, data); + } +} + +static void +acquire_global_lock (struct thread_state *self) +{ + sys_mutex_lock (&global_lock); + post_acquire_global_lock (self); +} + + + static void mark_one_thread (struct thread_state *thread) { @@ -113,19 +168,302 @@ unmark_threads (void) unmark_byte_stack (iter->m_byte_stack_list); } + + +static void +yield_callback (void *ignore) +{ + struct thread_state *self = current_thread; + + release_global_lock (); + sys_thread_yield (); + acquire_global_lock (self); +} + +DEFUN ("thread-yield", Fthread_yield, Sthread_yield, 0, 0, 0, + doc: /* Yield the CPU to another thread. */) + (void) +{ + flush_stack_call_func (yield_callback, NULL); + return Qnil; +} + +static Lisp_Object +invoke_thread_function (void) +{ + Lisp_Object iter; + + int count = SPECPDL_INDEX (); + + Ffuncall (1, ¤t_thread->function); + return unbind_to (count, Qnil); +} + +static Lisp_Object +do_nothing (Lisp_Object whatever) +{ + return whatever; +} + +static void * +run_thread (void *state) +{ + char stack_pos; + struct thread_state *self = state; + struct thread_state **iter; + + self->m_stack_bottom = &stack_pos; + self->stack_top = self->m_stack_bottom = &stack_pos; + self->thread_id = sys_thread_self (); + + acquire_global_lock (self); + + /* It might be nice to do something with errors here. */ + internal_condition_case (invoke_thread_function, Qt, do_nothing); + + unbind_for_thread_switch (); + + /* Unlink this thread from the list of all threads. */ + for (iter = &all_threads; *iter != self; iter = &(*iter)->next_thread) + ; + *iter = (*iter)->next_thread; + + self->m_last_thing_searched = Qnil; + self->m_saved_last_thing_searched = Qnil; + self->name = Qnil; + self->function = Qnil; + self->error_symbol = Qnil; + self->error_data = Qnil; + xfree (self->m_specpdl); + self->m_specpdl = NULL; + self->m_specpdl_ptr = NULL; + self->m_specpdl_size = 0; + + sys_cond_broadcast (&self->thread_condvar); + + release_global_lock (); + + return NULL; +} + void -init_threads_once (void) +finalize_one_thread (struct thread_state *state) { - the_only_thread.header.size + sys_cond_destroy (&state->thread_condvar); +} + +DEFUN ("make-thread", Fmake_thread, Smake_thread, 1, 2, 0, + doc: /* Start a new thread and run FUNCTION in it. +When the function exits, the thread dies. +If NAME is given, it names the new thread. */) + (Lisp_Object function, Lisp_Object name) +{ + sys_thread_t thr; + struct thread_state *new_thread; + Lisp_Object result; + + /* Can't start a thread in temacs. */ + if (!initialized) + abort (); + + new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, m_gcprolist, + PVEC_THREAD); + memset ((char *) new_thread + offsetof (struct thread_state, m_gcprolist), + 0, sizeof (struct thread_state) - offsetof (struct thread_state, + m_gcprolist)); + + new_thread->function = function; + new_thread->name = name; + new_thread->m_last_thing_searched = Qnil; /* copy from parent? */ + new_thread->m_saved_last_thing_searched = Qnil; + new_thread->m_current_buffer = current_thread->m_current_buffer; + new_thread->error_symbol = Qnil; + new_thread->error_data = Qnil; + + new_thread->m_specpdl_size = 50; + new_thread->m_specpdl = xmalloc (new_thread->m_specpdl_size + * sizeof (struct specbinding)); + new_thread->m_specpdl_ptr = new_thread->m_specpdl; + + sys_cond_init (&new_thread->thread_condvar); + + /* We'll need locking here eventually. */ + new_thread->next_thread = all_threads; + all_threads = new_thread; + + if (! sys_thread_create (&thr, run_thread, new_thread)) + { + /* Restore the previous situation. */ + all_threads = all_threads->next_thread; + error ("Could not start a new thread"); + } + + /* FIXME: race here where new thread might not be filled in? */ + XSETTHREAD (result, new_thread); + return result; +} + +DEFUN ("current-thread", Fcurrent_thread, Scurrent_thread, 0, 0, 0, + doc: /* Return the current thread. */) + (void) +{ + Lisp_Object result; + XSETTHREAD (result, current_thread); + return result; +} + +DEFUN ("thread-name", Fthread_name, Sthread_name, 1, 1, 0, + doc: /* Return the name of the THREAD. +The name is the same object that was passed to `make-thread'. */) + (Lisp_Object thread) +{ + struct thread_state *tstate; + + CHECK_THREAD (thread); + tstate = XTHREAD (thread); + + return tstate->name; +} + +static void +thread_signal_callback (void *arg) +{ + struct thread_state *tstate = arg; + struct thread_state *self = current_thread; + + sys_cond_broadcast (tstate->wait_condvar); + post_acquire_global_lock (self); +} + +DEFUN ("thread-signal", Fthread_signal, Sthread_signal, 3, 3, 0, + doc: /* FIXME */) + (Lisp_Object thread, Lisp_Object error_symbol, Lisp_Object data) +{ + struct thread_state *tstate; + + CHECK_THREAD (thread); + tstate = XTHREAD (thread); + + if (tstate == current_thread) + Fsignal (error_symbol, data); + + /* What to do if thread is already signalled? */ + /* What if error_symbol is Qnil? */ + tstate->error_symbol = error_symbol; + tstate->error_data = data; + + if (tstate->wait_condvar) + flush_stack_call_func (thread_signal_callback, tstate); + + return Qnil; +} + +DEFUN ("thread-alive-p", Fthread_alive_p, Sthread_alive_p, 1, 1, 0, + doc: /* FIXME */) + (Lisp_Object thread) +{ + struct thread_state *tstate; + + CHECK_THREAD (thread); + tstate = XTHREAD (thread); + + /* m_specpdl is set when the thread is created and cleared when the + thread dies. */ + return tstate->m_specpdl == NULL ? Qnil : Qt; +} + +static void +thread_join_callback (void *arg) +{ + struct thread_state *tstate = arg; + struct thread_state *self = current_thread; + + self->wait_condvar = &tstate->thread_condvar; + while (tstate->m_specpdl != NULL && EQ (self->error_symbol, Qnil)) + sys_cond_wait (self->wait_condvar, &global_lock); + + self->wait_condvar = NULL; + post_acquire_global_lock (self); +} + +DEFUN ("thread-join", Fthread_join, Sthread_join, 1, 1, 0, + doc: /* FIXME */) + (Lisp_Object thread) +{ + struct thread_state *tstate; + + CHECK_THREAD (thread); + tstate = XTHREAD (thread); + + if (tstate->m_specpdl != NULL) + flush_stack_call_func (thread_join_callback, tstate); + + return Qnil; +} + +DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0, + doc: /* Return a list of all threads. */) + (void) +{ + Lisp_Object result = Qnil; + struct thread_state *iter; + + for (iter = all_threads; iter; iter = iter->next_thread) + { + Lisp_Object thread; + + XSETTHREAD (thread, iter); + result = Fcons (thread, result); + } + + return result; +} + + + +static void +init_primary_thread (void) +{ + primary_thread.header.size = PSEUDOVECSIZE (struct thread_state, m_gcprolist); - XSETPVECTYPE (&the_only_thread, PVEC_THREAD); - the_only_thread.m_last_thing_searched = Qnil; - the_only_thread.m_saved_last_thing_searched = Qnil; + XSETPVECTYPE (&primary_thread, PVEC_THREAD); + primary_thread.m_last_thing_searched = Qnil; + primary_thread.m_saved_last_thing_searched = Qnil; + primary_thread.name = Qnil; + primary_thread.function = Qnil; + primary_thread.error_symbol = Qnil; + primary_thread.error_data = Qnil; + + sys_cond_init (&primary_thread.thread_condvar); +} + +void +init_threads_once (void) +{ + init_primary_thread (); } void init_threads (void) { + init_primary_thread (); + sys_mutex_init (&global_lock); sys_mutex_lock (&global_lock); } + +void +syms_of_threads (void) +{ + defsubr (&Sthread_yield); + defsubr (&Smake_thread); + defsubr (&Scurrent_thread); + defsubr (&Sthread_name); + defsubr (&Sthread_signal); + defsubr (&Sthread_alive_p); + defsubr (&Sthread_join); + defsubr (&Sall_threads); + + Qthreadp = intern_c_string ("threadp"); + staticpro (&Qthreadp); +} diff --git a/src/thread.h b/src/thread.h index df26b887d1f..3b533316817 100644 --- a/src/thread.h +++ b/src/thread.h @@ -34,6 +34,16 @@ struct thread_state Lisp_Object m_saved_last_thing_searched; #define saved_last_thing_searched (current_thread->m_saved_last_thing_searched) + /* The thread's name. */ + Lisp_Object name; + + /* The thread's function. */ + Lisp_Object function; + + /* If non-nil, this thread has been signalled. */ + Lisp_Object error_symbol; + Lisp_Object error_data; + /* m_gcprolist must be the first non-lisp field. */ /* Recording what needs to be marked for gc. */ struct gcpro *m_gcprolist; @@ -142,6 +152,18 @@ struct thread_state /*re_char*/ unsigned char *m_whitespace_regexp; #define whitespace_regexp (current_thread->m_whitespace_regexp) + /* The OS identifier for this thread. */ + sys_thread_t thread_id; + + /* The condition variable for this thread. This is associated with + the global lock. This thread broadcasts to it when it exits. */ + sys_cond_t thread_condvar; + + /* This thread might be waiting for some condition. If so, this + points to the condition. If the thread is interrupted, the + interrupter should broadcast to this condition. */ + sys_cond_t *wait_condvar; + /* Threads are kept on a linked list. */ struct thread_state *next_thread; }; @@ -149,10 +171,13 @@ struct thread_state extern struct thread_state *current_thread; extern sys_mutex_t global_lock; +extern void post_acquire_global_lock (struct thread_state *); extern void unmark_threads (void); +extern void finalize_one_thread (struct thread_state *state); extern void init_threads_once (void); extern void init_threads (void); +extern void syms_of_threads (void); #endif /* THREAD_H */ -- cgit v1.2.3 From 51100bb8d36f68842ab55fd0501af56dfc58cc51 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 15 Aug 2012 13:11:22 -0600 Subject: This supplies the mutex implementation for Emacs Lisp. A lisp mutex is implemented using a condition variable, so that we can interrupt a mutex-lock operation by calling thread-signal on the blocking thread. I did things this way because pthread_mutex_lock can't readily be interrupted. --- src/alloc.c | 2 ++ src/data.c | 15 ++++++++++- src/lisp.h | 9 ++++++- src/print.c | 8 ++++++ src/thread.c | 83 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- src/thread.h | 3 +++ 6 files changed, 117 insertions(+), 3 deletions(-) (limited to 'src/thread.h') diff --git a/src/alloc.c b/src/alloc.c index 69742a325d1..80d22d61d66 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3104,6 +3104,8 @@ sweep_vectors (void) if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_THREAD)) finalize_one_thread ((struct thread_state *) vector); + else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MUTEX)) + finalize_one_mutex ((struct Lisp_Mutex *) vector); next = ADVANCE (vector, nbytes); diff --git a/src/data.c b/src/data.c index fd2194fe1ae..b47c2d12aff 100644 --- a/src/data.c +++ b/src/data.c @@ -94,7 +94,7 @@ static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; static Lisp_Object Qsubrp, Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; static Lisp_Object Qdefun; -Lisp_Object Qthread; +Lisp_Object Qthread, Qmutex; Lisp_Object Qinteractive_form; @@ -214,6 +214,8 @@ for example, (type-of 1) returns `integer'. */) return Qfont_object; if (THREADP (object)) return Qthread; + if (MUTEXP (object)) + return Qmutex; return Qvector; case Lisp_Float: @@ -471,6 +473,15 @@ DEFUN ("threadp", Fthreadp, Sthreadp, 1, 1, 0, return Qnil; } +DEFUN ("mutexp", Fmutexp, Smutexp, 1, 1, 0, + doc: /* Return t if OBJECT is a mutex. */) + (Lisp_Object object) +{ + if (MUTEXP (object)) + return Qt; + else + return Qnil; +} /* Extract and set components of lists */ @@ -3105,6 +3116,7 @@ syms_of_data (void) DEFSYM (Qbool_vector, "bool-vector"); DEFSYM (Qhash_table, "hash-table"); DEFSYM (Qthread, "thread"); + DEFSYM (Qmutex, "mutex"); /* Used by Fgarbage_collect. */ DEFSYM (Qinterval, "interval"); DEFSYM (Qmisc, "misc"); @@ -3148,6 +3160,7 @@ syms_of_data (void) defsubr (&Sbyte_code_function_p); defsubr (&Schar_or_string_p); defsubr (&Sthreadp); + defsubr (&Smutexp); defsubr (&Scar); defsubr (&Scdr); defsubr (&Scar_safe); diff --git a/src/lisp.h b/src/lisp.h index 52a523259db..f0c831852f6 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -366,6 +366,7 @@ enum pvec_type PVEC_SUBR, PVEC_OTHER, PVEC_THREAD, + PVEC_MUTEX, /* These last 4 are special because we OR them in fns.c:internal_equal, so they have to use a disjoint bit pattern: if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE @@ -555,6 +556,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) ((struct Lisp_Bool_Vector *) \ XUNTAG (a, Lisp_Vectorlike))) #define XTHREAD(a) (eassert (THREADP (a)), (struct thread_state *) XPNTR(a)) +#define XMUTEX(a) (eassert (MUTEXP (a)), (struct Lisp_Mutex *) XPNTR(a)) /* Construct a Lisp_Object from a value or address. */ @@ -606,6 +608,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) #define XSETTHREAD(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_THREAD)) +#define XSETMUTEX(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_MUTEX)) /* Convenience macros for dealing with Lisp arrays. */ @@ -1705,6 +1708,7 @@ typedef struct { #define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR) #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME) #define THREADP(x) PSEUDOVECTORP (x, PVEC_THREAD) +#define MUTEXP(x) PSEUDOVECTORP (x, PVEC_MUTEX) /* Test for image (image . spec) */ #define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) @@ -1826,6 +1830,9 @@ typedef struct { #define CHECK_THREAD(x) \ CHECK_TYPE (THREADP (x), Qthreadp, x) +#define CHECK_MUTEX(x) \ + CHECK_TYPE (MUTEXP (x), Qmutexp, x) + /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ #define CHECK_NUMBER_CAR(x) \ @@ -2448,7 +2455,7 @@ extern Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp; extern Lisp_Object Qbuffer_or_string_p; extern Lisp_Object Qfboundp; extern Lisp_Object Qchar_table_p, Qvector_or_char_table_p; -extern Lisp_Object Qthreadp; +extern Lisp_Object Qthreadp, Qmutexp; extern Lisp_Object Qcdr; diff --git a/src/print.c b/src/print.c index 4537521b9fa..42e7241ecba 100644 --- a/src/print.c +++ b/src/print.c @@ -1955,6 +1955,14 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag } PRINTCHAR ('>'); } + else if (MUTEXP (obj)) + { + int len; + strout ("#'); + } else { ptrdiff_t size = ASIZE (obj); diff --git a/src/thread.c b/src/thread.c index 5da2e10f1ae..80557e5d5ee 100644 --- a/src/thread.c +++ b/src/thread.c @@ -35,7 +35,83 @@ static struct thread_state *all_threads = &primary_thread; sys_mutex_t global_lock; -Lisp_Object Qthreadp; +Lisp_Object Qthreadp, Qmutexp; + + + +struct Lisp_Mutex +{ + struct vectorlike_header header; + + lisp_mutex_t mutex; +}; + +DEFUN ("make-mutex", Fmake_mutex, Smake_mutex, 0, 0, 0, + doc: /* FIXME */) + (void) +{ + struct Lisp_Mutex *mutex; + Lisp_Object result; + + mutex = ALLOCATE_PSEUDOVECTOR (struct Lisp_Mutex, mutex, PVEC_MUTEX); + memset ((char *) mutex + offsetof (struct Lisp_Mutex, mutex), + 0, sizeof (struct Lisp_Mutex) - offsetof (struct Lisp_Mutex, + mutex)); + lisp_mutex_init (&mutex->mutex); + + XSETMUTEX (result, mutex); + return result; +} + +static void +mutex_lock_callback (void *arg) +{ + struct Lisp_Mutex *mutex = arg; + + /* This calls post_acquire_global_lock. */ + lisp_mutex_lock (&mutex->mutex); +} + +DEFUN ("mutex-lock", Fmutex_lock, Smutex_lock, 1, 1, 0, + doc: /* FIXME */) + (Lisp_Object obj) +{ + struct Lisp_Mutex *mutex; + + CHECK_MUTEX (obj); + mutex = XMUTEX (obj); + + flush_stack_call_func (mutex_lock_callback, mutex); + return Qnil; +} + +static void +mutex_unlock_callback (void *arg) +{ + struct Lisp_Mutex *mutex = arg; + + /* This calls post_acquire_global_lock. */ + lisp_mutex_unlock (&mutex->mutex); +} + +DEFUN ("mutex-unlock", Fmutex_unlock, Smutex_unlock, 1, 1, 0, + doc: /* FIXME */) + (Lisp_Object obj) +{ + struct Lisp_Mutex *mutex; + + CHECK_MUTEX (obj); + mutex = XMUTEX (obj); + + flush_stack_call_func (mutex_unlock_callback, mutex); + return Qnil; +} + +void +finalize_one_mutex (struct Lisp_Mutex *mutex) +{ + lisp_mutex_destroy (&mutex->mutex); +} @@ -463,7 +539,12 @@ syms_of_threads (void) defsubr (&Sthread_alive_p); defsubr (&Sthread_join); defsubr (&Sall_threads); + defsubr (&Smake_mutex); + defsubr (&Smutex_lock); + defsubr (&Smutex_unlock); Qthreadp = intern_c_string ("threadp"); staticpro (&Qthreadp); + Qmutexp = intern_c_string ("mutexp"); + staticpro (&Qmutexp); } diff --git a/src/thread.h b/src/thread.h index 3b533316817..d3ec38a22b9 100644 --- a/src/thread.h +++ b/src/thread.h @@ -168,6 +168,8 @@ struct thread_state struct thread_state *next_thread; }; +struct Lisp_Mutex; + extern struct thread_state *current_thread; extern sys_mutex_t global_lock; @@ -175,6 +177,7 @@ extern void post_acquire_global_lock (struct thread_state *); extern void unmark_threads (void); extern void finalize_one_thread (struct thread_state *state); +extern void finalize_one_mutex (struct Lisp_Mutex *); extern void init_threads_once (void); extern void init_threads (void); -- cgit v1.2.3 From 8d3566c6a0eb3977c3115ae100a357f8d63cf77e Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 15 Aug 2012 13:14:14 -0600 Subject: This adds names to mutexes. This seemed like a nice debugging extension. --- src/print.c | 10 +++++++--- src/thread.c | 25 ++++++++++++++++--------- src/thread.h | 9 ++++++++- 3 files changed, 31 insertions(+), 13 deletions(-) (limited to 'src/thread.h') diff --git a/src/print.c b/src/print.c index 42e7241ecba..b14a769dc74 100644 --- a/src/print.c +++ b/src/print.c @@ -1957,10 +1957,14 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag } else if (MUTEXP (obj)) { - int len; strout ("#name)) + print_string (XMUTEX (obj)->name, printcharfun); + else + { + int len = sprintf (buf, "%p", XMUTEX (obj)); + strout (buf, len, len, printcharfun); + } PRINTCHAR ('>'); } else diff --git a/src/thread.c b/src/thread.c index 80557e5d5ee..9ec418f9871 100644 --- a/src/thread.c +++ b/src/thread.c @@ -39,16 +39,9 @@ Lisp_Object Qthreadp, Qmutexp; -struct Lisp_Mutex -{ - struct vectorlike_header header; - - lisp_mutex_t mutex; -}; - -DEFUN ("make-mutex", Fmake_mutex, Smake_mutex, 0, 0, 0, +DEFUN ("make-mutex", Fmake_mutex, Smake_mutex, 0, 1, 0, doc: /* FIXME */) - (void) + (Lisp_Object name) { struct Lisp_Mutex *mutex; Lisp_Object result; @@ -57,6 +50,7 @@ DEFUN ("make-mutex", Fmake_mutex, Smake_mutex, 0, 0, 0, memset ((char *) mutex + offsetof (struct Lisp_Mutex, mutex), 0, sizeof (struct Lisp_Mutex) - offsetof (struct Lisp_Mutex, mutex)); + mutex->name = name; lisp_mutex_init (&mutex->mutex); XSETMUTEX (result, mutex); @@ -107,6 +101,18 @@ DEFUN ("mutex-unlock", Fmutex_unlock, Smutex_unlock, 1, 1, 0, return Qnil; } +DEFUN ("mutex-name", Fmutex_name, Smutex_name, 1, 1, 0, + doc: /* FIXME */) + (Lisp_Object obj) +{ + struct Lisp_Mutex *mutex; + + CHECK_MUTEX (obj); + mutex = XMUTEX (obj); + + return mutex->name; +} + void finalize_one_mutex (struct Lisp_Mutex *mutex) { @@ -542,6 +548,7 @@ syms_of_threads (void) defsubr (&Smake_mutex); defsubr (&Smutex_lock); defsubr (&Smutex_unlock); + defsubr (&Smutex_name); Qthreadp = intern_c_string ("threadp"); staticpro (&Qthreadp); diff --git a/src/thread.h b/src/thread.h index d3ec38a22b9..1a193b1e4ae 100644 --- a/src/thread.h +++ b/src/thread.h @@ -168,7 +168,14 @@ struct thread_state struct thread_state *next_thread; }; -struct Lisp_Mutex; +struct Lisp_Mutex +{ + struct vectorlike_header header; + + Lisp_Object name; + + lisp_mutex_t mutex; +}; extern struct thread_state *current_thread; -- cgit v1.2.3 From dbb33d4e99cc9d68dea0b1c137afdb9f19121022 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 15 Aug 2012 13:16:33 -0600 Subject: This adds thread-blocker, a function to examine what a thread is blocked on. I thought this would be another nice debugging addition. --- src/thread.c | 31 ++++++++++++++++++++++++++++++- src/thread.h | 4 ++++ 2 files changed, 34 insertions(+), 1 deletion(-) (limited to 'src/thread.h') diff --git a/src/thread.c b/src/thread.c index 9ec418f9871..40c8be9f4d5 100644 --- a/src/thread.c +++ b/src/thread.c @@ -66,17 +66,27 @@ mutex_lock_callback (void *arg) lisp_mutex_lock (&mutex->mutex); } +static Lisp_Object +do_unwind_mutex_lock (Lisp_Object ignore) +{ + current_thread->event_object = Qnil; + return Qnil; +} + DEFUN ("mutex-lock", Fmutex_lock, Smutex_lock, 1, 1, 0, doc: /* FIXME */) (Lisp_Object obj) { struct Lisp_Mutex *mutex; + ptrdiff_t count = SPECPDL_INDEX (); CHECK_MUTEX (obj); mutex = XMUTEX (obj); + current_thread->event_object = obj; + record_unwind_protect (do_unwind_mutex_lock, Qnil); flush_stack_call_func (mutex_lock_callback, mutex); - return Qnil; + return unbind_to (count, Qnil); } static void @@ -361,6 +371,7 @@ If NAME is given, it names the new thread. */) new_thread->m_current_buffer = current_thread->m_current_buffer; new_thread->error_symbol = Qnil; new_thread->error_data = Qnil; + new_thread->event_object = Qnil; new_thread->m_specpdl_size = 50; new_thread->m_specpdl = xmalloc (new_thread->m_specpdl_size @@ -454,17 +465,33 @@ DEFUN ("thread-alive-p", Fthread_alive_p, Sthread_alive_p, 1, 1, 0, return tstate->m_specpdl == NULL ? Qnil : Qt; } +DEFUN ("thread-blocker", Fthread_blocker, Sthread_blocker, 1, 1, 0, + doc: /* FIXME */) + (Lisp_Object thread) +{ + struct thread_state *tstate; + + CHECK_THREAD (thread); + tstate = XTHREAD (thread); + + return tstate->event_object; +} + static void thread_join_callback (void *arg) { struct thread_state *tstate = arg; struct thread_state *self = current_thread; + Lisp_Object thread; + XSETTHREAD (thread, tstate); + self->event_object = thread; self->wait_condvar = &tstate->thread_condvar; while (tstate->m_specpdl != NULL && EQ (self->error_symbol, Qnil)) sys_cond_wait (self->wait_condvar, &global_lock); self->wait_condvar = NULL; + self->event_object = Qnil; post_acquire_global_lock (self); } @@ -515,6 +542,7 @@ init_primary_thread (void) primary_thread.function = Qnil; primary_thread.error_symbol = Qnil; primary_thread.error_data = Qnil; + primary_thread.event_object = Qnil; sys_cond_init (&primary_thread.thread_condvar); } @@ -544,6 +572,7 @@ syms_of_threads (void) defsubr (&Sthread_signal); defsubr (&Sthread_alive_p); defsubr (&Sthread_join); + defsubr (&Sthread_blocker); defsubr (&Sall_threads); defsubr (&Smake_mutex); defsubr (&Smutex_lock); diff --git a/src/thread.h b/src/thread.h index 1a193b1e4ae..d21887a0928 100644 --- a/src/thread.h +++ b/src/thread.h @@ -44,6 +44,10 @@ struct thread_state Lisp_Object error_symbol; Lisp_Object error_data; + /* If we are waiting for some event, this holds the object we are + waiting on. */ + Lisp_Object event_object; + /* m_gcprolist must be the first non-lisp field. */ /* Recording what needs to be marked for gc. */ struct gcpro *m_gcprolist; -- cgit v1.2.3 From 6c0d5ae50789673f53c834084bbe1f62f5a62731 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 15 Aug 2012 13:19:24 -0600 Subject: process changes This changes wait_reading_process_output to handle threads better. It introduces a wrapper for select that releases the global lock, and it ensures that only a single thread can select a given file descriptor at a time. This also adds the thread-locking feature to processes. By default a process can only have its output accepted by the thread that created it. This can be changed using set-process-thread. (If the thread exits, the process is again available for waiting by any thread.) Note that thread-signal will not currently interrupt a thread blocked on select. I'll fix this later. --- src/process.c | 175 ++++++++++++++++++++++++++++++++++++++++++++++++---------- src/process.h | 5 ++ src/thread.c | 47 ++++++++++++++++ src/thread.h | 22 ++++++++ 4 files changed, 221 insertions(+), 28 deletions(-) (limited to 'src/thread.h') diff --git a/src/process.c b/src/process.c index 0d3355512b8..ada673e3c34 100644 --- a/src/process.c +++ b/src/process.c @@ -335,6 +335,13 @@ static struct fd_callback_data void *data; /* Flags from enum fd_bits. */ int flags; + /* If this fd is locked to a certain thread, this points to it. + Otherwise, this is NULL. If an fd is locked to a thread, then + only that thread is permitted to wait on it. */ + struct thread_state *thread; + /* If this fd is currently being selected on by a thread, this + points to the thread. Otherwise it is NULL. */ + struct thread_state *waiting_thread; } fd_callback_info[MAXDESC]; @@ -451,8 +458,17 @@ compute_input_wait_mask (SELECT_TYPE *mask) FD_ZERO (mask); for (fd = 0; fd < max (max_process_desc, max_input_desc); ++fd) { + if (fd_callback_info[fd].thread != NULL + && fd_callback_info[fd].thread != current_thread) + continue; + if (fd_callback_info[fd].waiting_thread != NULL + && fd_callback_info[fd].waiting_thread != current_thread) + continue; if ((fd_callback_info[fd].flags & FOR_READ) != 0) - FD_SET (fd, mask); + { + FD_SET (fd, mask); + fd_callback_info[fd].waiting_thread = current_thread; + } } } @@ -464,9 +480,18 @@ compute_non_process_wait_mask (SELECT_TYPE *mask) FD_ZERO (mask); for (fd = 0; fd < max (max_process_desc, max_input_desc); ++fd) { + if (fd_callback_info[fd].thread != NULL + && fd_callback_info[fd].thread != current_thread) + continue; + if (fd_callback_info[fd].waiting_thread != NULL + && fd_callback_info[fd].waiting_thread != current_thread) + continue; if ((fd_callback_info[fd].flags & FOR_READ) != 0 && (fd_callback_info[fd].flags & PROCESS_FD) == 0) - FD_SET (fd, mask); + { + FD_SET (fd, mask); + fd_callback_info[fd].waiting_thread = current_thread; + } } } @@ -478,9 +503,18 @@ compute_non_keyboard_wait_mask (SELECT_TYPE *mask) FD_ZERO (mask); for (fd = 0; fd < max (max_process_desc, max_input_desc); ++fd) { + if (fd_callback_info[fd].thread != NULL + && fd_callback_info[fd].thread != current_thread) + continue; + if (fd_callback_info[fd].waiting_thread != NULL + && fd_callback_info[fd].waiting_thread != current_thread) + continue; if ((fd_callback_info[fd].flags & FOR_READ) != 0 && (fd_callback_info[fd].flags & KEYBOARD_FD) == 0) - FD_SET (fd, mask); + { + FD_SET (fd, mask); + fd_callback_info[fd].waiting_thread = current_thread; + } } } @@ -492,12 +526,31 @@ compute_write_mask (SELECT_TYPE *mask) FD_ZERO (mask); for (fd = 0; fd < max (max_process_desc, max_input_desc); ++fd) { + if (fd_callback_info[fd].thread != NULL + && fd_callback_info[fd].thread != current_thread) + continue; + if (fd_callback_info[fd].waiting_thread != NULL + && fd_callback_info[fd].waiting_thread != current_thread) + continue; if ((fd_callback_info[fd].flags & FOR_WRITE) != 0) - FD_SET (fd, mask); + { + FD_SET (fd, mask); + fd_callback_info[fd].waiting_thread = current_thread; + } } } +static void +clear_waiting_thread_info (void) +{ + int fd; + for (fd = 0; fd < max (max_process_desc, max_input_desc); ++fd) + { + if (fd_callback_info[fd].waiting_thread == current_thread) + fd_callback_info[fd].waiting_thread = NULL; + } +} /* Compute the Lisp form of the process status, p->status, from @@ -709,6 +762,7 @@ make_process (Lisp_Object name) Lisp data to nil, so do it only for slots which should not be nil. */ PSET (p, status, Qrun); PSET (p, mark, Fmake_marker ()); + PSET (p, thread, Fcurrent_thread ()); /* Initialize non-Lisp data. Note that allocate_process zeroes out all non-Lisp data, so do it only for slots which should not be zero. */ @@ -746,6 +800,27 @@ remove_process (register Lisp_Object proc) deactivate_process (proc); } +void +update_processes_for_thread_death (Lisp_Object dying_thread) +{ + Lisp_Object pair; + + for (pair = Vprocess_alist; !NILP (pair); pair = XCDR (pair)) + { + Lisp_Object process = XCDR (XCAR (pair)); + if (EQ (XPROCESS (process)->thread, dying_thread)) + { + struct Lisp_Process *proc = XPROCESS (process); + + proc->thread = Qnil; + if (proc->infd >= 0) + fd_callback_info[proc->infd].thread = NULL; + if (proc->outfd >= 0) + fd_callback_info[proc->outfd].thread = NULL; + } + } +} + DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0, doc: /* Return t if OBJECT is a process. */) @@ -1094,6 +1169,42 @@ See `set-process-sentinel' for more info on sentinels. */) return XPROCESS (process)->sentinel; } +DEFUN ("set-process-thread", Fset_process_thread, Sset_process_thread, + 2, 2, 0, + doc: /* FIXME */) + (Lisp_Object process, Lisp_Object thread) +{ + struct Lisp_Process *proc; + struct thread_state *tstate; + + CHECK_PROCESS (process); + if (NILP (thread)) + tstate = NULL; + else + { + CHECK_THREAD (thread); + tstate = XTHREAD (thread); + } + + proc = XPROCESS (process); + proc->thread = thread; + if (proc->infd >= 0) + fd_callback_info[proc->infd].thread = tstate; + if (proc->outfd >= 0) + fd_callback_info[proc->outfd].thread = tstate; + + return thread; +} + +DEFUN ("process-thread", Fprocess_thread, Sprocess_thread, + 1, 1, 0, + doc: /* FIXME */) + (Lisp_Object process) +{ + CHECK_PROCESS (process); + return XPROCESS (process)->thread; +} + DEFUN ("set-process-window-size", Fset_process_window_size, Sset_process_window_size, 3, 3, 0, doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */) @@ -3993,7 +4104,17 @@ Return non-nil if we received any output before the timeout expired. */) int nsecs; if (! NILP (process)) - CHECK_PROCESS (process); + { + struct Lisp_Process *procp; + + CHECK_PROCESS (process); + procp = XPROCESS (process); + + /* Can't wait for a process that is dedicated to a different + thread. */ + if (!EQ (procp->thread, Qnil) && !EQ (procp->thread, Fcurrent_thread ())) + error ("FIXME"); + } else just_this_one = Qnil; @@ -4249,20 +4370,10 @@ server_accept_connection (Lisp_Object server, int channel) build_string ("\n"))); } -/* This variable is different from waiting_for_input in keyboard.c. - It is used to communicate to a lisp process-filter/sentinel (via the - function Fwaiting_for_user_input_p below) whether Emacs was waiting - for user-input when that process-filter was called. - waiting_for_input cannot be used as that is by definition 0 when - lisp code is being evalled. - This is also used in record_asynch_buffer_change. - For that purpose, this must be 0 - when not inside wait_reading_process_output. */ -static int waiting_for_user_input_p; - static Lisp_Object wait_reading_process_output_unwind (Lisp_Object data) { + clear_waiting_thread_info (); waiting_for_user_input_p = XINT (data); return Qnil; } @@ -4329,6 +4440,10 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, int got_some_input = 0; ptrdiff_t count = SPECPDL_INDEX (); + eassert (wait_proc == NULL + || EQ (wait_proc->thread, Qnil) + || XTHREAD (wait_proc->thread) == current_thread); + FD_ZERO (&Available); FD_ZERO (&Writeok); @@ -4484,14 +4599,15 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, compute_write_mask (&Ctemp); timeout = make_emacs_time (0, 0); - if ((pselect (max (max_process_desc, max_input_desc) + 1, - &Atemp, + if ((thread_select (pselect, + max (max_process_desc, max_input_desc) + 1, + &Atemp, #ifdef NON_BLOCKING_CONNECT - (num_pending_connects > 0 ? &Ctemp : NULL), + (num_pending_connects > 0 ? &Ctemp : NULL), #else - NULL, + NULL, #endif - NULL, &timeout, NULL) + NULL, &timeout, NULL) <= 0)) { /* It's okay for us to do this and then continue with @@ -4639,17 +4755,18 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, process_output_skip = 0; } #endif + nfds = thread_select ( #if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS) - nfds = xg_select + xg_select #elif defined (HAVE_NS) - nfds = ns_select + ns_select #else - nfds = pselect + pselect #endif - (max (max_process_desc, max_input_desc) + 1, - &Available, - (check_write ? &Writeok : (SELECT_TYPE *)0), - NULL, &timeout, NULL); + , max (max_process_desc, max_input_desc) + 1, + &Available, + (check_write ? &Writeok : (SELECT_TYPE *)0), + NULL, &timeout, NULL); #ifdef HAVE_GNUTLS /* GnuTLS buffers data internally. In lowat mode it leaves @@ -7597,6 +7714,8 @@ The variable takes effect when `start-process' is called. */); defsubr (&Sprocess_filter); defsubr (&Sset_process_sentinel); defsubr (&Sprocess_sentinel); + defsubr (&Sset_process_thread); + defsubr (&Sprocess_thread); defsubr (&Sset_process_window_size); defsubr (&Sset_process_inherit_coding_system_flag); defsubr (&Sset_process_query_on_exit_flag); diff --git a/src/process.h b/src/process.h index 43cc7ea33c0..1ddfe915357 100644 --- a/src/process.h +++ b/src/process.h @@ -103,6 +103,9 @@ struct Lisp_Process Lisp_Object gnutls_cred_type; #endif + /* The thread a process is linked to, or nil for any thread. */ + Lisp_Object thread; + /* After this point, there are no Lisp_Objects any more. */ /* alloc.c assumes that `pid' is the first such non-Lisp slot. */ @@ -208,3 +211,5 @@ extern void add_read_fd (int fd, fd_callback func, void *data); extern void delete_read_fd (int fd); extern void add_write_fd (int fd, fd_callback func, void *data); extern void delete_write_fd (int fd); + +extern void update_processes_for_thread_death (Lisp_Object); diff --git a/src/thread.c b/src/thread.c index 40c8be9f4d5..be98b4aae1d 100644 --- a/src/thread.c +++ b/src/thread.c @@ -22,6 +22,7 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "character.h" #include "buffer.h" +#include "process.h" /* FIXME */ extern void unbind_for_thread_switch (void); @@ -176,6 +177,50 @@ acquire_global_lock (struct thread_state *self) +struct select_args +{ + select_func *func; + int max_fds; + SELECT_TYPE *rfds; + SELECT_TYPE *wfds; + SELECT_TYPE *efds; + EMACS_TIME *timeout; + sigset_t *sigmask; + int result; +}; + +static void +really_call_select (void *arg) +{ + struct select_args *sa = arg; + struct thread_state *self = current_thread; + + release_global_lock (); + sa->result = (sa->func) (sa->max_fds, sa->rfds, sa->wfds, sa->efds, + sa->timeout, sa->sigmask); + acquire_global_lock (self); +} + +int +thread_select (select_func *func, int max_fds, SELECT_TYPE *rfds, + SELECT_TYPE *wfds, SELECT_TYPE *efds, EMACS_TIME *timeout, + sigset_t *sigmask) +{ + struct select_args sa; + + sa.func = func; + sa.max_fds = max_fds; + sa.rfds = rfds; + sa.wfds = wfds; + sa.efds = efds; + sa.timeout = timeout; + sa.sigmask = sigmask; + flush_stack_call_func (really_call_select, &sa); + return sa.result; +} + + + static void mark_one_thread (struct thread_state *thread) { @@ -315,6 +360,8 @@ run_thread (void *state) unbind_for_thread_switch (); + update_processes_for_thread_death (Fcurrent_thread ()); + /* Unlink this thread from the list of all threads. */ for (iter = &all_threads; *iter != self; iter = &(*iter)->next_thread) ; diff --git a/src/thread.h b/src/thread.h index d21887a0928..9db3c795653 100644 --- a/src/thread.h +++ b/src/thread.h @@ -21,6 +21,9 @@ along with GNU Emacs. If not, see . */ #include "regex.h" +#include "sysselect.h" /* FIXME */ +#include "systime.h" /* FIXME */ + struct thread_state { struct vectorlike_header header; @@ -156,6 +159,18 @@ struct thread_state /*re_char*/ unsigned char *m_whitespace_regexp; #define whitespace_regexp (current_thread->m_whitespace_regexp) + /* This variable is different from waiting_for_input in keyboard.c. + It is used to communicate to a lisp process-filter/sentinel (via the + function Fwaiting_for_user_input_p) whether Emacs was waiting + for user-input when that process-filter was called. + waiting_for_input cannot be used as that is by definition 0 when + lisp code is being evalled. + This is also used in record_asynch_buffer_change. + For that purpose, this must be 0 + when not inside wait_reading_process_output. */ + int m_waiting_for_user_input_p; +#define waiting_for_user_input_p (current_thread->m_waiting_for_user_input_p) + /* The OS identifier for this thread. */ sys_thread_t thread_id; @@ -194,4 +209,11 @@ extern void init_threads_once (void); extern void init_threads (void); extern void syms_of_threads (void); +typedef int select_func (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *, + EMACS_TIME *, sigset_t *); + +int thread_select (select_func *func, int max_fds, SELECT_TYPE *rfds, + SELECT_TYPE *wfds, SELECT_TYPE *efds, EMACS_TIME *timeout, + sigset_t *sigmask); + #endif /* THREAD_H */ -- cgit v1.2.3 From b3c78ffa31af4fb96cc18da887e2f2a1e68f5e09 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Sat, 18 Aug 2012 19:59:47 -0600 Subject: refactor systhread.h This refactors systhread.h to move the notion of a "lisp mutex" into thread.c. This lets us make make the global lock and post_acquire_global_lock static. --- src/systhread.c | 61 ---------------------- src/systhread.h | 18 ------- src/thread.c | 154 +++++++++++++++++++++++++++++++++++++++----------------- src/thread.h | 16 ++++-- 4 files changed, 121 insertions(+), 128 deletions(-) (limited to 'src/thread.h') diff --git a/src/systhread.c b/src/systhread.c index 968620bcd1c..666641c24da 100644 --- a/src/systhread.c +++ b/src/systhread.c @@ -78,67 +78,6 @@ sys_cond_destroy (sys_cond_t *cond) pthread_cond_destroy (cond); } -void -lisp_mutex_init (lisp_mutex_t *mutex) -{ - mutex->owner = NULL; - mutex->count = 0; - /* A lisp "mutex" is really a condition variable. */ - pthread_cond_init (&mutex->condition, NULL); -} - -void -lisp_mutex_lock (lisp_mutex_t *mutex) -{ - struct thread_state *self; - - if (mutex->owner == NULL) - { - mutex->owner = current_thread; - mutex->count = 1; - return; - } - if (mutex->owner == current_thread) - { - ++mutex->count; - return; - } - - self = current_thread; - self->wait_condvar = &mutex->condition; - while (mutex->owner != NULL && EQ (self->error_symbol, Qnil)) - pthread_cond_wait (&mutex->condition, &global_lock); - self->wait_condvar = NULL; - - post_acquire_global_lock (self); - - mutex->owner = self; - mutex->count = 1; -} - -void -lisp_mutex_unlock (lisp_mutex_t *mutex) -{ - struct thread_state *self = current_thread; - - if (mutex->owner != current_thread) - error ("blah"); - - if (--mutex->count > 0) - return; - - mutex->owner = NULL; - pthread_cond_broadcast (&mutex->condition); - - post_acquire_global_lock (self); -} - -void -lisp_mutex_destroy (lisp_mutex_t *mutex) -{ - sys_cond_destroy (&mutex->condition); -} - sys_thread_t sys_thread_self (void) { diff --git a/src/systhread.h b/src/systhread.h index bf9358c21c6..790b385b7ff 100644 --- a/src/systhread.h +++ b/src/systhread.h @@ -23,19 +23,6 @@ along with GNU Emacs. If not, see . */ #include -/* A mutex in lisp is represented by a pthread condition variable. - The pthread mutex associated with this condition variable is the - global lock. - - Using a condition variable lets us implement interruptibility for - lisp mutexes. */ -typedef struct -{ - struct thread_state *owner; - unsigned int count; - pthread_cond_t condition; -} lisp_mutex_t; - /* A system mutex is just a pthread mutex. This is only used for the GIL. */ typedef pthread_mutex_t sys_mutex_t; @@ -64,11 +51,6 @@ extern void sys_cond_signal (sys_cond_t *); extern void sys_cond_broadcast (sys_cond_t *); extern void sys_cond_destroy (sys_cond_t *); -extern void lisp_mutex_init (lisp_mutex_t *); -extern void lisp_mutex_lock (lisp_mutex_t *); -extern void lisp_mutex_unlock (lisp_mutex_t *); -extern void lisp_mutex_destroy (lisp_mutex_t *); - extern sys_thread_t sys_thread_self (void); extern int sys_thread_equal (sys_thread_t, sys_thread_t); diff --git a/src/thread.c b/src/thread.c index e8e43c5e402..9c39b84eb50 100644 --- a/src/thread.c +++ b/src/thread.c @@ -30,12 +30,119 @@ struct thread_state *current_thread = &primary_thread; static struct thread_state *all_threads = &primary_thread; -sys_mutex_t global_lock; +static sys_mutex_t global_lock; Lisp_Object Qthreadp, Qmutexp; +static void +release_global_lock (void) +{ + sys_mutex_unlock (&global_lock); +} + +/* You must call this after acquiring the global lock. + acquire_global_lock does it for you. */ +static void +post_acquire_global_lock (struct thread_state *self) +{ + Lisp_Object buffer; + + if (self != current_thread) + { + unbind_for_thread_switch (); + current_thread = self; + rebind_for_thread_switch (); + } + + /* We need special handling to re-set the buffer. */ + XSETBUFFER (buffer, self->m_current_buffer); + self->m_current_buffer = 0; + set_buffer_internal (XBUFFER (buffer)); + + if (!EQ (current_thread->error_symbol, Qnil)) + { + Lisp_Object sym = current_thread->error_symbol; + Lisp_Object data = current_thread->error_data; + + current_thread->error_symbol = Qnil; + current_thread->error_data = Qnil; + Fsignal (sym, data); + } +} + +static void +acquire_global_lock (struct thread_state *self) +{ + sys_mutex_lock (&global_lock); + post_acquire_global_lock (self); +} + + + +static void +lisp_mutex_init (lisp_mutex_t *mutex) +{ + mutex->owner = NULL; + mutex->count = 0; + sys_cond_init (&mutex->condition); +} + +static void +lisp_mutex_lock (lisp_mutex_t *mutex) +{ + struct thread_state *self; + + if (mutex->owner == NULL) + { + mutex->owner = current_thread; + mutex->count = 1; + return; + } + if (mutex->owner == current_thread) + { + ++mutex->count; + return; + } + + self = current_thread; + self->wait_condvar = &mutex->condition; + while (mutex->owner != NULL && EQ (self->error_symbol, Qnil)) + sys_cond_wait (&mutex->condition, &global_lock); + self->wait_condvar = NULL; + + post_acquire_global_lock (self); + + mutex->owner = self; + mutex->count = 1; +} + +static void +lisp_mutex_unlock (lisp_mutex_t *mutex) +{ + struct thread_state *self = current_thread; + + if (mutex->owner != current_thread) + error ("blah"); + + if (--mutex->count > 0) + return; + + mutex->owner = NULL; + sys_cond_broadcast (&mutex->condition); + + post_acquire_global_lock (self); +} + +static void +lisp_mutex_destroy (lisp_mutex_t *mutex) +{ + sys_cond_destroy (&mutex->condition); +} + + + DEFUN ("make-mutex", Fmake_mutex, Smake_mutex, 0, 1, 0, doc: /* Create a mutex. A mutex provides a synchronization point for threads. @@ -146,51 +253,6 @@ finalize_one_mutex (struct Lisp_Mutex *mutex) -static void -release_global_lock (void) -{ - sys_mutex_unlock (&global_lock); -} - -/* You must call this after acquiring the global lock. - acquire_global_lock does it for you. */ -void -post_acquire_global_lock (struct thread_state *self) -{ - Lisp_Object buffer; - - if (self != current_thread) - { - unbind_for_thread_switch (); - current_thread = self; - rebind_for_thread_switch (); - } - - /* We need special handling to re-set the buffer. */ - XSETBUFFER (buffer, self->m_current_buffer); - self->m_current_buffer = 0; - set_buffer_internal (XBUFFER (buffer)); - - if (!EQ (current_thread->error_symbol, Qnil)) - { - Lisp_Object sym = current_thread->error_symbol; - Lisp_Object data = current_thread->error_data; - - current_thread->error_symbol = Qnil; - current_thread->error_data = Qnil; - Fsignal (sym, data); - } -} - -static void -acquire_global_lock (struct thread_state *self) -{ - sys_mutex_lock (&global_lock); - post_acquire_global_lock (self); -} - - - struct select_args { select_func *func; diff --git a/src/thread.h b/src/thread.h index 9db3c795653..32ef48f63ff 100644 --- a/src/thread.h +++ b/src/thread.h @@ -187,6 +187,19 @@ struct thread_state struct thread_state *next_thread; }; +/* A mutex in lisp is represented by a pthread condition variable. + The system mutex associated with this condition variable is the + global lock. + + Using a condition variable lets us implement interruptibility for + lisp mutexes. */ +typedef struct +{ + struct thread_state *owner; + unsigned int count; + sys_cond_t condition; +} lisp_mutex_t; + struct Lisp_Mutex { struct vectorlike_header header; @@ -198,9 +211,6 @@ struct Lisp_Mutex extern struct thread_state *current_thread; -extern sys_mutex_t global_lock; -extern void post_acquire_global_lock (struct thread_state *); - extern void unmark_threads (void); extern void finalize_one_thread (struct thread_state *state); extern void finalize_one_mutex (struct Lisp_Mutex *); -- cgit v1.2.3 From ee1464eab19311ab7708b135bdb6eb989909e4cc Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Sat, 18 Aug 2012 20:05:13 -0600 Subject: comment fixes --- src/thread.h | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'src/thread.h') diff --git a/src/thread.h b/src/thread.h index 32ef48f63ff..6b66ea4d1c3 100644 --- a/src/thread.h +++ b/src/thread.h @@ -187,7 +187,7 @@ struct thread_state struct thread_state *next_thread; }; -/* A mutex in lisp is represented by a pthread condition variable. +/* A mutex in lisp is represented by a system condition variable. The system mutex associated with this condition variable is the global lock. @@ -195,17 +195,23 @@ struct thread_state lisp mutexes. */ typedef struct { + /* The owning thread, or NULL if unlocked. */ struct thread_state *owner; + /* The lock count. */ unsigned int count; + /* The underlying system condition variable. */ sys_cond_t condition; } lisp_mutex_t; +/* A mutex as a lisp object. */ struct Lisp_Mutex { struct vectorlike_header header; + /* The name of the mutex, or nil. */ Lisp_Object name; + /* The lower-level mutex object. */ lisp_mutex_t mutex; }; -- cgit v1.2.3 From 5651640d578fa2efa40be4789d9fa61813ccb1fa Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Sun, 19 Aug 2012 03:23:03 -0600 Subject: condition variables This implements condition variables for elisp. This needs more tests. --- src/alloc.c | 2 + src/data.c | 17 +++- src/lisp.h | 9 +- src/print.c | 12 +++ src/thread.c | 219 ++++++++++++++++++++++++++++++++++++++++++---- src/thread.h | 16 ++++ test/automated/threads.el | 13 +++ 7 files changed, 268 insertions(+), 20 deletions(-) (limited to 'src/thread.h') diff --git a/src/alloc.c b/src/alloc.c index 80d22d61d66..19b77d567d0 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3106,6 +3106,8 @@ sweep_vectors (void) finalize_one_thread ((struct thread_state *) vector); else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MUTEX)) finalize_one_mutex ((struct Lisp_Mutex *) vector); + else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_CONDVAR)) + finalize_one_condvar ((struct Lisp_CondVar *) vector); next = ADVANCE (vector, nbytes); diff --git a/src/data.c b/src/data.c index b47c2d12aff..e6342caadf1 100644 --- a/src/data.c +++ b/src/data.c @@ -94,7 +94,7 @@ static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; static Lisp_Object Qsubrp, Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; static Lisp_Object Qdefun; -Lisp_Object Qthread, Qmutex; +Lisp_Object Qthread, Qmutex, Qcondition_variable; Lisp_Object Qinteractive_form; @@ -216,6 +216,8 @@ for example, (type-of 1) returns `integer'. */) return Qthread; if (MUTEXP (object)) return Qmutex; + if (CONDVARP (object)) + return Qcondition_variable; return Qvector; case Lisp_Float: @@ -482,6 +484,17 @@ DEFUN ("mutexp", Fmutexp, Smutexp, 1, 1, 0, else return Qnil; } + +DEFUN ("condition-variablep", Fcondition_variablep, Scondition_variablep, + 1, 1, 0, + doc: /* Return t if OBJECT is a condition variable. */) + (Lisp_Object object) +{ + if (CONDVARP (object)) + return Qt; + else + return Qnil; +} /* Extract and set components of lists */ @@ -3117,6 +3130,7 @@ syms_of_data (void) DEFSYM (Qhash_table, "hash-table"); DEFSYM (Qthread, "thread"); DEFSYM (Qmutex, "mutex"); + DEFSYM (Qcondition_variable, "condition-variable"); /* Used by Fgarbage_collect. */ DEFSYM (Qinterval, "interval"); DEFSYM (Qmisc, "misc"); @@ -3161,6 +3175,7 @@ syms_of_data (void) defsubr (&Schar_or_string_p); defsubr (&Sthreadp); defsubr (&Smutexp); + defsubr (&Scondition_variablep); defsubr (&Scar); defsubr (&Scdr); defsubr (&Scar_safe); diff --git a/src/lisp.h b/src/lisp.h index 34ecfe697d6..2a75dfcbc7d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -367,6 +367,7 @@ enum pvec_type PVEC_OTHER, PVEC_THREAD, PVEC_MUTEX, + PVEC_CONDVAR, /* These last 4 are special because we OR them in fns.c:internal_equal, so they have to use a disjoint bit pattern: if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE @@ -557,6 +558,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) XUNTAG (a, Lisp_Vectorlike))) #define XTHREAD(a) (eassert (THREADP (a)), (struct thread_state *) XPNTR(a)) #define XMUTEX(a) (eassert (MUTEXP (a)), (struct Lisp_Mutex *) XPNTR(a)) +#define XCONDVAR(a) (eassert (CONDVARP (a)), (struct Lisp_CondVar *) XPNTR(a)) /* Construct a Lisp_Object from a value or address. */ @@ -609,6 +611,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) #define XSETTHREAD(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_THREAD)) #define XSETMUTEX(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_MUTEX)) +#define XSETCONDVAR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CONDVAR)) /* Convenience macros for dealing with Lisp arrays. */ @@ -1709,6 +1712,7 @@ typedef struct { #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME) #define THREADP(x) PSEUDOVECTORP (x, PVEC_THREAD) #define MUTEXP(x) PSEUDOVECTORP (x, PVEC_MUTEX) +#define CONDVARP(x) PSEUDOVECTORP (x, PVEC_CONDVAR) /* Test for image (image . spec) */ #define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) @@ -1833,6 +1837,9 @@ typedef struct { #define CHECK_MUTEX(x) \ CHECK_TYPE (MUTEXP (x), Qmutexp, x) +#define CHECK_CONDVAR(x) \ + CHECK_TYPE (CONDVARP (x), Qcondition_variablep, x) + /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ #define CHECK_NUMBER_CAR(x) \ @@ -2455,7 +2462,7 @@ extern Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp; extern Lisp_Object Qbuffer_or_string_p; extern Lisp_Object Qfboundp; extern Lisp_Object Qchar_table_p, Qvector_or_char_table_p; -extern Lisp_Object Qthreadp, Qmutexp; +extern Lisp_Object Qthreadp, Qmutexp, Qcondition_variablep; extern Lisp_Object Qcdr; diff --git a/src/print.c b/src/print.c index b14a769dc74..78a0707627c 100644 --- a/src/print.c +++ b/src/print.c @@ -1967,6 +1967,18 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag } PRINTCHAR ('>'); } + else if (CONDVARP (obj)) + { + strout ("#name)) + print_string (XCONDVAR (obj)->name, printcharfun); + else + { + int len = sprintf (buf, "%p", XCONDVAR (obj)); + strout (buf, len, len, printcharfun); + } + PRINTCHAR ('>'); + } else { ptrdiff_t size = ASIZE (obj); diff --git a/src/thread.c b/src/thread.c index 9c39b84eb50..4657d6a797e 100644 --- a/src/thread.c +++ b/src/thread.c @@ -32,7 +32,7 @@ static struct thread_state *all_threads = &primary_thread; static sys_mutex_t global_lock; -Lisp_Object Qthreadp, Qmutexp; +Lisp_Object Qthreadp, Qmutexp, Qcondition_variablep; @@ -89,36 +89,41 @@ lisp_mutex_init (lisp_mutex_t *mutex) sys_cond_init (&mutex->condition); } -static void -lisp_mutex_lock (lisp_mutex_t *mutex) +static int +lisp_mutex_lock (lisp_mutex_t *mutex, int new_count) { struct thread_state *self; if (mutex->owner == NULL) { mutex->owner = current_thread; - mutex->count = 1; - return; + mutex->count = new_count == 0 ? 1 : new_count; + return 0; } if (mutex->owner == current_thread) { + eassert (new_count == 0); ++mutex->count; - return; + return 0; } self = current_thread; self->wait_condvar = &mutex->condition; - while (mutex->owner != NULL && EQ (self->error_symbol, Qnil)) + while (mutex->owner != NULL && (new_count != 0 + || EQ (self->error_symbol, Qnil))) sys_cond_wait (&mutex->condition, &global_lock); self->wait_condvar = NULL; - post_acquire_global_lock (self); + if (new_count == 0 && !NILP (self->error_symbol)) + return 1; mutex->owner = self; - mutex->count = 1; + mutex->count = new_count == 0 ? 1 : new_count; + + return 1; } -static void +static int lisp_mutex_unlock (lisp_mutex_t *mutex) { struct thread_state *self = current_thread; @@ -127,12 +132,28 @@ lisp_mutex_unlock (lisp_mutex_t *mutex) error ("blah"); if (--mutex->count > 0) - return; + return 0; mutex->owner = NULL; sys_cond_broadcast (&mutex->condition); - post_acquire_global_lock (self); + return 1; +} + +static unsigned int +lisp_mutex_unlock_for_wait (lisp_mutex_t *mutex) +{ + struct thread_state *self = current_thread; + unsigned int result = mutex->count; + + /* Ensured by condvar code. */ + eassert (mutex->owner == current_thread); + + mutex->count = 0; + mutex->owner = NULL; + sys_cond_broadcast (&mutex->condition); + + return result; } static void @@ -141,6 +162,12 @@ lisp_mutex_destroy (lisp_mutex_t *mutex) sys_cond_destroy (&mutex->condition); } +static int +lisp_mutex_owned_p (lisp_mutex_t *mutex) +{ + return mutex->owner == current_thread; +} + DEFUN ("make-mutex", Fmake_mutex, Smake_mutex, 0, 1, 0, @@ -173,9 +200,10 @@ static void mutex_lock_callback (void *arg) { struct Lisp_Mutex *mutex = arg; + struct thread_state *self = current_thread; - /* This calls post_acquire_global_lock. */ - lisp_mutex_lock (&mutex->mutex); + if (lisp_mutex_lock (&mutex->mutex, 0)) + post_acquire_global_lock (self); } static Lisp_Object @@ -211,9 +239,10 @@ static void mutex_unlock_callback (void *arg) { struct Lisp_Mutex *mutex = arg; + struct thread_state *self = current_thread; - /* This calls post_acquire_global_lock. */ - lisp_mutex_unlock (&mutex->mutex); + if (lisp_mutex_unlock (&mutex->mutex)) + post_acquire_global_lock (self); } DEFUN ("mutex-unlock", Fmutex_unlock, Smutex_unlock, 1, 1, 0, @@ -253,6 +282,154 @@ finalize_one_mutex (struct Lisp_Mutex *mutex) +DEFUN ("make-condition-variable", + Fmake_condition_variable, Smake_condition_variable, + 1, 2, 0, + doc: /* Make a condition variable. +A condition variable provides a way for a thread to sleep while +waiting for a state change. + +MUTEX is the mutex associated with this condition variable. +NAME, if given, is the name of this condition variable. The name is +informational only. */) + (Lisp_Object mutex, Lisp_Object name) +{ + struct Lisp_CondVar *condvar; + Lisp_Object result; + + CHECK_MUTEX (mutex); + if (!NILP (name)) + CHECK_STRING (name); + + condvar = ALLOCATE_PSEUDOVECTOR (struct Lisp_CondVar, cond, PVEC_CONDVAR); + memset ((char *) condvar + offsetof (struct Lisp_CondVar, cond), + 0, sizeof (struct Lisp_CondVar) - offsetof (struct Lisp_CondVar, + cond)); + condvar->mutex = mutex; + condvar->name = name; + sys_cond_init (&condvar->cond); + + XSETCONDVAR (result, condvar); + return result; +} + +static void +condition_wait_callback (void *arg) +{ + struct Lisp_CondVar *cvar = arg; + struct Lisp_Mutex *mutex = XMUTEX (cvar->mutex); + struct thread_state *self = current_thread; + unsigned int saved_count; + Lisp_Object cond; + + XSETCONDVAR (cond, cvar); + current_thread->event_object = cond; + saved_count = lisp_mutex_unlock_for_wait (&mutex->mutex); + /* If we were signalled while unlocking, we skip the wait, but we + still must reacquire our lock. */ + if (NILP (self->error_symbol)) + { + self->wait_condvar = &cvar->cond; + sys_cond_wait (&cvar->cond, &global_lock); + self->wait_condvar = NULL; + } + lisp_mutex_lock (&mutex->mutex, saved_count); + current_thread->event_object = Qnil; + post_acquire_global_lock (self); +} + +DEFUN ("condition-wait", Fcondition_wait, Scondition_wait, 1, 1, 0, + doc: /* Wait for the condition variable to be notified. +CONDITION is the condition variable to wait on. + +The mutex associated with CONDITION must be held when this is called. +It is an error if it is not held. + +This atomically releases the mutex and waits for CONDITION to be +notified. When `condition-wait' returns, the mutex will again be +locked by this thread. */) + (Lisp_Object condition) +{ + struct Lisp_CondVar *cvar; + struct Lisp_Mutex *mutex; + + CHECK_CONDVAR (condition); + cvar = XCONDVAR (condition); + + mutex = XMUTEX (cvar->mutex); + if (!lisp_mutex_owned_p (&mutex->mutex)) + error ("fixme"); + + flush_stack_call_func (condition_wait_callback, cvar); + + return Qnil; +} + +/* Used to communicate argumnets to condition_notify_callback. */ +struct notify_args +{ + struct Lisp_CondVar *cvar; + int all; +}; + +static void +condition_notify_callback (void *arg) +{ + struct notify_args *na = arg; + struct Lisp_Mutex *mutex = XMUTEX (na->cvar->mutex); + struct thread_state *self = current_thread; + unsigned int saved_count; + Lisp_Object cond; + + XSETCONDVAR (cond, na->cvar); + saved_count = lisp_mutex_unlock_for_wait (&mutex->mutex); + if (na->all) + sys_cond_broadcast (&na->cvar->cond); + else + sys_cond_signal (&na->cvar->cond); + lisp_mutex_lock (&mutex->mutex, saved_count); + post_acquire_global_lock (self); +} + +DEFUN ("condition-notify", Fcondition_notify, Scondition_notify, 1, 2, 0, + doc: /* Notify a condition variable. +This wakes a thread waiting on CONDITION. +If ALL is non-nil, all waiting threads are awoken. + +The mutex associated with CONDITION must be held when this is called. +It is an error if it is not held. + +This atomically releases the mutex when notifying CONDITION. When +`condition-notify' returns, the mutex will again be locked by this +thread. */) + (Lisp_Object condition, Lisp_Object all) +{ + struct Lisp_CondVar *cvar; + struct Lisp_Mutex *mutex; + struct notify_args args; + + CHECK_CONDVAR (condition); + cvar = XCONDVAR (condition); + + mutex = XMUTEX (cvar->mutex); + if (!lisp_mutex_owned_p (&mutex->mutex)) + error ("fixme"); + + args.cvar = cvar; + args.all = !NILP (all); + flush_stack_call_func (condition_notify_callback, &args); + + return Qnil; +} + +void +finalize_one_condvar (struct Lisp_CondVar *condvar) +{ + sys_cond_destroy (&condvar->cond); +} + + + struct select_args { select_func *func; @@ -555,8 +732,8 @@ DEFUN ("thread-signal", Fthread_signal, Sthread_signal, 3, 3, 0, doc: /* Signal an error in a thread. This acts like `signal', but arranges for the signal to be raised in THREAD. If THREAD is the current thread, acts just like `signal'. -This will interrupt a blocked call to `mutex-lock' or`thread-join' in -the target thread. */) +This will interrupt a blocked call to `mutex-lock', `condition-wait', +or `thread-join' in the target thread. */) (Lisp_Object thread, Lisp_Object error_symbol, Lisp_Object data) { struct thread_state *tstate; @@ -597,6 +774,7 @@ DEFUN ("thread-blocker", Fthread_blocker, Sthread_blocker, 1, 1, 0, If THREAD is blocked in `thread-join' on a second thread, return that thread. If THREAD is blocked in `mutex-lock', return the mutex. +If THREAD is blocked in `condition-wait', return the condition variable. Otherwise, if THREAD is not blocked, return nil. */) (Lisp_Object thread) { @@ -711,9 +889,14 @@ syms_of_threads (void) defsubr (&Smutex_lock); defsubr (&Smutex_unlock); defsubr (&Smutex_name); + defsubr (&Smake_condition_variable); + defsubr (&Scondition_wait); + defsubr (&Scondition_notify); Qthreadp = intern_c_string ("threadp"); staticpro (&Qthreadp); Qmutexp = intern_c_string ("mutexp"); staticpro (&Qmutexp); + Qcondition_variablep = intern_c_string ("condition-variablep"); + staticpro (&Qcondition_variablep); } diff --git a/src/thread.h b/src/thread.h index 6b66ea4d1c3..989acec6afb 100644 --- a/src/thread.h +++ b/src/thread.h @@ -215,11 +215,27 @@ struct Lisp_Mutex lisp_mutex_t mutex; }; +/* A condition variable as a lisp object. */ +struct Lisp_CondVar +{ + struct vectorlike_header header; + + /* The associated mutex. */ + Lisp_Object mutex; + + /* The name of the condition variable, or nil. */ + Lisp_Object name; + + /* The lower-level condition variable object. */ + sys_cond_t cond; +}; + extern struct thread_state *current_thread; extern void unmark_threads (void); extern void finalize_one_thread (struct thread_state *state); extern void finalize_one_mutex (struct Lisp_Mutex *); +extern void finalize_one_condvar (struct Lisp_CondVar *); extern void init_threads_once (void); extern void init_threads (void); diff --git a/test/automated/threads.el b/test/automated/threads.el index 4c1afbdde67..ce929fc0add 100644 --- a/test/automated/threads.el +++ b/test/automated/threads.el @@ -175,4 +175,17 @@ (accept-process-output nil 1)) threads-test-global))) +(ert-deftest threads-condvarp () + "simple test of condition-variablep" + (should-not (condition-variablep 'hi))) + +(ert-deftest threads-condvarp-2 () + "another simple test of condition-variablep" + (should (condition-variablep (make-condition-variable (make-mutex))))) + +(ert-deftest threads-condvar-type () + "type-of condvar" + (should (eq (type-of (make-condition-variable (make-mutex))) + 'condition-variable))) + ;;; threads.el ends here -- cgit v1.2.3 From cbcba8ce7f980b01c18c0fd561ef6687b1361507 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Mon, 18 Mar 2013 08:48:53 -0600 Subject: don't let kill-buffer kill a buffer if it is current in any thread --- src/buffer.c | 3 +++ src/thread.c | 19 +++++++++++++++++++ src/thread.h | 2 ++ 3 files changed, 24 insertions(+) (limited to 'src/thread.h') diff --git a/src/buffer.c b/src/buffer.c index 4d24f970792..b7b471d6d46 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1726,6 +1726,9 @@ cleaning up all windows currently displaying the buffer to be killed. */) if (!BUFFER_LIVE_P (b)) return Qnil; + if (thread_check_current_buffer (b)) + return Qnil; + /* Query if the buffer is still modified. */ if (INTERACTIVE && !NILP (BVAR (b, filename)) && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) diff --git a/src/thread.c b/src/thread.c index 551f3de10e4..7de260ee3c0 100644 --- a/src/thread.c +++ b/src/thread.c @@ -881,6 +881,25 @@ DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0, +int +thread_check_current_buffer (struct buffer *buffer) +{ + struct thread_state *iter; + + for (iter = all_threads; iter; iter = iter->next_thread) + { + if (iter == current_thread) + continue; + + if (iter->m_current_buffer == buffer) + return 1; + } + + return 0; +} + + + static void init_primary_thread (void) { diff --git a/src/thread.h b/src/thread.h index 97bdb2c805c..47fa87c77fa 100644 --- a/src/thread.h +++ b/src/thread.h @@ -248,4 +248,6 @@ int thread_select (select_func *func, int max_fds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds, EMACS_TIME *timeout, sigset_t *sigmask); +int thread_check_current_buffer (struct buffer *); + #endif /* THREAD_H */ -- cgit v1.2.3 From 1d10d048003619f4e2d396a03274adad0dec78ba Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 3 Jul 2013 13:12:10 -0600 Subject: remove unused field from struct thread_state --- src/thread.h | 6 ------ 1 file changed, 6 deletions(-) (limited to 'src/thread.h') diff --git a/src/thread.h b/src/thread.h index 9f0eead4637..e43b0a335aa 100644 --- a/src/thread.h +++ b/src/thread.h @@ -99,12 +99,6 @@ struct thread_state struct specbinding *m_specpdl_ptr; #define specpdl_ptr (current_thread->m_specpdl_ptr) - /* Pointer to the first "saved" element in specpdl. When this - thread is swapped out, the current values of all specpdl bindings - are pushed onto the specpdl; then these are popped again when - switching back to this thread. */ - struct specbinding *m_saved_specpdl_ptr; - /* Depth in Lisp evaluations and function calls. */ EMACS_INT m_lisp_eval_depth; #define lisp_eval_depth (current_thread->m_lisp_eval_depth) -- cgit v1.2.3 From 545af8557a68f5f34e74349d6dee9d8319df6f7c Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Mon, 26 Aug 2013 20:09:38 -0600 Subject: fix whitespace_regexp warning --- src/thread.h | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'src/thread.h') diff --git a/src/thread.h b/src/thread.h index e77d1144ecf..231c7acc31f 100644 --- a/src/thread.h +++ b/src/thread.h @@ -147,7 +147,9 @@ struct thread_state #define re_syntax_options (current_thread->m_re_syntax_options) /* Regexp to use to replace spaces, or NULL meaning don't. */ - /*re_char*/ unsigned char *m_whitespace_regexp; + /* This ought to be a "const re_char *" but that is not available + outside regex.h. */ + const void *m_whitespace_regexp; #define whitespace_regexp (current_thread->m_whitespace_regexp) /* This variable is different from waiting_for_input in keyboard.c. -- cgit v1.2.3 From 6a64a7118d4b0c13789bbe69f2575dd9c1c88524 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Tue, 27 Aug 2013 12:29:56 -0600 Subject: make thread_check_current_buffer return bool --- src/thread.c | 6 +++--- src/thread.h | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'src/thread.h') diff --git a/src/thread.c b/src/thread.c index ae2212e697d..20d0568bef5 100644 --- a/src/thread.c +++ b/src/thread.c @@ -882,7 +882,7 @@ DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0, -int +bool thread_check_current_buffer (struct buffer *buffer) { struct thread_state *iter; @@ -893,10 +893,10 @@ thread_check_current_buffer (struct buffer *buffer) continue; if (iter->m_current_buffer == buffer) - return 1; + return true; } - return 0; + return false; } diff --git a/src/thread.h b/src/thread.h index 231c7acc31f..2b9963423db 100644 --- a/src/thread.h +++ b/src/thread.h @@ -241,6 +241,6 @@ int thread_select (select_func *func, int max_fds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds, EMACS_TIME *timeout, sigset_t *sigmask); -int thread_check_current_buffer (struct buffer *); +bool thread_check_current_buffer (struct buffer *); #endif /* THREAD_H */ -- cgit v1.2.3 From 470e3028d8a741d97349faa8fdeb148d913a49d0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 2 Nov 2015 19:04:06 +0200 Subject: Fix the MS-Windows build * src/thread.h [WINDOWSNT]: Include sys/socket.h. * src/sysselect.h: Don't define fd_set and FD_* macros for MS-Windows here. * src/w32.h: Define them here. * src/process.h (sys_select): Declare prototype. * src/sysdep.c: * src/process.c: * src/filelock.c: * src/emacs.c: * src/callproc.c: Move inclusion of sys/select.h after lisp.h. * nt/inc/socket.h: Include w32.h instead of sysselect.h --- nt/inc/sys/socket.h | 2 +- src/callproc.c | 6 ++---- src/emacs.c | 10 ++++------ src/filelock.c | 7 ++----- src/process.c | 7 ++++--- src/sysdep.c | 22 +++++++++++----------- src/sysselect.h | 38 ++++---------------------------------- src/thread.h | 4 ++++ src/w32.c | 3 +-- src/w32.h | 26 ++++++++++++++++++++++++++ 10 files changed, 59 insertions(+), 66 deletions(-) (limited to 'src/thread.h') diff --git a/nt/inc/sys/socket.h b/nt/inc/sys/socket.h index 6ad121699c5..067effe929e 100644 --- a/nt/inc/sys/socket.h +++ b/nt/inc/sys/socket.h @@ -74,7 +74,7 @@ typedef unsigned short uint16_t; /* allow us to provide our own version of fd_set */ #define fd_set ws_fd_set -#include "sysselect.h" +#include "w32.h" #endif /* EMACS_CONFIG_H */ #if defined (HAVE_TIMEVAL) && defined (_MSC_VER) diff --git a/src/callproc.c b/src/callproc.c index a6c7bdafdba..bb21c35dccc 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -27,14 +27,12 @@ along with GNU Emacs. If not, see . */ #include #include -#ifdef WINDOWSNT -#define NOMINMAX -#include /* for fcntl */ -#endif #include "lisp.h" #ifdef WINDOWSNT +#define NOMINMAX +#include /* for fcntl */ #include #include "w32.h" #define _P_NOWAIT 1 /* from process.h */ diff --git a/src/emacs.c b/src/emacs.c index 9dc4e423547..f91e5499916 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -31,20 +31,18 @@ along with GNU Emacs. If not, see . */ #include +#define MAIN_PROGRAM +#include "lisp.h" + #ifdef WINDOWSNT #include #include #include +#include "w32.h" #include "w32heap.h" #endif -#define MAIN_PROGRAM -#include "lisp.h" - #if defined WINDOWSNT || defined HAVE_NTGUI -#ifdef WINDOWSNT -#include "w32.h" -#endif #include "w32select.h" #include "w32font.h" #include "w32common.h" diff --git a/src/filelock.c b/src/filelock.c index b37319c9ae8..7f9b6e7f8e8 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -40,11 +40,6 @@ along with GNU Emacs. If not, see . */ #include #endif /* __FreeBSD__ */ -#ifdef WINDOWSNT -#include -#include /* for fcntl */ -#endif - #include #include @@ -53,6 +48,8 @@ along with GNU Emacs. If not, see . */ #include "buffer.h" #include "coding.h" #ifdef WINDOWSNT +#include +#include /* for fcntl */ #include "w32.h" /* for dostounix_filename */ #endif diff --git a/src/process.c b/src/process.c index 791f8f5c308..5e9b687ba60 100644 --- a/src/process.c +++ b/src/process.c @@ -29,6 +29,8 @@ along with GNU Emacs. If not, see . */ #include #include +#include "lisp.h" + /* Only MS-DOS does not define `subprocesses'. */ #ifdef subprocesses @@ -92,8 +94,6 @@ along with GNU Emacs. If not, see . */ #endif /* subprocesses */ -#include "lisp.h" - #include "systime.h" #include "systty.h" @@ -126,7 +126,8 @@ along with GNU Emacs. If not, see . */ #endif #ifdef WINDOWSNT -#include "w32.h" +extern int sys_select (int, fd_set *, fd_set *, fd_set *, + struct timespec *, sigset_t *); #endif /* Work around GCC 4.7.0 bug with strict overflow checking; see diff --git a/src/sysdep.c b/src/sysdep.c index ba6be57278e..d75dcd3f9e3 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -39,17 +39,6 @@ along with GNU Emacs. If not, see . */ #include #include -#ifdef HAVE_SOCKETS -#include -#include -#endif /* HAVE_SOCKETS */ - -#ifdef TRY_AGAIN -#ifndef HAVE_H_ERRNO -extern int h_errno; -#endif -#endif /* TRY_AGAIN */ - #include "lisp.h" #include "sysselect.h" #include "blockinput.h" @@ -68,6 +57,17 @@ extern int h_errno; # include #endif +#ifdef HAVE_SOCKETS +#include +#include +#endif /* HAVE_SOCKETS */ + +#ifdef TRY_AGAIN +#ifndef HAVE_H_ERRNO +extern int h_errno; +#endif +#endif /* TRY_AGAIN */ + #ifdef WINDOWSNT #define read sys_read #define write sys_write diff --git a/src/sysselect.h b/src/sysselect.h index e0f7b4e13ee..d6c5d1c7148 100644 --- a/src/sysselect.h +++ b/src/sysselect.h @@ -25,40 +25,10 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" -#ifdef WINDOWSNT - -/* File descriptor set emulation. */ - -/* MSVC runtime library has limit of 64 descriptors by default */ -#define FD_SETSIZE 64 -typedef struct { - unsigned int bits[FD_SETSIZE / 32]; -} fd_set; - -/* standard access macros */ -#define FD_SET(n, p) \ - do { \ - if ((n) < FD_SETSIZE) { \ - (p)->bits[(n)/32] |= (1 << (n)%32); \ - } \ - } while (0) -#define FD_CLR(n, p) \ - do { \ - if ((n) < FD_SETSIZE) { \ - (p)->bits[(n)/32] &= ~(1 << (n)%32); \ - } \ - } while (0) -#define FD_ISSET(n, p) ((n) < FD_SETSIZE ? ((p)->bits[(n)/32] & (1 << (n)%32)) : 0) -#define FD_ZERO(p) memset((p), 0, sizeof(fd_set)) - -#define SELECT_TYPE fd_set - -#include "systime.h" -extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *, - struct timespec *, sigset_t *); - -#else /* not WINDOWSNT */ - +/* The w32 build defines select stuff in w32.h, which is included + where w32 needs it, but not where sysselect.h is included. The w32 + definitions in w32.h are incompatible with the below. */ +#ifndef WINDOWSNT #ifdef FD_SET #ifndef FD_SETSIZE #define FD_SETSIZE 64 diff --git a/src/thread.h b/src/thread.h index d155837ccad..91bab8284e6 100644 --- a/src/thread.h +++ b/src/thread.h @@ -21,6 +21,10 @@ along with GNU Emacs. If not, see . */ #include "regex.h" +#ifdef WINDOWSNT +#include +#endif + #include "sysselect.h" /* FIXME */ #include "systime.h" /* FIXME */ diff --git a/src/w32.c b/src/w32.c index 0966b8df1ce..93eb6284cf2 100644 --- a/src/w32.c +++ b/src/w32.c @@ -42,8 +42,6 @@ along with GNU Emacs. If not, see . */ #include #include /* for _mbspbrk, _mbslwr, _mbsrchr, ... */ -#include - #undef access #undef chdir #undef chmod @@ -205,6 +203,7 @@ typedef struct _REPARSE_DATA_BUFFER { #endif /* TCP connection support. */ +#include #undef socket #undef bind #undef connect diff --git a/src/w32.h b/src/w32.h index 7de05478e93..29a3ae35cbf 100644 --- a/src/w32.h +++ b/src/w32.h @@ -25,6 +25,32 @@ along with GNU Emacs. If not, see . */ #include +/* File descriptor set emulation. */ + +/* MSVC runtime library has limit of 64 descriptors by default */ +#define FD_SETSIZE 64 +typedef struct { + unsigned int bits[FD_SETSIZE / 32]; +} fd_set; + +/* standard access macros */ +#define FD_SET(n, p) \ + do { \ + if ((n) < FD_SETSIZE) { \ + (p)->bits[(n)/32] |= (1 << (n)%32); \ + } \ + } while (0) +#define FD_CLR(n, p) \ + do { \ + if ((n) < FD_SETSIZE) { \ + (p)->bits[(n)/32] &= ~(1 << (n)%32); \ + } \ + } while (0) +#define FD_ISSET(n, p) ((n) < FD_SETSIZE ? ((p)->bits[(n)/32] & (1 << (n)%32)) : 0) +#define FD_ZERO(p) memset((p), 0, sizeof(fd_set)) + +#define SELECT_TYPE fd_set + /* ------------------------------------------------------------------------- */ /* child_process.status values */ -- cgit v1.2.3