# define FAST_SV_GETS
#endif
+static IV asIV _((SV* sv));
+static UV asUV _((SV* sv));
static SV *more_sv _((void));
static XPVIV *more_xiv _((void));
static XPVNV *more_xnv _((void));
sprintf(t,"(\"%.127s\")",SvPVX(sv));
}
else if (SvNOKp(sv)) {
- NUMERIC_STANDARD();
+ SET_NUMERIC_STANDARD();
sprintf(t,"(%g)",SvNVX(sv));
}
else if (SvIOKp(sv))
else
return (IV) U_V(SvNVX(sv));
}
- if (SvPOKp(sv) && SvLEN(sv)) {
- if (dowarn && !looks_like_number(sv))
- not_a_number(sv);
- return (IV)atol(SvPVX(sv));
- }
- if (!SvROK(sv)) {
- return 0;
- }
+ if (SvPOKp(sv) && SvLEN(sv))
+ return asIV(sv);
+ if (!SvROK(sv))
+ return 0;
}
if (SvTHINKFIRST(sv)) {
if (SvROK(sv)) {
else
return (IV) U_V(SvNVX(sv));
}
- if (SvPOKp(sv) && SvLEN(sv)) {
- if (dowarn && !looks_like_number(sv))
- not_a_number(sv);
- return (IV)atol(SvPVX(sv));
- }
+ if (SvPOKp(sv) && SvLEN(sv))
+ return asIV(sv);
if (dowarn)
warn(warn_uninit);
return 0;
if (SvNVX(sv) < 0.0)
SvIVX(sv) = I_V(SvNVX(sv));
else
- SvIVX(sv) = (IV) U_V(SvNVX(sv));
+ SvUVX(sv) = U_V(SvNVX(sv));
}
else if (SvPOKp(sv) && SvLEN(sv)) {
- if (dowarn && !looks_like_number(sv))
- not_a_number(sv);
(void)SvIOK_on(sv);
- SvIVX(sv) = (IV)atol(SvPVX(sv));
+ SvIVX(sv) = asIV(sv);
}
else {
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
return SvIVX(sv);
}
+UV
+sv_2uv(sv)
+register SV *sv;
+{
+ if (!sv)
+ return 0;
+ if (SvGMAGICAL(sv)) {
+ mg_get(sv);
+ if (SvIOKp(sv))
+ return SvUVX(sv);
+ if (SvNOKp(sv))
+ return U_V(SvNVX(sv));
+ if (SvPOKp(sv) && SvLEN(sv))
+ return asUV(sv);
+ if (!SvROK(sv))
+ return 0;
+ }
+ if (SvTHINKFIRST(sv)) {
+ if (SvROK(sv)) {
+#ifdef OVERLOAD
+ SV* tmpstr;
+ if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
+ return SvUV(tmpstr);
+#endif /* OVERLOAD */
+ return (UV)SvRV(sv);
+ }
+ if (SvREADONLY(sv)) {
+ if (SvNOKp(sv)) {
+ return U_V(SvNVX(sv));
+ }
+ if (SvPOKp(sv) && SvLEN(sv))
+ return asUV(sv);
+ if (dowarn)
+ warn(warn_uninit);
+ return 0;
+ }
+ }
+ switch (SvTYPE(sv)) {
+ case SVt_NULL:
+ sv_upgrade(sv, SVt_IV);
+ return SvUVX(sv);
+ case SVt_PV:
+ sv_upgrade(sv, SVt_PVIV);
+ break;
+ case SVt_NV:
+ sv_upgrade(sv, SVt_PVNV);
+ break;
+ }
+ if (SvNOKp(sv)) {
+ (void)SvIOK_on(sv);
+ SvUVX(sv) = U_V(SvNVX(sv));
+ }
+ else if (SvPOKp(sv) && SvLEN(sv)) {
+ (void)SvIOK_on(sv);
+ SvUVX(sv) = asUV(sv);
+ }
+ else {
+ if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+ warn(warn_uninit);
+ return 0;
+ }
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2uv(%lu)\n",
+ (unsigned long)sv,SvUVX(sv)));
+ return SvUVX(sv);
+}
+
double
sv_2nv(sv)
register SV *sv;
if (SvPOKp(sv) && SvLEN(sv)) {
if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
not_a_number(sv);
- NUMERIC_STANDARD();
+ SET_NUMERIC_STANDARD();
return atof(SvPVX(sv));
}
if (SvIOKp(sv))
if (SvPOKp(sv) && SvLEN(sv)) {
if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
not_a_number(sv);
- NUMERIC_STANDARD();
+ SET_NUMERIC_STANDARD();
return atof(SvPVX(sv));
}
if (SvIOKp(sv))
sv_upgrade(sv, SVt_PVNV);
else
sv_upgrade(sv, SVt_NV);
- DEBUG_c(NUMERIC_STANDARD());
+ DEBUG_c(SET_NUMERIC_STANDARD());
DEBUG_c(PerlIO_printf(Perl_debug_log,
"0x%lx num(%g)\n",(unsigned long)sv,SvNVX(sv)));
}
else if (SvPOKp(sv) && SvLEN(sv)) {
if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
not_a_number(sv);
- NUMERIC_STANDARD();
+ SET_NUMERIC_STANDARD();
SvNVX(sv) = atof(SvPVX(sv));
}
else {
return 0.0;
}
SvNOK_on(sv);
- DEBUG_c(NUMERIC_STANDARD());
+ DEBUG_c(SET_NUMERIC_STANDARD());
DEBUG_c(PerlIO_printf(Perl_debug_log,
"0x%lx 2nv(%g)\n",(unsigned long)sv,SvNVX(sv)));
return SvNVX(sv);
}
+static IV
+asIV(sv)
+SV *sv;
+{
+ I32 numtype = looks_like_number(sv);
+ double d;
+
+ if (numtype == 1)
+ return atol(SvPVX(sv));
+ if (!numtype && dowarn)
+ not_a_number(sv);
+ SET_NUMERIC_STANDARD();
+ d = atof(SvPVX(sv));
+ if (d < 0.0)
+ return I_V(d);
+ else
+ return (IV) U_V(d);
+}
+
+static UV
+asUV(sv)
+SV *sv;
+{
+ I32 numtype = looks_like_number(sv);
+
+ if (numtype == 1)
+ return atol(SvPVX(sv));
+ if (!numtype && dowarn)
+ not_a_number(sv);
+ SET_NUMERIC_STANDARD();
+ return U_V(atof(SvPVX(sv)));
+}
+
+I32
+looks_like_number(sv)
+SV *sv;
+{
+ register char *s;
+ register char *send;
+ register char *sbegin;
+ I32 numtype = 1;
+ STRLEN len;
+
+ if (SvPOK(sv)) {
+ sbegin = SvPVX(sv);
+ len = SvCUR(sv);
+ }
+ else if (SvPOKp(sv))
+ sbegin = SvPV(sv, len);
+ else
+ return 1;
+ send = sbegin + len;
+
+ s = sbegin;
+ while (isSPACE(*s))
+ s++;
+ if (s >= send)
+ return 0;
+ if (*s == '+' || *s == '-')
+ s++;
+ while (isDIGIT(*s))
+ s++;
+ if (s == send)
+ return numtype;
+ if (*s == '.') {
+ numtype = 1;
+ s++;
+ }
+ else if (s == SvPVX(sv))
+ return 0;
+ while (isDIGIT(*s))
+ s++;
+ if (s == send)
+ return numtype;
+ if (*s == 'e' || *s == 'E') {
+ numtype = 2;
+ s++;
+ if (*s == '+' || *s == '-')
+ s++;
+ while (isDIGIT(*s))
+ s++;
+ }
+ while (isSPACE(*s))
+ s++;
+ if (s >= send)
+ return numtype;
+ if (len == 10 && memEQ(sbegin, "0 but true", 10))
+ return 1;
+ return 0;
+}
+
char *
sv_2pv(sv, lp)
register SV *sv;
goto tokensave;
}
if (SvNOKp(sv)) {
- NUMERIC_STANDARD();
+ SET_NUMERIC_STANDARD();
Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
goto tokensave;
}
case SVt_PVCV: s = "CODE"; break;
case SVt_PVGV: s = "GLOB"; break;
case SVt_PVFM: s = "FORMATLINE"; break;
- case SVt_PVIO: s = "FILEHANDLE"; break;
+ case SVt_PVIO: s = "IO"; break;
default: s = "UNKNOWN"; break;
}
if (SvOBJECT(sv))
}
if (SvREADONLY(sv)) {
if (SvNOKp(sv)) {
- NUMERIC_STANDARD();
+ SET_NUMERIC_STANDARD();
Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
goto tokensave;
}
else
#endif /*apollo*/
{
- NUMERIC_STANDARD();
+ SET_NUMERIC_STANDARD();
Gconvert(SvNVX(sv), DBL_DIG, 0, s);
}
errno = olderrno;
(void)SvOK_off(dstr);
return;
case SVt_IV:
- if (dtype <= SVt_PV) {
+ if (dtype != SVt_IV && dtype < SVt_PVIV) {
if (dtype < SVt_IV)
sv_upgrade(dstr, SVt_IV);
else if (dtype == SVt_NV)
sv_upgrade(dstr, SVt_PVNV);
- else if (dtype <= SVt_PV)
+ else
sv_upgrade(dstr, SVt_PVIV);
}
break;
case SVt_NV:
- if (dtype <= SVt_PVIV) {
+ if (dtype != SVt_NV && dtype < SVt_PVNV) {
if (dtype < SVt_NV)
sv_upgrade(dstr, SVt_NV);
- else if (dtype == SVt_PVIV)
- sv_upgrade(dstr, SVt_PVNV);
- else if (dtype <= SVt_PV)
+ else
sv_upgrade(dstr, SVt_PVNV);
}
break;
* has to be allocated and SvPVX(sstr) has to be freed.
*/
- if ((SvTEMP(sstr) || SvPADTMP(sstr)) && /* slated for free anyway? */
+ if (SvTEMP(sstr) && /* slated for free anyway? */
!(sflags & SVf_OOK)) /* and not involved in OOK hack? */
{
if (SvPVX(dstr)) { /* we know that dtype >= SVt_PV */
case 'l':
mg->mg_virtual = &vtbl_dbline;
break;
-#ifdef HAS_STRXFRM
+#ifdef USE_LOCALE_COLLATE
case 'o':
mg->mg_virtual = &vtbl_collxfrm;
break;
-#endif
+#endif /* USE_LOCALE_COLLATE */
case 'P':
mg->mg_virtual = &vtbl_pack;
break;
if (cur1 != cur2)
return 0;
- return !memcmp(pv1, pv2, cur1);
+ return memEQ(pv1, pv2, cur1);
}
I32
register SV *sv1;
register SV *sv2;
{
-#ifdef LC_COLLATE
+#ifdef USE_LOCALE_COLLATE
char *pv1, *pv2;
STRLEN len1, len2;
raw_compare:
/* FALL THROUGH */
-#endif /* LC_COLLATE */
+#endif /* USE_LOCALE_COLLATE */
return sv_cmp(sv1, sv2);
}
-#ifdef LC_COLLATE
+#ifdef USE_LOCALE_COLLATE
char *
sv_collxfrm(sv, nxp)
{
/* Any scalar variable may carry an 'o' magic that contains the
* scalar data of the variable transformed to such a format that
- * a normal memcmp() can be used to compare the data according
- * to the locale settings. */
+ * a normal memory comparison can be used to compare the data
+ * according to the locale settings. */
MAGIC *mg = NULL;
}
}
-#endif /* LC_COLLATE */
+#endif /* USE_LOCALE_COLLATE */
char *
sv_gets(sv,fp,append)
}
if (!SvUPGRADE(sv, SVt_PV))
return 0;
+ SvSCREAM_off(sv);
if (RsSNARF(rs)) {
rsptr = NULL;
}
}
else {
- memcpy((char*)bp, (char*)ptr, cnt); /* this | eat */
+ Copy(ptr, bp, cnt, char); /* this | eat */
bp += cnt; /* screams | dust */
ptr += cnt; /* louder | sed :-) */
cnt = 0;
thats_all_folks:
if ((rslen > 1 && (bp - (STDCHAR*)SvPVX(sv) < rslen)) ||
- memcmp((char*)bp - rslen, rsptr, rslen))
+ memNE((char*)bp - rslen, rsptr, rslen))
goto screamer; /* go back to the fray */
thats_really_all_folks:
if (shortbuffered)
if (i != EOF && /* joy */
(!rslen ||
SvCUR(sv) < rslen ||
- memcmp(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen)))
+ memNE(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen)))
{
append = -1;
goto screamer2;
while (isALPHA(*d)) d++;
while (isDIGIT(*d)) d++;
if (*d) {
- NUMERIC_STANDARD();
+ SET_NUMERIC_STANDARD();
sv_setnv(sv,atof(SvPVX(sv)) + 1.0); /* punt */
return;
}
(void)SvNOK_only(sv);
return;
}
- NUMERIC_STANDARD();
+ SET_NUMERIC_STANDARD();
sv_setnv(sv,atof(SvPVX(sv)) - 1.0); /* punt */
}
register SV *old;
{
register SV *sv;
- U32 oflags;
if (!old)
return Nullsv;
SvANY(sv) = 0;
SvREFCNT(sv) = 1;
SvFLAGS(sv) = 0;
- oflags = SvFLAGS(old) & (SVs_TEMP|SVs_PADTMP);
- if (oflags) {
- SvFLAGS(old) &= ~(SVs_TEMP|SVs_PADTMP);
+ if (SvTEMP(old)) {
+ SvTEMP_off(old);
sv_setsv(sv,old);
- SvFLAGS(old) |= oflags;
+ SvTEMP_on(old);
}
else
sv_setsv(sv,old);
}
}
}
-#endif /* SvTRUE */
+#endif /* !SvTRUE */
#ifndef SvIV
-IV SvIV(Sv)
-register SV *Sv;
+IV
+SvIV(sv)
+register SV *sv;
{
- if (SvIOK(Sv))
- return SvIVX(Sv);
- return sv_2iv(Sv);
+ if (SvIOK(sv))
+ return SvIVX(sv);
+ return sv_2iv(sv);
}
-#endif /* SvIV */
+#endif /* !SvIV */
+#ifndef SvUV
+UV
+SvUV(sv)
+register SV *sv;
+{
+ if (SvIOK(sv))
+ return SvUVX(sv);
+ return sv_2uv(sv);
+}
+#endif /* !SvUV */
#ifndef SvNV
-double SvNV(Sv)
-register SV *Sv;
+double
+SvNV(sv)
+register SV *sv;
{
- if (SvNOK(Sv))
- return SvNVX(Sv);
- if (SvIOK(Sv))
- return (double)SvIVX(Sv);
- return sv_2nv(Sv);
+ if (SvNOK(sv))
+ return SvNVX(sv);
+ return sv_2nv(sv);
}
-#endif /* SvNV */
+#endif /* !SvNV */
#ifdef CRIPPLED_CC
char *
sv_untaint(sv)
SV *sv;
{
- MAGIC *mg = mg_find(sv, 't');
- if (mg)
- mg->mg_len &= ~1;
+ if (SvMAGICAL(sv)) {
+ MAGIC *mg = mg_find(sv, 't');
+ if (mg)
+ mg->mg_len &= ~1;
+ }
}
bool
sv_tainted(sv)
SV *sv;
{
- MAGIC *mg = mg_find(sv, 't');
- return (mg && ((mg->mg_len & 1)
- || (mg->mg_len & 2) && mg->mg_obj == sv));
+ if (SvMAGICAL(sv)) {
+ MAGIC *mg = mg_find(sv, 't');
+ if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv))
+ return TRUE;
+ }
+ return FALSE;
}
#ifdef DEBUGGING
if (type >= SVt_PVIV || type == SVt_IV)
PerlIO_printf(Perl_debug_log, " IV = %ld\n", (long)SvIVX(sv));
if (type >= SVt_PVNV || type == SVt_NV) {
- NUMERIC_STANDARD();
+ SET_NUMERIC_STANDARD();
PerlIO_printf(Perl_debug_log, " NV = %.*g\n", DBL_DIG, SvNVX(sv));
}
if (SvROK(sv)) {
projects / p5sagit/p5-mst-13.2.git / blobdiff