PL_sv_root = 0;
}
+void
+Perl_report_uninit(pTHX)
+{
+ if (PL_op)
+ Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit,
+ " in ", PL_op_desc[PL_op->op_type]);
+ else
+ Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit, "", "");
+}
+
STATIC XPVIV*
S_new_xiv(pTHX)
{
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
}
return 0;
}
if (SvREADONLY(sv) && !SvOK(sv)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
return 0;
}
}
else {
dTHR;
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
if (SvTYPE(sv) < SVt_IV)
/* Typically the caller expects that sv_any is not NULL now. */
sv_upgrade(sv, SVt_IV);
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
}
return 0;
}
if (SvREADONLY(sv) && !SvOK(sv)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
return 0;
}
}
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
}
if (SvTYPE(sv) < SVt_IV)
/* Typically the caller expects that sv_any is not NULL now. */
}
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);
}
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
}
return 0;
}
if (SvREADONLY(sv) && !SvOK(sv)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
return 0.0;
}
}
else {
dTHR;
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
if (SvTYPE(sv) < SVt_NV)
/* Typically the caller expects that sv_any is not NULL now. */
sv_upgrade(sv, SVt_NV);
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
}
*lp = 0;
return "";
if (SvREADONLY(sv) && !SvOK(sv)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
*lp = 0;
return "";
}
if (ckWARN(WARN_UNINITIALIZED)
&& !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
{
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
}
*lp = 0;
if (SvTYPE(sv) < SVt_PV)
}
}
+char *
+Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv)
+{
+ return sv_2pv_nolen(sv);
+}
+
+char *
+Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
+{
+ return sv_2pv(sv,lp);
+}
+
+char *
+Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv)
+{
+ return sv_2pv_nolen(sv);
+}
+
+char *
+Perl_sv_2pvutf8(pTHX_ register SV *sv, STRLEN *lp)
+{
+ return sv_2pv(sv,lp);
+}
+
/* This function is only called on magical items */
bool
Perl_sv_2bool(pTHX_ register SV *sv)
sstr = SvRV(sstr);
if (sstr == dstr) {
if (GvIMPORTED(dstr) != GVf_IMPORTED
- && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
GvIMPORTED_on(dstr);
}
GvGP(dstr) = gp_ref(GvGP(sstr));
SvTAINT(dstr);
if (GvIMPORTED(dstr) != GVf_IMPORTED
- && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
GvIMPORTED_on(dstr);
}
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);
dref = (SV*)GvAV(dstr);
GvAV(dstr) = (AV*)sref;
if (GvIMPORTED_AV_off(dstr)
- && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
GvIMPORTED_AV_on(dstr);
}
dref = (SV*)GvHV(dstr);
GvHV(dstr) = (HV*)sref;
if (GvIMPORTED_HV_off(dstr)
- && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
GvIMPORTED_HV_on(dstr);
}
PL_sub_generation++;
}
if (GvIMPORTED_CV_off(dstr)
- && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
GvIMPORTED_CV_on(dstr);
}
dref = (SV*)GvSV(dstr);
GvSV(dstr) = sref;
if (GvIMPORTED_SV_off(dstr)
- && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
GvIMPORTED_SV_on(dstr);
}
*SvEND(dstr) = '\0';
(void)SvPOK_only(dstr);
}
+ if (SvUTF8(sstr))
+ SvUTF8_on(dstr);
/*SUPPRESS 560*/
if (sflags & SVp_NOK) {
SvNOK_on(dstr);
SvCUR_set(bigstr, offset+len);
}
+ SvTAINT(bigstr);
i = littlelen - len;
if (i > 0) { /* string might grow */
big = SvGROW(bigstr, SvCUR(bigstr) + i + 1);
}
}
-#ifdef WIN32
- win32_strip_return(sv);
-#endif
-
return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch;
}
if (SvPOK(sv)) {
register XPV* tXpv;
if ((tXpv = (XPV*)SvANY(sv)) &&
- (*tXpv->xpv_pv > '0' ||
- tXpv->xpv_cur > 1 ||
+ (tXpv->xpv_cur > 1 ||
(tXpv->xpv_cur && *tXpv->xpv_pv != '0')))
return 1;
else
}
char *
+Perl_sv_pvbyte(pTHX_ SV *sv)
+{
+ return sv_pv(sv);
+}
+
+char *
+Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp)
+{
+ return sv_pvn(sv,lp);
+}
+
+char *
+Perl_sv_pvbyten_force(pTHX_ SV *sv, STRLEN *lp)
+{
+ return sv_pvn_force(sv,lp);
+}
+
+char *
+Perl_sv_pvutf8(pTHX_ SV *sv)
+{
+ return sv_pv(sv);
+}
+
+char *
+Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp)
+{
+ return sv_pvn(sv,lp);
+}
+
+char *
+Perl_sv_pvutf8n_force(pTHX_ SV *sv, STRLEN *lp)
+{
+ return sv_pvn_force(sv,lp);
+}
+
+char *
Perl_sv_reftype(pTHX_ SV *sv, int ob)
{
if (ob && SvOBJECT(sv))
/* 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))
PerlIO *
Perl_fp_dup(pTHX_ PerlIO *fp, char type)
{
+ PerlIO *ret;
if (!fp)
return (PerlIO*)NULL;
- return fp; /* XXX */
- /* return PerlIO_fdopen(PerlIO_fileno(fp),
- type == '<' ? "r" : type == '>' ? "w" : "rw"); */
+
+ /* look for it in the table first */
+ ret = (PerlIO*)ptr_table_fetch(PL_ptr_table, fp);
+ if (ret)
+ return ret;
+
+ /* create anew and remember what it is */
+ ret = PerlIO_fdupopen(fp);
+ ptr_table_store(PL_ptr_table, fp, ret);
+ return ret;
}
DIR *
GP *ret;
if (!gp)
return (GP*)NULL;
+ /* look for it in the table first */
+ ret = (GP*)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;
+ /* 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;
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 *oldv, void *newv)
{
- SVTBLENT *tblent, **otblent;
- UV hash = (UV)old;
+ 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)oldv;
bool i = 1;
+
assert(tbl);
otblent = &tbl->tbl_ary[hash & tbl->tbl_max];
for (tblent = *otblent; tblent; i=0, tblent = tblent->next) {
- if (tblent->oldval == old) {
- tblent->newval = new;
+ if (tblent->oldval == oldv) {
+ tblent->newval = newv;
tbl->tbl_items++;
return;
}
}
- Newz(0, tblent, 1, SVTBLENT);
- tblent->oldval = old;
- tblent->newval = new;
+ Newz(0, tblent, 1, PTR_TBL_ENT_t);
+ tblent->oldval = oldv;
+ tblent->newval = newv;
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
+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 = (SV*)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));
+ IoIFP(dstr) = fp_dup(IoIFP(sstr), IoTYPE(sstr));
if (IoOFP(sstr) == IoIFP(sstr))
IoOFP(dstr) = IoIFP(dstr);
else
- IoOFP(dstr) = fp_dup(IoOFP(sstr), IoTYPE(sstr));
+ IoOFP(dstr) = fp_dup(IoOFP(sstr), IoTYPE(sstr));
/* PL_rsfp_filters entries have fake IoDIRP() */
if (IoDIRP(sstr) && !(IoFLAGS(sstr) & IOf_FAKE_DIRP))
IoDIRP(dstr) = dirp_dup(IoDIRP(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*);
+ ptr_table_store(PL_ptr_table, src_ary, dst_ary);
SvPVX(dstr) = (char*)dst_ary;
AvALLOC((AV*)dstr) = dst_ary;
if (AvREAL((AV*)sstr)) {
Newz(0, dxhv->xhv_array,
PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1), char);
while (i <= sxhv->xhv_max) {
- HE *dentry, *oentry;
- entry = ((HE**)sxhv->xhv_array)[i];
- dentry = he_dup(entry, !!HvSHAREKEYS(sstr));
- ((HE**)dxhv->xhv_array)[i] = dentry;
- while (entry) {
- entry = HeNEXT(entry);
- oentry = dentry;
- dentry = he_dup(entry, !!HvSHAREKEYS(sstr));
- HeNEXT(oentry) = dentry;
- }
+ ((HE**)dxhv->xhv_array)[i] = he_dup(((HE**)sxhv->xhv_array)[i],
+ !!HvSHAREKEYS(sstr));
++i;
}
- if (sxhv->xhv_riter >= 0 && sxhv->xhv_eiter) {
- entry = ((HE**)sxhv->xhv_array)[sxhv->xhv_riter];
- while (entry && entry != sxhv->xhv_eiter)
- entry = HeNEXT(entry);
- dxhv->xhv_eiter = entry;
- }
- else
- dxhv->xhv_eiter = (HE*)NULL;
+ dxhv->xhv_eiter = he_dup(sxhv->xhv_eiter, !!HvSHAREKEYS(sstr));
}
- 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 *cxs, I32 ix, I32 max)
+{
+ PERL_CONTEXT *ncxs;
+
+ if (!cxs)
+ return (PERL_CONTEXT*)NULL;
+
+ /* look for it in the table first */
+ ncxs = (PERL_CONTEXT*)ptr_table_fetch(PL_ptr_table, cxs);
+ if (ncxs)
+ return ncxs;
+
+ /* create anew and remember what it is */
+ Newz(56, ncxs, max + 1, PERL_CONTEXT);
+ ptr_table_store(PL_ptr_table, cxs, ncxs);
+
+ while (ix >= 0) {
+ PERL_CONTEXT *cx = &cxs[ix];
+ PERL_CONTEXT *ncx = &ncxs[ix];
+ ncx->cx_type = cx->cx_type;
+ if (CxTYPE(cx) == CXt_SUBST) {
+ Perl_croak(aTHX_ "Cloning substitution context is unimplemented");
+ }
+ else {
+ ncx->blk_oldsp = cx->blk_oldsp;
+ ncx->blk_oldcop = cx->blk_oldcop;
+ ncx->blk_oldretsp = cx->blk_oldretsp;
+ ncx->blk_oldmarksp = cx->blk_oldmarksp;
+ ncx->blk_oldscopesp = cx->blk_oldscopesp;
+ ncx->blk_oldpm = cx->blk_oldpm;
+ ncx->blk_gimme = cx->blk_gimme;
+ switch (CxTYPE(cx)) {
+ case CXt_SUB:
+ ncx->blk_sub.cv = (cx->blk_sub.olddepth == 0
+ ? cv_dup_inc(cx->blk_sub.cv)
+ : cv_dup(cx->blk_sub.cv));
+ ncx->blk_sub.argarray = (cx->blk_sub.hasargs
+ ? av_dup_inc(cx->blk_sub.argarray)
+ : Nullav);
+ ncx->blk_sub.savearray = av_dup(cx->blk_sub.savearray);
+ ncx->blk_sub.olddepth = cx->blk_sub.olddepth;
+ ncx->blk_sub.hasargs = cx->blk_sub.hasargs;
+ ncx->blk_sub.lval = cx->blk_sub.lval;
+ break;
+ case CXt_EVAL:
+ ncx->blk_eval.old_in_eval = cx->blk_eval.old_in_eval;
+ ncx->blk_eval.old_op_type = cx->blk_eval.old_op_type;
+ ncx->blk_eval.old_name = SAVEPV(cx->blk_eval.old_name);
+ ncx->blk_eval.old_eval_root = cx->blk_eval.old_eval_root;
+ ncx->blk_eval.cur_text = sv_dup(cx->blk_eval.cur_text);
+ break;
+ case CXt_LOOP:
+ ncx->blk_loop.label = cx->blk_loop.label;
+ ncx->blk_loop.resetsp = cx->blk_loop.resetsp;
+ ncx->blk_loop.redo_op = cx->blk_loop.redo_op;
+ ncx->blk_loop.next_op = cx->blk_loop.next_op;
+ ncx->blk_loop.last_op = cx->blk_loop.last_op;
+ ncx->blk_loop.iterdata = (CxPADLOOP(cx)
+ ? cx->blk_loop.iterdata
+ : gv_dup((GV*)cx->blk_loop.iterdata));
+ ncx->blk_loop.itersave = sv_dup_inc(cx->blk_loop.itersave);
+ ncx->blk_loop.iterlval = sv_dup_inc(cx->blk_loop.iterlval);
+ ncx->blk_loop.iterary = av_dup_inc(cx->blk_loop.iterary);
+ ncx->blk_loop.iterix = cx->blk_loop.iterix;
+ ncx->blk_loop.itermax = cx->blk_loop.itermax;
+ break;
+ case CXt_FORMAT:
+ ncx->blk_sub.cv = cv_dup(cx->blk_sub.cv);
+ ncx->blk_sub.gv = gv_dup(cx->blk_sub.gv);
+ ncx->blk_sub.dfoutgv = gv_dup_inc(cx->blk_sub.dfoutgv);
+ ncx->blk_sub.hasargs = cx->blk_sub.hasargs;
+ break;
+ case CXt_BLOCK:
+ case CXt_NULL:
+ break;
+ }
+ }
+ --ix;
+ }
+ return ncxs;
+}
+
+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 = (PERL_SI*)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;
+}
+
+#define POPINT(ss,ix) ((ss)[--(ix)].any_i32)
+#define TOPINT(ss,ix) ((ss)[ix].any_i32)
+#define POPLONG(ss,ix) ((ss)[--(ix)].any_long)
+#define TOPLONG(ss,ix) ((ss)[ix].any_long)
+#define POPIV(ss,ix) ((ss)[--(ix)].any_iv)
+#define TOPIV(ss,ix) ((ss)[ix].any_iv)
+#define POPPTR(ss,ix) ((ss)[--(ix)].any_ptr)
+#define TOPPTR(ss,ix) ((ss)[ix].any_ptr)
+#define POPDPTR(ss,ix) ((ss)[--(ix)].any_dptr)
+#define TOPDPTR(ss,ix) ((ss)[ix].any_dptr)
+#define POPDXPTR(ss,ix) ((ss)[--(ix)].any_dxptr)
+#define TOPDXPTR(ss,ix) ((ss)[ix].any_dxptr)
+
+/* XXXXX todo */
+#define pv_dup_inc(p) SAVEPV(p)
+#define pv_dup(p) SAVEPV(p)
+#define svp_dup_inc(p,pp) any_dup(p,pp)
+
+void *
+Perl_any_dup(pTHX_ void *v, PerlInterpreter *proto_perl)
+{
+ void *ret;
+
+ if (!v)
+ return (void*)NULL;
+
+ /* look for it in the table first */
+ ret = ptr_table_fetch(PL_ptr_table, v);
+ if (ret)
+ return ret;
+
+ /* see if it is part of the interpreter structure */
+ if (v >= (void*)proto_perl && v < (void*)(proto_perl+1))
+ ret = (void*)(((char*)aTHXo) + (((char*)v) - (char*)proto_perl));
+ else
+ ret = v;
+
+ return ret;
+}
+
+ANY *
+Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
+{
+ ANY *ss = proto_perl->Tsavestack;
+ I32 ix = proto_perl->Tsavestack_ix;
+ I32 max = proto_perl->Tsavestack_max;
+ ANY *nss;
+ SV *sv;
+ GV *gv;
+ AV *av;
+ HV *hv;
+ void* ptr;
+ int intval;
+ long longval;
+ GP *gp;
+ IV iv;
+ I32 i;
+ char *c;
+ void (*dptr) (void*);
+ void (*dxptr) (pTHXo_ void*);
+
+ Newz(54, nss, max, ANY);
+
+ while (ix > 0) {
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ switch (i) {
+ case SAVEt_ITEM: /* normal string */
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ break;
+ case SAVEt_SV: /* scalar reference */
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ gv = (GV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = gv_dup_inc(gv);
+ break;
+ case SAVEt_GENERIC_SVREF: /* generic sv */
+ case SAVEt_SVREF: /* scalar reference */
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = svp_dup_inc((SV**)ptr, proto_perl);/* XXXXX */
+ break;
+ case SAVEt_AV: /* array reference */
+ av = (AV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = av_dup_inc(av);
+ gv = (GV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = gv_dup(gv);
+ break;
+ case SAVEt_HV: /* hash reference */
+ hv = (HV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = hv_dup_inc(hv);
+ gv = (GV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = gv_dup(gv);
+ break;
+ case SAVEt_INT: /* int reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ intval = (int)POPINT(ss,ix);
+ TOPINT(nss,ix) = intval;
+ break;
+ case SAVEt_LONG: /* long reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ longval = (long)POPLONG(ss,ix);
+ TOPLONG(nss,ix) = longval;
+ break;
+ case SAVEt_I32: /* I32 reference */
+ case SAVEt_I16: /* I16 reference */
+ case SAVEt_I8: /* I8 reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ break;
+ case SAVEt_IV: /* IV reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ iv = POPIV(ss,ix);
+ TOPIV(nss,ix) = iv;
+ break;
+ case SAVEt_SPTR: /* SV* reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup(sv);
+ break;
+ case SAVEt_VPTR: /* random* reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ break;
+ case SAVEt_PPTR: /* char* reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ c = (char*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = pv_dup(c);
+ break;
+ case SAVEt_HPTR: /* HV* reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ hv = (HV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = hv_dup(hv);
+ break;
+ case SAVEt_APTR: /* AV* reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ av = (AV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = av_dup(av);
+ break;
+ case SAVEt_NSTAB:
+ gv = (GV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = gv_dup(gv);
+ break;
+ case SAVEt_GP: /* scalar reference */
+ gp = (GP*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = gp = gp_dup(gp);
+ (void)GpREFCNT_inc(gp);
+ gv = (GV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = gv_dup_inc(c);
+ c = (char*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = pv_dup(c);
+ iv = POPIV(ss,ix);
+ TOPIV(nss,ix) = iv;
+ iv = POPIV(ss,ix);
+ TOPIV(nss,ix) = iv;
+ break;
+ case SAVEt_FREESV:
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ break;
+ case SAVEt_FREEOP:
+ ptr = POPPTR(ss,ix);
+ if (ptr && (((OP*)ptr)->op_private & OPpREFCOUNTED)) {
+ /* these are assumed to be refcounted properly */
+ switch (((OP*)ptr)->op_type) {
+ case OP_LEAVESUB:
+ case OP_LEAVESUBLV:
+ case OP_LEAVEEVAL:
+ case OP_LEAVE:
+ case OP_SCOPE:
+ case OP_LEAVEWRITE:
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ break;
+ default:
+ TOPPTR(nss,ix) = Nullop;
+ break;
+ }
+ }
+ else
+ TOPPTR(nss,ix) = Nullop;
+ break;
+ case SAVEt_FREEPV:
+ c = (char*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = pv_dup_inc(c);
+ break;
+ case SAVEt_CLEARSV:
+ longval = POPLONG(ss,ix);
+ TOPLONG(nss,ix) = longval;
+ break;
+ case SAVEt_DELETE:
+ hv = (HV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = hv_dup_inc(hv);
+ c = (char*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = pv_dup_inc(c);
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ break;
+ case SAVEt_DESTRUCTOR:
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl); /* XXX quite arbitrary */
+ dptr = POPDPTR(ss,ix);
+ TOPDPTR(nss,ix) = (void (*)(void*))any_dup(dptr, proto_perl);
+ break;
+ case SAVEt_DESTRUCTOR_X:
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl); /* XXX quite arbitrary */
+ dxptr = POPDXPTR(ss,ix);
+ TOPDXPTR(nss,ix) = (void (*)(pTHXo_ void*))any_dup(dxptr, proto_perl);
+ break;
+ case SAVEt_REGCONTEXT:
+ case SAVEt_ALLOC:
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ ix -= i;
+ break;
+ case SAVEt_STACK_POS: /* Position on Perl stack */
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ break;
+ case SAVEt_AELEM: /* array element */
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ av = (AV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = av_dup_inc(av);
+ break;
+ case SAVEt_HELEM: /* hash element */
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ hv = (HV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = hv_dup_inc(hv);
+ break;
+ case SAVEt_OP:
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = ptr;
+ break;
+ case SAVEt_HINTS:
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ break;
+ default:
+ Perl_croak(aTHX_ "panic: ss_dup inconsistency");
+ }
+ }
+
+ return nss;
+}
+
+#ifdef PERL_OBJECT
+#include "XSUB.h"
+#endif
+
+PerlInterpreter *
+perl_clone(PerlInterpreter *proto_perl, UV flags)
+{
+#ifdef PERL_OBJECT
+ CPerlObj *pPerl = (CPerlObj*)proto_perl;
+#endif
+
+#ifdef PERL_IMPLICIT_SYS
+ return perl_clone_using(proto_perl, flags,
+ proto_perl->IMem,
+ proto_perl->IMemShared,
+ proto_perl->IMemParse,
+ proto_perl->IEnv,
+ proto_perl->IStdIO,
+ proto_perl->ILIO,
+ proto_perl->IDir,
+ proto_perl->ISock,
+ proto_perl->IProc);
+}
+
PerlInterpreter *
-perl_clone_using(PerlInterpreter *proto_perl, IV flags,
- struct IPerlMem* ipM, struct IPerlEnv* ipE,
+perl_clone_using(PerlInterpreter *proto_perl, UV flags,
+ struct IPerlMem* ipM, struct IPerlMem* ipMS,
+ struct IPerlMem* ipMP, struct IPerlEnv* ipE,
struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
struct IPerlDir* ipD, struct IPerlSock* ipS,
struct IPerlProc* ipP)
{
+ /* XXX many of the string copies here can be optimized if they're
+ * constants; they need to be allocated as common memory and just
+ * their pointers copied. */
+
IV i;
SV *sv;
SV **svp;
+# ifdef PERL_OBJECT
+ CPerlObj *pPerl = new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd, ipLIO,
+ ipD, ipS, ipP);
+ PERL_SET_INTERP(pPerl);
+# else /* !PERL_OBJECT */
PerlInterpreter *my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
PERL_SET_INTERP(my_perl);
-#ifdef DEBUGGING
+# ifdef DEBUGGING
memset(my_perl, 0xab, sizeof(PerlInterpreter));
PL_markstack = 0;
PL_scopestack = 0;
PL_savestack = 0;
PL_retstack = 0;
-#else
-# if 0
- Copy(proto_perl, my_perl, 1, PerlInterpreter);
-# endif
-#endif
-
- /* XXX many of the string copies here can be optimized if they're
- * constants; they need to be allocated as common memory and just
- * their pointers copied. */
+# else /* !DEBUGGING */
+ Zero(my_perl, 1, PerlInterpreter);
+# endif /* DEBUGGING */
/* host pointers */
PL_Mem = ipM;
+ PL_MemShared = ipMS;
+ PL_MemParse = ipMP;
PL_Env = ipE;
PL_StdIO = ipStd;
PL_LIO = ipLIO;
PL_Dir = ipD;
PL_Sock = ipS;
PL_Proc = ipP;
+# endif /* PERL_OBJECT */
+#else /* !PERL_IMPLICIT_SYS */
+ IV i;
+ SV *sv;
+ SV **svp;
+ PerlInterpreter *my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
+ PERL_SET_INTERP(my_perl);
+
+# ifdef DEBUGGING
+ memset(my_perl, 0xab, sizeof(PerlInterpreter));
+ PL_markstack = 0;
+ PL_scopestack = 0;
+ PL_savestack = 0;
+ PL_retstack = 0;
+# else /* !DEBUGGING */
+ Zero(my_perl, 1, PerlInterpreter);
+# endif /* DEBUGGING */
+#endif /* PERL_IMPLICIT_SYS */
/* arena roots */
PL_xiv_arenaroot = NULL;
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);
+#ifdef PERL_OBJECT
+ SvUPGRADE(&PL_sv_no, SVt_PVNV);
+#else
SvANY(&PL_sv_no) = new_XPVNV();
+#endif
SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
SvFLAGS(&PL_sv_no) = SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
SvPVX(&PL_sv_no) = SAVEPVN(PL_No, 0);
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);
+#ifdef PERL_OBJECT
+ SvUPGRADE(&PL_sv_yes, SVt_PVNV);
+#else
SvANY(&PL_sv_yes) = new_XPVNV();
+#endif
SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
SvFLAGS(&PL_sv_yes) = SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
SvPVX(&PL_sv_yes) = SAVEPVN(PL_Yes, 1);
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_stashpv = SAVEPV(PL_compiling.cop_stashpv);
PL_compiling.cop_file = SAVEPV(PL_compiling.cop_file);
- PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings);
- if (proto_perl->Tcurcop == &proto_perl->Icompiling)
- PL_curcop = &PL_compiling;
- else
- PL_curcop = proto_perl->Tcurcop;
+ ptr_table_store(PL_ptr_table, &proto_perl->Icompiling, &PL_compiling);
+ if (!specialWARN(PL_compiling.cop_warnings))
+ PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings);
+ PL_curcop = (COP*)any_dup(proto_perl->Tcurcop, proto_perl);
/* pseudo environmental stuff */
PL_origargc = proto_perl->Iorigargc;
/* switches */
PL_minus_c = proto_perl->Iminus_c;
- Copy(proto_perl->Ipatchlevel, PL_patchlevel, 10, char);
+ PL_patchlevel = sv_dup_inc(proto_perl->Ipatchlevel);
PL_localpatches = proto_perl->Ilocalpatches;
PL_splitstr = proto_perl->Isplitstr;
PL_preprocess = proto_perl->Ipreprocess;
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_main_cv = cv_dup_inc(proto_perl->Imain_cv);
PL_main_root = OpREFCNT_inc(proto_perl->Imain_root);
PL_main_start = proto_perl->Imain_start;
- PL_eval_root = proto_perl->Ieval_root;
+ PL_eval_root = OpREFCNT_inc(proto_perl->Ieval_root);
PL_eval_start = proto_perl->Ieval_start;
/* runtime control stuff */
- PL_curcopdb = proto_perl->Icurcopdb;
+ 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;
- 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 = (SV**)ptr_table_fetch(PL_ptr_table,
+ proto_perl->Tcurpad);
#ifdef HAVE_INTERP_INTERN
sys_intern_dup(&proto_perl->Isys_intern, &PL_sys_intern);
/* more statics moved here */
PL_generation = proto_perl->Igeneration;
PL_DBcv = cv_dup(proto_perl->IDBcv);
- PL_archpat_auto = SAVEPV(proto_perl->Iarchpat_auto);
PL_in_clean_objs = proto_perl->Iin_clean_objs;
PL_in_clean_all = proto_perl->Iin_clean_all;
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_defer = proto_perl->Ilex_defer;
PL_lex_expect = proto_perl->Ilex_expect;
PL_lex_formbrack = proto_perl->Ilex_formbrack;
- 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_last_swash_tmps = (U8*)NULL;
PL_last_swash_slen = 0;
/* perly.c globals */
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 */
+ if (proto_perl->Ipsig_ptr) {
+ int sig_num[] = { SIG_NUM };
+ Newz(0, PL_psig_ptr, sizeof(sig_num)/sizeof(*sig_num), SV*);
+ Newz(0, PL_psig_name, sizeof(sig_num)/sizeof(*sig_num), SV*);
+ for (i = 1; PL_sig_name[i]; i++) {
+ PL_psig_ptr[i] = sv_dup_inc(proto_perl->Ipsig_ptr[i]);
+ PL_psig_name[i] = sv_dup_inc(proto_perl->Ipsig_name[i]);
+ }
+ }
+ else {
+ PL_psig_ptr = (SV**)NULL;
+ PL_psig_name = (SV**)NULL;
+ }
/* 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 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);
+
+ /* 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);
+ }
+ 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;
+
+ PL_sortcop = (OP*)any_dup(proto_perl->Tsortcop, proto_perl);
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;
+#ifdef PERL_OBJECT
+ return (PerlInterpreter*)pPerl;
+#else
return my_perl;
+#endif
}
-PerlInterpreter *
-perl_clone(pTHXx_ IV flags)
-{
- return perl_clone_using(aTHXx_ flags, PL_Mem, PL_Env, PL_StdIO, PL_LIO,
- PL_Dir, PL_Sock, PL_Proc);
-}
-
-#endif /* USE_ITHREADS */
+#else /* !USE_ITHREADS */
#ifdef PERL_OBJECT
#include "XSUB.h"
#endif
+#endif /* USE_ITHREADS */
+
static void
do_report_used(pTHXo_ SV *sv)
{
static void
do_clean_named_objs(pTHXo_ SV *sv)
{
- if (SvTYPE(sv) == SVt_PVGV) {
+ if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) {
if ( SvOBJECT(GvSV(sv)) ||
GvAV(sv) && SvOBJECT(GvAV(sv)) ||
GvHV(sv) && SvOBJECT(GvHV(sv)) ||
https://perl5.git.perl.org / perl5.git / blobdiff