Optimize packing for "optional use" operands

Operands that are marked with a "?" are not always used when
an instruction is executed. Enhance the packing algorithm to
place optional use operands into the instruction word even they
are not the first operand (as long as the total instruction
size stays the same).

Here are the instructions that will be packed differently
because of this change:

    allocate_heap t I t?
    allocate_heap_zero t I t?
    test_heap I t?

    i_bs_get_integer_8 x f? x
    i_bs_get_integer_16 x f? x
    i_bs_get_integer_32 x f? x

1 files changed, 52 insertions, 14 deletions

diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index a705ba27b7..9da62f18ac 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -27,6 +27,7 @@ use constant HOT => 2;
 # Instructions for packing
 use constant PACK_JUMP => 1;
 use constant PACK_IN_INSTR_WORD => 2;
+use constant PACK_OPT_IN_INSTR_WORD => 4;
 
 # Packing commands
 use constant PACK_CMD_TIGHTEST => '1';
@@ -1623,13 +1624,38 @@ sub needs_do_wrapper {
 }
 
 sub do_pack {
-    my($name,$offset,$pack_options,@args) = @_;
-    @args = map { s/[?]$//; $_ } @args;
+    my($name,$offset,$pack_opts_ref,@args) = @_;
+    my @pack_opts = @$pack_opts_ref;
+    my $opt_arg_pos = -1;
+
+    # Look for an optional use operand not as the first argument.
+    if (@args and $args[0] !~ /[?]$/) {
+        for (my $pos = 0; $pos < @args; $pos++) {
+            if ($args[$pos] =~ /[?]$/) {
+                $opt_arg_pos = $pos;
+                last;
+            }
+        }
+    }
+
+    @args = map { s/[?]$//; $_ } @args; # Remove any optional use marker.
+
+    # If there is an optional operand, extend the array of pack options.
+    if ($opt_arg_pos >= 0) {
+        my @new_pack_opts = grep { $_ & PACK_IN_INSTR_WORD } @pack_opts;
+        @new_pack_opts = map {
+            ($_ & ~ PACK_IN_INSTR_WORD) | PACK_OPT_IN_INSTR_WORD;
+        } @new_pack_opts;
+        push @pack_opts, @new_pack_opts;
+    }
+
     my $ret = ['', ':', @args];
     my $score = 0;
 
-    foreach my $options (@$pack_options) {
-        my($this_score,$this_result) = do_pack_one($name, $options, $offset, @args);
+    foreach my $options (@pack_opts) {
+        my $this_opt_arg_pos = ($options & PACK_OPT_IN_INSTR_WORD) ? $opt_arg_pos : -1;
+        my($this_score,$this_result) =
+            do_pack_one($name, $options, $this_opt_arg_pos, $offset, @args);
         if ($this_score > $score) {
             $ret = $this_result;
             $score = $this_score;
@@ -1639,7 +1665,7 @@ sub do_pack {
 }
 
 sub do_pack_one {
-    my($name,$options,$offset,@args) = @_;
+    my($name,$options,$opt_arg_pos,$offset,@args) = @_;
     my($packable_args) = 0;
     my @bits_needed;            # Bits needed for each argument.
     my $pack_in_iw = $options & PACK_IN_INSTR_WORD;
@@ -1684,7 +1710,7 @@ sub do_pack_one {
     #
     if ($packable_args == 0) {
         return (-1);
-    } elsif ($packable_args == 1 and !$pack_in_iw) {
+    } elsif ($packable_args == 1 and $options == 0) {
         return (-1);
     }
 
@@ -1707,9 +1733,11 @@ sub do_pack_one {
 
     $next_word->();
     $this_wordsize = 32 if $pack_in_iw;
-    for (my $i = 0; $i < @args; $i++) {
-            my $needed = $bits_needed[$i];
+    for (my $arg_num = 0; $arg_num < @args; $arg_num++) {
+            my $needed = $bits_needed[$arg_num];
+
             next unless $needed;
+            next if $arg_num == $opt_arg_pos;
 
             if ($bits+$needed > $this_wordsize) { # Does not fit.
                 $next_word->();
@@ -1765,12 +1793,19 @@ sub do_pack_one {
 				# beginning).
     my $up = '';		# Pack commands (storing back while
 				# moving forward).
+    my $arg_num = 0;            # Number of argument.
 
-    # Skip an unpackable argument.
+    # Skip an unpackable argument. Also handle packing of
+    # an single operand into the instruction word.
     my $skip_unpackable = sub {
         my($arg) = @_;
 
-        if ($arg_size{$arg}) {
+        if ($arg_num == $opt_arg_pos) {
+            my $pack = chr(ord('#') + $arg_num);
+            $down = PACK_CMD_WIDE . "$pack$down";
+            my $unpack = "BeamExtraData(I[0])";
+            $args[$arg_num] = "packed:$arg:0:${arg}b($unpack)";
+        } elsif ($arg_size{$arg}) {
             # Save the argument on the pack engine's stack.
             my $push = 'g';
             if ($type_bit{$arg} & $type_bit{'q'}) {
@@ -1790,7 +1825,6 @@ sub do_pack_one {
     # the packing engine works from right-to-left, but we must generate
     # the instructions from left-to-right because we must calculate
     # instruction sizes from left-to-right.
-    my $arg_num = 0;
     for (my $word = 0; $word < @args_per_word; $word++) {
         my $ap = 0;              # Argument number within word.
         my $packed_var = "tmp_packed" . ($word+1);
@@ -1849,7 +1883,9 @@ sub do_pack_one {
     # Skip any unpackable arguments at the end.
     #
     while ($arg_num < @args) {
-        $skip_unpackable->($args[$arg_num]);
+        my $arg = $args[$arg_num];
+        $skip_unpackable->($arg);
+        $size += $arg_size{$arg};
         $arg_num++;
     }
 
@@ -1935,8 +1971,10 @@ sub pack_score {
 
     # Less numbers of words give a higher score; for the same number of
     # words, using PACK_JUMP or PACK_IN_INSTR_WORD gives a lower score.
-    my $score = 1 + $max_spec_operands*($max_spec_operands - $size);
-    if ($options == PACK_IN_INSTR_WORD) {
+    my $score = 1 + 10*($max_spec_operands - $size);
+    if (($options & PACK_OPT_IN_INSTR_WORD) != 0) {
+        $score += 4;
+    } elsif ($options == PACK_IN_INSTR_WORD) {
         $score += 0;
     } elsif ($options == PACK_JUMP) {
         $score += 1;