aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator
diff options
context:
space:
mode:
authorBjörn Gustavsson <[email protected]>2017-09-15 10:24:18 +0200
committerBjörn Gustavsson <[email protected]>2017-09-15 10:24:18 +0200
commit5af84c3251bda6861d760c748935c85cba406f31 (patch)
treea7b7b822a4a69d030fa848fe639ea74247e2c53a /erts/emulator
parent482120c97dc5c0419b92b6a5621886908abfd837 (diff)
parent127b96806b732cb7c39d2e174c77a884de73626b (diff)
downloadotp-5af84c3251bda6861d760c748935c85cba406f31.tar.gz
otp-5af84c3251bda6861d760c748935c85cba406f31.tar.bz2
otp-5af84c3251bda6861d760c748935c85cba406f31.zip
Merge branch 'bjorn/erts/pack-combined'
* bjorn/erts/pack-combined: Pack combined instructions beam_makeops: Refactor code generation Correct disassembly of select instructions
Diffstat (limited to 'erts/emulator')
-rw-r--r--erts/emulator/beam/beam_debug.c15
-rwxr-xr-xerts/emulator/utils/beam_makeops206
2 files changed, 157 insertions, 64 deletions
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index 4e91bfffe8..7819e9907d 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -629,13 +629,20 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
unpacked = ap;
ap = addr + size;
+
+ /*
+ * In the code below, never use ap[-1], ap[-2], ...
+ * (will not work if the arguments have been packed).
+ *
+ * Instead use unpacked[-1], unpacked[-2], ...
+ */
switch (op) {
case op_i_select_val_lins_xfI:
case op_i_select_val_lins_yfI:
case op_i_select_val_bins_xfI:
case op_i_select_val_bins_yfI:
{
- int n = ap[-1];
+ int n = unpacked[-1];
int ix = n;
Sint32* jump_tab = (Sint32 *)(ap + n);
@@ -656,7 +663,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
case op_i_select_tuple_arity_xfI:
case op_i_select_tuple_arity_yfI:
{
- int n = ap[-1];
+ int n = unpacked[-1];
int ix = n - 1; /* without sentinel */
Sint32* jump_tab = (Sint32 *)(ap + n);
@@ -698,7 +705,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
case op_i_jump_on_val_xfIW:
case op_i_jump_on_val_yfIW:
{
- int n = ap[-2];
+ int n = unpacked[-2];
Sint32* jump_tab = (Sint32 *) ap;
size += (n+1) / 2;
@@ -712,7 +719,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
case op_i_jump_on_val_zero_xfI:
case op_i_jump_on_val_zero_yfI:
{
- int n = ap[-1];
+ int n = unpacked[-1];
Sint32* jump_tab = (Sint32 *) ap;
size += (n+1) / 2;
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index bb31db7eb5..a9b2c8861c 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -80,7 +80,10 @@ my %gen_opnum;
my %num_specific;
my %gen_to_spec;
my %specific_op;
-my %group_size; # Group size for specific operators.
+
+# Information about each specific operator. Key is the print name (e.g. get_list_xxy).
+# Value is a hash.
+my %spec_op_info;
my %gen_arity;
my @gen_arity;
@@ -523,6 +526,37 @@ sub emulator_output {
my $key; # Loop variable.
#
+ # Generate code and meta information for all instructions.
+ #
+ foreach $key (keys %specific_op) {
+ foreach (@{$specific_op{$key}}) {
+ my($name, $hotness, @args) = @$_;
+ my $sign = join('', @args);
+ my $print_name = print_name($name, @args);
+
+ my($size, $code, $pack_spec) = cg_basic($name, @args);
+ if (defined $code) {
+ $code = "OpCase($print_name):\n$code";
+ push @generated_code, [$hotness,$code,($print_name)];
+ }
+
+ # Note: Some of the information below will be modified
+ # for combined instructions.
+ my %info = ('size' => $size,
+ 'pack_spec' => $pack_spec,
+ 'adj' => 0,
+ 'args' => \@args);
+ $spec_op_info{$print_name} = \%info;
+ }
+ }
+
+ #
+ # Combine micro instruction into instruction blocks and generate
+ # code for them.
+ #
+ combine_micro_instructions();
+
+ #
# Information about opcodes (beam_opcodes.c).
#
$name = "$outdir/beam_opcodes.c";
@@ -551,14 +585,9 @@ sub emulator_output {
print "\n";
#
- # Combine micro instruction into instruction blocks.
- #
- combine_micro_instructions();
-
- #
# Generate code for specific ops.
#
- my($spec_opnum) = 0;
+ my $spec_opnum = 0;
print "const OpEntry opc[] = {\n";
foreach $key (sort keys %specific_op) {
$gen_to_spec{$key} = $spec_opnum;
@@ -576,35 +605,21 @@ sub emulator_output {
# The primitive types should sort before other types.
- my($sort_key) = $sign;
+ my $sort_key = $sign;
eval "\$sort_key =~ tr/$genop_types/./";
$sort_key .= ":$sign";
- $items{$sort_key} = [$name, $hot, $sign, @args];
+ my $print_name = print_name($name, @args);
+ $items{$sort_key} = $print_name;
}
#
# Now call the generator for the sorted result.
#
- foreach (sort keys %items) {
- my($name, $hot, $sign, @args) = @{$items{$_}};
+ foreach my $sort_key (sort keys %items) {
+ my $print_name = $items{$sort_key};
+ my $info = $spec_op_info{$print_name};
+ my(@args) = @{$info->{'args'}};
my $arity = @args;
- my($instr) = "${name}_$sign";
- $instr =~ s/_$//;
-
- #
- # Call a generator to calculate size and generate macros
- # for the emulator.
- #
- my($size, $code, $pack) =
- basic_generator($name, 1, '', 0, undef, @args);
-
- #
- # Save the generated $code for later.
- #
- if (defined $code) {
- $code = "OpCase($instr):\n$code";
- push @generated_code, [$hot,$code,($instr)];
- }
#
# Calculate the bit mask which should be used to match this
@@ -626,7 +641,6 @@ sub emulator_output {
}
printf "/* %3d */ ", $spec_opnum;
- my $print_name = $sign ne '' ? "${name}_$sign" : $name;
my $init = "{";
my $sep = "";
foreach (@bits) {
@@ -634,12 +648,12 @@ sub emulator_output {
$sep = ",";
}
$init .= "}";
- 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;
+ my $adj = $info->{'adj'};
+ my $size = $info->{'size'};
+ my $pack_spec = $info->{'pack_spec'};
+ my $sign = join '', @args;
+ init_item($print_name, $init, $involves_r, $size, $adj, $pack_spec, $sign);
+ $op_to_name[$spec_opnum] = $print_name;
$spec_opnum++;
}
}
@@ -835,6 +849,12 @@ sub emulator_output {
print_code(COLD);
}
+sub print_name {
+ my($name,@args) = @_;
+ my $sign = join '', @args;
+ $sign ne '' ? "${name}_$sign" : $name;
+}
+
sub init_item {
my($sep) = "";
@@ -1108,8 +1128,9 @@ sub combine_instruction_group {
my $offset = 0;
my @rest = @args;
my @new_subs;
- my $opcase = $specific;
- $opcase .= "_" . join '', @args if @args;
+ my $print_name = print_name($specific, @args);
+ my $opcase = $print_name;
+ my $last = $subs[$#subs];
foreach my $s (@subs) {
my $code = $c_code{$s};
my(undef,undef,@c_args) = @{$code};
@@ -1117,7 +1138,7 @@ sub combine_instruction_group {
foreach (0..$#c_args) {
push @first, shift @rest;
}
- my($size,undef) = basic_generator($s, 0, '', 0, undef, @first);
+ my $size = cg_combined_size($s, 1, @first);
$offsets{$s} = $offset
unless defined $offsets{$s} and $offsets{$s} >= $offset;
$offset += $size - 1;
@@ -1126,6 +1147,7 @@ sub combine_instruction_group {
push @new_subs, [$opcase,$label,$s,$size-1,@first];
$opcase = '';
}
+ $spec_op_info{$print_name}->{'size'} = $offset + 1;
$group_size = $offset if $group_size < $offset;
push @instrs, [$specific_key,@new_subs];
}
@@ -1162,6 +1184,8 @@ sub combine_instruction_group {
# Now generate the code for the entire group.
my $offset = 0;
my @opcase_labels;
+ my %down;
+ my %up;
for(my $i = 0; $i < @slots; $i++) {
my $key = $slots[$i];
@@ -1182,11 +1206,11 @@ sub combine_instruction_group {
my $seen_key = "$label:$next:" . scalar(@first);
next if $opcase eq '' and $seen{$seen_key};
$seen{$seen_key} = 1;
+ $seen_key .= $opcase;
if ($opcase ne '') {
$gcode .= "OpCase($opcase):\n";
push @opcase_labels, $opcase;
- $group_size{$opcase} = $group_size + 1;
}
if ($num_references{$label}) {
$gcode .= "$label:\n";
@@ -1204,14 +1228,42 @@ sub combine_instruction_group {
$transfer_to_next .= "goto $next;\n\n";
}
- my(undef,$gen_code) =
- basic_generator($s, 0, $flags, $offset,
- $group_size-$offset-$dec, @first);
+ my($gen_code,$down,$up) =
+ cg_combined_code($s, 1, $flags, $offset,
+ $group_size-$offset-$dec, @first);
+ my $spec_label = "$opcase$label";
+ $down{$spec_label} = $down;
+ $up{$spec_label} = $up;
$gcode .= $gen_code . $transfer_to_next;
}
$offset = $order_to_offset{$slots[$i+1]} if $i < $#slots;
}
+ foreach my $print_name (@opcase_labels) {
+ my $info = $spec_op_info{$print_name};
+ $info->{'adj'} = $info->{'size'} - $group_size - 1;
+ }
+
+ #
+ # Assemble pack specifications for all instructions in the group.
+ #
+ foreach my $instr (@instrs) {
+ my(undef,@subs) = @{$instr};
+ my $down = '';
+ my $up = '';
+ for (my $i = 0; $i < @subs; $i++) {
+ my($opcase,$label) = @{$subs[$i]};
+ my $spec_label = "$opcase$label";
+ if (defined $down{$spec_label}) {
+ $down = $down{$spec_label} . $down;
+ $up = $up . $up{$spec_label};
+ }
+ }
+ my $print_name = $subs[0]->[0];
+ my $info = $spec_op_info{$print_name};
+ $info->{'pack_spec'} = build_pack_spec("$down:$up");
+ }
+
($group_hotness,"{\n$gcode\n}\n\n",@opcase_labels);
}
@@ -1223,12 +1275,42 @@ sub micro_label {
#
-# Basic implementation of instruction in emulator loop
-# (assuming no packing).
+# Basic code generation for one instruction.
#
-sub basic_generator {
- my($name,$hot,$extra_comments,$offset,$group_size,@args) = @_;
+sub cg_basic {
+ my($name,@args) = @_;
+ my($size,$code,$pack_spec) = code_gen($name, 1, '', 0, undef, @args);
+ $pack_spec = build_pack_spec($pack_spec);
+ ($size,$code,$pack_spec);
+}
+
+#
+# Calculate size for a micro instruction.
+#
+
+sub cg_combined_size {
+ my($name,$pack,@args) = @_;
+ my($size) = code_gen($name, $pack, '', 0, undef, @args);
+ $size;
+}
+
+#
+# Generate code for a micro instruction.
+#
+
+sub cg_combined_code {
+ my($size,$code,$pack_spec) = code_gen(@_);
+ if ($pack_spec eq '') {
+ ($code,'','');
+ } else {
+ my($down,$up) = split /:/, $pack_spec;
+ ($code,$down,$up);
+ }
+}
+
+sub code_gen {
+ my($name,$pack,$extra_comments,$offset,$group_size,@args) = @_;
my $size = 0;
my $flags = '';
my @f;
@@ -1242,8 +1324,8 @@ sub basic_generator {
#
my $c_code_ref = $c_code{$name};
- if ($hot and defined $c_code_ref and $name ne 'catch') {
- ($var_decls, $pack_spec, @args) = do_pack(@args);
+ if ($pack and defined $c_code_ref and $name ne 'catch') {
+ ($var_decls, $pack_spec, @args) = do_pack($offset, @args);
}
#
@@ -1519,7 +1601,7 @@ sub needs_do_wrapper {
}
sub do_pack {
- my(@args) = @_;
+ my($offset,@args) = @_;
my($packable_args) = 0;
my @bits_needed; # Bits needed for each argument.
@@ -1569,7 +1651,7 @@ sub do_pack {
#
# Nothing to pack unless there are at least 2 packable arguments.
#
- return ('', '', @args) if $packable_args < 2;
+ return ('', ':', @args) if $packable_args < 2;
#
# Determine how many arguments we should pack into each word.
@@ -1644,13 +1726,12 @@ sub do_pack {
# beginning).
my $up = ''; # Pack commands (storing back while
# moving forward).
- my $did_some_packing = 0; # Nothing packed yet.
# Skip an unpackable argument.
my $skip_unpackable = sub {
my($arg) = @_;
- if ($arg_size{$arg} and $did_some_packing) {
+ if ($arg_size{$arg}) {
# Save the argument on the pack engine's stack.
my $push = 'g';
if ($type_bit{$arg} & $type_bit{'q'}) {
@@ -1662,11 +1743,6 @@ sub do_pack {
}
$down = "$push${down}";
$up = "${up}p";
- } else {
- # The argument has either zero size (e.g. r(0)),
- # or is to the left of the first packed argument
- # and will never be accessed. No need to do
- # anything.
}
};
@@ -1700,11 +1776,10 @@ sub do_pack {
my $this_size = $arg_size{$reg};
if ($bits_needed[$arg_num]) {
$this_size = 0;
- $did_some_packing = 1;
if ($ap == 0) {
$pack_prefix .= "Eterm $packed_var = " .
- arg_offset($size) . ";\n";
+ arg_offset($size+$offset) . ";\n";
$up .= "p";
$down = "P$down";
$this_size = 1;
@@ -1731,7 +1806,7 @@ sub do_pack {
$arg_num++;
}
- my $pack_spec = $down . $up;
+ my $pack_spec = "$down:$up";
return ($pack_prefix, $pack_spec, @args);
}
@@ -1744,6 +1819,17 @@ sub make_unpack {
$e;
}
+sub build_pack_spec {
+ my $pack_spec = shift;
+ return '' if $pack_spec eq '';
+ my($down,$up) = split /:/, $pack_spec;
+ while ($down =~ /[gfq]$/ and $up =~ /^p/) {
+ $down = substr($down, 0, -1);
+ $up = substr($up, 1);
+ }
+ "$down$up";
+}
+
sub quote {
local($_) = @_;
return "'$_'" if $_ eq 'try';