Run a subroutine in Parrot_call

* the src tests is cheating (missing interfaces)
* actually running the code should probably be separate


git-svn-id: https://svn.parrot.org/parrot/trunk@4522 d31e2699-5ff4-0310-a27c-f18f2fbe73fe

extend.c

@@ -6,7 +6,7 @@
  *     The Parrot extension interface. These are the functions that
  *     parrot extensions (i.e. parrot subroutines written in C, or
  *     some other compiled language, rather than in parrot bytecode)
- *     may access. 
+ *     may access.
  *
  *     There is a deliberate distancing from the internals here. Don't
  *     go peeking inside -- you've as much access as bytecode does,
@@ -153,9 +153,11 @@ void Parrot_call(Parrot_INTERP interpreter, Parrot_PMC sub,
                  Parrot_Int argcount, ...) {
     Parrot_Int inreg = 0;
     va_list ap;
+    static PMC *ret_c = NULL;
+    opcode_t offset, *dest;
 
     va_start(ap, argcount);
-    
+
     /* Will all the arguments fit into registers? */
     if (argcount < 12) {
         for (inreg = 0; inreg < argcount; inreg++) {
@@ -182,6 +184,19 @@ void Parrot_call(Parrot_INTERP interpreter, Parrot_PMC sub,
     /* Actually make the call, which turns out to be somewhat
        problematic */
 
+    /* we ever need one return continuation with a NULL offset */
+    if (!ret_c) {
+        ret_c = pmc_new(interpreter, enum_class_RetContinuation);
+    }
+    REG_PMC(1) = ret_c;
+    /* invoke the sub, which places the context of the sub in the
+     * interpreter, and switches code segments if needed
+     */
+    dest = VTABLE_invoke(interpreter, sub, NULL);
+
+    offset = dest - interpreter->code->byte_code;
+    runops(interpreter, offset);
+
 }
 
 /*=for api extend Parrot_call_method

src/extend.c

@@ -6,7 +6,7 @@
  *     The Parrot extension interface. These are the functions that
  *     parrot extensions (i.e. parrot subroutines written in C, or
  *     some other compiled language, rather than in parrot bytecode)
- *     may access. 
+ *     may access.
  *
  *     There is a deliberate distancing from the internals here. Don't
  *     go peeking inside -- you've as much access as bytecode does,
@@ -153,9 +153,11 @@ void Parrot_call(Parrot_INTERP interpreter, Parrot_PMC sub,
                  Parrot_Int argcount, ...) {
     Parrot_Int inreg = 0;
     va_list ap;
+    static PMC *ret_c = NULL;
+    opcode_t offset, *dest;
 
     va_start(ap, argcount);
-    
+
     /* Will all the arguments fit into registers? */
     if (argcount < 12) {
         for (inreg = 0; inreg < argcount; inreg++) {
@@ -182,6 +184,19 @@ void Parrot_call(Parrot_INTERP interpreter, Parrot_PMC sub,
     /* Actually make the call, which turns out to be somewhat
        problematic */
 
+    /* we ever need one return continuation with a NULL offset */
+    if (!ret_c) {
+        ret_c = pmc_new(interpreter, enum_class_RetContinuation);
+    }
+    REG_PMC(1) = ret_c;
+    /* invoke the sub, which places the context of the sub in the
+     * interpreter, and switches code segments if needed
+     */
+    dest = VTABLE_invoke(interpreter, sub, NULL);
+
+    offset = dest - interpreter->code->byte_code;
+    runops(interpreter, offset);
+
 }
 
 /*=for api extend Parrot_call_method

t/src/extend.t

@@ -1,7 +1,8 @@
 #! perl -w
 # Tests the extension API
 
-use Parrot::Test tests => 10;
+use Parrot::Test tests => 11;
+use Parrot::Config;
 
 c_output_is(<<'CODE', <<'OUTPUT', "set/get_intreg");
 
@@ -319,4 +320,64 @@ Wibble
 6
 OUTPUT
 
+my $temp = 'temp';;
+open S, ">$temp.pasm" or die "Can't write $temp.pasm";
+print S <<'EOF';
+  .pcc_sub _sub1:
+  printerr "in sub1\n"
+  invoke P1
+  .pcc_sub _sub2:
+  printerr P5
+  print "in sub2\n"
+  invoke P1
+EOF
+close S;
+# compile to pbc
+system(".$PConfig{slash}parrot$PConfig{exe} -o $temp.pbc $temp.pasm");
+
+c_output_is(<<'CODE', <<'OUTPUT', "call a parrot sub");
+
+#include <stdio.h>
+/* have to cheat because of missing extend interfaces */
+/* #include "parrot/extend.h" */
+#include "parrot/parrot.h"
+#include "parrot/embed.h"
+
+/* also both the test PASM and main print to stderr
+ * so that buffering in PIO isn't and issue
+ */
+
+int main(int argc, char* argv[]) {
+    Parrot_Interp interpreter;
+    struct PackFile *pf;
+    PMC *key, *sub, *arg;
+
+    interpreter = Parrot_new();
+    pf = Parrot_readbc(interpreter, "temp.pbc");
+    Parrot_loadbc(interpreter, pf);
+    key = key_new_cstring(interpreter, "_sub1");
+    sub = VTABLE_get_pmc_keyed(interpreter,
+				interpreter->perl_stash->stash_hash, key);
+    Parrot_call(interpreter, sub, 0);
+    fprintf(stderr, "back\n");
+
+    key = key_new_cstring(interpreter, "_sub2");
+    sub = VTABLE_get_pmc_keyed(interpreter,
+				interpreter->perl_stash->stash_hash, key);
+    arg = pmc_new(interpreter, enum_class_PerlString);
+    VTABLE_set_string_native(interpreter, arg,
+	    string_from_cstring(interpreter, "hello ", 0));
+    Parrot_call(interpreter, sub, 1, arg);
+    fprintf(stderr, "back\n");
+    return 0;
+}
+CODE
+in sub1
+back
+hello in sub2
+back
+OUTPUT
+
+unlink "$temp.pasm", "$temp.pbc";
+
 1;