ext/Thread/specific.tx Test thread-specific user data
ext/Thread/sync.tx Test thread synchronisation
ext/Thread/sync2.tx Test thread synchronisation
-ext/Thread/thr5005.t Test 5.005-style threading (skipped if no use5005threads)
ext/Thread/Thread.xs Thread extension external subroutines
ext/Thread/Thread/Signal.pm Start a thread to run signal handlers
ext/Thread/Thread/Specific.pm Thread specific data access
"static_ext=$(STATIC_EXT)" \
"dynamic_ext=$(DYNAMIC_EXT)" \
"nonxs_ext=$(NONXS_EXT)" \
- "use5005threads=$(USE_5005THREADS)" \
"useithreads=$(USE_ITHREADS)" \
- "usethreads=$(USE_5005THREADS)" \
"usemultiplicity=$(USE_MULTI)" \
"ld=$(LINK)" \
"base_import=$(BASE_IMPORT_FILES)" \
# else USE_STDIO will be defined.
#USE_PERLIO = define
#USE_STDIO = define
-#
-# WARNING! This option is deprecated and will eventually go away (enable
-# USE_ITHREADS instead).
-#
-# uncomment to enable threads-capabilities. This is incompatible with
-# USE_ITHREADS, and is only here for people who may have come to rely
-# on the experimental Thread support that was in 5.005.
-#
-#USE_5005THREADS= define
# For now let this be here
#
PERL_MALLOC = undef
!ENDIF
-!IF "$(USE_5005THREADS)" == ""
-USE_5005THREADS = undef
-!ENDIF
-
-!IF "$(USE_5005THREADS)" == "define"
-USE_ITHREADS = undef
-!ENDIF
-
!IF "$(USE_IMP_SYS)" == "define"
PERL_MALLOC = undef
!ENDIF
USE_PERLCRT = undef
!ENDIF
-!IF "$(USE_IMP_SYS)$(USE_MULTI)$(USE_5005THREADS)" == "defineundefundef"
+!IF "$(USE_IMP_SYS)$(USE_MULTI)" == "defineundef"
USE_MULTI = define
!ENDIF
!IF "$(USE_ITHREADS)$(USE_MULTI)" == "defineundef"
USE_MULTI = define
-USE_5005THREADS = undef
!ENDIF
-!IF "$(USE_MULTI)$(USE_5005THREADS)" != "undefundef"
+!IF "$(USE_MULTI)" != "undef"
BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_CONTEXT
!ENDIF
PROCESSOR_ARCHITECTURE = x86
!ENDIF
-!IF "$(USE_5005THREADS)" == "define"
-ARCHNAME = NetWare-$(PROCESSOR_ARCHITECTURE)-thread
-!ELSE
!IF "$(USE_MULTI)" == "define"
ARCHNAME = NetWare-$(PROCESSOR_ARCHITECTURE)-multi
!ELSE
ARCHNAME = NetWare-$(PROCESSOR_ARCHITECTURE)
!ENDIF
-!ENDIF
-!IF "$(USE_MULTI)$(USE_5005THREADS)" != "undefundef"
+!IF "$(USE_MULTI)" != "undef"
ADD_BUILDOPT = $(ADD_BUILDOPT) -DPERL_IMPLICIT_CONTEXT
!ENDIF
uname='uname'
uniq='uniq'
uquadtype='unsigned __int64'
-use5005threads='undef'
use64bitall='undef'
use64bitint='undef'
usedl='define'
* This symbol, if defined, indicates that Perl should be built to
* use the interpreter-based threading implementation.
*/
-/* USE_5005THREADS:
- * This symbol, if defined, indicates that Perl should be built to
- * use the 5.005-based threading implementation.
- */
/* OLD_PTHREADS_API:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-/*#define USE_5005THREADS /**/
#define USE_ITHREADS /**/
-#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
-#define USE_5005THREADS /* until src is revised*/
-#endif
/*#define OLD_PTHREADS_API /**/
/*#define USE_REENTRANT_API /**/
void
Perl_set_context(void *t)
{
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
# ifdef USE_DECLSPEC_THREAD
Perl_current_context = t;
# else
void *
Perl_get_context(void)
{
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
# ifdef USE_DECLSPEC_THREAD
return Perl_current_context;
# else
BOOL
Remove_Thread_Ctx(void)
{
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
# ifdef USE_DECLSPEC_THREAD
return TRUE;
# else
// Ananth, 3 Sept 2001
typedef struct nw_cond { long waiters; unsigned int sem; } perl_cond;
-#if (defined (USE_ITHREADS) || defined (USE_5005THREADS)) && defined(MPK_ON)
+#if defined (USE_ITHREADS) && defined(MPK_ON)
#ifdef __cplusplus
extern "C"
{
unsigned int, unsigned long long, uint64_t, or whatever type is
used for 64-bit integers.
-use5005threads (usethreads.U):
- This variable conditionally defines the USE_5005THREADS symbol,
- and indicates that Perl should be built to use the 5.005-based
- threading implementation.
-
use64bitall (use64bits.U):
This variable conditionally defines the USE_64_BIT_ALL symbol,
and indicates that 64-bit integer types should be used
uname='uname'
uniq='uniq'
uquadtype='unsigned long long'
-use5005threads='undef'
use64bitall='undef'
use64bitint='undef'
usecrosscompile='undef'
* This symbol, if defined, indicates that Perl should be built to
* use the interpreter-based threading implementation.
*/
-/* USE_5005THREADS:
- * This symbol, if defined, indicates that Perl should be built to
- * use the 5.005-based threading implementation.
- */
/* OLD_PTHREADS_API:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-/*#define USE_5005THREADS / **/
/*#define USE_ITHREADS / **/
-#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
-#define USE_THREADS /* until src is revised*/
-#endif
/*#define OLD_PTHREADS_API / **/
/*#define USE_REENTRANT_API / **/
* This symbol, if defined, indicates that Perl should be built to
* use the interpreter-based threading implementation.
*/
-/* USE_5005THREADS:
- * This symbol, if defined, indicates that Perl should be built to
- * use the 5.005-based threading implementation.
- */
/* OLD_PTHREADS_API:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-#$use5005threads USE_5005THREADS /**/
#$useithreads USE_ITHREADS /**/
-#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
-#define USE_THREADS /* until src is revised*/
-#endif
#$d_oldpthreads OLD_PTHREADS_API /**/
#$usereentrant USE_REENTRANT_API /**/
CV * cv;
GV * gv;
GV * dfoutgv;
-#ifndef USE_5005THREADS
AV * savearray;
-#endif /* USE_5005THREADS */
AV * argarray;
long olddepth;
U8 hasargs;
cx->blk_sub.dfoutgv = PL_defoutgv; \
(void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
-#ifdef USE_5005THREADS
-# define POP_SAVEARRAY() NOOP
-#else
-# define POP_SAVEARRAY() \
+#define POP_SAVEARRAY() \
STMT_START { \
SvREFCNT_dec(GvAV(PL_defgv)); \
GvAV(PL_defgv) = cx->blk_sub.savearray; \
} STMT_END
-#endif /* USE_5005THREADS */
/* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't
* leave any (a fast av_clear(ary), basically) */
long xcv_depth; /* >= 2 indicates recursive call */
PADLIST * xcv_padlist;
CV * xcv_outside;
-#ifdef USE_5005THREADS
- perl_mutex *xcv_mutexp;
- struct perl_thread *xcv_owner; /* current owner thread */
-#endif /* USE_5005THREADS */
cv_flags_t xcv_flags;
};
#define CvDEPTH(sv) ((XPVCV*)SvANY(sv))->xcv_depth
#define CvPADLIST(sv) ((XPVCV*)SvANY(sv))->xcv_padlist
#define CvOUTSIDE(sv) ((XPVCV*)SvANY(sv))->xcv_outside
-#ifdef USE_5005THREADS
-#define CvMUTEXP(sv) ((XPVCV*)SvANY(sv))->xcv_mutexp
-#define CvOWNER(sv) ((XPVCV*)SvANY(sv))->xcv_owner
-#endif /* USE_5005THREADS */
#define CvFLAGS(sv) ((XPVCV*)SvANY(sv))->xcv_flags
#define CVf_CLONE 0x0001 /* anon CV uses external lexicals */
#ifdef DEBUGGING
char* file = OutCopFILE(PL_curcop);
-#ifdef USE_5005THREADS
- PerlIO_printf(Perl_debug_log, "0x%"UVxf" (%s:%ld)\t",
- PTR2UV(thr),
- (file ? file : "<free>"),
- (long)CopLINE(PL_curcop));
-#else
PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", (file ? file : "<free>"),
(long)CopLINE(PL_curcop));
-#endif /* USE_5005THREADS */
(void) PerlIO_vprintf(Perl_debug_log, pat, *args);
#endif /* DEBUGGING */
}
# if (DJGPP==2 && DJGPP_MINOR < 2)
# define NO_LOCALECONV_MON_THOUSANDS_SEP
# endif
-# ifdef USE_5005THREADS
-# define OLD_PTHREADS_API
-# endif
# define PERL_FS_VER_FMT "%d_%d_%d"
#else /* DJGPP */
# ifdef WIN32
do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
-#ifdef USE_5005THREADS
- Perl_dump_indent(aTHX_ level, file, " MUTEXP = 0x%"UVxf"\n", PTR2UV(CvMUTEXP(sv)));
- Perl_dump_indent(aTHX_ level, file, " OWNER = 0x%"UVxf"\n", PTR2UV(CvOWNER(sv)));
-#endif /* USE_5005THREADS */
Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
if (type == SVt_PVFM)
Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)FmLINES(sv));
#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
Ap |I32 |my_chsize |int fd|Off_t length
#endif
-#if defined(USE_5005THREADS)
-Ap |MAGIC* |condpair_magic |SV *sv
-#endif
p |OP* |convert |I32 optype|I32 flags|OP* o
Afprd |void |croak |const char* pat|...
Apr |void |vcroak |const char* pat|va_list* args
|SV* littlesv|U32 flags
p |char* |find_script |char *scriptname|bool dosearch \
|char **search_ext|I32 flags
-#if defined(USE_5005THREADS)
-p |PADOFFSET|find_threadsv|const char *name
-#endif
p |OP* |force_list |OP* arg
p |OP* |fold_constants |OP* arg
Afpd |char* |form |const char* pat|...
p |int |magic_getuvar |SV* sv|MAGIC* mg
p |int |magic_getvec |SV* sv|MAGIC* mg
p |U32 |magic_len |SV* sv|MAGIC* mg
-#if defined(USE_5005THREADS)
-p |int |magic_mutexfree|SV* sv|MAGIC* mg
-#endif
p |int |magic_nextpack |SV* sv|MAGIC* mg|SV* key
p |U32 |magic_regdata_cnt|SV* sv|MAGIC* mg
p |int |magic_regdatum_get|SV* sv|MAGIC* mg
pd |void |pad_swipe |PADOFFSET po|bool refadjust
p |void |peep |OP* o
dopM |PerlIO*|start_glob |SV* pattern|IO *io
-#if defined(USE_5005THREADS)
-Ap |struct perl_thread* |new_struct_thread|struct perl_thread *t
-#endif
#if defined(USE_REENTRANT_API)
Ap |void |reentrant_size
Ap |void |reentrant_init
#if defined(UNLINK_ALL_VERSIONS)
Ap |I32 |unlnk |char* f
#endif
-#if defined(USE_5005THREADS)
-Ap |void |unlock_condpair|void* svv
-#endif
Apd |I32 |unpack_str |char *pat|char *patend|char *s|char *strbeg|char *strend|char **new_s|I32 ocnt|U32 flags
Ap |void |unsharepvn |const char* sv|I32 len|U32 hash
p |void |unshare_hek |HEK* hek
#endif
Ap |int |runops_standard
Ap |int |runops_debug
-#if defined(USE_5005THREADS)
-Ap |SV* |sv_lock |SV *sv
-#endif
Afpd |void |sv_catpvf_mg |SV *sv|const char* pat|...
Ap |void |sv_vcatpvf_mg |SV* sv|const char* pat|va_list* args
Apd |void |sv_catpv_mg |SV *sv|const char *ptr
s |void* |vcall_body |va_list args
s |void* |vcall_list_body|va_list args
#endif
-# if defined(USE_5005THREADS)
-s |struct perl_thread * |init_main_thread
-# endif
#endif
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
#define my_chsize Perl_my_chsize
#endif
-#if defined(USE_5005THREADS)
-#define condpair_magic Perl_condpair_magic
-#endif
#define convert Perl_convert
#define croak Perl_croak
#define vcroak Perl_vcroak
#define fbm_compile Perl_fbm_compile
#define fbm_instr Perl_fbm_instr
#define find_script Perl_find_script
-#if defined(USE_5005THREADS)
-#define find_threadsv Perl_find_threadsv
-#endif
#define force_list Perl_force_list
#define fold_constants Perl_fold_constants
#define form Perl_form
#define magic_getuvar Perl_magic_getuvar
#define magic_getvec Perl_magic_getvec
#define magic_len Perl_magic_len
-#if defined(USE_5005THREADS)
-#define magic_mutexfree Perl_magic_mutexfree
-#endif
#define magic_nextpack Perl_magic_nextpack
#define magic_regdata_cnt Perl_magic_regdata_cnt
#define magic_regdatum_get Perl_magic_regdatum_get
#define pad_reset Perl_pad_reset
#define pad_swipe Perl_pad_swipe
#define peep Perl_peep
-#if defined(USE_5005THREADS)
-#define new_struct_thread Perl_new_struct_thread
-#endif
#if defined(USE_REENTRANT_API)
#define reentrant_size Perl_reentrant_size
#define reentrant_init Perl_reentrant_init
#if defined(UNLINK_ALL_VERSIONS)
#define unlnk Perl_unlnk
#endif
-#if defined(USE_5005THREADS)
-#define unlock_condpair Perl_unlock_condpair
-#endif
#define unpack_str Perl_unpack_str
#define unsharepvn Perl_unsharepvn
#define unshare_hek Perl_unshare_hek
#endif
#define runops_standard Perl_runops_standard
#define runops_debug Perl_runops_debug
-#if defined(USE_5005THREADS)
-#define sv_lock Perl_sv_lock
-#endif
#define sv_catpvf_mg Perl_sv_catpvf_mg
#define sv_vcatpvf_mg Perl_sv_vcatpvf_mg
#define sv_catpv_mg Perl_sv_catpv_mg
#define vcall_body S_vcall_body
#define vcall_list_body S_vcall_list_body
#endif
-# if defined(USE_5005THREADS)
-#define init_main_thread S_init_main_thread
-# endif
#endif
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
#define refto S_refto
#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
#define my_chsize(a,b) Perl_my_chsize(aTHX_ a,b)
#endif
-#if defined(USE_5005THREADS)
-#define condpair_magic(a) Perl_condpair_magic(aTHX_ a)
-#endif
#define convert(a,b,c) Perl_convert(aTHX_ a,b,c)
#define vcroak(a,b) Perl_vcroak(aTHX_ a,b)
#if defined(PERL_IMPLICIT_CONTEXT)
#define fbm_compile(a,b) Perl_fbm_compile(aTHX_ a,b)
#define fbm_instr(a,b,c,d) Perl_fbm_instr(aTHX_ a,b,c,d)
#define find_script(a,b,c,d) Perl_find_script(aTHX_ a,b,c,d)
-#if defined(USE_5005THREADS)
-#define find_threadsv(a) Perl_find_threadsv(aTHX_ a)
-#endif
#define force_list(a) Perl_force_list(aTHX_ a)
#define fold_constants(a) Perl_fold_constants(aTHX_ a)
#define vform(a,b) Perl_vform(aTHX_ a,b)
#define magic_getuvar(a,b) Perl_magic_getuvar(aTHX_ a,b)
#define magic_getvec(a,b) Perl_magic_getvec(aTHX_ a,b)
#define magic_len(a,b) Perl_magic_len(aTHX_ a,b)
-#if defined(USE_5005THREADS)
-#define magic_mutexfree(a,b) Perl_magic_mutexfree(aTHX_ a,b)
-#endif
#define magic_nextpack(a,b,c) Perl_magic_nextpack(aTHX_ a,b,c)
#define magic_regdata_cnt(a,b) Perl_magic_regdata_cnt(aTHX_ a,b)
#define magic_regdatum_get(a,b) Perl_magic_regdatum_get(aTHX_ a,b)
#define pad_reset() Perl_pad_reset(aTHX)
#define pad_swipe(a,b) Perl_pad_swipe(aTHX_ a,b)
#define peep(a) Perl_peep(aTHX_ a)
-#if defined(USE_5005THREADS)
-#define new_struct_thread(a) Perl_new_struct_thread(aTHX_ a)
-#endif
#if defined(USE_REENTRANT_API)
#define reentrant_size() Perl_reentrant_size(aTHX)
#define reentrant_init() Perl_reentrant_init(aTHX)
#if defined(UNLINK_ALL_VERSIONS)
#define unlnk(a) Perl_unlnk(aTHX_ a)
#endif
-#if defined(USE_5005THREADS)
-#define unlock_condpair(a) Perl_unlock_condpair(aTHX_ a)
-#endif
#define unpack_str(a,b,c,d,e,f,g,h) Perl_unpack_str(aTHX_ a,b,c,d,e,f,g,h)
#define unsharepvn(a,b,c) Perl_unsharepvn(aTHX_ a,b,c)
#define unshare_hek(a) Perl_unshare_hek(aTHX_ a)
#endif
#define runops_standard() Perl_runops_standard(aTHX)
#define runops_debug() Perl_runops_debug(aTHX)
-#if defined(USE_5005THREADS)
-#define sv_lock(a) Perl_sv_lock(aTHX_ a)
-#endif
#define sv_vcatpvf_mg(a,b,c) Perl_sv_vcatpvf_mg(aTHX_ a,b,c)
#define sv_catpv_mg(a,b) Perl_sv_catpv_mg(aTHX_ a,b)
#define sv_catpvn_mg(a,b,c) Perl_sv_catpvn_mg(aTHX_ a,b,c)
#define vcall_body(a) S_vcall_body(aTHX_ a)
#define vcall_list_body(a) S_vcall_list_body(aTHX_ a)
#endif
-# if defined(USE_5005THREADS)
-#define init_main_thread() S_init_main_thread(aTHX)
-# endif
#endif
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
#define refto(a) S_refto(aTHX_ a)
/* (Doing namespace management portably in C is really gross.) */
/*
- The following combinations of MULTIPLICITY, USE_5005THREADS
- and PERL_IMPLICIT_CONTEXT are supported:
+ The following combinations of MULTIPLICITY and PERL_IMPLICIT_CONTEXT
+ are supported:
1) none
2) MULTIPLICITY # supported for compatibility
3) MULTIPLICITY && PERL_IMPLICIT_CONTEXT
- 4) USE_5005THREADS && PERL_IMPLICIT_CONTEXT
- 5) MULTIPLICITY && USE_5005THREADS && PERL_IMPLICIT_CONTEXT
All other combinations of these flags are errors.
- #3, #4, #5, and #6 are supported directly, while #2 is a special
+ only #3 is supported directly, while #2 is a special
case of #3 (supported by redefining vTHX appropriately).
*/
#if defined(MULTIPLICITY)
-/* cases 2, 3 and 5 above */
+/* cases 2 and 3 above */
# if defined(PERL_IMPLICIT_CONTEXT)
# define vTHX aTHX
print EM <<'END';
-# if defined(USE_5005THREADS)
-/* case 5 above */
-
-END
-
-for $sym (sort keys %intrp) {
- print EM multon($sym,'I','PERL_GET_INTERP->');
-}
-
-print EM <<'END';
-
-# else /* !USE_5005THREADS */
/* cases 2 and 3 above */
END
print EM <<'END';
-# endif /* USE_5005THREADS */
-
#else /* !MULTIPLICITY */
-/* cases 1 and 4 above */
+/* case 1 above */
END
print EM <<'END';
-# if defined(USE_5005THREADS)
-/* case 4 above */
-
-END
-
-for $sym (sort keys %thread) {
- print EM multon($sym,'T','aTHX->');
-}
-
-print EM <<'END';
-
-# else /* !USE_5005THREADS */
-/* case 1 above */
-
END
for $sym (sort keys %thread) {
print EM <<'END';
-# endif /* USE_5005THREADS */
#endif /* MULTIPLICITY */
#if defined(PERL_GLOBAL_STRUCT)
/* (Doing namespace management portably in C is really gross.) */
/*
- The following combinations of MULTIPLICITY, USE_5005THREADS
- and PERL_IMPLICIT_CONTEXT are supported:
+ The following combinations of MULTIPLICITY and PERL_IMPLICIT_CONTEXT
+ are supported:
1) none
2) MULTIPLICITY # supported for compatibility
3) MULTIPLICITY && PERL_IMPLICIT_CONTEXT
- 4) USE_5005THREADS && PERL_IMPLICIT_CONTEXT
- 5) MULTIPLICITY && USE_5005THREADS && PERL_IMPLICIT_CONTEXT
All other combinations of these flags are errors.
- #3, #4, #5, and #6 are supported directly, while #2 is a special
+ only #3 is supported directly, while #2 is a special
case of #3 (supported by redefining vTHX appropriately).
*/
#if defined(MULTIPLICITY)
-/* cases 2, 3 and 5 above */
+/* cases 2 and 3 above */
# if defined(PERL_IMPLICIT_CONTEXT)
# define vTHX aTHX
#define PL_watchaddr (vTHX->Twatchaddr)
#define PL_watchok (vTHX->Twatchok)
-# if defined(USE_5005THREADS)
-/* case 5 above */
-
-#define PL_Argv (PERL_GET_INTERP->IArgv)
-#define PL_Cmd (PERL_GET_INTERP->ICmd)
-#define PL_DBcv (PERL_GET_INTERP->IDBcv)
-#define PL_DBgv (PERL_GET_INTERP->IDBgv)
-#define PL_DBline (PERL_GET_INTERP->IDBline)
-#define PL_DBsignal (PERL_GET_INTERP->IDBsignal)
-#define PL_DBsingle (PERL_GET_INTERP->IDBsingle)
-#define PL_DBsub (PERL_GET_INTERP->IDBsub)
-#define PL_DBtrace (PERL_GET_INTERP->IDBtrace)
-#define PL_Dir (PERL_GET_INTERP->IDir)
-#define PL_Env (PERL_GET_INTERP->IEnv)
-#define PL_LIO (PERL_GET_INTERP->ILIO)
-#define PL_Mem (PERL_GET_INTERP->IMem)
-#define PL_MemParse (PERL_GET_INTERP->IMemParse)
-#define PL_MemShared (PERL_GET_INTERP->IMemShared)
-#define PL_OpPtr (PERL_GET_INTERP->IOpPtr)
-#define PL_OpSlab (PERL_GET_INTERP->IOpSlab)
-#define PL_OpSpace (PERL_GET_INTERP->IOpSpace)
-#define PL_Proc (PERL_GET_INTERP->IProc)
-#define PL_Sock (PERL_GET_INTERP->ISock)
-#define PL_StdIO (PERL_GET_INTERP->IStdIO)
-#define PL_amagic_generation (PERL_GET_INTERP->Iamagic_generation)
-#define PL_an (PERL_GET_INTERP->Ian)
-#define PL_argvgv (PERL_GET_INTERP->Iargvgv)
-#define PL_argvout_stack (PERL_GET_INTERP->Iargvout_stack)
-#define PL_argvoutgv (PERL_GET_INTERP->Iargvoutgv)
-#define PL_basetime (PERL_GET_INTERP->Ibasetime)
-#define PL_beginav (PERL_GET_INTERP->Ibeginav)
-#define PL_beginav_save (PERL_GET_INTERP->Ibeginav_save)
-#define PL_bitcount (PERL_GET_INTERP->Ibitcount)
-#define PL_bufend (PERL_GET_INTERP->Ibufend)
-#define PL_bufptr (PERL_GET_INTERP->Ibufptr)
-#define PL_checkav (PERL_GET_INTERP->Icheckav)
-#define PL_checkav_save (PERL_GET_INTERP->Icheckav_save)
-#define PL_clocktick (PERL_GET_INTERP->Iclocktick)
-#define PL_collation_ix (PERL_GET_INTERP->Icollation_ix)
-#define PL_collation_name (PERL_GET_INTERP->Icollation_name)
-#define PL_collation_standard (PERL_GET_INTERP->Icollation_standard)
-#define PL_collxfrm_base (PERL_GET_INTERP->Icollxfrm_base)
-#define PL_collxfrm_mult (PERL_GET_INTERP->Icollxfrm_mult)
-#define PL_compcv (PERL_GET_INTERP->Icompcv)
-#define PL_compiling (PERL_GET_INTERP->Icompiling)
-#define PL_comppad (PERL_GET_INTERP->Icomppad)
-#define PL_comppad_name (PERL_GET_INTERP->Icomppad_name)
-#define PL_comppad_name_fill (PERL_GET_INTERP->Icomppad_name_fill)
-#define PL_comppad_name_floor (PERL_GET_INTERP->Icomppad_name_floor)
-#define PL_cop_seqmax (PERL_GET_INTERP->Icop_seqmax)
-#define PL_copline (PERL_GET_INTERP->Icopline)
-#define PL_cred_mutex (PERL_GET_INTERP->Icred_mutex)
-#define PL_cryptseen (PERL_GET_INTERP->Icryptseen)
-#define PL_cshlen (PERL_GET_INTERP->Icshlen)
-#define PL_cshname (PERL_GET_INTERP->Icshname)
-#define PL_curcopdb (PERL_GET_INTERP->Icurcopdb)
-#define PL_curstname (PERL_GET_INTERP->Icurstname)
-#define PL_curthr (PERL_GET_INTERP->Icurthr)
-#define PL_custom_op_descs (PERL_GET_INTERP->Icustom_op_descs)
-#define PL_custom_op_names (PERL_GET_INTERP->Icustom_op_names)
-#define PL_dbargs (PERL_GET_INTERP->Idbargs)
-#define PL_debstash (PERL_GET_INTERP->Idebstash)
-#define PL_debug (PERL_GET_INTERP->Idebug)
-#define PL_debug_pad (PERL_GET_INTERP->Idebug_pad)
-#define PL_def_layerlist (PERL_GET_INTERP->Idef_layerlist)
-#define PL_defgv (PERL_GET_INTERP->Idefgv)
-#define PL_diehook (PERL_GET_INTERP->Idiehook)
-#define PL_doextract (PERL_GET_INTERP->Idoextract)
-#define PL_doswitches (PERL_GET_INTERP->Idoswitches)
-#define PL_dowarn (PERL_GET_INTERP->Idowarn)
-#define PL_e_script (PERL_GET_INTERP->Ie_script)
-#define PL_egid (PERL_GET_INTERP->Iegid)
-#define PL_encoding (PERL_GET_INTERP->Iencoding)
-#define PL_endav (PERL_GET_INTERP->Iendav)
-#define PL_envgv (PERL_GET_INTERP->Ienvgv)
-#define PL_errgv (PERL_GET_INTERP->Ierrgv)
-#define PL_error_count (PERL_GET_INTERP->Ierror_count)
-#define PL_euid (PERL_GET_INTERP->Ieuid)
-#define PL_eval_cond (PERL_GET_INTERP->Ieval_cond)
-#define PL_eval_mutex (PERL_GET_INTERP->Ieval_mutex)
-#define PL_eval_owner (PERL_GET_INTERP->Ieval_owner)
-#define PL_eval_root (PERL_GET_INTERP->Ieval_root)
-#define PL_eval_start (PERL_GET_INTERP->Ieval_start)
-#define PL_evalseq (PERL_GET_INTERP->Ievalseq)
-#define PL_exit_flags (PERL_GET_INTERP->Iexit_flags)
-#define PL_exitlist (PERL_GET_INTERP->Iexitlist)
-#define PL_exitlistlen (PERL_GET_INTERP->Iexitlistlen)
-#define PL_expect (PERL_GET_INTERP->Iexpect)
-#define PL_fdpid (PERL_GET_INTERP->Ifdpid)
-#define PL_fdpid_mutex (PERL_GET_INTERP->Ifdpid_mutex)
-#define PL_filemode (PERL_GET_INTERP->Ifilemode)
-#define PL_forkprocess (PERL_GET_INTERP->Iforkprocess)
-#define PL_formfeed (PERL_GET_INTERP->Iformfeed)
-#define PL_generation (PERL_GET_INTERP->Igeneration)
-#define PL_gensym (PERL_GET_INTERP->Igensym)
-#define PL_gid (PERL_GET_INTERP->Igid)
-#define PL_glob_index (PERL_GET_INTERP->Iglob_index)
-#define PL_globalstash (PERL_GET_INTERP->Iglobalstash)
-#define PL_he_arenaroot (PERL_GET_INTERP->Ihe_arenaroot)
-#define PL_he_root (PERL_GET_INTERP->Ihe_root)
-#define PL_hintgv (PERL_GET_INTERP->Ihintgv)
-#define PL_hints (PERL_GET_INTERP->Ihints)
-#define PL_in_clean_all (PERL_GET_INTERP->Iin_clean_all)
-#define PL_in_clean_objs (PERL_GET_INTERP->Iin_clean_objs)
-#define PL_in_my (PERL_GET_INTERP->Iin_my)
-#define PL_in_my_stash (PERL_GET_INTERP->Iin_my_stash)
-#define PL_incgv (PERL_GET_INTERP->Iincgv)
-#define PL_initav (PERL_GET_INTERP->Iinitav)
-#define PL_inplace (PERL_GET_INTERP->Iinplace)
-#define PL_known_layers (PERL_GET_INTERP->Iknown_layers)
-#define PL_last_lop (PERL_GET_INTERP->Ilast_lop)
-#define PL_last_lop_op (PERL_GET_INTERP->Ilast_lop_op)
-#define PL_last_swash_hv (PERL_GET_INTERP->Ilast_swash_hv)
-#define PL_last_swash_key (PERL_GET_INTERP->Ilast_swash_key)
-#define PL_last_swash_klen (PERL_GET_INTERP->Ilast_swash_klen)
-#define PL_last_swash_slen (PERL_GET_INTERP->Ilast_swash_slen)
-#define PL_last_swash_tmps (PERL_GET_INTERP->Ilast_swash_tmps)
-#define PL_last_uni (PERL_GET_INTERP->Ilast_uni)
-#define PL_lastfd (PERL_GET_INTERP->Ilastfd)
-#define PL_laststatval (PERL_GET_INTERP->Ilaststatval)
-#define PL_laststype (PERL_GET_INTERP->Ilaststype)
-#define PL_lex_brackets (PERL_GET_INTERP->Ilex_brackets)
-#define PL_lex_brackstack (PERL_GET_INTERP->Ilex_brackstack)
-#define PL_lex_casemods (PERL_GET_INTERP->Ilex_casemods)
-#define PL_lex_casestack (PERL_GET_INTERP->Ilex_casestack)
-#define PL_lex_defer (PERL_GET_INTERP->Ilex_defer)
-#define PL_lex_dojoin (PERL_GET_INTERP->Ilex_dojoin)
-#define PL_lex_expect (PERL_GET_INTERP->Ilex_expect)
-#define PL_lex_formbrack (PERL_GET_INTERP->Ilex_formbrack)
-#define PL_lex_inpat (PERL_GET_INTERP->Ilex_inpat)
-#define PL_lex_inwhat (PERL_GET_INTERP->Ilex_inwhat)
-#define PL_lex_op (PERL_GET_INTERP->Ilex_op)
-#define PL_lex_repl (PERL_GET_INTERP->Ilex_repl)
-#define PL_lex_starts (PERL_GET_INTERP->Ilex_starts)
-#define PL_lex_state (PERL_GET_INTERP->Ilex_state)
-#define PL_lex_stuff (PERL_GET_INTERP->Ilex_stuff)
-#define PL_lineary (PERL_GET_INTERP->Ilineary)
-#define PL_linestart (PERL_GET_INTERP->Ilinestart)
-#define PL_linestr (PERL_GET_INTERP->Ilinestr)
-#define PL_localpatches (PERL_GET_INTERP->Ilocalpatches)
-#define PL_main_cv (PERL_GET_INTERP->Imain_cv)
-#define PL_main_root (PERL_GET_INTERP->Imain_root)
-#define PL_main_start (PERL_GET_INTERP->Imain_start)
-#define PL_max_intro_pending (PERL_GET_INTERP->Imax_intro_pending)
-#define PL_maxo (PERL_GET_INTERP->Imaxo)
-#define PL_maxsysfd (PERL_GET_INTERP->Imaxsysfd)
-#define PL_mess_sv (PERL_GET_INTERP->Imess_sv)
-#define PL_min_intro_pending (PERL_GET_INTERP->Imin_intro_pending)
-#define PL_minus_F (PERL_GET_INTERP->Iminus_F)
-#define PL_minus_a (PERL_GET_INTERP->Iminus_a)
-#define PL_minus_c (PERL_GET_INTERP->Iminus_c)
-#define PL_minus_l (PERL_GET_INTERP->Iminus_l)
-#define PL_minus_n (PERL_GET_INTERP->Iminus_n)
-#define PL_minus_p (PERL_GET_INTERP->Iminus_p)
-#define PL_modglobal (PERL_GET_INTERP->Imodglobal)
-#define PL_multi_close (PERL_GET_INTERP->Imulti_close)
-#define PL_multi_end (PERL_GET_INTERP->Imulti_end)
-#define PL_multi_open (PERL_GET_INTERP->Imulti_open)
-#define PL_multi_start (PERL_GET_INTERP->Imulti_start)
-#define PL_multiline (PERL_GET_INTERP->Imultiline)
-#define PL_nexttoke (PERL_GET_INTERP->Inexttoke)
-#define PL_nexttype (PERL_GET_INTERP->Inexttype)
-#define PL_nextval (PERL_GET_INTERP->Inextval)
-#define PL_nice_chunk (PERL_GET_INTERP->Inice_chunk)
-#define PL_nice_chunk_size (PERL_GET_INTERP->Inice_chunk_size)
-#define PL_nomemok (PERL_GET_INTERP->Inomemok)
-#define PL_nthreads (PERL_GET_INTERP->Inthreads)
-#define PL_nthreads_cond (PERL_GET_INTERP->Inthreads_cond)
-#define PL_numeric_compat1 (PERL_GET_INTERP->Inumeric_compat1)
-#define PL_numeric_local (PERL_GET_INTERP->Inumeric_local)
-#define PL_numeric_name (PERL_GET_INTERP->Inumeric_name)
-#define PL_numeric_radix_sv (PERL_GET_INTERP->Inumeric_radix_sv)
-#define PL_numeric_standard (PERL_GET_INTERP->Inumeric_standard)
-#define PL_ofmt (PERL_GET_INTERP->Iofmt)
-#define PL_oldbufptr (PERL_GET_INTERP->Ioldbufptr)
-#define PL_oldname (PERL_GET_INTERP->Ioldname)
-#define PL_oldoldbufptr (PERL_GET_INTERP->Ioldoldbufptr)
-#define PL_op_mask (PERL_GET_INTERP->Iop_mask)
-#define PL_op_seqmax (PERL_GET_INTERP->Iop_seqmax)
-#define PL_origalen (PERL_GET_INTERP->Iorigalen)
-#define PL_origargc (PERL_GET_INTERP->Iorigargc)
-#define PL_origargv (PERL_GET_INTERP->Iorigargv)
-#define PL_origenviron (PERL_GET_INTERP->Iorigenviron)
-#define PL_origfilename (PERL_GET_INTERP->Iorigfilename)
-#define PL_ors_sv (PERL_GET_INTERP->Iors_sv)
-#define PL_osname (PERL_GET_INTERP->Iosname)
-#define PL_pad_reset_pending (PERL_GET_INTERP->Ipad_reset_pending)
-#define PL_padix (PERL_GET_INTERP->Ipadix)
-#define PL_padix_floor (PERL_GET_INTERP->Ipadix_floor)
-#define PL_patchlevel (PERL_GET_INTERP->Ipatchlevel)
-#define PL_pending_ident (PERL_GET_INTERP->Ipending_ident)
-#define PL_perl_destruct_level (PERL_GET_INTERP->Iperl_destruct_level)
-#define PL_perldb (PERL_GET_INTERP->Iperldb)
-#define PL_perlio (PERL_GET_INTERP->Iperlio)
-#define PL_pidstatus (PERL_GET_INTERP->Ipidstatus)
-#define PL_preambleav (PERL_GET_INTERP->Ipreambleav)
-#define PL_preambled (PERL_GET_INTERP->Ipreambled)
-#define PL_preprocess (PERL_GET_INTERP->Ipreprocess)
-#define PL_profiledata (PERL_GET_INTERP->Iprofiledata)
-#define PL_psig_name (PERL_GET_INTERP->Ipsig_name)
-#define PL_psig_pend (PERL_GET_INTERP->Ipsig_pend)
-#define PL_psig_ptr (PERL_GET_INTERP->Ipsig_ptr)
-#define PL_ptr_table (PERL_GET_INTERP->Iptr_table)
-#define PL_reentrant_buffer (PERL_GET_INTERP->Ireentrant_buffer)
-#define PL_regex_pad (PERL_GET_INTERP->Iregex_pad)
-#define PL_regex_padav (PERL_GET_INTERP->Iregex_padav)
-#define PL_replgv (PERL_GET_INTERP->Ireplgv)
-#define PL_rsfp (PERL_GET_INTERP->Irsfp)
-#define PL_rsfp_filters (PERL_GET_INTERP->Irsfp_filters)
-#define PL_runops (PERL_GET_INTERP->Irunops)
-#define PL_savebegin (PERL_GET_INTERP->Isavebegin)
-#define PL_sawampersand (PERL_GET_INTERP->Isawampersand)
-#define PL_sh_path (PERL_GET_INTERP->Ish_path)
-#define PL_sig_pending (PERL_GET_INTERP->Isig_pending)
-#define PL_sighandlerp (PERL_GET_INTERP->Isighandlerp)
-#define PL_sort_RealCmp (PERL_GET_INTERP->Isort_RealCmp)
-#define PL_splitstr (PERL_GET_INTERP->Isplitstr)
-#define PL_srand_called (PERL_GET_INTERP->Isrand_called)
-#define PL_statusvalue (PERL_GET_INTERP->Istatusvalue)
-#define PL_statusvalue_vms (PERL_GET_INTERP->Istatusvalue_vms)
-#define PL_stderrgv (PERL_GET_INTERP->Istderrgv)
-#define PL_stdingv (PERL_GET_INTERP->Istdingv)
-#define PL_strtab (PERL_GET_INTERP->Istrtab)
-#define PL_strtab_mutex (PERL_GET_INTERP->Istrtab_mutex)
-#define PL_sub_generation (PERL_GET_INTERP->Isub_generation)
-#define PL_sublex_info (PERL_GET_INTERP->Isublex_info)
-#define PL_subline (PERL_GET_INTERP->Isubline)
-#define PL_subname (PERL_GET_INTERP->Isubname)
-#define PL_sv_arenaroot (PERL_GET_INTERP->Isv_arenaroot)
-#define PL_sv_count (PERL_GET_INTERP->Isv_count)
-#define PL_sv_lock_mutex (PERL_GET_INTERP->Isv_lock_mutex)
-#define PL_sv_mutex (PERL_GET_INTERP->Isv_mutex)
-#define PL_sv_no (PERL_GET_INTERP->Isv_no)
-#define PL_sv_objcount (PERL_GET_INTERP->Isv_objcount)
-#define PL_sv_root (PERL_GET_INTERP->Isv_root)
-#define PL_sv_undef (PERL_GET_INTERP->Isv_undef)
-#define PL_sv_yes (PERL_GET_INTERP->Isv_yes)
-#define PL_svref_mutex (PERL_GET_INTERP->Isvref_mutex)
-#define PL_sys_intern (PERL_GET_INTERP->Isys_intern)
-#define PL_taint_warn (PERL_GET_INTERP->Itaint_warn)
-#define PL_tainting (PERL_GET_INTERP->Itainting)
-#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_thrsv (PERL_GET_INTERP->Ithrsv)
-#define PL_tokenbuf (PERL_GET_INTERP->Itokenbuf)
-#define PL_uid (PERL_GET_INTERP->Iuid)
-#define PL_unsafe (PERL_GET_INTERP->Iunsafe)
-#define PL_utf8_alnum (PERL_GET_INTERP->Iutf8_alnum)
-#define PL_utf8_alnumc (PERL_GET_INTERP->Iutf8_alnumc)
-#define PL_utf8_alpha (PERL_GET_INTERP->Iutf8_alpha)
-#define PL_utf8_ascii (PERL_GET_INTERP->Iutf8_ascii)
-#define PL_utf8_cntrl (PERL_GET_INTERP->Iutf8_cntrl)
-#define PL_utf8_digit (PERL_GET_INTERP->Iutf8_digit)
-#define PL_utf8_graph (PERL_GET_INTERP->Iutf8_graph)
-#define PL_utf8_idcont (PERL_GET_INTERP->Iutf8_idcont)
-#define PL_utf8_idstart (PERL_GET_INTERP->Iutf8_idstart)
-#define PL_utf8_lower (PERL_GET_INTERP->Iutf8_lower)
-#define PL_utf8_mark (PERL_GET_INTERP->Iutf8_mark)
-#define PL_utf8_print (PERL_GET_INTERP->Iutf8_print)
-#define PL_utf8_punct (PERL_GET_INTERP->Iutf8_punct)
-#define PL_utf8_space (PERL_GET_INTERP->Iutf8_space)
-#define PL_utf8_tofold (PERL_GET_INTERP->Iutf8_tofold)
-#define PL_utf8_tolower (PERL_GET_INTERP->Iutf8_tolower)
-#define PL_utf8_totitle (PERL_GET_INTERP->Iutf8_totitle)
-#define PL_utf8_toupper (PERL_GET_INTERP->Iutf8_toupper)
-#define PL_utf8_upper (PERL_GET_INTERP->Iutf8_upper)
-#define PL_utf8_xdigit (PERL_GET_INTERP->Iutf8_xdigit)
-#define PL_uudmap (PERL_GET_INTERP->Iuudmap)
-#define PL_wantutf8 (PERL_GET_INTERP->Iwantutf8)
-#define PL_warnhook (PERL_GET_INTERP->Iwarnhook)
-#define PL_widesyscalls (PERL_GET_INTERP->Iwidesyscalls)
-#define PL_xiv_arenaroot (PERL_GET_INTERP->Ixiv_arenaroot)
-#define PL_xiv_root (PERL_GET_INTERP->Ixiv_root)
-#define PL_xnv_arenaroot (PERL_GET_INTERP->Ixnv_arenaroot)
-#define PL_xnv_root (PERL_GET_INTERP->Ixnv_root)
-#define PL_xpv_arenaroot (PERL_GET_INTERP->Ixpv_arenaroot)
-#define PL_xpv_root (PERL_GET_INTERP->Ixpv_root)
-#define PL_xpvav_arenaroot (PERL_GET_INTERP->Ixpvav_arenaroot)
-#define PL_xpvav_root (PERL_GET_INTERP->Ixpvav_root)
-#define PL_xpvbm_arenaroot (PERL_GET_INTERP->Ixpvbm_arenaroot)
-#define PL_xpvbm_root (PERL_GET_INTERP->Ixpvbm_root)
-#define PL_xpvcv_arenaroot (PERL_GET_INTERP->Ixpvcv_arenaroot)
-#define PL_xpvcv_root (PERL_GET_INTERP->Ixpvcv_root)
-#define PL_xpvhv_arenaroot (PERL_GET_INTERP->Ixpvhv_arenaroot)
-#define PL_xpvhv_root (PERL_GET_INTERP->Ixpvhv_root)
-#define PL_xpviv_arenaroot (PERL_GET_INTERP->Ixpviv_arenaroot)
-#define PL_xpviv_root (PERL_GET_INTERP->Ixpviv_root)
-#define PL_xpvlv_arenaroot (PERL_GET_INTERP->Ixpvlv_arenaroot)
-#define PL_xpvlv_root (PERL_GET_INTERP->Ixpvlv_root)
-#define PL_xpvmg_arenaroot (PERL_GET_INTERP->Ixpvmg_arenaroot)
-#define PL_xpvmg_root (PERL_GET_INTERP->Ixpvmg_root)
-#define PL_xpvnv_arenaroot (PERL_GET_INTERP->Ixpvnv_arenaroot)
-#define PL_xpvnv_root (PERL_GET_INTERP->Ixpvnv_root)
-#define PL_xrv_arenaroot (PERL_GET_INTERP->Ixrv_arenaroot)
-#define PL_xrv_root (PERL_GET_INTERP->Ixrv_root)
-#define PL_yychar (PERL_GET_INTERP->Iyychar)
-#define PL_yydebug (PERL_GET_INTERP->Iyydebug)
-#define PL_yyerrflag (PERL_GET_INTERP->Iyyerrflag)
-#define PL_yylval (PERL_GET_INTERP->Iyylval)
-#define PL_yynerrs (PERL_GET_INTERP->Iyynerrs)
-#define PL_yyval (PERL_GET_INTERP->Iyyval)
-
-# else /* !USE_5005THREADS */
/* cases 2 and 3 above */
#define PL_Argv (vTHX->IArgv)
#define PL_comppad_name_floor (vTHX->Icomppad_name_floor)
#define PL_cop_seqmax (vTHX->Icop_seqmax)
#define PL_copline (vTHX->Icopline)
-#define PL_cred_mutex (vTHX->Icred_mutex)
#define PL_cryptseen (vTHX->Icryptseen)
#define PL_cshlen (vTHX->Icshlen)
#define PL_cshname (vTHX->Icshname)
#define PL_curcopdb (vTHX->Icurcopdb)
#define PL_curstname (vTHX->Icurstname)
-#define PL_curthr (vTHX->Icurthr)
#define PL_custom_op_descs (vTHX->Icustom_op_descs)
#define PL_custom_op_names (vTHX->Icustom_op_names)
#define PL_dbargs (vTHX->Idbargs)
#define PL_errgv (vTHX->Ierrgv)
#define PL_error_count (vTHX->Ierror_count)
#define PL_euid (vTHX->Ieuid)
-#define PL_eval_cond (vTHX->Ieval_cond)
-#define PL_eval_mutex (vTHX->Ieval_mutex)
-#define PL_eval_owner (vTHX->Ieval_owner)
#define PL_eval_root (vTHX->Ieval_root)
#define PL_eval_start (vTHX->Ieval_start)
#define PL_evalseq (vTHX->Ievalseq)
#define PL_exitlistlen (vTHX->Iexitlistlen)
#define PL_expect (vTHX->Iexpect)
#define PL_fdpid (vTHX->Ifdpid)
-#define PL_fdpid_mutex (vTHX->Ifdpid_mutex)
#define PL_filemode (vTHX->Ifilemode)
#define PL_forkprocess (vTHX->Iforkprocess)
#define PL_formfeed (vTHX->Iformfeed)
#define PL_nice_chunk (vTHX->Inice_chunk)
#define PL_nice_chunk_size (vTHX->Inice_chunk_size)
#define PL_nomemok (vTHX->Inomemok)
-#define PL_nthreads (vTHX->Inthreads)
-#define PL_nthreads_cond (vTHX->Inthreads_cond)
#define PL_numeric_compat1 (vTHX->Inumeric_compat1)
#define PL_numeric_local (vTHX->Inumeric_local)
#define PL_numeric_name (vTHX->Inumeric_name)
#define PL_stderrgv (vTHX->Istderrgv)
#define PL_stdingv (vTHX->Istdingv)
#define PL_strtab (vTHX->Istrtab)
-#define PL_strtab_mutex (vTHX->Istrtab_mutex)
#define PL_sub_generation (vTHX->Isub_generation)
#define PL_sublex_info (vTHX->Isublex_info)
#define PL_subline (vTHX->Isubline)
#define PL_subname (vTHX->Isubname)
#define PL_sv_arenaroot (vTHX->Isv_arenaroot)
#define PL_sv_count (vTHX->Isv_count)
-#define PL_sv_lock_mutex (vTHX->Isv_lock_mutex)
-#define PL_sv_mutex (vTHX->Isv_mutex)
#define PL_sv_no (vTHX->Isv_no)
#define PL_sv_objcount (vTHX->Isv_objcount)
#define PL_sv_root (vTHX->Isv_root)
#define PL_sv_undef (vTHX->Isv_undef)
#define PL_sv_yes (vTHX->Isv_yes)
-#define PL_svref_mutex (vTHX->Isvref_mutex)
#define PL_sys_intern (vTHX->Isys_intern)
#define PL_taint_warn (vTHX->Itaint_warn)
#define PL_tainting (vTHX->Itainting)
-#define PL_threadnum (vTHX->Ithreadnum)
-#define PL_threads_mutex (vTHX->Ithreads_mutex)
-#define PL_threadsv_names (vTHX->Ithreadsv_names)
-#define PL_thrsv (vTHX->Ithrsv)
#define PL_tokenbuf (vTHX->Itokenbuf)
#define PL_uid (vTHX->Iuid)
#define PL_unsafe (vTHX->Iunsafe)
#define PL_yynerrs (vTHX->Iyynerrs)
#define PL_yyval (vTHX->Iyyval)
-# endif /* USE_5005THREADS */
-
#else /* !MULTIPLICITY */
-/* cases 1 and 4 above */
+/* case 1 above */
#define PL_IArgv PL_Argv
#define PL_ICmd PL_Cmd
#define PL_Icomppad_name_floor PL_comppad_name_floor
#define PL_Icop_seqmax PL_cop_seqmax
#define PL_Icopline PL_copline
-#define PL_Icred_mutex PL_cred_mutex
#define PL_Icryptseen PL_cryptseen
#define PL_Icshlen PL_cshlen
#define PL_Icshname PL_cshname
#define PL_Icurcopdb PL_curcopdb
#define PL_Icurstname PL_curstname
-#define PL_Icurthr PL_curthr
#define PL_Icustom_op_descs PL_custom_op_descs
#define PL_Icustom_op_names PL_custom_op_names
#define PL_Idbargs PL_dbargs
#define PL_Ierrgv PL_errgv
#define PL_Ierror_count PL_error_count
#define PL_Ieuid PL_euid
-#define PL_Ieval_cond PL_eval_cond
-#define PL_Ieval_mutex PL_eval_mutex
-#define PL_Ieval_owner PL_eval_owner
#define PL_Ieval_root PL_eval_root
#define PL_Ieval_start PL_eval_start
#define PL_Ievalseq PL_evalseq
#define PL_Iexitlistlen PL_exitlistlen
#define PL_Iexpect PL_expect
#define PL_Ifdpid PL_fdpid
-#define PL_Ifdpid_mutex PL_fdpid_mutex
#define PL_Ifilemode PL_filemode
#define PL_Iforkprocess PL_forkprocess
#define PL_Iformfeed PL_formfeed
#define PL_Inice_chunk PL_nice_chunk
#define PL_Inice_chunk_size PL_nice_chunk_size
#define PL_Inomemok PL_nomemok
-#define PL_Inthreads PL_nthreads
-#define PL_Inthreads_cond PL_nthreads_cond
#define PL_Inumeric_compat1 PL_numeric_compat1
#define PL_Inumeric_local PL_numeric_local
#define PL_Inumeric_name PL_numeric_name
#define PL_Istderrgv PL_stderrgv
#define PL_Istdingv PL_stdingv
#define PL_Istrtab PL_strtab
-#define PL_Istrtab_mutex PL_strtab_mutex
#define PL_Isub_generation PL_sub_generation
#define PL_Isublex_info PL_sublex_info
#define PL_Isubline PL_subline
#define PL_Isubname PL_subname
#define PL_Isv_arenaroot PL_sv_arenaroot
#define PL_Isv_count PL_sv_count
-#define PL_Isv_lock_mutex PL_sv_lock_mutex
-#define PL_Isv_mutex PL_sv_mutex
#define PL_Isv_no PL_sv_no
#define PL_Isv_objcount PL_sv_objcount
#define PL_Isv_root PL_sv_root
#define PL_Isv_undef PL_sv_undef
#define PL_Isv_yes PL_sv_yes
-#define PL_Isvref_mutex PL_svref_mutex
#define PL_Isys_intern PL_sys_intern
#define PL_Itaint_warn PL_taint_warn
#define PL_Itainting PL_tainting
-#define PL_Ithreadnum PL_threadnum
-#define PL_Ithreads_mutex PL_threads_mutex
-#define PL_Ithreadsv_names PL_threadsv_names
-#define PL_Ithrsv PL_thrsv
#define PL_Itokenbuf PL_tokenbuf
#define PL_Iuid PL_uid
#define PL_Iunsafe PL_unsafe
#define PL_Iyynerrs PL_yynerrs
#define PL_Iyyval PL_yyval
-# if defined(USE_5005THREADS)
-/* case 4 above */
-
-#define PL_Sv (aTHX->TSv)
-#define PL_Xpv (aTHX->TXpv)
-#define PL_av_fetch_sv (aTHX->Tav_fetch_sv)
-#define PL_bodytarget (aTHX->Tbodytarget)
-#define PL_bostr (aTHX->Tbostr)
-#define PL_chopset (aTHX->Tchopset)
-#define PL_colors (aTHX->Tcolors)
-#define PL_colorset (aTHX->Tcolorset)
-#define PL_curcop (aTHX->Tcurcop)
-#define PL_curpad (aTHX->Tcurpad)
-#define PL_curpm (aTHX->Tcurpm)
-#define PL_curstack (aTHX->Tcurstack)
-#define PL_curstackinfo (aTHX->Tcurstackinfo)
-#define PL_curstash (aTHX->Tcurstash)
-#define PL_defoutgv (aTHX->Tdefoutgv)
-#define PL_defstash (aTHX->Tdefstash)
-#define PL_delaymagic (aTHX->Tdelaymagic)
-#define PL_dirty (aTHX->Tdirty)
-#define PL_dumpindent (aTHX->Tdumpindent)
-#define PL_efloatbuf (aTHX->Tefloatbuf)
-#define PL_efloatsize (aTHX->Tefloatsize)
-#define PL_errors (aTHX->Terrors)
-#define PL_extralen (aTHX->Textralen)
-#define PL_firstgv (aTHX->Tfirstgv)
-#define PL_formtarget (aTHX->Tformtarget)
-#define PL_hv_fetch_ent_mh (aTHX->Thv_fetch_ent_mh)
-#define PL_hv_fetch_sv (aTHX->Thv_fetch_sv)
-#define PL_in_eval (aTHX->Tin_eval)
-#define PL_last_in_gv (aTHX->Tlast_in_gv)
-#define PL_lastgotoprobe (aTHX->Tlastgotoprobe)
-#define PL_lastscream (aTHX->Tlastscream)
-#define PL_localizing (aTHX->Tlocalizing)
-#define PL_mainstack (aTHX->Tmainstack)
-#define PL_markstack (aTHX->Tmarkstack)
-#define PL_markstack_max (aTHX->Tmarkstack_max)
-#define PL_markstack_ptr (aTHX->Tmarkstack_ptr)
-#define PL_maxscream (aTHX->Tmaxscream)
-#define PL_modcount (aTHX->Tmodcount)
-#define PL_na (aTHX->Tna)
-#define PL_nrs (aTHX->Tnrs)
-#define PL_ofs_sv (aTHX->Tofs_sv)
-#define PL_op (aTHX->Top)
-#define PL_opsave (aTHX->Topsave)
-#define PL_peepp (aTHX->Tpeepp)
-#define PL_protect (aTHX->Tprotect)
-#define PL_reg_call_cc (aTHX->Treg_call_cc)
-#define PL_reg_curpm (aTHX->Treg_curpm)
-#define PL_reg_eval_set (aTHX->Treg_eval_set)
-#define PL_reg_flags (aTHX->Treg_flags)
-#define PL_reg_ganch (aTHX->Treg_ganch)
-#define PL_reg_leftiter (aTHX->Treg_leftiter)
-#define PL_reg_magic (aTHX->Treg_magic)
-#define PL_reg_match_utf8 (aTHX->Treg_match_utf8)
-#define PL_reg_maxiter (aTHX->Treg_maxiter)
-#define PL_reg_oldcurpm (aTHX->Treg_oldcurpm)
-#define PL_reg_oldpos (aTHX->Treg_oldpos)
-#define PL_reg_oldsaved (aTHX->Treg_oldsaved)
-#define PL_reg_oldsavedlen (aTHX->Treg_oldsavedlen)
-#define PL_reg_poscache (aTHX->Treg_poscache)
-#define PL_reg_poscache_size (aTHX->Treg_poscache_size)
-#define PL_reg_re (aTHX->Treg_re)
-#define PL_reg_start_tmp (aTHX->Treg_start_tmp)
-#define PL_reg_start_tmpl (aTHX->Treg_start_tmpl)
-#define PL_reg_starttry (aTHX->Treg_starttry)
-#define PL_reg_sv (aTHX->Treg_sv)
-#define PL_reg_whilem_seen (aTHX->Treg_whilem_seen)
-#define PL_regbol (aTHX->Tregbol)
-#define PL_regcc (aTHX->Tregcc)
-#define PL_regcode (aTHX->Tregcode)
-#define PL_regcomp_parse (aTHX->Tregcomp_parse)
-#define PL_regcomp_rx (aTHX->Tregcomp_rx)
-#define PL_regcompat1 (aTHX->Tregcompat1)
-#define PL_regcompp (aTHX->Tregcompp)
-#define PL_regdata (aTHX->Tregdata)
-#define PL_regdummy (aTHX->Tregdummy)
-#define PL_regendp (aTHX->Tregendp)
-#define PL_regeol (aTHX->Tregeol)
-#define PL_regexecp (aTHX->Tregexecp)
-#define PL_regflags (aTHX->Tregflags)
-#define PL_regfree (aTHX->Tregfree)
-#define PL_regindent (aTHX->Tregindent)
-#define PL_reginput (aTHX->Treginput)
-#define PL_regint_start (aTHX->Tregint_start)
-#define PL_regint_string (aTHX->Tregint_string)
-#define PL_reginterp_cnt (aTHX->Treginterp_cnt)
-#define PL_reglastcloseparen (aTHX->Treglastcloseparen)
-#define PL_reglastparen (aTHX->Treglastparen)
-#define PL_regnarrate (aTHX->Tregnarrate)
-#define PL_regnaughty (aTHX->Tregnaughty)
-#define PL_regnpar (aTHX->Tregnpar)
-#define PL_regprecomp (aTHX->Tregprecomp)
-#define PL_regprogram (aTHX->Tregprogram)
-#define PL_regsawback (aTHX->Tregsawback)
-#define PL_regseen (aTHX->Tregseen)
-#define PL_regsize (aTHX->Tregsize)
-#define PL_regstartp (aTHX->Tregstartp)
-#define PL_regtill (aTHX->Tregtill)
-#define PL_regxend (aTHX->Tregxend)
-#define PL_restartop (aTHX->Trestartop)
-#define PL_retstack (aTHX->Tretstack)
-#define PL_retstack_ix (aTHX->Tretstack_ix)
-#define PL_retstack_max (aTHX->Tretstack_max)
-#define PL_rs (aTHX->Trs)
-#define PL_savestack (aTHX->Tsavestack)
-#define PL_savestack_ix (aTHX->Tsavestack_ix)
-#define PL_savestack_max (aTHX->Tsavestack_max)
-#define PL_scopestack (aTHX->Tscopestack)
-#define PL_scopestack_ix (aTHX->Tscopestack_ix)
-#define PL_scopestack_max (aTHX->Tscopestack_max)
-#define PL_screamfirst (aTHX->Tscreamfirst)
-#define PL_screamnext (aTHX->Tscreamnext)
-#define PL_secondgv (aTHX->Tsecondgv)
-#define PL_seen_evals (aTHX->Tseen_evals)
-#define PL_seen_zerolen (aTHX->Tseen_zerolen)
-#define PL_sortcop (aTHX->Tsortcop)
-#define PL_sortcxix (aTHX->Tsortcxix)
-#define PL_sortstash (aTHX->Tsortstash)
-#define PL_stack_base (aTHX->Tstack_base)
-#define PL_stack_max (aTHX->Tstack_max)
-#define PL_stack_sp (aTHX->Tstack_sp)
-#define PL_start_env (aTHX->Tstart_env)
-#define PL_statbuf (aTHX->Tstatbuf)
-#define PL_statcache (aTHX->Tstatcache)
-#define PL_statgv (aTHX->Tstatgv)
-#define PL_statname (aTHX->Tstatname)
-#define PL_tainted (aTHX->Ttainted)
-#define PL_timesbuf (aTHX->Ttimesbuf)
-#define PL_tmps_floor (aTHX->Ttmps_floor)
-#define PL_tmps_ix (aTHX->Ttmps_ix)
-#define PL_tmps_max (aTHX->Ttmps_max)
-#define PL_tmps_stack (aTHX->Ttmps_stack)
-#define PL_top_env (aTHX->Ttop_env)
-#define PL_toptarget (aTHX->Ttoptarget)
-#define PL_watchaddr (aTHX->Twatchaddr)
-#define PL_watchok (aTHX->Twatchok)
-
-# else /* !USE_5005THREADS */
-/* case 1 above */
-
#define PL_TSv PL_Sv
#define PL_TXpv PL_Xpv
#define PL_Tav_fetch_sv PL_av_fetch_sv
#define PL_Twatchaddr PL_watchaddr
#define PL_Twatchok PL_watchok
-# endif /* USE_5005THREADS */
#endif /* MULTIPLICITY */
#if defined(PERL_GLOBAL_STRUCT)
d_strtouq='undef'
d_nv_preserves_uv='define'
nv_preserves_uv_bits='32'
-use5005threads='undef'
useithreads='undef'
inc_version_list=' '
inc_version_list_init='0'
void
threadsv_names()
PPCODE:
-#ifdef USE_5005THREADS
- int i;
- STRLEN len = strlen(PL_threadsv_names);
-
- EXTEND(sp, len);
- for (i = 0; i < len; i++)
- PUSHs(sv_2mortal(newSVpvn(&PL_threadsv_names[i], 1)));
-#endif
#define OP_next(o) o->op_next
long xcv_depth; /* >= 2 indicates recursive call */
AV * xcv_padlist;
CV * xcv_outside;
-#ifdef USE_5005THREADS
- perl_mutex *xcv_mutexp;
- struct perl_thread *xcv_owner; /* current owner thread */
-#endif /* USE_5005THREADS */
cv_flags_t xcv_flags;
} XPVCV_or_similar;
#define ANYINIT(i) i
getlogin
syscall
lock 6 1
-threadsv 6 2 unused if not USE_5005THREADS
setstate 1 1 currently unused anywhere
method_named 10 2
use Config;
skip("Doesn't work with threaded perls",9)
- if $Config{useithreads} || $Config{use5005threads};
+ if $Config{useithreads};
runlint 'implicit-read', '1 for @ARGV', <<'RESULT', 'implicit-read in foreach';
Implicit use of $_ in foreach at -e line 1
int msgsiz;
char *msg;
-#ifdef USE_5005THREADS
- char *buf = malloc(BUFSIZ);
-
- if (buf == 0)
- return 0;
- if (strerror_r(err, buf, BUFSIZ) == 0)
- msg = buf;
- else
- msg = strerror_r_failed;
- msgsiz = strlen(msg);
- if (strsiz + msgsiz < BUFSIZ)
- strcat(str, msg);
- free(buf);
-#else
dTHX;
if ((msg = strerror(err)) == 0)
msgsiz = strlen(msg); /* Note msg = buf and free() above. */
if (strsiz + msgsiz < BUFSIZ) /* Do not move this after #endif. */
strcat(str, msg);
-#endif
return str;
}
int msgsiz;
char *msg;
-#ifdef USE_5005THREADS
- char *buf = malloc(BUFSIZ);
-
- if (buf == 0)
- return 0;
- if (strerror_r(err, buf, BUFSIZ) == 0)
- msg = buf;
- else
- msg = strerror_r_failed;
- msgsiz = strlen(msg);
- if (msgsiz < BUFSIZ)
- strcpy(str, msg);
- free(buf);
-#else
dTHX;
if ((msg = strerror(err)) == 0)
msgsiz = strlen(msg); /* Note msg = buf and free() above. */
if (msgsiz < BUFSIZ) /* Do not move this after #endif. */
strcpy(str, msg);
-#endif
return str;
}
by the Win32 port for emulating fork()). As of Perl 5.8.0, ithreads has
become the standard threading model for Perl.
-If you really want the older support for threads described below,
-it is enabled with:
-
- sh Configure -Dusethreads -Duse5005threads
-
-Be warned that the old 5.005 implementation of threads is known
-to be quite buggy, and unmaintained, which means that the bugs
-are there to stay. (We are not mean by not fixing the bugs:
-the bugs are just really, really, really hard to fix. Honest.)
-
-The rest of this document only applies to the use5005threads style of
-threads, and the comments on what works on which platform are highly
-obsolete and preserved here for archaeology buffs only. The
-architecture specific hints files do all the necessary option
-tweaking automatically during Configure, both for the 5.005 threads
-and for the new interpreter threads.
-
----------------------------------------------------------------------------
-
-Support for threading is still in the highly experimental stages. There
-are known race conditions that show up under high contention on SMP
-machines. Internal implementation is still subject to changes.
-It is not recommended for production use at this time.
-
----------------------------------------------------------------------------
-
-Building
-
-If your system is in the following list you should be able to just:
-
- ./Configure -Dusethreads -Duse5005threads -des
- make
-
-and ignore the rest of this "Building" section. If not, continue
-from the "Problems" section.
-
- * Linux 2.* (with the LinuxThreads library installed:
- that's the linuxthreads and linuxthreads-devel RPMs
- for RedHat)
-
- * Tru64 UNIX (formerly Digital UNIX formerly DEC OSF/1)
- (see additional note below)
-
- * Solaris 2.* for recentish x (2.5 is OK)
-
- * IRIX 6.2 or newer. 6.2 will require a few OS patches.
- IMPORTANT: Without patch 2401 (or its replacement),
- a kernel bug in IRIX 6.2 will cause your machine to
- panic and crash when running threaded perl.
- IRIX 6.3 and up should be OK. See lower down for patch details.
-
- * AIX 4.1.5 or newer.
-
- * FreeBSD 2.2.8 or newer.
-
- * OpenBSD
-
- * NeXTstep, OpenStep
-
- * OS/2
-
- * DOS DJGPP
-
- * VM/ESA
-
----------------------------------------------------------------------------
-
-Problems
-
-If the simple way doesn't work or you are using another platform which
-you believe supports POSIX.1c threads then read on. Additional
-information may be in a platform-specific "hints" file in the hints/
-subdirectory.
-
-On platforms that use Configure to build perl, omit the -d from your
-./Configure arguments. For example, use:
-
- ./Configure -Dusethreads -Duse5005threads
-
-When Configure prompts you for ccflags, insert any other arguments in
-there that your compiler needs to use POSIX threads (-D_REENTRANT,
--pthreads, -threads, -pthread, -thread, are good guesses). When
-Configure prompts you for linking flags, include any flags required
-for threading (usually nothing special is required here). Finally,
-when Configure prompts you for libraries, include any necessary
-libraries (e.g. -lpthread). Pay attention to the order of libraries.
-It is probably necessary to specify your threading library *before*
-your standard C library, e.g. it might be necessary to have -lpthread
--lc, instead of -lc -lpthread. You may also need to use -lc_r instead
-of -lc.
-
-Once you have specified all your compiler flags, you can have Configure
-accept all the defaults for the remainder of the session by typing &-d
-at any Configure prompt.
-
-Some additional notes (some of these may be obsolete now, other items
-may be handled automatically):
-
-For Digital Unix 4.x:
- Add -pthread to ccflags
- Add -pthread to ldflags
- Add -lpthread -lc_r to lddlflags
-
- For some reason, the extra includes for pthreads make Digital UNIX
- complain fatally about the sbrk() declaration in perl's malloc.c
- so use the native malloc, e.g. sh Configure -Uusemymalloc, or
- manually edit your config.sh as follows:
- Change usemymalloc to n
- Zap mallocobj and mallocsrc (foo='')
- Change d_mymalloc to undef
-
-For Digital Unix 3.x (Formerly DEC OSF/1):
- Add -DOLD_PTHREADS_API to ccflags
- If compiling with the GNU cc compiler, remove -threads from ccflags
-
- (The following should be done automatically if you call Configure
- with the -Dusethreads option).
- Add -lpthread -lmach -lc_r to libs (in the order specified).
-
-For IRIX:
- (This should all be done automatically by the hint file).
- Add -lpthread to libs
- For IRIX 6.2, you have to have the following patches installed:
- 1404 Irix 6.2 Posix 1003.1b man pages
- 1645 IRIX 6.2 & 6.3 POSIX header file updates
- 2000 Irix 6.2 Posix 1003.1b support modules
- 2254 Pthread library fixes
- 2401 6.2 all platform kernel rollup
- IMPORTANT: Without patch 2401, a kernel bug in IRIX 6.2 will
- cause your machine to panic and crash when running threaded perl.
- IRIX 6.3 and up should be OK.
-
- For IRIX 6.3 and 6.4 the pthreads should work out of the box.
- Thanks to Hannu Napari <Hannu.Napari@hut.fi> for the IRIX
- pthreads patches information.
-
-For AIX:
- (This should all be done automatically by the hint file).
- Change cc to xlc_r or cc_r.
- Add -DNEED_PTHREAD_INIT to ccflags and cppflags
- Add -lc_r to libswanted
- Change -lc in lddflags to be -lpthread -lc_r -lc
-
-For Win32:
- See README.win32, and the notes at the beginning of win32/Makefile
- or win32/makefile.mk.
-
-Now you can do a
- make
-
-When you succeed in compiling and testing ("make test" after your
-build) a threaded Perl in a platform previously unknown to support
-threaded perl, please let perlbug@perl.com know about your victory.
-Explain what you did in painful detail.
-
----------------------------------------------------------------------------
-
-O/S specific bugs
-
-Irix 6.2: See the Irix warning above.
-
-LinuxThreads 0.5 has a bug which can cause file descriptor 0 to be
-closed after a fork() leading to many strange symptoms. Version 0.6
-has this fixed but the following patch can be applied to 0.5 for now:
-
------------------------------ cut here -----------------------------
---- linuxthreads-0.5/pthread.c.ORI Mon Oct 6 13:55:50 1997
-+++ linuxthreads-0.5/pthread.c Mon Oct 6 13:57:24 1997
-@@ -312,8 +312,10 @@
- free(pthread_manager_thread_bos);
- pthread_manager_thread_bos = pthread_manager_thread_tos = NULL;
- /* Close the two ends of the pipe */
-- close(pthread_manager_request);
-- close(pthread_manager_reader);
-+ if (pthread_manager_request >= 0) {
-+ close(pthread_manager_request);
-+ close(pthread_manager_reader);
-+ }
- pthread_manager_request = pthread_manager_reader = -1;
- /* Update the pid of the main thread */
- self->p_pid = getpid();
------------------------------ cut here -----------------------------
-
-
-Building the Thread extension
-
-The Thread extension is now part of the main perl distribution tree.
-If you did Configure -Dusethreads -Duse5005threads then it will have been
-added to the list of extensions automatically.
-
-You can try some of the tests with
- cd ext/Thread
- perl create.t
- perl join.t
- perl lock.t
- perl io.t
-etc.
-The io one leaves a thread reading from the keyboard on stdin so
-as the ping messages appear you can type lines and see them echoed.
-
-Try running the main perl test suite too. There are known
-failures for some of the DBM/DB extensions (if their underlying
-libraries were not compiled to be thread-aware).
-
----------------------------------------------------------------------------
-
-Bugs
-
-* FAKE_THREADS should produce a working perl but the Thread
-extension won't build with it yet. (FAKE_THREADS has not been
-tested at all in recent times.)
-
-* There may still be races where bugs show up under contention.
-
----------------------------------------------------------------------------
-
-Debugging
-
-Use the -DS command-line option to turn on debugging of the
-multi-threading code. Under Linux, that also turns on a quick
-hack I did to grab a bit of extra information from segfaults.
-If you have a fancier gdb/threads setup than I do then you'll
-have to delete the lines in perl.c which say
- #if defined(DEBUGGING) && defined(USE_5005THREADS) && defined(__linux__)
- DEBUG_S(signal(SIGSEGV, (void(*)(int))catch_sigsegv););
- #endif
-
----------------------------------------------------------------------------
-
-Background
-
-Some old globals (e.g. stack_sp, op) and some old per-interpreter
-variables (e.g. tmps_stack, cxstack) move into struct thread.
-All fields of struct thread which derived from original perl
-variables have names of the form Tfoo. For example, stack_sp becomes
-the field Tstack_sp of struct thread. For those fields which moved
-from original perl, thread.h does
- #define foo (thr->Tfoo)
-This means that all functions in perl which need to use one of these
-fields need an (automatic) variable thr which points at the current
-thread's struct thread. For pp_foo functions, it is passed around as
-an argument, for other functions they do
- dTHR;
-which declares and initialises thr from thread-specific data
-via pthread_getspecific. If a function fails to compile with an
-error about "no such variable thr", it probably just needs a dTHR
-at the top.
-
-
-Fake threads
-
-For FAKE_THREADS, thr is a global variable and perl schedules threads
-by altering thr in between appropriate ops. The next and prev fields
-of struct thread keep all fake threads on a doubly linked list and
-the next_run and prev_run fields keep all runnable threads on a
-doubly linked list. Mutexes are stubs for FAKE_THREADS. Condition
-variables are implemented as a list of waiting threads.
-
-
-Mutexes and condition variables
-
-The API is via macros MUTEX_{INIT,LOCK,UNLOCK,DESTROY} and
-COND_{INIT,WAIT,SIGNAL,BROADCAST,DESTROY}.
-
-A mutex is only required to be a simple, fast mutex (e.g. it does not
-have to be recursive). It is only ever held across very short pieces
-of code. Condition variables are only ever signalled/broadcast while
-their associated mutex is held. (This constraint simplifies the
-implementation of condition variables in certain porting situations.)
-For POSIX threads, perl mutexes and condition variables correspond to
-POSIX ones. For FAKE_THREADS, mutexes are stubs and condition variables
-are implemented as lists of waiting threads. For FAKE_THREADS, a thread
-waits on a condition variable by removing itself from the runnable
-list, calling SCHEDULE to change thr to the next appropriate
-runnable thread and returning op (i.e. the new threads next op).
-This means that fake threads can only block while in PP code.
-A PP function which contains a COND_WAIT must be prepared to
-handle such restarts and can use the field "private" of struct
-thread to record its state. For fake threads, COND_SIGNAL and
-COND_BROADCAST work by putting back all the threads on the
-condition variables list into the run queue. Note that a mutex
-must *not* be held while returning from a PP function.
-
-Perl locks and condition variables are both implemented as a
-condpair_t structure, containing a mutex, an "owner" condition
-variable, an owner thread field and another condition variable).
-The structure is attached by 'm' magic to any SV. pp_lock locks
-such an object by waiting on the ownercond condition variable until
-the owner field is zero and then setting the owner field to its own
-thread pointer. The lock is semantically recursive so if the owner
-field already matches the current thread then pp_lock returns
-straight away. If the owner field has to be filled in then
-unlock_condpair is queued as an end-of-block destructor and
-that function zeroes out the owner field and signals the ownercond
-condition variable, thus waking up any other thread that wants to
-lock it. When used as a condition variable, the condpair is locked
-(involving the above wait-for-ownership and setting the owner field)
-and the spare condition variable field is used for waiting on.
-
-
-Thread states
-
-
- $t->join
-R_JOINABLE ---------------------> R_JOINED >----\
- | \ pthread_join(t) | ^ |
- | \ | | join | pthread_join
- | \ | | |
- | \ | \------/
- | \ |
- | \ |
- | $t->detach\ pthread_detach |
- | _\| |
-ends| R_DETACHED ends | unlink
- | \ |
- | ends \ unlink |
- | \ |
- | \ |
- | \ |
- | \ |
- | \ |
- V join detach _\| V
-ZOMBIE ----------------------------> DEAD
- pthread_join pthread_detach
- and unlink and unlink
-
-
+As of 5.9.0, the older threading model is not supported anymore.
Malcolm Beattie
mbeattie@sable.ox.ac.uk
More platforms added 26 Jul 1999 by
Jarkko Hietaniemi
+
+Removed 5005threads support 03 Oct 2002 by
+H.Merijn Brand
static void
remove_thread(pTHX_ Thread t)
{
-#ifdef USE_5005THREADS
- DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log,
- "%p: remove_thread %p\n", thr, t)));
- MUTEX_LOCK(&PL_threads_mutex);
- MUTEX_DESTROY(&t->mutex);
- PL_nthreads--;
- t->prev->next = t->next;
- t->next->prev = t->prev;
- SvREFCNT_dec(t->oursv);
- COND_BROADCAST(&PL_nthreads_cond);
- MUTEX_UNLOCK(&PL_threads_mutex);
-#endif
}
static THREAD_RET_TYPE
threadstart(void *arg)
{
-#ifdef USE_5005THREADS
-#ifdef FAKE_THREADS
- Thread savethread = thr;
- LOGOP myop;
- dSP;
- I32 oldscope = PL_scopestack_ix;
- I32 retval;
- AV *av;
- int i;
-
- DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p starting at %s\n",
- thr, SvPEEK(TOPs)));
- thr = (Thread) arg;
- savemark = TOPMARK;
- thr->prev = thr->prev_run = savethread;
- thr->next = savethread->next;
- thr->next_run = savethread->next_run;
- savethread->next = savethread->next_run = thr;
- thr->wait_queue = 0;
- thr->private = 0;
-
- /* Now duplicate most of perl_call_sv but with a few twists */
- PL_op = (OP*)&myop;
- Zero(PL_op, 1, LOGOP);
- myop.op_flags = OPf_STACKED;
- myop.op_next = Nullop;
- myop.op_flags |= OPf_KNOW;
- myop.op_flags |= OPf_WANT_LIST;
- PL_op = pp_entersub(ARGS);
- DEBUG_S(if (!PL_op)
- PerlIO_printf(Perl_debug_log, "thread starts at Nullop\n"));
- /*
- * When this thread is next scheduled, we start in the right
- * place. When the thread runs off the end of the sub, perl.c
- * handles things, using savemark to figure out how much of the
- * stack is the return value for any join.
- */
- thr = savethread; /* back to the old thread */
- return 0;
-#else
- Thread thr = (Thread) arg;
- dSP;
- I32 oldmark = TOPMARK;
- I32 retval;
- SV *sv;
- AV *av;
- int i;
-
-#if defined(MULTIPLICITY)
- PERL_SET_INTERP(thr->interp);
-#endif
-
- DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p waiting to start\n",
- thr));
-
- /*
- * Wait until our creator releases us. If we didn't do this, then
- * it would be potentially possible for out thread to carry on and
- * do stuff before our creator fills in our "self" field. For example,
- * if we went and created another thread which tried to JOIN with us,
- * then we'd be in a mess.
- */
- MUTEX_LOCK(&thr->mutex);
- MUTEX_UNLOCK(&thr->mutex);
-
- /*
- * It's safe to wait until now to set the thread-specific pointer
- * from our pthread_t structure to our struct perl_thread, since
- * we're the only thread who can get at it anyway.
- */
- PERL_SET_THX(thr);
-
- DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p starting at %s\n",
- thr, SvPEEK(TOPs)));
-
- av = newAV();
- sv = POPs;
- PUTBACK;
- ENTER;
- SAVETMPS;
- perl_call_sv(sv, G_ARRAY|G_EVAL);
- SPAGAIN;
- retval = SP - (PL_stack_base + oldmark);
- SP = PL_stack_base + oldmark + 1;
- if (SvCUR(thr->errsv)) {
- MUTEX_LOCK(&thr->mutex);
- thr->flags |= THRf_DID_DIE;
- MUTEX_UNLOCK(&thr->mutex);
- av_store(av, 0, &PL_sv_no);
- av_store(av, 1, newSVsv(thr->errsv));
- DEBUG_S(PerlIO_printf(Perl_debug_log, "%p died: %s\n",
- thr, SvPV(thr->errsv, PL_na)));
- }
- else {
- DEBUG_S(STMT_START {
- for (i = 1; i <= retval; i++) {
- PerlIO_printf(Perl_debug_log, "%p return[%d] = %s\n",
- thr, i, SvPEEK(SP[i - 1]));
- }
- } STMT_END);
- av_store(av, 0, &PL_sv_yes);
- for (i = 1; i <= retval; i++, SP++)
- sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*SP));
- }
- FREETMPS;
- LEAVE;
-
-#if 0
- /* removed for debug */
- SvREFCNT_dec(PL_curstack);
-#endif
- SvREFCNT_dec(thr->cvcache);
- SvREFCNT_dec(thr->threadsv);
- SvREFCNT_dec(thr->specific);
- SvREFCNT_dec(thr->errsv);
-
- /*Safefree(cxstack);*/
- while (PL_curstackinfo->si_next)
- PL_curstackinfo = PL_curstackinfo->si_next;
- while (PL_curstackinfo) {
- PERL_SI *p = PL_curstackinfo->si_prev;
- SvREFCNT_dec(PL_curstackinfo->si_stack);
- Safefree(PL_curstackinfo->si_cxstack);
- Safefree(PL_curstackinfo);
- PL_curstackinfo = p;
- }
- Safefree(PL_markstack);
- Safefree(PL_scopestack);
- Safefree(PL_savestack);
- Safefree(PL_retstack);
- Safefree(PL_tmps_stack);
- SvREFCNT_dec(PL_ofs_sv);
-
- SvREFCNT_dec(PL_rs);
- SvREFCNT_dec(PL_statname);
- SvREFCNT_dec(PL_errors);
- Safefree(PL_screamfirst);
- Safefree(PL_screamnext);
- Safefree(PL_reg_start_tmp);
- SvREFCNT_dec(PL_lastscream);
- SvREFCNT_dec(PL_defoutgv);
- Safefree(PL_reg_poscache);
-
- MUTEX_LOCK(&thr->mutex);
- thr->thr_done = 1;
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "%p: threadstart finishing: state is %u\n",
- thr, ThrSTATE(thr)));
- switch (ThrSTATE(thr)) {
- case THRf_R_JOINABLE:
- ThrSETSTATE(thr, THRf_ZOMBIE);
- MUTEX_UNLOCK(&thr->mutex);
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "%p: R_JOINABLE thread finished\n", thr));
- break;
- case THRf_R_JOINED:
- ThrSETSTATE(thr, THRf_DEAD);
- MUTEX_UNLOCK(&thr->mutex);
- remove_thread(aTHX_ thr);
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "%p: R_JOINED thread finished\n", thr));
- break;
- case THRf_R_DETACHED:
- ThrSETSTATE(thr, THRf_DEAD);
- MUTEX_UNLOCK(&thr->mutex);
- SvREFCNT_dec(av);
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "%p: DETACHED thread finished\n", thr));
- remove_thread(aTHX_ thr); /* This might trigger main thread to finish */
- break;
- default:
- MUTEX_UNLOCK(&thr->mutex);
- croak("panic: illegal state %u at end of threadstart", ThrSTATE(thr));
- /* NOTREACHED */
- }
- return THREAD_RET_CAST(av); /* Available for anyone to join with */
- /* us unless we're detached, in which */
- /* case noone sees the value anyway. */
-#endif
-#else
return THREAD_RET_CAST(NULL);
-#endif
}
static SV *
newthread (pTHX_ SV *startsv, AV *initargs, char *classname)
{
-#ifdef USE_5005THREADS
- dSP;
- Thread savethread;
- int i;
- SV *sv;
- int err;
-#ifndef THREAD_CREATE
- static pthread_attr_t attr;
- static int attr_inited = 0;
- sigset_t fullmask, oldmask;
- static int attr_joinable = PTHREAD_CREATE_JOINABLE;
-#endif
-
- savethread = thr;
- thr = new_struct_thread(thr);
- /* temporarily pretend to be the child thread in case the
- * XPUSHs() below want to grow the child's stack. This is
- * safe, since the other thread is not yet created, and we
- * are the only ones who know about it */
- PERL_SET_THX(thr);
- SPAGAIN;
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "%p: newthread (%p), tid is %u, preparing stack\n",
- savethread, thr, thr->tid));
- /* The following pushes the arg list and startsv onto the *new* stack */
- PUSHMARK(SP);
- /* Could easily speed up the following greatly */
- for (i = 0; i <= AvFILL(initargs); i++)
- XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE)));
- XPUSHs(SvREFCNT_inc(startsv));
- PUTBACK;
-
- /* On your marks... */
- PERL_SET_THX(savethread);
- MUTEX_LOCK(&thr->mutex);
-
-#ifdef THREAD_CREATE
- err = THREAD_CREATE(thr, threadstart);
-#else
- /* Get set... */
- sigfillset(&fullmask);
- if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1)
- croak("panic: sigprocmask");
- err = 0;
- if (!attr_inited) {
- attr_inited = 1;
- err = pthread_attr_init(&attr);
-# ifdef THREAD_CREATE_NEEDS_STACK
- if (err == 0)
- err = pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK);
- if (err)
- croak("panic: pthread_attr_setstacksize failed");
-# endif
-# ifdef PTHREAD_ATTR_SETDETACHSTATE
- if (err == 0)
- err = PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable);
- if (err)
- croak("panic: pthread_attr_setdetachstate failed");
-# else
- croak("panic: can't pthread_attr_setdetachstate");
-# endif
- }
- if (err == 0)
- err = PTHREAD_CREATE(&thr->self, attr, threadstart, (void*) thr);
-#endif
-
- if (err) {
- MUTEX_UNLOCK(&thr->mutex);
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "%p: create of %p failed %d\n",
- savethread, thr, err));
- /* Thread creation failed--clean up */
- SvREFCNT_dec(thr->cvcache);
- remove_thread(aTHX_ thr);
- for (i = 0; i <= AvFILL(initargs); i++)
- SvREFCNT_dec(*av_fetch(initargs, i, FALSE));
- SvREFCNT_dec(startsv);
- return NULL;
- }
-
-#ifdef THREAD_POST_CREATE
- THREAD_POST_CREATE(thr);
-#else
- if (sigprocmask(SIG_SETMASK, &oldmask, 0))
- croak("panic: sigprocmask");
-#endif
-
- sv = newSViv(thr->tid);
- sv_magic(sv, thr->oursv, '~', 0, 0);
- SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
- sv = sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE));
-
- /* Go */
- MUTEX_UNLOCK(&thr->mutex);
-
- return sv;
-#else
-# ifdef USE_ITHREADS
+#ifdef USE_ITHREADS
croak("This perl was built for \"ithreads\", which currently does not support Thread.pm.\n"
"Run \"perldoc Thread\" for more information");
-# else
+#else
croak("This perl was not built with support for 5.005-style threads.\n"
"Run \"perldoc Thread\" for more information");
-# endif
- return &PL_sv_undef;
#endif
+ return &PL_sv_undef;
}
static Signal_t handle_thread_signal (int sig);
AV * av = NO_INIT
int i = NO_INIT
PPCODE:
-#ifdef USE_5005THREADS
- if (t == thr)
- croak("Attempt to join self");
- DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: joining %p (state %u)\n",
- thr, t, ThrSTATE(t)));
- MUTEX_LOCK(&t->mutex);
- switch (ThrSTATE(t)) {
- case THRf_R_JOINABLE:
- case THRf_R_JOINED:
- ThrSETSTATE(t, THRf_R_JOINED);
- MUTEX_UNLOCK(&t->mutex);
- break;
- case THRf_ZOMBIE:
- ThrSETSTATE(t, THRf_DEAD);
- MUTEX_UNLOCK(&t->mutex);
- remove_thread(aTHX_ t);
- break;
- default:
- MUTEX_UNLOCK(&t->mutex);
- croak("can't join with thread");
- /* NOTREACHED */
- }
- JOIN(t, &av);
-
- sv_2mortal((SV*)av);
-
- if (SvTRUE(*av_fetch(av, 0, FALSE))) {
- /* Could easily speed up the following if necessary */
- for (i = 1; i <= AvFILL(av); i++)
- XPUSHs(*av_fetch(av, i, FALSE));
- }
- else {
- STRLEN n_a;
- char *mess = SvPV(*av_fetch(av, 1, FALSE), n_a);
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "%p: join propagating die message: %s\n",
- thr, mess));
- croak(mess);
- }
-#endif
void
detach(t)
Thread t
CODE:
-#ifdef USE_5005THREADS
- DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: detaching %p (state %u)\n",
- thr, t, ThrSTATE(t)));
- MUTEX_LOCK(&t->mutex);
- switch (ThrSTATE(t)) {
- case THRf_R_JOINABLE:
- ThrSETSTATE(t, THRf_R_DETACHED);
- /* fall through */
- case THRf_R_DETACHED:
- DETACH(t);
- MUTEX_UNLOCK(&t->mutex);
- break;
- case THRf_ZOMBIE:
- ThrSETSTATE(t, THRf_DEAD);
- DETACH(t);
- MUTEX_UNLOCK(&t->mutex);
- remove_thread(aTHX_ t);
- break;
- default:
- MUTEX_UNLOCK(&t->mutex);
- croak("can't detach thread");
- /* NOTREACHED */
- }
-#endif
void
equal(t1, t2)
flags(t)
Thread t
PPCODE:
-#ifdef USE_5005THREADS
- PUSHs(sv_2mortal(newSViv(t->flags)));
-#endif
void
done(t)
Thread t
PPCODE:
-#ifdef USE_5005THREADS
- PUSHs(t->thr_done ? &PL_sv_yes : &PL_sv_no);
-#endif
void
self(classname)
PREINIT:
SV *sv;
PPCODE:
-#ifdef USE_5005THREADS
- sv = newSViv(thr->tid);
- sv_magic(sv, thr->oursv, '~', 0, 0);
- SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
- PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv),
- gv_stashpv(classname, TRUE))));
-#endif
U32
tid(t)
Thread t
CODE:
-#ifdef USE_5005THREADS
- MUTEX_LOCK(&t->mutex);
- RETVAL = t->tid;
- MUTEX_UNLOCK(&t->mutex);
-#else
RETVAL = 0;
-#endif
OUTPUT:
RETVAL
void
yield()
CODE:
-{
-#ifdef USE_5005THREADS
- YIELD;
-#endif
-}
void
cond_wait(sv)
SV * sv
- MAGIC * mg = NO_INIT
CODE:
-#ifdef USE_5005THREADS
- if (SvROK(sv))
- sv = SvRV(sv);
-
- mg = condpair_magic(sv);
- DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: cond_wait %p\n", thr, sv));
- MUTEX_LOCK(MgMUTEXP(mg));
- if (MgOWNER(mg) != thr) {
- MUTEX_UNLOCK(MgMUTEXP(mg));
- croak("cond_wait for lock that we don't own\n");
- }
- MgOWNER(mg) = 0;
- COND_SIGNAL(MgOWNERCONDP(mg));
- COND_WAIT(MgCONDP(mg), MgMUTEXP(mg));
- while (MgOWNER(mg))
- COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
- MgOWNER(mg) = thr;
- MUTEX_UNLOCK(MgMUTEXP(mg));
-#endif
void
cond_signal(sv)
SV * sv
- MAGIC * mg = NO_INIT
CODE:
-#ifdef USE_5005THREADS
- if (SvROK(sv))
- sv = SvRV(sv);
-
- mg = condpair_magic(sv);
- DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: cond_signal %p\n",thr,sv));
- MUTEX_LOCK(MgMUTEXP(mg));
- if (MgOWNER(mg) != thr) {
- MUTEX_UNLOCK(MgMUTEXP(mg));
- croak("cond_signal for lock that we don't own\n");
- }
- COND_SIGNAL(MgCONDP(mg));
- MUTEX_UNLOCK(MgMUTEXP(mg));
-#endif
void
cond_broadcast(sv)
SV * sv
- MAGIC * mg = NO_INIT
CODE:
-#ifdef USE_5005THREADS
- if (SvROK(sv))
- sv = SvRV(sv);
-
- mg = condpair_magic(sv);
- DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: cond_broadcast %p\n",
- thr, sv));
- MUTEX_LOCK(MgMUTEXP(mg));
- if (MgOWNER(mg) != thr) {
- MUTEX_UNLOCK(MgMUTEXP(mg));
- croak("cond_broadcast for lock that we don't own\n");
- }
- COND_BROADCAST(MgCONDP(mg));
- MUTEX_UNLOCK(MgMUTEXP(mg));
-#endif
void
list(classname)
char * classname
- PREINIT:
- Thread t;
- AV * av;
- SV ** svp;
- int n = 0;
PPCODE:
-#ifdef USE_5005THREADS
- av = newAV();
- /*
- * Iterate until we have enough dynamic storage for all threads.
- * We mustn't do any allocation while holding threads_mutex though.
- */
- MUTEX_LOCK(&PL_threads_mutex);
- do {
- n = PL_nthreads;
- MUTEX_UNLOCK(&PL_threads_mutex);
- if (AvFILL(av) < n - 1) {
- int i = AvFILL(av);
- for (i = AvFILL(av); i < n - 1; i++) {
- SV *sv = newSViv(0); /* fill in tid later */
- sv_magic(sv, 0, '~', 0, 0); /* fill in other magic later */
- av_push(av, sv_bless(newRV_noinc(sv),
- gv_stashpv(classname, TRUE)));
-
- }
- }
- MUTEX_LOCK(&PL_threads_mutex);
- } while (n < PL_nthreads);
- n = PL_nthreads; /* Get the final correct value */
-
- /*
- * At this point, there's enough room to fill in av.
- * Note that we are holding threads_mutex so the list
- * won't change out from under us but all the remaining
- * processing is "fast" (no blocking, malloc etc.)
- */
- t = thr;
- svp = AvARRAY(av);
- do {
- SV *sv = (SV*)SvRV(*svp);
- sv_setiv(sv, t->tid);
- SvMAGIC(sv)->mg_obj = SvREFCNT_inc(t->oursv);
- SvMAGIC(sv)->mg_flags |= MGf_REFCOUNTED;
- SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
- t = t->next;
- svp++;
- } while (t != thr);
- /* */
- MUTEX_UNLOCK(&PL_threads_mutex);
- /* Truncate any unneeded slots in av */
- av_fill(av, n - 1);
- /* Finally, push all the new objects onto the stack and drop av */
- EXTEND(SP, n);
- for (svp = AvARRAY(av); n > 0; n--, svp++)
- PUSHs(*svp);
- (void)sv_2mortal((SV*)av);
-#endif
MODULE = Thread PACKAGE = Thread::Signal
data(classname = "Thread::Specific")
char * classname
PPCODE:
-#ifdef USE_5005THREADS
- if (AvFILL(thr->specific) == -1) {
- GV *gv = gv_fetchpv("Thread::Specific::FIELDS", TRUE, SVt_PVHV);
- av_store(thr->specific, 0, newRV((SV*)GvHV(gv)));
- }
- XPUSHs(sv_bless(newRV((SV*)thr->specific),gv_stashpv(classname,TRUE)));
-#endif
CvGV(GvCV(gv)) = gv;
CvFILE_set_from_cop(GvCV(gv), PL_curcop);
CvSTASH(GvCV(gv)) = PL_curstash;
-#ifdef USE_5005THREADS
- CvOWNER(GvCV(gv)) = 0;
- if (!CvMUTEXP(GvCV(gv))) {
- New(666, CvMUTEXP(GvCV(gv)), 1, perl_mutex);
- MUTEX_INIT(CvMUTEXP(GvCV(gv)));
- }
-#endif /* USE_5005THREADS */
if (proto) {
sv_setpv((SV*)GvCV(gv), proto);
Safefree(proto);
"Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
HvNAME(stash), (int)len, name);
-#ifndef USE_5005THREADS
if (CvXSUB(cv)) {
/* rather than lookup/init $AUTOLOAD here
* only to have the XSUB do another lookup for $AUTOLOAD
SvCUR(cv) = len;
return gv;
}
-#endif
/*
* Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
ENTER;
-#ifdef USE_5005THREADS
- sv_lock((SV *)varstash);
-#endif
if (!isGV(vargv))
gv_init(vargv, varstash, autoload, autolen, FALSE);
LEAVE;
varsv = GvSV(vargv);
-#ifdef USE_5005THREADS
- sv_lock(varsv);
-#endif
sv_setpv(varsv, HvNAME(stash));
sv_catpvn(varsv, "::", 2);
sv_catpvn(varsv, name, len);
#
# Fix when Apple fixes libc.
#
-case "$usethreads$useithreads$use5005threads" in
+case "$usethreads$useithreads" in
*define*)
cat <<EOM >&4
}
}
-# Switch in the 5.005-threads versions of he threadsafe queue and semaphore
-# modules if so needed.
-if ($Config{use5005threads}) {
- for my $m (qw(Queue Semaphore)) {
- my $t = "$installprivlib/Thread/$m.pm";
- unlink $t;
- copy("ext/Thread/$m.pmx", $t);
- chmod(0444, $t);
- }
-}
-
# Install main perl executables
# Make links to ordinary names if installbin directory isn't current directory.
PERLVAR(Ipending_ident, char) /* pending identifier lookup */
PERLVAR(Isublex_info, SUBLEXINFO) /* from toke.c */
-#ifdef USE_5005THREADS
-PERLVAR(Ithrsv, SV *) /* struct perl_thread for main thread */
-PERLVARI(Ithreadnum, U32, 0) /* incremented each thread creation */
-PERLVAR(Istrtab_mutex, perl_mutex) /* Mutex for string table access */
-#endif /* USE_5005THREADS */
-
PERLVAR(Iuid, Uid_t) /* current real user id */
PERLVAR(Ieuid, Uid_t) /* current effective user id */
PERLVAR(Igid, Gid_t) /* current real group id */
PERLVARA(Iuudmap,256, char)
PERLVAR(Ibitcount, char *)
-#ifdef USE_5005THREADS
-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 */
-PERLVAR(Ieval_owner, struct perl_thread *)
- /* Owner thread for doeval */
-PERLVAR(Inthreads, int) /* Number of threads currently */
-PERLVAR(Ithreads_mutex, perl_mutex) /* Mutex for nthreads and thread list */
-PERLVAR(Inthreads_cond, perl_cond) /* Condition variable for nthreads */
-PERLVAR(Isvref_mutex, perl_mutex) /* Mutex for SvREFCNT_{inc,dec} */
-PERLVARI(Ithreadsv_names,char *, THREADSV_NAMES)
-#ifdef FAKE_THREADS
-PERLVAR(Icurthr, struct perl_thread *)
- /* Currently executing (fake) thread */
-#endif
-
-PERLVAR(Icred_mutex, perl_mutex) /* altered credentials in effect */
-
-#endif /* USE_5005THREADS */
-
PERLVAR(Ipsig_ptr, SV**)
PERLVAR(Ipsig_name, SV**)
#endif
PERLVARI(Ibeginav_save, AV*, Nullav) /* save BEGIN{}s when compiling */
-#ifdef USE_5005THREADS
-PERLVAR(Ifdpid_mutex, perl_mutex) /* mutex for fdpid array */
-PERLVAR(Isv_lock_mutex, perl_mutex) /* mutex for SvLOCK macro */
-#endif
-
PERLVAR(Ixnv_arenaroot, XPV*) /* list of allocated xnv areas */
PERLVAR(Ixrv_arenaroot, XPV*) /* list of allocated xrv areas */
PERLVAR(Ixpv_arenaroot, XPV*) /* list of allocated xpv areas */
$define{PERL_IMPLICIT_CONTEXT} ||=
$define{USE_ITHREADS} ||
- $define{USE_5005THREADS} ||
$define{MULTIPLICITY} ;
if ($define{USE_ITHREADS} && $PLATFORM ne 'win32' && $^O ne 'darwin') {
Perl_strdup
Perl_putenv
)];
- if ($define{'USE_5005THREADS'} || $define{'USE_ITHREADS'}) {
+ if ($define{'USE_ITHREADS'}) {
emit_symbols [qw(
PL_malloc_mutex
)];
)];
}
-unless ($define{'USE_5005THREADS'} || $define{'USE_ITHREADS'}) {
+unless ($define{'USE_ITHREADS'}) {
skip_symbols [qw(
PL_thr_key
)];
}
-unless ($define{'USE_5005THREADS'}) {
+# USE_5005THREADS symbols. Kept as reference for easier removal
skip_symbols [qw(
PL_sv_mutex
PL_strtab_mutex
Perl_magic_mutexfree
Perl_sv_lock
)];
-}
unless ($define{'USE_ITHREADS'}) {
skip_symbols [qw(
return \@syms;
}
-if ($define{'USE_5005THREADS'}) {
- my $thrd = readvar($thrdvar_h);
- skip_symbols $thrd;
-}
-
if ($define{'PERL_GLOBAL_STRUCT'}) {
my $global = readvar($perlvars_h);
skip_symbols $global;
my $glob = readvar($intrpvar_h);
emit_symbols $glob;
}
- unless ($define{'MULTIPLICITY'} || $define{'USE_5005THREADS'}) {
+ unless ($define{'MULTIPLICITY'}) {
my $glob = readvar($thrdvar_h);
emit_symbols $glob;
}
case '0':
break;
#endif
-#ifdef USE_5005THREADS
- case '@':
- sv_setsv(sv, thr->errsv);
- break;
-#endif /* USE_5005THREADS */
}
return 0;
}
}
break;
#endif
-#ifdef USE_5005THREADS
- case '@':
- sv_setsv(thr->errsv, sv);
- break;
-#endif /* USE_5005THREADS */
}
return 0;
}
-#ifdef USE_5005THREADS
-int
-Perl_magic_mutexfree(pTHX_ SV *sv, MAGIC *mg)
-{
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "0x%"UVxf": magic_mutexfree 0x%"UVxf"\n",
- PTR2UV(thr), PTR2UV(sv)));
- if (MgOWNER(mg))
- Perl_croak(aTHX_ "panic: magic_mutexfree");
- MUTEX_DESTROY(MgMUTEXP(mg));
- COND_DESTROY(MgCONDP(mg));
- return 0;
-}
-#endif /* USE_5005THREADS */
-
I32
Perl_whichsig(pTHX_ char *sig)
{
PERL_SYS_INIT3(&argc,&argv,&env);
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
/* XXX Ideally, this should really be happening in perl_alloc() or
* perl_construct() to keep libperl.a transparently fork()-safe.
* It is currently done here only because Apache/mod_perl have
uname='$myuname'
config_args='$config_args'
hint=$hint, useposix=$useposix, d_sigaction=$d_sigaction
- usethreads=$usethreads use5005threads=$use5005threads useithreads=$useithreads usemultiplicity=$usemultiplicity
+ usethreads=$usethreads useithreads=$useithreads usemultiplicity=$usemultiplicity
useperlio=$useperlio d_sfio=$d_sfio uselargefiles=$uselargefiles usesocks=$usesocks
use64bitint=$use64bitint use64bitall=$use64bitall uselongdouble=$uselongdouble
usemymalloc=$usemymalloc, bincompat5005=undef
return off;
}
-
-#ifdef USE_5005THREADS
-/* find_threadsv is not reentrant */
-PADOFFSET
-Perl_find_threadsv(pTHX_ const char *name)
-{
- char *p;
- PADOFFSET key;
- SV **svp;
- /* We currently only handle names of a single character */
- p = strchr(PL_threadsv_names, *name);
- if (!p)
- return NOT_IN_PAD;
- key = p - PL_threadsv_names;
- MUTEX_LOCK(&thr->mutex);
- svp = av_fetch(thr->threadsv, key, FALSE);
- if (svp)
- MUTEX_UNLOCK(&thr->mutex);
- else {
- SV *sv = NEWSV(0, 0);
- av_store(thr->threadsv, key, sv);
- thr->threadsvp = AvARRAY(thr->threadsv);
- MUTEX_UNLOCK(&thr->mutex);
- /*
- * Some magic variables used to be automagically initialised
- * in gv_fetchpv. Those which are now per-thread magicals get
- * initialised here instead.
- */
- switch (*name) {
- case '_':
- break;
- case ';':
- sv_setpv(sv, "\034");
- sv_magic(sv, 0, PERL_MAGIC_sv, name, 1);
- break;
- case '&':
- case '`':
- case '\'':
- PL_sawampersand = TRUE;
- /* FALL THROUGH */
- case '1':
- case '2':
- case '3':
- case '4':
- case '5':
- case '6':
- case '7':
- case '8':
- case '9':
- SvREADONLY_on(sv);
- /* FALL THROUGH */
-
- /* XXX %! tied to Errno.pm needs to be added here.
- * See gv_fetchpv(). */
- /* case '!': */
-
- default:
- sv_magic(sv, 0, PERL_MAGIC_sv, name, 1);
- }
- DEBUG_S(PerlIO_printf(Perl_error_log,
- "find_threadsv: new SV %p for $%s%c\n",
- sv, (*name < 32) ? "^" : "",
- (*name < 32) ? toCTRL(*name) : *name));
- }
- return key;
-}
-#endif /* USE_5005THREADS */
-
/* Destructor */
void
switch (o->op_type) {
case OP_NULL: /* Was holding old type, if any. */
case OP_ENTEREVAL: /* Was holding hints. */
-#ifdef USE_5005THREADS
- case OP_THREADSV: /* Was holding index into thr->threadsv AV. */
-#endif
o->op_targ = 0;
break;
-#ifdef USE_5005THREADS
- case OP_ENTERITER:
- if (!(o->op_flags & OPf_SPECIAL))
- break;
- /* FALL THROUGH */
-#endif /* USE_5005THREADS */
default:
if (!(o->op_flags & OPf_REF)
|| (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)))
}
break;
-#ifdef USE_5005THREADS
- case OP_THREADSV:
- PL_modcount++; /* XXX ??? */
- break;
-#endif /* USE_5005THREADS */
-
case OP_PUSHMARK:
break;
STATIC OP *
S_newDEFSVOP(pTHX)
{
-#ifdef USE_5005THREADS
- OP *o = newOP(OP_THREADSV, 0);
- o->op_targ = find_threadsv("_");
- return o;
-#else
return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
-#endif /* USE_5005THREADS */
}
void
{
if (o->op_type == OP_LIST) {
OP *o2;
-#ifdef USE_5005THREADS
- o2 = newOP(OP_THREADSV, 0);
- o2->op_targ = find_threadsv(";");
-#else
o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
-#endif /* USE_5005THREADS */
o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o));
}
return o;
if (CopLINE(PL_curcop) < PL_multi_end)
CopLINE_set(PL_curcop, (line_t)PL_multi_end);
}
-#ifdef USE_5005THREADS
- else if (repl->op_type == OP_THREADSV
- && strchr("&`'123456789+",
- PL_threadsv_names[repl->op_targ]))
- {
- curop = 0;
- }
-#endif /* USE_5005THREADS */
else if (repl->op_type == OP_CONST)
curop = repl;
else {
OP *lastop = 0;
for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
-#ifdef USE_5005THREADS
- if (curop->op_type == OP_THREADSV) {
- repl_has_vars = 1;
- if (strchr("&`'123456789+", curop->op_private))
- break;
- }
-#else
if (curop->op_type == OP_GV) {
GV *gv = cGVOPx_gv(curop);
repl_has_vars = 1;
if (strchr("&`'123456789+", *GvENAME(gv)))
break;
}
-#endif /* USE_5005THREADS */
else if (curop->op_type == OP_RV2CV)
break;
else if (curop->op_type == OP_RV2SV ||
Perl_croak(aTHX_ "Can't use %s for loop variable", PL_op_desc[sv->op_type]);
}
else {
-#ifdef USE_5005THREADS
- padoff = find_threadsv("_");
- iterflags |= OPf_SPECIAL;
-#else
sv = newGVOP(OP_GV, 0, PL_defgv);
-#endif
}
if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
expr = mod(force_list(scalar(ref(expr, OP_ITER))), OP_GREPSTART);
CV *outsidecv;
CV *freecv = Nullcv;
-#ifdef USE_5005THREADS
- if (CvMUTEXP(cv)) {
- MUTEX_DESTROY(CvMUTEXP(cv));
- Safefree(CvMUTEXP(cv));
- CvMUTEXP(cv) = 0;
- }
-#endif /* USE_5005THREADS */
-
#ifdef USE_ITHREADS
if (CvFILE(cv) && !CvXSUB(cv)) {
/* for XSUBs CvFILE point directly to static memory; __FILE__ */
#endif
if (!CvXSUB(cv) && CvROOT(cv)) {
-#ifdef USE_5005THREADS
- if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
- Perl_croak(aTHX_ "Can't undef active subroutine");
-#else
if (CvDEPTH(cv))
Perl_croak(aTHX_ "Can't undef active subroutine");
-#endif /* USE_5005THREADS */
ENTER;
PAD_SAVE_SETNULLPAD;
CvGV(cv) = gv;
CvFILE_set_from_cop(cv, PL_curcop);
CvSTASH(cv) = PL_curstash;
-#ifdef USE_5005THREADS
- CvOWNER(cv) = 0;
- if (!CvMUTEXP(cv)) {
- New(666, CvMUTEXP(cv), 1, perl_mutex);
- MUTEX_INIT(CvMUTEXP(cv));
- }
-#endif /* USE_5005THREADS */
if (ps)
sv_setpv((SV*)cv, ps);
}
}
CvGV(cv) = gv;
-#ifdef USE_5005THREADS
- New(666, CvMUTEXP(cv), 1, perl_mutex);
- MUTEX_INIT(CvMUTEXP(cv));
- CvOWNER(cv) = 0;
-#endif /* USE_5005THREADS */
(void)gv_fetchfile(filename);
CvFILE(cv) = filename; /* NOTE: not copied, as it is expected to be
an external constant string */
OP *argop;
op_free(o);
-#ifdef USE_5005THREADS
- if (!CvUNIQUE(PL_compcv)) {
- argop = newOP(OP_PADAV, OPf_REF);
- argop->op_targ = 0; /* PAD_SV(0) is @_ */
- }
- else {
- argop = newUNOP(OP_RV2AV, 0,
- scalar(newGVOP(OP_GV, 0,
- gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
- }
-#else
argop = newUNOP(OP_RV2AV, 0,
scalar(newGVOP(OP_GV, 0, !CvUNIQUE(PL_compcv) ?
PL_defgv : gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
-#endif /* USE_5005THREADS */
return newUNOP(type, 0, scalar(argop));
}
return scalar(modkids(ck_fun(o), type));
#include "EXTERN.h"
#include "perl.h"
-#ifdef USE_5005THREADS
-
-typedef void (*emx_startroutine)(void *);
-typedef void* (*pthreads_startroutine)(void *);
-
-enum pthreads_state {
- pthreads_st_none = 0,
- pthreads_st_run,
- pthreads_st_exited,
- pthreads_st_detached,
- pthreads_st_waited,
-};
-const char *pthreads_states[] = {
- "uninit",
- "running",
- "exited",
- "detached",
- "waited for",
-};
-
-typedef struct {
- void *status;
- perl_cond cond;
- enum pthreads_state state;
-} thread_join_t;
-
-thread_join_t *thread_join_data;
-int thread_join_count;
-perl_mutex start_thread_mutex;
-
-int
-pthread_join(perl_os_thread tid, void **status)
-{
- MUTEX_LOCK(&start_thread_mutex);
- switch (thread_join_data[tid].state) {
- case pthreads_st_exited:
- thread_join_data[tid].state = pthreads_st_none; /* Ready to reuse */
- MUTEX_UNLOCK(&start_thread_mutex);
- *status = thread_join_data[tid].status;
- break;
- case pthreads_st_waited:
- MUTEX_UNLOCK(&start_thread_mutex);
- Perl_croak_nocontext("join with a thread with a waiter");
- break;
- case pthreads_st_run:
- thread_join_data[tid].state = pthreads_st_waited;
- COND_INIT(&thread_join_data[tid].cond);
- MUTEX_UNLOCK(&start_thread_mutex);
- COND_WAIT(&thread_join_data[tid].cond, NULL);
- COND_DESTROY(&thread_join_data[tid].cond);
- thread_join_data[tid].state = pthreads_st_none; /* Ready to reuse */
- *status = thread_join_data[tid].status;
- break;
- default:
- MUTEX_UNLOCK(&start_thread_mutex);
- Perl_croak_nocontext("join: unknown thread state: '%s'",
- pthreads_states[thread_join_data[tid].state]);
- break;
- }
- return 0;
-}
-
-void
-pthread_startit(void *arg)
-{
- /* Thread is already started, we need to transfer control only */
- pthreads_startroutine start_routine = *((pthreads_startroutine*)arg);
- int tid = pthread_self();
- void *retval;
-
- arg = ((void**)arg)[1];
- if (tid >= thread_join_count) {
- int oc = thread_join_count;
-
- thread_join_count = tid + 5 + tid/5;
- if (thread_join_data) {
- Renew(thread_join_data, thread_join_count, thread_join_t);
- Zero(thread_join_data + oc, thread_join_count - oc, thread_join_t);
- } else {
- Newz(1323, thread_join_data, thread_join_count, thread_join_t);
- }
- }
- if (thread_join_data[tid].state != pthreads_st_none)
- Perl_croak_nocontext("attempt to reuse thread id %i", tid);
- thread_join_data[tid].state = pthreads_st_run;
- /* Now that we copied/updated the guys, we may release the caller... */
- MUTEX_UNLOCK(&start_thread_mutex);
- thread_join_data[tid].status = (*start_routine)(arg);
- switch (thread_join_data[tid].state) {
- case pthreads_st_waited:
- COND_SIGNAL(&thread_join_data[tid].cond);
- break;
- default:
- thread_join_data[tid].state = pthreads_st_exited;
- break;
- }
-}
-
-int
-pthread_create(perl_os_thread *tid, const pthread_attr_t *attr,
- void *(*start_routine)(void*), void *arg)
-{
- void *args[2];
-
- args[0] = (void*)start_routine;
- args[1] = arg;
-
- MUTEX_LOCK(&start_thread_mutex);
- *tid = _beginthread(pthread_startit, /*stack*/ NULL,
- /*stacksize*/ 10*1024*1024, (void*)args);
- MUTEX_LOCK(&start_thread_mutex);
- MUTEX_UNLOCK(&start_thread_mutex);
- return *tid ? 0 : EINVAL;
-}
-
-int
-pthread_detach(perl_os_thread tid)
-{
- MUTEX_LOCK(&start_thread_mutex);
- switch (thread_join_data[tid].state) {
- case pthreads_st_waited:
- MUTEX_UNLOCK(&start_thread_mutex);
- Perl_croak_nocontext("detach on a thread with a waiter");
- break;
- case pthreads_st_run:
- thread_join_data[tid].state = pthreads_st_detached;
- MUTEX_UNLOCK(&start_thread_mutex);
- break;
- default:
- MUTEX_UNLOCK(&start_thread_mutex);
- Perl_croak_nocontext("detach: unknown thread state: '%s'",
- pthreads_states[thread_join_data[tid].state]);
- break;
- }
- return 0;
-}
-
-/* This is a very bastardized version: */
-int
-os2_cond_wait(perl_cond *c, perl_mutex *m)
-{
- int rc;
- STRLEN n_a;
- if ((rc = DosResetEventSem(*c,&n_a)) && (rc != ERROR_ALREADY_RESET))
- Perl_croak_nocontext("panic: COND_WAIT-reset: rc=%i", rc);
- if (m) MUTEX_UNLOCK(m);
- if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT))
- && (rc != ERROR_INTERRUPT))
- Perl_croak_nocontext("panic: COND_WAIT: rc=%i", rc);
- if (rc == ERROR_INTERRUPT)
- errno = EINTR;
- if (m) MUTEX_LOCK(m);
-}
-#endif
-
static int exe_is_aout(void);
/*****************************************************************************/
}
avlen --;
}
-#ifdef USE_5005THREADS
- sum++; /* Avoid conflict of DLLs in memory. */
-#endif
/* We always load modules as *specific* DLLs, and with the full name.
When loading a specific DLL by its full name, one cannot get a
different DLL, even if a DLL with the same basename is loaded already.
# undef I_SYS_UN
#endif
-#ifdef USE_5005THREADS
-
-#define do_spawn(a) os2_do_spawn(aTHX_ (a))
-#define do_aspawn(a,b,c) os2_do_aspawn(aTHX_ (a),(b),(c))
-
-#define OS2_ERROR_ALREADY_POSTED 299 /* Avoid os2.h */
-
-extern int rc;
-
-#define MUTEX_INIT(m) \
- STMT_START { \
- int rc; \
- if ((rc = _rmutex_create(m,0))) \
- Perl_croak_nocontext("panic: MUTEX_INIT: rc=%i", rc); \
- } STMT_END
-#define MUTEX_LOCK(m) \
- STMT_START { \
- int rc; \
- if ((rc = _rmutex_request(m,_FMR_IGNINT))) \
- Perl_croak_nocontext("panic: MUTEX_LOCK: rc=%i", rc); \
- } STMT_END
-#define MUTEX_UNLOCK(m) \
- STMT_START { \
- int rc; \
- if ((rc = _rmutex_release(m))) \
- Perl_croak_nocontext("panic: MUTEX_UNLOCK: rc=%i", rc); \
- } STMT_END
-#define MUTEX_DESTROY(m) \
- STMT_START { \
- int rc; \
- if ((rc = _rmutex_close(m))) \
- Perl_croak_nocontext("panic: MUTEX_DESTROY: rc=%i", rc); \
- } STMT_END
-
-#define COND_INIT(c) \
- STMT_START { \
- int rc; \
- if ((rc = DosCreateEventSem(NULL,c,0,0))) \
- Perl_croak_nocontext("panic: COND_INIT: rc=%i", rc); \
- } STMT_END
-#define COND_SIGNAL(c) \
- STMT_START { \
- int rc; \
- if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\
- Perl_croak_nocontext("panic: COND_SIGNAL, rc=%ld", rc); \
- } STMT_END
-#define COND_BROADCAST(c) \
- STMT_START { \
- int rc; \
- if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\
- Perl_croak_nocontext("panic: COND_BROADCAST, rc=%i", rc); \
- } STMT_END
-/* #define COND_WAIT(c, m) \
- STMT_START { \
- if (WaitForSingleObject(*(c),INFINITE) == WAIT_FAILED) \
- Perl_croak_nocontext("panic: COND_WAIT"); \
- } STMT_END
-*/
-#define COND_WAIT(c, m) os2_cond_wait(c,m)
-
-#define COND_WAIT_win32(c, m) \
- STMT_START { \
- int rc; \
- if ((rc = SignalObjectAndWait(*(m),*(c),INFINITE,FALSE))) \
- Perl_croak_nocontext("panic: COND_WAIT"); \
- else \
- MUTEX_LOCK(m); \
- } STMT_END
-#define COND_DESTROY(c) \
- STMT_START { \
- int rc; \
- if ((rc = DosCloseEventSem(*(c)))) \
- Perl_croak_nocontext("panic: COND_DESTROY, rc=%i", rc); \
- } STMT_END
-/*#define THR ((struct thread *) TlsGetValue(PL_thr_key))
-*/
-
-#ifdef USE_SLOW_THREAD_SPECIFIC
-# define pthread_getspecific(k) (*_threadstore())
-# define pthread_setspecific(k,v) (*_threadstore()=v,0)
-# define pthread_key_create(keyp,flag) (*keyp=_gettid(),0)
-#else /* USE_SLOW_THREAD_SPECIFIC */
-# define pthread_getspecific(k) (*(k))
-# define pthread_setspecific(k,v) (*(k)=(v),0)
-# define pthread_key_create(keyp,flag) \
- ( DosAllocThreadLocalMemory(1,(U32*)keyp) \
- ? Perl_croak_nocontext("LocalMemory"),1 \
- : 0 \
- )
-#endif /* USE_SLOW_THREAD_SPECIFIC */
-#define pthread_key_delete(keyp)
-#define pthread_self() _gettid()
-#define YIELD DosSleep(0)
-
-#ifdef PTHREADS_INCLUDED /* For ./x2p stuff. */
-int pthread_join(pthread_t tid, void **status);
-int pthread_detach(pthread_t tid);
-int pthread_create(pthread_t *tid, const pthread_attr_t *attr,
- void *(*start_routine)(void*), void *arg);
-#endif /* PTHREAD_INCLUDED */
-
-#define THREADS_ELSEWHERE
-
-#else /* USE_5005THREADS */
-
#define do_spawn(a) os2_do_spawn(a)
#define do_aspawn(a,b,c) os2_do_aspawn((a),(b),(c))
-
-#endif /* USE_5005THREADS */
void Perl_OS2_init(char **);
void Perl_OS2_init3(char **envp, void **excH, int flags);
AvFLAGS(a0) = AVf_REIFY;
}
else {
-#ifdef USE_5005THREADS
- av_store(padname, 0, newSVpvn("@_", 2));
- a0 = newAV();
- SvPADMY_on((SV*)a0); /* XXX Needed? */
- av_store(pad, 0, (SV*)a0);
-#else
av_store(pad, 0, Nullsv);
-#endif /* USE_THREADS */
}
AvREAL_off(padlist);
DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad findmy: \"%s\"\n", name));
-#ifdef USE_5005THREADS
- /*
- * Special case to get lexical (and hence per-thread) @_.
- * XXX I need to find out how to tell at parse-time whether use
- * of @_ should refer to a lexical (from a sub) or defgv (global
- * scope and maybe weird sub-ish things like formats). See
- * startsub in perly.y. It's possible that @_ could be lexical
- * (at least from subs) even in non-threaded perl.
- */
- if (strEQ(name, "@_"))
- return 0; /* success. (NOT_IN_PAD indicates failure) */
-#endif /* USE_5005THREADS */
-
/* The one we're looking for is probably just before comppad_name_fill. */
for (off = AvFILLp(PL_comppad_name); off > 0; off--) {
if ((sv = svp[off]) &&
cp = Nullav;
#endif
-#ifndef USE_5005THREADS
if (!po)
Perl_croak(aTHX_ "panic: pad_sv po");
-#endif
DEBUG_X(PerlIO_printf(Perl_debug_log,
"Pad 0x%"UVxf"[0x%"UVxf"] sv: %ld sv=0x%"UVxf"\n",
PTR2UV(cp), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
CvFLAGS(cv) = CvFLAGS(proto) & ~CVf_CLONE;
CvCLONED_on(cv);
-#ifdef USE_5005THREADS
- New(666, CvMUTEXP(cv), 1, perl_mutex);
- MUTEX_INIT(CvMUTEXP(cv));
- CvOWNER(cv) = 0;
-#endif /* USE_5005THREADS */
#ifdef USE_ITHREADS
CvFILE(cv) = CvXSUB(proto) ? CvFILE(proto)
: savepv(CvFILE(proto));
#endif
#endif
-#if defined(USE_5005THREADS)
-# define INIT_TLS_AND_INTERP \
- STMT_START { \
- if (!PL_curinterp) { \
- PERL_SET_INTERP(my_perl); \
- INIT_THREADS; \
- ALLOC_THREAD_KEY; \
- } \
- } STMT_END
-#else
-# if defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
# define INIT_TLS_AND_INTERP \
STMT_START { \
if (!PL_curinterp) { \
PERL_SET_THX(my_perl); \
} \
} STMT_END
-# else
+#else
# define INIT_TLS_AND_INTERP \
STMT_START { \
if (!PL_curinterp) { \
PERL_SET_THX(my_perl); \
} STMT_END
# endif
-#endif
#ifdef PERL_IMPLICIT_SYS
PerlInterpreter *
void
perl_construct(pTHXx)
{
-#ifdef USE_5005THREADS
-#ifndef FAKE_THREADS
- struct perl_thread *thr = NULL;
-#endif /* FAKE_THREADS */
-#endif /* USE_5005THREADS */
-
#ifdef MULTIPLICITY
init_interp();
PL_perl_destruct_level = 1;
/* Init the real globals (and main thread)? */
if (!PL_linestr) {
-#ifdef USE_5005THREADS
- MUTEX_INIT(&PL_sv_mutex);
- /*
- * Safe to use basic SV functions from now on (though
- * not things like mortals or tainting yet).
- */
- MUTEX_INIT(&PL_eval_mutex);
- COND_INIT(&PL_eval_cond);
- MUTEX_INIT(&PL_threads_mutex);
- COND_INIT(&PL_nthreads_cond);
-# ifdef EMULATE_ATOMIC_REFCOUNTS
- MUTEX_INIT(&PL_svref_mutex);
-# endif /* EMULATE_ATOMIC_REFCOUNTS */
-
- MUTEX_INIT(&PL_cred_mutex);
- MUTEX_INIT(&PL_sv_lock_mutex);
- MUTEX_INIT(&PL_fdpid_mutex);
-
- thr = init_main_thread();
-#endif /* USE_5005THREADS */
-
#ifdef PERL_FLEXIBLE_EXCEPTIONS
PL_protect = MEMBER_TO_FPTR(Perl_default_protect); /* for exceptions */
#endif
It is properly deallocated in perl_destruct() */
PL_strtab = newHV();
-#ifdef USE_5005THREADS
- MUTEX_INIT(&PL_strtab_mutex);
-#endif
HvSHAREKEYS_off(PL_strtab); /* mandatory */
hv_ksplit(PL_strtab, 512);
volatile int destruct_level; /* 0=none, 1=full, 2=full with checks */
HV *hv;
#ifdef USE_5005THREADS
- Thread t;
dTHX;
#endif /* USE_5005THREADS */
/* wait for all pseudo-forked children to finish */
PERL_WAIT_FOR_CHILDREN;
-#ifdef USE_5005THREADS
-#ifndef FAKE_THREADS
- /* Pass 1 on any remaining threads: detach joinables, join zombies */
- retry_cleanup:
- MUTEX_LOCK(&PL_threads_mutex);
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "perl_destruct: waiting for %d threads...\n",
- PL_nthreads - 1));
- for (t = thr->next; t != thr; t = t->next) {
- MUTEX_LOCK(&t->mutex);
- switch (ThrSTATE(t)) {
- AV *av;
- case THRf_ZOMBIE:
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "perl_destruct: joining zombie %p\n", t));
- ThrSETSTATE(t, THRf_DEAD);
- MUTEX_UNLOCK(&t->mutex);
- PL_nthreads--;
- /*
- * The SvREFCNT_dec below may take a long time (e.g. av
- * may contain an object scalar whose destructor gets
- * called) so we have to unlock threads_mutex and start
- * all over again.
- */
- MUTEX_UNLOCK(&PL_threads_mutex);
- JOIN(t, &av);
- SvREFCNT_dec((SV*)av);
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "perl_destruct: joined zombie %p OK\n", t));
- goto retry_cleanup;
- case THRf_R_JOINABLE:
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "perl_destruct: detaching thread %p\n", t));
- ThrSETSTATE(t, THRf_R_DETACHED);
- /*
- * We unlock threads_mutex and t->mutex in the opposite order
- * from which we locked them just so that DETACH won't
- * deadlock if it panics. It's only a breach of good style
- * not a bug since they are unlocks not locks.
- */
- MUTEX_UNLOCK(&PL_threads_mutex);
- DETACH(t);
- MUTEX_UNLOCK(&t->mutex);
- goto retry_cleanup;
- default:
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "perl_destruct: ignoring %p (state %u)\n",
- t, ThrSTATE(t)));
- MUTEX_UNLOCK(&t->mutex);
- /* fall through and out */
- }
- }
- /* We leave the above "Pass 1" loop with threads_mutex still locked */
-
- /* Pass 2 on remaining threads: wait for the thread count to drop to one */
- while (PL_nthreads > 1)
- {
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "perl_destruct: final wait for %d threads\n",
- PL_nthreads - 1));
- COND_WAIT(&PL_nthreads_cond, &PL_threads_mutex);
- }
- /* At this point, we're the last thread */
- MUTEX_UNLOCK(&PL_threads_mutex);
- DEBUG_S(PerlIO_printf(Perl_debug_log, "perl_destruct: armageddon has arrived\n"));
- MUTEX_DESTROY(&PL_threads_mutex);
- COND_DESTROY(&PL_nthreads_cond);
- PL_nthreads--;
-#endif /* !defined(FAKE_THREADS) */
-#endif /* USE_5005THREADS */
-
destruct_level = PL_perl_destruct_level;
#ifdef DEBUGGING
{
PL_hints = 0; /* Reset hints. Should hints be per-interpreter ? */
DEBUG_P(debprofdump());
-#ifdef USE_5005THREADS
- MUTEX_DESTROY(&PL_strtab_mutex);
- MUTEX_DESTROY(&PL_sv_mutex);
- MUTEX_DESTROY(&PL_eval_mutex);
- MUTEX_DESTROY(&PL_cred_mutex);
- MUTEX_DESTROY(&PL_fdpid_mutex);
- COND_DESTROY(&PL_eval_cond);
-#ifdef EMULATE_ATOMIC_REFCOUNTS
- MUTEX_DESTROY(&PL_svref_mutex);
-#endif /* EMULATE_ATOMIC_REFCOUNTS */
-
- /* As the penultimate thing, free the non-arena SV for thrsv */
- Safefree(SvPVX(PL_thrsv));
- Safefree(SvANY(PL_thrsv));
- Safefree(PL_thrsv);
- PL_thrsv = Nullsv;
-#endif /* USE_5005THREADS */
#ifdef USE_REENTRANT_API
Perl_reentrant_free(aTHX);
# include "config.h"
#endif
-#if defined(USE_ITHREADS) && defined(USE_5005THREADS)
-# include "error: USE_ITHREADS and USE_5005THREADS are incompatible"
-#endif
-
-/* XXX This next guard can disappear if the sources are revised
- to use USE_5005THREADS throughout. -- A.D 1/6/2000
-*/
-#if defined(USE_ITHREADS) && defined(USE_5005THREADS)
-# include "error: USE_ITHREADS and USE_5005THREADS are incompatible"
-#endif
-
/* See L<perlguts/"The Perl API"> for detailed notes on
* PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */
# endif
#endif
-#ifdef USE_5005THREADS
-# ifndef PERL_IMPLICIT_CONTEXT
-# define PERL_IMPLICIT_CONTEXT
-# endif
-#endif
-
#if defined(MULTIPLICITY)
# ifndef PERL_IMPLICIT_CONTEXT
# define PERL_IMPLICIT_CONTEXT
/* <--- here ends the logic shared by perl.h and makedef.pl */
#ifdef PERL_IMPLICIT_CONTEXT
-# ifdef USE_5005THREADS
-struct perl_thread;
-# define pTHX register struct perl_thread *thr PERL_UNUSED_DECL
-# define aTHX thr
-# define dTHR dNOOP /* only backward compatibility */
-# define dTHXa(a) pTHX = (struct perl_thread*)a
-# else
-# ifndef MULTIPLICITY
-# define MULTIPLICITY
-# endif
-# define pTHX register PerlInterpreter *my_perl PERL_UNUSED_DECL
-# define aTHX my_perl
-# define dTHXa(a) pTHX = (PerlInterpreter*)a
+# ifndef MULTIPLICITY
+# define MULTIPLICITY
# endif
+# define pTHX register PerlInterpreter *my_perl PERL_UNUSED_DECL
+# define aTHX my_perl
+# define dTHXa(a) pTHX = (PerlInterpreter*)a
# define dTHX pTHX = PERL_GET_THX
# define pTHX_ pTHX,
# define aTHX_ aTHX,
/* HP-UX 10.X CMA (Common Multithreaded Architecure) insists that
pthread.h must be included before all other header files.
*/
-#if (defined(USE_5005THREADS) || defined(USE_ITHREADS)) \
- && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD)
+#if defined(USE_ITHREADS) && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD)
# include <pthread.h>
#endif
# define INCLUDE_PROTOTYPES /* for <socks.h> */
# define PERL_SOCKS_NEED_PROTOTYPES
# endif
-# ifdef USE_5005THREADS
-# define PERL_USE_THREADS /* store our value */
-# undef USE_5005THREADS
-# endif
# include <socks.h>
-# ifdef USE_5005THREADS
-# undef USE_5005THREADS /* socks.h does this on its own */
-# endif
-# ifdef PERL_USE_THREADS
-# define USE_5005THREADS /* restore our value */
-# undef PERL_USE_THREADS
-# endif
# ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */
# undef INCLUDE_PROTOTYPES
# undef PERL_SOCKS_NEED_PROTOTYPES
# define SS_NORMAL 0
#endif
-#ifdef USE_5005THREADS
-# define ERRSV (thr->errsv)
-# define DEFSV THREADSV(0)
-# define SAVE_DEFSV save_threadsv(0)
-#else
-# define ERRSV GvSV(PL_errgv)
-# define DEFSV GvSV(PL_defgv)
-# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
-#endif /* USE_5005THREADS */
+#define ERRSV GvSV(PL_errgv)
+#define DEFSV GvSV(PL_defgv)
+#define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
#define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */
# endif
#endif
-/*
- * USE_5005THREADS needs to be after unixish.h as <pthread.h> includes
+/* USE_5005THREADS needs to be after unixish.h as <pthread.h> includes
* <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
* this results in many functions being undeclared which bothers C++
* May make sense to have threads after "*ish.h" anyway
*/
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
-# if defined(USE_5005THREADS)
- /* pending resolution of licensing issues, we avoid the erstwhile
- * atomic.h everywhere */
-# define EMULATE_ATOMIC_REFCOUNTS
-# endif
+#if defined(USE_ITHREADS)
# ifdef NETWARE
# include <nw5thread.h>
# else
# endif /* WIN32 */
# endif /* FAKE_THREADS */
#endif /* NETWARE */
-#endif /* USE_5005THREADS || USE_ITHREADS */
+#endif /* USE_ITHREADS */
#if defined(WIN32)
# include "win32.h"
#endif
#if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX)
-# ifdef USE_5005THREADS
-# define PERL_GET_THX ((struct perl_thread *)PERL_GET_CONTEXT)
-# else
# ifdef MULTIPLICITY
# define PERL_GET_THX ((PerlInterpreter *)PERL_GET_CONTEXT)
# endif
-# endif
# define PERL_SET_THX(t) PERL_SET_CONTEXT(t)
#endif
};
#endif
-#ifdef USE_5005THREADS
-#define ARGSproto struct perl_thread *thr
-#else
-#define ARGSproto
-#endif /* USE_5005THREADS */
-
typedef I32 (*filter_t) (pTHX_ int, SV *, int);
#define FILTER_READ(idx, sv, len) filter_read(idx, sv, len)
# define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a)
# define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a)
-# ifdef USE_5005THREADS
-# define DEBUG_S(a) DEBUG__(DEBUG_S_TEST, a)
-# else
-# define DEBUG_S(a)
-# endif
+# define DEBUG_S(a)
# define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a)
# define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a)
want_vtbl_collxfrm,
want_vtbl_amagic,
want_vtbl_amagicelem,
-#ifdef USE_5005THREADS
- want_vtbl_mutex,
-#endif
want_vtbl_regdata,
want_vtbl_regdatum,
want_vtbl_backref
*/
struct interpreter {
-# ifndef USE_5005THREADS
-# include "thrdvar.h"
-# endif
+# include "thrdvar.h"
# include "intrpvar.h"
/*
* The following is a buffer where new variables must
};
#endif /* MULTIPLICITY */
-#ifdef USE_5005THREADS
-/* If we have threads define a struct with all the variables
- * that have to be per-thread
- */
-
-
-struct perl_thread {
-#include "thrdvar.h"
-};
-
-typedef struct perl_thread *Thread;
-
-#else
typedef void *Thread;
-#endif
/* Done with PERLVAR macros for now ... */
#undef PERLVAR
#if !defined(MULTIPLICITY)
START_EXTERN_C
# include "intrpvar.h"
-# ifndef USE_5005THREADS
-# include "thrdvar.h"
-# endif
+# include "thrdvar.h"
END_EXTERN_C
#endif
EXT MGVTBL PL_vtbl_uvar = {MEMBER_TO_FPTR(Perl_magic_getuvar),
MEMBER_TO_FPTR(Perl_magic_setuvar),
0, 0, 0};
-#ifdef USE_5005THREADS
-EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0,
- MEMBER_TO_FPTR(Perl_magic_mutexfree)};
-#endif /* USE_5005THREADS */
EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem),
MEMBER_TO_FPTR(Perl_magic_setdefelem),
0, 0, 0};
EXT MGVTBL PL_vtbl_uvar;
EXT MGVTBL PL_vtbl_ovrld;
-#ifdef USE_5005THREADS
-EXT MGVTBL PL_vtbl_mutex;
-#endif /* USE_5005THREADS */
-
EXT MGVTBL PL_vtbl_defelem;
EXT MGVTBL PL_vtbl_regexp;
EXT MGVTBL PL_vtbl_regdata;
/* currently running interpreter
* (initial parent interpreter under
* useithreads) */
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
PERLVAR(Gthr_key, perl_key) /* key to retrieve per-thread struct */
#endif
/* XXX does anyone even use this? */
PERLVARI(Gdo_undump, bool, FALSE) /* -u or dump seen? */
-#if defined(MYMALLOC) && (defined(USE_5005THREADS) || defined(USE_ITHREADS))
+#if defined(MYMALLOC) && defined(USE_ITHREADS)
PERLVAR(Gmalloc_mutex, perl_mutex) /* Mutex for malloc */
#endif
C<u16size>, C<u16type>, C<u32size>, C<u32type>, C<u64size>, C<u64type>,
C<u8size>, C<u8type>, C<uidformat>, C<uidsign>, C<uidsize>, C<uidtype>,
-C<uname>, C<uniq>, C<uquadtype>, C<use5005threads>, C<use64bitall>,
-C<use64bitint>, C<usecrosscompile>, C<usedl>, C<useithreads>,
-C<uselargefiles>, C<uselongdouble>, C<usemorebits>, C<usemultiplicity>,
+C<uname>, C<uniq>, C<uquadtype>, C<use64bitall>, C<use64bitint>,
+C<usecrosscompile>, C<usedl>, C<useithreads>, C<uselargefiles>,
+C<uselongdouble>, C<usemorebits>, C<usemultiplicity>,
C<usemymalloc>, C<usenm>, C<useopcode>, C<useperlio>, C<useposix>,
C<usereentrant>, C<usesfio>, C<useshrplib>, C<usesocks>, C<usethreads>,
C<usevendorprefix>, C<usevfork>, C<usrinc>, C<uuname>, C<uvoformat>,
#endif
}
else if (gimme != G_ARRAY)
-#ifdef USE_5005THREADS
- ary = (AV*)PAD_SVl(0);
-#else
ary = GvAVn(PL_defgv);
-#endif /* USE_5005THREADS */
else
ary = Nullav;
if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
RETPUSHUNDEF;
}
-#ifdef USE_5005THREADS
-void
-Perl_unlock_condpair(pTHX_ void *svv)
-{
- MAGIC *mg = mg_find((SV*)svv, PERL_MAGIC_mutex);
-
- if (!mg)
- Perl_croak(aTHX_ "panic: unlock_condpair unlocking non-mutex");
- MUTEX_LOCK(MgMUTEXP(mg));
- if (MgOWNER(mg) != thr)
- Perl_croak(aTHX_ "panic: unlock_condpair unlocking mutex that we don't own");
- MgOWNER(mg) = 0;
- COND_SIGNAL(MgOWNERCONDP(mg));
- DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": unlock 0x%"UVxf"\n",
- PTR2UV(thr), PTR2UV(svv)));
- MUTEX_UNLOCK(MgMUTEXP(mg));
-}
-#endif /* USE_5005THREADS */
-
PP(pp_lock)
{
dSP;
PP(pp_threadsv)
{
-#ifdef USE_5005THREADS
- dSP;
- EXTEND(SP, 1);
- if (PL_op->op_private & OPpLVAL_INTRO)
- PUSHs(*save_threadsv(PL_op->op_targ));
- else
- PUSHs(THREADSV(PL_op->op_targ));
- RETURN;
-#else
DIE(aTHX_ "tried to access per-thread data in non-threaded perl");
-#endif /* USE_5005THREADS */
}
*
*/
-#ifdef USE_5005THREADS
-#define ARGS thr
-#define dARGS struct perl_thread *thr;
-#else
-#define ARGS
-#define dARGS
-#endif /* USE_5005THREADS */
-
#define PP(s) OP * Perl_##s(pTHX)
/*
tmpstr = POPs;
/* prevent recompiling under /o and ithreads. */
-#if defined(USE_ITHREADS) || defined(USE_5005THREADS)
+#if defined(USE_ITHREADS)
if (pm->op_pmflags & PMf_KEEP && PM_GETRE(pm))
RETURN;
#endif
/* XXX runtime compiled output needs to move to the pad */
if (pm->op_pmflags & PMf_KEEP) {
pm->op_private &= ~OPpRUNTIME; /* no point compiling again */
-#if !defined(USE_ITHREADS) && !defined(USE_5005THREADS)
+#if !defined(USE_ITHREADS)
/* XXX can't change the optree at runtime either */
cLOGOP->op_first->op_next = PL_op->op_next;
#endif
ENTER;
SAVETMPS;
-#ifdef USE_5005THREADS
- if (PL_op->op_flags & OPf_SPECIAL) {
- svp = &THREADSV(PL_op->op_targ); /* per-thread variable */
- SAVEGENERICSV(*svp);
- *svp = NEWSV(0,0);
- }
- else
-#endif /* USE_5005THREADS */
if (PL_op->op_targ) {
#ifndef USE_ITHREADS
svp = &PAD_SVl(PL_op->op_targ); /* "my" variable */
EXTEND(PL_stack_sp, items); /* @_ could have been extended. */
Copy(AvARRAY(av), PL_stack_sp, items, SV*);
PL_stack_sp += items;
-#ifndef USE_5005THREADS
SvREFCNT_dec(GvAV(PL_defgv));
GvAV(PL_defgv) = cx->blk_sub.savearray;
-#endif /* USE_5005THREADS */
/* abandon @_ if it got reified */
if (AvREAL(av)) {
(void)sv_2mortal((SV*)av); /* delay until return */
}
else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
AV* av;
-#ifdef USE_5005THREADS
- av = (AV*)PAD_SVl(0);
-#else
av = GvAV(PL_defgv);
-#endif
items = AvFILLp(av) + 1;
PL_stack_sp++;
EXTEND(PL_stack_sp, items); /* @_ could have been extended. */
sub_crush_depth(cv);
pad_push(padlist, CvDEPTH(cv), cx->blk_sub.hasargs);
}
-#ifdef USE_5005THREADS
- if (!cx->blk_sub.hasargs) {
- AV* av = (AV*)PAD_SVl(0);
-
- items = AvFILLp(av) + 1;
- if (items) {
- /* Mark is at the end of the stack. */
- EXTEND(SP, items);
- Copy(AvARRAY(av), SP + 1, items, SV*);
- SP += items;
- PUTBACK ;
- }
- }
-#endif /* USE_5005THREADS */
PAD_SET_CUR(padlist, CvDEPTH(cv));
-#ifndef USE_5005THREADS
if (cx->blk_sub.hasargs)
-#endif /* USE_5005THREADS */
{
AV* av = (AV*)PAD_SVl(0);
SV** ary;
-#ifndef USE_5005THREADS
cx->blk_sub.savearray = GvAV(PL_defgv);
GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
-#endif /* USE_5005THREADS */
CX_CURPAD_SAVE(cx->blk_sub);
cx->blk_sub.argarray = av;
++mark;
assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
cxstack[cxstack_ix].blk_eval.cv = PL_compcv;
-#ifdef USE_5005THREADS
- CvOWNER(PL_compcv) = 0;
- New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
- MUTEX_INIT(CvMUTEXP(PL_compcv));
-#endif /* USE_5005THREADS */
-
/* set up a scratch pad */
CvPADLIST(PL_compcv) = pad_new(padnew_SAVE);
Perl_croak(aTHX_ "%sCompilation failed in regexp",
(*msg ? msg : "Unknown error\n"));
}
-#ifdef USE_5005THREADS
- MUTEX_LOCK(&PL_eval_mutex);
- PL_eval_owner = 0;
- COND_SIGNAL(&PL_eval_cond);
- MUTEX_UNLOCK(&PL_eval_mutex);
-#endif /* USE_5005THREADS */
RETPUSHUNDEF;
}
CopLINE_set(&PL_compiling, 0);
SP = PL_stack_base + POPMARK; /* pop original mark */
PL_op = saveop; /* The caller may need it. */
PL_lex_state = LEX_NOTPARSING; /* $^S needs this. */
-#ifdef USE_5005THREADS
- MUTEX_LOCK(&PL_eval_mutex);
- PL_eval_owner = 0;
- COND_SIGNAL(&PL_eval_cond);
- MUTEX_UNLOCK(&PL_eval_mutex);
-#endif /* USE_5005THREADS */
RETURNOP(PL_eval_start);
}
CopLINE_set(&PL_compiling, 0);
PUTBACK;
-#ifdef USE_5005THREADS
- MUTEX_LOCK(&PL_eval_mutex);
- if (PL_eval_owner && PL_eval_owner != thr)
- while (PL_eval_owner)
- COND_WAIT(&PL_eval_cond, &PL_eval_mutex);
- PL_eval_owner = thr;
- MUTEX_UNLOCK(&PL_eval_mutex);
-#endif /* USE_5005THREADS */
/* Store and reset encoding. */
encoding = PL_encoding;
if (PERLDB_LINE && PL_curstash != PL_debstash)
save_lines(CopFILEAV(&PL_compiling), PL_linestr);
PUTBACK;
-#ifdef USE_5005THREADS
- MUTEX_LOCK(&PL_eval_mutex);
- if (PL_eval_owner && PL_eval_owner != thr)
- while (PL_eval_owner)
- COND_WAIT(&PL_eval_cond, &PL_eval_mutex);
- PL_eval_owner = thr;
- MUTEX_UNLOCK(&PL_eval_mutex);
-#endif /* USE_5005THREADS */
ret = doeval(gimme, NULL);
if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined here. */
&& ret != PL_op->op_next) { /* Successive compilation. */
/* Hot code. */
-#ifdef USE_5005THREADS
-static void unset_cvowner(pTHX_ void *cvarg);
-#endif /* USE_5005THREADS */
-
PP(pp_const)
{
dSP;
STRLEN maxlen;
char *max = SvPV((SV*)av, maxlen);
if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
-#ifndef USE_5005THREADS /* don't risk potential race */
if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
/* safe to reuse old SV */
sv_setsv(*itersvp, cur);
}
else
-#endif
{
/* we need a fresh SV every time so that loop body sees a
* completely new SV for closures/references to work as
if (cx->blk_loop.iterix > cx->blk_loop.itermax)
RETPUSHNO;
-#ifndef USE_5005THREADS /* don't risk potential race */
+ /* don't risk potential race */
if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
/* safe to reuse old SV */
sv_setiv(*itersvp, cx->blk_loop.iterix++);
}
else
-#endif
{
/* we need a fresh SV every time so that loop body sees a
* completely new SV for closures/references to work as they
DIE(aTHX_ "No DBsub routine");
}
-#ifdef USE_5005THREADS
- /*
- * First we need to check if the sub or method requires locking.
- * If so, we gain a lock on the CV, the first argument or the
- * stash (for static methods), as appropriate. This has to be
- * inline because for FAKE_THREADS, COND_WAIT inlines code to
- * reschedule by returning a new op.
- */
- MUTEX_LOCK(CvMUTEXP(cv));
- if (CvFLAGS(cv) & CVf_LOCKED) {
- MAGIC *mg;
- if (CvFLAGS(cv) & CVf_METHOD) {
- if (SP > PL_stack_base + TOPMARK)
- sv = *(PL_stack_base + TOPMARK + 1);
- else {
- AV *av = (AV*)PAD_SVl(0);
- if (hasargs || !av || AvFILLp(av) < 0
- || !(sv = AvARRAY(av)[0]))
- {
- MUTEX_UNLOCK(CvMUTEXP(cv));
- DIE(aTHX_ "no argument for locked method call");
- }
- }
- if (SvROK(sv))
- sv = SvRV(sv);
- else {
- STRLEN len;
- char *stashname = SvPV(sv, len);
- sv = (SV*)gv_stashpvn(stashname, len, TRUE);
- }
- }
- else {
- sv = (SV*)cv;
- }
- MUTEX_UNLOCK(CvMUTEXP(cv));
- mg = condpair_magic(sv);
- MUTEX_LOCK(MgMUTEXP(mg));
- if (MgOWNER(mg) == thr)
- MUTEX_UNLOCK(MgMUTEXP(mg));
- else {
- while (MgOWNER(mg))
- COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
- MgOWNER(mg) = thr;
- DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: pp_entersub lock %p\n",
- thr, sv));
- MUTEX_UNLOCK(MgMUTEXP(mg));
- SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
- }
- MUTEX_LOCK(CvMUTEXP(cv));
- }
- /*
- * Now we have permission to enter the sub, we must distinguish
- * four cases. (0) It's an XSUB (in which case we don't care
- * about ownership); (1) it's ours already (and we're recursing);
- * (2) it's free (but we may already be using a cached clone);
- * (3) another thread owns it. Case (1) is easy: we just use it.
- * Case (2) means we look for a clone--if we have one, use it
- * otherwise grab ownership of cv. Case (3) means we look for a
- * clone (for non-XSUBs) and have to create one if we don't
- * already have one.
- * Why look for a clone in case (2) when we could just grab
- * ownership of cv straight away? Well, we could be recursing,
- * i.e. we originally tried to enter cv while another thread
- * owned it (hence we used a clone) but it has been freed up
- * and we're now recursing into it. It may or may not be "better"
- * to use the clone but at least CvDEPTH can be trusted.
- */
- if (CvOWNER(cv) == thr || CvXSUB(cv))
- MUTEX_UNLOCK(CvMUTEXP(cv));
- else {
- /* Case (2) or (3) */
- SV **svp;
-
- /*
- * XXX Might it be better to release CvMUTEXP(cv) while we
- * do the hv_fetch? We might find someone has pinched it
- * when we look again, in which case we would be in case
- * (3) instead of (2) so we'd have to clone. Would the fact
- * that we released the mutex more quickly make up for this?
- */
- if ((svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE)))
- {
- /* We already have a clone to use */
- MUTEX_UNLOCK(CvMUTEXP(cv));
- cv = *(CV**)svp;
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "entersub: %p already has clone %p:%s\n",
- thr, cv, SvPEEK((SV*)cv)));
- CvOWNER(cv) = thr;
- SvREFCNT_inc(cv);
- if (CvDEPTH(cv) == 0)
- SAVEDESTRUCTOR_X(unset_cvowner, (void*) cv);
- }
- else {
- /* (2) => grab ownership of cv. (3) => make clone */
- if (!CvOWNER(cv)) {
- CvOWNER(cv) = thr;
- SvREFCNT_inc(cv);
- MUTEX_UNLOCK(CvMUTEXP(cv));
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "entersub: %p grabbing %p:%s in stash %s\n",
- thr, cv, SvPEEK((SV*)cv), CvSTASH(cv) ?
- HvNAME(CvSTASH(cv)) : "(none)"));
- }
- else {
- /* Make a new clone. */
- CV *clonecv;
- SvREFCNT_inc(cv); /* don't let it vanish from under us */
- MUTEX_UNLOCK(CvMUTEXP(cv));
- DEBUG_S((PerlIO_printf(Perl_debug_log,
- "entersub: %p cloning %p:%s\n",
- thr, cv, SvPEEK((SV*)cv))));
- /*
- * We're creating a new clone so there's no race
- * between the original MUTEX_UNLOCK and the
- * SvREFCNT_inc since no one will be trying to undef
- * it out from underneath us. At least, I don't think
- * there's a race...
- */
- clonecv = cv_clone(cv);
- SvREFCNT_dec(cv); /* finished with this */
- hv_store(thr->cvcache, (char*)cv, sizeof(cv), (SV*)clonecv,0);
- CvOWNER(clonecv) = thr;
- cv = clonecv;
- SvREFCNT_inc(cv);
- }
- DEBUG_S(if (CvDEPTH(cv) != 0)
- PerlIO_printf(Perl_debug_log, "depth %ld != 0\n",
- CvDEPTH(cv)));
- SAVEDESTRUCTOR_X(unset_cvowner, (void*) cv);
- }
- }
-#endif /* USE_5005THREADS */
-
if (CvXSUB(cv)) {
#ifdef PERL_XSUB_OLDSTYLE
if (CvOLDSTYLE(cv)) {
* back. This would allow popping @_ in XSUB, e.g.. XXXX */
AV* av;
I32 items;
-#ifdef USE_5005THREADS
- av = (AV*)PAD_SVl(0);
-#else
av = GvAV(PL_defgv);
-#endif /* USE_5005THREADS */
items = AvFILLp(av) + 1; /* @_ is not tieable */
if (items) {
PERL_STACK_OVERFLOW_CHECK();
pad_push(padlist, CvDEPTH(cv), 1);
}
-#ifdef USE_5005THREADS
- if (!hasargs) {
- AV* av = (AV*)PAD_SVl(0);
-
- items = AvFILLp(av) + 1;
- if (items) {
- /* Mark is at the end of the stack. */
- EXTEND(SP, items);
- Copy(AvARRAY(av), SP + 1, items, SV*);
- SP += items;
- PUTBACK ;
- }
- }
-#endif /* USE_5005THREADS */
PAD_SET_CUR(padlist, CvDEPTH(cv));
-#ifndef USE_5005THREADS
if (hasargs)
-#endif /* USE_5005THREADS */
{
AV* av;
SV** ary;
AvREAL_off(av);
AvREIFY_on(av);
}
-#ifndef USE_5005THREADS
cx->blk_sub.savearray = GvAV(PL_defgv);
GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
-#endif /* USE_5005THREADS */
CX_CURPAD_SAVE(cx->blk_sub);
cx->blk_sub.argarray = av;
++MARK;
}
return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv;
}
-
-#ifdef USE_5005THREADS
-static void
-unset_cvowner(pTHX_ void *cvarg)
-{
- register CV* cv = (CV *) cvarg;
-
- DEBUG_S((PerlIO_printf(Perl_debug_log, "%p unsetting CvOWNER of %p:%s\n",
- thr, cv, SvPEEK((SV*)cv))));
- MUTEX_LOCK(CvMUTEXP(cv));
- DEBUG_S(if (CvDEPTH(cv) != 0)
- PerlIO_printf(Perl_debug_log, "depth %ld != 0\n",
- CvDEPTH(cv)));
- assert(thr == CvOWNER(cv));
- CvOWNER(cv) = 0;
- MUTEX_UNLOCK(CvMUTEXP(cv));
- SvREFCNT_dec(cv);
-}
-#endif /* USE_5005THREADS */
PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
PL_sortstash = stash;
}
-#ifdef USE_5005THREADS
- sv_lock((SV *)PL_firstgv);
- sv_lock((SV *)PL_secondgv);
-#endif
SAVESPTR(GvSV(PL_firstgv));
SAVESPTR(GvSV(PL_secondgv));
}
/* This is mostly copied from pp_entersub */
AV *av = (AV*)PAD_SVl(0);
-#ifndef USE_5005THREADS
cx->blk_sub.savearray = GvAV(PL_defgv);
GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
-#endif /* USE_5005THREADS */
CX_CURPAD_SAVE(cx->blk_sub);
cx->blk_sub.argarray = av;
}
I32 result;
AV *av;
-#ifdef USE_5005THREADS
- av = (AV*)PAD_SVl(0);
-#else
av = GvAV(PL_defgv);
-#endif
if (AvMAX(av) < 1) {
SV** ary = AvALLOC(av);
#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
PERL_CALLCONV I32 Perl_my_chsize(pTHX_ int fd, Off_t length);
#endif
-#if defined(USE_5005THREADS)
-PERL_CALLCONV MAGIC* Perl_condpair_magic(pTHX_ SV *sv);
-#endif
PERL_CALLCONV OP* Perl_convert(pTHX_ I32 optype, I32 flags, OP* o);
PERL_CALLCONV void Perl_croak(pTHX_ const char* pat, ...) __attribute__((noreturn))
#ifdef CHECK_FORMAT
PERL_CALLCONV void Perl_fbm_compile(pTHX_ SV* sv, U32 flags);
PERL_CALLCONV char* Perl_fbm_instr(pTHX_ unsigned char* big, unsigned char* bigend, SV* littlesv, U32 flags);
PERL_CALLCONV char* Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 flags);
-#if defined(USE_5005THREADS)
-PERL_CALLCONV PADOFFSET Perl_find_threadsv(pTHX_ const char *name);
-#endif
PERL_CALLCONV OP* Perl_force_list(pTHX_ OP* arg);
PERL_CALLCONV OP* Perl_fold_constants(pTHX_ OP* arg);
PERL_CALLCONV char* Perl_form(pTHX_ const char* pat, ...)
PERL_CALLCONV int Perl_magic_getuvar(pTHX_ SV* sv, MAGIC* mg);
PERL_CALLCONV int Perl_magic_getvec(pTHX_ SV* sv, MAGIC* mg);
PERL_CALLCONV U32 Perl_magic_len(pTHX_ SV* sv, MAGIC* mg);
-#if defined(USE_5005THREADS)
-PERL_CALLCONV int Perl_magic_mutexfree(pTHX_ SV* sv, MAGIC* mg);
-#endif
PERL_CALLCONV int Perl_magic_nextpack(pTHX_ SV* sv, MAGIC* mg, SV* key);
PERL_CALLCONV U32 Perl_magic_regdata_cnt(pTHX_ SV* sv, MAGIC* mg);
PERL_CALLCONV int Perl_magic_regdatum_get(pTHX_ SV* sv, MAGIC* mg);
PERL_CALLCONV void Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust);
PERL_CALLCONV void Perl_peep(pTHX_ OP* o);
PERL_CALLCONV PerlIO* Perl_start_glob(pTHX_ SV* pattern, IO *io);
-#if defined(USE_5005THREADS)
-PERL_CALLCONV struct perl_thread* Perl_new_struct_thread(pTHX_ struct perl_thread *t);
-#endif
#if defined(USE_REENTRANT_API)
PERL_CALLCONV void Perl_reentrant_size(pTHX);
PERL_CALLCONV void Perl_reentrant_init(pTHX);
#if defined(UNLINK_ALL_VERSIONS)
PERL_CALLCONV I32 Perl_unlnk(pTHX_ char* f);
#endif
-#if defined(USE_5005THREADS)
-PERL_CALLCONV void Perl_unlock_condpair(pTHX_ void* svv);
-#endif
PERL_CALLCONV I32 Perl_unpack_str(pTHX_ char *pat, char *patend, char *s, char *strbeg, char *strend, char **new_s, I32 ocnt, U32 flags);
PERL_CALLCONV void Perl_unsharepvn(pTHX_ const char* sv, I32 len, U32 hash);
PERL_CALLCONV void Perl_unshare_hek(pTHX_ HEK* hek);
#endif
PERL_CALLCONV int Perl_runops_standard(pTHX);
PERL_CALLCONV int Perl_runops_debug(pTHX);
-#if defined(USE_5005THREADS)
-PERL_CALLCONV SV* Perl_sv_lock(pTHX_ SV *sv);
-#endif
PERL_CALLCONV void Perl_sv_catpvf_mg(pTHX_ SV *sv, const char* pat, ...)
#ifdef CHECK_FORMAT
__attribute__((format(printf,pTHX_2,pTHX_3)))
STATIC void* S_vcall_body(pTHX_ va_list args);
STATIC void* S_vcall_list_body(pTHX_ va_list args);
#endif
-# if defined(USE_5005THREADS)
-STATIC struct perl_thread * S_init_main_thread(pTHX);
-# endif
#endif
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
SV **
Perl_save_threadsv(pTHX_ PADOFFSET i)
{
-#ifdef USE_5005THREADS
- SV **svp = &THREADSV(i); /* XXX Change to save by offset */
- DEBUG_S(PerlIO_printf(Perl_debug_log, "save_threadsv %"UVuf": %p %p:%s\n",
- (UV)i, svp, *svp, SvPEEK(*svp)));
- save_svref(svp);
- return svp;
-#else
Perl_croak(aTHX_ "panic: save_threadsv called in non-threaded perl");
return 0;
-#endif /* USE_5005THREADS */
}
void
case PERL_MAGIC_dbline:
vtable = &PL_vtbl_dbline;
break;
-#ifdef USE_5005THREADS
- case PERL_MAGIC_mutex:
- vtable = &PL_vtbl_mutex;
- break;
-#endif /* USE_5005THREADS */
#ifdef USE_LOCALE_COLLATE
case PERL_MAGIC_collxfrm:
vtable = &PL_vtbl_collxfrm;
#if defined(USE_ITHREADS)
-#if defined(USE_5005THREADS)
-# include "error: USE_5005THREADS and USE_ITHREADS are incompatible"
-#endif
-
#ifndef GpREFCNT_inc
# define GpREFCNT_inc(gp) ((gp) ? (++(gp)->gp_refcnt, (gp)) : (GP*)NULL)
#endif
#define SvFLAGS(sv) (sv)->sv_flags
#define SvREFCNT(sv) (sv)->sv_refcnt
-#ifdef USE_5005THREADS
-
-# if defined(VMS)
-# define ATOMIC_INC(count) __ATOMIC_INCREMENT_LONG(&count)
-# define ATOMIC_DEC_AND_TEST(res,count) res=(1==__ATOMIC_DECREMENT_LONG(&count))
- # else
-# ifdef EMULATE_ATOMIC_REFCOUNTS
- # define ATOMIC_INC(count) STMT_START { \
- MUTEX_LOCK(&PL_svref_mutex); \
- ++count; \
- MUTEX_UNLOCK(&PL_svref_mutex); \
- } STMT_END
-# define ATOMIC_DEC_AND_TEST(res,count) STMT_START { \
- MUTEX_LOCK(&PL_svref_mutex); \
- res = (--count == 0); \
- MUTEX_UNLOCK(&PL_svref_mutex); \
- } STMT_END
-# else
-# define ATOMIC_INC(count) atomic_inc(&count)
-# define ATOMIC_DEC_AND_TEST(res,count) (res = atomic_dec_and_test(&count))
-# endif /* EMULATE_ATOMIC_REFCOUNTS */
-# endif /* VMS */
-#else
-# define ATOMIC_INC(count) (++count)
-# define ATOMIC_DEC_AND_TEST(res, count) (res = (--count == 0))
-#endif /* USE_5005THREADS */
+#define ATOMIC_INC(count) (++count)
+#define ATOMIC_DEC_AND_TEST(res, count) (res = (--count == 0))
#if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC)
# define SvREFCNT_inc(sv) \
nsv; \
})
#else
-# ifdef USE_5005THREADS
-# if defined(VMS) && defined(__ALPHA)
-# define SvREFCNT_inc(sv) \
- (PL_Sv=(SV*)(sv), (PL_Sv && __ATOMIC_INCREMENT_LONG(&(SvREFCNT(PL_Sv)))), (SV *)PL_Sv)
-# else
-# define SvREFCNT_inc(sv) sv_newref((SV*)sv)
-# endif
-# else
-# define SvREFCNT_inc(sv) \
+# define SvREFCNT_inc(sv) \
((PL_Sv=(SV*)(sv)), (PL_Sv && ATOMIC_INC(SvREFCNT(PL_Sv))), (SV*)PL_Sv)
-# endif
#endif
#define SvREFCNT_dec(sv) sv_free((SV*)(sv))
long xcv_depth; /* >= 2 indicates recursive call */
AV * xcv_padlist;
CV * xcv_outside;
-#ifdef USE_5005THREADS
- perl_mutex *xcv_mutexp; /* protects xcv_owner */
- struct perl_thread *xcv_owner; /* current owner thread */
-#endif /* USE_5005THREADS */
cv_flags_t xcv_flags;
IV xfm_lines;
#else /* __GNUC__ */
-# ifdef USE_5005THREADS
-# define SvIVx(sv) sv_iv(sv)
-# define SvUVx(sv) sv_uv(sv)
-# define SvNVx(sv) sv_nv(sv)
-# define SvPVx(sv, lp) sv_pvn(sv, &lp)
-# define SvPVutf8x(sv, lp) sv_pvutf8n(sv, &lp)
-# define SvPVbytex(sv, lp) sv_pvbyten(sv, &lp)
-# define SvTRUE(sv) SvTRUEx(sv)
-# define SvTRUEx(sv) sv_true(sv)
-
-# else /* USE_5005THREADS */
-
/* These inlined macros use globals, which will require a thread
* declaration in user code, so we avoid them under threads */
-# define SvIVx(sv) ((PL_Sv = (sv)), SvIV(PL_Sv))
-# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
-# define SvNVx(sv) ((PL_Sv = (sv)), SvNV(PL_Sv))
-# define SvPVx(sv, lp) ((PL_Sv = (sv)), SvPV(PL_Sv, lp))
-# define SvPVutf8x(sv, lp) ((PL_Sv = (sv)), SvPVutf8(PL_Sv, lp))
-# define SvPVbytex(sv, lp) ((PL_Sv = (sv)), SvPVbyte(PL_Sv, lp))
-# define SvTRUE(sv) ( \
+# define SvIVx(sv) ((PL_Sv = (sv)), SvIV(PL_Sv))
+# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
+# define SvNVx(sv) ((PL_Sv = (sv)), SvNV(PL_Sv))
+# define SvPVx(sv, lp) ((PL_Sv = (sv)), SvPV(PL_Sv, lp))
+# define SvPVutf8x(sv, lp) ((PL_Sv = (sv)), SvPVutf8(PL_Sv, lp))
+# define SvPVbytex(sv, lp) ((PL_Sv = (sv)), SvPVbyte(PL_Sv, lp))
+# define SvTRUE(sv) ( \
!sv \
? 0 \
: SvPOK(sv) \
: SvNOK(sv) \
? SvNVX(sv) != 0.0 \
: sv_2bool(sv) )
-# define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv))
-# endif /* USE_5005THREADS */
+# define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv))
#endif /* __GNU__ */
#define SvIsCOW(sv) ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \
/* Important ones in the first cache line (if alignment is done right) */
-#ifdef USE_5005THREADS
-PERLVAR(interp, PerlInterpreter*) /* thread owner */
-#endif
-
PERLVAR(Tstack_sp, SV **) /* top of the stack */
#ifdef OP_IN_REGISTER
PERLVAR(Topsave, OP *)
/* Note that the variables below are all explicitly referenced in the code
* as thr->whatever and therefore don't need the 'T' prefix. */
-#ifdef USE_5005THREADS
-
-PERLVAR(oursv, SV *)
-PERLVAR(cvcache, HV *)
-PERLVAR(self, perl_os_thread) /* Underlying thread object */
-PERLVAR(flags, U32)
-PERLVAR(threadsv, AV *) /* Per-thread SVs ($_, $@ etc.) */
-PERLVAR(threadsvp, SV **) /* AvARRAY(threadsv) */
-PERLVAR(specific, AV *) /* Thread-specific user data */
-PERLVAR(errsv, SV *) /* Backing SV for $@ */
-PERLVAR(mutex, perl_mutex) /* For the fields others can change */
-PERLVAR(tid, U32)
-PERLVAR(prev, struct perl_thread *)
-PERLVAR(next, struct perl_thread *)
- /* Circular linked list of threads */
-
-#ifdef HAVE_THREAD_INTERN
-PERLVAR(i, struct thread_intern)
- /* Platform-dependent internals */
-#endif
-
-PERLVAR(trailing_nul, char) /* For the sake of thrsv and oursv */
-PERLVAR(thr_done, bool) /* True when the thread has finished */
-
-#endif /* USE_5005THREADS */
-
PERLVAR(Treg_match_utf8, bool) /* was what we matched against utf8 */
*
*/
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
#if defined(VMS)
#include <builtins.h>
# define THREAD_RET_CAST(p) ((void *)(p))
#endif /* THREAD_RET */
-#if defined(USE_5005THREADS)
-
-/* Accessor for per-thread SVs */
-# define THREADSV(i) (thr->threadsvp[i])
-
-/*
- * LOCK_SV_MUTEX and UNLOCK_SV_MUTEX are performance-critical. Here, we
- * try only locking them if there may be more than one thread in existence.
- * Systems with very fast mutexes (and/or slow conditionals) may wish to
- * remove the "if (threadnum) ..." test.
- * XXX do NOT use C<if (PL_threadnum) ...> -- it sets up race conditions!
- */
-# define LOCK_SV_MUTEX MUTEX_LOCK(&PL_sv_mutex)
-# define UNLOCK_SV_MUTEX MUTEX_UNLOCK(&PL_sv_mutex)
-# define LOCK_STRTAB_MUTEX MUTEX_LOCK(&PL_strtab_mutex)
-# define UNLOCK_STRTAB_MUTEX MUTEX_UNLOCK(&PL_strtab_mutex)
-# define LOCK_CRED_MUTEX MUTEX_LOCK(&PL_cred_mutex)
-# define UNLOCK_CRED_MUTEX MUTEX_UNLOCK(&PL_cred_mutex)
-# define LOCK_FDPID_MUTEX MUTEX_LOCK(&PL_fdpid_mutex)
-# define UNLOCK_FDPID_MUTEX MUTEX_UNLOCK(&PL_fdpid_mutex)
-# define LOCK_SV_LOCK_MUTEX MUTEX_LOCK(&PL_sv_lock_mutex)
-# define UNLOCK_SV_LOCK_MUTEX MUTEX_UNLOCK(&PL_sv_lock_mutex)
-
-/* Values and macros for thr->flags */
-#define THRf_STATE_MASK 7
-#define THRf_R_JOINABLE 0
-#define THRf_R_JOINED 1
-#define THRf_R_DETACHED 2
-#define THRf_ZOMBIE 3
-#define THRf_DEAD 4
-
-#define THRf_DID_DIE 8
-
-/* ThrSTATE(t) and ThrSETSTATE(t) must only be called while holding t->mutex */
-#define ThrSTATE(t) ((t)->flags & THRf_STATE_MASK)
-#define ThrSETSTATE(t, s) STMT_START { \
- (t)->flags &= ~THRf_STATE_MASK; \
- (t)->flags |= (s); \
- DEBUG_S(PerlIO_printf(Perl_debug_log, \
- "thread %p set to state %d\n", (t), (s))); \
- } STMT_END
-
-typedef struct condpair {
- perl_mutex mutex; /* Protects all other fields */
- perl_cond owner_cond; /* For when owner changes at all */
- perl_cond cond; /* For cond_signal and cond_broadcast */
- Thread owner; /* Currently owning thread */
-} condpair_t;
-
-#define MgMUTEXP(mg) (&((condpair_t *)(mg->mg_ptr))->mutex)
-#define MgOWNERCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->owner_cond)
-#define MgCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->cond)
-#define MgOWNER(mg) ((condpair_t *)(mg->mg_ptr))->owner
-
-#endif /* USE_5005THREADS */
-#endif /* USE_5005THREADS || USE_ITHREADS */
+#endif /* USE_ITHREADS */
#ifndef MUTEX_LOCK
# define MUTEX_LOCK(m)
if (PL_lex_dojoin) {
PL_nextval[PL_nexttoke].ival = 0;
force_next(',');
-#ifdef USE_5005THREADS
- PL_nextval[PL_nexttoke].opval = newOP(OP_THREADSV, 0);
- PL_nextval[PL_nexttoke].opval->op_targ = find_threadsv("\"");
- force_next(PRIVATEREF);
-#else
force_ident("\"", '$');
-#endif /* USE_5005THREADS */
PL_nextval[PL_nexttoke].ival = 0;
force_next('$');
PL_nextval[PL_nexttoke].ival = 0;
*/
if (!strchr(PL_tokenbuf,':')) {
-#ifdef USE_5005THREADS
- /* Check for single character per-thread SVs */
- if (PL_tokenbuf[0] == '$' && PL_tokenbuf[2] == '\0'
- && !isALPHA(PL_tokenbuf[1]) /* Rule out obvious non-threadsvs */
- && (tmp = find_threadsv(&PL_tokenbuf[1])) != NOT_IN_PAD)
- {
- yylval.opval = newOP(OP_THREADSV, 0);
- yylval.opval->op_targ = tmp;
- return PRIVATEREF;
- }
-#endif /* USE_5005THREADS */
if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
/* might be an "our" variable" */
if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
PL_subline = CopLINE(PL_curcop);
CvPADLIST(PL_compcv) = pad_new(padnew_SAVE|padnew_SAVESUB);
CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outsidecv);
-#ifdef USE_5005THREADS
- CvOWNER(PL_compcv) = 0;
- New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
- MUTEX_INIT(CvMUTEXP(PL_compcv));
-#endif /* USE_5005THREADS */
return oldsavestack_ix;
}
* This symbol, if defined, indicates that Perl should be built to
* use the interpreter-based threading implementation.
*/
-/* USE_5005THREADS:
- * This symbol, if defined, indicates that Perl should be built to
- * use the 5.005-based threading implementation.
- */
/* OLD_PTHREADS_API:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-/*#define USE_5005THREADS / **/
/*#define USE_ITHREADS / **/
-#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
-#define USE_THREADS /* until src is revised*/
-#endif
/*#define OLD_PTHREADS_API / **/
/*#define USE_REENTRANT_API / **/
uidsize='4'
uidtype=int
uquadtype='uint64_t'
-use5005threads='undef'
use64bitall='undef'
use64bitint='undef'
usecrosscompile='undef'
line_mode ? "line" : "chunk",
(IV)IoLINES(GvIOp(PL_last_in_gv)));
}
-#ifdef USE_5005THREADS
- if (thr->tid)
- Perl_sv_catpvf(aTHX_ sv, " thread %ld", thr->tid);
-#endif
sv_catpv(sv, PL_dirty ? dgd : ".\n");
}
return sv;
message = SvPV(msv, msglen);
if (ckDEAD(err)) {
-#ifdef USE_5005THREADS
- DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%"UVxf" %s", PTR2UV(thr), message));
-#endif /* USE_5005THREADS */
if (PL_diehook) {
/* sv_2cv might call Perl_croak() */
SV *olddiehook = PL_diehook;
void
Perl_atfork_lock(void)
{
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
/* locks must be held in locking order (if any) */
# ifdef MYMALLOC
MUTEX_LOCK(&PL_malloc_mutex);
void
Perl_atfork_unlock(void)
{
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
/* locks must be released in same order as in atfork_lock() */
# ifdef MYMALLOC
MUTEX_UNLOCK(&PL_malloc_mutex);
{
#if defined(HAS_FORK)
Pid_t pid;
-#if (defined(USE_5005THREADS) || defined(USE_ITHREADS)) && !defined(HAS_PTHREAD_ATFORK)
+#if defined(USE_ITHREADS) && !defined(HAS_PTHREAD_ATFORK)
atfork_lock();
pid = fork();
atfork_unlock();
void *
Perl_get_context(void)
{
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
# ifdef OLD_PTHREADS_API
pthread_addr_t t;
if (pthread_getspecific(PL_thr_key, &t))
void
Perl_set_context(void *t)
{
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
# ifdef I_MACH_CTHREADS
cthread_set_data(cthread_self(), t);
# else
#endif /* !PERL_GET_CONTEXT_DEFINED */
-#ifdef USE_5005THREADS
-
-#ifdef FAKE_THREADS
-/* Very simplistic scheduler for now */
-void
-schedule(void)
-{
- thr = thr->i.next_run;
-}
-
-void
-Perl_cond_init(pTHX_ perl_cond *cp)
-{
- *cp = 0;
-}
-
-void
-Perl_cond_signal(pTHX_ perl_cond *cp)
-{
- perl_os_thread t;
- perl_cond cond = *cp;
-
- if (!cond)
- return;
- t = cond->thread;
- /* Insert t in the runnable queue just ahead of us */
- t->i.next_run = thr->i.next_run;
- thr->i.next_run->i.prev_run = t;
- t->i.prev_run = thr;
- thr->i.next_run = t;
- thr->i.wait_queue = 0;
- /* Remove from the wait queue */
- *cp = cond->next;
- Safefree(cond);
-}
-
-void
-Perl_cond_broadcast(pTHX_ perl_cond *cp)
-{
- perl_os_thread t;
- perl_cond cond, cond_next;
-
- for (cond = *cp; cond; cond = cond_next) {
- t = cond->thread;
- /* Insert t in the runnable queue just ahead of us */
- t->i.next_run = thr->i.next_run;
- thr->i.next_run->i.prev_run = t;
- t->i.prev_run = thr;
- thr->i.next_run = t;
- thr->i.wait_queue = 0;
- /* Remove from the wait queue */
- cond_next = cond->next;
- Safefree(cond);
- }
- *cp = 0;
-}
-
-void
-Perl_cond_wait(pTHX_ perl_cond *cp)
-{
- perl_cond cond;
-
- if (thr->i.next_run == thr)
- Perl_croak(aTHX_ "panic: perl_cond_wait called by last runnable thread");
-
- New(666, cond, 1, struct perl_wait_queue);
- cond->thread = thr;
- cond->next = *cp;
- *cp = cond;
- thr->i.wait_queue = cond;
- /* Remove ourselves from runnable queue */
- thr->i.next_run->i.prev_run = thr->i.prev_run;
- thr->i.prev_run->i.next_run = thr->i.next_run;
-}
-#endif /* FAKE_THREADS */
-
-MAGIC *
-Perl_condpair_magic(pTHX_ SV *sv)
-{
- MAGIC *mg;
-
- (void)SvUPGRADE(sv, SVt_PVMG);
- mg = mg_find(sv, PERL_MAGIC_mutex);
- if (!mg) {
- condpair_t *cp;
-
- New(53, cp, 1, condpair_t);
- MUTEX_INIT(&cp->mutex);
- COND_INIT(&cp->owner_cond);
- COND_INIT(&cp->cond);
- cp->owner = 0;
- LOCK_CRED_MUTEX; /* XXX need separate mutex? */
- mg = mg_find(sv, PERL_MAGIC_mutex);
- if (mg) {
- /* someone else beat us to initialising it */
- UNLOCK_CRED_MUTEX; /* XXX need separate mutex? */
- MUTEX_DESTROY(&cp->mutex);
- COND_DESTROY(&cp->owner_cond);
- COND_DESTROY(&cp->cond);
- Safefree(cp);
- }
- else {
- sv_magic(sv, Nullsv, PERL_MAGIC_mutex, 0, 0);
- mg = SvMAGIC(sv);
- mg->mg_ptr = (char *)cp;
- mg->mg_len = sizeof(cp);
- UNLOCK_CRED_MUTEX; /* XXX need separate mutex? */
- DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log,
- "%p: condpair_magic %p\n", thr, sv)));
- }
- }
- return mg;
-}
-
-SV *
-Perl_sv_lock(pTHX_ SV *osv)
-{
- MAGIC *mg;
- SV *sv = osv;
-
- LOCK_SV_LOCK_MUTEX;
- if (SvROK(sv)) {
- sv = SvRV(sv);
- }
-
- mg = condpair_magic(sv);
- MUTEX_LOCK(MgMUTEXP(mg));
- if (MgOWNER(mg) == thr)
- MUTEX_UNLOCK(MgMUTEXP(mg));
- else {
- while (MgOWNER(mg))
- COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
- MgOWNER(mg) = thr;
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "0x%"UVxf": Perl_lock lock 0x%"UVxf"\n",
- PTR2UV(thr), PTR2UV(sv)));
- MUTEX_UNLOCK(MgMUTEXP(mg));
- SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
- }
- UNLOCK_SV_LOCK_MUTEX;
- return sv;
-}
-
-/*
- * Make a new perl thread structure using t as a prototype. Some of the
- * fields for the new thread are copied from the prototype thread, t,
- * so t should not be running in perl at the time this function is
- * called. The use by ext/Thread/Thread.xs in core perl (where t is the
- * thread calling new_struct_thread) clearly satisfies this constraint.
- */
-struct perl_thread *
-Perl_new_struct_thread(pTHX_ struct perl_thread *t)
-{
-#if !defined(PERL_IMPLICIT_CONTEXT)
- struct perl_thread *thr;
-#endif
- SV *sv;
- SV **svp;
- I32 i;
-
- sv = newSVpvn("", 0);
- SvGROW(sv, sizeof(struct perl_thread) + 1);
- SvCUR_set(sv, sizeof(struct perl_thread));
- thr = (Thread) SvPVX(sv);
-#ifdef DEBUGGING
- Poison(thr, 1, struct perl_thread);
- PL_markstack = 0;
- PL_scopestack = 0;
- PL_savestack = 0;
- PL_retstack = 0;
- PL_dirty = 0;
- PL_localizing = 0;
- Zero(&PL_hv_fetch_ent_mh, 1, HE);
- PL_efloatbuf = (char*)NULL;
- PL_efloatsize = 0;
-#else
- Zero(thr, 1, struct perl_thread);
-#endif
-
- thr->oursv = sv;
- init_stacks();
-
- PL_curcop = &PL_compiling;
- thr->interp = t->interp;
- thr->cvcache = newHV();
- thr->threadsv = newAV();
- thr->specific = newAV();
- thr->errsv = newSVpvn("", 0);
- thr->flags = THRf_R_JOINABLE;
- thr->thr_done = 0;
- MUTEX_INIT(&thr->mutex);
-
- JMPENV_BOOTSTRAP;
-
- PL_in_eval = EVAL_NULL; /* ~(EVAL_INEVAL|EVAL_WARNONLY|EVAL_KEEPERR|EVAL_INREQUIRE) */
- PL_restartop = 0;
-
- PL_statname = NEWSV(66,0);
- PL_errors = newSVpvn("", 0);
- PL_maxscream = -1;
- PL_regcompp = MEMBER_TO_FPTR(Perl_pregcomp);
- PL_regexecp = MEMBER_TO_FPTR(Perl_regexec_flags);
- PL_regint_start = MEMBER_TO_FPTR(Perl_re_intuit_start);
- PL_regint_string = MEMBER_TO_FPTR(Perl_re_intuit_string);
- PL_regfree = MEMBER_TO_FPTR(Perl_pregfree);
- PL_regindent = 0;
- PL_reginterp_cnt = 0;
- PL_lastscream = Nullsv;
- PL_screamfirst = 0;
- PL_screamnext = 0;
- PL_reg_start_tmp = 0;
- PL_reg_start_tmpl = 0;
- PL_reg_poscache = Nullch;
-
- PL_peepp = MEMBER_TO_FPTR(Perl_peep);
-
- /* parent thread's data needs to be locked while we make copy */
- MUTEX_LOCK(&t->mutex);
-
-#ifdef PERL_FLEXIBLE_EXCEPTIONS
- PL_protect = t->Tprotect;
-#endif
-
- PL_curcop = t->Tcurcop; /* XXX As good a guess as any? */
- PL_defstash = t->Tdefstash; /* XXX maybe these should */
- PL_curstash = t->Tcurstash; /* always be set to main? */
-
- PL_tainted = t->Ttainted;
- PL_curpm = t->Tcurpm; /* XXX No PMOP ref count */
- PL_rs = newSVsv(t->Trs);
- PL_last_in_gv = Nullgv;
- PL_ofs_sv = t->Tofs_sv ? SvREFCNT_inc(PL_ofs_sv) : Nullsv;
- PL_defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv);
- PL_chopset = t->Tchopset;
- PL_bodytarget = newSVsv(t->Tbodytarget);
- PL_toptarget = newSVsv(t->Ttoptarget);
- if (t->Tformtarget == t->Ttoptarget)
- PL_formtarget = PL_toptarget;
- else
- PL_formtarget = PL_bodytarget;
-
- /* Initialise all per-thread SVs that the template thread used */
- svp = AvARRAY(t->threadsv);
- for (i = 0; i <= AvFILLp(t->threadsv); i++, svp++) {
- if (*svp && *svp != &PL_sv_undef) {
- SV *sv = newSVsv(*svp);
- av_store(thr->threadsv, i, sv);
- sv_magic(sv, 0, PERL_MAGIC_sv, &PL_threadsv_names[i], 1);
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "new_struct_thread: copied threadsv %"IVdf" %p->%p\n",
- (IV)i, t, thr));
- }
- }
- thr->threadsvp = AvARRAY(thr->threadsv);
-
- MUTEX_LOCK(&PL_threads_mutex);
- PL_nthreads++;
- thr->tid = ++PL_threadnum;
- thr->next = t->next;
- thr->prev = t;
- t->next = thr;
- thr->next->prev = thr;
- MUTEX_UNLOCK(&PL_threads_mutex);
-
- /* done copying parent's state */
- MUTEX_UNLOCK(&t->mutex);
-
-#ifdef HAVE_THREAD_INTERN
- Perl_init_thread_intern(thr);
-#endif /* HAVE_THREAD_INTERN */
- return thr;
-}
-#endif /* USE_5005THREADS */
-
#ifdef PERL_GLOBAL_STRUCT
struct perl_vars *
Perl_GetVars(pTHX)
case want_vtbl_uvar:
result = &PL_vtbl_uvar;
break;
-#ifdef USE_5005THREADS
- case want_vtbl_mutex:
- result = &PL_vtbl_mutex;
- break;
-#endif
case want_vtbl_defelem:
result = &PL_vtbl_defelem;
break;
$DESCRIPTOR(crtlenv,"CRTL_ENV"); $DESCRIPTOR(clisym,"CLISYM");
#if defined(PERL_IMPLICIT_CONTEXT)
pTHX = NULL;
-# if defined(USE_5005THREADS)
- /* We jump through these hoops because we can be called at */
- /* platform-specific initialization time, which is before anything is */
- /* set up--we can't even do a plain dTHX since that relies on the */
- /* interpreter structure to be initialized */
- if (PL_curinterp) {
- aTHX = PL_threadnum? THR : (struct perl_thread*)SvPVX(PL_thrsv);
- } else {
- aTHX = NULL;
- }
-# else
if (PL_curinterp) {
aTHX = PERL_GET_INTERP;
} else {
aTHX = NULL;
}
-
-# endif
#endif
if (!lnm || !eqv || idx > PERL_LNM_MAX_ALLOWED_INDEX) {
/* fully initialized, in which case either thr or PL_curcop */
/* might be bogus. We have to check, since ckWARN needs them */
/* both to be valid if running threaded */
-#if defined(USE_5005THREADS)
- if (thr && PL_curcop) {
-#endif
if (ckWARN(WARN_MISC)) {
Perl_warner(aTHX_ packWARN(WARN_MISC),"Value of CLI symbol \"%s\" too long",lnm);
}
-#if defined(USE_5005THREADS)
- } else {
- Perl_warner(aTHX_ packWARN(WARN_MISC),"Value of CLI symbol \"%s\" too long",lnm);
- }
-#endif
-
}
strncpy(eqv,eqvdsc.dsc$a_pointer,eqvlen);
}
#if defined(PERL_IMPLICIT_CONTEXT)
pTHX;
#endif
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
static perl_mutex primenv_mutex;
MUTEX_INIT(&primenv_mutex);
#endif
/* platform-specific initialization time, which is before anything is */
/* set up--we can't even do a plain dTHX since that relies on the */
/* interpreter structure to be initialized */
-#if defined(USE_5005THREADS)
- if (PL_curinterp) {
- aTHX = PL_threadnum? THR : (struct perl_thread*)SvPVX(PL_thrsv);
- } else {
- aTHX = NULL;
- }
-#else
if (PL_curinterp) {
aTHX = PERL_GET_INTERP;
} else {
aTHX = NULL;
}
#endif
-#endif
if (primed || !PL_envgv) return;
MUTEX_LOCK(&primenv_mutex);
if (tabidx) { tabvec[tabidx] = NULL; env_tables = tabvec; }
getredirection(argcp,argvp);
-#if defined(USE_5005THREADS) && ( defined(__DECC) || defined(__DECCXX) )
- {
-# include <reentrancy.h>
- (void) decc$set_reentrancy(C$C_MULTITHREAD);
- }
-#endif
return;
}
/*}}}*/
USE_PERLIO = define
#
-# WARNING! This option is deprecated and will eventually go away (enable
-# USE_ITHREADS instead).
-#
-# uncomment to enable threads-capabilities. This is incompatible with
-# USE_ITHREADS, and is only here for people who may have come to rely
-# on the experimental Thread support that was in 5.005.
-#
-#USE_5005THREADS = define
-
-#
# uncomment one of the following lines if you are using either
# Visual C++ 2.x or Visual C++ 6.x (aka Visual Studio 98)
#
PERL_MALLOC = undef
!ENDIF
-!IF "$(USE_5005THREADS)" == ""
-USE_5005THREADS = undef
-!ENDIF
-
-!IF "$(USE_5005THREADS)" == "define"
-USE_ITHREADS = undef
-!ENDIF
-
!IF "$(USE_IMP_SYS)" == "define"
PERL_MALLOC = undef
!ENDIF
USE_PERLCRT = undef
!ENDIF
-!IF "$(USE_IMP_SYS)$(USE_MULTI)$(USE_5005THREADS)" == "defineundefundef"
+!IF "$(USE_IMP_SYS)$(USE_MULTI)" == "defineundef"
USE_MULTI = define
!ENDIF
!IF "$(USE_ITHREADS)$(USE_MULTI)" == "defineundef"
USE_MULTI = define
-USE_5005THREADS = undef
!ENDIF
-!IF "$(USE_MULTI)$(USE_5005THREADS)" != "undefundef"
+!IF "$(USE_MULTI)" != "undef"
BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_CONTEXT
!ENDIF
!ENDIF
!ENDIF
-!IF "$(USE_5005THREADS)" == "define"
-ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread
-!ELSE
!IF "$(USE_MULTI)" == "define"
ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-multi
!ELSE
ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)
!ENDIF
!ENDIF
-!ENDIF
!IF "$(USE_PERLIO)" == "define"
BUILDOPT = $(BUILDOPT) -DUSE_PERLIO
"libpth=$(CCLIBDIR:"=\");$(EXTRALIBDIRS:"=\")" \
"libc=$(LIBC)" \
"make=$(MAKE_BARE)" \
- "use5005threads=$(USE_5005THREADS)" \
"useithreads=$(USE_ITHREADS)" \
- "usethreads=$(USE_5005THREADS)" \
"usemultiplicity=$(USE_MULTI)" \
"useperlio=$(USE_PERLIO)" \
"LINK_FLAGS=$(LINK_FLAGS:"=\")" \
uname='uname'
uniq='uniq'
uquadtype='unsigned __int64'
-use5005threads='undef'
use64bitall='undef'
use64bitint='undef'
usecrosscompile='undef'
uname='uname'
uniq='uniq'
uquadtype='unsigned long long'
-use5005threads='undef'
use64bitall='undef'
use64bitint='undef'
usecrosscompile='undef'
uname='uname'
uniq='uniq'
uquadtype='unsigned __int64'
-use5005threads='undef'
use64bitall='undef'
use64bitint='undef'
usecrosscompile='undef'
uname='uname'
uniq='uniq'
uquadtype='unsigned __int64'
-use5005threads='undef'
use64bitall='undef'
use64bitint='define'
usecrosscompile='undef'
* This symbol, if defined, indicates that Perl should be built to
* use the interpreter-based threading implementation.
*/
-/* USE_5005THREADS:
- * This symbol, if defined, indicates that Perl should be built to
- * use the 5.005-based threading implementation.
- */
/* OLD_PTHREADS_API:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-/*#define USE_5005THREADS /**/
#define USE_ITHREADS /**/
-#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
-#define USE_THREADS /* until src is revised*/
-#endif
/*#define OLD_PTHREADS_API /**/
/*#define USE_REENTRANT_API /**/
* This symbol, if defined, indicates that Perl should be built to
* use the interpreter-based threading implementation.
*/
-/* USE_5005THREADS:
- * This symbol, if defined, indicates that Perl should be built to
- * use the 5.005-based threading implementation.
- */
/* OLD_PTHREADS_API:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-/*#define USE_5005THREADS /**/
#define USE_ITHREADS /**/
-#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
-#define USE_THREADS /* until src is revised*/
-#endif
/*#define OLD_PTHREADS_API /**/
/*#define USE_REENTRANT_API /**/
* This symbol, if defined, indicates that Perl should be built to
* use the interpreter-based threading implementation.
*/
-/* USE_5005THREADS:
- * This symbol, if defined, indicates that Perl should be built to
- * use the 5.005-based threading implementation.
- */
/* OLD_PTHREADS_API:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-/*#define USE_5005THREADS /**/
#define USE_ITHREADS /**/
-#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
-#define USE_THREADS /* until src is revised*/
-#endif
/*#define OLD_PTHREADS_API /**/
/*#define USE_REENTRANT_API /**/
* This symbol, if defined, indicates that Perl should be built to
* use the interpreter-based threading implementation.
*/
-/* USE_5005THREADS:
- * This symbol, if defined, indicates that Perl should be built to
- * use the 5.005-based threading implementation.
- */
/* OLD_PTHREADS_API:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-/*#define USE_5005THREADS /**/
#define USE_ITHREADS /**/
-#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
-#define USE_THREADS /* until src is revised*/
-#endif
/*#define OLD_PTHREADS_API /**/
/*#define USE_REENTRANT_API /**/
my @known = sort(@dynamic,split(/\s+/,$opt{'staticext'}),@noxs);
$opt{'known_extensions'} = join(' ',@known);
-if (!$opt{'use5005threads'} || $opt{'use5005threads'} eq 'undef')
- {
- @dynamic = grep(!/Thread/,@dynamic);
- @known = grep(!/Thread/,@dynamic);
- }
+@dynamic = grep(!/Thread/,@dynamic);
+@known = grep(!/Thread/,@dynamic);
$opt{'dynamic_ext'} = join(' ',@dynamic);
$opt{'nonxs_ext'} = join(' ',@noxs);
USE_PERLIO = define
#
-# WARNING! This option is deprecated and will eventually go away (enable
-# USE_ITHREADS instead).
-#
-# uncomment to enable threads-capabilities. This is incompatible with
-# USE_ITHREADS, and is only here for people who may have come to rely
-# on the experimental Thread support that was in 5.005.
-#
-#USE_5005THREADS *= define
-
-#
# uncomment exactly one of the following
#
# Visual C++ 2.x
PERL_MALLOC *= undef
-USE_5005THREADS *= undef
-
-.IF "$(USE_5005THREADS)" == "define"
-USE_ITHREADS != undef
-.ENDIF
-
USE_MULTI *= undef
USE_ITHREADS *= undef
USE_IMP_SYS *= undef
USE_PERLIO *= undef
USE_PERLCRT *= undef
-.IF "$(USE_IMP_SYS)$(USE_MULTI)$(USE_5005THREADS)" == "defineundefundef"
+.IF "$(USE_IMP_SYS)$(USE_MULTI)" == "defineundef"
USE_MULTI != define
.ENDIF
.IF "$(USE_ITHREADS)$(USE_MULTI)" == "defineundef"
USE_MULTI != define
-USE_5005THREADS != undef
.ENDIF
-.IF "$(USE_MULTI)$(USE_5005THREADS)" != "undefundef"
+.IF "$(USE_MULTI)" != "undef"
BUILDOPT += -DPERL_IMPLICIT_CONTEXT
.ENDIF
.ENDIF
.ENDIF
-.IF "$(USE_5005THREADS)" == "define"
-ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread
-.ELIF "$(USE_MULTI)" == "define"
+.IF "$(USE_MULTI)" == "define"
ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-multi
.ELSE
.IF "$(USE_PERLIO)" == "define"
_a=$(a) ~ \
lib_ext=$(a) ~ \
static_ext=$(STATIC_EXT) ~ \
- use5005threads=$(USE_5005THREADS) ~ \
useithreads=$(USE_ITHREADS) ~ \
- usethreads=$(USE_5005THREADS) ~ \
usemultiplicity=$(USE_MULTI) ~ \
useperlio=$(USE_PERLIO) ~ \
LINK_FLAGS=$(LINK_FLAGS:s/\/\\/) ~ \
PerlIO_cleanup() was done here but fails (B).
*/
EndSockets();
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
if (PL_curinterp)
FREE_THREAD_KEY;
#endif
}
return my_perl;
#else
-#ifdef USE_5005THREADS
- return aTHX;
-#else
return PL_curinterp;
#endif
-#endif
}
if (!my_perl)
return FALSE;
-#else
-#ifdef USE_5005THREADS
- dTHX;
-#endif
#endif
switch(dwCtrlType) {
WORD Wshowwindow;
};
-#ifdef USE_5005THREADS
-# ifndef USE_DECLSPEC_THREAD
-# define HAVE_THREAD_INTERN
-# endif /* !USE_DECLSPEC_THREAD */
-#endif /* USE_5005THREADS */
-
#define HAVE_INTERP_INTERN
typedef struct {
long num;
child_tab * pseudo_children;
#endif
void * internal_host;
-#ifndef USE_5005THREADS
struct thread_intern thr_intern;
-#endif
UINT timerid;
unsigned poll_count;
Sighandler_t sigtable[SIG_SIZE];
#define w32_sighandler (PL_sys_intern.sigtable)
#define w32_poll_count (PL_sys_intern.poll_count)
#define w32_do_async (w32_poll_count++ > WIN32_POLL_INTERVAL)
-#ifdef USE_5005THREADS
-# define w32_strerror_buffer (thr->i.Wstrerror_buffer)
-# define w32_getlogin_buffer (thr->i.Wgetlogin_buffer)
-# define w32_crypt_buffer (thr->i.Wcrypt_buffer)
-# define w32_servent (thr->i.Wservent)
-# define w32_init_socktype (thr->i.Winit_socktype)
-# define w32_use_showwindow (thr->i.Wuse_showwindow)
-# define w32_showwindow (thr->i.Wshowwindow)
-#else
-# define w32_strerror_buffer (PL_sys_intern.thr_intern.Wstrerror_buffer)
-# define w32_getlogin_buffer (PL_sys_intern.thr_intern.Wgetlogin_buffer)
-# define w32_crypt_buffer (PL_sys_intern.thr_intern.Wcrypt_buffer)
-# define w32_servent (PL_sys_intern.thr_intern.Wservent)
-# define w32_init_socktype (PL_sys_intern.thr_intern.Winit_socktype)
-# define w32_use_showwindow (PL_sys_intern.thr_intern.Wuse_showwindow)
-# define w32_showwindow (PL_sys_intern.thr_intern.Wshowwindow)
-#endif /* USE_5005THREADS */
+#define w32_strerror_buffer (PL_sys_intern.thr_intern.Wstrerror_buffer)
+#define w32_getlogin_buffer (PL_sys_intern.thr_intern.Wgetlogin_buffer)
+#define w32_crypt_buffer (PL_sys_intern.thr_intern.Wcrypt_buffer)
+#define w32_servent (PL_sys_intern.thr_intern.Wservent)
+#define w32_init_socktype (PL_sys_intern.thr_intern.Winit_socktype)
+#define w32_use_showwindow (PL_sys_intern.thr_intern.Wuse_showwindow)
+#define w32_showwindow (PL_sys_intern.thr_intern.Wshowwindow)
/* UNICODE<>ANSI translation helpers */
/* Use CP_ACP when mode is ANSI */
# define TO_SOCKET(x) (x)
#endif /* USE_SOCKETS_AS_HANDLES */
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
#define StartSockets() \
STMT_START { \
if (!wsock_started) \
set_socktype(void)
{
#ifdef USE_SOCKETS_AS_HANDLES
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
dTHX;
if (!w32_init_socktype) {
#endif
*/
setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
(char *)&iSockOpt, sizeof(iSockOpt));
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
w32_init_socktype = 1;
}
#endif
void
Perl_set_context(void *t)
{
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
# ifdef USE_DECLSPEC_THREAD
Perl_current_context = t;
# else
void *
Perl_get_context(void)
{
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
# ifdef USE_DECLSPEC_THREAD
return Perl_current_context;
# else
return NULL;
#endif
}
-
-#ifdef USE_5005THREADS
-void
-Perl_init_thread_intern(struct perl_thread *athr)
-{
-#ifndef USE_DECLSPEC_THREAD
-
- /*
- * Initialize port-specific per-thread data in thr->i
- * as only things we have there are just static areas for
- * return values we don't _need_ to do anything but
- * this is good practice:
- */
- memset(&athr->i,0,sizeof(athr->i));
-
-#endif
-}
-
-void
-Perl_set_thread_self(struct perl_thread *thr)
-{
- /* Set thr->self. GetCurrentThread() retrurns a pseudo handle, need
- this to convert it into a handle another thread can use.
- */
- DuplicateHandle(GetCurrentProcess(),
- GetCurrentThread(),
- GetCurrentProcess(),
- &thr->self,
- 0,
- FALSE,
- DUPLICATE_SAME_ACCESS);
-}
-
-int
-Perl_thread_create(struct perl_thread *thr, thread_func_t *fn)
-{
- DWORD junk;
- unsigned long th;
-
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "%p: create OS thread\n", thr));
-#ifdef USE_RTL_THREAD_API
- /* See comment about USE_RTL_THREAD_API in win32thread.h */
-#if defined(__BORLANDC__)
- th = _beginthreadNT(fn, /* start address */
- 0, /* stack size */
- (void *)thr, /* parameters */
- (void *)NULL, /* security attrib */
- 0, /* creation flags */
- (unsigned long *)&junk); /* tid */
- if (th == (unsigned long)-1)
- th = 0;
-#elif defined(_MSC_VER_)
- th = _beginthreadex((void *)NULL, /* security attrib */
- 0, /* stack size */
- fn, /* start address */
- (void*)thr, /* parameters */
- 0, /* creation flags */
- (unsigned *)&junk); /* tid */
-#else /* compilers using CRTDLL.DLL only have _beginthread() */
- th = _beginthread(fn, /* start address */
- 0, /* stack size */
- (void*)thr); /* parameters */
- if (th == (unsigned long)-1)
- th = 0;
-#endif
- thr->self = (HANDLE)th;
-#else /* !USE_RTL_THREAD_API */
- thr->self = CreateThread(NULL, 0, fn, (void*)thr, 0, &junk);
-#endif /* !USE_RTL_THREAD_API */
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk));
- return thr->self ? 0 : -1;
-}
-#endif
-
#define PERL_SET_CONTEXT(t) Perl_set_context(t)
#endif
-#if defined(USE_5005THREADS)
-struct perl_thread;
-int Perl_thread_create (struct perl_thread *thr, thread_func_t *fn);
-void Perl_set_thread_self (struct perl_thread *thr);
-void Perl_init_thread_intern (struct perl_thread *t);
-
-#define SET_THREAD_SELF(thr) Perl_set_thread_self(thr)
-
-#endif /* USE_5005THREADS */
-
END_EXTERN_C
#define INIT_THREADS NOOP
PERL_MALLOC = undef
!ENDIF
-!IF "$(USE_5005THREADS)" == ""
-USE_5005THREADS = undef
-!ENDIF
-
-!IF "$(USE_5005THREADS)" == "define"
-USE_ITHREADS = undef
-!ENDIF
-
!IF "$(USE_IMP_SYS)" == "define"
PERL_MALLOC = undef
!ENDIF
USE_PERLCRT = undef
!ENDIF
-!IF "$(USE_IMP_SYS)$(USE_MULTI)$(USE_5005THREADS)" == "defineundefundef"
+!IF "$(USE_IMP_SYS)$(USE_MULTI)" == "defineundef"
USE_MULTI = define
!ENDIF
!IF "$(USE_ITHREADS)$(USE_MULTI)" == "defineundef"
USE_MULTI = define
-USE_5005THREADS = undef
!ENDIF
-!IF "$(USE_MULTI)$(USE_5005THREADS)" != "undefundef"
+!IF "$(USE_MULTI)" != "undef"
BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_CONTEXT
!ENDIF
"static_ext=$(STATIC_EXT)" \
"dynamic_ext=$(DYNAMIC_EXT)" \
"nonxs_ext=$(NONXS_EXT)" \
- "use5005threads=$(USE_5005THREADS)" \
"useithreads=$(USE_ITHREADS)" \
- "usethreads=$(USE_5005THREADS)" \
"usemultiplicity=$(USE_MULTI)" \
"useperlio=$(USE_PERLIO)" \
"LINK_FLAGS=$(LDLIBPATH) $(LINK_FLAGS) $(SUBSYS)" \
uname='uname'
uniq='uniq'
uquadtype='unsigned __int64'
-use5005threads='undef'
use64bitall='undef'
use64bitint='undef'
usedl='define'
* This symbol, if defined, indicates that Perl should be built to
* use the interpreter-based threading implementation.
*/
-/* USE_5005THREADS:
- * This symbol, if defined, indicates that Perl should be built to
- * use the 5.005-based threading implementation.
- */
/* OLD_PTHREADS_API:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-/*#define USE_5005THREADS /**/
/*#define USE_ITHREADS /**/
-#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
-#define USE_THREADS /* until src is revised*/
-#endif
/*#define OLD_PTHREADS_API /**/
/*#define USE_REENTRANT_API /**/
my @known = sort(@dynamic,split(/\s+/,$opt{'staticext'}),@noxs);
$opt{'known_extensions'} = join(' ',@known);
-if (!$opt{'use5005threads'} || $opt{'use5005threads'} eq 'undef')
- {
- @dynamic = grep(!/Thread/,@dynamic);
- @known = grep(!/Thread/,@dynamic);
- }
+@dynamic = grep(!/Thread/,@dynamic);
+@known = grep(!/Thread/,@dynamic);
$opt{'dynamic_ext'} = join(' ',@dynamic);
$opt{'nonxs_ext'} = join(' ',@noxs);
# endif
};
-#ifdef USE_5005THREADS
-# ifndef USE_DECLSPEC_THREAD
-# define HAVE_THREAD_INTERN
-# endif /* !USE_DECLSPEC_THREAD */
-#endif /* USE_5005THREADS */
-
#define HAVE_INTERP_INTERN
typedef struct {
long num;
child_tab * pseudo_children;
#endif
void * internal_host;
-#ifndef USE_5005THREADS
struct thread_intern thr_intern;
-#endif
};
#define w32_pseudo_child_pids (w32_pseudo_children->pids)
#define w32_pseudo_child_handles (w32_pseudo_children->handles)
#define w32_internal_host (PL_sys_intern.internal_host)
-#ifdef USE_5005THREADS
-# define w32_strerror_buffer (thr->i.Wstrerror_buffer)
-# define w32_getlogin_buffer (thr->i.Wgetlogin_buffer)
-# define w32_crypt_buffer (thr->i.Wcrypt_buffer)
-# define w32_servent (thr->i.Wservent)
-# define w32_init_socktype (thr->i.Winit_socktype)
-#else
-# define w32_strerror_buffer (PL_sys_intern.thr_intern.Wstrerror_buffer)
-# define w32_getlogin_buffer (PL_sys_intern.thr_intern.Wgetlogin_buffer)
-# define w32_crypt_buffer (PL_sys_intern.thr_intern.Wcrypt_buffer)
-# define w32_servent (PL_sys_intern.thr_intern.Wservent)
-# define w32_init_socktype (PL_sys_intern.thr_intern.Winit_socktype)
-#endif /* USE_5005THREADS */
+#define w32_strerror_buffer (PL_sys_intern.thr_intern.Wstrerror_buffer)
+#define w32_getlogin_buffer (PL_sys_intern.thr_intern.Wgetlogin_buffer)
+#define w32_crypt_buffer (PL_sys_intern.thr_intern.Wcrypt_buffer)
+#define w32_servent (PL_sys_intern.thr_intern.Wservent)
+#define w32_init_socktype (PL_sys_intern.thr_intern.Winit_socktype)
/* UNICODE<>ANSI translation helpers */
/* Use CP_ACP when mode is ANSI */
void
Perl_set_context(void *t)
{
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
# ifdef USE_DECLSPEC_THREAD
Perl_current_context = t;
# else
void *
Perl_get_context(void)
{
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
# ifdef USE_DECLSPEC_THREAD
return Perl_current_context;
# else
return NULL;
#endif
}
-
-#ifdef USE_5005THREADS
-void
-Perl_init_thread_intern(struct perl_thread *athr)
-{
-#ifndef USE_DECLSPEC_THREAD
-
- /*
- * Initialize port-specific per-thread data in thr->i
- * as only things we have there are just static areas for
- * return values we don't _need_ to do anything but
- * this is good practice:
- */
- memset(&athr->i,0,sizeof(athr->i));
-
-#endif
-}
-
-void
-Perl_set_thread_self(struct perl_thread *thr)
-{
- /* Set thr->self. GetCurrentThread() retrurns a pseudo handle, need
- this to convert it into a handle another thread can use.
- */
- DuplicateHandle(GetCurrentProcess(),
- GetCurrentThread(),
- GetCurrentProcess(),
- &thr->self,
- 0,
- FALSE,
- DUPLICATE_SAME_ACCESS);
-}
-
-int
-Perl_thread_create(struct perl_thread *thr, thread_func_t *fn)
-{
- DWORD junk;
- unsigned long th;
-
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "%p: create OS thread\n", thr));
-#ifdef USE_RTL_THREAD_API
- /* See comment about USE_RTL_THREAD_API in win32thread.h */
-#if defined(__BORLANDC__)
- th = _beginthreadNT(fn, /* start address */
- 0, /* stack size */
- (void *)thr, /* parameters */
- (void *)NULL, /* security attrib */
- 0, /* creation flags */
- (unsigned long *)&junk); /* tid */
- if (th == (unsigned long)-1)
- th = 0;
-#elif defined(_MSC_VER_)
- th = _beginthreadex((void *)NULL, /* security attrib */
- 0, /* stack size */
- fn, /* start address */
- (void*)thr, /* parameters */
- 0, /* creation flags */
- (unsigned *)&junk); /* tid */
-#else /* compilers using CRTDLL.DLL only have _beginthread() */
- th = _beginthread(fn, /* start address */
- 0, /* stack size */
- (void*)thr); /* parameters */
- if (th == (unsigned long)-1)
- th = 0;
-#endif
- thr->self = (HANDLE)th;
-#else /* !USE_RTL_THREAD_API */
- thr->self = CreateThread(NULL, 0, fn, (void*)thr, 0, &junk);
-#endif /* !USE_RTL_THREAD_API */
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk));
- return thr->self ? 0 : -1;
-}
-#endif
-
#define PERL_SET_CONTEXT(t) Perl_set_context(t)
#endif
-#if defined(USE_5005THREADS)
-struct perl_thread;
-int Perl_thread_create (struct perl_thread *thr, thread_func_t *fn);
-void Perl_set_thread_self (struct perl_thread *thr);
-void Perl_init_thread_intern (struct perl_thread *t);
-
-#define SET_THREAD_SELF(thr) Perl_set_thread_self(thr)
-
-#endif /* USE_5005THREADS */
-
END_EXTERN_C
#define INIT_THREADS NOOP
#define TO_SOCKET(X) (X)
-#ifdef USE_5005THREADS
-#define StartSockets() \
- STMT_START { \
- if (!wsock_started) \
- start_sockets(); \
- set_socktype(); \
- } STMT_END
-#else
#define StartSockets() \
STMT_START { \
if (!wsock_started) { \
set_socktype(); \
} \
} STMT_END
-#endif
#define EndSockets() \
STMT_START { \
projects / p5sagit/p5-mst-13.2.git / commitdiff