10 Starts executing the thread. Needs to clean up memory a tad better.
14 THREAD_RET_TYPE thread_run(LPVOID arg) {
15 ithread* thread = (ithread*) arg;
17 void thread_run(ithread* thread) {
21 dTHXa(thread->interp);
22 PERL_SET_CONTEXT(thread->interp);
25 thread->thr = GetCurrentThreadId();
27 thread->thr = pthread_self();
30 SHAREDSvLOCK(threads);
31 SHAREDSvEDIT(threads);
32 thread_tid_ptr = Perl_newSViv(PL_sharedsv_space, (IV) thread->thr);
33 thread_ptr = Perl_newSViv(PL_sharedsv_space, (IV) thread);
34 hv_store_ent((HV*)SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
35 SvREFCNT_dec(thread_tid_ptr);
36 SHAREDSvRELEASE(threads);
37 SHAREDSvUNLOCK(threads);
38 PL_perl_destruct_level = 2;
46 params = (AV*) SvRV(thread->params);
52 for(i = 0; i < len + 1; i++) {
53 XPUSHs(av_shift(params));
57 call_sv(thread->init_function, G_DISCARD);
66 MUTEX_LOCK(&thread->mutex);
67 perl_destruct(thread->interp);
68 perl_free(thread->interp);
69 if(thread->detached == 1) {
70 MUTEX_UNLOCK(&thread->mutex);
71 thread_destruct(thread);
73 MUTEX_UNLOCK(&thread->mutex);
87 SV* thread_create(char* class, SV* init_function, SV* params) {
88 ithread* thread = malloc(sizeof(ithread));
93 PerlInterpreter *current_perl;
95 MUTEX_LOCK(&create_mutex);
97 obj = newSVrv(obj_ref, class);
98 sv_setiv(obj, (IV)thread);
102 current_perl = PERL_GET_CONTEXT;
105 here we put the values of params and function to call onto namespace, this is so perl will properly clone them when we call perl_clone.
110 temp_store = Perl_get_sv(current_perl, "threads::paramtempstore", TRUE | GV_ADDMULTI);
111 Perl_sv_setsv(current_perl, temp_store,params);
115 temp_store = Perl_get_sv(current_perl, "threads::calltempstore", TRUE | GV_ADDMULTI);
116 Perl_sv_setsv(current_perl,temp_store, init_function);
117 init_function = NULL;
122 thread->interp = perl_clone(current_perl,4);
124 thread->interp = perl_clone(current_perl,0);
127 thread->init_function = newSVsv(Perl_get_sv(thread->interp, "threads::calltempstore",FALSE));
128 thread->params = newSVsv(Perl_get_sv(thread->interp, "threads::paramtempstore",FALSE));
135 And here we make sure we clean up the data we put in the namespace of iThread, both in the new and the calling inteprreter
140 temp_store = Perl_get_sv(thread->interp,"threads::paramtempstore",FALSE);
141 Perl_sv_setsv(thread->interp,temp_store, &PL_sv_undef);
143 temp_store = Perl_get_sv(thread->interp,"threads::calltempstore",FALSE);
144 Perl_sv_setsv(thread->interp,temp_store, &PL_sv_undef);
146 PERL_SET_CONTEXT(current_perl);
148 temp_store = Perl_get_sv(current_perl,"threads::paramtempstore",FALSE);
149 Perl_sv_setsv(current_perl, temp_store, &PL_sv_undef);
151 temp_store = Perl_get_sv(current_perl,"threads::calltempstore",FALSE);
152 Perl_sv_setsv(current_perl, temp_store, &PL_sv_undef);
154 /* lets init the thread */
157 // thread->mutex = (perl_mutex) malloc(sizeof(perl_mutex));
160 MUTEX_INIT(&thread->mutex);
161 thread->tid = tid_counter++;
162 thread->detached = 0;
167 thread->handle = CreateThread(NULL, 0, thread_run,
168 (LPVOID)thread, 0, &thread->thr);
171 pthread_create( &thread->thr, NULL, (void *) thread_run, thread);
173 MUTEX_UNLOCK(&create_mutex);
181 returns the id of the thread
183 I32 thread_tid (SV* obj) {
186 obj = thread_self(SvPV_nolen(obj));
187 thread = (ithread*)SvIV(SvRV(obj));
190 thread = (ithread*)SvIV(SvRV(obj));
195 SV* thread_self (char* class) {
202 PerlInterpreter *old_context = PERL_GET_CONTEXT;
206 SHAREDSvLOCK(threads);
207 SHAREDSvEDIT(threads);
209 thread_tid_ptr = Perl_newSViv(PL_sharedsv_space, (IV) GetCurrentThreadId());
211 thread_tid_ptr = Perl_newSViv(PL_sharedsv_space, (IV) pthread_self());
213 thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space,(HV*) SHAREDSvGET(threads), thread_tid_ptr, 0,0);
214 thread_ptr = HeVAL(thread_entry);
215 SvREFCNT_dec(thread_tid_ptr);
216 SHAREDSvRELEASE(threads);
217 SHAREDSvUNLOCK(threads);
221 obj_ref = newSViv(0);
222 obj = newSVrv(obj_ref, class);
223 sv_setsv(obj, thread_ptr);
230 this code needs to take the returnvalue from the call_sv and send it back
233 void thread_join(SV* obj) {
234 ithread* thread = (ithread*)SvIV(SvRV(obj));
237 waitcode = WaitForSingleObject(thread->handle, INFINITE);
240 pthread_join(thread->thr,&retval);
247 needs to better clean up memory
250 void thread_detach(SV* obj) {
251 ithread* thread = (ithread*)SvIV(SvRV(obj));
252 MUTEX_LOCK(&thread->mutex);
253 thread->detached = 1;
255 pthread_detach(thread->thr);
257 MUTEX_UNLOCK(&thread->mutex);
262 void thread_DESTROY (SV* obj) {
263 ithread* thread = (ithread*)SvIV(SvRV(obj));
265 MUTEX_LOCK(&thread->mutex);
267 MUTEX_UNLOCK(&thread->mutex);
268 thread_destruct(thread);
272 void thread_destruct (ithread* thread) {
274 MUTEX_LOCK(&thread->mutex);
275 if(thread->count != 0) {
276 MUTEX_UNLOCK(&thread->mutex);
279 MUTEX_UNLOCK(&thread->mutex);
280 /* it is safe noone is holding a ref to this */
281 /*printf("proper destruction!\n");*/
285 MODULE = threads PACKAGE = threads
287 Perl_sharedsv_init(aTHX);
288 PL_perl_destruct_level = 2;
289 threads = Perl_sharedsv_new(aTHX);
290 SHAREDSvEDIT(threads);
291 ((HV*) SHAREDSvGET(threads)) = newHV();
292 SHAREDSvRELEASE(threads);
296 SV* temp = get_sv("threads::sharedsv_space", TRUE | GV_ADDMULTI);
297 SV* temp2 = newSViv((IV)PL_sharedsv_space );
298 sv_setsv( temp , temp2 );
301 ithread* thread = malloc(sizeof(ithread));
304 MUTEX_INIT(&thread->mutex);
307 thread->thr = GetCurrentThreadId();
309 thread->thr = pthread_self();
311 thread_tid_ptr = Perl_newSViv(PL_sharedsv_space, (IV) thread->thr);
312 thread_ptr = Perl_newSViv(PL_sharedsv_space, (IV) thread);
313 SHAREDSvEDIT(threads);
314 hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
315 SHAREDSvRELEASE(threads);
316 SvREFCNT_dec(thread_tid_ptr);
318 MUTEX_INIT(&create_mutex);
325 create (class, function_to_call, ...)
327 SV * function_to_call
329 AV* params = newAV();
332 for(i = 2; i < items ; i++) {
333 av_push(params, ST(i));
336 RETVAL = thread_create(class, function_to_call, newRV_noinc((SV*) params));
344 RETVAL = thread_self(class);
352 RETVAL = thread_tid(obj);
362 temp = PL_markstack_ptr++;
364 if (PL_markstack_ptr != temp) {
365 /* truly void, because dXSARGS not invoked */
366 PL_markstack_ptr = temp;
367 XSRETURN_EMPTY; /* return empty stack */
369 /* must have used dXSARGS; list context implied */
370 return; /* assume stack size is correct */
378 temp = PL_markstack_ptr++;
380 if (PL_markstack_ptr != temp) {
381 /* truly void, because dXSARGS not invoked */
382 PL_markstack_ptr = temp;
383 XSRETURN_EMPTY; /* return empty stack */
385 /* must have used dXSARGS; list context implied */
386 return; /* assume stack size is correct */
398 temp = PL_markstack_ptr++;
400 if (PL_markstack_ptr != temp) {
401 /* truly void, because dXSARGS not invoked */
402 PL_markstack_ptr = temp;
403 XSRETURN_EMPTY; /* return empty stack */
405 /* must have used dXSARGS; list context implied */
406 return; /* assume stack size is correct */