# 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 */
#ifdef PURIFY
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) {
visit(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 && GvSV(sv))
}
#endif
-static bool in_clean_objs = FALSE;
-
void
sv_clean_objs(void)
{
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));)
SvREFCNT_dec(sv);
}
-static bool in_clean_all = FALSE;
-
void
sv_clean_all(void)
{
sv_root = 0;
}
-static XPVIV*
+STATIC XPVIV*
new_xiv(void)
{
IV** xiv;
return more_xiv();
}
-static void
+STATIC void
del_xiv(XPVIV *p)
{
IV** xiv = (IV**)((char*)(p) + sizeof(XPV));
xiv_root = xiv;
}
-static XPVIV*
+STATIC XPVIV*
more_xiv(void)
{
register IV** xiv;
return new_xiv();
}
-static XPVNV*
+STATIC XPVNV*
new_xnv(void)
{
double* xnv;
return more_xnv();
}
-static void
+STATIC void
del_xnv(XPVNV *p)
{
double* xnv = (double*)((char*)(p) + sizeof(XPVIV));
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*
-my_safemalloc(size)
- MEM_SIZE size;
+STATIC void*
+my_safemalloc(MEM_SIZE size)
{
char *p;
New(717, p, size, char);
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);
}
-static void
+void
+sv_setnv_mg(register SV *sv, double num)
+{
+ sv_setnv(sv,num);
+ SvSETMAGIC(sv);
+}
+
+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);
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);
}
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);
}
-static void
+void
+sv_usepvn_mg(register SV *sv, register char *ptr, register STRLEN len)
+{
+ sv_usepvn_mg(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_mg(sv,ptr);
+ SvSETMAGIC(sv);
+}
+
SV *
#ifdef LEAKTEST
newSV(I32 x, STRLEN len)
}
}
else {
- if (!SvUPGRADE(sv, SVt_PVMG))
- return;
+ (void)SvUPGRADE(sv, SVt_PVMG);
}
Newz(702,mg, 1, MAGIC);
mg->mg_moremagic = SvMAGIC(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);
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)) {
if (defstash) { /* Still have a symbol table? */
djSP;
GV* destructor;
+ HV* stash;
+ SV tmpref;
- 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(&tmpref, 1, SV);
+ sv_upgrade(&tmpref, SVt_RV);
+ SvROK_on(&tmpref);
+ SvREADONLY_on(&tmpref); /* DESTROY() could be naughty */
+ SvREFCNT(&tmpref) = 1;
- LEAVE;
+ do {
+ stash = SvSTASH(sv);
+ destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
+ if (destructor) {
+ ENTER;
+ SvRV(&tmpref) = SvREFCNT_inc(sv);
+ EXTEND(SP, 2);
+ PUSHMARK(SP);
+ PUSHs(&tmpref);
+ PUTBACK;
+ perl_call_sv((SV*)GvCV(destructor),
+ G_DISCARD|G_EVAL|G_KEEPERR);
+ SvREFCNT(sv)--;
+ LEAVE;
+ }
+ } while (SvOBJECT(sv) && SvSTASH(sv) != stash);
+
+ del_XRV(SvANY(&tmpref));
}
- 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 */
return 0;
if (SvGMAGICAL(sv))
- len = mg_len(sv);
+ len = mg_length(sv);
else
junk = SvPV(sv, len);
return len;
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)) {
* hopefully we won't free it until it has been assigned to a
* permanent location. */
-static void
+STATIC void
sv_mortalgrow(void)
{
dTHR;
}
SV *
-newSVpvn(s,len)
-char *s;
-STRLEN len;
+newSVpvn(char *s, STRLEN len)
{
register SV *sv;
}
SV *
-newRV(SV *ref)
+newRV(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) = SvREFCNT_inc(tmpRef);
SvROK_on(sv);
return sv;
}
SV *
-Perl_newRV_noinc(SV *ref)
+Perl_newRV_noinc(SV *tmpRef)
{
register SV *sv;
- sv = newRV(ref);
- SvREFCNT_dec(ref);
+ sv = newRV(tmpRef);
+ SvREFCNT_dec(tmpRef);
return sv;
}
SvREFCNT(sv) = 0;
SvFLAGS(sv) = 0;
- sv_check_thinkfirst(rv);
+ SV_CHECK_THINKFIRST(rv);
#ifdef OVERLOAD
SvAMAGIC_off(rv);
#endif /* OVERLOAD */
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);
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)
{
projects / p5sagit/p5-mst-13.2.git / blobdiff