aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/beam
diff options
context:
space:
mode:
authorBjörn-Egil Dahlberg <[email protected]>2012-06-27 17:03:54 +0200
committerBjörn-Egil Dahlberg <[email protected]>2015-03-12 17:16:05 +0100
commit8d3dba44bc2ac5ff9e724e90aa832854280b7d1e (patch)
tree7c5d414977da3901064e6de018f5420ca54bb9b9 /erts/emulator/beam
parent6d521dae843ee098e823e1c4a3bb2e426409dcea (diff)
downloadotp-8d3dba44bc2ac5ff9e724e90aa832854280b7d1e.tar.gz
otp-8d3dba44bc2ac5ff9e724e90aa832854280b7d1e.tar.bz2
otp-8d3dba44bc2ac5ff9e724e90aa832854280b7d1e.zip
Initial Persistent HAMT - Map framework
Conflicts: erts/emulator/Makefile.in erts/emulator/beam/bif.tab erts/emulator/beam/erl_gc.c erts/emulator/beam/erl_gc.h erts/emulator/beam/erl_printf_term.c erts/emulator/beam/erl_term.c erts/emulator/beam/erl_term.h
Diffstat (limited to 'erts/emulator/beam')
-rw-r--r--erts/emulator/beam/beam_emu.c1
-rw-r--r--erts/emulator/beam/bif.tab10
-rw-r--r--erts/emulator/beam/copy.c47
-rw-r--r--erts/emulator/beam/erl_gc.c1
-rw-r--r--erts/emulator/beam/erl_gc.h3
-rw-r--r--erts/emulator/beam/erl_hashmap.c506
-rw-r--r--erts/emulator/beam/erl_hashmap.h149
-rw-r--r--erts/emulator/beam/erl_printf_term.c76
-rw-r--r--erts/emulator/beam/erl_term.c4
-rw-r--r--erts/emulator/beam/erl_term.h9
-rw-r--r--erts/emulator/beam/erl_vm.h4
-rw-r--r--erts/emulator/beam/global.h10
12 files changed, 804 insertions, 16 deletions
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index b89c8b3900..b734d34872 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -2801,6 +2801,7 @@ get_map_elements_fail:
}
PreFetch(1, next);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
reg[0] = r(0);
result = (*bf)(c_p, reg, I);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 1d0d214e77..a3fb21ee52 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -614,6 +614,16 @@ bif erlang:fun_info_mfa/1
bif erlang:get_keys/0
+# Hash Array Mappped Trie
+bif hashmap:put/3
+bif hashmap:get/2
+#bif hashmap:info/1
+bif hashmap:to_list/1
+bif hashmap:new/0
+# bif hashmap:keys/1
+bif hashmap:size/1
+bif erlang:is_hashmap/1
+
#
# Obsolete
#
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index 0010f6a440..6294ba9412 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -33,6 +33,7 @@
#include "erl_binary.h"
#include "erl_bits.h"
#include "dtrace-wrapper.h"
+#include "erl_hashmap.h"
static void move_one_frag(Eterm** hpp, Eterm* src, Uint src_sz, ErlOffHeap*);
@@ -127,6 +128,35 @@ Uint size_object(Eterm obj)
obj = *bptr;
break;
}
+ case HASHMAP_SUBTAG:
+ switch (MAP_HEADER_TYPE(hdr)) {
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP :
+ {
+ Eterm *head;
+ Uint sz;
+ head = hashmap_val_rel(obj, base);
+ sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ sum += 1 + sz + header_arity(hdr);
+ head += 1 + header_arity(hdr);
+
+ if (sz == 0) {
+ goto pop_next;
+ }
+ while(sz-- > 1) {
+ obj = head[sz];
+ if (!IS_CONST(obj)) {
+ ESTACK_PUSH(s, obj);
+ }
+ }
+ obj = head[0];
+ }
+ break;
+ default:
+ erl_exit(ERTS_ABORT_EXIT, "size_object: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
+ }
+ break;
case SUB_BINARY_SUBTAG:
{
Eterm real_bin;
@@ -459,7 +489,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
{
ExternalThing *etp = (ExternalThing *) htop;
- i = thing_arityval(hdr) + 1;
+ i = thing_arityval(hdr) + 1;
tp = htop;
while (i--) {
@@ -473,6 +503,21 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
*argp = make_external_rel(tp, dst_base);
}
break;
+ case HASHMAP_SUBTAG:
+ tp = htop;
+ switch (MAP_HEADER_TYPE(hdr)) {
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
+ *htop++ = *objp++;
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP :
+ i = 1 + hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ while (i--) { *htop++ = *objp++; }
+ *argp = make_hashmap_rel(tp, dstbase);
+ break;
+ default:
+ erl_exit(ERTS_ABORT_EXIT, "copy_struct: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
+ }
+ break;
case BIN_MATCHSTATE_SUBTAG:
erl_exit(ERTS_ABORT_EXIT,
"copy_struct: matchstate term not allowed");
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index d1a7ee113b..bdf7aa362e 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -31,6 +31,7 @@
#include "erl_binary.h"
#include "erl_bits.h"
#include "erl_map.h"
+#include "erl_hashmap.h"
#include "error.h"
#include "big.h"
#include "erl_gc.h"
diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h
index bf0496c112..3fec553684 100644
--- a/erts/emulator/beam/erl_gc.h
+++ b/erts/emulator/beam/erl_gc.h
@@ -56,6 +56,8 @@ do { \
switch ((HDR) & _HEADER_SUBTAG_MASK) { \
case SUB_BINARY_SUBTAG: nelts++; break; \
case MAP_SUBTAG: nelts+=map_get_size(PTR) + 1; break; \
+ case HASHMAP_SUBTAG: nelts=hashmap_bitcount(MAP_HEADER_VAL(HDR)); \
+ nelts += is_hashmap_header_head(HDR) ? 1 : 0; break; \
case FUN_SUBTAG: nelts+=((ErlFunThing*)(PTR))->num_free+1; break; \
} \
gval = make_boxed(HTOP); \
@@ -63,7 +65,6 @@ do { \
*HTOP++ = HDR; \
*PTR++ = gval; \
while (nelts--) *HTOP++ = *PTR++; \
- \
} while(0)
#define in_area(ptr,start,nbytes) \
diff --git a/erts/emulator/beam/erl_hashmap.c b/erts/emulator/beam/erl_hashmap.c
new file mode 100644
index 0000000000..b7d5d2e2eb
--- /dev/null
+++ b/erts/emulator/beam/erl_hashmap.c
@@ -0,0 +1,506 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2011. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ *
+ * hashmaps are an adaption of Rich Hickeys Persistent HashMaps
+ * which were an adaption of Phil Bagwells - Hash Array Mapped Tries
+ *
+ * Author: Björn-Egil Dahlberg
+ */
+/*
+ * Ls = lists:seq(1,188888).
+ * A = lists:foldl(fun(I,O) -> hashmap:put(I,I,O) end, hashmap:new(), Ls).
+ * lists:foreach(fun(I) -> io:format("looking up ~p got ~p~n", [I, hashmap:get(I, A)]), I = hashmap:get(I,A) end, Ls).
+ *
+ * lists:foldl(fun(I,O) -> hashmap:put(I,I,O) end, hashmap:new(), lists:seq(1,7)).
+ *
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include "sys.h"
+#include "erl_vm.h"
+#include "global.h"
+#include "erl_process.h"
+#include "error.h"
+#include "bif.h"
+
+#include "erl_hashmap.h"
+
+#ifndef DECL_AM
+#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
+#endif
+
+static char *format_binary(Uint64 x, char *b) {
+ int z;
+ b[64] = '\0';
+ for (z = 0; z < 64; z++) {
+ b[63-z] = ((x>>z) & 0x1) ? '1' : '0';
+ }
+ return b;
+}
+
+static Uint32 hashmap_shift_hash(Uint32 hx, Uint *lvl, Eterm key);
+static Uint32 hashmap_restore_hash(Uint lvl, Eterm key);
+static Eterm hashmap_insert(Process *p, Uint32 hx, Eterm key, Eterm value, Eterm node);
+static const Eterm *hashmap_get(Uint32 hx, Eterm key, Eterm node);
+static Eterm hashmap_to_list(Process *p, Eterm map);
+
+/* hashmap:new/0 */
+
+BIF_RETTYPE hashmap_new_0(BIF_ALIST_0) {
+ Eterm* hp;
+ hashmap_head_t *head;
+
+ hp = HAlloc(BIF_P, HAMT_HEAD_EMPTY_SZ);
+ head = (hashmap_head_t *) hp;
+
+ head->thing_word = MAP_HEADER_HAMT_HEAD_BITMAP(0);
+ head->size = 0;
+
+ BIF_RET(make_hashmap(head));
+}
+
+/* hashmap:put/3 */
+
+BIF_RETTYPE hashmap_put_3(BIF_ALIST_3) {
+ if (is_hashmap(BIF_ARG_3)) {
+ Uint32 hx = make_hash2(BIF_ARG_1);
+ Eterm map;
+
+ map = hashmap_insert(BIF_P, hx, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ ASSERT(is_hashmap(map));
+ BIF_RET(map);
+ }
+ BIF_ERROR(BIF_P, BADARG);
+}
+
+/* hashmap:to_list/1 */
+
+BIF_RETTYPE hashmap_to_list_1(BIF_ALIST_1) {
+ if (is_hashmap(BIF_ARG_1)) {
+ return hashmap_to_list(BIF_P, BIF_ARG_1);
+ }
+
+ BIF_ERROR(BIF_P, BADARG);
+}
+
+/* hashmap:get/2 */
+
+BIF_RETTYPE hashmap_get_2(BIF_ALIST_2) {
+ if (is_hashmap(BIF_ARG_2)) {
+ const Eterm *value;
+ Uint32 hx = make_hash2(BIF_ARG_1);
+
+ if ((value = hashmap_get(hx, BIF_ARG_1, BIF_ARG_2)) != NULL) {
+ BIF_RET(*value);
+ }
+ }
+ BIF_ERROR(BIF_P, BADARG);
+}
+
+/* hashmap:size/1 */
+
+BIF_RETTYPE hashmap_size_1(BIF_ALIST_1) {
+ if (is_hashmap(BIF_ARG_1)) {
+ Eterm *head, *hp, res;
+ Uint size, hsz=0;
+
+ head = hashmap_val(BIF_ARG_1);
+ size = head[1];
+ (void) erts_bld_uint(NULL, &hsz, size);
+ hp = HAlloc(BIF_P, hsz);
+ res = erts_bld_uint(&hp, NULL, size);
+ BIF_RET(res);
+ }
+ BIF_ERROR(BIF_P, BADARG);
+}
+
+/* erlang:is_hashmap/1 */
+
+BIF_RETTYPE is_hashmap_1(BIF_ALIST_1) {
+ if (is_hashmap(BIF_ARG_1)) {
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+}
+
+/* impl. */
+
+static const Eterm *hashmap_get(Uint32 hx, Eterm key, Eterm node) {
+ Eterm *ptr, hdr;
+ Uint ix,slot, lvl = 0;
+ Uint32 hval,bp;
+
+ for (;;) {
+ switch(primary_tag(node)) {
+ case TAG_PRIMARY_LIST: /* LEAF NODE [K|V] */
+ ptr = list_val(node);
+ if (EQ(CAR(ptr), key)) {
+ return &(CDR(ptr));
+ }
+ return NULL;
+ case TAG_PRIMARY_BOXED:
+ ptr = boxed_val(node);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_NODE_ARRAY:
+ ix = hashmap_index(hx);
+ hx = hashmap_shift_hash(hx,&lvl,key);
+ node = ptr[ix+1];
+ break;
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ ix = hashmap_index(hx);
+ hx = hashmap_shift_hash(hx,&lvl,key);
+ node = ptr[ix+2];
+ break;
+ case HAMT_SUBTAG_NODE_BITMAP:
+ hval = MAP_HEADER_VAL(hdr);
+ ix = hashmap_index(hx);
+ bp = 1 << ix;
+ slot = hashmap_bitcount(hval & (bp - 1));
+
+ /* occupied */
+ if (bp & hval) {
+ hx = hashmap_shift_hash(hx,&lvl,key);
+ node = ptr[slot+1];
+ break;
+ }
+ /* not occupied */
+ return NULL;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ hval = MAP_HEADER_VAL(hdr);
+ ix = hashmap_index(hx);
+ bp = 1 << ix;
+ slot = hashmap_bitcount(hval & (bp - 1));
+
+ /* occupied */
+ if (bp & hval) {
+ hx = hashmap_shift_hash(hx,&lvl,key);
+ node = ptr[slot+2];
+ break;
+ }
+ /* not occupied */
+ return NULL;
+ default:
+ erl_exit(1, "bad header tag %ld\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
+ break;
+ }
+ break;
+ default:
+ erl_exit(1, "bad primary tag %p\r\n", node);
+ break;
+ }
+ }
+ return NULL;
+}
+
+static Eterm hashmap_insert(Process *p, Uint32 hx, Eterm key, Eterm value, Eterm node) {
+ Eterm *hp = NULL, *nhp = NULL;
+ Eterm *ptr;
+ Eterm hdr,res,ckey,fake;
+ Uint32 ix, cix, bp, hval, chx;
+ Uint slot, lvl = 0, clvl;
+ Uint size = 0, n = 0, update_size = 1;
+ DECLARE_ESTACK(stack);
+
+ for (;;) {
+ switch(primary_tag(node)) {
+ case TAG_PRIMARY_LIST: /* LEAF NODE [K|V] */
+ ptr = list_val(node);
+ ckey = CAR(ptr);
+ if (EQ(ckey, key)) {
+ update_size = 0;
+ goto unroll;
+ }
+ goto insert_subnodes;
+ case TAG_PRIMARY_BOXED:
+ ptr = boxed_val(node);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_NODE_ARRAY:
+ ix = hashmap_index(hx);
+ hx = hashmap_shift_hash(hx,&lvl,key);
+ size += HAMT_NODE_ARRAY_SZ;
+ ESTACK_PUSH2(stack, ix, node);
+ node = ptr[ix+1];
+ break;
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ ix = hashmap_index(hx);
+ hx = hashmap_shift_hash(hx,&lvl,key);
+ size += HAMT_HEAD_ARRAY_SZ;
+ ESTACK_PUSH2(stack, ix, node);
+ node = ptr[ix+2];
+ break;
+ case HAMT_SUBTAG_NODE_BITMAP:
+ hval = MAP_HEADER_VAL(hdr);
+ ix = hashmap_index(hx);
+ bp = 1 << ix;
+ slot = hashmap_bitcount(hval & (bp - 1));
+ n = hashmap_bitcount(hval);
+
+ ESTACK_PUSH(stack, n);
+ ESTACK_PUSH3(stack, bp, slot, node);
+
+ /* occupied */
+ if (bp & hval) {
+ hx = hashmap_shift_hash(hx,&lvl,key);
+ node = ptr[slot+1];
+ ASSERT(HAMT_NODE_BITMAP_SZ(n) <= 17);
+ size += HAMT_NODE_BITMAP_SZ(n);
+ break;
+ }
+ /* not occupied */
+ size += HAMT_NODE_BITMAP_SZ(n+1);
+ goto unroll;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ hval = MAP_HEADER_VAL(hdr);
+ ix = hashmap_index(hx);
+ bp = 1 << ix;
+ slot = hashmap_bitcount(hval & (bp - 1));
+ n = hashmap_bitcount(hval);
+
+ ESTACK_PUSH(stack, n);
+ ESTACK_PUSH3(stack, bp, slot, node);
+
+ /* occupied */
+ if (bp & hval) {
+ hx = hashmap_shift_hash(hx,&lvl,key);
+ node = ptr[slot+2];
+ ASSERT(HAMT_HEAD_BITMAP_SZ(n) <= 18);
+ size += HAMT_HEAD_BITMAP_SZ(n);
+ break;
+ }
+ /* not occupied */
+ size += HAMT_HEAD_BITMAP_SZ(n+1);
+ goto unroll;
+ default:
+ erl_exit(1, "bad header tag %ld\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
+ break;
+ }
+ break;
+ default:
+ erl_exit(1, "bad primary tag %p\r\n", node);
+ break;
+ }
+ }
+insert_subnodes:
+ clvl = lvl;
+ chx = hashmap_restore_hash(clvl,ckey);
+ size += HAMT_NODE_BITMAP_SZ(2);
+ ix = hashmap_index(hx);
+ cix = hashmap_index(chx);
+
+ while (cix == ix) {
+ ESTACK_PUSH(stack, 0);
+ ESTACK_PUSH3(stack, 1 << ix, 0, MAP_HEADER_HAMT_NODE_BITMAP(0));
+ size += HAMT_NODE_BITMAP_SZ(1);
+ hx = hashmap_shift_hash(hx,&lvl,key);
+ chx = hashmap_shift_hash(chx,&clvl,ckey);
+ ix = hashmap_index(hx);
+ cix = hashmap_index(chx);
+ }
+ ESTACK_PUSH3(stack, cix, ix, node);
+
+unroll:
+ size += 2;
+ hp = HAlloc(p, size);
+ res = CONS(hp, key, value); hp += 2;
+
+ do {
+ node = ESTACK_POP(stack);
+ switch(primary_tag(node)) {
+ case TAG_PRIMARY_LIST:
+ ix = (Uint32) ESTACK_POP(stack);
+ cix = (Uint32) ESTACK_POP(stack);
+
+ nhp = hp;
+ *hp++ = MAP_HEADER_HAMT_NODE_BITMAP((1 << ix) | (1 << cix));
+ if (ix < cix) {
+ *hp++ = res;
+ *hp++ = node;
+ } else {
+ *hp++ = node;
+ *hp++ = res;
+ }
+ res = make_hashmap(nhp);
+ break;
+ case TAG_PRIMARY_HEADER:
+ /* subnodes, fake it */
+ fake = node;
+ node = make_boxed(&fake);
+ case TAG_PRIMARY_BOXED:
+ ptr = boxed_val(node);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_NODE_ARRAY:
+ slot = (Uint) ESTACK_POP(stack);
+ nhp = hp;
+ n = HAMT_NODE_ARRAY_SZ;
+ while(n--) { *hp++ = *ptr++; }
+ nhp[slot+1] = res;
+ res = make_hashmap(nhp);
+ break;
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ slot = (Uint) ESTACK_POP(stack);
+ nhp = hp;
+ n = HAMT_HEAD_ARRAY_SZ - 2;
+ *hp++ = MAP_HEADER_HAMT_HEAD_ARRAY; ptr++;
+ *hp++ = (*ptr++) + update_size;
+ while(n--) { *hp++ = *ptr++; }
+ nhp[slot+2] = res;
+ res = make_hashmap(nhp);
+ break;
+ case HAMT_SUBTAG_NODE_BITMAP:
+ slot = (Uint) ESTACK_POP(stack);
+ bp = (Uint32) ESTACK_POP(stack);
+ n = (Uint32) ESTACK_POP(stack);
+ hval = MAP_HEADER_VAL(hdr);
+ nhp = hp;
+ *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(hval | bp); ptr++;
+
+ n -= slot;
+ while(slot--) { *hp++ = *ptr++; }
+ *hp++ = res;
+ if (hval & bp) { ptr++; n--; }
+ while(n--) { *hp++ = *ptr++; }
+
+ if ((hval | bp) == 0xffff) {
+ *nhp = make_arityval(16);
+ }
+ res = make_hashmap(nhp);
+ break;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ slot = (Uint) ESTACK_POP(stack);
+ bp = (Uint32) ESTACK_POP(stack);
+ n = (Uint32) ESTACK_POP(stack);
+ hval = MAP_HEADER_VAL(hdr);
+ nhp = hp;
+ *hp++ = MAP_HEADER_HAMT_HEAD_BITMAP(hval | bp); ptr++;
+ *hp++ = (*ptr++) + update_size;
+
+ n -= slot;
+ while(slot--) { *hp++ = *ptr++; }
+ *hp++ = res;
+ if (hval & bp) { ptr++; n--; }
+ while(n--) { *hp++ = *ptr++; }
+
+ if ((hval | bp) == 0xffff) {
+ *nhp = MAP_HEADER_HAMT_HEAD_ARRAY;
+ }
+ res = make_hashmap(nhp);
+ break;
+ default:
+ erl_exit(1, "bad header tag %x\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
+ break;
+ }
+ break;
+ default:
+ erl_exit(1, "bad primary tag %x\r\n", primary_tag(node));
+ break;
+ }
+
+ } while(!ESTACK_ISEMPTY(stack));
+
+ DESTROY_ESTACK(stack);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(p);
+ ERTS_HOLE_CHECK(p);
+ return res;
+}
+
+static Eterm hashmap_to_list(Process *p, Eterm node) {
+ Eterm *hp;
+ Eterm res = NIL;
+ Eterm *ptr, tup, hdr;
+ Uint sz, n;
+ DECLARE_ESTACK(stack);
+
+ ptr = boxed_val(node);
+ n = (Uint)ptr[1];
+ hp = HAlloc(p, n * (2 + 3));
+ ESTACK_PUSH(stack, node);
+ do {
+ node = ESTACK_POP(stack);
+ switch(primary_tag(node)) {
+ case TAG_PRIMARY_LIST:
+ ptr = list_val(node);
+ tup = TUPLE2(hp, CAR(ptr), CDR(ptr)); hp += 3;
+ res = CONS(hp, tup, res); hp += 2;
+ break;
+ case TAG_PRIMARY_BOXED:
+ ptr = boxed_val(node);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ ptr++;
+ case HAMT_SUBTAG_NODE_ARRAY:
+ ptr++;
+ sz = 16;
+ while(sz--) { ESTACK_PUSH(stack, ptr[sz]); }
+ break;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ ptr++;
+ case HAMT_SUBTAG_NODE_BITMAP:
+ sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ ASSERT(sz < 17);
+ ptr++;
+ while(sz--) { ESTACK_PUSH(stack, ptr[sz]); }
+ break;
+ default:
+ erl_exit(1, "bad header\r\n");
+ break;
+ }
+ }
+ } while(!ESTACK_ISEMPTY(stack));
+
+ DESTROY_ESTACK(stack);
+ ERTS_HOLE_CHECK(p);
+ return res;
+}
+
+static Uint32 hashmap_restore_hash(Uint lvl, Eterm key) {
+ Eterm heap[2], ret;
+
+ if (lvl < 8) {
+ return make_hash2(key) >> (4*lvl);
+ }
+ ret = CONS(heap, make_small(lvl), key);
+
+ return make_hash2(ret) >> (4*(lvl % 8));
+}
+
+static Uint32 hashmap_shift_hash(Uint32 hx, Uint *lvl, Eterm key) {
+ Eterm heap[2], ret;
+
+ /* rehash with [ lvl | key ] */
+ *lvl = *lvl + 1;
+ if (*lvl % 8) {
+ return hx >> 4;
+ }
+
+ ret = CONS(heap, make_small((*lvl)), key);
+ return make_hash2(ret);
+}
diff --git a/erts/emulator/beam/erl_hashmap.h b/erts/emulator/beam/erl_hashmap.h
new file mode 100644
index 0000000000..03739fa1f9
--- /dev/null
+++ b/erts/emulator/beam/erl_hashmap.h
@@ -0,0 +1,149 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2011. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+
+#ifndef __ERL_HASH_H__
+#define __ERL_HASH_H__
+
+#include "sys.h"
+
+Eterm erts_hashmap_get(Eterm key, Eterm map);
+
+/* erl_term.h stuff */
+#define make_hashmap(x) make_boxed((Eterm*)(x))
+#define make_hashmap_rel make_boxed_rel
+#define is_hashmap(x) (is_boxed((x)) && is_hashmap_header(*boxed_val((x))))
+#define is_hashmap_header(x) (((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_HASHMAP)
+#define hashmap_val(x) _unchecked_boxed_val((x))
+#define hashmap_val_rel(RTERM, BASE) hashmap_val(rterm2wterm(RTERM, BASE))
+
+/* HASH */
+
+
+#if defined(__GNUC__)
+#define hashmap_bitcount(x) (Uint32) __builtin_popcount((unsigned int) (x))
+#else
+const Uint32 SK5 = 0x55555555, SK3 = 0x33333333;
+const Uint32 SKF0 = 0xF0F0F0F, SKFF = 0xFF00FF;
+
+/* CTPOP emulation */
+Uint32 hashmap_bitcount(Uint32 map) {
+ map -= (( map >> 1 ) & SK5 );
+ map = ( map & SK3 ) + (( map >> 2 ) & SK3 );
+ map = ( map & SKF0 ) + (( map >> 4 ) & SKF0);
+ map += map >> 8;
+ return ( map + ( map >> 16)) & 0x3F;
+}
+#endif
+
+/* hamt nodes v2.0
+ *
+ * node :: leaf | array | bitmap
+ * head
+ */
+
+/* the head-node is a bitmap or array with an untagged size
+ */
+typedef struct hashmap_head_s {
+ Eterm thing_word;
+ Uint size;
+ Eterm items[1];
+} hashmap_head_t;
+
+/* the bitmap-node
+ * typedef struct hashmap_bitmap_node_s {
+ * Eterm thing_word;
+ * Eterm items[1];
+ * } hashmap_bitmap_node_t;
+ *
+ * the array-node is a tuple
+ * typedef struct hashmap_bitmap_node_s {
+ * Eterm thing_word;
+ * Eterm items[1];
+ * } hashmap_bitmap_node_t;
+ *
+ * the leaf-node
+ * cons-cell
+ */
+
+/* thing_word tagscheme
+ * Need two bits for map subtags
+ *
+ * Original HEADER representation:
+ *
+ * aaaaaaaaaaaaaaaa aaaaaaaaaatttt00 arity:26, tag:4
+ *
+ * For maps we have:
+ *
+ * vvvvvvvvvvvvvvvv aaaaaaaamm111100 val:16, arity:8, mtype:2
+ *
+ * unsure about trailing zeros
+ *
+ * map-tag:
+ * 00 - flat map tag (non-hamt) -> val:16 = #items
+ * 01 - map-node bitmap tag -> val:16 = bitmap
+ * 10 - map-head (array-node) -> val:16 = 0xffff
+ * 11 - map-head (bitmap-node) -> val:16 = bitmap
+ */
+
+/* erl_map.h stuff */
+
+#define MAP_HEADER_TAG_SZ (2)
+#define MAP_HEADER_ARITY_SZ (8)
+#define MAP_HEADER_VAL_SZ (16)
+
+#define MAP_HEADER_TAG_FLAT (0x0)
+#define MAP_HEADER_TAG_HAMT_NODE_BITMAP (0x1)
+#define MAP_HEADER_TAG_HAMT_HEAD_ARRAY (0x2)
+#define MAP_HEADER_TAG_HAMT_HEAD_BITMAP (0x3)
+
+#define MAP_HEADER_TYPE(Hdr) (((Hdr) >> (_HEADER_ARITY_OFFS)) & (0x3))
+#define MAP_HEADER_ARITY(Hdr) (((Hdr) >> (_HEADER_ARITY_OFFS + MAP_HEADER_TAG_SZ)) & (0xff))
+#define MAP_HEADER_VAL(Hdr) (((Hdr) >> (_HEADER_ARITY_OFFS + MAP_HEADER_TAG_SZ + MAP_HEADER_ARITY_SZ)) & (0xffff))
+
+#define is_hashmap_header_head(x) ((MAP_HEADER_TYPE(x) & (0x2)))
+
+#define MAKE_MAP_HEADER(Type,Arity,Val) \
+ (_make_header(((((Uint16)Val) << MAP_HEADER_ARITY_SZ) | (Arity)) << MAP_HEADER_TAG_SZ | (Type) , _TAG_HEADER_HASHMAP))
+
+#define MAP_HEADER_HAMT_HEAD_ARRAY \
+ MAKE_MAP_HEADER(MAP_HEADER_TAG_HAMT_HEAD_ARRAY,0x1,0xffff)
+
+#define MAP_HEADER_HAMT_HEAD_BITMAP(Bmp) \
+ MAKE_MAP_HEADER(MAP_HEADER_TAG_HAMT_HEAD_BITMAP,0x1,Bmp)
+
+#define MAP_HEADER_HAMT_NODE_BITMAP(Bmp) \
+ MAKE_MAP_HEADER(MAP_HEADER_TAG_HAMT_NODE_BITMAP,0x0,Bmp)
+
+#define HAMT_HEAD_EMPTY_SZ (2)
+#define HAMT_NODE_ARRAY_SZ (17)
+#define HAMT_HEAD_ARRAY_SZ (18)
+#define HAMT_NODE_BITMAP_SZ(n) (1 + n)
+#define HAMT_HEAD_BITMAP_SZ(n) (2 + n)
+
+#define _HEADER_MAP_SUBTAG_MASK (0xfc) /* 2 bits maps tag + 4 bits subtag + 2 ignore bits */
+/* SUBTAG_NODE_ARRAY is in fact a tuple with 16 elements */
+#define HAMT_SUBTAG_NODE_ARRAY (((16 << _HEADER_ARITY_OFFS) | ARITYVAL_SUBTAG) & _HEADER_MAP_SUBTAG_MASK)
+#define HAMT_SUBTAG_NODE_BITMAP ((MAP_HEADER_TAG_HAMT_NODE_BITMAP << _HEADER_ARITY_OFFS) | HASHMAP_SUBTAG)
+#define HAMT_SUBTAG_HEAD_ARRAY ((MAP_HEADER_TAG_HAMT_HEAD_ARRAY << _HEADER_ARITY_OFFS) | HASHMAP_SUBTAG)
+#define HAMT_SUBTAG_HEAD_BITMAP ((MAP_HEADER_TAG_HAMT_HEAD_BITMAP << _HEADER_ARITY_OFFS) | HASHMAP_SUBTAG)
+
+#define hashmap_index(hash) (((Uint32)hash) & 0xf)
+
+#endif
diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c
index c982dc2080..f07fe30cf6 100644
--- a/erts/emulator/beam/erl_printf_term.c
+++ b/erts/emulator/beam/erl_printf_term.c
@@ -26,12 +26,13 @@
#include "big.h"
#include "erl_map.h"
#include "erl_binary.h"
+#include "erl_hashmap.h"
#define PRINT_CHAR(CNT, FN, ARG, C) \
do { \
int res__ = erts_printf_char((FN), (ARG), (C)); \
if (res__ < 0) \
- return res__; \
+ abort(); \
(CNT) += res__; \
} while (0)
@@ -39,7 +40,7 @@ do { \
do { \
int res__ = erts_printf_string((FN), (ARG), (STR)); \
if (res__ < 0) \
- return res__; \
+ abort(); \
(CNT) += res__; \
} while (0)
@@ -47,7 +48,7 @@ do { \
do { \
int res__ = erts_printf_buf((FN), (ARG), (char*)(BUF), (LEN)); \
if (res__ < 0) \
- return res__; \
+ abort(); \
(CNT) += res__; \
} while (0)
@@ -55,7 +56,7 @@ do { \
do { \
int res__ = erts_printf_pointer((FN), (ARG), (void *) (PTR)); \
if (res__ < 0) \
- return res__; \
+ abort(); \
(CNT) += res__; \
} while (0)
@@ -63,7 +64,7 @@ do { \
do { \
int res__ = erts_printf_uword((FN), (ARG), (C), (P), (W), (I)); \
if (res__ < 0) \
- return res__; \
+ abort(); \
(CNT) += res__; \
} while (0)
@@ -71,7 +72,7 @@ do { \
do { \
int res__ = erts_printf_sword((FN), (ARG), (C), (P), (W), (I)); \
if (res__ < 0) \
- return res__; \
+ abort(); \
(CNT) += res__; \
} while (0)
@@ -79,7 +80,7 @@ do { \
do { \
int res__ = erts_printf_double((FN), (ARG), (C), (P), (W), (I)); \
if (res__ < 0) \
- return res__; \
+ abort(); \
(CNT) += res__; \
} while (0)
@@ -247,6 +248,17 @@ static int print_atom_name(fmtfn_t fn, void* arg, Eterm atom, long *dcount)
#define PRT_PATCH_FUN_SIZE ((Eterm) 7)
#define PRT_LAST_ARRAY_ELEMENT ((Eterm) 8) /* Note! Must be last... */
+#if 0
+static char *format_binary(Uint16 x, char *b) {
+ int z;
+ b[16] = '\0';
+ for (z = 0; z < 16; z++) {
+ b[15-z] = ((x>>z) & 0x1) ? '1' : '0';
+ }
+ return b;
+}
+#endif
+
static int
print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
Eterm* obj_base) /* ignored if !HALFWORD_HEAP */
@@ -575,6 +587,54 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
}
}
break;
+ case HASHMAP_DEF:
+ {
+ Uint n,mapval;
+ Eterm *head;
+ head = hashmap_val(wobj);
+ mapval = MAP_HEADER_VAL(*head);
+ switch (MAP_HEADER_TYPE(*head)) {
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP:
+ PRINT_STRING(res, fn, arg, "#<");
+ PRINT_UWORD(res, fn, arg, 'x', 0, 1, mapval);
+ PRINT_STRING(res, fn, arg, ">{");
+ WSTACK_PUSH(s,PRT_CLOSE_TUPLE);
+ n = hashmap_bitcount(mapval);
+ ASSERT(n < 17);
+ head += 2;
+ if (n > 0) {
+ n--;
+ WSTACK_PUSH(s, head[n]);
+ WSTACK_PUSH(s, PRT_TERM);
+ while (n--) {
+ WSTACK_PUSH(s, PRT_COMMA);
+ WSTACK_PUSH(s, head[n]);
+ WSTACK_PUSH(s, PRT_TERM);
+ }
+ }
+ break;
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP:
+ n = hashmap_bitcount(mapval);
+ head++;
+ PRINT_CHAR(res, fn, arg, '<');
+ PRINT_UWORD(res, fn, arg, 'x', 0, 1, mapval);
+ PRINT_STRING(res, fn, arg, ">{");
+ WSTACK_PUSH(s,PRT_CLOSE_TUPLE);
+ ASSERT(n < 17);
+ if (n > 0) {
+ n--;
+ WSTACK_PUSH(s, head[n]);
+ WSTACK_PUSH(s, PRT_TERM);
+ while (n--) {
+ WSTACK_PUSH(s, PRT_COMMA);
+ WSTACK_PUSH(s, head[n]);
+ WSTACK_PUSH(s, PRT_TERM);
+ }
+ }
+ break;
+ }
+ }
+ break;
default:
PRINT_STRING(res, fn, arg, "<unknown:");
PRINT_POINTER(res, fn, arg, wobj);
@@ -584,11 +644,11 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
}
L_done:
-
DESTROY_WSTACK(s);
return res;
}
+
int
erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision,
ErlPfEterm* term_base)
diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c
index 28cbe7004f..d6fb88ea61 100644
--- a/erts/emulator/beam/erl_term.c
+++ b/erts/emulator/beam/erl_term.c
@@ -86,11 +86,13 @@ unsigned tag_val_def(Wterm x)
case (_TAG_HEADER_EXTERNAL_PID >> _TAG_PRIMARY_SIZE): return EXTERNAL_PID_DEF;
case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE): return EXTERNAL_PORT_DEF;
case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): return EXTERNAL_REF_DEF;
+ case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE): return MAP_DEF;
case (_TAG_HEADER_REFC_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF;
case (_TAG_HEADER_HEAP_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF;
case (_TAG_HEADER_SUB_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF;
- case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE): return MAP_DEF;
+ case (_TAG_HEADER_HASHMAP >> _TAG_PRIMARY_SIZE): return HASHMAP_DEF;
}
+
break;
}
case TAG_PRIMARY_IMMED1: {
diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h
index 37014ccf94..fde90997e3 100644
--- a/erts/emulator/beam/erl_term.h
+++ b/erts/emulator/beam/erl_term.h
@@ -21,6 +21,7 @@
#define __ERL_TERM_H
#include "sys.h" /* defines HALFWORD_HEAP */
+#include "erl_hashmap.h"
typedef UWord Wterm; /* Full word terms */
@@ -141,6 +142,7 @@ struct erl_node_; /* Declared in erl_node_tables.h */
#define HEAP_BINARY_SUBTAG (0x9 << _TAG_PRIMARY_SIZE) /* BINARY */
#define SUB_BINARY_SUBTAG (0xA << _TAG_PRIMARY_SIZE) /* BINARY */
/* _BINARY_XXX_MASK depends on 0xB being unused */
+#define HASHMAP_SUBTAG (0xB << _TAG_PRIMARY_SIZE) /* HASHMAP */
#define EXTERNAL_PID_SUBTAG (0xC << _TAG_PRIMARY_SIZE) /* EXTERNAL_PID */
#define EXTERNAL_PORT_SUBTAG (0xD << _TAG_PRIMARY_SIZE) /* EXTERNAL_PORT */
#define EXTERNAL_REF_SUBTAG (0xE << _TAG_PRIMARY_SIZE) /* EXTERNAL_REF */
@@ -162,6 +164,7 @@ struct erl_node_; /* Declared in erl_node_tables.h */
#define _TAG_HEADER_EXTERNAL_REF (TAG_PRIMARY_HEADER|EXTERNAL_REF_SUBTAG)
#define _TAG_HEADER_BIN_MATCHSTATE (TAG_PRIMARY_HEADER|BIN_MATCHSTATE_SUBTAG)
#define _TAG_HEADER_MAP (TAG_PRIMARY_HEADER|MAP_SUBTAG)
+#define _TAG_HEADER_HASHMAP (TAG_PRIMARY_HEADER|HASHMAP_SUBTAG)
#define _TAG_HEADER_MASK 0x3F
@@ -298,7 +301,9 @@ _ET_DECLARE_CHECKED(Uint,atom_val,Eterm)
/* header (arityval or thing) access methods */
#define _make_header(sz,tag) ((Uint)(((sz) << _HEADER_ARITY_OFFS) + (tag)))
#define is_header(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_HEADER)
-#define _unchecked_header_arity(x) ((x) >> _HEADER_ARITY_OFFS)
+//#define _unchecked_header_arity(x) ((x) >> _HEADER_ARITY_OFFS)
+#define _unchecked_header_arity(x) \
+ (is_hashmap_header(x) ? MAP_HEADER_ARITY(x) : ((x) >> _HEADER_ARITY_OFFS))
_ET_DECLARE_CHECKED(Uint,header_arity,Eterm)
#define header_arity(x) _ET_APPLY(header_arity,(x))
@@ -361,6 +366,7 @@ _ET_DECLARE_CHECKED(Uint,thing_subtag,Eterm)
((((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_REFC_BIN) || \
(((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_HEAP_BIN) || \
(((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_SUB_BIN))
+
#define make_binary(x) make_boxed((Eterm*)(x))
#define is_binary(x) (is_boxed((x)) && is_binary_header(*boxed_val((x))))
#define is_not_binary(x) (!is_binary((x)))
@@ -1095,6 +1101,7 @@ _ET_DECLARE_CHECKED(Uint,y_reg_index,Uint)
#define FLOAT_DEF 0xe
#define BIG_DEF 0xf
#define SMALL_DEF 0x10
+#define HASHMAP_DEF 0x11
#if ET_DEBUG
extern unsigned tag_val_def_debug(Wterm, const char*, unsigned);
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index 6e9216bef3..3a9fb1e07b 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -117,9 +117,9 @@
#if defined(DEBUG) || defined(CHECK_FOR_HOLES)
#if HALFWORD_HEAP
-# define ERTS_HOLE_MARKER (0xaf5e78ccU)
+# define ERTS_HOLE_MARKER (0xdeadbeef)
#else
-# define ERTS_HOLE_MARKER (((0xaf5e78ccUL << 24) << 8) | 0xaf5e78ccUL)
+# define ERTS_HOLE_MARKER (((0xdeadbeef << 24) << 8) | 0xdeadbeef)
#endif
#endif
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 5330f389e0..1fb069232a 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -539,6 +539,12 @@ do { \
} \
} while(0)
+#define WSTACK_DEBUG(s) \
+ do { \
+ fprintf(stderr, "wstack size = %ld\r\n", s.wsp - s.wstart); \
+ fprintf(stderr, "wstack wstart = %p\r\n", s.wstart); \
+ fprintf(stderr, "wstack wsp = %p\r\n", s.wsp); \
+ } while(0)
/*
* Do not free the stack after this, it may have pointers into what
@@ -581,7 +587,7 @@ do { \
ASSERT(s.wsp <= s.wend); \
} while (0)
-#define WSTACK_IS_STATIC(s) (s.wstart == WSTK_DEF_STACK(s)))
+#define WSTACK_IS_STATIC(s) (s.wstart == WSTK_DEF_STACK(s))
#define WSTACK_PUSH(s, x) \
do { \
@@ -648,7 +654,7 @@ do { \
#define WSTACK_COUNT(s) (s.wsp - s.wstart)
#define WSTACK_ISEMPTY(s) (s.wsp == s.wstart)
-#define WSTACK_POP(s) (*(--s.wsp))
+#define WSTACK_POP(s) ((ASSERT(s.wsp > s.wstart)),*(--s.wsp))
/* binary.c */