1			/*
     2			 * This file was generated automatically by ExtUtils::ParseXS version 2.10 from the
     3			 * contents of threads.xs. Do not edit this file, edit threads.xs instead.
     4			 *
     5			 *	ANY CHANGES MADE HERE WILL BE LOST! 
     6			 *
     7			 */
     8			
     9			#line 1 "threads.xs"
    10			#define PERL_NO_GET_CONTEXT
    11			#include "EXTERN.h"
    12			#include "perl.h"
    13			#include "XSUB.h"
    14			
    15			#ifdef USE_ITHREADS
    16			
    17			
    18			#ifdef WIN32
    19			#include <windows.h>
    20			#include <win32thread.h>
    21			#else
    22			#ifdef OS2
    23			typedef perl_os_thread pthread_t;
    24			#else
    25			#include <pthread.h>
    26			#endif
    27			#include <thread.h>
    28			#define PERL_THREAD_SETSPECIFIC(k,v) pthread_setspecific(k,v)
    29			#ifdef OLD_PTHREADS_API
    30			#define PERL_THREAD_DETACH(t) pthread_detach(&(t))
    31			#else
    32			#define PERL_THREAD_DETACH(t) pthread_detach((t))
    33			#endif  /* OLD_PTHREADS_API */
    34			#endif
    35			
    36			
    37			
    38			
    39			/* Values for 'state' member */
    40			#define PERL_ITHR_JOINABLE		0
    41			#define PERL_ITHR_DETACHED		1
    42			#define PERL_ITHR_FINISHED		4
    43			#define PERL_ITHR_JOINED		2
    44			
    45			typedef struct ithread_s {
    46			    struct ithread_s *next;	/* Next thread in the list */
    47			    struct ithread_s *prev;	/* Prev thread in the list */
    48			    PerlInterpreter *interp;	/* The threads interpreter */
    49			    I32 tid;              	/* Threads module's thread id */
    50			    perl_mutex mutex; 		/* Mutex for updating things in this struct */
    51			    I32 count;			/* How many SVs have a reference to us */
    52			    signed char state;		/* Are we detached ? */
    53			    int gimme;			/* Context of create */
    54			    SV* init_function;          /* Code to run */
    55			    SV* params;                 /* Args to pass function */
    56			#ifdef WIN32
    57				DWORD	thr;            /* OS's idea if thread id */
    58				HANDLE handle;          /* OS's waitable handle */
    59			#else
    60			  	pthread_t thr;          /* OS's handle for the thread */
    61			#endif
    62			} ithread;
    63			
    64			ithread *threads;
    65			
    66			/* Macros to supply the aTHX_ in an embed.h like manner */
    67			#define ithread_join(thread)		Perl_ithread_join(aTHX_ thread)
    68			#define ithread_DESTROY(thread)		Perl_ithread_DESTROY(aTHX_ thread)
    69			#define ithread_CLONE(thread)		Perl_ithread_CLONE(aTHX_ thread)
    70			#define ithread_detach(thread)		Perl_ithread_detach(aTHX_ thread)
    71			#define ithread_tid(thread)		((thread)->tid)
    72			#define ithread_yield(thread)		(YIELD);
    73			
    74			static perl_mutex create_destruct_mutex;  /* protects the creation and destruction of threads*/
    75			
    76			I32 tid_counter = 0;
    77			I32 known_threads = 0;
    78			I32 active_threads = 0;
    79			
    80			
    81			void Perl_ithread_set (pTHX_ ithread* thread)
    82			{
    83			  SV* thread_sv = newSViv(PTR2IV(thread));
    84			  if(!hv_store(PL_modglobal, "threads::self", 12, thread_sv,0)) {
    85			    croak("%s\n","Internal error, couldn't set TLS");
    86			  }
    87			}
    88			
    89			ithread* Perl_ithread_get (pTHX) {
    90			  SV** thread_sv = hv_fetch(PL_modglobal, "threads::self",12,0);
    91			  if(!thread_sv) {
    92			    croak("%s\n","Internal error, couldn't get TLS");
    93			  }
    94			  return INT2PTR(ithread*,SvIV(*thread_sv));
    95			}
    96			
    97			
    98			
    99			/*
   100			 *  Clear up after thread is done with
   101			 */
   102			void
   103			Perl_ithread_destruct (pTHX_ ithread* thread, const char *why)
   104			{
   105			        PerlInterpreter *freeperl = NULL;
   106				MUTEX_LOCK(&thread->mutex);
   107				if (!thread->next) {
   108				    Perl_croak(aTHX_ "panic: destruct destroyed thread %p (%s)",thread, why);
   109				}
   110				if (thread->count != 0) {
   111					MUTEX_UNLOCK(&thread->mutex);
   112					return;
   113				}
   114				MUTEX_LOCK(&create_destruct_mutex);
   115				/* Remove from circular list of threads */
   116				if (thread->next == thread) {
   117				    /* last one should never get here ? */
   118				    threads = NULL;
   119			        }
   120				else {
   121				    thread->next->prev = thread->prev;
   122				    thread->prev->next = thread->next;
   123				    if (threads == thread) {
   124					threads = thread->next;
   125				    }
   126				    thread->next = NULL;
   127				    thread->prev = NULL;
   128				}
   129				known_threads--;
   130				assert( known_threads >= 0 );
   131			#if 0
   132			        Perl_warn(aTHX_ "destruct %d @ %p by %p now %d",
   133				          thread->tid,thread->interp,aTHX, known_threads);
   134			#endif
   135				MUTEX_UNLOCK(&create_destruct_mutex);
   136				/* Thread is now disowned */
   137			
   138				if(thread->interp) {
   139				    dTHXa(thread->interp);
   140				    ithread*        current_thread;
   141			#ifdef OEMVS
   142				    void *ptr;
   143			#endif
   144				    PERL_SET_CONTEXT(thread->interp);
   145				    current_thread = Perl_ithread_get(aTHX);
   146				    Perl_ithread_set(aTHX_ thread);
   147			
   148			
   149			
   150				    
   151				    SvREFCNT_dec(thread->params);
   152			
   153			
   154			
   155				    thread->params = Nullsv;
   156				    perl_destruct(thread->interp);
   157			            freeperl = thread->interp;
   158				    thread->interp = NULL;
   159				}
   160				MUTEX_UNLOCK(&thread->mutex);
   161				MUTEX_DESTROY(&thread->mutex);
   162			#ifdef WIN32
   163				if (thread->handle)
   164				    CloseHandle(thread->handle);
   165				thread->handle = 0;
   166			#endif
   167			        PerlMemShared_free(thread);
   168			        if (freeperl)
   169			            perl_free(freeperl);
   170			
   171				PERL_SET_CONTEXT(aTHX);
   172			}
   173			
   174			int
   175			Perl_ithread_hook(pTHX)
   176			{
   177			    int veto_cleanup = 0;
   178			    MUTEX_LOCK(&create_destruct_mutex);
   179			    if (aTHX == PL_curinterp && active_threads != 1) {
   180				Perl_warn(aTHX_ "A thread exited while %" IVdf " threads were running",
   181									(IV)active_threads);
   182				veto_cleanup = 1;
   183			    }
   184			    MUTEX_UNLOCK(&create_destruct_mutex);
   185			    return veto_cleanup;
   186			}
   187			
   188			void
   189			Perl_ithread_detach(pTHX_ ithread *thread)
   190			{
   191			    MUTEX_LOCK(&thread->mutex);
   192			    if (!(thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) {
   193				thread->state |= PERL_ITHR_DETACHED;
   194			#ifdef WIN32
   195				CloseHandle(thread->handle);
   196				thread->handle = 0;
   197			#else
   198				PERL_THREAD_DETACH(thread->thr);
   199			#endif
   200			    }
   201			    if ((thread->state & PERL_ITHR_FINISHED) &&
   202			        (thread->state & PERL_ITHR_DETACHED)) {
   203				MUTEX_UNLOCK(&thread->mutex);
   204				Perl_ithread_destruct(aTHX_ thread, "detach");
   205			    }
   206			    else {
   207				MUTEX_UNLOCK(&thread->mutex);
   208			    }
   209			}
   210			
   211			/* MAGIC (in mg.h sense) hooks */
   212			
   213			int
   214			ithread_mg_get(pTHX_ SV *sv, MAGIC *mg)
   215			{
   216			    ithread *thread = (ithread *) mg->mg_ptr;
   217			    SvIV_set(sv, PTR2IV(thread));
   218			    SvIOK_on(sv);
   219			    return 0;
   220			}
   221			
   222			int
   223			ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
   224			{
   225			    ithread *thread = (ithread *) mg->mg_ptr;
   226			    MUTEX_LOCK(&thread->mutex);
   227			    thread->count--;
   228			    if (thread->count == 0) {
   229			       if(thread->state & PERL_ITHR_FINISHED &&
   230			          (thread->state & PERL_ITHR_DETACHED ||
   231			           thread->state & PERL_ITHR_JOINED))
   232			       {
   233			            MUTEX_UNLOCK(&thread->mutex);
   234			            Perl_ithread_destruct(aTHX_ thread, "no reference");
   235			       }
   236			       else {
   237				    MUTEX_UNLOCK(&thread->mutex);
   238			       }    
   239			    }
   240			    else {
   241				MUTEX_UNLOCK(&thread->mutex);
   242			    }
   243			    return 0;
   244			}
   245			
   246			int
   247			ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
   248			{
   249			    ithread *thread = (ithread *) mg->mg_ptr;
   250			    MUTEX_LOCK(&thread->mutex);
   251			    thread->count++;
   252			    MUTEX_UNLOCK(&thread->mutex);
   253			    return 0;
   254			}
   255			
   256			MGVTBL ithread_vtbl = {
   257			 ithread_mg_get,	/* get */
   258			 0,			/* set */
   259			 0,			/* len */
   260			 0,			/* clear */
   261			 ithread_mg_free,	/* free */
   262			 0,			/* copy */
   263			 ithread_mg_dup		/* dup */
   264			};
   265			
   266			
   267			/*
   268			 *	Starts executing the thread. Needs to clean up memory a tad better.
   269			 *      Passed as the C level function to run in the new thread
   270			 */
   271			
   272			#ifdef WIN32
   273			THREAD_RET_TYPE
   274			Perl_ithread_run(LPVOID arg) {
   275			#else
   276			void*
   277			Perl_ithread_run(void * arg) {
   278			#endif
   279				ithread* thread = (ithread*) arg;
   280				dTHXa(thread->interp);
   281				PERL_SET_CONTEXT(thread->interp);
   282				Perl_ithread_set(aTHX_ thread);
   283			
   284			#if 0
   285				/* Far from clear messing with ->thr child-side is a good idea */
   286				MUTEX_LOCK(&thread->mutex);
   287			#ifdef WIN32
   288				thread->thr = GetCurrentThreadId();
   289			#else
   290				thread->thr = pthread_self();
   291			#endif
   292			 	MUTEX_UNLOCK(&thread->mutex);
   293			#endif
   294			
   295				PL_perl_destruct_level = 2;
   296			
   297				{
   298					AV* params = (AV*) SvRV(thread->params);
   299					I32 len = av_len(params)+1;
   300					int i;
   301					dSP;
   302					ENTER;
   303					SAVETMPS;
   304					PUSHMARK(SP);
   305					for(i = 0; i < len; i++) {
   306					    XPUSHs(av_shift(params));
   307					}
   308					PUTBACK;
   309					len = call_sv(thread->init_function, thread->gimme|G_EVAL);
   310			
   311					SPAGAIN;
   312					for (i=len-1; i >= 0; i--) {
   313					  SV *sv = POPs;
   314					  av_store(params, i, SvREFCNT_inc(sv));
   315					}
   316					if (SvTRUE(ERRSV)) {
   317					    Perl_warn(aTHX_ "thread failed to start: %" SVf, ERRSV);
   318					}
   319					FREETMPS;
   320					LEAVE;
   321					SvREFCNT_dec(thread->init_function);
   322				}
   323			
   324				PerlIO_flush((PerlIO*)NULL);
   325				MUTEX_LOCK(&thread->mutex);
   326				thread->state |= PERL_ITHR_FINISHED;
   327			
   328				if (thread->state & PERL_ITHR_DETACHED) {
   329					MUTEX_UNLOCK(&thread->mutex);
   330					Perl_ithread_destruct(aTHX_ thread, "detached finish");
   331				} else {
   332					MUTEX_UNLOCK(&thread->mutex);
   333				}
   334				MUTEX_LOCK(&create_destruct_mutex);
   335				active_threads--;
   336				assert( active_threads >= 0 );
   337				MUTEX_UNLOCK(&create_destruct_mutex);
   338			
   339			#ifdef WIN32
   340				return (DWORD)0;
   341			#else
   342				return 0;
   343			#endif
   344			}
   345			
   346			SV *
   347			ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc)
   348			{
   349			    SV *sv;
   350			    MAGIC *mg;
   351			    if (inc) {
   352				MUTEX_LOCK(&thread->mutex);
   353				thread->count++;
   354				MUTEX_UNLOCK(&thread->mutex);
   355			    }
   356			    if (!obj)
   357			     obj = newSV(0);
   358			    sv = newSVrv(obj,classname);
   359			    sv_setiv(sv,PTR2IV(thread));
   360			    mg = sv_magicext(sv,Nullsv,PERL_MAGIC_shared_scalar,&ithread_vtbl,(char *)thread,0);
   361			    mg->mg_flags |= MGf_DUP;
   362			    SvREADONLY_on(sv);
   363			    return obj;
   364			}
   365			
   366			ithread *
   367			SV_to_ithread(pTHX_ SV *sv)
   368			{
   369			    if (SvROK(sv))
   370			     {
   371			      return INT2PTR(ithread*, SvIV(SvRV(sv)));
   372			     }
   373			    else
   374			     {
   375			      return Perl_ithread_get(aTHX);
   376			     }
   377			}
   378			
   379			/*
   380			 * ithread->create(); ( aka ithread->new() )
   381			 * Called in context of parent thread
   382			 */
   383			
   384			SV *
   385			Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* params)
   386			{
   387				ithread*	thread;
   388				CLONE_PARAMS	clone_param;
   389				ithread*        current_thread = Perl_ithread_get(aTHX);
   390			
   391				SV**            tmps_tmp = PL_tmps_stack;
   392				I32             tmps_ix  = PL_tmps_ix;
   393			#ifndef WIN32
   394				int		failure;
   395				const char*	panic = NULL;
   396			#endif
   397			
   398			
   399				MUTEX_LOCK(&create_destruct_mutex);
   400				thread = (ithread *) PerlMemShared_malloc(sizeof(ithread));
   401				if (!thread) {	
   402				    MUTEX_UNLOCK(&create_destruct_mutex);
   403				    PerlLIO_write(PerlIO_fileno(Perl_error_log),
   404						  PL_no_mem, strlen(PL_no_mem));
   405				    my_exit(1);
   406				}
   407				Zero(thread,1,ithread);
   408				thread->next = threads;
   409				thread->prev = threads->prev;
   410				threads->prev = thread;
   411				thread->prev->next = thread;
   412				/* Set count to 1 immediately in case thread exits before
   413				 * we return to caller !
   414				 */
   415				thread->count = 1;
   416				MUTEX_INIT(&thread->mutex);
   417				thread->tid = tid_counter++;
   418				thread->gimme = GIMME_V;
   419			
   420				/* "Clone" our interpreter into the thread's interpreter
   421				 * This gives thread access to "static data" and code.
   422				 */
   423			
   424				PerlIO_flush((PerlIO*)NULL);
   425				Perl_ithread_set(aTHX_ thread);
   426			
   427				SAVEBOOL(PL_srand_called); /* Save this so it becomes the correct
   428				                              value */
   429				PL_srand_called = FALSE; /* Set it to false so we can detect
   430				                            if it gets set during the clone */
   431			
   432			#ifdef WIN32
   433				thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST);
   434			#else
   435				thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE);
   436			#endif
   437				/* perl_clone leaves us in new interpreter's context.
   438				   As it is tricky to spot an implicit aTHX, create a new scope
   439				   with aTHX matching the context for the duration of
   440				   our work for new interpreter.
   441				 */
   442				{
   443				    dTHXa(thread->interp);
   444			
   445			            /* Here we remove END blocks since they should only run
   446				       in the thread they are created
   447			            */
   448			            SvREFCNT_dec(PL_endav);
   449			            PL_endav = newAV();
   450			            clone_param.flags = 0;
   451				    thread->init_function = sv_dup(init_function, &clone_param);
   452				    if (SvREFCNT(thread->init_function) == 0) {
   453					SvREFCNT_inc(thread->init_function);
   454				    }
   455				    
   456			
   457			
   458				    thread->params = sv_dup(params, &clone_param);
   459				    SvREFCNT_inc(thread->params);
   460			
   461			
   462				    /* The code below checks that anything living on
   463				       the tmps stack and has been cloned (so it lives in the
   464				       ptr_table) has a refcount higher than 0
   465			
   466				       If the refcount is 0 it means that a something on the
   467				       stack/context was holding a reference to it and
   468				       since we init_stacks() in perl_clone that won't get
   469				       cleaned and we will get a leaked scalar.
   470				       The reason it was cloned was that it lived on the
   471				       @_ stack.
   472			
   473				       Example of this can be found in bugreport 15837
   474				       where calls in the parameter list end up as a temp
   475			
   476				       One could argue that this fix should be in perl_clone
   477				    */
   478				       
   479			
   480				    while (tmps_ix > 0) { 
   481				      SV* sv = (SV*)ptr_table_fetch(PL_ptr_table, tmps_tmp[tmps_ix]);
   482				      tmps_ix--;
   483				      if (sv && SvREFCNT(sv) == 0) {
   484					SvREFCNT_inc(sv);
   485					SvREFCNT_dec(sv);
   486				      }
   487				    }
   488				    
   489			
   490			
   491				    SvTEMP_off(thread->init_function);
   492				    ptr_table_free(PL_ptr_table);
   493				    PL_ptr_table = NULL;
   494				    PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
   495				}
   496				Perl_ithread_set(aTHX_ current_thread);
   497				PERL_SET_CONTEXT(aTHX);
   498			
   499				/* Start the thread */
   500			
   501			#ifdef WIN32
   502				thread->handle = CreateThread(NULL, 0, Perl_ithread_run,
   503						(LPVOID)thread, 0, &thread->thr);
   504			#else
   505				{
   506				  static pthread_attr_t attr;
   507				  static int attr_inited = 0;
   508				  static int attr_joinable = PTHREAD_CREATE_JOINABLE;
   509				  if (!attr_inited) {
   510				    attr_inited = 1;
   511				    pthread_attr_init(&attr);
   512				  }
   513			#  ifdef PTHREAD_ATTR_SETDETACHSTATE
   514			            PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable);
   515			#  endif
   516			#  ifdef THREAD_CREATE_NEEDS_STACK
   517				    if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK))
   518				      panic = "panic: pthread_attr_setstacksize failed";
   519			#  endif
   520			
   521			#ifdef OLD_PTHREADS_API
   522				    failure
   523				      = panic ? 1 : pthread_create( &thread->thr, attr,
   524								    Perl_ithread_run, (void *)thread);
   525			#else
   526			#  if defined(HAS_PTHREAD_ATTR_SETSCOPE) && defined(PTHREAD_SCOPE_SYSTEM)
   527				  pthread_attr_setscope( &attr, PTHREAD_SCOPE_SYSTEM );
   528			#  endif
   529				  failure
   530				    = panic ? 1 : pthread_create( &thread->thr, &attr,
   531								  Perl_ithread_run, (void *)thread);
   532			#endif
   533				}
   534			#endif
   535				known_threads++;
   536				if (
   537			#ifdef WIN32
   538				    thread->handle == NULL
   539			#else
   540				    failure
   541			#endif
   542				    ) {
   543				  MUTEX_UNLOCK(&create_destruct_mutex);
   544				  sv_2mortal(params);
   545				  Perl_ithread_destruct(aTHX_ thread, "create failed");
   546			#ifndef WIN32
   547				  if (panic)
   548				    Perl_croak(aTHX_ panic);
   549			#endif
   550				  return &PL_sv_undef;
   551				}
   552				active_threads++;
   553				MUTEX_UNLOCK(&create_destruct_mutex);
   554				sv_2mortal(params);
   555			
   556				return ithread_to_SV(aTHX_ obj, thread, classname, FALSE);
   557			}
   558			
   559			SV*
   560			Perl_ithread_self (pTHX_ SV *obj, char* Class)
   561			{
   562			   ithread *thread = Perl_ithread_get(aTHX);
   563			   if (thread)
   564				return ithread_to_SV(aTHX_ obj, thread, Class, TRUE);
   565			   else
   566				Perl_croak(aTHX_ "panic: cannot find thread data");
   567			   return NULL; /* silence compiler warning */
   568			}
   569			
   570			/*
   571			 * Joins the thread this code needs to take the returnvalue from the
   572			 * call_sv and send it back
   573			 */
   574			
   575			void
   576			Perl_ithread_CLONE(pTHX_ SV *obj)
   577			{
   578			 if (SvROK(obj))
   579			  {
   580			   ithread *thread = SV_to_ithread(aTHX_ obj);
   581			  }
   582			 else
   583			  {
   584			   Perl_warn(aTHX_ "CLONE %" SVf,obj);
   585			  }
   586			}
   587			
   588			AV*
   589			Perl_ithread_join(pTHX_ SV *obj)
   590			{
   591			    ithread *thread = SV_to_ithread(aTHX_ obj);
   592			    MUTEX_LOCK(&thread->mutex);
   593			    if (thread->state & PERL_ITHR_DETACHED) {
   594				MUTEX_UNLOCK(&thread->mutex);
   595				Perl_croak(aTHX_ "Cannot join a detached thread");
   596			    }
   597			    else if (thread->state & PERL_ITHR_JOINED) {
   598				MUTEX_UNLOCK(&thread->mutex);
   599				Perl_croak(aTHX_ "Thread already joined");
   600			    }
   601			    else {
   602			        AV* retparam;
   603			#ifdef WIN32
   604				DWORD waitcode;
   605			#else
   606				void *retval;
   607			#endif
   608				MUTEX_UNLOCK(&thread->mutex);
   609			#ifdef WIN32
   610				waitcode = WaitForSingleObject(thread->handle, INFINITE);
   611				CloseHandle(thread->handle);
   612				thread->handle = 0;
   613			#else
   614				pthread_join(thread->thr,&retval);
   615			#endif
   616				MUTEX_LOCK(&thread->mutex);
   617				
   618				/* sv_dup over the args */
   619				{
   620				  ithread*        current_thread;
   621				  AV* params = (AV*) SvRV(thread->params);	
   622				  PerlInterpreter *other_perl = thread->interp;
   623				  CLONE_PARAMS clone_params;
   624				  clone_params.stashes = newAV();
   625				  clone_params.flags |= CLONEf_JOIN_IN;
   626				  PL_ptr_table = ptr_table_new();
   627				  current_thread = Perl_ithread_get(aTHX);
   628				  Perl_ithread_set(aTHX_ thread);
   629				  /* ensure 'meaningful' addresses retain their meaning */
   630				  ptr_table_store(PL_ptr_table, &other_perl->Isv_undef, &PL_sv_undef);
   631				  ptr_table_store(PL_ptr_table, &other_perl->Isv_no, &PL_sv_no);
   632				  ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes);
   633			
   634			#if 0
   635				  {
   636				    I32 len = av_len(params)+1;
   637				    I32 i;
   638				    for(i = 0; i < len; i++) {
   639				      sv_dump(SvRV(AvARRAY(params)[i]));
   640				    }
   641				  }
   642			#endif
   643				  retparam = (AV*) sv_dup((SV*)params, &clone_params);
   644			#if 0
   645				  {
   646				    I32 len = av_len(retparam)+1;
   647				    I32 i;
   648				    for(i = 0; i < len; i++) {
   649					sv_dump(SvRV(AvARRAY(retparam)[i]));
   650				    }
   651				  }
   652			#endif
   653				  Perl_ithread_set(aTHX_ current_thread);
   654				  SvREFCNT_dec(clone_params.stashes);
   655				  SvREFCNT_inc(retparam);
   656				  ptr_table_free(PL_ptr_table);
   657				  PL_ptr_table = NULL;
   658			
   659				}
   660				/* We are finished with it */
   661				thread->state |= PERL_ITHR_JOINED;
   662				MUTEX_UNLOCK(&thread->mutex);
   663			    	
   664				return retparam;
   665			    }
   666			    return (AV*)NULL;
   667			}
   668			
   669			void
   670			Perl_ithread_DESTROY(pTHX_ SV *sv)
   671			{
   672			    ithread *thread = SV_to_ithread(aTHX_ sv);
   673			    sv_unmagic(SvRV(sv),PERL_MAGIC_shared_scalar);
   674			}
   675			
   676			#endif /* USE_ITHREADS */
   677			
   678			#ifndef PERL_UNUSED_VAR
   679			#  define PERL_UNUSED_VAR(var) if (0) var = var
   680			#endif
   681			
   682			#line 683 "threads.c"
   683			#ifdef USE_ITHREADS
   684			#define XSubPPtmpAAAA 1
   685			
   686			
   687			XS(XS_threads_new); /* prototype to pass -Wmissing-prototypes */
   688			XS(XS_threads_new)
   689			{
   690			    dXSARGS;
   691			    if (items < 2)
   692				Perl_croak(aTHX_ "Usage: threads::new(classname, function_to_call, ...)");
   693			    PERL_UNUSED_VAR(cv); /* -W */
   694			    {
   695				char *	classname = (char *)SvPV_nolen(ST(0));
   696				SV *	function_to_call = ST(1);
   697			#line 679 "threads.xs"
   698			{
   699			    AV* params = newAV();
   700			    if (items > 2) {
   701				int i;
   702				for(i = 2; i < items ; i++) {
   703				    av_push(params, SvREFCNT_inc(ST(i)));
   704				}
   705			    }
   706			    ST(0) = sv_2mortal(Perl_ithread_create(aTHX_ Nullsv, classname, function_to_call, newRV_noinc((SV*) params)));
   707			    XSRETURN(1);
   708			}
   709			#line 710 "threads.c"
   710			    }
   711			    XSRETURN(1);
   712			}
   713			
   714			
   715			XS(XS_threads_list); /* prototype to pass -Wmissing-prototypes */
   716			XS(XS_threads_list)
   717			{
   718			    dXSARGS;
   719			    if (items != 1)
   720				Perl_croak(aTHX_ "Usage: threads::list(classname)");
   721			    PERL_UNUSED_VAR(cv); /* -W */
   722			    PERL_UNUSED_VAR(ax); /* -Wall */
   723			    SP -= items;
   724			    {
   725				char *	classname = (char *)SvPV_nolen(ST(0));
   726			#line 694 "threads.xs"
   727			{
   728			  ithread *curr_thread;
   729			  MUTEX_LOCK(&create_destruct_mutex);
   730			  curr_thread = threads;
   731			  if(curr_thread->tid != 0)	
   732			    XPUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
   733			  while(curr_thread) {
   734			    curr_thread = curr_thread->next;
   735			    if(curr_thread == threads)
   736			      break;
   737			    if(curr_thread->state & PERL_ITHR_DETACHED ||
   738			       curr_thread->state & PERL_ITHR_JOINED)
   739			         continue;
   740			     XPUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
   741			  }	
   742			  MUTEX_UNLOCK(&create_destruct_mutex);
   743			}
   744			#line 745 "threads.c"
   745				PUTBACK;
   746				return;
   747			    }
   748			}
   749			
   750			
   751			XS(XS_threads_self); /* prototype to pass -Wmissing-prototypes */
   752			XS(XS_threads_self)
   753			{
   754			    dXSARGS;
   755			    if (items != 1)
   756				Perl_croak(aTHX_ "Usage: threads::self(classname)");
   757			    PERL_UNUSED_VAR(cv); /* -W */
   758			    {
   759				char *	classname = (char *)SvPV_nolen(ST(0));
   760			#line 716 "threads.xs"
   761			{
   762				ST(0) = sv_2mortal(Perl_ithread_self(aTHX_ Nullsv,classname));
   763				XSRETURN(1);
   764			}
   765			#line 766 "threads.c"
   766			    }
   767			    XSRETURN(1);
   768			}
   769			
   770			
   771			XS(XS_threads_tid); /* prototype to pass -Wmissing-prototypes */
   772			XS(XS_threads_tid)
   773			{
   774			    dXSARGS;
   775			    if (items != 1)
   776				Perl_croak(aTHX_ "Usage: threads::tid(thread)");
   777			    PERL_UNUSED_VAR(cv); /* -W */
   778			    {
   779				int	RETVAL;
   780				dXSTARG;
   781				ithread *	thread = SV_to_ithread(aTHX_ ST(0));
   782			
   783				RETVAL = ithread_tid(thread);
   784				XSprePUSH; PUSHi((IV)RETVAL);
   785			    }
   786			    XSRETURN(1);
   787			}
   788			
   789			
   790			XS(XS_threads_join); /* prototype to pass -Wmissing-prototypes */
   791			XS(XS_threads_join)
   792			{
   793			    dXSARGS;
   794			    if (items != 1)
   795				Perl_croak(aTHX_ "Usage: threads::join(obj)");
   796			    PERL_UNUSED_VAR(cv); /* -W */
   797			    PERL_UNUSED_VAR(ax); /* -Wall */
   798			    SP -= items;
   799			    {
   800				SV *	obj = ST(0);
   801			#line 727 "threads.xs"
   802			{
   803			  AV* params = Perl_ithread_join(aTHX_ obj);
   804			  int i;
   805			  I32 len = AvFILL(params);
   806			  for (i = 0; i <= len; i++) {
   807			    SV* tmp = av_shift(params);
   808			    XPUSHs(tmp);
   809			    sv_2mortal(tmp);
   810			  }
   811			  SvREFCNT_dec(params);
   812			}
   813			#line 814 "threads.c"
   814				PUTBACK;
   815				return;
   816			    }
   817			}
   818			
   819			
   820			XS(XS_threads_yield); /* prototype to pass -Wmissing-prototypes */
   821			XS(XS_threads_yield)
   822			{
   823			    dXSARGS;
   824			    PERL_UNUSED_VAR(cv); /* -W */
   825			    {
   826			#line 742 "threads.xs"
   827			{
   828			    YIELD;
   829			}
   830			#line 831 "threads.c"
   831			    }
   832			    XSRETURN_EMPTY;
   833			}
   834			
   835			
   836			XS(XS_threads_detach); /* prototype to pass -Wmissing-prototypes */
   837			XS(XS_threads_detach)
   838			{
   839			    dXSARGS;
   840			    if (items != 1)
   841				Perl_croak(aTHX_ "Usage: threads::detach(thread)");
   842			    PERL_UNUSED_VAR(cv); /* -W */
   843			    {
   844				ithread *	thread = SV_to_ithread(aTHX_ ST(0));
   845			
   846				ithread_detach(thread);
   847			    }
   848			    XSRETURN_EMPTY;
   849			}
   850			
   851			
   852			XS(XS_threads_DESTROY); /* prototype to pass -Wmissing-prototypes */
   853			XS(XS_threads_DESTROY)
   854			{
   855			    dXSARGS;
   856			    if (items != 1)
   857				Perl_croak(aTHX_ "Usage: threads::DESTROY(thread)");
   858			    PERL_UNUSED_VAR(cv); /* -W */
   859			    {
   860				SV *	thread = ST(0);
   861			
   862				ithread_DESTROY(thread);
   863			    }
   864			    XSRETURN_EMPTY;
   865			}
   866			
   867			#endif /* USE_ITHREADS */
   868			#ifdef __cplusplus
   869			extern "C"
   870			#endif
   871			XS(boot_threads); /* prototype to pass -Wmissing-prototypes */
   872			XS(boot_threads)
   873	      ######    {
   874	      ######        dXSARGS;
   875	      ######        char* file = __FILE__;
   876			
   877	      ######        PERL_UNUSED_VAR(cv); /* -W */
   878	      ######        PERL_UNUSED_VAR(items); /* -W */
   879	      ######        XS_VERSION_BOOTCHECK ;
   880			
   881			#if XSubPPtmpAAAA
   882			        newXS("threads::new", XS_threads_new, file);
   883			        newXS("threads::list", XS_threads_list, file);
   884			        newXS("threads::self", XS_threads_self, file);
   885			        newXS("threads::tid", XS_threads_tid, file);
   886			        newXS("threads::join", XS_threads_join, file);
   887			        newXS("threads::yield", XS_threads_yield, file);
   888			        newXS("threads::detach", XS_threads_detach, file);
   889			        newXS("threads::DESTROY", XS_threads_DESTROY, file);
   890			#endif
   891			
   892			    /* Initialisation Section */
   893			
   894			#if XSubPPtmpAAAA
   895			#endif
   896			#line 756 "threads.xs"
   897			{
   898			#ifdef USE_ITHREADS
   899				ithread* thread;
   900				PL_perl_destruct_level = 2;
   901				MUTEX_INIT(&create_destruct_mutex);
   902				MUTEX_LOCK(&create_destruct_mutex);
   903				PL_threadhook = &Perl_ithread_hook;
   904				thread  = (ithread *) PerlMemShared_malloc(sizeof(ithread));
   905				if (!thread) {
   906				    PerlLIO_write(PerlIO_fileno(Perl_error_log),
   907						  PL_no_mem, strlen(PL_no_mem));
   908				    my_exit(1);
   909				}
   910				Zero(thread,1,ithread);
   911				PL_perl_destruct_level = 2;
   912				MUTEX_INIT(&thread->mutex);
   913				threads = thread;
   914				thread->next = thread;
   915			        thread->prev = thread;
   916				thread->interp = aTHX;
   917				thread->count  = 1;  /* Immortal. */
   918				thread->tid = tid_counter++;
   919				known_threads++;
   920				active_threads++;
   921				thread->state = PERL_ITHR_DETACHED;
   922			#ifdef WIN32
   923				thread->thr = GetCurrentThreadId();
   924			#else
   925				thread->thr = pthread_self();
   926			#endif
   927			
   928				Perl_ithread_set(aTHX_ thread);
   929				MUTEX_UNLOCK(&create_destruct_mutex);
   930			#endif /* USE_ITHREADS */
   931			}
   932			
   933			#line 934 "threads.c"
   934			
   935			    /* End of Initialisation Section */
   936			
   937	      ######        XSRETURN_YES;
   938			}
   939