[svn:parrot] r39683 - branches/tt761_keys_revamp/lib/Parrot/Pmc2c

[bacek at svn.parrot.org]

Author: bacek
Date: Sun Jun 21 09:39:08 2009
New Revision: 39683
URL: https://trac.parrot.org/parrot/changeset/39683

Log:
[pmc2c] Slightly improve generating switch-base MULTI VTABLE optimiser.

Modified:
   branches/tt761_keys_revamp/lib/Parrot/Pmc2c/PMCEmitter.pm

Modified: branches/tt761_keys_revamp/lib/Parrot/Pmc2c/PMCEmitter.pm
==============================================================================
--- branches/tt761_keys_revamp/lib/Parrot/Pmc2c/PMCEmitter.pm	Sat Jun 20 21:20:22 2009	(r39682)
+++ branches/tt761_keys_revamp/lib/Parrot/Pmc2c/PMCEmitter.pm	Sun Jun 21 09:39:08 2009	(r39683)
@@ -943,12 +943,15 @@
 
         my $multis = $multi_methods{$vt_method_name};
 
+        # Get parameters.      strip type from param
+        my @parameters = map { s/(\s*\S+\s*\*?\s*)//; $_ } split (/,/, $method->parameters);
+
         # Gather "case :"
-        my @cases = map { $self->generate_single_case($vt_method_name, $_) } @$multis;
+        my @cases = map { $self->generate_single_case($vt_method_name, $_, @parameters) } @$multis;
         my $cases = join "\n", @cases;
 
         my $body = <<"BODY";
-    INTVAL type = VTABLE_type(INTERP, value);
+    INTVAL type = VTABLE_type(INTERP, $parameters[0]);
     /* For dynpmc fallback to MMD */
     if ((type >= enum_class_core_max) || (SELF.type() >= enum_class_core_max))
         type = enum_class_core_max;
@@ -968,13 +971,12 @@
 
 # Generate signle case for switch VTABLE
 sub generate_single_case {
-    my ($self, $vt_method_name, $multi) = @_;
+    my ($self, $vt_method_name, $multi, @parameters) = @_;
 
     my ($type, $ssig, $fsig, $ns, $func, $impl) = @$multi;
     my $case;
 
     # Gather parameters names
-    my @parameters = map { s/\s*PMC\s*\*\s*//; $_ } split (/,/, $impl->parameters);
     my $parameters = join ', ', @parameters;
     # ISO C forbids return with expression from void functions.
     my $return = $impl->return_type =~ /^void\s*$/
@@ -1023,6 +1025,14 @@
             'return retval;',
         );
     }
+    elsif ($letter eq 'S') {
+        return (
+            "PP->" . $letter,
+            "STRING *retval;",
+            ', &retval',
+            'return retval;',
+        );
+    }
     elsif ($letter eq 'P') {
         return (
             'PPP->P',