#if defined(MYMALLOC)
#define malloced_size Perl_malloced_size
#endif
+#define get_context Perl_get_context
+#define set_context Perl_set_context
#if defined(PERL_OBJECT)
#ifndef __BORLANDC__
#endif
#if defined(MYMALLOC)
#define malloced_size Perl_malloced_size
#endif
+#define get_context Perl_get_context
+#define set_context Perl_set_context
#if defined(PERL_OBJECT)
#ifndef __BORLANDC__
#endif
#define mfree Perl_mfree
#define malloced_size Perl_malloced_size
#endif
+#define get_context Perl_get_context
+#define set_context Perl_set_context
#if defined(PERL_OBJECT)
#ifndef __BORLANDC__
#endif
jnp |MEM_SIZE|malloced_size |void *p
#endif
+Ajnp |void* |get_context
+Ajnp |void |set_context |void *thx
+
END_EXTERN_C
/* functions with flag 'n' should come before here */
#define PL_svref_mutex (PERL_GET_INTERP->Isvref_mutex)
#define PL_sys_intern (PERL_GET_INTERP->Isys_intern)
#define PL_tainting (PERL_GET_INTERP->Itainting)
-#define PL_thr_key (PERL_GET_INTERP->Ithr_key)
#define PL_threadnum (PERL_GET_INTERP->Ithreadnum)
#define PL_threads_mutex (PERL_GET_INTERP->Ithreads_mutex)
#define PL_threadsv_names (PERL_GET_INTERP->Ithreadsv_names)
#define PL_svref_mutex (vTHX->Isvref_mutex)
#define PL_sys_intern (vTHX->Isys_intern)
#define PL_tainting (vTHX->Itainting)
-#define PL_thr_key (vTHX->Ithr_key)
#define PL_threadnum (vTHX->Ithreadnum)
#define PL_threads_mutex (vTHX->Ithreads_mutex)
#define PL_threadsv_names (vTHX->Ithreadsv_names)
#define PL_svref_mutex (aTHXo->interp.Isvref_mutex)
#define PL_sys_intern (aTHXo->interp.Isys_intern)
#define PL_tainting (aTHXo->interp.Itainting)
-#define PL_thr_key (aTHXo->interp.Ithr_key)
#define PL_threadnum (aTHXo->interp.Ithreadnum)
#define PL_threads_mutex (aTHXo->interp.Ithreads_mutex)
#define PL_threadsv_names (aTHXo->interp.Ithreadsv_names)
#define PL_Isvref_mutex PL_svref_mutex
#define PL_Isys_intern PL_sys_intern
#define PL_Itainting PL_tainting
-#define PL_Ithr_key PL_thr_key
#define PL_Ithreadnum PL_threadnum
#define PL_Ithreads_mutex PL_threads_mutex
#define PL_Ithreadsv_names PL_threadsv_names
#define PL_hexdigit (PL_Vars.Ghexdigit)
#define PL_malloc_mutex (PL_Vars.Gmalloc_mutex)
#define PL_patleave (PL_Vars.Gpatleave)
+#define PL_thr_key (PL_Vars.Gthr_key)
#else /* !PERL_GLOBAL_STRUCT */
#define PL_Ghexdigit PL_hexdigit
#define PL_Gmalloc_mutex PL_malloc_mutex
#define PL_Gpatleave PL_patleave
+#define PL_Gthr_key PL_thr_key
#endif /* PERL_GLOBAL_STRUCT */
Perl_calloc
Perl_realloc
Perl_mfree
+Perl_get_context
+Perl_set_context
Perl_amagic_call
Perl_Gv_AMupdate
Perl_avhv_delete_ent
PERLVAR(Ibitcount, char *)
#ifdef USE_THREADS
-PERLVAR(Ithr_key, perl_key) /* For per-thread struct perl_thread* */
PERLVAR(Isv_mutex, perl_mutex) /* Mutex for allocating SVs in sv.c */
PERLVAR(Ieval_mutex, perl_mutex) /* Mutex for doeval */
PERLVAR(Ieval_cond, perl_cond) /* Condition variable for doeval */
PL_threadsv_names
PL_thrsv
PL_vtbl_mutex
- Perl_getTHR
- Perl_setTHR
Perl_condpair_magic
Perl_new_struct_thread
Perl_per_thread_magicals
if ($PLATFORM eq 'win32') {
foreach my $symbol (qw(
boot_DynaLoader
- Perl_getTHR
Perl_init_os_extras
- Perl_setTHR
- Perl_thread_create
Perl_win32_init
RunPerl
- GetPerlInterpreter
- SetPerlInterpreter
win32_errno
win32_environ
win32_stdin
#ifdef PERL_OBJECT
my_perl = (PerlInterpreter*)new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd,
ipLIO, ipD, ipS, ipP);
- PERL_SET_INTERP(my_perl);
+ if (!PL_curinterp) {
+ PERL_SET_INTERP(my_perl);
+#if defined(USE_THREADS) || defined(USE_ITHREADS)
+ INIT_THREADS;
+ ALLOC_THREAD_KEY;
+#endif
+ }
+ PERL_SET_THX(my_perl);
#else
/* New() needs interpreter, so call malloc() instead */
my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
- PERL_SET_INTERP(my_perl);
+ if (!PL_curinterp) {
+ PERL_SET_INTERP(my_perl);
+#if defined(USE_THREADS) || defined(USE_ITHREADS)
+ INIT_THREADS;
+ ALLOC_THREAD_KEY;
+#endif
+ }
+ PERL_SET_THX(my_perl);
Zero(my_perl, 1, PerlInterpreter);
PL_Mem = ipM;
PL_MemShared = ipMS;
/* New() needs interpreter, so call malloc() instead */
my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
- PERL_SET_INTERP(my_perl);
+
+ if (!PL_curinterp) {
+ PERL_SET_INTERP(my_perl);
+#if defined(USE_THREADS) || defined(USE_ITHREADS)
+ INIT_THREADS;
+ ALLOC_THREAD_KEY;
+#endif
+ }
+ PERL_SET_THX(my_perl);
Zero(my_perl, 1, PerlInterpreter);
return my_perl;
}
struct perl_thread *thr = NULL;
#endif /* FAKE_THREADS */
#endif /* USE_THREADS */
-
+
#ifdef MULTIPLICITY
init_interp();
PL_perl_destruct_level = 1;
/* Init the real globals (and main thread)? */
if (!PL_linestr) {
- INIT_THREADS;
#ifdef USE_THREADS
-#ifdef ALLOC_THREAD_KEY
- ALLOC_THREAD_KEY;
-#else
- if (pthread_key_create(&PL_thr_key, 0))
- Perl_croak(aTHX_ "panic: pthread_key_create");
-#endif
MUTEX_INIT(&PL_sv_mutex);
/*
* Safe to use basic SV functions from now on (though
COND_INIT(&PL_eval_cond);
MUTEX_INIT(&PL_threads_mutex);
COND_INIT(&PL_nthreads_cond);
-#ifdef EMULATE_ATOMIC_REFCOUNTS
+# ifdef EMULATE_ATOMIC_REFCOUNTS
MUTEX_INIT(&PL_svref_mutex);
-#endif /* EMULATE_ATOMIC_REFCOUNTS */
+# endif /* EMULATE_ATOMIC_REFCOUNTS */
MUTEX_INIT(&PL_cred_mutex);
# define PERL_WAIT_FOR_CHILDREN NOOP
#endif
-/* the traditional thread-unsafe notion of "current interpreter".
- * XXX todo: a thread-safe version that fetches it from TLS (akin to THR)
- * needs to be defined elsewhere (conditional on pthread_getspecific()
- * availability). */
+/* the traditional thread-unsafe notion of "current interpreter". */
#ifndef PERL_SET_INTERP
# define PERL_SET_INTERP(i) (PL_curinterp = (PerlInterpreter*)(i))
#endif
# define PERL_GET_INTERP (PL_curinterp)
#endif
+#ifndef PERL_SET_CONTEXT
+# define PERL_SET_CONTEXT(i) PERL_SET_INTERP(i)
+#endif
+
+#ifndef PERL_GET_CONTEXT
+# define PERL_GET_CONTEXT PERL_GET_INTERP
+#endif
+
#if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX)
# ifdef USE_THREADS
-# define PERL_GET_THX THR
+# define PERL_GET_THX ((struct perl_thread *)PERL_GET_CONTEXT)
# else
# ifdef MULTIPLICITY
-# define PERL_GET_THX PERL_GET_INTERP
+# define PERL_GET_THX ((PerlInterpreter *)PERL_GET_CONTEXT)
# else
# ifdef PERL_OBJECT
-# define PERL_GET_THX ((CPerlObj*)PERL_GET_INTERP)
-# else
-# define PERL_GET_THX ((void*)0)
+# define PERL_GET_THX ((CPerlObj *)PERL_GET_CONTEXT)
# endif
# endif
# endif
+# define PERL_SET_THX(t) PERL_SET_CONTEXT(t)
+#endif
+
+#ifndef PERL_GET_THX
+# define PERL_GET_THX ((void*)NULL)
+#endif
+
+#ifndef PERL_SET_THX
+# define PERL_SET_THX(t) NOOP
#endif
#ifndef SVf
#define PL_sys_intern (*Perl_Isys_intern_ptr(aTHXo))
#undef PL_tainting
#define PL_tainting (*Perl_Itainting_ptr(aTHXo))
-#undef PL_thr_key
-#define PL_thr_key (*Perl_Ithr_key_ptr(aTHXo))
#undef PL_threadnum
#define PL_threadnum (*Perl_Ithreadnum_ptr(aTHXo))
#undef PL_threads_mutex
#define PL_malloc_mutex (*Perl_Gmalloc_mutex_ptr(NULL))
#undef PL_patleave
#define PL_patleave (*Perl_Gpatleave_ptr(NULL))
+#undef PL_thr_key
+#define PL_thr_key (*Perl_Gthr_key_ptr(NULL))
#endif /* !PERL_CORE */
#endif /* PERL_OBJECT || MULTIPLICITY */
/* global state */
PERLVAR(Gcurinterp, PerlInterpreter *)
/* currently running interpreter
- * XXX this needs to be in TLS */
+ * (initial parent interpreter under
+ * useithreads) */
+#if defined(USE_THREADS) || defined(USE_ITHREADS)
+PERLVAR(Gthr_key, perl_key) /* key to retrieve per-thread struct */
+#endif
/* constants (these are not literals to facilitate pointer comparisons) */
PERLVARIC(GYes, char *, "1")
The -Dusethreads flag now enables the experimental interpreter-based thread
support by default. To get the flavor of experimental threads that was in
-5.005 instead, you need to ask for -Duse5005threads.
+5.005 instead, you need to run Configure with "-Dusethreads -Duse5005threads".
As of v5.5.640, interpreter-threads support is still lacking a way to
create new threads from Perl (i.e., C<use Thread;> will not work with
interpreter threads). C<use Thread;> continues to be available when you
-ask for -Duse5005threads, bugs and all.
+ask for use5005threads, bugs and all.
=head2 New Configure flags
by running Configure with C<-Dflag>.
usemultiplicity
- use5005threads
+ usethreads useithreads (new interpreter threads: no Perl API yet)
+ usethreads use5005threads (threads as they were in 5.005)
- use64bitint (equal to now deprecated 'use64bits')
+ use64bitint (equal to now deprecated 'use64bits')
use64bitall
uselongdouble
usemorebits
uselargefiles
- usesocks (only SOCKS v5 supported)
+ usesocks (only SOCKS v5 supported)
=head2 Threadedness and 64-bitness now more daring
PERL_CALLCONV MEM_SIZE Perl_malloced_size(void *p);
#endif
+PERL_CALLCONV void* Perl_get_context(void);
+PERL_CALLCONV void Perl_set_context(void *thx);
+
END_EXTERN_C
/* functions with flag 'n' should come before here */
# ifdef PERL_OBJECT
CPerlObj *pPerl = new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd, ipLIO,
ipD, ipS, ipP);
- PERL_SET_INTERP(pPerl);
+ PERL_SET_THX(pPerl);
# else /* !PERL_OBJECT */
PerlInterpreter *my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
- PERL_SET_INTERP(my_perl);
+ PERL_SET_THX(my_perl);
# ifdef DEBUGGING
memset(my_perl, 0xab, sizeof(PerlInterpreter));
SV *sv;
SV **svp;
PerlInterpreter *my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
- PERL_SET_INTERP(my_perl);
+ PERL_SET_THX(my_perl);
# ifdef DEBUGGING
memset(my_perl, 0xab, sizeof(PerlInterpreter));
# include <win32thread.h>
#else
# ifdef OLD_PTHREADS_API /* Here be dragons. */
-# define DETACH(t) \
- STMT_START { \
- if (pthread_detach(&(t)->self)) { \
- MUTEX_UNLOCK(&(t)->mutex); \
- Perl_croak(aTHX_ "panic: DETACH"); \
- } \
+# define DETACH(t) \
+ STMT_START { \
+ if (pthread_detach(&(t)->self)) { \
+ MUTEX_UNLOCK(&(t)->mutex); \
+ Perl_croak(aTHX_ "panic: DETACH"); \
+ } \
} STMT_END
-# define THR getTHR()
-struct perl_thread *getTHR (void);
+
+# define PERL_GET_CONTEXT Perl_get_context()
+# define PERL_SET_CONTEXT(t) Perl_set_context((void*)t)
+
# define PTHREAD_GETSPECIFIC_INT
# ifdef DJGPP
# define pthread_addr_t any_t
/* #include <mach/cthreads.h> is in perl.h #ifdef I_MACH_CTHREADS */
-#define MUTEX_INIT(m) \
- STMT_START { \
- *m = mutex_alloc(); \
- if (*m) { \
- mutex_init(*m); \
- } else { \
- Perl_croak(aTHX_ "panic: MUTEX_INIT"); \
- } \
- } STMT_END
-
-#define MUTEX_LOCK(m) mutex_lock(*m)
-#define MUTEX_LOCK_NOCONTEXT(m) mutex_lock(*m)
-#define MUTEX_UNLOCK(m) mutex_unlock(*m)
-#define MUTEX_UNLOCK_NOCONTEXT(m) mutex_unlock(*m)
-#define MUTEX_DESTROY(m) \
- STMT_START { \
- mutex_free(*m); \
- *m = 0; \
- } STMT_END
-
-#define COND_INIT(c) \
- STMT_START { \
- *c = condition_alloc(); \
- if (*c) { \
- condition_init(*c); \
- } else { \
- Perl_croak(aTHX_ "panic: COND_INIT"); \
- } \
- } STMT_END
+#define MUTEX_INIT(m) \
+ STMT_START { \
+ *m = mutex_alloc(); \
+ if (*m) { \
+ mutex_init(*m); \
+ } else { \
+ Perl_croak(aTHX_ "panic: MUTEX_INIT"); \
+ } \
+ } STMT_END
+
+#define MUTEX_LOCK(m) mutex_lock(*m)
+#define MUTEX_LOCK_NOCONTEXT(m) mutex_lock(*m)
+#define MUTEX_UNLOCK(m) mutex_unlock(*m)
+#define MUTEX_UNLOCK_NOCONTEXT(m) mutex_unlock(*m)
+#define MUTEX_DESTROY(m) \
+ STMT_START { \
+ mutex_free(*m); \
+ *m = 0; \
+ } STMT_END
+
+#define COND_INIT(c) \
+ STMT_START { \
+ *c = condition_alloc(); \
+ if (*c) { \
+ condition_init(*c); \
+ } \
+ else { \
+ Perl_croak(aTHX_ "panic: COND_INIT"); \
+ } \
+ } STMT_END
#define COND_SIGNAL(c) condition_signal(*c)
#define COND_BROADCAST(c) condition_broadcast(*c)
#define COND_WAIT(c, m) condition_wait(*c, *m)
-#define COND_DESTROY(c) \
- STMT_START { \
- condition_free(*c); \
- *c = 0; \
- } STMT_END
+#define COND_DESTROY(c) \
+ STMT_START { \
+ condition_free(*c); \
+ *c = 0; \
+ } STMT_END
#define THREAD_CREATE(thr, f) (thr->self = cthread_fork(f, thr), 0)
#define THREAD_POST_CREATE(thr)
#define DETACH(t) cthread_detach(t->self)
#define JOIN(t, avp) (*(avp) = (AV *)cthread_join(t->self))
-#define SET_THR(thr) cthread_set_data(cthread_self(), thr)
-#define THR ((struct perl_thread *)cthread_data(cthread_self()))
+#define PERL_SET_CONTEXT(t) cthread_set_data(cthread_self(), t)
+#define PERL_GET_CONTEXT cthread_data(cthread_self())
#define INIT_THREADS cthread_init()
#define YIELD cthread_yield()
-#define ALLOC_THREAD_KEY
+#define ALLOC_THREAD_KEY NOOP
#define SET_THREAD_SELF(thr) (thr->self = cthread_self())
#endif /* I_MACH_CTHREADS */
#endif
#ifndef MUTEX_INIT
-#ifdef MUTEX_INIT_NEEDS_MUTEX_ZEROED
+
+# ifdef MUTEX_INIT_NEEDS_MUTEX_ZEROED
/* Temporary workaround, true bug is deeper. --jhi 1999-02-25 */
-#define MUTEX_INIT(m) \
+# define MUTEX_INIT(m) \
STMT_START { \
Zero((m), 1, perl_mutex); \
if (pthread_mutex_init((m), pthread_mutexattr_default)) \
- Perl_croak(aTHX_ "panic: MUTEX_INIT"); \
+ Perl_croak(aTHX_ "panic: MUTEX_INIT"); \
} STMT_END
-#else
-#define MUTEX_INIT(m) \
+# else
+# define MUTEX_INIT(m) \
STMT_START { \
if (pthread_mutex_init((m), pthread_mutexattr_default)) \
- Perl_croak(aTHX_ "panic: MUTEX_INIT"); \
+ Perl_croak(aTHX_ "panic: MUTEX_INIT"); \
} STMT_END
-#endif
-#define MUTEX_LOCK(m) \
- STMT_START { \
- if (pthread_mutex_lock((m))) \
+# endif
+
+# define MUTEX_LOCK(m) \
+ STMT_START { \
+ if (pthread_mutex_lock((m))) \
Perl_croak(aTHX_ "panic: MUTEX_LOCK"); \
} STMT_END
-#define MUTEX_UNLOCK(m) \
- STMT_START { \
- if (pthread_mutex_unlock((m))) \
- Perl_croak(aTHX_ "panic: MUTEX_UNLOCK"); \
+
+# define MUTEX_UNLOCK(m) \
+ STMT_START { \
+ if (pthread_mutex_unlock((m))) \
+ Perl_croak(aTHX_ "panic: MUTEX_UNLOCK"); \
} STMT_END
-#define MUTEX_LOCK_NOCONTEXT(m) \
- STMT_START { \
- if (pthread_mutex_lock((m))) \
- Perl_croak_nocontext("panic: MUTEX_LOCK"); \
+
+# define MUTEX_LOCK_NOCONTEXT(m) \
+ STMT_START { \
+ if (pthread_mutex_lock((m))) \
+ Perl_croak_nocontext("panic: MUTEX_LOCK"); \
} STMT_END
-#define MUTEX_UNLOCK_NOCONTEXT(m) \
- STMT_START { \
- if (pthread_mutex_unlock((m))) \
- Perl_croak_nocontext("panic: MUTEX_UNLOCK");\
+
+# define MUTEX_UNLOCK_NOCONTEXT(m) \
+ STMT_START { \
+ if (pthread_mutex_unlock((m))) \
+ Perl_croak_nocontext("panic: MUTEX_UNLOCK"); \
} STMT_END
-#define MUTEX_DESTROY(m) \
- STMT_START { \
- if (pthread_mutex_destroy((m))) \
- Perl_croak(aTHX_ "panic: MUTEX_DESTROY"); \
+
+# define MUTEX_DESTROY(m) \
+ STMT_START { \
+ if (pthread_mutex_destroy((m))) \
+ Perl_croak(aTHX_ "panic: MUTEX_DESTROY"); \
} STMT_END
#endif /* MUTEX_INIT */
#ifndef COND_INIT
-#define COND_INIT(c) \
+# define COND_INIT(c) \
STMT_START { \
if (pthread_cond_init((c), pthread_condattr_default)) \
- Perl_croak(aTHX_ "panic: COND_INIT"); \
+ Perl_croak(aTHX_ "panic: COND_INIT"); \
} STMT_END
-#define COND_SIGNAL(c) \
- STMT_START { \
- if (pthread_cond_signal((c))) \
- Perl_croak(aTHX_ "panic: COND_SIGNAL"); \
+
+# define COND_SIGNAL(c) \
+ STMT_START { \
+ if (pthread_cond_signal((c))) \
+ Perl_croak(aTHX_ "panic: COND_SIGNAL"); \
} STMT_END
-#define COND_BROADCAST(c) \
- STMT_START { \
- if (pthread_cond_broadcast((c))) \
- Perl_croak(aTHX_ "panic: COND_BROADCAST"); \
+
+# define COND_BROADCAST(c) \
+ STMT_START { \
+ if (pthread_cond_broadcast((c))) \
+ Perl_croak(aTHX_ "panic: COND_BROADCAST"); \
} STMT_END
-#define COND_WAIT(c, m) \
- STMT_START { \
- if (pthread_cond_wait((c), (m))) \
+
+# define COND_WAIT(c, m) \
+ STMT_START { \
+ if (pthread_cond_wait((c), (m))) \
Perl_croak(aTHX_ "panic: COND_WAIT"); \
} STMT_END
-#define COND_DESTROY(c) \
- STMT_START { \
- if (pthread_cond_destroy((c))) \
- Perl_croak(aTHX_ "panic: COND_DESTROY"); \
+
+# define COND_DESTROY(c) \
+ STMT_START { \
+ if (pthread_cond_destroy((c))) \
+ Perl_croak(aTHX_ "panic: COND_DESTROY"); \
} STMT_END
#endif /* COND_INIT */
/* DETACH(t) must only be called while holding t->mutex */
#ifndef DETACH
-#define DETACH(t) \
- STMT_START { \
- if (pthread_detach((t)->self)) { \
- MUTEX_UNLOCK(&(t)->mutex); \
- Perl_croak(aTHX_ "panic: DETACH"); \
- } \
+# define DETACH(t) \
+ STMT_START { \
+ if (pthread_detach((t)->self)) { \
+ MUTEX_UNLOCK(&(t)->mutex); \
+ Perl_croak(aTHX_ "panic: DETACH"); \
+ } \
} STMT_END
#endif /* DETACH */
#ifndef JOIN
-#define JOIN(t, avp) \
- STMT_START { \
- if (pthread_join((t)->self, (void**)(avp))) \
+# define JOIN(t, avp) \
+ STMT_START { \
+ if (pthread_join((t)->self, (void**)(avp))) \
Perl_croak(aTHX_ "panic: pthread_join"); \
} STMT_END
#endif /* JOIN */
-#ifndef SET_THR
-#define SET_THR(t) \
- STMT_START { \
- if (pthread_setspecific(PL_thr_key, (void *) (t))) \
+#ifndef PERL_GET_CONTEXT
+# define PERL_GET_CONTEXT pthread_getspecific(PL_thr_key)
+#endif
+
+#ifndef PERL_SET_CONTEXT
+# define PERL_SET_CONTEXT(t) \
+ STMT_START { \
+ if (pthread_setspecific(PL_thr_key, (void *)(t))) \
Perl_croak(aTHX_ "panic: pthread_setspecific"); \
} STMT_END
-#endif /* SET_THR */
+#endif /* PERL_SET_CONTEXT */
#ifndef INIT_THREADS
# ifdef NEED_PTHREAD_INIT
# endif
#endif
+#ifndef ALLOC_THREAD_KEY
+# define ALLOC_THREAD_KEY \
+ STMT_START { \
+ if (pthread_key_create(&PL_thr_key, 0)) \
+ Perl_croak(aTHX_ "panic: pthread_key_create"); \
+ } STMT_END
+#endif
+
#ifndef THREAD_RET_TYPE
# define THREAD_RET_TYPE void *
# define THREAD_RET_CAST(p) ((void *)(p))
#if defined(USE_THREADS)
-/*
- * dTHR is performance-critical. Here, we only do the pthread_get_specific
- * if there may be more than one thread in existence, otherwise we get thr
- * from thrsv which is cached in the per-interpreter structure.
- * Systems with very fast pthread_get_specific (which should be all systems
- * but unfortunately isn't) may wish to simplify to "...*thr = THR".
- *
- * The use of PL_threadnum should be safe here.
- */
-# if !defined(dTHR)
-# define dTHR \
- struct perl_thread *thr = PL_threadnum ? THR : (struct perl_thread*)SvPVX(PL_thrsv)
-# endif /* dTHR */
-
-# if !defined(THR)
-# define THR ((struct perl_thread *) pthread_getspecific(PL_thr_key))
-# endif
-
-
/* Accessor for per-thread SVs */
# define THREADSV(i) (thr->threadsvp[i])
# define UNLOCK_CRED_MUTEX
#endif
+/* THR, SET_THR, and dTHR are there for compatibility with old versions */
#ifndef THR
-# define THR
+# define THR PERL_GET_THX
+#endif
+
+#ifndef SET_THR
+# define SET_THR(t) PERL_SET_THX(t)
#endif
#ifndef dTHR
return (scriptname ? savepv(scriptname) : Nullch);
}
+#ifndef PERL_GET_CONTEXT_DEFINED
+
+void *
+Perl_get_context(void)
+{
+#if defined(USE_THREADS) || defined(USE_ITHREADS)
+# ifdef OLD_PTHREADS_API
+ pthread_addr_t t;
+ if (pthread_getspecific(PL_thr_key, &t))
+ Perl_croak_nocontext("panic: pthread_getspecific");
+ return (void*)t;
+# else
+ return (void*)pthread_getspecific(PL_thr_key);
+# endif
+#else
+ return (void*)NULL;
+#endif
+}
+
+void
+Perl_set_context(void *t)
+{
+#if defined(USE_THREADS) || defined(USE_ITHREADS)
+ if (pthread_setspecific(PL_thr_key, t))
+ Perl_croak_nocontext("panic: pthread_setspecific");
+#endif
+}
+
+#endif /* !PERL_GET_CONTEXT_DEFINED */
#ifdef USE_THREADS
+
#ifdef FAKE_THREADS
/* Very simplistic scheduler for now */
void
}
#endif /* FAKE_THREADS */
-#ifdef PTHREAD_GETSPECIFIC_INT
-struct perl_thread *
-Perl_getTHR(pTHX)
-{
- pthread_addr_t t;
-
- if (pthread_getspecific(PL_thr_key, &t))
- Perl_croak(aTHX_ "panic: pthread_getspecific");
- return (struct perl_thread *) t;
-}
-#endif
-
MAGIC *
Perl_condpair_magic(pTHX_ SV *sv)
{
#endif
- PERL_SET_INTERP(my_perl);
+ PERL_SET_THX(my_perl);
/* set $$ to pseudo id */
#ifdef PERL_SYNC_FORK
new_perl->Isys_intern.internal_host = h;
# ifdef PERL_SYNC_FORK
id = win32_start_child((LPVOID)new_perl);
- PERL_SET_INTERP(aTHXo);
+ PERL_SET_THX(aTHXo);
# else
# ifdef USE_RTL_THREAD_API
handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
handle = CreateThread(NULL, 0, win32_start_child,
(LPVOID)new_perl, 0, &id);
# endif
- PERL_SET_INTERP(aTHXo); /* XXX perl_clone*() set TLS */
+ PERL_SET_THX(aTHXo); /* XXX perl_clone*() set TLS */
if (!handle)
Perl_croak(aTHX_ "panic: pseudo fork() failed");
w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
CPerlHost* pHost = (CPerlHost*)w32_internal_host;
Perl_free();
delete pHost;
- SetPerlInterpreter(NULL);
+ PERL_SET_THX(NULL);
}
}
{
}
#endif
- SetPerlInterpreter(NULL);
+ PERL_SET_THX(NULL);
}
EXTERN_C int
EXTERN_C HANDLE w32_perldll_handle;
-static DWORD g_TlsAllocIndex;
-
-EXTERN_C DllExport bool
-SetPerlInterpreter(void *interp)
-{
- DWORD dwErr = GetLastError();
- bool bResult = TlsSetValue(g_TlsAllocIndex, interp);
- SetLastError(dwErr);
- return bResult;
-}
-
-EXTERN_C DllExport void*
-GetPerlInterpreter(void)
-{
- DWORD dwErr = GetLastError();
- LPVOID pResult = TlsGetValue(g_TlsAllocIndex);
- SetLastError(dwErr);
- return pResult;
-}
-
EXTERN_C DllExport int
RunPerl(int argc, char **argv, char **env)
{
new_perl = perl_clone(my_perl, 1);
# endif
exitstatus = perl_run( new_perl );
- SetPerlInterpreter(my_perl);
+ PERL_SET_THX(my_perl);
#else
exitstatus = perl_run( my_perl );
#endif
perl_free( my_perl );
#ifdef USE_ITHREADS
if (new_perl) {
- SetPerlInterpreter(new_perl);
+ PERL_SET_THX(new_perl);
perl_destruct(new_perl);
perl_free(new_perl);
}
setmode( fileno( stderr ), O_BINARY );
_fmode = O_BINARY;
#endif
- g_TlsAllocIndex = TlsAlloc();
DisableThreadLibraryCalls((HMODULE)hModule);
w32_perldll_handle = hModule;
break;
* process termination or call to FreeLibrary.
*/
case DLL_PROCESS_DETACH:
- TlsFree(g_TlsAllocIndex);
break;
/* The attached process creates a new thread. */
#endif
#if defined(PERL_IMPLICIT_CONTEXT)
-# define PERL_GET_INTERP ((PerlInterpreter*)GetPerlInterpreter())
-# define PERL_SET_INTERP(i) (SetPerlInterpreter(i))
+/* compat */
+# define GetPerlInterpreter Perl_get_context
+# define SetPerlInterpreter Perl_set_context
#endif
#ifdef __GNUC__
DllExport void Perl_init_os_extras();
DllExport void win32_str_os_error(void *sv, DWORD err);
DllExport int RunPerl(int argc, char **argv, char **env);
-DllExport bool SetPerlInterpreter(void* interp);
-DllExport void* GetPerlInterpreter(void);
typedef struct {
HANDLE childStdIn;
#endif
#ifdef USE_DECLSPEC_THREAD
-__declspec(thread) struct perl_thread *Perl_current_thread = NULL;
+__declspec(thread) void *PL_current_context = NULL;
#endif
void
-Perl_setTHR(struct perl_thread *t)
+Perl_set_context(void *t)
{
-#ifdef USE_THREADS
-#ifdef USE_DECLSPEC_THREAD
- Perl_current_thread = t;
-#else
- TlsSetValue(PL_thr_key,t);
-#endif
+#if defined(USE_THREADS) || defined(USE_ITHREADS)
+# ifdef USE_DECLSPEC_THREAD
+ Perl_current_context = t;
+# else
+ DWORD err = GetLastError();
+ TlsSetValue(PL_thr_key,t);
+ SetLastError(err);
+# endif
#endif
}
-struct perl_thread *
-Perl_getTHR(void)
+void *
+Perl_get_context(void)
{
-#ifdef USE_THREADS
-#ifdef USE_DECLSPEC_THREAD
- return Perl_current_thread;
-#else
- return (struct perl_thread *) TlsGetValue(PL_thr_key);
-#endif
+#if defined(USE_THREADS) || defined(USE_ITHREADS)
+# ifdef USE_DECLSPEC_THREAD
+ return Perl_current_context;
+# else
+ DWORD err = GetLastError();
+ void *result = TlsGetValue(PL_thr_key);
+ SetLastError(err);
+ return result;
+# endif
#else
- return NULL;
+ return NULL;
#endif
}
-void
-Perl_alloc_thread_key(void)
-{
#ifdef USE_THREADS
- static int key_allocated = 0;
- if (!key_allocated) {
- if ((PL_thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES)
- Perl_croak_nocontext("panic: TlsAlloc");
- key_allocated = 1;
- }
-#endif
-}
-
void
Perl_init_thread_intern(struct perl_thread *athr)
{
-#ifdef USE_THREADS
#ifndef USE_DECLSPEC_THREAD
/*
memset(&athr->i,0,sizeof(athr->i));
#endif
-#endif
}
void
Perl_set_thread_self(struct perl_thread *thr)
{
-#ifdef USE_THREADS
/* Set thr->self. GetCurrentThread() retrurns a pseudo handle, need
this to convert it into a handle another thread can use.
*/
0,
FALSE,
DUPLICATE_SAME_ACCESS);
-#endif
}
-#ifdef USE_THREADS
int
Perl_thread_create(struct perl_thread *thr, thread_func_t *fn)
{
#else
typedef HANDLE perl_mutex;
-#define MUTEX_INIT(m) \
+# define MUTEX_INIT(m) \
STMT_START { \
if ((*(m) = CreateMutex(NULL,FALSE,NULL)) == NULL) \
- Perl_croak(aTHX_ "panic: MUTEX_INIT"); \
+ Perl_croak(aTHX_ "panic: MUTEX_INIT"); \
} STMT_END
-#define MUTEX_LOCK(m) \
+
+# define MUTEX_LOCK(m) \
STMT_START { \
if (WaitForSingleObject(*(m),INFINITE) == WAIT_FAILED) \
Perl_croak(aTHX_ "panic: MUTEX_LOCK"); \
} STMT_END
-#define MUTEX_UNLOCK(m) \
+
+# define MUTEX_UNLOCK(m) \
STMT_START { \
if (ReleaseMutex(*(m)) == 0) \
Perl_croak(aTHX_ "panic: MUTEX_UNLOCK"); \
} STMT_END
-#define MUTEX_LOCK_NOCONTEXT(m) \
+
+# define MUTEX_LOCK_NOCONTEXT(m) \
STMT_START { \
if (WaitForSingleObject(*(m),INFINITE) == WAIT_FAILED) \
Perl_croak_nocontext("panic: MUTEX_LOCK"); \
} STMT_END
-#define MUTEX_UNLOCK_NOCONTEXT(m) \
+
+# define MUTEX_UNLOCK_NOCONTEXT(m) \
STMT_START { \
if (ReleaseMutex(*(m)) == 0) \
Perl_croak_nocontext("panic: MUTEX_UNLOCK"); \
} STMT_END
-#define MUTEX_DESTROY(m) \
+
+# define MUTEX_DESTROY(m) \
STMT_START { \
if (CloseHandle(*(m)) == 0) \
Perl_croak(aTHX_ "panic: MUTEX_DESTROY"); \
START_EXTERN_C
#if defined(PERLDLL) && defined(USE_DECLSPEC_THREAD) && (!defined(__BORLANDC__) || defined(_DLL))
-extern __declspec(thread) struct perl_thread *Perl_current_thread;
-#define SET_THR(t) (Perl_current_thread = t)
-#define THR Perl_current_thread
+extern __declspec(thread) void *PL_current_context;
+#define PERL_SET_CONTEXT(t) (PL_current_context = t)
+#define PERL_GET_CONTEXT PL_current_context
#else
-#define THR Perl_getTHR()
-#define SET_THR(t) Perl_setTHR(t)
+#define PERL_GET_CONTEXT Perl_get_context()
+#define PERL_SET_CONTEXT(t) Perl_set_context(t)
#endif
-struct perl_thread;
-void Perl_alloc_thread_key (void);
+#define PERL_GET_CONTEXT_DEFINED
+
+#if defined(USE_THREADS)
+struct perl_thread;
int Perl_thread_create (struct perl_thread *thr, thread_func_t *fn);
void Perl_set_thread_self (struct perl_thread *thr);
-struct perl_thread *Perl_getTHR (void);
-void Perl_setTHR (struct perl_thread *t);
void Perl_init_thread_intern (struct perl_thread *t);
+#define SET_THREAD_SELF(thr) Perl_set_thread_self(thr)
+
+#endif /* USE_THREADS */
+
END_EXTERN_C
-#define INIT_THREADS NOOP
-#define ALLOC_THREAD_KEY Perl_alloc_thread_key()
-#define SET_THREAD_SELF(thr) Perl_set_thread_self(thr)
+#define INIT_THREADS NOOP
+#define ALLOC_THREAD_KEY \
+ STMT_START { \
+ if ((PL_thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES) \
+ Perl_croak_nocontext("panic: TlsAlloc"); \
+ } STMT_END
#if defined(USE_RTL_THREAD_API) && !defined(_MSC_VER)
#define JOIN(t, avp) \
projects / p5sagit/p5-mst-13.2.git / commitdiff