Mercurial > hg > Members > anatofuz > MoarVM
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; +}