From: Gurusamy Sarathy Date: Sat, 25 Nov 2000 20:52:17 +0000 (+0000) Subject: C in pseudo-fork()ed process may diddle X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c3564e5c35b594706ecb001261b86a47fb837059;p=p5sagit%2Fp5-mst-13.2.git C in pseudo-fork()ed process may diddle parent's memory; fix it by keeping track of the actual pad offset rather than a raw pointer (this change is probably also relevant to non-ithreads case to avoid fallout from reallocs of the pad array, but is currently only enabled for the ithreads case in the interests of minimal disruption to existing "well tested" code) p4raw-id: //depot/perl@7858 --- diff --git a/embed.h b/embed.h index 1301e3e..14dcbd7 100644 --- a/embed.h +++ b/embed.h @@ -597,6 +597,7 @@ #define save_pptr Perl_save_pptr #define save_vptr Perl_save_vptr #define save_re_context Perl_save_re_context +#define save_padsv Perl_save_padsv #define save_sptr Perl_save_sptr #define save_svref Perl_save_svref #define save_threadsv Perl_save_threadsv @@ -2061,6 +2062,7 @@ #define save_pptr(a) Perl_save_pptr(aTHX_ a) #define save_vptr(a) Perl_save_vptr(aTHX_ a) #define save_re_context() Perl_save_re_context(aTHX) +#define save_padsv(a) Perl_save_padsv(aTHX_ a) #define save_sptr(a) Perl_save_sptr(aTHX_ a) #define save_svref(a) Perl_save_svref(aTHX_ a) #define save_threadsv(a) Perl_save_threadsv(aTHX_ a) @@ -4038,6 +4040,8 @@ #define save_vptr Perl_save_vptr #define Perl_save_re_context CPerlObj::Perl_save_re_context #define save_re_context Perl_save_re_context +#define Perl_save_padsv CPerlObj::Perl_save_padsv +#define save_padsv Perl_save_padsv #define Perl_save_sptr CPerlObj::Perl_save_sptr #define save_sptr Perl_save_sptr #define Perl_save_svref CPerlObj::Perl_save_svref diff --git a/embed.pl b/embed.pl index b8abef3..1d35bf6 100755 --- a/embed.pl +++ b/embed.pl @@ -1933,6 +1933,7 @@ Ap |SV* |save_scalar |GV* gv Ap |void |save_pptr |char** pptr Ap |void |save_vptr |void* pptr Ap |void |save_re_context +Ap |void |save_padsv |PADOFFSET off Ap |void |save_sptr |SV** sptr Ap |SV* |save_svref |SV** sptr Ap |SV** |save_threadsv |PADOFFSET i diff --git a/global.sym b/global.sym index c5e527b..b5c367d 100644 --- a/global.sym +++ b/global.sym @@ -358,6 +358,7 @@ Perl_save_scalar Perl_save_pptr Perl_save_vptr Perl_save_re_context +Perl_save_padsv Perl_save_sptr Perl_save_svref Perl_save_threadsv diff --git a/objXSUB.h b/objXSUB.h index 88eb400..91dc6df 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -1433,6 +1433,10 @@ #define Perl_save_re_context pPerl->Perl_save_re_context #undef save_re_context #define save_re_context Perl_save_re_context +#undef Perl_save_padsv +#define Perl_save_padsv pPerl->Perl_save_padsv +#undef save_padsv +#define save_padsv Perl_save_padsv #undef Perl_save_sptr #define Perl_save_sptr pPerl->Perl_save_sptr #undef save_sptr diff --git a/perlapi.c b/perlapi.c index a2e73e4..02c5aa3 100644 --- a/perlapi.c +++ b/perlapi.c @@ -2615,6 +2615,13 @@ Perl_save_re_context(pTHXo) ((CPerlObj*)pPerl)->Perl_save_re_context(); } +#undef Perl_save_padsv +void +Perl_save_padsv(pTHXo_ PADOFFSET off) +{ + ((CPerlObj*)pPerl)->Perl_save_padsv(off); +} + #undef Perl_save_sptr void Perl_save_sptr(pTHXo_ SV** sptr) diff --git a/pp_ctl.c b/pp_ctl.c index 2b217dd..d22f2ef 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1776,9 +1776,11 @@ PP(pp_enteriter) else #endif /* USE_THREADS */ if (PL_op->op_targ) { +#ifndef USE_ITHREADS svp = &PL_curpad[PL_op->op_targ]; /* "my" variable */ SAVESPTR(*svp); -#ifdef USE_ITHREADS +#else + SAVEPADSV(PL_op->op_targ); iterdata = (void*)PL_op->op_targ; cxtype |= CXp_PADVAR; #endif diff --git a/proto.h b/proto.h index 91b7f86..2a60195 100644 --- a/proto.h +++ b/proto.h @@ -669,6 +669,7 @@ PERL_CALLCONV SV* Perl_save_scalar(pTHX_ GV* gv); PERL_CALLCONV void Perl_save_pptr(pTHX_ char** pptr); PERL_CALLCONV void Perl_save_vptr(pTHX_ void* pptr); PERL_CALLCONV void Perl_save_re_context(pTHX); +PERL_CALLCONV void Perl_save_padsv(pTHX_ PADOFFSET off); PERL_CALLCONV void Perl_save_sptr(pTHX_ SV** sptr); PERL_CALLCONV SV* Perl_save_svref(pTHX_ SV** sptr); PERL_CALLCONV SV** Perl_save_threadsv(pTHX_ PADOFFSET i); diff --git a/scope.c b/scope.c index 7c904b4..82cd748 100644 --- a/scope.c +++ b/scope.c @@ -470,6 +470,17 @@ Perl_save_sptr(pTHX_ SV **sptr) SSPUSHINT(SAVEt_SPTR); } +void +Perl_save_padsv(pTHX_ PADOFFSET off) +{ + dTHR; + SSCHECK(4); + SSPUSHPTR(PL_curpad[off]); + SSPUSHPTR(PL_curpad); + SSPUSHLONG((long)off); + SSPUSHINT(SAVEt_PADSV); +} + SV ** Perl_save_threadsv(pTHX_ PADOFFSET i) { @@ -961,6 +972,14 @@ Perl_leave_scope(pTHX_ I32 base) else PL_curpad = Null(SV**); break; + case SAVEt_PADSV: + { + PADOFFSET off = (PADOFFSET)SSPOPLONG; + ptr = SSPOPPTR; + if (ptr) + ((SV**)ptr)[off] = (SV*)SSPOPPTR; + } + break; default: Perl_croak(aTHX_ "panic: leave_scope inconsistency"); } diff --git a/scope.h b/scope.h index 9152b39..3e05962 100644 --- a/scope.h +++ b/scope.h @@ -33,6 +33,7 @@ #define SAVEt_I8 32 #define SAVEt_COMPPAD 33 #define SAVEt_GENERIC_PVREF 34 +#define SAVEt_PADSV 35 #define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow() #define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i)) @@ -101,6 +102,7 @@ Closing bracket on a callback. See C and L. #define SAVESPTR(s) save_sptr((SV**)&(s)) #define SAVEPPTR(s) save_pptr(SOFT_CAST(char**)&(s)) #define SAVEVPTR(s) save_vptr((void*)&(s)) +#define SAVEPADSV(s) save_padsv(s) #define SAVEFREESV(s) save_freesv((SV*)(s)) #define SAVEFREEOP(o) save_freeop(SOFT_CAST(OP*)(o)) #define SAVEFREEPV(p) save_freepv(SOFT_CAST(char*)(p)) diff --git a/sv.c b/sv.c index acb0b82..35cef28 100644 --- a/sv.c +++ b/sv.c @@ -7656,6 +7656,14 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl) av = (AV*)POPPTR(ss,ix); TOPPTR(nss,ix) = av_dup(av); break; + case SAVEt_PADSV: + longval = (long)POPLONG(ss,ix); + TOPLONG(nss,ix) = longval; + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + sv = (SV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = sv_dup(sv); + break; default: Perl_croak(aTHX_ "panic: ss_dup inconsistency"); } diff --git a/t/op/fork.t b/t/op/fork.t index 93cf673..88b6b4b 100755 --- a/t/op/fork.t +++ b/t/op/fork.t @@ -184,6 +184,28 @@ child 3 [1] -2- -3- -1- -2- -3- ######## +$| = 1; +foreach my $c (1,2,3) { + if (fork) { + print "parent $c\n"; + } + else { + print "child $c\n"; + exit; + } +} +while (wait() != -1) { print "waited\n" } +EXPECT +child 1 +child 2 +child 3 +parent 1 +parent 2 +parent 3 +waited +waited +waited +######## use Config; $| = 1; $\ = "\n";