4 #include "blockinput.h"
7 void mark_byte_stack
P_ ((struct byte_stack
*));
8 void mark_backtrace
P_ ((struct backtrace
*));
9 void mark_catchlist
P_ ((struct catchtag
*));
10 void mark_stack
P_ ((char *, char *));
11 void flush_stack_call_func
P_ ((void (*) (char *, void *), void *));
14 static struct thread_state primary_thread
;
16 static struct thread_state
*all_threads
= &primary_thread
;
18 __thread
struct thread_state
*current_thread
= &primary_thread
;
20 static int inhibit_yield_counter
= 0;
22 pthread_mutex_t global_lock
;
25 mark_one_thread (struct thread_state
*thread
)
27 register struct specbinding
*bind
;
28 struct handler
*handler
;
31 for (bind
= thread
->m_specpdl
; bind
!= thread
->m_specpdl_ptr
; bind
++)
33 mark_object (bind
->symbol
);
34 mark_object (bind
->old_value
);
37 #if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
38 || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
39 mark_stack (thread
->stack_bottom
, thread
->stack_top
);
42 register struct gcpro
*tail
;
43 for (tail
= thread
->m_gcprolist
; tail
; tail
= tail
->next
)
44 for (i
= 0; i
< tail
->nvars
; i
++)
45 mark_object (tail
->var
[i
]);
49 if (thread
->m_byte_stack_list
)
50 mark_byte_stack (thread
->m_byte_stack_list
);
52 mark_catchlist (thread
->m_catchlist
);
54 for (handler
= thread
->m_handlerlist
; handler
; handler
= handler
->next
)
56 mark_object (handler
->handler
);
57 mark_object (handler
->var
);
60 mark_backtrace (thread
->m_backtrace_list
);
62 if (thread
->m_current_buffer
)
64 XSETBUFFER (tem
, thread
->m_current_buffer
);
70 mark_threads_callback (char *end
, void *ignore
)
72 struct thread_state
*iter
;
74 current_thread
->stack_top
= end
;
75 for (iter
= all_threads
; iter
; iter
= iter
->next_thread
)
77 Lisp_Object thread_obj
;
78 XSETTHREAD (thread_obj
, iter
);
79 mark_object (thread_obj
);
80 mark_one_thread (iter
);
87 flush_stack_call_func (mark_threads_callback
, NULL
);
93 struct thread_state
*iter
;
95 for (iter
= all_threads
; iter
; iter
= iter
->next_thread
)
96 if (iter
->m_byte_stack_list
)
97 unmark_byte_stack (iter
->m_byte_stack_list
);
101 thread_inhibit_yield_p ()
103 return inhibit_yield_counter
|| interrupt_input_blocked
|| abort_on_gc
;
107 thread_yield_callback (char *end
, void *ignore
)
109 if (thread_inhibit_yield_p ())
112 current_thread
->stack_top
= end
;
113 pthread_mutex_unlock (&global_lock
);
115 pthread_mutex_lock (&global_lock
);
121 /* Note: currently it is safe to check this here, but eventually it
122 will require a lock to ensure non-racy operation. */
123 /* Only yield if there is another thread to yield to. */
124 if (all_threads
->next_thread
)
125 flush_stack_call_func (thread_yield_callback
, NULL
);
128 DEFUN ("yield", Fyield
, Syield
, 0, 0, 0,
129 doc
: /* Yield to the next thread. */)
133 return other_threads_p () ? Qt
: Qnil
;
137 invoke_thread_function (void)
141 int count
= SPECPDL_INDEX ();
143 /* Set up specpdl. */
144 for (iter
= current_thread
->initial_specpdl
;
148 /* We may bind a variable twice -- but it doesn't matter because
149 there is no way to undo these bindings without exiting the
151 specbind (XCAR (XCAR (iter
)), XCDR (XCAR (iter
)));
153 current_thread
->initial_specpdl
= Qnil
;
155 Feval (current_thread
->func
);
156 return unbind_to (count
, Qnil
);
160 do_nothing (Lisp_Object whatever
)
166 run_thread (void *state
)
168 struct thread_state
*self
= state
;
169 struct thread_state
**iter
;
174 self
->stack_top
= self
->stack_bottom
= &stack_pos
;
176 self
->m_specpdl_size
= 50;
177 self
->m_specpdl
= xmalloc (self
->m_specpdl_size
178 * sizeof (struct specbinding
));
179 self
->m_specpdl_ptr
= self
->m_specpdl
;
180 self
->pthread_id
= pthread_self ();
182 /* Thread-local assignment. */
183 current_thread
= self
;
185 /* We need special handling to set the initial buffer. Our parent
186 thread is very likely to be using this same buffer so we will
187 typically wait for the parent thread to release it first. */
188 XSETBUFFER (buffer
, self
->m_current_buffer
);
190 self
->m_current_buffer
= 0;
191 set_buffer_internal (XBUFFER (buffer
));
193 pthread_mutex_lock (&global_lock
);
195 /* It might be nice to do something with errors here. */
196 internal_condition_case (invoke_thread_function
, Qt
, do_nothing
);
198 /* Unlink this thread from the list of all threads. */
199 for (iter
= &all_threads
; *iter
!= self
; iter
= &(*iter
)->next_thread
)
201 *iter
= (*iter
)->next_thread
;
203 release_buffer (self
);
204 xfree (self
->m_specpdl
);
206 pthread_mutex_unlock (&global_lock
);
211 DEFUN ("run-in-thread", Frun_in_thread
, Srun_in_thread
, 1, 2, 0,
212 doc
: /* Start a new thread and run FUNCTION in it.
213 When the function exits, the thread dies. When NOLOCK is no-nil the thread
214 does not try to get a lock on the current buffer. */)
216 Lisp_Object function
;
221 struct thread_state
*new_thread
;
222 struct specbinding
*p
;
224 /* Can't start a thread in temacs. */
228 new_thread
= (struct thread_state
*) allocate_pseudovector (VECSIZE (struct thread_state
),
230 memset ((char *) new_thread
+ OFFSETOF (struct thread_state
, m_gcprolist
),
231 0, sizeof (struct thread_state
) - OFFSETOF (struct thread_state
,
234 new_thread
->func
= function
;
235 new_thread
->nolock
= !EQ (nolock
, Qnil
);
236 new_thread
->initial_specpdl
= Qnil
;
237 new_thread
->m_current_buffer
= current_thread
->m_current_buffer
;
238 new_thread
->stack_bottom
= &stack_pos
;
240 for (p
= specpdl
; p
!= specpdl_ptr
; ++p
)
244 Lisp_Object sym
= p
->symbol
;
247 new_thread
->initial_specpdl
248 = Fcons (Fcons (sym
, find_symbol_value (sym
)),
249 new_thread
->initial_specpdl
);
253 /* We'll need locking here. */
254 new_thread
->next_thread
= all_threads
;
255 all_threads
= new_thread
;
257 if (pthread_create (&thr
, NULL
, run_thread
, new_thread
))
259 /* Restore the previous situation. */
260 all_threads
= all_threads
->next_thread
;
266 /* Get the current thread as a lisp object. */
268 get_current_thread (void)
271 XSETTHREAD (result
, current_thread
);
275 /* Get the main thread as a lisp object. */
277 get_main_thread (void)
280 XSETTHREAD (result
, &primary_thread
);
284 /* Is the current an user thread. */
288 struct thread_state
*it
= all_threads
;
289 pthread_t self
= pthread_self ();
292 if (it
->pthread_id
== self
)
295 while (it
= it
->next_thread
);
300 DEFUN ("inhibit-yield", Finhibit_yield
, Sinhibit_yield
, 1, 1, 0,
301 doc
: /* Inhibit the yield function. */)
306 inhibit_yield_counter
++;
307 else if (inhibit_yield_counter
> 0)
308 inhibit_yield_counter
--;
315 other_threads_p (void)
317 return all_threads
->next_thread
!= NULL
;
323 pthread_mutex_init (&global_lock
, NULL
);
324 pthread_mutex_lock (&global_lock
);
325 primary_thread
.pthread_id
= pthread_self ();
326 primary_thread
.nolock
= 0;
330 syms_of_threads (void)
332 defsubr (&Srun_in_thread
);
334 defsubr (&Sinhibit_yield
);