static void sv_unglob _((SV* sv));
static void sv_check_thinkfirst _((SV *sv));
+#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_check_thinkfirst(sv)
+
+#ifndef PURIFY
+static void *my_safemalloc(MEM_SIZE size);
+#endif
+
typedef void (*SVFUNC) _((SV*));
#ifdef PURIFY
#define new_SV(p) \
do { \
- MUTEX_LOCK(&sv_mutex); \
+ LOCK_SV_MUTEX; \
(p) = (SV*)safemalloc(sizeof(SV)); \
reg_add(p); \
- MUTEX_UNLOCK(&sv_mutex); \
+ UNLOCK_SV_MUTEX; \
} while (0)
#define del_SV(p) \
do { \
- MUTEX_LOCK(&sv_mutex); \
+ LOCK_SV_MUTEX; \
reg_remove(p); \
- free((char*)(p)); \
- MUTEX_UNLOCK(&sv_mutex); \
+ Safefree((char*)(p)); \
+ UNLOCK_SV_MUTEX; \
} while (0)
static SV **registry;
I32 oldsize = regsize;
regsize = regsize ? ((regsize << 2) + 1) : 2037;
- registry = (SV**)safemalloc(regsize * sizeof(SV*));
- memzero(registry, regsize * sizeof(SV*));
+ Newz(707, registry, regsize, SV*);
if (oldreg) {
I32 i;
U32 flags;
{
if (!(flags & SVf_FAKE))
- free(ptr);
+ Safefree(ptr);
}
#else /* ! PURIFY */
++sv_count; \
} while (0)
-#define new_SV(p) do { \
- MUTEX_LOCK(&sv_mutex); \
- if (sv_root) \
- uproot_SV(p); \
- else \
- (p) = more_sv(); \
- MUTEX_UNLOCK(&sv_mutex); \
+#define new_SV(p) do { \
+ LOCK_SV_MUTEX; \
+ if (sv_root) \
+ uproot_SV(p); \
+ else \
+ (p) = more_sv(); \
+ UNLOCK_SV_MUTEX; \
} while (0)
#ifdef DEBUGGING
-#define del_SV(p) do { \
- MUTEX_LOCK(&sv_mutex); \
- if (debug & 32768) \
- del_sv(p); \
- else \
- plant_SV(p); \
- MUTEX_UNLOCK(&sv_mutex); \
+#define del_SV(p) do { \
+ LOCK_SV_MUTEX; \
+ if (debug & 32768) \
+ del_sv(p); \
+ else \
+ plant_SV(p); \
+ UNLOCK_SV_MUTEX; \
} while (0)
static void
static void
do_clean_named_objs(SV *sv)
{
- if (SvTYPE(sv) == SVt_PVGV && GvSV(sv))
- do_clean_objs(GvSV(sv));
+ if (SvTYPE(sv) == SVt_PVGV) {
+ if ( SvOBJECT(GvSV(sv)) ||
+ GvAV(sv) && SvOBJECT(GvAV(sv)) ||
+ GvHV(sv) && SvOBJECT(GvHV(sv)) ||
+ GvIO(sv) && SvOBJECT(GvIO(sv)) ||
+ GvCV(sv) && SvOBJECT(GvCV(sv)) )
+ {
+ DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv));)
+ SvREFCNT_dec(sv);
+ }
+ else if (GvSV(sv))
+ do_clean_objs(GvSV(sv));
+ }
}
#endif
Safefree((void *)sva);
}
+ if (nice_chunk)
+ Safefree(nice_chunk);
+ nice_chunk = Nullch;
+ nice_chunk_size = 0;
sv_arenaroot = 0;
sv_root = 0;
}
{
register IV** xiv;
register IV** xivend;
- XPV* ptr = (XPV*)safemalloc(1008);
+ XPV* ptr;
+ New(705, ptr, 1008/sizeof(XPV), XPV);
ptr->xpv_pv = (char*)xiv_arenaroot; /* linked list of xiv arenas */
xiv_arenaroot = ptr; /* to keep Purify happy */
{
register double* xnv;
register double* xnvend;
- xnv = (double*)safemalloc(1008);
+ New(711, xnv, 1008/sizeof(double), double);
xnvend = &xnv[1008 / sizeof(double) - 1];
xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */
xnv_root = xnv;
{
register XRV* xrv;
register XRV* xrvend;
- xrv_root = (XRV*)safemalloc(1008);
+ New(712, xrv_root, 1008/sizeof(XRV), XRV);
xrv = xrv_root;
xrvend = &xrv[1008 / sizeof(XRV) - 1];
while (xrv < xrvend) {
{
register XPV* xpv;
register XPV* xpvend;
- xpv_root = (XPV*)safemalloc(1008);
+ New(713, xpv_root, 1008/sizeof(XPV), XPV);
xpv = xpv_root;
xpvend = &xpv[1008 / sizeof(XPV) - 1];
while (xpv < xpvend) {
#ifdef PURIFY
#define new_XIV() (void*)safemalloc(sizeof(XPVIV))
-#define del_XIV(p) free((char*)p)
+#define del_XIV(p) Safefree((char*)p)
#else
#define new_XIV() (void*)new_xiv()
#define del_XIV(p) del_xiv((XPVIV*) p)
#ifdef PURIFY
#define new_XNV() (void*)safemalloc(sizeof(XPVNV))
-#define del_XNV(p) free((char*)p)
+#define del_XNV(p) Safefree((char*)p)
#else
#define new_XNV() (void*)new_xnv()
#define del_XNV(p) del_xnv((XPVNV*) p)
#ifdef PURIFY
#define new_XRV() (void*)safemalloc(sizeof(XRV))
-#define del_XRV(p) free((char*)p)
+#define del_XRV(p) Safefree((char*)p)
#else
#define new_XRV() (void*)new_xrv()
#define del_XRV(p) del_xrv((XRV*) p)
#ifdef PURIFY
#define new_XPV() (void*)safemalloc(sizeof(XPV))
-#define del_XPV(p) free((char*)p)
+#define del_XPV(p) Safefree((char*)p)
#else
#define new_XPV() (void*)new_xpv()
#define del_XPV(p) del_xpv((XPV *)p)
#endif
-#define new_XPVIV() (void*)safemalloc(sizeof(XPVIV))
-#define del_XPVIV(p) free((char*)p)
-
-#define new_XPVNV() (void*)safemalloc(sizeof(XPVNV))
-#define del_XPVNV(p) free((char*)p)
-
-#define new_XPVMG() (void*)safemalloc(sizeof(XPVMG))
-#define del_XPVMG(p) free((char*)p)
-
-#define new_XPVLV() (void*)safemalloc(sizeof(XPVLV))
-#define del_XPVLV(p) free((char*)p)
-
-#define new_XPVAV() (void*)safemalloc(sizeof(XPVAV))
-#define del_XPVAV(p) free((char*)p)
-
-#define new_XPVHV() (void*)safemalloc(sizeof(XPVHV))
-#define del_XPVHV(p) free((char*)p)
-
-#define new_XPVCV() (void*)safemalloc(sizeof(XPVCV))
-#define del_XPVCV(p) free((char*)p)
-
-#define new_XPVGV() (void*)safemalloc(sizeof(XPVGV))
-#define del_XPVGV(p) free((char*)p)
-
-#define new_XPVBM() (void*)safemalloc(sizeof(XPVBM))
-#define del_XPVBM(p) free((char*)p)
-
-#define new_XPVFM() (void*)safemalloc(sizeof(XPVFM))
-#define del_XPVFM(p) free((char*)p)
-
-#define new_XPVIO() (void*)safemalloc(sizeof(XPVIO))
-#define del_XPVIO(p) free((char*)p)
+#ifdef PURIFY
+# define my_safemalloc(s) safemalloc(s)
+# define my_safefree(s) free(s)
+#else
+static void*
+my_safemalloc(MEM_SIZE size)
+{
+ char *p;
+ New(717, p, size, char);
+ return (void*)p;
+}
+# define my_safefree(s) Safefree(s)
+#endif
+
+#define new_XPVIV() (void*)my_safemalloc(sizeof(XPVIV))
+#define del_XPVIV(p) my_safefree((char*)p)
+
+#define new_XPVNV() (void*)my_safemalloc(sizeof(XPVNV))
+#define del_XPVNV(p) my_safefree((char*)p)
+
+#define new_XPVMG() (void*)my_safemalloc(sizeof(XPVMG))
+#define del_XPVMG(p) my_safefree((char*)p)
+
+#define new_XPVLV() (void*)my_safemalloc(sizeof(XPVLV))
+#define del_XPVLV(p) my_safefree((char*)p)
+
+#define new_XPVAV() (void*)my_safemalloc(sizeof(XPVAV))
+#define del_XPVAV(p) my_safefree((char*)p)
+
+#define new_XPVHV() (void*)my_safemalloc(sizeof(XPVHV))
+#define del_XPVHV(p) my_safefree((char*)p)
+
+#define new_XPVCV() (void*)my_safemalloc(sizeof(XPVCV))
+#define del_XPVCV(p) my_safefree((char*)p)
+
+#define new_XPVGV() (void*)my_safemalloc(sizeof(XPVGV))
+#define del_XPVGV(p) my_safefree((char*)p)
+
+#define new_XPVBM() (void*)my_safemalloc(sizeof(XPVBM))
+#define del_XPVBM(p) my_safefree((char*)p)
+
+#define new_XPVFM() (void*)my_safemalloc(sizeof(XPVFM))
+#define del_XPVFM(p) my_safefree((char*)p)
+
+#define new_XPVIO() (void*)my_safemalloc(sizeof(XPVIO))
+#define del_XPVIO(p) my_safefree((char*)p)
bool
sv_upgrade(register SV *sv, U32 mt)
s = SvPVX(sv);
if (newlen > SvLEN(sv))
newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
+#ifdef HAS_64K_LIMIT
+ if (newlen >= 0x10000)
+ newlen = 0xFFFF;
+#endif
}
else
s = SvPVX(sv);
void
sv_setiv(register SV *sv, IV i)
{
- sv_check_thinkfirst(sv);
+ SV_CHECK_THINKFIRST(sv);
switch (SvTYPE(sv)) {
case SVt_NULL:
sv_upgrade(sv, SVt_IV);
}
void
+sv_setiv_mg(register SV *sv, IV i)
+{
+ sv_setiv(sv,i);
+ SvSETMAGIC(sv);
+}
+
+void
sv_setuv(register SV *sv, UV u)
{
if (u <= IV_MAX)
}
void
+sv_setuv_mg(register SV *sv, UV u)
+{
+ sv_setuv(sv,u);
+ SvSETMAGIC(sv);
+}
+
+void
sv_setnv(register SV *sv, double num)
{
- sv_check_thinkfirst(sv);
+ SV_CHECK_THINKFIRST(sv);
switch (SvTYPE(sv)) {
case SVt_NULL:
case SVt_IV:
sv_upgrade(sv, SVt_NV);
break;
- case SVt_NV:
case SVt_RV:
case SVt_PV:
case SVt_PVIV:
SvTAINT(sv);
}
+void
+sv_setnv_mg(register SV *sv, double num)
+{
+ sv_setnv(sv,num);
+ SvSETMAGIC(sv);
+}
+
static void
not_a_number(SV *sv)
{
case SVt_PVHV: s = "HASH"; break;
case SVt_PVCV: s = "CODE"; break;
case SVt_PVGV: s = "GLOB"; break;
- case SVt_PVFM: s = "FORMATLINE"; break;
+ case SVt_PVFM: s = "FORMLINE"; break;
case SVt_PVIO: s = "IO"; break;
default: s = "UNKNOWN"; break;
}
return "";
}
}
- if (!SvUPGRADE(sv, SVt_PV))
- return 0;
+ (void)SvUPGRADE(sv, SVt_PV);
if (SvNOKp(sv)) {
if (SvTYPE(sv) < SVt_PVNV)
sv_upgrade(sv, SVt_PVNV);
if (sstr == dstr)
return;
- sv_check_thinkfirst(dstr);
+ SV_CHECK_THINKFIRST(dstr);
if (!sstr)
sstr = &sv_undef;
stype = SvTYPE(sstr);
switch (stype) {
case SVt_NULL:
- (void)SvOK_off(dstr);
- return;
+ if (dtype != SVt_PVGV) {
+ (void)SvOK_off(dstr);
+ return;
+ }
+ break;
case SVt_IV:
if (dtype != SVt_IV && dtype < SVt_PVIV) {
if (dtype < SVt_IV)
if (dtype < SVt_PVNV)
sv_upgrade(dstr, SVt_PVNV);
break;
-
case SVt_PVAV:
case SVt_PVHV:
case SVt_PVCV:
STRLEN len = GvNAMELEN(sstr);
sv_upgrade(dstr, SVt_PVGV);
sv_magic(dstr, dstr, '*', name, len);
- GvSTASH(dstr) = GvSTASH(sstr);
+ GvSTASH(dstr) = (HV*)SvREFCNT_inc(GvSTASH(sstr));
GvNAME(dstr) = savepvn(name, len);
GvNAMELEN(dstr) = len;
SvFAKE_on(dstr); /* can coerce to non-glob */
}
/* ahem, death to those who redefine active sort subs */
- else if (curstack == sortstack
+ else if (curstackinfo->si_type == SI_SORT
&& GvCV(dstr) && sortcop == CvSTART(GvCV(dstr)))
croak("Can't redefine active sort subroutine %s",
GvNAME(dstr));
goto glob_assign;
}
}
- if (dtype < stype)
- sv_upgrade(dstr, stype);
+ if (stype == SVt_PVLV)
+ SvUPGRADE(dstr, SVt_PVNV);
+ else
+ SvUPGRADE(dstr, stype);
}
sflags = SvFLAGS(sstr);
{
/* ahem, death to those who redefine
* active sort subs */
- if (curstack == sortstack &&
+ if (curstackinfo->si_type == SI_SORT &&
sortcop == CvSTART(cv))
croak(
"Can't redefine active sort subroutine %s",
if (cv_const_sv(cv))
warn("Constant subroutine %s redefined",
GvENAME((GV*)dstr));
- else if (dowarn)
- warn("Subroutine %s redefined",
- GvENAME((GV*)dstr));
+ else if (dowarn) {
+ if (!(CvGV(cv) && GvSTASH(CvGV(cv))
+ && HvNAME(GvSTASH(CvGV(cv)))
+ && strEQ(HvNAME(GvSTASH(CvGV(cv))),
+ "autouse")))
+ warn("Subroutine %s redefined",
+ GvENAME((GV*)dstr));
+ }
}
cv_ckproto(cv, (GV*)dstr,
SvPOK(sref) ? SvPVX(sref) : Nullch);
SvIVX(dstr) = SvIVX(sstr);
}
else {
- (void)SvOK_off(dstr);
+ if (dtype == SVt_PVGV) {
+ if (dowarn)
+ warn("Undefined value assigned to typeglob");
+ }
+ else
+ (void)SvOK_off(dstr);
}
SvTAINT(dstr);
}
void
+sv_setsv_mg(SV *dstr, register SV *sstr)
+{
+ sv_setsv(dstr,sstr);
+ SvSETMAGIC(dstr);
+}
+
+void
sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len)
{
+ register char *dptr;
assert(len >= 0); /* STRLEN is probably unsigned, so this may
elicit a warning, but it won't hurt. */
- sv_check_thinkfirst(sv);
+ SV_CHECK_THINKFIRST(sv);
if (!ptr) {
(void)SvOK_off(sv);
return;
if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
sv_unglob(sv);
}
- else if (!sv_upgrade(sv, SVt_PV))
- return;
+ else
+ sv_upgrade(sv, SVt_PV);
+
SvGROW(sv, len + 1);
- Move(ptr,SvPVX(sv),len,char);
+ dptr = SvPVX(sv);
+ Move(ptr,dptr,len,char);
+ dptr[len] = '\0';
SvCUR_set(sv, len);
- *SvEND(sv) = '\0';
(void)SvPOK_only(sv); /* validate pointer */
SvTAINT(sv);
}
void
+sv_setpvn_mg(register SV *sv, register const char *ptr, register STRLEN len)
+{
+ sv_setpvn(sv,ptr,len);
+ SvSETMAGIC(sv);
+}
+
+void
sv_setpv(register SV *sv, register const char *ptr)
{
register STRLEN len;
- sv_check_thinkfirst(sv);
+ SV_CHECK_THINKFIRST(sv);
if (!ptr) {
(void)SvOK_off(sv);
return;
if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
sv_unglob(sv);
}
- else if (!sv_upgrade(sv, SVt_PV))
- return;
+ else
+ sv_upgrade(sv, SVt_PV);
+
SvGROW(sv, len + 1);
Move(ptr,SvPVX(sv),len+1,char);
SvCUR_set(sv, len);
}
void
+sv_setpv_mg(register SV *sv, register const char *ptr)
+{
+ sv_setpv(sv,ptr);
+ SvSETMAGIC(sv);
+}
+
+void
sv_usepvn(register SV *sv, register char *ptr, register STRLEN len)
{
- sv_check_thinkfirst(sv);
- if (!SvUPGRADE(sv, SVt_PV))
- return;
+ SV_CHECK_THINKFIRST(sv);
+ (void)SvUPGRADE(sv, SVt_PV);
if (!ptr) {
(void)SvOK_off(sv);
return;
SvTAINT(sv);
}
+void
+sv_usepvn_mg(register SV *sv, register char *ptr, register STRLEN len)
+{
+ sv_usepvn(sv,ptr,len);
+ SvSETMAGIC(sv);
+}
+
static void
sv_check_thinkfirst(register SV *sv)
{
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv)) {
- dTHR;
- if (curcop != &compiling)
- croak(no_modify);
- }
- if (SvROK(sv))
- sv_unref(sv);
+ if (SvREADONLY(sv)) {
+ dTHR;
+ if (curcop != &compiling)
+ croak(no_modify);
}
+ if (SvROK(sv))
+ sv_unref(sv);
}
void
if (!ptr || !SvPOKp(sv))
return;
- sv_check_thinkfirst(sv);
+ SV_CHECK_THINKFIRST(sv);
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv,SVt_PVIV);
}
void
+sv_catpvn_mg(register SV *sv, register char *ptr, register STRLEN len)
+{
+ sv_catpvn(sv,ptr,len);
+ SvSETMAGIC(sv);
+}
+
+void
sv_catsv(SV *dstr, register SV *sstr)
{
char *s;
}
void
+sv_catsv_mg(SV *dstr, register SV *sstr)
+{
+ sv_catsv(dstr,sstr);
+ SvSETMAGIC(dstr);
+}
+
+void
sv_catpv(register SV *sv, register char *ptr)
{
register STRLEN len;
SvTAINT(sv);
}
+void
+sv_catpv_mg(register SV *sv, register char *ptr)
+{
+ sv_catpv(sv,ptr);
+ SvSETMAGIC(sv);
+}
+
SV *
#ifdef LEAKTEST
-newSV(x,len)
-I32 x;
+newSV(I32 x, STRLEN len)
#else
newSV(STRLEN len)
#endif
-
{
register SV *sv;
}
}
else {
- if (!SvUPGRADE(sv, SVt_PVMG))
- return;
+ (void)SvUPGRADE(sv, SVt_PVMG);
}
Newz(702,mg, 1, MAGIC);
mg->mg_moremagic = SvMAGIC(sv);
sv_replace(register SV *sv, register SV *nsv)
{
U32 refcnt = SvREFCNT(sv);
- sv_check_thinkfirst(sv);
+ SV_CHECK_THINKFIRST(sv);
if (SvREFCNT(nsv) != 1)
warn("Reference miscount in sv_replace()");
if (SvMAGICAL(sv)) {
void
sv_clear(register SV *sv)
{
+ HV* stash;
assert(sv);
assert(SvREFCNT(sv) == 0);
if (defstash) { /* Still have a symbol table? */
djSP;
GV* destructor;
+ SV ref;
- ENTER;
- SAVEFREESV(SvSTASH(sv));
-
- destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
- if (destructor) {
- SV ref;
-
- Zero(&ref, 1, SV);
- sv_upgrade(&ref, SVt_RV);
- SvRV(&ref) = SvREFCNT_inc(sv);
- SvROK_on(&ref);
- SvREFCNT(&ref) = 1; /* Fake, but otherwise
- creating+destructing a ref
- leads to disaster. */
-
- EXTEND(SP, 2);
- PUSHMARK(SP);
- PUSHs(&ref);
- PUTBACK;
- perl_call_sv((SV*)GvCV(destructor),
- G_DISCARD|G_EVAL|G_KEEPERR);
- del_XRV(SvANY(&ref));
- SvREFCNT(sv)--;
- }
+ Zero(&ref, 1, SV);
+ sv_upgrade(&ref, SVt_RV);
+ SvROK_on(&ref);
+ SvREADONLY_on(&ref); /* DESTROY() could be naughty */
+ SvREFCNT(&ref) = 1;
- LEAVE;
+ do {
+ stash = SvSTASH(sv);
+ destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
+ if (destructor) {
+ ENTER;
+ PUSHSTACK(SI_DESTROY);
+ SvRV(&ref) = SvREFCNT_inc(sv);
+ EXTEND(SP, 2);
+ PUSHMARK(SP);
+ PUSHs(&ref);
+ PUTBACK;
+ perl_call_sv((SV*)GvCV(destructor),
+ G_DISCARD|G_EVAL|G_KEEPERR);
+ SvREFCNT(sv)--;
+ POPSTACK();
+ LEAVE;
+ }
+ } while (SvOBJECT(sv) && SvSTASH(sv) != stash);
+
+ del_XRV(SvANY(&ref));
}
- else
- SvREFCNT_dec(SvSTASH(sv));
+
if (SvOBJECT(sv)) {
+ SvREFCNT_dec(SvSTASH(sv)); /* possibly of changed persuasion */
SvOBJECT_off(sv); /* Curse the object. */
if (SvTYPE(sv) != SVt_PVIO)
--sv_objcount; /* XXX Might want something more general */
}
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
mg_free(sv);
+ stash = NULL;
switch (SvTYPE(sv)) {
case SVt_PVIO:
if (IoIFP(sv) != PerlIO_stdin() &&
case SVt_PVGV:
gp_free((GV*)sv);
Safefree(GvNAME(sv));
+ /* cannot decrease stash refcount yet, as we might recursively delete
+ ourselves when the refcnt drops to zero. Delay SvREFCNT_dec
+ of stash until current sv is completely gone.
+ -- JohnPC, 27 Mar 1998 */
+ stash = GvSTASH(sv);
/* FALL THROUGH */
case SVt_PVLV:
case SVt_PVMG:
break;
case SVt_PVGV:
del_XPVGV(SvANY(sv));
- break;
+ /* code duplication for increased performance. */
+ SvFLAGS(sv) &= SVf_BREAK;
+ SvFLAGS(sv) |= SVTYPEMASK;
+ /* decrease refcount of the stash that owns this GV, if any */
+ if (stash)
+ SvREFCNT_dec(stash);
+ return; /* not break, SvFLAGS reset already happened */
case SVt_PVBM:
del_XPVBM(SvANY(sv));
break;
sv_newref(SV *sv)
{
if (sv)
- SvREFCNT(sv)++;
+ ATOMIC_INC(SvREFCNT(sv));
return sv;
}
void
sv_free(SV *sv)
{
+ int refcount_is_zero;
+
if (!sv)
return;
if (SvREADONLY(sv)) {
warn("Attempt to free unreferenced scalar");
return;
}
- if (--SvREFCNT(sv) > 0)
+ ATOMIC_DEC_AND_TEST(refcount_is_zero, SvREFCNT(sv));
+ if (!refcount_is_zero)
return;
#ifdef DEBUGGING
if (SvTEMP(sv)) {
register I32 cnt;
I32 i;
- sv_check_thinkfirst(sv);
- if (!SvUPGRADE(sv, SVt_PV))
- return 0;
+ SV_CHECK_THINKFIRST(sv);
+ (void)SvUPGRADE(sv, SVt_PV);
SvSCREAM_off(sv);
if (RsSNARF(rs)) {
return sv;
}
+SV *
+newSVpvn(s,len)
+char *s;
+STRLEN len;
+{
+ register SV *sv;
+
+ new_SV(sv);
+ SvANY(sv) = 0;
+ SvREFCNT(sv) = 1;
+ SvFLAGS(sv) = 0;
+ sv_setpvn(sv,s,len);
+ return sv;
+}
+
#ifdef I_STDARG
SV *
newSVpvf(const char* pat, ...)
register I32 max;
char todo[256];
+ if (!stash)
+ return;
+
if (!*s) { /* reset ?? searches */
for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
pm->op_pmflags &= ~PMf_USED;
SvREFCNT(sv) = 0;
SvFLAGS(sv) = 0;
- sv_check_thinkfirst(rv);
+ SV_CHECK_THINKFIRST(rv);
#ifdef OVERLOAD
SvAMAGIC_off(rv);
#endif /* OVERLOAD */
SV*
sv_setref_pv(SV *rv, char *classname, void *pv)
{
- if (!pv)
+ if (!pv) {
sv_setsv(rv, &sv_undef);
+ SvSETMAGIC(rv);
+ }
else
sv_setiv(newSVrv(rv,classname), (IV)pv);
return rv;
SvFAKE_off(sv);
if (GvGP(sv))
gp_free((GV*)sv);
+ if (GvSTASH(sv)) {
+ SvREFCNT_dec(GvSTASH(sv));
+ GvSTASH(sv) = Nullhv;
+ }
sv_unmagic(sv, '*');
Safefree(GvNAME(sv));
GvMULTI_off(sv);
SvCUR(sv) = p - SvPVX(sv);
}
+
+void
+sv_setpviv_mg(SV *sv, IV iv)
+{
+ sv_setpviv(sv,iv);
+ SvSETMAGIC(sv);
+}
+
#ifdef I_STDARG
void
sv_setpvf(SV *sv, const char* pat, ...)
va_end(args);
}
+
+#ifdef I_STDARG
+void
+sv_setpvf_mg(SV *sv, const char* pat, ...)
+#else
+/*VARARGS0*/
+void
+sv_setpvf_mg(sv, pat, va_alist)
+ SV *sv;
+ const char *pat;
+ va_dcl
+#endif
+{
+ va_list args;
+#ifdef I_STDARG
+ va_start(args, pat);
+#else
+ va_start(args);
+#endif
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ va_end(args);
+ SvSETMAGIC(sv);
+}
+
#ifdef I_STDARG
void
sv_catpvf(SV *sv, const char* pat, ...)
va_end(args);
}
+#ifdef I_STDARG
+void
+sv_catpvf_mg(SV *sv, const char* pat, ...)
+#else
+/*VARARGS0*/
+void
+sv_catpvf_mg(sv, pat, va_alist)
+ SV *sv;
+ const char *pat;
+ va_dcl
+#endif
+{
+ va_list args;
+#ifdef I_STDARG
+ va_start(args, pat);
+#else
+ va_start(args);
+#endif
+ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ va_end(args);
+ SvSETMAGIC(sv);
+}
+
void
sv_vsetpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *used_locale)
{
switch (base) {
unsigned dig;
case 16:
+ if (!uv)
+ alt = FALSE;
p = (c == 'X') ? "0123456789ABCDEF" : "0123456789abcdef";
do {
dig = uv & 15;
break;
}
elen = (ebuf + sizeof ebuf) - eptr;
- if (has_precis && precis > elen)
- zeros = precis - elen;
+ if (has_precis) {
+ if (precis > elen)
+ zeros = precis - elen;
+ else if (precis == 0 && elen == 1 && *eptr == '0')
+ elen = 0;
+ }
break;
/* FLOATING POINT */
case SVt_PVGV:
PerlIO_printf(Perl_debug_log, " NAME = \"%s\"\n", GvNAME(sv));
PerlIO_printf(Perl_debug_log, " NAMELEN = %ld\n", (long)GvNAMELEN(sv));
- PerlIO_printf(Perl_debug_log, " STASH = \"%s\"\n", HvNAME(GvSTASH(sv)));
+ PerlIO_printf(Perl_debug_log, " STASH = \"%s\"\n",
+ SvTYPE(GvSTASH(sv)) == SVt_PVHV ? HvNAME(GvSTASH(sv)) : "(deleted)");
PerlIO_printf(Perl_debug_log, " GP = 0x%lx\n", (long)GvGP(sv));
PerlIO_printf(Perl_debug_log, " SV = 0x%lx\n", (long)GvSV(sv));
PerlIO_printf(Perl_debug_log, " REFCNT = %ld\n", (long)GvREFCNT(sv));
https://perl5.git.perl.org / perl5.git / blobdiff