13 #include "validate.h" /* for CONTROL_STACK_SIZE etc */
16 #include "target-arch-os.h"
20 #include "genesis/cons.h"
21 #include "genesis/fdefn.h"
22 #include "interr.h" /* for lose() */
23 #include "gc-internal.h"
25 #define ALIEN_STACK_SIZE (1*1024*1024) /* 1Mb size chosen at random */
27 int dynamic_values_bytes
=4096*sizeof(lispobj
); /* same for all threads */
28 struct thread
*all_threads
;
29 volatile lispobj all_threads_lock
;
30 extern struct interrupt_data
* global_interrupt_data
;
33 initial_thread_trampoline(struct thread
*th
)
37 function
= th
->unbound_marker
;
38 th
->unbound_marker
= UNBOUND_MARKER_WIDETAG
;
39 if(arch_os_thread_init(th
)==0) return 1;
41 if(th
->pid
< 1) lose("th->pid not set up right");
42 th
->state
=STATE_RUNNING
;
43 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
44 return call_into_lisp_first_time(function
,args
,0);
46 return funcall0(function
);
50 /* this is the first thing that clone() runs in the child (which is
51 * why the silly calling convention). Basically it calls the user's
52 * requested lisp function after doing arch_os_thread_init and
53 * whatever other bookkeeping needs to be done
56 #ifdef LISP_FEATURE_SB_THREAD
58 new_thread_trampoline(struct thread
*th
)
61 function
= th
->unbound_marker
;
62 th
->unbound_marker
= UNBOUND_MARKER_WIDETAG
;
63 if(arch_os_thread_init(th
)==0) return 1;
65 /* wait here until our thread is linked into all_threads: see below */
66 while(th
->pid
<1) sched_yield();
68 th
->state
=STATE_RUNNING
;
69 return funcall0(function
);
71 #endif /* LISP_FEATURE_SB_THREAD */
73 /* this is called from any other thread to create the new one, and
74 * initialize all parts of it that can be initialized from another
78 struct thread
* create_thread_struct(lispobj initial_function
) {
79 union per_thread_data
*per_thread
;
80 struct thread
*th
=0; /* subdue gcc */
83 /* may as well allocate all the spaces at once: it saves us from
84 * having to decide what to do if only some of the allocations
87 THREAD_CONTROL_STACK_SIZE
+
93 if(!spaces
) goto cleanup
;
94 per_thread
=(union per_thread_data
*)
96 THREAD_CONTROL_STACK_SIZE
+
100 th
=&per_thread
->thread
;
102 memcpy(per_thread
,arch_os_get_current_thread(),
103 dynamic_values_bytes
);
105 #ifdef LISP_FEATURE_SB_THREAD
107 for(i
=0;i
<(dynamic_values_bytes
/sizeof(lispobj
));i
++)
108 per_thread
->dynamic_values
[i
]=UNBOUND_MARKER_WIDETAG
;
109 if(SymbolValue(FREE_TLS_INDEX
,0)==UNBOUND_MARKER_WIDETAG
)
112 make_fixnum(MAX_INTERRUPTS
+
113 sizeof(struct thread
)/sizeof(lispobj
)),
115 #define STATIC_TLS_INIT(sym,field) \
116 ((struct symbol *)(sym-OTHER_POINTER_LOWTAG))->tls_index= \
117 make_fixnum(THREAD_SLOT_OFFSET_WORDS(field))
119 STATIC_TLS_INIT(BINDING_STACK_START
,binding_stack_start
);
120 STATIC_TLS_INIT(BINDING_STACK_POINTER
,binding_stack_pointer
);
121 STATIC_TLS_INIT(CONTROL_STACK_START
,control_stack_start
);
122 STATIC_TLS_INIT(CONTROL_STACK_END
,control_stack_end
);
123 STATIC_TLS_INIT(ALIEN_STACK
,alien_stack_pointer
);
124 #ifdef LISP_FEATURE_X86
125 STATIC_TLS_INIT(PSEUDO_ATOMIC_ATOMIC
,pseudo_atomic_atomic
);
126 STATIC_TLS_INIT(PSEUDO_ATOMIC_INTERRUPTED
,pseudo_atomic_interrupted
);
128 #undef STATIC_TLS_INIT
132 th
->control_stack_start
= spaces
;
133 th
->binding_stack_start
=
134 (lispobj
*)((void*)th
->control_stack_start
+THREAD_CONTROL_STACK_SIZE
);
135 th
->control_stack_end
= th
->binding_stack_start
;
136 th
->alien_stack_start
=
137 (lispobj
*)((void*)th
->binding_stack_start
+BINDING_STACK_SIZE
);
138 th
->binding_stack_pointer
=th
->binding_stack_start
;
141 th
->state
=STATE_STOPPED
;
142 #ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
143 th
->alien_stack_pointer
=((void *)th
->alien_stack_start
144 + ALIEN_STACK_SIZE
-N_WORD_BYTES
);
146 th
->alien_stack_pointer
=((void *)th
->alien_stack_start
);
148 #if defined(LISP_FEATURE_X86) || defined (LISP_FEATURE_X86_64)
149 th
->pseudo_atomic_interrupted
=0;
150 th
->pseudo_atomic_atomic
=0;
152 #ifdef LISP_FEATURE_GENCGC
153 gc_set_region_empty(&th
->alloc_region
);
156 #ifndef LISP_FEATURE_SB_THREAD
157 /* the tls-points-into-struct-thread trick is only good for threaded
158 * sbcl, because unithread sbcl doesn't have tls. So, we copy the
159 * appropriate values from struct thread here, and make sure that
160 * we use the appropriate SymbolValue macros to access any of the
161 * variable quantities from the C runtime. It's not quite OAOOM,
162 * it just feels like it */
163 SetSymbolValue(BINDING_STACK_START
,(lispobj
)th
->binding_stack_start
,th
);
164 SetSymbolValue(CONTROL_STACK_START
,(lispobj
)th
->control_stack_start
,th
);
165 SetSymbolValue(CONTROL_STACK_END
,(lispobj
)th
->control_stack_end
,th
);
166 #if defined(LISP_FEATURE_X86) || defined (LISP_FEATURE_X86_64)
167 SetSymbolValue(BINDING_STACK_POINTER
,(lispobj
)th
->binding_stack_pointer
,th
);
168 SetSymbolValue(ALIEN_STACK
,(lispobj
)th
->alien_stack_pointer
,th
);
169 SetSymbolValue(PSEUDO_ATOMIC_ATOMIC
,(lispobj
)th
->pseudo_atomic_atomic
,th
);
170 SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED
,th
->pseudo_atomic_interrupted
,th
);
172 current_binding_stack_pointer
=th
->binding_stack_pointer
;
173 current_control_stack_pointer
=th
->control_stack_start
;
176 bind_variable(CURRENT_CATCH_BLOCK
,make_fixnum(0),th
);
177 bind_variable(CURRENT_UNWIND_PROTECT_BLOCK
,make_fixnum(0),th
);
178 bind_variable(FREE_INTERRUPT_CONTEXT_INDEX
,make_fixnum(0),th
);
179 bind_variable(INTERRUPT_PENDING
, NIL
,th
);
180 bind_variable(INTERRUPTS_ENABLED
,T
,th
);
183 os_validate(0,(sizeof (struct interrupt_data
)));
185 memcpy(th
->interrupt_data
,
186 arch_os_get_current_thread()->interrupt_data
,
187 sizeof (struct interrupt_data
));
189 memcpy(th
->interrupt_data
,global_interrupt_data
,
190 sizeof (struct interrupt_data
));
192 th
->unbound_marker
=initial_function
;
195 /* if(th && th->tls_cookie>=0) os_free_tls_pointer(th); */
196 if(spaces
) os_invalidate(spaces
,
197 THREAD_CONTROL_STACK_SIZE
+BINDING_STACK_SIZE
+
198 ALIEN_STACK_SIZE
+dynamic_values_bytes
);
202 void link_thread(struct thread
*th
,pid_t kid_pid
)
204 sigset_t newset
,oldset
;
205 sigemptyset(&newset
);
206 sigaddset_blockable(&newset
);
207 sigprocmask(SIG_BLOCK
, &newset
, &oldset
);
209 get_spinlock(&all_threads_lock
,kid_pid
);
210 th
->next
=all_threads
;
212 /* note that th->pid is 0 at this time. We rely on all_threads_lock
213 * to ensure that we don't have >1 thread with pid=0 on the list at once
215 protect_control_stack_guard_page(th
->pid
,1);
216 release_spinlock(&all_threads_lock
);
218 sigprocmask(SIG_SETMASK
,&oldset
,0);
219 th
->pid
=kid_pid
; /* child will not start until this is set */
222 void create_initial_thread(lispobj initial_function
) {
223 struct thread
*th
=create_thread_struct(initial_function
);
224 pid_t kid_pid
=getpid();
225 if(th
&& kid_pid
>0) {
226 link_thread(th
,kid_pid
);
227 initial_thread_trampoline(all_threads
); /* no return */
228 } else lose("can't create initial thread");
231 #ifdef LISP_FEATURE_SB_THREAD
232 pid_t
create_thread(lispobj initial_function
) {
233 struct thread
*th
=create_thread_struct(initial_function
);
237 kid_pid
=clone(new_thread_trampoline
,
238 (((void*)th
->control_stack_start
)+
239 THREAD_CONTROL_STACK_SIZE
-4),
240 CLONE_FILES
|SIG_THREAD_EXIT
|CLONE_VM
,th
);
243 link_thread(th
,kid_pid
);
246 os_invalidate((os_vm_address_t
) th
->control_stack_start
,
248 * (th
->control_stack_end
-th
->control_stack_start
)) +
249 BINDING_STACK_SIZE
+ALIEN_STACK_SIZE
+dynamic_values_bytes
+
257 void destroy_thread (struct thread
*th
)
259 /* precondition: the unix task has already been killed and exited.
260 * This is called by the parent or some other thread */
261 #ifdef LISP_FEATURE_GENCGC
262 gc_alloc_update_page_tables(0, &th
->alloc_region
);
264 get_spinlock(&all_threads_lock
,th
->pid
);
265 th
->unbound_marker
=0; /* for debugging */
267 all_threads
=th
->next
;
269 struct thread
*th1
=all_threads
;
270 while(th1
&& th1
->next
!=th
) th1
=th1
->next
;
271 if(th1
) th1
->next
=th
->next
; /* unlink */
273 release_spinlock(&all_threads_lock
);
274 if(th
&& th
->tls_cookie
>=0) arch_os_thread_cleanup(th
);
275 os_invalidate((os_vm_address_t
) th
->control_stack_start
,
277 * (th
->control_stack_end
-th
->control_stack_start
)) +
278 BINDING_STACK_SIZE
+ALIEN_STACK_SIZE
+dynamic_values_bytes
+
282 struct thread
*find_thread_by_pid(pid_t pid
)
286 if(th
->pid
==pid
) return th
;
290 #if defined LISP_FEATURE_SB_THREAD
291 /* This is not needed unless #+SB-THREAD, as there's a trivial null
292 * unithread definition. */
294 void mark_dead_threads()
299 kid
=waitpid(-1,&status
,__WALL
|WNOHANG
);
301 if(WIFEXITED(status
) || WIFSIGNALED(status
)) {
302 struct thread
*th
=find_thread_by_pid(kid
);
303 if(th
) th
->state
=STATE_DEAD
;
308 void reap_dead_threads()
310 struct thread
*th
,*next
,*prev
=0;
314 if(th
->state
==STATE_DEAD
) {
315 funcall1(SymbolFunction(HANDLE_THREAD_EXIT
),make_fixnum(th
->pid
));
316 #ifdef LISP_FEATURE_GENCGC
317 gc_alloc_update_page_tables(0, &th
->alloc_region
);
319 get_spinlock(&all_threads_lock
,th
->pid
);
320 if(prev
) prev
->next
=next
;
321 else all_threads
=next
;
322 release_spinlock(&all_threads_lock
);
323 if(th
->tls_cookie
>=0) arch_os_thread_cleanup(th
);
324 os_invalidate((os_vm_address_t
) th
->control_stack_start
,
326 * (th
->control_stack_end
-th
->control_stack_start
)) +
327 BINDING_STACK_SIZE
+ALIEN_STACK_SIZE
+dynamic_values_bytes
+
335 /* These are not needed unless #+SB-THREAD, and since sigwaitinfo()
336 * doesn't seem to be easily available everywhere (OpenBSD...) it's
337 * more trouble than it's worth to compile it when not needed. */
338 void block_sigcont(void)
340 /* don't allow ourselves to receive SIGCONT while we're in the
341 * "ambiguous" state of being on the queue but not actually stopped.
344 sigemptyset(&newset
);
345 sigaddset(&newset
,SIG_DEQUEUE
);
346 sigprocmask(SIG_BLOCK
, &newset
, 0);
349 void unblock_sigcont_and_sleep(void)
353 sigaddset(&set
,SIG_DEQUEUE
);
357 }while(errno
==EINTR
);
358 sigprocmask(SIG_UNBLOCK
,&set
,0);
361 int interrupt_thread(pid_t pid
, lispobj function
)
365 sigval
.sival_int
=function
;
367 if((th
->pid
==pid
) && (th
->state
!= STATE_DEAD
))
368 return sigqueue(pid
, SIG_INTERRUPT_THREAD
, sigval
);
369 errno
=EPERM
; return -1;
372 int signal_thread_to_dequeue (pid_t pid
)
374 return kill (pid
, SIG_DEQUEUE
);
378 /* stopping the world is a two-stage process. From this thread we signal
379 * all the others with SIG_STOP_FOR_GC. The handler for this signal does
380 * the usual pseudo-atomic checks (we don't want to stop a thread while
381 * it's in the middle of allocation) then kills _itself_ with SIGSTOP.
384 void gc_stop_the_world()
386 /* stop all other threads by sending them SIG_STOP_FOR_GC */
387 struct thread
*p
,*th
=arch_os_get_current_thread();
392 for(p
=all_threads
,old_pid
=p
->pid
; p
; p
=p
->next
) {
394 if(p
->state
==STATE_RUNNING
) {
395 p
->state
=STATE_STOPPING
;
396 if(kill(p
->pid
,SIG_STOP_FOR_GC
)==-1) {
397 /* we can't kill the process; assume because it
398 * died already (and its parent is dead so never
399 * saw the SIGCHLD) */
403 if((p
->state
!=STATE_STOPPED
) &&
404 (p
->state
!=STATE_DEAD
)) {
408 if(old_pid
!=all_threads
->pid
) {
414 void gc_start_the_world()
416 struct thread
*p
,*th
=arch_os_get_current_thread();
417 /* if a resumed thread creates a new thread before we're done with
418 * this loop, the new thread will get consed on the front of *
419 * all_threads_lock, but it won't have been stopped so won't need
421 for(p
=all_threads
;p
;p
=p
->next
) {
422 if((p
==th
) || (p
->state
==STATE_DEAD
)) continue;
423 p
->state
=STATE_RUNNING
;
424 kill(p
->pid
,SIG_STOP_FOR_GC
);