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_ALLOC_SPECIFIC(self_key);
27 PERL_THREAD_SETSPECIFIC(self_key,INT2PTR(void*,thread->tid));
28 thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, thread->tid);
29 thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
30 hv_store_ent((HV*)SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
31 SvREFCNT_dec(thread_tid_ptr);
32 SHAREDSvRELEASE(threads);
33 SHAREDSvUNLOCK(threads);
34 PL_perl_destruct_level = 2;
42 params = (AV*) SvRV(thread->params);
48 for(i = 0; i < len + 1; i++) {
49 XPUSHs(av_shift(params));
53 call_sv(thread->init_function, G_DISCARD);
60 MUTEX_LOCK(&thread->mutex);
61 PerlIO_flush((PerlIO*)NULL);
62 perl_destruct(thread->interp);
63 perl_free(thread->interp);
64 if(thread->detached == 1) {
65 MUTEX_UNLOCK(&thread->mutex);
66 Perl_thread_destruct(thread);
68 MUTEX_UNLOCK(&thread->mutex);
82 SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
83 ithread* thread = malloc(sizeof(ithread));
87 PerlInterpreter *current_perl;
89 MUTEX_LOCK(&create_mutex);
91 obj = newSVrv(obj_ref, class);
92 sv_setiv(obj, (IV)thread);
95 current_perl = PERL_GET_CONTEXT;
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
103 temp_store = Perl_get_sv(current_perl, "threads::paramtempstore",
105 Perl_sv_setsv(current_perl, temp_store,params);
109 temp_store = Perl_get_sv(current_perl, "threads::calltempstore",
111 Perl_sv_setsv(current_perl,temp_store, init_function);
112 init_function = NULL;
116 thread->interp = perl_clone(current_perl, 4);
118 thread->interp = perl_clone(current_perl, 0);
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));
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
131 temp_store = Perl_get_sv(thread->interp, "threads::paramtempstore",FALSE);
132 Perl_sv_setsv(thread->interp,temp_store, &PL_sv_undef);
134 temp_store = Perl_get_sv(thread->interp,"threads::calltempstore",FALSE);
135 Perl_sv_setsv(thread->interp,temp_store, &PL_sv_undef);
137 PERL_SET_CONTEXT(current_perl);
139 temp_store = Perl_get_sv(current_perl,"threads::paramtempstore",FALSE);
140 Perl_sv_setsv(current_perl, temp_store, &PL_sv_undef);
142 temp_store = Perl_get_sv(current_perl,"threads::calltempstore",FALSE);
143 Perl_sv_setsv(current_perl, temp_store, &PL_sv_undef);
145 /* let's init the thread */
147 MUTEX_INIT(&thread->mutex);
148 thread->tid = tid_counter++;
149 thread->detached = 0;
154 thread->handle = CreateThread(NULL, 0, Perl_thread_run,
155 (LPVOID)thread, 0, &thread->thr);
159 #ifdef OLD_PTHREADS_API
161 static pthread_attr_t attr;
162 static int attr_inited = 0;
163 sigset_t fullmask, oldmask;
164 static int attr_joinable = PTHREAD_CREATE_JOINABLE;
167 pthread_attr_init(&attr);
169 # ifdef PTHREAD_ATTR_SETDETACHSTATE
170 PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable);
173 pthread_create( &thread->thr, attr, Perl_thread_run, (void *)thread);
176 pthread_create( &thread->thr, (pthread_attr_t*)NULL, Perl_thread_run, (void *)thread);
179 MUTEX_UNLOCK(&create_mutex);
185 * returns the id of the thread
187 I32 Perl_thread_tid (SV* obj) {
190 obj = Perl_thread_self(SvPV_nolen(obj));
191 thread = (ithread*)SvIV(SvRV(obj));
194 thread = (ithread*)SvIV(SvRV(obj));
199 SV* Perl_thread_self (char* class) {
207 PERL_THREAD_GETSPECIFIC(self_key,id);
208 SHAREDSvLOCK(threads);
209 SHAREDSvEDIT(threads);
211 thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(id));
213 thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space,
214 (HV*) SHAREDSvGET(threads),
215 thread_tid_ptr, 0,0);
216 thread_ptr = HeVAL(thread_entry);
217 SvREFCNT_dec(thread_tid_ptr);
218 SHAREDSvRELEASE(threads);
219 SHAREDSvUNLOCK(threads);
221 obj_ref = newSViv(0);
222 obj = newSVrv(obj_ref, class);
223 sv_setsv(obj, thread_ptr);
229 * joins the thread this code needs to take the returnvalue from the
230 * call_sv and send it back */
232 void Perl_thread_join(SV* obj) {
233 ithread* thread = (ithread*)SvIV(SvRV(obj));
236 waitcode = WaitForSingleObject(thread->handle, INFINITE);
239 pthread_join(thread->thr,&retval);
244 * needs to better clean up memory */
246 void Perl_thread_detach(SV* obj) {
247 ithread* thread = (ithread*)SvIV(SvRV(obj));
248 MUTEX_LOCK(&thread->mutex);
249 thread->detached = 1;
250 PERL_THREAD_DETACH(thread->thr);
251 MUTEX_UNLOCK(&thread->mutex);
254 void Perl_thread_DESTROY (SV* obj) {
255 ithread* thread = (ithread*)SvIV(SvRV(obj));
257 MUTEX_LOCK(&thread->mutex);
259 MUTEX_UNLOCK(&thread->mutex);
260 Perl_thread_destruct(thread);
263 void Perl_thread_destruct (ithread* thread) {
265 MUTEX_LOCK(&thread->mutex);
266 if(thread->count != 0) {
267 MUTEX_UNLOCK(&thread->mutex);
270 MUTEX_UNLOCK(&thread->mutex);
271 /* it is safe noone is holding a ref to this */
272 /*printf("proper destruction!\n");*/
275 MODULE = threads PACKAGE = threads
277 Perl_sharedsv_init(aTHX);
278 PL_perl_destruct_level = 2;
279 threads = Perl_sharedsv_new(aTHX);
280 SHAREDSvEDIT(threads);
281 SHAREDSvGET(threads) = (SV *)newHV();
282 SHAREDSvRELEASE(threads);
286 SV* temp = get_sv("threads::sharedsv_space", TRUE | GV_ADDMULTI);
287 SV* temp2 = newSViv((IV)PL_sharedsv_space );
288 sv_setsv( temp , temp2 );
291 ithread* thread = malloc(sizeof(ithread));
294 MUTEX_INIT(&thread->mutex);
297 thread->thr = GetCurrentThreadId();
299 thread->thr = pthread_self();
301 SHAREDSvEDIT(threads);
302 PERL_THREAD_ALLOC_SPECIFIC(self_key);
303 PERL_THREAD_SETSPECIFIC(self_key,0);
304 thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, 0);
305 thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
306 hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
307 SvREFCNT_dec(thread_tid_ptr);
308 SHAREDSvRELEASE(threads);
310 MUTEX_INIT(&create_mutex);
315 create (class, function_to_call, ...)
317 SV * function_to_call
319 AV* params = newAV();
322 for(i = 2; i < items ; i++) {
323 av_push(params, ST(i));
326 RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params));
334 RETVAL = Perl_thread_self(class);
342 RETVAL = Perl_thread_tid(obj);
352 temp = PL_markstack_ptr++;
353 Perl_thread_join(obj);
354 if (PL_markstack_ptr != temp) {
355 /* truly void, because dXSARGS not invoked */
356 PL_markstack_ptr = temp;
357 XSRETURN_EMPTY; /* return empty stack */
359 /* must have used dXSARGS; list context implied */
360 return; /* assume stack size is correct */
368 temp = PL_markstack_ptr++;
369 Perl_thread_detach(obj);
370 if (PL_markstack_ptr != temp) {
371 /* truly void, because dXSARGS not invoked */
372 PL_markstack_ptr = temp;
373 XSRETURN_EMPTY; /* return empty stack */
375 /* must have used dXSARGS; list context implied */
376 return; /* assume stack size is correct */
384 temp = PL_markstack_ptr++;
385 Perl_thread_DESTROY(obj);
386 if (PL_markstack_ptr != temp) {
387 /* truly void, because dXSARGS not invoked */
388 PL_markstack_ptr = temp;
389 XSRETURN_EMPTY; /* return empty stack */
391 /* must have used dXSARGS; list context implied */
392 return; /* assume stack size is correct */