/* 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_BIND, TRUE, NONV, NOARENA, 0 },
+ { 0, 0, 0, SVt_DUMMY, TRUE, NONV, NOARENA, 0 },
/* IVs are in the head, so the allocation size is 0. */
{ 0,
assert(!SvPAD_TYPED(sv));
break;
default:
- if (old_type_details->cant_upgrade)
+ if (UNLIKELY(old_type_details->cant_upgrade))
Perl_croak(aTHX_ "Can't upgrade %s (%" UVuf ") to %" UVuf,
sv_reftype(sv, 0), (UV) old_type, (UV) new_type);
}
- if (old_type > new_type)
+ if (UNLIKELY(old_type > new_type))
Perl_croak(aTHX_ "sv_upgrade from type %d down to type %d",
(int)old_type, (int)new_type);
SvNV_set(sv, 0);
#endif
- if (new_type == SVt_PVIO) {
+ if (UNLIKELY(new_type == SVt_PVIO)) {
IO * const io = MUTABLE_IO(sv);
GV *iogv = gv_fetchpvs("IO::File::", GV_ADD, SVt_PVHV);
SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
IoPAGE_LEN(sv) = 60;
}
- if (new_type == SVt_REGEXP)
+ if (UNLIKELY(new_type == SVt_REGEXP))
sv->sv_u.svu_rx = (regexp *)new_body;
else if (old_type < SVt_PV) {
/* referant will be NULL unless the old type was SVt_IV emulating
PERL_ARGS_ASSERT_SV_GROW;
- if (PL_madskills && newlen >= 0x100000) {
- PerlIO_printf(Perl_debug_log,
- "Allocation too large: %"UVxf"\n", (UV)newlen);
- }
#ifdef HAS_64K_LIMIT
if (newlen >= 0x10000) {
PerlIO_printf(Perl_debug_log,
s = SvPVX_mutable(sv);
}
+#ifdef PERL_NEW_COPY_ON_WRITE
+ /* the new COW scheme uses SvPVX(sv)[SvLEN(sv)-1] (if spare)
+ * to store the COW count. So in general, allocate one more byte than
+ * asked for, to make it likely this byte is always spare: and thus
+ * make more strings COW-able.
+ * If the new size is a big power of two, don't bother: we assume the
+ * caller wanted a nice 2^N sized block and will be annoyed at getting
+ * 2^N+1 */
+ if (newlen & 0xff)
+ newlen++;
+#endif
+
if (newlen > SvLEN(sv)) { /* need more room? */
STRLEN minlen = SvCUR(sv);
minlen += (minlen >> PERL_STRLEN_EXPAND_SHIFT) + 10;
);
}
else if(mro_changes) mro_method_changed_in(GvSTASH(dstr));
+ if (GvIO(dstr) && dtype == SVt_PVGV) {
+ DEBUG_o(Perl_deb(aTHX_
+ "glob_assign_glob clearing PL_stashcache\n"));
+ /* It's a cache. It will rebuild itself quite happily.
+ It's a lot of effort to work out exactly which key (or keys)
+ might be invalidated by the creation of the this file handle.
+ */
+ hv_clear(PL_stashcache);
+ }
return;
}
}
break;
- /* case SVt_BIND: */
+ /* case SVt_DUMMY: */
case SVt_PVLV:
case SVt_PVGV:
case SVt_PVMG:
SvREFCNT_dec(SvSTASH(sv));
}
switch (type) {
- /* case SVt_BIND: */
+ /* case SVt_DUMMY: */
case SVt_PVIO:
if (IoIFP(sv) &&
IoIFP(sv) != PerlIO_stdin() &&
PL_last_in_gv = NULL;
else if ((const GV *)sv == PL_statgv)
PL_statgv = NULL;
+ else if ((const GV *)sv == PL_stderrgv)
+ PL_stderrgv = NULL;
case SVt_PVMG:
case SVt_PVNV:
case SVt_PVIV:
SvOBJECT_off(sv); /* Curse the object. */
SvSTASH_set(sv,0); /* SvREFCNT_dec may try to read this */
SvREFCNT_dec(stash); /* possibly of changed persuasion */
- if (SvTYPE(sv) != SVt_PVIO)
- --PL_sv_objcount;/* XXX Might want something more general */
}
return TRUE;
}
char todo[PERL_UCHAR_MAX+1];
const char *send;
- if (!stash)
+ if (!stash || SvTYPE(stash) != SVt_PVHV)
return;
if (!s) { /* reset ?? searches */
? "GLOB" : "SCALAR");
case SVt_PVFM: return "FORMAT";
case SVt_PVIO: return "IO";
- case SVt_BIND: return "BIND";
+ case SVt_DUMMY: return "DUMMY";
case SVt_REGEXP: return "REGEXP";
default: return "UNKNOWN";
}
if (SvREADONLY(tmpRef) && !SvIsCOW(tmpRef))
Perl_croak_no_modify();
if (SvOBJECT(tmpRef)) {
- if (SvTYPE(tmpRef) != SVt_PVIO)
- --PL_sv_objcount;
SvREFCNT_dec(SvSTASH(tmpRef));
}
}
SvOBJECT_on(tmpRef);
- if (SvTYPE(tmpRef) != SVt_PVIO)
- ++PL_sv_objcount;
SvUPGRADE(tmpRef, SVt_PVMG);
SvSTASH_set(tmpRef, MUTABLE_HV(SvREFCNT_inc_simple(stash)));
have = esignlen + zeros + elen;
if (have < zeros)
- croak_memory_wrap();
+ Perl_croak_memory_wrap();
need = (have > width ? have : width);
gap = need - have;
if (need >= (((STRLEN)~0) - SvCUR(sv) - dotstrlen - 1))
- croak_memory_wrap();
+ Perl_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_BIND: */
+ /* case SVt_DUMMY: */
default:
{
/* These are all the types that need complex bodies allocating. */
}
daux->xhv_name_count = saux->xhv_name_count;
+ daux->xhv_fill_lazy = saux->xhv_fill_lazy;
daux->xhv_riter = saux->xhv_riter;
daux->xhv_eiter = saux->xhv_eiter
? he_dup(saux->xhv_eiter,
}
}
- if (SvOBJECT(dstr) && SvTYPE(dstr) != SVt_PVIO)
- ++PL_sv_objcount;
-
return dstr;
}
sv = (const SV *)POPPTR(ss,ix);
TOPPTR(nss,ix) = sv_dup(sv, param);
break;
- case SAVEt_RE_STATE:
- {
- const struct re_save_state *const old_state
- = (struct re_save_state *)
- (ss + ix - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);
- struct re_save_state *const new_state
- = (struct re_save_state *)
- (nss + ix - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);
-
- Copy(old_state, new_state, 1, struct re_save_state);
- ix -= SAVESTACK_ALLOC_FOR_RE_SAVE_STATE;
-
- new_state->re_state_bostr
- = pv_dup(old_state->re_state_bostr);
- new_state->re_state_regeol
- = pv_dup(old_state->re_state_regeol);
-#ifdef PERL_ANY_COW
- new_state->re_state_nrs
- = sv_dup(old_state->re_state_nrs, param);
-#endif
- new_state->re_state_reg_magic
- = (MAGIC*) any_dup(old_state->re_state_reg_magic,
- proto_perl);
- new_state->re_state_reg_oldcurpm
- = (PMOP*) any_dup(old_state->re_state_reg_oldcurpm,
- proto_perl);
- new_state->re_state_reg_curpm
- = (PMOP*) any_dup(old_state->re_state_reg_curpm,
- proto_perl);
- new_state->re_state_reg_oldsaved
- = pv_dup(old_state->re_state_reg_oldsaved);
- new_state->re_state_reg_poscache
- = pv_dup(old_state->re_state_reg_poscache);
- new_state->re_state_reg_starttry
- = pv_dup(old_state->re_state_reg_starttry);
- break;
- }
case SAVEt_COMPILE_WARNINGS:
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = DUP_WARNINGS((STRLEN*)ptr);
Zero(&PL_body_roots, 1, PL_body_roots);
PL_sv_count = 0;
- PL_sv_objcount = 0;
PL_sv_root = NULL;
PL_sv_arenaroot = NULL;
#endif
/* RE engine related */
- Zero(&PL_reg_state, 1, struct re_save_state);
PL_regmatch_slab = NULL;
+ PL_reg_curpm = NULL;
PL_sub_generation = proto_perl->Isub_generation;
/* regex stuff */
- PL_regdummy = proto_perl->Iregdummy;
PL_colorset = 0; /* reinits PL_colors[] */
/*PL_colors[6] = {0,0,0,0,0,0};*/
PL_errors = sv_dup_inc(proto_perl->Ierrors, 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);
https://perl5.git.perl.org / perl5.git / blobdiff