diff options
author | Björn Gustavsson <bjorn@erlang.org> | 2012-05-23 16:08:59 +0200 |
---|---|---|
committer | Björn-Egil Dahlberg <egil@erlang.org> | 2014-01-28 15:56:24 +0100 |
commit | 331bb6cab54e6697e12cc9c5a4ca0ae618c37dd3 (patch) | |
tree | 674772a9bc325fc962d3e16c914356e5c06e5fd2 /erts/emulator/utils/beam_makeops | |
parent | 3c112fbde20a21db0cafc140aa72346f60315b90 (diff) | |
download | otp-331bb6cab54e6697e12cc9c5a4ca0ae618c37dd3.tar.gz otp-331bb6cab54e6697e12cc9c5a4ca0ae618c37dd3.tar.bz2 otp-331bb6cab54e6697e12cc9c5a4ca0ae618c37dd3.zip |
BEAM loader: Support preservation of extra operand in transforms
It was not possible to preserve extra arguments in transformations.
The following (hypothetical) example will now work:
some_op Lit=c SizeArg Rest=* => move Lit x | some_op x SizeArg Rest
Diffstat (limited to 'erts/emulator/utils/beam_makeops')
-rwxr-xr-x | erts/emulator/utils/beam_makeops | 23 |
1 files changed, 16 insertions, 7 deletions
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 16a949c2a6..0b7c16f606 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1202,6 +1202,7 @@ sub parse_transformation { my($from, $to) = split(/\s*=>\s*/); my(@op); + my $rest_var; # The source instructions. @@ -1212,7 +1213,7 @@ sub parse_transformation { $_ = (&compile_transform_function($name, split(/\s*,\s*/, $arglist))); } else { (@op) = split; - $_ = &compile_transform(1, @op); + ($rest_var,$_) = compile_transform(1, $rest_var, @op); } } @@ -1230,7 +1231,7 @@ sub parse_transformation { @to = split(/\s*\|\s*/, $to); foreach (@to) { (@op) = split; - $_ = &compile_transform(0, @op); + (undef,$_) = compile_transform(0, $rest_var, @op); } } push(@transformations, [$., $orig, [@from], [reverse @to]]); @@ -1243,12 +1244,18 @@ sub compile_transform_function { } sub compile_transform { - my($src, $name, @ops) = @_; + my($src, $rest_var, $name, @ops) = @_; my $arity = 0; - + foreach (@ops) { my(@list) = &tr_parse_op($src, $_); - $arity++ unless $list[1] eq '*'; + if ($list[1] eq '*') { + $rest_var = $list[0]; + } elsif (defined $rest_var and $list[0] eq $rest_var) { + $list[1] = '*'; + } else { + $arity++; + } $_ = [ @list ]; } @@ -1260,7 +1267,7 @@ sub compile_transform { $is_transformed{$name,$arity} = 1; } - [$name,$arity,@ops]; + ($rest_var,[$name,$arity,@ops]); } sub tr_parse_op { @@ -1681,7 +1688,9 @@ sub tr_gen_to { foreach $op (@ops) { my($var, $type, $type_val) = @$op; - if ($var ne '') { + if ($type eq '*') { + push(@code, make_op($var, 'store_rest_args', $var{$var})); + } elsif ($var ne '') { &error($where, "variable '$var' unbound") unless defined $var{$var}; push(@code, &make_op($var, 'store_var_next_arg', $var{$var})); |