5 #ifndef CLONE_PARENT /* lameass glibc 2.2 doesn't define this */
6 #define CLONE_PARENT 0x00008000 /* even though the manpage documents it */
10 #include "validate.h" /* for CONTROL_STACK_SIZE etc */
13 #include "target-arch-os.h"
16 #ifdef LISP_FEATURE_GENCGC
20 #include "genesis/cons.h"
21 #define ALIEN_STACK_SIZE (1*1024*1024) /* 1Mb size chosen at random */
23 int dynamic_values_bytes
=4096*sizeof(lispobj
); /* same for all threads */
24 struct thread
*all_threads
;
25 lispobj all_threads_lock
;
26 extern struct interrupt_data
* global_interrupt_data
;
28 void get_spinlock(lispobj
*word
,int value
);
30 /* this is the first thing that clone() runs in the child (which is
31 * why the silly calling convention). Basically it calls the user's
32 * requested lisp function after doing arch_os_thread_init and
33 * whatever other bookkeeping needs to be done
36 /* set go to 0 to stop the thread before it starts. Convenient if you
37 * want to attach a debugger to it before it does anything */
41 new_thread_trampoline(struct thread
*th
)
45 function
= th
->unbound_marker
;
47 fprintf(stderr
, "/pausing 0x%lx(%d,%d) before new_thread_trampoline(0x%lx)\n",
48 (unsigned long)th
,th
->pid
,getpid(),(unsigned long)function
);
50 fprintf(stderr
, "/continue\n");
52 th
->unbound_marker
= UNBOUND_MARKER_WIDETAG
;
53 /* wait here until our thread is linked into all_threads: see below */
54 while(th
->pid
<1) sched_yield();
56 if(arch_os_thread_init(th
)==0)
57 return 1; /* failure. no, really */
58 #if !defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_X86)
59 return call_into_lisp_first_time(function
,args
,0);
61 return funcall0(function
);
65 /* this is called from any other thread to create the new one, and
66 * initialize all parts of it that can be initialized from another
70 pid_t
create_thread(lispobj initial_function
) {
71 union per_thread_data
*per_thread
;
72 struct thread
*th
=0; /* subdue gcc */
76 /* may as well allocate all the spaces at once: it saves us from
77 * having to decide what to do if only some of the allocations
80 THREAD_CONTROL_STACK_SIZE
+
86 if(!spaces
) goto cleanup
;
87 per_thread
=(union per_thread_data
*)
89 THREAD_CONTROL_STACK_SIZE
+
93 th
=&per_thread
->thread
;
95 memcpy(per_thread
,arch_os_get_current_thread(),
96 dynamic_values_bytes
);
98 #ifdef LISP_FEATURE_SB_THREAD
100 for(i
=0;i
<(dynamic_values_bytes
/sizeof(lispobj
));i
++)
101 per_thread
->dynamic_values
[i
]=UNBOUND_MARKER_WIDETAG
;
102 if(SymbolValue(FREE_TLS_INDEX
,0)==UNBOUND_MARKER_WIDETAG
)
105 make_fixnum(MAX_INTERRUPTS
+
106 sizeof(struct thread
)/sizeof(lispobj
)),
108 #define STATIC_TLS_INIT(sym,field) \
109 ((struct symbol *)(sym-OTHER_POINTER_LOWTAG))->tls_index= \
110 make_fixnum(THREAD_SLOT_OFFSET_WORDS(field))
112 STATIC_TLS_INIT(BINDING_STACK_START
,binding_stack_start
);
113 STATIC_TLS_INIT(BINDING_STACK_POINTER
,binding_stack_pointer
);
114 STATIC_TLS_INIT(CONTROL_STACK_START
,control_stack_start
);
115 STATIC_TLS_INIT(CONTROL_STACK_END
,control_stack_end
);
116 STATIC_TLS_INIT(ALIEN_STACK
,alien_stack_pointer
);
117 STATIC_TLS_INIT(PSEUDO_ATOMIC_ATOMIC
,pseudo_atomic_atomic
);
118 STATIC_TLS_INIT(PSEUDO_ATOMIC_INTERRUPTED
,pseudo_atomic_interrupted
);
119 #undef STATIC_TLS_INIT
123 th
->control_stack_start
= spaces
;
124 th
->binding_stack_start
=
125 (lispobj
*)((void*)th
->control_stack_start
+THREAD_CONTROL_STACK_SIZE
);
126 th
->control_stack_end
= th
->binding_stack_start
;
127 th
->alien_stack_start
=
128 (lispobj
*)((void*)th
->binding_stack_start
+BINDING_STACK_SIZE
);
129 th
->binding_stack_pointer
=th
->binding_stack_start
;
132 #ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
133 th
->alien_stack_pointer
=((void *)th
->alien_stack_start
134 + ALIEN_STACK_SIZE
-4); /* naked 4. FIXME */
136 th
->alien_stack_pointer
=((void *)th
->alien_stack_start
);
138 th
->pseudo_atomic_interrupted
=0;
139 /* runtime.c used to set PSEUDO_ATOMIC_ATOMIC =1 globally. I'm not
140 * sure why, but it appears to help */
141 th
->pseudo_atomic_atomic
=make_fixnum(1);
142 #ifdef LISP_FEATURE_GENCGC
143 gc_set_region_empty(&th
->alloc_region
);
146 #ifndef LISP_FEATURE_SB_THREAD
147 /* the tls-points-into-struct-thread trick is only good for threaded
148 * sbcl, because unithread sbcl doesn't have tls. So, we copy the
149 * appropriate values from struct thread here, and make sure that
150 * we use the appropriate SymbolValue macros to access any of the
151 * variable quantities from the C runtime. It's not quite OAOOM,
152 * it just feels like it */
153 SetSymbolValue(BINDING_STACK_START
,th
->binding_stack_start
,th
);
154 SetSymbolValue(CONTROL_STACK_START
,th
->control_stack_start
,th
);
155 SetSymbolValue(CONTROL_STACK_END
,th
->control_stack_end
,th
);
156 #ifdef LISP_FEATURE_X86
157 SetSymbolValue(BINDING_STACK_POINTER
,th
->binding_stack_pointer
,th
);
158 SetSymbolValue(ALIEN_STACK
,th
->alien_stack_pointer
,th
);
159 SetSymbolValue(PSEUDO_ATOMIC_ATOMIC
,th
->pseudo_atomic_atomic
,th
);
160 SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED
,th
->pseudo_atomic_interrupted
,th
);
162 current_binding_stack_pointer
=th
->binding_stack_pointer
;
163 current_control_stack_pointer
=th
->control_stack_start
;
166 bind_variable(CURRENT_CATCH_BLOCK
,make_fixnum(0),th
);
167 bind_variable(CURRENT_UNWIND_PROTECT_BLOCK
,make_fixnum(0),th
);
168 bind_variable(FREE_INTERRUPT_CONTEXT_INDEX
,make_fixnum(0),th
);
169 bind_variable(INTERRUPT_PENDING
, NIL
,th
);
170 bind_variable(INTERRUPTS_ENABLED
,T
,th
);
172 th
->interrupt_data
=malloc(sizeof (struct interrupt_data
));
174 memcpy(th
->interrupt_data
,
175 arch_os_get_current_thread()->interrupt_data
,
176 sizeof (struct interrupt_data
));
178 memcpy(th
->interrupt_data
,global_interrupt_data
,
179 sizeof (struct interrupt_data
));
181 th
->unbound_marker
=initial_function
;
182 #ifdef LISP_FEATURE_SB_THREAD
183 #if defined(LISP_FEATURE_X86) && defined (LISP_FEATURE_LINUX)
185 clone(new_thread_trampoline
,
186 (((void*)th
->control_stack_start
)+THREAD_CONTROL_STACK_SIZE
-4),
187 (((getpid()!=parent_pid
)?(CLONE_PARENT
):0)
188 |CLONE_FILES
|SIGALRM
|CLONE_VM
),th
);
192 #error this stuff presently only works on x86 Linux
197 get_spinlock(&all_threads_lock
,kid_pid
);
198 th
->next
=all_threads
;
200 /* note that th->pid is 0 at this time. We rely on all_threads_lock
201 * to ensure that we don't have >1 thread with pid=0 on the list at once
203 protect_control_stack_guard_page(th
->pid
,1);
205 th
->pid
=kid_pid
; /* child will not start until this is set */
206 #ifndef LISP_FEATURE_SB_THREAD
207 new_thread_trampoline(all_threads
); /* call_into_lisp */
208 lose("Clever child? Idiot savant, verging on the.");
213 /* if(th && th->tls_cookie>=0) os_free_tls_pointer(th); */
214 if(spaces
) os_invalidate(spaces
,
215 THREAD_CONTROL_STACK_SIZE
+BINDING_STACK_SIZE
+
216 ALIEN_STACK_SIZE
+dynamic_values_bytes
);
220 void destroy_thread (struct thread
*th
)
222 /* precondition: the unix task has already been killed and exited.
223 * This is called by the parent */
224 #ifdef LISP_FEATURE_GENCGC
225 gc_alloc_update_page_tables(0, &th
->alloc_region
);
227 get_spinlock(&all_threads_lock
,th
->pid
);
229 all_threads
=th
->next
;
231 struct thread
*th1
=all_threads
;
232 while(th1
->next
!=th
) th1
=th1
->next
;
233 th1
->next
=th
->next
; /* unlink */
236 if(th
&& th
->tls_cookie
>=0) arch_os_thread_cleanup(th
);
237 os_invalidate((os_vm_address_t
) th
->control_stack_start
,
238 THREAD_CONTROL_STACK_SIZE
+BINDING_STACK_SIZE
+
239 ALIEN_STACK_SIZE
+dynamic_values_bytes
+
244 struct thread
*find_thread_by_pid(pid_t pid
)
248 if(th
->pid
==pid
) return th
;
254 void block_sigcont(void)
256 /* don't allow ourselves to receive SIGCONT while we're in the
257 * "ambiguous" state of being on the queue but not actually stopped.
260 sigemptyset(&newset
);
261 sigaddset(&newset
,SIGCONT
);
262 sigprocmask(SIG_BLOCK
, &newset
, 0);
265 void unblock_sigcont_and_sleep(void)
269 sigaddset(&set
,SIGCONT
);
271 sigprocmask(SIG_UNBLOCK
,&set
,0);