diff options
| -rw-r--r-- | erts/emulator/beam/beam_debug.c | 2 | ||||
| -rw-r--r-- | erts/emulator/beam/beam_emu.c | 11 | ||||
| -rw-r--r-- | erts/emulator/beam/ops.tab | 6 | ||||
| -rw-r--r-- | erts/emulator/test/beam_SUITE.erl | 77 | ||||
| -rwxr-xr-x | erts/emulator/utils/beam_makeops | 35 |
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"; # |