From: Tom Tromey Date: Sun, 7 Jul 2013 05:18:58 +0000 (-0600) Subject: merge from trunk X-Git-Tag: emacs-26.0.90~1144^2~17^2~27 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=6dacdad5fcb278e5a16b38bb81786aac9ca27be4;p=emacs.git merge from trunk this merges frmo trunk and fixes various build issues. this needed a few ugly tweaks. this hangs in "make check" now --- 6dacdad5fcb278e5a16b38bb81786aac9ca27be4 diff --cc configure.ac index f6c855815bf,baf8aab1406..90f9f3a4799 --- a/configure.ac +++ b/configure.ac @@@ -1310,10 -1311,10 +1311,10 @@@ f dnl checks for header files AC_CHECK_HEADERS_ONCE( - linux/version.h sys/systeminfo.h + sys/systeminfo.h coff.h pty.h sys/resource.h - sys/utsname.h pwd.h utmp.h util.h) + sys/utsname.h pwd.h utmp.h util.h sys/prctl.h) AC_MSG_CHECKING(if personality LINUX32 can be set) AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[personality (PER_LINUX32)]])], @@@ -3234,7 -3248,7 +3248,7 @@@ gai_strerror mkstemp getline getdelim s difftime posix_memalign \ getpwent endpwent getgrent endgrent \ touchlock \ - cfmakeraw cfsetspeed copysign __executable_start prctl) -cfmakeraw cfsetspeed copysign __executable_start log2) ++cfmakeraw cfsetspeed copysign __executable_start log2 prctl) ## Eric Backus says, HP-UX 9.x on HP 700 machines ## has a broken `rint' in some library versions including math library diff --cc src/buffer.c index e78962e1550,94104ef535c..2555b5c17ac --- a/src/buffer.c +++ b/src/buffer.c @@@ -1726,21 -1734,6 +1732,9 @@@ cleaning up all windows currently displ 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)) - { - GCPRO1 (buffer); - tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ", - BVAR (b, name), make_number (0))); - UNGCPRO; - if (NILP (tem)) - return Qnil; - } - /* Run hooks with the buffer to be killed the current buffer. */ { ptrdiff_t count = SPECPDL_INDEX (); diff --cc src/data.c index 59fd921747a,dedbd51f36e..ea72a3fc181 --- a/src/data.c +++ b/src/data.c @@@ -76,10 -76,10 +76,11 @@@ static Lisp_Object Qprocess, Qmarker static Lisp_Object Qcompiled_function, Qframe; Lisp_Object Qbuffer; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; - static Lisp_Object Qsubrp, Qmany, Qunevalled; + static Lisp_Object Qsubrp; + static Lisp_Object Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; static Lisp_Object Qdefun; +Lisp_Object Qthread, Qmutex, Qcondition_variable; Lisp_Object Qinteractive_form; static Lisp_Object Qdefalias_fset_function; diff --cc src/eval.c index 37ea81ba1cb,d3545add21d..451a7b0cc28 --- a/src/eval.c +++ b/src/eval.c @@@ -76,17 -76,19 +76,19 @@@ Lisp_Object Vrun_hooks Lisp_Object Vautoload_queue; - /* Current number of specbindings allocated in specpdl. */ + /* Current number of specbindings allocated in specpdl, not counting + the dummy entry specpdl[-1]. */ -ptrdiff_t specpdl_size; +/* ptrdiff_t specpdl_size; */ - /* Pointer to beginning of specpdl. */ + /* Pointer to beginning of specpdl. A dummy entry specpdl[-1] exists + only so that its address can be taken. */ - /* struct specbinding *specpdl; */ -union specbinding *specpdl; ++/* union specbinding *specpdl; */ /* Pointer to first unused element in specpdl. */ - /* struct specbinding *specpdl_ptr; */ -union specbinding *specpdl_ptr; ++/* union specbinding *specpdl_ptr; */ /* Depth in Lisp evaluations and function calls. */ @@@ -115,6 -117,69 +117,76 @@@ Lisp_Object inhibit_lisp_code static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); + static Lisp_Object + specpdl_symbol (union specbinding *pdl) + { + eassert (pdl->kind >= SPECPDL_LET); + return pdl->let.symbol; + } + + static Lisp_Object + specpdl_old_value (union specbinding *pdl) + { + eassert (pdl->kind >= SPECPDL_LET); + return pdl->let.old_value; + } + + static Lisp_Object + specpdl_where (union specbinding *pdl) + { + eassert (pdl->kind > SPECPDL_LET); + return pdl->let.where; + } + ++static Lisp_Object ++specpdl_saved_value (union specbinding *pdl) ++{ ++ eassert (pdl->kind >= SPECPDL_LET); ++ return pdl->let.saved_value; ++} ++ + static Lisp_Object + specpdl_arg (union specbinding *pdl) + { + eassert (pdl->kind == SPECPDL_UNWIND); + return pdl->unwind.arg; + } + + static specbinding_func + specpdl_func (union specbinding *pdl) + { + eassert (pdl->kind == SPECPDL_UNWIND); + return pdl->unwind.func; + } + + static Lisp_Object + backtrace_function (union specbinding *pdl) + { + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->bt.function; + } + + static ptrdiff_t + backtrace_nargs (union specbinding *pdl) + { + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->bt.nargs; + } + + static Lisp_Object * + backtrace_args (union specbinding *pdl) + { + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->bt.args; + } + + static bool + backtrace_debug_on_exit (union specbinding *pdl) + { + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->bt.debug_on_exit; + } + /* Functions to modify slots of backtrace records. */ static void @@@ -3022,52 -3088,6 +3108,52 @@@ let_shadows_global_binding_p (Lisp_Obje return 0; } +static Lisp_Object - binding_symbol (struct specbinding *bind) ++binding_symbol (union specbinding *bind) +{ + if (!CONSP (specpdl_symbol (bind))) + return specpdl_symbol (bind); + return XCAR (specpdl_symbol (bind)); +} + +void - do_specbind (struct Lisp_Symbol *sym, struct specbinding *bind, ++do_specbind (struct Lisp_Symbol *sym, union specbinding *bind, + Lisp_Object value) +{ + switch (sym->redirect) + { + case SYMBOL_PLAINVAL: + if (!sym->constant) + SET_SYMBOL_VAL (sym, value); + else + set_internal (specpdl_symbol (bind), value, Qnil, 1); + break; + + case SYMBOL_LOCALIZED: + case SYMBOL_FORWARDED: + if ((sym->redirect == SYMBOL_LOCALIZED + || BUFFER_OBJFWDP (SYMBOL_FWD (sym))) + && CONSP (specpdl_symbol (bind))) + { + Lisp_Object where; + + where = XCAR (XCDR (specpdl_symbol (bind))); + if (NILP (where) + && sym->redirect == SYMBOL_FORWARDED) + { + Fset_default (XCAR (specpdl_symbol (bind)), 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: @@@ -3101,12 -3121,14 +3187,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. */ - 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->let.kind = SPECPDL_LET; + specpdl_ptr->let.symbol = symbol; + specpdl_ptr->let.old_value = SYMBOL_VAL (sym); ++ specpdl_ptr->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) @@@ -3114,11 -3136,10 +3200,11 @@@ case SYMBOL_FORWARDED: { Lisp_Object ovalue = find_symbol_value (symbol); - specpdl_ptr->kind = SPECPDL_LET_LOCAL; - specpdl_ptr->v.let.symbol = symbol; - specpdl_ptr->v.let.old_value = ovalue; - specpdl_ptr->v.let.where = Fcurrent_buffer (); - specpdl_ptr->v.let.saved_value = Qnil; + specpdl_ptr->let.kind = SPECPDL_LET_LOCAL; + specpdl_ptr->let.symbol = symbol; + specpdl_ptr->let.old_value = ovalue; + specpdl_ptr->let.where = Fcurrent_buffer (); ++ specpdl_ptr->let.saved_value = Qnil; eassert (sym->redirect != SYMBOL_LOCALIZED || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); @@@ -3137,17 -3158,17 +3223,17 @@@ happens with other buffer-local variables. */ if (NILP (Flocal_variable_p (symbol, Qnil))) { - specpdl_ptr->kind = SPECPDL_LET_DEFAULT; + specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; ++specpdl_ptr; - Fset_default (symbol, value); + do_specbind (sym, specpdl_ptr - 1, value); return; } } else - specpdl_ptr->kind = SPECPDL_LET; + specpdl_ptr->let.kind = SPECPDL_LET; specpdl_ptr++; - set_internal (symbol, value, Qnil, 1); + do_specbind (sym, specpdl_ptr - 1, value); break; } default: emacs_abort (); @@@ -3165,73 -3186,6 +3251,73 @@@ record_unwind_protect (Lisp_Object (*fu specpdl_ptr++; } +void +rebind_for_thread_switch (void) +{ - struct specbinding *bind; ++ union specbinding *bind; + + for (bind = specpdl; bind != specpdl_ptr; ++bind) + { + if (bind->kind >= SPECPDL_LET) + { + Lisp_Object value = specpdl_saved_value (bind); + - bind->v.let.saved_value = Qnil; ++ bind->let.saved_value = Qnil; + do_specbind (XSYMBOL (binding_symbol (bind)), bind, value); + } + } +} + +static void - do_one_unbind (struct specbinding *this_binding, int unwinding) ++do_one_unbind (union specbinding *this_binding, int unwinding) +{ + eassert (unwinding || this_binding->kind >= SPECPDL_LET); + switch (this_binding->kind) + { + case SPECPDL_UNWIND: - (*specpdl_func (this_binding)) (specpdl_arg (this_binding)); ++ 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) { @@@ -3243,16 -3197,57 +3329,16 @@@ while (specpdl_ptr != specpdl + count) { - /* Decrement specpdl_ptr before we do the work to unbind it, so - that an error in unbinding won't try to unbind the same entry - again. Take care to copy any parts of the binding needed - before invoking any code that can make more bindings. */ + /* Copy the binding, and decrement specpdl_ptr, before we do + the work to unbind it. We decrement first + so that an error in unbinding won't try to unbind + the same entry again, and we copy the binding first + in case more bindings are made during some of the code we run. */ - struct specbinding this_binding; - specpdl_ptr--; ++ union specbinding this_binding; + this_binding = *--specpdl_ptr; - switch (specpdl_ptr->kind) - { - case SPECPDL_UNWIND: - specpdl_func (specpdl_ptr) (specpdl_arg (specpdl_ptr)); - 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 (specpdl_ptr))->redirect - == SYMBOL_PLAINVAL) - SET_SYMBOL_VAL (XSYMBOL (specpdl_symbol (specpdl_ptr)), - specpdl_old_value (specpdl_ptr)); - 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 (specpdl_ptr), - specpdl_old_value (specpdl_ptr)); - 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 (specpdl_ptr); - Lisp_Object where = specpdl_where (specpdl_ptr); - Lisp_Object old_value = specpdl_old_value (specpdl_ptr); - eassert (BUFFERP (where)); - - if (specpdl_ptr->kind == SPECPDL_LET_DEFAULT) - Fset_default (symbol, old_value); - /* 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, old_value, where, 1); - } - break; - } + do_one_unbind (&this_binding, 1); } if (NILP (Vquit_flag) && !NILP (quitf)) @@@ -3262,21 -3257,6 +3348,21 @@@ return value; } +void +unbind_for_thread_switch (void) +{ - struct specbinding *bind; ++ union specbinding *bind; + + for (bind = specpdl_ptr; bind != specpdl; --bind) + { + if (bind->kind >= SPECPDL_LET) + { - bind->v.let.saved_value = find_symbol_value (binding_symbol (bind)); ++ bind->let.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 @@@ -3386,10 -3366,10 +3472,10 @@@ If NFRAMES is more than the number of f void - mark_specpdl (struct specbinding *first, struct specbinding *ptr) -mark_specpdl (void) ++mark_specpdl (union specbinding *first, union specbinding *ptr) { - struct specbinding *pdl; + union specbinding *pdl; - for (pdl = specpdl; pdl != specpdl_ptr; pdl++) + for (pdl = first; pdl != ptr; pdl++) { switch (pdl->kind) { @@@ -3412,7 -3395,7 +3501,8 @@@ case SPECPDL_LET: mark_object (specpdl_symbol (pdl)); mark_object (specpdl_old_value (pdl)); + mark_object (specpdl_saved_value (pdl)); + break; } } } diff --cc src/lisp.h index 7a8823e6bac,5d6fa760108..9af69c61da8 --- a/src/lisp.h +++ b/src/lisp.h @@@ -391,6 -503,11 +505,44 @@@ typedef EMACS_INT Lisp_Object enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 0 }; #endif /* CHECK_LISP_OBJECT_TYPE */ ++/* Header of vector-like objects. This documents the layout constraints on ++ vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents ++ compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR ++ and PSEUDOVECTORP cast their pointers to struct vectorlike_header *, ++ because when two such pointers potentially alias, a compiler won't ++ incorrectly reorder loads and stores to their size fields. See ++ . */ ++struct vectorlike_header ++ { ++ /* The only field contains various pieces of information: ++ - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit. ++ - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain ++ vector (0) or a pseudovector (1). ++ - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number ++ of slots) of the vector. ++ - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into three fields: ++ - a) pseudovector subtype held in PVEC_TYPE_MASK field; ++ - b) number of Lisp_Objects slots at the beginning of the object ++ held in PSEUDOVECTOR_SIZE_MASK field. These objects are always ++ traced by the GC; ++ - c) size of the rest fields held in PSEUDOVECTOR_REST_MASK and ++ measured in word_size units. Rest fields may also include ++ Lisp_Objects, but these objects usually needs some special treatment ++ during GC. ++ There are some exceptions. For PVEC_FREE, b) is always zero. For ++ PVEC_BOOL_VECTOR and PVEC_SUBR, both b) and c) are always zero. ++ Current layout limits the pseudovectors to 63 PVEC_xxx subtypes, ++ 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */ ++ ptrdiff_t size; ++ }; ++ ++#include "thread.h" ++ + /* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa. + At the machine level, these operations are no-ops. */ + LISP_MACRO_DEFUN (XLI, EMACS_INT, (Lisp_Object o), (o)) + LISP_MACRO_DEFUN (XIL, Lisp_Object, (EMACS_INT i), (i)) + /* In the size word of a vector, this bit means the vector has been marked. */ static ptrdiff_t const ARRAY_MARK_FLAG @@@ -556,69 -694,173 +732,200 @@@ clip_to_bounds (ptrdiff_t lower, EMACS_ { return num < lower ? lower : num <= upper ? num : upper; } + + /* Forward declarations. */ + + /* Defined in this file. */ + union Lisp_Fwd; + LISP_INLINE bool BOOL_VECTOR_P (Lisp_Object); + LISP_INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *); + LISP_INLINE bool BUFFERP (Lisp_Object); + LISP_INLINE bool CHAR_TABLE_P (Lisp_Object); + LISP_INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t); + LISP_INLINE bool (CONSP) (Lisp_Object); + LISP_INLINE bool (FLOATP) (Lisp_Object); + LISP_INLINE bool functionp (Lisp_Object); + LISP_INLINE bool (INTEGERP) (Lisp_Object); + LISP_INLINE bool (MARKERP) (Lisp_Object); + LISP_INLINE bool (MISCP) (Lisp_Object); + LISP_INLINE bool (NILP) (Lisp_Object); + LISP_INLINE bool OVERLAYP (Lisp_Object); + LISP_INLINE bool PROCESSP (Lisp_Object); + LISP_INLINE bool PSEUDOVECTORP (Lisp_Object, int); + LISP_INLINE bool SAVE_VALUEP (Lisp_Object); + LISP_INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, + Lisp_Object); + LISP_INLINE bool STRINGP (Lisp_Object); + LISP_INLINE bool SUB_CHAR_TABLE_P (Lisp_Object); + LISP_INLINE bool SUBRP (Lisp_Object); + LISP_INLINE bool (SYMBOLP) (Lisp_Object); + LISP_INLINE bool (VECTORLIKEP) (Lisp_Object); + LISP_INLINE bool WINDOWP (Lisp_Object); ++LISP_INLINE bool THREADP (Lisp_Object); ++LISP_INLINE bool MUTEXP (Lisp_Object); ++LISP_INLINE bool CONDVARP (Lisp_Object); + LISP_INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object); + + /* Defined in chartab.c. */ + extern Lisp_Object char_table_ref (Lisp_Object, int); + extern void char_table_set (Lisp_Object, int, Lisp_Object); + extern int char_table_translate (Lisp_Object, int); + + /* Defined in data.c. */ + extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p; + extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil; + extern Lisp_Object Qnumberp, Qstringp, Qsymbolp, Qvectorp; + extern Lisp_Object Qvector_or_char_table_p, Qwholenump; + extern Lisp_Object Ffboundp (Lisp_Object); + extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); + + /* Defined in emacs.c. */ + extern bool initialized; + + /* Defined in eval.c. */ + extern Lisp_Object Qautoload; + + /* Defined in floatfns.c. */ + extern double extract_float (Lisp_Object); + + /* Defined in process.c. */ + extern Lisp_Object Qprocessp; + ++/* Defined in thread.c. */ ++extern Lisp_Object Qthreadp, Qmutexp, Qcondition_variablep; ++ + /* Defined in window.c. */ + extern Lisp_Object Qwindowp; + /* Defined in xdisp.c. */ + extern Lisp_Object Qimage; + /* Extract a value or address from a Lisp_Object. */ - #define XCONS(a) (eassert (CONSP (a)), \ - (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) - #define XVECTOR(a) (eassert (VECTORLIKEP (a)), \ - (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike)) - #define XSTRING(a) (eassert (STRINGP (a)), \ - (struct Lisp_String *) XUNTAG (a, Lisp_String)) - #define XSYMBOL(a) (eassert (SYMBOLP (a)), \ - (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) - #define XFLOAT(a) (eassert (FLOATP (a)), \ - (struct Lisp_Float *) XUNTAG (a, Lisp_Float)) + LISP_MACRO_DEFUN (XCONS, struct Lisp_Cons *, (Lisp_Object a), (a)) - /* Misc types. */ + LISP_INLINE struct Lisp_Vector * + XVECTOR (Lisp_Object a) + { + eassert (VECTORLIKEP (a)); + return XUNTAG (a, Lisp_Vectorlike); + } - #define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc)) - #define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any)) - #define XMISCTYPE(a) (XMISCANY (a)->type) - #define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker)) - #define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC (a)->u_overlay)) + LISP_INLINE struct Lisp_String * + XSTRING (Lisp_Object a) + { + eassert (STRINGP (a)); + return XUNTAG (a, Lisp_String); + } - /* Forwarding object types. */ + LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a)) - #define XFWDTYPE(a) (a->u_intfwd.type) - #define XINTFWD(a) (eassert (INTFWDP (a)), &((a)->u_intfwd)) - #define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &((a)->u_boolfwd)) - #define XOBJFWD(a) (eassert (OBJFWDP (a)), &((a)->u_objfwd)) - #define XBUFFER_OBJFWD(a) \ - (eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd)) - #define XKBOARD_OBJFWD(a) \ - (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd)) + LISP_INLINE struct Lisp_Float * + XFLOAT (Lisp_Object a) + { + eassert (FLOATP (a)); + return XUNTAG (a, Lisp_Float); + } /* Pseudovector types. */ - struct Lisp_Process; - LISP_INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p) - { return make_lisp_ptr (p, Lisp_Vectorlike); } - #define XPROCESS(a) (eassert (PROCESSP (a)), \ - (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike)) - #define XWINDOW(a) (eassert (WINDOWP (a)), \ - (struct window *) XUNTAG (a, Lisp_Vectorlike)) - #define XTERMINAL(a) (eassert (TERMINALP (a)), \ - (struct terminal *) XUNTAG (a, Lisp_Vectorlike)) - #define XSUBR(a) (eassert (SUBRP (a)), \ - (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike)) - #define XBUFFER(a) (eassert (BUFFERP (a)), \ - (struct buffer *) XUNTAG (a, Lisp_Vectorlike)) - #define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \ - (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike)) - #define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \ - ((struct Lisp_Sub_Char_Table *) \ - XUNTAG (a, Lisp_Vectorlike))) - #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)) - #define XMUTEX(a) (eassert (MUTEXP (a)), (struct Lisp_Mutex *) XPNTR(a)) - #define XCONDVAR(a) (eassert (CONDVARP (a)), (struct Lisp_CondVar *) XPNTR(a)) + + LISP_INLINE struct Lisp_Process * + XPROCESS (Lisp_Object a) + { + eassert (PROCESSP (a)); + return XUNTAG (a, Lisp_Vectorlike); + } + + LISP_INLINE struct window * + XWINDOW (Lisp_Object a) + { + eassert (WINDOWP (a)); + return XUNTAG (a, Lisp_Vectorlike); + } + + LISP_INLINE struct terminal * + XTERMINAL (Lisp_Object a) + { + return XUNTAG (a, Lisp_Vectorlike); + } + + LISP_INLINE struct Lisp_Subr * + XSUBR (Lisp_Object a) + { + eassert (SUBRP (a)); + return XUNTAG (a, Lisp_Vectorlike); + } + + LISP_INLINE struct buffer * + XBUFFER (Lisp_Object a) + { + eassert (BUFFERP (a)); + return XUNTAG (a, Lisp_Vectorlike); + } + + LISP_INLINE struct Lisp_Char_Table * + XCHAR_TABLE (Lisp_Object a) + { + eassert (CHAR_TABLE_P (a)); + return XUNTAG (a, Lisp_Vectorlike); + } + + LISP_INLINE struct Lisp_Sub_Char_Table * + XSUB_CHAR_TABLE (Lisp_Object a) + { + eassert (SUB_CHAR_TABLE_P (a)); + return XUNTAG (a, Lisp_Vectorlike); + } + + LISP_INLINE struct Lisp_Bool_Vector * + XBOOL_VECTOR (Lisp_Object a) + { + eassert (BOOL_VECTOR_P (a)); + return XUNTAG (a, Lisp_Vectorlike); + } + ++LISP_INLINE struct thread_state * ++XTHREAD (Lisp_Object a) ++{ ++ eassert (THREADP (a)); ++ return XUNTAG (a, Lisp_Vectorlike); ++} ++ ++LISP_INLINE struct Lisp_Mutex * ++XMUTEX (Lisp_Object a) ++{ ++ eassert (MUTEXP (a)); ++ return XUNTAG (a, Lisp_Vectorlike); ++} ++ ++LISP_INLINE struct Lisp_CondVar * ++XCONDVAR (Lisp_Object a) ++{ ++ eassert (CONDVARP (a)); ++ return XUNTAG (a, Lisp_Vectorlike); ++} + /* Construct a Lisp_Object from a value or address. */ + LISP_INLINE Lisp_Object + make_lisp_ptr (void *ptr, enum Lisp_Type type) + { + EMACS_UINT utype = type; + EMACS_UINT typebits = USE_LSB_TAG ? type : utype << VALBITS; + Lisp_Object a = XIL (typebits | (uintptr_t) ptr); + eassert (XTYPE (a) == type && XUNTAG (a, type) == ptr); + return a; + } + + LISP_INLINE Lisp_Object + make_lisp_proc (struct Lisp_Process *p) + { + return make_lisp_ptr (p, Lisp_Vectorlike); + } + #define XSETINT(a, b) ((a) = make_number (b)) + #define XSETFASTINT(a, b) ((a) = make_natnum (b)) #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) @@@ -663,39 -905,11 +970,14 @@@ #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)) +#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. */ - - #define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX] - #define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size - #define ASET(ARRAY, IDX, VAL) \ - (eassert (0 <= (IDX) && (IDX) < ASIZE (ARRAY)), \ - XVECTOR (ARRAY)->contents[IDX] = (VAL)) - - /* Convenience macros for dealing with Lisp strings. */ - - #define SDATA(string) (XSTRING (string)->data + 0) - #define SREF(string, index) (SDATA (string)[index] + 0) - #define SSET(string, index, new) (SDATA (string)[index] = (new)) - #define SCHARS(string) (XSTRING (string)->size + 0) - #define SBYTES(string) (STRING_BYTES (XSTRING (string)) + 0) - - /* Avoid "differ in sign" warnings. */ - #define SSDATA(x) ((char *) SDATA (x)) - - #define STRING_SET_CHARS(string, newsize) \ - (XSTRING (string)->size = (newsize)) - - #define STRING_COPYIN(string, index, new, count) \ - memcpy (SDATA (string) + index, new, count) - /* Type checking. */ - #define CHECK_TYPE(ok, Qxxxp, x) \ - do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0) + LISP_MACRO_DEFUN_VOID (CHECK_TYPE, (int ok, Lisp_Object Qxxxp, Lisp_Object x), + (ok, Qxxxp, x)) /* Deprecated and will be removed soon. */ @@@ -813,47 -1045,96 +1113,65 @@@ STRING_MULTIBYTE (Lisp_Object str (STR) = empty_multibyte_string; \ else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0) - /* In a string or vector, the sign bit of the `size' is the gc mark bit. */ + /* Convenience functions for dealing with Lisp strings. */ - struct Lisp_String - { - ptrdiff_t size; - ptrdiff_t size_byte; - INTERVAL intervals; /* Text properties in this string. */ - unsigned char *data; - }; + LISP_INLINE unsigned char * + SDATA (Lisp_Object string) + { + return XSTRING (string)->data; + } + LISP_INLINE char * + SSDATA (Lisp_Object string) + { + /* Avoid "differ in sign" warnings. */ + return (char *) SDATA (string); + } + LISP_INLINE unsigned char + SREF (Lisp_Object string, ptrdiff_t index) + { + return SDATA (string)[index]; + } + LISP_INLINE void + SSET (Lisp_Object string, ptrdiff_t index, unsigned char new) + { + SDATA (string)[index] = new; + } + LISP_INLINE ptrdiff_t + SCHARS (Lisp_Object string) + { + return XSTRING (string)->size; + } - /* Header of vector-like objects. This documents the layout constraints on - vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents - compilers from being fooled by Emacs's type punning: the XSETPSEUDOVECTOR - and PSEUDOVECTORP macros cast their pointers to struct vectorlike_header *, - because when two such pointers potentially alias, a compiler won't - incorrectly reorder loads and stores to their size fields. See - . */ - struct vectorlike_header - { - /* The only field contains various pieces of information: - - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit. - - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain - vector (0) or a pseudovector (1). - - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number - of slots) of the vector. - - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into three fields: - - a) pseudovector subtype held in PVEC_TYPE_MASK field; - - b) number of Lisp_Objects slots at the beginning of the object - held in PSEUDOVECTOR_SIZE_MASK field. These objects are always - traced by the GC; - - c) size of the rest fields held in PSEUDOVECTOR_REST_MASK and - measured in word_size units. Rest fields may also include - Lisp_Objects, but these objects usually needs some special treatment - during GC. - There are some exceptions. For PVEC_FREE, b) is always zero. For - PVEC_BOOL_VECTOR and PVEC_SUBR, both b) and c) are always zero. - Current layout limits the pseudovectors to 63 PVEC_xxx subtypes, - 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */ - ptrdiff_t size; - }; + #ifdef GC_CHECK_STRING_BYTES + extern ptrdiff_t string_bytes (struct Lisp_String *); + #endif + LISP_INLINE ptrdiff_t + STRING_BYTES (struct Lisp_String *s) + { + #ifdef GC_CHECK_STRING_BYTES + return string_bytes (s); + #else + return s->size_byte < 0 ? s->size : s->size_byte; + #endif + } + + LISP_INLINE ptrdiff_t + SBYTES (Lisp_Object string) + { + return STRING_BYTES (XSTRING (string)); + } + LISP_INLINE void + STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize) + { + XSTRING (string)->size = newsize; + } + LISP_INLINE void + STRING_COPYIN (Lisp_Object string, ptrdiff_t index, char const *new, + ptrdiff_t count) + { + memcpy (SDATA (string) + index, new, count); + } -/* Header of vector-like objects. This documents the layout constraints on - vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents - compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR - and PSEUDOVECTORP cast their pointers to struct vectorlike_header *, - because when two such pointers potentially alias, a compiler won't - incorrectly reorder loads and stores to their size fields. See - . */ -struct vectorlike_header - { - /* The only field contains various pieces of information: - - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit. - - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain - vector (0) or a pseudovector (1). - - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number - of slots) of the vector. - - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into three fields: - - a) pseudovector subtype held in PVEC_TYPE_MASK field; - - b) number of Lisp_Objects slots at the beginning of the object - held in PSEUDOVECTOR_SIZE_MASK field. These objects are always - traced by the GC; - - c) size of the rest fields held in PSEUDOVECTOR_REST_MASK and - measured in word_size units. Rest fields may also include - Lisp_Objects, but these objects usually needs some special treatment - during GC. - There are some exceptions. For PVEC_FREE, b) is always zero. For - PVEC_BOOL_VECTOR and PVEC_SUBR, both b) and c) are always zero. - Current layout limits the pseudovectors to 63 PVEC_xxx subtypes, - 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */ - ptrdiff_t size; - }; - /* Regular vector is just a header plus array of Lisp_Objects. */ struct Lisp_Vector @@@ -1779,193 -2216,235 +2253,253 @@@ typedef struct /* Data type checking. */ - #define NILP(x) EQ (x, Qnil) + LISP_MACRO_DEFUN (NILP, bool, (Lisp_Object x), (x)) - #define NUMBERP(x) (INTEGERP (x) || FLOATP (x)) - #define NATNUMP(x) (INTEGERP (x) && XINT (x) >= 0) + LISP_INLINE bool + NUMBERP (Lisp_Object x) + { + return INTEGERP (x) || FLOATP (x); + } + LISP_INLINE bool + NATNUMP (Lisp_Object x) + { + return INTEGERP (x) && 0 <= XINT (x); + } + + LISP_INLINE bool + RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi) + { + return INTEGERP (x) && lo <= XINT (x) && XINT (x) <= hi; + } - #define RANGED_INTEGERP(lo, x, hi) \ - (INTEGERP (x) && (lo) <= XINT (x) && XINT (x) <= (hi)) #define TYPE_RANGED_INTEGERP(type, x) \ - (TYPE_SIGNED (type) \ - ? RANGED_INTEGERP (TYPE_MINIMUM (type), x, TYPE_MAXIMUM (type)) \ - : RANGED_INTEGERP (0, x, TYPE_MAXIMUM (type))) - - #define INTEGERP(x) (LISP_INT_TAG_P (XTYPE ((x)))) - #define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol) - #define MISCP(x) (XTYPE ((x)) == Lisp_Misc) - #define VECTORLIKEP(x) (XTYPE ((x)) == Lisp_Vectorlike) - #define STRINGP(x) (XTYPE ((x)) == Lisp_String) - #define CONSP(x) (XTYPE ((x)) == Lisp_Cons) - - #define FLOATP(x) (XTYPE ((x)) == Lisp_Float) - #define VECTORP(x) (VECTORLIKEP (x) && !(ASIZE (x) & PSEUDOVECTOR_FLAG)) - #define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay) - #define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) + (INTEGERP (x) \ + && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \ + && XINT (x) <= TYPE_MAXIMUM (type)) + + LISP_MACRO_DEFUN (CONSP, bool, (Lisp_Object x), (x)) + LISP_MACRO_DEFUN (FLOATP, bool, (Lisp_Object x), (x)) + LISP_MACRO_DEFUN (MISCP, bool, (Lisp_Object x), (x)) + LISP_MACRO_DEFUN (SYMBOLP, bool, (Lisp_Object x), (x)) + LISP_MACRO_DEFUN (INTEGERP, bool, (Lisp_Object x), (x)) + LISP_MACRO_DEFUN (VECTORLIKEP, bool, (Lisp_Object x), (x)) + LISP_MACRO_DEFUN (MARKERP, bool, (Lisp_Object x), (x)) + + LISP_INLINE bool + STRINGP (Lisp_Object x) + { + return XTYPE (x) == Lisp_String; + } + LISP_INLINE bool + VECTORP (Lisp_Object x) + { + return VECTORLIKEP (x) && ! (ASIZE (x) & PSEUDOVECTOR_FLAG); + } + LISP_INLINE bool + OVERLAYP (Lisp_Object x) + { + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay; + } + LISP_INLINE bool + SAVE_VALUEP (Lisp_Object x) + { + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; + } + + LISP_INLINE bool + AUTOLOADP (Lisp_Object x) + { + return CONSP (x) && EQ (Qautoload, XCAR (x)); + } + + LISP_INLINE bool + BUFFER_OBJFWDP (union Lisp_Fwd *a) + { + return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj; + } + + LISP_INLINE bool + PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, int code) + { + return ((a->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) + == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))); + } + + /* True if A is a pseudovector whose code is CODE. */ + LISP_INLINE bool + PSEUDOVECTORP (Lisp_Object a, int code) + { + if (! VECTORLIKEP (a)) + return 0; + else + { + /* Converting to struct vectorlike_header * avoids aliasing issues. */ + struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike); + return PSEUDOVECTOR_TYPEP (h, code); + } + } + + + /* Test for specific pseudovector types. */ + + LISP_INLINE bool + WINDOW_CONFIGURATIONP (Lisp_Object a) + { + return PSEUDOVECTORP (a, PVEC_WINDOW_CONFIGURATION); + } + + LISP_INLINE bool + PROCESSP (Lisp_Object a) + { + return PSEUDOVECTORP (a, PVEC_PROCESS); + } LISP_INLINE bool - SAVE_VALUEP (Lisp_Object x) + WINDOWP (Lisp_Object a) { - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; + return PSEUDOVECTORP (a, PVEC_WINDOW); } - LISP_INLINE struct Lisp_Save_Value * - XSAVE_VALUE (Lisp_Object a) + LISP_INLINE bool + TERMINALP (Lisp_Object a) { - eassert (SAVE_VALUEP (a)); - return & XMISC (a)->u_save_value; + return PSEUDOVECTORP (a, PVEC_TERMINAL); } - /* Return the type of V's Nth saved value. */ - LISP_INLINE int - save_type (struct Lisp_Save_Value *v, int n) + LISP_INLINE bool + SUBRP (Lisp_Object a) { - eassert (0 <= n && n < SAVE_VALUE_SLOTS); - return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); + return PSEUDOVECTORP (a, PVEC_SUBR); } - /* Get and set the Nth saved pointer. */ - - LISP_INLINE void * - XSAVE_POINTER (Lisp_Object obj, int n) + LISP_INLINE bool + COMPILEDP (Lisp_Object a) { - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - return XSAVE_VALUE (obj)->data[n].pointer;; + return PSEUDOVECTORP (a, PVEC_COMPILED); } - LISP_INLINE void - set_save_pointer (Lisp_Object obj, int n, void *val) + + LISP_INLINE bool + BUFFERP (Lisp_Object a) { - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - XSAVE_VALUE (obj)->data[n].pointer = val; + return PSEUDOVECTORP (a, PVEC_BUFFER); } - /* Likewise for the saved integer. */ - - LISP_INLINE ptrdiff_t - XSAVE_INTEGER (Lisp_Object obj, int n) + LISP_INLINE bool + CHAR_TABLE_P (Lisp_Object a) { - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - return XSAVE_VALUE (obj)->data[n].integer; + return PSEUDOVECTORP (a, PVEC_CHAR_TABLE); } - LISP_INLINE void - set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) + + LISP_INLINE bool + SUB_CHAR_TABLE_P (Lisp_Object a) { - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - XSAVE_VALUE (obj)->data[n].integer = val; + return PSEUDOVECTORP (a, PVEC_SUB_CHAR_TABLE); } - /* Extract Nth saved object. */ - - LISP_INLINE Lisp_Object - XSAVE_OBJECT (Lisp_Object obj, int n) + LISP_INLINE bool + BOOL_VECTOR_P (Lisp_Object a) { - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); - return XSAVE_VALUE (obj)->data[n].object; + return PSEUDOVECTORP (a, PVEC_BOOL_VECTOR); } - #define AUTOLOADP(x) (CONSP (x) && EQ (Qautoload, XCAR (x))) - - #define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int) - #define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool) - #define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj) - #define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj) - #define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj) - - /* True if object X is a pseudovector whose code is CODE. The cast to struct - vectorlike_header * avoids aliasing issues. */ - #define PSEUDOVECTORP(x, code) \ - TYPED_PSEUDOVECTORP (x, vectorlike_header, code) + LISP_INLINE bool + FRAMEP (Lisp_Object a) + { + return PSEUDOVECTORP (a, PVEC_FRAME); + } - #define PSEUDOVECTOR_TYPEP(v, code) \ - (((v)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ - == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))) ++LISP_INLINE bool ++THREADP (Lisp_Object a) ++{ ++ return PSEUDOVECTORP (a, PVEC_THREAD); ++} + - /* True if object X, with internal type struct T *, is a pseudovector whose - code is CODE. */ - #define TYPED_PSEUDOVECTORP(x, t, code) \ - (VECTORLIKEP (x) \ - && PSEUDOVECTOR_TYPEP ((struct t *) XUNTAG (x, Lisp_Vectorlike), code)) ++LISP_INLINE bool ++MUTEXP (Lisp_Object a) ++{ ++ return PSEUDOVECTORP (a, PVEC_MUTEX); ++} + - /* Test for specific pseudovector types. */ - #define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION) - #define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS) - #define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW) - #define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL) - #define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR) - #define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED) - #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER) - #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE) - #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) - #define MUTEXP(x) PSEUDOVECTORP (x, PVEC_MUTEX) - #define CONDVARP(x) PSEUDOVECTORP (x, PVEC_CONDVAR) ++LISP_INLINE bool ++CONDVARP (Lisp_Object a) ++{ ++ return PSEUDOVECTORP (a, PVEC_CONDVAR); ++} + /* Test for image (image . spec) */ - #define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) + LISP_INLINE bool + IMAGEP (Lisp_Object x) + { + return CONSP (x) && EQ (XCAR (x), Qimage); + } /* Array types. */ - - #define ARRAYP(x) \ - (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x)) + LISP_INLINE bool + ARRAYP (Lisp_Object x) + { + return VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x); + } - #define CHECK_LIST(x) \ - CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x) - - #define CHECK_LIST_CONS(x, y) \ - CHECK_TYPE (CONSP (x), Qlistp, y) - - #define CHECK_LIST_END(x, y) \ - CHECK_TYPE (NILP (x), Qlistp, y) - - #define CHECK_STRING(x) \ - CHECK_TYPE (STRINGP (x), Qstringp, x) - - #define CHECK_STRING_CAR(x) \ - CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)) - - #define CHECK_CONS(x) \ - CHECK_TYPE (CONSP (x), Qconsp, x) - - #define CHECK_SYMBOL(x) \ - CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) - - #define CHECK_CHAR_TABLE(x) \ - CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x) - - #define CHECK_VECTOR(x) \ - CHECK_TYPE (VECTORP (x), Qvectorp, x) - - #define CHECK_VECTOR_OR_STRING(x) \ - CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x) - - #define CHECK_ARRAY(x, Qxxxp) \ - CHECK_TYPE (ARRAYP (x), Qxxxp, x) - - #define CHECK_VECTOR_OR_CHAR_TABLE(x) \ - CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x) - - #define CHECK_BUFFER(x) \ - CHECK_TYPE (BUFFERP (x), Qbufferp, x) - - #define CHECK_WINDOW(x) \ - CHECK_TYPE (WINDOWP (x), Qwindowp, x) - - #define CHECK_WINDOW_CONFIGURATION(x) \ - CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x) - - #define CHECK_PROCESS(x) \ - CHECK_TYPE (PROCESSP (x), Qprocessp, x) - - #define CHECK_SUBR(x) \ - CHECK_TYPE (SUBRP (x), Qsubrp, x) + LISP_INLINE void + CHECK_LIST (Lisp_Object x) + { + CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x); + } - #define CHECK_NUMBER(x) \ - CHECK_TYPE (INTEGERP (x), Qintegerp, x) + LISP_MACRO_DEFUN_VOID (CHECK_LIST_CONS, (Lisp_Object x, Lisp_Object y), (x, y)) + LISP_MACRO_DEFUN_VOID (CHECK_SYMBOL, (Lisp_Object x), (x)) + LISP_MACRO_DEFUN_VOID (CHECK_NUMBER, (Lisp_Object x), (x)) - #define CHECK_NATNUM(x) \ - CHECK_TYPE (NATNUMP (x), Qwholenump, x) + LISP_INLINE void + CHECK_STRING (Lisp_Object x) + { + CHECK_TYPE (STRINGP (x), Qstringp, x); + } + LISP_INLINE void + CHECK_STRING_CAR (Lisp_Object x) + { + CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)); + } + LISP_INLINE void + CHECK_CONS (Lisp_Object x) + { + CHECK_TYPE (CONSP (x), Qconsp, x); + } + LISP_INLINE void + CHECK_VECTOR (Lisp_Object x) + { + CHECK_TYPE (VECTORP (x), Qvectorp, x); + } + LISP_INLINE void + CHECK_VECTOR_OR_STRING (Lisp_Object x) + { + CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x); + } + LISP_INLINE void + CHECK_ARRAY (Lisp_Object x, Lisp_Object Qxxxp) + { + CHECK_TYPE (ARRAYP (x), Qxxxp, x); + } + LISP_INLINE void + CHECK_BUFFER (Lisp_Object x) + { + CHECK_TYPE (BUFFERP (x), Qbufferp, x); + } + LISP_INLINE void + CHECK_WINDOW (Lisp_Object x) + { + CHECK_TYPE (WINDOWP (x), Qwindowp, x); + } + LISP_INLINE void + CHECK_PROCESS (Lisp_Object x) + { + CHECK_TYPE (PROCESSP (x), Qprocessp, x); + } + LISP_INLINE void + CHECK_NATNUM (Lisp_Object x) + { + CHECK_TYPE (NATNUMP (x), Qwholenump, x); + } #define CHECK_RANGED_INTEGER(x, lo, hi) \ do { \ @@@ -2005,47 -2485,23 +2540,42 @@@ CHECK_NUMBER_OR_FLOAT (Lisp_Object x do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \ else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0) - #define CHECK_OVERLAY(x) \ - CHECK_TYPE (OVERLAYP (x), Qoverlayp, x) + - #define CHECK_THREAD(x) \ - CHECK_TYPE (THREADP (x), Qthreadp, x) ++LISP_INLINE void ++CHECK_THREAD (Lisp_Object x) ++{ ++ CHECK_TYPE (THREADP (x), Qthreadp, x); ++} + - #define CHECK_MUTEX(x) \ - CHECK_TYPE (MUTEXP (x), Qmutexp, x) ++LISP_INLINE void ++CHECK_MUTEX (Lisp_Object x) ++{ ++ CHECK_TYPE (MUTEXP (x), Qmutexp, x); ++} + - #define CHECK_CONDVAR(x) \ - CHECK_TYPE (CONDVARP (x), Qcondition_variablep, x) ++LISP_INLINE void ++CHECK_CONDVAR (Lisp_Object 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) \ - do { \ - Lisp_Object tmp = XCAR (x); \ - CHECK_NUMBER (tmp); \ - XSETCAR ((x), tmp); \ - } while (0) - - #define CHECK_NUMBER_CDR(x) \ - do { \ - Lisp_Object tmp = XCDR (x); \ - CHECK_NUMBER (tmp); \ - XSETCDR ((x), tmp); \ - } while (0) - - #define CHECK_NATNUM_CAR(x) \ - do { \ - Lisp_Object tmp = XCAR (x); \ - CHECK_NATNUM (tmp); \ - XSETCAR ((x), tmp); \ - } while (0) + LISP_INLINE void + CHECK_NUMBER_CAR (Lisp_Object x) + { + Lisp_Object tmp = XCAR (x); + CHECK_NUMBER (tmp); + XSETCAR (x, tmp); + } - #define CHECK_NATNUM_CDR(x) \ - do { \ - Lisp_Object tmp = XCDR (x); \ - CHECK_NATNUM (tmp); \ - XSETCDR ((x), tmp); \ - } while (0) + LISP_INLINE void + CHECK_NUMBER_CDR (Lisp_Object x) + { + Lisp_Object tmp = XCDR (x); + CHECK_NUMBER (tmp); + XSETCDR (x, tmp); + } /* Define a built-in function for calling from Lisp. `lname' should be the name to give the function in Lisp, @@@ -2247,65 -2707,37 +2781,40 @@@ enum specbind_tag SPECPDL_LET_DEFAULT /* A global binding for a localized var. */ }; - struct specbinding + union specbinding { - 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 set 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; + ENUM_BF (specbind_tag) kind : CHAR_BIT; + struct { + ENUM_BF (specbind_tag) kind : CHAR_BIT; + Lisp_Object arg; + specbinding_func func; + } unwind; + struct { + ENUM_BF (specbind_tag) kind : CHAR_BIT; + /* `where' is not used in the case of SPECPDL_LET. */ + Lisp_Object symbol, old_value, where; ++ /* Normally this is unused; but it is set to the symbol's ++ current value when a thread is swapped out. */ ++ Lisp_Object saved_value; + } let; + struct { + ENUM_BF (specbind_tag) kind : CHAR_BIT; + bool debug_on_exit : 1; + Lisp_Object function; + Lisp_Object *args; + ptrdiff_t nargs; + } bt; }; - LISP_INLINE Lisp_Object specpdl_symbol (struct specbinding *pdl) - { eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.symbol; } - - 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; } - - 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 union specbinding *specpdl; -extern union specbinding *specpdl_ptr; -extern ptrdiff_t specpdl_size; ++/* extern union specbinding *specpdl; */ ++/* extern union specbinding *specpdl_ptr; */ +/* extern ptrdiff_t specpdl_size; */ - #define SPECPDL_INDEX() (specpdl_ptr - specpdl) + LISP_INLINE ptrdiff_t + SPECPDL_INDEX (void) + { + return specpdl_ptr - specpdl; + } /* Everything needed to describe an active condition case. @@@ -3424,7 -3749,7 +3824,7 @@@ 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 (struct specbinding *first, struct specbinding *ptr); -extern void mark_specpdl (void); ++extern void mark_specpdl (union specbinding *first, union 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); diff --cc src/systime.h index c3bc00c1479,c3bc00c1479..0e611a3f5e3 --- a/src/systime.h +++ b/src/systime.h @@@ -150,8 -150,8 +150,8 @@@ extern void set_waiting_for_input (EMAC /* When lisp.h is not included Lisp_Object is not defined (this can happen when this files is used outside the src directory). -- Use GCPRO1 to determine if lisp.h was included. */ --#ifdef GCPRO1 ++ Use GCTYPEBITS to determine if lisp.h was included. */ ++#ifdef GCTYPEBITS /* defined in editfns.c */ extern Lisp_Object make_lisp_time (EMACS_TIME); extern bool decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object, diff --cc src/thread.c index 21f74b7696f,00000000000..a8e79e8377d mode 100644,000000..100644 --- a/src/thread.c +++ b/src/thread.c @@@ -1,963 -1,0 +1,965 @@@ +/* Threading code. + 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; + + + +/* m_specpdl is set when the thread is created and cleared when the + thread dies. */ +#define thread_alive_p(STATE) ((STATE)->m_specpdl != NULL) + + + +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) + { + /* CURRENT_THREAD is NULL if the previously current thread + exited. In this case, there is no reason to unbind, and + trying will crash. */ + if (current_thread != NULL) + 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); + self->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); + self->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 handler *handler; + Lisp_Object tem; + + 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); + } +#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; + volatile struct thread_state *self = current_thread; + + 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 = &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); + + update_processes_for_thread_death (Fcurrent_thread ()); + + xfree (self->m_specpdl); + self->m_specpdl = NULL; + self->m_specpdl_ptr = NULL; + self->m_specpdl_size = 0; + + current_thread = NULL; + sys_cond_broadcast (&self->thread_condvar); + + /* Unlink this thread from the list of all threads. Note that we + have to do this very late, after broadcasting our death. + Otherwise the GC may decide to reap the thread_state object, + leading to crashes. */ + for (iter = &all_threads; *iter != self; iter = &(*iter)->next_thread) + ; + *iter = (*iter)->next_thread; + + 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 = xmalloc ((1 + new_thread->m_specpdl_size) ++ * sizeof (union specbinding)); ++ /* Skip the dummy entry. */ ++ ++new_thread->m_specpdl; + 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); + + return thread_alive_p (tstate) ? Qt : Qnil; +} + +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) + { + if (thread_alive_p (iter)) + { + 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; +} + +void +init_threads_once (void) +{ + init_primary_thread (); +} + +void +init_threads (void) +{ + init_primary_thread (); + sys_cond_init (&primary_thread.thread_condvar); + sys_mutex_init (&global_lock); + sys_mutex_lock (&global_lock); + current_thread = &primary_thread; + primary_thread.thread_id = sys_thread_self (); +} + +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 e43b0a335aa,00000000000..e77d1144ecf mode 100644,000000..100644 --- a/src/thread.h +++ b/src/thread.h @@@ -1,244 -1,0 +1,244 @@@ +/* 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 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; ++ union specbinding *m_specpdl; +#define specpdl (current_thread->m_specpdl) + + /* Pointer to first unused element in specpdl. */ - struct specbinding *m_specpdl_ptr; ++ union 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. */ + 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 */