diff options
| -rw-r--r-- | embed.h | 6 | ||||
| -rwxr-xr-x | embed.pl | 2 | ||||
| -rw-r--r-- | iperlsys.h | 1 | ||||
| -rw-r--r-- | makedef.pl | 3 | ||||
| -rw-r--r-- | objXSUB.h | 2 | ||||
| -rw-r--r-- | perlapi.c | 2 | ||||
| -rw-r--r-- | pp.c | 18 | ||||
| -rw-r--r-- | pp_sys.c | 4 | ||||
| -rw-r--r-- | proto.h | 2 | ||||
| -rw-r--r-- | sv.c | 36 |
10 files changed, 57 insertions, 19 deletions
@@ -49,6 +49,8 @@ #else #endif #if defined(USE_ITHREADS) +# if defined(USE_IMPLICIT_SYS) +# endif #endif #if defined(MYMALLOC) #define malloced_size Perl_malloced_size @@ -1462,6 +1464,8 @@ #else #endif #if defined(USE_ITHREADS) +# if defined(USE_IMPLICIT_SYS) +# endif #endif #if defined(MYMALLOC) #define malloced_size Perl_malloced_size @@ -2848,6 +2852,8 @@ #else #endif #if defined(USE_ITHREADS) +# if defined(USE_IMPLICIT_SYS) +# endif #endif #if defined(MYMALLOC) #define malloc Perl_malloc @@ -1040,12 +1040,14 @@ jno |int |perl_parse |PerlInterpreter* interp|XSINIT_t xsinit \ |int argc|char** argv|char** env #if defined(USE_ITHREADS) jno |PerlInterpreter*|perl_clone|PerlInterpreter* interp, UV flags +# if defined(USE_IMPLICIT_SYS) jno |PerlInterpreter*|perl_clone_using|PerlInterpreter *interp|UV flags \ |struct IPerlMem* m|struct IPerlMem* ms \ |struct IPerlMem* mp|struct IPerlEnv* e \ |struct IPerlStdIO* io|struct IPerlLIO* lio \ |struct IPerlDir* d|struct IPerlSock* s \ |struct IPerlProc* p +# endif #endif #if defined(MYMALLOC) diff --git a/iperlsys.h b/iperlsys.h index 222d88bfb9..0d9f699513 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -293,6 +293,7 @@ struct IPerlStdIOInfo #include "perlsdio.h" #include "perl.h" +#define PerlIO_fdupopen(f) (f) #endif /* PERL_IMPLICIT_SYS */ diff --git a/makedef.pl b/makedef.pl index 4b1b84f31a..1d585a2e31 100644 --- a/makedef.pl +++ b/makedef.pl @@ -425,6 +425,7 @@ unless ($define{'PERL_IMPLICIT_CONTEXT'}) { unless ($define{'PERL_IMPLICIT_SYS'}) { skip_symbols [qw( perl_alloc_using + perl_clone_using )]; } @@ -747,6 +748,8 @@ __DATA__ # extra globals not included above. perl_alloc perl_alloc_using +perl_clone +perl_clone_using perl_construct perl_destruct perl_free @@ -823,6 +823,8 @@ #else #endif #if defined(USE_ITHREADS) +# if defined(USE_IMPLICIT_SYS) +# endif #endif #if defined(MYMALLOC) #endif @@ -43,6 +43,8 @@ START_EXTERN_C #else #endif #if defined(USE_ITHREADS) +# if defined(USE_IMPLICIT_SYS) +# endif #endif #if defined(MYMALLOC) #endif @@ -2261,7 +2261,7 @@ PP(pp_ucfirst) tend = uv_to_utf8(tmpbuf, uv); - if (!SvPADTMP(sv) || tend - tmpbuf != ulen) { + if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) { dTARGET; sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf); sv_catpvn(TARG, (char*)(s + ulen), slen - ulen); @@ -2273,7 +2273,7 @@ PP(pp_ucfirst) } } else { - if (!SvPADTMP(sv)) { + if (!SvPADTMP(sv) || SvREADONLY(sv)) { dTARGET; sv_setsv(TARG, sv); sv = TARG; @@ -2318,7 +2318,7 @@ PP(pp_lcfirst) tend = uv_to_utf8(tmpbuf, uv); - if (!SvPADTMP(sv) || tend - tmpbuf != ulen) { + if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) { dTARGET; sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf); sv_catpvn(TARG, (char*)(s + ulen), slen - ulen); @@ -2330,7 +2330,7 @@ PP(pp_lcfirst) } } else { - if (!SvPADTMP(sv)) { + if (!SvPADTMP(sv) || SvREADONLY(sv)) { dTARGET; sv_setsv(TARG, sv); sv = TARG; @@ -2397,7 +2397,7 @@ PP(pp_uc) } } else { - if (!SvPADTMP(sv)) { + if (!SvPADTMP(sv) || SvREADONLY(sv)) { dTARGET; sv_setsv(TARG, sv); sv = TARG; @@ -2468,7 +2468,7 @@ PP(pp_lc) } } else { - if (!SvPADTMP(sv)) { + if (!SvPADTMP(sv) || SvREADONLY(sv)) { dTARGET; sv_setsv(TARG, sv); sv = TARG; @@ -4852,9 +4852,13 @@ PP(pp_pack) * of pack() (and all copies of the result) are * gone. */ - if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) || SvPADTMP(fromstr))) + if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) + || (SvPADTMP(fromstr) + && !SvREADONLY(fromstr)))) + { Perl_warner(aTHX_ WARN_UNSAFE, "Attempt to pack pointer to temporary value"); + } if (SvPOK(fromstr) || SvNIOK(fromstr)) aptr = SvPV(fromstr,n_a); else @@ -3602,7 +3602,7 @@ PP(pp_fork) PUSHi(childpid); RETURN; #else -# if defined(USE_ITHREADS) && defined(WIN32) +# if defined(USE_ITHREADS) && defined(USE_IMPLICIT_SYS) djSP; dTARGET; Pid_t childpid; @@ -3800,7 +3800,7 @@ PP(pp_exec) #endif } -#ifdef USE_ITHREADS +#if !defined(HAS_FORK) && defined(USE_ITHREADS) && defined(USE_IMPLICIT_SYS) if (value >= 0) my_exit(value); #endif @@ -20,7 +20,9 @@ PERL_CALLCONV int perl_run(PerlInterpreter* interp); PERL_CALLCONV int perl_parse(PerlInterpreter* interp, XSINIT_t xsinit, int argc, char** argv, char** env); #if defined(USE_ITHREADS) PERL_CALLCONV PerlInterpreter* perl_clone(PerlInterpreter* interp, UV flags); +# if defined(USE_IMPLICIT_SYS) PERL_CALLCONV PerlInterpreter* perl_clone_using(PerlInterpreter *interp, UV flags, struct IPerlMem* m, struct IPerlMem* ms, struct IPerlMem* mp, struct IPerlEnv* e, struct IPerlStdIO* io, struct IPerlLIO* lio, struct IPerlDir* d, struct IPerlSock* s, struct IPerlProc* p); +# endif #endif #if defined(MYMALLOC) @@ -6526,13 +6526,23 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl) #endif PerlInterpreter * -perl_clone(PerlInterpreter *my_perl, UV flags) +perl_clone(PerlInterpreter *proto_perl, UV flags) { #ifdef PERL_OBJECT - CPerlObj *pPerl = (CPerlObj*)my_perl; + CPerlObj *pPerl = (CPerlObj*)proto_perl; #endif - return perl_clone_using(my_perl, flags, PL_Mem, PL_MemShared, PL_MemParse, - PL_Env, PL_StdIO, PL_LIO, PL_Dir, PL_Sock, PL_Proc); + +#ifdef PERL_IMPLICIT_SYS + return perl_clone_using(proto_perl, flags, + proto_perl->IMem, + proto_perl->IMemShared, + proto_perl->IMemParse, + proto_perl->IEnv, + proto_perl->IStdIO, + proto_perl->ILIO, + proto_perl->IDir, + proto_perl->ISock, + proto_perl->IProc); } PerlInterpreter * @@ -6550,23 +6560,23 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, IV i; SV *sv; SV **svp; -#ifdef PERL_OBJECT +# ifdef PERL_OBJECT CPerlObj *pPerl = new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd, ipLIO, ipD, ipS, ipP); PERL_SET_INTERP(pPerl); -#else +# else /* !PERL_OBJECT */ PerlInterpreter *my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter)); PERL_SET_INTERP(my_perl); -# ifdef DEBUGGING +# ifdef DEBUGGING memset(my_perl, 0xab, sizeof(PerlInterpreter)); PL_markstack = 0; PL_scopestack = 0; PL_savestack = 0; PL_retstack = 0; -# else +# else /* !DEBUGGING */ Zero(my_perl, 1, PerlInterpreter); -# endif +# endif /* DEBUGGING */ /* host pointers */ PL_Mem = ipM; @@ -6578,7 +6588,13 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_Dir = ipD; PL_Sock = ipS; PL_Proc = ipP; -#endif +# endif /* PERL_OBJECT */ +#else /* !PERL_IMPLICIT_SYS */ + IV i; + SV *sv; + SV **svp; + PerlInterpreter *my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter)); +#endif /* PERL_IMPLICIT_SYS */ /* arena roots */ PL_xiv_arenaroot = NULL; |