pthread_keycreate not pthread_key_create under the here be dragons API
[p5sagit/p5-mst-13.2.git] / ext / threads / threads.xs
CommitLineData
47ba8780 1#include "threads.h"
2
47ba8780 3/*
b1edfb69 4 * Starts executing the thread. Needs to clean up memory a tad better.
5 */
47ba8780 6
7#ifdef WIN32
e6e315b9 8THREAD_RET_TYPE Perl_thread_run(LPVOID arg) {
47ba8780 9#else
e8f2bb9a 10void* Perl_thread_run(void * arg) {
47ba8780 11#endif
5b414d21 12 ithread* thread = (ithread*) arg;
47ba8780 13 SV* thread_tid_ptr;
14 SV* thread_ptr;
15 dTHXa(thread->interp);
47ba8780 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 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 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 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 54 FREETMPS;
55 LEAVE;
56
57
58 }
59
47ba8780 60 MUTEX_LOCK(&thread->mutex);
fd58862f 61 PerlIO_flush((PerlIO*)NULL);
47ba8780 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 67 } else {
68 MUTEX_UNLOCK(&thread->mutex);
69 }
70#ifdef WIN32
71 return (DWORD)0;
e8f2bb9a 72#else
73 return 0;
47ba8780 74#endif
75
76}
77
47ba8780 78/*
b1edfb69 79 * iThread->create();
80 */
47ba8780 81
e6e315b9 82SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
47ba8780 83 ithread* thread = malloc(sizeof(ithread));
84 SV* obj_ref;
85 SV* obj;
86 SV* temp_store;
47ba8780 87 PerlInterpreter *current_perl;
88
89 MUTEX_LOCK(&create_mutex);
90 obj_ref = newSViv(0);
91 obj = newSVrv(obj_ref, class);
b1edfb69 92 sv_setiv(obj, (IV)thread);
93 SvREADONLY_on(obj);
47ba8780 94
b1edfb69 95 current_perl = PERL_GET_CONTEXT;
47ba8780 96
97 /*
b1edfb69 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 103 temp_store = Perl_get_sv(current_perl, "threads::paramtempstore",
104 TRUE | GV_ADDMULTI);
47ba8780 105 Perl_sv_setsv(current_perl, temp_store,params);
106 params = NULL;
107 temp_store = NULL;
108
b1edfb69 109 temp_store = Perl_get_sv(current_perl, "threads::calltempstore",
110 TRUE | GV_ADDMULTI);
47ba8780 111 Perl_sv_setsv(current_perl,temp_store, init_function);
4f896ddc 112 init_function = NULL;
113 temp_store = NULL;
47ba8780 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 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 125
126 /*
b1edfb69 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);
47ba8780 132 Perl_sv_setsv(thread->interp,temp_store, &PL_sv_undef);
133
134 temp_store = Perl_get_sv(thread->interp,"threads::calltempstore",FALSE);
135 Perl_sv_setsv(thread->interp,temp_store, &PL_sv_undef);
136
137 PERL_SET_CONTEXT(current_perl);
138
139 temp_store = Perl_get_sv(current_perl,"threads::paramtempstore",FALSE);
140 Perl_sv_setsv(current_perl, temp_store, &PL_sv_undef);
141
142 temp_store = Perl_get_sv(current_perl,"threads::calltempstore",FALSE);
143 Perl_sv_setsv(current_perl, temp_store, &PL_sv_undef);
144
b1edfb69 145 /* let's init the thread */
47ba8780 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 155 (LPVOID)thread, 0, &thread->thr);
156
82c40bf6 157
158#else
159#ifdef OLD_PTHREADS_API
df9156bb 160 pthread_create( &thread->thr, (pthread_attr_t)NULL, Perl_thread_run, (void *)thread);
47ba8780 161#else
df9156bb 162 pthread_create( &thread->thr, (pthread_attr_t*)NULL, Perl_thread_run, (void *)thread);
47ba8780 163#endif
82c40bf6 164#endif
47ba8780 165 MUTEX_UNLOCK(&create_mutex);
166
b1edfb69 167 return obj_ref;
47ba8780 168}
169
170/*
b1edfb69 171 * returns the id of the thread
172 */
e6e315b9 173I32 Perl_thread_tid (SV* obj) {
47ba8780 174 ithread* thread;
175 if(!SvROK(obj)) {
e6e315b9 176 obj = Perl_thread_self(SvPV_nolen(obj));
47ba8780 177 thread = (ithread*)SvIV(SvRV(obj));
178 SvREFCNT_dec(obj);
179 } else {
180 thread = (ithread*)SvIV(SvRV(obj));
181 }
182 return thread->tid;
183}
184
e6e315b9 185SV* Perl_thread_self (char* class) {
47ba8780 186 dTHX;
187 SV* obj_ref;
188 SV* obj;
b1edfb69 189 SV* thread_tid_ptr;
190 SV* thread_ptr;
191 HE* thread_entry;
7f9a95ef 192 void* id;
193 PERL_THREAD_GETSPECIFIC(self_key,id);
4f896ddc 194 SHAREDSvLOCK(threads);
47ba8780 195 SHAREDSvEDIT(threads);
7f9a95ef 196
197 thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(id));
82c40bf6 198
b1edfb69 199 thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space,
200 (HV*) SHAREDSvGET(threads),
201 thread_tid_ptr, 0,0);
47ba8780 202 thread_ptr = HeVAL(thread_entry);
203 SvREFCNT_dec(thread_tid_ptr);
47ba8780 204 SHAREDSvRELEASE(threads);
4f896ddc 205 SHAREDSvUNLOCK(threads);
47ba8780 206
207 obj_ref = newSViv(0);
208 obj = newSVrv(obj_ref, class);
4f896ddc 209 sv_setsv(obj, thread_ptr);
47ba8780 210 SvREADONLY_on(obj);
211 return obj_ref;
212}
213
214/*
b1edfb69 215 * joins the thread this code needs to take the returnvalue from the
216 * call_sv and send it back */
47ba8780 217
e6e315b9 218void Perl_thread_join(SV* obj) {
47ba8780 219 ithread* thread = (ithread*)SvIV(SvRV(obj));
220#ifdef WIN32
221 DWORD waitcode;
222 waitcode = WaitForSingleObject(thread->handle, INFINITE);
223#else
224 void *retval;
225 pthread_join(thread->thr,&retval);
226#endif
227}
228
b1edfb69 229/* detaches a thread
230 * needs to better clean up memory */
47ba8780 231
e6e315b9 232void Perl_thread_detach(SV* obj) {
47ba8780 233 ithread* thread = (ithread*)SvIV(SvRV(obj));
234 MUTEX_LOCK(&thread->mutex);
235 thread->detached = 1;
82c40bf6 236 PERL_THREAD_DETACH(thread->thr);
47ba8780 237 MUTEX_UNLOCK(&thread->mutex);
238}
239
e6e315b9 240void Perl_thread_DESTROY (SV* obj) {
47ba8780 241 ithread* thread = (ithread*)SvIV(SvRV(obj));
242
243 MUTEX_LOCK(&thread->mutex);
244 thread->count--;
245 MUTEX_UNLOCK(&thread->mutex);
e6e315b9 246 Perl_thread_destruct(thread);
47ba8780 247}
248
e6e315b9 249void Perl_thread_destruct (ithread* thread) {
47ba8780 250 return;
251 MUTEX_LOCK(&thread->mutex);
252 if(thread->count != 0) {
253 MUTEX_UNLOCK(&thread->mutex);
254 return;
255 }
256 MUTEX_UNLOCK(&thread->mutex);
257 /* it is safe noone is holding a ref to this */
258 /*printf("proper destruction!\n");*/
259}
260
47ba8780 261MODULE = threads PACKAGE = threads
262BOOT:
263 Perl_sharedsv_init(aTHX);
264 PL_perl_destruct_level = 2;
265 threads = Perl_sharedsv_new(aTHX);
266 SHAREDSvEDIT(threads);
e8f2bb9a 267 SHAREDSvGET(threads) = (SV *)newHV();
47ba8780 268 SHAREDSvRELEASE(threads);
269 {
270
271
272 SV* temp = get_sv("threads::sharedsv_space", TRUE | GV_ADDMULTI);
4f896ddc 273 SV* temp2 = newSViv((IV)PL_sharedsv_space );
47ba8780 274 sv_setsv( temp , temp2 );
275 }
276 {
277 ithread* thread = malloc(sizeof(ithread));
278 SV* thread_tid_ptr;
279 SV* thread_ptr;
280 MUTEX_INIT(&thread->mutex);
281 thread->tid = 0;
282#ifdef WIN32
283 thread->thr = GetCurrentThreadId();
284#else
285 thread->thr = pthread_self();
286#endif
d5ecd109 287 SHAREDSvEDIT(threads);
82c40bf6 288 PERL_THREAD_ALLOC_SPECIFIC(self_key);
7f9a95ef 289 PERL_THREAD_SETSPECIFIC(self_key,0);
290 thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, 0);
b1edfb69 291 thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
47ba8780 292 hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
4f896ddc 293 SvREFCNT_dec(thread_tid_ptr);
d5ecd109 294 SHAREDSvRELEASE(threads);
47ba8780 295 }
296 MUTEX_INIT(&create_mutex);
297
47ba8780 298PROTOTYPES: DISABLE
299
300SV *
301create (class, function_to_call, ...)
302 char * class
303 SV * function_to_call
304 CODE:
305 AV* params = newAV();
306 if(items > 2) {
307 int i;
308 for(i = 2; i < items ; i++) {
309 av_push(params, ST(i));
310 }
311 }
e6e315b9 312 RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params));
47ba8780 313 OUTPUT:
314 RETVAL
315
316SV *
317self (class)
318 char* class
319 CODE:
e6e315b9 320 RETVAL = Perl_thread_self(class);
47ba8780 321 OUTPUT:
322 RETVAL
323
324int
325tid (obj)
326 SV * obj;
327 CODE:
e6e315b9 328 RETVAL = Perl_thread_tid(obj);
47ba8780 329 OUTPUT:
330 RETVAL
331
332void
333join (obj)
334 SV * obj
335 PREINIT:
336 I32* temp;
337 PPCODE:
338 temp = PL_markstack_ptr++;
e6e315b9 339 Perl_thread_join(obj);
47ba8780 340 if (PL_markstack_ptr != temp) {
341 /* truly void, because dXSARGS not invoked */
342 PL_markstack_ptr = temp;
343 XSRETURN_EMPTY; /* return empty stack */
344 }
345 /* must have used dXSARGS; list context implied */
346 return; /* assume stack size is correct */
347
348void
349detach (obj)
350 SV * obj
351 PREINIT:
352 I32* temp;
353 PPCODE:
354 temp = PL_markstack_ptr++;
e6e315b9 355 Perl_thread_detach(obj);
47ba8780 356 if (PL_markstack_ptr != temp) {
357 /* truly void, because dXSARGS not invoked */
358 PL_markstack_ptr = temp;
359 XSRETURN_EMPTY; /* return empty stack */
360 }
361 /* must have used dXSARGS; list context implied */
362 return; /* assume stack size is correct */
363
47ba8780 364void
365DESTROY (obj)
366 SV * obj
367 PREINIT:
368 I32* temp;
369 PPCODE:
370 temp = PL_markstack_ptr++;
e6e315b9 371 Perl_thread_DESTROY(obj);
47ba8780 372 if (PL_markstack_ptr != temp) {
373 /* truly void, because dXSARGS not invoked */
374 PL_markstack_ptr = temp;
375 XSRETURN_EMPTY; /* return empty stack */
376 }
377 /* must have used dXSARGS; list context implied */
378 return; /* assume stack size is correct */
379