4 * Starts executing the thread. Needs to clean up memory a tad better.
8 THREAD_RET_TYPE Perl_thread_run(LPVOID arg) {
10 void* Perl_thread_run(void * arg) {
12 ithread* thread = (ithread*) arg;
15 dTHXa(thread->interp);
16 PERL_SET_CONTEXT(thread->interp);
19 thread->thr = GetCurrentThreadId();
21 thread->thr = pthread_self();
24 SHAREDSvLOCK(threads);
25 SHAREDSvEDIT(threads);
26 PERL_THREAD_SETSPECIFIC(self_key,INT2PTR(void*,thread->tid));
27 thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, thread->tid);
28 thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
29 hv_store_ent((HV*)SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
30 SvREFCNT_dec(thread_tid_ptr);
31 SHAREDSvRELEASE(threads);
32 SHAREDSvUNLOCK(threads);
33 PL_perl_destruct_level = 2;
41 params = (AV*) SvRV(thread->params);
47 for(i = 0; i < len + 1; i++) {
48 XPUSHs(av_shift(params));
52 call_sv(thread->init_function, G_DISCARD);
59 MUTEX_LOCK(&thread->mutex);
60 PerlIO_flush((PerlIO*)NULL);
61 perl_destruct(thread->interp);
62 perl_free(thread->interp);
63 if(thread->detached == 1) {
64 MUTEX_UNLOCK(&thread->mutex);
65 Perl_thread_destruct(thread);
67 MUTEX_UNLOCK(&thread->mutex);
81 SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
82 ithread* thread = malloc(sizeof(ithread));
86 PerlInterpreter *current_perl;
88 MUTEX_LOCK(&create_mutex);
90 obj = newSVrv(obj_ref, class);
91 sv_setiv(obj, (IV)thread);
93 PerlIO_flush((PerlIO*)NULL);
94 current_perl = PERL_GET_CONTEXT;
97 * here we put the values of params and function to call onto
98 * namespace, this is so perl will properly clone them when we
102 temp_store = Perl_get_sv(current_perl, "threads::paramtempstore",
104 Perl_sv_setsv_flags(current_perl, temp_store,params, SV_GMAGIC);
108 temp_store = Perl_get_sv(current_perl, "threads::calltempstore",
110 Perl_sv_setsv_flags(current_perl,temp_store, init_function, SV_GMAGIC);
111 init_function = NULL;
114 temp_store = Perl_get_sv(current_perl, "threads::origthread", TRUE | GV_ADDMULTI);
115 sv_setiv(temp_store,(IV)current_perl);
120 thread->interp = perl_clone(current_perl, 4);
122 thread->interp = perl_clone(current_perl, 0);
125 thread->init_function = newSVsv(Perl_get_sv(thread->interp,
126 "threads::calltempstore",FALSE));
127 thread->params = newSVsv(Perl_get_sv(thread->interp,
128 "threads::paramtempstore",FALSE));
133 * And here we make sure we clean up the data we put in the
134 * namespace of iThread, both in the new and the calling
137 temp_store = Perl_get_sv(thread->interp, "threads::paramtempstore",FALSE);
138 Perl_sv_setsv_flags(thread->interp,temp_store, &PL_sv_undef, SV_GMAGIC);
140 temp_store = Perl_get_sv(thread->interp,"threads::calltempstore",FALSE);
141 Perl_sv_setsv_flags(thread->interp,temp_store, &PL_sv_undef, SV_GMAGIC);
143 PERL_SET_CONTEXT(current_perl);
145 temp_store = Perl_get_sv(current_perl,"threads::paramtempstore",FALSE);
146 Perl_sv_setsv_flags(current_perl, temp_store, &PL_sv_undef, SV_GMAGIC);
148 temp_store = Perl_get_sv(current_perl,"threads::calltempstore",FALSE);
149 Perl_sv_setsv_flags(current_perl, temp_store, &PL_sv_undef, SV_GMAGIC);
151 /* let's init the thread */
153 MUTEX_INIT(&thread->mutex);
154 thread->tid = tid_counter++;
155 thread->detached = 0;
160 thread->handle = CreateThread(NULL, 0, Perl_thread_run,
161 (LPVOID)thread, 0, &thread->thr);
166 static pthread_attr_t attr;
167 static int attr_inited = 0;
168 sigset_t fullmask, oldmask;
169 static int attr_joinable = PTHREAD_CREATE_JOINABLE;
172 pthread_attr_init(&attr);
174 # ifdef PTHREAD_ATTR_SETDETACHSTATE
175 PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable);
177 # ifdef THREAD_CREATE_NEEDS_STACK
178 if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK))
179 croak("panic: pthread_attr_setstacksize failed");
182 #ifdef OLD_PTHREADS_API
183 pthread_create( &thread->thr, attr, Perl_thread_run, (void *)thread);
185 pthread_create( &thread->thr, &attr, Perl_thread_run, (void *)thread);
189 MUTEX_UNLOCK(&create_mutex);
195 * returns the id of the thread
197 I32 Perl_thread_tid (SV* obj) {
200 obj = Perl_thread_self(SvPV_nolen(obj));
201 thread = (ithread*)SvIV(SvRV(obj));
204 thread = (ithread*)SvIV(SvRV(obj));
209 SV* Perl_thread_self (char* class) {
217 PERL_THREAD_GETSPECIFIC(self_key,id);
218 SHAREDSvLOCK(threads);
219 SHAREDSvEDIT(threads);
221 thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(id));
223 thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space,
224 (HV*) SHAREDSvGET(threads),
225 thread_tid_ptr, 0,0);
226 thread_ptr = HeVAL(thread_entry);
227 SvREFCNT_dec(thread_tid_ptr);
228 SHAREDSvRELEASE(threads);
229 SHAREDSvUNLOCK(threads);
231 obj_ref = newSViv(0);
232 obj = newSVrv(obj_ref, class);
233 sv_setsv(obj, thread_ptr);
239 * joins the thread this code needs to take the returnvalue from the
240 * call_sv and send it back */
242 void Perl_thread_join(SV* obj) {
243 ithread* thread = (ithread*)SvIV(SvRV(obj));
246 waitcode = WaitForSingleObject(thread->handle, INFINITE);
249 pthread_join(thread->thr,&retval);
254 * needs to better clean up memory */
256 void Perl_thread_detach(SV* obj) {
257 ithread* thread = (ithread*)SvIV(SvRV(obj));
258 MUTEX_LOCK(&thread->mutex);
259 thread->detached = 1;
260 PERL_THREAD_DETACH(thread->thr);
261 MUTEX_UNLOCK(&thread->mutex);
264 void Perl_thread_DESTROY (SV* obj) {
265 ithread* thread = (ithread*)SvIV(SvRV(obj));
267 MUTEX_LOCK(&thread->mutex);
269 MUTEX_UNLOCK(&thread->mutex);
270 Perl_thread_destruct(thread);
273 void Perl_thread_destruct (ithread* thread) {
275 MUTEX_LOCK(&thread->mutex);
276 if(thread->count != 0) {
277 MUTEX_UNLOCK(&thread->mutex);
280 MUTEX_UNLOCK(&thread->mutex);
281 /* it is safe noone is holding a ref to this */
282 /*printf("proper destruction!\n");*/
285 MODULE = threads PACKAGE = threads
287 Perl_sharedsv_init(aTHX);
288 PERL_THREAD_ALLOC_SPECIFIC(self_key);
289 PL_perl_destruct_level = 2;
290 threads = Perl_sharedsv_new(aTHX);
291 SHAREDSvEDIT(threads);
292 SHAREDSvGET(threads) = (SV *)newHV();
293 SHAREDSvRELEASE(threads);
297 SV* temp = get_sv("threads::sharedsv_space", TRUE | GV_ADDMULTI);
298 SV* temp2 = newSViv((IV)PL_sharedsv_space );
299 sv_setsv( temp , temp2 );
302 ithread* thread = malloc(sizeof(ithread));
305 MUTEX_INIT(&thread->mutex);
308 thread->thr = GetCurrentThreadId();
310 thread->thr = pthread_self();
312 SHAREDSvEDIT(threads);
313 PERL_THREAD_ALLOC_SPECIFIC(self_key);
314 PERL_THREAD_SETSPECIFIC(self_key,0);
315 thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, 0);
316 thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
317 hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
318 SvREFCNT_dec(thread_tid_ptr);
319 SHAREDSvRELEASE(threads);
321 MUTEX_INIT(&create_mutex);
326 create (class, function_to_call, ...)
328 SV * function_to_call
330 AV* params = newAV();
333 for(i = 2; i < items ; i++) {
334 av_push(params, ST(i));
337 RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params));
342 new (class, function_to_call, ...)
344 SV * function_to_call
346 AV* params = newAV();
349 for(i = 2; i < items ; i++) {
350 av_push(params, ST(i));
353 RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params));
363 RETVAL = Perl_thread_self(class);
371 RETVAL = Perl_thread_tid(obj);
381 temp = PL_markstack_ptr++;
382 Perl_thread_join(obj);
383 if (PL_markstack_ptr != temp) {
384 /* truly void, because dXSARGS not invoked */
385 PL_markstack_ptr = temp;
386 XSRETURN_EMPTY; /* return empty stack */
388 /* must have used dXSARGS; list context implied */
389 return; /* assume stack size is correct */
397 temp = PL_markstack_ptr++;
398 Perl_thread_detach(obj);
399 if (PL_markstack_ptr != temp) {
400 /* truly void, because dXSARGS not invoked */
401 PL_markstack_ptr = temp;
402 XSRETURN_EMPTY; /* return empty stack */
404 /* must have used dXSARGS; list context implied */
405 return; /* assume stack size is correct */
413 temp = PL_markstack_ptr++;
414 Perl_thread_DESTROY(obj);
415 if (PL_markstack_ptr != temp) {
416 /* truly void, because dXSARGS not invoked */
417 PL_markstack_ptr = temp;
418 XSRETURN_EMPTY; /* return empty stack */
420 /* must have used dXSARGS; list context implied */
421 return; /* assume stack size is correct */