[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_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;
	CLONE_PARAMS clone_param;

	MUTEX_LOCK(&create_mutex);  
	obj_ref = newSViv(0);
	obj = newSVrv(obj_ref, class);
	sv_setiv(obj, PTR2IV(thread));
	SvREADONLY_on(obj);
	PerlIO_flush((PerlIO*)NULL);
	current_perl = PERL_GET_CONTEXT;	


	temp_store = Perl_get_sv(current_perl, "threads::origthread", TRUE | GV_ADDMULTI);
	sv_setiv(temp_store,PTR2IV(current_perl));
	temp_store = NULL;	

	
#ifdef WIN32
	thread->interp = perl_clone(current_perl, CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST);
#else
	thread->interp = perl_clone(current_perl, CLONEf_KEEP_PTR_TABLE);
#endif
	

	clone_param.flags = 0;	
	thread->init_function = Perl_sv_dup(thread->interp, init_function, &clone_param);
	if(SvREFCNT(thread->init_function) == 0) {
	    SvREFCNT_inc(thread->init_function);
	}	

	thread->params = Perl_sv_dup(thread->interp,params, &clone_param);
	SvREFCNT_inc(thread->params);
	SvTEMP_off(thread->init_function);
	ptr_table_free(PL_ptr_table);
	PL_ptr_table = NULL;
	

	PERL_SET_CONTEXT(current_perl);


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