diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | NetWare/Makefile | 30 | ||||
| -rw-r--r-- | NetWare/config.wc | 1 | ||||
| -rw-r--r-- | NetWare/config_H.wc | 8 | ||||
| -rw-r--r-- | NetWare/nw5thread.c | 6 | ||||
| -rw-r--r-- | NetWare/nw5thread.h | 2 | ||||
| -rw-r--r-- | Porting/Glossary | 5 | ||||
| -rw-r--r-- | Porting/config.sh | 1 | ||||
| -rw-r--r-- | Porting/config_H | 8 | ||||
| -rw-r--r-- | config_h.SH | 8 | ||||
| -rw-r--r-- | cop.h | 8 | ||||
| -rw-r--r-- | cv.h | 8 | ||||
| -rw-r--r-- | deb.c | 7 | ||||
| -rw-r--r-- | dosish.h | 3 | ||||
| -rw-r--r-- | dump.c | 4 | ||||
| -rw-r--r-- | embed.fnc | 21 | ||||
| -rw-r--r-- | embed.h | 42 | ||||
| -rwxr-xr-x | embed.pl | 41 | ||||
| -rw-r--r-- | embedvar.h | 493 | ||||
| -rw-r--r-- | epoc/config.sh | 1 | ||||
| -rw-r--r-- | ext/B/B.xs | 8 | ||||
| -rw-r--r-- | ext/B/B/C.pm | 4 | ||||
| -rw-r--r-- | ext/B/ramblings/runtime.porting | 1 | ||||
| -rw-r--r-- | ext/B/t/lint.t | 2 | ||||
| -rw-r--r-- | ext/DynaLoader/dl_aix.xs | 30 | ||||
| -rw-r--r-- | ext/Thread/README.threads | 331 | ||||
| -rw-r--r-- | ext/Thread/Thread.xs | 499 | ||||
| -rw-r--r-- | gv.c | 15 | ||||
| -rw-r--r-- | hints/darwin.sh | 2 | ||||
| -rwxr-xr-x | installperl | 11 | ||||
| -rw-r--r-- | intrpvar.h | 31 | ||||
| -rw-r--r-- | makedef.pl | 15 | ||||
| -rw-r--r-- | mg.c | 25 | ||||
| -rw-r--r-- | miniperlmain.c | 2 | ||||
| -rw-r--r-- | myconfig.SH | 2 | ||||
| -rw-r--r-- | op.c | 152 | ||||
| -rw-r--r-- | os2/os2.c | 158 | ||||
| -rw-r--r-- | os2/os2ish.h | 107 | ||||
| -rw-r--r-- | pad.c | 27 | ||||
| -rw-r--r-- | perl.c | 134 | ||||
| -rw-r--r-- | perl.h | 122 | ||||
| -rw-r--r-- | perlvars.h | 4 | ||||
| -rw-r--r-- | pod/perltoc.pod | 6 | ||||
| -rw-r--r-- | pp.c | 33 | ||||
| -rw-r--r-- | pp.h | 8 | ||||
| -rw-r--r-- | pp_ctl.c | 70 | ||||
| -rw-r--r-- | pp_hot.c | 184 | ||||
| -rw-r--r-- | pp_sort.c | 10 | ||||
| -rw-r--r-- | proto.h | 21 | ||||
| -rw-r--r-- | scope.c | 8 | ||||
| -rw-r--r-- | sv.c | 9 | ||||
| -rw-r--r-- | sv.h | 72 | ||||
| -rw-r--r-- | thrdvar.h | 30 | ||||
| -rw-r--r-- | thread.h | 59 | ||||
| -rw-r--r-- | toke.c | 22 | ||||
| -rw-r--r-- | uconfig.h | 8 | ||||
| -rwxr-xr-x | uconfig.sh | 1 | ||||
| -rw-r--r-- | util.c | 296 | ||||
| -rw-r--r-- | vms/vms.c | 38 | ||||
| -rw-r--r-- | win32/Makefile | 29 | ||||
| -rw-r--r-- | win32/config.bc | 1 | ||||
| -rw-r--r-- | win32/config.gc | 1 | ||||
| -rw-r--r-- | win32/config.vc | 1 | ||||
| -rw-r--r-- | win32/config.vc64 | 1 | ||||
| -rw-r--r-- | win32/config_H.bc | 8 | ||||
| -rw-r--r-- | win32/config_H.gc | 8 | ||||
| -rw-r--r-- | win32/config_H.vc | 8 | ||||
| -rw-r--r-- | win32/config_H.vc64 | 8 | ||||
| -rw-r--r-- | win32/config_sh.PL | 7 | ||||
| -rw-r--r-- | win32/makefile.mk | 27 | ||||
| -rw-r--r-- | win32/perllib.c | 2 | ||||
| -rw-r--r-- | win32/win32.c | 8 | ||||
| -rw-r--r-- | win32/win32.h | 32 | ||||
| -rw-r--r-- | win32/win32sck.c | 6 | ||||
| -rw-r--r-- | win32/win32thread.c | 80 | ||||
| -rw-r--r-- | win32/win32thread.h | 10 | ||||
| -rw-r--r-- | wince/Makefile.ce | 15 | ||||
| -rw-r--r-- | wince/config.ce | 1 | ||||
| -rw-r--r-- | wince/config_H.ce | 8 | ||||
| -rw-r--r-- | wince/config_sh.PL | 7 | ||||
| -rw-r--r-- | wince/win32.h | 26 | ||||
| -rw-r--r-- | wince/win32thread.c | 80 | ||||
| -rw-r--r-- | wince/win32thread.h | 10 | ||||
| -rw-r--r-- | wince/wincesck.c | 9 |
84 files changed, 108 insertions, 3540 deletions
@@ -662,7 +662,6 @@ ext/Thread/Semaphore.pmx Threadsafe semaphore 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 diff --git a/NetWare/Makefile b/NetWare/Makefile index 9121f4f74b..e3e2a538f3 100644 --- a/NetWare/Makefile +++ b/NetWare/Makefile @@ -285,9 +285,7 @@ NW_CFG_VARS = \ "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)" \ @@ -505,15 +503,6 @@ USE_IMP_SYS = define # 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 # @@ -555,14 +544,6 @@ CRYPT_FLAG = -DHAVE_DES_FCRYPT 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 @@ -583,16 +564,15 @@ USE_IMP_SYS = undef 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 @@ -604,17 +584,13 @@ BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_SYS 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 diff --git a/NetWare/config.wc b/NetWare/config.wc index 28d22903e2..26edbb8b80 100644 --- a/NetWare/config.wc +++ b/NetWare/config.wc @@ -860,7 +860,6 @@ uidtype='uid_t' uname='uname' uniq='uniq' uquadtype='unsigned __int64' -use5005threads='undef' use64bitall='undef' use64bitint='undef' usedl='define' diff --git a/NetWare/config_H.wc b/NetWare/config_H.wc index c3a0d94555..9573a12317 100644 --- a/NetWare/config_H.wc +++ b/NetWare/config_H.wc @@ -3185,10 +3185,6 @@ * 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. @@ -3198,11 +3194,7 @@ * 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 /**/ diff --git a/NetWare/nw5thread.c b/NetWare/nw5thread.c index 7ed18bbeaf..9ff2c32605 100644 --- a/NetWare/nw5thread.c +++ b/NetWare/nw5thread.c @@ -32,7 +32,7 @@ __declspec(thread) void *PL_current_context = NULL; 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 @@ -45,7 +45,7 @@ Perl_set_context(void *t) 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 @@ -61,7 +61,7 @@ Perl_get_context(void) BOOL Remove_Thread_Ctx(void) { -#if defined(USE_5005THREADS) || defined(USE_ITHREADS) +#if defined(USE_ITHREADS) # ifdef USE_DECLSPEC_THREAD return TRUE; # else diff --git a/NetWare/nw5thread.h b/NetWare/nw5thread.h index c4e17d15cf..ad70db01fa 100644 --- a/NetWare/nw5thread.h +++ b/NetWare/nw5thread.h @@ -32,7 +32,7 @@ typedef long perl_key; // 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" { diff --git a/Porting/Glossary b/Porting/Glossary index 9cec029211..79da8e1027 100644 --- a/Porting/Glossary +++ b/Porting/Glossary @@ -4342,11 +4342,6 @@ uquadtype (quadtype.U): 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 diff --git a/Porting/config.sh b/Porting/config.sh index 8501faa29f..1c1a88a50f 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -917,7 +917,6 @@ uidtype='uid_t' uname='uname' uniq='uniq' uquadtype='unsigned long long' -use5005threads='undef' use64bitall='undef' use64bitint='undef' usecrosscompile='undef' diff --git a/Porting/config_H b/Porting/config_H index f1919a022b..e004bd6813 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -3575,10 +3575,6 @@ * 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. @@ -3588,11 +3584,7 @@ * 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 / **/ diff --git a/config_h.SH b/config_h.SH index a80675b648..05d8ec2403 100644 --- a/config_h.SH +++ b/config_h.SH @@ -3595,10 +3595,6 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un * 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. @@ -3608,11 +3604,7 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un * 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 /**/ @@ -107,9 +107,7 @@ struct block_sub { CV * cv; GV * gv; GV * dfoutgv; -#ifndef USE_5005THREADS AV * savearray; -#endif /* USE_5005THREADS */ AV * argarray; long olddepth; U8 hasargs; @@ -131,15 +129,11 @@ struct block_sub { 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) */ @@ -29,10 +29,6 @@ struct xpvcv { 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; }; @@ -68,10 +64,6 @@ Returns the stash of the CV. #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 */ @@ -47,15 +47,8 @@ Perl_vdeb(pTHX_ const char *pat, va_list *args) #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 */ } @@ -26,9 +26,6 @@ # 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 @@ -1288,10 +1288,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo 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)); @@ -106,9 +106,6 @@ Ap |UV |cast_uv |NV f #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 @@ -222,9 +219,6 @@ Apd |char* |fbm_instr |unsigned char* big|unsigned char* bigend \ |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|... @@ -392,9 +386,6 @@ p |int |magic_gettaint |SV* sv|MAGIC* mg 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 @@ -559,9 +550,6 @@ pd |void |pad_reset 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 @@ -806,9 +794,6 @@ Apd |UV |to_utf8_fold |U8 *p|U8* ustrp|STRLEN *lenp #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 @@ -863,9 +848,6 @@ Ap |struct perl_vars *|GetVars #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 @@ -1056,9 +1038,6 @@ s |void* |vrun_body |va_list args 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) @@ -68,9 +68,6 @@ #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 @@ -176,9 +173,6 @@ #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 @@ -339,9 +333,6 @@ #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 @@ -501,9 +492,6 @@ #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 @@ -725,9 +713,6 @@ #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 @@ -781,9 +766,6 @@ #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 @@ -950,9 +932,6 @@ #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 @@ -1669,9 +1648,6 @@ #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) @@ -1759,9 +1735,6 @@ #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) @@ -1920,9 +1893,6 @@ #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) @@ -2080,9 +2050,6 @@ #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) @@ -2301,9 +2268,6 @@ #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) @@ -2355,9 +2319,6 @@ #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) @@ -2520,9 +2481,6 @@ #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) @@ -519,22 +519,20 @@ print EM <<'END'; /* (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 @@ -550,18 +548,6 @@ for $sym (sort keys %thread) { 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 @@ -572,11 +558,9 @@ for $sym (sort keys %intrp) { print EM <<'END'; -# endif /* USE_5005THREADS */ - #else /* !MULTIPLICITY */ -/* cases 1 and 4 above */ +/* case 1 above */ END @@ -586,20 +570,6 @@ for $sym (sort keys %intrp) { 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) { @@ -608,7 +578,6 @@ for $sym (sort keys %thread) { print EM <<'END'; -# endif /* USE_5005THREADS */ #endif /* MULTIPLICITY */ #if defined(PERL_GLOBAL_STRUCT) diff --git a/embedvar.h b/embedvar.h index 975ff995d1..9ab91d23b2 100644 --- a/embedvar.h +++ b/embedvar.h @@ -15,22 +15,20 @@ /* (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 @@ -174,310 +172,6 @@ #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) @@ -528,13 +222,11 @@ #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) @@ -555,9 +247,6 @@ #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) @@ -566,7 +255,6 @@ #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) @@ -643,8 +331,6 @@ #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) @@ -700,28 +386,20 @@ #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) @@ -780,11 +458,9 @@ #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 @@ -834,13 +510,11 @@ #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 @@ -861,9 +535,6 @@ #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 @@ -872,7 +543,6 @@ #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 @@ -949,8 +619,6 @@ #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 @@ -1006,28 +674,20 @@ #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 @@ -1086,148 +746,6 @@ #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 @@ -1364,7 +882,6 @@ #define PL_Twatchaddr PL_watchaddr #define PL_Twatchok PL_watchok -# endif /* USE_5005THREADS */ #endif /* MULTIPLICITY */ #if defined(PERL_GLOBAL_STRUCT) diff --git a/epoc/config.sh b/epoc/config.sh index dd489a5f8f..c5d96cfa0e 100644 --- a/epoc/config.sh +++ b/epoc/config.sh @@ -936,7 +936,6 @@ d_strtoll='undef' 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' diff --git a/ext/B/B.xs b/ext/B/B.xs index 38b36ca356..f24d0705c2 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -625,14 +625,6 @@ cchar(sv) 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 diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm index 8d71bb2760..1d195a0b2a 100644 --- a/ext/B/B/C.pm +++ b/ext/B/B/C.pm @@ -1435,10 +1435,6 @@ typedef struct { 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 diff --git a/ext/B/ramblings/runtime.porting b/ext/B/ramblings/runtime.porting index 2f63a9e37c..f237cefdba 100644 --- a/ext/B/ramblings/runtime.porting +++ b/ext/B/ramblings/runtime.porting @@ -352,6 +352,5 @@ egrent getlogin syscall lock 6 1 -threadsv 6 2 unused if not USE_5005THREADS setstate 1 1 currently unused anywhere method_named 10 2 diff --git a/ext/B/t/lint.t b/ext/B/t/lint.t index 7be86acce2..2d4e680d03 100644 --- a/ext/B/t/lint.t +++ b/ext/B/t/lint.t @@ -41,7 +41,7 @@ SKIP : { 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 diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs index 47c2e78a16..43e0c0307e 100644 --- a/ext/DynaLoader/dl_aix.xs +++ b/ext/DynaLoader/dl_aix.xs @@ -179,20 +179,6 @@ char *strerrorcat(char *str, int err) { 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) @@ -200,7 +186,6 @@ char *strerrorcat(char *str, int err) { 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; } @@ -209,20 +194,6 @@ char *strerrorcpy(char *str, int err) { 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) @@ -230,7 +201,6 @@ char *strerrorcpy(char *str, int err) { msgsiz = strlen(msg); /* Note msg = buf and free() above. */ if (msgsiz < BUFSIZ) /* Do not move this after #endif. */ strcpy(str, msg); -#endif return str; } diff --git a/ext/Thread/README.threads b/ext/Thread/README.threads index 9cd0dbcb20..6e4d13344b 100644 --- a/ext/Thread/README.threads +++ b/ext/Thread/README.threads @@ -7,333 +7,7 @@ available only internally and to XS extension builders, and used 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 @@ -347,3 +21,6 @@ Gurusamy Sarathy More platforms added 26 Jul 1999 by Jarkko Hietaniemi + +Removed 5005threads support 03 Oct 2002 by +H.Merijn Brand diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index b76c0be18b..14740097f7 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -23,316 +23,25 @@ static int sig_pipe[2]; 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); @@ -369,75 +78,11 @@ join(t) 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) @@ -450,17 +95,11 @@ void 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) @@ -468,25 +107,12 @@ 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 @@ -499,138 +125,26 @@ DESTROY(t) 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 @@ -672,10 +186,3 @@ void 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 @@ -133,13 +133,6 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) 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); @@ -496,7 +489,6 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) "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 @@ -508,7 +500,6 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) SvCUR(cv) = len; return gv; } -#endif /* * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name. @@ -520,16 +511,10 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) 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); diff --git a/hints/darwin.sh b/hints/darwin.sh index abc0a7c2c9..777960e2b9 100644 --- a/hints/darwin.sh +++ b/hints/darwin.sh @@ -145,7 +145,7 @@ firstmakefile=GNUmakefile; # # Fix when Apple fixes libc. # -case "$usethreads$useithreads$use5005threads" in +case "$usethreads$useithreads" in *define*) cat <<EOM >&4 diff --git a/installperl b/installperl index ebddeca4dd..e775c9c978 100755 --- a/installperl +++ b/installperl @@ -396,17 +396,6 @@ foreach my $file (@corefiles) { } } -# 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. diff --git a/intrpvar.h b/intrpvar.h index b2807c8d73..d4f92d2074 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -226,12 +226,6 @@ PERLVAR(Ilinestart, char *) /* beg. of most recently read line */ 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 */ @@ -411,26 +405,6 @@ PERLVAR(Isrand_called, bool) 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**) @@ -451,11 +425,6 @@ PERLVAR(Iptr_table, PTR_TBL_t*) #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 */ diff --git a/makedef.pl b/makedef.pl index 86a18087dc..564ded0f76 100644 --- a/makedef.pl +++ b/makedef.pl @@ -105,7 +105,6 @@ if ($define{USE_ITHREADS}) { $define{PERL_IMPLICIT_CONTEXT} ||= $define{USE_ITHREADS} || - $define{USE_5005THREADS} || $define{MULTIPLICITY} ; if ($define{USE_ITHREADS} && $PLATFORM ne 'win32' && $^O ne 'darwin') { @@ -582,7 +581,7 @@ if ($define{'MYMALLOC'}) { Perl_strdup Perl_putenv )]; - if ($define{'USE_5005THREADS'} || $define{'USE_ITHREADS'}) { + if ($define{'USE_ITHREADS'}) { emit_symbols [qw( PL_malloc_mutex )]; @@ -602,13 +601,13 @@ else { )]; } -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 @@ -635,7 +634,6 @@ unless ($define{'USE_5005THREADS'}) { Perl_magic_mutexfree Perl_sv_lock )]; -} unless ($define{'USE_ITHREADS'}) { skip_symbols [qw( @@ -732,11 +730,6 @@ sub readvar { 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; @@ -960,7 +953,7 @@ else { 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; } @@ -872,11 +872,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) case '0': break; #endif -#ifdef USE_5005THREADS - case '@': - sv_setsv(sv, thr->errsv); - break; -#endif /* USE_5005THREADS */ } return 0; } @@ -2288,30 +2283,10 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) } 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) { diff --git a/miniperlmain.c b/miniperlmain.c index e2415d8a53..e7c74547cc 100644 --- a/miniperlmain.c +++ b/miniperlmain.c @@ -57,7 +57,7 @@ main(int argc, char **argv, char **env) 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 diff --git a/myconfig.SH b/myconfig.SH index 737c6eca7b..0fc6c5e1e7 100644 --- a/myconfig.SH +++ b/myconfig.SH @@ -33,7 +33,7 @@ Summary of my $package (revision $baserev $version_patchlevel_string) configurat 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 @@ -216,74 +216,6 @@ Perl_allocmy(pTHX_ char *name) 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 @@ -341,17 +273,8 @@ Perl_op_clear(pTHX_ OP *o) 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))) @@ -1190,12 +1113,6 @@ Perl_mod(pTHX_ OP *o, I32 type) } break; -#ifdef USE_5005THREADS - case OP_THREADSV: - PL_modcount++; /* XXX ??? */ - break; -#endif /* USE_5005THREADS */ - case OP_PUSHMARK: break; @@ -1853,13 +1770,7 @@ Perl_block_end(pTHX_ I32 floor, OP *seq) 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 @@ -1943,12 +1854,7 @@ Perl_jmaybe(pTHX_ OP *o) { 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; @@ -2732,34 +2638,18 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl) 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 || @@ -3769,12 +3659,7 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo 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); @@ -3865,14 +3750,6 @@ Perl_cv_undef(pTHX_ CV *cv) 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__ */ @@ -3882,13 +3759,8 @@ Perl_cv_undef(pTHX_ CV *cv) #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; @@ -4229,13 +4101,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) 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); @@ -4475,11 +4340,6 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) } } 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 */ @@ -5713,21 +5573,9 @@ Perl_ck_shift(pTHX_ OP *o) 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)); @@ -29,161 +29,6 @@ #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); /*****************************************************************************/ @@ -1406,9 +1251,6 @@ mod2fname(pTHX_ SV *sv) } 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. diff --git a/os2/os2ish.h b/os2/os2ish.h index 1b38b85427..20e413a837 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -99,115 +99,8 @@ # 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); @@ -152,14 +152,7 @@ Perl_pad_new(pTHX_ padnew_flags 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); @@ -528,19 +521,6 @@ Perl_pad_findmy(pTHX_ char *name) 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]) && @@ -817,10 +797,8 @@ Perl_pad_sv(pTHX_ PADOFFSET po) 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])) @@ -1314,11 +1292,6 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside) 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)); @@ -56,17 +56,7 @@ static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen); #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) { \ @@ -80,7 +70,7 @@ static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen); PERL_SET_THX(my_perl); \ } \ } STMT_END -# else +#else # define INIT_TLS_AND_INTERP \ STMT_START { \ if (!PL_curinterp) { \ @@ -89,7 +79,6 @@ static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen); PERL_SET_THX(my_perl); \ } STMT_END # endif -#endif #ifdef PERL_IMPLICIT_SYS PerlInterpreter * @@ -156,12 +145,6 @@ Initializes a new Perl interpreter. See L<perlembed>. 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; @@ -172,27 +155,6 @@ perl_construct(pTHXx) /* 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 @@ -292,9 +254,6 @@ perl_construct(pTHXx) 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); @@ -347,84 +306,12 @@ perl_destruct(pTHXx) 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 { @@ -893,23 +780,6 @@ perl_destruct(pTHXx) 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); @@ -36,17 +36,6 @@ # 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 */ @@ -69,12 +58,6 @@ # 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 @@ -96,20 +79,12 @@ /* <--- 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, @@ -361,8 +336,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); /* 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 @@ -684,18 +658,7 @@ typedef struct perl_mstats perl_mstats_t; # 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 @@ -758,15 +721,9 @@ int sockatmark(int); # 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 */ @@ -1993,19 +1950,13 @@ typedef struct clone_params CLONE_PARAMS; # 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 @@ -2040,7 +1991,7 @@ typedef pthread_key_t perl_key; # endif /* WIN32 */ # endif /* FAKE_THREADS */ #endif /* NETWARE */ -#endif /* USE_5005THREADS || USE_ITHREADS */ +#endif /* USE_ITHREADS */ #if defined(WIN32) # include "win32.h" @@ -2144,13 +2095,9 @@ typedef pthread_key_t perl_key; #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 @@ -2231,12 +2178,6 @@ union any { }; #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) @@ -2577,11 +2518,7 @@ Gid_t getegid (void); # 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) @@ -3265,9 +3202,6 @@ enum { /* pass one of these to get_vtbl */ 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 @@ -3381,9 +3315,7 @@ struct perl_vars *PL_VarsPtr; */ struct interpreter { -# ifndef USE_5005THREADS -# include "thrdvar.h" -# endif +# include "thrdvar.h" # include "intrpvar.h" /* * The following is a buffer where new variables must @@ -3398,21 +3330,7 @@ struct interpreter { }; #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 @@ -3465,9 +3383,7 @@ typedef void *Thread; #if !defined(MULTIPLICITY) START_EXTERN_C # include "intrpvar.h" -# ifndef USE_5005THREADS -# include "thrdvar.h" -# endif +# include "thrdvar.h" END_EXTERN_C #endif @@ -3557,10 +3473,6 @@ EXT MGVTBL PL_vtbl_fm = {0, MEMBER_TO_FPTR(Perl_magic_setfm), 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}; @@ -3612,10 +3524,6 @@ EXT MGVTBL PL_vtbl_fm; 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; diff --git a/perlvars.h b/perlvars.h index 6b26f0ed04..0299f8f53a 100644 --- a/perlvars.h +++ b/perlvars.h @@ -27,7 +27,7 @@ PERLVAR(Gcurinterp, PerlInterpreter *) /* 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 @@ -40,7 +40,7 @@ PERLVARIC(Gpatleave, char *, "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}") /* 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 diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 8a23663a08..078f41c527 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -10799,9 +10799,9 @@ C<ttyname_r_proto> 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>, @@ -4380,11 +4380,7 @@ PP(pp_split) #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))) { @@ -4644,25 +4640,6 @@ PP(pp_split) 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; @@ -4679,15 +4656,5 @@ PP(pp_lock) 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 */ } @@ -7,14 +7,6 @@ * */ -#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) /* @@ -73,7 +73,7 @@ PP(pp_regcomp) 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 @@ -138,7 +138,7 @@ PP(pp_regcomp) /* 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 @@ -1654,14 +1654,6 @@ PP(pp_enteriter) 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 */ @@ -2136,10 +2128,8 @@ PP(pp_goto) 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 */ @@ -2151,11 +2141,7 @@ PP(pp_goto) } 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. */ @@ -2220,32 +2206,14 @@ PP(pp_goto) 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; @@ -2693,12 +2661,6 @@ S_doeval(pTHX_ int gimme, OP** startop) 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); @@ -2765,12 +2727,6 @@ S_doeval(pTHX_ int gimme, OP** startop) 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); @@ -2807,12 +2763,6 @@ S_doeval(pTHX_ int gimme, OP** startop) 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); } @@ -3202,14 +3152,6 @@ PP(pp_require) 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; @@ -3296,14 +3238,6 @@ PP(pp_entereval) 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. */ @@ -21,10 +21,6 @@ /* Hot code. */ -#ifdef USE_5005THREADS -static void unset_cvowner(pTHX_ void *cvarg); -#endif /* USE_5005THREADS */ - PP(pp_const) { dSP; @@ -1772,13 +1768,11 @@ PP(pp_iter) 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 @@ -1798,13 +1792,12 @@ PP(pp_iter) 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 @@ -2557,140 +2550,6 @@ try_autoload: 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)) { @@ -2722,11 +2581,7 @@ try_autoload: * 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) { @@ -2777,24 +2632,8 @@ try_autoload: 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; @@ -2811,10 +2650,8 @@ try_autoload: 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; @@ -3096,22 +2933,3 @@ S_method_common(pTHX_ SV* meth, U32* hashp) } 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 */ @@ -1514,10 +1514,6 @@ PP(pp_sort) 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)); } @@ -1536,10 +1532,8 @@ PP(pp_sort) /* 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; } @@ -1612,11 +1606,7 @@ sortcv_stacked(pTHX_ SV *a, SV *b) 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); @@ -84,9 +84,6 @@ PERL_CALLCONV UV Perl_cast_uv(pTHX_ NV f); #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 @@ -260,9 +257,6 @@ PERL_CALLCONV void Perl_dump_sub(pTHX_ GV* gv); 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, ...) @@ -427,9 +421,6 @@ PERL_CALLCONV int Perl_magic_gettaint(pTHX_ SV* sv, MAGIC* mg); 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); @@ -599,9 +590,6 @@ PERL_CALLCONV void Perl_pad_reset(pTHX); 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); @@ -836,9 +824,6 @@ PERL_CALLCONV UV Perl_to_utf8_fold(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp); #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); @@ -900,9 +885,6 @@ PERL_CALLCONV struct perl_vars * Perl_GetVars(pTHX); #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))) @@ -1096,9 +1078,6 @@ STATIC void* S_vrun_body(pTHX_ va_list args); 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) @@ -469,16 +469,8 @@ Perl_save_padsv(pTHX_ PADOFFSET off) 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 @@ -4757,11 +4757,6 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam 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; @@ -8806,10 +8801,6 @@ ptr_table_* functions. #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 @@ -125,32 +125,8 @@ perform the upgrade if necessary. See C<svtype>. #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) \ @@ -161,17 +137,8 @@ perform the upgrade if necessary. See C<svtype>. 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)) @@ -350,10 +317,6 @@ struct xpvfm { 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; @@ -1028,28 +991,16 @@ otherwise. #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) \ @@ -1064,8 +1015,7 @@ otherwise. : 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)) == \ @@ -27,10 +27,6 @@ /* 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 *) @@ -246,31 +242,5 @@ PERLVAR(Twatchok, char *) /* 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 */ @@ -7,7 +7,7 @@ * */ -#if defined(USE_5005THREADS) || defined(USE_ITHREADS) +#if defined(USE_ITHREADS) #if defined(VMS) #include <builtins.h> @@ -326,62 +326,7 @@ # 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) @@ -2322,13 +2322,7 @@ Perl_yylex(pTHX) 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; @@ -5286,17 +5280,6 @@ S_pending_ident(pTHX) */ 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) { @@ -7575,11 +7558,6 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags) 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; } @@ -3559,10 +3559,6 @@ * 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. @@ -3572,11 +3568,7 @@ * 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 / **/ diff --git a/uconfig.sh b/uconfig.sh index 5a06d2e417..ef2891101a 100755 --- a/uconfig.sh +++ b/uconfig.sh @@ -669,7 +669,6 @@ uidsign='1' uidsize='4' uidtype=int uquadtype='uint64_t' -use5005threads='undef' use64bitall='undef' use64bitint='undef' usecrosscompile='undef' @@ -967,10 +967,6 @@ Perl_vmess(pTHX_ const char *pat, va_list *args) 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; @@ -1332,9 +1328,6 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) 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; @@ -2082,7 +2075,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode) 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); @@ -2095,7 +2088,7 @@ Perl_atfork_lock(void) 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); @@ -2109,7 +2102,7 @@ Perl_my_fork(void) { #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(); @@ -2802,7 +2795,7 @@ Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 f 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)) @@ -2823,7 +2816,7 @@ Perl_get_context(void) 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 @@ -2835,280 +2828,6 @@ Perl_set_context(void *t) #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) @@ -3228,11 +2947,6 @@ Perl_get_vtbl(pTHX_ int vtbl_id) 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; @@ -154,24 +154,11 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, $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) { @@ -231,18 +218,9 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, /* 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); } @@ -447,7 +425,7 @@ prime_env_iter(void) #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 @@ -457,20 +435,12 @@ prime_env_iter(void) /* 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); @@ -4521,12 +4491,6 @@ vms_image_init(int *argcp, char ***argvp) 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; } /*}}}*/ diff --git a/win32/Makefile b/win32/Makefile index 76163fa062..9cc3399f65 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -74,16 +74,6 @@ USE_IMP_SYS = define 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) # @@ -206,14 +196,6 @@ CRYPT_FLAG = -DHAVE_DES_FCRYPT 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 @@ -238,16 +220,15 @@ USE_PERLIO = undef 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 @@ -272,9 +253,6 @@ WIN64 = undef !ENDIF !ENDIF -!IF "$(USE_5005THREADS)" == "define" -ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread -!ELSE !IF "$(USE_MULTI)" == "define" ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-multi !ELSE @@ -284,7 +262,6 @@ ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-perlio ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE) !ENDIF !ENDIF -!ENDIF !IF "$(USE_PERLIO)" == "define" BUILDOPT = $(BUILDOPT) -DUSE_PERLIO @@ -787,9 +764,7 @@ CFG_VARS = \ "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:"=\")" \ diff --git a/win32/config.bc b/win32/config.bc index 42c8449f8d..7d669fffa8 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -899,7 +899,6 @@ uidtype='uid_t' uname='uname' uniq='uniq' uquadtype='unsigned __int64' -use5005threads='undef' use64bitall='undef' use64bitint='undef' usecrosscompile='undef' diff --git a/win32/config.gc b/win32/config.gc index 3c2fc0c5da..141fb542ee 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -899,7 +899,6 @@ uidtype='uid_t' uname='uname' uniq='uniq' uquadtype='unsigned long long' -use5005threads='undef' use64bitall='undef' use64bitint='undef' usecrosscompile='undef' diff --git a/win32/config.vc b/win32/config.vc index 8d94c569a4..89192be0a0 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -899,7 +899,6 @@ uidtype='uid_t' uname='uname' uniq='uniq' uquadtype='unsigned __int64' -use5005threads='undef' use64bitall='undef' use64bitint='undef' usecrosscompile='undef' diff --git a/win32/config.vc64 b/win32/config.vc64 index fbc4308b34..bc969884bb 100644 --- a/win32/config.vc64 +++ b/win32/config.vc64 @@ -899,7 +899,6 @@ uidtype='uid_t' uname='uname' uniq='uniq' uquadtype='unsigned __int64' -use5005threads='undef' use64bitall='undef' use64bitint='define' usecrosscompile='undef' diff --git a/win32/config_H.bc b/win32/config_H.bc index e89d0c81e2..f4fec85114 100644 --- a/win32/config_H.bc +++ b/win32/config_H.bc @@ -3493,10 +3493,6 @@ * 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. @@ -3506,11 +3502,7 @@ * 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 /**/ diff --git a/win32/config_H.gc b/win32/config_H.gc index 5564a417b6..2422466cc2 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -3493,10 +3493,6 @@ * 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. @@ -3506,11 +3502,7 @@ * 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 /**/ diff --git a/win32/config_H.vc b/win32/config_H.vc index f45fe40bed..8fcfb0fbfb 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -3493,10 +3493,6 @@ * 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. @@ -3506,11 +3502,7 @@ * 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 /**/ diff --git a/win32/config_H.vc64 b/win32/config_H.vc64 index dcc2592aef..5f1ff0fc8d 100644 --- a/win32/config_H.vc64 +++ b/win32/config_H.vc64 @@ -3493,10 +3493,6 @@ * 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. @@ -3506,11 +3502,7 @@ * 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 /**/ diff --git a/win32/config_sh.PL b/win32/config_sh.PL index cea5fef747..b31415d88a 100644 --- a/win32/config_sh.PL +++ b/win32/config_sh.PL @@ -49,11 +49,8 @@ my @noxs = FindExt::noxs_extensions(); 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); diff --git a/win32/makefile.mk b/win32/makefile.mk index b01923a837..59d20072b8 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -76,16 +76,6 @@ USE_IMP_SYS *= define 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 @@ -236,28 +226,21 @@ CRYPT_FLAG = -DHAVE_DES_FCRYPT 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 @@ -280,9 +263,7 @@ WIN64 = undef .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" @@ -823,9 +804,7 @@ CFG_VARS = \ _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/\/\\/) ~ \ diff --git a/win32/perllib.c b/win32/perllib.c index 4aeb7413da..f38dfa1fd6 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -261,7 +261,7 @@ DllMain(HANDLE hModule, /* DLL module handle */ 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 diff --git a/win32/win32.c b/win32/win32.c index 41788273b7..fdadcb2f6f 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -4750,12 +4750,8 @@ win32_signal_context(void) } return my_perl; #else -#ifdef USE_5005THREADS - return aTHX; -#else return PL_curinterp; #endif -#endif } @@ -4767,10 +4763,6 @@ win32_ctrlhandler(DWORD dwCtrlType) if (!my_perl) return FALSE; -#else -#ifdef USE_5005THREADS - dTHX; -#endif #endif switch(dwCtrlType) { diff --git a/win32/win32.h b/win32/win32.h index 897588544d..d1c2325026 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -368,12 +368,6 @@ struct thread_intern { 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; @@ -397,9 +391,7 @@ struct interp_intern { 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]; @@ -428,23 +420,13 @@ DllExport int win32_async_check(pTHX); #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 */ diff --git a/win32/win32sck.c b/win32/win32sck.c index 947a42a28e..cd537b3e38 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -35,7 +35,7 @@ # 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) \ @@ -100,7 +100,7 @@ void 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 @@ -110,7 +110,7 @@ set_socktype(void) */ 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 diff --git a/win32/win32thread.c b/win32/win32thread.c index 1fdd0efc02..1f327d6d41 100644 --- a/win32/win32thread.c +++ b/win32/win32thread.c @@ -8,7 +8,7 @@ __declspec(thread) void *PL_current_context = NULL; 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 @@ -22,7 +22,7 @@ Perl_set_context(void *t) 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 @@ -35,79 +35,3 @@ Perl_get_context(void) 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 - diff --git a/win32/win32thread.h b/win32/win32thread.h index a86ea61f04..8c02fa179f 100644 --- a/win32/win32thread.h +++ b/win32/win32thread.h @@ -154,16 +154,6 @@ extern __declspec(thread) void *PL_current_context; #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 diff --git a/wince/Makefile.ce b/wince/Makefile.ce index f31ed989b7..2771bcc36a 100644 --- a/wince/Makefile.ce +++ b/wince/Makefile.ce @@ -375,14 +375,6 @@ CRYPT_FLAG = -DHAVE_DES_FCRYPT 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 @@ -407,16 +399,15 @@ USE_PERLIO = undef 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 @@ -749,9 +740,7 @@ CFG_VARS = \ "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)" \ diff --git a/wince/config.ce b/wince/config.ce index a467a45112..1d7e8b3780 100644 --- a/wince/config.ce +++ b/wince/config.ce @@ -852,7 +852,6 @@ uidtype='uid_t' uname='uname' uniq='uniq' uquadtype='unsigned __int64' -use5005threads='undef' use64bitall='undef' use64bitint='undef' usedl='define' diff --git a/wince/config_H.ce b/wince/config_H.ce index b246ce69bd..aaff6d2b21 100644 --- a/wince/config_H.ce +++ b/wince/config_H.ce @@ -3493,10 +3493,6 @@ * 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. @@ -3506,11 +3502,7 @@ * 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 /**/ diff --git a/wince/config_sh.PL b/wince/config_sh.PL index 35bb6e26e3..0bcc77df5d 100644 --- a/wince/config_sh.PL +++ b/wince/config_sh.PL @@ -49,11 +49,8 @@ my @noxs = FindExt::noxs_extensions(); 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); diff --git a/wince/win32.h b/wince/win32.h index de2e628969..7d107c66ed 100644 --- a/wince/win32.h +++ b/wince/win32.h @@ -341,12 +341,6 @@ struct thread_intern { # 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; @@ -365,9 +359,7 @@ struct interp_intern { child_tab * pseudo_children; #endif void * internal_host; -#ifndef USE_5005THREADS struct thread_intern thr_intern; -#endif }; @@ -385,19 +377,11 @@ struct interp_intern { #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 */ diff --git a/wince/win32thread.c b/wince/win32thread.c index 4675822c66..141c5d68a0 100644 --- a/wince/win32thread.c +++ b/wince/win32thread.c @@ -10,7 +10,7 @@ __declspec(thread) void *PL_current_context = NULL; 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 @@ -24,7 +24,7 @@ Perl_set_context(void *t) 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 @@ -37,79 +37,3 @@ Perl_get_context(void) 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 - diff --git a/wince/win32thread.h b/wince/win32thread.h index 33e11a5c64..879819f6ab 100644 --- a/wince/win32thread.h +++ b/wince/win32thread.h @@ -156,16 +156,6 @@ extern __declspec(thread) void *PL_current_context; #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 diff --git a/wince/wincesck.c b/wince/wincesck.c index 003a250dd6..09f5dfbc2b 100644 --- a/wince/wincesck.c +++ b/wince/wincesck.c @@ -57,14 +57,6 @@ XCE_EXPORT struct protoent *xcegetprotobynumber(int number); #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) { \ @@ -72,7 +64,6 @@ XCE_EXPORT struct protoent *xcegetprotobynumber(int number); set_socktype(); \ } \ } STMT_END -#endif #define EndSockets() \ STMT_START { \ |