X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=f94e1bac7d5b105ffa69c7ee2f07c1dbe9146813;hb=869efde7048cf4e4bafcc463f8d4209a63e0d41a;hp=917f806c942e36e9756ecbc94140ab68ce8d6da8;hpb=e1a479c5e0c08fb10925261f03573261c69ca0dc;p=p5sagit%2Fp5-mst-13.2.git diff --git a/sv.c b/sv.c index 917f806..f94e1ba 100644 --- a/sv.c +++ b/sv.c @@ -246,8 +246,13 @@ S_new_SV(pTHX) SvREFCNT(sv) = 1; SvFLAGS(sv) = 0; sv->sv_debug_optype = PL_op ? PL_op->op_type : 0; - sv->sv_debug_line = (U16) ((PL_copline == NOLINE) ? - (PL_curcop ? CopLINE(PL_curcop) : 0) : PL_copline); + sv->sv_debug_line = (U16) (PL_parser + ? PL_parser->copline == NOLINE + ? PL_curcop + ? CopLINE(PL_curcop) + : 0 + : PL_parser->copline + : 0); sv->sv_debug_inpad = 0; sv->sv_debug_cloned = 0; sv->sv_debug_file = PL_curcop ? savepv(CopFILE(PL_curcop)): NULL; @@ -349,7 +354,7 @@ Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags) #ifdef DEBUGGING SvREFCNT(sv) = 0; #endif - /* Must always set typemask because it's awlays checked in on cleanup + /* Must always set typemask because it's always checked in on cleanup when the arenas are walked looking for objects. */ SvFLAGS(sv) = SVTYPEMASK; sv++; @@ -462,7 +467,8 @@ do_clean_named_objs(pTHX_ SV *sv) SvOBJECT(GvSV(sv))) || (GvAV(sv) && SvOBJECT(GvAV(sv))) || (GvHV(sv) && SvOBJECT(GvHV(sv))) || - (GvIO(sv) && SvOBJECT(GvIO(sv))) || + /* In certain rare cases GvIOp(sv) can be NULL, which would make SvOBJECT(GvIO(sv)) dereference NULL. */ + (GvIO(sv) ? (SvFLAGS(GvIOp(sv)) & SVs_OBJECT) : 0) || (GvCV(sv) && SvOBJECT(GvCV(sv))) ) { DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv))); @@ -780,16 +786,16 @@ are used for this, except for arena_size. For the sv-types that have no bodies, arenas are not used, so those PL_body_roots[sv_type] are unused, and can be overloaded. In something of a special case, SVt_NULL is borrowed for HE arenas; -PL_body_roots[SVt_NULL] is filled by S_more_he, but the +PL_body_roots[HE_SVSLOT=SVt_NULL] is filled by S_more_he, but the bodies_by_type[SVt_NULL] slot is not used, as the table is not -available in hv.c, +available in hv.c. -PTEs also use arenas, but are never seen in Perl_sv_upgrade. -Nonetheless, they get their own slot in bodies_by_type[SVt_NULL], so -they can just use the same allocation semantics. At first, PTEs were -also overloaded to a non-body sv-type, but this yielded hard-to-find -malloc bugs, so was simplified by claiming a new slot. This choice -has no consequence at this time. +PTEs also use arenas, but are never seen in Perl_sv_upgrade. Nonetheless, +they get their own slot in bodies_by_type[PTE_SVSLOT =SVt_IV], so they can +just use the same allocation semantics. At first, PTEs were also +overloaded to a non-body sv-type, but this yielded hard-to-find malloc +bugs, so was simplified by claiming a new slot. This choice has no +consequence at this time. */ @@ -869,7 +875,7 @@ static const struct body_details bodies_by_type[] = { FALSE, NONV, NOARENA, FIT_ARENA(0, sizeof(HE)) }, /* The bind placeholder pretends to be an RV for now. - Also it's marked as "can't upgrade" top stop anyone using it before it's + Also it's marked as "can't upgrade" to stop anyone using it before it's implemented. */ { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 }, @@ -2734,15 +2740,16 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags) const U32 isUIOK = SvIsUV(sv); char buf[TYPE_CHARS(UV)]; char *ebuf, *ptr; + STRLEN len; if (SvTYPE(sv) < SVt_PVIV) sv_upgrade(sv, SVt_PVIV); ptr = uiv_2buf(buf, SvIVX(sv), SvUVX(sv), isUIOK, &ebuf); + len = ebuf - ptr; /* inlined from sv_setpvn */ - SvGROW_mutable(sv, (STRLEN)(ebuf - ptr + 1)); - Move(ptr,SvPVX_mutable(sv),ebuf - ptr,char); - SvCUR_set(sv, ebuf - ptr); - s = SvEND(sv); + s = SvGROW_mutable(sv, len + 1); + Move(ptr, s, len, char); + s += len; *s = '\0'; } else if (SvNOKp(sv)) { @@ -3145,6 +3152,8 @@ copy-ish functions and macros use this underneath. static void S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype) { + I32 mro_changes = 0; /* 1 = method, 2 = isa */ + if (dtype != SVt_PVGV) { const char * const name = GvNAME(sstr); const STRLEN len = GvNAMELEN(sstr); @@ -3174,6 +3183,28 @@ S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype) } #endif + if(GvGP((GV*)sstr)) { + /* If source has method cache entry, clear it */ + if(GvCVGEN(sstr)) { + SvREFCNT_dec(GvCV(sstr)); + GvCV(sstr) = NULL; + GvCVGEN(sstr) = 0; + } + /* If source has a real method, then a method is + going to change */ + else if(GvCV((GV*)sstr)) { + mro_changes = 1; + } + } + + /* If dest already had a real method, that's a change as well */ + if(!mro_changes && GvGP((GV*)dstr) && GvCVu((GV*)dstr)) { + mro_changes = 1; + } + + if(strEQ(GvNAME((GV*)dstr),"ISA")) + mro_changes = 2; + gp_free((GV*)dstr); isGV_with_GP_off(dstr); (void)SvOK_off(dstr); @@ -3188,6 +3219,8 @@ S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype) GvIMPORTED_on(dstr); } GvMULTI_on(dstr); + if(mro_changes == 2) mro_isa_changed_in(GvSTASH(dstr)); + else if(mro_changes) mro_method_changed_in(GvSTASH(dstr)); return; } @@ -3237,18 +3270,18 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr) { common: if (intro) { if (stype == SVt_PVCV) { - if (GvCVGEN(dstr) && GvCV(dstr) != (CV*)sref) { + /*if (GvCVGEN(dstr) && (GvCV(dstr) != (CV*)sref || GvCVGEN(dstr))) {*/ + if (GvCVGEN(dstr)) { SvREFCNT_dec(GvCV(dstr)); GvCV(dstr) = NULL; GvCVGEN(dstr) = 0; /* Switch off cacheness. */ - mro_method_changed_in(GvSTASH(dstr)); } } SAVEGENERICSV(*location); } else dref = *location; - if (stype == SVt_PVCV && *location != sref) { + if (stype == SVt_PVCV && (*location != sref || GvCVGEN(dstr))) { CV* const cv = (CV*)*location; if (cv) { if (!GvCVGEN((GV*)dstr) && @@ -3287,7 +3320,7 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr) { } GvCVGEN(dstr) = 0; /* Switch off cacheness. */ GvASSUMECV_on(dstr); - mro_method_changed_in(GvSTASH(dstr)); /* sub foo { 1 } sub bar { 2 } *bar = \&foo */ + if(GvSTASH(dstr)) mro_method_changed_in(GvSTASH(dstr)); /* sub foo { 1 } sub bar { 2 } *bar = \&foo */ } *location = sref; if (import_flag && !(GvFLAGS(dstr) & import_flag) @@ -3590,9 +3623,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) /* and won't be needed again, potentially */ !(PL_op && PL_op->op_type == OP_AASSIGN)) #ifdef PERL_OLD_COPY_ON_WRITE - && !((sflags & CAN_COW_MASK) == CAN_COW_FLAGS - && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS - && SvTYPE(sstr) >= SVt_PVIV) + && ((flags & SV_COW_SHARED_HASH_KEYS) + ? (!((sflags & CAN_COW_MASK) == CAN_COW_FLAGS + && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS + && SvTYPE(sstr) >= SVt_PVIV)) + : 1) #endif ) { /* Failed the swipe test, and it's not a shared hash key either. @@ -3972,7 +4007,7 @@ Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags) SvCUR_set(sv, len); SvLEN_set(sv, allocate); if (!(flags & SV_HAS_TRAILING_NUL)) { - *SvEND(sv) = '\0'; + ptr[len] = '\0'; } (void)SvPOK_only_UTF8(sv); /* validate pointer */ SvTAINT(sv); @@ -5025,6 +5060,7 @@ Perl_sv_clear(pTHX_ register SV *sv) const U32 type = SvTYPE(sv); const struct body_details *const sv_type_details = bodies_by_type + type; + HV *stash; assert(sv); assert(SvREFCNT(sv) == 0); @@ -5136,13 +5172,15 @@ Perl_sv_clear(pTHX_ register SV *sv) SvREFCNT_dec(LvTARG(sv)); case SVt_PVGV: if (isGV_with_GP(sv)) { + if(GvCVu((GV*)sv) && (stash = GvSTASH((GV*)sv)) && HvNAME_get(stash)) + mro_method_changed_in(stash); gp_free((GV*)sv); if (GvNAME_HEK(sv)) unshare_hek(GvNAME_HEK(sv)); - /* If we're in a stash, we don't own a reference to it. However it does - have a back reference to us, which needs to be cleared. */ - if (!SvVALID(sv) && GvSTASH(sv)) - sv_del_backref((SV*)GvSTASH(sv), sv); + /* If we're in a stash, we don't own a reference to it. However it does + have a back reference to us, which needs to be cleared. */ + if (!SvVALID(sv) && (stash = GvSTASH(sv))) + sv_del_backref((SV*)stash, sv); } /* FIXME. There are probably more unreferenced pointers to SVs in the interpreter struct that we should check and tidy in a similar @@ -5359,7 +5397,7 @@ Perl_sv_len_utf8(pTHX_ register SV *sv) if (PL_utf8cache) { STRLEN ulen; - MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : 0; + MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL; if (mg && mg->mg_len != -1) { ulen = mg->mg_len; @@ -7021,11 +7059,11 @@ Perl_newSVhek(pTHX_ const HEK *hek) Creates a new SV with its SvPVX_const pointing to a shared string in the string table. If the string does not already exist in the table, it is created -first. Turns on READONLY and FAKE. The string's hash is stored in the UV -slot of the SV; if the C parameter is non-zero, that value is used; -otherwise the hash is computed. The idea here is that as the string table -is used for shared hash keys these strings will have SvPVX_const == HeKEY and -hash lookup will avoid string compare. +first. Turns on READONLY and FAKE. If the C parameter is non-zero, that +value is used; otherwise the hash is computed. The string's hash can be later +be retrieved from the SV with the C macro. The idea here is +that as the string table is used for shared hash keys these strings will have +SvPVX_const == HeKEY and hash lookup will avoid string compare. =cut */ @@ -7583,7 +7621,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags) SvGROW(sv, len + 1); Move(s,SvPVX(sv),len,char); SvCUR_set(sv, len); - *SvEND(sv) = '\0'; + SvPVX(sv)[len] = '\0'; } if (!SvPOK(sv)) { SvPOK_on(sv); /* validate pointer */ @@ -7949,6 +7987,7 @@ S_sv_unglob(pTHX_ SV *sv) { dVAR; void *xpvmg; + HV *stash; SV * const temp = sv_newmortal(); assert(SvTYPE(sv) == SVt_PVGV); @@ -7956,6 +7995,8 @@ S_sv_unglob(pTHX_ SV *sv) gv_efullname3(temp, (GV *) sv, "*"); if (GvGP(sv)) { + if(GvCVu((GV*)sv) && (stash = GvSTASH((GV*)sv)) && HvNAME_get(stash)) + mro_method_changed_in(stash); gp_free((GV*)sv); } if (GvSTASH(sv)) { @@ -8578,7 +8619,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV has_precis = TRUE; } argsv = (SV*)va_arg(*args, void*); - eptr = SvPVx_const(argsv, elen); + eptr = SvPV_const(argsv, elen); if (DO_UTF8(argsv)) is_utf8 = TRUE; goto string; @@ -8837,7 +8878,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV case 'c': if (vectorize) goto unknown; - uv = (args) ? va_arg(*args, int) : SvIVx(argsv); + uv = (args) ? va_arg(*args, int) : SvIV(argsv); if ((uv > 255 || (!UNI_IS_INVARIANT(uv) && SvUTF8(sv))) && !IN_BYTES) { @@ -8871,7 +8912,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV } } else { - eptr = SvPVx_const(argsv, elen); + eptr = SvPV_const(argsv, elen); if (DO_UTF8(argsv)) { I32 old_precis = precis; if (has_precis && precis < elen) { @@ -8943,7 +8984,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV } } else { - IV tiv = SvIVx(argsv); /* work around GCC bug #13488 */ + IV tiv = SvIV(argsv); /* work around GCC bug #13488 */ switch (intsize) { case 'h': iv = (short)tiv; break; case 'l': iv = (long)tiv; break; @@ -9028,7 +9069,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV } } else { - UV tuv = SvUVx(argsv); /* work around GCC bug #13488 */ + UV tuv = SvUV(argsv); /* work around GCC bug #13488 */ switch (intsize) { case 'h': uv = (unsigned short)tuv; break; case 'l': uv = (unsigned long)tuv; break; @@ -9150,10 +9191,12 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV #else va_arg(*args, double) #endif - : SvNVx(argsv); + : SvNV(argsv); need = 0; - if (c != 'e' && c != 'E') { + /* nv * 0 will be NaN for NaN, +Inf and -Inf, and 0 for anything + else. frexp() has some unspecified behaviour for those three */ + if (c != 'e' && c != 'E' && (nv * 0) == 0) { i = PERL_INT_MIN; /* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this will cast our (long double) to (double) */ @@ -9540,9 +9583,47 @@ Perl_parser_dup(pTHX_ const yy_parser *proto, CLONE_PARAMS* param) parser->multi_close = proto->multi_close; parser->multi_open = proto->multi_open; parser->multi_start = proto->multi_start; + parser->multi_end = proto->multi_end; parser->pending_ident = proto->pending_ident; parser->preambled = proto->preambled; parser->sublex_info = proto->sublex_info; /* XXX not quite right */ + parser->linestr = sv_dup_inc(proto->linestr, param); + parser->expect = proto->expect; + parser->copline = proto->copline; + parser->last_lop_op = proto->last_lop_op; + parser->lex_state = proto->lex_state; + parser->rsfp = fp_dup(proto->rsfp, '<', param); + /* rsfp_filters entries have fake IoDIRP() */ + parser->rsfp_filters= av_dup_inc(proto->rsfp_filters, param); + parser->in_my = proto->in_my; + parser->in_my_stash = hv_dup(proto->in_my_stash, param); + parser->error_count = proto->error_count; + + + parser->linestr = sv_dup_inc(proto->linestr, param); + + { + char * const ols = SvPVX(proto->linestr); + char * const ls = SvPVX(parser->linestr); + + parser->bufptr = ls + (proto->bufptr >= ols ? + proto->bufptr - ols : 0); + parser->oldbufptr = ls + (proto->oldbufptr >= ols ? + proto->oldbufptr - ols : 0); + parser->oldoldbufptr= ls + (proto->oldoldbufptr >= ols ? + proto->oldoldbufptr - ols : 0); + parser->linestart = ls + (proto->linestart >= ols ? + proto->linestart - ols : 0); + parser->last_uni = ls + (proto->last_uni >= ols ? + proto->last_uni - ols : 0); + parser->last_lop = ls + (proto->last_lop >= ols ? + proto->last_lop - ols : 0); + + parser->bufend = ls + SvCUR(parser->linestr); + } + + Copy(proto->tokenbuf, parser->tokenbuf, 256, char); + #ifdef PERL_MAD parser->endwhite = proto->endwhite; @@ -9557,6 +9638,13 @@ Perl_parser_dup(pTHX_ const yy_parser *proto, CLONE_PARAMS* param) parser->thisstuff = proto->thisstuff; parser->thistoken = proto->thistoken; parser->thiswhite = proto->thiswhite; + + Copy(proto->nexttoke, parser->nexttoke, 5, NEXTTOKE); + parser->curforce = proto->curforce; +#else + Copy(proto->nextval, parser->nextval, 5, YYSTYPE); + Copy(proto->nexttype, parser->nexttype, 5, I32); + parser->nexttoke = proto->nexttoke; #endif return parser; } @@ -10069,7 +10157,7 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param) IoOFP(dstr) = IoIFP(dstr); else IoOFP(dstr) = fp_dup(IoOFP(dstr), IoTYPE(dstr), param); - /* PL_rsfp_filters entries have fake IoDIRP() */ + /* PL_parser->rsfp_filters entries have fake IoDIRP() */ if(IoFLAGS(dstr) & IOf_FAKE_DIRP) { /* I have no idea why fake dirp (rsfps) should be treated differently but otherwise @@ -10382,9 +10470,9 @@ ANY * Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param) { dVAR; - ANY * const ss = proto_perl->Tsavestack; - const I32 max = proto_perl->Tsavestack_max; - I32 ix = proto_perl->Tsavestack_ix; + ANY * const ss = proto_perl->Isavestack; + const I32 max = proto_perl->Isavestack_max; + I32 ix = proto_perl->Isavestack_ix; ANY *nss; SV *sv; GV *gv; @@ -10820,6 +10908,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_savestack_ix = 0; PL_savestack_max = -1; PL_sig_pending = 0; + PL_parser = NULL; Zero(&PL_debug_pad, 1, struct perl_debug_pad); # else /* !DEBUGGING */ Zero(my_perl, 1, PerlInterpreter); @@ -10854,6 +10943,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_savestack_ix = 0; PL_savestack_max = -1; PL_sig_pending = 0; + PL_parser = NULL; Zero(&PL_debug_pad, 1, struct perl_debug_pad); # else /* !DEBUGGING */ Zero(my_perl, 1, PerlInterpreter); @@ -10940,7 +11030,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_compiling.cop_hints_hash->refcounted_he_refcnt++; HINTS_REFCNT_UNLOCK; } - PL_curcop = (COP*)any_dup(proto_perl->Tcurcop, proto_perl); + PL_curcop = (COP*)any_dup(proto_perl->Icurcop, proto_perl); #ifdef PERL_DEBUG_READONLY_OPS PL_slabs = NULL; PL_slab_count = 0; @@ -11059,13 +11149,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_DBsingle = sv_dup(proto_perl->IDBsingle, param); PL_DBtrace = sv_dup(proto_perl->IDBtrace, param); PL_DBsignal = sv_dup(proto_perl->IDBsignal, param); - PL_DBassertion = sv_dup(proto_perl->IDBassertion, param); - PL_lineary = av_dup(proto_perl->Ilineary, param); PL_dbargs = av_dup(proto_perl->Idbargs, param); /* symbol tables */ - PL_defstash = hv_dup_inc(proto_perl->Tdefstash, param); - PL_curstash = hv_dup(proto_perl->Tcurstash, param); + PL_defstash = hv_dup_inc(proto_perl->Idefstash, param); + PL_curstash = hv_dup(proto_perl->Icurstash, param); PL_debstash = hv_dup(proto_perl->Idebstash, param); PL_globalstash = hv_dup(proto_perl->Iglobalstash, param); PL_curstname = sv_dup_inc(proto_perl->Icurstname, param); @@ -11080,6 +11168,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_initav = av_dup_inc(proto_perl->Iinitav, param); PL_sub_generation = proto_perl->Isub_generation; + PL_isarev = hv_dup_inc(proto_perl->Iisarev, param); /* funky return mechanisms */ PL_forkprocess = proto_perl->Iforkprocess; @@ -11106,7 +11195,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, /* runtime control stuff */ PL_curcopdb = (COP*)any_dup(proto_perl->Icurcopdb, proto_perl); - PL_copline = proto_perl->Icopline; PL_filemode = proto_perl->Ifilemode; PL_lastfd = proto_perl->Ilastfd; @@ -11150,9 +11238,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_custom_op_descs = hv_dup_inc(proto_perl->Icustom_op_descs,param); PL_profiledata = NULL; - PL_rsfp = fp_dup(proto_perl->Irsfp, '<', param); - /* PL_rsfp_filters entries have fake IoDIRP() */ - PL_rsfp_filters = av_dup_inc(proto_perl->Irsfp_filters, param); PL_compcv = cv_dup(proto_perl->Icompcv, param); @@ -11186,8 +11271,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_runops = proto_perl->Irunops; - Copy(proto_perl->Itokenbuf, PL_tokenbuf, 256, char); - #ifdef CSH PL_cshlen = proto_perl->Icshlen; PL_cshname = proto_perl->Icshname; /* XXX never deallocated */ @@ -11195,43 +11278,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_parser = parser_dup(proto_perl->Iparser, param); - PL_lex_state = proto_perl->Ilex_state; - -#ifdef PERL_MAD - Copy(proto_perl->Inexttoke, PL_nexttoke, 5, NEXTTOKE); - PL_curforce = proto_perl->Icurforce; -#else - Copy(proto_perl->Inextval, PL_nextval, 5, YYSTYPE); - Copy(proto_perl->Inexttype, PL_nexttype, 5, I32); - PL_nexttoke = proto_perl->Inexttoke; -#endif - - PL_linestr = sv_dup_inc(proto_perl->Ilinestr, param); - i = proto_perl->Ibufptr - SvPVX_const(proto_perl->Ilinestr); - PL_bufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i); - i = proto_perl->Ioldbufptr - SvPVX_const(proto_perl->Ilinestr); - PL_oldbufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i); - i = proto_perl->Ioldoldbufptr - SvPVX_const(proto_perl->Ilinestr); - PL_oldoldbufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i); - i = proto_perl->Ilinestart - SvPVX_const(proto_perl->Ilinestr); - PL_linestart = SvPVX(PL_linestr) + (i < 0 ? 0 : i); - PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); - - PL_expect = proto_perl->Iexpect; - - PL_multi_end = proto_perl->Imulti_end; - - PL_error_count = proto_perl->Ierror_count; PL_subline = proto_perl->Isubline; PL_subname = sv_dup_inc(proto_perl->Isubname, param); - i = proto_perl->Ilast_uni - SvPVX_const(proto_perl->Ilinestr); - PL_last_uni = SvPVX(PL_linestr) + (i < 0 ? 0 : i); - i = proto_perl->Ilast_lop - SvPVX_const(proto_perl->Ilinestr); - PL_last_lop = SvPVX(PL_linestr) + (i < 0 ? 0 : i); - PL_last_lop_op = proto_perl->Ilast_lop_op; - PL_in_my = proto_perl->Iin_my; - PL_in_my_stash = hv_dup(proto_perl->Iin_my_stash, param); #ifdef FCRYPT PL_cryptseen = proto_perl->Icryptseen; #endif @@ -11304,9 +11353,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_unlockhook = proto_perl->Iunlockhook; PL_threadhook = proto_perl->Ithreadhook; - PL_runops_std = proto_perl->Irunops_std; - PL_runops_dbg = proto_perl->Irunops_dbg; - #ifdef THREADS_HAVE_PIDS PL_ppid = proto_perl->Ippid; #endif @@ -11320,7 +11366,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_glob_index = proto_perl->Iglob_index; PL_srand_called = proto_perl->Isrand_called; - PL_uudmap[(U32) 'M'] = 0; /* reinits on demand */ PL_bitcount = NULL; /* reinits on demand */ if (proto_perl->Ipsig_pend) { @@ -11343,54 +11388,54 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_psig_name = (SV**)NULL; } - /* thrdvar.h stuff */ + /* intrpvar.h stuff */ if (flags & CLONEf_COPY_STACKS) { /* next allocation will be PL_tmps_stack[PL_tmps_ix+1] */ - PL_tmps_ix = proto_perl->Ttmps_ix; - PL_tmps_max = proto_perl->Ttmps_max; - PL_tmps_floor = proto_perl->Ttmps_floor; + PL_tmps_ix = proto_perl->Itmps_ix; + PL_tmps_max = proto_perl->Itmps_max; + PL_tmps_floor = proto_perl->Itmps_floor; Newxz(PL_tmps_stack, PL_tmps_max, SV*); i = 0; while (i <= PL_tmps_ix) { - PL_tmps_stack[i] = sv_dup_inc(proto_perl->Ttmps_stack[i], param); + PL_tmps_stack[i] = sv_dup_inc(proto_perl->Itmps_stack[i], param); ++i; } /* next PUSHMARK() sets *(PL_markstack_ptr+1) */ - i = proto_perl->Tmarkstack_max - proto_perl->Tmarkstack; + i = proto_perl->Imarkstack_max - proto_perl->Imarkstack; Newxz(PL_markstack, i, I32); - PL_markstack_max = PL_markstack + (proto_perl->Tmarkstack_max - - proto_perl->Tmarkstack); - PL_markstack_ptr = PL_markstack + (proto_perl->Tmarkstack_ptr - - proto_perl->Tmarkstack); - Copy(proto_perl->Tmarkstack, PL_markstack, + PL_markstack_max = PL_markstack + (proto_perl->Imarkstack_max + - proto_perl->Imarkstack); + PL_markstack_ptr = PL_markstack + (proto_perl->Imarkstack_ptr + - proto_perl->Imarkstack); + Copy(proto_perl->Imarkstack, PL_markstack, PL_markstack_ptr - PL_markstack + 1, I32); /* next push_scope()/ENTER sets PL_scopestack[PL_scopestack_ix] * NOTE: unlike the others! */ - PL_scopestack_ix = proto_perl->Tscopestack_ix; - PL_scopestack_max = proto_perl->Tscopestack_max; + PL_scopestack_ix = proto_perl->Iscopestack_ix; + PL_scopestack_max = proto_perl->Iscopestack_max; Newxz(PL_scopestack, PL_scopestack_max, I32); - Copy(proto_perl->Tscopestack, PL_scopestack, PL_scopestack_ix, I32); + Copy(proto_perl->Iscopestack, PL_scopestack, PL_scopestack_ix, I32); /* NOTE: si_dup() looks at PL_markstack */ - PL_curstackinfo = si_dup(proto_perl->Tcurstackinfo, param); + PL_curstackinfo = si_dup(proto_perl->Icurstackinfo, param); /* PL_curstack = PL_curstackinfo->si_stack; */ - PL_curstack = av_dup(proto_perl->Tcurstack, param); - PL_mainstack = av_dup(proto_perl->Tmainstack, param); + PL_curstack = av_dup(proto_perl->Icurstack, param); + PL_mainstack = av_dup(proto_perl->Imainstack, param); /* next PUSHs() etc. set *(PL_stack_sp+1) */ PL_stack_base = AvARRAY(PL_curstack); - PL_stack_sp = PL_stack_base + (proto_perl->Tstack_sp - - proto_perl->Tstack_base); + PL_stack_sp = PL_stack_base + (proto_perl->Istack_sp + - proto_perl->Istack_base); PL_stack_max = PL_stack_base + AvMAX(PL_curstack); /* next SSPUSHFOO() sets PL_savestack[PL_savestack_ix] * NOTE: unlike the others! */ - PL_savestack_ix = proto_perl->Tsavestack_ix; - PL_savestack_max = proto_perl->Tsavestack_max; + PL_savestack_ix = proto_perl->Isavestack_ix; + PL_savestack_max = proto_perl->Isavestack_max; /*Newxz(PL_savestack, PL_savestack_max, ANY);*/ PL_savestack = ss_dup(proto_perl, param); } @@ -11403,9 +11448,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, * non-refcount means (eg a temp in @_); otherwise they will be * orphaned */ - for (i = 0; i<= proto_perl->Ttmps_ix; i++) { + for (i = 0; i<= proto_perl->Itmps_ix; i++) { SV * const nsv = (SV*)ptr_table_fetch(PL_ptr_table, - proto_perl->Ttmps_stack[i]); + proto_perl->Itmps_stack[i]); if (nsv && !SvREFCNT(nsv)) { EXTEND_MORTAL(1); PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple(nsv); @@ -11413,50 +11458,50 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, } } - PL_start_env = proto_perl->Tstart_env; /* XXXXXX */ + PL_start_env = proto_perl->Istart_env; /* XXXXXX */ PL_top_env = &PL_start_env; - PL_op = proto_perl->Top; + PL_op = proto_perl->Iop; PL_Sv = NULL; PL_Xpv = (XPV*)NULL; - PL_na = proto_perl->Tna; + PL_na = proto_perl->Ina; - PL_statbuf = proto_perl->Tstatbuf; - PL_statcache = proto_perl->Tstatcache; - PL_statgv = gv_dup(proto_perl->Tstatgv, param); - PL_statname = sv_dup_inc(proto_perl->Tstatname, param); + PL_statbuf = proto_perl->Istatbuf; + PL_statcache = proto_perl->Istatcache; + PL_statgv = gv_dup(proto_perl->Istatgv, param); + PL_statname = sv_dup_inc(proto_perl->Istatname, param); #ifdef HAS_TIMES - PL_timesbuf = proto_perl->Ttimesbuf; + PL_timesbuf = proto_perl->Itimesbuf; #endif - PL_tainted = proto_perl->Ttainted; - PL_curpm = proto_perl->Tcurpm; /* XXX No PMOP ref count */ - PL_rs = sv_dup_inc(proto_perl->Trs, param); - PL_last_in_gv = gv_dup(proto_perl->Tlast_in_gv, param); - PL_ofs_sv = sv_dup_inc(proto_perl->Tofs_sv, param); - PL_defoutgv = gv_dup_inc(proto_perl->Tdefoutgv, param); - PL_chopset = proto_perl->Tchopset; /* XXX never deallocated */ - PL_toptarget = sv_dup_inc(proto_perl->Ttoptarget, param); - PL_bodytarget = sv_dup_inc(proto_perl->Tbodytarget, param); - PL_formtarget = sv_dup(proto_perl->Tformtarget, param); - - PL_restartop = proto_perl->Trestartop; - PL_in_eval = proto_perl->Tin_eval; - PL_delaymagic = proto_perl->Tdelaymagic; - PL_dirty = proto_perl->Tdirty; - PL_localizing = proto_perl->Tlocalizing; - - PL_errors = sv_dup_inc(proto_perl->Terrors, param); + PL_tainted = proto_perl->Itainted; + PL_curpm = proto_perl->Icurpm; /* XXX No PMOP ref count */ + PL_rs = sv_dup_inc(proto_perl->Irs, param); + PL_last_in_gv = gv_dup(proto_perl->Ilast_in_gv, param); + PL_ofs_sv = sv_dup_inc(proto_perl->Iofs_sv, param); + PL_defoutgv = gv_dup_inc(proto_perl->Idefoutgv, param); + PL_chopset = proto_perl->Ichopset; /* XXX never deallocated */ + PL_toptarget = sv_dup_inc(proto_perl->Itoptarget, param); + PL_bodytarget = sv_dup_inc(proto_perl->Ibodytarget, param); + PL_formtarget = sv_dup(proto_perl->Iformtarget, param); + + PL_restartop = proto_perl->Irestartop; + PL_in_eval = proto_perl->Iin_eval; + PL_delaymagic = proto_perl->Idelaymagic; + PL_dirty = proto_perl->Idirty; + PL_localizing = proto_perl->Ilocalizing; + + PL_errors = sv_dup_inc(proto_perl->Ierrors, param); PL_hv_fetch_ent_mh = NULL; - PL_modcount = proto_perl->Tmodcount; + PL_modcount = proto_perl->Imodcount; PL_lastgotoprobe = NULL; - PL_dumpindent = proto_perl->Tdumpindent; + PL_dumpindent = proto_perl->Idumpindent; - PL_sortcop = (OP*)any_dup(proto_perl->Tsortcop, proto_perl); - PL_sortstash = hv_dup(proto_perl->Tsortstash, param); - PL_firstgv = gv_dup(proto_perl->Tfirstgv, param); - PL_secondgv = gv_dup(proto_perl->Tsecondgv, param); + PL_sortcop = (OP*)any_dup(proto_perl->Isortcop, proto_perl); + PL_sortstash = hv_dup(proto_perl->Isortstash, param); + PL_firstgv = gv_dup(proto_perl->Ifirstgv, param); + PL_secondgv = gv_dup(proto_perl->Isecondgv, param); PL_efloatbuf = NULL; /* reinits on demand */ PL_efloatsize = 0; /* reinits on demand */ @@ -11468,24 +11513,24 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_lastscream = NULL; - PL_regdummy = proto_perl->Tregdummy; + PL_regdummy = proto_perl->Iregdummy; PL_colorset = 0; /* reinits PL_colors[] */ /*PL_colors[6] = {0,0,0,0,0,0};*/ /* Pluggable optimizer */ - PL_peepp = proto_perl->Tpeepp; + PL_peepp = proto_perl->Ipeepp; PL_stashcache = newHV(); PL_watchaddr = (char **) ptr_table_fetch(PL_ptr_table, - proto_perl->Twatchaddr); + proto_perl->Iwatchaddr); PL_watchok = PL_watchaddr ? * PL_watchaddr : NULL; if (PL_debug && PL_watchaddr) { PerlIO_printf(Perl_debug_log, "WATCHING: %"UVxf" cloned as %"UVxf" with value %"UVxf"\n", - PTR2UV(proto_perl->Twatchaddr), PTR2UV(PL_watchaddr), + PTR2UV(proto_perl->Iwatchaddr), PTR2UV(PL_watchaddr), PTR2UV(PL_watchok)); } @@ -11740,8 +11785,7 @@ S_varname(pTHX_ GV *gv, const char gvtype, PADOFFSET targ, } } else { - U32 unused; - CV * const cv = find_runcv(&unused); + CV * const cv = find_runcv(NULL); SV *sv; AV *av; @@ -12035,6 +12079,11 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match) match = 1; /* XS or custom code could trigger random warnings */ goto do_op; + case OP_POS: + /* def-ness of rval pos() is independent of the def-ness of its arg */ + if ( !(obase->op_flags & OPf_MOD)) + break; + case OP_SCHOMP: case OP_CHOMP: if (SvROK(PL_rs) && uninit_sv == SvRV(PL_rs))