#!/usr/bin/env perl
use strict;
use warnings;

my $cbc_file = shift or die; # src/core/cbc-interp.cbc

open my $fh, '<',$cbc_file;
my @cbc_lines= <$fh>;
close $fh;

my @rewritec = ();
my $indent = " " x 12;
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;
    }
}

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++;
        last;
    }
}
my @dispatch = ();

for (;$i < scalar(@cbc_lines); $i++){
    # check OP(.*) {  codes

    if ($cbc_lines[$i] =~ /#if MVM_CGOTO/){
        $i--;
        last;
    }

    if ($cbc_lines[$i] =~ /^\s+OP\((.*)\):/ ){
        my $opcode = $1;
        #push @dispatch,"${indent}OP($opcode):\n";
        $none_left_blanket = $cbc_lines[$i] =~ /{/ ? 0 : 1;
        # transrate OP(HOGE) to __code hoge(INTERP *i){
        $cbc_lines[$i]  =  "__code "."cbc_$opcode"."(INTERP i){\n";
        #$cbc_lines[$i]  = $indent. "__code ".$opcode."(INTERP i){\n";
        push @rewritec,$cbc_lines[$i];

        # 次の行に移動
        $i++;

        # この行がOP()だった場合
        #  OP(DEPRECATED_4):
        #  OP(DEPRECATED_5): <- $i
        # このような宣言になっているので$iにgotoするように関数を書き直し
        # $iの部分の関数定義を次ループでするために一行戻して再ループ

        if ($cbc_lines[$i] =~ /^\s+OP\((.*)\):/){
            push @rewritec,"    goto cbc_$1(i);\n";
            #push @rewritec,"$indent   goto $1(i);\n";
            insert_right_blanket();
            $i--;
            next;
        }

        # 例外だったらかえってこないはずなので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;
        }
    }

    # 普通の行は変換して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){
        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;
    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;
}