[svn:parrot] r44600 - in branches/tt1477/ext/Parrot-Embed: lib/Parrot t
plobsing at svn.parrot.org
plobsing at svn.parrot.org
Wed Mar 3 02:36:36 UTC 2010
Author: plobsing
Date: Wed Mar 3 02:36:34 2010
New Revision: 44600
URL: https://trac.parrot.org/parrot/changeset/44600
Log:
convert Parrot::Embed test suite to new PCC signatures
Modified:
branches/tt1477/ext/Parrot-Embed/lib/Parrot/Embed.xs
branches/tt1477/ext/Parrot-Embed/t/interp.t
branches/tt1477/ext/Parrot-Embed/t/languages.t
branches/tt1477/ext/Parrot-Embed/t/pipp.t
Modified: branches/tt1477/ext/Parrot-Embed/lib/Parrot/Embed.xs
==============================================================================
--- branches/tt1477/ext/Parrot-Embed/lib/Parrot/Embed.xs Wed Mar 3 02:30:24 2010 (r44599)
+++ branches/tt1477/ext/Parrot-Embed/lib/Parrot/Embed.xs Wed Mar 3 02:36:34 2010 (r44600)
@@ -22,6 +22,23 @@
Parrot_PMC pmc;
} PMC_struct;
+typedef enum Parrot_return_type {
+ enum_ret_intval,
+ enum_ret_numval,
+ enum_ret_string,
+ enum_ret_pmc,
+} Parrot_return_type;
+
+typedef struct Parrot_return_space {
+ Parrot_return_type type;
+ union {
+ Parrot_Int intval;
+ Parrot_Float numval;
+ Parrot_String string;
+ Parrot_PMC pmc;
+ } u;
+} Parrot_return_space;
+
Interpreter_struct*
make_interp( pTHX_ SV *parent, PARROT_INTERP )
@@ -61,6 +78,82 @@
}
+static Parrot_Int
+invoke_intval_arg_cb(PARROT_INTERP, pTHX_ int idx) {
+ dXSARGS; PUSHMARK(MARK);
+ SV *v = ST(idx + 2);
+ return SvIV(v);
+}
+
+static Parrot_Float
+invoke_numval_arg_cb(PARROT_INTERP, pTHX_ int idx) {
+ dXSARGS; PUSHMARK(MARK);
+ SV *v = ST(idx + 2);
+ return SvNV(v);
+}
+
+static Parrot_String
+invoke_string_arg_cb(PARROT_INTERP, pTHX_ int idx) {
+ dXSARGS; PUSHMARK(MARK);
+ SV *v = ST(idx + 2);
+ STRLEN len;
+ char *s = SvPV(v, len);
+ return Parrot_str_new(interp, s, len);
+}
+
+static Parrot_PMC
+invoke_pmc_arg_cb(PARROT_INTERP, pTHX_ int idx) {
+ dXSARGS; PUSHMARK(MARK);
+ SV *v = ST(idx + 2);
+ Parrot_PMC ret;
+
+ /* unpack pmc T_PTROBJ_PARROT style */
+ if (sv_derived_from(v, "Parrot::PMC")) {
+ IV tmp = SvIV((SV*)(long)SvRv(v));
+ ret = INT2PTR(Parrot_PMC, tmp);
+ } else
+ croak("Argument %i is not of type Parrot::PMC", idx);
+
+ return ret;
+}
+
+#define RESET_PERL_STACK do { \
+ SP = MARK; \
+ PUTBACK; \
+} while (0)
+
+#define INVOKE_CB(x) do { \
+ dXSARGS; PUSHMARK(MARK); \
+ Parrot_return_space *v; \
+ if (idx == 0) \
+ RESET_PERL_STACK; \
+ Newz(0, v, 1, Parrot_return_space); \
+ mXPUSHi( (IV)v ); \
+ PUTBACK; \
+ v->type = enum_ret_ ## x; \
+ return &(v->u.x); \
+} while (0)
+
+static Parrot_Int *
+invoke_intval_ret_cb(PARROT_INTERP, pTHX_ int idx) {
+ INVOKE_CB(intval);
+}
+
+static Parrot_Float *
+invoke_numval_ret_cb(PARROT_INTERP, pTHX_ int idx) {
+ INVOKE_CB(numval);
+}
+
+static Parrot_String *
+invoke_string_ret_cb(PARROT_INTERP, pTHX_ int idx) {
+ INVOKE_CB(string);
+}
+
+static Parrot_PMC *
+invoke_pmc_ret_cb(PARROT_INTERP, pTHX_ int idx) {
+ INVOKE_CB(pmc);
+}
+
MODULE = Parrot::Embed PACKAGE = Parrot::Interpreter
Parrot_Interp
@@ -210,23 +303,57 @@
PMC_struct*
-invoke( pmc, signature, argument )
+invoke( pmc, signature, ... )
PMC_struct *pmc
const char *signature
- const char *argument
PREINIT:
Parrot_PMC pmc_actual;
- Parrot_PMC out_pmc;
Parrot_Interp interp;
- Parrot_String arg_string;
-CODE:
+ static Parrot_ext_call_cbs callback_functions = {
+ (void*)invoke_intval_arg_cb,
+ (void*)invoke_numval_arg_cb,
+ (void*)invoke_string_arg_cb,
+ (void*)invoke_pmc_arg_cb,
+ (void*)invoke_intval_ret_cb,
+ (void*)invoke_numval_ret_cb,
+ (void*)invoke_string_ret_cb,
+ (void*)invoke_pmc_ret_cb,
+ };
+ SV **s;
+PPCODE:
pmc_actual = pmc->pmc;
interp = get_interp( pmc->interp );
- arg_string = Parrot_str_new_constant( interp, argument );
- Parrot_ext_call( interp, pmc_actual, signature, arg_string, &out_pmc );
- RETVAL = make_pmc( aTHX_ pmc->interp, out_pmc );
-OUTPUT:
- RETVAL
+ SP = MARK;
+ PUTBACK;
+ Parrot_ext_call_cb( interp, pmc_actual, signature, &callback_functions, aTHX );
+ SPAGAIN;
+ for (s = SP; s > MARK; s--) {
+ Parrot_return_space *ret = (Parrot_return_space *)SvIV(*s);
+ switch (ret->type) {
+ case enum_ret_intval:
+ *s = newSViv(ret->u.intval);
+ break;
+ case enum_ret_numval:
+ *s = newSVnv(ret->u.numval);
+ break;
+ case enum_ret_string: {
+ char *cstr = Parrot_str_to_cstring(interp, ret->u.string);
+ STRLEN len = Parrot_str_byte_length(interp, ret->u.string);
+ *s = newSVpvn(cstr, len);
+ Parrot_str_free_cstring(cstr);
+ break;
+ }
+ case enum_ret_pmc: {
+ /* wrap pmc T_PTROBJ_PARROT style */
+ *s = newSV(0);
+ sv_setref_pv(*s, "Parrot::PMC",
+ make_pmc(aTHX_ pmc->interp, ret->u.pmc));
+ break;
+ }
+ }
+ sv_2mortal(*s);
+ Safefree(ret);
+ }
char *
Modified: branches/tt1477/ext/Parrot-Embed/t/interp.t
==============================================================================
--- branches/tt1477/ext/Parrot-Embed/t/interp.t Wed Mar 3 02:30:24 2010 (r44599)
+++ branches/tt1477/ext/Parrot-Embed/t/interp.t Wed Mar 3 02:36:34 2010 (r44600)
@@ -45,7 +45,7 @@
'... but again, not if there is no global of that name there' );
can_ok( $global_greet, 'invoke' );
-my $pmc = $global_greet->invoke( 'PS', 'Bob' );
+my $pmc = $global_greet->invoke( 'S->P', 'Bob' );
ok( $pmc, 'invoke() should return a PMC, given that signature' );
is( $pmc->get_string(), 'Hello, Bob!', '... containing a string returned in the PMC' );
@@ -72,11 +72,11 @@
ok( !$interp->compile('blah'), '... but only for valid PIR' );
}
-$pmc = $else_greet->invoke( 'P', '' );
+$pmc = $else_greet->invoke( '->P', '' );
is( $pmc->get_string(), 'Hiya!', '... calling the passed-in subroutine' );
my $foo = $interp->find_global('foo');
-$pmc = $foo->invoke( 'PS', 'BAR' );
+$pmc = $foo->invoke( 'S->P', 'BAR' );
is( $pmc->get_string(), 'BAR FOO ',
'... and compiled sub should work just like any other Sub pmc' );
@@ -86,7 +86,7 @@
$foo = $die_interp->find_global('greet');
}
-$pmc = $foo->invoke( 'PS', 'out of scope' );
+$pmc = $foo->invoke( 'S->P', 'out of scope' );
is(
$pmc->get_string(),
'Hello, out of scope!',
Modified: branches/tt1477/ext/Parrot-Embed/t/languages.t
==============================================================================
--- branches/tt1477/ext/Parrot-Embed/t/languages.t Wed Mar 3 02:30:24 2010 (r44599)
+++ branches/tt1477/ext/Parrot-Embed/t/languages.t Wed Mar 3 02:36:34 2010 (r44600)
@@ -29,7 +29,7 @@
my $abc = $interp->find_global( 'main', 'abc::Compiler' );
isa_ok( $abc, 'Parrot::PMC' );
-my $pmc = $abc->invoke('PS', '2+3');
+my $pmc = $abc->invoke('S->P', '2+3');
ok( $pmc, 'invoke() should return a PMC, given that signature' );
is( $pmc->get_string(), 1, 'value returned in the PMC' );
Modified: branches/tt1477/ext/Parrot-Embed/t/pipp.t
==============================================================================
--- branches/tt1477/ext/Parrot-Embed/t/pipp.t Wed Mar 3 02:30:24 2010 (r44599)
+++ branches/tt1477/ext/Parrot-Embed/t/pipp.t Wed Mar 3 02:36:34 2010 (r44600)
@@ -52,7 +52,7 @@
# compile some PHP code
if (0)
{
- my $pmc = $pipp_eval->invoke( 'PS', $code );
+ my $pmc = $pipp_eval->invoke( 'S->P', $code );
ok( $pmc, 'invoke() should return a PMC, given that signature' );
is( $pmc->get_string(), 1, 'string returned in the PMC should be true?' );
}
@@ -61,7 +61,7 @@
# invoke a built-in php function
if (0)
{
- my $pmc = $pipp_eval->invoke( 'PS', 'strlen', 'some string' );
+ my $pmc = $pipp_eval->invoke( 'S->P', 'strlen', 'some string' );
ok( $pmc, 'invoke() should return a PMC, given that signature' );
is( $pmc->get_string(), 11, 'value returned in the PMC' );
}
@@ -69,7 +69,7 @@
# invoke a php function
if (0)
{
- my $pmc = $pipp_eval->invoke( 'PS', 'add', 23, 19 );
+ my $pmc = $pipp_eval->invoke( 'S->P', 'add', 23, 19 );
ok( $pmc, 'invoke() should return a PMC, given that signature' );
is( $pmc->get_string(), 42, 'value returned in the PMC' );
}
More information about the parrot-commits
mailing list