diff options
Diffstat (limited to 'erts/emulator')
| -rw-r--r-- | erts/emulator/beam/beam_load.c | 1 | ||||
| -rw-r--r-- | erts/emulator/beam/ops.tab | 2 | ||||
| -rwxr-xr-x | erts/emulator/utils/beam_makeops | 43 |
3 files changed, 37 insertions, 9 deletions
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 16dd5795c7..4da411be1f 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -4238,7 +4238,6 @@ transform_engine(LoaderState* st) ASSERT(restart != NULL); pc = restart; ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ - ASSERT(*pc == TOP_try_me_else || *pc == TOP_fail); instr = st->genop; #define RETURN(r) rval = (r); goto do_return; diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index dcfd9063d9..08d2e35fbb 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -595,8 +595,6 @@ get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst | original_reg Reg original_reg Reg Pos => -get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst - original_reg/2 extract_next_element D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \ diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index ec3d6c067d..7b66496856 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1395,18 +1395,24 @@ sub tr_gen_from { my($op, $ref); # Loop variables. my $where = "left side of transformation in line $line: "; my %var_used = %$used_ref; + my $may_fail = 0; + my $is_first = 1; foreach $ref (@tr) { my($name, $arity, @ops) = @$ref; my($key) = "$name/$arity"; my($opnum); + $may_fail = 1 unless $is_first; + $is_first = 0; + # # A name starting with a period is a C pred function to be called. # if ($name =~ /^\.(\w+)/) { $name = $1; + $may_fail = 1; my $var; my(@args); @@ -1432,6 +1438,8 @@ sub tr_gen_from { my $ignored_var = "$var (ignored)"; if ($type ne '' && $type ne '*') { + $may_fail = 1; + # # The is_bif, is_not_bif, and is_func instructions have # their own built-in type test and don't need to @@ -1460,16 +1468,19 @@ sub tr_gen_from { if ($cond eq 'is_func') { my($m, $f, $a) = split(/:/, $val); $ignored_var = ''; + $may_fail = 1; push(@code, &make_op('', "$cond", "am_$m", "am_$f", $a)); } elsif ($cond ne '') { $ignored_var = ''; + $may_fail = 1; push(@code, &make_op('', "$cond", $val)); } if ($var ne '') { if (defined $var{$var}) { $ignored_var = ''; + $may_fail = 1; push(@code, &make_op($var, 'is_same_var', $var{$var})); } elsif ($type eq '*') { # @@ -1504,7 +1515,8 @@ sub tr_gen_from { # Insert the commit operation. # pop(@code); # Get rid of 'next_instr' - push(@code, &make_op('', 'commit')); + + push(@code, make_op($may_fail ? '' : 'always reached', 'commit')); # # If there is an rest_args instruction, we must insert its correct @@ -1553,6 +1565,10 @@ sub tr_gen_to { my($op, $ref); # Loop variables. my($where) = "right side of transformation in line $line: "; + my $last_instr = $code[$#code]; + my $cannot_fail = is_instr($last_instr, 'commit') && + (get_comment($last_instr) =~ /^always/); + foreach $ref (@tr) { my($name, $arity, @ops) = @$ref; @@ -1625,12 +1641,20 @@ sub tr_gen_to { $min_window{$key} = $min_window if $min_window{$key} > $min_window; - pop(@{$gen_transform{$key}}) + my $prev_last; + $prev_last = pop(@{$gen_transform{$key}}) if defined @{$gen_transform{$key}}; # Fail - my(@prefix) = (&make_op($comment), &make_op('', 'try_me_else', &tr_code_len(@code))); - unshift(@code, @prefix); - push(@{$gen_transform{$key}}, - @code, make_op(""), make_op("$key", 'fail')); + + if ($prev_last && !is_instr($prev_last, 'fail')) { + error("Line $line: A previous transformation shadows '$orig_transform'"); + } + unless ($cannot_fail) { + unshift(@code, make_op('', 'try_me_else', + tr_code_len(@code))); + push(@code, make_op(""), make_op("$key", 'fail')); + } + unshift(@code, make_op($comment)); + push(@{$gen_transform{$key}}, @code), } sub tr_code_len { @@ -1654,6 +1678,13 @@ sub is_instr { $ref->[1][0] eq $op; } +sub get_comment { + my($ref,$op) = @_; + return '' unless ref($ref) eq 'ARRAY'; + $ref->[2]; +} + + sub tr_gen_call { my(@call_table) = @_; my($i); |