#ifdef PERL_COPY_ON_WRITE
#define SV_COW_NEXT_SV(sv) INT2PTR(SV *,SvUVX(sv))
#define SV_COW_NEXT_SV_SET(current,next) SvUVX(current) = PTR2UV(next)
-/* This is a pessamistic view. Scalar must be purely a read-write PV to copy-
+/* This is a pessimistic view. Scalar must be purely a read-write PV to copy-
on-write. */
#define CAN_COW_MASK (SVs_OBJECT|SVs_GMG|SVs_SMG|SVs_RMG|SVf_IOK|SVf_NOK| \
SVf_POK|SVf_ROK|SVp_IOK|SVp_NOK|SVp_POK|SVf_FAKE| \
/* new_SV(): return a new, empty SV head */
-#define new_SV(p) \
+#ifdef DEBUG_LEAKING_SCALARS
+/* provide a real function for a debugger to play with */
+STATIC SV*
+S_new_SV(pTHX)
+{
+ SV* sv;
+
+ LOCK_SV_MUTEX;
+ if (PL_sv_root)
+ uproot_SV(sv);
+ else
+ sv = more_sv();
+ UNLOCK_SV_MUTEX;
+ SvANY(sv) = 0;
+ SvREFCNT(sv) = 1;
+ SvFLAGS(sv) = 0;
+ return sv;
+}
+# define new_SV(p) (p)=S_new_SV(aTHX)
+
+#else
+# define new_SV(p) \
STMT_START { \
LOCK_SV_MUTEX; \
if (PL_sv_root) \
SvREFCNT(p) = 1; \
SvFLAGS(p) = 0; \
} STMT_END
+#endif
/* del_SV(): return an empty SV head to the free list */
avoid incrementing the object refcount.
Note we cannot do this to avoid self-tie loops as intervening RV must
- have its REFCNT incremented to keep it in existence - instead we could
- special case them in sv_free() -- NI-S
+ have its REFCNT incremented to keep it in existence.
*/
if (!obj || obj == sv ||
mg->mg_obj = SvREFCNT_inc(obj);
mg->mg_flags |= MGf_REFCOUNTED;
}
+
+ /* Normal self-ties simply pass a null object, and instead of
+ using mg_obj directly, use the SvTIED_obj macro to produce a
+ new RV as needed. For glob "self-ties", we are tieing the PVIO
+ with an RV obj pointing to the glob containing the PVIO. In
+ this case, to avoid a reference loop, we need to weaken the
+ reference.
+ */
+
+ if (how == PERL_MAGIC_tiedscalar && SvTYPE(sv) == SVt_PVIO &&
+ obj && SvROK(obj) && GvIO(SvRV(obj)) == (IO*)sv)
+ {
+ sv_rvweaken(obj);
+ }
+
mg->mg_type = how;
mg->mg_len = namlen;
if (name) {
PUSHMARK(SP);
PUSHs(&tmpref);
PUTBACK;
- call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR);
+ call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR|G_VOID);
SvREFCNT(sv)--;
POPSTACK;
SPAGAIN;
CvDEPTH(dstr) = 0;
}
PAD_DUP(CvPADLIST(dstr), CvPADLIST(sstr), param);
+ /* anon prototypes aren't refcounted */
if (!CvANON(sstr) || CvCLONED(sstr))
CvOUTSIDE(dstr) = cv_dup_inc(CvOUTSIDE(sstr), param);
else
CvOUTSIDE(dstr) = cv_dup(CvOUTSIDE(sstr), param);
+ CvOUTSIDE_SEQ(dstr) = CvOUTSIDE_SEQ(sstr);
CvFLAGS(dstr) = CvFLAGS(sstr);
CvFILE(dstr) = CvXSUB(sstr) ? CvFILE(sstr) : SAVEPV(CvFILE(sstr));
break;
/* pseudo environmental stuff */
PL_origargc = proto_perl->Iorigargc;
- i = PL_origargc;
- New(0, PL_origargv, i+1, char*);
- PL_origargv[i] = '\0';
- while (i-- > 0) {
- PL_origargv[i] = SAVEPV(proto_perl->Iorigargv[i]);
- }
+ PL_origargv = proto_perl->Iorigargv;
param->stashes = newAV(); /* Setup array of objects to call clone on */