[p5sagit/p5-mst-13.2.git] / ext / threads / threads.xs

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#ifdef USE_ITHREADS

#ifdef WIN32
#include <windows.h>
#include <win32thread.h>
#define PERL_THREAD_SETSPECIFIC(k,v) TlsSetValue(k,v)
#define PERL_THREAD_GETSPECIFIC(k,v) v = TlsGetValue(k)
#define PERL_THREAD_ALLOC_SPECIFIC(k) \
STMT_START {\
  if((k = TlsAlloc()) == TLS_OUT_OF_INDEXES) {\
    PerlIO_printf(PerlIO_stderr(),"panic threads.h: TlsAlloc");\
    exit(1);\
  }\
} STMT_END
#else
#include <pthread.h>
#include <thread.h>

#define PERL_THREAD_SETSPECIFIC(k,v) pthread_setspecific(k,v)
#ifdef OLD_PTHREADS_API
#define PERL_THREAD_DETACH(t) pthread_detach(&(t))
#define PERL_THREAD_GETSPECIFIC(k,v) pthread_getspecific(k,&v)
#define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\
  if(pthread_keycreate(&(k),0)) {\
    PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\
    exit(1);\
  }\
} STMT_END
#else
#define PERL_THREAD_DETACH(t) pthread_detach((t))
#define PERL_THREAD_GETSPECIFIC(k,v) v = pthread_getspecific(k)
#define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\
  if(pthread_key_create(&(k),0)) {\
    PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\
    exit(1);\
  }\
} STMT_END
#endif
#endif

/* Values for 'state' member */
#define PERL_ITHR_JOINABLE		0
#define PERL_ITHR_DETACHED		1
#define PERL_ITHR_FINISHED		4
#define PERL_ITHR_JOINED		2

typedef struct ithread_s {
    struct ithread_s *next;	/* next thread in the list */
    struct ithread_s *prev;	/* prev thread in the list */
    PerlInterpreter *interp;	/* The threads interpreter */
    I32 tid;              	/* threads module's thread id */
    perl_mutex mutex; 		/* mutex for updating things in this struct */
    I32 count;			/* how many SVs have a reference to us */
    signed char state;		/* are we detached ? */
    int gimme;			/* Context of create */
    SV* init_function;          /* Code to run */
    SV* params;                 /* args to pass function */
#ifdef WIN32
	DWORD	thr;            /* OS's idea if thread id */
	HANDLE handle;          /* OS's waitable handle */
#else
  	pthread_t thr;          /* OS's handle for the thread */
#endif
} ithread;

ithread *threads;

/* Macros to supply the aTHX_ in an embed.h like manner */
#define ithread_join(thread)		Perl_ithread_join(aTHX_ thread)
#define ithread_DESTROY(thread)		Perl_ithread_DESTROY(aTHX_ thread)
#define ithread_CLONE(thread)		Perl_ithread_CLONE(aTHX_ thread)
#define ithread_detach(thread)		Perl_ithread_detach(aTHX_ thread)
#define ithread_tid(thread)		((thread)->tid)
#define ithread_yield(thread)		(YIELD);

static perl_mutex create_destruct_mutex;  /* protects the creation and destruction of threads*/

I32 tid_counter = 0;
I32 known_threads = 0;
I32 active_threads = 0;
perl_key self_key;

/*
 *  Clear up after thread is done with
 */
void
Perl_ithread_destruct (pTHX_ ithread* thread, const char *why)
{
        PerlInterpreter* destroyperl = NULL;        
	MUTEX_LOCK(&thread->mutex);
	if (!thread->next) {
	    Perl_croak(aTHX_ "panic: destruct destroyed thread %p (%s)",thread, why);
	}
	if (thread->count != 0) {
		MUTEX_UNLOCK(&thread->mutex);
		return;
	}
	MUTEX_LOCK(&create_destruct_mutex);
	/* Remove from circular list of threads */
	if (thread->next == thread) {
	    /* last one should never get here ? */
	    threads = NULL;
        }
	else {
	    thread->next->prev = thread->prev;
	    thread->prev->next = thread->next;
	    if (threads == thread) {
		threads = thread->next;
	    }
	    thread->next = NULL;
	    thread->prev = NULL;
	}
	known_threads--;
	assert( known_threads >= 0 );
#if 0
        Perl_warn(aTHX_ "destruct %d @ %p by %p now %d",
	          thread->tid,thread->interp,aTHX, known_threads);
#endif
	MUTEX_UNLOCK(&create_destruct_mutex);
	/* Thread is now disowned */
	if (thread->interp) {
	    dTHXa(thread->interp);
	    PERL_SET_CONTEXT(thread->interp);
	    SvREFCNT_dec(thread->params);
	    thread->params = Nullsv;
	    destroyperl = thread->interp;
	    thread->interp = NULL;
	}
	MUTEX_UNLOCK(&thread->mutex);
	MUTEX_DESTROY(&thread->mutex);
        PerlMemShared_free(thread);
	if(destroyperl) {
	    ithread*        current_thread;
	    PERL_THREAD_GETSPECIFIC(self_key,current_thread);
	    PERL_THREAD_SETSPECIFIC(self_key,thread);
	    perl_destruct(destroyperl);
            perl_free(destroyperl);
	    PERL_THREAD_SETSPECIFIC(self_key,current_thread);

	}
	PERL_SET_CONTEXT(aTHX);
}

int
Perl_ithread_hook(pTHX)
{
    int veto_cleanup = 0;
    MUTEX_LOCK(&create_destruct_mutex);
    if (aTHX == PL_curinterp && active_threads != 1) {
	Perl_warn(aTHX_ "A thread exited while %" IVdf " other threads were still running",
						(IV)active_threads);
	veto_cleanup = 1;
    }
    MUTEX_UNLOCK(&create_destruct_mutex);
    return veto_cleanup;
}

void
Perl_ithread_detach(pTHX_ ithread *thread)
{
    MUTEX_LOCK(&thread->mutex);
    if (!(thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) {
	thread->state |= PERL_ITHR_DETACHED;
#ifdef WIN32
	CloseHandle(thread->handle);
	thread->handle = 0;
#else
	PERL_THREAD_DETACH(thread->thr);
#endif
    }
    if ((thread->state & PERL_ITHR_FINISHED) &&
        (thread->state & PERL_ITHR_DETACHED)) {
	MUTEX_UNLOCK(&thread->mutex);
	Perl_ithread_destruct(aTHX_ thread, "detach");
    }
    else {
	MUTEX_UNLOCK(&thread->mutex);
    }
}

/* MAGIC (in mg.h sense) hooks */

int
ithread_mg_get(pTHX_ SV *sv, MAGIC *mg)
{
    ithread *thread = (ithread *) mg->mg_ptr;
    SvIVX(sv) = PTR2IV(thread);
    SvIOK_on(sv);
    return 0;
}

int
ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
{
    ithread *thread = (ithread *) mg->mg_ptr;
    MUTEX_LOCK(&thread->mutex);
    thread->count--;
    if (thread->count == 0) {
       if(thread->state & PERL_ITHR_FINISHED &&
          (thread->state & PERL_ITHR_DETACHED ||
           thread->state & PERL_ITHR_JOINED))
       {
            MUTEX_UNLOCK(&thread->mutex);
            Perl_ithread_destruct(aTHX_ thread, "no reference");
       }
       else {
	    MUTEX_UNLOCK(&thread->mutex);
       }    
    }
    else {
	MUTEX_UNLOCK(&thread->mutex);
    }
    return 0;
}

int
ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
{
    ithread *thread = (ithread *) mg->mg_ptr;
    MUTEX_LOCK(&thread->mutex);
    thread->count++;
    MUTEX_UNLOCK(&thread->mutex);
    return 0;
}

MGVTBL ithread_vtbl = {
 ithread_mg_get,	/* get */
 0,			/* set */
 0,			/* len */
 0,			/* clear */
 ithread_mg_free,	/* free */
 0,			/* copy */
 ithread_mg_dup		/* dup */
};


/*
 *	Starts executing the thread. Needs to clean up memory a tad better.
 *      Passed as the C level function to run in the new thread
 */

#ifdef WIN32
THREAD_RET_TYPE
Perl_ithread_run(LPVOID arg) {
#else
void*
Perl_ithread_run(void * arg) {
#endif
	ithread* thread = (ithread*) arg;
	dTHXa(thread->interp);
	PERL_SET_CONTEXT(thread->interp);
	PERL_THREAD_SETSPECIFIC(self_key,thread);

#if 0
	/* Far from clear messing with ->thr child-side is a good idea */
	MUTEX_LOCK(&thread->mutex);
#ifdef WIN32
	thread->thr = GetCurrentThreadId();
#else
	thread->thr = pthread_self();
#endif
 	MUTEX_UNLOCK(&thread->mutex);
#endif

	PL_perl_destruct_level = 2;

	{
		AV* params = (AV*) SvRV(thread->params);
		I32 len = av_len(params)+1;
		int i;
		dSP;
		ENTER;
		SAVETMPS;
		PUSHMARK(SP);
		for(i = 0; i < len; i++) {
		    XPUSHs(av_shift(params));
		}
		PUTBACK;
		len = call_sv(thread->init_function, thread->gimme|G_EVAL);

		SPAGAIN;
		for (i=len-1; i >= 0; i--) {
		  SV *sv = POPs;
		  av_store(params, i, SvREFCNT_inc(sv));
		}
		if (SvTRUE(ERRSV)) {
		    Perl_warn(aTHX_ "thread failed to start: %" SVf, ERRSV);
		}
		FREETMPS;
		LEAVE;
		SvREFCNT_dec(thread->init_function);
	}

	PerlIO_flush((PerlIO*)NULL);
	MUTEX_LOCK(&thread->mutex);
	thread->state |= PERL_ITHR_FINISHED;

	if (thread->state & PERL_ITHR_DETACHED) {
		MUTEX_UNLOCK(&thread->mutex);
		Perl_ithread_destruct(aTHX_ thread, "detached finish");
	} else {
		MUTEX_UNLOCK(&thread->mutex);
	}
	MUTEX_LOCK(&create_destruct_mutex);
	active_threads--;
	assert( active_threads >= 0 );
	MUTEX_UNLOCK(&create_destruct_mutex);

#ifdef WIN32
	return (DWORD)0;
#else
	return 0;
#endif
}

SV *
ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc)
{
    SV *sv;
    MAGIC *mg;
    if (inc) {
	MUTEX_LOCK(&thread->mutex);
	thread->count++;
	MUTEX_UNLOCK(&thread->mutex);
    }
    if (!obj)
     obj = newSV(0);
    sv = newSVrv(obj,classname);
    sv_setiv(sv,PTR2IV(thread));
    mg = sv_magicext(sv,Nullsv,PERL_MAGIC_shared_scalar,&ithread_vtbl,(char *)thread,0);
    mg->mg_flags |= MGf_DUP;
    SvREADONLY_on(sv);
    return obj;
}

ithread *
SV_to_ithread(pTHX_ SV *sv)
{
    ithread *thread;
    if (SvROK(sv))
     {
      thread = INT2PTR(ithread*, SvIV(SvRV(sv)));
     }
    else
     {
      PERL_THREAD_GETSPECIFIC(self_key,thread);
     }
    return thread;
}

/*
 * iThread->create(); ( aka iThread->new() )
 * Called in context of parent thread
 */

SV *
Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* params)
{
	ithread*	thread;
	CLONE_PARAMS	clone_param;
	ithread*        current_thread;
	PERL_THREAD_GETSPECIFIC(self_key,current_thread);
	MUTEX_LOCK(&create_destruct_mutex);
	thread = PerlMemShared_malloc(sizeof(ithread));
	Zero(thread,1,ithread);
	thread->next = threads;
	thread->prev = threads->prev;
	threads->prev = thread;
	thread->prev->next = thread;
	/* Set count to 1 immediately in case thread exits before
	 * we return to caller !
	 */
	thread->count = 1;
	MUTEX_INIT(&thread->mutex);
	thread->tid = tid_counter++;
	thread->gimme = GIMME_V;

	/* "Clone" our interpreter into the thread's interpreter
	 * This gives thread access to "static data" and code.
	 */

	PerlIO_flush((PerlIO*)NULL);
	PERL_THREAD_SETSPECIFIC(self_key,thread);
#ifdef WIN32
	thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST);
#else
	thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE);
#endif
	/* perl_clone leaves us in new interpreter's context.
	   As it is tricky to spot an implicit aTHX, create a new scope
	   with aTHX matching the context for the duration of
	   our work for new interpreter.
	 */
	{
	    dTHXa(thread->interp);
            /* Here we remove END blocks since they should only run
	       in the thread they are created
            */
            SvREFCNT_dec(PL_endav);
            PL_endav = newAV();
            clone_param.flags = 0;
	    thread->init_function = sv_dup(init_function, &clone_param);
	    if (SvREFCNT(thread->init_function) == 0) {
		SvREFCNT_inc(thread->init_function);
	    }

	    thread->params = sv_dup(params, &clone_param);
	    SvREFCNT_inc(thread->params);
	    SvTEMP_off(thread->init_function);
	    ptr_table_free(PL_ptr_table);
	    PL_ptr_table = NULL;
	    PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
	}
	PERL_THREAD_SETSPECIFIC(self_key,current_thread);
	PERL_SET_CONTEXT(aTHX);

	/* Start the thread */

#ifdef WIN32

	thread->handle = CreateThread(NULL, 0, Perl_ithread_run,
			(LPVOID)thread, 0, &thread->thr);

#else
	{
	  static pthread_attr_t attr;
	  static int attr_inited = 0;
	  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_ithread_run, (void *)thread);
#else
	  pthread_create( &thread->thr, &attr, Perl_ithread_run, (void *)thread);
#endif
	}
#endif
	known_threads++;
	active_threads++;
	MUTEX_UNLOCK(&create_destruct_mutex);
	sv_2mortal(params);
	return ithread_to_SV(aTHX_ obj, thread, classname, FALSE);
}

SV*
Perl_ithread_self (pTHX_ SV *obj, char* Class)
{
    ithread *thread;
    PERL_THREAD_GETSPECIFIC(self_key,thread);
    return ithread_to_SV(aTHX_ obj, thread, Class, TRUE);
}

/*
 * Joins the thread this code needs to take the returnvalue from the
 * call_sv and send it back
 */

void
Perl_ithread_CLONE(pTHX_ SV *obj)
{
 if (SvROK(obj))
  {
   ithread *thread = SV_to_ithread(aTHX_ obj);
  }
 else
  {
   Perl_warn(aTHX_ "CLONE %" SVf,obj);
  }
}

AV*
Perl_ithread_join(pTHX_ SV *obj)
{
    ithread *thread = SV_to_ithread(aTHX_ obj);
    MUTEX_LOCK(&thread->mutex);
    if (thread->state & PERL_ITHR_DETACHED) {
	MUTEX_UNLOCK(&thread->mutex);
	Perl_croak(aTHX_ "Cannot join a detached thread");
    }
    else if (thread->state & PERL_ITHR_JOINED) {
	MUTEX_UNLOCK(&thread->mutex);
	Perl_croak(aTHX_ "Thread already joined");
    }
    else {
        AV* retparam;
#ifdef WIN32
	DWORD waitcode;
#else
	void *retval;
#endif
	MUTEX_UNLOCK(&thread->mutex);
#ifdef WIN32
	waitcode = WaitForSingleObject(thread->handle, INFINITE);
#else
	pthread_join(thread->thr,&retval);
#endif
	MUTEX_LOCK(&thread->mutex);
	
	/* sv_dup over the args */
	{
	  ithread*        current_thread;
	  AV* params = (AV*) SvRV(thread->params);	
	  CLONE_PARAMS clone_params;
	  clone_params.stashes = newAV();
	  clone_params.flags |= CLONEf_JOIN_IN;
	  PL_ptr_table = ptr_table_new();
	  PERL_THREAD_GETSPECIFIC(self_key,current_thread);
	  PERL_THREAD_SETSPECIFIC(self_key,thread);

	  {
	    I32 len = av_len(params)+1;
	    I32 i;
	    for(i = 0; i < len; i++) {
	      //	      sv_dump(SvRV(AvARRAY(params)[i]));
	    }
	  }

	  retparam = (AV*) sv_dup((SV*)params, &clone_params);
#if 0
	  {
	    I32 len = av_len(retparam)+1;
	    I32 i;
	    for(i = 0; i < len; i++) {
		sv_dump(SvRV(AvARRAY(retparam)[i]));
	    }
	  }
#endif
	  PERL_THREAD_SETSPECIFIC(self_key,current_thread);
	  SvREFCNT_dec(clone_params.stashes);
	  SvREFCNT_inc(retparam);
	  ptr_table_free(PL_ptr_table);
	  PL_ptr_table = NULL;

	}
	/* We have finished with it */
	thread->state |= PERL_ITHR_JOINED;
	MUTEX_UNLOCK(&thread->mutex);
    	sv_unmagic(SvRV(obj),PERL_MAGIC_shared_scalar);
	return retparam;
    }
    return (AV*)NULL;
}

void
Perl_ithread_DESTROY(pTHX_ SV *sv)
{
    ithread *thread = SV_to_ithread(aTHX_ sv);
    sv_unmagic(SvRV(sv),PERL_MAGIC_shared_scalar);
}

#endif /* USE_ITHREADS */

MODULE = threads		PACKAGE = threads	PREFIX = ithread_
PROTOTYPES: DISABLE

#ifdef USE_ITHREADS

void
ithread_new (classname, function_to_call, ...)
char *	classname
SV *	function_to_call
CODE:
{
    AV* params = newAV();
    if (items > 2) {
	int i;
	for(i = 2; i < items ; i++) {
	    av_push(params, SvREFCNT_inc(ST(i)));
	}
    }
    ST(0) = sv_2mortal(Perl_ithread_create(aTHX_ Nullsv, classname, function_to_call, newRV_noinc((SV*) params)));
    XSRETURN(1);
}

void
ithread_list(char *classname)
PPCODE:
{
  ithread *curr_thread;
  MUTEX_LOCK(&create_destruct_mutex);
  curr_thread = threads;
  if(curr_thread->tid != 0)	
    PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
  while(curr_thread) {
    curr_thread = curr_thread->next;
    if(curr_thread == threads)
      break;
    if(curr_thread->state & PERL_ITHR_DETACHED ||
       curr_thread->state & PERL_ITHR_JOINED)
         continue;
     PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
  }	
  MUTEX_UNLOCK(&create_destruct_mutex);
}


void
ithread_self(char *classname)
CODE:
{
	ST(0) = sv_2mortal(Perl_ithread_self(aTHX_ Nullsv,classname));
	XSRETURN(1);
}

int
ithread_tid(ithread *thread)

void
ithread_join(SV *obj)
PPCODE:
{
  AV* params = Perl_ithread_join(aTHX_ obj);
  int i;
  I32 len = AvFILL(params);
  for (i = 0; i <= len; i++) {
    SV* tmp = av_shift(params);
    XPUSHs(tmp);
    sv_2mortal(tmp);
  }
  SvREFCNT_dec(params);
}

void
yield(...)
CODE:
{
    YIELD;
}
	

void
ithread_detach(ithread *thread)

void
ithread_DESTROY(SV *thread)

#endif /* USE_ITHREADS */

BOOT:
{
#ifdef USE_ITHREADS
	ithread* thread;
	PL_perl_destruct_level = 2;
	PERL_THREAD_ALLOC_SPECIFIC(self_key);
	MUTEX_INIT(&create_destruct_mutex);
	MUTEX_LOCK(&create_destruct_mutex);
	PL_threadhook = &Perl_ithread_hook;
	thread  = PerlMemShared_malloc(sizeof(ithread));
	Zero(thread,1,ithread);
	PL_perl_destruct_level = 2;
	MUTEX_INIT(&thread->mutex);
	threads = thread;
	thread->next = thread;
        thread->prev = thread;
	thread->interp = aTHX;
	thread->count  = 1;  /* imortal */
	thread->tid = tid_counter++;
	known_threads++;
	active_threads++;
	thread->state = 1;
#ifdef WIN32
	thread->thr = GetCurrentThreadId();
#else
	thread->thr = pthread_self();
#endif

	PERL_THREAD_SETSPECIFIC(self_key,thread);
	MUTEX_UNLOCK(&create_destruct_mutex);
#endif /* USE_ITHREADS */
}
Commit	Line	Data
68795e93	1	#define PERL_NO_GET_CONTEXT
	2	#include "EXTERN.h"
	3	#include "perl.h"
	4	#include "XSUB.h"
	5
73e09c8f	6	#ifdef USE_ITHREADS
73e09c8f	7
68795e93	8	#ifdef WIN32
	9	#include <windows.h>
	10	#include <win32thread.h>
	11	#define PERL_THREAD_SETSPECIFIC(k,v) TlsSetValue(k,v)
	12	#define PERL_THREAD_GETSPECIFIC(k,v) v = TlsGetValue(k)
	13	#define PERL_THREAD_ALLOC_SPECIFIC(k) \
	14	STMT_START {\
	15	if((k = TlsAlloc()) == TLS_OUT_OF_INDEXES) {\
	16	PerlIO_printf(PerlIO_stderr(),"panic threads.h: TlsAlloc");\
	17	exit(1);\
	18	}\
	19	} STMT_END
	20	#else
	21	#include <pthread.h>
	22	#include <thread.h>
	23
	24	#define PERL_THREAD_SETSPECIFIC(k,v) pthread_setspecific(k,v)
	25	#ifdef OLD_PTHREADS_API
	26	#define PERL_THREAD_DETACH(t) pthread_detach(&(t))
	27	#define PERL_THREAD_GETSPECIFIC(k,v) pthread_getspecific(k,&v)
	28	#define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\
	29	if(pthread_keycreate(&(k),0)) {\
	30	PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\
	31	exit(1);\
	32	}\
	33	} STMT_END
	34	#else
	35	#define PERL_THREAD_DETACH(t) pthread_detach((t))
	36	#define PERL_THREAD_GETSPECIFIC(k,v) v = pthread_getspecific(k)
	37	#define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\
	38	if(pthread_key_create(&(k),0)) {\
	39	PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\
	40	exit(1);\
	41	}\
	42	} STMT_END
	43	#endif
	44	#endif
	45
62375a60	46	/* Values for 'state' member */
	47	#define PERL_ITHR_JOINABLE 0
	48	#define PERL_ITHR_DETACHED 1
	49	#define PERL_ITHR_FINISHED 4
	50	#define PERL_ITHR_JOINED 2
	51
68795e93	52	typedef struct ithread_s {
	53	struct ithread_s next; / next thread in the list */
	54	struct ithread_s prev; / prev thread in the list */
	55	PerlInterpreter interp; / The threads interpreter */
	56	I32 tid; /* threads module's thread id */
	57	perl_mutex mutex; /* mutex for updating things in this struct */
	58	I32 count; /* how many SVs have a reference to us */
62375a60	59	signed char state; /* are we detached ? */
a446a88f	60	int gimme; /* Context of create */
68795e93	61	SV* init_function; /* Code to run */
	62	SV* params; /* args to pass function */
	63	#ifdef WIN32
	64	DWORD thr; /* OS's idea if thread id */
	65	HANDLE handle; /* OS's waitable handle */
	66	#else
	67	pthread_t thr; /* OS's handle for the thread */
	68	#endif
	69	} ithread;
	70
	71	ithread *threads;
	72
	73	/* Macros to supply the aTHX_ in an embed.h like manner */
	74	#define ithread_join(thread) Perl_ithread_join(aTHX_ thread)
	75	#define ithread_DESTROY(thread) Perl_ithread_DESTROY(aTHX_ thread)
	76	#define ithread_CLONE(thread) Perl_ithread_CLONE(aTHX_ thread)
	77	#define ithread_detach(thread) Perl_ithread_detach(aTHX_ thread)
	78	#define ithread_tid(thread) ((thread)->tid)
f9dff5f5	79	#define ithread_yield(thread) (YIELD);
68795e93	80
58c2ef19	81	static perl_mutex create_destruct_mutex; /* protects the creation and destruction of threads*/
68795e93	82
68795e93	83	I32 tid_counter = 0;
62375a60	84	I32 known_threads = 0;
58c2ef19	85	I32 active_threads = 0;
68795e93	86	perl_key self_key;
	87
	88	/*
	89	* Clear up after thread is done with
	90	*/
	91	void
62375a60	92	Perl_ithread_destruct (pTHX_ ithread* thread, const char *why)
68795e93	93	{
3deee5e7	94	PerlInterpreter* destroyperl = NULL;
68795e93	95	MUTEX_LOCK(&thread->mutex);
62375a60	96	if (!thread->next) {
	97	Perl_croak(aTHX_ "panic: destruct destroyed thread %p (%s)",thread, why);
	98	}
68795e93	99	if (thread->count != 0) {
68795e93	100	MUTEX_UNLOCK(&thread->mutex);
d1400e48	101	return;
68795e93	102	}
58c2ef19	103	MUTEX_LOCK(&create_destruct_mutex);
68795e93	104	/* Remove from circular list of threads */
	105	if (thread->next == thread) {
	106	/* last one should never get here ? */
	107	threads = NULL;
	108	}
	109	else {
f42ad631	110	thread->next->prev = thread->prev;
f42ad631	111	thread->prev->next = thread->next;
68795e93	112	if (threads == thread) {
	113	threads = thread->next;
	114	}
62375a60	115	thread->next = NULL;
62375a60	116	thread->prev = NULL;
68795e93	117	}
62375a60	118	known_threads--;
62375a60	119	assert( known_threads >= 0 );
ba14dd9a	120	#if 0
62375a60	121	Perl_warn(aTHX_ "destruct %d @ %p by %p now %d",
62375a60	122	thread->tid,thread->interp,aTHX, known_threads);
ba14dd9a	123	#endif
62375a60	124	MUTEX_UNLOCK(&create_destruct_mutex);
62375a60	125	/* Thread is now disowned */
68795e93	126	if (thread->interp) {
1c3adb19	127	dTHXa(thread->interp);
68795e93	128	PERL_SET_CONTEXT(thread->interp);
1c3adb19	129	SvREFCNT_dec(thread->params);
1c3adb19	130	thread->params = Nullsv;
3deee5e7	131	destroyperl = thread->interp;
68795e93	132	thread->interp = NULL;
68795e93	133	}
d1400e48	134	MUTEX_UNLOCK(&thread->mutex);
1c3adb19	135	MUTEX_DESTROY(&thread->mutex);
1c3adb19	136	PerlMemShared_free(thread);
3deee5e7	137	if(destroyperl) {
1d784c90	138	ithread* current_thread;
	139	PERL_THREAD_GETSPECIFIC(self_key,current_thread);
	140	PERL_THREAD_SETSPECIFIC(self_key,thread);
3deee5e7	141	perl_destruct(destroyperl);
3deee5e7	142	perl_free(destroyperl);
1d784c90	143	PERL_THREAD_SETSPECIFIC(self_key,current_thread);
1d784c90	144
3deee5e7	145	}
64821230	146	PERL_SET_CONTEXT(aTHX);
68795e93	147	}
68795e93	148
62375a60	149	int
	150	Perl_ithread_hook(pTHX)
	151	{
	152	int veto_cleanup = 0;
	153	MUTEX_LOCK(&create_destruct_mutex);
	154	if (aTHX == PL_curinterp && active_threads != 1) {
c133c03f	155	Perl_warn(aTHX_ "A thread exited while %" IVdf " other threads were still running",
436c6dd3	156	(IV)active_threads);
62375a60	157	veto_cleanup = 1;
	158	}
	159	MUTEX_UNLOCK(&create_destruct_mutex);
	160	return veto_cleanup;
	161	}
	162
	163	void
	164	Perl_ithread_detach(pTHX_ ithread *thread)
	165	{
	166	MUTEX_LOCK(&thread->mutex);
	167	if (!(thread->state & (PERL_ITHR_DETACHED\|PERL_ITHR_JOINED))) {
	168	thread->state \|= PERL_ITHR_DETACHED;
	169	#ifdef WIN32
	170	CloseHandle(thread->handle);
	171	thread->handle = 0;
	172	#else
	173	PERL_THREAD_DETACH(thread->thr);
	174	#endif
	175	}
	176	if ((thread->state & PERL_ITHR_FINISHED) &&
	177	(thread->state & PERL_ITHR_DETACHED)) {
	178	MUTEX_UNLOCK(&thread->mutex);
	179	Perl_ithread_destruct(aTHX_ thread, "detach");
	180	}
	181	else {
	182	MUTEX_UNLOCK(&thread->mutex);
	183	}
	184	}
68795e93	185
	186	/* MAGIC (in mg.h sense) hooks */
	187
	188	int
	189	ithread_mg_get(pTHX_ SV sv, MAGIC mg)
	190	{
	191	ithread thread = (ithread ) mg->mg_ptr;
	192	SvIVX(sv) = PTR2IV(thread);
	193	SvIOK_on(sv);
	194	return 0;
	195	}
	196
	197	int
	198	ithread_mg_free(pTHX_ SV sv, MAGIC mg)
	199	{
	200	ithread thread = (ithread ) mg->mg_ptr;
	201	MUTEX_LOCK(&thread->mutex);
68795e93	202	thread->count--;
62375a60	203	if (thread->count == 0) {
1c3adb19	204	if(thread->state & PERL_ITHR_FINISHED &&
	205	(thread->state & PERL_ITHR_DETACHED \|\|
	206	thread->state & PERL_ITHR_JOINED))
	207	{
	208	MUTEX_UNLOCK(&thread->mutex);
	209	Perl_ithread_destruct(aTHX_ thread, "no reference");
	210	}
1ea20f42	211	else {
	212	MUTEX_UNLOCK(&thread->mutex);
	213	}
62375a60	214	}
	215	else {
	216	MUTEX_UNLOCK(&thread->mutex);
	217	}
68795e93	218	return 0;
	219	}
	220
	221	int
	222	ithread_mg_dup(pTHX_ MAGIC mg, CLONE_PARAMS param)
	223	{
	224	ithread thread = (ithread ) mg->mg_ptr;
	225	MUTEX_LOCK(&thread->mutex);
68795e93	226	thread->count++;
	227	MUTEX_UNLOCK(&thread->mutex);
	228	return 0;
	229	}
	230
	231	MGVTBL ithread_vtbl = {
	232	ithread_mg_get, /* get */
	233	0, /* set */
	234	0, /* len */
	235	0, /* clear */
	236	ithread_mg_free, /* free */
	237	0, /* copy */
	238	ithread_mg_dup /* dup */
	239	};
	240
47ba8780	241
47ba8780	242	/*
b1edfb69	243	* Starts executing the thread. Needs to clean up memory a tad better.
68795e93	244	* Passed as the C level function to run in the new thread
b1edfb69	245	*/
47ba8780	246
47ba8780	247	#ifdef WIN32
68795e93	248	THREAD_RET_TYPE
68795e93	249	Perl_ithread_run(LPVOID arg) {
47ba8780	250	#else
68795e93	251	void*
68795e93	252	Perl_ithread_run(void * arg) {
47ba8780	253	#endif
5b414d21	254	ithread* thread = (ithread*) arg;
47ba8780	255	dTHXa(thread->interp);
47ba8780	256	PERL_SET_CONTEXT(thread->interp);
68795e93	257	PERL_THREAD_SETSPECIFIC(self_key,thread);
47ba8780	258
68795e93	259	#if 0
	260	/* Far from clear messing with ->thr child-side is a good idea */
	261	MUTEX_LOCK(&thread->mutex);
47ba8780	262	#ifdef WIN32
	263	thread->thr = GetCurrentThreadId();
	264	#else
	265	thread->thr = pthread_self();
	266	#endif
68795e93	267	MUTEX_UNLOCK(&thread->mutex);
68795e93	268	#endif
47ba8780	269
47ba8780	270	PL_perl_destruct_level = 2;
4f896ddc	271
47ba8780	272	{
68795e93	273	AV* params = (AV*) SvRV(thread->params);
68795e93	274	I32 len = av_len(params)+1;
47ba8780	275	int i;
47ba8780	276	dSP;
47ba8780	277	ENTER;
	278	SAVETMPS;
	279	PUSHMARK(SP);
68795e93	280	for(i = 0; i < len; i++) {
68795e93	281	XPUSHs(av_shift(params));
47ba8780	282	}
47ba8780	283	PUTBACK;
a446a88f	284	len = call_sv(thread->init_function, thread->gimme\|G_EVAL);
0405e91e	285
68795e93	286	SPAGAIN;
a446a88f	287	for (i=len-1; i >= 0; i--) {
e1c44605	288	SV *sv = POPs;
e1c44605	289	av_store(params, i, SvREFCNT_inc(sv));
a446a88f	290	}
a446a88f	291	if (SvTRUE(ERRSV)) {
6b3c7930	292	Perl_warn(aTHX_ "thread failed to start: %" SVf, ERRSV);
a446a88f	293	}
47ba8780	294	FREETMPS;
47ba8780	295	LEAVE;
68795e93	296	SvREFCNT_dec(thread->init_function);
47ba8780	297	}
47ba8780	298
fd58862f	299	PerlIO_flush((PerlIO*)NULL);
68795e93	300	MUTEX_LOCK(&thread->mutex);
62375a60	301	thread->state \|= PERL_ITHR_FINISHED;
	302
	303	if (thread->state & PERL_ITHR_DETACHED) {
47ba8780	304	MUTEX_UNLOCK(&thread->mutex);
62375a60	305	Perl_ithread_destruct(aTHX_ thread, "detached finish");
47ba8780	306	} else {
62375a60	307	MUTEX_UNLOCK(&thread->mutex);
62375a60	308	}
91604d21	309	MUTEX_LOCK(&create_destruct_mutex);
	310	active_threads--;
	311	assert( active_threads >= 0 );
	312	MUTEX_UNLOCK(&create_destruct_mutex);
	313
47ba8780	314	#ifdef WIN32
47ba8780	315	return (DWORD)0;
e8f2bb9a	316	#else
e8f2bb9a	317	return 0;
47ba8780	318	#endif
68795e93	319	}
	320
	321	SV *
	322	ithread_to_SV(pTHX_ SV obj, ithread thread, char *classname, bool inc)
	323	{
	324	SV *sv;
	325	MAGIC *mg;
	326	if (inc) {
	327	MUTEX_LOCK(&thread->mutex);
	328	thread->count++;
68795e93	329	MUTEX_UNLOCK(&thread->mutex);
	330	}
	331	if (!obj)
	332	obj = newSV(0);
	333	sv = newSVrv(obj,classname);
	334	sv_setiv(sv,PTR2IV(thread));
	335	mg = sv_magicext(sv,Nullsv,PERL_MAGIC_shared_scalar,&ithread_vtbl,(char *)thread,0);
	336	mg->mg_flags \|= MGf_DUP;
	337	SvREADONLY_on(sv);
	338	return obj;
	339	}
47ba8780	340
68795e93	341	ithread *
	342	SV_to_ithread(pTHX_ SV *sv)
	343	{
	344	ithread *thread;
	345	if (SvROK(sv))
	346	{
	347	thread = INT2PTR(ithread*, SvIV(SvRV(sv)));
	348	}
	349	else
	350	{
	351	PERL_THREAD_GETSPECIFIC(self_key,thread);
	352	}
	353	return thread;
47ba8780	354	}
47ba8780	355
47ba8780	356	/*
68795e93	357	* iThread->create(); ( aka iThread->new() )
68795e93	358	* Called in context of parent thread
b1edfb69	359	*/
47ba8780	360
68795e93	361	SV *
	362	Perl_ithread_create(pTHX_ SV obj, char classname, SV* init_function, SV* params)
	363	{
	364	ithread* thread;
	365	CLONE_PARAMS clone_param;
1d784c90	366	ithread* current_thread;
1d784c90	367	PERL_THREAD_GETSPECIFIC(self_key,current_thread);
58c2ef19	368	MUTEX_LOCK(&create_destruct_mutex);
68795e93	369	thread = PerlMemShared_malloc(sizeof(ithread));
	370	Zero(thread,1,ithread);
	371	thread->next = threads;
	372	thread->prev = threads->prev;
f42ad631	373	threads->prev = thread;
68795e93	374	thread->prev->next = thread;
	375	/* Set count to 1 immediately in case thread exits before
	376	* we return to caller !
	377	*/
	378	thread->count = 1;
	379	MUTEX_INIT(&thread->mutex);
	380	thread->tid = tid_counter++;
a446a88f	381	thread->gimme = GIMME_V;
4f896ddc	382
68795e93	383	/* "Clone" our interpreter into the thread's interpreter
	384	* This gives thread access to "static data" and code.
	385	*/
47ba8780	386
68795e93	387	PerlIO_flush((PerlIO*)NULL);
1d784c90	388	PERL_THREAD_SETSPECIFIC(self_key,thread);
47ba8780	389	#ifdef WIN32
68795e93	390	thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE \| CLONEf_CLONE_HOST);
47ba8780	391	#else
68795e93	392	thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE);
47ba8780	393	#endif
ba14dd9a	394	/* perl_clone leaves us in new interpreter's context.
c8dae523	395	As it is tricky to spot an implicit aTHX, create a new scope
a446a88f	396	with aTHX matching the context for the duration of
ba14dd9a	397	our work for new interpreter.
	398	*/
	399	{
	400	dTHXa(thread->interp);
58c2ef19	401	/* Here we remove END blocks since they should only run
62375a60	402	in the thread they are created
58c2ef19	403	*/
	404	SvREFCNT_dec(PL_endav);
	405	PL_endav = newAV();
d1400e48	406	clone_param.flags = 0;
ba14dd9a	407	thread->init_function = sv_dup(init_function, &clone_param);
	408	if (SvREFCNT(thread->init_function) == 0) {
	409	SvREFCNT_inc(thread->init_function);
d1400e48	410	}
ba14dd9a	411
	412	thread->params = sv_dup(params, &clone_param);
	413	SvREFCNT_inc(thread->params);
	414	SvTEMP_off(thread->init_function);
	415	ptr_table_free(PL_ptr_table);
	416	PL_ptr_table = NULL;
ffb29f90	417	PL_exit_flags \|= PERL_EXIT_DESTRUCT_END;
ba14dd9a	418	}
1d784c90	419	PERL_THREAD_SETSPECIFIC(self_key,current_thread);
68795e93	420	PERL_SET_CONTEXT(aTHX);
47ba8780	421
68795e93	422	/* Start the thread */
47ba8780	423
	424	#ifdef WIN32
	425
68795e93	426	thread->handle = CreateThread(NULL, 0, Perl_ithread_run,
47ba8780	427	(LPVOID)thread, 0, &thread->thr);
47ba8780	428
82c40bf6	429	#else
fa26028c	430	{
	431	static pthread_attr_t attr;
	432	static int attr_inited = 0;
fa26028c	433	static int attr_joinable = PTHREAD_CREATE_JOINABLE;
	434	if (!attr_inited) {
	435	attr_inited = 1;
	436	pthread_attr_init(&attr);
	437	}
	438	# ifdef PTHREAD_ATTR_SETDETACHSTATE
	439	PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable);
	440	# endif
3eb37d38	441	# ifdef THREAD_CREATE_NEEDS_STACK
	442	if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK))
	443	croak("panic: pthread_attr_setstacksize failed");
	444	# endif
	445
3ad0b7d6	446	#ifdef OLD_PTHREADS_API
68795e93	447	pthread_create( &thread->thr, attr, Perl_ithread_run, (void *)thread);
47ba8780	448	#else
68795e93	449	pthread_create( &thread->thr, &attr, Perl_ithread_run, (void *)thread);
47ba8780	450	#endif
3ad0b7d6	451	}
82c40bf6	452	#endif
62375a60	453	known_threads++;
58c2ef19	454	active_threads++;
58c2ef19	455	MUTEX_UNLOCK(&create_destruct_mutex);
95393226	456	sv_2mortal(params);
68795e93	457	return ithread_to_SV(aTHX_ obj, thread, classname, FALSE);
68795e93	458	}
47ba8780	459
68795e93	460	SV*
	461	Perl_ithread_self (pTHX_ SV obj, char Class)
	462	{
	463	ithread *thread;
	464	PERL_THREAD_GETSPECIFIC(self_key,thread);
	465	return ithread_to_SV(aTHX_ obj, thread, Class, TRUE);
47ba8780	466	}
	467
	468	/*
e1c44605	469	* Joins the thread this code needs to take the returnvalue from the
68795e93	470	* call_sv and send it back
b1edfb69	471	*/
47ba8780	472
68795e93	473	void
	474	Perl_ithread_CLONE(pTHX_ SV *obj)
	475	{
	476	if (SvROK(obj))
	477	{
	478	ithread *thread = SV_to_ithread(aTHX_ obj);
	479	}
	480	else
	481	{
436c6dd3	482	Perl_warn(aTHX_ "CLONE %" SVf,obj);
68795e93	483	}
47ba8780	484	}
47ba8780	485
62375a60	486	AV*
68795e93	487	Perl_ithread_join(pTHX_ SV *obj)
	488	{
	489	ithread *thread = SV_to_ithread(aTHX_ obj);
	490	MUTEX_LOCK(&thread->mutex);
62375a60	491	if (thread->state & PERL_ITHR_DETACHED) {
a446a88f	492	MUTEX_UNLOCK(&thread->mutex);
	493	Perl_croak(aTHX_ "Cannot join a detached thread");
	494	}
62375a60	495	else if (thread->state & PERL_ITHR_JOINED) {
a446a88f	496	MUTEX_UNLOCK(&thread->mutex);
	497	Perl_croak(aTHX_ "Thread already joined");
	498	}
	499	else {
e1c44605	500	AV* retparam;
47ba8780	501	#ifdef WIN32
47ba8780	502	DWORD waitcode;
47ba8780	503	#else
47ba8780	504	void *retval;
47ba8780	505	#endif
47ba8780	506	MUTEX_UNLOCK(&thread->mutex);
68795e93	507	#ifdef WIN32
	508	waitcode = WaitForSingleObject(thread->handle, INFINITE);
	509	#else
	510	pthread_join(thread->thr,&retval);
	511	#endif
47ba8780	512	MUTEX_LOCK(&thread->mutex);
e1c44605	513
62375a60	514	/* sv_dup over the args */
e1c44605	515	{
1d784c90	516	ithread* current_thread;
62375a60	517	AV* params = (AV*) SvRV(thread->params);
e1c44605	518	CLONE_PARAMS clone_params;
3275ba96	519	clone_params.stashes = newAV();
0405e91e	520	clone_params.flags \|= CLONEf_JOIN_IN;
e1c44605	521	PL_ptr_table = ptr_table_new();
1d784c90	522	PERL_THREAD_GETSPECIFIC(self_key,current_thread);
1d784c90	523	PERL_THREAD_SETSPECIFIC(self_key,thread);
0405e91e	524
	525	{
	526	I32 len = av_len(params)+1;
	527	I32 i;
	528	for(i = 0; i < len; i++) {
	529	// sv_dump(SvRV(AvARRAY(params)[i]));
	530	}
	531	}
	532
e1c44605	533	retparam = (AV) sv_dup((SV)params, &clone_params);
b4cb676b	534	#if 0
0405e91e	535	{
	536	I32 len = av_len(retparam)+1;
	537	I32 i;
	538	for(i = 0; i < len; i++) {
b4cb676b	539	sv_dump(SvRV(AvARRAY(retparam)[i]));
0405e91e	540	}
0405e91e	541	}
b4cb676b	542	#endif
1d784c90	543	PERL_THREAD_SETSPECIFIC(self_key,current_thread);
3275ba96	544	SvREFCNT_dec(clone_params.stashes);
e1c44605	545	SvREFCNT_inc(retparam);
	546	ptr_table_free(PL_ptr_table);
	547	PL_ptr_table = NULL;
	548
	549	}
a446a88f	550	/* We have finished with it */
62375a60	551	thread->state \|= PERL_ITHR_JOINED;
47ba8780	552	MUTEX_UNLOCK(&thread->mutex);
9684265f	553	sv_unmagic(SvRV(obj),PERL_MAGIC_shared_scalar);
e1c44605	554	return retparam;
68795e93	555	}
e1c44605	556	return (AV*)NULL;
47ba8780	557	}
47ba8780	558
68795e93	559	void
68795e93	560	Perl_ithread_DESTROY(pTHX_ SV *sv)
	561	{
	562	ithread *thread = SV_to_ithread(aTHX_ sv);
68795e93	563	sv_unmagic(SvRV(sv),PERL_MAGIC_shared_scalar);
68795e93	564	}
8222d950	565
73e09c8f	566	#endif /* USE_ITHREADS */
e1c44605	567
68795e93	568	MODULE = threads PACKAGE = threads PREFIX = ithread_
68795e93	569	PROTOTYPES: DISABLE
8222d950	570
73e09c8f	571	#ifdef USE_ITHREADS
73e09c8f	572
68795e93	573	void
	574	ithread_new (classname, function_to_call, ...)
	575	char * classname
	576	SV * function_to_call
	577	CODE:
	578	{
	579	AV* params = newAV();
	580	if (items > 2) {
	581	int i;
	582	for(i = 2; i < items ; i++) {
95393226	583	av_push(params, SvREFCNT_inc(ST(i)));
68795e93	584	}
	585	}
	586	ST(0) = sv_2mortal(Perl_ithread_create(aTHX_ Nullsv, classname, function_to_call, newRV_noinc((SV*) params)));
	587	XSRETURN(1);
	588	}
8222d950	589
68795e93	590	void
678a9b6c	591	ithread_list(char *classname)
	592	PPCODE:
	593	{
	594	ithread *curr_thread;
	595	MUTEX_LOCK(&create_destruct_mutex);
	596	curr_thread = threads;
5eb9fe8f	597	if(curr_thread->tid != 0)
5eb9fe8f	598	PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
678a9b6c	599	while(curr_thread) {
678a9b6c	600	curr_thread = curr_thread->next;
	601	if(curr_thread == threads)
	602	break;
6794f985	603	if(curr_thread->state & PERL_ITHR_DETACHED \|\|
5eb9fe8f	604	curr_thread->state & PERL_ITHR_JOINED)
	605	continue;
	606	PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
678a9b6c	607	}
	608	MUTEX_UNLOCK(&create_destruct_mutex);
	609	}
	610
	611
	612	void
68795e93	613	ithread_self(char *classname)
	614	CODE:
	615	{
	616	ST(0) = sv_2mortal(Perl_ithread_self(aTHX_ Nullsv,classname));
	617	XSRETURN(1);
	618	}
47ba8780	619
47ba8780	620	int
68795e93	621	ithread_tid(ithread *thread)
47ba8780	622
47ba8780	623	void
68795e93	624	ithread_join(SV *obj)
e1c44605	625	PPCODE:
	626	{
	627	AV* params = Perl_ithread_join(aTHX_ obj);
	628	int i;
	629	I32 len = AvFILL(params);
	630	for (i = 0; i <= len; i++) {
1c3adb19	631	SV* tmp = av_shift(params);
	632	XPUSHs(tmp);
	633	sv_2mortal(tmp);
e1c44605	634	}
	635	SvREFCNT_dec(params);
	636	}
	637
f9dff5f5	638	void
9d7debe1	639	yield(...)
70f2e746	640	CODE:
	641	{
	642	YIELD;
	643	}
	644
47ba8780	645
47ba8780	646	void
68795e93	647	ithread_detach(ithread *thread)
47ba8780	648
47ba8780	649	void
68795e93	650	ithread_DESTROY(SV *thread)
68795e93	651
73e09c8f	652	#endif /* USE_ITHREADS */
73e09c8f	653
68795e93	654	BOOT:
68795e93	655	{
73e09c8f	656	#ifdef USE_ITHREADS
68795e93	657	ithread* thread;
e1c44605	658	PL_perl_destruct_level = 2;
68795e93	659	PERL_THREAD_ALLOC_SPECIFIC(self_key);
58c2ef19	660	MUTEX_INIT(&create_destruct_mutex);
58c2ef19	661	MUTEX_LOCK(&create_destruct_mutex);
62375a60	662	PL_threadhook = &Perl_ithread_hook;
68795e93	663	thread = PerlMemShared_malloc(sizeof(ithread));
	664	Zero(thread,1,ithread);
	665	PL_perl_destruct_level = 2;
	666	MUTEX_INIT(&thread->mutex);
	667	threads = thread;
	668	thread->next = thread;
	669	thread->prev = thread;
	670	thread->interp = aTHX;
	671	thread->count = 1; /* imortal */
	672	thread->tid = tid_counter++;
62375a60	673	known_threads++;
58c2ef19	674	active_threads++;
62375a60	675	thread->state = 1;
68795e93	676	#ifdef WIN32
	677	thread->thr = GetCurrentThreadId();
	678	#else
	679	thread->thr = pthread_self();
	680	#endif
62375a60	681
68795e93	682	PERL_THREAD_SETSPECIFIC(self_key,thread);
58c2ef19	683	MUTEX_UNLOCK(&create_destruct_mutex);
73e09c8f	684	#endif /* USE_ITHREADS */
68795e93	685	}
68795e93	686