return TRUE;
}
-STATIC char *
-S_glob_2pv(pTHX_ GV * const gv, STRLEN * const len)
-{
- const U32 wasfake = SvFLAGS(gv) & SVf_FAKE;
- SV *const buffer = sv_newmortal();
-
- PERL_ARGS_ASSERT_GLOB_2PV;
-
- /* FAKE globs can get coerced, so need to turn this off temporarily if it
- is on. */
- SvFAKE_off(gv);
- gv_efullname3(buffer, gv, "*");
- SvFLAGS(gv) |= wasfake;
-
- assert(SvPOK(buffer));
- if (len) {
- *len = SvCUR(buffer);
- }
- return SvPVX(buffer);
-}
-
/* Actually, ISO C leaves conversion of UV to IV undefined, but
until proven guilty, assume that things are not that bad... */
#endif
}
else {
- if (isGV_with_GP(sv))
- return glob_2pv(MUTABLE_GV(sv), lp);
+ if (isGV_with_GP(sv)) {
+ GV *const gv = MUTABLE_GV(sv);
+ const U32 wasfake = SvFLAGS(gv) & SVf_FAKE;
+ SV *const buffer = sv_newmortal();
+
+ /* FAKE globs can get coerced, so need to turn this off temporarily
+ if it is on. */
+ SvFAKE_off(gv);
+ gv_efullname3(buffer, gv, "*");
+ SvFLAGS(gv) |= wasfake;
+
+ assert(SvPOK(buffer));
+ if (lp) {
+ *lp = SvCUR(buffer);
+ }
+ return SvPVX(buffer);
+ }
if (lp)
*lp = 0;
goto common;
case SVt_PVFM:
location = (SV **) &GvFORM(dstr);
+ goto common;
default:
location = &GvSV(dstr);
import_flag = GVf_IMPORTED_SV;
/* Certain cases in Perl_ss_dup have been merged, by relying on the fact
that currently av_dup, gv_dup and hv_dup are the same as sv_dup.
- If this changes, please unmerge ss_dup. */
+ If this changes, please unmerge ss_dup.
+ Likewise, sv_dup_inc_multiple() relies on this fact. */
#define sv_dup_inc(s,t) SvREFCNT_inc(sv_dup(s,t))
#define sv_dup_inc_NN(s,t) SvREFCNT_inc_NN(sv_dup(s,t))
#define av_dup(s,t) MUTABLE_AV(sv_dup((const SV *)s,t))
ptr_table_store(PL_ptr_table, gp, ret);
/* clone */
- ret->gp_refcnt = 0; /* must be before any other dups! */
+ /* ret->gp_refcnt must be 0 before any other dups are called. We're relying
+ on Newxz() to do this for us. */
ret->gp_sv = sv_dup_inc(gp->gp_sv, param);
ret->gp_io = io_dup_inc(gp->gp_io, param);
ret->gp_form = cv_dup_inc(gp->gp_form, param);
ret->gp_cv = cv_dup_inc(gp->gp_cv, param);
ret->gp_cvgen = gp->gp_cvgen;
ret->gp_line = gp->gp_line;
- ret->gp_file_hek = gp->gp_file_hek ? hek_dup(gp->gp_file_hek, param) : NULL;
+ ret->gp_file_hek = hek_dup(gp->gp_file_hek, param);
return ret;
}
MAGIC *
Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *const param)
{
- MAGIC *mgprev = (MAGIC*)NULL;
- MAGIC *mgret;
+ MAGIC *mgret = NULL;
+ MAGIC **mgprev_p = &mgret;
PERL_ARGS_ASSERT_MG_DUP;
- if (!mg)
- return (MAGIC*)NULL;
- /* look for it in the table first */
- mgret = (MAGIC*)ptr_table_fetch(PL_ptr_table, mg);
- if (mgret)
- return mgret;
-
for (; mg; mg = mg->mg_moremagic) {
MAGIC *nmg;
- Newxz(nmg, 1, MAGIC);
- if (mgprev)
- mgprev->mg_moremagic = nmg;
- else
- mgret = nmg;
- nmg->mg_virtual = mg->mg_virtual; /* XXX copy dynamic vtable? */
- nmg->mg_private = mg->mg_private;
- nmg->mg_type = mg->mg_type;
- nmg->mg_flags = mg->mg_flags;
+ Newx(nmg, 1, MAGIC);
+ *mgprev_p = nmg;
+ mgprev_p = &(nmg->mg_moremagic);
+
+ /* There was a comment "XXX copy dynamic vtable?" but as we don't have
+ dynamic vtables, I'm not sure why Sarathy wrote it. The comment dates
+ from the original commit adding Perl_mg_dup() - revision 4538.
+ Similarly there is the annotation "XXX random ptr?" next to the
+ assignment to nmg->mg_ptr. */
+ *nmg = *mg;
+
/* FIXME for plugins
- if (mg->mg_type == PERL_MAGIC_qr) {
- nmg->mg_obj = MUTABLE_SV(CALLREGDUPE((REGEXP*)mg->mg_obj, param));
+ if (nmg->mg_type == PERL_MAGIC_qr) {
+ nmg->mg_obj = MUTABLE_SV(CALLREGDUPE((REGEXP*)nmg->mg_obj, param));
}
else
*/
- if(mg->mg_type == PERL_MAGIC_backref) {
+ if(nmg->mg_type == PERL_MAGIC_backref) {
/* The backref AV has its reference count deliberately bumped by
1. */
nmg->mg_obj
- = SvREFCNT_inc(av_dup_inc((const AV *) mg->mg_obj, param));
+ = SvREFCNT_inc(av_dup_inc((const AV *) nmg->mg_obj, param));
}
else {
- nmg->mg_obj = (mg->mg_flags & MGf_REFCOUNTED)
- ? sv_dup_inc(mg->mg_obj, param)
- : sv_dup(mg->mg_obj, param);
- }
- nmg->mg_len = mg->mg_len;
- nmg->mg_ptr = mg->mg_ptr; /* XXX random ptr? */
- if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
- if (mg->mg_len > 0) {
- nmg->mg_ptr = SAVEPVN(mg->mg_ptr, mg->mg_len);
- if (mg->mg_type == PERL_MAGIC_overload_table &&
- AMT_AMAGIC((AMT*)mg->mg_ptr))
+ nmg->mg_obj = (nmg->mg_flags & MGf_REFCOUNTED)
+ ? sv_dup_inc(nmg->mg_obj, param)
+ : sv_dup(nmg->mg_obj, param);
+ }
+
+ if (nmg->mg_ptr && nmg->mg_type != PERL_MAGIC_regex_global) {
+ if (nmg->mg_len > 0) {
+ nmg->mg_ptr = SAVEPVN(nmg->mg_ptr, nmg->mg_len);
+ if (nmg->mg_type == PERL_MAGIC_overload_table &&
+ AMT_AMAGIC((AMT*)nmg->mg_ptr))
{
- const AMT * const amtp = (AMT*)mg->mg_ptr;
AMT * const namtp = (AMT*)nmg->mg_ptr;
- I32 i;
- for (i = 1; i < NofAMmeth; i++) {
- namtp->table[i] = cv_dup_inc(amtp->table[i], param);
- }
+ sv_dup_inc_multiple((SV**)(namtp->table),
+ (SV**)(namtp->table), NofAMmeth, param);
}
}
- else if (mg->mg_len == HEf_SVKEY)
- nmg->mg_ptr = (char*)sv_dup_inc((const SV *)mg->mg_ptr, param);
+ else if (nmg->mg_len == HEf_SVKEY)
+ nmg->mg_ptr = (char*)sv_dup_inc((const SV *)nmg->mg_ptr, param);
}
- if ((mg->mg_flags & MGf_DUP) && mg->mg_virtual && mg->mg_virtual->svt_dup) {
+ if ((nmg->mg_flags & MGf_DUP) && nmg->mg_virtual && nmg->mg_virtual->svt_dup) {
CALL_FPTR(nmg->mg_virtual->svt_dup)(aTHX_ nmg, param);
}
- mgprev = nmg;
}
return mgret;
}
PTR_TBL_t *tbl;
PERL_UNUSED_CONTEXT;
- Newxz(tbl, 1, PTR_TBL_t);
+ Newx(tbl, 1, PTR_TBL_t);
tbl->tbl_max = 511;
tbl->tbl_items = 0;
Newxz(tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
}
}
+/* duplicate a list of SVs. source and dest may point to the same memory. */
+static SV **
+S_sv_dup_inc_multiple(pTHX_ SV *const *source, SV **dest,
+ SSize_t items, CLONE_PARAMS *const param)
+{
+ PERL_ARGS_ASSERT_SV_DUP_INC_MULTIPLE;
+
+ while (items-- > 0) {
+ *dest++ = sv_dup_inc(*source++, param);
+ }
+
+ return dest;
+}
+
/* duplicate an SV of any type (including AV, HV etc) */
SV *
LvTARG(dstr) = sv_dup_inc(LvTARG(dstr), param);
case SVt_PVGV:
if(isGV_with_GP(sstr)) {
- if (GvNAME_HEK(dstr))
- GvNAME_HEK(dstr) = hek_dup(GvNAME_HEK(dstr), param);
+ GvNAME_HEK(dstr) = hek_dup(GvNAME_HEK(dstr), param);
/* Don't call sv_add_backref here as it's going to be
created as part of the magic cloning of the symbol
table. */
AvARRAY(MUTABLE_AV(dstr)) = dst_ary;
AvALLOC((const AV *)dstr) = dst_ary;
if (AvREAL((const AV *)sstr)) {
- while (items-- > 0)
- *dst_ary++ = sv_dup_inc(*src_ary++, param);
+ dst_ary = sv_dup_inc_multiple(src_ary, dst_ary, items,
+ param);
}
else {
while (items-- > 0)
SvFLAGS(dstr) |= SVf_OOK;
hvname = saux->xhv_name;
- daux->xhv_name = hvname ? hek_dup(hvname, param) : hvname;
+ daux->xhv_name = hek_dup(hvname, param);
daux->xhv_riter = saux->xhv_riter;
daux->xhv_eiter = saux->xhv_eiter
PL_glob_index = proto_perl->Iglob_index;
PL_srand_called = proto_perl->Isrand_called;
- PL_bitcount = NULL; /* reinits on demand */
if (proto_perl->Ipsig_pend) {
Newxz(PL_psig_pend, SIG_SIZE, int);
PL_psig_pend = (int*)NULL;
}
- if (proto_perl->Ipsig_ptr) {
- Newxz(PL_psig_ptr, SIG_SIZE, SV*);
- Newxz(PL_psig_name, SIG_SIZE, SV*);
- for (i = 1; i < SIG_SIZE; i++) {
- PL_psig_ptr[i] = sv_dup_inc(proto_perl->Ipsig_ptr[i], param);
- PL_psig_name[i] = sv_dup_inc(proto_perl->Ipsig_name[i], param);
- }
+ if (proto_perl->Ipsig_name) {
+ Newx(PL_psig_name, 2 * SIG_SIZE, SV*);
+ sv_dup_inc_multiple(proto_perl->Ipsig_name, PL_psig_name, 2 * SIG_SIZE,
+ param);
+ PL_psig_ptr = PL_psig_name + SIG_SIZE;
}
else {
PL_psig_ptr = (SV**)NULL;
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->Itmps_stack[i], param);
- ++i;
- }
+ Newx(PL_tmps_stack, PL_tmps_max, SV*);
+ sv_dup_inc_multiple(proto_perl->Itmps_stack, PL_tmps_stack, PL_tmps_ix,
+ param);
/* next PUSHMARK() sets *(PL_markstack_ptr+1) */
i = proto_perl->Imarkstack_max - proto_perl->Imarkstack;