[svn:ponie] rev 313 - trunk/perl

Author: nicholas
Date: Fri Jul  8 08:37:40 2005
New Revision: 313

Modified:
   trunk/perl/embed.fnc
   trunk/perl/embed.h
   trunk/perl/proto.h
   trunk/perl/sv.c
   trunk/perl/sv.h
Log:
Send sv_2pv round via the PMC


Modified: trunk/perl/embed.fnc
==============================================================================
--- trunk/perl/embed.fnc	(original)
+++ trunk/perl/embed.fnc	Fri Jul  8 08:37:40 2005
@@ -708,6 +708,7 @@ Apd	|SV*	|sv_2mortal	|SV* sv
 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
+po	|char*	|sv_2pv_backend	|SV* sv|STRLEN* lp|I32 flags
 #endif
 Apd	|NV	|sv_2nv		|SV* sv
 Amb	|char*	|sv_2pv		|SV* sv|STRLEN* lp

Modified: trunk/perl/embed.h
==============================================================================
--- trunk/perl/embed.h	(original)
+++ trunk/perl/embed.h	Fri Jul  8 08:37:40 2005
@@ -3462,6 +3462,8 @@
 #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 08:37:40 2005
@@ -676,6 +676,7 @@ PERL_CALLCONV SV*	Perl_sv_2mortal(pTHX_ 
 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);
+PERL_CALLCONV char*	Perl_sv_2pv_backend(pTHX_ SV* sv, STRLEN* lp, I32 flags);
 #endif
 PERL_CALLCONV NV	Perl_sv_2nv(pTHX_ SV* sv);
 /* PERL_CALLCONV char*	sv_2pv(pTHX_ SV* sv, STRLEN* lp); */

Modified: trunk/perl/sv.c
==============================================================================
--- trunk/perl/sv.c	(original)
+++ trunk/perl/sv.c	Fri Jul  8 08:37:40 2005
@@ -19,6 +19,13 @@
 
 #include "EXTERN.h"
 #define PERL_IN_SV_C
+#include "ponie.h"
+#undef cache
+#if 0
+/* You realise, we can't actually do this! We do die horribly.  */
+#define data ``` /* Die horribly, badly named thing.  */
+#endif
+#define data2 `````` http://use.perl.org/~petdance/journal/17788 :-)
 #include "perl.h"
 #include "regcomp.h"
 
@@ -2335,6 +2342,32 @@ Perl_sv_2nv(pTHX_ SV *sv)
     return Parrot_PMC_get_numval(PL_Parrot,MUMBLE(sv));
 }
 
+/*
+=for apidoc sv_2pv_flags
+
+Returns a pointer to the string value of an SV, and sets *lp to its length.
+If flags includes SV_GMAGIC, does an mg_get() first. Coerces sv to a string
+if necessary.
+Normally invoked via the C<SvPV_flags> macro. C<sv_2pv()> and C<sv_2pv_nomg>
+usually end up here too.
+
+=cut
+*/
+
+char *
+Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
+{
+    struct Ponie_pvlen getlen;
+    Parrot_PMC_set_pointer_intkey(PL_Parrot, MUMBLE(sv),
+				  (flags & SV_GMAGIC)
+				  ? Ponie_P_SV_PV
+				  : Ponie_P_SV_PV_NO_GMAGIC,
+				  &getlen);
+    if (lp)
+	*lp = getlen.len;
+    return getlen.pv;
+}
+
 /* asIV(): extract an integer from the string value of an SV.
  * Caller must validate PVX  */
 
@@ -2441,20 +2474,10 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLE
     return sv_2pv_flags(sv, lp, SV_GMAGIC);
 }
 
-/*
-=for apidoc sv_2pv_flags
-
-Returns a pointer to the string value of an SV, and sets *lp to its length.
-If flags includes SV_GMAGIC, does an mg_get() first. Coerces sv to a string
-if necessary.
-Normally invoked via the C<SvPV_flags> macro. C<sv_2pv()> and C<sv_2pv_nomg>
-usually end up here too.
-
-=cut
-*/
+/* The code that the PMC calls back to (for now).  */
 
 char *
-Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
+Perl_sv_2pv_backend(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 {
     register char *s;
     int olderrno;

Modified: trunk/perl/sv.h
==============================================================================
--- trunk/perl/sv.h	(original)
+++ trunk/perl/sv.h	Fri Jul  8 08:37:40 2005
@@ -251,6 +251,8 @@ typedef enum {
   Ponie_P_NEWSVRV,		/* newSVrv */
   Ponie_P_REPLACE,		/* Special things for sv_replace */
   Ponie_P_PINE_FOR_FJORDS,	/* Free all internal storage and play dead */
+  Ponie_P_SV_PV,		/* Get the pvx and len.  */
+  Ponie_P_SV_PV_NO_GMAGIC,	/* Get the pvx and len, but don't call GMAGIC */
   Ponie_P_MAX
 } Ponie_pointers;