summaryrefslogtreecommitdiff
path: root/sv.c
diff options
context:
space:
mode:
authorIlya Zakharevich <ilya@math.berkeley.edu>1999-07-11 00:39:44 -0400
committerGurusamy Sarathy <gsar@cpan.org>1999-07-18 04:56:28 +0000
commit0336b60e58b87c57a6ce50070e947487d998d24f (patch)
tree1b45d9fd82f9bfbc1c011d93b6e4ca0b6fc5b21d /sv.c
parentd962e1c00169c11bdb367e8d6aa4cbf4c9c81d44 (diff)
downloadperl-0336b60e58b87c57a6ce50070e947487d998d24f.tar.gz
cache [NIUP]V conversions of defined READONLY values
Message-ID: <19990711043944.A25944@monk.mps.ohio-state.edu> Subject: [PATCH 5.005_57] Allow caching of numeric/string conversion p4raw-id: //depot/perl@3694
Diffstat (limited to 'sv.c')
-rw-r--r--sv.c95
1 files changed, 29 insertions, 66 deletions
diff --git a/sv.c b/sv.c
index 5b5a361ab6..8550332091 100644
--- a/sv.c
+++ b/sv.c
@@ -1107,17 +1107,10 @@ Perl_sv_2iv(pTHX_ register SV *sv)
return SvIV(tmpstr);
return (IV)SvRV(sv);
}
- if (SvREADONLY(sv)) {
- if (SvNOKp(sv)) {
- return I_V(SvNVX(sv));
- }
- if (SvPOKp(sv) && SvLEN(sv))
- return asIV(sv);
- {
- dTHR;
- if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
- }
+ if (SvREADONLY(sv) && !SvOK(sv)) {
+ dTHR;
+ if (ckWARN(WARN_UNINITIALIZED))
+ Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
return 0;
}
}
@@ -1252,17 +1245,10 @@ Perl_sv_2uv(pTHX_ register SV *sv)
return SvUV(tmpstr);
return (UV)SvRV(sv);
}
- if (SvREADONLY(sv)) {
- if (SvNOKp(sv)) {
- return U_V(SvNVX(sv));
- }
- if (SvPOKp(sv) && SvLEN(sv))
- return asUV(sv);
- {
- dTHR;
- if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
- }
+ if (SvREADONLY(sv) && !SvOK(sv)) {
+ dTHR;
+ if (ckWARN(WARN_UNINITIALIZED))
+ Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
return 0;
}
}
@@ -1423,19 +1409,8 @@ Perl_sv_2nv(pTHX_ register SV *sv)
return SvNV(tmpstr);
return (NV)(unsigned long)SvRV(sv);
}
- if (SvREADONLY(sv)) {
+ if (SvREADONLY(sv) && !SvOK(sv)) {
dTHR;
- if (SvPOKp(sv) && SvLEN(sv)) {
- if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
- not_a_number(sv);
- return Atof(SvPVX(sv));
- }
- if (SvIOKp(sv)) {
- if (SvIsUV(sv))
- return (NV)SvUVX(sv);
- else
- return (NV)SvIVX(sv);
- }
if (ckWARN(WARN_UNINITIALIZED))
Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
return 0.0;
@@ -1817,29 +1792,10 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
*lp = strlen(s);
return s;
}
- if (SvREADONLY(sv)) {
- if (SvNOKp(sv)) { /* See note in sv_2uv() */
- /* XXXX 64-bit? IV may have better precision... */
- Gconvert(SvNVX(sv), DBL_DIG, 0, tmpbuf);
- tsv = Nullsv;
- goto tokensave;
- }
- if (SvIOKp(sv)) {
- char *ebuf;
-
- if (SvIsUV(sv))
- tmpbuf = uiv_2buf(tbuf, 0, SvUVX(sv), 1, &ebuf);
- else
- tmpbuf = uiv_2buf(tbuf, SvIVX(sv), 0, 0, &ebuf);
- *ebuf = 0;
- tsv = Nullsv;
- goto tokensave;
- }
- {
- dTHR;
- if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
- }
+ if (SvREADONLY(sv) && !SvOK(sv)) {
+ dTHR;
+ if (ckWARN(WARN_UNINITIALIZED))
+ Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
*lp = 0;
return "";
}
@@ -1872,30 +1828,36 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
}
else if (SvIOKp(sv)) {
U32 isIOK = SvIOK(sv);
+ U32 isUIOK = SvIsUV(sv);
char buf[TYPE_CHARS(UV)];
char *ebuf, *ptr;
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv, SVt_PVIV);
- if (SvIsUV(sv)) {
+ if (isUIOK)
ptr = uiv_2buf(buf, 0, SvUVX(sv), 1, &ebuf);
- sv_setpvn(sv, ptr, ebuf - ptr);
- SvIsUV_on(sv);
- }
- else {
+ else
ptr = uiv_2buf(buf, SvIVX(sv), 0, 0, &ebuf);
- sv_setpvn(sv, ptr, ebuf - ptr);
- }
+ SvGROW(sv, ebuf - ptr + 1); /* inlined from sv_setpvn */
+ Move(ptr,SvPVX(sv),ebuf - ptr,char);
+ SvCUR_set(sv, ebuf - ptr);
s = SvEND(sv);
+ *s = '\0';
if (isIOK)
SvIOK_on(sv);
else
SvIOKp_on(sv);
+ if (isUIOK)
+ SvIsUV_on(sv);
+ SvPOK_on(sv);
}
else {
dTHR;
- if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+ if (ckWARN(WARN_UNINITIALIZED)
+ && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+ {
Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ }
*lp = 0;
if (SvTYPE(sv) < SVt_PV)
/* Typically the caller expects that sv_any is not NULL now. */
@@ -1905,7 +1867,8 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
*lp = s - SvPVX(sv);
SvCUR_set(sv, *lp);
SvPOK_on(sv);
- DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",(unsigned long)sv,SvPVX(sv)));
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",
+ (unsigned long)sv,SvPVX(sv)));
return SvPVX(sv);
tokensave: