BEAM loader: Pack more instructions using a new 'Q' type

Introduce a new 'Q' type, similar to 'P' except that it
can be packed.

5 files changed, 19 insertions, 13 deletions

diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index 5ada352202..463d5f3acc 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -525,6 +525,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
 	    ap++;
 	    break;
 	case 'P':	/* Byte offset into tuple (see beam_load.c) */
+	case 'Q':	/* Like 'P', but packable */
 	    erts_print(to, to_arg, "%d", (*ap / sizeof(Eterm)) - 1);
 	    ap++;
 	    break;
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 254eba42d0..05afedcc7a 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -344,6 +344,7 @@ extern int count_instructions;
 #define xb(N) (*(Eterm *) (((unsigned char *)reg) + (N)))
 #define yb(N) (*(Eterm *) (((unsigned char *)E) + (N)))
 #define fb(N) (*(double *) (((unsigned char *)&(freg[0].fd)) + (N)))
+#define Qb(N) (N)
 #define x(N) reg[N]
 #define y(N) E[N]
 #define r(N) x##N
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index c190efb0d1..8df053ae64 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -1929,7 +1929,8 @@ load_code(LoaderState* stp)
 		}
 		code[ci++] = (BeamInstr) stp->import[i].bf;
 		break;
-	    case 'P':		/* Byte offset into tuple */
+	    case 'P':		/* Byte offset into tuple or stack */
+	    case 'Q':		/* Like 'P', but packable */
 		VerifyTag(stp, tag, TAG_u);
 		tmp = tmp_op->a[arg].val;
 		code[ci++] = (BeamInstr) ((tmp_op->a[arg].val+1) * sizeof(Eterm));
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 8843dafa4b..9e55e2030e 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -464,16 +464,16 @@ move_return n r
 
 move S r | deallocate D | return => move_deallocate_return S r D
 
-%macro: move_deallocate_return MoveDeallocateReturn -nonext
-move_deallocate_return x r P
-move_deallocate_return y r P
-move_deallocate_return c r P
-move_deallocate_return n r P
+%macro: move_deallocate_return MoveDeallocateReturn -pack -nonext
+move_deallocate_return x r Q
+move_deallocate_return y r Q
+move_deallocate_return c r Q
+move_deallocate_return n r Q
 
 deallocate D | return => deallocate_return D
 
 %macro: deallocate_return DeallocateReturn -nonext
-deallocate_return P
+deallocate_return Q
 
 test_heap Need u==1 | put_list Y=y r r => test_heap_1_put_list Need Y
 
@@ -940,11 +940,11 @@ move S r | call_last Ar P=f D => move_call_last S r P D
 
 i_move_call_last f P c r
 
-%macro:move_call_last MoveCallLast -arg_f -nonext
+%macro:move_call_last MoveCallLast -arg_f -nonext -pack
 
 move_call_last/4
-move_call_last x r f P
-move_call_last y r f P
+move_call_last x r f Q
+move_call_last y r f Q
 
 move S=c r | call_only Ar P=f => i_move_call_only P S r
 move S=x r | call_only Ar P=f => move_call_only S r P
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index 38c2f5bcfe..ea06a48d29 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -129,7 +129,8 @@ my %arg_size = ('r' => 0,	# x(0) - x register zero
 		't' => 1,	# untagged integer -- can be packed
 		'b' => 1,	# pointer to bif
 		'A' => 1,	# arity value
-		'P' => 1,	# byte offset into tuple
+		'P' => 1,	# byte offset into tuple or stack
+		'Q' => 1,	# like 'P', but packable
 		'h' => 1,	# character
 		'l' => 1,	# float reg
 		'q' => 1,	# literal term
@@ -168,6 +169,7 @@ my @tag_type;
     $type_bit{'U'} = $type_bit{'u'};
     $type_bit{'e'} = $type_bit{'u'};
     $type_bit{'P'} = $type_bit{'u'};
+    $type_bit{'Q'} = $type_bit{'u'};
 }
 
 #
@@ -809,6 +811,7 @@ sub basic_generator {
 		     'I' => 1,
 		     't' => 1,
 		     'P' => 1,
+		     'Q' => 1,
 		     );
 
     # Pick up the macro to use and its flags (if any).
@@ -959,7 +962,7 @@ sub do_pack {
     # arguments, packing is not possible.
     #
     for ($i = 0; $i < @args; $i++) {
-	if ($args[$i] =~ /[xyt]/) {
+	if ($args[$i] =~ /[xytQ]/) {
 	    $packable_args++;
 	} elsif ($args[$i] =~ /[sd]/) {
 	    return ('', '', @args);
@@ -1005,7 +1008,7 @@ sub do_pack {
     for ($i = 0; $i < @args; $i++) {
 	my($reg) = $args[$i];
 	my($this_size) = $arg_size{$reg};
-	if ($reg =~ /[xyt]/) {
+	if ($reg =~ /[xytQ]/) {
 	    $this_size = 0;
 	    $did_some_packing = 1;