[svn:ponie] rev 322 - in trunk/perl: . ext/B/t ext/Devel/Peek/t
[email protected] 9 Jul 2005 22:03:59 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
Author: nicholas
Date: Sat Jul 9 15:03:59 2005
New Revision: 322
Modified:
trunk/perl/embed.fnc
trunk/perl/embed.h
trunk/perl/ext/B/t/f_sort.t
trunk/perl/ext/Devel/Peek/t/Peek.t
trunk/perl/proto.h
trunk/perl/sv.c
trunk/perl/sv.h
Log:
Stage 1 of converting sv_setiv etc to use the PMC interface - route all IV
setting via 1 backend function.
Modified: trunk/perl/embed.fnc
==============================================================================
--- trunk/perl/embed.fnc (original)
+++ trunk/perl/embed.fnc Sat Jul 9 15:03:59 2005
@@ -779,7 +779,8 @@ Apd |char* |sv_reftype |const SV* sv|int
Apd |void |sv_replace |SV* sv|SV* nsv
Apd |void |sv_report_used
#if defined(PERL_CORE) || defined(PONIE_CORE)
-Apd |void |sv_setnv_backend |SV* sv|NV num|I32 flags
+po |void |sv_setnv_backend |SV* sv|NV num|I32 flags
+po |void |sv_setiv_backend |SV* sv|UV num|I32 flags
#endif
Apd |void |sv_reset |const char* s|HV* stash
Afpd |void |sv_setpvf |SV* sv|const char* pat|...
Modified: trunk/perl/embed.h
==============================================================================
--- trunk/perl/embed.h (original)
+++ trunk/perl/embed.h Sat Jul 9 15:03:59 2005
@@ -1034,6 +1034,8 @@
#define sv_reftype Perl_sv_reftype
#define sv_replace Perl_sv_replace
#define sv_report_used Perl_sv_report_used
+#if defined(PERL_CORE) || defined(PONIE_CORE)
+#endif
#define sv_reset Perl_sv_reset
#define sv_setpvf Perl_sv_setpvf
#define sv_vsetpvf Perl_sv_vsetpvf
@@ -3532,6 +3534,12 @@
#define sv_reftype(a,b) Perl_sv_reftype(aTHX_ a,b)
#define sv_replace(a,b) Perl_sv_replace(aTHX_ a,b)
#define sv_report_used() Perl_sv_report_used(aTHX)
+#if defined(PERL_CORE) || defined(PONIE_CORE)
+#ifdef PERL_CORE
+#endif
+#ifdef PERL_CORE
+#endif
+#endif
#define sv_reset(a,b) Perl_sv_reset(aTHX_ a,b)
#define sv_vsetpvf(a,b,c) Perl_sv_vsetpvf(aTHX_ a,b,c)
#define sv_setiv(a,b) Perl_sv_setiv(aTHX_ a,b)
Modified: trunk/perl/ext/B/t/f_sort.t
==============================================================================
--- trunk/perl/ext/B/t/f_sort.t (original)
+++ trunk/perl/ext/B/t/f_sort.t Sat Jul 9 15:03:59 2005
@@ -562,7 +562,7 @@ EOT_EOT
# n <$> gv(*_) s
# o <1> rv2sv sKM/DREFAV,1
# p <1> rv2av[t2] sKR/1
-# q <$> const(IV 0) s
+# q <$> const(UV 0) s
# r <2> aelem sK/2
# - <@> scope lK
# goto m
Modified: trunk/perl/ext/Devel/Peek/t/Peek.t
==============================================================================
--- trunk/perl/ext/Devel/Peek/t/Peek.t (original)
+++ trunk/perl/ext/Devel/Peek/t/Peek.t Sat Jul 9 15:03:59 2005
@@ -98,10 +98,10 @@ do_test( 5,
# building subsequent regexps.
my $type = do_test( 6,
$c + $d,
-'SV = ([NI])V\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
+'SV = IV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
- FLAGS = \\(PADTMP,\1OK,p\1OK\\)
- \1V = 456');
+ FLAGS = \\(PADTMP,IOK,pIOK,IsUV\\)
+ UV = 456');
($d = "789") += 0.1;
@@ -120,8 +120,8 @@ do_test( 8,
0xabcd,
'SV = IV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
- FLAGS = \\(.*IOK,READONLY,pIOK\\)
- IV = 43981');
+ FLAGS = \\(.*IOK,READONLY,pIOK,IsUV\\)
+ UV = 43981');
do_test( 9,
undef,
Modified: trunk/perl/proto.h
==============================================================================
--- trunk/perl/proto.h (original)
+++ trunk/perl/proto.h Sat Jul 9 15:03:59 2005
@@ -743,6 +743,10 @@ PERL_CALLCONV bool Perl_sv_cat_decode(pT
PERL_CALLCONV char* Perl_sv_reftype(pTHX_ const SV* sv, int ob);
PERL_CALLCONV void Perl_sv_replace(pTHX_ SV* sv, SV* nsv);
PERL_CALLCONV void Perl_sv_report_used(pTHX);
+#if defined(PERL_CORE) || defined(PONIE_CORE)
+PERL_CALLCONV void Perl_sv_setnv_backend(pTHX_ SV* sv, NV num, I32 flags);
+PERL_CALLCONV void Perl_sv_setiv_backend(pTHX_ SV* sv, UV num, I32 flags);
+#endif
PERL_CALLCONV void Perl_sv_reset(pTHX_ const char* s, HV* stash);
PERL_CALLCONV void Perl_sv_setpvf(pTHX_ SV* sv, const char* pat, ...)
__attribute__format__(__printf__,pTHX_2,pTHX_3);
Modified: trunk/perl/sv.c
==============================================================================
--- trunk/perl/sv.c (original)
+++ trunk/perl/sv.c Sat Jul 9 15:03:59 2005
@@ -1106,6 +1106,45 @@ Perl_sv_grow(pTHX_ register SV *sv, regi
return s;
}
+void
+Perl_sv_setiv_backend(pTHX_ register SV *sv, UV i, I32 flags)
+{
+ SV_CHECK_THINKFIRST_COW_DROP(sv);
+ switch (SvTYPE(sv)) {
+ case SVt_NULL:
+ sv_upgrade(sv, SVt_IV);
+ break;
+ case SVt_NV:
+ sv_upgrade(sv, SVt_PVNV);
+ break;
+ case SVt_RV:
+ case SVt_PV:
+ sv_upgrade(sv, SVt_PVIV);
+ break;
+
+ case SVt_PVGV:
+ case SVt_PVAV:
+ case SVt_PVHV:
+ case SVt_PVCV:
+ case SVt_PVFM:
+ case SVt_PVIO:
+ Perl_croak(aTHX_ "Can't coerce %s to integer in %s", sv_reftype(sv,0),
+ OP_DESC(PL_op));
+ }
+ (void)SvIOK_only(sv); /* validate number */
+ if (flags & SV_SUV) {
+ SvIsUV_on(sv);
+ SvUV_set(sv, i);
+ }
+ else {
+ SvIV_set(sv, (IV)i);
+ }
+ SvTAINT(sv);
+ if (flags & SV_SMAGIC)
+ SvSETMAGIC(sv);
+}
+
+
/*
=for apidoc sv_setiv
@@ -1118,6 +1157,7 @@ Does not handle 'set' magic. See also C
void
Perl_sv_setiv(pTHX_ register SV *sv, IV i)
{
+ //Perl_sv_setiv_backend(aTHX_ sv, i, 0);
SV_CHECK_THINKFIRST_COW_DROP(sv);
switch (SvTYPE(sv)) {
case SVt_NULL:
@@ -1156,8 +1196,7 @@ Like C<sv_setiv>, but also handles 'set'
void
Perl_sv_setiv_mg(pTHX_ register SV *sv, IV i)
{
- sv_setiv(sv,i);
- SvSETMAGIC(sv);
+ Perl_sv_setiv_backend(aTHX_ sv, i, SV_SMAGIC);
}
/*
@@ -1172,21 +1211,7 @@ Does not handle 'set' magic. See also C
void
Perl_sv_setuv(pTHX_ register SV *sv, UV u)
{
- /* With these two if statements:
- u=1.49 s=0.52 cu=72.49 cs=10.64 scripts=270 tests=20865
-
- without
- u=1.35 s=0.47 cu=73.45 cs=11.43 scripts=270 tests=20865
-
- If you wish to remove them, please benchmark to see what the effect is
- */
- if (u <= (UV)IV_MAX) {
- sv_setiv(sv, (IV)u);
- return;
- }
- sv_setiv(sv, 0);
- SvIsUV_on(sv);
- SvUV_set(sv, u);
+ Perl_sv_setiv_backend(aTHX_ sv, u, SV_SUV);
}
/*
@@ -1200,22 +1225,7 @@ Like C<sv_setuv>, but also handles 'set'
void
Perl_sv_setuv_mg(pTHX_ register SV *sv, UV u)
{
- /* With these two if statements:
- u=1.49 s=0.52 cu=72.49 cs=10.64 scripts=270 tests=20865
-
- without
- u=1.35 s=0.47 cu=73.45 cs=11.43 scripts=270 tests=20865
-
- If you wish to remove them, please benchmark to see what the effect is
- */
- if (u <= (UV)IV_MAX) {
- sv_setiv(sv, (IV)u);
- } else {
- sv_setiv(sv, 0);
- SvIsUV_on(sv);
- sv_setuv(sv,u);
- }
- SvSETMAGIC(sv);
+ Perl_sv_setiv_backend(aTHX_ sv, u, SV_SUV|SV_SMAGIC);
}
void
Modified: trunk/perl/sv.h
==============================================================================
--- trunk/perl/sv.h (original)
+++ trunk/perl/sv.h Sat Jul 9 15:03:59 2005
@@ -1314,6 +1314,7 @@ Like C<sv_catsv> but doesn't process mag
#define SV_UTF8_NO_ENCODING 8
#define SV_NOSTEAL 16
#define SV_SMAGIC 32
+#define SV_SUV 64
/* We are about to replace the SV's current value. So if it's copy on write
we need to normalise it. Use the SV_COW_DROP_PV flag hint to say that