aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBjörn Gustavsson <[email protected]>2013-10-03 14:06:57 +0200
committerBjörn-Egil Dahlberg <[email protected]>2014-01-28 15:56:28 +0100
commitc2702eb35db00ad67f922708eeea48616d908306 (patch)
treea4f4133e5279bfc0e96c227520ecede70cbb821b
parent760ed909f8e2a655100ea773829c7d0e7dd40088 (diff)
downloadotp-c2702eb35db00ad67f922708eeea48616d908306.tar.gz
otp-c2702eb35db00ad67f922708eeea48616d908306.tar.bz2
otp-c2702eb35db00ad67f922708eeea48616d908306.zip
compiler: Implement different instructions for => and :=
-rw-r--r--erts/emulator/beam/beam_emu.c301
-rw-r--r--erts/emulator/beam/ops.tab11
-rw-r--r--erts/emulator/test/map_SUITE.erl38
-rw-r--r--lib/compiler/src/beam_a.erl4
-rw-r--r--lib/compiler/src/beam_block.erl6
-rw-r--r--lib/compiler/src/beam_clean.erl5
-rw-r--r--lib/compiler/src/beam_flatten.erl4
-rw-r--r--lib/compiler/src/beam_jump.erl2
-rw-r--r--lib/compiler/src/beam_split.erl7
-rw-r--r--lib/compiler/src/beam_validator.erl23
-rw-r--r--lib/compiler/src/beam_z.erl4
-rwxr-xr-xlib/compiler/src/genop.tab9
-rw-r--r--lib/compiler/src/v3_codegen.erl111
13 files changed, 392 insertions, 133 deletions
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 1cad31be2c..b666b7c3f7 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -959,8 +959,10 @@ static BeamInstr* apply_fun(Process* p, Eterm fun,
static Eterm new_fun(Process* p, Eterm* reg,
ErlFunEntry* fe, int num_free) NOINLINE;
static Eterm new_map(Process* p, Eterm* reg, BeamInstr* I) NOINLINE;
-static Eterm update_map(Process* p, Eterm* reg,
- Eterm map, BeamInstr* I) NOINLINE;
+static Eterm update_map_assoc(Process* p, Eterm* reg,
+ Eterm map, BeamInstr* I) NOINLINE;
+static Eterm update_map_exact(Process* p, Eterm* reg,
+ Eterm map, BeamInstr* I) NOINLINE;
static int has_not_map_field(Eterm map, Eterm key);
static Eterm get_map_element(Eterm map, Eterm key);
@@ -2353,21 +2355,39 @@ void process_main(void)
Next(4+Arg(3));
}
- OpCase(update_map_jddII): {
+ OpCase(update_map_assoc_jddII): {
Eterm res;
Eterm map;
GetArg1(1, map);
x(0) = r(0);
SWAPOUT;
- res = update_map(c_p, reg, map, I);
+ res = update_map_assoc(c_p, reg, map, I);
SWAPIN;
- if (res) {
+ if (is_value(res)) {
r(0) = x(0);
StoreResult(res, Arg(2));
Next(5+Arg(4));
} else {
- goto lb_Cl_error;
+ goto badarg;
+ }
+ }
+
+ OpCase(update_map_exact_jddII): {
+ Eterm res;
+ Eterm map;
+
+ GetArg1(1, map);
+ x(0) = r(0);
+ SWAPOUT;
+ res = update_map_exact(c_p, reg, map, I);
+ SWAPIN;
+ if (is_value(res)) {
+ r(0) = x(0);
+ StoreResult(res, Arg(2));
+ Next(5+Arg(4));
+ } else {
+ goto badarg;
}
}
@@ -6387,18 +6407,10 @@ new_map(Process* p, Eterm* reg, BeamInstr* I)
return make_map(mp);
}
-
-/* This entire instruction will be split into two.
- * 1) update_map_exact (literals) <- this can be much more optimized
- * 2) update_map_assoc (literals)
- * Also update_map is pretty bad code as it stands now.
- */
-
static Eterm
-update_map(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
+update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
{
Uint n;
- Uint i;
Uint num_old;
Uint num_updates;
Uint need;
@@ -6413,7 +6425,7 @@ update_map(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
Eterm* kp;
if (is_not_map(map)) {
- return 0;
+ return THE_NON_VALUE;
}
old_mp = (map_t *) map_val(map);
@@ -6428,11 +6440,12 @@ update_map(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
}
/*
- * Allocate heap space for the worst case (i.e. all keys are new).
+ * Allocate heap space for the worst case (i.e. all keys in the
+ * update list are new).
*/
num_updates = Arg(4) / 2;
- need = 2*(num_old+num_updates) + 4;
+ need = 2*(num_old+num_updates) + 1 + sizeof(map_t) / sizeof(Eterm);
if (HeapWordsLeft(p) < need) {
Uint live = Arg(3);
reg[live] = map;
@@ -6442,67 +6455,37 @@ update_map(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
}
/*
- * Update map, optimistically assuming that there are no
- * new keys, allowing us to keep the old key tuple.
+ * Build the skeleton for the map, ready to be filled in.
+ *
+ * +-----------------------------------+
+ * | (Space for aritvyal for keys) | <-----------+
+ * +-----------------------------------+ |
+ * | (Space for key 1) | | <-- kp
+ * +-----------------------------------+ |
+ * . |
+ * . |
+ * . |
+ * +-----------------------------------+ |
+ * | (Space for last key) | |
+ * +-----------------------------------+ |
+ * | MAP_HEADER | |
+ * +-----------------------------------+ |
+ * | (Space for number of keys/values) | |
+ * +-----------------------------------+ |
+ * | Boxed tuple pointer >----------------+
+ * +-----------------------------------+
+ * | (Space for value 1) | <-- hp
+ * +-----------------------------------+
*/
- hp = p->htop;
- E = p->stop;
-
- old_vals = map_get_values(old_mp);
- old_keys = map_get_keys(old_mp);
+ E = p->stop;
+ kp = p->htop + 1; /* Point to first key */
+ hp = kp + num_old + num_updates;
res = make_map(hp);
- mp = (map_t *)hp; hp += 3;
+ mp = (map_t *)hp;
+ hp += sizeof(map_t) / sizeof(Eterm);
mp->thing_word = MAP_HEADER;
- mp->size = num_old;
- mp->keys = old_mp->keys;
-
- ASSERT(num_updates > 0);
-
- /* Get array of key/value pairs to be updated */
- new_p = &Arg(5);
- GET_TERM(*new_p, new_key);
-
- n = num_updates;
-
- for (i = 0; i < num_old; i++) {
- if (new_key == THE_NON_VALUE || !eq(*old_keys, new_key)) {
- /* not same keys */
- *hp++ = *old_vals;
- } else {
- GET_TERM(new_p[1], *hp);
- hp++;
- n--;
- if (n == 0) {
- new_key = THE_NON_VALUE;
- } else {
- new_p += 2;
- GET_TERM(*new_p, new_key);
- }
- }
- old_vals++, old_keys++;
- }
-
- /*
- * If we have exhausted the update list we are done.
- */
-
- if (n == 0) {
- p->htop = hp;
- return res;
- }
-
- /*
- * There were some new keys. We'll have to start over and rebuild
- * the key tuple too.
- */
-
- kp = p->htop;
- *kp++ = make_arityval(0);
-
- res = make_map(hp);
- mp = (map_t *)hp; hp += 3;
mp->keys = make_tuple(kp-1);
old_vals = map_get_values(old_mp);
@@ -6512,20 +6495,28 @@ update_map(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
GET_TERM(*new_p, new_key);
n = num_updates;
+ /*
+ * Fill in keys and values, until we run out of either updates
+ * or old values and keys.
+ */
+
for (;;) {
Eterm key;
Sint c;
ASSERT(kp < (Eterm *)mp);
key = *old_keys;
- if ((c = cmp(key, new_key)) < 0) {
+ if ((c = CMP(key, new_key)) < 0) {
+ /* Copy old key and value */
*kp++ = key;
*hp++ = *old_vals;
old_keys++, old_vals++, num_old--;
} else { /* Replace or insert new */
- *kp++ = new_key;
GET_TERM(new_p[1], *hp++);
- if (c == 0) { /* If replacement */
+ if (c > 0) { /* If new new key */
+ *kp++ = new_key;
+ } else { /* If replacement */
+ *kp++ = key;
old_keys++, old_vals++, num_old--;
}
n--;
@@ -6541,32 +6532,162 @@ update_map(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
}
}
- while (n-- > 0) {
- GET_TERM(new_p[0], *kp++);
- GET_TERM(new_p[1], *hp++);
- new_p += 2;
- }
-
/*
- * All updates done. Now copy the remaining part of the frame's
- * keys and values.
+ * At this point, we have run out of either old keys and values,
+ * or the update list. In other words, at least of one n and
+ * num_old must be zero.
*/
- while (num_old-- > 0) {
- ASSERT(kp < (Eterm *)mp);
- *kp++ = *old_keys++;
- *hp++ = *old_vals++;
+ if (n > 0) {
+ /*
+ * All old keys and values have been copied, but there
+ * are still new keys and values in the update list that
+ * must be copied.
+ */
+ ASSERT(num_old == 0);
+ while (n-- > 0) {
+ GET_TERM(new_p[0], *kp++);
+ GET_TERM(new_p[1], *hp++);
+ new_p += 2;
+ }
+ } else {
+ /*
+ * All updates are now done. We may still have old
+ * keys and values that we must copy.
+ */
+ ASSERT(n == 0);
+ while (num_old-- > 0) {
+ ASSERT(kp < (Eterm *)mp);
+ *kp++ = *old_keys++;
+ *hp++ = *old_vals++;
+ }
}
+
+ /*
+ * Calculate how many values that are unused at the end of the
+ * key tuple and fill it out with a bignum header.
+ */
if ((n = (Eterm *)mp - kp) > 0) {
*kp = make_pos_bignum_header(n-1);
}
+
+ /*
+ * Fill in the size of the map in both the key tuple and in the map.
+ */
+
n = kp - p->htop - 1; /* Actual number of keys/values */
*p->htop = make_arityval(n);
- mp->thing_word = MAP_HEADER;
mp->size = n;
p->htop = hp;
return res;
}
+
+/*
+ * Update values for keys that already exist in the map.
+ */
+
+static Eterm
+update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
+{
+ Uint n;
+ Uint i;
+ Uint num_old;
+ Uint need;
+ map_t *old_mp, *mp;
+ Eterm res;
+ Eterm* hp;
+ Eterm* E;
+ Eterm* old_keys;
+ Eterm* old_vals;
+ Eterm* new_p;
+ Eterm new_key;
+
+ if (is_not_map(map)) {
+ return THE_NON_VALUE;
+ }
+
+ old_mp = (map_t *) map_val(map);
+ num_old = map_get_size(old_mp);
+
+ /*
+ * If the old map is empty, create a new map.
+ */
+
+ if (num_old == 0) {
+ return new_map(p, reg, I+1);
+ }
+
+ /*
+ * Allocate the exact heap space needed.
+ */
+
+ need = num_old + sizeof(map_t) / sizeof(Eterm);
+ if (HeapWordsLeft(p) < need) {
+ Uint live = Arg(3);
+ reg[live] = map;
+ erts_garbage_collect(p, need, reg, live+1);
+ map = reg[live];
+ old_mp = (map_t *)map_val(map);
+ }
+
+ /*
+ * Update map, keeping the old key tuple.
+ */
+
+ hp = p->htop;
+ E = p->stop;
+
+ old_vals = map_get_values(old_mp);
+ old_keys = map_get_keys(old_mp);
+
+ res = make_map(hp);
+ mp = (map_t *)hp;
+ hp += sizeof(map_t) / sizeof(Eterm);
+ mp->thing_word = MAP_HEADER;
+ mp->size = num_old;
+ mp->keys = old_mp->keys;
+
+ /* Get array of key/value pairs to be updated */
+ new_p = &Arg(5);
+ GET_TERM(*new_p, new_key);
+
+ /* Update all values */
+ n = Arg(4) / 2; /* Number of values to be updated */
+ ASSERT(n > 0);
+ for (i = 0; i < num_old; i++) {
+ if (!EQ(*old_keys, new_key)) {
+ /* Not same keys */
+ *hp++ = *old_vals;
+ } else {
+ GET_TERM(new_p[1], *hp);
+ hp++;
+ n--;
+ if (n == 0) {
+ /*
+ * All updates done. Copy remaining values
+ * and return the result.
+ */
+ for (i++, old_vals++; i < num_old; i++) {
+ *hp++ = *old_vals++;
+ }
+ ASSERT(hp == p->htop + need);
+ p->htop = hp;
+ return res;
+ } else {
+ new_p += 2;
+ GET_TERM(*new_p, new_key);
+ }
+ }
+ old_vals++, old_keys++;
+ }
+
+ /*
+ * Updates left. That means that at least one the keys in the
+ * update list did not previously exist.
+ */
+ ASSERT(hp == p->htop + need);
+ return THE_NON_VALUE;
+}
#undef GET_TERM
int catchlevel(Process *p)
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index b89bdb2e3a..f35997efee 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -1474,11 +1474,16 @@ apply_last I P
# has_map_field Fail Src Key => jump Fail
# get_map_element Fail Src Key Dst => jump Fail
-put_map F n Dst Live Size Rest=* => new_map F Dst Live Size Rest
-put_map F Src Dst Live Size Rest=* => update_map F Src Dst Live Size Rest
+put_map_assoc F n Dst Live Size Rest=* => new_map F Dst Live Size Rest
+put_map_exact F n Dst Live Size Rest=* => new_map F Dst Live Size Rest
+put_map_assoc F Src Dst Live Size Rest=* => \
+ update_map_assoc F Src Dst Live Size Rest
+put_map_exact F Src Dst Live Size Rest=* => \
+ update_map_exact F Src Dst Live Size Rest
new_map j d I I
-update_map j d d I I
+update_map_assoc j d d I I
+update_map_exact j d d I I
is_map Fail cq => jump Fail
diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl
index 6d82a2cb59..81d39fc97a 100644
--- a/erts/emulator/test/map_SUITE.erl
+++ b/erts/emulator/test/map_SUITE.erl
@@ -23,6 +23,7 @@
-export([
t_build_and_match_literals/1,
t_update_literals/1,t_match_and_update_literals/1,
+ update_assoc/1,update_exact/1,
t_guard_bifs/1, t_guard_sequence/1, t_guard_update/1,
t_guard_receive/1, t_guard_fun/1,
t_list_comprehension/1,
@@ -48,6 +49,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() -> [
t_build_and_match_literals,
t_update_literals, t_match_and_update_literals,
+ update_assoc,update_exact,
t_guard_bifs, t_guard_sequence, t_guard_update,
t_guard_receive,t_guard_fun, t_list_comprehension,
t_map_sort_literals,
@@ -166,6 +168,42 @@ loop_match_and_update_literals_x_q(Map, []) -> Map;
loop_match_and_update_literals_x_q(#{q:=Q0,x:=X0} = Map, [{X,Q}|Vs]) ->
loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs).
+update_assoc(Config) when is_list(Config) ->
+ M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}),
+
+ M1 = M0#{1=>42,2=>100,4=>[a,b,c]},
+ #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1,
+ M1 = M0#{1.0=>wrong,1:=42,2.0=>wrong,2.0=>100,4.0=>[a,b,c]},
+
+ M2 = M0#{3.0=>new},
+ #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2,
+ M2 = M0#{3.0:=wrong,3.0=>new},
+
+ %% Errors cases.
+ BadMap = id(badmap),
+ {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}),
+
+ ok.
+
+update_exact(Config) when is_list(Config) ->
+ M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}),
+
+ M1 = M0#{1:=42,2:=100,4:=[a,b,c]},
+ #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1,
+ M1 = M0#{1:=wrong,1=>42,2=>wrong,2:=100,4:=[a,b,c]},
+
+ M2 = M0#{3.0:=new},
+ #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2,
+ M2 = M0#{3.0=>wrong,3.0:=new},
+ M2 = M0#{3=>wrong,3.0:=new},
+
+ %% Errors cases.
+ {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}),
+ {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}),
+ {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}),
+ {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}),
+
+ ok.
t_guard_bifs(Config) when is_list(Config) ->
true = map_guard_head(#{a=>1}),
diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl
index c590c5e35b..3dfa67a771 100644
--- a/lib/compiler/src/beam_a.erl
+++ b/lib/compiler/src/beam_a.erl
@@ -88,6 +88,10 @@ rename_instr({bs_private_append=I,F,Sz,U,Src,Flags,Dst}) ->
{bs_init,F,{I,U,Flags},none,[Sz,Src],Dst};
rename_instr(bs_init_writable=I) ->
{bs_init,{f,0},I,1,[{x,0}],{x,0}};
+rename_instr({put_map_assoc,Fail,S,D,R,L}) ->
+ {put_map,Fail,assoc,S,D,R,L};
+rename_instr({put_map_exact,Fail,S,D,R,L}) ->
+ {put_map,Fail,exact,S,D,R,L};
rename_instr({select_val=I,Reg,Fail,{list,List}}) ->
{select,I,Reg,Fail,List};
rename_instr({select_tuple_arity=I,Reg,Fail,{list,List}}) ->
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index f9e90b81d2..d5f2ffc444 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -152,8 +152,8 @@ collect({get_tuple_element,S,I,D}) -> {set,[D],[S],{get_tuple_element,I}};
collect({set_tuple_element,S,D,I}) -> {set,[],[S,D],{set_tuple_element,I}};
collect({get_list,S,D1,D2}) -> {set,[D1,D2],[S],get_list};
collect(remove_message) -> {set,[],[],remove_message};
-collect({put_map,F,S,D,R,{list,Puts}}) ->
- {set,[D],[S|Puts],{alloc,R,{put_map,F}}};
+collect({put_map,F,Op,S,D,R,{list,Puts}}) ->
+ {set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}};
collect({get_map_element,F,S,K,D}) ->
{set,[D],[S],{get_map_element,K,F}};
collect({'catch',R,L}) -> {set,[R],[],{'catch',L}};
@@ -387,7 +387,7 @@ gen_init(Fs, Regs, Y, Acc) ->
init_yreg([{set,_,_,{bif,_,_}}|_], Reg) -> Reg;
init_yreg([{set,_,_,{alloc,_,{gc_bif,_,_}}}|_], Reg) -> Reg;
-init_yreg([{set,_,_,{alloc,_,{put_map,_}}}|_], Reg) -> Reg;
+init_yreg([{set,_,_,{alloc,_,{put_map,_,_}}}|_], Reg) -> Reg;
init_yreg([{set,Ds,_,_}|Is], Reg) -> init_yreg(Is, add_yregs(Ds, Reg));
init_yreg(_Is, Reg) -> Reg.
diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl
index 6f802d0436..55f985ad0e 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -259,8 +259,9 @@ replace([{bs_utf8_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 ->
replace(Is, [{I,{f,label(Lbl, D)},Src,Dst}|Acc], D);
replace([{bs_utf16_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 ->
replace(Is, [{I,{f,label(Lbl, D)},Src,Dst}|Acc], D);
-replace([{put_map=I,{f,Lbl},Src,Dst,Live,List}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{I,{f,label(Lbl, D)},Src,Dst,Live,List}|Acc], D);
+replace([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D)
+ when Lbl =/= 0 ->
+ replace(Is, [{I,{f,label(Lbl, D)},Op,Src,Dst,Live,List}|Acc], D);
replace([{get_map_element=I,{f,Lbl},Src,Key,Dst}|Is], Acc, D) when Lbl =/= 0 ->
replace(Is, [{I,{f,label(Lbl, D)},Src,Key,Dst}|Acc], D);
replace([I|Is], Acc, D) ->
diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl
index ad9591ff05..534bc6d954 100644
--- a/lib/compiler/src/beam_flatten.erl
+++ b/lib/compiler/src/beam_flatten.erl
@@ -61,8 +61,8 @@ norm({set,[],[S],put}) -> {put,S};
norm({set,[D],[S],{get_tuple_element,I}}) -> {get_tuple_element,S,I,D};
norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I};
norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2};
-norm({set,[D],[S|Puts],{alloc,R,{put_map,F}}}) ->
- {put_map,F,S,D,R,{list,Puts}};
+norm({set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}) ->
+ {put_map,F,Op,S,D,R,{list,Puts}};
norm({set,[D],[S],{get_map_element,K,F}}) ->
{get_map_element,F,S,K,D};
norm({set,[],[],remove_message}) -> remove_message;
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index bbef75c219..1f720b94c3 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -527,7 +527,7 @@ ulbl({bs_init,Lbl,_,_,_,_}, Used) ->
mark_used(Lbl, Used);
ulbl({bs_put,Lbl,_,_}, Used) ->
mark_used(Lbl, Used);
-ulbl({put_map,Lbl,_Src,_Dst,_Live,_List}, Used) ->
+ulbl({put_map,Lbl,_Op,_Src,_Dst,_Live,_List}, Used) ->
mark_used(Lbl, Used);
ulbl({get_map_element,Lbl,_Src,_Key,_Dst}, Used) ->
mark_used(Lbl, Used);
diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl
index bbd4695289..638a4826ea 100644
--- a/lib/compiler/src/beam_split.erl
+++ b/lib/compiler/src/beam_split.erl
@@ -49,9 +49,10 @@ split_block([{set,[R],As,{bif,N,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 ->
split_block([{set,[R],As,{alloc,Live,{gc_bif,N,{f,Lbl}=Fail}}}|Is], Bl, Acc)
when Lbl =/= 0 ->
split_block(Is, [], [{gc_bif,N,Fail,Live,As,R}|make_block(Bl, Acc)]);
-split_block([{set,[D],[S|Puts],{alloc,R,{put_map,{f,Lbl}=Fail}}}|Is], Bl, Acc)
- when Lbl =/= 0 ->
- split_block(Is, [], [{put_map,Fail,S,D,R,{list,Puts}}|make_block(Bl, Acc)]);
+split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is],
+ Bl, Acc) when Lbl =/= 0 ->
+ split_block(Is, [], [{put_map,Fail,Op,S,D,R,{list,Puts}}|
+ make_block(Bl, Acc)]);
split_block([{set,[D],[S],{get_map_element,K,{f,Lbl}=Fail}}|Is], Bl, Acc)
when Lbl =/= 0 ->
split_block(Is, [], [{get_map_element,Fail,S,K,D}|make_block(Bl, Acc)]);
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 37b08f43d3..97f84da08f 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -866,15 +866,10 @@ valfun_4({bs_final2,Src,Dst}, Vst0) ->
assert_term(Src, Vst0),
set_type_reg(binary, Dst, Vst0);
%% Map instructions.
-valfun_4({put_map,{f,Fail},Src,Dst,Live,{list,List}}, Vst0) ->
- verify_live(Live, Vst0),
- verify_y_init(Vst0),
- [assert_term(Term, Vst0) || Term <- List],
- assert_term(Src, Vst0),
- Vst1 = heap_alloc(0, Vst0),
- Vst2 = branch_state(Fail, Vst1),
- Vst = prune_x_regs(Live, Vst2),
- set_type_reg(term, Dst, Vst);
+valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) ->
+ verify_put_map(Fail, Src, Dst, Live, List, Vst);
+valfun_4({put_map_exact,{f,Fail},Src,Dst,Live,{list,List}}, Vst) ->
+ verify_put_map(Fail, Src, Dst, Live, List, Vst);
valfun_4({get_map_element,{f,Fail},Src,Key,Dst}, Vst0) ->
assert_term(Src, Vst0),
assert_term(Key, Vst0),
@@ -883,6 +878,16 @@ valfun_4({get_map_element,{f,Fail},Src,Key,Dst}, Vst0) ->
valfun_4(_, _) ->
error(unknown_instruction).
+verify_put_map(Fail, Src, Dst, Live, List, Vst0) ->
+ verify_live(Live, Vst0),
+ verify_y_init(Vst0),
+ [assert_term(Term, Vst0) || Term <- List],
+ assert_term(Src, Vst0),
+ Vst1 = heap_alloc(0, Vst0),
+ Vst2 = branch_state(Fail, Vst1),
+ Vst = prune_x_regs(Live, Vst2),
+ set_type_reg(term, Dst, Vst).
+
%%
%% Common code for validating bs_get* instructions.
%%
diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl
index 8c6b0c916d..9953a48710 100644
--- a/lib/compiler/src/beam_z.erl
+++ b/lib/compiler/src/beam_z.erl
@@ -74,6 +74,10 @@ undo_rename({bs_init,F,{I,Extra,U,Flags},Live,[Sz,Src],Dst}) ->
{I,F,Sz,Extra,Live,U,Src,Flags,Dst};
undo_rename({bs_init,_,bs_init_writable=I,_,_,_}) ->
I;
+undo_rename({put_map,Fail,assoc,S,D,R,L}) ->
+ {put_map_assoc,Fail,S,D,R,L};
+undo_rename({put_map,Fail,exact,S,D,R,L}) ->
+ {put_map_exact,Fail,S,D,R,L};
undo_rename({select,I,Reg,Fail,List}) ->
{I,Reg,Fail,{list,List}};
undo_rename(I) -> I.
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index 861acd3932..79b467f949 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -531,7 +531,8 @@ BEAM_FORMAT_NUMBER=0
# R16
-154: put_map/5
-155: is_map/2
-156: has_map_field/3
-157: get_map_element/4
+154: put_map_assoc/5
+155: put_map_exact/5
+156: is_map/2
+157: has_map_field/3
+158: get_map_element/4
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index c1d555efac..db8ea04778 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -1488,7 +1488,7 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef,
%% Now generate the complete code for constructing the binary.
Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a),
{Sis++Code,Aft,St};
-set_cg([{var,R}], {map,SrcMap,Es}, Le, Vdb, Bef,
+set_cg([{var,R}], {map,SrcMap,Es0}, Le, Vdb, Bef,
#cg{in_catch=InCatch,bfail=Bfail}=St) ->
Fail = {f,Bfail},
{Sis,Int0} =
@@ -1501,24 +1501,41 @@ set_cg([{var,R}], {map,SrcMap,Es}, Le, Vdb, Bef,
{var,SrcVar} -> fetch_var(SrcVar, Int0);
_ -> SrcMap
end,
-
- %% MapPairs in put_map must be sorted in ascending Key order.
- %% Key literals must be unique when arriving here in v3_codegen.
-
- SortedEs = lists:sort(fun({_,{_T1,K1},_},{_,{_T2,K2},_}) ->
- K1 =< K2
- end, Es),
- List = flatmap(fun
- ({map_pair_assoc,K,{var,V}}) -> [K,fetch_var(V, Int0)];
- ({map_pair_exact,K,{var,V}}) -> [K,fetch_var(V, Int0)];
- ({map_pair_assoc,K,E}) -> [K,E];
- ({map_pair_exact,K,E}) -> [K,E]
- end, SortedEs),
- Live = max_reg(Bef#sr.reg),
+ {Assoc,Exact} =
+ try
+ cg_map_pairs(Es0)
+ catch
+ throw:badarg ->
+ {[],[{{float,0.0},{atom,badarg}},
+ {{integer,0},{atom,badarg}}]}
+ end,
+ F = fun ({K,{var,V}}) -> [K,fetch_var(V, Int0)];
+ ({K,E}) -> [K,E]
+ end,
+ AssocList = flatmap(F, Assoc),
+ ExactList = flatmap(F, Exact),
+ Live0 = max_reg(Bef#sr.reg),
Int1 = clear_dead(Int0, Le#l.i, Vdb),
Aft = Bef#sr{reg=put_reg(R, Int1#sr.reg)},
Target = fetch_reg(R, Aft#sr.reg),
- Code = [Line,{put_map,Fail,SrcReg,Target,Live,{list,List}}],
+ Code = [Line] ++
+ case {AssocList,ExactList} of
+ {[_|_],[]} ->
+ [{put_map_assoc,Fail,SrcReg,Target,Live0,{list,AssocList}}];
+ {[_|_],[_|_]} ->
+ Live = case Target of
+ {x,TargetX} when TargetX =:= Live0 ->
+ Live0 + 1;
+ _ ->
+ Live0
+ end,
+ [{put_map_assoc,Fail,SrcReg,Target,Live0,{list,AssocList}},
+ {put_map_exact,Fail,Target,Target,Live,{list,ExactList}}];
+ {[],[_|_]} ->
+ [{put_map_exact,Fail,SrcReg,Target,Live0,{list,ExactList}}];
+ {[],[]} ->
+ [{put_map_assoc,Fail,SrcReg,Target,Live0,{list,[]}}]
+ end,
{Sis++Code,Aft,St};
set_cg([{var,R}], Con, Le, Vdb, Bef, St) ->
%% Find a place for the return register first.
@@ -1532,6 +1549,68 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) ->
end,
{Ais,clear_dead(Int, Le#l.i, Vdb),St}.
+%% cg_map_pairs(MapPairs) -> {Assoc,Exact}
+%% Assoc = Exact = [{K,V}]
+%%
+%% Remove multiple assignments to the same key, and return
+%% one list key-value list with all keys that may or may not exist
+%% (Assoc), and one with keys that must exist (Exact).
+%%
+
+cg_map_pairs(Es0) ->
+ Es = cg_map_pairs_1(Es0, 0),
+ R0 = sofs:relation(Es),
+ R1 = sofs:relation_to_family(R0),
+ R2 = sofs:to_external(R1),
+
+ %% R2 is now [{KeyValue,[{Order,Op,OriginalKey,Value}]}]
+ R3 = [begin
+ %% The value for the last pair determines the value.
+ {_,_,_,V} = lists:last(Vs),
+ {Op,{_,SortOrder}=K} = map_pair_op_and_key(Vs),
+ {Op,{SortOrder,K,V}}
+ end || {_,Vs} <- R2],
+
+ %% R3 is now [{Op,{Key,Value}}]
+ R = lists:sort(R3),
+
+ %% R4 is now sorted with all alloc first in the list, followed by
+ %% all exact.
+ {Assoc,Exact} = lists:partition(fun({Op,_}) -> Op =:= assoc end, R),
+ {[{K,V} || {_,{_,K,V}} <- Assoc],
+ [{K,V} || {_,{_,K,V}} <- Exact]}.
+
+cg_map_pairs_1([{map_pair_assoc,{_,Kv}=K,V}|T], Order) ->
+ [{Kv,{Order,assoc,K,V}}|cg_map_pairs_1(T, Order+1)];
+cg_map_pairs_1([{map_pair_exact,{_,Kv}=K,V}|T], Order) ->
+ [{Kv,{Order,exact,K,V}}|cg_map_pairs_1(T, Order+1)];
+cg_map_pairs_1([], _) -> [].
+
+%% map_pair_op_and_key({_,Op,K,_}) -> {Operator,Key}
+%% Determine the operator and key to use. Throw a 'badarg'
+%% exception if there are contradictory exact updates.
+
+map_pair_op_and_key(L) ->
+ case [K || {_,exact,K,_} <- L] of
+ [K] ->
+ %% There is a single ':=' operator. Use that key.
+ {exact,K};
+ [K|T] ->
+ %% There is more than one ':=' operator. All of them
+ %% must have the same key.
+ case lists:all(fun(E) -> E =:= K end, T) of
+ true ->
+ {exact,K};
+ false ->
+ %% Some keys are different, e.g. 1 and 1.0.
+ throw(badarg)
+ end;
+ [] ->
+ %% Only '=>' operators. Use the first key in the list.
+ [{_,assoc,K,_}|_] = L,
+ {assoc,K}
+ end.
+
%%%
%%% Code generation for constructing binaries.
%%%