# define FAST_SV_GETS
#endif
+#ifdef PERL_OBJECT
+#define FCALL this->*f
+#define VTBL this->*vtbl
+
+#else /* !PERL_OBJECT */
+
static IV asIV _((SV* sv));
static UV asUV _((SV* sv));
static SV *more_sv _((void));
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*));
+#define VTBL *vtbl
+#define FCALL *f
+
+#endif /* PERL_OBJECT */
+
+#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_check_thinkfirst(sv)
#ifdef PURIFY
} while (0)
static SV **registry;
-static I32 regsize;
+static I32 registry_size;
#define REGHASH(sv,size) ((((U32)(sv)) >> 2) % (size))
#define REG_REPLACE(sv,a,b) \
do { \
void* p = sv->sv_any; \
- I32 h = REGHASH(sv, regsize); \
+ I32 h = REGHASH(sv, registry_size); \
I32 i = h; \
while (registry[i] != (a)) { \
- if (++i >= regsize) \
+ if (++i >= registry_size) \
i = 0; \
if (i == h) \
die("SV registry bug"); \
reg_add(sv)
SV* sv;
{
- if (sv_count >= (regsize >> 1))
+ if (sv_count >= (registry_size >> 1))
{
SV **oldreg = registry;
- I32 oldsize = regsize;
+ I32 oldsize = registry_size;
- regsize = regsize ? ((regsize << 2) + 1) : 2037;
- Newz(707, registry, regsize, SV*);
+ registry_size = registry_size ? ((registry_size << 2) + 1) : 2037;
+ Newz(707, registry, registry_size, SV*);
if (oldreg) {
I32 i;
{
I32 i;
- for (i = 0; i < regsize; ++i) {
+ for (i = 0; i < registry_size; ++i) {
SV* sv = registry[i];
- if (sv)
+ if (sv && SvTYPE(sv) != SVTYPEMASK)
(*f)(sv);
}
}
UNLOCK_SV_MUTEX; \
} while (0)
-static void
+STATIC void
del_sv(SV *p)
{
if (debug & 32768) {
}
/* sv_mutex must be held while calling more_sv() */
-static SV*
+STATIC SV*
more_sv(void)
{
register SV* sv;
return sv;
}
-static void
+STATIC void
visit(SVFUNC f)
{
SV* sva;
svend = &sva[SvREFCNT(sva)];
for (sv = sva + 1; sv < svend; ++sv) {
if (SvTYPE(sv) != SVTYPEMASK)
- (*f)(sv);
+ (FCALL)(sv);
}
}
}
#endif /* PURIFY */
-static void
+STATIC void
do_report_used(SV *sv)
{
if (SvTYPE(sv) != SVTYPEMASK) {
void
sv_report_used(void)
{
- visit(do_report_used);
+ visit(FUNC_NAME_TO_PTR(do_report_used));
}
-static void
+STATIC void
do_clean_objs(SV *sv)
{
SV* rv;
}
#ifndef DISABLE_DESTRUCTOR_KLUDGE
-static void
+STATIC void
do_clean_named_objs(SV *sv)
{
if (SvTYPE(sv) == SVt_PVGV) {
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
-static bool in_clean_objs = FALSE;
-
void
sv_clean_objs(void)
{
in_clean_objs = TRUE;
+ visit(FUNC_NAME_TO_PTR(do_clean_objs));
#ifndef DISABLE_DESTRUCTOR_KLUDGE
- visit(do_clean_named_objs);
+ /* some barnacles may yet remain, clinging to typeglobs */
+ visit(FUNC_NAME_TO_PTR(do_clean_named_objs));
#endif
- visit(do_clean_objs);
in_clean_objs = FALSE;
}
-static void
+STATIC void
do_clean_all(SV *sv)
{
- DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops:\n "), sv_dump(sv));)
+ DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%lx\n", sv) );)
SvFLAGS(sv) |= SVf_BREAK;
SvREFCNT_dec(sv);
}
-static bool in_clean_all = FALSE;
-
void
sv_clean_all(void)
{
in_clean_all = TRUE;
- visit(do_clean_all);
+ visit(FUNC_NAME_TO_PTR(do_clean_all));
in_clean_all = FALSE;
}
Safefree((void *)sva);
}
+ if (nice_chunk)
+ Safefree(nice_chunk);
+ nice_chunk = Nullch;
+ nice_chunk_size = 0;
sv_arenaroot = 0;
sv_root = 0;
}
-static XPVIV*
+STATIC XPVIV*
new_xiv(void)
{
- IV** xiv;
+ IV* xiv;
if (xiv_root) {
xiv = xiv_root;
/*
* See comment in more_xiv() -- RAM.
*/
- xiv_root = (IV**)*xiv;
- return (XPVIV*)((char*)xiv - sizeof(XPV));
+ xiv_root = *(IV**)xiv;
+ return (XPVIV*)((char*)xiv - STRUCT_OFFSET(XPVIV, xiv_iv));
}
return more_xiv();
}
-static void
+STATIC void
del_xiv(XPVIV *p)
{
- IV** xiv = (IV**)((char*)(p) + sizeof(XPV));
- *xiv = (IV *)xiv_root;
+ IV* xiv = (IV*)((char*)(p) + STRUCT_OFFSET(XPVIV, xiv_iv));
+ *(IV**)xiv = xiv_root;
xiv_root = xiv;
}
-static XPVIV*
+STATIC XPVIV*
more_xiv(void)
{
- register IV** xiv;
- register IV** xivend;
+ register IV* xiv;
+ register IV* xivend;
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 */
- xiv = (IV**) ptr;
- xivend = &xiv[1008 / sizeof(IV *) - 1];
- xiv += (sizeof(XPV) - 1) / sizeof(IV *) + 1; /* fudge by size of XPV */
+ xiv = (IV*) ptr;
+ xivend = &xiv[1008 / sizeof(IV) - 1];
+ xiv += (sizeof(XPV) - 1) / sizeof(IV) + 1; /* fudge by size of XPV */
xiv_root = xiv;
while (xiv < xivend) {
- *xiv = (IV *)(xiv + 1);
+ *(IV**)xiv = (IV *)(xiv + 1);
xiv++;
}
- *xiv = 0;
+ *(IV**)xiv = 0;
return new_xiv();
}
-static XPVNV*
+STATIC XPVNV*
new_xnv(void)
{
double* xnv;
if (xnv_root) {
xnv = xnv_root;
xnv_root = *(double**)xnv;
- return (XPVNV*)((char*)xnv - sizeof(XPVIV));
+ return (XPVNV*)((char*)xnv - STRUCT_OFFSET(XPVNV, xnv_nv));
}
return more_xnv();
}
-static void
+STATIC void
del_xnv(XPVNV *p)
{
- double* xnv = (double*)((char*)(p) + sizeof(XPVIV));
+ double* xnv = (double*)((char*)(p) + STRUCT_OFFSET(XPVNV, xnv_nv));
*(double**)xnv = xnv_root;
xnv_root = xnv;
}
-static XPVNV*
+STATIC XPVNV*
more_xnv(void)
{
register double* xnv;
return new_xnv();
}
-static XRV*
+STATIC XRV*
new_xrv(void)
{
XRV* xrv;
return more_xrv();
}
-static void
+STATIC void
del_xrv(XRV *p)
{
p->xrv_rv = (SV*)xrv_root;
xrv_root = p;
}
-static XRV*
+STATIC XRV*
more_xrv(void)
{
register XRV* xrv;
return new_xrv();
}
-static XPV*
+STATIC XPV*
new_xpv(void)
{
XPV* xpv;
return more_xpv();
}
-static void
+STATIC void
del_xpv(XPV *p)
{
p->xpv_pv = (char*)xpv_root;
xpv_root = p;
}
-static XPV*
+STATIC XPV*
more_xpv(void)
{
register XPV* xpv;
# define my_safemalloc(s) safemalloc(s)
# define my_safefree(s) free(s)
#else
-static void*
+STATIC void*
my_safemalloc(MEM_SIZE size)
{
char *p;
return TRUE;
}
-#ifdef DEBUGGING
char *
sv_peek(SV *sv)
{
+#ifdef DEBUGGING
SV *t = sv_newmortal();
STRLEN prevlen;
int unref = 0;
sv_catpv(t, ")");
}
return SvPV(t, na);
+#else /* DEBUGGING */
+ return "";
+#endif /* DEBUGGING */
}
-#endif
int
sv_backoff(register SV *sv)
else
s = SvPVX(sv);
if (newlen > SvLEN(sv)) { /* need more room? */
- if (SvLEN(sv) && s)
+ if (SvLEN(sv) && s) {
+#if defined(MYMALLOC) && !defined(PURIFY)
+ STRLEN l = malloced_size((void*)SvPVX(sv));
+ if (newlen <= l) {
+ SvLEN_set(sv, l);
+ return s;
+ } else
+#endif
Renew(s,newlen,char);
+ }
else
New(703,s,newlen,char);
SvPV_set(sv, s);
case SVt_PV:
case SVt_PVIV:
sv_upgrade(sv, SVt_PVNV);
- /* FALL THROUGH */
- case SVt_PVNV:
- case SVt_PVMG:
- case SVt_PVBM:
- case SVt_PVLV:
- if (SvOOK(sv))
- (void)SvOOK_off(sv);
break;
+
case SVt_PVGV:
if (SvFAKE(sv)) {
sv_unglob(sv);
SvSETMAGIC(sv);
}
-static void
+STATIC void
not_a_number(SV *sv)
{
dTHR;
return SvNVX(sv);
}
-static IV
+STATIC IV
asIV(SV *sv)
{
I32 numtype = looks_like_number(sv);
return (IV) U_V(d);
}
-static UV
+STATIC UV
asUV(SV *sv)
{
I32 numtype = looks_like_number(sv);
if (!sv)
s = "NULLREF";
else {
+ MAGIC *mg;
+
switch (SvTYPE(sv)) {
+ case SVt_PVMG:
+ if ( ((SvFLAGS(sv) &
+ (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
+ == (SVs_OBJECT|SVs_RMG))
+ && strEQ(s=HvNAME(SvSTASH(sv)), "Regexp")
+ && (mg = mg_find(sv, 'r'))) {
+ dTHR;
+ regexp *re = (regexp *)mg->mg_obj;
+
+ if (!mg->mg_ptr) {
+ char *fptr = "msix";
+ char reflags[6];
+ char ch;
+ int left = 0;
+ int right = 4;
+ U16 reganch = (re->reganch & PMf_COMPILETIME) >> 12;
+
+ while(ch = *fptr++) {
+ if(reganch & 1) {
+ reflags[left++] = ch;
+ }
+ else {
+ reflags[right--] = ch;
+ }
+ reganch >>= 1;
+ }
+ if(left != 4) {
+ reflags[left] = '-';
+ left = 5;
+ }
+
+ mg->mg_len = re->prelen + 4 + left;
+ New(616, mg->mg_ptr, mg->mg_len + 1 + left, char);
+ Copy("(?", mg->mg_ptr, 2, char);
+ Copy(reflags, mg->mg_ptr+2, left, char);
+ Copy(":", mg->mg_ptr+left+2, 1, char);
+ Copy(re->precomp, mg->mg_ptr+3+left, re->prelen, char);
+ mg->mg_ptr[mg->mg_len - 1] = ')';
+ mg->mg_ptr[mg->mg_len] = 0;
+ }
+ reginterp_cnt += re->program[0].next_off;
+ *lp = mg->mg_len;
+ return mg->mg_ptr;
+ }
+ /* Fall through */
case SVt_NULL:
case SVt_IV:
case SVt_NV:
case SVt_PV:
case SVt_PVIV:
case SVt_PVNV:
- case SVt_PVBM:
- case SVt_PVMG: s = "SCALAR"; break;
+ case SVt_PVBM: s = "SCALAR"; break;
case SVt_PVLV: s = "LVALUE"; break;
case SVt_PVAV: s = "ARRAY"; break;
case SVt_PVHV: s = "HASH"; break;
case SVt_PVCV: s = "CODE"; break;
case SVt_PVGV: s = "GLOB"; break;
- case SVt_PVFM: s = "FORMLINE"; break;
+ case SVt_PVFM: s = "FORMAT"; break;
case SVt_PVIO: s = "IO"; break;
default: s = "UNKNOWN"; break;
}
switch (stype) {
case SVt_NULL:
- (void)SvOK_off(dstr);
- return;
+ undef_sstr:
+ 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 (SvIOK(sstr)) {
+ switch (dtype) {
+ case SVt_NULL:
sv_upgrade(dstr, SVt_IV);
- else if (dtype == SVt_NV)
+ break;
+ case SVt_NV:
sv_upgrade(dstr, SVt_PVNV);
- else
+ break;
+ case SVt_RV:
+ case SVt_PV:
sv_upgrade(dstr, SVt_PVIV);
+ break;
+ }
+ (void)SvIOK_only(dstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvTAINT(dstr);
+ return;
}
- break;
+ goto undef_sstr;
+
case SVt_NV:
- if (dtype != SVt_NV && dtype < SVt_PVNV) {
- if (dtype < SVt_NV)
+ if (SvNOK(sstr)) {
+ switch (dtype) {
+ case SVt_NULL:
+ case SVt_IV:
sv_upgrade(dstr, SVt_NV);
- else
+ break;
+ case SVt_RV:
+ case SVt_PV:
+ case SVt_PVIV:
sv_upgrade(dstr, SVt_PVNV);
+ break;
+ }
+ SvNVX(dstr) = SvNVX(sstr);
+ (void)SvNOK_only(dstr);
+ SvTAINT(dstr);
+ return;
}
- break;
+ goto undef_sstr;
+
case SVt_RV:
if (dtype < SVt_RV)
sv_upgrade(dstr, SVt_RV);
SvFAKE_on(dstr); /* can coerce to non-glob */
}
/* ahem, death to those who redefine active sort subs */
- else if (curstackinfo->si_type == SI_SORT
+ else if (curstackinfo->si_type == PERLSI_SORT
&& GvCV(dstr) && sortcop == CvSTART(GvCV(dstr)))
croak("Can't redefine active sort subroutine %s",
GvNAME(dstr));
if (!GvCVGEN((GV*)dstr) &&
(CvROOT(cv) || CvXSUB(cv)))
{
+ SV *const_sv = cv_const_sv(cv);
+ bool const_changed = TRUE;
+ if(const_sv)
+ const_changed = sv_cmp(const_sv,
+ op_const_sv(CvSTART((CV*)sref),
+ Nullcv));
/* ahem, death to those who redefine
* active sort subs */
- if (curstackinfo->si_type == SI_SORT &&
+ if (curstackinfo->si_type == PERLSI_SORT &&
sortcop == CvSTART(cv))
croak(
"Can't redefine active sort subroutine %s",
GvENAME((GV*)dstr));
- if (cv_const_sv(cv))
- warn("Constant subroutine %s redefined",
- GvENAME((GV*)dstr));
- else if (dowarn) {
+ if (dowarn || (const_changed && const_sv)) {
if (!(CvGV(cv) && GvSTASH(CvGV(cv))
&& HvNAME(GvSTASH(CvGV(cv)))
&& strEQ(HvNAME(GvSTASH(CvGV(cv))),
"autouse")))
- warn("Subroutine %s redefined",
+ warn(const_sv ?
+ "Constant subroutine %s redefined"
+ : "Subroutine %s redefined",
GvENAME((GV*)dstr));
}
}
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);
}
SvSETMAGIC(sv);
}
-static void
+STATIC void
sv_check_thinkfirst(register SV *sv)
{
if (SvREADONLY(sv)) {
}
SV *
-#ifdef LEAKTEST
-newSV(I32 x, STRLEN len)
-#else
newSV(STRLEN len)
-#endif
{
register SV *sv;
if (mg->mg_type == type) {
MGVTBL* vtbl = mg->mg_virtual;
*mgp = mg->mg_moremagic;
- if (vtbl && vtbl->svt_free)
- (*vtbl->svt_free)(sv, mg);
+ if (vtbl && (vtbl->svt_free != NULL))
+ (VTBL->svt_free)(sv, mg);
if (mg->mg_ptr && mg->mg_type != 'g')
if (mg->mg_len >= 0)
Safefree(mg->mg_ptr);
register char *midend;
register char *bigend;
register I32 i;
+ STRLEN curlen;
+
if (!bigstr)
croak("Can't modify non-existent substring");
- SvPV_force(bigstr, na);
+ SvPV_force(bigstr, curlen);
+ if (offset + len > curlen) {
+ SvGROW(bigstr, offset+len+1);
+ Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char);
+ SvCUR_set(bigstr, offset+len);
+ }
i = littlelen - len;
if (i > 0) { /* string might grow */
if (defstash) { /* Still have a symbol table? */
djSP;
GV* destructor;
- SV ref;
+ SV tmpref;
- Zero(&ref, 1, SV);
- sv_upgrade(&ref, SVt_RV);
- SvROK_on(&ref);
- SvREADONLY_on(&ref); /* DESTROY() could be naughty */
- SvREFCNT(&ref) = 1;
+ Zero(&tmpref, 1, SV);
+ sv_upgrade(&tmpref, SVt_RV);
+ SvROK_on(&tmpref);
+ SvREADONLY_on(&tmpref); /* DESTROY() could be naughty */
+ SvREFCNT(&tmpref) = 1;
do {
stash = SvSTASH(sv);
destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
if (destructor) {
ENTER;
- PUSHSTACK(SI_DESTROY);
- SvRV(&ref) = SvREFCNT_inc(sv);
+ PUSHSTACKi(PERLSI_DESTROY);
+ SvRV(&tmpref) = SvREFCNT_inc(sv);
EXTEND(SP, 2);
PUSHMARK(SP);
- PUSHs(&ref);
+ PUSHs(&tmpref);
PUTBACK;
perl_call_sv((SV*)GvCV(destructor),
G_DISCARD|G_EVAL|G_KEEPERR);
SvREFCNT(sv)--;
- POPSTACK();
+ POPSTACK;
LEAVE;
}
} while (SvOBJECT(sv) && SvSTASH(sv) != stash);
- del_XRV(SvANY(&ref));
+ del_XRV(SvANY(&tmpref));
}
if (SvOBJECT(sv)) {
if (!sv)
return;
- if (SvREADONLY(sv)) {
- if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
- return;
- }
if (SvREFCNT(sv) == 0) {
if (SvFLAGS(sv) & SVf_BREAK)
return;
if (in_clean_all) /* All is fair */
return;
+ if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+ /* make sure SvREFCNT(sv)==0 happens very seldom */
+ SvREFCNT(sv) = (~(U32)0)/2;
+ return;
+ }
warn("Attempt to free unreferenced scalar");
return;
}
return;
}
#endif
+ if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+ /* make sure SvREFCNT(sv)==0 happens very seldom */
+ SvREFCNT(sv) = (~(U32)0)/2;
+ return;
+ }
sv_clear(sv);
if (! SvREFCNT(sv))
del_SV(sv);
return 0;
if (SvGMAGICAL(sv))
- len = mg_len(sv);
+ len = mg_length(sv);
else
junk = SvPV(sv, len);
return len;
rsptr = NULL;
rslen = 0;
}
+ else if (RsRECORD(rs)) {
+ I32 recsize, bytesread;
+ char *buffer;
+
+ /* Grab the size of the record we're getting */
+ recsize = SvIV(SvRV(rs));
+ (void)SvPOK_only(sv); /* Validate pointer */
+ /* Make sure we've got the room to yank in the whole thing */
+ if (SvLEN(sv) <= recsize + 3) {
+ /* No, so make it bigger */
+ SvGROW(sv, recsize + 3);
+ }
+ buffer = SvPVX(sv); /* Get the location of the final buffer */
+ /* Go yank in */
+#ifdef VMS
+ /* VMS wants read instead of fread, because fread doesn't respect */
+ /* RMS record boundaries. This is not necessarily a good thing to be */
+ /* doing, but we've got no other real choice */
+ bytesread = PerlLIO_read(PerlIO_fileno(fp), buffer, recsize);
+#else
+ bytesread = PerlIO_read(fp, buffer, recsize);
+#endif
+ SvCUR_set(sv, bytesread);
+ return(SvCUR(sv) ? SvPVX(sv) : Nullch);
+ }
else if (RsPARA(rs)) {
rsptr = "\n\n";
rslen = 2;
croak(no_modify);
}
if (SvROK(sv)) {
+ IV i;
#ifdef OVERLOAD
- if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
+ if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
#endif /* OVERLOAD */
- sv_unref(sv);
+ i = (IV)SvRV(sv);
+ sv_unref(sv);
+ sv_setiv(sv, i);
}
}
if (SvGMAGICAL(sv))
croak(no_modify);
}
if (SvROK(sv)) {
+ IV i;
#ifdef OVERLOAD
- if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
+ if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
#endif /* OVERLOAD */
- sv_unref(sv);
+ i = (IV)SvRV(sv);
+ sv_unref(sv);
+ sv_setiv(sv, i);
}
}
if (SvGMAGICAL(sv))
* hopefully we won't free it until it has been assigned to a
* permanent location. */
-static void
+STATIC void
sv_mortalgrow(void)
{
dTHR;
dTHR;
if (!sv)
return sv;
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
+ if (SvREADONLY(sv) && SvIMMORTAL(sv))
+ return sv;
if (++tmps_ix >= tmps_max)
sv_mortalgrow();
tmps_stack[tmps_ix] = sv;
}
SV *
-newSVpvn(s,len)
-char *s;
-STRLEN len;
+newSVpvn(char *s, STRLEN len)
{
register SV *sv;
return sv;
}
-#ifdef I_STDARG
SV *
newSVpvf(const char* pat, ...)
-#else
-/*VARARGS0*/
-SV *
-newSVpvf(pat, va_alist)
-const char *pat;
-va_dcl
-#endif
{
register SV *sv;
va_list args;
SvANY(sv) = 0;
SvREFCNT(sv) = 1;
SvFLAGS(sv) = 0;
-#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);
return sv;
}
SV *
-newRV(SV *ref)
+newRV_noinc(SV *tmpRef)
{
dTHR;
register SV *sv;
SvREFCNT(sv) = 1;
SvFLAGS(sv) = 0;
sv_upgrade(sv, SVt_RV);
- SvTEMP_off(ref);
- SvRV(sv) = SvREFCNT_inc(ref);
+ SvTEMP_off(tmpRef);
+ SvRV(sv) = tmpRef;
SvROK_on(sv);
return sv;
}
-
-
SV *
-Perl_newRV_noinc(SV *ref)
+newRV(SV *tmpRef)
{
- register SV *sv;
-
- sv = newRV(ref);
- SvREFCNT_dec(ref);
- return sv;
+ return newRV_noinc(SvREFCNT_inc(tmpRef));
}
/* make an exact duplicate of old */
if (!*s) { /* reset ?? searches */
for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
- pm->op_pmflags &= ~PMf_USED;
+ pm->op_pmdynflags &= ~PMdf_USED;
}
return;
}
case SVt_PVHV: return "HASH";
case SVt_PVCV: return "CODE";
case SVt_PVGV: return "GLOB";
- case SVt_PVFM: return "FORMLINE";
+ case SVt_PVFM: return "FORMAT";
default: return "UNKNOWN";
}
}
sv_bless(SV *sv, HV *stash)
{
dTHR;
- SV *ref;
+ SV *tmpRef;
if (!SvROK(sv))
croak("Can't bless non-reference value");
- ref = SvRV(sv);
- if (SvFLAGS(ref) & (SVs_OBJECT|SVf_READONLY)) {
- if (SvREADONLY(ref))
+ tmpRef = SvRV(sv);
+ if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {
+ if (SvREADONLY(tmpRef))
croak(no_modify);
- if (SvOBJECT(ref)) {
- if (SvTYPE(ref) != SVt_PVIO)
+ if (SvOBJECT(tmpRef)) {
+ if (SvTYPE(tmpRef) != SVt_PVIO)
--sv_objcount;
- SvREFCNT_dec(SvSTASH(ref));
+ SvREFCNT_dec(SvSTASH(tmpRef));
}
}
- SvOBJECT_on(ref);
- if (SvTYPE(ref) != SVt_PVIO)
+ SvOBJECT_on(tmpRef);
+ if (SvTYPE(tmpRef) != SVt_PVIO)
++sv_objcount;
- (void)SvUPGRADE(ref, SVt_PVMG);
- SvSTASH(ref) = (HV*)SvREFCNT_inc(stash);
+ (void)SvUPGRADE(tmpRef, SVt_PVMG);
+ SvSTASH(tmpRef) = (HV*)SvREFCNT_inc(stash);
#ifdef OVERLOAD
if (Gv_AMG(stash))
return sv;
}
-static void
+STATIC void
sv_unglob(SV *sv)
{
assert(SvTYPE(sv) == SVt_PVGV);
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);
SvSETMAGIC(sv);
}
-#ifdef I_STDARG
void
sv_setpvf(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_setpvf(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);
}
-#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, ...)
-#else
-/*VARARGS0*/
-void
-sv_catpvf(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);
}
-#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);
}
}
-#ifdef DEBUGGING
void
sv_dump(SV *sv)
{
+#ifdef DEBUGGING
SV *d = sv_newmortal();
char *s;
U32 flags;
PerlIO_printf(Perl_debug_log, " FLAGS = 0x%lx\n", (long)IoFLAGS(sv));
break;
}
+#endif /* DEBUGGING */
}
-#else
-void
-sv_dump(SV *sv)
-{
-}
-#endif
-
-
-
-
https://perl5.git.perl.org / perl5.git / blobdiff