From 4bbaf12b7442abb8fa6dc0798f15e46c2a629e5c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 12 Sep 2017 02:40:50 +0200 Subject: beam_makeops: Refactor code generation The refactoring will simplify packing of combined instructions. --- erts/emulator/utils/beam_makeops | 171 ++++++++++++++++++++++++++------------- 1 file changed, 114 insertions(+), 57 deletions(-) (limited to 'erts/emulator/utils') diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index bb31db7eb5..ac2b140c2a 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; @@ -522,6 +525,37 @@ sub emulator_output { my $name; 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). # @@ -550,15 +584,10 @@ sub emulator_output { print "\n};\n"; 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,7 @@ sub combine_instruction_group { my $offset = 0; my @rest = @args; my @new_subs; - my $opcase = $specific; - $opcase .= "_" . join '', @args if @args; + my $opcase = print_name($specific, @args); foreach my $s (@subs) { my $code = $c_code{$s}; my(undef,undef,@c_args) = @{$code}; @@ -1117,7 +1136,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, 0, @first); $offsets{$s} = $offset unless defined $offsets{$s} and $offsets{$s} >= $offset; $offset += $size - 1; @@ -1186,7 +1205,6 @@ 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"; @@ -1204,14 +1222,19 @@ 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) = + cg_combined_code($s, 0, $flags, $offset, + $group_size-$offset-$dec, @first); $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; + } + ($group_hotness,"{\n$gcode\n}\n\n",@opcase_labels); } @@ -1223,12 +1246,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,7 +1295,7 @@ sub basic_generator { # my $c_code_ref = $c_code{$name}; - if ($hot and defined $c_code_ref and $name ne 'catch') { + if ($pack and defined $c_code_ref and $name ne 'catch') { ($var_decls, $pack_spec, @args) = do_pack(@args); } @@ -1569,7 +1622,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 +1697,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 +1714,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,7 +1747,6 @@ 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 = " . @@ -1731,7 +1777,7 @@ sub do_pack { $arg_num++; } - my $pack_spec = $down . $up; + my $pack_spec = "$down:$up"; return ($pack_prefix, $pack_spec, @args); } @@ -1744,6 +1790,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'; -- cgit v1.2.3 From 127b96806b732cb7c39d2e174c77a884de73626b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 12 Sep 2017 03:22:40 +0200 Subject: Pack combined instructions --- erts/emulator/utils/beam_makeops | 43 +++++++++++++++++++++++++++++++++------- 1 file changed, 36 insertions(+), 7 deletions(-) (limited to 'erts/emulator/utils') diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index ac2b140c2a..a9b2c8861c 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1128,7 +1128,9 @@ sub combine_instruction_group { my $offset = 0; my @rest = @args; my @new_subs; - my $opcase = print_name($specific, @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}; @@ -1136,7 +1138,7 @@ sub combine_instruction_group { foreach (0..$#c_args) { push @first, shift @rest; } - my $size = cg_combined_size($s, 0, @first); + my $size = cg_combined_size($s, 1, @first); $offsets{$s} = $offset unless defined $offsets{$s} and $offsets{$s} >= $offset; $offset += $size - 1; @@ -1145,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]; } @@ -1181,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]; @@ -1201,6 +1206,7 @@ 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"; @@ -1222,9 +1228,12 @@ sub combine_instruction_group { $transfer_to_next .= "goto $next;\n\n"; } - my($gen_code) = - cg_combined_code($s, 0, $flags, $offset, + 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; @@ -1235,6 +1244,26 @@ sub combine_instruction_group { $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); } @@ -1296,7 +1325,7 @@ sub code_gen { my $c_code_ref = $c_code{$name}; if ($pack and defined $c_code_ref and $name ne 'catch') { - ($var_decls, $pack_spec, @args) = do_pack(@args); + ($var_decls, $pack_spec, @args) = do_pack($offset, @args); } # @@ -1572,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. @@ -1750,7 +1779,7 @@ sub do_pack { 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; -- cgit v1.2.3