Commit | Line | Data |
---|---|---|
47ba8780 AB |
1 | #include "threads.h" |
2 | ||
47ba8780 | 3 | /* |
b1edfb69 JH |
4 | * Starts executing the thread. Needs to clean up memory a tad better. |
5 | */ | |
47ba8780 AB |
6 | |
7 | #ifdef WIN32 | |
e6e315b9 | 8 | THREAD_RET_TYPE Perl_thread_run(LPVOID arg) { |
47ba8780 | 9 | #else |
e8f2bb9a | 10 | void* Perl_thread_run(void * arg) { |
47ba8780 | 11 | #endif |
5b414d21 | 12 | ithread* thread = (ithread*) arg; |
47ba8780 AB |
13 | SV* thread_tid_ptr; |
14 | SV* thread_ptr; | |
15 | dTHXa(thread->interp); | |
47ba8780 AB |
16 | PERL_SET_CONTEXT(thread->interp); |
17 | ||
18 | #ifdef WIN32 | |
19 | thread->thr = GetCurrentThreadId(); | |
20 | #else | |
21 | thread->thr = pthread_self(); | |
22 | #endif | |
23 | ||
4f896ddc | 24 | SHAREDSvLOCK(threads); |
47ba8780 | 25 | SHAREDSvEDIT(threads); |
82c40bf6 | 26 | PERL_THREAD_ALLOC_SPECIFIC(self_key); |
7f9a95ef AB |
27 | PERL_THREAD_SETSPECIFIC(self_key,INT2PTR(void*,thread->tid)); |
28 | thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, thread->tid); | |
b1edfb69 | 29 | thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread)); |
47ba8780 AB |
30 | hv_store_ent((HV*)SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0); |
31 | SvREFCNT_dec(thread_tid_ptr); | |
32 | SHAREDSvRELEASE(threads); | |
4f896ddc | 33 | SHAREDSvUNLOCK(threads); |
47ba8780 | 34 | PL_perl_destruct_level = 2; |
4f896ddc | 35 | |
47ba8780 AB |
36 | { |
37 | ||
38 | AV* params; | |
39 | I32 len; | |
40 | int i; | |
41 | dSP; | |
42 | params = (AV*) SvRV(thread->params); | |
43 | len = av_len(params); | |
44 | ENTER; | |
45 | SAVETMPS; | |
46 | PUSHMARK(SP); | |
47 | if(len > -1) { | |
48 | for(i = 0; i < len + 1; i++) { | |
49 | XPUSHs(av_shift(params)); | |
50 | } | |
51 | } | |
52 | PUTBACK; | |
4f896ddc | 53 | call_sv(thread->init_function, G_DISCARD); |
47ba8780 AB |
54 | FREETMPS; |
55 | LEAVE; | |
56 | ||
57 | ||
58 | } | |
59 | ||
47ba8780 | 60 | MUTEX_LOCK(&thread->mutex); |
fd58862f | 61 | PerlIO_flush((PerlIO*)NULL); |
47ba8780 AB |
62 | perl_destruct(thread->interp); |
63 | perl_free(thread->interp); | |
64 | if(thread->detached == 1) { | |
65 | MUTEX_UNLOCK(&thread->mutex); | |
e6e315b9 | 66 | Perl_thread_destruct(thread); |
47ba8780 AB |
67 | } else { |
68 | MUTEX_UNLOCK(&thread->mutex); | |
69 | } | |
70 | #ifdef WIN32 | |
71 | return (DWORD)0; | |
e8f2bb9a JH |
72 | #else |
73 | return 0; | |
47ba8780 AB |
74 | #endif |
75 | ||
76 | } | |
77 | ||
47ba8780 | 78 | /* |
b1edfb69 JH |
79 | * iThread->create(); |
80 | */ | |
47ba8780 | 81 | |
e6e315b9 | 82 | SV* Perl_thread_create(char* class, SV* init_function, SV* params) { |
47ba8780 AB |
83 | ithread* thread = malloc(sizeof(ithread)); |
84 | SV* obj_ref; | |
85 | SV* obj; | |
86 | SV* temp_store; | |
47ba8780 AB |
87 | PerlInterpreter *current_perl; |
88 | ||
89 | MUTEX_LOCK(&create_mutex); | |
90 | obj_ref = newSViv(0); | |
91 | obj = newSVrv(obj_ref, class); | |
b1edfb69 JH |
92 | sv_setiv(obj, (IV)thread); |
93 | SvREADONLY_on(obj); | |
47ba8780 | 94 | |
b1edfb69 | 95 | current_perl = PERL_GET_CONTEXT; |
47ba8780 AB |
96 | |
97 | /* | |
b1edfb69 JH |
98 | * here we put the values of params and function to call onto |
99 | * namespace, this is so perl will properly clone them when we | |
100 | * call perl_clone. | |
101 | */ | |
4f896ddc | 102 | |
b1edfb69 JH |
103 | temp_store = Perl_get_sv(current_perl, "threads::paramtempstore", |
104 | TRUE | GV_ADDMULTI); | |
485caab9 | 105 | Perl_sv_setsv_flags(current_perl, temp_store,params, SV_GMAGIC); |
47ba8780 AB |
106 | params = NULL; |
107 | temp_store = NULL; | |
108 | ||
b1edfb69 JH |
109 | temp_store = Perl_get_sv(current_perl, "threads::calltempstore", |
110 | TRUE | GV_ADDMULTI); | |
485caab9 | 111 | Perl_sv_setsv_flags(current_perl,temp_store, init_function, SV_GMAGIC); |
4f896ddc AB |
112 | init_function = NULL; |
113 | temp_store = NULL; | |
47ba8780 AB |
114 | |
115 | #ifdef WIN32 | |
b1edfb69 | 116 | thread->interp = perl_clone(current_perl, 4); |
47ba8780 | 117 | #else |
b1edfb69 | 118 | thread->interp = perl_clone(current_perl, 0); |
47ba8780 | 119 | #endif |
47ba8780 | 120 | |
b1edfb69 JH |
121 | thread->init_function = newSVsv(Perl_get_sv(thread->interp, |
122 | "threads::calltempstore",FALSE)); | |
123 | thread->params = newSVsv(Perl_get_sv(thread->interp, | |
124 | "threads::paramtempstore",FALSE)); | |
47ba8780 AB |
125 | |
126 | /* | |
b1edfb69 JH |
127 | * And here we make sure we clean up the data we put in the |
128 | * namespace of iThread, both in the new and the calling | |
129 | * inteprreter */ | |
47ba8780 | 130 | |
b1edfb69 | 131 | temp_store = Perl_get_sv(thread->interp, "threads::paramtempstore",FALSE); |
485caab9 | 132 | Perl_sv_setsv_flags(thread->interp,temp_store, &PL_sv_undef, SV_GMAGIC); |
47ba8780 AB |
133 | |
134 | temp_store = Perl_get_sv(thread->interp,"threads::calltempstore",FALSE); | |
485caab9 | 135 | Perl_sv_setsv_flags(thread->interp,temp_store, &PL_sv_undef, SV_GMAGIC); |
47ba8780 AB |
136 | |
137 | PERL_SET_CONTEXT(current_perl); | |
138 | ||
139 | temp_store = Perl_get_sv(current_perl,"threads::paramtempstore",FALSE); | |
485caab9 | 140 | Perl_sv_setsv_flags(current_perl, temp_store, &PL_sv_undef, SV_GMAGIC); |
47ba8780 AB |
141 | |
142 | temp_store = Perl_get_sv(current_perl,"threads::calltempstore",FALSE); | |
485caab9 | 143 | Perl_sv_setsv_flags(current_perl, temp_store, &PL_sv_undef, SV_GMAGIC); |
47ba8780 | 144 | |
b1edfb69 | 145 | /* let's init the thread */ |
47ba8780 AB |
146 | |
147 | MUTEX_INIT(&thread->mutex); | |
148 | thread->tid = tid_counter++; | |
149 | thread->detached = 0; | |
150 | thread->count = 1; | |
151 | ||
152 | #ifdef WIN32 | |
153 | ||
e6e315b9 | 154 | thread->handle = CreateThread(NULL, 0, Perl_thread_run, |
47ba8780 AB |
155 | (LPVOID)thread, 0, &thread->thr); |
156 | ||
82c40bf6 AB |
157 | |
158 | #else | |
fa26028c AB |
159 | { |
160 | static pthread_attr_t attr; | |
161 | static int attr_inited = 0; | |
162 | sigset_t fullmask, oldmask; | |
163 | static int attr_joinable = PTHREAD_CREATE_JOINABLE; | |
164 | if (!attr_inited) { | |
165 | attr_inited = 1; | |
166 | pthread_attr_init(&attr); | |
167 | } | |
168 | # ifdef PTHREAD_ATTR_SETDETACHSTATE | |
169 | PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable); | |
170 | # endif | |
3eb37d38 AB |
171 | # ifdef THREAD_CREATE_NEEDS_STACK |
172 | if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK)) | |
173 | croak("panic: pthread_attr_setstacksize failed"); | |
174 | # endif | |
175 | ||
3ad0b7d6 | 176 | #ifdef OLD_PTHREADS_API |
fa26028c | 177 | pthread_create( &thread->thr, attr, Perl_thread_run, (void *)thread); |
47ba8780 | 178 | #else |
3ad0b7d6 | 179 | pthread_create( &thread->thr, &attr, Perl_thread_run, (void *)thread); |
47ba8780 | 180 | #endif |
3ad0b7d6 | 181 | } |
82c40bf6 | 182 | #endif |
47ba8780 AB |
183 | MUTEX_UNLOCK(&create_mutex); |
184 | ||
b1edfb69 | 185 | return obj_ref; |
47ba8780 AB |
186 | } |
187 | ||
188 | /* | |
b1edfb69 JH |
189 | * returns the id of the thread |
190 | */ | |
e6e315b9 | 191 | I32 Perl_thread_tid (SV* obj) { |
47ba8780 AB |
192 | ithread* thread; |
193 | if(!SvROK(obj)) { | |
e6e315b9 | 194 | obj = Perl_thread_self(SvPV_nolen(obj)); |
47ba8780 AB |
195 | thread = (ithread*)SvIV(SvRV(obj)); |
196 | SvREFCNT_dec(obj); | |
197 | } else { | |
198 | thread = (ithread*)SvIV(SvRV(obj)); | |
199 | } | |
200 | return thread->tid; | |
201 | } | |
202 | ||
e6e315b9 | 203 | SV* Perl_thread_self (char* class) { |
47ba8780 AB |
204 | dTHX; |
205 | SV* obj_ref; | |
206 | SV* obj; | |
b1edfb69 JH |
207 | SV* thread_tid_ptr; |
208 | SV* thread_ptr; | |
209 | HE* thread_entry; | |
7f9a95ef AB |
210 | void* id; |
211 | PERL_THREAD_GETSPECIFIC(self_key,id); | |
4f896ddc | 212 | SHAREDSvLOCK(threads); |
47ba8780 | 213 | SHAREDSvEDIT(threads); |
7f9a95ef AB |
214 | |
215 | thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(id)); | |
82c40bf6 | 216 | |
b1edfb69 JH |
217 | thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space, |
218 | (HV*) SHAREDSvGET(threads), | |
219 | thread_tid_ptr, 0,0); | |
47ba8780 AB |
220 | thread_ptr = HeVAL(thread_entry); |
221 | SvREFCNT_dec(thread_tid_ptr); | |
47ba8780 | 222 | SHAREDSvRELEASE(threads); |
4f896ddc | 223 | SHAREDSvUNLOCK(threads); |
47ba8780 AB |
224 | |
225 | obj_ref = newSViv(0); | |
226 | obj = newSVrv(obj_ref, class); | |
4f896ddc | 227 | sv_setsv(obj, thread_ptr); |
47ba8780 AB |
228 | SvREADONLY_on(obj); |
229 | return obj_ref; | |
230 | } | |
231 | ||
232 | /* | |
b1edfb69 JH |
233 | * joins the thread this code needs to take the returnvalue from the |
234 | * call_sv and send it back */ | |
47ba8780 | 235 | |
e6e315b9 | 236 | void Perl_thread_join(SV* obj) { |
47ba8780 AB |
237 | ithread* thread = (ithread*)SvIV(SvRV(obj)); |
238 | #ifdef WIN32 | |
239 | DWORD waitcode; | |
240 | waitcode = WaitForSingleObject(thread->handle, INFINITE); | |
241 | #else | |
242 | void *retval; | |
243 | pthread_join(thread->thr,&retval); | |
244 | #endif | |
245 | } | |
246 | ||
b1edfb69 JH |
247 | /* detaches a thread |
248 | * needs to better clean up memory */ | |
47ba8780 | 249 | |
e6e315b9 | 250 | void Perl_thread_detach(SV* obj) { |
47ba8780 AB |
251 | ithread* thread = (ithread*)SvIV(SvRV(obj)); |
252 | MUTEX_LOCK(&thread->mutex); | |
253 | thread->detached = 1; | |
82c40bf6 | 254 | PERL_THREAD_DETACH(thread->thr); |
47ba8780 AB |
255 | MUTEX_UNLOCK(&thread->mutex); |
256 | } | |
257 | ||
e6e315b9 | 258 | void Perl_thread_DESTROY (SV* obj) { |
47ba8780 AB |
259 | ithread* thread = (ithread*)SvIV(SvRV(obj)); |
260 | ||
261 | MUTEX_LOCK(&thread->mutex); | |
262 | thread->count--; | |
263 | MUTEX_UNLOCK(&thread->mutex); | |
e6e315b9 | 264 | Perl_thread_destruct(thread); |
47ba8780 AB |
265 | } |
266 | ||
e6e315b9 | 267 | void Perl_thread_destruct (ithread* thread) { |
47ba8780 AB |
268 | return; |
269 | MUTEX_LOCK(&thread->mutex); | |
270 | if(thread->count != 0) { | |
271 | MUTEX_UNLOCK(&thread->mutex); | |
272 | return; | |
273 | } | |
274 | MUTEX_UNLOCK(&thread->mutex); | |
275 | /* it is safe noone is holding a ref to this */ | |
276 | /*printf("proper destruction!\n");*/ | |
277 | } | |
278 | ||
47ba8780 AB |
279 | MODULE = threads PACKAGE = threads |
280 | BOOT: | |
281 | Perl_sharedsv_init(aTHX); | |
282 | PL_perl_destruct_level = 2; | |
283 | threads = Perl_sharedsv_new(aTHX); | |
284 | SHAREDSvEDIT(threads); | |
e8f2bb9a | 285 | SHAREDSvGET(threads) = (SV *)newHV(); |
47ba8780 AB |
286 | SHAREDSvRELEASE(threads); |
287 | { | |
288 | ||
289 | ||
290 | SV* temp = get_sv("threads::sharedsv_space", TRUE | GV_ADDMULTI); | |
4f896ddc | 291 | SV* temp2 = newSViv((IV)PL_sharedsv_space ); |
47ba8780 AB |
292 | sv_setsv( temp , temp2 ); |
293 | } | |
294 | { | |
295 | ithread* thread = malloc(sizeof(ithread)); | |
296 | SV* thread_tid_ptr; | |
297 | SV* thread_ptr; | |
298 | MUTEX_INIT(&thread->mutex); | |
299 | thread->tid = 0; | |
300 | #ifdef WIN32 | |
301 | thread->thr = GetCurrentThreadId(); | |
302 | #else | |
303 | thread->thr = pthread_self(); | |
304 | #endif | |
d5ecd109 | 305 | SHAREDSvEDIT(threads); |
82c40bf6 | 306 | PERL_THREAD_ALLOC_SPECIFIC(self_key); |
7f9a95ef AB |
307 | PERL_THREAD_SETSPECIFIC(self_key,0); |
308 | thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, 0); | |
b1edfb69 | 309 | thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread)); |
47ba8780 | 310 | hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0); |
4f896ddc | 311 | SvREFCNT_dec(thread_tid_ptr); |
d5ecd109 | 312 | SHAREDSvRELEASE(threads); |
47ba8780 AB |
313 | } |
314 | MUTEX_INIT(&create_mutex); | |
315 | ||
47ba8780 AB |
316 | PROTOTYPES: DISABLE |
317 | ||
318 | SV * | |
319 | create (class, function_to_call, ...) | |
320 | char * class | |
321 | SV * function_to_call | |
322 | CODE: | |
323 | AV* params = newAV(); | |
324 | if(items > 2) { | |
325 | int i; | |
326 | for(i = 2; i < items ; i++) { | |
327 | av_push(params, ST(i)); | |
328 | } | |
329 | } | |
e6e315b9 | 330 | RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params)); |
47ba8780 AB |
331 | OUTPUT: |
332 | RETVAL | |
333 | ||
334 | SV * | |
335 | self (class) | |
336 | char* class | |
337 | CODE: | |
e6e315b9 | 338 | RETVAL = Perl_thread_self(class); |
47ba8780 AB |
339 | OUTPUT: |
340 | RETVAL | |
341 | ||
342 | int | |
343 | tid (obj) | |
344 | SV * obj; | |
345 | CODE: | |
e6e315b9 | 346 | RETVAL = Perl_thread_tid(obj); |
47ba8780 AB |
347 | OUTPUT: |
348 | RETVAL | |
349 | ||
350 | void | |
351 | join (obj) | |
352 | SV * obj | |
353 | PREINIT: | |
354 | I32* temp; | |
355 | PPCODE: | |
356 | temp = PL_markstack_ptr++; | |
e6e315b9 | 357 | Perl_thread_join(obj); |
47ba8780 AB |
358 | if (PL_markstack_ptr != temp) { |
359 | /* truly void, because dXSARGS not invoked */ | |
360 | PL_markstack_ptr = temp; | |
361 | XSRETURN_EMPTY; /* return empty stack */ | |
362 | } | |
363 | /* must have used dXSARGS; list context implied */ | |
364 | return; /* assume stack size is correct */ | |
365 | ||
366 | void | |
367 | detach (obj) | |
368 | SV * obj | |
369 | PREINIT: | |
370 | I32* temp; | |
371 | PPCODE: | |
372 | temp = PL_markstack_ptr++; | |
e6e315b9 | 373 | Perl_thread_detach(obj); |
47ba8780 AB |
374 | if (PL_markstack_ptr != temp) { |
375 | /* truly void, because dXSARGS not invoked */ | |
376 | PL_markstack_ptr = temp; | |
377 | XSRETURN_EMPTY; /* return empty stack */ | |
378 | } | |
379 | /* must have used dXSARGS; list context implied */ | |
380 | return; /* assume stack size is correct */ | |
381 | ||
47ba8780 AB |
382 | void |
383 | DESTROY (obj) | |
384 | SV * obj | |
385 | PREINIT: | |
386 | I32* temp; | |
387 | PPCODE: | |
388 | temp = PL_markstack_ptr++; | |
e6e315b9 | 389 | Perl_thread_DESTROY(obj); |
47ba8780 AB |
390 | if (PL_markstack_ptr != temp) { |
391 | /* truly void, because dXSARGS not invoked */ | |
392 | PL_markstack_ptr = temp; | |
393 | XSRETURN_EMPTY; /* return empty stack */ | |
394 | } | |
395 | /* must have used dXSARGS; list context implied */ | |
396 | return; /* assume stack size is correct */ | |
397 |