-
#include "threads.h"
-
-
-
-
-
/*
- Starts executing the thread. Needs to clean up memory a tad better.
-*/
+ * Starts executing the thread. Needs to clean up memory a tad better.
+ */
#ifdef WIN32
-THREAD_RET_TYPE thread_run(LPVOID arg) {
- ithread* thread = (ithread*) arg;
+THREAD_RET_TYPE Perl_thread_run(LPVOID arg) {
#else
-void thread_run(ithread* thread) {
+void* Perl_thread_run(void * arg) {
#endif
+ ithread* thread = (ithread*) arg;
SV* thread_tid_ptr;
SV* thread_ptr;
dTHXa(thread->interp);
-
-
PERL_SET_CONTEXT(thread->interp);
#ifdef WIN32
thread->thr = pthread_self();
#endif
+ SHAREDSvLOCK(threads);
SHAREDSvEDIT(threads);
- thread_tid_ptr = Perl_newSViv(sharedsv_space, (IV) thread->thr);
- thread_ptr = Perl_newSViv(sharedsv_space, (IV) thread);
+ PERL_THREAD_SETSPECIFIC(self_key,INT2PTR(void*,thread->tid));
+ thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, thread->tid);
+ thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
hv_store_ent((HV*)SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
SvREFCNT_dec(thread_tid_ptr);
SHAREDSvRELEASE(threads);
-
-
+ SHAREDSvUNLOCK(threads);
PL_perl_destruct_level = 2;
+
{
AV* params;
}
}
PUTBACK;
- call_sv(thread->init_function, G_DISCARD);
+ call_sv(thread->init_function, G_DISCARD);
FREETMPS;
LEAVE;
}
-
-
MUTEX_LOCK(&thread->mutex);
+ PerlIO_flush((PerlIO*)NULL);
perl_destruct(thread->interp);
perl_free(thread->interp);
if(thread->detached == 1) {
MUTEX_UNLOCK(&thread->mutex);
- thread_destruct(thread);
+ Perl_thread_destruct(thread);
} else {
MUTEX_UNLOCK(&thread->mutex);
}
#ifdef WIN32
return (DWORD)0;
+#else
+ return 0;
#endif
}
-
-
/*
- iThread->create();
-*/
+ * iThread->create();
+ */
-SV* thread_create(char* class, SV* init_function, SV* params) {
+SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
ithread* thread = malloc(sizeof(ithread));
SV* obj_ref;
SV* obj;
SV* temp_store;
- I32 result;
PerlInterpreter *current_perl;
MUTEX_LOCK(&create_mutex);
obj_ref = newSViv(0);
obj = newSVrv(obj_ref, class);
- sv_setiv(obj, (IV)thread);
- SvREADONLY_on(obj);
-
-
- current_perl = PERL_GET_CONTEXT;
+ sv_setiv(obj, (IV)thread);
+ SvREADONLY_on(obj);
+ PerlIO_flush((PerlIO*)NULL);
+ current_perl = PERL_GET_CONTEXT;
/*
- 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.
- */
-
- /*if(SvTYPE(SvRV(init_function)) == SVt_PVCV) {
- CvCLONED_on(SvRV(init_function));
- }
- */
-
- temp_store = Perl_get_sv(current_perl, "threads::paramtempstore", TRUE | GV_ADDMULTI);
- Perl_sv_setsv(current_perl, temp_store,params);
+ * 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.
+ */
+
+ temp_store = Perl_get_sv(current_perl, "threads::paramtempstore",
+ TRUE | GV_ADDMULTI);
+ Perl_sv_setsv_flags(current_perl, temp_store,params, SV_GMAGIC);
params = NULL;
temp_store = NULL;
- temp_store = Perl_get_sv(current_perl, "threads::calltempstore", TRUE | GV_ADDMULTI);
- Perl_sv_setsv(current_perl,temp_store, init_function);
-
-
+ temp_store = Perl_get_sv(current_perl, "threads::calltempstore",
+ TRUE | GV_ADDMULTI);
+ Perl_sv_setsv_flags(current_perl,temp_store, init_function, SV_GMAGIC);
+ init_function = NULL;
+ temp_store = NULL;
#ifdef WIN32
- thread->interp = perl_clone(current_perl,4);
+ thread->interp = perl_clone(current_perl, 4);
#else
- thread->interp = perl_clone(current_perl,0);
-#endif
-
- PL_perl_destruct_level = 2;
-
-#if 0
- sv_dump(SvRV(Perl_get_sv(current_perl, "threads::calltempstore",FALSE)));
- sv_dump(SvRV(Perl_get_sv(thread->interp, "threads::calltempstore",FALSE)));
+ thread->interp = perl_clone(current_perl, 0);
#endif
- thread->init_function = newSVsv(Perl_get_sv(thread->interp, "threads::calltempstore",FALSE));
- thread->params = newSVsv(Perl_get_sv(thread->interp, "threads::paramtempstore",FALSE));
-
- init_function = NULL;
- temp_store = NULL;
-
+ thread->init_function = newSVsv(Perl_get_sv(thread->interp,
+ "threads::calltempstore",FALSE));
+ thread->params = newSVsv(Perl_get_sv(thread->interp,
+ "threads::paramtempstore",FALSE));
/*
- 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
- */
+ * 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 */
-
-
- temp_store = Perl_get_sv(thread->interp,"threads::paramtempstore",FALSE);
- Perl_sv_setsv(thread->interp,temp_store, &PL_sv_undef);
+ temp_store = Perl_get_sv(thread->interp, "threads::paramtempstore",FALSE);
+ Perl_sv_setsv_flags(thread->interp,temp_store, &PL_sv_undef, SV_GMAGIC);
temp_store = Perl_get_sv(thread->interp,"threads::calltempstore",FALSE);
- Perl_sv_setsv(thread->interp,temp_store, &PL_sv_undef);
+ Perl_sv_setsv_flags(thread->interp,temp_store, &PL_sv_undef, SV_GMAGIC);
PERL_SET_CONTEXT(current_perl);
temp_store = Perl_get_sv(current_perl,"threads::paramtempstore",FALSE);
- Perl_sv_setsv(current_perl, temp_store, &PL_sv_undef);
+ Perl_sv_setsv_flags(current_perl, temp_store, &PL_sv_undef, SV_GMAGIC);
temp_store = Perl_get_sv(current_perl,"threads::calltempstore",FALSE);
- Perl_sv_setsv(current_perl, temp_store, &PL_sv_undef);
-
- /* lets init the thread */
-
-
-
+ Perl_sv_setsv_flags(current_perl, temp_store, &PL_sv_undef, SV_GMAGIC);
+ /* let's init the thread */
MUTEX_INIT(&thread->mutex);
thread->tid = tid_counter++;
#ifdef WIN32
- thread->handle = CreateThread(NULL, 0, thread_run,
+ thread->handle = CreateThread(NULL, 0, Perl_thread_run,
(LPVOID)thread, 0, &thread->thr);
+
+#else
+ {
+ static pthread_attr_t attr;
+ static int attr_inited = 0;
+ sigset_t fullmask, oldmask;
+ static int attr_joinable = PTHREAD_CREATE_JOINABLE;
+ if (!attr_inited) {
+ attr_inited = 1;
+ pthread_attr_init(&attr);
+ }
+# ifdef PTHREAD_ATTR_SETDETACHSTATE
+ PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable);
+# endif
+# ifdef THREAD_CREATE_NEEDS_STACK
+ if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK))
+ croak("panic: pthread_attr_setstacksize failed");
+# endif
+
+#ifdef OLD_PTHREADS_API
+ pthread_create( &thread->thr, attr, Perl_thread_run, (void *)thread);
#else
- pthread_create( &thread->thr, NULL, (void *) thread_run, thread);
+ pthread_create( &thread->thr, &attr, Perl_thread_run, (void *)thread);
+#endif
+ }
#endif
MUTEX_UNLOCK(&create_mutex);
-
- if(!SvRV(obj_ref)) printf("FUCK\n");
- return obj_ref;
+ return obj_ref;
}
/*
- returns the id of the thread
-*/
-I32 thread_tid (SV* obj) {
+ * returns the id of the thread
+ */
+I32 Perl_thread_tid (SV* obj) {
ithread* thread;
if(!SvROK(obj)) {
- obj = thread_self(SvPV_nolen(obj));
+ obj = Perl_thread_self(SvPV_nolen(obj));
thread = (ithread*)SvIV(SvRV(obj));
SvREFCNT_dec(obj);
} else {
return thread->tid;
}
-SV* thread_self (char* class) {
+SV* Perl_thread_self (char* class) {
dTHX;
SV* obj_ref;
SV* obj;
- SV* thread_tid_ptr;
- SV* thread_ptr;
- HE* thread_entry;
- IV pointer;
- PerlInterpreter *old_context = PERL_GET_CONTEXT;
-
-
-
+ SV* thread_tid_ptr;
+ SV* thread_ptr;
+ HE* thread_entry;
+ void* id;
+ PERL_THREAD_GETSPECIFIC(self_key,id);
+ SHAREDSvLOCK(threads);
SHAREDSvEDIT(threads);
-#ifdef WIN32
- thread_tid_ptr = Perl_newSViv(sharedsv_space, (IV) GetCurrentThreadId());
-#else
- thread_tid_ptr = Perl_newSViv(sharedsv_space, (IV) pthread_self());
-#endif
- thread_entry = Perl_hv_fetch_ent(sharedsv_space,(HV*) SHAREDSvGET(threads), thread_tid_ptr, 0,0);
+
+ thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(id));
+
+ thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space,
+ (HV*) SHAREDSvGET(threads),
+ thread_tid_ptr, 0,0);
thread_ptr = HeVAL(thread_entry);
SvREFCNT_dec(thread_tid_ptr);
- pointer = SvIV(thread_ptr);
SHAREDSvRELEASE(threads);
-
-
-
+ SHAREDSvUNLOCK(threads);
obj_ref = newSViv(0);
obj = newSVrv(obj_ref, class);
- sv_setiv(obj, pointer);
+ sv_setsv(obj, thread_ptr);
SvREADONLY_on(obj);
return obj_ref;
}
/*
- joins the thread
- this code needs to take the returnvalue from the call_sv and send it back
-*/
+ * joins the thread this code needs to take the returnvalue from the
+ * call_sv and send it back */
-void thread_join(SV* obj) {
+void Perl_thread_join(SV* obj) {
ithread* thread = (ithread*)SvIV(SvRV(obj));
#ifdef WIN32
DWORD waitcode;
#endif
}
+/* detaches a thread
+ * needs to better clean up memory */
-/*
- detaches a thread
- needs to better clean up memory
-*/
-
-void thread_detach(SV* obj) {
+void Perl_thread_detach(SV* obj) {
ithread* thread = (ithread*)SvIV(SvRV(obj));
MUTEX_LOCK(&thread->mutex);
thread->detached = 1;
-#if !defined(WIN32)
- pthread_detach(thread->thr);
-#endif
+ PERL_THREAD_DETACH(thread->thr);
MUTEX_UNLOCK(&thread->mutex);
}
-
-
-void thread_DESTROY (SV* obj) {
+void Perl_thread_DESTROY (SV* obj) {
ithread* thread = (ithread*)SvIV(SvRV(obj));
MUTEX_LOCK(&thread->mutex);
thread->count--;
MUTEX_UNLOCK(&thread->mutex);
- thread_destruct(thread);
-
+ Perl_thread_destruct(thread);
}
-void thread_destruct (ithread* thread) {
+void Perl_thread_destruct (ithread* thread) {
return;
MUTEX_LOCK(&thread->mutex);
if(thread->count != 0) {
/*printf("proper destruction!\n");*/
}
-
MODULE = threads PACKAGE = threads
BOOT:
Perl_sharedsv_init(aTHX);
+ PERL_THREAD_ALLOC_SPECIFIC(self_key);
PL_perl_destruct_level = 2;
threads = Perl_sharedsv_new(aTHX);
SHAREDSvEDIT(threads);
SV* temp = get_sv("threads::sharedsv_space", TRUE | GV_ADDMULTI);
- SV* temp2 = newSViv((IV)sharedsv_space );
+ SV* temp2 = newSViv((IV)PL_sharedsv_space );
sv_setsv( temp , temp2 );
}
{
thread->thr = pthread_self();
#endif
SHAREDSvEDIT(threads);
- thread_tid_ptr = Perl_newSViv(sharedsv_space, (IV) thread->thr);
- thread_ptr = Perl_newSViv(sharedsv_space, (IV) thread);
+ PERL_THREAD_ALLOC_SPECIFIC(self_key);
+ PERL_THREAD_SETSPECIFIC(self_key,0);
+ thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, 0);
+ thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
SvREFCNT_dec(thread_tid_ptr);
SHAREDSvRELEASE(threads);
-
}
MUTEX_INIT(&create_mutex);
-
-
PROTOTYPES: DISABLE
SV *
av_push(params, ST(i));
}
}
- RETVAL = thread_create(class, function_to_call, newRV_noinc((SV*) params));
+ RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params));
OUTPUT:
RETVAL
SV *
+new (class, function_to_call, ...)
+ char * class
+ SV * function_to_call
+ CODE:
+ AV* params = newAV();
+ if(items > 2) {
+ int i;
+ for(i = 2; i < items ; i++) {
+ av_push(params, ST(i));
+ }
+ }
+ RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params));
+ OUTPUT:
+ RETVAL
+
+
+
+SV *
self (class)
char* class
CODE:
- RETVAL = thread_self(class);
+ RETVAL = Perl_thread_self(class);
OUTPUT:
RETVAL
tid (obj)
SV * obj;
CODE:
- RETVAL = thread_tid(obj);
+ RETVAL = Perl_thread_tid(obj);
OUTPUT:
RETVAL
I32* temp;
PPCODE:
temp = PL_markstack_ptr++;
- thread_join(obj);
+ Perl_thread_join(obj);
if (PL_markstack_ptr != temp) {
/* truly void, because dXSARGS not invoked */
PL_markstack_ptr = temp;
I32* temp;
PPCODE:
temp = PL_markstack_ptr++;
- thread_detach(obj);
+ Perl_thread_detach(obj);
if (PL_markstack_ptr != temp) {
/* truly void, because dXSARGS not invoked */
PL_markstack_ptr = temp;
/* must have used dXSARGS; list context implied */
return; /* assume stack size is correct */
-
-
-
-
void
DESTROY (obj)
SV * obj
I32* temp;
PPCODE:
temp = PL_markstack_ptr++;
- thread_DESTROY(obj);
+ Perl_thread_DESTROY(obj);
if (PL_markstack_ptr != temp) {
/* truly void, because dXSARGS not invoked */
PL_markstack_ptr = temp;
/* must have used dXSARGS; list context implied */
return; /* assume stack size is correct */
-
-
projects / p5sagit/p5-mst-13.2.git / blobdiff