Merge branch 'bjorn/erts/beam_load'

* bjorn/erts/beam_load:
  Optimize get_tuple_element instructions that target Y registers
  Mend beam_SUITE:packed_registers/1
  Correct unpacking of 3 operands on 32-bit archictectures
  Eliminate misleading #ifdef ARCH_64 in beam_opcodes.h
  beam_debug: Correct masking when unpacking packed operands

5 files changed, 77 insertions, 54 deletions

diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index 61149721fe..a4ad3e7886 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -431,7 +431,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
 		packed >>= 10;
 		break;
 	    case '0':		/* Tight shift */
-		*ap++ = packed & (BEAM_TIGHT_MASK / sizeof(Eterm));
+		*ap++ = packed & BEAM_TIGHT_MASK;
 		packed >>= BEAM_TIGHT_SHIFT;
 		break;
 	    case '6':		/* Shift 16 steps */
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 254bfe4ba0..72526bca5e 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -702,6 +702,17 @@ void** beam_ops;
     dst[1] = E2;					\
   } while (0)
 
+#define GetTupleElement2Y(Src, Element, D1, D2)		\
+  do {							\
+    Eterm* src;						\
+    Eterm E1, E2;					\
+    src = ADD_BYTE_OFFSET(tuple_val(Src), (Element));	\
+    E1 = src[0];					\
+    E2 = src[1];					\
+    D1 = E1;						\
+    D2 = E2;						\
+  } while (0)
+
 #define GetTupleElement3(Src, Element, Dest)		\
   do {							\
     Eterm* src;						\
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 69d06094ee..c08b4a8759 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -229,6 +229,9 @@ i_get_tuple_element y P y
 %macro: i_get_tuple_element2 GetTupleElement2 -pack
 i_get_tuple_element2 x P x
 
+%macro: i_get_tuple_element2y GetTupleElement2Y -pack
+i_get_tuple_element2y x P y y
+
 %macro: i_get_tuple_element3 GetTupleElement3 -pack
 i_get_tuple_element3 x P x
 
@@ -649,6 +652,9 @@ get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \
 get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \
    succ(P1, P2) | succ(D1, D2) => i_get_tuple_element2 Reg P1 D1
 
+get_tuple_element Reg=x P1 D1=y | get_tuple_element Reg=x P2 D2=y | \
+   succ(P1, P2) => i_get_tuple_element2y Reg P1 D1 D2
+
 get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst
 
 is_integer Fail=f i =>
diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl
index b11afbdc08..6a54fa87e0 100644
--- a/erts/emulator/test/beam_SUITE.erl
+++ b/erts/emulator/test/beam_SUITE.erl
@@ -29,6 +29,7 @@
 -export([applied/2,swap_temp_applied/1]).
 
 -include_lib("common_test/include/ct.hrl").
+-include_lib("syntax_tools/include/merl.hrl").
 
 suite() -> [{ct_hooks,[ts_install_cth]}].
 
@@ -93,48 +94,46 @@ applied(Starter, N) ->
 apply_last_bif(Config) when is_list(Config) ->
     apply(erlang, abs, [1]).
 
-%% Test three high register numbers in a put_list instruction
-%% (to test whether packing works properly).
+%% Test whether packing works properly.
 packed_registers(Config) when is_list(Config) ->
-    PrivDir = proplists:get_value(priv_dir, Config),
-    Mod = packed_regs,
-    Name = filename:join(PrivDir, atom_to_list(Mod) ++ ".erl"),
-
-    %% Generate a module which generates a list of tuples.
-    %% put_list(A) -> [{A, 600}, {A, 999}, ... {A, 0}].
-    Code = gen_packed_regs(600, ["-module("++atom_to_list(Mod)++").\n",
-				       "-export([put_list/1]).\n",
-				       "put_list(A) ->\n["]),
-    ok = file:write_file(Name, Code),
-
-    %% Compile the module.
-    io:format("Compiling: ~s\n", [Name]),
-    CompRc = compile:file(Name, [{outdir, PrivDir}, report]),
-    io:format("Result: ~p\n",[CompRc]),
-    {ok, Mod} = CompRc,
-
-    %% Load it.
-    io:format("Loading...\n",[]),
-    LoadRc = code:load_abs(filename:join(PrivDir, atom_to_list(Mod))),
-    {module,_Module} = LoadRc,
-
-    %% Call it and verify result.
-    Term = {a, b},
-    L = Mod:put_list(Term),
-    verify_packed_regs(L, Term, 600),
+    Mod = ?FUNCTION_NAME,
+
+    %% Generate scrambled sequence.
+    Seq0 = [{erlang:phash2(I),I} || I <- lists:seq(0, 260)],
+    Seq = [I || {_,I} <- lists:sort(Seq0)],
+
+    %% Generate a test modules that uses get_list/3 instructions
+    %% with high register numbers.
+    S0 = [begin
+	      VarName = list_to_atom("V"++integer_to_list(V)),
+	      {merl:var(VarName),V}
+	  end || V <- Seq],
+    Vars = [V || {V,_} <- S0],
+    NewVars = [begin
+		   VarName = list_to_atom("M"++integer_to_list(V)),
+		   merl:var(VarName)
+	       end || V <- Seq],
+    S = [?Q("_@Var = id(_@Value@)") || {Var,Value} <- S0],
+    Code = ?Q(["-module('@Mod@').\n"
+	       "-export([f/0]).\n"
+	       "f() ->\n"
+	       "_@S,\n"
+	       "_ = id(0),\n"
+	       "L = [_@Vars],\n"
+	       "_ = id(1),\n"
+	       "[_@NewVars] = L,\n"		%Test get_list/3.
+	       "_ = id(2),\n"
+	       "id([_@Vars,_@NewVars]).\n"
+	       "id(I) -> I.\n"]),
+    merl:compile_and_load(Code),
+    CombinedSeq = Seq ++ Seq,
+    CombinedSeq = Mod:f(),
+
+    %% Clean up.
+    true = code:delete(Mod),
+    false = code:purge(Mod),
     ok.
 
-gen_packed_regs(0, Acc) ->
-    [Acc|"{A,0}].\n"];
-gen_packed_regs(N, Acc) ->
-    gen_packed_regs(N-1, [Acc,"{A,",integer_to_list(N)|"},\n"]).
-
-verify_packed_regs([], _, -1) -> ok;
-verify_packed_regs([{Term, N}| T], Term, N) ->
-    verify_packed_regs(T, Term, N-1);
-verify_packed_regs(L, Term, N) ->
-    ct:fail("Expected [{~p, ~p}|T]; got\n~p\n", [Term, N, L]).
-
 buildo_mucho(Config) when is_list(Config) ->
     buildo_mucho_1(),
     ok.
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index 1a5bbe0d33..4407f7e289 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -48,7 +48,7 @@ $pack_shift[4] = ['0', 'BEAM_LOOSE_SHIFT', # Only for 64 bit wordsize
 		  '(3*BEAM_LOOSE_SHIFT)'];
 
 $pack_mask[2]  = ['BEAM_LOOSE_MASK', $WHOLE_WORD];
-$pack_mask[3]  = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_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',
@@ -251,6 +251,7 @@ $args_per_word[5] = 3;
 $args_per_word[6] = 3;
 
 if ($wordsize == 64) {
+    $pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD];
     $args_per_word[4] = 4;
 }
 
@@ -624,19 +625,25 @@ sub emulator_output {
     print "#define NUM_SPECIFIC_OPS ", scalar(@op_to_name), "\n";
     print "#define SCRATCH_X_REG 1023\n";
     print "\n";
-    print "#ifdef ARCH_64\n";
-    print "#  define BEAM_WIDE_MASK 0xFFFFUL\n";
-    print "#  define BEAM_LOOSE_MASK 0xFFFFUL\n";
-    print "#  define BEAM_TIGHT_MASK 0xFFFFUL\n";
-    print "#  define BEAM_WIDE_SHIFT 32\n";
-    print "#  define BEAM_LOOSE_SHIFT 16\n";
-    print "#  define BEAM_TIGHT_SHIFT 16\n";
-    print "#else\n";
-    print "#  define BEAM_LOOSE_MASK 0xFFF\n";
-    print "#  define BEAM_TIGHT_MASK 0xFFC\n";
-    print "#  define BEAM_LOOSE_SHIFT 16\n";
-    print "#  define BEAM_TIGHT_SHIFT 10\n";
-    print "#endif\n";
+    if ($wordsize == 32) {
+	print "#if defined(ARCH_64)\n";
+	print qq[  #error "32-bit architecture assumed, but ARCH_64 is defined"\n];
+	print "#endif\n";
+	print "#define BEAM_LOOSE_MASK 0xFFF\n";
+	print "#define BEAM_TIGHT_MASK 0xFFC\n";
+	print "#define BEAM_LOOSE_SHIFT 16\n";
+	print "#define BEAM_TIGHT_SHIFT 10\n";
+    } elsif ($wordsize == 64) {
+	print "#if !defined(ARCH_64)\n";
+	print qq[  #error "64-bit architecture assumed, but ARCH_64 not defined"\n];
+	print "#endif\n";
+	print "#define BEAM_WIDE_MASK 0xFFFFUL\n";
+	print "#define BEAM_LOOSE_MASK 0xFFFFUL\n";
+	print "#define BEAM_TIGHT_MASK 0xFFFFUL\n";
+	print "#define BEAM_WIDE_SHIFT 32\n";
+	print "#define BEAM_LOOSE_SHIFT 16\n";
+	print "#define BEAM_TIGHT_SHIFT 16\n";
+    }
     print "\n";
 
     #