0001-pmc2c-fixup-Chirags-code-a-bit.patch

0001-pmc2c-fixup-Chirags-code-a-bit.patch

From cde13dbfa3caea108bdec5ccd71efbe10ea3a2e4 Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@cpanel.net>
Date: Fri, 27 Jun 2014 12:00:08 -0500
Subject: [PATCH] [pmc2c] fixup Chirags code a bit

fallback to old slow code with unknown arg adverbs.
fix indices and whitespace and more codingstd with Chirags code.
add helper function convert_pcc_sigtype for args and return sigs.
---
 lib/Parrot/Pmc2c/PCCMETHOD.pm | 118 ++++++++++++++++++++----------------------
 src/call/args.c               |   2 +-
 2 files changed, 56 insertions(+), 64 deletions(-)

diff --git lib/Parrot/Pmc2c/PCCMETHOD.pm lib/Parrot/Pmc2c/PCCMETHOD.pm
index e6ed223..0e4bbab 100644
--- lib/Parrot/Pmc2c/PCCMETHOD.pm
+++ lib/Parrot/Pmc2c/PCCMETHOD.pm
@@ -1,4 +1,4 @@
-# Copyright (C) 2004-2012, Parrot Foundation.
+# Copyright (C) 2004-2014, Parrot Foundation.
 
 package Parrot::Pmc2c::PCCMETHOD;
 use strict;
@@ -128,6 +128,14 @@ sub convert_type_string_to_reg_type {
     croak "$_ not recognized as INTVAL, FLOATVAL, STRING, or PMC";
 }
 
+sub convert_pcc_sigtype {
+    my %sigtype = ('P' => 'pmc',
+                   'S' => 'string',
+                   'I' => 'integer',
+                   'N' => 'number');
+    return $sigtype{$_[0]};
+}
+
 sub gen_arg_pcc_sig {
     my ($param) = @_;
 
@@ -209,47 +217,31 @@ END
         my ( $returns_signature, $returns_varargs ) =
             process_pccmethod_args( parse_p_args_string($returns), 'return' );
 
+        my $rettype;
         if ($returns_signature and !$method->is_vtable) {
-            $e->emit( <<"END" );
+            my $type = convert_pcc_sigtype($returns_signature);
+            unless ($type) {
+                # Fallback to slow arg filling. Currently only "II" with FileHandle.tell
+                $e->emit( <<"END" );
     {  /*BEGIN RETURN $returns */
+        Parrot_pcc_set_call_from_c_args(interp, _call_object,
+            "$returns_signature", $returns_varargs);
+        $wb
+        return;
+    }   /*END RETURN $returns */
 END
-        my $arg_index = 0;
-        my @sig_vals = split(//,$returns_signature);
-        my @returns_vararg_list = split(/, /,$returns_varargs);
-        my $temp_val;
-
-        foreach $temp_val (@sig_vals) {
-	        if ($temp_val eq uc($temp_val)) {
-	            if($temp_val eq 'P') {
-                    $e->emit( <<"END");
-        VTABLE_set_pmc_keyed_int(interp, _call_object, 0, $returns_vararg_list[$arg_index]);
-END
-        		}
-	            elsif($temp_val eq 'S') {
-                    $e->emit( <<"END");
-        VTABLE_set_string_keyed_int(interp, _call_object, 3, $returns_vararg_list[$arg_index]);
-END
-        		}
-	            elsif($temp_val eq 'I') {
-                    $e->emit( <<"END");
-        VTABLE_set_integer_keyed_int(interp, _call_object, 1, $returns_vararg_list[$arg_index]);
-END
-        		}
-	            elsif($temp_val eq 'N') {
-                    $e->emit( <<"END");
-        VTABLE_set_number_keyed_int(interp, _call_object, 2, $returns_vararg_list[$arg_index]);
-END
-        		}
-        		$arg_index += 1;
+                $matched->replace( $match, $e );
+                return 1;
             }
-        }
-        $e->emit( <<"END" );
+            $e->emit( <<"END" );
+     {
+        VTABLE_set_${type}_keyed_int(interp, _call_object, 0, $returns_varargs);
         $wb
         return;
-    }   /*END RETURN $returns */
+     }
 END
         }
-        elsif ($wb) { # if ($returns_signature)
+        elsif ($wb) { # if ($returns_signature) block needed
             $e->emit( <<"END" );
     {
         $wb
@@ -257,7 +249,7 @@ END
     }
 END
         }
-        else {
+        else { # no block needed
             $e->emit( <<"END" );
     return $returns_varargs;
 END
@@ -401,43 +393,43 @@ sub rewrite_pccmethod {
     PMC * const _ctx         = CURRENT_CONTEXT(interp);
     PMC * const _call_object = Parrot_pcc_get_signature(interp, _ctx);
 
-    { /* BEGIN PARMS SCOPE */
+    { /* BEGIN PARAMS SCOPE */
 END
     $e->emit(<<"END");
 $params_declarations
 END
-    if ($params_signature) {
+    # SKIP fast code for c,f,l,n,o,p,s arg adverbs
+    if ($params_signature and $params_signature !~ /[cflnops]/) {
         my $arg_index = 0;
-        my @sig_vals = split(//,$params_signature);
-        my @params_vararg_list = split(/, &/,(substr $params_varargs, 1));
-        my $temp_val;
-
-        foreach $temp_val (@sig_vals) {
-	        if ($temp_val eq uc($temp_val)) {
-	            if($temp_val eq 'P') {
-                    $e->emit( <<"END");
-        $params_vararg_list[$arg_index] = VTABLE_get_pmc_keyed_int(interp, _call_object, 0);
-END
-        		}
-	            elsif($temp_val eq 'S') {
-                    $e->emit( <<"END");
-        $params_vararg_list[$arg_index] = VTABLE_get_string_keyed_int(interp, _call_object, 3);
-END
-        		}
-	            elsif($temp_val eq 'I') {
-                    $e->emit( <<"END");
-        $params_vararg_list[$arg_index] = VTABLE_get_integer_keyed_int(interp, _call_object, 1);
+        my @sig_vals = split(//, $params_signature);
+        my @params_vararg_list = split(/, &/, substr($params_varargs, 1));
+        # TODO: handle o for optional, and c for constant. maybe s for slurpy also
+
+        foreach my $sig (@sig_vals) {
+            my $type = convert_pcc_sigtype($sig);
+            if ($type) {
+                $e->emit( <<"END");
+        $params_vararg_list[$arg_index] = VTABLE_get_${type}_keyed_int(interp, _call_object, $arg_index);
 END
-        		}
-	            elsif($temp_val eq 'N') {
-                    $e->emit( <<"END");
-        $params_vararg_list[$arg_index] = VTABLE_get_number_keyed_int(interp, _call_object, 2);
+                $arg_index++;
+            }
+            elsif($sig eq 'i' # for invocant
+                  and $params_vararg_list[$arg_index - 1] eq '_self'
+                  and $sig_vals[$arg_index - 1] eq 'P') {
+            }
+            else {
+                warn "Warning: ".$pmc->name.".".$method->name."(\"$params_signature\"): unhandled arg adverb $sig for $params_vararg_list[$arg_index - 1]";
+                $e->emit( <<"END");
+        /* unhandled $sig for $params_vararg_list[$arg_index - 1] */
 END
-        		}          
-        		$arg_index += 1;
             }
         }
-
+    }
+    elsif ($params_signature) {
+        $e->emit( <<"END");
+        Parrot_pcc_fill_params_from_c_args(interp, _call_object, "$params_signature",
+            $params_varargs);
+END
     }
     $e->emit( <<'END' );
     { /* BEGIN PMETHOD BODY */
diff --git src/call/args.c src/call/args.c
index a7ec8c8..7ba54e2 100644
--- src/call/args.c
+++ src/call/args.c
@@ -1586,7 +1586,7 @@ Parrot_pcc_merge_signature_for_tailcall(PARROT_INTERP, ARGMOD(PMC *parent), ARGM
     if (LIKELY(PMC_IS_NULL(parent) || PMC_IS_NULL(tailcall) || (parent == tailcall)))
         return;
     else {
-        /* Broke encapuslation. Direct poking into CallContext is much faster */
+        /* Broke encapsulation. Direct poking into CallContext is much faster */
         PMC * temp;
 
         /* Store raw signature */
-- 
2.0.0