/* HEs use this offset for their arena. */
{ 0, 0, 0, SVt_NULL, FALSE, NONV, NOARENA, 0 },
- /* The bind placeholder pretends to be an RV for now.
- Also it's marked as "can't upgrade" to stop anyone using it before it's
- implemented. */
- { 0, 0, 0, SVt_DUMMY, TRUE, NONV, NOARENA, 0 },
-
/* IVs are in the head, so the allocation size is 0. */
{ 0,
sizeof(IV), /* This is used to copy out the IV body. */
SVt_PV, FALSE, NONV, HASARENA,
FIT_ARENA(0, sizeof(XPV) - STRUCT_OFFSET(XPV, xpv_cur)) },
+ { sizeof(XINVLIST) - STRUCT_OFFSET(XPV, xpv_cur),
+ copy_length(XINVLIST, is_offset) - STRUCT_OFFSET(XPV, xpv_cur),
+ + STRUCT_OFFSET(XPV, xpv_cur),
+ SVt_INVLIST, TRUE, NONV, HASARENA,
+ FIT_ARENA(0, sizeof(XINVLIST) - STRUCT_OFFSET(XPV, xpv_cur)) },
+
{ sizeof(XPVIV) - STRUCT_OFFSET(XPV, xpv_cur),
copy_length(XPVIV, xiv_u) - STRUCT_OFFSET(XPV, xpv_cur),
+ STRUCT_OFFSET(XPV, xpv_cur),
{ sizeof(regexp),
sizeof(regexp),
0,
- SVt_REGEXP, FALSE, NONV, HASARENA,
+ SVt_REGEXP, TRUE, NONV, HASARENA,
FIT_ARENA(0, sizeof(regexp))
},
case SVt_PVGV:
case SVt_PVCV:
case SVt_PVLV:
+ case SVt_INVLIST:
case SVt_REGEXP:
case SVt_PVMG:
case SVt_PVNV:
if (!sv)
return 0;
+ assert (SvTYPE(sv) != SVt_PVAV && SvTYPE(sv) != SVt_PVHV
+ && SvTYPE(sv) != SVt_PVFM);
+
if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
mg_get(sv);
dVAR;
if (!sv)
return 0.0;
+ assert (SvTYPE(sv) != SVt_PVAV && SvTYPE(sv) != SVt_PVHV
+ && SvTYPE(sv) != SVt_PVFM);
if (SvGMAGICAL(sv) || SvVALID(sv) || isREGEXP(sv)) {
/* FBMs use the space for SvIVX and SvNVX for other purposes, and use
the same flag bit as SVf_IVisUV, so must not let them cache NVs.
*lp = 0;
return (char *)"";
}
+ assert (SvTYPE(sv) != SVt_PVAV && SvTYPE(sv) != SVt_PVHV
+ && SvTYPE(sv) != SVt_PVFM);
if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
mg_get(sv);
if (SvROK(sv)) {
* change to the C locale during the Gconvert and then change back.
* But if we're already in the C locale (PL_numeric_standard is
* TRUE in that case), no need to do any changing */
- if (PL_numeric_standard || IN_LOCALE_RUNTIME) {
+ if (PL_numeric_standard || IN_SOME_LOCALE_FORM_RUNTIME) {
Gconvert(SvNVX(sv), NV_DIG, 0, s);
+
+ /* If the radix character is UTF-8, and actually is in the
+ * output, turn on the UTF-8 flag for the scalar */
+ if (! PL_numeric_standard
+ && PL_numeric_radix_sv && SvUTF8(PL_numeric_radix_sv)
+ && instr(s, SvPVX_const(PL_numeric_radix_sv)))
+ {
+ SvUTF8_on(sv);
+ }
}
else {
char *loc = savepv(setlocale(LC_NUMERIC, NULL));
Gconvert(SvNVX(sv), NV_DIG, 0, s);
setlocale(LC_NUMERIC, loc);
Safefree(loc);
+
}
/* We don't call SvPOK_on(), because it may come to pass that the
{
PERL_ARGS_ASSERT_SV_2PVBYTE;
+ SvGETMAGIC(sv);
if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv))
|| isGV_with_GP(sv) || SvROK(sv)) {
SV *sv2 = sv_newmortal();
- sv_copypv(sv2,sv);
+ sv_copypv_nomg(sv2,sv);
sv = sv2;
}
- else SvGETMAGIC(sv);
sv_utf8_downgrade(sv,0);
return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
}
}
return SvRV(sv) != 0;
}
+ if (isREGEXP(sv))
+ return
+ RX_WRAPLEN(sv) > 1 || (RX_WRAPLEN(sv) && *RX_WRAPPED(sv) != '0');
return SvTRUE_common(sv, isGV_with_GP(sv) ? 1 : 0);
}
*/
+static void S_sv_uncow(pTHX_ SV * const sv, const U32 flags);
+
STRLEN
Perl_sv_utf8_upgrade_flags_grow(pTHX_ SV *const sv, const I32 flags, STRLEN extra)
{
}
if (SvIsCOW(sv)) {
- sv_force_normal_flags(sv, 0);
+ S_sv_uncow(aTHX_ sv, 0);
}
if (PL_encoding && !(flags & SV_UTF8_NO_ENCODING)) {
int mg_flags = SV_GMAGIC;
if (SvIsCOW(sv)) {
- sv_force_normal_flags(sv, 0);
+ S_sv_uncow(aTHX_ sv, 0);
}
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
/* update pos */
}
break;
- /* case SVt_DUMMY: */
+ case SVt_INVLIST:
case SVt_PVLV:
case SVt_PVGV:
case SVt_PVMG:
? (!((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
# ifdef PERL_OLD_COPY_ON_WRITE
&& (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
- && SvTYPE(sstr) >= SVt_PVIV
+ && SvTYPE(sstr) >= SVt_PVIV && len
# else
&& !(SvFLAGS(dstr) & SVf_BREAK)
&& !(sflags & SVf_IsCOW)
{
SV_CHECK_THINKFIRST_COW_DROP(sv);
SvUPGRADE(sv, SVt_PV);
- Safefree(SvPVX(sv));
+ SvPV_free(sv);
SvPV_set(sv,(char *)HEK_KEY(share_hek_hek(hek)));
SvCUR_set(sv, HEK_LEN(hek));
SvLEN_set(sv, 0);
=cut
*/
-void
-Perl_sv_force_normal_flags(pTHX_ SV *const sv, const U32 flags)
+static void
+S_sv_uncow(pTHX_ SV * const sv, const U32 flags)
{
dVAR;
- PERL_ARGS_ASSERT_SV_FORCE_NORMAL_FLAGS;
-
+ assert(SvIsCOW(sv));
+ {
#ifdef PERL_ANY_COW
- if (SvREADONLY(sv)) {
- if (IN_PERL_RUNTIME)
- Perl_croak_no_modify();
- }
- else if (SvIsCOW(sv)) {
const char * const pvx = SvPVX_const(sv);
const STRLEN len = SvLEN(sv);
const STRLEN cur = SvCUR(sv);
sv_dump(sv);
}
}
- }
#else
- if (SvREADONLY(sv)) {
- if (IN_PERL_RUNTIME)
- Perl_croak_no_modify();
- }
- else
- if (SvIsCOW(sv)) {
const char * const pvx = SvPVX_const(sv);
const STRLEN len = SvCUR(sv);
SvIsCOW_off(sv);
*SvEND(sv) = '\0';
}
unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
- }
#endif
+ }
+}
+
+void
+Perl_sv_force_normal_flags(pTHX_ SV *const sv, const U32 flags)
+{
+ PERL_ARGS_ASSERT_SV_FORCE_NORMAL_FLAGS;
+
+ if (SvREADONLY(sv))
+ Perl_croak_no_modify();
+ else if (SvIsCOW(sv))
+ S_sv_uncow(aTHX_ sv, flags);
if (SvROK(sv))
sv_unref_flags(sv, flags);
else if (SvFAKE(sv) && isGV_with_GP(sv))
evacp = p - evacn;
#endif
+ /* This sets 'delta' to the accumulated value of all deltas so far */
delta += old_delta;
assert(delta);
+
+ /* If 'delta' fits in a byte, store it just prior to the new beginning of
+ * the string; otherwise store a 0 byte there and store 'delta' just prior
+ * to that, using as many bytes as a STRLEN occupies. Thus it overwrites a
+ * portion of the chopped part of the string */
if (delta < 0x100) {
*--p = (U8) delta;
} else {
PERL_ARGS_ASSERT_SV_MAGICEXT;
+ if (SvTYPE(sv)==SVt_PVAV) { assert (!AvPAD_NAMELIST(sv)); }
+
SvUPGRADE(sv, SVt_PVMG);
Newxz(mg, 1, MAGIC);
mg->mg_moremagic = SvMAGIC(sv);
return mg;
}
+MAGIC *
+Perl_sv_magicext_mglob(pTHX_ SV *sv)
+{
+ PERL_ARGS_ASSERT_SV_MAGICEXT_MGLOB;
+ if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') {
+ /* This sv is only a delegate. //g magic must be attached to
+ its target. */
+ vivify_defelem(sv);
+ sv = LvTARG(sv);
+ }
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(sv))
+ sv_force_normal_flags(sv, 0);
+#endif
+ return sv_magicext(sv, NULL, PERL_MAGIC_regex_global,
+ &PL_vtbl_mglob, 0, 0);
+}
+
/*
=for apidoc sv_magic
vtable = (vtable_index == magic_vtable_max)
? NULL : PL_magic_vtables + vtable_index;
-#ifdef PERL_ANY_COW
+#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW(sv))
sv_force_normal_flags(sv, 0);
#endif
if (SvREADONLY(sv)) {
if (
- /* its okay to attach magic to shared strings */
- !SvIsCOW(sv)
-
- && IN_PERL_RUNTIME
- && !PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(how)
+ !PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(how)
)
{
Perl_croak_no_modify();
}
else if (type == SVt_PVMG && SvPAD_OUR(sv)) {
SvREFCNT_dec(SvOURSTASH(sv));
+ }
+ else if (type == SVt_PVAV && AvPAD_NAMELIST(sv)) {
+ assert(!SvMAGICAL(sv));
} else if (SvMAGIC(sv)) {
/* Free back-references before other types of magic. */
sv_unmagic(sv, PERL_MAGIC_backref);
SvREFCNT_dec(SvSTASH(sv));
}
switch (type) {
- /* case SVt_DUMMY: */
+ /* case SVt_INVLIST: */
case SVt_PVIO:
if (IoIFP(sv) &&
IoIFP(sv) != PerlIO_stdin() &&
case SVt_PVMG:
case SVt_PVNV:
case SVt_PVIV:
+ case SVt_INVLIST:
case SVt_PV:
freescalar:
/* Don't bother with SvOOK_off(sv); as we're only going to
PERL_ARGS_ASSERT_SV_FREE2;
- if (rc == 1) {
+ if (LIKELY( rc == 1 )) {
/* normal case */
SvREFCNT(sv) = 0;
/*
=for apidoc sv_pos_u2b_flags
-Converts the value pointed to by offsetp from a count of UTF-8 chars from
+Converts the offset from a count of UTF-8 chars from
the start of the string, to a count of the equivalent number of bytes; if
lenp is non-zero, it does the same to lenp, but this time starting from
the offset, rather than from the start
assert(*mgp);
(*mgp)->mg_len = ulen;
- /* For now, treat "overflowed" as "still unknown". See RT #72924. */
- if (ulen != (STRLEN) (*mgp)->mg_len)
- (*mgp)->mg_len = -1;
}
/* Create and update the UTF8 magic offset cache, with the proffered utf8/
}
/*
-=for apidoc sv_pos_b2u
+=for apidoc sv_pos_b2u_flags
-Converts the value pointed to by offsetp from a count of bytes from the
-start of the string, to a count of the equivalent number of UTF-8 chars.
-Handles magic and type coercion.
+Converts the offset from a count of bytes from the start of the string, to
+a count of the equivalent number of UTF-8 chars. Handles type coercion.
+I<flags> is passed to C<SvPV_flags>, and usually should be
+C<SV_GMAGIC|SV_CONST_RETURN> to handle magic.
=cut
*/
/*
- * sv_pos_b2u() uses, like sv_pos_u2b(), the mg_ptr of the potential
- * PERL_MAGIC_utf8 of the sv to store the mapping between UTF-8 and
- * byte offsets.
+ * sv_pos_b2u_flags() uses, like sv_pos_u2b_flags(), the mg_ptr of the
+ * potential PERL_MAGIC_utf8 of the sv to store the mapping between UTF-8
+ * and byte offsets.
*
*/
-void
-Perl_sv_pos_b2u(pTHX_ SV *const sv, I32 *const offsetp)
+STRLEN
+Perl_sv_pos_b2u_flags(pTHX_ SV *const sv, STRLEN const offset, U32 flags)
{
const U8* s;
- const STRLEN byte = *offsetp;
STRLEN len = 0; /* Actually always set, but let's keep gcc happy. */
STRLEN blen;
MAGIC* mg = NULL;
const U8* send;
bool found = FALSE;
- PERL_ARGS_ASSERT_SV_POS_B2U;
-
- if (!sv)
- return;
+ PERL_ARGS_ASSERT_SV_POS_B2U_FLAGS;
- s = (const U8*)SvPV_const(sv, blen);
+ s = (const U8*)SvPV_flags(sv, blen, flags);
- if (blen < byte)
+ if (blen < offset)
Perl_croak(aTHX_ "panic: sv_pos_b2u: bad byte offset, blen=%"UVuf
- ", byte=%"UVuf, (UV)blen, (UV)byte);
+ ", byte=%"UVuf, (UV)blen, (UV)offset);
- send = s + byte;
+ send = s + offset;
if (!SvREADONLY(sv)
&& PL_utf8cache
{
if (mg->mg_ptr) {
STRLEN * const cache = (STRLEN *) mg->mg_ptr;
- if (cache[1] == byte) {
+ if (cache[1] == offset) {
/* An exact match. */
- *offsetp = cache[0];
- return;
+ return cache[0];
}
- if (cache[3] == byte) {
+ if (cache[3] == offset) {
/* An exact match. */
- *offsetp = cache[2];
- return;
+ return cache[2];
}
- if (cache[1] < byte) {
+ if (cache[1] < offset) {
/* We already know part of the way. */
if (mg->mg_len != -1) {
/* Actually, we know the end too. */
len = cache[0] + utf8_length(s + cache[1], send);
}
}
- else if (cache[3] < byte) {
+ else if (cache[3] < offset) {
/* We're between the two cached pairs, so we do the calculation
offset by the byte/utf-8 positions for the earlier pair,
then add the utf-8 characters from the string start to
+ cache[2];
}
- else { /* cache[3] > byte */
+ else { /* cache[3] > offset */
len = S_sv_pos_b2u_midway(aTHX_ s, send, s + cache[3],
cache[2]);
assert_uft8_cache_coherent("sv_pos_b2u", len, real_len, sv);
len = real_len;
}
- *offsetp = len;
if (PL_utf8cache) {
- if (blen == byte)
+ if (blen == offset)
utf8_mg_len_cache_update(sv, &mg, len);
else
- utf8_mg_pos_cache_update(sv, &mg, byte, len, blen);
+ utf8_mg_pos_cache_update(sv, &mg, offset, len, blen);
}
+
+ return len;
+}
+
+/*
+=for apidoc sv_pos_b2u
+
+Converts the value pointed to by offsetp from a count of bytes from the
+start of the string, to a count of the equivalent number of UTF-8 chars.
+Handles magic and type coercion.
+
+Use C<sv_pos_b2u_flags> in preference, which correctly handles strings
+longer than 2Gb.
+
+=cut
+*/
+
+/*
+ * sv_pos_b2u() uses, like sv_pos_u2b(), the mg_ptr of the potential
+ * PERL_MAGIC_utf8 of the sv to store the mapping between UTF-8 and
+ * byte offsets.
+ *
+ */
+void
+Perl_sv_pos_b2u(pTHX_ SV *const sv, I32 *const offsetp)
+{
+ PERL_ARGS_ASSERT_SV_POS_B2U;
+
+ if (!sv)
+ return;
+
+ *offsetp = (I32)sv_pos_b2u_flags(sv, (STRLEN)*offsetp,
+ SV_GMAGIC|SV_CONST_RETURN);
}
static void
if (!sv)
return;
if (SvTHINKFIRST(sv)) {
- if (SvIsCOW(sv) || isGV_with_GP(sv))
- sv_force_normal_flags(sv, 0);
if (SvREADONLY(sv)) {
- if (IN_PERL_RUNTIME)
Perl_croak_no_modify();
}
if (SvROK(sv)) {
sv_unref(sv);
sv_setiv(sv, i);
}
+ else sv_force_normal_flags(sv, 0);
}
flags = SvFLAGS(sv);
if ((flags & (SVp_NOK|SVp_IOK)) == SVp_NOK) {
if (!sv)
return;
if (SvTHINKFIRST(sv)) {
- if (SvIsCOW(sv) || isGV_with_GP(sv))
- sv_force_normal_flags(sv, 0);
if (SvREADONLY(sv)) {
- if (IN_PERL_RUNTIME)
Perl_croak_no_modify();
}
if (SvROK(sv)) {
sv_unref(sv);
sv_setiv(sv, i);
}
+ else sv_force_normal_flags(sv, 0);
}
/* Unlike sv_inc we don't have to worry about string-never-numbers
and keeping them magic. But we mustn't warn on punting */
new_SV(sv);
sv_setpvn(sv,s,len);
- /* This code used to a sv_2mortal(), however we now unroll the call to sv_2mortal()
- * and do what it does ourselves here.
- * Since we have asserted that flags can only have the SVf_UTF8 and/or SVs_TEMP flags
- * set above we can use it to enable the sv flags directly (bypassing SvTEMP_on), which
- * in turn means we dont need to mask out the SVf_UTF8 flag below, which means that we
- * eliminate quite a few steps than it looks - Yves (explaining patch by gfx)
- */
+ /* This code used to do a sv_2mortal(), however we now unroll the call to
+ * sv_2mortal() and do what it does ourselves here. Since we have asserted
+ * that flags can only have the SVf_UTF8 and/or SVs_TEMP flags set above we
+ * can use it to enable the sv flags directly (bypassing SvTEMP_on), which
+ * in turn means we dont need to mask out the SVf_UTF8 flag below, which
+ * means that we eliminate quite a few steps than it looks - Yves
+ * (explaining patch by gfx) */
SvFLAGS(sv) |= flags;
continue;
gv = MUTABLE_GV(HeVAL(entry));
sv = GvSV(gv);
- if (sv) {
- if (SvTHINKFIRST(sv)) {
- if (!SvREADONLY(sv) && SvROK(sv))
- sv_unref(sv);
- /* XXX Is this continue a bug? Why should THINKFIRST
- exempt us from resetting arrays and hashes? */
- continue;
- }
+ if (sv && !SvREADONLY(sv)) {
+ SV_CHECK_THINKFIRST_COW_DROP(sv);
SvOK_off(sv);
if (SvTYPE(sv) >= SVt_PV) {
SvCUR_set(sv, 0);
PERL_ARGS_ASSERT_SV_PVN_FORCE_FLAGS;
if (flags & SV_GMAGIC) SvGETMAGIC(sv);
- if (SvTHINKFIRST(sv) && !SvROK(sv))
+ if (SvTHINKFIRST(sv) && (!SvROK(sv) || SvREADONLY(sv)))
sv_force_normal_flags(sv, 0);
if (SvPOK(sv)) {
char *s;
STRLEN len;
- if (SvREADONLY(sv) && !(flags & SV_MUTABLE_RETURN)) {
- const char * const ref = sv_reftype(sv,0);
- if (PL_op)
- Perl_croak(aTHX_ "Can't coerce readonly %s to string in %s",
- ref, OP_DESC(PL_op));
- else
- Perl_croak(aTHX_ "Can't coerce readonly %s to string", ref);
- }
if (SvTYPE(sv) > SVt_PVLV
|| isGV_with_GP(sv))
/* diag_listed_as: Can't coerce %s to %s in %s */
? "GLOB" : "SCALAR");
case SVt_PVFM: return "FORMAT";
case SVt_PVIO: return "IO";
- case SVt_DUMMY: return "DUMMY";
+ case SVt_INVLIST: return "INVLIST";
case SVt_REGEXP: return "REGEXP";
default: return "UNKNOWN";
}
PERL_ARGS_ASSERT_SV_BLESS;
+ SvGETMAGIC(sv);
if (!SvROK(sv))
Perl_croak(aTHX_ "Can't bless non-reference value");
tmpRef = SvRV(sv);
if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {
- if (SvREADONLY(tmpRef) && !SvIsCOW(tmpRef))
+ if (SvREADONLY(tmpRef))
Perl_croak_no_modify();
if (SvOBJECT(tmpRef)) {
SvREFCNT_dec(SvSTASH(tmpRef));
%-<num>p include an SV with precision <num>
%2p include a HEK
%3p include a HEK with precision of 256
- %<num>p (where num != 2 or 3) reserved for future
+ %4p char* preceded by utf8 flag and length
+ %<num>p (where num is 1 or > 4) reserved for future
extensions
Robin Barker 2005-07-14 (but modified since)
STRLEN n = 0;
if (*q == '-')
sv = *q++;
+ else if (strnEQ(q, UTF8f, sizeof(UTF8f)-1)) { /* UTF8f */
+ /* The argument has already gone through cBOOL, so the cast
+ is safe. */
+ is_utf8 = (bool)va_arg(*args, int);
+ elen = va_arg(*args, UV);
+ eptr = va_arg(*args, char *);
+ q += sizeof(UTF8f)-1;
+ goto string;
+ }
n = expect_number(&q);
if (*q++ == 'p') {
if (sv) { /* SVf */
}
float_converted:
eptr = PL_efloatbuf;
+ if (PL_numeric_radix_sv && SvUTF8(PL_numeric_radix_sv)
+ && instr(eptr, SvPVX_const(PL_numeric_radix_sv)))
+ {
+ is_utf8 = TRUE;
+ }
+
break;
/* SPECIAL */
have = esignlen + zeros + elen;
if (have < zeros)
- Perl_croak_memory_wrap();
+ croak_memory_wrap();
need = (have > width ? have : width);
gap = need - have;
if (need >= (((STRLEN)~0) - SvCUR(sv) - dotstrlen - 1))
- Perl_croak_memory_wrap();
+ croak_memory_wrap();
SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
p = SvEND(sv);
if (esignlen && fill == '0') {
SvANY(dstr) = new_XNV();
SvNV_set(dstr, SvNVX(sstr));
break;
- /* case SVt_DUMMY: */
default:
{
/* These are all the types that need complex bodies allocating. */
case SVt_PVMG:
case SVt_PVNV:
case SVt_PVIV:
+ case SVt_INVLIST:
case SVt_PV:
assert(sv_type_details->body_size);
if (sv_type_details->arena) {
if (sv_type >= SVt_PVMG) {
if ((sv_type == SVt_PVMG) && SvPAD_OUR(dstr)) {
SvOURSTASH_set(dstr, hv_dup_inc(SvOURSTASH(dstr), param));
+ } else if (sv_type == SVt_PVAV && AvPAD_NAMELIST(dstr)) {
+ NOOP;
} else if (SvMAGIC(dstr))
SvMAGIC_set(dstr, mg_dup(SvMAGIC(dstr), param));
if (SvOBJECT(dstr) && SvSTASH(dstr))
/* fall through */
case SAVEt_FREESV:
case SAVEt_MORTALIZESV:
+ case SAVEt_READONLY_OFF:
sv = (const SV *)POPPTR(ss,ix);
TOPPTR(nss,ix) = sv_dup_inc(sv, param);
break;
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = cophh_copy((COPHH *)ptr);
break;
+ case SAVEt_ADELETE:
+ av = (const AV *)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = av_dup_inc(av, param);
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ break;
case SAVEt_DELETE:
hv = (const HV *)POPPTR(ss,ix);
TOPPTR(nss,ix) = hv_dup_inc(hv, param);
PL_cryptseen = proto_perl->Icryptseen;
#endif
- PL_hints = proto_perl->Ihints;
-
#ifdef USE_LOCALE_COLLATE
PL_collation_ix = proto_perl->Icollation_ix;
PL_collation_standard = proto_perl->Icollation_standard;
hv_ksplit(PL_strtab, HvTOTALKEYS(proto_perl->Istrtab));
ptr_table_store(PL_ptr_table, proto_perl->Istrtab, PL_strtab);
+ Zero(PL_sv_consts, SV_CONSTS_COUNT, SV*);
+
/* This PV will be free'd special way so must set it same way op.c does */
PL_compiling.cop_file = savesharedpv(PL_compiling.cop_file);
ptr_table_store(PL_ptr_table, proto_perl->Icompiling.cop_file, PL_compiling.cop_file);
/* Unicode inversion lists */
PL_ASCII = sv_dup_inc(proto_perl->IASCII, param);
PL_Latin1 = sv_dup_inc(proto_perl->ILatin1, param);
+ PL_AboveLatin1 = sv_dup_inc(proto_perl->IAboveLatin1, param);
PL_NonL1NonFinalFold = sv_dup_inc(proto_perl->INonL1NonFinalFold, param);
PL_HasMultiCharFold= sv_dup_inc(proto_perl->IHasMultiCharFold, param);
PL_utf8_foldable = sv_dup_inc(proto_perl->Iutf8_foldable, param);
PL_utf8_charname_begin = sv_dup_inc(proto_perl->Iutf8_charname_begin, param);
PL_utf8_charname_continue = sv_dup_inc(proto_perl->Iutf8_charname_continue, param);
- PL_ASCII = sv_dup_inc(proto_perl->IASCII, param);
- PL_AboveLatin1 = sv_dup_inc(proto_perl->IAboveLatin1, param);
- PL_Latin1 = sv_dup_inc(proto_perl->ILatin1, param);
if (proto_perl->Ipsig_pend) {
Newxz(PL_psig_pend, SIG_SIZE, int);
break;
}
else {
+ SV * const opsv = cSVOPx_sv(kid);
+ const IV opsviv = SvIV(opsv);
SV * const * const svp = av_fetch(MUTABLE_AV(sv),
- negate ? - SvIV(cSVOPx_sv(kid)) : SvIV(cSVOPx_sv(kid)),
+ negate ? - opsviv : opsviv,
FALSE);
if (!svp || *svp != uninit_sv)
break;
https://perl5.git.perl.org / perl5.git / blobdiff