[perl5.git] / ext / threads / threads.xs

#include "threads.h"

/*
 *	Starts executing the thread. Needs to clean up memory a tad better.
 */

#ifdef WIN32
THREAD_RET_TYPE Perl_thread_run(LPVOID arg) {
#else
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 = GetCurrentThreadId();
#else
	thread->thr = pthread_self();
#endif

	SHAREDSvLOCK(threads);
	SHAREDSvEDIT(threads);
	PERL_THREAD_ALLOC_SPECIFIC(self_key);
	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;
		I32 len;
		int i;
		dSP;
		params = (AV*) SvRV(thread->params);
		len = av_len(params);
		ENTER;
		SAVETMPS;
		PUSHMARK(SP);
		if(len > -1) {
			for(i = 0; i < len + 1; i++) {
				XPUSHs(av_shift(params));
			}	
		}
		PUTBACK;
	 	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);
		Perl_thread_destruct(thread);
	} else {
	  	MUTEX_UNLOCK(&thread->mutex);
   	}
#ifdef WIN32
	return (DWORD)0;
#else
	return 0;
#endif

}

/*
 * iThread->create();
 */

SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
	ithread* thread = malloc(sizeof(ithread));
  	SV*      obj_ref;
  	SV*      obj;
	SV*		temp_store;
	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;	

	/*
	 * 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_flags(current_perl,temp_store, init_function, SV_GMAGIC);
	init_function = NULL;
	temp_store = NULL;

#ifdef WIN32
	thread->interp = perl_clone(current_perl, 4);
#else
	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));

	/*
	 * 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_flags(thread->interp,temp_store, &PL_sv_undef, SV_GMAGIC);

	temp_store = Perl_get_sv(thread->interp,"threads::calltempstore",FALSE);
	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_flags(current_perl, temp_store, &PL_sv_undef, SV_GMAGIC);

	temp_store = Perl_get_sv(current_perl,"threads::calltempstore",FALSE);
	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++;
	thread->detached = 0;
	thread->count = 1;

#ifdef WIN32

	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, &attr, Perl_thread_run, (void *)thread);
#endif
	}
#endif
	MUTEX_UNLOCK(&create_mutex);	

	return obj_ref;
}

/*
 * returns the id of the thread
 */
I32 Perl_thread_tid (SV* obj) {
	ithread* thread;
	if(!SvROK(obj)) {
		obj = Perl_thread_self(SvPV_nolen(obj));
		thread = (ithread*)SvIV(SvRV(obj));	
		SvREFCNT_dec(obj);
	} else {
		thread = (ithread*)SvIV(SvRV(obj));	
	}
	return thread->tid;
}

SV* Perl_thread_self (char* class) {
	dTHX;
	SV*      obj_ref;
	SV*      obj;
	SV*	thread_tid_ptr;
	SV*	thread_ptr;
	HE*	thread_entry;
	void*   id;
	PERL_THREAD_GETSPECIFIC(self_key,id);
	SHAREDSvLOCK(threads);
	SHAREDSvEDIT(threads);
	
	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);	
	SHAREDSvRELEASE(threads);
	SHAREDSvUNLOCK(threads);

	obj_ref = newSViv(0);
	obj = newSVrv(obj_ref, class);
   	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 */

void Perl_thread_join(SV* obj) {
	ithread* thread = (ithread*)SvIV(SvRV(obj));
#ifdef WIN32
	DWORD waitcode;
	waitcode = WaitForSingleObject(thread->handle, INFINITE);
#else
	void *retval;
	pthread_join(thread->thr,&retval);
#endif
}

/* detaches a thread
 * needs to better clean up memory */

void Perl_thread_detach(SV* obj) {
	ithread* thread = (ithread*)SvIV(SvRV(obj));
	MUTEX_LOCK(&thread->mutex);
	thread->detached = 1;
	PERL_THREAD_DETACH(thread->thr);
	MUTEX_UNLOCK(&thread->mutex);
}

void Perl_thread_DESTROY (SV* obj) {
	ithread* thread = (ithread*)SvIV(SvRV(obj));
	
	MUTEX_LOCK(&thread->mutex);
	thread->count--;
	MUTEX_UNLOCK(&thread->mutex);
	Perl_thread_destruct(thread);
}

void Perl_thread_destruct (ithread* thread) {
	return;
	MUTEX_LOCK(&thread->mutex);
	if(thread->count != 0) {
		MUTEX_UNLOCK(&thread->mutex);
		return;	
	}
	MUTEX_UNLOCK(&thread->mutex);
	/* it is safe noone is holding a ref to this */
	/*printf("proper destruction!\n");*/
}

MODULE = threads		PACKAGE = threads		
BOOT:
	Perl_sharedsv_init(aTHX);
	PL_perl_destruct_level = 2;
	threads = Perl_sharedsv_new(aTHX);
	SHAREDSvEDIT(threads);
	SHAREDSvGET(threads) = (SV *)newHV();
	SHAREDSvRELEASE(threads);
	{
	    
	
	    SV* temp = get_sv("threads::sharedsv_space", TRUE | GV_ADDMULTI);
	    SV* temp2 = newSViv((IV)PL_sharedsv_space );
	    sv_setsv( temp , temp2 );
	}
	{
		ithread* thread = malloc(sizeof(ithread));
		SV* thread_tid_ptr;
		SV* thread_ptr;
		MUTEX_INIT(&thread->mutex);
		thread->tid = 0;
#ifdef WIN32
		thread->thr = GetCurrentThreadId();
#else
		thread->thr = pthread_self();
#endif
		SHAREDSvEDIT(threads);
		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 *
create (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 = Perl_thread_self(class);
	OUTPUT:
		RETVAL

int
tid (obj)	
		SV *	obj;
	CODE:
		RETVAL = Perl_thread_tid(obj);
	OUTPUT:
	RETVAL

void
join (obj)
        SV *    obj
        PREINIT:
        I32* temp;
        PPCODE:
        temp = PL_markstack_ptr++;
        Perl_thread_join(obj);
        if (PL_markstack_ptr != temp) {
          /* truly void, because dXSARGS not invoked */
          PL_markstack_ptr = temp;
          XSRETURN_EMPTY; /* return empty stack */
        }
        /* must have used dXSARGS; list context implied */
        return; /* assume stack size is correct */

void
detach (obj)
        SV *    obj
        PREINIT:
        I32* temp;
        PPCODE:
        temp = PL_markstack_ptr++;
        Perl_thread_detach(obj);
        if (PL_markstack_ptr != temp) {
          /* truly void, because dXSARGS not invoked */
          PL_markstack_ptr = temp;
          XSRETURN_EMPTY; /* return empty stack */
        }
        /* must have used dXSARGS; list context implied */
        return; /* assume stack size is correct */

void
DESTROY (obj)
        SV *    obj
        PREINIT:
        I32* temp;
        PPCODE:
        temp = PL_markstack_ptr++;
        Perl_thread_DESTROY(obj);
        if (PL_markstack_ptr != temp) {
          /* truly void, because dXSARGS not invoked */
          PL_markstack_ptr = temp;
          XSRETURN_EMPTY; /* return empty stack */
        }
        /* must have used dXSARGS; list context implied */
        return; /* assume stack size is correct */
Commit	Line	Data
47ba8780 AB	1	#include "threads.h"
47ba8780 AB	2
47ba8780	3	/*
b1edfb69 JH	4	* Starts executing the thread. Needs to clean up memory a tad better.
b1edfb69 JH	5	*/
47ba8780 AB	6
47ba8780 AB	7	#ifdef WIN32
e6e315b9	8	THREAD_RET_TYPE Perl_thread_run(LPVOID arg) {
47ba8780	9	#else
e8f2bb9a	10	void* Perl_thread_run(void * arg) {
47ba8780	11	#endif
5b414d21	12	ithread* thread = (ithread*) arg;
47ba8780 AB	13	SV* thread_tid_ptr;
	14	SV* thread_ptr;
	15	dTHXa(thread->interp);
47ba8780 AB	16	PERL_SET_CONTEXT(thread->interp);
	17
	18	#ifdef WIN32
	19	thread->thr = GetCurrentThreadId();
	20	#else
	21	thread->thr = pthread_self();
	22	#endif
	23
4f896ddc	24	SHAREDSvLOCK(threads);
47ba8780	25	SHAREDSvEDIT(threads);
82c40bf6	26	PERL_THREAD_ALLOC_SPECIFIC(self_key);
7f9a95ef AB	27	PERL_THREAD_SETSPECIFIC(self_key,INT2PTR(void*,thread->tid));
7f9a95ef AB	28	thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, thread->tid);
b1edfb69	29	thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
47ba8780 AB	30	hv_store_ent((HV*)SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
	31	SvREFCNT_dec(thread_tid_ptr);
	32	SHAREDSvRELEASE(threads);
4f896ddc	33	SHAREDSvUNLOCK(threads);
47ba8780	34	PL_perl_destruct_level = 2;
4f896ddc	35
47ba8780 AB	36	{
	37
	38	AV* params;
	39	I32 len;
	40	int i;
	41	dSP;
	42	params = (AV*) SvRV(thread->params);
	43	len = av_len(params);
	44	ENTER;
	45	SAVETMPS;
	46	PUSHMARK(SP);
	47	if(len > -1) {
	48	for(i = 0; i < len + 1; i++) {
	49	XPUSHs(av_shift(params));
	50	}
	51	}
	52	PUTBACK;
4f896ddc	53	call_sv(thread->init_function, G_DISCARD);
47ba8780 AB	54	FREETMPS;
	55	LEAVE;
	56
	57
	58	}
	59
47ba8780	60	MUTEX_LOCK(&thread->mutex);
fd58862f	61	PerlIO_flush((PerlIO*)NULL);
47ba8780 AB	62	perl_destruct(thread->interp);
	63	perl_free(thread->interp);
	64	if(thread->detached == 1) {
	65	MUTEX_UNLOCK(&thread->mutex);
e6e315b9	66	Perl_thread_destruct(thread);
47ba8780 AB	67	} else {
	68	MUTEX_UNLOCK(&thread->mutex);
	69	}
	70	#ifdef WIN32
	71	return (DWORD)0;
e8f2bb9a JH	72	#else
e8f2bb9a JH	73	return 0;
47ba8780 AB	74	#endif
	75
	76	}
	77
47ba8780	78	/*
b1edfb69 JH	79	* iThread->create();
b1edfb69 JH	80	*/
47ba8780	81
e6e315b9	82	SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
47ba8780 AB	83	ithread* thread = malloc(sizeof(ithread));
	84	SV* obj_ref;
	85	SV* obj;
	86	SV* temp_store;
47ba8780 AB	87	PerlInterpreter *current_perl;
	88
	89	MUTEX_LOCK(&create_mutex);
	90	obj_ref = newSViv(0);
	91	obj = newSVrv(obj_ref, class);
b1edfb69 JH	92	sv_setiv(obj, (IV)thread);
b1edfb69 JH	93	SvREADONLY_on(obj);
47ba8780	94
b1edfb69	95	current_perl = PERL_GET_CONTEXT;
47ba8780 AB	96
47ba8780 AB	97	/*
b1edfb69 JH	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
	100	* call perl_clone.
	101	*/
4f896ddc	102
b1edfb69 JH	103	temp_store = Perl_get_sv(current_perl, "threads::paramtempstore",
b1edfb69 JH	104	TRUE \| GV_ADDMULTI);
485caab9	105	Perl_sv_setsv_flags(current_perl, temp_store,params, SV_GMAGIC);
47ba8780 AB	106	params = NULL;
	107	temp_store = NULL;
	108
b1edfb69 JH	109	temp_store = Perl_get_sv(current_perl, "threads::calltempstore",
b1edfb69 JH	110	TRUE \| GV_ADDMULTI);
485caab9	111	Perl_sv_setsv_flags(current_perl,temp_store, init_function, SV_GMAGIC);
4f896ddc AB	112	init_function = NULL;
4f896ddc AB	113	temp_store = NULL;
47ba8780 AB	114
47ba8780 AB	115	#ifdef WIN32
b1edfb69	116	thread->interp = perl_clone(current_perl, 4);
47ba8780	117	#else
b1edfb69	118	thread->interp = perl_clone(current_perl, 0);
47ba8780	119	#endif
47ba8780	120
b1edfb69 JH	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));
47ba8780 AB	125
47ba8780 AB	126	/*
b1edfb69 JH	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
	129	* inteprreter */
47ba8780	130
b1edfb69	131	temp_store = Perl_get_sv(thread->interp, "threads::paramtempstore",FALSE);
485caab9	132	Perl_sv_setsv_flags(thread->interp,temp_store, &PL_sv_undef, SV_GMAGIC);
47ba8780 AB	133
47ba8780 AB	134	temp_store = Perl_get_sv(thread->interp,"threads::calltempstore",FALSE);
485caab9	135	Perl_sv_setsv_flags(thread->interp,temp_store, &PL_sv_undef, SV_GMAGIC);
47ba8780 AB	136
	137	PERL_SET_CONTEXT(current_perl);
	138
	139	temp_store = Perl_get_sv(current_perl,"threads::paramtempstore",FALSE);
485caab9	140	Perl_sv_setsv_flags(current_perl, temp_store, &PL_sv_undef, SV_GMAGIC);
47ba8780 AB	141
47ba8780 AB	142	temp_store = Perl_get_sv(current_perl,"threads::calltempstore",FALSE);
485caab9	143	Perl_sv_setsv_flags(current_perl, temp_store, &PL_sv_undef, SV_GMAGIC);
47ba8780	144
b1edfb69	145	/* let's init the thread */
47ba8780 AB	146
	147	MUTEX_INIT(&thread->mutex);
	148	thread->tid = tid_counter++;
	149	thread->detached = 0;
	150	thread->count = 1;
	151
	152	#ifdef WIN32
	153
e6e315b9	154	thread->handle = CreateThread(NULL, 0, Perl_thread_run,
47ba8780 AB	155	(LPVOID)thread, 0, &thread->thr);
47ba8780 AB	156
82c40bf6 AB	157
82c40bf6 AB	158	#else
fa26028c AB	159	{
	160	static pthread_attr_t attr;
	161	static int attr_inited = 0;
	162	sigset_t fullmask, oldmask;
	163	static int attr_joinable = PTHREAD_CREATE_JOINABLE;
	164	if (!attr_inited) {
	165	attr_inited = 1;
	166	pthread_attr_init(&attr);
	167	}
	168	# ifdef PTHREAD_ATTR_SETDETACHSTATE
	169	PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable);
	170	# endif
3eb37d38 AB	171	# ifdef THREAD_CREATE_NEEDS_STACK
	172	if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK))
	173	croak("panic: pthread_attr_setstacksize failed");
	174	# endif
	175
3ad0b7d6	176	#ifdef OLD_PTHREADS_API
fa26028c	177	pthread_create( &thread->thr, attr, Perl_thread_run, (void *)thread);
47ba8780	178	#else
3ad0b7d6	179	pthread_create( &thread->thr, &attr, Perl_thread_run, (void *)thread);
47ba8780	180	#endif
3ad0b7d6	181	}
82c40bf6	182	#endif
47ba8780 AB	183	MUTEX_UNLOCK(&create_mutex);
47ba8780 AB	184
b1edfb69	185	return obj_ref;
47ba8780 AB	186	}
	187
	188	/*
b1edfb69 JH	189	* returns the id of the thread
b1edfb69 JH	190	*/
e6e315b9	191	I32 Perl_thread_tid (SV* obj) {
47ba8780 AB	192	ithread* thread;
47ba8780 AB	193	if(!SvROK(obj)) {
e6e315b9	194	obj = Perl_thread_self(SvPV_nolen(obj));
47ba8780 AB	195	thread = (ithread*)SvIV(SvRV(obj));
	196	SvREFCNT_dec(obj);
	197	} else {
	198	thread = (ithread*)SvIV(SvRV(obj));
	199	}
	200	return thread->tid;
	201	}
	202
e6e315b9	203	SV* Perl_thread_self (char* class) {
47ba8780 AB	204	dTHX;
	205	SV* obj_ref;
	206	SV* obj;
b1edfb69 JH	207	SV* thread_tid_ptr;
	208	SV* thread_ptr;
	209	HE* thread_entry;
7f9a95ef AB	210	void* id;
7f9a95ef AB	211	PERL_THREAD_GETSPECIFIC(self_key,id);
4f896ddc	212	SHAREDSvLOCK(threads);
47ba8780	213	SHAREDSvEDIT(threads);
7f9a95ef AB	214
7f9a95ef AB	215	thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(id));
82c40bf6	216
b1edfb69 JH	217	thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space,
	218	(HV*) SHAREDSvGET(threads),
	219	thread_tid_ptr, 0,0);
47ba8780 AB	220	thread_ptr = HeVAL(thread_entry);
47ba8780 AB	221	SvREFCNT_dec(thread_tid_ptr);
47ba8780	222	SHAREDSvRELEASE(threads);
4f896ddc	223	SHAREDSvUNLOCK(threads);
47ba8780 AB	224
	225	obj_ref = newSViv(0);
	226	obj = newSVrv(obj_ref, class);
4f896ddc	227	sv_setsv(obj, thread_ptr);
47ba8780 AB	228	SvREADONLY_on(obj);
	229	return obj_ref;
	230	}
	231
	232	/*
b1edfb69 JH	233	* joins the thread this code needs to take the returnvalue from the
b1edfb69 JH	234	* call_sv and send it back */
47ba8780	235
e6e315b9	236	void Perl_thread_join(SV* obj) {
47ba8780 AB	237	ithread* thread = (ithread*)SvIV(SvRV(obj));
	238	#ifdef WIN32
	239	DWORD waitcode;
	240	waitcode = WaitForSingleObject(thread->handle, INFINITE);
	241	#else
	242	void *retval;
	243	pthread_join(thread->thr,&retval);
	244	#endif
	245	}
	246
b1edfb69 JH	247	/* detaches a thread
b1edfb69 JH	248	* needs to better clean up memory */
47ba8780	249
e6e315b9	250	void Perl_thread_detach(SV* obj) {
47ba8780 AB	251	ithread* thread = (ithread*)SvIV(SvRV(obj));
	252	MUTEX_LOCK(&thread->mutex);
	253	thread->detached = 1;
82c40bf6	254	PERL_THREAD_DETACH(thread->thr);
47ba8780 AB	255	MUTEX_UNLOCK(&thread->mutex);
	256	}
	257
e6e315b9	258	void Perl_thread_DESTROY (SV* obj) {
47ba8780 AB	259	ithread* thread = (ithread*)SvIV(SvRV(obj));
	260
	261	MUTEX_LOCK(&thread->mutex);
	262	thread->count--;
	263	MUTEX_UNLOCK(&thread->mutex);
e6e315b9	264	Perl_thread_destruct(thread);
47ba8780 AB	265	}
47ba8780 AB	266
e6e315b9	267	void Perl_thread_destruct (ithread* thread) {
47ba8780 AB	268	return;
	269	MUTEX_LOCK(&thread->mutex);
	270	if(thread->count != 0) {
	271	MUTEX_UNLOCK(&thread->mutex);
	272	return;
	273	}
	274	MUTEX_UNLOCK(&thread->mutex);
	275	/* it is safe noone is holding a ref to this */
	276	/printf("proper destruction!\n");/
	277	}
	278
47ba8780 AB	279	MODULE = threads PACKAGE = threads
	280	BOOT:
	281	Perl_sharedsv_init(aTHX);
	282	PL_perl_destruct_level = 2;
	283	threads = Perl_sharedsv_new(aTHX);
	284	SHAREDSvEDIT(threads);
e8f2bb9a	285	SHAREDSvGET(threads) = (SV *)newHV();
47ba8780 AB	286	SHAREDSvRELEASE(threads);
	287	{
	288
	289
	290	SV* temp = get_sv("threads::sharedsv_space", TRUE \| GV_ADDMULTI);
4f896ddc	291	SV* temp2 = newSViv((IV)PL_sharedsv_space );
47ba8780 AB	292	sv_setsv( temp , temp2 );
	293	}
	294	{
	295	ithread* thread = malloc(sizeof(ithread));
	296	SV* thread_tid_ptr;
	297	SV* thread_ptr;
	298	MUTEX_INIT(&thread->mutex);
	299	thread->tid = 0;
	300	#ifdef WIN32
	301	thread->thr = GetCurrentThreadId();
	302	#else
	303	thread->thr = pthread_self();
	304	#endif
d5ecd109	305	SHAREDSvEDIT(threads);
82c40bf6	306	PERL_THREAD_ALLOC_SPECIFIC(self_key);
7f9a95ef AB	307	PERL_THREAD_SETSPECIFIC(self_key,0);
7f9a95ef AB	308	thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, 0);
b1edfb69	309	thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
47ba8780	310	hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
4f896ddc	311	SvREFCNT_dec(thread_tid_ptr);
d5ecd109	312	SHAREDSvRELEASE(threads);
47ba8780 AB	313	}
	314	MUTEX_INIT(&create_mutex);
	315
47ba8780 AB	316	PROTOTYPES: DISABLE
	317
	318	SV *
	319	create (class, function_to_call, ...)
	320	char * class
	321	SV * function_to_call
	322	CODE:
	323	AV* params = newAV();
	324	if(items > 2) {
	325	int i;
	326	for(i = 2; i < items ; i++) {
	327	av_push(params, ST(i));
	328	}
	329	}
e6e315b9	330	RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params));
47ba8780 AB	331	OUTPUT:
	332	RETVAL
	333
	334	SV *
	335	self (class)
	336	char* class
	337	CODE:
e6e315b9	338	RETVAL = Perl_thread_self(class);
47ba8780 AB	339	OUTPUT:
	340	RETVAL
	341
	342	int
	343	tid (obj)
	344	SV * obj;
	345	CODE:
e6e315b9	346	RETVAL = Perl_thread_tid(obj);
47ba8780 AB	347	OUTPUT:
	348	RETVAL
	349
	350	void
	351	join (obj)
	352	SV * obj
	353	PREINIT:
	354	I32* temp;
	355	PPCODE:
	356	temp = PL_markstack_ptr++;
e6e315b9	357	Perl_thread_join(obj);
47ba8780 AB	358	if (PL_markstack_ptr != temp) {
	359	/* truly void, because dXSARGS not invoked */
	360	PL_markstack_ptr = temp;
	361	XSRETURN_EMPTY; /* return empty stack */
	362	}
	363	/* must have used dXSARGS; list context implied */
	364	return; /* assume stack size is correct */
	365
	366	void
	367	detach (obj)
	368	SV * obj
	369	PREINIT:
	370	I32* temp;
	371	PPCODE:
	372	temp = PL_markstack_ptr++;
e6e315b9	373	Perl_thread_detach(obj);
47ba8780 AB	374	if (PL_markstack_ptr != temp) {
	375	/* truly void, because dXSARGS not invoked */
	376	PL_markstack_ptr = temp;
	377	XSRETURN_EMPTY; /* return empty stack */
	378	}
	379	/* must have used dXSARGS; list context implied */
	380	return; /* assume stack size is correct */
	381
47ba8780 AB	382	void
	383	DESTROY (obj)
	384	SV * obj
	385	PREINIT:
	386	I32* temp;
	387	PPCODE:
	388	temp = PL_markstack_ptr++;
e6e315b9	389	Perl_thread_DESTROY(obj);
47ba8780 AB	390	if (PL_markstack_ptr != temp) {
	391	/* truly void, because dXSARGS not invoked */
	392	PL_markstack_ptr = temp;
	393	XSRETURN_EMPTY; /* return empty stack */
	394	}
	395	/* must have used dXSARGS; list context implied */
	396	return; /* assume stack size is correct */
	397