changeset 40:9b496a0c430a

merge
author anatofuz
date Tue, 27 Nov 2018 11:25:43 +0900
parents a25406f7da51 (current diff) 2c51389684ca (diff)
children d79216c6452b
files
diffstat 1 files changed, 73 insertions(+), 4 deletions(-) [+]
line wrap: on
line diff
--- a/cbctools/change_OP_to_cbc.pl	Tue Nov 27 11:24:34 2018 +0900
+++ b/cbctools/change_OP_to_cbc.pl	Tue Nov 27 11:25:43 2018 +0900
@@ -13,9 +13,19 @@
 my $none_left_blanket = 0;
 
 my $i = 0;
+our @regex_targets = qw/op cu cur_op tc cur_callsite bytecode_start/;
 
 my @upside = ();
 for (;$i < scalar(@cbc_lines); $i++){
+
+    $cbc_lines[$i] = change_i($cbc_lines[$i]);
+
+    #$cbc_lines[$i] =~ s/reg_base/i->reg_base/g;
+    #$cbc_lines[$i] =~ s/tc/i->tc/g;
+    #$cbc_lines[$i] =~ s/tc/i->tc/g;
+
+    $cbc_lines[$i] =~ s/GET_(REG|LEX)\((.*?)\)/GET_$1($2,i)/g;
+
     push @upside,$cbc_lines[$i];
     if ($cbc_lines[$i+1] =~ /\/\* This is the interpreter run loop. We have one of these per thread. \*\//){
         last;
@@ -25,6 +35,13 @@
 my @middle = ();
 
 for (;$i < scalar(@cbc_lines); $i++){
+
+    if ($cbc_lines[$i] =~ /#if MVM_CGOTO/ && $cbc_lines[$i+1] =~ /#include/){
+        while ( $cbc_lines[$i] !~ /Stash address/){
+                $i++;
+            }
+    }
+
     push @middle,$cbc_lines[$i];
     if ($cbc_lines[$i] =~ /DISPATCH\(NEXT_OP\)/){ # DISPATCHの中身を書き換えるのでそこまで飛ばす
         $i++;
@@ -70,38 +87,90 @@
         # 例外だったらかえってこないはずなのでgoto
         if ( $cbc_lines[$i] =~ /MVM_exception_throw_adhoc/ && $cbc_lines[$i+1] =~ /OP\(/){
             push @rewritec, change_i($cbc_lines[$i]);
+            insert_cbc_next();
             insert_right_blanket();
             next;
         }
+
+        if ($cbc_lines[$i] =~ /{/){
+            $i++;
+            $none_left_blanket = 1;
+            next;
+        }
     }
 
     # 普通の行は変換してinsertする
+    if ($cbc_lines[$i] =~ /}/){
+        if ($cbc_lines[$i+1] =~ /OP/){
+            $cbc_lines[$i] = "}\n";
+        }
+    }
+    $cbc_lines[$i] =~ s/GET_(REG|LEX)\((.*?)\)/GET_$1($2,i)/g;
     push @rewritec,change_i($cbc_lines[$i]);
 
 
    if ($i != scalar(@cbc_lines)-1 && $cbc_lines[$i+1] =~ /OP/ && $none_left_blanket){
+       if ($cbc_lines[$i] !~ /\s*}\s*/ ){
         insert_right_blanket();
+       }
         $none_left_blanket = 0;
     }
 }
 
 my @after = ();
+insert_interp_constract();
 map { push @after,$cbc_lines[$_]} ($i+1.. scalar(@cbc_lines)-1);
 #map { print; } (@upside,@rewritec,@middle,@dispatch,@after);
 map { print; } (@upside,@rewritec,@middle,@after);
 
 
+
+
 sub change_i {
     my $str = shift;
-    $str =~ s/cur_op/i->cur_op/g;
-    $str =~ s/tc/i->tc/g;
-    $str =~ s/cur_callsite/i->cur_callsite/g;
-    $str =~ s/NEXT;/NEXT(i);/;
+    map { $str = substitution_regex($str,$_); } @regex_targets;
+    #
+    #for my $reg (@regex_targets){
+    #    $str = substitution_regex($str,$reg);
+    #}
+    #$str =~ s/(\A)op|([\s,(])op/$2i->op/g;
+    #$str =~ s/(\A)cu|([\s,(])cu/$2i->cu/g;
+    #$str =~ s/(\A)cur_op|([\s,(])cur_op/$2i->cur_op/g;
+    #$str =~ s/(\A)tc|([\s,(&])tc/$2i->tc/g;
+    #$str =~ s/(\A)cur_callsite|([\s,(&])cur_callsite/$2i->cur_callsite/g;
+    #$str =~ s/(\A)bytecode_start|([\s,(&])bytecode_start/$2i->bytecode_start/g;
+    $str =~ s/NEXT;/cbc_next(i);/;
     $str =~ s/                /    /g;
     return $str;
 }
 
+sub substitution_regex {
+    my ($str,$target) = @_;
+    if ($str =~ /(\A)$target/){
+        $str =~ s/(\A)$target/i->$target/g;
+        return $str;
+    }
+    if ($str =~ /([\s,(&])$target/){
+        $str =~ s/([\s,(&])$target/$1i->$target/g;
+        return $str;
+    }
+    return $str;
+}
+
+sub insert_cbc_next{
+    #push @rewritec,"$indent}\n";
+    push @rewritec,"    goto cbc_next(i);\n";
+}
+
 sub insert_right_blanket {
     #push @rewritec,"$indent}\n";
     push @rewritec,"}\n";
 }
+
+sub insert_interp_constract {
+my $msg = <<'EOF';
+INTER inter = {0,NULL,NULL,NULL,NULL,NULL,tc};
+INTERP i = &inter;
+EOF
+    push @after, $msg;
+}