From 53c988fe4ae6bba24071d1a8b9f3dbfa0c6f3b7e Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 9 Sep 2009 23:38:04 +0200 Subject: [PATCH] Introduce threads. Add a new thread.c file. Move selected globals to a thread-specific structure. Add elisp functions run-in-thread and yield. Update GC to work with threads. --- src/Makefile.in | 13 ++-- src/alloc.c | 117 ++++++++++++------------------ src/bytecode.c | 19 ++--- src/emacs.c | 22 +++--- src/eval.c | 72 +++++++------------ src/lisp.h | 17 +---- src/thread.c | 186 ++++++++++++++++++++++++++++++++++++++++++++++++ src/thread.h | 69 ++++++++++++++++++ 8 files changed, 346 insertions(+), 169 deletions(-) create mode 100644 src/thread.c create mode 100644 src/thread.h diff --git a/src/Makefile.in b/src/Makefile.in index d8661bc0be6..ff8c1c47abe 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -511,7 +511,7 @@ obj= dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ eval.o floatfns.o fns.o font.o print.o lread.o \ syntax.o UNEXEC bytecode.o \ process.o callproc.o \ - region-cache.o sound.o atimer.o \ + region-cache.o sound.o atimer.o thread.o \ doprnt.o strftime.o intervals.o textprop.o composite.o md5.o \ $(MSDOS_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_DRIVERS) @@ -1126,11 +1126,12 @@ term.o: term.c termchar.h termhooks.h termopts.h lisp.h $(config_h) cm.h frame.h syssignal.h $(INTERVALS_H) buffer.h termcap.o: termcap.c lisp.h $(config_h) terminal.o: terminal.c frame.h termchar.h termhooks.h charset.h coding.h \ - keyboard.h lisp.h $(config_h) dispextern.h composite.h systime.h -terminfo.o: terminfo.c lisp.h $(config_h) -tparam.o: tparam.c lisp.h $(config_h) -undo.o: undo.c buffer.h commands.h window.h dispextern.h lisp.h $(config_h) -unexaix.o: unexaix.c lisp.h $(config_h) + keyboard.h $(config_h) +terminfo.o: terminfo.c $(config_h) +thread.o: thread.c $(config_h) lisp.h +tparam.o: tparam.c $(config_h) +undo.o: undo.c buffer.h commands.h window.h $(config_h) +unexaix.o: unexaix.c $(config_h) unexalpha.o: unexalpha.c $(config_h) unexcw.o: unexcw.c lisp.h $(config_h) unexec.o: unexec.c lisp.h $(config_h) diff --git a/src/alloc.c b/src/alloc.c index db6b316b8f5..d37295ec899 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -334,7 +334,7 @@ static void mark_buffer P_ ((Lisp_Object)); static void mark_terminals P_ ((void)); extern void mark_kboards P_ ((void)); extern void mark_ttys P_ ((void)); -extern void mark_backtrace P_ ((void)); +extern void mark_threads P_ ((void)); static void gc_sweep P_ ((void)); static void mark_glyph_matrix P_ ((struct glyph_matrix *)); static void mark_face_cache P_ ((struct face_cache *)); @@ -436,10 +436,6 @@ struct mem_node enum mem_type type; }; -/* Base address of stack. Set in main. */ - -Lisp_Object *stack_base; - /* Root of the tree describing allocated Lisp memory. */ static struct mem_node *mem_root; @@ -456,7 +452,6 @@ static struct mem_node mem_z; static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type)); static struct Lisp_Vector *allocate_vectorlike P_ ((EMACS_INT)); static void lisp_free P_ ((POINTER_TYPE *)); -static void mark_stack P_ ((void)); static int live_vector_p P_ ((struct mem_node *, void *)); static int live_buffer_p P_ ((struct mem_node *, void *)); static int live_string_p P_ ((struct mem_node *, void *)); @@ -482,10 +477,6 @@ static void check_gcpros P_ ((void)); #endif /* GC_MARK_STACK || GC_MALLOC_CHECK */ -/* Recording what needs to be marked for gc. */ - -struct gcpro *gcprolist; - /* Addresses of staticpro'd variables. Initialize it to a nonzero value; otherwise some compilers put it into BSS. */ @@ -4460,16 +4451,49 @@ dump_zombies () The current code assumes by default that Lisp_Objects are aligned equally on the stack. */ -static void -mark_stack () +void +mark_stack (bottom, end) + char *bottom; + char *end; { int i; + + /* This assumes that the stack is a contiguous region in memory. If + that's not the case, something has to be done here to iterate + over the stack segments. */ +#ifndef GC_LISP_OBJECT_ALIGNMENT +#ifdef __GNUC__ +#define GC_LISP_OBJECT_ALIGNMENT __alignof__ (Lisp_Object) +#else +#define GC_LISP_OBJECT_ALIGNMENT sizeof (Lisp_Object) +#endif +#endif + for (i = 0; i < sizeof (Lisp_Object); i += GC_LISP_OBJECT_ALIGNMENT) + mark_memory (bottom, end, i); + /* Allow for marking a secondary stack, like the register stack on the + ia64. */ +#ifdef GC_MARK_SECONDARY_STACK + GC_MARK_SECONDARY_STACK (); +#endif + +#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS + check_gcpros (); +#endif +} + +#endif /* GC_MARK_STACK != 0 */ + +void +flush_stack_call_func (func) + void (*func) P_ ((char *end)); +{ +#if GC_MARK_STACK /* jmp_buf may not be aligned enough on darwin-ppc64 */ union aligned_jmpbuf { Lisp_Object o; jmp_buf j; } j; - volatile int stack_grows_down_p = (char *) &j > (char *) stack_base; + volatile int stack_grows_down_p = (char *) &j > (char *) current_thread->stack_bottom; void *end; /* This trick flushes the register windows so that all the state of @@ -4507,32 +4531,11 @@ mark_stack () setjmp (j.j); end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j; #endif /* not GC_SAVE_REGISTERS_ON_STACK */ +#endif /* GC_MARK_STACK != 0 */ - /* This assumes that the stack is a contiguous region in memory. If - that's not the case, something has to be done here to iterate - over the stack segments. */ -#ifndef GC_LISP_OBJECT_ALIGNMENT -#ifdef __GNUC__ -#define GC_LISP_OBJECT_ALIGNMENT __alignof__ (Lisp_Object) -#else -#define GC_LISP_OBJECT_ALIGNMENT sizeof (Lisp_Object) -#endif -#endif - for (i = 0; i < sizeof (Lisp_Object); i += GC_LISP_OBJECT_ALIGNMENT) - mark_memory (stack_base, end, i); - /* Allow for marking a secondary stack, like the register stack on the - ia64. */ -#ifdef GC_MARK_SECONDARY_STACK - GC_MARK_SECONDARY_STACK (); -#endif - -#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS - check_gcpros (); -#endif + (*func) (end); } -#endif /* GC_MARK_STACK != 0 */ - /* Determine whether it is safe to access memory at address P. */ static int @@ -4979,8 +4982,6 @@ returns nil, because real GC can't be done. */) () { register struct specbinding *bind; - struct catchtag *catch; - struct handler *handler; char stack_top_variable; register int i; int message_p; @@ -5048,7 +5049,7 @@ returns nil, because real GC can't be done. */) #if MAX_SAVE_STACK > 0 if (NILP (Vpurify_flag)) { - i = &stack_top_variable - stack_bottom; + i = &stack_top_variable - /*FIXME*/current_thread->stack_bottom; if (i < 0) i = -i; if (i < MAX_SAVE_STACK) { @@ -5058,8 +5059,8 @@ returns nil, because real GC can't be done. */) stack_copy = (char *) xrealloc (stack_copy, (stack_copy_size = i)); if (stack_copy) { - if ((EMACS_INT) (&stack_top_variable - stack_bottom) > 0) - bcopy (stack_bottom, stack_copy, i); + if ((EMACS_INT) (&stack_top_variable - /*FIXME*/current_thread->stack_bottom) > 0) + bcopy (/*FIXME*/current_thread->stack_bottom, stack_copy, i); else bcopy (&stack_top_variable, stack_copy, i); } @@ -5083,11 +5084,7 @@ returns nil, because real GC can't be done. */) for (i = 0; i < staticidx; i++) mark_object (*staticvec[i]); - for (bind = specpdl; bind != specpdl_ptr; bind++) - { - mark_object (bind->symbol); - mark_object (bind->old_value); - } + mark_threads (); mark_terminals (); mark_kboards (); mark_ttys (); @@ -5099,36 +5096,12 @@ returns nil, because real GC can't be done. */) } #endif -#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \ - || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS) - mark_stack (); -#else - { - register struct gcpro *tail; - for (tail = gcprolist; tail; tail = tail->next) - for (i = 0; i < tail->nvars; i++) - mark_object (tail->var[i]); - } -#endif - - mark_byte_stack (); - for (catch = catchlist; catch; catch = catch->next) - { - mark_object (catch->tag); - mark_object (catch->val); - } - for (handler = handlerlist; handler; handler = handler->next) - { - mark_object (handler->handler); - mark_object (handler->var); - } - mark_backtrace (); - #ifdef HAVE_WINDOW_SYSTEM mark_fringe_data (); #endif #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES + FIXME; mark_stack (); #endif @@ -5184,7 +5157,7 @@ returns nil, because real GC can't be done. */) /* Clear the mark bits that we set in certain root slots. */ - unmark_byte_stack (); + unmark_threads (); VECTOR_UNMARK (&buffer_defaults); VECTOR_UNMARK (&buffer_local_symbols); diff --git a/src/bytecode.c b/src/bytecode.c index 8325deeb2bb..07cf98c5daf 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -260,24 +260,15 @@ struct byte_stack struct byte_stack *next; }; -/* 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 *byte_stack_list; - /* Mark objects on byte_stack_list. Called during GC. */ void -mark_byte_stack () +mark_byte_stack (struct byte_stack *stack) { - struct byte_stack *stack; Lisp_Object *obj; - for (stack = byte_stack_list; stack; stack = stack->next) + for (; stack; stack = stack->next) { /* If STACK->top is null here, this means there's an opcode in Fbyte_code that wasn't expected to GC, but did. To find out @@ -301,11 +292,9 @@ mark_byte_stack () counters. Called when GC has completed. */ void -unmark_byte_stack () +unmark_byte_stack (struct byte_stack *stack) { - struct byte_stack *stack; - - for (stack = byte_stack_list; stack; stack = stack->next) + for (; stack; stack = stack->next) { if (stack->byte_string_start != SDATA (stack->byte_string)) { diff --git a/src/emacs.c b/src/emacs.c index 39747fd1caa..f87c0a2f0ac 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -203,9 +203,9 @@ extern int inherited_pgroup; int display_arg; #endif -/* An address near the bottom of the stack. - Tells GC how to save a copy of the stack. */ -char *stack_bottom; +#ifdef HAVE_NS +extern char ns_no_defaults; +#endif /* The address where the heap starts (from the first sbrk (0) call). */ static void *my_heap_start; @@ -750,9 +750,6 @@ void (*__malloc_initialize_hook) () = malloc_initialize_hook; int main (int argc, char **argv) { -#if GC_MARK_STACK - Lisp_Object dummy; -#endif char stack_bottom_variable; int do_initial_setlocale; int skip_args = 0; @@ -769,10 +766,8 @@ main (int argc, char **argv) char dname_arg2[80]; #endif -#if GC_MARK_STACK - extern Lisp_Object *stack_base; - stack_base = &dummy; -#endif + /* Record (approximately) where the stack begins. */ + current_thread->stack_bottom = &stack_bottom_variable; #if defined (USE_GTK) && defined (G_SLICE_ALWAYS_MALLOC) /* This is used by the Cygwin build. */ @@ -915,9 +910,6 @@ main (int argc, char **argv) } #endif /* HAVE_SETRLIMIT and RLIMIT_STACK */ - /* Record (approximately) where the stack begins. */ - stack_bottom = &stack_bottom_variable; - clearerr (stdin); #ifndef SYSTEM_MALLOC @@ -1567,6 +1559,8 @@ main (int argc, char **argv) init_callproc (); /* Must follow init_cmdargs but not init_sys_modes. */ init_lread (); + init_threads (); + /* Intern the names of all standard functions and variables; define standard keys. */ @@ -1677,6 +1671,8 @@ main (int argc, char **argv) SYMS_MACHINE; #endif + syms_of_threads (); + keys_of_casefiddle (); keys_of_cmds (); keys_of_buffer (); diff --git a/src/eval.c b/src/eval.c index 81f54278a1c..92b6b8adf8d 100644 --- a/src/eval.c +++ b/src/eval.c @@ -47,15 +47,6 @@ struct backtrace char debug_on_exit; }; -struct backtrace *backtrace_list; - -struct catchtag *catchlist; - -#ifdef DEBUG_GCPRO -/* Count levels of GCPRO to detect failure to UNGCPRO. */ -int gcpro_level; -#endif - Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun; Lisp_Object Qinhibit_quit, impl_Vinhibit_quit, impl_Vquit_flag; Lisp_Object Qand_rest, Qand_optional; @@ -77,26 +68,10 @@ Lisp_Object Vrun_hooks; Lisp_Object Vautoload_queue; -/* Current number of specbindings allocated in specpdl. */ - -int specpdl_size; - -/* Pointer to beginning of specpdl. */ - -struct specbinding *specpdl; - -/* Pointer to first unused element in specpdl. */ - -struct specbinding *specpdl_ptr; - /* Maximum size allowed for specpdl allocation */ EMACS_INT max_specpdl_size; -/* Depth in Lisp evaluations and function calls. */ - -int lisp_eval_depth; - /* Maximum allowed depth in Lisp evaluations and function calls. */ EMACS_INT max_lisp_eval_depth; @@ -210,6 +185,16 @@ init_eval () when_entered_debugger = -1; } +void +mark_catchlist (struct catchtag *catch) +{ + for (; catch; catch = catch->next) + { + mark_object (catch->tag); + mark_object (catch->val); + } +} + /* unwind-protect function used by call_debugger. */ static Lisp_Object @@ -1212,8 +1197,8 @@ internal_catch (tag, func, arg) c.tag = tag; c.val = Qnil; c.backlist = backtrace_list; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; + c.m_handlerlist = handlerlist; + c.m_lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; c.interrupt_input_blocked = interrupt_input_blocked; @@ -1269,7 +1254,7 @@ unwind_to_catch (catch, value) /* Unwind the specpdl stack, and then restore the proper set of handlers. */ unbind_to (catchlist->pdlcount, Qnil); - handlerlist = catchlist->handlerlist; + handlerlist = catchlist->m_handlerlist; catchlist = catchlist->next; } while (! last_time); @@ -1293,7 +1278,7 @@ unwind_to_catch (catch, value) gcpro_level = 0; #endif backtrace_list = catch->backlist; - lisp_eval_depth = catch->lisp_eval_depth; + lisp_eval_depth = catch->m_lisp_eval_depth; _longjmp (catch->jmp, 1); } @@ -1333,14 +1318,6 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */) return unbind_to (count, val); } -/* 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 *handlerlist; - DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0, doc: /* Regain control when an error is signaled. Executes BODYFORM and returns its value if no error happens. @@ -1404,8 +1381,8 @@ internal_lisp_condition_case (var, bodyform, handlers) c.tag = Qnil; c.val = Qnil; c.backlist = backtrace_list; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; + c.m_handlerlist = handlerlist; + c.m_lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; c.interrupt_input_blocked = interrupt_input_blocked; @@ -1468,8 +1445,8 @@ internal_condition_case (bfun, handlers, hfun) c.tag = Qnil; c.val = Qnil; c.backlist = backtrace_list; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; + c.m_handlerlist = handlerlist; + c.m_lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; c.interrupt_input_blocked = interrupt_input_blocked; @@ -1516,8 +1493,8 @@ internal_condition_case_1 (bfun, arg, handlers, hfun) c.tag = Qnil; c.val = Qnil; c.backlist = backtrace_list; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; + c.m_handlerlist = handlerlist; + c.m_lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; c.interrupt_input_blocked = interrupt_input_blocked; @@ -1567,8 +1544,8 @@ internal_condition_case_2 (bfun, nargs, args, handlers, hfun) c.tag = Qnil; c.val = Qnil; c.backlist = backtrace_list; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; + c.m_handlerlist = handlerlist; + c.m_lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; c.interrupt_input_blocked = interrupt_input_blocked; @@ -3536,12 +3513,11 @@ If NFRAMES is more than the number of frames, the value is nil. */) void -mark_backtrace () +mark_backtrace (struct backtrace *backlist) { - register struct backtrace *backlist; register int i; - for (backlist = backtrace_list; backlist; backlist = backlist->next) + for (; backlist; backlist = backlist->next) { mark_object (*backlist->function); diff --git a/src/lisp.h b/src/lisp.h index 8bab60dc355..f412d97cd6b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1859,10 +1859,6 @@ struct specbinding Lisp_Object unused; /* Dividing by 16 is faster than by 12 */ }; -extern struct specbinding *specpdl; -extern struct specbinding *specpdl_ptr; -extern int specpdl_size; - extern EMACS_INT max_specpdl_size; #define SPECPDL_INDEX() (specpdl_ptr - specpdl) @@ -1932,10 +1928,6 @@ extern struct backtrace *backtrace_list; 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. @@ -2049,8 +2041,6 @@ extern EMACS_INT memory_full_cons_threshold; 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; @@ -2149,8 +2139,6 @@ struct gcpro #else -extern int gcpro_level; - #define GCPRO1(varname) \ {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \ gcpro1.level = gcpro_level++; \ @@ -3294,9 +3282,6 @@ extern int read_bytecode_char P_ ((int)); extern Lisp_Object Qbytecode; EXFUN (Fbyte_code, 3); extern void syms_of_bytecode P_ ((void)); -extern struct byte_stack *byte_stack_list; -extern void mark_byte_stack P_ ((void)); -extern void unmark_byte_stack P_ ((void)); /* defined in macros.c */ extern Lisp_Object Qexecute_kbd_macro; @@ -3648,6 +3633,8 @@ extern Lisp_Object safe_alloca_unwind (Lisp_Object); #include "globals.h" +#include "thread.h" + #endif /* EMACS_LISP_H */ /* arch-tag: 9b2ed020-70eb-47ac-94ee-e1c2a5107d5e diff --git a/src/thread.c b/src/thread.c new file mode 100644 index 00000000000..44ee3cd71ed --- /dev/null +++ b/src/thread.c @@ -0,0 +1,186 @@ + +#include +#include "lisp.h" +#include + +void mark_byte_stack P_ ((struct byte_stack *)); +void mark_backtrace P_ ((struct backtrace *)); +void mark_catchlist P_ ((struct catchtag *)); +void mark_stack P_ ((char *, char *)); +void flush_stack_call_func P_ ((void (*) (char *))); + + +static struct thread_state primary_thread; + +static struct thread_state *all_threads = &primary_thread; + +__thread struct thread_state *current_thread = &primary_thread; + +static pthread_mutex_t global_lock; + +static void +mark_one_thread (struct thread_state *thread) +{ + register struct specbinding *bind; + struct handler *handler; + + for (bind = thread->m_specpdl; bind != thread->m_specpdl_ptr; bind++) + { + mark_object (bind->symbol); + mark_object (bind->old_value); + } + +#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \ + || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS) + mark_stack (thread->stack_bottom, thread->stack_top); +#else + { + register struct gcpro *tail; + for (tail = thread->m_gcprolist; tail; tail = tail->next) + for (i = 0; i < tail->nvars; i++) + mark_object (tail->var[i]); + } +#endif + + mark_byte_stack (thread->m_byte_stack_list); + + mark_catchlist (thread->m_catchlist); + + for (handler = thread->m_handlerlist; handler; handler = handler->next) + { + mark_object (handler->handler); + mark_object (handler->var); + } + + mark_backtrace (thread->m_backtrace_list); + + if (thread->func) + mark_object (thread->func); +} + +static void +mark_threads_continuation (char *end) +{ + struct thread_state *iter; + + current_thread->stack_top = end; + for (iter = all_threads; iter; iter = iter->next) + mark_one_thread (iter); +} + +void +mark_threads (void) +{ + flush_stack_call_func (mark_threads_continuation); +} + +void +unmark_threads (void) +{ + struct thread_state *iter; + + for (iter = all_threads; iter; iter = iter->next) + unmark_byte_stack (iter->m_byte_stack_list); +} + +static void +thread_yield_continuation (char *end) +{ + current_thread->stack_top = end; + pthread_mutex_unlock (&global_lock); + sched_yield (); + pthread_mutex_lock (&global_lock); +} + +void +thread_yield (void) +{ + /* Note: currently it is safe to check this here, but eventually it + will require a lock to ensure non-racy operation. */ + /* Only yield if there is another thread to yield to. */ + if (all_threads->next) + flush_stack_call_func (thread_yield_continuation); +} + +DEFUN ("yield", Fyield, Syield, 0, 0, 0, + doc: /* Yield to the next thread. */) + (void) +{ + thread_yield (); +} + +static void * +run_thread (void *state) +{ + char stack_bottom_variable; + struct thread_state *self = state; + struct thread_state **iter; + + self->stack_bottom = &stack_bottom_variable; + + self->m_specpdl_size = 50; + self->m_specpdl = xmalloc (self->m_specpdl_size + * sizeof (struct specbinding)); + self->m_specpdl_ptr = self->m_specpdl; + + /* Thread-local assignment. */ + current_thread = self; + + pthread_mutex_lock (&global_lock); + + /* FIXME: unwind protect here. */ + Ffuncall (1, &self->func); + + /* Unlink this thread from the list of all threads. */ + for (iter = &all_threads; *iter != self; iter = &(*iter)->next) + ; + *iter = (*iter)->next; + + xfree (self->m_specpdl); + /* FIXME: other cleanups here. */ + xfree (self); + + pthread_mutex_unlock (&global_lock); + + return NULL; +} + +DEFUN ("run-in-thread", Frun_in_thread, Srun_in_thread, 1, 1, 0, + doc: /* Start a new thread and run FUNCTION in it. +When the function exits, the thread dies. */) + (function) + Lisp_Object function; +{ + pthread_t thr; + struct thread_state *new_thread; + + /* Can't start a thread in temacs. */ + if (!initialized) + abort (); + + new_thread = xmalloc (sizeof (struct thread_state)); + memset (new_thread, 0, sizeof (struct thread_state)); + + new_thread->func = function; + + /* We'll need locking here. */ + new_thread->next = all_threads; + all_threads = new_thread; + + /* FIXME check result */ + pthread_create (&thr, NULL, run_thread, new_thread); +} + +void +init_threads (void) +{ + pthread_mutex_init (&global_lock, NULL); + pthread_mutex_lock (&global_lock); +} + +void +syms_of_threads (void) +{ + defsubr (&Srun_in_thread); + defsubr (&Syield); +} diff --git a/src/thread.h b/src/thread.h new file mode 100644 index 00000000000..a415727fab2 --- /dev/null +++ b/src/thread.h @@ -0,0 +1,69 @@ + +struct thread_state +{ + /* 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 *stack_bottom; + + /* An address near the top of the stack. */ + char *stack_top; + + struct backtrace *m_backtrace_list; +#define backtrace_list (current_thread->m_backtrace_list) + + struct catchtag *m_catchlist; +#define catchlist (current_thread->m_catchlist) + + /* Chain of condition handlers currently in effect. + The elements of this chain are contained in the stack frames + of Fcondition_case and internal_condition_case. + When an error is signaled (by calling Fsignal, below), + this chain is searched for an element that applies. */ + struct handler *m_handlerlist; +#define handlerlist (current_thread->m_handlerlist) + + /* Count levels of GCPRO to detect failure to UNGCPRO. */ + int m_gcpro_level; +#define gcpro_level (current_thread->m_gcpro_level) + + /* Current number of specbindings allocated in specpdl. */ + int m_specpdl_size; +#define specpdl_size (current_thread->m_specpdl_size) + + /* Pointer to beginning of specpdl. */ + struct specbinding *m_specpdl; +#define specpdl (current_thread->m_specpdl) + + /* Pointer to first unused element in specpdl. */ + struct specbinding *m_specpdl_ptr; +#define specpdl_ptr (current_thread->m_specpdl_ptr) + + /* Depth in Lisp evaluations and function calls. */ + int m_lisp_eval_depth; +#define lisp_eval_depth (current_thread->m_lisp_eval_depth) + + /* The function we are evaluating, or 0 in the main thread. */ + Lisp_Object func; + + struct thread_state *next; +}; + +extern __thread struct thread_state *current_thread; + +extern void init_threads P_ ((void)); + +extern void thread_yield P_ ((void)); + +extern void syms_of_threads P_ ((void)); -- 2.39.5