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 thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread->thr));
27 thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
28 hv_store_ent((HV*)SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
29 SvREFCNT_dec(thread_tid_ptr);
30 SHAREDSvRELEASE(threads);
31 SHAREDSvUNLOCK(threads);
32 PL_perl_destruct_level = 2;
40 params = (AV*) SvRV(thread->params);
46 for(i = 0; i < len + 1; i++) {
47 XPUSHs(av_shift(params));
51 call_sv(thread->init_function, G_DISCARD);
58 MUTEX_LOCK(&thread->mutex);
59 PerlIO_flush((PerlIO*)NULL);
60 perl_destruct(thread->interp);
61 perl_free(thread->interp);
62 if(thread->detached == 1) {
63 MUTEX_UNLOCK(&thread->mutex);
64 Perl_thread_destruct(thread);
66 MUTEX_UNLOCK(&thread->mutex);
80 SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
81 ithread* thread = malloc(sizeof(ithread));
85 PerlInterpreter *current_perl;
87 MUTEX_LOCK(&create_mutex);
89 obj = newSVrv(obj_ref, class);
90 sv_setiv(obj, (IV)thread);
93 current_perl = PERL_GET_CONTEXT;
96 * here we put the values of params and function to call onto
97 * namespace, this is so perl will properly clone them when we
101 temp_store = Perl_get_sv(current_perl, "threads::paramtempstore",
103 Perl_sv_setsv(current_perl, temp_store,params);
107 temp_store = Perl_get_sv(current_perl, "threads::calltempstore",
109 Perl_sv_setsv(current_perl,temp_store, init_function);
110 init_function = NULL;
114 thread->interp = perl_clone(current_perl, 4);
116 thread->interp = perl_clone(current_perl, 0);
119 thread->init_function = newSVsv(Perl_get_sv(thread->interp,
120 "threads::calltempstore",FALSE));
121 thread->params = newSVsv(Perl_get_sv(thread->interp,
122 "threads::paramtempstore",FALSE));
125 * And here we make sure we clean up the data we put in the
126 * namespace of iThread, both in the new and the calling
129 temp_store = Perl_get_sv(thread->interp, "threads::paramtempstore",FALSE);
130 Perl_sv_setsv(thread->interp,temp_store, &PL_sv_undef);
132 temp_store = Perl_get_sv(thread->interp,"threads::calltempstore",FALSE);
133 Perl_sv_setsv(thread->interp,temp_store, &PL_sv_undef);
135 PERL_SET_CONTEXT(current_perl);
137 temp_store = Perl_get_sv(current_perl,"threads::paramtempstore",FALSE);
138 Perl_sv_setsv(current_perl, temp_store, &PL_sv_undef);
140 temp_store = Perl_get_sv(current_perl,"threads::calltempstore",FALSE);
141 Perl_sv_setsv(current_perl, temp_store, &PL_sv_undef);
143 /* let's init the thread */
145 MUTEX_INIT(&thread->mutex);
146 thread->tid = tid_counter++;
147 thread->detached = 0;
152 thread->handle = CreateThread(NULL, 0, Perl_thread_run,
153 (LPVOID)thread, 0, &thread->thr);
156 pthread_create( &thread->thr, (pthread_attr_t*)NULL, Perl_thread_run, thread);
158 MUTEX_UNLOCK(&create_mutex);
164 * returns the id of the thread
166 I32 Perl_thread_tid (SV* obj) {
169 obj = Perl_thread_self(SvPV_nolen(obj));
170 thread = (ithread*)SvIV(SvRV(obj));
173 thread = (ithread*)SvIV(SvRV(obj));
178 SV* Perl_thread_self (char* class) {
186 SHAREDSvLOCK(threads);
187 SHAREDSvEDIT(threads);
189 thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space,
190 (UV) GetCurrentThreadId());
192 thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space,
193 PTR2UV(pthread_self()));
195 thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space,
196 (HV*) SHAREDSvGET(threads),
197 thread_tid_ptr, 0,0);
198 thread_ptr = HeVAL(thread_entry);
199 SvREFCNT_dec(thread_tid_ptr);
200 SHAREDSvRELEASE(threads);
201 SHAREDSvUNLOCK(threads);
203 obj_ref = newSViv(0);
204 obj = newSVrv(obj_ref, class);
205 sv_setsv(obj, thread_ptr);
211 * joins the thread this code needs to take the returnvalue from the
212 * call_sv and send it back */
214 void Perl_thread_join(SV* obj) {
215 ithread* thread = (ithread*)SvIV(SvRV(obj));
218 waitcode = WaitForSingleObject(thread->handle, INFINITE);
221 pthread_join(thread->thr,&retval);
226 * needs to better clean up memory */
228 void Perl_thread_detach(SV* obj) {
229 ithread* thread = (ithread*)SvIV(SvRV(obj));
230 MUTEX_LOCK(&thread->mutex);
231 thread->detached = 1;
233 pthread_detach(thread->thr);
235 MUTEX_UNLOCK(&thread->mutex);
238 void Perl_thread_DESTROY (SV* obj) {
239 ithread* thread = (ithread*)SvIV(SvRV(obj));
241 MUTEX_LOCK(&thread->mutex);
243 MUTEX_UNLOCK(&thread->mutex);
244 Perl_thread_destruct(thread);
247 void Perl_thread_destruct (ithread* thread) {
249 MUTEX_LOCK(&thread->mutex);
250 if(thread->count != 0) {
251 MUTEX_UNLOCK(&thread->mutex);
254 MUTEX_UNLOCK(&thread->mutex);
255 /* it is safe noone is holding a ref to this */
256 /*printf("proper destruction!\n");*/
259 MODULE = threads PACKAGE = threads
261 Perl_sharedsv_init(aTHX);
262 PL_perl_destruct_level = 2;
263 threads = Perl_sharedsv_new(aTHX);
264 SHAREDSvEDIT(threads);
265 SHAREDSvGET(threads) = (SV *)newHV();
266 SHAREDSvRELEASE(threads);
270 SV* temp = get_sv("threads::sharedsv_space", TRUE | GV_ADDMULTI);
271 SV* temp2 = newSViv((IV)PL_sharedsv_space );
272 sv_setsv( temp , temp2 );
275 ithread* thread = malloc(sizeof(ithread));
278 MUTEX_INIT(&thread->mutex);
281 thread->thr = GetCurrentThreadId();
283 thread->thr = pthread_self();
285 SHAREDSvEDIT(threads);
286 thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread->thr));
287 thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
288 hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
289 SvREFCNT_dec(thread_tid_ptr);
290 SHAREDSvRELEASE(threads);
292 MUTEX_INIT(&create_mutex);
297 create (class, function_to_call, ...)
299 SV * function_to_call
301 AV* params = newAV();
304 for(i = 2; i < items ; i++) {
305 av_push(params, ST(i));
308 RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params));
316 RETVAL = Perl_thread_self(class);
324 RETVAL = Perl_thread_tid(obj);
334 temp = PL_markstack_ptr++;
335 Perl_thread_join(obj);
336 if (PL_markstack_ptr != temp) {
337 /* truly void, because dXSARGS not invoked */
338 PL_markstack_ptr = temp;
339 XSRETURN_EMPTY; /* return empty stack */
341 /* must have used dXSARGS; list context implied */
342 return; /* assume stack size is correct */
350 temp = PL_markstack_ptr++;
351 Perl_thread_detach(obj);
352 if (PL_markstack_ptr != temp) {
353 /* truly void, because dXSARGS not invoked */
354 PL_markstack_ptr = temp;
355 XSRETURN_EMPTY; /* return empty stack */
357 /* must have used dXSARGS; list context implied */
358 return; /* assume stack size is correct */
366 temp = PL_markstack_ptr++;
367 Perl_thread_DESTROY(obj);
368 if (PL_markstack_ptr != temp) {
369 /* truly void, because dXSARGS not invoked */
370 PL_markstack_ptr = temp;
371 XSRETURN_EMPTY; /* return empty stack */
373 /* must have used dXSARGS; list context implied */
374 return; /* assume stack size is correct */