diff options
| -rw-r--r-- | doio.c | 4 | ||||
| -rw-r--r-- | doop.c | 6 | ||||
| -rw-r--r-- | embed.h | 14 | ||||
| -rwxr-xr-x | embed.pl | 5 | ||||
| -rw-r--r-- | global.sym | 2 | ||||
| -rw-r--r-- | gv.c | 4 | ||||
| -rw-r--r-- | makedef.pl | 2 | ||||
| -rw-r--r-- | objXSUB.h | 10 | ||||
| -rw-r--r-- | op.c | 4 | ||||
| -rwxr-xr-x | perlapi.c | 16 | ||||
| -rw-r--r-- | pp.c | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 4 | ||||
| -rw-r--r-- | pp_hot.c | 6 | ||||
| -rw-r--r-- | proto.h | 5 | ||||
| -rw-r--r-- | thread.h | 11 | ||||
| -rw-r--r-- | toke.c | 42 | ||||
| -rw-r--r-- | util.c | 19 | ||||
| -rw-r--r-- | win32/Makefile | 2 | ||||
| -rw-r--r-- | win32/win32.c | 9 |
19 files changed, 96 insertions, 71 deletions
@@ -476,13 +476,13 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, SV *sv; PerlLIO_dup2(PerlIO_fileno(fp), fd); - MUTEX_LOCK(&PL_fdpid_mutex); + LOCK_FDPID_MUTEX; sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE); (void)SvUPGRADE(sv, SVt_IV); pid = SvIVX(sv); SvIVX(sv) = 0; sv = *av_fetch(PL_fdpid,fd,TRUE); - MUTEX_UNLOCK(&PL_fdpid_mutex); + UNLOCK_FDPID_MUTEX; (void)SvUPGRADE(sv, SVt_IV); SvIVX(sv) = pid; if (!was_fdopen) @@ -23,11 +23,11 @@ #define HALF_UPGRADE(start,end) { \ - U8* new; \ + U8* newstr; \ STRLEN len; \ len = end-start; \ - new = bytes_to_utf8(start, &len); \ - Copy(new,start,len,U8*); \ + newstr = bytes_to_utf8(start, &len); \ + Copy(newstr,start,len,U8*); \ end = start + len; \ } @@ -765,6 +765,9 @@ #endif #define runops_standard Perl_runops_standard #define runops_debug Perl_runops_debug +#if defined(USE_THREADS) +#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 @@ -1132,7 +1135,6 @@ #define xstat S_xstat # endif #endif -#define lock Perl_lock #if defined(PERL_OBJECT) #endif #define ck_anoncode Perl_ck_anoncode @@ -2215,6 +2217,9 @@ #endif #define runops_standard() Perl_runops_standard(aTHX) #define runops_debug() Perl_runops_debug(aTHX) +#if defined(USE_THREADS) +#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) @@ -2577,7 +2582,6 @@ #define xstat(a) S_xstat(aTHX_ a) # endif #endif -#define lock(a) Perl_lock(aTHX_ a) #if defined(PERL_OBJECT) #endif #define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a) @@ -4337,6 +4341,10 @@ #define runops_standard Perl_runops_standard #define Perl_runops_debug CPerlObj::Perl_runops_debug #define runops_debug Perl_runops_debug +#if defined(USE_THREADS) +#define Perl_sv_lock CPerlObj::Perl_sv_lock +#define sv_lock Perl_sv_lock +#endif #define Perl_sv_catpvf_mg CPerlObj::Perl_sv_catpvf_mg #define sv_catpvf_mg Perl_sv_catpvf_mg #define Perl_sv_vcatpvf_mg CPerlObj::Perl_sv_vcatpvf_mg @@ -5000,8 +5008,6 @@ #define xstat S_xstat # endif #endif -#define Perl_lock CPerlObj::Perl_lock -#define lock Perl_lock #if defined(PERL_OBJECT) #endif #define Perl_ck_anoncode CPerlObj::Perl_ck_anoncode @@ -2106,6 +2106,9 @@ Ap |struct perl_vars *|GetVars #endif Ap |int |runops_standard Ap |int |runops_debug +#if defined(USE_THREADS) +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 @@ -2515,8 +2518,6 @@ s |void |xstat |int # endif #endif -Arp |SV* |lock |SV *sv - #if defined(PERL_OBJECT) }; #endif diff --git a/global.sym b/global.sym index 9053446da2..719e50a2f4 100644 --- a/global.sym +++ b/global.sym @@ -480,6 +480,7 @@ Perl_safexfree Perl_GetVars Perl_runops_standard Perl_runops_debug +Perl_sv_lock Perl_sv_catpvf_mg Perl_sv_vcatpvf_mg Perl_sv_catpv_mg @@ -542,4 +543,3 @@ Perl_ptr_table_fetch Perl_ptr_table_store Perl_ptr_table_split Perl_sys_intern_clear -Perl_sys_intern_init @@ -438,14 +438,14 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) ENTER; #ifdef USE_THREADS - Perl_lock(aTHX_ (SV *)varstash); + sv_lock((SV *)varstash); #endif if (!isGV(vargv)) gv_init(vargv, varstash, autoload, autolen, FALSE); LEAVE; varsv = GvSV(vargv); #ifdef USE_THREADS - Perl_lock(aTHX_ varsv); + sv_lock(varsv); #endif sv_setpv(varsv, HvNAME(stash)); sv_catpvn(varsv, "::", 2); diff --git a/makedef.pl b/makedef.pl index 108993c75d..a02a298213 100644 --- a/makedef.pl +++ b/makedef.pl @@ -421,7 +421,7 @@ unless ($define{'USE_5005THREADS'}) { Perl_find_threadsv Perl_unlock_condpair Perl_magic_mutexfree - Perl_lock + Perl_sv_lock )]; } @@ -1954,6 +1954,12 @@ #define Perl_runops_debug pPerl->Perl_runops_debug #undef runops_debug #define runops_debug Perl_runops_debug +#if defined(USE_THREADS) +#undef Perl_sv_lock +#define Perl_sv_lock pPerl->Perl_sv_lock +#undef sv_lock +#define sv_lock Perl_sv_lock +#endif #undef Perl_sv_catpvf_mg #define Perl_sv_catpvf_mg pPerl->Perl_sv_catpvf_mg #undef sv_catpvf_mg @@ -2277,10 +2283,6 @@ # if defined(LEAKTEST) # endif #endif -#undef Perl_lock -#define Perl_lock pPerl->Perl_lock -#undef lock -#define lock Perl_lock #if defined(PERL_OBJECT) #endif @@ -6265,8 +6265,8 @@ S_method_2entersub(pTHX_ OP *o, OP *o2, OP *svop) if (o2->op_type == OP_CONST) { STRLEN len; - char *package = SvPV(((SVOP*)o2)->op_sv, len); - stash = gv_stashpvn(package, len, FALSE); + char *pkg = SvPV(((SVOP*)o2)->op_sv, len); + stash = gv_stashpvn(pkg, len, FALSE); } else if (o2->op_type == OP_PADSV) { /* my Dog $spot = shift; $spot->bark */ @@ -3533,6 +3533,15 @@ Perl_runops_debug(pTHXo) { return ((CPerlObj*)pPerl)->Perl_runops_debug(); } +#if defined(USE_THREADS) + +#undef Perl_sv_lock +SV* +Perl_sv_lock(pTHXo_ SV *sv) +{ + return ((CPerlObj*)pPerl)->Perl_sv_lock(sv); +} +#endif #undef Perl_sv_catpvf_mg void @@ -4060,13 +4069,6 @@ Perl_sys_intern_init(pTHXo) # if defined(LEAKTEST) # endif #endif - -#undef Perl_lock -SV* -Perl_lock(pTHXo_ SV *sv) -{ - return ((CPerlObj*)pPerl)->Perl_lock(sv); -} #if defined(PERL_OBJECT) #endif @@ -5263,7 +5263,7 @@ PP(pp_lock) dTOPss; SV *retsv = sv; #ifdef USE_THREADS - Perl_lock(aTHX_ sv); + sv_lock(sv); #endif /* USE_THREADS */ if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV || SvTYPE(retsv) == SVt_PVCV) { @@ -892,8 +892,8 @@ PP(pp_sort) PL_sortstash = stash; } #ifdef USE_THREADS - Perl_lock(aTHX_ (SV *)PL_firstgv); - Perl_lock(aTHX_ (SV *)PL_secondgv); + sv_lock((SV *)PL_firstgv); + sv_lock((SV *)PL_secondgv); #endif SAVESPTR(GvSV(PL_firstgv)); SAVESPTR(GvSV(PL_secondgv)); @@ -145,7 +145,7 @@ PP(pp_concat) { dPOPTOPssrl; STRLEN len; - U8 *s; + char *s; bool left_utf = DO_UTF8(left); bool right_utf = DO_UTF8(right); @@ -156,7 +156,7 @@ PP(pp_concat) } else { /* Set TARG to PV(left), then add right */ - U8 *l, *c; + char *l, *c; STRLEN targlen; if (TARG == right) /* Need a safe copy elsewhere since we're just about to @@ -182,7 +182,7 @@ PP(pp_concat) /* And now copy, maybe upgrading right to UTF8 on the fly */ for (c = SvEND(TARG); *s; s++) { if (*s & 0x80 && !right_utf) - c = uv_to_utf8(c, *s); + c = (char*)uv_to_utf8((U8*)c, *s); else *c++ = *s; } @@ -865,6 +865,9 @@ 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_THREADS) +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))) @@ -1267,8 +1270,6 @@ STATIC void S_xstat(pTHX_ int); # endif #endif -PERL_CALLCONV SV* Perl_lock(pTHX_ SV *sv) __attribute__((noreturn)); - #if defined(PERL_OBJECT) }; #endif @@ -280,7 +280,8 @@ # 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) /* Values and macros for thr->flags */ #define THRf_STATE_MASK 7 @@ -376,6 +377,14 @@ typedef struct condpair { # define UNLOCK_CRED_MUTEX #endif +#ifndef LOCK_FDPID_MUTEX +# define LOCK_FDPID_MUTEX +#endif + +#ifndef UNLOCK_FDPID_MUTEX +# define UNLOCK_FDPID_MUTEX +#endif + /* THR, SET_THR, and dTHR are there for compatibility with old versions */ #ifndef THR # define THR PERL_GET_THX @@ -7391,27 +7391,6 @@ Perl_yyerror(pTHX_ char *s) } -#ifdef PERL_OBJECT -#include "XSUB.h" -#endif - -/* - * restore_rsfp - * Restore a source filter. - */ - -static void -restore_rsfp(pTHXo_ void *f) -{ - PerlIO *fp = (PerlIO*)f; - - if (PL_rsfp == PerlIO_stdin()) - PerlIO_clearerr(PL_rsfp); - else if (PL_rsfp && (PL_rsfp != fp)) - PerlIO_close(PL_rsfp); - PL_rsfp = fp; -} - STATIC char* S_swallow_bom(pTHX_ char *s) { STRLEN slen; @@ -7463,3 +7442,24 @@ S_swallow_bom(pTHX_ char *s) { } return s; } + +#ifdef PERL_OBJECT +#include "XSUB.h" +#endif + +/* + * restore_rsfp + * Restore a source filter. + */ + +static void +restore_rsfp(pTHXo_ void *f) +{ + PerlIO *fp = (PerlIO*)f; + + if (PL_rsfp == PerlIO_stdin()) + PerlIO_clearerr(PL_rsfp); + else if (PL_rsfp && (PL_rsfp != fp)) + PerlIO_close(PL_rsfp); + PL_rsfp = fp; +} @@ -2402,9 +2402,9 @@ Perl_my_popen(pTHX_ char *cmd, char *mode) PerlLIO_close(p[This]); p[This] = p[that]; } - MUTEX_LOCK(&PL_fdpid_mutex); + LOCK_FDPID_MUTEX; sv = *av_fetch(PL_fdpid,p[This],TRUE); - MUTEX_UNLOCK(&PL_fdpid_mutex); + UNLOCK_FDPID_MUTEX; (void)SvUPGRADE(sv,SVt_IV); SvIVX(sv) = pid; PL_forkprocess = pid; @@ -2622,9 +2622,9 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) int saved_win32_errno; #endif - MUTEX_LOCK(&PL_fdpid_mutex); + LOCK_FDPID_MUTEX; svp = av_fetch(PL_fdpid,PerlIO_fileno(ptr),TRUE); - MUTEX_UNLOCK(&PL_fdpid_mutex); + UNLOCK_FDPID_MUTEX; pid = SvIVX(*svp); SvREFCNT_dec(*svp); *svp = &PL_sv_undef; @@ -3497,7 +3497,7 @@ Perl_condpair_magic(pTHX_ SV *sv) } SV * -Perl_lock(pTHX_ SV *osv) +Perl_sv_lock(pTHX_ SV *osv) { MAGIC *mg; SV *sv = osv; @@ -3513,17 +3513,18 @@ Perl_lock(pTHX_ SV *osv) MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) == thr) MUTEX_UNLOCK(MgMUTEXP(mg)); - else { + 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", + 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); } - SvUNLOCK(sv); - return sv; + SvUNLOCK(sv); + return sv; } /* diff --git a/win32/Makefile b/win32/Makefile index d669516974..f5ee4c6482 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -972,6 +972,8 @@ utils: $(PERLEXE) $(X2P) copy ..\vms\perlvms.pod .\perlvms.pod copy ..\README.win32 .\perlwin32.pod $(MAKE) -f ..\win32\pod.mak converters + cd ..\lib + $(PERLEXE) lib.pm.PL cd ..\win32 $(PERLEXE) $(PL2BAT) $(UTILS) diff --git a/win32/win32.c b/win32/win32.c index a05a3fe8a6..a4e1a7938b 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -2390,9 +2390,9 @@ win32_popen(const char *command, const char *mode) /* close saved handle */ win32_close(oldfd); - MUTEX_LOCK(&PL_fdpid_mutex); + LOCK_FDPID_MUTEX; sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid); - MUTEX_UNLOCK(&PL_fdpid_mutex); + UNLOCK_FDPID_MUTEX; /* set process id so that it can be returned by perl's open() */ PL_forkprocess = childpid; @@ -2428,9 +2428,9 @@ win32_pclose(FILE *pf) int childpid, status; SV *sv; - MUTEX_LOCK(&PL_fdpid_mutex); + LOCK_FDPID_MUTEX; sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE); - MUTEX_UNLOCK(&PL_fdpid_mutex); + if (SvIOK(sv)) childpid = SvIVX(sv); else @@ -2443,6 +2443,7 @@ win32_pclose(FILE *pf) win32_fclose(pf); SvIVX(sv) = 0; + UNLOCK_FDPID_MUTEX; if (win32_waitpid(childpid, &status, 0) == -1) return -1; |