Skip to content

Commit

Permalink
Merge branch 'bjorn/erts/beam_load'
Browse files Browse the repository at this point in the history 
* 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
  • Loading branch information
@bjorng
bjorng committed Apr 18, 2016
2 parents 6f137f7 + 9b2ee6c commit 3a0aa16
Show file tree
Hide file tree
Showing 5 changed files with 77 additions and 54 deletions.
2 changes: 1 addition & 1 deletion erts/emulator/beam/beam_debug.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 */
Expand Down
11 changes: 11 additions & 0 deletions erts/emulator/beam/beam_emu.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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; \
Expand Down
6 changes: 6 additions & 0 deletions erts/emulator/beam/ops.tab
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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 =>
Expand Down
77 changes: 38 additions & 39 deletions erts/emulator/test/beam_SUITE.erl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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]}].

Expand Down Expand Up @@ -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.
Expand Down
35 changes: 21 additions & 14 deletions erts/emulator/utils/beam_makeops
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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',
Expand Down Expand Up @@ -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;
}

Expand Down Expand Up @@ -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";

#
Expand Down

0 comments on commit 3a0aa16

Please sign in to comment.