From: Tom Tromey Date: Mon, 3 Jun 2013 18:25:05 +0000 (-0600) Subject: merge from trunk; clean up some issues X-Git-Tag: emacs-26.0.90~1144^2~17^2~42 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=68359abba96d7ec4db8aab3d3dd9cf1105c3bab5;p=emacs.git merge from trunk; clean up some issues --- 68359abba96d7ec4db8aab3d3dd9cf1105c3bab5 diff --cc src/Makefile.in index eeb2b88bf32,0556bae1ecd..86e5aca36ec --- a/src/Makefile.in +++ b/src/Makefile.in @@@ -344,9 -368,8 +368,9 @@@ base_obj = dispnew.o frame.o scroll.o x syntax.o $(UNEXEC_OBJ) bytecode.o \ process.o gnutls.o callproc.o \ region-cache.o sound.o atimer.o \ - doprnt.o intervals.o textprop.o composite.o xml.o inotify.o \ + doprnt.o intervals.o textprop.o composite.o xml.o $(NOTIFY_OBJ) \ profiler.o \ + thread.o systhread.o \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \ $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) obj = $(base_obj) $(NS_OBJC_OBJ) diff --cc src/emacs.c index 148bb836927,4e439a601b1..b4b726183cf --- a/src/emacs.c +++ b/src/emacs.c @@@ -1409,10 -1425,11 +1416,12 @@@ Using an Emacs configured with --with-x #ifdef WINDOWSNT syms_of_ntterm (); + #ifdef HAVE_W32NOTIFY syms_of_w32notify (); + #endif /* HAVE_W32NOTIFY */ #endif /* WINDOWSNT */ + syms_of_threads (); syms_of_profiler (); keys_of_casefiddle (); diff --cc src/eval.c index a58a1508aaf,d6236b6edf2..be9de93bf1f --- a/src/eval.c +++ b/src/eval.c @@@ -32,12 -32,10 +32,10 @@@ along with GNU Emacs. If not, see level + 1 : 0; #endif - backtrace_list = catch->backlist; - lisp_eval_depth = catch->lisp_eval_depth; + lisp_eval_depth = catch->f_lisp_eval_depth; sys_longjmp (catch->jmp, 1); } @@@ -1134,9 -1129,8 +1142,8 @@@ internal_lisp_condition_case (volatile c.tag = Qnil; c.val = Qnil; - c.backlist = backtrace_list; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; + c.f_handlerlist = handlerlist; + c.f_lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; c.interrupt_input_blocked = interrupt_input_blocked; @@@ -1189,9 -1183,8 +1196,8 @@@ internal_condition_case (Lisp_Object (* c.tag = Qnil; c.val = Qnil; - c.backlist = backtrace_list; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; + c.f_handlerlist = handlerlist; + c.f_lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; c.interrupt_input_blocked = interrupt_input_blocked; @@@ -1227,9 -1220,8 +1233,8 @@@ internal_condition_case_1 (Lisp_Object c.tag = Qnil; c.val = Qnil; - c.backlist = backtrace_list; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; + c.f_handlerlist = handlerlist; + c.f_lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; c.interrupt_input_blocked = interrupt_input_blocked; @@@ -1269,9 -1261,8 +1274,8 @@@ internal_condition_case_2 (Lisp_Object c.tag = Qnil; c.val = Qnil; - c.backlist = backtrace_list; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; + c.f_handlerlist = handlerlist; + c.f_lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; c.interrupt_input_blocked = interrupt_input_blocked; @@@ -1313,9 -1304,8 +1317,8 @@@ internal_condition_case_n (Lisp_Object c.tag = Qnil; c.val = Qnil; - c.backlist = backtrace_list; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; + c.f_handlerlist = handlerlist; + c.f_lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; c.interrupt_input_blocked = interrupt_input_blocked; @@@ -2955,68 -2966,40 +2979,86 @@@ DEFUN ("fetch-bytecode", Ffetch_bytecod return object; } - static void - grow_specpdl (void) + /* Return true if SYMBOL currently has a let-binding + which was made in the buffer that is now current. */ + + bool + let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) { - register ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX); - if (max_size <= specpdl_size) - { - if (max_specpdl_size < 400) - max_size = max_specpdl_size = 400; - if (max_size <= specpdl_size) - signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); - } - specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl); - specpdl_ptr = specpdl + count; + struct specbinding *p; + Lisp_Object buf = Fcurrent_buffer (); + + for (p = specpdl_ptr; p > specpdl; ) + if ((--p)->kind > SPECPDL_LET) + { + struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p)); + eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS); + if (symbol == let_bound_symbol + && EQ (specpdl_where (p), buf)) + return 1; + } + + return 0; + } + + bool + let_shadows_global_binding_p (Lisp_Object symbol) + { + struct specbinding *p; + + for (p = specpdl_ptr; p > specpdl; ) + if ((--p)->kind >= SPECPDL_LET && EQ (specpdl_symbol (p), symbol)) + return 1; + + return 0; } +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: @@@ -3050,12 -3033,14 +3092,12 @@@ specbind (Lisp_Object symbol, Lisp_Obje case SYMBOL_PLAINVAL: /* The most common case is that of a non-constant symbol with a trivial value. Make that as fast as we can. */ - set_specpdl_symbol (symbol); - set_specpdl_old_value (SYMBOL_VAL (sym)); - specpdl_ptr->func = NULL; - specpdl_ptr->saved_value = Qnil; + specpdl_ptr->kind = SPECPDL_LET; + specpdl_ptr->v.let.symbol = symbol; + specpdl_ptr->v.let.old_value = SYMBOL_VAL (sym); ++ specpdl_ptr->v.let.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) @@@ -3105,20 -3068,19 +3125,19 @@@ value by changing the value of SYMBOL in all buffers not having their own value. This is consistent with what happens with other buffer-local variables. */ - if (NILP (where) - && sym->redirect == SYMBOL_FORWARDED) + if (NILP (Flocal_variable_p (symbol, Qnil))) { - eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym))); + specpdl_ptr->kind = SPECPDL_LET_DEFAULT; ++specpdl_ptr; - Fset_default (symbol, value); + do_specbind (sym, specpdl_ptr - 1, value); return; } } else - set_specpdl_symbol (symbol); + specpdl_ptr->kind = SPECPDL_LET; specpdl_ptr++; - set_internal (symbol, value, Qnil, 1); + do_specbind (sym, specpdl_ptr - 1, value); break; } default: emacs_abort (); @@@ -3137,63 -3098,6 +3155,72 @@@ record_unwind_protect (Lisp_Object (*fu specpdl_ptr++; } +void +rebind_for_thread_switch (void) +{ + struct specbinding *bind; + + for (bind = specpdl; bind != specpdl_ptr; ++bind) + { - if (bind->func == NULL) ++ if (bind->kind >= SPECPDL_LET) + { + 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); ++ switch (this_binding->kind) ++ { ++ case SPECPDL_UNWIND: ++ (*specpdl_func (this_binding)) (specpdl_arg (this_binding)); ++ break; ++ case SPECPDL_LET: ++ /* 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. */ ++ if (XSYMBOL (specpdl_symbol (this_binding))->redirect ++ == SYMBOL_PLAINVAL) ++ SET_SYMBOL_VAL (XSYMBOL (specpdl_symbol (this_binding)), ++ specpdl_old_value (this_binding)); ++ 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 (specpdl_symbol (this_binding), ++ specpdl_old_value (this_binding)); ++ break; ++ case SPECPDL_BACKTRACE: ++ break; ++ case SPECPDL_LET_LOCAL: ++ case SPECPDL_LET_DEFAULT: ++ { /* 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. */ ++ Lisp_Object symbol = specpdl_symbol (this_binding); ++ Lisp_Object where = specpdl_where (this_binding); ++ eassert (BUFFERP (where)); ++ ++ if (this_binding->kind == SPECPDL_LET_DEFAULT) ++ Fset_default (symbol, specpdl_old_value (this_binding)); ++ /* If this was a local binding, reset the value in the appropriate ++ buffer, but only if that buffer's binding still exists. */ ++ else if (!NILP (Flocal_variable_p (symbol, where))) ++ set_internal (symbol, specpdl_old_value (this_binding), ++ where, 1); ++ } ++ break; ++ } +} + Lisp_Object unbind_to (ptrdiff_t count, Lisp_Object value) { @@@ -3224,21 -3171,6 +3251,21 @@@ return value; } +void +unbind_for_thread_switch (void) +{ + struct specbinding *bind; + + for (bind = specpdl_ptr; bind != specpdl; --bind) + { - if (bind->func == NULL) ++ if (bind->kind >= SPECPDL_LET) + { + 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 @@@ -3369,27 -3279,61 +3374,62 @@@ If NFRAMES is more than the number of f } - #if BYTE_MARK_STACK void - mark_backtrace (void) -mark_specpdl (void) ++mark_specpdl (struct specbinding *first, struct specbinding *ptr) { - register struct backtrace *backlist; - ptrdiff_t i; - - for (backlist = backtrace_list; backlist; backlist = backlist->next) + struct specbinding *pdl; - for (pdl = specpdl; pdl != specpdl_ptr; pdl++) ++ for (pdl = first; pdl != ptr; pdl++) { - mark_object (backlist->function); + switch (pdl->kind) + { + case SPECPDL_UNWIND: + mark_object (specpdl_arg (pdl)); + break; + case SPECPDL_BACKTRACE: + { + ptrdiff_t nargs = backtrace_nargs (pdl); + mark_object (backtrace_function (pdl)); + if (nargs == UNEVALLED) + nargs = 1; + while (nargs--) + mark_object (backtrace_args (pdl)[nargs]); + } + break; + case SPECPDL_LET_DEFAULT: + case SPECPDL_LET_LOCAL: + mark_object (specpdl_where (pdl)); + case SPECPDL_LET: + mark_object (specpdl_symbol (pdl)); + mark_object (specpdl_old_value (pdl)); ++ mark_object (specpdl_saved_value (pdl)); + } + } + } + + void + get_backtrace (Lisp_Object array) + { + struct specbinding *pdl = backtrace_next (backtrace_top ()); + ptrdiff_t i = 0, asize = ASIZE (array); - if (backlist->nargs == UNEVALLED - || backlist->nargs == MANY) /* FIXME: Can this happen? */ - i = 1; + /* Copy the backtrace contents into working memory. */ + for (; i < asize; i++) + { + if (backtrace_p (pdl)) + { + ASET (array, i, backtrace_function (pdl)); + pdl = backtrace_next (pdl); + } else - i = backlist->nargs; - while (i--) - mark_object (backlist->args[i]); + ASET (array, i, Qnil); } } - #endif + + Lisp_Object backtrace_top_function (void) + { + struct specbinding *pdl = backtrace_top (); + return (backtrace_p (pdl) ? backtrace_function (pdl) : Qnil); + } void syms_of_eval (void) diff --cc src/lisp.h index 44dde1860cc,517d0abbb61..c8732d125cc --- a/src/lisp.h +++ b/src/lisp.h @@@ -2158,28 -2215,68 +2238,74 @@@ typedef jmp_buf sys_jmp_buf typedef Lisp_Object (*specbinding_func) (Lisp_Object); + enum specbind_tag { + SPECPDL_UNWIND, /* An unwind_protect function. */ + SPECPDL_BACKTRACE, /* An element of the backtrace. */ + SPECPDL_LET, /* A plain and simple dynamic let-binding. */ + /* Tags greater than SPECPDL_LET must be "subkinds" of LET. */ + SPECPDL_LET_LOCAL, /* A buffer-local let-binding. */ + SPECPDL_LET_DEFAULT /* A global binding for a localized var. */ + }; + struct specbinding { - Lisp_Object symbol, old_value; - specbinding_func func; - /* Normally this is unused; but it is to the symbol's current - value when a thread is swapped out. */ - Lisp_Object saved_value; + enum specbind_tag kind; + union { + struct { + Lisp_Object arg; + specbinding_func func; + } unwind; + struct { + /* `where' is not used in the case of SPECPDL_LET. */ + Lisp_Object symbol, old_value, where; ++ /* Normally this is unused; but it is to the symbol's current ++ value when a thread is swapped out. */ ++ Lisp_Object saved_value; + } let; + struct { + Lisp_Object function; + Lisp_Object *args; + ptrdiff_t nargs : BITS_PER_PTRDIFF_T - 1; + bool debug_on_exit : 1; + } bt; + } v; }; - #define SPECPDL_INDEX() (specpdl_ptr - specpdl) + LISP_INLINE Lisp_Object specpdl_symbol (struct specbinding *pdl) + { eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.symbol; } - struct backtrace - { - struct backtrace *next; - Lisp_Object function; - Lisp_Object *args; /* Points to vector of args. */ - ptrdiff_t nargs; /* Length of vector. */ - /* Nonzero means call value of debugger when done with this operation. */ - unsigned int debug_on_exit : 1; - }; + LISP_INLINE Lisp_Object specpdl_old_value (struct specbinding *pdl) + { eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.old_value; } + ++LISP_INLINE Lisp_Object specpdl_saved_value (struct specbinding *pdl) ++{ eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.saved_value; } + - extern struct backtrace *backtrace_list; + LISP_INLINE Lisp_Object specpdl_where (struct specbinding *pdl) + { eassert (pdl->kind > SPECPDL_LET); return pdl->v.let.where; } + + LISP_INLINE Lisp_Object specpdl_arg (struct specbinding *pdl) + { eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.arg; } + + LISP_INLINE specbinding_func specpdl_func (struct specbinding *pdl) + { eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.func; } + + LISP_INLINE Lisp_Object backtrace_function (struct specbinding *pdl) + { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.function; } + + LISP_INLINE ptrdiff_t backtrace_nargs (struct specbinding *pdl) + { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.nargs; } + + LISP_INLINE Lisp_Object *backtrace_args (struct specbinding *pdl) + { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.args; } + + LISP_INLINE bool backtrace_debug_on_exit (struct specbinding *pdl) + { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.debug_on_exit; } + -extern struct specbinding *specpdl; -extern struct specbinding *specpdl_ptr; -extern ptrdiff_t specpdl_size; ++/* extern struct specbinding *specpdl; */ ++/* extern struct specbinding *specpdl_ptr; */ ++/* extern ptrdiff_t specpdl_size; */ + + #define SPECPDL_INDEX() (specpdl_ptr - specpdl) /* Everything needed to describe an active condition case. @@@ -2235,11 -2332,12 +2361,12 @@@ struct catchta Lisp_Object tag; Lisp_Object volatile val; struct catchtag *volatile next; + #if 1 /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but they're defined later. */ struct gcpro *gcpro; + #endif sys_jmp_buf jmp; - struct backtrace *backlist; - struct handler *handlerlist; - EMACS_INT lisp_eval_depth; + struct handler *f_handlerlist; + EMACS_INT f_lisp_eval_depth; ptrdiff_t volatile pdlcount; int poll_suppress_count; int interrupt_input_blocked; @@@ -3294,10 -3394,15 +3422,18 @@@ extern Lisp_Object safe_call1 (Lisp_Obj extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object); extern void init_eval (void); extern void syms_of_eval (void); + extern void record_in_backtrace (Lisp_Object function, + Lisp_Object *args, ptrdiff_t nargs); -extern void mark_specpdl (void); ++extern void mark_specpdl (struct specbinding *first, struct specbinding *ptr); + extern void get_backtrace (Lisp_Object array); + Lisp_Object backtrace_top_function (void); + extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); + extern bool let_shadows_global_binding_p (Lisp_Object symbol); + +/* Defined in thread.c. */ +extern void mark_threads (void); + /* Defined in editfns.c. */ extern Lisp_Object Qfield; extern void insert1 (Lisp_Object); diff --cc src/process.c index e8e7a2be7be,9df003fa3a3..c1726e7ad60 --- a/src/process.c +++ b/src/process.c @@@ -4297,13 -4138,23 +4309,12 @@@ server_accept_connection (Lisp_Object s (STRINGP (host) ? host : build_string ("-")), build_string ("\n"))); - if (!NILP (p->sentinel)) - exec_sentinel (proc, - concat3 (build_string ("open from "), - (STRINGP (host) ? host : build_string ("-")), - build_string ("\n"))); + exec_sentinel (proc, + concat3 (build_string ("open from "), + (STRINGP (host) ? host : build_string ("-")), + 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) { @@@ -7188,12 -7054,14 +7206,10 @@@ init_process_emacs (void if (! noninteractive || initialized) #endif { - struct sigaction action; - emacs_sigaction_init (&action, deliver_child_signal); - sigaction (SIGCHLD, &action, 0); + catch_child_signal (); } - FD_ZERO (&input_wait_mask); - FD_ZERO (&non_keyboard_wait_mask); - FD_ZERO (&non_process_wait_mask); - FD_ZERO (&write_mask); - max_process_desc = 0; + max_desc = 0; memset (fd_callback_info, 0, sizeof (fd_callback_info)); #ifdef NON_BLOCKING_CONNECT diff --cc src/process.h index 7d13a8e5042,9455df18beb..cf1e0ea1d44 --- a/src/process.h +++ b/src/process.h @@@ -220,7 -217,6 +220,8 @@@ extern void add_read_fd (int fd, fd_cal 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 catch_child_signal (void); +extern void update_processes_for_thread_death (Lisp_Object); + INLINE_HEADER_END diff --cc src/thread.c index 7de260ee3c0,00000000000..1d282c3557a mode 100644,000000..100644 --- a/src/thread.c +++ b/src/thread.c @@@ -1,963 -1,0 +1,955 @@@ +/* Threading code. - Copyright (C) 2012 Free Software Foundation, Inc. ++ Copyright (C) 2012, 2013 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" +#include "character.h" +#include "buffer.h" +#include "process.h" +#include "coding.h" + +static struct thread_state primary_thread; + +struct thread_state *current_thread = &primary_thread; + +static struct thread_state *all_threads = &primary_thread; + +static sys_mutex_t global_lock; + +Lisp_Object Qthreadp, Qmutexp, Qcondition_variablep; + + + +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 (!NILP (current_thread->error_symbol)) + { + 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 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 = new_count == 0 ? 1 : new_count; + return 0; + } + if (mutex->owner == current_thread) + { + eassert (new_count == 0); + ++mutex->count; + return 0; + } + + self = current_thread; + self->wait_condvar = &mutex->condition; + while (mutex->owner != NULL && (new_count != 0 + || NILP (self->error_symbol))) + sys_cond_wait (&mutex->condition, &global_lock); + self->wait_condvar = NULL; + + if (new_count == 0 && !NILP (self->error_symbol)) + return 1; + + mutex->owner = self; + mutex->count = new_count == 0 ? 1 : new_count; + + return 1; +} + +static int +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 0; + + mutex->owner = NULL; + sys_cond_broadcast (&mutex->condition); + + 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 +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, + doc: /* Create a mutex. +A mutex provides a synchronization point for threads. +Only one thread at a time can hold a mutex. Other threads attempting +to acquire it will block until the mutex is available. + +A thread can acquire a mutex any number of times. + +NAME, if given, is used as the name of the mutex. The name is +informational only. */) + (Lisp_Object name) +{ + struct Lisp_Mutex *mutex; + Lisp_Object result; + + if (!NILP (name)) + CHECK_STRING (name); + + 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)); + mutex->name = name; + lisp_mutex_init (&mutex->mutex); + + XSETMUTEX (result, mutex); + return result; +} + +static void +mutex_lock_callback (void *arg) +{ + struct Lisp_Mutex *mutex = arg; + struct thread_state *self = current_thread; + + if (lisp_mutex_lock (&mutex->mutex, 0)) + post_acquire_global_lock (self); +} + +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: /* Acquire a mutex. +If the current thread already owns MUTEX, increment the count and +return. +Otherwise, if no thread owns MUTEX, make the current thread own it. +Otherwise, block until MUTEX is available, or until the current thread +is signalled using `thread-signal'. +Note that calls to `mutex-lock' and `mutex-unlock' must be paired. */) + (Lisp_Object mutex) +{ + struct Lisp_Mutex *lmutex; + ptrdiff_t count = SPECPDL_INDEX (); + + CHECK_MUTEX (mutex); + lmutex = XMUTEX (mutex); + + current_thread->event_object = mutex; + record_unwind_protect (do_unwind_mutex_lock, Qnil); + flush_stack_call_func (mutex_lock_callback, lmutex); + return unbind_to (count, Qnil); +} + +static void +mutex_unlock_callback (void *arg) +{ + struct Lisp_Mutex *mutex = arg; + struct thread_state *self = current_thread; + + if (lisp_mutex_unlock (&mutex->mutex)) + post_acquire_global_lock (self); +} + +DEFUN ("mutex-unlock", Fmutex_unlock, Smutex_unlock, 1, 1, 0, + doc: /* Release the mutex. +If this thread does not own MUTEX, signal an error. +Otherwise, decrement the mutex's count. If the count is zero, +release MUTEX. */) + (Lisp_Object mutex) +{ + struct Lisp_Mutex *lmutex; + + CHECK_MUTEX (mutex); + lmutex = XMUTEX (mutex); + + flush_stack_call_func (mutex_unlock_callback, lmutex); + return Qnil; +} + +DEFUN ("mutex-name", Fmutex_name, Smutex_name, 1, 1, 0, + doc: /* Return the name of MUTEX. +If no name was given when MUTEX was created, return nil. */) + (Lisp_Object mutex) +{ + struct Lisp_Mutex *lmutex; + + CHECK_MUTEX (mutex); + lmutex = XMUTEX (mutex); + + return lmutex->name; +} + +void +finalize_one_mutex (struct Lisp_Mutex *mutex) +{ + lisp_mutex_destroy (&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 releases the mutex and waits for CONDITION to be notified or for +this thread to be signalled with `thread-signal'. 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 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; +} + +DEFUN ("condition-mutex", Fcondition_mutex, Scondition_mutex, 1, 1, 0, + doc: /* Return the mutex associated with CONDITION. */) + (Lisp_Object condition) +{ + struct Lisp_CondVar *cvar; + + CHECK_CONDVAR (condition); + cvar = XCONDVAR (condition); + + return cvar->mutex; +} + +DEFUN ("condition-name", Fcondition_name, Scondition_name, 1, 1, 0, + doc: /* Return the name of CONDITION. +If no name was given when CONDITION was created, return nil. */) + (Lisp_Object condition) +{ + struct Lisp_CondVar *cvar; + + CHECK_CONDVAR (condition); + cvar = XCONDVAR (condition); + + return cvar->name; +} + +void +finalize_one_condvar (struct Lisp_CondVar *condvar) +{ + sys_cond_destroy (&condvar->cond); +} + + + +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) +{ - 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); - mark_object (bind->saved_value); - } ++ mark_specpdl (thread->m_specpdl, thread->m_specpdl_ptr); + +#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 + { + 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) + { + Lisp_Object thread_obj; + + XSETTHREAD (thread_obj, iter); + mark_object (thread_obj); + 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); +} + + + +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 (); + + 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) + ; + *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 +finalize_one_thread (struct thread_state *state) +{ + 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; + const char *c_name = NULL; + + /* Can't start a thread in temacs. */ + if (!initialized) + abort (); + + if (!NILP (name)) + CHECK_STRING (name); + + 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->event_object = 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 (!NILP (name)) + c_name = SSDATA (ENCODE_UTF_8 (name)); + + if (! sys_thread_create (&thr, c_name, 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: /* 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', `condition-wait', +or `thread-join' in the target thread. */) + (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: /* Return t if THREAD is alive, or nil if it has exited. */) + (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; +} + +DEFUN ("thread-blocker", Fthread_blocker, Sthread_blocker, 1, 1, 0, + doc: /* Return the object that THREAD is blocking on. +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) +{ + 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 && NILP (self->error_symbol)) + sys_cond_wait (self->wait_condvar, &global_lock); + + self->wait_condvar = NULL; + self->event_object = Qnil; + post_acquire_global_lock (self); +} + +DEFUN ("thread-join", Fthread_join, Sthread_join, 1, 1, 0, + doc: /* Wait for a thread to exit. +This blocks the current thread until THREAD exits. +It is an error for a thread to try to join itself. */) + (Lisp_Object thread) +{ + struct thread_state *tstate; + + CHECK_THREAD (thread); + tstate = XTHREAD (thread); + + if (tstate == current_thread) + error ("cannot join current 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; +} + + + +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) +{ + primary_thread.header.size + = PSEUDOVECSIZE (struct thread_state, m_gcprolist); + 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; + primary_thread.event_object = 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 (&Sthread_blocker); + defsubr (&Sall_threads); + defsubr (&Smake_mutex); + defsubr (&Smutex_lock); + defsubr (&Smutex_unlock); + defsubr (&Smutex_name); + defsubr (&Smake_condition_variable); + defsubr (&Scondition_wait); + defsubr (&Scondition_notify); + defsubr (&Scondition_mutex); + defsubr (&Scondition_name); + + 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 --cc src/thread.h index 47fa87c77fa,00000000000..9f0eead4637 mode 100644,000000..100644 --- a/src/thread.h +++ b/src/thread.h @@@ -1,253 -1,0 +1,250 @@@ +/* Thread definitions + Copyright (C) 2012, 2013 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" + +#include "sysselect.h" /* FIXME */ +#include "systime.h" /* FIXME */ + +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. */ + 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) + + /* 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; + + /* 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; +#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) + + /* 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) + + /* 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. */ + bool 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) + + /* 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; + + /* 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; +}; + +/* A mutex in lisp is represented by a system 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 +{ + /* 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; +}; + +/* 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); +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); + +int thread_check_current_buffer (struct buffer *); + +#endif /* THREAD_H */