Pack operands into the instruction word

On 64-bit machines where the C code is always at address below 4Gb,
pack one or more operands into the instruction word.

5 files changed, 283 insertions, 110 deletions

diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 85ca145d9f..54d45dce50 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -569,6 +569,7 @@ $(TTF_DIR)/beam_tr_funcs.h \
 $(TTF_DIR)/OPCODES-GENERATED: $(OPCODE_TABLES) utils/beam_makeops
 	$(gen_verbose)LANG=C $(PERL) utils/beam_makeops \
 		-wordsize @EXTERNAL_WORD_SIZE@ \
+		-code-model @CODE_MODEL@ \
 		-outdir $(TTF_DIR) \
 		-DUSE_VM_PROBES=$(if $(USE_VM_PROBES),1,0) \
 		-DNO_FPE_SIGNALS=$(if $filter(unreliable,$(FPE)),1,0) \
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index d8303a651a..70078c8c59 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -201,7 +201,7 @@ void debug_dump_code(BeamInstr *I, int num)
 	for (i = 0; i < NUM_SPECIFIC_OPS; i++) {
 	    if (BeamIsOpCode(instr, i) && opc[i].name[0] != '\0') {
 		code_ptr += print_op(ERTS_PRINT_DSBUF, (void *) dsbufp,
-				     i, opc[i].sz-1, code_ptr+1) + 1;
+				     i, opc[i].sz-1, code_ptr) + 1;
 		break;
 	    }
 	}
@@ -321,7 +321,7 @@ erts_debug_disassemble_1(BIF_ALIST_1)
     for (i = 0; i < NUM_SPECIFIC_OPS; i++) {
 	if (BeamIsOpCode(instr, i) && opc[i].name[0] != '\0') {
 	    code_ptr += print_op(ERTS_PRINT_DSBUF, (void *) dsbufp,
-				 i, opc[i].sz-1, code_ptr+1) + 1;
+				 i, opc[i].sz-1, code_ptr) + 1;
 	    break;
 	}
     }
@@ -405,8 +405,11 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
 	 * Avoid copying because instructions containing bignum operands
 	 * are bigger than actually declared.
 	 */
-	ap = (BeamInstr *) addr;
+        addr++;
+        ap = addr;
     } else {
+        BeamInstr instr_word = addr++[0];
+
 	/*
 	 * Copy all arguments to a local buffer for the unpacking.
 	 */
@@ -431,23 +434,22 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
 	    case 'q':
 		*ap++ = *--sp;
 		break;
-	    case 'i':		/* Initialize packing accumulator. */
-		*ap++ = packed;
-		break;
-	    case 's':
-		*ap++ = packed & 0x3ff;
-		packed >>= 10;
+#ifdef ARCH_64
+	    case '1':		/* Tightest shift */
+		*ap++ = (packed & BEAM_TIGHTEST_MASK) << 3;
+		packed >>= BEAM_TIGHTEST_SHIFT;
 		break;
-	    case '0':		/* Tight shift */
+#endif
+	    case '2':		/* Tight shift */
 		*ap++ = packed & BEAM_TIGHT_MASK;
 		packed >>= BEAM_TIGHT_SHIFT;
 		break;
-	    case '6':		/* Shift 16 steps */
+	    case '3':		/* Loose shift */
 		*ap++ = packed & BEAM_LOOSE_MASK;
 		packed >>= BEAM_LOOSE_SHIFT;
 		break;
 #ifdef ARCH_64
-	    case 'w':		/* Shift 32 steps */
+	    case '4':		/* Shift 32 steps */
 		*ap++ = packed & BEAM_WIDE_MASK;
 		packed >>= BEAM_WIDE_SHIFT;
 		break;
@@ -458,8 +460,18 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
 	    case 'P':
 		packed = *--sp;
 		break;
+#if defined(ARCH_64) && defined(CODE_MODEL_SMALL)
+            case '#':       /* -1 */
+            case '$':       /* -2 */
+            case '%':       /* -3 */
+            case '&':       /* -4 */
+            case '\'':      /* -5 */
+            case '(':       /* -6 */
+                packed = (packed << BEAM_WIDE_SHIFT) | BeamExtraData(instr_word);
+		break;
+#endif
 	    default:
-		ASSERT(0);
+                erts_exit(ERTS_ERROR_EXIT, "beam_debug: invalid packing op: %c\n", *prog);
 	    }
 	}
 	ap = args;
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 6a45087a34..73c4e3532b 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -234,15 +234,18 @@ void** beam_ops;
 #define fb(N) ((Sint)(Sint32)(N))
 #define jb(N) ((Sint)(Sint32)(N))
 #define tb(N) (N)
-#define xb(N) (*(Eterm *) (((unsigned char *)reg) + (N)))
-#define yb(N) (*(Eterm *) (((unsigned char *)E) + (N)))
+#define xb(N) (*ADD_BYTE_OFFSET(reg, N))
+#define yb(N) (*ADD_BYTE_OFFSET(E, N))
 #define Sb(N) (*REG_TARGET_PTR(N))
 #define lb(N) (*(double *) (((unsigned char *)&(freg[0].fd)) + (N)))
 #define Qb(N) (N)
 #define Ib(N) (N)
+
 #define x(N) reg[N]
 #define y(N) E[N]
 #define r(N) x(N)
+#define Q(N) (N*sizeof(Eterm *))
+#define l(N) (freg[N].fd)
 
 /*
  * Check that we haven't used the reductions and jump to function pointed to by
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 9835b1c096..00dd28b26c 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -2578,23 +2578,31 @@ load_code(LoaderState* stp)
                         sp++;
                     }
                     break;
-		case 'i':	/* Initialize packing accumulator. */
-		    packed = code[--ci];
+#ifdef ARCH_64
+		case '1':	/* Tightest shift (always 10 bits) */
+                    ci--;
+                    ASSERT((code[ci] & ~0x1FF8ull) == 0); /* Fits in 10 bits */
+                    packed = (packed << BEAM_TIGHTEST_SHIFT);
+                    packed |= code[ci] >> 3;
+                    if (packed_label) {
+                        packed_label->packed++;
+                    }
 		    break;
-		case '0':	/* Tight shift */
+#endif
+		case '2':	/* Tight shift (10 or 16 bits) */
 		    packed = (packed << BEAM_TIGHT_SHIFT) | code[--ci];
                     if (packed_label) {
                         packed_label->packed++;
                     }
 		    break;
-		case '6':	/* Shift 16 steps */
+		case '3':	/* Loose shift (16 bits) */
 		    packed = (packed << BEAM_LOOSE_SHIFT) | code[--ci];
                     if (packed_label) {
                         packed_label->packed++;
                     }
 		    break;
 #ifdef ARCH_64
-		case 'w':	/* Shift 32 steps */
+		case '4':	/* Wide shift (32 bits) */
                     {
                         Uint w = code[--ci];
 
@@ -2646,8 +2654,31 @@ load_code(LoaderState* stp)
                     sp++;
 		    packed = 0;
 		    break;
+#if defined(ARCH_64) && defined(CODE_MODEL_SMALL)
+                case '#':       /* -1 */
+                case '$':       /* -2 */
+                case '%':       /* -3 */
+                case '&':       /* -4 */
+                case '\'':      /* -5 */
+                case '(':       /* -6 */
+                    /* Pack accumulator contents into instruction word. */
+                    {
+                        Sint pos = ci - (*prog - '#' + 1);
+                        /* Are the high 32 bits of the instruction word zero? */
+                        ASSERT((code[pos] & ~((1ull << BEAM_WIDE_SHIFT)-1)) == 0);
+                        code[pos] |= packed << BEAM_WIDE_SHIFT;
+                        if (packed_label) {
+                            ASSERT(packed_label->packed == 1);
+                            packed_label->pos = pos;
+                            packed_label->packed = 2;
+                            packed_label = 0;
+                        }
+                        packed >>= BEAM_WIDE_SHIFT;
+                    }
+		    break;
+#endif
 		default:
-		    ASSERT(0);
+                    erts_exit(ERTS_ERROR_EXIT, "beam_load: invalid packing op: %c\n", *prog);
 		}
 	    }
 	    ASSERT(sp == stack); /* Incorrect program? */
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index 64a9a49ac8..388e3d164d 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -24,6 +24,16 @@ use constant COLD => 0;
 use constant WARM => 1;
 use constant HOT => 2;
 
+# Instructions for packing
+use constant PACK_JUMP => 1;
+use constant PACK_IN_INSTR_WORD => 2;
+
+# Packing commands
+use constant PACK_CMD_TIGHTEST => '1';
+use constant PACK_CMD_TIGHT => '2';
+use constant PACK_CMD_LOOSE => '3';
+use constant PACK_CMD_WIDE => '4';
+
 $BEAM_FORMAT_NUMBER = undef;
 
 my $target = \&emulator_output;
@@ -32,30 +42,15 @@ my $verbose = 0;
 my $hotness = 1;
 my $num_file_opcodes = 0;
 my $wordsize = 32;
-my %defs;			# Defines (from command line).
+my $code_pointers_are_short = 0; # Whether code pointers (to C code) are short.
+my $code_model = 'unknown';
+my %defs;                        # Defines (from command line).
 
 # This is shift counts and mask for the packer.
 my $WHOLE_WORD = '';
-my @pack_instr;
-my @pack_shift;
-my @pack_mask;
-
-$pack_instr[2] = ['6', 'i'];
-$pack_instr[3] = ['0', '0', 'i'];
-$pack_instr[4] = ['6', '6', '6', 'i']; # Only for 64 bit wordsize
-
-$pack_shift[2] = ['0', 'BEAM_LOOSE_SHIFT'];
-$pack_shift[3] = ['0', 'BEAM_TIGHT_SHIFT', '(2*BEAM_TIGHT_SHIFT)'];
-$pack_shift[4] = ['0', 'BEAM_LOOSE_SHIFT', # Only for 64 bit wordsize
-		  '(2*BEAM_LOOSE_SHIFT)',
-		  '(3*BEAM_LOOSE_SHIFT)'];
-
-$pack_mask[2]  = ['BEAM_LOOSE_MASK', $WHOLE_WORD];
-$pack_mask[3]  = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK'];
-$pack_mask[4]  = ['BEAM_LOOSE_MASK', # Only for 64 bit wordsize
-		  'BEAM_LOOSE_MASK',
-		  'BEAM_LOOSE_MASK',
-		  $WHOLE_WORD];
+
+my @basic_pack_options = (0);
+my @extended_pack_options = @basic_pack_options;
 
 # There are two types of instructions: generic and specific.
 # The generic instructions are those generated by the Beam compiler.
@@ -250,6 +245,7 @@ while (@ARGV && $ARGV[0] =~ /^-(.*)/) {
     ($target = \&compiler_output), next if /^compiler/;
     ($outdir = shift), next if /^outdir/;
     ($wordsize = shift), next if /^wordsize/;
+    ($code_model = shift), next if /^code-model/;
     ($verbose = 1), next if /^v/;
     ($defs{$1} = $2), next if /^D(\w+)=(\w+)/;
     die "$0: Bad option: -$_\n";
@@ -261,14 +257,21 @@ if ($wordsize == 32) {
 } elsif ($wordsize == 64) {
     $defs{'ARCH_32'} = 0;
     $defs{'ARCH_64'} = 1;
+    $code_pointers_are_short = $code_model eq 'small';
 }
 
 #
-# Initialize number of arguments per packed word.
+# Initialize pack options.
 #
 
 if ($wordsize == 64) {
-    $pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD];
+    @basic_pack_options = (0,PACK_JUMP);
+    @extended_pack_options = @basic_pack_options;
+    if ($code_pointers_are_short) {
+        foreach (@basic_pack_options) {
+            push @extended_pack_options, $_ | PACK_IN_INSTR_WORD;
+        }
+    }
 }
 
 #
@@ -732,12 +735,19 @@ 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";
+        if ($code_pointers_are_short) {
+            print "#if !defined(CODE_MODEL_SMALL)\n";
+            print qq[  #error "small code model assumed, but CODE_MODEL_SMALL not defined"\n];
+            print "#endif\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_TIGHTEST_MASK 0x3FFull\n";
 	print "#define BEAM_WIDE_SHIFT 32\n";
 	print "#define BEAM_LOOSE_SHIFT 16\n";
 	print "#define BEAM_TIGHT_SHIFT 16\n";
+	print "#define BEAM_TIGHTEST_SHIFT 10\n";
     }
     print "\n";
 
@@ -1138,7 +1148,7 @@ sub combine_instruction_group {
                 foreach (0..$#c_args) {
                     push @first, shift @rest;
                 }
-                my $size = cg_combined_size($s, 1, @first);
+                my $size = cg_combined_size($s, @first);
                 $offsets{$s} = $offset
                     unless defined $offsets{$s} and $offsets{$s} < $offset;
                 $offset += $size - 1;
@@ -1229,7 +1239,7 @@ sub combine_instruction_group {
             }
 
             my($gen_code,$down,$up) =
-                cg_combined_code($s, 1, $flags, $offset,
+                cg_combined_code($s, $flags, $offset,
                                  $group_size-$offset, $inc, @first);
             my $spec_label = "$opcase$label";
             $down{$spec_label} = $down;
@@ -1280,7 +1290,7 @@ sub micro_label {
 
 sub cg_basic {
     my($name,@args) = @_;
-    my($size,$code,$pack_spec) = code_gen($name, 1, '', 0, undef, undef, @args);
+    my($size,$code,$pack_spec) = code_gen($name, \@extended_pack_options, '', 0, undef, undef, @args);
     $pack_spec = build_pack_spec($pack_spec);
     ($size,$code,$pack_spec);
 }
@@ -1290,8 +1300,8 @@ sub cg_basic {
 #
 
 sub cg_combined_size {
-    my($name,$pack,@args) = @_;
-    my($size) = code_gen($name, $pack, '', 0, undef, undef, @args);
+    my($name,@args) = @_;
+    my($size) = code_gen($name, \@basic_pack_options, '', 0, undef, undef, @args);
     $size;
 }
 
@@ -1300,8 +1310,9 @@ sub cg_combined_size {
 #
 
 sub cg_combined_code {
-    my($name,$pack,$extra_comments,$offset,$comp_size,$inc,@args) = @_;
-    my($size,$code,$pack_spec) = code_gen(@_);
+    my($name,$extra,$offset,$comp_size,$inc,@args) = @_;
+    my($size,$code,$pack_spec) =
+        code_gen($name, \@basic_pack_options, $extra, $offset, $comp_size, $inc, @args);
     if ($pack_spec eq '') {
         ($code,'','');
     } else {
@@ -1311,7 +1322,7 @@ sub cg_combined_code {
 }
 
 sub code_gen {
-    my($name,$pack,$extra_comments,$offset,$comp_size,$inc,@args) = @_;
+    my($name,$pack_options,$extra_comments,$offset,$comp_size,$inc,@args) = @_;
     my $group_size = defined $comp_size ? $comp_size + $inc : undef;
     my $size = 0;
     my $flags = '';
@@ -1326,8 +1337,8 @@ 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($offset, @args);
+    if (defined $c_code_ref and $name ne 'catch') {
+        ($var_decls, $pack_spec, @args) = do_pack($offset, $pack_options, @args);
     }
 
     #
@@ -1603,9 +1614,25 @@ sub needs_do_wrapper {
 }
 
 sub do_pack {
-    my($offset,@args) = @_;
+    my($offset,$pack_options,@args) = @_;
+    my $ret = ['', ':', @args];
+    my $score = 0;
+
+    foreach my $options (@$pack_options) {
+        my($this_score,$this_result) = do_pack_one($options, $offset, @args);
+        if ($this_score > $score) {
+            $ret = $this_result;
+            $score = $this_score;
+        }
+    }
+    return @$ret;
+}
+
+sub do_pack_one {
+    my($options,$offset,@args) = @_;
     my($packable_args) = 0;
     my @bits_needed;            # Bits needed for each argument.
+    my $pack_in_iw = $options & PACK_IN_INSTR_WORD;
 
     #
     # Define the minimum number of bits needed for the packable argument types.
@@ -1619,6 +1646,10 @@ sub do_pack {
                        't' => 16);
     if ($wordsize == 64) {
         $bits_needed{'I'} = 32;
+        if ($options & PACK_JUMP) {
+            $bits_needed{'f'} = 32;
+            $bits_needed{'j'} = 32;
+        }
     }
 
     #
@@ -1631,51 +1662,46 @@ sub do_pack {
 	} else {
 	    push @bits_needed, 0;
 	}
-    }
-
-    #
-    # 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;
-            }
+        if ($arg =~ /^[fj]$/) {
+            # Only pack the first occurrence of 'f' or 'j'.
+            delete $bits_needed{'f'};
+            delete $bits_needed{'j'};
         }
     }
 
     #
-    # Nothing to pack unless there are at least 2 packable arguments.
+    # Return if there is nothing to pack.
     #
-    return ('', ':', @args) if $packable_args < 2;
+    if ($packable_args == 0) {
+        return (-1);
+    } elsif ($packable_args == 1 and !$pack_in_iw) {
+        return (-1);
+    }
 
     #
     # Determine how many arguments we should pack into each word.
     #
     my @args_per_word;
     my @need_wide_mask;
-    my $bits = 0;
-    my $word = 0;
-    $args_per_word[0] = 0;
-    $need_wide_mask[0] = 0;
+    my $bits;
+    my $this_wordsize;
+    my $word = -1;
+
+    my $next_word = sub {
+        $word++;
+        $args_per_word[$word] = 0;
+        $need_wide_mask[$word] = 0;
+        $bits = 0;
+        $this_wordsize = $wordsize;
+    };
+
+    $next_word->();
+    $this_wordsize = 32 if $pack_in_iw;
     for (my $i = 0; $i < @args; $i++) {
-        if ($bits_needed[$i]) {
             my $needed = $bits_needed[$i];
+            next unless $needed;
 
-            my $next_word = sub {
-                $word++;
-                $args_per_word[$word] = 0;
-                $need_wide_mask[$word] = 0;
-                $bits = 0;
-            };
-
-            if ($bits+$needed > $wordsize) { # Does not fit.
+            if ($bits+$needed > $this_wordsize) { # Does not fit.
                 $next_word->();
             }
             if ($args_per_word[$word] == 4) { # Can't handle more than 4 args.
@@ -1695,15 +1721,16 @@ sub do_pack {
                 # Can only pack two things in a word where one
                 # item is 32 bits. Force the next item into
                 # the next word.
-                $bits = $wordsize;
+                $bits = $this_wordsize;
             }
-        }
     }
 
     #
     # Try to balance packing between words.
     #
-    if ($args_per_word[$#args_per_word] == 1) {
+    if (@args_per_word == 1 and $args_per_word[0] == 1 and $pack_in_iw) {
+        # Don't rebalance.
+    } elsif ($args_per_word[$#args_per_word] == 1) {
         if ($args_per_word[$#args_per_word-1] < 3) {
             pop @args_per_word;
         } else {
@@ -1753,43 +1780,51 @@ sub do_pack {
     # 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);
         my $args_per_word = $args_per_word[$word];
-        my @shift;
-        my @mask;
-        my @instr;
-
-        if ($need_wide_mask[$word]) {
-            @shift = ('0', 'BEAM_WIDE_SHIFT');
-            @mask = ('BEAM_WIDE_MASK', $WHOLE_WORD);
-            @instr = ('w', 'w');
-        } else {
-            @shift = @{$pack_shift[$args_per_word]};
-            @mask = @{$pack_mask[$args_per_word]};
-            @instr = @{$pack_instr[$args_per_word]};
-        }
+        my $pack_word_size = ($pack_in_iw && $word == 0) ? 32 : $wordsize;
+
+        my($shref,$mref,$iref,$unpack_suffix)  =
+            get_pack_parameters($args_per_word, $pack_word_size,
+                                $need_wide_mask[$word]);
+        my @shift = @$shref;
+        my @mask = @$mref;
+        my @instr = @$iref;
 
         while ($ap < $args_per_word) {
             my $reg = $args[$arg_num];
             my $this_size = $arg_size{$reg};
+
             if ($bits_needed[$arg_num]) {
                 $this_size = 0;
 
                 if ($ap == 0) {
-                    $pack_prefix .= "Eterm $packed_var = " .
-                        arg_offset($size+$offset) . ";\n";
-                    $up .= "p";
-                    $down = "P$down";
-                    $this_size = 1;
+                    my $packed_data;
+                    if ($pack_in_iw and $word == 0) {
+                        $packed_data = "BeamExtraData(I[0])";
+                        if ($args_per_word == 1) {
+                            $packed_var = $packed_data;
+                        } else {
+                            $pack_prefix .= "Eterm $packed_var = $packed_data;\n";
+                        }
+                        my $pack = chr(ord('#') + $size);
+                        $down = "$pack$down";
+                    } else {
+                        $packed_data = arg_offset($size + $offset);
+                        $pack_prefix .= "Eterm $packed_var = $packed_data;\n";
+                        $down = "P$down";
+                        $up .= "p";
+                        $this_size = 1;
+                    }
                 }
 
                 $down = "$instr[$ap]$down";
                 my $unpack = make_unpack($packed_var, $shift[$ap], $mask[$ap]);
-                $args[$arg_num] = "packed:$reg:$this_size:$reg" . "b($unpack)";
+                my $macro = "$reg$unpack_suffix";
+                $args[$arg_num] = "packed:$reg:$this_size:$macro($unpack)";
 
                 $ap++;
             } else {
@@ -1809,7 +1844,98 @@ sub do_pack {
     }
 
     my $pack_spec = "$down:$up";
-    return ($pack_prefix, $pack_spec, @args);
+    my $score = pack_score($options, @args);
+
+    return ($score, [$pack_prefix,$pack_spec,@args]);
+}
+
+sub get_pack_parameters {
+    my($args_per_word,$pack_word_size,$wide_mask) = @_;
+    my(@shift,@mask,@instr);
+    my $unpack_suffix = 'b';
+
+    if ($wide_mask and $args_per_word > 1) {
+        @shift = ('0', 'BEAM_WIDE_SHIFT');
+        @mask = ('BEAM_WIDE_MASK', $WHOLE_WORD);
+        @instr = (PACK_CMD_WIDE) x 2;
+    } elsif ($args_per_word == 1) {
+        @shift = ('0');
+        @mask = ($WHOLE_WORD);
+        @instr = (PACK_CMD_WIDE);
+    } elsif ($args_per_word == 2) {
+        if ($pack_word_size != $wordsize) {
+            # 64-bit word size, pack 32 bits into instruction word.
+            @shift = ('0', 'BEAM_TIGHT_SHIFT');
+            @mask  = ('BEAM_TIGHT_MASK', $WHOLE_WORD);
+            @instr = (PACK_CMD_TIGHT) x 2;
+        } else {
+            # 32/64 bit word size
+            @shift = ('0', 'BEAM_LOOSE_SHIFT');
+            @mask  = ('BEAM_LOOSE_MASK', $WHOLE_WORD);
+            @instr = (PACK_CMD_LOOSE) x 2;
+        }
+    } elsif ($args_per_word == 3) {
+        if ($pack_word_size != $wordsize) {
+            # 64-bit word size, pack 3 register numbers into instruction word.
+            @shift = ('0', 'BEAM_TIGHTEST_SHIFT', '(2*BEAM_TIGHTEST_SHIFT)');
+            @mask = ('BEAM_TIGHTEST_MASK', 'BEAM_TIGHTEST_MASK', $WHOLE_WORD);
+            @instr = (PACK_CMD_TIGHTEST) x 3;
+            $unpack_suffix = '';
+        } else {
+            # 32/64 bit word size.
+            @shift = ('0', 'BEAM_TIGHT_SHIFT', '(2*BEAM_TIGHT_SHIFT)');
+            if ($wordsize == 32) {
+                @mask = ('BEAM_TIGHT_MASK') x 3;
+            } elsif ($wordsize == 64) {
+                @mask = ('BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD);
+            }
+            @instr = (PACK_CMD_TIGHT) x 3;
+        }
+    } elsif ($args_per_word == 4) {
+        # 64 bit word size only.
+        @shift = ('0',
+                  'BEAM_LOOSE_SHIFT',
+                  '(2*BEAM_LOOSE_SHIFT)',
+		  '(3*BEAM_LOOSE_SHIFT)');
+        @mask = ('BEAM_LOOSE_MASK', 'BEAM_LOOSE_MASK',
+                 'BEAM_LOOSE_MASK', $WHOLE_WORD);
+        @instr = (PACK_CMD_LOOSE) x 4;
+    }
+
+    unless (@shift) {
+        error("internal error: args_per_word=$args_per_word, " .
+              "pack_word_size=$pack_word_size");
+    }
+
+    (\@shift,\@mask,\@instr,$unpack_suffix);
+}
+
+sub pack_score {
+    my($options,@args) = @_;
+    my $size = 0;
+
+    # Calculate the number of words.
+    foreach (@args) {
+        if (/^packed:[^:]*:(\d+)/) {
+            $size += $1;
+        } else {
+            $size += $arg_size{$_}
+        }
+    }
+
+    # 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) {
+        $score += 0;
+    } elsif ($options == PACK_JUMP) {
+        $score += 1;
+    } elsif ($options == (PACK_JUMP|PACK_IN_INSTR_WORD)) {
+        $score += 2;
+    } elsif ($options == 0) {
+        $score += 3;
+    }
+    $score;
 }
 
 sub make_unpack {