diff options
Diffstat (limited to 'erts/emulator/utils')
| -rwxr-xr-x | erts/emulator/utils/beam_makeops | 100 |
1 files changed, 82 insertions, 18 deletions
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index e55d3eadb5..bb31db7eb5 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -80,6 +80,7 @@ my %gen_opnum; my %num_specific; my %gen_to_spec; my %specific_op; +my %group_size; # Group size for specific operators. my %gen_arity; my @gen_arity; @@ -268,6 +269,16 @@ if ($wordsize == 64) { } # +# Add placeholders for built-in macros. +# + +$c_code{'IS_PACKED'} = ['$Expr',"built-in macro",('Expr')]; +$c_code{'ARG_POSITION'} = ['$Expr',"built-in macro",('Expr')]; +foreach my $name (keys %c_code) { + $c_code_used{$name} = 1; +} + +# # Parse the input files. # @@ -623,7 +634,11 @@ sub emulator_output { $sep = ","; } $init .= "}"; - init_item($print_name, $init, $involves_r, $size, $pack, $sign); + my $adj = 0; + if (defined $group_size{$print_name}) { + $adj = $size - $group_size{$print_name}; + } + init_item($print_name, $init, $involves_r, $size, $adj, $pack, $sign); $op_to_name[$spec_opnum] = $instr; $spec_opnum++; } @@ -703,9 +718,9 @@ sub emulator_output { print "#if !defined(ARCH_64)\n"; print qq[ #error "64-bit architecture assumed, but ARCH_64 not defined"\n]; print "#endif\n"; - print "#define BEAM_WIDE_MASK 0xFFFFFFFFUL\n"; - print "#define BEAM_LOOSE_MASK 0xFFFFUL\n"; - print "#define BEAM_TIGHT_MASK 0xFFFFUL\n"; + print "#define BEAM_WIDE_MASK 0xFFFFFFFFull\n"; + print "#define BEAM_LOOSE_MASK 0xFFFFull\n"; + print "#define BEAM_TIGHT_MASK 0xFFFFull\n"; print "#define BEAM_WIDE_SHIFT 32\n"; print "#define BEAM_LOOSE_SHIFT 16\n"; print "#define BEAM_TIGHT_SHIFT 16\n"; @@ -1171,6 +1186,7 @@ sub combine_instruction_group { if ($opcase ne '') { $gcode .= "OpCase($opcase):\n"; push @opcase_labels, $opcase; + $group_size{$opcase} = $group_size + 1; } if ($num_references{$label}) { $gcode .= "$label:\n"; @@ -1226,7 +1242,7 @@ sub basic_generator { # my $c_code_ref = $c_code{$name}; - if ($hot and defined $c_code_ref) { + if ($hot and defined $c_code_ref and $name ne 'catch') { ($var_decls, $pack_spec, @args) = do_pack(@args); } @@ -1382,14 +1398,8 @@ sub expand_all { my $keep = substr($code, 0, $-[0]); my $after = substr($code, $+[0]); - # Keep the special, pre-defined bindings. - my %new_bindings; - foreach my $key (qw(NEXT_INSTRUCTION)) { - $new_bindings{$key} = $bindings{$key}; - } - my $body; - ($body,$code) = expand_macro($macro_name, $after, \%new_bindings); + ($body,$code) = expand_macro($macro_name, $after, \%bindings); $res .= "$keep$body"; } @@ -1436,21 +1446,49 @@ sub expand_macro { $arg =~ s/^\s*//; } - # Now combine bindings from the parameter names and arguments. - my %bindings = %{$bindings_ref}; + # Make sure that the number of arguments are correct. if (@vars != @args) { error("calling $name with ", scalar(@args), " arguments instead of expected ", scalar(@vars), " arguments..."); } + + # Now combine bindings from the parameter names and arguments. + my %bindings = %{$bindings_ref}; + my %new_bindings; + + # Keep the special, pre-defined bindings. + foreach my $key (qw(NEXT_INSTRUCTION)) { + $new_bindings{$key} = $bindings{$key}; + } + for (my $i = 0; $i < @vars; $i++) { - $bindings{$vars[$i]} = $args[$i]; + my $arg = $args[$i]; + $arg = eval { expand_all($arg, \%bindings) }; + unless (defined $arg) { + warn $@; + die "... from the body of $name at $where\n"; + } + $new_bindings{$vars[$i]} = $arg; } - $body = eval { expand_all($body, \%bindings) }; + $body = eval { expand_all($body, \%new_bindings) }; unless (defined $body) { warn $@; die "... from the body of $name at $where\n"; } + + # Handle built-in macros. + if ($name eq 'ARG_POSITION') { + if ($body =~ /^I\[(\d+)\]$/) { + $body = $1; + } else { + $body = 0; + } + } elsif ($name eq 'IS_PACKED') { + $body = ($body =~ /^I\[\d+\]$/) ? 0 : 1; + } + + # Wrap body if needed and return resul.t $body = "do {\n$body\n} while (0)" if needs_do_wrapper($body); ($body,$rest); @@ -1476,6 +1514,7 @@ sub needs_do_wrapper { return 0 if /^[A-Z_]*SWAPOUT/; return 0 if /^if\s*[(]/; return 0 if /^goto\b/; + return 0 if /^\d+/; return 1; # Not sure, say that it is needed. } @@ -1511,6 +1550,23 @@ sub do_pack { } # + # Try to pack 'f' and 'j', but not at expense at worse packing + # for other operands. For example, given the arguments "f x x", we + # want the 'x' operands to be packed, not 'f' and 'x' packed and + # the final 'x' not packed. + # + + if ($wordsize == 64 and $packable_args == 1) { + for (my $i = 0; $i < @args; $i++) { + if ($args[$i] =~ /^[fj]$/) { + $bits_needed[$i] = 32; + $packable_args++; + last; + } + } + } + + # # Nothing to pack unless there are at least 2 packable arguments. # return ('', '', @args) if $packable_args < 2; @@ -1596,7 +1652,15 @@ sub do_pack { if ($arg_size{$arg} and $did_some_packing) { # Save the argument on the pack engine's stack. - $down = "g${down}"; + my $push = 'g'; + if ($type_bit{$arg} & $type_bit{'q'}) { + # The operand may be a literal. + $push = 'q'; + } elsif ($type_bit{$arg} & $type_bit{'f'}) { + # The operand may be a failure label. + $push = 'f'; + } + $down = "$push${down}"; $up = "${up}p"; } else { # The argument has either zero size (e.g. r(0)), @@ -1624,7 +1688,7 @@ sub do_pack { if ($need_wide_mask[$word]) { @shift = ('0', 'BEAM_WIDE_SHIFT'); @mask = ('BEAM_WIDE_MASK', $WHOLE_WORD); - @instr = ('w', 'i'); + @instr = ('w', 'w'); } else { @shift = @{$pack_shift[$args_per_word]}; @mask = @{$pack_mask[$args_per_word]}; |