[svn:parrot] r41988 - in trunk: include/parrot src t/src
allison at svn.parrot.org
allison at svn.parrot.org
Wed Oct 21 20:05:44 UTC 2009
Author: allison
Date: Wed Oct 21 20:05:43 2009
New Revision: 41988
URL: https://trac.parrot.org/parrot/changeset/41988
Log:
[pcc] Add a generic extend/embed interface function for invoking Parrot
subs/method. This will replace all the other Parrot_call* functions.
Modified:
trunk/include/parrot/extend.h
trunk/src/extend.c
trunk/t/src/extend.t
Modified: trunk/include/parrot/extend.h
==============================================================================
--- trunk/include/parrot/extend.h Wed Oct 21 19:56:49 2009 (r41987)
+++ trunk/include/parrot/extend.h Wed Oct 21 20:05:43 2009 (r41988)
@@ -124,6 +124,15 @@
__attribute__nonnull__(2);
PARROT_EXPORT
+void Parrot_ext_call(PARROT_INTERP,
+ ARGIN(Parrot_PMC sub_pmc),
+ ARGIN(const char *signature),
+ ...)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
Parrot_Language Parrot_find_language(SHIM_INTERP, SHIM(char *language));
@@ -472,6 +481,10 @@
, PARROT_ASSERT_ARG(signature))
#define ASSERT_ARGS_Parrot_eprintf __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(s))
+#define ASSERT_ARGS_Parrot_ext_call __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(sub_pmc) \
+ , PARROT_ASSERT_ARG(signature))
#define ASSERT_ARGS_Parrot_find_language __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
#define ASSERT_ARGS_Parrot_fprintf __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
Modified: trunk/src/extend.c
==============================================================================
--- trunk/src/extend.c Wed Oct 21 19:56:49 2009 (r41987)
+++ trunk/src/extend.c Wed Oct 21 20:05:43 2009 (r41988)
@@ -1071,6 +1071,53 @@
/*
+=item C<void Parrot_ext_call(PARROT_INTERP, Parrot_PMC sub_pmc, const char
+*signature, ...)>
+
+Call a Parrot subroutine or method with the given function signature. The
+function signature holds one type character for each argument or return, these
+are:
+
+ I ... Parrot_Int
+ N ... Parrot_Float
+ S ... Parrot_String
+ P ... Parrot_PMC
+
+Returns come after the arguments, separated by an arrow, so "PN->S" takes a PMC
+and a float as arguments and returns a string.
+
+Pass the variables for the arguments and returns in the same order as the
+signature, with returns as reference to the variable (so it can be modified).
+
+ Parrot_ext_call(interp, sub, "P->S", pmc_arg, &string_result);
+
+To call a method, pass the object for the method as the first argument, and
+mark it in the signature as "Pi" ("i" stands for "invocant").
+
+ Parrot_ext_call(interp, sub, "PiP->S", object_arg, pmc_arg, &string_result);
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_ext_call(PARROT_INTERP, ARGIN(Parrot_PMC sub_pmc),
+ ARGIN(const char *signature), ...)
+{
+ ASSERT_ARGS(Parrot_ext_call)
+ va_list args;
+ PMC *sig_object;
+
+ va_start(args, signature);
+ sig_object = Parrot_pcc_build_sig_object_from_varargs(interp, PMCNULL, signature, args);
+ va_end(args);
+
+ Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, sig_object);
+}
+
+/*
+
=item C<void* Parrot_call_sub(PARROT_INTERP, Parrot_PMC sub_pmc, const char
*signature, ...)>
Modified: trunk/t/src/extend.t
==============================================================================
--- trunk/t/src/extend.t Wed Oct 21 19:56:49 2009 (r41987)
+++ trunk/t/src/extend.t Wed Oct 21 20:05:43 2009 (r41988)
@@ -12,7 +12,7 @@
use Parrot::Test;
use Parrot::Config;
-plan tests => 17;
+plan tests => 20;
=head1 NAME
@@ -471,6 +471,133 @@
back
OUTPUT
+c_output_is( <<"CODE", <<'OUTPUT', 'call a parrot sub using the unified interface' );
+
+#include <parrot/parrot.h>
+#include <parrot/embed.h>
+#include <parrot/extend.h>
+
+static opcode_t *the_test(Parrot_Interp, opcode_t *, opcode_t *);
+
+int
+main(int argc, char *argv[])
+{
+ Parrot_Interp interp = Parrot_new(NULL);
+ if (!interp)
+ return 1;
+
+ Parrot_run_native(interp, the_test);
+
+ Parrot_exit(interp, 0);
+ return 0;
+}
+
+/* also both the test PASM and the_test() print to stderr
+ * so that buffering in PIO is not an issue */
+
+static opcode_t*
+the_test(PARROT_INTERP, opcode_t *cur_op, opcode_t *start)
+{
+ PackFile *pf = Parrot_pbc_read(interp, "$temp_pbc", 0);
+ STRING *name = Parrot_str_new_constant(interp, "_sub1");
+ PMC *sub, *arg;
+
+ Parrot_pbc_load(interp, pf);
+ sub = Parrot_find_global_cur(interp, name);
+ Parrot_ext_call(interp, sub, "->");
+ Parrot_eprintf(interp, "back\\n");
+
+ /* win32 seems to buffer stderr ? */
+ Parrot_io_flush(interp, Parrot_io_STDERR(interp));
+
+ name = Parrot_str_new_constant(interp, "_sub2");
+ sub = Parrot_find_global_cur(interp, name);
+ arg = pmc_new(interp, enum_class_String);
+
+ Parrot_PMC_set_string_native(interp, arg,
+ Parrot_str_new(interp, "hello ", 0));
+
+ Parrot_ext_call(interp, sub, "P->", arg);
+ Parrot_eprintf(interp, "back\\n");
+
+ return NULL;
+}
+CODE
+in sub1
+back
+hello in sub2
+back
+OUTPUT
+
+($TEMP, my $temp_pir) = create_tempfile( SUFFIX => '.pir', UNLINK => 1 );
+
+print $TEMP <<'EOF';
+ .sub foo
+ .param pmc input
+ printerr input
+ printerr "in sub2\n"
+ $P0 = new "Integer"
+ $P0 = 42
+ .return($P0)
+ .end
+EOF
+close $TEMP;
+
+# compile to pbc
+(undef, $temp_pbc) = create_tempfile( SUFFIX => '.pbc', UNLINK => 1 );
+system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pir);
+
+c_output_is( <<"CODE", <<'OUTPUT', 'call a parrot sub and return an integer' );
+
+#include <parrot/parrot.h>
+#include <parrot/embed.h>
+#include <parrot/extend.h>
+
+static opcode_t *the_test(Parrot_Interp, opcode_t *, opcode_t *);
+
+int
+main(int argc, char *argv[])
+{
+ Parrot_Interp interp = Parrot_new(NULL);
+ if (!interp)
+ return 1;
+
+ Parrot_run_native(interp, the_test);
+
+ Parrot_exit(interp, 0);
+ return 0;
+}
+
+/* also both the test PASM and the_test() print to stderr
+ * so that buffering in PIO is not an issue */
+
+static opcode_t*
+the_test(PARROT_INTERP, opcode_t *cur_op, opcode_t *start)
+{
+ PackFile *pf = Parrot_pbc_read(interp, "$temp_pbc", 0);
+ STRING *name = Parrot_str_new_constant(interp, "foo");
+ PMC *sub, *arg;
+ Parrot_Int result;
+
+ Parrot_pbc_load(interp, pf);
+ sub = Parrot_find_global_cur(interp, name);
+ arg = pmc_new(interp, enum_class_String);
+
+ Parrot_PMC_set_string_native(interp, arg,
+ Parrot_str_new(interp, "hello ", 0));
+
+ Parrot_ext_call(interp, sub, "P->I", arg, &result);
+ Parrot_eprintf(interp, "result %d\\n", result);
+ Parrot_eprintf(interp, "back\\n");
+
+ return NULL;
+}
+CODE
+hello in sub2
+result 42
+back
+OUTPUT
+
($TEMP, $temp_pasm) = create_tempfile( SUFFIX => '.pasm', UNLINK => 1 );
print $TEMP <<'EOF';
@@ -543,7 +670,7 @@
back
OUTPUT
-($TEMP, my $temp_pir) = create_tempfile( SUFFIX => '.pir', UNLINK => 1 );
+($TEMP, $temp_pir) = create_tempfile( SUFFIX => '.pir', UNLINK => 1 );
print $TEMP <<'EOF';
.sub main :main
@@ -695,6 +822,38 @@
Result is 300.
OUTPUT
+c_output_is( <<"CODE", <<'OUTPUT', 'call multi sub from C - unified interface' );
+#include <parrot/parrot.h>
+#include <parrot/embed.h>
+#include <parrot/extend.h>
+
+int
+main(int argc, char* argv[])
+{
+ Parrot_Int result;
+ Parrot_PMC sub;
+ Parrot_PackFile pf;
+ Parrot_Interp interp = Parrot_new(NULL);
+
+ if (!interp) {
+ printf( "No interpreter\\n" );
+ return 1;
+ }
+
+ pf = Parrot_pbc_read( interp, "$temp_pbc", 0 );
+ Parrot_pbc_load( interp, pf );
+
+ sub = Parrot_find_global_cur( interp, Parrot_str_new_constant( interp, "add" ) );
+ Parrot_ext_call( interp, sub, "II->I", 100, 200, &result );
+ printf( "Result is %d.\\n", result );
+
+ Parrot_exit(interp, 0);
+ return 0;
+}
+CODE
+Result is 300.
+OUTPUT
+
c_output_is( <<'CODE', <<'OUTPUT', 'multiple Parrot_new/Parrot_exit cycles' );
#include <stdio.h>
More information about the parrot-commits
mailing list