diff options
Diffstat (limited to 'src/lisp.h')
| -rw-r--r-- | src/lisp.h | 181 |
1 files changed, 129 insertions, 52 deletions
diff --git a/src/lisp.h b/src/lisp.h index 5d6fa760108..9af69c61da8 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -32,6 +32,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <intprops.h> +#include "systhread.h" + INLINE_HEADER_BEGIN #ifndef LISP_INLINE # define LISP_INLINE INLINE @@ -503,6 +505,39 @@ 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 + <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */ +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)) @@ -537,6 +572,9 @@ enum pvec_type PVEC_WINDOW_CONFIGURATION, PVEC_SUBR, PVEC_OTHER, + PVEC_THREAD, + PVEC_MUTEX, + PVEC_CONDVAR, /* These should be last, check internal_equal to see why. */ PVEC_COMPILED, PVEC_CHAR_TABLE, @@ -723,6 +761,9 @@ 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. */ @@ -750,6 +791,9 @@ 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; @@ -841,6 +885,27 @@ XBOOL_VECTOR (Lisp_Object 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 @@ -905,6 +970,9 @@ make_lisp_proc (struct Lisp_Process *p) #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)) /* Type checking. */ @@ -1104,37 +1172,6 @@ STRING_COPYIN (Lisp_Object string, ptrdiff_t index, char const *new, 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 - <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */ -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 @@ -2371,6 +2408,24 @@ FRAMEP (Lisp_Object a) return PSEUDOVECTORP (a, PVEC_FRAME); } +LISP_INLINE bool +THREADP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_THREAD); +} + +LISP_INLINE bool +MUTEXP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_MUTEX); +} + +LISP_INLINE bool +CONDVARP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_CONDVAR); +} + /* Test for image (image . spec) */ LISP_INLINE bool IMAGEP (Lisp_Object x) @@ -2485,6 +2540,25 @@ 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) + +LISP_INLINE void +CHECK_THREAD (Lisp_Object x) +{ + CHECK_TYPE (THREADP (x), Qthreadp, x); +} + +LISP_INLINE void +CHECK_MUTEX (Lisp_Object x) +{ + CHECK_TYPE (MUTEXP (x), Qmutexp, 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. */ LISP_INLINE void @@ -2719,6 +2793,9 @@ union specbinding 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; @@ -2729,9 +2806,9 @@ union specbinding } bt; }; -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; */ LISP_INLINE ptrdiff_t SPECPDL_INDEX (void) @@ -2797,8 +2874,8 @@ struct catchtag struct gcpro *gcpro; #endif sys_jmp_buf jmp; - 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; @@ -2807,10 +2884,6 @@ struct catchtag extern Lisp_Object memory_signal_data; -/* An address near the bottom of the stack. - Tells GC how to save a copy of the stack. */ -extern char *stack_bottom; - /* Check quit-flag and quit if it is non-nil. Typing C-g does not directly cause a quit; it only sets Vquit_flag. So the program needs to do QUIT at times when it is safe to quit. @@ -2860,8 +2933,6 @@ extern Lisp_Object Vascii_canon_table; Every function that can call Feval must protect in this fashion all Lisp_Object variables whose contents will be used again. */ -extern struct gcpro *gcprolist; - struct gcpro { struct gcpro *next; @@ -2970,8 +3041,6 @@ struct gcpro #else -extern int gcpro_level; - #define GCPRO1(varname) \ {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \ gcpro1.level = gcpro_level++; \ @@ -3457,9 +3526,12 @@ extern void mark_object (Lisp_Object); #if defined REL_ALLOC && !defined SYSTEM_MALLOC extern void refill_memory_reserve (void); #endif +#if GC_MARK_STACK +extern void mark_stack (char *, char *); +#endif +extern void flush_stack_call_func (void (*func) (void *arg), void *arg); extern const char *pending_malloc_warning; extern Lisp_Object zero_vector; -extern Lisp_Object *stack_base; extern EMACS_INT consing_since_gc; extern EMACS_INT gc_relative_threshold; extern EMACS_INT memory_full_cons_threshold; @@ -3692,9 +3764,10 @@ extern Lisp_Object Qand_rest; extern Lisp_Object Vautoload_queue; extern Lisp_Object Vsignaling_function; extern Lisp_Object inhibit_lisp_code; -#if BYTE_MARK_STACK -extern struct catchtag *catchlist; -extern struct handler *handlerlist; +extern int handling_signal; +#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \ + || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS) +extern void mark_catchlist (struct catchtag *); #endif /* To run a normal hook, use the appropriate function from the list below. The calling convention: @@ -3736,6 +3809,8 @@ extern Lisp_Object internal_condition_case_n extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (Lisp_Object (*) (Lisp_Object), Lisp_Object); extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object); +extern void rebind_for_thread_switch (void); +extern void unbind_for_thread_switch (void); extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2); extern _Noreturn void verror (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); @@ -3749,13 +3824,16 @@ 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 (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); 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); @@ -4018,11 +4096,10 @@ extern int read_bytecode_char (bool); /* Defined in bytecode.c. */ extern void syms_of_bytecode (void); -extern struct byte_stack *byte_stack_list; #if BYTE_MARK_STACK -extern void mark_byte_stack (void); +extern void mark_byte_stack (struct byte_stack *); #endif -extern void unmark_byte_stack (void); +extern void unmark_byte_stack (struct byte_stack *); extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, ptrdiff_t, Lisp_Object *); |