}
DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%"UVuf")\n",
- (UV)sv,SvUVX(sv)));
+ PTR2UV(sv),SvUVX(sv)));
return SvIsUV(sv) ? SvUVX(sv) : (UV)SvIVX(sv);
}
SvTYPE(SvRV(sstr)) == SVt_PVGV) {
sstr = SvRV(sstr);
if (sstr == dstr) {
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED(dstr) != GVf_IMPORTED
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+ {
GvIMPORTED_on(dstr);
+ }
GvMULTI_on(dstr);
return;
}
gp_free((GV*)dstr);
GvGP(dstr) = gp_ref(GvGP(sstr));
SvTAINT(dstr);
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED(dstr) != GVf_IMPORTED
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+ {
GvIMPORTED_on(dstr);
+ }
GvMULTI_on(dstr);
return;
}
if (intro) {
GP *gp;
- GvGP(dstr)->gp_refcnt--;
+ gp_free((GV*)dstr);
GvINTRO_off(dstr); /* one-shot flag */
Newz(602,gp, 1, GP);
GvGP(dstr) = gp_ref(gp);
GvSV(dstr) = NEWSV(72,0);
- GvLINE(dstr) = PL_curcop->cop_line;
+ GvLINE(dstr) = CopLINE(PL_curcop);
GvEGV(dstr) = (GV*)dstr;
}
GvMULTI_on(dstr);
else
dref = (SV*)GvAV(dstr);
GvAV(dstr) = (AV*)sref;
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_AV_off(dstr)
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+ {
GvIMPORTED_AV_on(dstr);
+ }
break;
case SVt_PVHV:
if (intro)
else
dref = (SV*)GvHV(dstr);
GvHV(dstr) = (HV*)sref;
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_HV_off(dstr)
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+ {
GvIMPORTED_HV_on(dstr);
+ }
break;
case SVt_PVCV:
if (intro) {
GvASSUMECV_on(dstr);
PL_sub_generation++;
}
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_CV_off(dstr)
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+ {
GvIMPORTED_CV_on(dstr);
+ }
break;
case SVt_PVIO:
if (intro)
else
dref = (SV*)GvSV(dstr);
GvSV(dstr) = sref;
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_SV_off(dstr)
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+ {
GvIMPORTED_SV_on(dstr);
+ }
break;
}
if (dref)
/* SIZE */
switch (*q) {
-#ifdef Quad_t
+#ifdef HAS_QUAD
case 'L': /* Ld */
case 'q': /* qd */
intsize = 'q';
break;
#endif
case 'l':
-#ifdef Quad_t
+#ifdef HAS_QUAD
if (*(q + 1) == 'l') { /* lld */
intsize = 'q';
q += 2;
if (args) {
eptr = va_arg(*args, char*);
if (eptr)
+#ifdef MACOS_TRADITIONAL
+ /* On MacOS, %#s format is used for Pascal strings */
+ if (alt)
+ elen = *eptr++;
+ else
+#endif
elen = strlen(eptr);
else {
eptr = nullstr;
default: iv = va_arg(*args, int); break;
case 'l': iv = va_arg(*args, long); break;
case 'V': iv = va_arg(*args, IV); break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
case 'q': iv = va_arg(*args, Quad_t); break;
#endif
}
default: iv = (int)iv; break;
case 'l': iv = (long)iv; break;
case 'V': break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
case 'q': iv = (Quad_t)iv; break;
#endif
}
default: uv = va_arg(*args, unsigned); break;
case 'l': uv = va_arg(*args, unsigned long); break;
case 'V': uv = va_arg(*args, UV); break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
case 'q': uv = va_arg(*args, Quad_t); break;
#endif
}
default: uv = (unsigned)uv; break;
case 'l': uv = (unsigned long)uv; break;
case 'V': break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
case 'q': uv = (Quad_t)uv; break;
#endif
}
default: *(va_arg(*args, int*)) = i; break;
case 'l': *(va_arg(*args, long*)) = i; break;
case 'V': *(va_arg(*args, IV*)) = i; break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
case 'q': *(va_arg(*args, Quad_t*)) = i; break;
#endif
}
#endif
#ifndef OpREFCNT_inc
-# define OpREFCNT_inc(o) o
+# define OpREFCNT_inc(o) ((o) ? (++(o)->op_targ, (o)) : Nullop)
+#endif
+
+#ifndef GpREFCNT_inc
+# define GpREFCNT_inc(gp) ((gp) ? (++(gp)->gp_refcnt, (gp)) : (GP*)NULL)
#endif
+
#define sv_dup_inc(s) SvREFCNT_inc(sv_dup(s))
#define av_dup(s) (AV*)sv_dup((SV*)s)
#define av_dup_inc(s) (AV*)SvREFCNT_inc(sv_dup((SV*)s))
GP *ret;
if (!gp)
return (GP*)NULL;
+ /* look for it in the table first */
+ ret = ptr_table_fetch(PL_ptr_table, gp);
+ if (ret)
+ return ret;
+
+ /* create anew and remember what it is */
Newz(0, ret, 1, GP);
+ ptr_table_store(PL_ptr_table, gp, ret);
+
+ /* clone */
+ ret->gp_refcnt = 0; /* must be before any other dups! */
ret->gp_sv = sv_dup_inc(gp->gp_sv);
ret->gp_io = io_dup_inc(gp->gp_io);
ret->gp_form = cv_dup_inc(gp->gp_form);
ret->gp_av = av_dup_inc(gp->gp_av);
ret->gp_hv = hv_dup_inc(gp->gp_hv);
- ret->gp_egv = gv_dup_inc(gp->gp_egv);
+ ret->gp_egv = gv_dup(gp->gp_egv); /* GvEGV is not refcounted */
ret->gp_cv = cv_dup_inc(gp->gp_cv);
ret->gp_cvgen = gp->gp_cvgen;
ret->gp_flags = gp->gp_flags;
ret->gp_line = gp->gp_line;
ret->gp_file = gp->gp_file; /* points to COP.cop_file */
- ret->gp_refcnt = 0;
return ret;
}
MAGIC *mgprev;
if (!mg)
return (MAGIC*)NULL;
+ /* XXX need to handle aliases here? */
+
for (; mg; mg = mg->mg_moremagic) {
MAGIC *nmg;
Newz(0, nmg, 1, MAGIC);
nmg->mg_len = mg->mg_len;
nmg->mg_ptr = mg->mg_ptr; /* XXX random ptr? */
if (mg->mg_ptr && mg->mg_type != 'g') {
- if (mg->mg_len >= 0)
+ if (mg->mg_len >= 0) {
nmg->mg_ptr = SAVEPVN(mg->mg_ptr, mg->mg_len);
+ if (mg->mg_type == 'c' && AMT_AMAGIC((AMT*)mg->mg_ptr)) {
+ AMT *amtp = (AMT*)mg->mg_ptr;
+ AMT *namtp = (AMT*)nmg->mg_ptr;
+ I32 i;
+ for (i = 1; i < NofAMmeth; i++) {
+ namtp->table[i] = cv_dup_inc(amtp->table[i]);
+ }
+ }
+ }
else if (mg->mg_len == HEf_SVKEY)
nmg->mg_ptr = (char*)sv_dup_inc((SV*)mg->mg_ptr);
}
return mgret;
}
-SVTBL *
-Perl_sv_table_new(pTHX)
+PTR_TBL_t *
+Perl_ptr_table_new(pTHX)
{
- SVTBL *tbl;
- Newz(0, tbl, 1, SVTBL);
+ PTR_TBL_t *tbl;
+ Newz(0, tbl, 1, PTR_TBL_t);
tbl->tbl_max = 511;
tbl->tbl_items = 0;
- Newz(0, tbl->tbl_ary, tbl->tbl_max + 1, SVTBLENT*);
+ Newz(0, tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
return tbl;
}
-SV *
-Perl_sv_table_fetch(pTHX_ SVTBL *tbl, SV *sv)
+void *
+Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv)
{
- SVTBLENT *tblent;
+ PTR_TBL_ENT_t *tblent;
UV hash = (UV)sv;
assert(tbl);
tblent = tbl->tbl_ary[hash & tbl->tbl_max];
if (tblent->oldval == sv)
return tblent->newval;
}
- return Nullsv;
+ return (void*)NULL;
}
void
-Perl_sv_table_store(pTHX_ SVTBL *tbl, SV *old, SV *new)
+Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *old, void *new)
{
- SVTBLENT *tblent, **otblent;
+ PTR_TBL_ENT_t *tblent, **otblent;
+ /* XXX this may be pessimal on platforms where pointers aren't good
+ * hash values e.g. if they grow faster in the most significant
+ * bits */
UV hash = (UV)old;
bool i = 1;
+
assert(tbl);
otblent = &tbl->tbl_ary[hash & tbl->tbl_max];
for (tblent = *otblent; tblent; i=0, tblent = tblent->next) {
return;
}
}
- Newz(0, tblent, 1, SVTBLENT);
+ Newz(0, tblent, 1, PTR_TBL_ENT_t);
tblent->oldval = old;
tblent->newval = new;
tblent->next = *otblent;
*otblent = tblent;
tbl->tbl_items++;
if (i && tbl->tbl_items > tbl->tbl_max)
- sv_table_split(tbl);
+ ptr_table_split(tbl);
}
void
-Perl_sv_table_split(pTHX_ SVTBL *tbl)
+Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl)
{
- SVTBLENT **ary = tbl->tbl_ary;
+ PTR_TBL_ENT_t **ary = tbl->tbl_ary;
UV oldsize = tbl->tbl_max + 1;
UV newsize = oldsize * 2;
UV i;
- Renew(ary, newsize, SVTBLENT*);
- Zero(&ary[oldsize], newsize-oldsize, SVTBLENT*);
+ Renew(ary, newsize, PTR_TBL_ENT_t*);
+ Zero(&ary[oldsize], newsize-oldsize, PTR_TBL_ENT_t*);
tbl->tbl_max = --newsize;
tbl->tbl_ary = ary;
for (i=0; i < oldsize; i++, ary++) {
- SVTBLENT **curentp, **entp, *ent;
+ PTR_TBL_ENT_t **curentp, **entp, *ent;
if (!*ary)
continue;
curentp = ary + oldsize;
}
}
+#ifdef DEBUGGING
+DllExport char *PL_watch_pvx;
+#endif
+
SV *
Perl_sv_dup(pTHX_ SV *sstr)
{
int stype;
SV *dstr;
- if (!sstr)
+ if (!sstr || SvTYPE(sstr) == SVTYPEMASK)
return Nullsv;
/* look for it in the table first */
- dstr = sv_table_fetch(PL_sv_table, sstr);
+ dstr = ptr_table_fetch(PL_ptr_table, sstr);
if (dstr)
return dstr;
- /* XXX TODO: sanity-check sv_dup() vs sv_dup_inc() appropriateness */
-
/* create anew and remember what it is */
new_SV(dstr);
- sv_table_store(PL_sv_table, sstr, dstr);
+ ptr_table_store(PL_ptr_table, sstr, dstr);
/* clone */
SvFLAGS(dstr) = SvFLAGS(sstr);
SvFLAGS(dstr) &= ~SVf_OOK; /* don't propagate OOK hack */
- SvREFCNT(dstr) = 0;
+ SvREFCNT(dstr) = 0; /* must be before any other dups! */
+
+#ifdef DEBUGGING
+ if (SvANY(sstr) && PL_watch_pvx && SvPVX(sstr) == PL_watch_pvx)
+ PerlIO_printf(Perl_debug_log, "watch at %p hit, found string \"%s\"\n",
+ PL_watch_pvx, SvPVX(sstr));
+#endif
switch (SvTYPE(sstr)) {
case SVt_NULL:
SvANY(dstr) = new_XPV();
SvCUR(dstr) = SvCUR(sstr);
SvLEN(dstr) = SvLEN(sstr);
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
break;
SvCUR(dstr) = SvCUR(sstr);
SvLEN(dstr) = SvLEN(sstr);
SvIVX(dstr) = SvIVX(sstr);
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
break;
SvLEN(dstr) = SvLEN(sstr);
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
break;
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
- if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
- SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
- else
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
break;
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
- if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
- SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
- else
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
- if (SvPOKp(sstr) && SvLEN(sstr))
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
- if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
- SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
- else
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
LvTARGOFF(dstr) = LvTARGOFF(sstr); /* XXX sometimes holds PMOP* when DEBUGGING */
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
- if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
- SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
- else
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
GvNAMELEN(dstr) = GvNAMELEN(sstr);
GvSTASH(dstr) = hv_dup_inc(GvSTASH(sstr));
GvFLAGS(dstr) = GvFLAGS(sstr);
GvGP(dstr) = gp_dup(GvGP(sstr));
- GvGP(dstr)->gp_refcnt++;
+ (void)GpREFCNT_inc(GvGP(dstr));
break;
case SVt_PVIO:
SvANY(dstr) = new_XPVIO();
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
- if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
- SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
- else
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
IoIFP(dstr) = fp_dup(IoIFP(sstr), IoTYPE(sstr));
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
AvARYLEN((AV*)dstr) = sv_dup_inc(AvARYLEN((AV*)sstr));
AvFLAGS((AV*)dstr) = AvFLAGS((AV*)sstr);
- if (AvALLOC((AV*)sstr)) {
+ if (AvARRAY((AV*)sstr)) {
SV **dst_ary, **src_ary;
SSize_t items = AvFILLp((AV*)sstr) + 1;
- src_ary = AvALLOC((AV*)sstr);
+ src_ary = AvARRAY((AV*)sstr);
Newz(0, dst_ary, AvMAX((AV*)sstr)+1, SV*);
SvPVX(dstr) = (char*)dst_ary;
AvALLOC((AV*)dstr) = dst_ary;
else
dxhv->xhv_eiter = (HE*)NULL;
}
- else
+ else {
SvPVX(dstr) = Nullch;
+ HvEITER((HV*)dstr) = (HE*)NULL;
+ }
HvPMROOT((HV*)dstr) = HvPMROOT((HV*)sstr); /* XXX */
HvNAME((HV*)dstr) = SAVEPV(HvNAME((HV*)sstr));
break;
case SVt_PVFM:
SvANY(dstr) = new_XPVFM();
+ FmLINES(dstr) = FmLINES(sstr);
goto dup_pvcv;
/* NOTREACHED */
case SVt_PVCV:
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
- if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
- SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
- else
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
- if (SvPOKp(sstr) && SvLEN(sstr))
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
CvSTASH(dstr) = hv_dup(CvSTASH(sstr));/* NOTE: not refcounted */
CvXSUBANY(dstr) = CvXSUBANY(sstr);
CvGV(dstr) = gv_dup_inc(CvGV(sstr));
CvDEPTH(dstr) = CvDEPTH(sstr);
- CvPADLIST(dstr) = av_dup_inc(CvPADLIST(sstr));
+ if (CvPADLIST(sstr) && !AvREAL(CvPADLIST(sstr))) {
+ /* XXX padlists are real, but pretend to be not */
+ AvREAL_on(CvPADLIST(sstr));
+ CvPADLIST(dstr) = av_dup_inc(CvPADLIST(sstr));
+ AvREAL_off(CvPADLIST(sstr));
+ AvREAL_off(CvPADLIST(dstr));
+ }
+ else
+ CvPADLIST(dstr) = av_dup_inc(CvPADLIST(sstr));
CvOUTSIDE(dstr) = cv_dup_inc(CvOUTSIDE(sstr));
CvFLAGS(dstr) = CvFLAGS(sstr);
break;
break;
}
- if (SvOBJECT(dstr))
+ if (SvOBJECT(dstr) && SvTYPE(dstr) != SVt_PVIO)
++PL_sv_objcount;
return dstr;
}
+PERL_CONTEXT *
+Perl_cx_dup(pTHX_ PERL_CONTEXT *cx, I32 ix, I32 max)
+{
+ PERL_CONTEXT *ncx;
+
+ if (!cx)
+ return (PERL_CONTEXT*)NULL;
+
+ /* look for it in the table first */
+ ncx = ptr_table_fetch(PL_ptr_table, cx);
+ if (ncx)
+ return ncx;
+
+ /* create anew and remember what it is */
+ Newz(56, ncx, max + 1, PERL_CONTEXT);
+ ptr_table_store(PL_ptr_table, cx, ncx);
+
+ /* XXX todo */
+ /* ... */
+
+ return ncx;
+}
+
+PERL_SI *
+Perl_si_dup(pTHX_ PERL_SI *si)
+{
+ PERL_SI *nsi;
+
+ if (!si)
+ return (PERL_SI*)NULL;
+
+ /* look for it in the table first */
+ nsi = ptr_table_fetch(PL_ptr_table, si);
+ if (nsi)
+ return nsi;
+
+ /* create anew and remember what it is */
+ Newz(56, nsi, 1, PERL_SI);
+ ptr_table_store(PL_ptr_table, si, nsi);
+
+ nsi->si_stack = av_dup_inc(si->si_stack);
+ nsi->si_cxix = si->si_cxix;
+ nsi->si_cxmax = si->si_cxmax;
+ nsi->si_cxstack = cx_dup(si->si_cxstack, si->si_cxix, si->si_cxmax);
+ nsi->si_type = si->si_type;
+ nsi->si_prev = si_dup(si->si_prev);
+ nsi->si_next = si_dup(si->si_next);
+ nsi->si_markoff = si->si_markoff;
+
+ return nsi;
+}
+
+ANY *
+Perl_ss_dup(pTHX_ ANY *ss, I32 ix, I32 max)
+{
+ /* XXX todo */
+ return NULL;
+}
+
PerlInterpreter *
-perl_clone_using(PerlInterpreter *proto_perl, IV flags,
+perl_clone_using(PerlInterpreter *proto_perl, UV flags,
struct IPerlMem* ipM, struct IPerlEnv* ipE,
struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
struct IPerlDir* ipD, struct IPerlSock* ipS,
PL_savestack = 0;
PL_retstack = 0;
#else
+ Zero(my_perl, 1, PerlInterpreter);
# if 0
Copy(proto_perl, my_perl, 1, PerlInterpreter);
# endif
PL_debug = proto_perl->Idebug;
/* create SV map for pointer relocation */
- PL_sv_table = sv_table_new();
+ PL_ptr_table = ptr_table_new();
/* initialize these special pointers as early as possible */
SvANY(&PL_sv_undef) = NULL;
SvREFCNT(&PL_sv_undef) = (~(U32)0)/2;
SvFLAGS(&PL_sv_undef) = SVf_READONLY|SVt_NULL;
- sv_table_store(PL_sv_table, &proto_perl->Isv_undef, &PL_sv_undef);
+ ptr_table_store(PL_ptr_table, &proto_perl->Isv_undef, &PL_sv_undef);
SvANY(&PL_sv_no) = new_XPVNV();
SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
SvCUR(&PL_sv_no) = 0;
SvLEN(&PL_sv_no) = 1;
SvNVX(&PL_sv_no) = 0;
- sv_table_store(PL_sv_table, &proto_perl->Isv_no, &PL_sv_no);
+ ptr_table_store(PL_ptr_table, &proto_perl->Isv_no, &PL_sv_no);
SvANY(&PL_sv_yes) = new_XPVNV();
SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
SvCUR(&PL_sv_yes) = 1;
SvLEN(&PL_sv_yes) = 2;
SvNVX(&PL_sv_yes) = 1;
- sv_table_store(PL_sv_table, &proto_perl->Isv_yes, &PL_sv_yes);
+ ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
/* create shared string table */
PL_strtab = newHV();
HvSHAREKEYS_off(PL_strtab);
hv_ksplit(PL_strtab, 512);
- sv_table_store(PL_sv_table, (SV*)proto_perl->Istrtab, (SV*)PL_strtab);
+ ptr_table_store(PL_ptr_table, proto_perl->Istrtab, PL_strtab);
PL_compiling = proto_perl->Icompiling;
- PL_compiling.cop_stash = hv_dup(PL_compiling.cop_stash);
- PL_compiling.cop_filegv = gv_dup(PL_compiling.cop_filegv);
- PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings);
+ PL_compiling.cop_stashpv = SAVEPV(PL_compiling.cop_stashpv);
+ PL_compiling.cop_file = SAVEPV(PL_compiling.cop_file);
+ if (!specialWARN(PL_compiling.cop_warnings))
+ PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings);
if (proto_perl->Tcurcop == &proto_perl->Icompiling)
PL_curcop = &PL_compiling;
else
PL_perl_destruct_level = proto_perl->Iperl_destruct_level;
/* magical thingies */
- /* XXX time(&PL_basetime) instead? */
+ /* XXX time(&PL_basetime) when asked for? */
PL_basetime = proto_perl->Ibasetime;
PL_formfeed = sv_dup(proto_perl->Iformfeed);
PL_forkprocess = proto_perl->Iforkprocess;
/* subprocess state */
- PL_fdpid = av_dup(proto_perl->Ifdpid);
+ PL_fdpid = av_dup_inc(proto_perl->Ifdpid);
/* internal state */
PL_tainting = proto_perl->Itainting;
PL_eval_start = proto_perl->Ieval_start;
/* runtime control stuff */
- PL_curcopdb = proto_perl->Icurcopdb;
+ if (proto_perl->Icurcopdb == &proto_perl->Icompiling)
+ PL_curcopdb = &PL_compiling;
+ else
+ PL_curcopdb = proto_perl->Icurcopdb;
PL_copline = proto_perl->Icopline;
PL_filemode = proto_perl->Ifilemode;
PL_lastfd = proto_perl->Ilastfd;
- PL_oldname = proto_perl->Ioldname; /* XXX */
+ PL_oldname = proto_perl->Ioldname; /* XXX not quite right */
PL_Argv = NULL;
PL_Cmd = Nullch;
PL_gensym = proto_perl->Igensym;
}
else
PL_exitlist = (PerlExitListEntry*)NULL;
- PL_modglobal = hv_dup(proto_perl->Imodglobal);
+ PL_modglobal = hv_dup_inc(proto_perl->Imodglobal);
- PL_profiledata = NULL; /* XXX */
+ PL_profiledata = NULL;
PL_rsfp = fp_dup(proto_perl->Irsfp, '<');
- /* XXX PL_rsfp_filters entries have fake IoDIRP() */
- PL_rsfp_filters = av_dup(proto_perl->Irsfp_filters);
+ /* PL_rsfp_filters entries have fake IoDIRP() */
+ PL_rsfp_filters = av_dup_inc(proto_perl->Irsfp_filters);
PL_compcv = cv_dup(proto_perl->Icompcv);
PL_comppad = av_dup(proto_perl->Icomppad);
PL_comppad_name = av_dup(proto_perl->Icomppad_name);
PL_comppad_name_fill = proto_perl->Icomppad_name_fill;
PL_comppad_name_floor = proto_perl->Icomppad_name_floor;
- PL_curpad = AvARRAY(PL_comppad); /* XXX */
+ PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : (SV**)NULL;
#ifdef HAVE_INTERP_INTERN
sys_intern_dup(&proto_perl->Isys_intern, &PL_sys_intern);
PL_cop_seqmax = proto_perl->Icop_seqmax;
PL_op_seqmax = proto_perl->Iop_seqmax;
PL_evalseq = proto_perl->Ievalseq;
- PL_origenviron = proto_perl->Iorigenviron; /* XXX */
+ PL_origenviron = proto_perl->Iorigenviron; /* XXX not quite right */
PL_origalen = proto_perl->Iorigalen;
- PL_pidstatus = newHV();
+ PL_pidstatus = newHV(); /* XXX flag for cloning? */
PL_osname = SAVEPV(proto_perl->Iosname);
PL_sh_path = SAVEPV(proto_perl->Ish_path);
PL_sighandlerp = proto_perl->Isighandlerp;
PL_runops = proto_perl->Irunops;
- Copy(proto_perl->Itokenbuf, PL_tokenbuf, 256, char); /* XXX */
+ Copy(proto_perl->Itokenbuf, PL_tokenbuf, 256, char);
#ifdef CSH
PL_cshlen = proto_perl->Icshlen;
PL_lex_fakebrack = proto_perl->Ilex_fakebrack;
PL_lex_dojoin = proto_perl->Ilex_dojoin;
PL_lex_starts = proto_perl->Ilex_starts;
- PL_lex_stuff = Nullsv; /* XXX */
- PL_lex_repl = Nullsv; /* XXX */
+ PL_lex_stuff = sv_dup_inc(proto_perl->Ilex_stuff);
+ PL_lex_repl = sv_dup_inc(proto_perl->Ilex_repl);
PL_lex_op = proto_perl->Ilex_op;
PL_lex_inpat = proto_perl->Ilex_inpat;
PL_lex_inwhat = proto_perl->Ilex_inwhat;
i = proto_perl->Ilinestart - SvPVX(proto_perl->Ilinestr);
PL_linestart = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
PL_pending_ident = proto_perl->Ipending_ident;
- PL_sublex_info = proto_perl->Isublex_info; /* XXX */
+ PL_sublex_info = proto_perl->Isublex_info; /* XXX not quite right */
PL_expect = proto_perl->Iexpect;
PL_utf8_tolower = sv_dup_inc(proto_perl->Iutf8_tolower);
/* swatch cache */
- PL_last_swash_hv = Nullhv; /* XXX recreate swatch cache? */
+ PL_last_swash_hv = Nullhv; /* reinits on demand */
PL_last_swash_klen = 0;
PL_last_swash_key[0]= '\0';
PL_last_swash_tmps = Nullch;
PL_glob_index = proto_perl->Iglob_index;
PL_srand_called = proto_perl->Isrand_called;
- PL_uudmap['M'] = 0; /* reinit on demand */
- PL_bitcount = Nullch; /* reinit on demand */
+ PL_uudmap['M'] = 0; /* reinits on demand */
+ PL_bitcount = Nullch; /* reinits on demand */
/* thrdvar.h stuff */
-/* PL_curstackinfo = clone_stackinfo(proto_perl->Tcurstackinfo);
- clone_stacks();
- PL_mainstack = av_dup(proto_perl->Tmainstack);
- PL_curstack = av_dup(proto_perl->Tcurstack);*/ /* XXXXXX */
- init_stacks();
+ if (flags & 1) {
+ /* 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;
+ Newz(50, 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]);
+ ++i;
+ }
+
+ /* next PUSHMARK() sets *(PL_markstack_ptr+1) */
+ i = proto_perl->Tmarkstack_max - proto_perl->Tmarkstack;
+ Newz(54, 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_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;
+ Newz(54, PL_scopestack, PL_scopestack_max, I32);
+ Copy(proto_perl->Tscopestack, PL_scopestack, PL_scopestack_ix, I32);
+
+ /* 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;
+ /*Newz(54, PL_savestack, PL_savestack_max, ANY);*/
+ PL_savestack = ss_dup(proto_perl->Tsavestack,
+ PL_savestack_ix,
+ PL_savestack_max);
+
+ /* next push_return() sets PL_retstack[PL_retstack_ix]
+ * NOTE: unlike the others! */
+ PL_retstack_ix = proto_perl->Tretstack_ix;
+ PL_retstack_max = proto_perl->Tretstack_max;
+ Newz(54, PL_retstack, PL_retstack_max, OP*);
+ Copy(proto_perl->Tretstack, PL_retstack, PL_retstack_ix, I32);
+
+ /* NOTE: si_dup() looks at PL_markstack */
+ PL_curstackinfo = si_dup(proto_perl->Tcurstackinfo);
+
+ /* PL_curstack = PL_curstackinfo->si_stack; */
+ PL_curstack = av_dup(proto_perl->Tcurstack);
+ PL_mainstack = av_dup(proto_perl->Tmainstack);
+
+ /* 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_max = PL_stack_base + AvMAX(PL_curstack);
+ }
+ else {
+ init_stacks();
+ }
+
+ PL_start_env = proto_perl->Tstart_env; /* XXXXXX */
+ PL_top_env = &PL_start_env;
PL_op = proto_perl->Top;
+
+ PL_Sv = Nullsv;
+ PL_Xpv = (XPV*)NULL;
+ PL_na = proto_perl->Tna;
+
PL_statbuf = proto_perl->Tstatbuf;
PL_statcache = proto_perl->Tstatcache;
PL_statgv = gv_dup(proto_perl->Tstatgv);
- PL_statname = sv_dup(proto_perl->Tstatname);
+ PL_statname = sv_dup_inc(proto_perl->Tstatname);
#ifdef HAS_TIMES
PL_timesbuf = proto_perl->Ttimesbuf;
#endif
PL_ofslen = proto_perl->Tofslen;
PL_ofs = SAVEPVN(proto_perl->Tofs, PL_ofslen);
PL_defoutgv = gv_dup_inc(proto_perl->Tdefoutgv);
- PL_chopset = proto_perl->Tchopset; /* XXX */
+ PL_chopset = proto_perl->Tchopset; /* XXX never deallocated */
PL_toptarget = sv_dup_inc(proto_perl->Ttoptarget);
PL_bodytarget = sv_dup_inc(proto_perl->Tbodytarget);
PL_formtarget = sv_dup(proto_perl->Tformtarget);
PL_dirty = proto_perl->Tdirty;
PL_localizing = proto_perl->Tlocalizing;
- PL_start_env = proto_perl->Tstart_env; /* XXXXXX */
- PL_top_env = &PL_start_env;
PL_protect = proto_perl->Tprotect;
PL_errors = sv_dup_inc(proto_perl->Terrors);
PL_av_fetch_sv = Nullsv;
PL_modcount = proto_perl->Tmodcount;
PL_lastgotoprobe = Nullop;
PL_dumpindent = proto_perl->Tdumpindent;
+
+ if (proto_perl->Tsortcop == (OP*)&proto_perl->Icompiling)
+ PL_sortcop = (OP*)&PL_compiling;
+ else
+ PL_sortcop = proto_perl->Tsortcop;
PL_sortstash = hv_dup(proto_perl->Tsortstash);
PL_firstgv = gv_dup(proto_perl->Tfirstgv);
PL_secondgv = gv_dup(proto_perl->Tsecondgv);
PL_sortcxix = proto_perl->Tsortcxix;
- PL_efloatbuf = Nullch;
- PL_efloatsize = 0;
+ PL_efloatbuf = Nullch; /* reinits on demand */
+ PL_efloatsize = 0; /* reinits on demand */
+
+ /* regex stuff */
PL_screamfirst = NULL;
PL_screamnext = NULL;
- PL_maxscream = -1;
+ PL_maxscream = -1; /* reinits on demand */
PL_lastscream = Nullsv;
+ PL_watchaddr = NULL;
+ PL_watchok = Nullch;
+
+ PL_regdummy = proto_perl->Tregdummy;
+ PL_regcomp_parse = Nullch;
+ PL_regxend = Nullch;
+ PL_regcode = (regnode*)NULL;
+ PL_regnaughty = 0;
+ PL_regsawback = 0;
+ PL_regprecomp = Nullch;
+ PL_regnpar = 0;
+ PL_regsize = 0;
+ PL_regflags = 0;
+ PL_regseen = 0;
+ PL_seen_zerolen = 0;
+ PL_seen_evals = 0;
+ PL_regcomp_rx = (regexp*)NULL;
+ PL_extralen = 0;
+ PL_colorset = 0; /* reinits PL_colors[] */
+ /*PL_colors[6] = {0,0,0,0,0,0};*/
+ PL_reg_whilem_seen = 0;
+ PL_reginput = Nullch;
+ PL_regbol = Nullch;
+ PL_regeol = Nullch;
+ PL_regstartp = (I32*)NULL;
+ PL_regendp = (I32*)NULL;
+ PL_reglastparen = (U32*)NULL;
+ PL_regtill = Nullch;
+ PL_regprev = '\n';
+ PL_reg_start_tmp = (char**)NULL;
+ PL_reg_start_tmpl = 0;
+ PL_regdata = (struct reg_data*)NULL;
+ PL_bostr = Nullch;
+ PL_reg_flags = 0;
+ PL_reg_eval_set = 0;
+ PL_regnarrate = 0;
+ PL_regprogram = (regnode*)NULL;
+ PL_regindent = 0;
+ PL_regcc = (CURCUR*)NULL;
+ PL_reg_call_cc = (struct re_cc_state*)NULL;
+ PL_reg_re = (regexp*)NULL;
+ PL_reg_ganch = Nullch;
+ PL_reg_sv = Nullsv;
+ PL_reg_magic = (MAGIC*)NULL;
+ PL_reg_oldpos = 0;
+ PL_reg_oldcurpm = (PMOP*)NULL;
+ PL_reg_curpm = (PMOP*)NULL;
+ PL_reg_oldsaved = Nullch;
+ PL_reg_oldsavedlen = 0;
+ PL_reg_maxiter = 0;
+ PL_reg_leftiter = 0;
+ PL_reg_poscache = Nullch;
+ PL_reg_poscache_size= 0;
+
/* RE engine - function pointers */
PL_regcompp = proto_perl->Tregcompp;
PL_regexecp = proto_perl->Tregexecp;
PL_regint_string = proto_perl->Tregint_string;
PL_regfree = proto_perl->Tregfree;
- PL_regindent = 0;
PL_reginterp_cnt = 0;
- PL_reg_start_tmp = 0;
- PL_reg_start_tmpl = 0;
- PL_reg_poscache = Nullch;
-
- PL_watchaddr = NULL;
- PL_watchok = Nullch;
+ PL_reg_starttry = 0;
return my_perl;
}
PerlInterpreter *
-perl_clone(pTHXx_ IV flags)
+perl_clone(pTHXx_ UV flags)
{
return perl_clone_using(aTHXx_ flags, PL_Mem, PL_Env, PL_StdIO, PL_LIO,
PL_Dir, PL_Sock, PL_Proc);
projects / p5sagit/p5-mst-13.2.git / blobdiff