[svn:parrot] r41613 - in branches/pcc_reapply/lib/Parrot/Pmc2c: . PMC

allison at svn.parrot.org allison at svn.parrot.org
Fri Oct 2 13:25:09 UTC 2009


Author: allison
Date: Fri Oct  2 13:25:04 2009
New Revision: 41613
URL: https://trac.parrot.org/parrot/changeset/41613

Log:
[pcc] Change the automatically generated vtable function stubs in Object PMC to
call vtable overrides using the new pcc call functions instead of the old ones.

Modified:
   branches/pcc_reapply/lib/Parrot/Pmc2c/Method.pm
   branches/pcc_reapply/lib/Parrot/Pmc2c/PMC/Object.pm

Modified: branches/pcc_reapply/lib/Parrot/Pmc2c/Method.pm
==============================================================================
--- branches/pcc_reapply/lib/Parrot/Pmc2c/Method.pm	Fri Oct  2 12:19:29 2009	(r41612)
+++ branches/pcc_reapply/lib/Parrot/Pmc2c/Method.pm	Fri Oct  2 13:25:04 2009	(r41613)
@@ -149,6 +149,40 @@
     return ( $return_prefix, $method_suffix, $args, $sig, $return_type_char, $null_return );
 }
 
+=head1 C<pcc_signature()>
+
+Returns a PCC-style method signature for the method's parameters, as well as
+some additional information useful in building a call to that method.
+
+=cut
+
+sub pcc_signature {
+    my ($self) = @_;
+
+    my $args             = passable_args_from_parameter_list( $self->parameters );
+    my ($types, $vars)   = args_from_parameter_list( $self->parameters );
+    my $return_type      = $self->return_type;
+    my $return_type_char = $self->trans($return_type);
+    my $sig              = join ('', map { $self->trans($_) } @{$types}) .
+                           '->';
+    
+    my $result_decl    = '';
+    my $return_stmt    = '';
+
+    if ( $return_type eq 'void' ) {
+        $return_stmt = "return ($return_type) NULL;" if $return_type_char =~ /P|I|S|V/;
+        $return_stmt = 'return (FLOATVAL) 0;'        if $return_type_char =~ /N/;
+        $return_stmt = 'return;'                     if $return_type_char =~ /v/;
+    } else {
+        $result_decl = "$return_type result;";
+        $args .= ', &result';
+        $sig .= $return_type_char;
+        $return_stmt = "return ($return_type) result;";
+    }
+
+    return ( $sig, $args, $result_decl, $return_stmt );
+}
+
 1;
 
 # Local Variables:

Modified: branches/pcc_reapply/lib/Parrot/Pmc2c/PMC/Object.pm
==============================================================================
--- branches/pcc_reapply/lib/Parrot/Pmc2c/PMC/Object.pm	Fri Oct  2 12:19:29 2009	(r41612)
+++ branches/pcc_reapply/lib/Parrot/Pmc2c/PMC/Object.pm	Fri Oct  2 13:25:04 2009	(r41613)
@@ -34,6 +34,8 @@
 
         my ( $return_prefix, $ret_suffix, $args, $sig, $return_type_char, $null_return ) =
             $new_default_method->signature;
+        my ( $pcc_sig, $pcc_args, $pcc_result_decl, $pcc_return_stmt ) =
+            $new_default_method->pcc_signature;
         my $void_return  = $return_type_char eq 'v' ? 'return;'    : '';
         my $return       = $return_type_char eq 'v' ? ''           : $return_prefix;
         my $superargs    = $args;
@@ -53,8 +55,9 @@
 
         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
+            $pcc_result_decl
+            Parrot_pcc_invoke_sub_from_c_args(interp, meth, "Pi$pcc_sig", pmc$pcc_args);
+            $pcc_return_stmt
         }
         /* method name is $vt_method_name */
 EOC


More information about the parrot-commits mailing list