aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/utils
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator/utils')
-rwxr-xr-xerts/emulator/utils/beam_makeops45
1 files changed, 38 insertions, 7 deletions
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index 8e34e07035..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;
@@ -633,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++;
}
@@ -713,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";
@@ -1181,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";
@@ -1236,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);
}
@@ -1544,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;
@@ -1629,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)),
@@ -1657,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]};