Commit | Line | Data |
---|---|---|
68795e93 NIS |
1 | #define PERL_NO_GET_CONTEXT |
2 | #include "EXTERN.h" | |
3 | #include "perl.h" | |
4 | #include "XSUB.h" | |
4dcb9e53 JH |
5 | /* Workaround for XSUB.h bug under WIN32 */ |
6 | #ifdef WIN32 | |
7 | # undef setjmp | |
c608f8c0 JH |
8 | # if !defined(__BORLANDC__) |
9 | # define setjmp(x) _setjmp(x) | |
10 | # endif | |
4dcb9e53 | 11 | #endif |
0f1612a7 | 12 | #ifdef HAS_PPPORT_H |
404aaa48 | 13 | # define NEED_PL_signals |
0f1612a7 JH |
14 | # define NEED_newRV_noinc |
15 | # define NEED_sv_2pv_nolen | |
16 | # include "ppport.h" | |
17 | # include "threads.h" | |
18 | #endif | |
68795e93 | 19 | |
73e09c8f JH |
20 | #ifdef USE_ITHREADS |
21 | ||
68795e93 | 22 | #ifdef WIN32 |
fc04eb16 | 23 | # include <windows.h> |
514612b7 JH |
24 | /* Supposed to be in Winbase.h */ |
25 | # ifndef STACK_SIZE_PARAM_IS_A_RESERVATION | |
26 | # define STACK_SIZE_PARAM_IS_A_RESERVATION 0x00010000 | |
27 | # endif | |
fc04eb16 | 28 | # include <win32thread.h> |
68795e93 | 29 | #else |
fc04eb16 | 30 | # ifdef OS2 |
5c728af0 | 31 | typedef perl_os_thread pthread_t; |
fc04eb16 JH |
32 | # else |
33 | # include <pthread.h> | |
34 | # endif | |
35 | # include <thread.h> | |
36 | # define PERL_THREAD_SETSPECIFIC(k,v) pthread_setspecific(k,v) | |
37 | # ifdef OLD_PTHREADS_API | |
38 | # define PERL_THREAD_DETACH(t) pthread_detach(&(t)) | |
39 | # else | |
40 | # define PERL_THREAD_DETACH(t) pthread_detach((t)) | |
41 | # endif | |
467f3f08 | 42 | #endif |
d305c2c9 JH |
43 | #if !defined(HAS_GETPAGESIZE) && defined(I_SYS_PARAM) |
44 | # include <sys/param.h> | |
45 | #endif | |
68795e93 | 46 | |
62375a60 | 47 | /* Values for 'state' member */ |
69a9b4b8 RGS |
48 | #define PERL_ITHR_DETACHED 1 |
49 | #define PERL_ITHR_JOINED 2 | |
50 | #define PERL_ITHR_FINISHED 4 | |
51 | #define PERL_ITHR_THREAD_EXIT_ONLY 8 | |
adc09a0e JH |
52 | #define PERL_ITHR_NONVIABLE 16 |
53 | #define PERL_ITHR_DESTROYED 32 | |
fc04eb16 JH |
54 | |
55 | typedef struct _ithread { | |
56 | struct _ithread *next; /* Next thread in the list */ | |
57 | struct _ithread *prev; /* Prev thread in the list */ | |
58 | PerlInterpreter *interp; /* The threads interpreter */ | |
59 | UV tid; /* Threads module's thread id */ | |
60 | perl_mutex mutex; /* Mutex for updating things in this struct */ | |
9feacc09 | 61 | int count; /* How many SVs have a reference to us */ |
fc04eb16 JH |
62 | int state; /* Detached, joined, finished, etc. */ |
63 | int gimme; /* Context of create */ | |
64 | SV *init_function; /* Code to run */ | |
65 | SV *params; /* Args to pass function */ | |
68795e93 | 66 | #ifdef WIN32 |
fc04eb16 JH |
67 | DWORD thr; /* OS's idea if thread id */ |
68 | HANDLE handle; /* OS's waitable handle */ | |
68795e93 | 69 | #else |
fc04eb16 | 70 | pthread_t thr; /* OS's handle for the thread */ |
68795e93 | 71 | #endif |
514612b7 | 72 | IV stack_size; |
68795e93 NIS |
73 | } ithread; |
74 | ||
fc04eb16 | 75 | |
5c6ff896 | 76 | #define MY_CXT_KEY "threads::_cxt" XS_VERSION |
628ab322 DM |
77 | |
78 | typedef struct { | |
861d5cbe JH |
79 | /* Used by Perl interpreter for thread context switching */ |
80 | ithread *context; | |
628ab322 DM |
81 | } my_cxt_t; |
82 | ||
83 | START_MY_CXT | |
84 | ||
68795e93 | 85 | |
5c6ff896 | 86 | #define MY_POOL_KEY "threads::_pool" XS_VERSION |
68795e93 | 87 | |
5c6ff896 JH |
88 | typedef struct { |
89 | /* Structure for 'main' thread | |
90 | * Also forms the 'base' for the doubly-linked list of threads */ | |
91 | ithread main_thread; | |
92 | ||
93 | /* Protects the creation and destruction of threads*/ | |
94 | perl_mutex create_destruct_mutex; | |
95 | ||
96 | UV tid_counter; | |
97 | IV joinable_threads; | |
98 | IV running_threads; | |
99 | IV detached_threads; | |
100 | IV default_stack_size; | |
101 | IV page_size; | |
102 | } my_pool_t; | |
103 | ||
104 | #define dMY_POOL \ | |
105 | SV *my_pool_sv = *hv_fetch(PL_modglobal, MY_POOL_KEY, \ | |
106 | sizeof(MY_POOL_KEY)-1, TRUE); \ | |
107 | my_pool_t *my_poolp = INT2PTR(my_pool_t*, SvUV(my_pool_sv)) | |
108 | ||
109 | #define MY_POOL (*my_poolp) | |
c05ae023 AB |
110 | |
111 | ||
fc04eb16 | 112 | /* Used by Perl interpreter for thread context switching */ |
861d5cbe | 113 | STATIC void |
fc04eb16 | 114 | S_ithread_set(pTHX_ ithread *thread) |
c05ae023 | 115 | { |
628ab322 | 116 | dMY_CXT; |
861d5cbe | 117 | MY_CXT.context = thread; |
c05ae023 AB |
118 | } |
119 | ||
861d5cbe | 120 | STATIC ithread * |
fc04eb16 JH |
121 | S_ithread_get(pTHX) |
122 | { | |
628ab322 | 123 | dMY_CXT; |
861d5cbe | 124 | return (MY_CXT.context); |
c05ae023 AB |
125 | } |
126 | ||
127 | ||
fc04eb16 JH |
128 | /* Free any data (such as the Perl interpreter) attached to an ithread |
129 | * structure. This is a bit like undef on SVs, where the SV isn't freed, | |
130 | * but the PVX is. Must be called with thread->mutex already held. | |
2e676467 | 131 | */ |
861d5cbe | 132 | STATIC void |
fc04eb16 | 133 | S_ithread_clear(pTHX_ ithread *thread) |
2e676467 DM |
134 | { |
135 | PerlInterpreter *interp; | |
fc04eb16 | 136 | |
adc09a0e JH |
137 | assert(((thread->state & PERL_ITHR_FINISHED) && |
138 | (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) | |
139 | || | |
140 | (thread->state & PERL_ITHR_NONVIABLE)); | |
2e676467 DM |
141 | |
142 | interp = thread->interp; | |
143 | if (interp) { | |
fc04eb16 JH |
144 | dTHXa(interp); |
145 | ||
146 | PERL_SET_CONTEXT(interp); | |
147 | S_ithread_set(aTHX_ thread); | |
f2cba68d | 148 | |
fc04eb16 JH |
149 | SvREFCNT_dec(thread->params); |
150 | thread->params = Nullsv; | |
2e676467 | 151 | |
fc04eb16 | 152 | perl_destruct(interp); |
9ca4d7fd | 153 | perl_free(interp); |
fc04eb16 | 154 | thread->interp = NULL; |
2e676467 | 155 | } |
fc04eb16 | 156 | |
2e676467 DM |
157 | PERL_SET_CONTEXT(aTHX); |
158 | } | |
159 | ||
68795e93 | 160 | |
fc04eb16 | 161 | /* Free an ithread structure and any attached data if its count == 0 */ |
861d5cbe | 162 | STATIC void |
fc04eb16 | 163 | S_ithread_destruct(pTHX_ ithread *thread) |
68795e93 | 164 | { |
adc09a0e | 165 | int destroy = 0; |
385d56e4 | 166 | #ifdef WIN32 |
fc04eb16 | 167 | HANDLE handle; |
385d56e4 | 168 | #endif |
adc09a0e JH |
169 | dMY_POOL; |
170 | ||
171 | /* Determine if thread can be destroyed now */ | |
172 | MUTEX_LOCK(&thread->mutex); | |
fc04eb16 | 173 | if (thread->count != 0) { |
adc09a0e JH |
174 | destroy = 0; |
175 | } else if (thread->state & PERL_ITHR_DESTROYED) { | |
176 | destroy = 0; | |
177 | } else if (thread->state & PERL_ITHR_NONVIABLE) { | |
178 | thread->state |= PERL_ITHR_DESTROYED; | |
179 | destroy = 1; | |
180 | } else if (! (thread->state & PERL_ITHR_FINISHED)) { | |
181 | destroy = 0; | |
182 | } else if (! (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) { | |
183 | destroy = 0; | |
184 | } else { | |
185 | thread->state |= PERL_ITHR_DESTROYED; | |
186 | destroy = 1; | |
fc04eb16 | 187 | } |
adc09a0e JH |
188 | MUTEX_UNLOCK(&thread->mutex); |
189 | if (! destroy) return; | |
9feacc09 | 190 | |
fc04eb16 JH |
191 | /* Main thread (0) is immortal and should never get here */ |
192 | assert(thread->tid != 0); | |
193 | ||
194 | /* Remove from circular list of threads */ | |
5c6ff896 | 195 | MUTEX_LOCK(&MY_POOL.create_destruct_mutex); |
adc09a0e JH |
196 | assert(thread->prev && thread->next); |
197 | thread->next->prev = thread->prev; | |
198 | thread->prev->next = thread->next; | |
fc04eb16 JH |
199 | thread->next = NULL; |
200 | thread->prev = NULL; | |
5c6ff896 | 201 | MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); |
c2f2a82b | 202 | |
fc04eb16 | 203 | /* Thread is now disowned */ |
9ca4d7fd | 204 | MUTEX_LOCK(&thread->mutex); |
fc04eb16 | 205 | S_ithread_clear(aTHX_ thread); |
385d56e4 JH |
206 | |
207 | #ifdef WIN32 | |
fc04eb16 JH |
208 | handle = thread->handle; |
209 | thread->handle = NULL; | |
385d56e4 | 210 | #endif |
fc04eb16 JH |
211 | MUTEX_UNLOCK(&thread->mutex); |
212 | MUTEX_DESTROY(&thread->mutex); | |
385d56e4 | 213 | |
c7667023 | 214 | #ifdef WIN32 |
fea7688c | 215 | if (handle) { |
fc04eb16 | 216 | CloseHandle(handle); |
fea7688c | 217 | } |
c7667023 | 218 | #endif |
385d56e4 | 219 | |
fc04eb16 JH |
220 | /* Call PerlMemShared_free() in the context of the "first" interpreter |
221 | * per http://www.nntp.perl.org/group/perl.perl5.porters/110772 | |
222 | */ | |
5c6ff896 | 223 | aTHX = MY_POOL.main_thread.interp; |
fc04eb16 | 224 | PerlMemShared_free(thread); |
68795e93 NIS |
225 | } |
226 | ||
fc04eb16 | 227 | |
69a9b4b8 | 228 | /* Warn if exiting with any unjoined threads */ |
861d5cbe | 229 | STATIC int |
69a9b4b8 | 230 | S_exit_warning(pTHX) |
62375a60 | 231 | { |
60bd5ef6 | 232 | int veto_cleanup; |
adc09a0e | 233 | dMY_POOL; |
69a9b4b8 | 234 | |
5c6ff896 JH |
235 | MUTEX_LOCK(&MY_POOL.create_destruct_mutex); |
236 | veto_cleanup = (MY_POOL.running_threads || MY_POOL.joinable_threads); | |
237 | MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); | |
60bd5ef6 RGS |
238 | |
239 | if (veto_cleanup) { | |
fc04eb16 | 240 | if (ckWARN_d(WARN_THREADS)) { |
4dcb9e53 JH |
241 | Perl_warn(aTHX_ "Perl exited with active threads:\n\t%" |
242 | IVdf " running and unjoined\n\t%" | |
243 | IVdf " finished and unjoined\n\t%" | |
244 | IVdf " running and detached\n", | |
5c6ff896 JH |
245 | MY_POOL.running_threads, |
246 | MY_POOL.joinable_threads, | |
247 | MY_POOL.detached_threads); | |
fc04eb16 | 248 | } |
62375a60 | 249 | } |
69a9b4b8 | 250 | |
fc04eb16 | 251 | return (veto_cleanup); |
62375a60 NIS |
252 | } |
253 | ||
69a9b4b8 RGS |
254 | /* Called on exit from main thread */ |
255 | int | |
256 | Perl_ithread_hook(pTHX) | |
257 | { | |
5c6ff896 | 258 | dMY_POOL; |
b5c80a23 | 259 | return ((aTHX == MY_POOL.main_thread.interp) ? S_exit_warning(aTHX) : 0); |
69a9b4b8 RGS |
260 | } |
261 | ||
68795e93 NIS |
262 | |
263 | /* MAGIC (in mg.h sense) hooks */ | |
264 | ||
265 | int | |
266 | ithread_mg_get(pTHX_ SV *sv, MAGIC *mg) | |
267 | { | |
fc04eb16 | 268 | ithread *thread = (ithread *)mg->mg_ptr; |
45977657 | 269 | SvIV_set(sv, PTR2IV(thread)); |
68795e93 | 270 | SvIOK_on(sv); |
fc04eb16 | 271 | return (0); |
68795e93 NIS |
272 | } |
273 | ||
274 | int | |
275 | ithread_mg_free(pTHX_ SV *sv, MAGIC *mg) | |
276 | { | |
f2cba68d | 277 | ithread *thread = (ithread *)mg->mg_ptr; |
f2cba68d | 278 | |
68795e93 | 279 | MUTEX_LOCK(&thread->mutex); |
adc09a0e | 280 | thread->count--; |
f2cba68d JH |
281 | MUTEX_UNLOCK(&thread->mutex); |
282 | ||
adc09a0e JH |
283 | /* Try to clean up thread */ |
284 | S_ithread_destruct(aTHX_ thread); | |
285 | ||
fc04eb16 | 286 | return (0); |
68795e93 NIS |
287 | } |
288 | ||
289 | int | |
290 | ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) | |
291 | { | |
fc04eb16 | 292 | ithread *thread = (ithread *)mg->mg_ptr; |
68795e93 | 293 | MUTEX_LOCK(&thread->mutex); |
68795e93 NIS |
294 | thread->count++; |
295 | MUTEX_UNLOCK(&thread->mutex); | |
fc04eb16 | 296 | return (0); |
68795e93 NIS |
297 | } |
298 | ||
299 | MGVTBL ithread_vtbl = { | |
fc04eb16 JH |
300 | ithread_mg_get, /* get */ |
301 | 0, /* set */ | |
302 | 0, /* len */ | |
303 | 0, /* clear */ | |
304 | ithread_mg_free, /* free */ | |
305 | 0, /* copy */ | |
306 | ithread_mg_dup /* dup */ | |
68795e93 NIS |
307 | }; |
308 | ||
47ba8780 | 309 | |
514612b7 | 310 | /* Provided default, minimum and rational stack sizes */ |
861d5cbe JH |
311 | STATIC IV |
312 | S_good_stack_size(pTHX_ IV stack_size) | |
514612b7 | 313 | { |
5c6ff896 JH |
314 | dMY_POOL; |
315 | ||
514612b7 | 316 | /* Use default stack size if no stack size specified */ |
fea7688c | 317 | if (! stack_size) { |
5c6ff896 | 318 | return (MY_POOL.default_stack_size); |
fea7688c | 319 | } |
514612b7 JH |
320 | |
321 | #ifdef PTHREAD_STACK_MIN | |
322 | /* Can't use less than minimum */ | |
323 | if (stack_size < PTHREAD_STACK_MIN) { | |
4dcb9e53 | 324 | if (ckWARN(WARN_THREADS)) { |
514612b7 JH |
325 | Perl_warn(aTHX_ "Using minimum thread stack size of %" IVdf, (IV)PTHREAD_STACK_MIN); |
326 | } | |
327 | return (PTHREAD_STACK_MIN); | |
328 | } | |
329 | #endif | |
330 | ||
331 | /* Round up to page size boundary */ | |
5c6ff896 | 332 | if (MY_POOL.page_size <= 0) { |
d305c2c9 | 333 | #if defined(HAS_SYSCONF) && (defined(_SC_PAGESIZE) || defined(_SC_MMAP_PAGE_SIZE)) |
514612b7 | 334 | SETERRNO(0, SS_NORMAL); |
d305c2c9 | 335 | # ifdef _SC_PAGESIZE |
5c6ff896 | 336 | MY_POOL.page_size = sysconf(_SC_PAGESIZE); |
d305c2c9 | 337 | # else |
5c6ff896 | 338 | MY_POOL.page_size = sysconf(_SC_MMAP_PAGE_SIZE); |
d305c2c9 | 339 | # endif |
5c6ff896 | 340 | if ((long)MY_POOL.page_size < 0) { |
514612b7 JH |
341 | if (errno) { |
342 | SV * const error = get_sv("@", FALSE); | |
343 | (void)SvUPGRADE(error, SVt_PV); | |
344 | Perl_croak(aTHX_ "PANIC: sysconf: %s", SvPV_nolen(error)); | |
345 | } else { | |
346 | Perl_croak(aTHX_ "PANIC: sysconf: pagesize unknown"); | |
347 | } | |
348 | } | |
d305c2c9 JH |
349 | #else |
350 | # ifdef HAS_GETPAGESIZE | |
5c6ff896 | 351 | MY_POOL.page_size = getpagesize(); |
514612b7 | 352 | # else |
d305c2c9 | 353 | # if defined(I_SYS_PARAM) && defined(PAGESIZE) |
5c6ff896 | 354 | MY_POOL.page_size = PAGESIZE; |
d305c2c9 | 355 | # else |
5c6ff896 | 356 | MY_POOL.page_size = 8192; /* A conservative default */ |
d305c2c9 | 357 | # endif |
514612b7 | 358 | # endif |
5c6ff896 JH |
359 | if (MY_POOL.page_size <= 0) { |
360 | Perl_croak(aTHX_ "PANIC: bad pagesize %" IVdf, (IV)MY_POOL.page_size); | |
fea7688c | 361 | } |
514612b7 JH |
362 | #endif |
363 | } | |
5c6ff896 | 364 | stack_size = ((stack_size + (MY_POOL.page_size - 1)) / MY_POOL.page_size) * MY_POOL.page_size; |
514612b7 JH |
365 | |
366 | return (stack_size); | |
367 | } | |
368 | ||
369 | ||
fc04eb16 JH |
370 | /* Starts executing the thread. |
371 | * Passed as the C level function to run in the new thread. | |
b1edfb69 | 372 | */ |
47ba8780 | 373 | #ifdef WIN32 |
861d5cbe | 374 | STATIC THREAD_RET_TYPE |
fc04eb16 | 375 | S_ithread_run(LPVOID arg) |
47ba8780 | 376 | #else |
861d5cbe | 377 | STATIC void * |
fc04eb16 | 378 | S_ithread_run(void * arg) |
47ba8780 | 379 | #endif |
fc04eb16 JH |
380 | { |
381 | ithread *thread = (ithread *)arg; | |
69a9b4b8 RGS |
382 | int jmp_rc = 0; |
383 | I32 oldscope; | |
384 | int exit_app = 0; | |
385 | int exit_code = 0; | |
f2cba68d | 386 | |
69a9b4b8 RGS |
387 | dJMPENV; |
388 | ||
fc04eb16 | 389 | dTHXa(thread->interp); |
47ba8780 | 390 | |
5c6ff896 JH |
391 | dMY_POOL; |
392 | ||
9ca4d7fd | 393 | /* Blocked until ->create() call finishes */ |
fc04eb16 | 394 | MUTEX_LOCK(&thread->mutex); |
fc04eb16 | 395 | MUTEX_UNLOCK(&thread->mutex); |
9ca4d7fd JH |
396 | |
397 | PERL_SET_CONTEXT(thread->interp); | |
398 | S_ithread_set(aTHX_ thread); | |
47ba8780 | 399 | |
fc04eb16 | 400 | PL_perl_destruct_level = 2; |
f2cba68d | 401 | |
fc04eb16 JH |
402 | { |
403 | AV *params = (AV *)SvRV(thread->params); | |
404 | int len = (int)av_len(params)+1; | |
405 | int ii; | |
406 | ||
407 | dSP; | |
408 | ENTER; | |
409 | SAVETMPS; | |
410 | ||
411 | /* Put args on the stack */ | |
412 | PUSHMARK(SP); | |
413 | for (ii=0; ii < len; ii++) { | |
414 | XPUSHs(av_shift(params)); | |
415 | } | |
416 | PUTBACK; | |
417 | ||
4dcb9e53 JH |
418 | oldscope = PL_scopestack_ix; |
419 | JMPENV_PUSH(jmp_rc); | |
420 | if (jmp_rc == 0) { | |
421 | /* Run the specified function */ | |
422 | len = (int)call_sv(thread->init_function, thread->gimme|G_EVAL); | |
423 | } else if (jmp_rc == 2) { | |
69a9b4b8 RGS |
424 | /* Thread exited */ |
425 | exit_app = 1; | |
426 | exit_code = STATUS_CURRENT; | |
4dcb9e53 JH |
427 | while (PL_scopestack_ix > oldscope) { |
428 | LEAVE; | |
429 | } | |
430 | } | |
431 | JMPENV_POP; | |
fc04eb16 JH |
432 | |
433 | /* Remove args from stack and put back in params array */ | |
434 | SPAGAIN; | |
435 | for (ii=len-1; ii >= 0; ii--) { | |
436 | SV *sv = POPs; | |
4dcb9e53 JH |
437 | if (jmp_rc == 0) { |
438 | av_store(params, ii, SvREFCNT_inc(sv)); | |
439 | } | |
fc04eb16 JH |
440 | } |
441 | ||
4dcb9e53 JH |
442 | FREETMPS; |
443 | LEAVE; | |
444 | ||
fc04eb16 JH |
445 | /* Check for failure */ |
446 | if (SvTRUE(ERRSV) && ckWARN_d(WARN_THREADS)) { | |
4dcb9e53 JH |
447 | oldscope = PL_scopestack_ix; |
448 | JMPENV_PUSH(jmp_rc); | |
449 | if (jmp_rc == 0) { | |
69a9b4b8 | 450 | /* Warn that thread died */ |
4dcb9e53 JH |
451 | Perl_warn(aTHX_ "Thread %" UVuf " terminated abnormally: %" SVf, thread->tid, ERRSV); |
452 | } else if (jmp_rc == 2) { | |
69a9b4b8 RGS |
453 | /* Warn handler exited */ |
454 | exit_app = 1; | |
455 | exit_code = STATUS_CURRENT; | |
4dcb9e53 JH |
456 | while (PL_scopestack_ix > oldscope) { |
457 | LEAVE; | |
458 | } | |
459 | } | |
460 | JMPENV_POP; | |
fc04eb16 JH |
461 | } |
462 | ||
fc04eb16 JH |
463 | /* Release function ref */ |
464 | SvREFCNT_dec(thread->init_function); | |
465 | thread->init_function = Nullsv; | |
466 | } | |
62375a60 | 467 | |
fc04eb16 JH |
468 | PerlIO_flush((PerlIO *)NULL); |
469 | ||
5c6ff896 | 470 | MUTEX_LOCK(&MY_POOL.create_destruct_mutex); |
fc04eb16 JH |
471 | MUTEX_LOCK(&thread->mutex); |
472 | /* Mark as finished */ | |
473 | thread->state |= PERL_ITHR_FINISHED; | |
69a9b4b8 | 474 | /* Clear exit flag if required */ |
fea7688c | 475 | if (thread->state & PERL_ITHR_THREAD_EXIT_ONLY) { |
69a9b4b8 | 476 | exit_app = 0; |
fea7688c | 477 | } |
fc04eb16 | 478 | |
69a9b4b8 | 479 | /* Adjust thread status counts */ |
adc09a0e | 480 | if (thread->state & PERL_ITHR_DETACHED) { |
5c6ff896 | 481 | MY_POOL.detached_threads--; |
4dcb9e53 | 482 | } else { |
5c6ff896 JH |
483 | MY_POOL.running_threads--; |
484 | MY_POOL.joinable_threads++; | |
5168baf3 | 485 | } |
adc09a0e | 486 | MUTEX_UNLOCK(&thread->mutex); |
5c6ff896 | 487 | MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); |
69a9b4b8 RGS |
488 | |
489 | /* Exit application if required */ | |
490 | if (exit_app) { | |
491 | oldscope = PL_scopestack_ix; | |
492 | JMPENV_PUSH(jmp_rc); | |
493 | if (jmp_rc == 0) { | |
494 | /* Warn if there are unjoined threads */ | |
495 | S_exit_warning(aTHX); | |
496 | } else if (jmp_rc == 2) { | |
497 | /* Warn handler exited */ | |
498 | exit_code = STATUS_CURRENT; | |
499 | while (PL_scopestack_ix > oldscope) { | |
500 | LEAVE; | |
501 | } | |
502 | } | |
503 | JMPENV_POP; | |
504 | ||
505 | my_exit(exit_code); | |
506 | } | |
507 | ||
adc09a0e JH |
508 | /* Try to clean up thread */ |
509 | S_ithread_destruct(aTHX_ thread); | |
91604d21 | 510 | |
47ba8780 | 511 | #ifdef WIN32 |
fc04eb16 | 512 | return ((DWORD)0); |
e8f2bb9a | 513 | #else |
fc04eb16 | 514 | return (0); |
47ba8780 | 515 | #endif |
68795e93 NIS |
516 | } |
517 | ||
fc04eb16 JH |
518 | |
519 | /* Type conversion helper functions */ | |
fea7688c | 520 | |
861d5cbe JH |
521 | STATIC SV * |
522 | S_ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc) | |
68795e93 NIS |
523 | { |
524 | SV *sv; | |
525 | MAGIC *mg; | |
fc04eb16 | 526 | |
9ca4d7fd | 527 | /* If incrementing thread ref count, then call within mutex lock */ |
68795e93 | 528 | if (inc) { |
fc04eb16 JH |
529 | MUTEX_LOCK(&thread->mutex); |
530 | thread->count++; | |
531 | MUTEX_UNLOCK(&thread->mutex); | |
532 | } | |
533 | ||
534 | if (! obj) { | |
535 | obj = newSV(0); | |
68795e93 | 536 | } |
fc04eb16 JH |
537 | |
538 | sv = newSVrv(obj, classname); | |
539 | sv_setiv(sv, PTR2IV(thread)); | |
540 | mg = sv_magicext(sv, Nullsv, PERL_MAGIC_shared_scalar, &ithread_vtbl, (char *)thread, 0); | |
68795e93 NIS |
541 | mg->mg_flags |= MGf_DUP; |
542 | SvREADONLY_on(sv); | |
fc04eb16 JH |
543 | |
544 | return (obj); | |
68795e93 | 545 | } |
47ba8780 | 546 | |
861d5cbe JH |
547 | STATIC ithread * |
548 | S_SV_to_ithread(pTHX_ SV *sv) | |
68795e93 | 549 | { |
fc04eb16 JH |
550 | /* Argument is a thread */ |
551 | if (SvROK(sv)) { | |
552 | return (INT2PTR(ithread *, SvIV(SvRV(sv)))); | |
553 | } | |
554 | /* Argument is classname, therefore return current thread */ | |
555 | return (S_ithread_get(aTHX)); | |
47ba8780 AB |
556 | } |
557 | ||
47ba8780 | 558 | |
fc04eb16 JH |
559 | /* threads->create() |
560 | * Called in context of parent thread. | |
5c6ff896 | 561 | * Called with MY_POOL.create_destruct_mutex locked. (Unlocked on error.) |
fc04eb16 | 562 | */ |
861d5cbe | 563 | STATIC ithread * |
fc04eb16 | 564 | S_ithread_create( |
9ca4d7fd | 565 | pTHX_ SV *init_function, |
514612b7 | 566 | IV stack_size, |
9d9ff5b1 | 567 | int gimme, |
69a9b4b8 | 568 | int exit_opt, |
fc04eb16 | 569 | SV *params) |
68795e93 | 570 | { |
fc04eb16 | 571 | ithread *thread; |
fc04eb16 | 572 | ithread *current_thread = S_ithread_get(aTHX); |
3b1c3273 | 573 | |
fc04eb16 JH |
574 | SV **tmps_tmp = PL_tmps_stack; |
575 | IV tmps_ix = PL_tmps_ix; | |
d94006e8 | 576 | #ifndef WIN32 |
fc04eb16 JH |
577 | int rc_stack_size = 0; |
578 | int rc_thread_create = 0; | |
d94006e8 | 579 | #endif |
adc09a0e | 580 | dMY_POOL; |
3b1c3273 | 581 | |
adc09a0e | 582 | /* Allocate thread structure in context of the main thread's interpreter */ |
5c6ff896 JH |
583 | { |
584 | PERL_SET_CONTEXT(MY_POOL.main_thread.interp); | |
585 | thread = (ithread *)PerlMemShared_malloc(sizeof(ithread)); | |
586 | } | |
587 | PERL_SET_CONTEXT(aTHX); | |
fc04eb16 | 588 | if (!thread) { |
5c6ff896 | 589 | MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); |
fc04eb16 JH |
590 | PerlLIO_write(PerlIO_fileno(Perl_error_log), PL_no_mem, strlen(PL_no_mem)); |
591 | my_exit(1); | |
592 | } | |
593 | Zero(thread, 1, ithread); | |
594 | ||
595 | /* Add to threads list */ | |
5c6ff896 JH |
596 | thread->next = &MY_POOL.main_thread; |
597 | thread->prev = MY_POOL.main_thread.prev; | |
598 | MY_POOL.main_thread.prev = thread; | |
fc04eb16 | 599 | thread->prev->next = thread; |
c05ae023 | 600 | |
fc04eb16 JH |
601 | /* Set count to 1 immediately in case thread exits before |
602 | * we return to caller! | |
603 | */ | |
604 | thread->count = 1; | |
605 | ||
9ca4d7fd | 606 | /* Block new thread until ->create() call finishes */ |
fc04eb16 | 607 | MUTEX_INIT(&thread->mutex); |
9ca4d7fd JH |
608 | MUTEX_LOCK(&thread->mutex); |
609 | ||
5c6ff896 | 610 | thread->tid = MY_POOL.tid_counter++; |
861d5cbe | 611 | thread->stack_size = S_good_stack_size(aTHX_ stack_size); |
9d9ff5b1 | 612 | thread->gimme = gimme; |
69a9b4b8 | 613 | thread->state = exit_opt; |
fc04eb16 JH |
614 | |
615 | /* "Clone" our interpreter into the thread's interpreter. | |
616 | * This gives thread access to "static data" and code. | |
617 | */ | |
618 | PerlIO_flush((PerlIO *)NULL); | |
619 | S_ithread_set(aTHX_ thread); | |
620 | ||
621 | SAVEBOOL(PL_srand_called); /* Save this so it becomes the correct value */ | |
622 | PL_srand_called = FALSE; /* Set it to false so we can detect if it gets | |
623 | set during the clone */ | |
3b1c3273 | 624 | |
47ba8780 | 625 | #ifdef WIN32 |
fc04eb16 | 626 | thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST); |
47ba8780 | 627 | #else |
fc04eb16 | 628 | thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE); |
47ba8780 | 629 | #endif |
47ba8780 | 630 | |
fc04eb16 JH |
631 | /* perl_clone() leaves us in new interpreter's context. As it is tricky |
632 | * to spot an implicit aTHX, create a new scope with aTHX matching the | |
633 | * context for the duration of our work for new interpreter. | |
634 | */ | |
635 | { | |
894eec8b JH |
636 | CLONE_PARAMS clone_param; |
637 | ||
fc04eb16 JH |
638 | dTHXa(thread->interp); |
639 | ||
640 | MY_CXT_CLONE; | |
641 | ||
642 | /* Here we remove END blocks since they should only run in the thread | |
643 | * they are created | |
644 | */ | |
645 | SvREFCNT_dec(PL_endav); | |
646 | PL_endav = newAV(); | |
404aaa48 | 647 | |
894eec8b | 648 | clone_param.flags = 0; |
f2e0bb91 JH |
649 | if (SvPOK(init_function)) { |
650 | thread->init_function = newSV(0); | |
651 | sv_copypv(thread->init_function, init_function); | |
652 | } else { | |
f2e0bb91 JH |
653 | thread->init_function = sv_dup(init_function, &clone_param); |
654 | if (SvREFCNT(thread->init_function) == 0) { | |
d4315dd6 | 655 | SvREFCNT_inc_void(thread->init_function); |
f2e0bb91 | 656 | } |
fc04eb16 JH |
657 | } |
658 | ||
659 | thread->params = sv_dup(params, &clone_param); | |
d4315dd6 | 660 | SvREFCNT_inc_void(thread->params); |
fc04eb16 JH |
661 | |
662 | /* The code below checks that anything living on the tmps stack and | |
663 | * has been cloned (so it lives in the ptr_table) has a refcount | |
664 | * higher than 0. | |
665 | * | |
666 | * If the refcount is 0 it means that a something on the stack/context | |
667 | * was holding a reference to it and since we init_stacks() in | |
668 | * perl_clone that won't get cleaned and we will get a leaked scalar. | |
669 | * The reason it was cloned was that it lived on the @_ stack. | |
670 | * | |
671 | * Example of this can be found in bugreport 15837 where calls in the | |
672 | * parameter list end up as a temp. | |
673 | * | |
674 | * One could argue that this fix should be in perl_clone. | |
675 | */ | |
676 | while (tmps_ix > 0) { | |
677 | SV* sv = (SV*)ptr_table_fetch(PL_ptr_table, tmps_tmp[tmps_ix]); | |
678 | tmps_ix--; | |
679 | if (sv && SvREFCNT(sv) == 0) { | |
d4315dd6 | 680 | SvREFCNT_inc_void(sv); |
fc04eb16 JH |
681 | SvREFCNT_dec(sv); |
682 | } | |
683 | } | |
684 | ||
685 | SvTEMP_off(thread->init_function); | |
686 | ptr_table_free(PL_ptr_table); | |
687 | PL_ptr_table = NULL; | |
688 | PL_exit_flags |= PERL_EXIT_DESTRUCT_END; | |
689 | } | |
690 | S_ithread_set(aTHX_ current_thread); | |
691 | PERL_SET_CONTEXT(aTHX); | |
692 | ||
693 | /* Create/start the thread */ | |
47ba8780 | 694 | #ifdef WIN32 |
fc04eb16 | 695 | thread->handle = CreateThread(NULL, |
514612b7 | 696 | (DWORD)thread->stack_size, |
fc04eb16 JH |
697 | S_ithread_run, |
698 | (LPVOID)thread, | |
514612b7 | 699 | STACK_SIZE_PARAM_IS_A_RESERVATION, |
fc04eb16 | 700 | &thread->thr); |
82c40bf6 | 701 | #else |
fc04eb16 | 702 | { |
861d5cbe JH |
703 | STATIC pthread_attr_t attr; |
704 | STATIC int attr_inited = 0; | |
705 | STATIC int attr_joinable = PTHREAD_CREATE_JOINABLE; | |
fc04eb16 JH |
706 | if (! attr_inited) { |
707 | pthread_attr_init(&attr); | |
708 | attr_inited = 1; | |
709 | } | |
710 | ||
fa26028c | 711 | # ifdef PTHREAD_ATTR_SETDETACHSTATE |
fc04eb16 JH |
712 | /* Threads start out joinable */ |
713 | PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable); | |
fa26028c | 714 | # endif |
fc04eb16 | 715 | |
514612b7 | 716 | # ifdef _POSIX_THREAD_ATTR_STACKSIZE |
fc04eb16 | 717 | /* Set thread's stack size */ |
514612b7 JH |
718 | if (thread->stack_size > 0) { |
719 | rc_stack_size = pthread_attr_setstacksize(&attr, (size_t)thread->stack_size); | |
720 | } | |
3eb37d38 AB |
721 | # endif |
722 | ||
fc04eb16 JH |
723 | /* Create the thread */ |
724 | if (! rc_stack_size) { | |
725 | # ifdef OLD_PTHREADS_API | |
726 | rc_thread_create = pthread_create(&thread->thr, | |
727 | attr, | |
728 | S_ithread_run, | |
729 | (void *)thread); | |
730 | # else | |
731 | # if defined(HAS_PTHREAD_ATTR_SETSCOPE) && defined(PTHREAD_SCOPE_SYSTEM) | |
732 | pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM); | |
733 | # endif | |
734 | rc_thread_create = pthread_create(&thread->thr, | |
735 | &attr, | |
736 | S_ithread_run, | |
737 | (void *)thread); | |
19a077f6 | 738 | # endif |
fc04eb16 | 739 | } |
514612b7 JH |
740 | |
741 | # ifdef _POSIX_THREAD_ATTR_STACKSIZE | |
742 | /* Try to get thread's actual stack size */ | |
743 | { | |
744 | size_t stacksize; | |
58a3a76c JH |
745 | #ifdef HPUX1020 |
746 | stacksize = pthread_attr_getstacksize(attr); | |
747 | #else | |
748 | if (! pthread_attr_getstacksize(&attr, &stacksize)) | |
749 | #endif | |
750 | if (stacksize > 0) { | |
514612b7 JH |
751 | thread->stack_size = (IV)stacksize; |
752 | } | |
514612b7 JH |
753 | } |
754 | # endif | |
fc04eb16 | 755 | } |
82c40bf6 | 756 | #endif |
bcd9ca9b | 757 | |
fc04eb16 | 758 | /* Check for errors */ |
d94006e8 | 759 | #ifdef WIN32 |
fc04eb16 | 760 | if (thread->handle == NULL) { |
d94006e8 | 761 | #else |
fc04eb16 | 762 | if (rc_stack_size || rc_thread_create) { |
d94006e8 | 763 | #endif |
9ca4d7fd | 764 | /* Must unlock mutex for destruct call */ |
5c6ff896 | 765 | MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); |
fc04eb16 | 766 | sv_2mortal(params); |
adc09a0e | 767 | thread->state |= PERL_ITHR_NONVIABLE; |
fc04eb16 | 768 | S_ithread_destruct(aTHX_ thread); |
d94006e8 | 769 | #ifndef WIN32 |
514612b7 | 770 | if (ckWARN_d(WARN_THREADS)) { |
fea7688c | 771 | if (rc_stack_size) { |
514612b7 | 772 | Perl_warn(aTHX_ "Thread creation failed: pthread_attr_setstacksize(%" IVdf ") returned %d", thread->stack_size, rc_stack_size); |
fea7688c | 773 | } else { |
514612b7 | 774 | Perl_warn(aTHX_ "Thread creation failed: pthread_create returned %d", rc_thread_create); |
fea7688c | 775 | } |
514612b7 | 776 | } |
d94006e8 | 777 | #endif |
9ca4d7fd | 778 | return (NULL); |
fc04eb16 JH |
779 | } |
780 | ||
5c6ff896 | 781 | MY_POOL.running_threads++; |
fc04eb16 | 782 | sv_2mortal(params); |
9ca4d7fd | 783 | return (thread); |
68795e93 | 784 | } |
47ba8780 | 785 | |
73e09c8f | 786 | #endif /* USE_ITHREADS */ |
e1c44605 | 787 | |
fcea4b7c | 788 | |
fc04eb16 | 789 | MODULE = threads PACKAGE = threads PREFIX = ithread_ |
68795e93 | 790 | PROTOTYPES: DISABLE |
8222d950 | 791 | |
73e09c8f JH |
792 | #ifdef USE_ITHREADS |
793 | ||
68795e93 | 794 | void |
f4cc38af JH |
795 | ithread_create(...) |
796 | PREINIT: | |
797 | char *classname; | |
514612b7 | 798 | ithread *thread; |
f4cc38af JH |
799 | SV *function_to_call; |
800 | AV *params; | |
514612b7 JH |
801 | HV *specs; |
802 | IV stack_size; | |
9d9ff5b1 | 803 | int context; |
69a9b4b8 RGS |
804 | int exit_opt; |
805 | SV *thread_exit_only; | |
9d9ff5b1 | 806 | char *str; |
514612b7 | 807 | int idx; |
f4cc38af | 808 | int ii; |
5c6ff896 | 809 | dMY_POOL; |
f4cc38af | 810 | CODE: |
514612b7 | 811 | if ((items >= 2) && SvROK(ST(1)) && SvTYPE(SvRV(ST(1)))==SVt_PVHV) { |
fea7688c | 812 | if (--items < 2) { |
514612b7 | 813 | Perl_croak(aTHX_ "Usage: threads->create(\\%specs, function, ...)"); |
fea7688c | 814 | } |
514612b7 JH |
815 | specs = (HV*)SvRV(ST(1)); |
816 | idx = 1; | |
817 | } else { | |
fea7688c | 818 | if (items < 2) { |
514612b7 | 819 | Perl_croak(aTHX_ "Usage: threads->create(function, ...)"); |
fea7688c | 820 | } |
514612b7 JH |
821 | specs = NULL; |
822 | idx = 0; | |
823 | } | |
f4cc38af | 824 | |
514612b7 JH |
825 | if (sv_isobject(ST(0))) { |
826 | /* $thr->create() */ | |
827 | classname = HvNAME(SvSTASH(SvRV(ST(0)))); | |
828 | thread = INT2PTR(ithread *, SvIV(SvRV(ST(0)))); | |
829 | stack_size = thread->stack_size; | |
69a9b4b8 | 830 | exit_opt = thread->state & PERL_ITHR_THREAD_EXIT_ONLY; |
514612b7 JH |
831 | } else { |
832 | /* threads->create() */ | |
833 | classname = (char *)SvPV_nolen(ST(0)); | |
5c6ff896 | 834 | stack_size = MY_POOL.default_stack_size; |
69a9b4b8 RGS |
835 | thread_exit_only = get_sv("threads::thread_exit_only", TRUE); |
836 | exit_opt = (SvTRUE(thread_exit_only)) | |
837 | ? PERL_ITHR_THREAD_EXIT_ONLY : 0; | |
514612b7 JH |
838 | } |
839 | ||
840 | function_to_call = ST(idx+1); | |
841 | ||
9d9ff5b1 | 842 | context = -1; |
514612b7 JH |
843 | if (specs) { |
844 | /* stack_size */ | |
845 | if (hv_exists(specs, "stack", 5)) { | |
846 | stack_size = SvIV(*hv_fetch(specs, "stack", 5, 0)); | |
847 | } else if (hv_exists(specs, "stacksize", 9)) { | |
848 | stack_size = SvIV(*hv_fetch(specs, "stacksize", 9, 0)); | |
849 | } else if (hv_exists(specs, "stack_size", 10)) { | |
850 | stack_size = SvIV(*hv_fetch(specs, "stack_size", 10, 0)); | |
851 | } | |
9d9ff5b1 JH |
852 | |
853 | /* context */ | |
854 | if (hv_exists(specs, "context", 7)) { | |
855 | str = (char *)SvPV_nolen(*hv_fetch(specs, "context", 7, 0)); | |
856 | switch (*str) { | |
857 | case 'a': | |
858 | case 'A': | |
859 | context = G_ARRAY; | |
860 | break; | |
861 | case 's': | |
862 | case 'S': | |
863 | context = G_SCALAR; | |
864 | break; | |
865 | case 'v': | |
866 | case 'V': | |
867 | context = G_VOID; | |
868 | break; | |
869 | default: | |
870 | Perl_croak(aTHX_ "Invalid context: %s", str); | |
871 | } | |
872 | } else if (hv_exists(specs, "array", 5)) { | |
873 | if (SvTRUE(*hv_fetch(specs, "array", 5, 0))) { | |
874 | context = G_ARRAY; | |
875 | } | |
876 | } else if (hv_exists(specs, "scalar", 6)) { | |
877 | if (SvTRUE(*hv_fetch(specs, "scalar", 6, 0))) { | |
878 | context = G_SCALAR; | |
879 | } | |
880 | } else if (hv_exists(specs, "void", 4)) { | |
881 | if (SvTRUE(*hv_fetch(specs, "void", 4, 0))) { | |
882 | context = G_VOID; | |
883 | } | |
884 | } | |
69a9b4b8 RGS |
885 | |
886 | /* exit => thread_only */ | |
887 | if (hv_exists(specs, "exit", 4)) { | |
888 | str = (char *)SvPV_nolen(*hv_fetch(specs, "exit", 4, 0)); | |
889 | exit_opt = (*str == 't' || *str == 'T') | |
890 | ? PERL_ITHR_THREAD_EXIT_ONLY : 0; | |
891 | } | |
9d9ff5b1 JH |
892 | } |
893 | if (context == -1) { | |
894 | context = GIMME_V; /* Implicit context */ | |
895 | } else { | |
896 | context |= (GIMME_V & (~(G_ARRAY|G_SCALAR|G_VOID))); | |
514612b7 | 897 | } |
f4cc38af JH |
898 | |
899 | /* Function args */ | |
900 | params = newAV(); | |
901 | if (items > 2) { | |
514612b7 JH |
902 | for (ii=2; ii < items ; ii++) { |
903 | av_push(params, SvREFCNT_inc(ST(idx+ii))); | |
f4cc38af JH |
904 | } |
905 | } | |
906 | ||
907 | /* Create thread */ | |
5c6ff896 | 908 | MUTEX_LOCK(&MY_POOL.create_destruct_mutex); |
9ca4d7fd JH |
909 | thread = S_ithread_create(aTHX_ function_to_call, |
910 | stack_size, | |
911 | context, | |
912 | exit_opt, | |
913 | newRV_noinc((SV*)params)); | |
914 | if (! thread) { | |
915 | XSRETURN_UNDEF; /* Mutex already unlocked */ | |
916 | } | |
861d5cbe | 917 | ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, FALSE)); |
adc09a0e | 918 | MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); |
9ca4d7fd JH |
919 | |
920 | /* Let thread run */ | |
921 | MUTEX_UNLOCK(&thread->mutex); | |
9ca4d7fd | 922 | |
f4cc38af JH |
923 | /* XSRETURN(1); - implied */ |
924 | ||
8222d950 | 925 | |
68795e93 | 926 | void |
f4cc38af JH |
927 | ithread_list(...) |
928 | PREINIT: | |
929 | char *classname; | |
fc04eb16 | 930 | ithread *thread; |
f4cc38af JH |
931 | int list_context; |
932 | IV count = 0; | |
11db694d | 933 | int want_running = 0; |
5c6ff896 | 934 | dMY_POOL; |
f4cc38af JH |
935 | PPCODE: |
936 | /* Class method only */ | |
fea7688c | 937 | if (SvROK(ST(0))) { |
ead32952 | 938 | Perl_croak(aTHX_ "Usage: threads->list(...)"); |
fea7688c | 939 | } |
f4cc38af JH |
940 | classname = (char *)SvPV_nolen(ST(0)); |
941 | ||
942 | /* Calling context */ | |
943 | list_context = (GIMME_V == G_ARRAY); | |
944 | ||
ead32952 JH |
945 | /* Running or joinable parameter */ |
946 | if (items > 1) { | |
947 | want_running = SvTRUE(ST(1)); | |
948 | } | |
949 | ||
f4cc38af | 950 | /* Walk through threads list */ |
5c6ff896 JH |
951 | MUTEX_LOCK(&MY_POOL.create_destruct_mutex); |
952 | for (thread = MY_POOL.main_thread.next; | |
953 | thread != &MY_POOL.main_thread; | |
fc04eb16 | 954 | thread = thread->next) |
f4cc38af JH |
955 | { |
956 | /* Ignore detached or joined threads */ | |
fc04eb16 | 957 | if (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)) { |
f4cc38af JH |
958 | continue; |
959 | } | |
ead32952 JH |
960 | |
961 | /* Filter per parameter */ | |
962 | if (items > 1) { | |
963 | if (want_running) { | |
964 | if (thread->state & PERL_ITHR_FINISHED) { | |
965 | continue; /* Not running */ | |
966 | } | |
967 | } else { | |
968 | if (! (thread->state & PERL_ITHR_FINISHED)) { | |
969 | continue; /* Still running - not joinable yet */ | |
970 | } | |
971 | } | |
972 | } | |
973 | ||
f4cc38af JH |
974 | /* Push object on stack if list context */ |
975 | if (list_context) { | |
861d5cbe | 976 | XPUSHs(sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE))); |
f4cc38af JH |
977 | } |
978 | count++; | |
979 | } | |
5c6ff896 | 980 | MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); |
f4cc38af JH |
981 | /* If scalar context, send back count */ |
982 | if (! list_context) { | |
983 | XSRETURN_IV(count); | |
984 | } | |
678a9b6c AB |
985 | |
986 | ||
987 | void | |
f4cc38af JH |
988 | ithread_self(...) |
989 | PREINIT: | |
990 | char *classname; | |
fcea4b7c | 991 | ithread *thread; |
f4cc38af JH |
992 | CODE: |
993 | /* Class method only */ | |
11db694d | 994 | if ((items != 1) || SvROK(ST(0))) { |
f4cc38af | 995 | Perl_croak(aTHX_ "Usage: threads->self()"); |
fea7688c | 996 | } |
f4cc38af JH |
997 | classname = (char *)SvPV_nolen(ST(0)); |
998 | ||
fcea4b7c JH |
999 | thread = S_ithread_get(aTHX); |
1000 | ||
861d5cbe | 1001 | ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE)); |
f4cc38af | 1002 | /* XSRETURN(1); - implied */ |
47ba8780 | 1003 | |
47ba8780 AB |
1004 | |
1005 | void | |
f4cc38af JH |
1006 | ithread_tid(...) |
1007 | PREINIT: | |
1008 | ithread *thread; | |
1009 | CODE: | |
11db694d | 1010 | PERL_UNUSED_VAR(items); |
861d5cbe | 1011 | thread = S_SV_to_ithread(aTHX_ ST(0)); |
f4cc38af JH |
1012 | XST_mUV(0, thread->tid); |
1013 | /* XSRETURN(1); - implied */ | |
1014 | ||
e1c44605 | 1015 | |
f9dff5f5 | 1016 | void |
f4cc38af JH |
1017 | ithread_join(...) |
1018 | PREINIT: | |
fcea4b7c JH |
1019 | ithread *thread; |
1020 | int join_err; | |
f4cc38af JH |
1021 | AV *params; |
1022 | int len; | |
1023 | int ii; | |
fcea4b7c JH |
1024 | #ifdef WIN32 |
1025 | DWORD waitcode; | |
1026 | #else | |
1027 | void *retval; | |
1028 | #endif | |
5c6ff896 | 1029 | dMY_POOL; |
f4cc38af JH |
1030 | PPCODE: |
1031 | /* Object method only */ | |
11db694d | 1032 | if ((items != 1) || ! sv_isobject(ST(0))) { |
f4cc38af | 1033 | Perl_croak(aTHX_ "Usage: $thr->join()"); |
fea7688c | 1034 | } |
f4cc38af | 1035 | |
fcea4b7c | 1036 | /* Check if the thread is joinable */ |
861d5cbe | 1037 | thread = S_SV_to_ithread(aTHX_ ST(0)); |
fcea4b7c | 1038 | join_err = (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)); |
fcea4b7c JH |
1039 | if (join_err) { |
1040 | if (join_err & PERL_ITHR_DETACHED) { | |
1041 | Perl_croak(aTHX_ "Cannot join a detached thread"); | |
1042 | } else { | |
1043 | Perl_croak(aTHX_ "Thread already joined"); | |
1044 | } | |
1045 | } | |
1046 | ||
1047 | /* Join the thread */ | |
1048 | #ifdef WIN32 | |
1049 | waitcode = WaitForSingleObject(thread->handle, INFINITE); | |
1050 | #else | |
1051 | pthread_join(thread->thr, &retval); | |
1052 | #endif | |
1053 | ||
1054 | MUTEX_LOCK(&thread->mutex); | |
1055 | /* Mark as joined */ | |
1056 | thread->state |= PERL_ITHR_JOINED; | |
1057 | ||
1058 | /* Get the return value from the call_sv */ | |
1059 | { | |
1060 | AV *params_copy; | |
1061 | PerlInterpreter *other_perl; | |
1062 | CLONE_PARAMS clone_params; | |
1063 | ithread *current_thread; | |
1064 | ||
1065 | params_copy = (AV *)SvRV(thread->params); | |
1066 | other_perl = thread->interp; | |
1067 | clone_params.stashes = newAV(); | |
1068 | clone_params.flags = CLONEf_JOIN_IN; | |
1069 | PL_ptr_table = ptr_table_new(); | |
1070 | current_thread = S_ithread_get(aTHX); | |
1071 | S_ithread_set(aTHX_ thread); | |
1072 | /* Ensure 'meaningful' addresses retain their meaning */ | |
1073 | ptr_table_store(PL_ptr_table, &other_perl->Isv_undef, &PL_sv_undef); | |
1074 | ptr_table_store(PL_ptr_table, &other_perl->Isv_no, &PL_sv_no); | |
1075 | ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes); | |
1076 | params = (AV *)sv_dup((SV*)params_copy, &clone_params); | |
1077 | S_ithread_set(aTHX_ current_thread); | |
1078 | SvREFCNT_dec(clone_params.stashes); | |
d4315dd6 | 1079 | SvREFCNT_inc_void(params); |
fcea4b7c JH |
1080 | ptr_table_free(PL_ptr_table); |
1081 | PL_ptr_table = NULL; | |
1082 | } | |
1083 | ||
1084 | /* We are finished with the thread */ | |
1085 | S_ithread_clear(aTHX_ thread); | |
1086 | MUTEX_UNLOCK(&thread->mutex); | |
1087 | ||
5c6ff896 | 1088 | MUTEX_LOCK(&MY_POOL.create_destruct_mutex); |
9ca4d7fd | 1089 | if (! (thread->state & PERL_ITHR_DETACHED)) { |
5c6ff896 | 1090 | MY_POOL.joinable_threads--; |
9ca4d7fd | 1091 | } |
5c6ff896 | 1092 | MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); |
4dcb9e53 | 1093 | |
fcea4b7c | 1094 | /* If no return values, then just return */ |
f4cc38af JH |
1095 | if (! params) { |
1096 | XSRETURN_UNDEF; | |
1097 | } | |
1098 | ||
1099 | /* Put return values on stack */ | |
1100 | len = (int)AvFILL(params); | |
1101 | for (ii=0; ii <= len; ii++) { | |
1102 | SV* param = av_shift(params); | |
1103 | XPUSHs(sv_2mortal(param)); | |
1104 | } | |
1105 | ||
1106 | /* Free return value array */ | |
1107 | SvREFCNT_dec(params); | |
1108 | ||
1109 | ||
1110 | void | |
1111 | ithread_yield(...) | |
1112 | CODE: | |
11db694d | 1113 | PERL_UNUSED_VAR(items); |
f4cc38af JH |
1114 | YIELD; |
1115 | ||
1116 | ||
1117 | void | |
1118 | ithread_detach(...) | |
1119 | PREINIT: | |
1120 | ithread *thread; | |
fcea4b7c | 1121 | int detach_err; |
5c6ff896 | 1122 | dMY_POOL; |
f4cc38af | 1123 | CODE: |
11db694d JH |
1124 | PERL_UNUSED_VAR(items); |
1125 | ||
fcea4b7c | 1126 | /* Check if the thread is detachable */ |
861d5cbe | 1127 | thread = S_SV_to_ithread(aTHX_ ST(0)); |
fcea4b7c | 1128 | if ((detach_err = (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)))) { |
fcea4b7c JH |
1129 | if (detach_err & PERL_ITHR_DETACHED) { |
1130 | Perl_croak(aTHX_ "Thread already detached"); | |
1131 | } else { | |
1132 | Perl_croak(aTHX_ "Cannot detach a joined thread"); | |
1133 | } | |
1134 | } | |
1135 | ||
1136 | /* Detach the thread */ | |
5c6ff896 | 1137 | MUTEX_LOCK(&MY_POOL.create_destruct_mutex); |
9ca4d7fd | 1138 | MUTEX_LOCK(&thread->mutex); |
fcea4b7c JH |
1139 | thread->state |= PERL_ITHR_DETACHED; |
1140 | #ifdef WIN32 | |
1141 | /* Windows has no 'detach thread' function */ | |
1142 | #else | |
1143 | PERL_THREAD_DETACH(thread->thr); | |
1144 | #endif | |
fcea4b7c | 1145 | |
adc09a0e | 1146 | if (thread->state & PERL_ITHR_FINISHED) { |
5c6ff896 | 1147 | MY_POOL.joinable_threads--; |
4dcb9e53 | 1148 | } else { |
5c6ff896 JH |
1149 | MY_POOL.running_threads--; |
1150 | MY_POOL.detached_threads++; | |
4dcb9e53 | 1151 | } |
adc09a0e | 1152 | MUTEX_UNLOCK(&thread->mutex); |
5c6ff896 | 1153 | MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); |
4dcb9e53 | 1154 | |
adc09a0e JH |
1155 | /* Try to cleanup thread */ |
1156 | S_ithread_destruct(aTHX_ thread); | |
f4cc38af | 1157 | |
47ba8780 AB |
1158 | |
1159 | void | |
c0003851 JH |
1160 | ithread_kill(...) |
1161 | PREINIT: | |
1162 | ithread *thread; | |
1163 | char *sig_name; | |
1164 | IV signal; | |
1165 | CODE: | |
1166 | /* Must have safe signals */ | |
fea7688c | 1167 | if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG) { |
4dcb9e53 | 1168 | Perl_croak(aTHX_ "Cannot signal threads without safe signals"); |
fea7688c | 1169 | } |
c0003851 JH |
1170 | |
1171 | /* Object method only */ | |
11db694d | 1172 | if ((items != 2) || ! sv_isobject(ST(0))) { |
c0003851 | 1173 | Perl_croak(aTHX_ "Usage: $thr->kill('SIG...')"); |
fea7688c | 1174 | } |
c0003851 | 1175 | |
c0003851 JH |
1176 | /* Get signal */ |
1177 | sig_name = SvPV_nolen(ST(1)); | |
1178 | if (isALPHA(*sig_name)) { | |
fea7688c | 1179 | if (*sig_name == 'S' && sig_name[1] == 'I' && sig_name[2] == 'G') { |
c0003851 | 1180 | sig_name += 3; |
fea7688c JH |
1181 | } |
1182 | if ((signal = whichsig(sig_name)) < 0) { | |
c0003851 | 1183 | Perl_croak(aTHX_ "Unrecognized signal name: %s", sig_name); |
fea7688c JH |
1184 | } |
1185 | } else { | |
c0003851 | 1186 | signal = SvIV(ST(1)); |
fea7688c | 1187 | } |
c0003851 JH |
1188 | |
1189 | /* Set the signal for the thread */ | |
861d5cbe | 1190 | thread = S_SV_to_ithread(aTHX_ ST(0)); |
4dcb9e53 | 1191 | MUTEX_LOCK(&thread->mutex); |
3ceb02cd | 1192 | if (thread->interp) { |
c0003851 JH |
1193 | dTHXa(thread->interp); |
1194 | PL_psig_pend[signal]++; | |
1195 | PL_sig_pending = 1; | |
1196 | } | |
4dcb9e53 | 1197 | MUTEX_UNLOCK(&thread->mutex); |
c0003851 JH |
1198 | |
1199 | /* Return the thread to allow for method chaining */ | |
1200 | ST(0) = ST(0); | |
1201 | /* XSRETURN(1); - implied */ | |
1202 | ||
1203 | ||
1204 | void | |
f4cc38af JH |
1205 | ithread_DESTROY(...) |
1206 | CODE: | |
11db694d | 1207 | PERL_UNUSED_VAR(items); |
fcea4b7c | 1208 | sv_unmagic(SvRV(ST(0)), PERL_MAGIC_shared_scalar); |
f4cc38af JH |
1209 | |
1210 | ||
1211 | void | |
1212 | ithread_equal(...) | |
fc04eb16 JH |
1213 | PREINIT: |
1214 | int are_equal = 0; | |
f4cc38af | 1215 | CODE: |
11db694d JH |
1216 | PERL_UNUSED_VAR(items); |
1217 | ||
fc04eb16 | 1218 | /* Compares TIDs to determine thread equality */ |
f4cc38af JH |
1219 | if (sv_isobject(ST(0)) && sv_isobject(ST(1))) { |
1220 | ithread *thr1 = INT2PTR(ithread *, SvIV(SvRV(ST(0)))); | |
1221 | ithread *thr2 = INT2PTR(ithread *, SvIV(SvRV(ST(1)))); | |
fc04eb16 JH |
1222 | are_equal = (thr1->tid == thr2->tid); |
1223 | } | |
1224 | if (are_equal) { | |
1225 | XST_mYES(0); | |
f4cc38af | 1226 | } else { |
fc04eb16 | 1227 | /* Return 0 on false for backward compatibility */ |
f4cc38af JH |
1228 | XST_mIV(0, 0); |
1229 | } | |
1230 | /* XSRETURN(1); - implied */ | |
1231 | ||
47ba8780 | 1232 | |
47ba8780 | 1233 | void |
f4cc38af JH |
1234 | ithread_object(...) |
1235 | PREINIT: | |
1236 | char *classname; | |
1237 | UV tid; | |
fc04eb16 | 1238 | ithread *thread; |
9ca4d7fd | 1239 | int have_obj = 0; |
5c6ff896 | 1240 | dMY_POOL; |
f4cc38af JH |
1241 | CODE: |
1242 | /* Class method only */ | |
fea7688c | 1243 | if (SvROK(ST(0))) { |
f4cc38af | 1244 | Perl_croak(aTHX_ "Usage: threads->object($tid)"); |
fea7688c | 1245 | } |
f4cc38af JH |
1246 | classname = (char *)SvPV_nolen(ST(0)); |
1247 | ||
1248 | if ((items < 2) || ! SvOK(ST(1))) { | |
1249 | XSRETURN_UNDEF; | |
1250 | } | |
1251 | ||
fc04eb16 | 1252 | /* threads->object($tid) */ |
f4cc38af JH |
1253 | tid = SvUV(ST(1)); |
1254 | ||
1255 | /* Walk through threads list */ | |
5c6ff896 JH |
1256 | MUTEX_LOCK(&MY_POOL.create_destruct_mutex); |
1257 | for (thread = MY_POOL.main_thread.next; | |
1258 | thread != &MY_POOL.main_thread; | |
fc04eb16 | 1259 | thread = thread->next) |
f4cc38af | 1260 | { |
9ca4d7fd JH |
1261 | /* Look for TID */ |
1262 | if (thread->tid == tid) { | |
1263 | /* Ignore if detached or joined */ | |
1264 | if (! (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) { | |
1265 | /* Put object on stack */ | |
861d5cbe | 1266 | ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE)); |
9ca4d7fd JH |
1267 | have_obj = 1; |
1268 | } | |
1269 | break; | |
f4cc38af | 1270 | } |
f4cc38af | 1271 | } |
5c6ff896 | 1272 | MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); |
9ca4d7fd JH |
1273 | |
1274 | if (! have_obj) { | |
f4cc38af JH |
1275 | XSRETURN_UNDEF; |
1276 | } | |
1277 | /* XSRETURN(1); - implied */ | |
1278 | ||
1279 | ||
1280 | void | |
1281 | ithread__handle(...); | |
1282 | PREINIT: | |
1283 | ithread *thread; | |
1284 | CODE: | |
11db694d | 1285 | PERL_UNUSED_VAR(items); |
861d5cbe | 1286 | thread = S_SV_to_ithread(aTHX_ ST(0)); |
f4cc38af | 1287 | #ifdef WIN32 |
fcea4b7c | 1288 | XST_mUV(0, PTR2UV(&thread->handle)); |
f4cc38af | 1289 | #else |
75ba4ae2 | 1290 | XST_mUV(0, PTR2UV(&thread->thr)); |
f4cc38af JH |
1291 | #endif |
1292 | /* XSRETURN(1); - implied */ | |
68795e93 | 1293 | |
514612b7 JH |
1294 | |
1295 | void | |
1296 | ithread_get_stack_size(...) | |
1297 | PREINIT: | |
1298 | IV stack_size; | |
5c6ff896 | 1299 | dMY_POOL; |
514612b7 | 1300 | CODE: |
11db694d | 1301 | PERL_UNUSED_VAR(items); |
514612b7 JH |
1302 | if (sv_isobject(ST(0))) { |
1303 | /* $thr->get_stack_size() */ | |
1304 | ithread *thread = INT2PTR(ithread *, SvIV(SvRV(ST(0)))); | |
1305 | stack_size = thread->stack_size; | |
1306 | } else { | |
1307 | /* threads->get_stack_size() */ | |
5c6ff896 | 1308 | stack_size = MY_POOL.default_stack_size; |
514612b7 JH |
1309 | } |
1310 | XST_mIV(0, stack_size); | |
1311 | /* XSRETURN(1); - implied */ | |
1312 | ||
1313 | ||
1314 | void | |
1315 | ithread_set_stack_size(...) | |
1316 | PREINIT: | |
1317 | IV old_size; | |
5c6ff896 | 1318 | dMY_POOL; |
514612b7 | 1319 | CODE: |
fea7688c | 1320 | if (items != 2) { |
514612b7 | 1321 | Perl_croak(aTHX_ "Usage: threads->set_stack_size($size)"); |
fea7688c JH |
1322 | } |
1323 | if (sv_isobject(ST(0))) { | |
514612b7 | 1324 | Perl_croak(aTHX_ "Cannot change stack size of an existing thread"); |
fea7688c | 1325 | } |
514612b7 | 1326 | |
5c6ff896 JH |
1327 | old_size = MY_POOL.default_stack_size; |
1328 | MY_POOL.default_stack_size = S_good_stack_size(aTHX_ SvIV(ST(1))); | |
514612b7 JH |
1329 | XST_mIV(0, old_size); |
1330 | /* XSRETURN(1); - implied */ | |
1331 | ||
ead32952 JH |
1332 | |
1333 | void | |
1334 | ithread_is_running(...) | |
1335 | PREINIT: | |
1336 | ithread *thread; | |
1337 | CODE: | |
1338 | /* Object method only */ | |
11db694d | 1339 | if ((items != 1) || ! sv_isobject(ST(0))) { |
ead32952 | 1340 | Perl_croak(aTHX_ "Usage: $thr->is_running()"); |
fea7688c | 1341 | } |
ead32952 JH |
1342 | |
1343 | thread = INT2PTR(ithread *, SvIV(SvRV(ST(0)))); | |
ead32952 | 1344 | ST(0) = (thread->state & PERL_ITHR_FINISHED) ? &PL_sv_no : &PL_sv_yes; |
ead32952 JH |
1345 | /* XSRETURN(1); - implied */ |
1346 | ||
1347 | ||
1348 | void | |
1349 | ithread_is_detached(...) | |
1350 | PREINIT: | |
1351 | ithread *thread; | |
1352 | CODE: | |
11db694d | 1353 | PERL_UNUSED_VAR(items); |
861d5cbe | 1354 | thread = S_SV_to_ithread(aTHX_ ST(0)); |
ead32952 | 1355 | ST(0) = (thread->state & PERL_ITHR_DETACHED) ? &PL_sv_yes : &PL_sv_no; |
ead32952 JH |
1356 | /* XSRETURN(1); - implied */ |
1357 | ||
1358 | ||
1359 | void | |
1360 | ithread_is_joinable(...) | |
1361 | PREINIT: | |
1362 | ithread *thread; | |
1363 | CODE: | |
1364 | /* Object method only */ | |
11db694d | 1365 | if ((items != 1) || ! sv_isobject(ST(0))) { |
ead32952 | 1366 | Perl_croak(aTHX_ "Usage: $thr->is_joinable()"); |
fea7688c | 1367 | } |
ead32952 JH |
1368 | |
1369 | thread = INT2PTR(ithread *, SvIV(SvRV(ST(0)))); | |
1370 | MUTEX_LOCK(&thread->mutex); | |
1371 | ST(0) = ((thread->state & PERL_ITHR_FINISHED) && | |
1372 | ! (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) | |
1373 | ? &PL_sv_yes : &PL_sv_no; | |
1374 | MUTEX_UNLOCK(&thread->mutex); | |
1375 | /* XSRETURN(1); - implied */ | |
1376 | ||
1377 | ||
1378 | void | |
1379 | ithread_wantarray(...) | |
1380 | PREINIT: | |
1381 | ithread *thread; | |
1382 | CODE: | |
11db694d | 1383 | PERL_UNUSED_VAR(items); |
861d5cbe | 1384 | thread = S_SV_to_ithread(aTHX_ ST(0)); |
ead32952 JH |
1385 | ST(0) = (thread->gimme & G_ARRAY) ? &PL_sv_yes : |
1386 | (thread->gimme & G_VOID) ? &PL_sv_undef | |
1387 | /* G_SCALAR */ : &PL_sv_no; | |
ead32952 JH |
1388 | /* XSRETURN(1); - implied */ |
1389 | ||
69a9b4b8 RGS |
1390 | |
1391 | void | |
1392 | ithread_set_thread_exit_only(...) | |
1393 | PREINIT: | |
1394 | ithread *thread; | |
1395 | CODE: | |
fea7688c | 1396 | if (items != 2) { |
69a9b4b8 | 1397 | Perl_croak(aTHX_ "Usage: ->set_thread_exit_only(boolean)"); |
fea7688c | 1398 | } |
861d5cbe | 1399 | thread = S_SV_to_ithread(aTHX_ ST(0)); |
69a9b4b8 RGS |
1400 | MUTEX_LOCK(&thread->mutex); |
1401 | if (SvTRUE(ST(1))) { | |
1402 | thread->state |= PERL_ITHR_THREAD_EXIT_ONLY; | |
1403 | } else { | |
1404 | thread->state &= ~PERL_ITHR_THREAD_EXIT_ONLY; | |
1405 | } | |
1406 | MUTEX_UNLOCK(&thread->mutex); | |
1407 | ||
73e09c8f JH |
1408 | #endif /* USE_ITHREADS */ |
1409 | ||
fc04eb16 | 1410 | |
68795e93 NIS |
1411 | BOOT: |
1412 | { | |
73e09c8f | 1413 | #ifdef USE_ITHREADS |
5c6ff896 JH |
1414 | SV *my_pool_sv = *hv_fetch(PL_modglobal, MY_POOL_KEY, |
1415 | sizeof(MY_POOL_KEY)-1, TRUE); | |
1416 | my_pool_t *my_poolp = (my_pool_t*)SvPVX(newSV(sizeof(my_pool_t)-1)); | |
1417 | ||
fc04eb16 JH |
1418 | MY_CXT_INIT; |
1419 | ||
5c6ff896 JH |
1420 | Zero(my_poolp, 1, my_pool_t); |
1421 | sv_setuv(my_pool_sv, PTR2UV(my_poolp)); | |
1422 | ||
fc04eb16 | 1423 | PL_perl_destruct_level = 2; |
5c6ff896 JH |
1424 | MUTEX_INIT(&MY_POOL.create_destruct_mutex); |
1425 | MUTEX_LOCK(&MY_POOL.create_destruct_mutex); | |
fc04eb16 JH |
1426 | |
1427 | PL_threadhook = &Perl_ithread_hook; | |
1428 | ||
5c6ff896 JH |
1429 | MY_POOL.tid_counter = 1; |
1430 | # ifdef THREAD_CREATE_NEEDS_STACK | |
1431 | MY_POOL.default_stack_size = THREAD_CREATE_NEEDS_STACK; | |
1432 | # endif | |
1433 | ||
c372d929 JH |
1434 | /* The 'main' thread is thread 0. |
1435 | * It is detached (unjoinable) and immortal. | |
1436 | */ | |
fc04eb16 | 1437 | |
5c6ff896 | 1438 | MUTEX_INIT(&MY_POOL.main_thread.mutex); |
fc04eb16 JH |
1439 | |
1440 | /* Head of the threads list */ | |
5c6ff896 JH |
1441 | MY_POOL.main_thread.next = &MY_POOL.main_thread; |
1442 | MY_POOL.main_thread.prev = &MY_POOL.main_thread; | |
fc04eb16 | 1443 | |
5c6ff896 | 1444 | MY_POOL.main_thread.count = 1; /* Immortal */ |
fc04eb16 | 1445 | |
5c6ff896 JH |
1446 | MY_POOL.main_thread.interp = aTHX; |
1447 | MY_POOL.main_thread.state = PERL_ITHR_DETACHED; /* Detached */ | |
1448 | MY_POOL.main_thread.stack_size = MY_POOL.default_stack_size; | |
fc04eb16 | 1449 | # ifdef WIN32 |
5c6ff896 | 1450 | MY_POOL.main_thread.thr = GetCurrentThreadId(); |
fc04eb16 | 1451 | # else |
5c6ff896 | 1452 | MY_POOL.main_thread.thr = pthread_self(); |
fc04eb16 JH |
1453 | # endif |
1454 | ||
5c6ff896 JH |
1455 | S_ithread_set(aTHX_ &MY_POOL.main_thread); |
1456 | MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); | |
73e09c8f | 1457 | #endif /* USE_ITHREADS */ |
68795e93 | 1458 | } |