[svn:parrot] r36926 - in branches/rename_pccinvoke: include/parrot lib/Parrot/Pmc2c lib/Parrot/Pmc2c/PMC src/io src/pmc t/pmc

whiteknight at svn.parrot.org whiteknight at svn.parrot.org
Sat Feb 21 20:02:23 UTC 2009


Author: whiteknight
Date: Sat Feb 21 20:02:22 2009
New Revision: 36926
URL: https://trac.parrot.org/parrot/changeset/36926

Log:
[rename_pccinvoke] update all calls to Parrot_run_meth_fromc_args in src/pmc/object.pmc. Also update one weird test that I think was doing the wrong thing, and a few other changes I had to make for cleaning. two weird failing tests persist, working on that later

Modified:
   branches/rename_pccinvoke/include/parrot/call.h
   branches/rename_pccinvoke/lib/Parrot/Pmc2c/Object.pm
   branches/rename_pccinvoke/lib/Parrot/Pmc2c/PMC/Object.pm
   branches/rename_pccinvoke/src/io/api.c
   branches/rename_pccinvoke/src/pmc/object.pmc
   branches/rename_pccinvoke/t/pmc/namespace.t

Modified: branches/rename_pccinvoke/include/parrot/call.h
==============================================================================
--- branches/rename_pccinvoke/include/parrot/call.h	Sat Feb 21 18:53:37 2009	(r36925)
+++ branches/rename_pccinvoke/include/parrot/call.h	Sat Feb 21 20:02:22 2009	(r36926)
@@ -177,6 +177,16 @@
 PARROT_EXPORT
 PARROT_WARN_UNUSED_RESULT
 PARROT_CANNOT_RETURN_NULL
+PMC* Parrot_pcc_build_sig_object_from_c_args(PARROT_INTERP,
+    ARGIN_NULLOK(PMC* obj),
+    ARGIN(const char *sig),
+    ...)
+        __attribute__nonnull__(1)
+        __attribute__nonnull__(3);
+
+PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
 PMC* Parrot_pcc_build_sig_object_from_varargs(PARROT_INTERP,
     ARGIN_NULLOK(PMC* obj),
     ARGIN(const char *sig),
@@ -313,6 +323,10 @@
        PARROT_ASSERT_ARG(interp) \
     || PARROT_ASSERT_ARG(src_ctx) \
     || PARROT_ASSERT_ARG(dest_ctx)
+#define ASSERT_ARGS_Parrot_pcc_build_sig_object_from_c_args \
+     __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+       PARROT_ASSERT_ARG(interp) \
+    || PARROT_ASSERT_ARG(sig)
 #define ASSERT_ARGS_Parrot_pcc_build_sig_object_from_varargs \
      __attribute__unused__ int _ASSERT_ARGS_CHECK = \
        PARROT_ASSERT_ARG(interp) \

Modified: branches/rename_pccinvoke/lib/Parrot/Pmc2c/Object.pm
==============================================================================
--- branches/rename_pccinvoke/lib/Parrot/Pmc2c/Object.pm	Sat Feb 21 18:53:37 2009	(r36925)
+++ branches/rename_pccinvoke/lib/Parrot/Pmc2c/Object.pm	Sat Feb 21 20:02:22 2009	(r36926)
@@ -57,19 +57,19 @@
     # Need to build signature and work out what return type we expect.
     my $ret_sig  = ctype_to_sigchar( $method->{type} );
 
-    my $ret_type = $ret_sig eq 'I' ? '_reti' : '_retf';
+    my $ret_type = $method->{type};
 
-    my $sig      = $ret_sig;
+    my $sig      = "";
     my @types    = grep { $_ } map { my @x = split /\s+/; $x[0] }
                         split /\s*,\s*/, $parameters;
 
     foreach (@types) {
         $sig .= ctype_to_sigchar($_);
     }
+    $sig .= "->" . $ret_sig;
 
     # Do we have a return value?
     my $return      = $method->{type} =~ /void/ ? ''        : 'return ';
-    my $void_return = $method->{type} =~ /void/ ? 'return;' : '';
 
     # work out what the null return should be so that we can quieten the "no
     # return from non-void function" warnings.
@@ -79,22 +79,25 @@
     # icc), so we add a workaround for the null return from a FLOATVAL
     # function
     my $null_return;
+    my $the_return = "return ret_val;";
     if ( $method->{type} eq 'void' ) {
         $null_return = '';
+        $the_return = "return;";
     }
     elsif ( $method->{type} eq 'void*' ) {
-        $null_return = 'return NULL;';
+        $null_return = '= NULL;';
     }
     elsif ( $method->{type} =~ /PMC|INTVAL|STRING|opcode_t/ ) {
-        $null_return = "return ($method->{type})NULL;";
+        $null_return = "= ($method->{type})NULL;";
     }
 
     # workaround for gcc because the general case doesn't work there
     elsif ( $method->{type} =~ /FLOATVAL/ ) {
-        $null_return = 'return (FLOATVAL) 0;';
+        $null_return = '= (FLOATVAL) 0;';
     }
     else {
         $null_return = '';
+        $the_return = "return;";
     }
 
     my $l         = $self->line_directive( $line + 1, "\L$self->{class}.c" );
@@ -127,10 +130,11 @@
             const ParrotClass_attributes * const class_info = PARROT_CLASS(cur_class);
             if (VTABLE_exists_keyed_str(interp, class_info->vtable_overrides, CONST_STRING_GEN(interp, "$meth"))) {
                 /* Found it; call. */
-                PMC * const meth = VTABLE_get_pmc_keyed_str(interp,
-                    class_info->vtable_overrides, CONST_STRING_GEN(interp, "$meth"));
-                ${return}Parrot_run_meth_fromc_args$ret_type(interp, meth, pmc, CONST_STRING_GEN(interp, "$meth"), "$sig"$arg);
-                $void_return
+                $ret_type ret_val $null_return;
+                PMC * sig_obj = Parrot_pcc_build_sig_object_from_c_args(interp, pmc, "$sig"$arg, &ret_val);
+                PMC * const meth = VTABLE_get_pmc_keyed_str(interp, class_info->vtable_overrides, CONST_STRING_GEN(interp, "$meth"));
+                Parrot_pcc_invoke_from_sig_object(interp, meth, sig_object);
+                $the_return
             }
 EOC
     }
@@ -157,7 +161,7 @@
     $ctype    =~ s/\s//g;
 
     if ( !$ctype || $ctype =~ /void/ ) {
-        return "v";
+        return "";
     }
     elsif ( $ctype =~ /opcode_t\*/ ) {
 

Modified: branches/rename_pccinvoke/lib/Parrot/Pmc2c/PMC/Object.pm
==============================================================================
--- branches/rename_pccinvoke/lib/Parrot/Pmc2c/PMC/Object.pm	Sat Feb 21 18:53:37 2009	(r36925)
+++ branches/rename_pccinvoke/lib/Parrot/Pmc2c/PMC/Object.pm	Sat Feb 21 20:02:22 2009	(r36926)
@@ -34,8 +34,15 @@
 
         my ( $return_prefix, $ret_suffix, $args, $sig, $return_type_char, $null_return ) =
             $new_default_method->signature;
+        $null_return =~ m/\(([^\)]*)\)(.*)$/;
+        my $decl_return = $return_type_char eq 'v' ? '' : "$1 ret_val = ($1) $2";
+        $sig =~ m/(.)(.*)$/;
+        my $sig_ret_val = $1 eq 'v' ? '' : $1;
+        $sig = "$2->$sig_ret_val";
+        my $ret_val_ptr = $return_type_char eq 'v' ? '' : ', &ret_val';
         my $void_return  = $return_type_char eq 'v' ? 'return;'    : '';
         my $return       = $return_type_char eq 'v' ? ''           : $return_prefix;
+        my $do_return    = $return_type_char eq 'v' ? 'return;'    : 'return ret_val;';
         my $superargs    = $args;
         $superargs       =~ s/^,//;
 
@@ -53,8 +60,11 @@
 
         PMC * const meth = Parrot_oo_find_vtable_override_for_class(interp, cur_class, meth_name);
         if (!PMC_IS_NULL(meth)) {
-            ${return}Parrot_run_meth_fromc_args$ret_suffix(interp, meth, pmc, meth_name, "$sig"$args);
-            $void_return
+            /* $return_prefix, $ret_suffix, $args, $sig, $return_type_char, $null_return */
+            $decl_return
+            PMC * sig_obj = Parrot_pcc_build_sig_object_from_c_args(interp, pmc, "$sig"$args$ret_val_ptr);
+            Parrot_pcc_invoke_from_sig_object(interp, meth, sig_obj);
+            $do_return
         }
         /* method name is $vt_method_name */
 EOC

Modified: branches/rename_pccinvoke/src/io/api.c
==============================================================================
--- branches/rename_pccinvoke/src/io/api.c	Sat Feb 21 18:53:37 2009	(r36925)
+++ branches/rename_pccinvoke/src/io/api.c	Sat Feb 21 20:02:22 2009	(r36926)
@@ -457,7 +457,7 @@
         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
             "Cannot write to null PMC");
 
-    Parrot_pcc_PCCINVOKE(interp, pmc, CONST_STRING(interp, "puts"), "S->I",
+    Parrot_PCCINVOKE(interp, pmc, CONST_STRING(interp, "puts"), "S->I",
             s, &result);
     return result;
 

Modified: branches/rename_pccinvoke/src/pmc/object.pmc
==============================================================================
--- branches/rename_pccinvoke/src/pmc/object.pmc	Sat Feb 21 18:53:37 2009	(r36925)
+++ branches/rename_pccinvoke/src/pmc/object.pmc	Sat Feb 21 20:02:22 2009	(r36926)
@@ -169,8 +169,12 @@
         /* If there's a vtable override for 'name' run that instead. */
         PMC * const method = Parrot_oo_find_vtable_override(interp, _class, name);
 
-        if (!PMC_IS_NULL(method))
-            return (STRING *)Parrot_run_meth_fromc_args(interp, method, SELF, name, "S");
+        if (!PMC_IS_NULL(method)) {
+            STRING * ret_val;
+            PMC * sig_obj = Parrot_pcc_build_sig_object_from_c_args(interp, SELF, "->S", &ret_val);
+            Parrot_pcc_invoke_from_sig_object(interp, method, sig_obj);
+            return ret_val;
+        }
         else
             return VTABLE_get_string(interp, _class);
     }
@@ -214,9 +218,12 @@
         PMC * const method = Parrot_oo_find_vtable_override(interp,
                 VTABLE_get_class(interp, SELF), get_attr);
 
-        if (!PMC_IS_NULL(method))
-            return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
-                    get_attr, "PS", name);
+        if (!PMC_IS_NULL(method)) {
+            PMC * ret_val;
+            PMC * sig_obj = Parrot_pcc_build_sig_object_from_c_args(interp, SELF, "S->P", name, &ret_val);
+            Parrot_pcc_invoke_from_sig_object(interp, method, sig_obj);
+            return ret_val;
+        }
 
         /* Look up the index. */
         index = get_attrib_index(interp, obj->_class, name);
@@ -273,9 +280,8 @@
         PMC * const method = Parrot_oo_find_vtable_override(interp,
                 VTABLE_get_class(interp, SELF), vtable_meth_name);
         if (!PMC_IS_NULL(method)) {
-            PMC *unused = (PMC *)Parrot_run_meth_fromc_args(interp, method,
-                SELF, vtable_meth_name, "vSP", name, value);
-            UNUSED(unused);
+            PMC * sig_obj = Parrot_pcc_build_sig_object_from_c_args(interp, SELF, "SP->", name, value);
+            Parrot_pcc_invoke_from_sig_object(interp, method, sig_obj);
             return;
         }
 
@@ -345,9 +351,12 @@
             method = Parrot_oo_find_vtable_override_for_class(interp, cur_class,
                     find_method);
 
-            if (!PMC_IS_NULL(method))
-                return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
-                        find_method, "PS", name);
+            if (!PMC_IS_NULL(method)) {
+                PMC * ret_val;
+                PMC * sig_obj = Parrot_pcc_build_sig_object_from_c_args(interp, SELF, "S->P", name, &ret_val);
+                Parrot_pcc_invoke_from_sig_object(interp, method, sig_obj);
+                return ret_val;
+            }
 
             /* If it's from this universe or the class doesn't inherit from
              * anything outside of it... */
@@ -397,7 +406,7 @@
 
 */
     VTABLE INTVAL get_integer() {
-        Parrot_Object_attributes * const obj       = PARROT_OBJECT(pmc);
+        Parrot_Object_attributes * const obj       = PARROT_OBJECT(SELF);
         Parrot_Class_attributes  * const _class    = PARROT_CLASS(obj->_class);
         STRING * const meth_name = CONST_STRING(interp, "get_integer");
 
@@ -408,20 +417,19 @@
             /* Get the class. */
             PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
 
-            PMC * const meth = Parrot_oo_find_vtable_override_for_class(interp,
+            PMC * const method = Parrot_oo_find_vtable_override_for_class(interp,
                     cur_class, meth_name);
-            if (!PMC_IS_NULL(meth)) {
-                INTVAL result;
-                Parrot_pcc_invoke_sub_from_c_args(interp, meth, "P->I", pmc, &result);
-                return result;
-/*            return (INTVAL)Parrot_run_meth_fromc_args_reti(interp, meth, pmc, meth_name, "I"); */
-
+            if (!PMC_IS_NULL(method)) {
+                INTVAL ret_val;
+                PMC * sig_obj = Parrot_pcc_build_sig_object_from_c_args(interp, SELF, "->I", &ret_val);
+                Parrot_pcc_invoke_from_sig_object(interp, method, sig_obj);
+                return ret_val;
             }
             /* method name is get_integer */
             if (cur_class->vtable->base_type == enum_class_PMCProxy) {
                 /* Get the PMC instance and call the vtable method on that. */
                 STRING * const proxy      = CONST_STRING(interp, "proxy");
-                PMC    * const del_object = VTABLE_get_attr_str(interp, pmc, proxy);
+                PMC    * const del_object = VTABLE_get_attr_str(interp, SELF, proxy);
 
                 if (!PMC_IS_NULL(del_object)) {
                     return (INTVAL)VTABLE_get_integer(interp, del_object);
@@ -429,7 +437,7 @@
                 }
             }
         }
-        return (INTVAL)Parrot_default_get_integer(interp, pmc);
+        return (INTVAL)Parrot_default_get_integer(interp, SELF);
     }
 
 /*
@@ -448,9 +456,12 @@
         PMC * const method = Parrot_oo_find_vtable_override(interp,
                 classobj, get_class);
 
-        if (!PMC_IS_NULL(method))
-            return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
-                    get_class, "P");
+        if (!PMC_IS_NULL(method)) {
+            PMC * ret_val;
+            PMC * sig_obj = Parrot_pcc_build_sig_object_from_c_args(interp, SELF, "->P", &ret_val);
+            Parrot_pcc_invoke_from_sig_object(interp, method, sig_obj);
+            return  ret_val;
+        }
 
         return classobj;
     }
@@ -472,12 +483,14 @@
         PMC * const method = Parrot_oo_find_vtable_override(interp,
                 classobj, get_namespace);
 
-        if (!PMC_IS_NULL(method))
-            return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
-                    get_namespace, "P");
-        else
-            return VTABLE_inspect_str(interp, classobj, CONST_STRING(interp, "namespace"));
+        if (!PMC_IS_NULL(method)) {
+            PMC * ret_val;
+            PMC * sig_obj = Parrot_pcc_build_sig_object_from_c_args(interp, SELF, "->P", &ret_val);
+            Parrot_pcc_invoke_from_sig_object(interp, method, sig_obj);
+            return ret_val;
+        }
 
+        return VTABLE_inspect_str(interp, classobj, CONST_STRING(interp, "namespace"));
     }
 
 /*
@@ -558,10 +571,15 @@
             PMC * const method = Parrot_oo_find_vtable_override(interp,
                 classobj, meth_name);
 
-            if (!PMC_IS_NULL(method)
-             && Parrot_run_meth_fromc_args_reti(interp, method, SELF, meth_name, "IS", role_name))
-                return 1;
+            if (!PMC_IS_NULL(method)) {
+                INTVAL * ret_val;
+                PMC * sig_obj = Parrot_pcc_build_sig_object_from_c_args(interp, SELF, "S->I", role_name, &ret_val);
+                Parrot_pcc_invoke_from_sig_object(interp, method, sig_obj);
+                if(ret_val)
+                    return 1;
+            }
         }
+
         /* Check the superclass's vtable interface, if any. */
         if (SUPER(role_name))
             return 1;
@@ -616,11 +634,12 @@
             PMC * const cur_class =
                 VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
 
-            PMC * const meth =
+            PMC * const method =
                 Parrot_oo_find_vtable_override_for_class(interp, cur_class,
                                                          meth_name);
-            if (!PMC_IS_NULL(meth))
-                return VTABLE_invoke(interp, meth, next);
+
+            if (!PMC_IS_NULL(method))
+                return VTABLE_invoke(interp, method, next);
 
             if (cur_class->vtable->base_type == enum_class_PMCProxy) {
                 /* Get the PMC instance and call the vtable method on that. */
@@ -675,10 +694,14 @@
             PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
 
             /* Look for a method and run it if we find one. */
-            PMC * const meth =
+            PMC * const method =
                 Parrot_oo_find_vtable_override_for_class(interp, cur_class, meth_name);
-            if (!PMC_IS_NULL(meth))
-                return (PMC*)Parrot_run_meth_fromc_args(interp, meth, pmc, meth_name, "P");
+            if (!PMC_IS_NULL(method)) {
+                PMC * ret_val;
+                PMC * sig_obj = Parrot_pcc_build_sig_object_from_c_args(interp, SELF, "->P", &ret_val);
+                Parrot_pcc_invoke_from_sig_object(interp, method, sig_obj);
+                return ret_val;
+            }
         }
 
         /* If we get here, no custom clone. Create a new object PMC. */
@@ -869,8 +892,10 @@
         PMC * const method = Parrot_oo_find_vtable_override(interp,
                 classobj, meth_name);
 
-        if (!PMC_IS_NULL(method))
-            Parrot_run_meth_fromc_args(interp, method, SELF, meth_name, "vP", type);
+        if (!PMC_IS_NULL(method)) {
+            PMC * sig_obj = Parrot_pcc_build_sig_object_from_c_args(interp, SELF, "P->", type);
+            Parrot_pcc_invoke_from_sig_object(interp, method, sig_obj);
+        }
         else
             SUPER(type);
     }

Modified: branches/rename_pccinvoke/t/pmc/namespace.t
==============================================================================
--- branches/rename_pccinvoke/t/pmc/namespace.t	Sat Feb 21 18:53:37 2009	(r36925)
+++ branches/rename_pccinvoke/t/pmc/namespace.t	Sat Feb 21 20:02:22 2009	(r36926)
@@ -1687,7 +1687,7 @@
 CODE
 OUTPUT
 
-pir_error_output_like( <<'CODE', <<'OUTPUT', 'overriding find_method()' );
+pir_output_like( <<'CODE', <<'OUTPUT', 'overriding find_method()' );
 .sub 'main' :main
     $P0 = newclass 'Override'
     $P1 = new ['Override']
@@ -1699,6 +1699,8 @@
 .sub 'find_method' :vtable
     .param string method
     say "Finding method"
+    $P0 = new 'Sub'
+    .return($P0)
 .end
 CODE
 /Finding method/


More information about the parrot-commits mailing list