aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/utils
diff options
context:
space:
mode:
authorBjörn Gustavsson <[email protected]>2012-05-23 16:08:59 +0200
committerBjörn-Egil Dahlberg <[email protected]>2014-01-28 15:56:24 +0100
commit331bb6cab54e6697e12cc9c5a4ca0ae618c37dd3 (patch)
tree674772a9bc325fc962d3e16c914356e5c06e5fd2 /erts/emulator/utils
parent3c112fbde20a21db0cafc140aa72346f60315b90 (diff)
downloadotp-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')
-rwxr-xr-xerts/emulator/utils/beam_makeops23
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}));