static void del_xrv _((XRV* p));
static void sv_mortalgrow _((void));
static void sv_unglob _((SV* sv));
+static void sv_check_thinkfirst _((SV *sv));
typedef void (*SVFUNC) _((SV*));
#define new_SV(p) \
do { \
+ MUTEX_LOCK(&sv_mutex); \
(p) = (SV*)safemalloc(sizeof(SV)); \
reg_add(p); \
+ MUTEX_UNLOCK(&sv_mutex); \
} while (0)
#define del_SV(p) \
do { \
+ MUTEX_LOCK(&sv_mutex); \
reg_remove(p); \
free((char*)(p)); \
+ MUTEX_UNLOCK(&sv_mutex); \
} while (0)
static SV **registry;
--sv_count; \
} while (0)
+/* sv_mutex must be held while calling uproot_SV() */
#define uproot_SV(p) \
do { \
(p) = sv_root; \
++sv_count; \
} while (0)
-#define new_SV(p) \
- if (sv_root) \
- uproot_SV(p); \
- else \
- (p) = more_sv()
+#define new_SV(p) do { \
+ MUTEX_LOCK(&sv_mutex); \
+ if (sv_root) \
+ uproot_SV(p); \
+ else \
+ (p) = more_sv(); \
+ MUTEX_UNLOCK(&sv_mutex); \
+ } while (0)
#ifdef DEBUGGING
-#define del_SV(p) \
- if (debug & 32768) \
- del_sv(p); \
- else \
- plant_SV(p)
+#define del_SV(p) do { \
+ MUTEX_LOCK(&sv_mutex); \
+ if (debug & 32768) \
+ del_sv(p); \
+ else \
+ plant_SV(p); \
+ MUTEX_UNLOCK(&sv_mutex); \
+ } while (0)
static void
-del_sv(p)
-SV* p;
+del_sv(SV *p)
{
if (debug & 32768) {
SV* sva;
#endif /* DEBUGGING */
void
-sv_add_arena(ptr, size, flags)
-char* ptr;
-U32 size;
-U32 flags;
+sv_add_arena(char *ptr, U32 size, U32 flags)
{
SV* sva = (SV*)ptr;
register SV* sv;
SvFLAGS(sv) = SVTYPEMASK;
}
+/* sv_mutex must be held while calling more_sv() */
static SV*
-more_sv()
+more_sv(void)
{
register SV* sv;
}
static void
-visit(f)
-SVFUNC f;
+visit(SVFUNC f)
{
SV* sva;
SV* sv;
#endif /* PURIFY */
static void
-do_report_used(sv)
-SV* sv;
+do_report_used(SV *sv)
{
if (SvTYPE(sv) != SVTYPEMASK) {
/* XXX Perhaps this ought to go to Perl_debug_log, if DEBUGGING. */
}
void
-sv_report_used()
+sv_report_used(void)
{
visit(do_report_used);
}
static void
-do_clean_objs(sv)
-SV* sv;
+do_clean_objs(SV *sv)
{
SV* rv;
#ifndef DISABLE_DESTRUCTOR_KLUDGE
static void
-do_clean_named_objs(sv)
-SV* sv;
+do_clean_named_objs(SV *sv)
{
if (SvTYPE(sv) == SVt_PVGV && GvSV(sv))
do_clean_objs(GvSV(sv));
static bool in_clean_objs = FALSE;
void
-sv_clean_objs()
+sv_clean_objs(void)
{
in_clean_objs = TRUE;
#ifndef DISABLE_DESTRUCTOR_KLUDGE
}
static void
-do_clean_all(sv)
-SV* sv;
+do_clean_all(SV *sv)
{
DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops:\n "), sv_dump(sv));)
SvFLAGS(sv) |= SVf_BREAK;
static bool in_clean_all = FALSE;
void
-sv_clean_all()
+sv_clean_all(void)
{
in_clean_all = TRUE;
visit(do_clean_all);
}
void
-sv_free_arenas()
+sv_free_arenas(void)
{
SV* sva;
SV* svanext;
}
static XPVIV*
-new_xiv()
+new_xiv(void)
{
IV** xiv;
if (xiv_root) {
}
static void
-del_xiv(p)
-XPVIV* p;
+del_xiv(XPVIV *p)
{
IV** xiv = (IV**)((char*)(p) + sizeof(XPV));
*xiv = (IV *)xiv_root;
}
static XPVIV*
-more_xiv()
+more_xiv(void)
{
register IV** xiv;
register IV** xivend;
}
static XPVNV*
-new_xnv()
+new_xnv(void)
{
double* xnv;
if (xnv_root) {
}
static void
-del_xnv(p)
-XPVNV* p;
+del_xnv(XPVNV *p)
{
double* xnv = (double*)((char*)(p) + sizeof(XPVIV));
*(double**)xnv = xnv_root;
}
static XPVNV*
-more_xnv()
+more_xnv(void)
{
register double* xnv;
register double* xnvend;
}
static XRV*
-new_xrv()
+new_xrv(void)
{
XRV* xrv;
if (xrv_root) {
}
static void
-del_xrv(p)
-XRV* p;
+del_xrv(XRV *p)
{
p->xrv_rv = (SV*)xrv_root;
xrv_root = p;
}
static XRV*
-more_xrv()
+more_xrv(void)
{
register XRV* xrv;
register XRV* xrvend;
}
static XPV*
-new_xpv()
+new_xpv(void)
{
XPV* xpv;
if (xpv_root) {
}
static void
-del_xpv(p)
-XPV* p;
+del_xpv(XPV *p)
{
p->xpv_pv = (char*)xpv_root;
xpv_root = p;
}
static XPV*
-more_xpv()
+more_xpv(void)
{
register XPV* xpv;
register XPV* xpvend;
#define del_XIV(p) free((char*)p)
#else
#define new_XIV() (void*)new_xiv()
-#define del_XIV(p) del_xiv(p)
+#define del_XIV(p) del_xiv((XPVIV*) p)
#endif
#ifdef PURIFY
#define del_XNV(p) free((char*)p)
#else
#define new_XNV() (void*)new_xnv()
-#define del_XNV(p) del_xnv(p)
+#define del_XNV(p) del_xnv((XPVNV*) p)
#endif
#ifdef PURIFY
#define del_XRV(p) free((char*)p)
#else
#define new_XRV() (void*)new_xrv()
-#define del_XRV(p) del_xrv(p)
+#define del_XRV(p) del_xrv((XRV*) p)
#endif
#ifdef PURIFY
#define del_XPV(p) free((char*)p)
#else
#define new_XPV() (void*)new_xpv()
-#define del_XPV(p) del_xpv(p)
+#define del_XPV(p) del_xpv((XPV *)p)
#endif
#define new_XPVIV() (void*)safemalloc(sizeof(XPVIV))
#define del_XPVIO(p) free((char*)p)
bool
-sv_upgrade(sv, mt)
-register SV* sv;
-U32 mt;
+sv_upgrade(register SV *sv, U32 mt)
{
char* pv;
U32 cur;
#ifdef DEBUGGING
char *
-sv_peek(sv)
-register SV *sv;
+sv_peek(SV *sv)
{
SV *t = sv_newmortal();
STRLEN prevlen;
#endif
int
-sv_backoff(sv)
-register SV *sv;
+sv_backoff(register SV *sv)
{
assert(SvOOK(sv));
if (SvIVX(sv)) {
}
char *
-sv_grow(sv,newlen)
-register SV *sv;
#ifndef DOSISH
-register I32 newlen;
+sv_grow(register SV *sv, register I32 newlen)
#else
-unsigned long newlen;
+sv_grow(SV* sv, unsigned long newlen)
#endif
{
register char *s;
}
void
-sv_setiv(sv,i)
-register SV *sv;
-IV i;
+sv_setiv(register SV *sv, IV i)
{
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
+ dTHR; /* just for taint */
+ sv_check_thinkfirst(sv);
switch (SvTYPE(sv)) {
case SVt_NULL:
sv_upgrade(sv, SVt_IV);
case SVt_PVCV:
case SVt_PVFM:
case SVt_PVIO:
- croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
- op_desc[op->op_type]);
+ {
+ dTHR;
+ croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
+ op_desc[op->op_type]);
+ }
}
(void)SvIOK_only(sv); /* validate number */
SvIVX(sv) = i;
}
void
-sv_setuv(sv,u)
-register SV *sv;
-UV u;
+sv_setuv(register SV *sv, UV u)
{
if (u <= IV_MAX)
sv_setiv(sv, u);
}
void
-sv_setnv(sv,num)
-register SV *sv;
-double num;
+sv_setnv(register SV *sv, double num)
{
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
+ dTHR; /* just for taint */
+ sv_check_thinkfirst(sv);
switch (SvTYPE(sv)) {
case SVt_NULL:
case SVt_IV:
case SVt_PVCV:
case SVt_PVFM:
case SVt_PVIO:
- croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
- op_name[op->op_type]);
+ {
+ dTHR;
+ croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
+ op_name[op->op_type]);
+ }
}
SvNVX(sv) = num;
(void)SvNOK_only(sv); /* validate number */
}
static void
-not_a_number(sv)
-SV *sv;
+not_a_number(SV *sv)
{
+ dTHR;
char tmpbuf[64];
char *d = tmpbuf;
char *s;
}
IV
-sv_2iv(sv)
-register SV *sv;
+sv_2iv(register SV *sv)
{
if (!sv)
return 0;
if (SvPOKp(sv) && SvLEN(sv))
return asIV(sv);
if (!SvROK(sv)) {
+ dTHR; /* just for localizing */
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
return 0;
SvIVX(sv) = asIV(sv);
}
else {
+ dTHR;
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
return 0;
}
UV
-sv_2uv(sv)
-register SV *sv;
+sv_2uv(register SV *sv)
{
if (!sv)
return 0;
if (SvPOKp(sv) && SvLEN(sv))
return asUV(sv);
if (!SvROK(sv)) {
+ dTHR; /* just for localizing */
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
return 0;
SvUVX(sv) = asUV(sv);
}
else {
+ dTHR; /* just for localizing */
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
return 0;
}
double
-sv_2nv(sv)
-register SV *sv;
+sv_2nv(register SV *sv)
{
if (!sv)
return 0.0;
if (SvIOKp(sv))
return (double)SvIVX(sv);
if (!SvROK(sv)) {
+ dTHR; /* just for localizing */
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
return 0;
SvNVX(sv) = atof(SvPVX(sv));
}
else {
+ dTHR;
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
return 0.0;
}
static IV
-asIV(sv)
-SV *sv;
+asIV(SV *sv)
{
I32 numtype = looks_like_number(sv);
double d;
}
static UV
-asUV(sv)
-SV *sv;
+asUV(SV *sv)
{
I32 numtype = looks_like_number(sv);
}
I32
-looks_like_number(sv)
-SV *sv;
+looks_like_number(SV *sv)
{
register char *s;
register char *send;
}
char *
-sv_2pv(sv, lp)
-register SV *sv;
-STRLEN *lp;
+sv_2pv(register SV *sv, STRLEN *lp)
{
register char *s;
int olderrno;
SV *tsv;
+ char tmpbuf[64]; /* Must fit sprintf/Gconvert of longest IV/NV */
if (!sv) {
*lp = 0;
return SvPVX(sv);
}
if (SvIOKp(sv)) {
- (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
+ (void)sprintf(tmpbuf,"%ld",(long)SvIVX(sv));
tsv = Nullsv;
goto tokensave;
}
if (SvNOKp(sv)) {
SET_NUMERIC_STANDARD();
- Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
+ Gconvert(SvNVX(sv), DBL_DIG, 0, tmpbuf);
tsv = Nullsv;
goto tokensave;
}
if (!SvROK(sv)) {
+ dTHR; /* just for localizing */
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
*lp = 0;
if (SvREADONLY(sv)) {
if (SvNOKp(sv)) {
SET_NUMERIC_STANDARD();
- Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
+ Gconvert(SvNVX(sv), DBL_DIG, 0, tmpbuf);
tsv = Nullsv;
goto tokensave;
}
if (SvIOKp(sv)) {
- (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
+ (void)sprintf(tmpbuf,"%ld",(long)SvIVX(sv));
tsv = Nullsv;
goto tokensave;
}
SvIOKp_on(sv);
}
else {
+ dTHR;
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
*lp = 0;
tokensaveref:
if (!tsv)
- tsv = newSVpv(tokenbuf, 0);
+ tsv = newSVpv(tmpbuf, 0);
sv_2mortal(tsv);
*lp = SvCUR(tsv);
return SvPVX(tsv);
len = SvCUR(tsv);
}
else {
- t = tokenbuf;
- len = strlen(tokenbuf);
+ t = tmpbuf;
+ len = strlen(tmpbuf);
}
#ifdef FIXNEGATIVEZERO
if (len == 2 && t[0] == '-' && t[1] == '0') {
/* This function is only called on magical items */
bool
-sv_2bool(sv)
-register SV *sv;
+sv_2bool(register SV *sv)
{
if (SvGMAGICAL(sv))
mg_get(sv);
if (SvROK(sv)) {
#ifdef OVERLOAD
{
+ dTHR;
SV* tmpsv;
if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_)))
return SvTRUE(tmpsv);
return SvRV(sv) != 0;
}
if (SvPOKp(sv)) {
- register XPV* Xpv;
- if ((Xpv = (XPV*)SvANY(sv)) &&
- (*Xpv->xpv_pv > '0' ||
- Xpv->xpv_cur > 1 ||
- (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
+ register XPV* Xpvtmp;
+ if ((Xpvtmp = (XPV*)SvANY(sv)) &&
+ (*Xpvtmp->xpv_pv > '0' ||
+ Xpvtmp->xpv_cur > 1 ||
+ (Xpvtmp->xpv_cur && *Xpvtmp->xpv_pv != '0')))
return 1;
else
return 0;
*/
void
-sv_setsv(dstr,sstr)
-SV *dstr;
-register SV *sstr;
+sv_setsv(SV *dstr, register SV *sstr)
{
+ dTHR;
register U32 sflags;
register int dtype;
register int stype;
if (sstr == dstr)
return;
- if (SvTHINKFIRST(dstr)) {
- if (SvREADONLY(dstr) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(dstr))
- sv_unref(dstr);
- }
+ sv_check_thinkfirst(dstr);
if (!sstr)
sstr = &sv_undef;
stype = SvTYPE(sstr);
if (sflags & SVf_ROK) {
if (dtype >= SVt_PV) {
if (dtype == SVt_PVGV) {
+ dTHR;
SV *sref = SvREFCNT_inc(SvRV(sstr));
SV *dref = 0;
int intro = GvINTRO(dstr);
}
void
-sv_setpvn(sv,ptr,len)
-register SV *sv;
-register const char *ptr;
-register STRLEN len;
+sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len)
{
+ dTHR; /* just for taint */
assert(len >= 0); /* STRLEN is probably unsigned, so this may
elicit a warning, but it won't hurt. */
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
+ sv_check_thinkfirst(sv);
if (!ptr) {
(void)SvOK_off(sv);
return;
}
void
-sv_setpv(sv,ptr)
-register SV *sv;
-register const char *ptr;
+sv_setpv(register SV *sv, register const char *ptr)
{
+ dTHR; /* just for taint */
register STRLEN len;
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
+ sv_check_thinkfirst(sv);
if (!ptr) {
(void)SvOK_off(sv);
return;
}
void
-sv_usepvn(sv,ptr,len)
-register SV *sv;
-register char *ptr;
-register STRLEN len;
+sv_usepvn(register SV *sv, register char *ptr, register STRLEN len)
{
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
+ dTHR; /* just for taint */
+ sv_check_thinkfirst(sv);
if (!SvUPGRADE(sv, SVt_PV))
return;
if (!ptr) {
SvTAINT(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);
+ }
+}
+
void
-sv_chop(sv,ptr) /* like set but assuming ptr is in sv */
-register SV *sv;
-register char *ptr;
+sv_chop(register SV *sv, register char *ptr) /* like set but assuming ptr is in sv */
+
+
{
register STRLEN delta;
if (!ptr || !SvPOKp(sv))
return;
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
+ sv_check_thinkfirst(sv);
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv,SVt_PVIV);
}
void
-sv_catpvn(sv,ptr,len)
-register SV *sv;
-register char *ptr;
-register STRLEN len;
+sv_catpvn(register SV *sv, register char *ptr, register STRLEN len)
{
+ dTHR; /* just for taint */
STRLEN tlen;
char *junk;
}
void
-sv_catsv(dstr,sstr)
-SV *dstr;
-register SV *sstr;
+sv_catsv(SV *dstr, register SV *sstr)
{
char *s;
STRLEN len;
}
void
-sv_catpv(sv,ptr)
-register SV *sv;
-register char *ptr;
+sv_catpv(register SV *sv, register char *ptr)
{
+ dTHR; /* just for taint */
register STRLEN len;
STRLEN tlen;
char *junk;
newSV(x,len)
I32 x;
#else
-newSV(len)
+newSV(STRLEN len)
#endif
-STRLEN len;
+
{
register SV *sv;
/* name is assumed to contain an SV* if (name && namelen == HEf_SVKEY) */
void
-sv_magic(sv, obj, how, name, namlen)
-register SV *sv;
-SV *obj;
-int how;
-char *name;
-I32 namlen;
+sv_magic(register SV *sv, SV *obj, int how, char *name, I32 namlen)
{
MAGIC* mg;
- if (SvREADONLY(sv) && curcop != &compiling && !strchr("gBf", how))
- croak(no_modify);
+ if (SvREADONLY(sv)) {
+ dTHR;
+ if (curcop != &compiling && !strchr("gBf", how))
+ croak(no_modify);
+ }
if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) {
if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
if (how == 't')
mg->mg_moremagic = SvMAGIC(sv);
SvMAGIC(sv) = mg;
- if (!obj || obj == sv || how == '#')
+ if (!obj || obj == sv || how == '#' || how == 'r')
mg->mg_obj = obj;
else {
+ dTHR;
mg->mg_obj = SvREFCNT_inc(obj);
mg->mg_flags |= MGf_REFCOUNTED;
}
if (name)
if (namlen >= 0)
mg->mg_ptr = savepvn(name, namlen);
- else if (namlen == HEf_SVKEY)
+ else if (namlen == HEf_SVKEY) {
+ dTHR; /* just for SvREFCNT_inc */
mg->mg_ptr = (char*)SvREFCNT_inc((SV*)name);
+ }
switch (how) {
case 0:
case 'l':
mg->mg_virtual = &vtbl_dbline;
break;
+#ifdef USE_THREADS
+ case 'm':
+ mg->mg_virtual = &vtbl_mutex;
+ break;
+#endif /* USE_THREADS */
#ifdef USE_LOCALE_COLLATE
case 'o':
mg->mg_virtual = &vtbl_collxfrm;
case 'q':
mg->mg_virtual = &vtbl_packelem;
break;
+ case 'r':
+ mg->mg_virtual = &vtbl_regexp;
+ break;
case 'S':
mg->mg_virtual = &vtbl_sig;
break;
}
int
-sv_unmagic(sv, type)
-SV* sv;
-int type;
+sv_unmagic(SV *sv, int type)
{
MAGIC* mg;
MAGIC** mgp;
}
void
-sv_insert(bigstr,offset,len,little,littlelen)
-SV *bigstr;
-STRLEN offset;
-STRLEN len;
-char *little;
-STRLEN littlelen;
+sv_insert(SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN littlelen)
{
register char *big;
register char *mid;
/* make sv point to what nstr did */
void
-sv_replace(sv,nsv)
-register SV *sv;
-register SV *nsv;
+sv_replace(register SV *sv, register SV *nsv)
{
U32 refcnt = SvREFCNT(sv);
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
+ sv_check_thinkfirst(sv);
if (SvREFCNT(nsv) != 1)
warn("Reference miscount in sv_replace()");
if (SvMAGICAL(sv)) {
}
void
-sv_clear(sv)
-register SV *sv;
+sv_clear(register SV *sv)
{
assert(sv);
assert(SvREFCNT(sv) == 0);
if (SvOBJECT(sv)) {
+ dTHR;
if (defstash) { /* Still have a symbol table? */
- dSP;
+ djSP;
GV* destructor;
ENTER;
}
SV *
-sv_newref(sv)
-SV* sv;
+sv_newref(SV *sv)
{
if (sv)
SvREFCNT(sv)++;
}
void
-sv_free(sv)
-SV *sv;
+sv_free(SV *sv)
{
if (!sv)
return;
return;
#ifdef DEBUGGING
if (SvTEMP(sv)) {
- warn("Attempt to free temp prematurely");
+ warn("Attempt to free temp prematurely: %s", SvPEEK(sv));
return;
}
#endif
}
STRLEN
-sv_len(sv)
-register SV *sv;
+sv_len(register SV *sv)
{
char *junk;
STRLEN len;
}
I32
-sv_eq(str1,str2)
-register SV *str1;
-register SV *str2;
+sv_eq(register SV *str1, register SV *str2)
{
char *pv1;
STRLEN cur1;
}
I32
-sv_cmp(str1, str2)
-register SV *str1;
-register SV *str2;
+sv_cmp(register SV *str1, register SV *str2)
{
STRLEN cur1 = 0;
- char *pv1 = str1 ? SvPV(str1, cur1) : NULL;
+ char *pv1 = str1 ? SvPV(str1, cur1) : (char *) NULL;
STRLEN cur2 = 0;
- char *pv2 = str2 ? SvPV(str2, cur2) : NULL;
+ char *pv2 = str2 ? SvPV(str2, cur2) : (char *) NULL;
I32 retval;
if (!cur1)
}
I32
-sv_cmp_locale(sv1, sv2)
-register SV *sv1;
-register SV *sv2;
+sv_cmp_locale(register SV *sv1, register SV *sv2)
{
#ifdef USE_LOCALE_COLLATE
goto raw_compare;
len1 = 0;
- pv1 = sv1 ? sv_collxfrm(sv1, &len1) : NULL;
+ pv1 = sv1 ? sv_collxfrm(sv1, &len1) : (char *) NULL;
len2 = 0;
- pv2 = sv2 ? sv_collxfrm(sv2, &len2) : NULL;
+ pv2 = sv2 ? sv_collxfrm(sv2, &len2) : (char *) NULL;
if (!pv1 || !len1) {
if (pv2 && len2)
* according to the locale settings.
*/
char *
-sv_collxfrm(sv, nxp)
- SV *sv;
- STRLEN *nxp;
+sv_collxfrm(SV *sv, STRLEN *nxp)
{
MAGIC *mg;
- mg = SvMAGICAL(sv) ? mg_find(sv, 'o') : NULL;
+ mg = SvMAGICAL(sv) ? mg_find(sv, 'o') : (MAGIC *) NULL;
if (!mg || !mg->mg_ptr || *(U32*)mg->mg_ptr != collation_ix) {
char *s, *xf;
STRLEN len, xlen;
#endif /* USE_LOCALE_COLLATE */
char *
-sv_gets(sv,fp,append)
-register SV *sv;
-register PerlIO *fp;
-I32 append;
+sv_gets(register SV *sv, register FILE *fp, I32 append)
{
+ dTHR;
char *rsptr;
STRLEN rslen;
register STDCHAR rslast;
register I32 cnt;
I32 i;
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
+ sv_check_thinkfirst(sv);
if (!SvUPGRADE(sv, SVt_PV))
return 0;
SvSCREAM_off(sv);
}
}
+#ifdef WIN32
+ win32_strip_return(sv);
+#endif
+
return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch;
}
void
-sv_inc(sv)
-register SV *sv;
+sv_inc(register SV *sv)
{
register char *d;
int flags;
if (!sv)
return;
if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
+ if (SvREADONLY(sv)) {
+ dTHR;
+ if (curcop != &compiling)
+ croak(no_modify);
+ }
if (SvROK(sv)) {
#ifdef OVERLOAD
if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
}
void
-sv_dec(sv)
-register SV *sv;
+sv_dec(register SV *sv)
{
int flags;
if (!sv)
return;
if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
+ if (SvREADONLY(sv)) {
+ dTHR;
+ if (curcop != &compiling)
+ croak(no_modify);
+ }
if (SvROK(sv)) {
#ifdef OVERLOAD
if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
* permanent location. */
static void
-sv_mortalgrow()
+sv_mortalgrow(void)
{
+ dTHR;
tmps_max += (tmps_max < 512) ? 128 : 512;
Renew(tmps_stack, tmps_max, SV*);
}
SV *
-sv_mortalcopy(oldstr)
-SV *oldstr;
+sv_mortalcopy(SV *oldstr)
{
+ dTHR;
register SV *sv;
new_SV(sv);
}
SV *
-sv_newmortal()
+sv_newmortal(void)
{
+ dTHR;
register SV *sv;
new_SV(sv);
/* same thing without the copying */
SV *
-sv_2mortal(sv)
-register SV *sv;
+sv_2mortal(register SV *sv)
{
+ dTHR;
if (!sv)
return sv;
if (SvREADONLY(sv) && curcop != &compiling)
}
SV *
-newSVpv(s,len)
-char *s;
-STRLEN len;
+newSVpv(char *s, STRLEN len)
{
register SV *sv;
SV *
-newSVnv(n)
-double n;
+newSVnv(double n)
{
register SV *sv;
}
SV *
-newSViv(i)
-IV i;
+newSViv(IV i)
{
register SV *sv;
}
SV *
-newRV(ref)
-SV *ref;
+newRV(SV *ref)
{
+ dTHR;
register SV *sv;
new_SV(sv);
return sv;
}
-#ifdef CRIPPLED_CC
+
+
SV *
-newRV_noinc(ref)
-SV *ref;
+Perl_newRV_noinc(SV *ref)
{
register SV *sv;
SvREFCNT_dec(ref);
return sv;
}
-#endif /* CRIPPLED_CC */
/* make an exact duplicate of old */
SV *
-newSVsv(old)
-register SV *old;
+newSVsv(register SV *old)
{
register SV *sv;
}
void
-sv_reset(s,stash)
-register char *s;
-HV *stash;
+sv_reset(register char *s, HV *stash)
{
register HE *entry;
register GV *gv;
sv = GvSV(gv);
(void)SvOK_off(sv);
if (SvTYPE(sv) >= SVt_PV) {
+ dTHR; /* just for taint */
SvCUR_set(sv, 0);
if (SvPVX(sv) != Nullch)
*SvPVX(sv) = '\0';
}
IO*
-sv_2io(sv)
-SV *sv;
+sv_2io(SV *sv)
{
IO* io;
GV* gv;
}
CV *
-sv_2cv(sv, st, gvp, lref)
-SV *sv;
-HV **st;
-GV **gvp;
-I32 lref;
+sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref)
{
GV *gv;
CV *cv;
}
}
-#ifndef SvTRUE
I32
-SvTRUE(sv)
-register SV *sv;
+sv_true(register SV *sv)
{
+ dTHR;
if (!sv)
return 0;
if (SvGMAGICAL(sv))
mg_get(sv);
if (SvPOK(sv)) {
- register XPV* Xpv;
- if ((Xpv = (XPV*)SvANY(sv)) &&
- (*Xpv->xpv_pv > '0' ||
- Xpv->xpv_cur > 1 ||
- (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
+ register XPV* tXpv;
+ if ((tXpv = (XPV*)SvANY(sv)) &&
+ (*tXpv->xpv_pv > '0' ||
+ tXpv->xpv_cur > 1 ||
+ (tXpv->xpv_cur && *tXpv->xpv_pv != '0')))
return 1;
else
return 0;
}
}
}
-#endif /* !SvTRUE */
-#ifndef SvIV
IV
-SvIV(sv)
-register SV *sv;
+sv_iv(register SV *sv)
{
if (SvIOK(sv))
return SvIVX(sv);
return sv_2iv(sv);
}
-#endif /* !SvIV */
-#ifndef SvUV
UV
-SvUV(sv)
-register SV *sv;
+sv_uv(register SV *sv)
{
if (SvIOK(sv))
return SvUVX(sv);
return sv_2uv(sv);
}
-#endif /* !SvUV */
-#ifndef SvNV
double
-SvNV(sv)
-register SV *sv;
+sv_nv(register SV *sv)
{
if (SvNOK(sv))
return SvNVX(sv);
return sv_2nv(sv);
}
-#endif /* !SvNV */
-#ifdef CRIPPLED_CC
char *
-sv_pvn(sv, lp)
-SV *sv;
-STRLEN *lp;
+sv_pvn(SV *sv, STRLEN *lp)
{
if (SvPOK(sv)) {
*lp = SvCUR(sv);
}
return sv_2pv(sv, lp);
}
-#endif
char *
-sv_pvn_force(sv, lp)
-SV *sv;
-STRLEN *lp;
+sv_pvn_force(SV *sv, STRLEN *lp)
{
char *s;
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
+ if (SvREADONLY(sv)) {
+ dTHR;
+ if (curcop != &compiling)
+ croak(no_modify);
+ }
if (SvPOK(sv)) {
*lp = SvCUR(sv);
s = SvPVX(sv);
*lp = SvCUR(sv);
}
- else
+ else {
+ dTHR;
croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
op_name[op->op_type]);
+ }
}
else
s = sv_2pv(sv, lp);
*SvEND(sv) = '\0';
}
if (!SvPOK(sv)) {
+ dTHR; /* just for taint */
SvPOK_on(sv); /* validate pointer */
SvTAINT(sv);
DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",
}
char *
-sv_reftype(sv, ob)
-SV* sv;
-int ob;
+sv_reftype(SV *sv, int ob)
{
if (ob && SvOBJECT(sv))
return HvNAME(SvSTASH(sv));
}
int
-sv_isobject(sv)
-SV *sv;
+sv_isobject(SV *sv)
{
if (!sv)
return 0;
}
int
-sv_isa(sv, name)
-SV *sv;
-char *name;
+sv_isa(SV *sv, char *name)
{
if (!sv)
return 0;
}
SV*
-newSVrv(rv, classname)
-SV *rv;
-char *classname;
+newSVrv(SV *rv, char *classname)
{
+ dTHR;
SV *sv;
new_SV(sv);
}
SV*
-sv_setref_pv(rv, classname, pv)
-SV *rv;
-char *classname;
-void* pv;
+sv_setref_pv(SV *rv, char *classname, void *pv)
{
if (!pv)
sv_setsv(rv, &sv_undef);
}
SV*
-sv_setref_iv(rv, classname, iv)
-SV *rv;
-char *classname;
-IV iv;
+sv_setref_iv(SV *rv, char *classname, IV iv)
{
sv_setiv(newSVrv(rv,classname), iv);
return rv;
}
SV*
-sv_setref_nv(rv, classname, nv)
-SV *rv;
-char *classname;
-double nv;
+sv_setref_nv(SV *rv, char *classname, double nv)
{
sv_setnv(newSVrv(rv,classname), nv);
return rv;
}
SV*
-sv_setref_pvn(rv, classname, pv, n)
-SV *rv;
-char *classname;
-char* pv;
-I32 n;
+sv_setref_pvn(SV *rv, char *classname, char *pv, I32 n)
{
sv_setpvn(newSVrv(rv,classname), pv, n);
return rv;
}
SV*
-sv_bless(sv,stash)
-SV* sv;
-HV* stash;
+sv_bless(SV *sv, HV *stash)
{
+ dTHR;
SV *ref;
if (!SvROK(sv))
croak("Can't bless non-reference value");
}
static void
-sv_unglob(sv)
-SV* sv;
+sv_unglob(SV *sv)
{
assert(SvTYPE(sv) == SVt_PVGV);
SvFAKE_off(sv);
}
void
-sv_unref(sv)
-SV* sv;
+sv_unref(SV *sv)
{
SV* rv = SvRV(sv);
}
void
-sv_taint(sv)
-SV *sv;
+sv_taint(SV *sv)
{
sv_magic((sv), Nullsv, 't', Nullch, 0);
}
void
-sv_untaint(sv)
-SV *sv;
+sv_untaint(SV *sv)
{
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
MAGIC *mg = mg_find(sv, 't');
}
bool
-sv_tainted(sv)
-SV *sv;
+sv_tainted(SV *sv)
{
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
MAGIC *mg = mg_find(sv, 't');
}
void
-sv_setpviv(sv, iv)
-SV *sv;
-IV iv;
+sv_setpviv(SV *sv, IV iv)
{
STRLEN len;
char buf[TYPE_DIGITS(UV)];
}
void
-sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
- SV *sv;
- const char *pat;
- STRLEN patlen;
- va_list *args;
- SV **svargs;
- I32 svmax;
- bool *used_locale;
+sv_vsetpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, char *used_locale)
{
sv_setpvn(sv, "", 0);
sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale);
}
void
-sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
- SV *sv;
- const char *pat;
- STRLEN patlen;
- va_list *args;
- SV **svargs;
- I32 svmax;
- bool *used_locale;
+sv_vcatpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, char *used_locale)
{
+ dTHR;
char *p;
char *q;
char *patend;
#ifdef DEBUGGING
void
-sv_dump(sv)
-SV* sv;
+sv_dump(SV *sv)
{
SV *d = sv_newmortal();
char *s;
sv_catpv(d, " ),");
}
}
+ case SVt_PVBM:
+ if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
+ if (SvCOMPILED(sv)) sv_catpv(d, "COMPILED,");
+ break;
}
if (*(SvEND(d) - 1) == ',')
PerlIO_printf(Perl_debug_log, " DEPTH = %ld\n", (long)CvDEPTH(sv));
PerlIO_printf(Perl_debug_log, " PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
PerlIO_printf(Perl_debug_log, " OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv));
+#ifdef USE_THREADS
+ PerlIO_printf(Perl_debug_log, " MUTEXP = 0x%lx\n", (long)CvMUTEXP(sv));
+ PerlIO_printf(Perl_debug_log, " OWNER = 0x%lx\n", (long)CvOWNER(sv));
+#endif /* USE_THREADS */
+ PerlIO_printf(Perl_debug_log, " FLAGS = 0x%lx\n",
+ (unsigned long)CvFLAGS(sv));
if (type == SVt_PVFM)
PerlIO_printf(Perl_debug_log, " LINES = %ld\n", (long)FmLINES(sv));
break;
}
#else
void
-sv_dump(sv)
-SV* sv;
+sv_dump(SV *sv)
{
}
#endif
+
+
+
+
projects / p5sagit/p5-mst-13.2.git / blobdiff