[svn:ponie] rev 312 - in trunk: perl src/pmc

[email protected] 8 Jul 2005 14:05:43 -0000
Newsgroups perl.ponie.changes
Message-ID <[email protected]>
Author: nicholas
Date: Fri Jul  8 07:05:43 2005
New Revision: 312

Modified:
   trunk/perl/embed.fnc
   trunk/perl/embed.h
   trunk/perl/proto.h
   trunk/perl/sv.c
   trunk/perl/sv.h
   trunk/src/pmc/perl5cargo_cult.pmc
   trunk/src/pmc/perl5cargo_cult_static_get.c
Log:
Send sv_2iv and sv_2uv round via the PMC


Modified: trunk/perl/embed.fnc
==============================================================================
--- trunk/perl/embed.fnc	(original)
+++ trunk/perl/embed.fnc	Fri Jul  8 07:05:43 2005
@@ -705,6 +705,8 @@ Amb	|IV	|sv_2iv		|SV* sv
 Apd	|IV	|sv_2iv_flags	|SV* sv|I32 flags
 Apd	|SV*	|sv_2mortal	|SV* sv
 #if defined(PERL_CORE) || defined(PONIE_CORE)
+po	|IV	|sv_2iv_backend	|SV* sv|I32 flags
+po	|UV	|sv_2uv_backend	|SV* sv|I32 flags
 po	|NV	|sv_2nv_backend	|SV* sv
 #endif
 Apd	|NV	|sv_2nv		|SV* sv

Modified: trunk/perl/embed.h
==============================================================================
--- trunk/perl/embed.h	(original)
+++ trunk/perl/embed.h	Fri Jul  8 07:05:43 2005
@@ -3458,6 +3458,10 @@
 #if defined(PERL_CORE) || defined(PONIE_CORE)
 #ifdef PERL_CORE
 #endif
+#ifdef PERL_CORE
+#endif
+#ifdef PERL_CORE
+#endif
 #endif
 #define sv_2nv(a)		Perl_sv_2nv(aTHX_ a)
 #define sv_2pvutf8(a,b)		Perl_sv_2pvutf8(aTHX_ a,b)

Modified: trunk/perl/proto.h
==============================================================================
--- trunk/perl/proto.h	(original)
+++ trunk/perl/proto.h	Fri Jul  8 07:05:43 2005
@@ -673,6 +673,8 @@ PERL_CALLCONV IO*	Perl_sv_2io(pTHX_ SV* 
 PERL_CALLCONV IV	Perl_sv_2iv_flags(pTHX_ SV* sv, I32 flags);
 PERL_CALLCONV SV*	Perl_sv_2mortal(pTHX_ SV* sv);
 #if defined(PERL_CORE) || defined(PONIE_CORE)
+PERL_CALLCONV IV	Perl_sv_2iv_backend(pTHX_ SV* sv, I32 flags);
+PERL_CALLCONV UV	Perl_sv_2uv_backend(pTHX_ SV* sv, I32 flags);
 PERL_CALLCONV NV	Perl_sv_2nv_backend(pTHX_ SV* sv);
 #endif
 PERL_CALLCONV NV	Perl_sv_2nv(pTHX_ SV* sv);

Modified: trunk/perl/sv.c
==============================================================================
--- trunk/perl/sv.c	(original)
+++ trunk/perl/sv.c	Fri Jul  8 07:05:43 2005
@@ -1505,18 +1505,10 @@ Perl_sv_2iv(pTHX_ register SV *sv)
     return sv_2iv_flags(sv, SV_GMAGIC);
 }
 
-/*
-=for apidoc sv_2iv_flags
-
-Return the integer value of an SV, doing any necessary string
-conversion.  If flags includes SV_GMAGIC, does an mg_get() first.
-Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
-
-=cut
-*/
+/* The code that the PMC calls back to (for now).  */
 
 IV
-Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
+Perl_sv_2iv_backend(pTHX_ register SV *sv, I32 flags)
 {
     if (!sv)
 	return 0;
@@ -1814,18 +1806,10 @@ Perl_sv_2uv(pTHX_ register SV *sv)
     return sv_2uv_flags(sv, SV_GMAGIC);
 }
 
-/*
-=for apidoc sv_2uv_flags
-
-Return the unsigned integer value of an SV, doing any necessary string
-conversion.  If flags includes SV_GMAGIC, does an mg_get() first.
-Normally used via the C<SvUV(sv)> and C<SvUVx(sv)> macros.
-
-=cut
-*/
+/* The code that the PMC calls back to (for now).  */
 
 UV
-Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
+Perl_sv_2uv_backend(pTHX_ register SV *sv, I32 flags)
 {
     if (!sv)
 	return 0;
@@ -2298,6 +2282,44 @@ Perl_sv_2nv_backend(pTHX_ register SV *s
 
 
 /*
+=for apidoc sv_2iv_flags
+
+Return the integer value of an SV, doing any necessary string
+conversion.  If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
+
+=cut
+*/
+
+IV
+Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
+{
+    return (flags & SV_GMAGIC)
+	? Parrot_PMC_get_intval(PL_Parrot,MUMBLE(sv))
+	: Parrot_PMC_get_intval_intkey(PL_Parrot,MUMBLE(sv),
+				       Ponie_I_SV_IV_NO_GMAGIC);
+}
+
+/*
+=for apidoc sv_2uv_flags
+
+Return the unsigned integer value of an SV, doing any necessary string
+conversion.  If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvUV(sv)> and C<SvUVx(sv)> macros.
+
+=cut
+*/
+
+UV
+Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
+{
+    return (UV) Parrot_PMC_get_intval_intkey(PL_Parrot,MUMBLE(sv),
+					     (flags & SV_GMAGIC)
+					     ? Ponie_I_SV_UV
+					     : Ponie_I_SV_UV_NO_GMAGIC);
+}
+
+/*
 =for apidoc sv_2nv
 
 Return the num value of an SV, doing any necessary string or integer

Modified: trunk/perl/sv.h
==============================================================================
--- trunk/perl/sv.h	(original)
+++ trunk/perl/sv.h	Fri Jul  8 07:05:43 2005
@@ -326,6 +326,9 @@ typedef enum {
   Ponie_I_HV_AMAGIC,
   Ponie_I_SV_REFCNT_NO_ABORT,
   Ponie_I_SV_TYPE_IS_MASK_NO_ABORT,
+  Ponie_I_SV_IV_NO_GMAGIC,
+  Ponie_I_SV_UV,
+  Ponie_I_SV_UV_NO_GMAGIC,
   Ponie_I_MAX
 } Ponie_integers;
 

Modified: trunk/src/pmc/perl5cargo_cult.pmc
==============================================================================
--- trunk/src/pmc/perl5cargo_cult.pmc	(original)
+++ trunk/src/pmc/perl5cargo_cult.pmc	Fri Jul  8 07:05:43 2005
@@ -108,6 +108,10 @@ pmclass Perl5cargo_cult dynpmc {
         return Perl_sv_2nv_backend(aTHX_ MUMBLE(SELF));
     }
 
+    INTVAL get_integer() {
+        return Perl_sv_2iv_backend(aTHX_ MUMBLE(SELF), SV_GMAGIC);
+    }
+
     void* get_pointer() {
         return PMC_struct_val(SELF);
     }

Modified: trunk/src/pmc/perl5cargo_cult_static_get.c
==============================================================================
--- trunk/src/pmc/perl5cargo_cult_static_get.c	(original)
+++ trunk/src/pmc/perl5cargo_cult_static_get.c	Fri Jul  8 07:05:43 2005
@@ -131,6 +131,13 @@ S_get_integer_keyed_int(PMC *pmc, INTVAL
     case Ponie_I_SV_TYPE_IS_MASK_NO_ABORT:
         return (PERL5_FLAGS(pmc) & SVTYPEMASK) == SVTYPEMASK;
 
+    case Ponie_I_SV_IV_NO_GMAGIC:
+        return Perl_sv_2iv_backend(aTHX_ MUMBLE(pmc), 0);
+    case Ponie_I_SV_UV:
+        return (INTVAL) Perl_sv_2uv_backend(aTHX_ MUMBLE(pmc), SV_GMAGIC);
+    case Ponie_I_SV_UV_NO_GMAGIC:
+        return (INTVAL) Perl_sv_2uv_backend(aTHX_ MUMBLE(pmc), 0);
+
     default:
         croak ("Out of range or illegal key %d (max is %d) "
                "in get_integer_keyed_int", key, Ponie_I_MAX - 1);