diff options
35 files changed, 1950 insertions, 853 deletions
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index a1d73fb698..9224d73b6f 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -541,6 +541,15 @@ <p>Calling <c>erlang:halt/1</c> with a string argument will still produce a crash dump.</p> </item> + <tag><c><![CDATA[+e Number]]></c></tag> + <item> + <p>Set max number of ETS tables.</p> + </item> + <tag><c><![CDATA[+ec]]></c></tag> + <item> + <p>Force the <c>compressed</c> option on all ETS tables. + Only intended for test and evaluation.</p> + </item> <tag><c><![CDATA[+hms Size]]></c></tag> <item> <p>Sets the default heap size of processes to the size diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index 64caf34550..9ccc3e5ba9 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -38,6 +38,7 @@ #define DFLAG_UNICODE_IO 0x1000 #define DFLAG_DIST_HDR_ATOM_CACHE 0x2000 #define DFLAG_SMALL_ATOM_TAGS 0x4000 +#define DFLAGS_INTERNAL_TAGS 0x8000 /* All flags that should be enabled when term_to_binary/1 is used. */ #define TERM_TO_BINARY_DFLAGS (DFLAG_EXTENDED_REFERENCES \ diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 89e3b3209c..75d8db880c 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -2002,6 +2002,8 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(db_get_trace_control_word_0(BIF_P)); } else if (ERTS_IS_ATOM_STR("ets_realloc_moves", BIF_ARG_1)) { BIF_RET((erts_ets_realloc_always_moves) ? am_true : am_false); + } else if (ERTS_IS_ATOM_STR("ets_always_compress", BIF_ARG_1)) { + BIF_RET((erts_ets_always_compress) ? am_true : am_false); } else if (ERTS_IS_ATOM_STR("snifs", BIF_ARG_1)) { Uint size = 0; Uint *szp; diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 1c2c0fe4cb..8577354d27 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -179,6 +179,7 @@ extern DbTableMethod db_tree; int user_requested_db_max_tabs; int erts_ets_realloc_always_moves; +int erts_ets_always_compress; static int db_max_tabs; static DbTable *meta_pid_to_tab; /* Pid mapped to owned tables */ static DbTable *meta_pid_to_fixed_tab; /* Pid mapped to fixed tables */ @@ -931,7 +932,7 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) position > arityval(handle.dbterm->tpl[0])) { goto finalize; } - oldcnt = handle.dbterm->tpl[position]; + oldcnt = db_do_read_element(&handle, position); if (is_big(oldcnt)) { halloc_size += BIG_NEED_SIZE(big_arity(oldcnt)); } @@ -1276,7 +1277,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) UWord heir_data; Uint32 status; Sint keypos; - int is_named, is_fine_locked, frequent_read; + int is_named, is_fine_locked, frequent_read, is_compressed; int cret; DeclareTmpHeap(meta_tuple,3,BIF_P); DbTableMethod* meth; @@ -1296,6 +1297,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) frequent_read = 0; heir = am_none; heir_data = (UWord) am_undefined; + is_compressed = erts_ets_always_compress; list = BIF_ARG_2; while(is_list(list)) { @@ -1358,6 +1360,9 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) else if (val == am_named_table) { is_named = 1; } + else if (val == am_compressed) { + is_compressed = 1; + } else if (val == am_set || val == am_protected) ; else break; @@ -1418,6 +1423,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) erts_smp_atomic_init(&tb->common.nitems, 0); tb->common.fixations = NULL; + tb->common.compress = is_compressed; cret = meth->db_create(BIF_P, tb); ASSERT(cret == DB_ERROR_NONE); @@ -2572,7 +2578,7 @@ BIF_RETTYPE ets_match_object_3(BIF_ALIST_3) BIF_RETTYPE ets_info_1(BIF_ALIST_1) { static Eterm fields[] = {am_protection, am_keypos, am_type, am_named_table, - am_node, am_size, am_name, am_heir, am_owner, am_memory}; + am_node, am_size, am_name, am_heir, am_owner, am_memory, am_compressed}; Eterm results[sizeof(fields)/sizeof(Eterm)]; DbTable* tb; Eterm res; @@ -2837,6 +2843,7 @@ void init_db(void) erts_smp_atomic_init(&meta_pid_to_tab->common.nitems, 0); meta_pid_to_tab->common.slot = -1; meta_pid_to_tab->common.meth = &db_hash; + meta_pid_to_tab->common.compress = 0; erts_refc_init(&meta_pid_to_tab->common.ref, 1); erts_refc_init(&meta_pid_to_tab->common.fixref, 0); @@ -2869,6 +2876,7 @@ void init_db(void) erts_smp_atomic_init(&meta_pid_to_fixed_tab->common.nitems, 0); meta_pid_to_fixed_tab->common.slot = -1; meta_pid_to_fixed_tab->common.meth = &db_hash; + meta_pid_to_fixed_tab->common.compress = 0; erts_refc_init(&meta_pid_to_fixed_tab->common.ref, 1); erts_refc_init(&meta_pid_to_fixed_tab->common.fixref, 0); @@ -3077,7 +3085,7 @@ retry: db_unlock(tb,LCK_WRITE); heir_data = tb->common.heir_data; if (!is_immed(heir_data)) { - Eterm* tpv = DBTERM_BUF((DbTerm*)heir_data); /* tuple_val */ + Eterm* tpv = ((DbTerm*)heir_data)->tpl; /* tuple_val */ ASSERT(arityval(*tpv) == 1); heir_data = tpv[1]; } @@ -3251,7 +3259,8 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) pp = &(*pp)->next) { if ((*pp)->pid == pid) { DbFixation* fix = *pp; - erts_refc_add(&tb->common.fixref,-fix->counter,0); + long diff = -(long)fix->counter; + erts_refc_add(&tb->common.fixref,diff,0); *pp = fix->next; erts_db_free(ERTS_ALC_T_DB_FIXATION, tb, fix, sizeof(DbFixation)); @@ -3469,8 +3478,8 @@ static void set_heir(Process* me, DbTable* tb, Eterm heir, UWord heir_data) UseTmpHeap(2,me); /* Make a dummy 1-tuple around data to use db_get_term() */ - heir_data = (UWord) db_get_term(&tb->common, NULL, 0, - TUPLE1(tmp,heir_data)); + heir_data = (UWord) db_store_term(&tb->common, NULL, 0, + TUPLE1(tmp,heir_data)); UnUseTmpHeap(2,me); ASSERT(!is_immed(heir_data)); } @@ -3481,7 +3490,7 @@ static void free_heir_data(DbTable* tb) { if (tb->common.heir != am_none && !is_immed(tb->common.heir_data)) { DbTerm* p = (DbTerm*) tb->common.heir_data; - db_free_term_data(p); + db_cleanup_offheap_comp(p); erts_db_free(ERTS_ALC_T_DB_TERM, tb, (void *)p, sizeof(DbTerm) + (p->size-1)*sizeof(Eterm)); } @@ -3618,10 +3627,13 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What) ret = erts_this_dist_entry->sysname; } else if (What == am_named_table) { ret = is_atom(tb->common.id) ? am_true : am_false; + } else if (What == am_compressed) { + ret = tb->common.compress ? am_true : am_false; + } /* * For debugging purposes */ - } else if (What == am_data) { + else if (What == am_data) { print_table(ERTS_PRINT_STDOUT, NULL, 1, tb); ret = am_true; } else if (What == am_atom_put("fixed",5)) { diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h index 7da28fad29..cb2da603f0 100644 --- a/erts/emulator/beam/erl_db.h +++ b/erts/emulator/beam/erl_db.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * Copyright Ericsson AB 1996-2010. 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 @@ -61,6 +61,7 @@ void erts_db_foreach_offheap(DbTable *, extern int user_requested_db_max_tabs; /* set in erl_init */ extern int erts_ets_realloc_always_moves; /* set in erl_init */ +extern int erts_ets_always_compress; /* set in erl_init */ extern Export ets_select_delete_continue_exp; extern Export ets_select_count_continue_exp; extern Export ets_select_continue_exp; diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index fa707f4eed..14ee63100a 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -267,11 +267,11 @@ static ERTS_INLINE Sint next_slot_w(DbTableHash* tb, Uint ix, */ #define BIN_FLAG_ALL_OBJECTS BIN_FLAG_USR1 -/* - * Size calculations - */ -#define SIZ_OVERHEAD ((sizeof(HashDbTerm)/sizeof(Eterm)) - 1) -#define SIZ_DBTERM(HDT) (SIZ_OVERHEAD + (HDT)->dbterm.size) + +static ERTS_INLINE void free_term(DbTableHash *tb, HashDbTerm* p) +{ + db_free_term((DbTable*)tb, p, offsetof(HashDbTerm, dbterm)); +} /* * Local types @@ -358,10 +358,8 @@ static HashDbTerm* search_list(DbTableHash* tb, Eterm key, HashValue hval, HashDbTerm *list); static void shrink(DbTableHash* tb, int nactive); static void grow(DbTableHash* tb, int nactive); -static void free_term(DbTableHash *tb, HashDbTerm* p); -static Eterm put_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2); -static HashDbTerm* get_term(DbTableHash* tb, HashDbTerm* old, - Eterm obj, HashValue hval); +static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2, + DbTableHash*); static int analyze_pattern(DbTableHash *tb, Eterm pattern, struct mp_info *mpi); @@ -442,6 +440,7 @@ static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b, if (b->hvalue != hval) return 0; else { Eterm itemKey = GETKEY(tb, b->dbterm.tpl); + ASSERT(!is_header(itemKey)); return EQ(key,itemKey); } } @@ -454,10 +453,38 @@ static ERTS_INLINE int has_key(DbTableHash* tb, HashDbTerm* b, if (b->hvalue != hval && b->hvalue != INVALID_HASH) return 0; else { Eterm itemKey = GETKEY(tb, b->dbterm.tpl); + ASSERT(!is_header(itemKey)); return EQ(key,itemKey); } } +static ERTS_INLINE HashDbTerm* new_dbterm(DbTableHash* tb, Eterm obj) +{ + HashDbTerm* p; + if (tb->common.compress) { + p = db_store_term_comp(&tb->common, NULL, offsetof(HashDbTerm,dbterm), obj); + } + else { + p = db_store_term(&tb->common, NULL, offsetof(HashDbTerm,dbterm), obj); + } + return p; +} + +static ERTS_INLINE HashDbTerm* replace_dbterm(DbTableHash* tb, HashDbTerm* old, + Eterm obj) +{ + HashDbTerm* ret; + ASSERT(old != NULL); + if (tb->common.compress) { + ret = db_store_term_comp(&tb->common, &(old->dbterm), offsetof(HashDbTerm,dbterm), obj); + } + else { + ret = db_store_term(&tb->common, &(old->dbterm), offsetof(HashDbTerm,dbterm), obj); + } + return ret; +} + + /* ** External interface @@ -764,7 +791,7 @@ int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail) ret = DB_ERROR_BADKEY; goto Ldone; } - q = get_term(tb, b, obj, hval); + q = replace_dbterm(tb, b, obj); q->next = bnext; q->hvalue = hval; /* In case of INVALID_HASH */ *bp = q; @@ -784,7 +811,7 @@ int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail) HashDbTerm** qp = bp; q = b; do { - if (eq(make_tuple(q->dbterm.tpl), obj)) { + if (db_eq(&tb->common,obj,&q->dbterm)) { if (q->hvalue == INVALID_HASH) { erts_smp_atomic_inc(&tb->common.nitems); q->hvalue = hval; @@ -803,7 +830,8 @@ int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail) /*else DB_DUPLICATE_BAG */ Lnew: - q = get_term(tb, NULL, obj, hval); + q = new_dbterm(tb, obj); + q->hvalue = hval; q->next = b; *bp = q; nitems = erts_smp_atomic_inctest(&tb->common.nitems); @@ -844,7 +872,7 @@ int db_get_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) while(b2 != NULL && has_key(tb,b2,key,hval)) b2 = b2->next; } - copy = put_term_list(p, b1, b2); + copy = build_term_list(p, b1, b2, tb); CHECK_TABLES(); *ret = copy; goto done; @@ -967,13 +995,10 @@ static int db_get_element_hash(Process *p, DbTable *tbl, while(b1 != 0) { if (has_live_key(tb,b1,key,hval)) { - Eterm copy; - if (ndex > arityval(b1->dbterm.tpl[0])) { retval = DB_ERROR_BADITEM; goto done; } - if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) { HashDbTerm* b; HashDbTerm* b2 = b1->next; @@ -987,15 +1012,12 @@ static int db_get_element_hash(Process *p, DbTable *tbl, } b2 = b2->next; } - b = b1; while(b != b2) { if (b->hvalue != INVALID_HASH) { Eterm *hp; - Uint sz = size_object(b->dbterm.tpl[ndex])+2; - - hp = HAlloc(p, sz); - copy = copy_struct(b->dbterm.tpl[ndex], sz-2, &hp, &MSO(p)); + Eterm copy = db_copy_element_from_ets(&tb->common, p, + &b->dbterm, ndex, &hp, 2); elem_list = CONS(hp, copy, elem_list); hp += 2; } @@ -1004,8 +1026,8 @@ static int db_get_element_hash(Process *p, DbTable *tbl, *ret = elem_list; } else { - COPY_OBJECT(b1->dbterm.tpl[ndex], p, ©); - *ret = copy; + Eterm* hp; + *ret = db_copy_element_from_ets(&tb->common, p, &b1->dbterm, ndex, &hp, 0); } retval = DB_ERROR_NONE; goto done; @@ -1040,6 +1062,7 @@ int db_erase_bag_exact2(DbTable *tbl, Eterm key, Eterm value) ASSERT(!IS_FIXED(tb)); ASSERT((tb->common.status & DB_BAG)); + ASSERT(!tb->common.compress); while(b != 0) { if (has_live_key(tb,b,key,hval)) { @@ -1139,7 +1162,7 @@ static int db_erase_object_hash(DbTable *tbl, Eterm object, Eterm *ret) while(b != 0) { if (has_live_key(tb,b,key,hval)) { ++nkeys; - if (eq(object, make_tuple(b->dbterm.tpl))) { + if (db_eq(&tb->common,object, &b->dbterm)) { --nitems_diff; if (nkeys==1 && IS_FIXED(tb)) { /* Pseudo remove */ add_fixed_deletion(tb,ix); @@ -1188,7 +1211,7 @@ static int db_slot_hash(Process *p, DbTable *tbl, Eterm slot_term, Eterm *ret) lck = RLOCK_HASH(tb, slot); nactive = NACTIVE(tb); if (slot < nactive) { - *ret = put_term_list(p, BUCKET(tb, slot), 0); + *ret = build_term_list(p, BUCKET(tb, slot), 0, tb); retval = DB_ERROR_NONE; } else if (slot == nactive) { @@ -1232,8 +1255,6 @@ static int db_select_continue_hash(Process *p, int num_left = 1000; HashDbTerm *current = 0; Eterm match_list; - Uint32 dummy; - unsigned sz; Eterm *hp; Eterm match_res; Sint got; @@ -1285,26 +1306,14 @@ static int db_select_continue_hash(Process *p, } for(;;) { if (current->hvalue != INVALID_HASH && - (match_res = - db_prog_match(p,mp, - make_tuple(current->dbterm.tpl), - NULL,0,&dummy), + (match_res = db_prog_match_and_copy(&tb->common, p, mp, all_objects, + ¤t->dbterm, &hp, 2), is_value(match_res))) { - if (all_objects) { - hp = HAlloc(p, current->dbterm.size + 2); - match_res = copy_shallow(DBTERM_BUF(¤t->dbterm), - current->dbterm.size, - &hp, - &MSO(p)); - } else { - sz = size_object(match_res); - - hp = HAlloc(p, sz + 2); - match_res = copy_struct(match_res, sz, &hp, &MSO(p)); - } - match_list = CONS(hp, match_res, match_list); + + match_list = CONS(hp, match_res, match_list); ++got; } + --num_left; save_slot_ix = slot_ix; if ((current = next(tb, (Uint*)&slot_ix, &lck, current)) == NULL) { @@ -1395,9 +1404,7 @@ static int db_select_chunk_hash(Process *p, DbTable *tbl, HashDbTerm *current = 0; unsigned current_list_pos = 0; Eterm match_list; - Uint32 dummy; Eterm match_res; - unsigned sz; Eterm *hp; int num_left = 1000; Uint got = 0; @@ -1464,22 +1471,9 @@ static int db_select_chunk_hash(Process *p, DbTable *tbl, for(;;) { if (current != NULL) { if (current->hvalue != INVALID_HASH) { - match_res = db_prog_match(p,mpi.mp, - make_tuple(current->dbterm.tpl), - NULL,0,&dummy); + match_res = db_prog_match_and_copy(&tb->common, p, mpi.mp, 0, + ¤t->dbterm, &hp, 2); if (is_value(match_res)) { - if (mpi.all_objects) { - hp = HAlloc(p, current->dbterm.size + 2); - match_res = copy_shallow(DBTERM_BUF(¤t->dbterm), - current->dbterm.size, - &hp, - &MSO(p)); - } else { - sz = size_object(match_res); - - hp = HAlloc(p, sz + 2); - match_res = copy_struct(match_res, sz, &hp, &MSO(p)); - } match_list = CONS(hp, match_res, match_list); ++got; } @@ -1594,7 +1588,6 @@ static int db_select_count_hash(Process *p, Uint slot_ix = 0; HashDbTerm* current = NULL; unsigned current_list_pos = 0; - Uint32 dummy; Eterm *hp; int num_left = 1000; Uint got = 0; @@ -1644,8 +1637,8 @@ static int db_select_count_hash(Process *p, for(;;) { if (current != NULL) { if (current->hvalue != INVALID_HASH) { - if (db_prog_match(p, mpi.mp, make_tuple(current->dbterm.tpl), - NULL,0, &dummy) == am_true) { + if (db_prog_match_and_copy(&tb->common, p, mpi.mp, 0, + ¤t->dbterm, NULL,0) == am_true) { ++got; } --num_left; @@ -1713,7 +1706,6 @@ static int db_select_delete_hash(Process *p, Uint slot_ix = 0; HashDbTerm **current = NULL; unsigned current_list_pos = 0; - Uint32 dummy; Eterm *hp; int num_left = 1000; Uint got = 0; @@ -1794,9 +1786,8 @@ static int db_select_delete_hash(Process *p, } else { int did_erase = 0; - if ((db_prog_match(p,mpi.mp, - make_tuple((*current)->dbterm.tpl), - NULL,0,&dummy)) == am_true) { + if (db_prog_match_and_copy(&tb->common, p, mpi.mp, 0, + &(*current)->dbterm, NULL, 0) == am_true) { if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */ if (slot_ix != last_pseudo_delete) { add_fixed_deletion(tb, slot_ix); @@ -1859,7 +1850,6 @@ static int db_select_delete_continue_hash(Process *p, Uint slot_ix; Uint last_pseudo_delete = (Uint)-1; HashDbTerm **current = NULL; - Uint32 dummy; Eterm *hp; int num_left = 1000; Uint got; @@ -1907,8 +1897,8 @@ static int db_select_delete_continue_hash(Process *p, } else { int did_erase = 0; - if ((db_prog_match(p,mp,make_tuple((*current)->dbterm.tpl), - NULL,0,&dummy)) == am_true) { + if (db_prog_match_and_copy(&tb->common, p, mp, 0, + &(*current)->dbterm, NULL, 0) == am_true) { if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */ if (slot_ix != last_pseudo_delete) { add_fixed_deletion(tb, slot_ix); @@ -1970,7 +1960,6 @@ static int db_select_count_continue_hash(Process *p, DbTableHash *tb = &tbl->hash; Uint slot_ix; HashDbTerm* current; - Uint32 dummy; Eterm *hp; int num_left = 1000; Uint got; @@ -2008,8 +1997,8 @@ static int db_select_count_continue_hash(Process *p, current = current->next; continue; } - if (db_prog_match(p, mp, make_tuple(current->dbterm.tpl), - NULL,0,&dummy) == am_true) { + if (db_prog_match_and_copy(&tb->common, p, mp, 0, ¤t->dbterm, + NULL, 0) == am_true) { ++got; } --num_left; @@ -2454,31 +2443,19 @@ static int free_seg(DbTableHash *tb, int free_records) } -static HashDbTerm* get_term(DbTableHash* tb, HashDbTerm* old, - Eterm obj, HashValue hval) -{ - HashDbTerm* p = db_get_term((DbTableCommon *) tb, - (old != NULL) ? &(old->dbterm) : NULL, - ((char *) &(old->dbterm)) - ((char *) old), - obj); - p->hvalue = hval; - /*p->next = NULL;*/ /*No Need */ - return p; -} - - /* ** Copy terms from ptr1 until ptr2 ** works for ptr1 == ptr2 == 0 => [] ** or ptr2 == 0 */ -static Eterm put_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2) +static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2, + DbTableHash* tb) { int sz = 0; HashDbTerm* ptr; Eterm list = NIL; Eterm copy; - Eterm *hp; + Eterm *hp, *hend; ptr = ptr1; while(ptr != ptr2) { @@ -2490,26 +2467,20 @@ static Eterm put_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2) } hp = HAlloc(p, sz); + hend = hp + sz; ptr = ptr1; while(ptr != ptr2) { if (ptr->hvalue != INVALID_HASH) { - copy = copy_shallow(DBTERM_BUF(&ptr->dbterm), ptr->dbterm.size, &hp, &MSO(p)); + copy = db_copy_object_from_ets(&tb->common, &ptr->dbterm, &hp, &MSO(p)); list = CONS(hp, copy, list); hp += 2; } ptr = ptr->next; } - return list; -} + HRelease(p,hend,hp); -static void free_term(DbTableHash *tb, HashDbTerm* p) -{ - db_free_term_data(&(p->dbterm)); - erts_db_free(ERTS_ALC_T_DB_TERM, - (DbTable *) tb, - (void *) p, - SIZ_DBTERM(p)*sizeof(Eterm)); + return list; } /* Grow table with one new bucket. @@ -2720,8 +2691,8 @@ static int db_lookup_dbterm_hash(DbTable *tbl, Eterm key, DbUpdateHandle* handle handle->tb = tbl; handle->bp = (void**) prevp; handle->dbterm = &b->dbterm; - handle->new_size = b->dbterm.size; handle->mustResize = 0; + handle->new_size = b->dbterm.size; handle->lck = lck; /* KEEP hval WLOCKED, db_finalize_dbterm_hash will WUNLOCK */ return 1; @@ -2742,37 +2713,14 @@ static void db_finalize_dbterm_hash(DbUpdateHandle* handle) erts_smp_rwmtx_t* lck = (erts_smp_rwmtx_t*) handle->lck; ERTS_SMP_LC_ASSERT(IS_HASH_WLOCKED(&tbl->hash,lck)); /* locked by db_lookup_dbterm_hash */ - ASSERT(&oldp->dbterm == handle->dbterm); - if (handle->mustResize) { - ErlOffHeap tmp_offheap; - Eterm* top; - Eterm copy; - DbTerm* newDbTerm; - HashDbTerm* newp = erts_db_alloc(ERTS_ALC_T_DB_TERM, tbl, - sizeof(HashDbTerm)+sizeof(Eterm)*(handle->new_size-1)); - sys_memcpy(newp, oldp, sizeof(HashDbTerm)-sizeof(DbTerm)); /* copy only hashtab header */ - *(handle->bp) = newp; - newDbTerm = &newp->dbterm; - - newDbTerm->size = handle->new_size; - tmp_offheap.first = NULL; - tmp_offheap.overhead = 0; - - /* make a flat copy */ - top = DBTERM_BUF(newDbTerm); - copy = copy_struct(make_tuple(handle->dbterm->tpl), - handle->new_size, - &top, &tmp_offheap); - newDbTerm->first_oh = tmp_offheap.first; - DBTERM_SET_TPL(newDbTerm,tuple_val(copy)); + ASSERT((&oldp->dbterm == handle->dbterm) == !(tbl->common.compress && handle->mustResize)); + if (handle->mustResize) { + db_finalize_resize(handle, offsetof(HashDbTerm,dbterm)); WUNLOCK_HASH(lck); - - db_free_term_data(handle->dbterm); - erts_db_free(ERTS_ALC_T_DB_TERM, tbl, - (void *) (((char *) handle->dbterm) - (sizeof(HashDbTerm) - sizeof(DbTerm))), - sizeof(HashDbTerm) + sizeof(Eterm)*(handle->dbterm->size-1)); + + free_term(&tbl->hash, oldp); } else { WUNLOCK_HASH(lck); @@ -2781,7 +2729,7 @@ static void db_finalize_dbterm_hash(DbUpdateHandle* handle) handle->dbterm = 0; #endif return; -} +} static int db_delete_all_objects_hash(Process* p, DbTable* tbl) { diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 5644e85f97..8108494fc5 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -122,12 +122,41 @@ static void release_stack(DbTableTree* tb, DbTreeStack* stack) } } -static void reset_static_stack(DbTableTree* tb) +static ERTS_INLINE void reset_static_stack(DbTableTree* tb) { tb->static_stack.pos = 0; tb->static_stack.slot = 0; } +static ERTS_INLINE void free_term(DbTableTree *tb, TreeDbTerm* p) +{ + db_free_term((DbTable*)tb, p, offsetof(TreeDbTerm, dbterm)); +} + +static ERTS_INLINE TreeDbTerm* new_dbterm(DbTableTree *tb, Eterm obj) +{ + TreeDbTerm* p; + if (tb->common.compress) { + p = db_store_term_comp(&tb->common, NULL, offsetof(TreeDbTerm,dbterm), obj); + } + else { + p = db_store_term(&tb->common, NULL, offsetof(TreeDbTerm,dbterm), obj); + } + return p; +} +static ERTS_INLINE TreeDbTerm* replace_dbterm(DbTableTree *tb, TreeDbTerm* old, + Eterm obj) +{ + TreeDbTerm* p; + ASSERT(old != NULL); + if (tb->common.compress) { + p = db_store_term_comp(&tb->common, &(old->dbterm), offsetof(TreeDbTerm,dbterm), obj); + } + else { + p = db_store_term(&tb->common, &(old->dbterm), offsetof(TreeDbTerm,dbterm), obj); + } + return p; +} /* ** Some macros for "direction stacks" @@ -178,12 +207,6 @@ static void do_dump_tree2(int to, void *to_arg, int show, TreeDbTerm *t, #endif /* - * Size calculations - */ -#define SIZ_OVERHEAD ((sizeof(TreeDbTerm)/sizeof(Eterm)) - 1) -#define SIZ_DBTERM(TDT) (SIZ_OVERHEAD + (TDT)->dbterm.size) - -/* ** Datatypes */ @@ -263,9 +286,6 @@ static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key); static TreeDbTerm *linkout_object_tree(DbTableTree *tb, Eterm object); static int do_free_tree_cont(DbTableTree *tb, int num_left); -static TreeDbTerm* get_term(DbTableTree *tb, - TreeDbTerm* old, - Eterm obj); static void free_term(DbTableTree *tb, TreeDbTerm* p); static int balance_left(TreeDbTerm **this); static int balance_right(TreeDbTerm **this); @@ -622,7 +642,7 @@ static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail) erts_smp_atomic_dec(&tb->common.nitems); return DB_ERROR_SYSRES; } - *this = get_term(tb, NULL, obj); + *this = new_dbterm(tb, obj); (*this)->balance = 0; (*this)->left = (*this)->right = NULL; break; @@ -636,7 +656,7 @@ static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail) tstack[tpos++] = this; this = &((*this)->right); } else if (!key_clash_fail) { /* Equal key and this is a set, replace. */ - *this = get_term(tb, *this, obj); + *this = replace_dbterm(tb, *this, obj); break; } else { return DB_ERROR_BADKEY; /* key already exists */ @@ -714,7 +734,7 @@ static int db_get_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) { DbTableTree *tb = &tbl->tree; Eterm copy; - Eterm *hp; + Eterm *hp, *hend; TreeDbTerm *this; /* @@ -728,11 +748,11 @@ static int db_get_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) *ret = NIL; } else { hp = HAlloc(p, this->dbterm.size + 2); - copy = copy_shallow(DBTERM_BUF(&this->dbterm), - this->dbterm.size, - &hp, - &MSO(p)); + hend = hp + this->dbterm.size + 2; + copy = db_copy_object_from_ets(&tb->common, &this->dbterm, &hp, &MSO(p)); *ret = CONS(hp, copy, NIL); + hp += 2; + HRelease(p,hend,hp); } return DB_ERROR_NONE; } @@ -766,18 +786,10 @@ static int db_get_element_tree(Process *p, DbTable *tbl, if (this == NULL) { return DB_ERROR_BADKEY; } else { - Eterm element; - Uint sz; if (ndex > arityval(this->dbterm.tpl[0])) { return DB_ERROR_BADPARAM; } - element = this->dbterm.tpl[ndex]; - sz = size_object(element); - hp = HAlloc(p, sz); - *ret = copy_struct(element, - sz, - &hp, - &MSO(p)); + *ret = db_copy_element_from_ets(&tb->common, p, &this->dbterm, ndex, &hp, 0); } return DB_ERROR_NONE; } @@ -815,7 +827,7 @@ static int db_slot_tree(Process *p, DbTable *tbl, DbTableTree *tb = &tbl->tree; Sint slot; TreeDbTerm *st; - Eterm *hp; + Eterm *hp, *hend; Eterm copy; /* @@ -847,11 +859,11 @@ static int db_slot_tree(Process *p, DbTable *tbl, return DB_ERROR_UNSPEC; } hp = HAlloc(p, st->dbterm.size + 2); - copy = copy_shallow(DBTERM_BUF(&st->dbterm), - st->dbterm.size, - &hp, - &MSO(p)); + hend = hp + st->dbterm.size + 2; + copy = db_copy_object_from_ets(&tb->common, &st->dbterm, &hp, &MSO(p)); *ret = CONS(hp, copy, NIL); + hp += 2; + HRelease(p,hend,hp); return DB_ERROR_NONE; } @@ -1738,7 +1750,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, ** Other interface routines (not directly coupled to one bif) */ -/* Display hash table contents (for dump) */ +/* Display tree contents (for dump) */ static void db_print_tree(int to, void *to_arg, int show, DbTable *tbl) @@ -1926,7 +1938,7 @@ static TreeDbTerm *linkout_object_tree(DbTableTree *tb, tstack[tpos++] = this; this = &((*this)->right); } else { /* Equal key, found the only possible matching object*/ - if (!eq(object,make_tuple((*this)->dbterm.tpl))) { + if (!db_eq(&tb->common,object,&(*this)->dbterm)) { return NULL; } q = (*this); @@ -2079,15 +2091,6 @@ static void do_dump_tree(int to, void *to_arg, TreeDbTerm *t) } } -static void free_term(DbTableTree *tb, TreeDbTerm* p) -{ - db_free_term_data(&(p->dbterm)); - erts_db_free(ERTS_ALC_T_DB_TERM, - (DbTable *) tb, - (void *) p, - SIZ_DBTERM(p)*sizeof(Uint)); -} - static int do_free_tree_cont(DbTableTree *tb, int num_left) { TreeDbTerm *root; @@ -2118,17 +2121,6 @@ static int do_free_tree_cont(DbTableTree *tb, int num_left) return 1; } -static TreeDbTerm* get_term(DbTableTree *tb, - TreeDbTerm* old, - Eterm obj) -{ - TreeDbTerm* p = db_get_term((DbTableCommon *) tb, - (old != NULL) ? &(old->dbterm) : NULL, - ((char *) &(old->dbterm)) - ((char *) old), - obj); - return p; -} - /* * Deletion helpers */ @@ -2570,46 +2562,21 @@ static int db_lookup_dbterm_tree(DbTable *tbl, Eterm key, DbUpdateHandle* handle handle->tb = tbl; handle->dbterm = &(*pp)->dbterm; + handle->mustResize = 0; handle->bp = (void**) pp; handle->new_size = (*pp)->dbterm.size; - handle->mustResize = 0; return 1; } static void db_finalize_dbterm_tree(DbUpdateHandle* handle) { if (handle->mustResize) { - ErlOffHeap tmp_offheap; - Eterm* top; - Eterm copy; - DbTerm* newDbTerm; - DbTableTree *tb = &handle->tb->tree; TreeDbTerm* oldp = (TreeDbTerm*) *handle->bp; - TreeDbTerm* newp = erts_db_alloc(ERTS_ALC_T_DB_TERM, - handle->tb, - sizeof(TreeDbTerm)+sizeof(Eterm)*(handle->new_size-1)); - memcpy(newp, oldp, sizeof(TreeDbTerm)-sizeof(DbTerm)); /* copy only tree header */ - *(handle->bp) = newp; - reset_static_stack(tb); - newDbTerm = &newp->dbterm; - - newDbTerm->size = handle->new_size; - tmp_offheap.first = NULL; - tmp_offheap.overhead = 0; - - /* make a flat copy */ - top = DBTERM_BUF(newDbTerm); - copy = copy_struct(make_tuple(handle->dbterm->tpl), - handle->new_size, - &top, &tmp_offheap); - newDbTerm->first_oh = tmp_offheap.first; - DBTERM_SET_TPL(newDbTerm,tuple_val(copy)); - - db_free_term_data(handle->dbterm); - erts_db_free(ERTS_ALC_T_DB_TERM, - handle->tb, - (void *) (((char *) handle->dbterm) - (sizeof(TreeDbTerm) - sizeof(DbTerm))), - sizeof(TreeDbTerm) + sizeof(Eterm)*(handle->dbterm->size-1)); + + db_finalize_resize(handle, offsetof(TreeDbTerm,dbterm)); + reset_static_stack(&handle->tb->tree); + + free_term(&handle->tb->tree, oldp); } #ifdef DEBUG handle->dbterm = 0; @@ -3009,7 +2976,7 @@ static int doit_select(DbTableTree *tb, TreeDbTerm *this, void *ptr, { struct select_context *sc = (struct select_context *) ptr; Eterm ret; - Uint32 dummy; + Eterm* hp; sc->lastobj = this->dbterm.tpl; @@ -3024,24 +2991,9 @@ static int doit_select(DbTableTree *tb, TreeDbTerm *this, void *ptr, this->dbterm.tpl)) > 0))) { return 0; } - ret = db_prog_match(sc->p, sc->mp, - make_tuple(this->dbterm.tpl), - NULL,0, &dummy); + ret = db_prog_match_and_copy(&tb->common,sc->p,sc->mp,sc->all_objects, + &this->dbterm, &hp, 2); if (is_value(ret)) { - Uint sz; - Eterm *hp; - if (sc->all_objects) { - hp = HAlloc(sc->p, this->dbterm.size + 2); - ret = copy_shallow(DBTERM_BUF(&this->dbterm), - this->dbterm.size, - &hp, - &MSO(sc->p)); - } else { - sz = size_object(ret); - hp = HAlloc(sc->p, sz + 2); - ret = copy_struct(ret, sz, - &hp, &MSO(sc->p)); - } sc->accum = CONS(hp, ret, sc->accum); } if (MBUF(sc->p)) { @@ -3062,7 +3014,6 @@ static int doit_select_count(DbTableTree *tb, TreeDbTerm *this, void *ptr, { struct select_count_context *sc = (struct select_count_context *) ptr; Eterm ret; - Uint32 dummy; sc->lastobj = this->dbterm.tpl; @@ -3073,9 +3024,8 @@ static int doit_select_count(DbTableTree *tb, TreeDbTerm *this, void *ptr, this->dbterm.tpl)) > 0)) { return 0; } - ret = db_prog_match(sc->p, sc->mp, - make_tuple(this->dbterm.tpl), - NULL,0, &dummy); + ret = db_prog_match_and_copy(&tb->common, sc->p, sc->mp, 0, + &this->dbterm, NULL, 0); if (ret == am_true) { ++(sc->got); } @@ -3090,7 +3040,7 @@ static int doit_select_chunk(DbTableTree *tb, TreeDbTerm *this, void *ptr, { struct select_context *sc = (struct select_context *) ptr; Eterm ret; - Uint32 dummy; + Eterm* hp; sc->lastobj = this->dbterm.tpl; @@ -3106,25 +3056,10 @@ static int doit_select_chunk(DbTableTree *tb, TreeDbTerm *this, void *ptr, return 0; } - ret = db_prog_match(sc->p, sc->mp, - make_tuple(this->dbterm.tpl), - NULL,0, &dummy); + ret = db_prog_match_and_copy(&tb->common, sc->p, sc->mp, sc->all_objects, + &this->dbterm, &hp, 2); if (is_value(ret)) { - Uint sz; - Eterm *hp; - ++(sc->got); - if (sc->all_objects) { - hp = HAlloc(sc->p, this->dbterm.size + 2); - ret = copy_shallow(DBTERM_BUF(&this->dbterm), - this->dbterm.size, - &hp, - &MSO(sc->p)); - } else { - sz = size_object(ret); - hp = HAlloc(sc->p, sz + 2); - ret = copy_struct(ret, sz, &hp, &MSO(sc->p)); - } sc->accum = CONS(hp, ret, sc->accum); } if (MBUF(sc->p)) { @@ -3146,7 +3081,6 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr, { struct select_delete_context *sc = (struct select_delete_context *) ptr; Eterm ret; - Uint32 dummy; Eterm key; if (sc->erase_lastterm) @@ -3159,9 +3093,8 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr, GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0) return 0; - ret = db_prog_match(sc->p, sc->mp, - make_tuple(this->dbterm.tpl), - NULL,0, &dummy); + ret = db_prog_match_and_copy(&tb->common, sc->p, sc->mp, 0, + &this->dbterm, NULL, 0); if (ret == am_true) { key = GETKEY(sc->tb, this->dbterm.tpl); linkout_tree(sc->tb, key); diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 2f34561234..e773361619 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -25,7 +25,6 @@ #ifdef HAVE_CONFIG_H # include "config.h" #endif - #include "sys.h" #include "erl_vm.h" #include "global.h" @@ -890,6 +889,8 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace); static Eterm seq_trace_fake(Process *p, Eterm arg1); +static void db_free_tmp_uncompressed(DbTerm* obj); + /* ** Interface routines. @@ -1604,6 +1605,7 @@ static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity) } return ret; } + /* ** Execution of the match program, this is Pam. ** May return THE_NON_VALUE, which is a bailout. @@ -2391,33 +2393,46 @@ void db_do_update_element(DbUpdateHandle* handle, if (is_both_immed(newval,oldval)) { handle->dbterm->tpl[position] = newval; +#ifdef DEBUG_CLONE + if (handle->dbterm->debug_clone) { + handle->dbterm->debug_clone[position] = newval; + } +#endif return; } - else if (!handle->mustResize && is_boxed(newval)) { - newp = boxed_val(newval); - switch (*newp & _TAG_HEADER_MASK) { - case _TAG_HEADER_POS_BIG: - case _TAG_HEADER_NEG_BIG: - case _TAG_HEADER_FLOAT: - case _TAG_HEADER_HEAP_BIN: - newval_sz = header_arity(*newp) + 1; - if (is_boxed(oldval)) { - oldp = boxed_val(oldval); - switch (*oldp & _TAG_HEADER_MASK) { - case _TAG_HEADER_POS_BIG: - case _TAG_HEADER_NEG_BIG: - case _TAG_HEADER_FLOAT: - case _TAG_HEADER_HEAP_BIN: - oldval_sz = header_arity(*oldp) + 1; - if (oldval_sz == newval_sz) { - /* "self contained" terms of same size, do memcpy */ - sys_memcpy(oldp, newp, newval_sz*sizeof(Eterm)); - return; + if (!handle->mustResize) { + if (handle->tb->common.compress) { + handle->dbterm = db_alloc_tmp_uncompressed(&handle->tb->common, + handle->dbterm); + handle->mustResize = 1; + oldval = handle->dbterm->tpl[position]; + } + else if (is_boxed(newval)) { + newp = boxed_val(newval); + switch (*newp & _TAG_HEADER_MASK) { + case _TAG_HEADER_POS_BIG: + case _TAG_HEADER_NEG_BIG: + case _TAG_HEADER_FLOAT: + case _TAG_HEADER_HEAP_BIN: + newval_sz = header_arity(*newp) + 1; + if (is_boxed(oldval)) { + oldp = boxed_val(oldval); + switch (*oldp & _TAG_HEADER_MASK) { + case _TAG_HEADER_POS_BIG: + case _TAG_HEADER_NEG_BIG: + case _TAG_HEADER_FLOAT: + case _TAG_HEADER_HEAP_BIN: + oldval_sz = header_arity(*oldp) + 1; + if (oldval_sz == newval_sz) { + /* "self contained" terms of same size, do memcpy */ + sys_memcpy(oldp, newp, newval_sz*sizeof(Eterm)); + return; + } + goto both_size_set; } - goto both_size_set; } + goto new_size_set; } - goto new_size_set; } } /* Not possible for simple memcpy or dbterm is already non-contiguous, */ @@ -2436,84 +2451,372 @@ both_size_set: handle->mustResize = 1; } +static ERTS_INLINE byte* db_realloc_term(DbTableCommon* tb, void* old, + Uint old_sz, Uint new_sz, Uint offset) +{ + byte* ret; + if (erts_ets_realloc_always_moves) { + ret = erts_db_alloc(ERTS_ALC_T_DB_TERM, (DbTable*)tb, new_sz); + sys_memcpy(ret, old, offset); + erts_db_free(ERTS_ALC_T_DB_TERM, (DbTable*)tb, old, old_sz); + } else { + ret = erts_db_realloc(ERTS_ALC_T_DB_TERM, (DbTable*)tb, + old, old_sz, new_sz); + } + return ret; +} + +/* Allocated size of a compressed dbterm +*/ +static ERTS_INLINE Uint db_alloced_size_comp(DbTerm* obj) +{ + return obj->tpl[arityval(*obj->tpl) + 1]; +} + +void db_free_term(DbTable *tb, void* basep, Uint offset) +{ + DbTerm* db = (DbTerm*) ((byte*)basep + offset); + Uint size; + if (tb->common.compress) { + db_cleanup_offheap_comp(db); + size = db_alloced_size_comp(db); + } + else { + ErlOffHeap tmp_oh; + tmp_oh.first = db->first_oh; + erts_cleanup_offheap(&tmp_oh); + size = offset + offsetof(DbTerm,tpl) + db->size*sizeof(Eterm); + } + erts_db_free(ERTS_ALC_T_DB_TERM, tb, basep, size); +} + +static ERTS_INLINE Uint align_up(Uint value, Uint pow2) +{ + ASSERT((pow2 & (pow2-1)) == 0); + return (value + (pow2-1)) & ~(pow2-1); +} + +/* Compressed size of an uncompressed term +*/ +static Uint db_size_dbterm_comp(DbTableCommon* tb, Eterm obj) +{ + Eterm* tpl = tuple_val(obj); + int i; + Uint size = sizeof(DbTerm) + + arityval(*tpl) * sizeof(Eterm) + + sizeof(Uint); /* "alloc_size" */ + + for (i = arityval(*tpl); i>0; i--) { + if (i != tb->keypos && is_not_immed(tpl[i])) { + size += erts_encode_ext_size_ets(tpl[i]); + } + } + size += size_object(tpl[tb->keypos]) * sizeof(Eterm); + return align_up(size, sizeof(Uint)); +} + +/* Conversion between top tuple element and pointer to compressed data +*/ +static ERTS_INLINE Eterm ext2elem(Eterm* tpl, byte* ext) +{ + return (((Uint)(ext - (byte*)tpl)) << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER; +} +static ERTS_INLINE byte* elem2ext(Eterm* tpl, Uint ix) +{ + ASSERT(is_header(tpl[ix])); + return (byte*)tpl + (tpl[ix] >> _TAG_PRIMARY_SIZE); +} + +static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest, + Uint alloc_size) +{ + ErlOffHeap tmp_offheap; + Eterm* src = tuple_val(obj); + Eterm* tpl = dest->tpl; + Eterm key = src[tb->keypos]; + int arity = arityval(src[0]); + union { + Eterm* ep; + byte* cp; + UWord ui; + }top; + int i; + + top.ep = tpl+ 1 + arity + 1; + tpl[0] = src[0]; + tpl[arity + 1] = alloc_size; + + tmp_offheap.first = NULL; + tpl[tb->keypos] = copy_struct(key, size_object(key), &top.ep, &tmp_offheap); + dest->first_oh = tmp_offheap.first; + for (i=1; i<=arity; i++) { + if (i != tb->keypos) { + if (is_immed(src[i])) { + tpl[i] = src[i]; + } + else { + tpl[i] = ext2elem(tpl, top.cp); + top.cp = erts_encode_ext_ets(src[i], top.cp, &dest->first_oh); + } + } + } + +#ifdef DEBUG_CLONE + { + Eterm* dbg_top = erts_alloc(ERTS_ALC_T_DB_TERM, dest->size * sizeof(Eterm)); + dest->debug_clone = dbg_top; + tmp_offheap.first = dest->first_oh; + copy_struct(obj, dest->size, &dbg_top, &tmp_offheap); + dest->first_oh = tmp_offheap.first; + ASSERT(dbg_top == dest->debug_clone + dest->size); + } +#endif + return top.cp; +} /* ** Copy the object into a possibly new DbTerm, ** offset is the offset of the DbTerm from the start -** of the sysAllocaed structure, The possibly realloced and copied +** of the allocated structure, The possibly realloced and copied ** structure is returned. Make sure (((char *) old) - offset) is a ** pointer to a ERTS_ALC_T_DB_TERM allocated data area. */ -void* db_get_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) +void* db_store_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) { + byte* basep; + DbTerm* newp; + Eterm* top; int size = size_object(obj); - void *structp = ((char*) old) - offset; - DbTerm* p; - Eterm copy; - Eterm *top; ErlOffHeap tmp_offheap; if (old != 0) { + basep = ((byte*) old) - offset; tmp_offheap.first = old->first_oh; - tmp_offheap.overhead = 0; erts_cleanup_offheap(&tmp_offheap); old->first_oh = tmp_offheap.first; if (size == old->size) { - p = old; - } else { + newp = old; + } + else { Uint new_sz = offset + sizeof(DbTerm) + sizeof(Eterm)*(size-1); Uint old_sz = offset + sizeof(DbTerm) + sizeof(Eterm)*(old->size-1); - if (erts_ets_realloc_always_moves) { - void *nstructp = erts_db_alloc(ERTS_ALC_T_DB_TERM, - (DbTable *) tb, - new_sz); - memcpy(nstructp,structp,offset); - erts_db_free(ERTS_ALC_T_DB_TERM, - (DbTable *) tb, - structp, - old_sz); - structp = nstructp; - } else { - structp = erts_db_realloc(ERTS_ALC_T_DB_TERM, - (DbTable *) tb, - structp, - old_sz, - new_sz); - } - p = (DbTerm*) ((void *)(((char *) structp) + offset)); + basep = db_realloc_term(tb, basep, old_sz, new_sz, offset); + newp = (DbTerm*) (basep + offset); } } else { - structp = erts_db_alloc(ERTS_ALC_T_DB_TERM, - (DbTable *) tb, - (offset - + sizeof(DbTerm) - + sizeof(Eterm)*(size-1))); - p = (DbTerm*) ((void *)(((char *) structp) + offset)); - } - p->size = size; + basep = erts_db_alloc(ERTS_ALC_T_DB_TERM, (DbTable *)tb, + (offset + sizeof(DbTerm) + sizeof(Eterm)*(size-1))); + newp = (DbTerm*) (basep + offset); + } + newp->size = size; + top = newp->tpl; tmp_offheap.first = NULL; - tmp_offheap.overhead = 0; + copy_struct(obj, size, &top, &tmp_offheap); + newp->first_oh = tmp_offheap.first; +#ifdef DEBUG_CLONE + newp->debug_clone = NULL; +#endif + return basep; +} + + +void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) +{ + Uint new_sz = offset + db_size_dbterm_comp(tb, obj); + byte* basep; + DbTerm* newp; + byte* top; + + ASSERT(tb->compress); + if (old != 0) { + Uint old_sz = db_alloced_size_comp(old); + db_cleanup_offheap_comp(old); + + basep = ((byte*) old) - offset; + if (new_sz == old_sz) { + newp = old; + } + else { + basep = db_realloc_term(tb, basep, old_sz, new_sz, offset); + newp = (DbTerm*) (basep + offset); + } + } + else { + basep = erts_db_alloc(ERTS_ALC_T_DB_TERM, (DbTable*)tb, new_sz); + newp = (DbTerm*) (basep + offset); + } + + newp->size = size_object(obj); + top = copy_to_comp(tb, obj, newp, new_sz); + ASSERT(top <= basep + new_sz); + + // SVERK: realloc? + + return basep; +} + + +void db_finalize_resize(DbUpdateHandle* handle, Uint offset) +{ + DbTable* tbl = handle->tb; + DbTerm* newDbTerm; + Uint alloc_sz = offset + + (tbl->common.compress ? + db_size_dbterm_comp(&tbl->common, make_tuple(handle->dbterm->tpl)) : + sizeof(DbTerm)+sizeof(Eterm)*(handle->new_size-1)); + byte* newp = erts_db_alloc(ERTS_ALC_T_DB_TERM, tbl, alloc_sz); + byte* oldp = *(handle->bp); + + sys_memcpy(newp, oldp, offset); /* copy only hash/tree header */ + *(handle->bp) = newp; + newDbTerm = (DbTerm*) (newp + offset); + newDbTerm->size = handle->new_size; + + /* make a flat copy */ + + if (tbl->common.compress) { + copy_to_comp(&tbl->common, make_tuple(handle->dbterm->tpl), + newDbTerm, alloc_sz); + db_free_tmp_uncompressed(handle->dbterm); + } + else { + Eterm* top; + ErlOffHeap tmp_offheap; + tmp_offheap.first = NULL; + top = newDbTerm->tpl; + copy_struct(make_tuple(handle->dbterm->tpl), handle->new_size, + &top, &tmp_offheap); + newDbTerm->first_oh = tmp_offheap.first; +#ifdef DEBUG_CLONE + newDbTerm->debug_clone = NULL; +#endif + ASSERT((byte*)top <= (newp + alloc_sz)); + } +} - top = DBTERM_BUF(p); - copy = copy_struct(obj, size, &top, &tmp_offheap); - p->first_oh = tmp_offheap.first; - DBTERM_SET_TPL(p,tuple_val(copy)); +Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, + ErlOffHeap* off_heap) +{ + Eterm* hp = *hpp; + int i, arity = arityval(bp->tpl[0]); + + hp[0] = bp->tpl[0]; + *hpp += arity + 1; + + hp[tb->keypos] = copy_struct(bp->tpl[tb->keypos], + size_object(bp->tpl[tb->keypos]), + hpp, off_heap); + for (i=arity; i>0; i--) { + if (i != tb->keypos) { + if (is_immed(bp->tpl[i])) { + hp[i] = bp->tpl[i]; + } + else { + hp[i] = erts_decode_ext_ets(hpp, off_heap, + elem2ext(bp->tpl, i)); + } + } + } + ASSERT((*hpp - hp) <= bp->size); +#ifdef DEBUG_CLONE + ASSERT(eq(make_tuple(hp),make_tuple(bp->debug_clone))); +#endif + return make_tuple(hp); +} - return structp; +Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p, + DbTerm* obj, Uint pos, + Eterm** hpp, Uint extra) +{ + if (is_immed(obj->tpl[pos])) { + *hpp = HAlloc(p, extra); + return obj->tpl[pos]; + } + if (tb->compress && pos != tb->keypos) { + byte* ext = elem2ext(obj->tpl, pos); + Sint sz = erts_decode_ext_size_ets(ext, db_alloced_size_comp(obj)) + extra; + Eterm* hp = HAlloc(p, sz); + Eterm* endp = hp + sz; + Eterm copy = erts_decode_ext_ets(&hp, &MSO(p), ext); + *hpp = hp; + hp += extra; + HRelease(p, endp, hp); +#ifdef DEBUG_CLONE + ASSERT(eq(copy,obj->debug_clone[pos])); +#endif + return copy; + } + else { + Uint sz = size_object(obj->tpl[pos]); + *hpp = HAlloc(p, sz + extra); + return copy_struct(obj->tpl[pos], sz, hpp, &MSO(p)); + } } -void db_free_term_data(DbTerm* p) +/* Our own "cleanup_offheap" + * as refc-binaries may be unaligned in compressed terms +*/ +void db_cleanup_offheap_comp(DbTerm* obj) +{ + union erl_off_heap_ptr u; + ProcBin tmp; + + for (u.hdr = obj->first_oh; u.hdr; u.hdr = u.hdr->next) { + if ((UWord)u.voidp % sizeof(UWord) != 0) { /* unaligned ptr */ + sys_memcpy(&tmp, u.voidp, sizeof(tmp)); + /* Warning, must pass (void*)-variable to memcpy. Otherwise it will + cause Bus error on Sparc due to false compile time assumptions + about word aligned memory (type cast is not enough) */ + u.pb = &tmp; + } + switch (thing_subtag(u.hdr->thing_word)) { + case REFC_BINARY_SUBTAG: + if (erts_refc_dectest(&u.pb->val->refc, 0) == 0) { + erts_bin_free(u.pb->val); + } + break; + case FUN_SUBTAG: + ASSERT(u.pb != &tmp); + if (erts_refc_dectest(&u.fun->fe->refc, 0) == 0) { + erts_erase_fun_entry(u.fun->fe); + } + break; + default: + ASSERT(is_external_header(u.hdr->thing_word)); + ASSERT(u.pb != &tmp); + erts_deref_node_entry(u.ext->node); + break; + } + } +#ifdef DEBUG_CLONE + if (obj->debug_clone != NULL) { + erts_free(ERTS_ALC_T_DB_TERM, obj->debug_clone); + obj->debug_clone = NULL; + } +#endif +} + +int db_eq_comp(DbTableCommon* tb, Eterm a, DbTerm* b) { ErlOffHeap tmp_offheap; - tmp_offheap.first = p->first_oh; - tmp_offheap.overhead = 0; + Eterm* allocp; + Eterm* hp; + Eterm tmp_b; + int is_eq; + + ASSERT(tb->compress); + hp = allocp = erts_alloc(ERTS_ALC_T_TMP, b->size*sizeof(Eterm)); + tmp_offheap.first = NULL; + tmp_b = db_copy_from_comp(tb, b, &hp, &tmp_offheap); + is_eq = eq(a,tmp_b); erts_cleanup_offheap(&tmp_offheap); + erts_free(ERTS_ALC_T_TMP, allocp); + return is_eq; } - /* ** Check if object represents a "match" variable ** i.e and atom $N where N is an integer @@ -4404,7 +4707,65 @@ static Eterm seq_trace_fake(Process *p, Eterm arg1) } return result; } - + +DbTerm* db_alloc_tmp_uncompressed(DbTableCommon* tb, DbTerm* org) +{ + ErlOffHeap tmp_offheap; + DbTerm* res = erts_alloc(ERTS_ALC_T_TMP, + sizeof(DbTerm) + org->size*sizeof(Eterm)); + Eterm* hp = res->tpl; + tmp_offheap.first = NULL; + db_copy_from_comp(tb, org, &hp, &tmp_offheap); + res->first_oh = tmp_offheap.first; + res->size = org->size; +#ifdef DEBUG_CLONE + res->debug_clone = NULL; +#endif + return res; +} + +void db_free_tmp_uncompressed(DbTerm* obj) +{ + ErlOffHeap off_heap; + off_heap.first = obj->first_oh; + erts_cleanup_offheap(&off_heap); +#ifdef DEBUG_CLONE + ASSERT(obj->debug_clone == NULL); +#endif + erts_free(ERTS_ALC_T_TMP, obj); +} + +Eterm db_prog_match_and_copy(DbTableCommon* tb, Process* c_p, Binary* bprog, + int all, DbTerm* obj, Eterm** hpp, Uint extra) +{ + Uint32 dummy; + Eterm res; + + if (tb->compress) { + obj = db_alloc_tmp_uncompressed(tb, obj); + } + + res = db_prog_match(c_p, bprog, make_tuple(obj->tpl), NULL, 0, &dummy); + + if (is_value(res) && hpp!=NULL) { + if (all) { + *hpp = HAlloc(c_p, obj->size + extra); + res = copy_shallow(obj->tpl, obj->size, hpp, &MSO(c_p)); + } + else { + Uint sz = size_object(res); + *hpp = HAlloc(c_p, sz + extra); + res = copy_struct(res, sz, hpp, &MSO(c_p)); + } + } + + if (tb->compress) { + db_free_tmp_uncompressed(obj); + } + return res; +} + + #ifdef DMC_DEBUG /* ** Disassemble match program diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 0f333e8b34..10ba755e80 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -52,22 +52,27 @@ is broken.*/ #define DB_ERROR_UNSPEC -10 /* Unspecified error */ +/*#define DEBUG_CLONE*/ /* * A datatype for a database entry stored out of a process heap */ typedef struct db_term { struct erl_off_heap_header* first_oh; /* Off heap data for term. */ - Uint size; /* Size of term in "words" */ - Eterm tpl[1]; /* Untagged "constant pointer" to top tuple */ - /* (assumed to be first in buffer) */ + Uint size; /* Heap size of term in "words" */ +#ifdef DEBUG_CLONE + Eterm* debug_clone; /* An uncompressed copy */ +#endif + Eterm tpl[1]; /* Term data. Top tuple always first */ + + /* Compression: is_immed and key element are uncompressed. + Compressed elements are stored in external format after each other + last in dbterm. The top tuple elements contains byte offsets, to + the start of the data, tagged as headers. + The allocated size of the dbterm in bytes is stored at tpl[arity+1]. + */ } DbTerm; -/* "Assign" a value to DbTerm.tpl */ -#define DBTERM_SET_TPL(dbtermPtr,tplPtr) ASSERT((tplPtr)==(dbtermPtr->tpl)) -/* Get start of term buffer */ -#define DBTERM_BUF(dbtermPtr) ((dbtermPtr)->tpl) - union db_table; typedef union db_table DbTable; @@ -186,6 +191,12 @@ typedef struct db_table_method } DbTableMethod; +typedef struct db_fixation { + Eterm pid; + Uint counter; + struct db_fixation *next; +} DbFixation; + /* * This structure contains data for all different types of database * tables. Note that these fields must match the same fields @@ -194,13 +205,6 @@ typedef struct db_table_method * operations may be the same on different types of tables. */ -typedef struct db_fixation { - Eterm pid; - Uint counter; - struct db_fixation *next; -} DbFixation; - - typedef struct db_table_common { erts_refc_t ref; erts_refc_t fixref; /* fixation counter */ @@ -226,6 +230,7 @@ typedef struct db_table_common { Uint32 status; /* bit masks defined below */ int slot; /* slot index in meta_main_tab */ int keypos; /* defaults to 1 */ + int compress; } DbTableCommon; /* These are status bit patterns */ @@ -252,6 +257,54 @@ typedef struct db_table_common { #define IS_FIXED(T) (NFIXED(T) != 0) Eterm erts_ets_copy_object(Eterm, Process*); +Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, + ErlOffHeap* off_heap); +int db_eq_comp(DbTableCommon* tb, Eterm a, DbTerm* b); +DbTerm* db_alloc_tmp_uncompressed(DbTableCommon* tb, DbTerm* org); + +ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp, + Eterm** hpp, ErlOffHeap* off_heap); +ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b); +ERTS_GLB_INLINE Eterm db_do_read_element(DbUpdateHandle* handle, Sint position); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF +ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp, + Eterm** hpp, ErlOffHeap* off_heap) +{ + if (tb->compress) { + return db_copy_from_comp(tb, bp, hpp, off_heap); + } + else { + return copy_shallow(bp->tpl, bp->size, hpp, off_heap); + } +} + +ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b) +{ + if (!tb->compress) { + return eq(a, make_tuple(b->tpl)); + } + else { + return db_eq_comp(tb, a, b); + } +} + +/* Must be called to read elements after db_lookup_dbterm. +** Will decompress if needed. */ +ERTS_GLB_INLINE Eterm db_do_read_element(DbUpdateHandle* handle, Sint position) +{ + Eterm elem = handle->dbterm->tpl[position]; + if (!is_header(elem)) { + return elem; + } + ASSERT(((DbTableCommon*)handle->tb)->compress); + ASSERT(!handle->mustResize); + handle->dbterm = db_alloc_tmp_uncompressed((DbTableCommon*)handle->tb, handle->dbterm); + handle->mustResize = 1; + return handle->dbterm->tpl[position]; +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ /* optimised version of copy_object (normal case? atomic object) */ #define COPY_OBJECT(obj, p, objp) \ @@ -277,14 +330,19 @@ Eterm db_set_trace_control_word_1(Process *p, Eterm val); void db_initialize_util(void); Eterm db_getkey(int keypos, Eterm obj); -void db_free_term_data(DbTerm* p); -void* db_get_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj); +void db_cleanup_offheap_comp(DbTerm* p); +void db_free_term(DbTable *tb, void* basep, Uint offset); +void* db_store_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj); +void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj); +Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p, DbTerm* obj, + Uint pos, Eterm** hpp, Uint extra); int db_has_variable(Eterm obj); int db_is_variable(Eterm obj); +Eterm db_do_read_element(DbUpdateHandle* handle, Sint position); void db_do_update_element(DbUpdateHandle* handle, Sint position, Eterm newval); -void db_finalize_update_element(DbUpdateHandle* handle); +void db_finalize_resize(DbUpdateHandle* handle, Uint offset); Eterm db_add_counter(Eterm** hpp, Eterm counter, Eterm incr); Eterm db_match_set_lint(Process *p, Eterm matchexpr, Uint flags); Binary *db_match_set_compile(Process *p, Eterm matchexpr, @@ -366,6 +424,8 @@ Binary *db_match_compile(Eterm *matchexpr, Eterm *guards, Eterm *body, int num_matches, Uint flags, DMCErrInfo *err_info); +Eterm db_prog_match_and_copy(DbTableCommon* tb, Process* c_p, Binary* bprog, + int all, DbTerm* obj, Eterm** hpp, Uint extra); /* Returns newly allocated MatchProg binary with refc == 0*/ Eterm db_prog_match(Process *p, Binary *prog, Eterm term, Eterm *termp, int arity, Uint32 *return_flags /* Zeroed on enter */); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index a2fd5921a2..a9f4f041ac 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -807,6 +807,7 @@ early_init(int *argc, char **argv) /* erl_sys_args(argc, argv); erts_ets_realloc_always_moves = 0; + erts_ets_always_compress = 0; erts_dist_buf_busy_limit = ERTS_DE_BUSY_LIMIT; return ncpu; @@ -1028,15 +1029,20 @@ erl_start(int argc, char **argv) break; case 'e': - /* set maximum number of ets tables */ - arg = get_arg(argv[i]+2, argv[i+1], &i); - if (( user_requested_db_max_tabs = atoi(arg) ) < 0) { - erts_fprintf(stderr, "bad maximum number of ets tables %s\n", arg); - erts_usage(); + if (sys_strcmp("c", argv[i]+2) == 0) { + erts_ets_always_compress = 1; + } + else { + /* set maximum number of ets tables */ + arg = get_arg(argv[i]+2, argv[i+1], &i); + if (( user_requested_db_max_tabs = atoi(arg) ) < 0) { + erts_fprintf(stderr, "bad maximum number of ets tables %s\n", arg); + erts_usage(); + } + VERBOSE(DEBUG_SYSTEM, + ("using maximum number of ets tables %d\n", + user_requested_db_max_tabs)); } - VERBOSE(DEBUG_SYSTEM, - ("using maximum number of ets tables %d\n", - user_requested_db_max_tabs)); break; case 'i': diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index cd63401581..48fa99934e 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -199,6 +199,7 @@ extern int BIN_VH_MIN_SIZE; /* minimum virtual (bin) heap */ extern int erts_atom_table_size;/* Atom table size */ #define ORIG_CREATION 0 +#define INTERNAL_CREATION 255 /* macros for extracting bytes from uint16's */ diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index d7c8aa84e9..328aa2be6a 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -49,10 +49,8 @@ #define in_area(ptr,start,nbytes) ((Uint)((char*)(ptr) - (char*)(start)) < (nbytes)) #define MAX_STRING_LEN 0xffff -#define dec_set_creation(nodename,creat) \ - (((nodename) == erts_this_node->sysname && (creat) == ORIG_CREATION) \ - ? erts_this_node->creation \ - : (creat)) + +#define is_valid_creation(Cre) ((unsigned)(Cre) < MAX_CREATION || (Cre) == INTERNAL_CREATION) #undef ERTS_DEBUG_USE_DIST_SEP #ifdef DEBUG @@ -83,14 +81,14 @@ * */ -static byte* enc_term(ErtsAtomCacheMap *, Eterm, byte*, Uint32); +static byte* enc_term(ErtsAtomCacheMap *, Eterm, byte*, Uint32, struct erl_off_heap_header** off_heap); static Uint is_external_string(Eterm obj, int* p_is_string); static byte* enc_atom(ErtsAtomCacheMap *, Eterm, byte*, Uint32); static byte* enc_pid(ErtsAtomCacheMap *, Eterm, byte*, Uint32); static byte* dec_term(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*); static byte* dec_atom(ErtsDistExternal *, byte*, Eterm*); static byte* dec_pid(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*); -static Sint decoded_size(byte *ep, byte* endp, int only_heap_bins); +static Sint decoded_size(byte *ep, byte* endp, int only_heap_bins, int internal_tags); static Uint encode_size_struct2(ErtsAtomCacheMap *, Eterm, unsigned); @@ -461,6 +459,12 @@ Uint erts_encode_ext_size(Eterm term) + 1 /* VERSION_MAGIC */; } +Uint erts_encode_ext_size_ets(Eterm term) +{ + return encode_size_struct2(NULL, term, TERM_TO_BINARY_DFLAGS|DFLAGS_INTERNAL_TAGS); +} + + void erts_encode_dist_ext(Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap *acmp) { byte *ep = *ext; @@ -468,7 +472,7 @@ void erts_encode_dist_ext(Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) #endif *ep++ = VERSION_MAGIC; - ep = enc_term(acmp, term, ep, flags); + ep = enc_term(acmp, term, ep, flags, NULL); if (!ep) erl_exit(ERTS_ABORT_EXIT, "%s:%d:erts_encode_dist_ext(): Internal data structure error\n", @@ -480,7 +484,7 @@ void erts_encode_ext(Eterm term, byte **ext) { byte *ep = *ext; *ep++ = VERSION_MAGIC; - ep = enc_term(NULL, term, ep, TERM_TO_BINARY_DFLAGS); + ep = enc_term(NULL, term, ep, TERM_TO_BINARY_DFLAGS, NULL); if (!ep) erl_exit(ERTS_ABORT_EXIT, "%s:%d:erts_encode_ext(): Internal data structure error\n", @@ -488,6 +492,12 @@ void erts_encode_ext(Eterm term, byte **ext) *ext = ep; } +byte* erts_encode_ext_ets(Eterm term, byte *ep, struct erl_off_heap_header** off_heap) +{ + return enc_term(NULL, term, ep, TERM_TO_BINARY_DFLAGS|DFLAGS_INTERNAL_TAGS, + off_heap); +} + ErtsDistExternal * erts_make_dist_ext_copy(ErtsDistExternal *edep, Uint xsize) { @@ -813,7 +823,7 @@ erts_decode_dist_ext_size(ErtsDistExternal *edep, int no_refc_bins) goto fail; ep = edep->extp+1; } - res = decoded_size(ep, edep->ext_endp, no_refc_bins); + res = decoded_size(ep, edep->ext_endp, no_refc_bins, 0); if (res >= 0) return res; fail: @@ -825,9 +835,17 @@ Sint erts_decode_ext_size(byte *ext, Uint size, int no_refc_bins) { if (size == 0 || *ext != VERSION_MAGIC) return -1; - return decoded_size(ext+1, ext+size, no_refc_bins); + return decoded_size(ext+1, ext+size, no_refc_bins, 0); } +Sint erts_decode_ext_size_ets(byte *ext, Uint size) +{ + Sint sz = decoded_size(ext, ext+size, 0, 1); + ASSERT(sz >= 0); + return sz; +} + + /* ** hpp is set to either a &p->htop or ** a pointer to a memory pointer (form message buffers) @@ -887,7 +905,13 @@ Eterm erts_decode_ext(Eterm **hpp, ErlOffHeap *off_heap, byte **ext) return obj; } - +Eterm erts_decode_ext_ets(Eterm **hpp, ErlOffHeap *off_heap, byte *ext) +{ + Eterm obj; + ext = dec_term(NULL, hpp, ext, off_heap, &obj); + ASSERT(ext); + return obj; +} /**********************************************************************/ @@ -964,6 +988,7 @@ term_to_binary_1(Process* p, Eterm Term) return erts_term_to_binary(p, Term, 0, TERM_TO_BINARY_DFLAGS); } + Eterm term_to_binary_2(Process* p, Eterm Term, Eterm Flags) { @@ -1075,7 +1100,7 @@ binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size) goto error; size = (Sint) dest_len; } - res = decoded_size(state->extp, state->extp + size, 0); + res = decoded_size(state->extp, state->extp + size, 0, 0); if (res < 0) goto error; return res; @@ -1183,7 +1208,8 @@ BIF_RETTYPE binary_to_term_2(BIF_ALIST_2) opt = CAR(list_val(opts)); if (opt == am_safe) { fakedep.flags |= ERTS_DIST_EXT_BTT_SAFE; - } else { + } + else { goto error; } opts = CDR(list_val(opts)); @@ -1255,7 +1281,7 @@ erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) bytes = erts_alloc(ERTS_ALC_T_TMP, size); } - if ((endp = enc_term(NULL, Term, bytes, flags)) + if ((endp = enc_term(NULL, Term, bytes, flags, NULL)) == NULL) { erl_exit(1, "%s, line %d: bad term: %x\n", __FILE__, __LINE__, Term); @@ -1300,7 +1326,7 @@ erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) bin = new_binary(p, (byte *)NULL, size); bytes = binary_bytes(bin); bytes[0] = VERSION_MAGIC; - if ((endp = enc_term(NULL, Term, bytes+1, flags)) + if ((endp = enc_term(NULL, Term, bytes+1, flags, NULL)) == NULL) { erl_exit(1, "%s, line %d: bad term: %x\n", __FILE__, __LINE__, Term); @@ -1330,6 +1356,21 @@ enc_atom(ErtsAtomCacheMap *acmp, Eterm atom, byte *ep, Uint32 dflags) ASSERT(is_atom(atom)); + if (dflags & DFLAGS_INTERNAL_TAGS) { + Uint aval = atom_val(atom); + ASSERT(aval < (1<<24)); + if (aval >= (1 << 16)) { + *ep++ = ATOM_INTERNAL_REF3; + put_int24(aval, ep); + ep += 3; + } + else { + *ep++ = ATOM_INTERNAL_REF2; + put_int16(aval, ep); + ep += 2; + } + return ep; + } /* * term_to_binary/1,2 and the initial distribution message * don't use the cache. @@ -1379,7 +1420,8 @@ enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint32 dflags) ep += 4; put_int32(os, ep); ep += 4; - *ep++ = pid_creation(pid); + *ep++ = (is_internal_pid(pid) && (dflags & DFLAGS_INTERNAL_TAGS)) ? + INTERNAL_CREATION : pid_creation(pid); return ep; } @@ -1418,6 +1460,23 @@ dec_atom(ErtsDistExternal *edep, byte* ep, Eterm* objp) } ep += len; break; + case ATOM_INTERNAL_REF2: + n = get_int16(ep); + ep += 2; + if (n >= atom_table_size()) { + goto error; + } + *objp = make_atom(n); + break; + case ATOM_INTERNAL_REF3: + n = get_int24(ep); + ep += 3; + if (n >= atom_table_size()) { + goto error; + } + *objp = make_atom(n); + break; + default: error: *objp = NIL; /* Don't leave a hole in the heap */ @@ -1426,6 +1485,19 @@ dec_atom(ErtsDistExternal *edep, byte* ep, Eterm* objp) return ep; } +static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint creation) +{ + switch (creation) { + case INTERNAL_CREATION: + return erts_this_node; + case ORIG_CREATION: + if (sysname == erts_this_node->sysname) { + creation = erts_this_node->creation; + } + } + return erts_find_or_insert_node(sysname,creation); +} + static byte* dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Eterm* objp) { @@ -1449,18 +1521,20 @@ dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Ete ep += 4; if (ser > ERTS_MAX_PID_SERIAL) return NULL; - if ((cre = get_int8(ep)) >= MAX_CREATION) - return NULL; + cre = get_int8(ep); ep += 1; + if (!is_valid_creation(cre)) { + return NULL; + } + data = make_pid_data(ser, num); + /* * We are careful to create the node entry only after all * validity tests are done. */ - cre = dec_set_creation(sysname,cre); - node = erts_find_or_insert_node(sysname,cre); + node = dec_get_node(sysname, cre); - data = make_pid_data(ser, num); if(node == erts_this_node) { *objp = make_internal_pid(data); } else { @@ -1485,7 +1559,8 @@ dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Ete #define ENC_LAST_ARRAY_ELEMENT ((Eterm) 3) static byte* -enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags) +enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, + struct erl_off_heap_header** off_heap) { DECLARE_WSTACK(s); Uint n; @@ -1637,12 +1712,14 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags) Uint32 *ref_num; ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); + *ep++ = NEW_REFERENCE_EXT; i = ref_no_of_numbers(obj); put_int16(i, ep); ep += 2; ep = enc_atom(acmp,ref_node_name(obj),ep,dflags); - *ep++ = ref_creation(obj); + *ep++ = ((dflags & DFLAGS_INTERNAL_TAGS) && is_internal_ref(obj)) ? + INTERNAL_CREATION : ref_creation(obj); ref_num = ref_numbers(obj); for (j = 0; j < i; j++) { put_int32(ref_num[j], ep); @@ -1658,7 +1735,8 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags) j = port_number(obj); put_int32(j, ep); ep += 4; - *ep++ = port_creation(obj); + *ep++ = ((dflags & DFLAGS_INTERNAL_TAGS) && is_internal_port(obj)) ? + INTERNAL_CREATION : port_creation(obj); break; case LIST_DEF: @@ -1738,6 +1816,41 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags) byte* bytes; ERTS_GET_BINARY_BYTES(obj, bytes, bitoffs, bitsize); + if (dflags & DFLAGS_INTERNAL_TAGS) { + ProcBin* pb = (ProcBin*) binary_val(obj); + Uint bytesize = pb->size; + if (pb->thing_word == HEADER_SUB_BIN) { + ErlSubBin* sub = (ErlSubBin*)pb; + pb = (ProcBin*) binary_val(sub->orig); + ASSERT(bytesize == sub->size); + bytesize += (bitoffs + bitsize + 7) / 8; + } + if (pb->thing_word == HEADER_PROC_BIN + && heap_bin_size(bytesize) > PROC_BIN_SIZE) { + ProcBin tmp; + if (bitoffs || bitsize) { + *ep++ = BIT_BINARY_INTERNAL_REF; + *ep++ = bitoffs; + *ep++ = bitsize; + } + else { + *ep++ = BINARY_INTERNAL_REF; + } + if (pb->flags) { + erts_emasculate_writable_binary(pb); + } + erts_refc_inc(&pb->val->refc, 2); + + sys_memcpy(&tmp, pb, sizeof(ProcBin)); + tmp.next = *off_heap; + tmp.bytes = bytes; + tmp.size = bytesize; + sys_memcpy(ep, &tmp, sizeof(ProcBin)); + *off_heap = (struct erl_off_heap_header*) ep; + ep += sizeof(ProcBin); + break; + } + } if (bitsize == 0) { /* Plain old byte-sized binary. */ *ep++ = BINARY_EXT; @@ -1773,8 +1886,8 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags) *ep++ = SMALL_INTEGER_EXT; *ep++ = bitsize; } - break; } + break; case EXPORT_DEF: { Export* exp = *((Export **) (export_val(obj) + 1)); @@ -1782,7 +1895,7 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags) *ep++ = EXPORT_EXT; ep = enc_atom(acmp, exp->code[0], ep, dflags); ep = enc_atom(acmp, exp->code[1], ep, dflags); - ep = enc_term(acmp, make_small(exp->code[2]), ep, dflags); + ep = enc_term(acmp, make_small(exp->code[2]), ep, dflags, off_heap); } else { /* Tag, arity */ *ep++ = SMALL_TUPLE_EXT; @@ -1818,8 +1931,8 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags) put_int32(funp->num_free, ep); ep += 4; ep = enc_atom(acmp, funp->fe->module, ep, dflags); - ep = enc_term(acmp, make_small(funp->fe->old_index), ep, dflags); - ep = enc_term(acmp, make_small(funp->fe->old_uniq), ep, dflags); + ep = enc_term(acmp, make_small(funp->fe->old_index), ep, dflags, off_heap); + ep = enc_term(acmp, make_small(funp->fe->old_uniq), ep, dflags, off_heap); ep = enc_pid(acmp, funp->creator, ep, dflags); fun_env: @@ -1872,7 +1985,8 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags) return ep; } -static Uint +static +Uint is_external_string(Eterm list, int* p_is_string) { Uint len = 0; @@ -2162,13 +2276,13 @@ dec_term_atom_common: goto error; } ep += 4; - if ((cre = get_int8(ep)) >= MAX_CREATION) { + cre = get_int8(ep); + ep++; + if (!is_valid_creation(cre)) { goto error; } - ep++; - cre = dec_set_creation(sysname,cre); - node = erts_find_or_insert_node(sysname, cre); + node = dec_get_node(sysname, cre); if(node == erts_this_node) { *objp = make_internal_port(num); } @@ -2205,9 +2319,11 @@ dec_term_atom_common: goto error; ep += 4; - if ((cre = get_int8(ep)) >= MAX_CREATION) - goto error; + cre = get_int8(ep); ep += 1; + if (!is_valid_creation(cre)) { + goto error; + } goto ref_ext_common; case NEW_REFERENCE_EXT: @@ -2220,10 +2336,11 @@ dec_term_atom_common: if ((ep = dec_atom(edep, ep, &sysname)) == NULL) goto error; - if ((cre = get_int8(ep)) >= MAX_CREATION) - goto error; + cre = get_int8(ep); ep += 1; - + if (!is_valid_creation(cre)) { + goto error; + } r0 = get_int32(ep); ep += 4; if (r0 >= MAX_REFERENCE) @@ -2231,8 +2348,7 @@ dec_term_atom_common: ref_ext_common: - cre = dec_set_creation(sysname, cre); - node = erts_find_or_insert_node(sysname, cre); + node = dec_get_node(sysname, cre); if(node == erts_this_node) { RefThing *rtp = (RefThing *) hp; ref_num = (Uint32 *) (hp + REF_THING_HEAD_SIZE); @@ -2560,6 +2676,66 @@ dec_term_atom_common: } break; } + case ATOM_INTERNAL_REF2: + n = get_int16(ep); + ep += 2; + if (n >= atom_table_size()) { + goto error; + } + *objp = make_atom(n); + break; + case ATOM_INTERNAL_REF3: + n = get_int24(ep); + ep += 3; + if (n >= atom_table_size()) { + goto error; + } + *objp = make_atom(n); + break; + + case BINARY_INTERNAL_REF: + { + ProcBin* pb = (ProcBin*) hp; + sys_memcpy(pb, ep, sizeof(ProcBin)); + ep += sizeof(ProcBin); + + erts_refc_inc(&pb->val->refc, 1); + hp += PROC_BIN_SIZE; + pb->next = off_heap->first; + off_heap->first = (struct erl_off_heap_header*)pb; + pb->flags = 0; + *objp = make_binary(pb); + break; + } + case BIT_BINARY_INTERNAL_REF: + { + Sint bitoffs = *ep++; + Sint bitsize = *ep++; + ProcBin* pb = (ProcBin*) hp; + ErlSubBin* sub; + sys_memcpy(pb, ep, sizeof(ProcBin)); + ep += sizeof(ProcBin); + + erts_refc_inc(&pb->val->refc, 1); + hp += PROC_BIN_SIZE; + pb->next = off_heap->first; + off_heap->first = (struct erl_off_heap_header*)pb; + pb->flags = 0; + + sub = (ErlSubBin*)hp; + sub->thing_word = HEADER_SUB_BIN; + sub->size = pb->size - (bitoffs + bitsize + 7)/8; + sub->offs = 0; + sub->bitoffs = bitoffs; + sub->bitsize = bitsize; + sub->is_writable = 0; + sub->orig = make_binary(pb); + + hp += ERL_SUB_BIN_SIZE; + *objp = make_binary(sub); + break; + } + default: error: /* UNDO: @@ -2642,20 +2818,29 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) case NIL_DEF: result++; break; - case ATOM_DEF: { - int alen = atom_tab(atom_val(obj))->len; - if ((MAX_ATOM_LENGTH <= 255 || alen <= 255) - && (dflags & DFLAG_SMALL_ATOM_TAGS)) { - /* Make sure a SMALL_ATOM_EXT fits: SMALL_ATOM_EXT l t1 t2... */ - result += 1 + 1 + alen; + case ATOM_DEF: + if (dflags & DFLAGS_INTERNAL_TAGS) { + if (atom_val(obj) >= (1<<16)) { + result += 1 + 3; + } + else { + result += 1 + 2; + } } else { - /* Make sure an ATOM_EXT fits: ATOM_EXT l1 l0 t1 t2... */ - result += 1 + 2 + alen; + int alen = atom_tab(atom_val(obj))->len; + if ((MAX_ATOM_LENGTH <= 255 || alen <= 255) + && (dflags & DFLAG_SMALL_ATOM_TAGS)) { + /* Make sure a SMALL_ATOM_EXT fits: SMALL_ATOM_EXT l t1 t2... */ + result += 1 + 1 + alen; + } + else { + /* Make sure an ATOM_EXT fits: ATOM_EXT l1 l0 t1 t2... */ + result += 1 + 2 + alen; + } + insert_acache_map(acmp, obj); } - insert_acache_map(acmp, obj); break; - } case SMALL_DEF: { Sint val = signed_val(obj); @@ -2734,8 +2919,25 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) } break; case BINARY_DEF: + if (dflags & DFLAGS_INTERNAL_TAGS) { + ProcBin* pb = (ProcBin*) binary_val(obj); + Uint sub_extra = 0; + Uint tot_bytes = pb->size; + if (pb->thing_word == HEADER_SUB_BIN) { + ErlSubBin* sub = (ErlSubBin*) pb; + pb = (ProcBin*) binary_val(sub->orig); + sub_extra = 2; /* bitoffs and bitsize */ + tot_bytes += (sub->bitoffs + sub->bitsize+ 7) / 8; + } + if (pb->thing_word == HEADER_PROC_BIN + && heap_bin_size(tot_bytes) > PROC_BIN_SIZE) { + + result += 1 + sub_extra + sizeof(ProcBin); + break; + } + } result += 1 + 4 + binary_size(obj) + - 5; /* For unaligned binary */ + 5; /* For unaligned binary */ break; case FUN_DEF: { @@ -2807,7 +3009,7 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) } static Sint -decoded_size(byte *ep, byte* endp, int no_refc_bins) +decoded_size(byte *ep, byte* endp, int no_refc_bins, int internal_tags) { int heap_size = 0; int terms; @@ -3017,6 +3219,29 @@ decoded_size(byte *ep, byte* endp, int no_refc_bins) heap_size += ERL_FUN_SIZE + num_free; break; } + case ATOM_INTERNAL_REF2: + SKIP(2+atom_extra_skip); + atom_extra_skip = 0; + break; + case ATOM_INTERNAL_REF3: + SKIP(3+atom_extra_skip); + atom_extra_skip = 0; + break; + + case BINARY_INTERNAL_REF: + if (!internal_tags) { + return -1; + } + SKIP(sizeof(ProcBin)); + heap_size += PROC_BIN_SIZE; + break; + case BIT_BINARY_INTERNAL_REF: + if (!internal_tags) { + return -1; + } + SKIP(2+sizeof(ProcBin)); + heap_size += PROC_BIN_SIZE + ERL_SUB_BIN_SIZE; + break; default: return -1; } diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index cee48bbeb0..d8287b96a4 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -54,6 +54,10 @@ #define DIST_HEADER 'D' #define ATOM_CACHE_REF 'R' +#define ATOM_INTERNAL_REF2 'I' +#define ATOM_INTERNAL_REF3 'K' +#define BINARY_INTERNAL_REF 'J' +#define BIT_BINARY_INTERNAL_REF 'L' #define COMPRESSED 'P' #if 0 @@ -156,7 +160,9 @@ Uint erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap *); void erts_encode_dist_ext(Eterm, byte **, Uint32, ErtsAtomCacheMap *); Uint erts_encode_ext_size(Eterm); +Uint erts_encode_ext_size_ets(Eterm); void erts_encode_ext(Eterm, byte **); +byte* erts_encode_ext_ets(Eterm, byte *, struct erl_off_heap_header** ext_off_heap); #ifdef ERTS_WANT_EXTERNAL_TAGS ERTS_GLB_INLINE void erts_peek_dist_header(ErtsDistHeaderPeek *, byte *, Uint); @@ -172,7 +178,9 @@ Sint erts_decode_dist_ext_size(ErtsDistExternal *, int); Eterm erts_decode_dist_ext(Eterm **, ErlOffHeap *, ErtsDistExternal *); Sint erts_decode_ext_size(byte*, Uint, int); +Sint erts_decode_ext_size_ets(byte*, Uint); Eterm erts_decode_ext(Eterm **, ErlOffHeap *, byte**); +Eterm erts_decode_ext_ets(Eterm **, ErlOffHeap *, byte*); Eterm erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 12536f6cde..89c6625550 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -522,6 +522,7 @@ union erl_off_heap_ptr { struct erl_fun_thing* fun; struct external_thing_* ext; Eterm* ep; + void* voidp; }; /* arrays that get malloced at startup */ diff --git a/erts/emulator/beam/packet_parser.c b/erts/emulator/beam/packet_parser.c index 5bcd567b5f..a66d60aa22 100644 --- a/erts/emulator/beam/packet_parser.c +++ b/erts/emulator/beam/packet_parser.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * Copyright Ericsson AB 2008-2010. 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 @@ -47,11 +47,6 @@ (((unsigned char*) (s))[1] << 8) | \ (((unsigned char*) (s))[0])) -#define put_int24(s, x) ((((unsigned char*)(s))[0] = ((x) >> 16) & 0xff), \ - (((unsigned char*)(s))[1] = ((x) >> 8) & 0xff), \ - (((unsigned char*)(s))[2] = (x) & 0xff)) - - #if !defined(__WIN32__) && !defined(HAVE_STRNCASECMP) #define STRNCASECMP my_strncasecmp @@ -833,7 +828,7 @@ int packet_parse_ssl(const char* buf, int len, char prefix[4]; /* <<1:8,Length:24,Data/binary>> */ prefix[0] = 1; - put_int24(&prefix[1],len-3); + put_int24(len-3,&prefix[1]); return pcb->ssl_tls(arg, 22, major, minor, buf+3, len-3, prefix, sizeof(prefix)); } else { diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 93203a08a9..0d15272aa8 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -1166,6 +1166,15 @@ void* sys_calloc2(Uint, Uint); ((char*)(s))[3] = (char)(i) & 0xff;} \ while (0) +#define get_int24(s) ((((unsigned char*) (s))[0] << 16) | \ + (((unsigned char*) (s))[1] << 8) | \ + (((unsigned char*) (s))[2])) + +#define put_int24(i, s) do {((char*)(s))[0] = (char)((i) >> 16) & 0xff; \ + ((char*)(s))[1] = (char)((i) >> 8) & 0xff; \ + ((char*)(s))[2] = (char)(i) & 0xff;} \ + while (0) + #define get_int16(s) ((((unsigned char*) (s))[0] << 8) | \ (((unsigned char*) (s))[1])) @@ -1179,6 +1188,7 @@ void* sys_calloc2(Uint, Uint); #define put_int8(i, s) do {((unsigned char*)(s))[0] = (i) & 0xff;} while (0) + /* * Use DEBUGF as you would use printf, but use double parentheses: * diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index f45cfa3e4a..42947aa6be 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -73,7 +73,7 @@ basic(Config) when is_list(Config) -> ?line true = (lib_version() =/= undefined), ?line [{load,1,1,101},{lib_version,1,2,102}] = call_history(), ?line [] = call_history(), - ?line [?MODULE] = erlang:system_info(taints), + ?line true = lists:member(?MODULE, erlang:system_info(taints)), ok. reload(doc) -> ["Test reload callback in nif lib"]; @@ -107,7 +107,8 @@ reload(Config) when is_list(Config) -> ?line true = erlang:purge_module(nif_mod), ?line [{unload,1,3,103}] = nif_mod_call_history(), - ?line [?MODULE, nif_mod] = erlang:system_info(taints), + ?line true = lists:member(?MODULE, erlang:system_info(taints)), + ?line true = lists:member(nif_mod, erlang:system_info(taints)), ?line verify_tmpmem(TmpMem), ok. @@ -197,7 +198,8 @@ upgrade(Config) when is_list(Config) -> ?line true = erlang:purge_module(nif_mod), ?line [{unload,2,4,204}] = nif_mod_call_history(), - ?line [?MODULE, nif_mod] = erlang:system_info(taints), + ?line true = lists:member(?MODULE, erlang:system_info(taints)), + ?line true = lists:member(nif_mod, erlang:system_info(taints)), ?line verify_tmpmem(TmpMem), ok. @@ -727,7 +729,8 @@ resource_takeover(Config) when is_list(Config) -> ?line ok = forget_resource(AN4), ?line [] = nif_mod_call_history(), - ?line [?MODULE, nif_mod] = erlang:system_info(taints), + ?line true = lists:member(?MODULE, erlang:system_info(taints)), + ?line true = lists:member(nif_mod, erlang:system_info(taints)), ?line verify_tmpmem(TmpMem), ok. diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 42e4cf08f4..2ea2ba106a 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -101,12 +101,14 @@ run([TS|TestSpecs],AllowUserTerms,InclNodes,ExclNodes) when is_list(TS), TSRec=#testspec{logdir=AllLogDirs, config=StdCfgFiles, userconfig=UserCfgFiles, + include=AllIncludes, init=AllInitOpts, event_handler=AllEvHs} -> AllCfgFiles = {StdCfgFiles, UserCfgFiles}, RunSkipPerNode = ct_testspec:prepare_tests(TSRec), RunSkipPerNode2 = exclude_nodes(ExclNodes,RunSkipPerNode), - run_all(RunSkipPerNode2,AllLogDirs,AllCfgFiles,AllEvHs,[],[],AllInitOpts,TS1) + run_all(RunSkipPerNode2,AllLogDirs,AllCfgFiles,AllEvHs, + AllIncludes,[],[],AllInitOpts,TS1) end, [{TS,Result} | run(TestSpecs,AllowUserTerms,InclNodes,ExclNodes)]; run([],_,_,_) -> @@ -163,11 +165,13 @@ run_on_node([TS|TestSpecs],AllowUserTerms,Node) when is_list(TS),is_atom(Node) - TSRec=#testspec{logdir=AllLogDirs, config=StdCfgFiles, init=AllInitOpts, + include=AllIncludes, userconfig=UserCfgFiles, event_handler=AllEvHs} -> AllCfgFiles = {StdCfgFiles, UserCfgFiles}, {Run,Skip} = ct_testspec:prepare_tests(TSRec,Node), - run_all([{Node,Run,Skip}],AllLogDirs,AllCfgFiles,AllEvHs,[],[],AllInitOpts,TS1) + run_all([{Node,Run,Skip}],AllLogDirs,AllCfgFiles,AllEvHs, + AllIncludes, [],[],AllInitOpts,TS1) end, [{TS,Result} | run_on_node(TestSpecs,AllowUserTerms,Node)]; run_on_node([],_,_) -> @@ -189,7 +193,7 @@ run_on_node(TestSpecs,Node) -> run_all([{Node,Run,Skip}|Rest],AllLogDirs, {AllStdCfgFiles, AllUserCfgFiles}=AllCfgFiles, - AllEvHs,NodeOpts,LogDirs,InitOptions,Specs) -> + AllEvHs,AllIncludes,NodeOpts,LogDirs,InitOptions,Specs) -> LogDir = lists:foldl(fun({N,Dir},_Found) when N == Node -> Dir; @@ -211,6 +215,14 @@ run_all([{Node,Run,Skip}|Rest],AllLogDirs, ({_N,_F},Fs) -> Fs; (F,Fs) -> [{userconfig, F}|Fs] end,[],AllUserCfgFiles), + + Includes = lists:foldr(fun({N,I},Acc) when N =:= Node -> + [I|Acc]; + ({_,_},Acc) -> + Acc; + (I,Acc) -> + [I | Acc] + end, [], AllIncludes), EvHs = lists:foldr(fun({N,H,A},Hs) when N == Node -> [{H,A}|Hs]; ({_N,_H,_A},Hs) -> Hs; @@ -219,10 +231,13 @@ run_all([{Node,Run,Skip}|Rest],AllLogDirs, NO = {Node,[{prepared_tests,{Run,Skip},Specs}, {logdir,LogDir}, + {include, Includes}, {config,StdCfgFiles}, {event_handler,EvHs}] ++ UserCfgFiles}, - run_all(Rest,AllLogDirs,AllCfgFiles,AllEvHs,[NO|NodeOpts],[LogDir|LogDirs],InitOptions,Specs); -run_all([],AllLogDirs,_,AllEvHs,NodeOpts,LogDirs,InitOptions,Specs) -> + run_all(Rest,AllLogDirs,AllCfgFiles,AllEvHs,AllIncludes, + [NO|NodeOpts],[LogDir|LogDirs],InitOptions,Specs); +run_all([],AllLogDirs,_,AllEvHs,_AllIncludes, + NodeOpts,LogDirs,InitOptions,Specs) -> Handlers = [{H,A} || {Master,H,A} <- AllEvHs, Master == master], MasterLogDir = case lists:keysearch(master,1,AllLogDirs) of {value,{_,Dir}} -> Dir; diff --git a/lib/common_test/test/ct_master_SUITE.erl b/lib/common_test/test/ct_master_SUITE.erl index e0e1f93db2..5ac2866227 100644 --- a/lib/common_test/test/ct_master_SUITE.erl +++ b/lib/common_test/test/ct_master_SUITE.erl @@ -33,6 +33,13 @@ -define(eh, ct_test_support_eh). +-define(TEMP_DIR, case os:type() of + {win32,_} -> + "c:/Temp"; + _ -> + "/tmp" + end). + %%-------------------------------------------------------------------- %% TEST SERVER CALLBACK FUNCTIONS %%-------------------------------------------------------------------- @@ -43,18 +50,39 @@ %% there will be clashes with logging processes etc). %%-------------------------------------------------------------------- init_per_suite(Config) -> - Config1 = ct_test_support:init_per_suite(Config), - Config1. + ct_test_support:init_per_suite(Config). end_per_suite(Config) -> ct_test_support:end_per_suite(Config). init_per_testcase(TestCase, Config) -> - ct_test_support:init_per_testcase(TestCase, [{master, true}|Config]). + NodeCount = 5, + NodeNames = [list_to_atom("t_"++integer_to_list(N)) || + N <- lists:seq(1, NodeCount)], + ct_test_support:init_per_testcase( + TestCase,[{node_names,NodeNames}, + {master, true}|Config]). end_per_testcase(TestCase, Config) -> + case os:type() of + {win32,_} -> + %% If this is a windows run the logs are saved to /tmp and + %% then moved to private_dir as a tar because otherwise + %% the file names become too long! :( + Files = filelib:wildcard(filename:join(?TEMP_DIR,"slave.*")), + erl_tar:create( + filename:join( + proplists:get_value(priv_dir,Config),"slaves.tar.gz"), + Files,[compressed]), + os:cmd("rm -rf "++filename:join(?TEMP_DIR,"slave.*")); + _ -> + ok + end, + ct_test_support:end_per_testcase(TestCase, Config). +all() -> + all(suite). all(doc) -> [""]; @@ -67,15 +95,35 @@ all(suite) -> %% TEST CASES %%-------------------------------------------------------------------- ct_master_test(Config) when is_list(Config)-> - NodeCount = 5, + NodeNames = proplists:get_value(node_names, Config), DataDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), - NodeNames = [list_to_atom("testnode_"++integer_to_list(N)) || - N <- lists:seq(1, NodeCount)], + FileName = filename:join(PrivDir, "ct_master_spec.spec"), Suites = [master_SUITE], TSFile = make_spec(DataDir, FileName, NodeNames, Suites, Config), + ERPid = ct_test_support:start_event_receiver(Config), + spawn(ct@ancalagon, + fun() -> + dbg:tracer(),dbg:p(all,c), + dbg:tpl(erlang, spawn_link, 4,x), + receive ok -> ok end + end), + [{TSFile, ok}] = run_test(ct_master_test, FileName, Config), + + Events = ct_test_support:get_events(ERPid, Config), + + ct_test_support:log_events(groups_suite_1, + reformat(Events, ?eh), + ?config(priv_dir, Config)), + find_events(NodeNames, [{tc_start,{master_SUITE,init_per_suite}}, + {tc_start,{master_SUITE,first_testcase}}, + {tc_start,{master_SUITE,second_testcase}}, + {tc_start,{master_SUITE,third_testcase}}, + {tc_start,{master_SUITE,end_per_suite}}], + Events), + ok. %%%----------------------------------------------------------------- @@ -112,13 +160,25 @@ make_spec(DataDir, FileName, NodeNames, Suites, Config)-> PrivDir = ?config(priv_dir, Config), LD = lists:map(fun(NodeName)-> - {logdir, NodeName, get_log_dir(PrivDir, NodeName)} + {logdir, NodeName, get_log_dir(os:type(),PrivDir, NodeName)} end, NodeNames) ++ [{logdir, master, PrivDir}], - - ct_test_support:write_testspec(N++C++S++LD++NS, FileName). - -get_log_dir(PrivDir, NodeName)-> + EvHArgs = [{cbm,ct_test_support},{trace_level,?config(trace_level,Config)}], + EH = [{event_handler,master,[?eh],EvHArgs}], + + Include = [{include,filename:join([DataDir,"master/include"])}], + + ct_test_support:write_testspec(N++Include++EH++C++S++LD++NS, FileName). + +get_log_dir({win32,_},PrivDir, NodeName)-> + case filelib:is_dir(?TEMP_DIR) of + false -> + file:make_dir(?TEMP_DIR); + _ -> + ok + end, + get_log_dir(tmp, ?TEMP_DIR,NodeName); +get_log_dir(_,PrivDir,NodeName) -> LogDir = filename:join(PrivDir, io_lib:format("slave.~p", [NodeName])), file:make_dir(LogDir), LogDir. @@ -126,11 +186,34 @@ get_log_dir(PrivDir, NodeName)-> run_test(_Name, FileName, Config)-> [{FileName, ok}] = ct_test_support:run(ct_master, run, [FileName], Config). -reformat_events(Events, EH) -> +reformat(Events, EH) -> ct_test_support:reformat(Events, EH). %%%----------------------------------------------------------------- %%% TEST EVENTS %%%----------------------------------------------------------------- +find_events([], _CheckEvents, _) -> + ok; +find_events([NodeName|NodeNames],CheckEvents,AllEvents) -> + find_events(NodeNames, CheckEvents, + remove_events(add_host(NodeName),CheckEvents, AllEvents, [])). + +remove_events(Node,[{Name,Data} | RestChecks], + [{?eh,#event{ name = Name, node = Node, data = Data }}|RestEvs], + Acc) -> + remove_events(Node, RestChecks, RestEvs, Acc); +remove_events(Node, Checks, [Event|RestEvs], Acc) -> + remove_events(Node, Checks, RestEvs, [Event | Acc]); +remove_events(_Node, [], [], Acc) -> + lists:reverse(Acc); +remove_events(Node, Events, [], Acc) -> + test_server:format("Could not find events: ~p in ~p for node ~p", + [Events, lists:reverse(Acc), Node]), + exit(event_not_found). + +add_host(NodeName) -> + {ok, HostName} = inet:gethostname(), + list_to_atom(atom_to_list(NodeName)++"@"++HostName). + expected_events(_)-> -[]. + []. diff --git a/lib/common_test/test/ct_master_SUITE_data/master/include/test.hrl b/lib/common_test/test/ct_master_SUITE_data/master/include/test.hrl new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/common_test/test/ct_master_SUITE_data/master/include/test.hrl diff --git a/lib/common_test/test/ct_master_SUITE_data/master/master_SUITE.erl b/lib/common_test/test/ct_master_SUITE_data/master/master_SUITE.erl index e37ec3659c..032d69ad9f 100644 --- a/lib/common_test/test/ct_master_SUITE_data/master/master_SUITE.erl +++ b/lib/common_test/test/ct_master_SUITE_data/master/master_SUITE.erl @@ -28,6 +28,7 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). +-include("test.hrl"). suite() -> []. diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 85614a84c2..92cc2b4dd9 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -126,6 +126,7 @@ static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -194,6 +195,8 @@ static ErlNifFunc nif_funcs[] = { {"des_ecb_crypt", 3, des_ecb_crypt}, {"des_ede3_cbc_crypt", 6, des_ede3_cbc_crypt}, {"aes_cfb_128_crypt", 4, aes_cfb_128_crypt}, + {"aes_ctr_encrypt", 3, aes_ctr_encrypt}, + {"aes_ctr_decrypt", 3, aes_ctr_encrypt}, {"rand_bytes", 1, rand_bytes_1}, {"rand_bytes", 3, rand_bytes_3}, {"rand_uniform_nif", 2, rand_uniform_nif}, @@ -654,6 +657,34 @@ static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TE return ret; } +/* Common for both encrypt and decrypt +*/ +static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, IVec, Data) */ + ErlNifBinary key, ivec, text; + AES_KEY aes_key; + unsigned char ivec_clone[16]; /* writable copy */ + unsigned char ecount_buf[AES_BLOCK_SIZE]; + unsigned int num = 0; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) + || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 + || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 + || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { + return enif_make_badarg(env); + } + memcpy(ivec_clone, ivec.data, 16); + memset(ecount_buf, 0, sizeof(ecount_buf)); + AES_ctr128_encrypt((unsigned char *) text.data, + enif_make_new_binary(env, text.size, &ret), + text.size, &aes_key, ivec_clone, ecount_buf, &num); + + /* To do an incremental {en|de}cryption, the state to to keep between calls + must include ivec_clone, ecount_buf and num. */ + return ret; +} + static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Bytes) */ unsigned bytes; diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index e1431cfd81..c407350c47 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -53,7 +53,7 @@ <p>aes: Advanced Encryption Standard (AES) (FIPS 197) </p> </item> <item> - <p>ecb, cbc, cfb, ofb: Recommendation for Block Cipher Modes + <p>ecb, cbc, cfb, ofb, ctr: Recommendation for Block Cipher Modes of Operation (NIST SP 800-38A).</p> </item> <item> @@ -557,6 +557,34 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </desc> </func> <func> + <name>aes_ctr_encrypt(Key, IVec, Text) -> Cipher</name> + <fsummary>Encrypt <c>Text</c>according to AES in Counter mode</fsummary> + <type> + <v>Key = Text = iolist() | binary()</v> + <v>IVec = Cipher = binary()</v> + </type> + <desc> + <p>Encrypts <c>Text</c> according to AES in Counter mode (CTR). <c>Text</c> + can be any number of bytes. <c>Key</c> is the AES key and must be either + 128, 192 or 256 bits long. <c>IVec</c> is an arbitrary initializing vector of 128 bits + (16 bytes).</p> + </desc> + </func> + <func> + <name>aes_ctr_decrypt(Key, IVec, Cipher) -> Text</name> + <fsummary>Decrypt <c>Cipher</c>according to AES in Counter mode</fsummary> + <type> + <v>Key = Cipher = iolist() | binary()</v> + <v>IVec = Text = binary()</v> + </type> + <desc> + <p>Decrypts <c>Cipher</c> according to AES in Counter mode (CTR). <c>Cipher</c> + can be any number of bytes. <c>Key</c> is the AES key and must be either + 128, 192 or 256 bits long. <c>IVec</c> is an arbitrary initializing vector of 128 bits + (16 bytes).</p> + </desc> + </func> + <func> <name>erlint(Mpint) -> N</name> <name>mpint(N) -> Mpint</name> <fsummary>Convert between binary multi-precision integer and erlang big integer</fsummary> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 71fd91cafd..d6e2e033c0 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -51,6 +51,7 @@ -export([aes_cbc_128_encrypt/3, aes_cbc_128_decrypt/3]). -export([aes_cbc_256_encrypt/3, aes_cbc_256_decrypt/3]). -export([aes_cbc_ivec/1]). +-export([aes_ctr_encrypt/3, aes_ctr_decrypt/3]). -export([dh_generate_parameters/2, dh_check/1]). %% Testing see below @@ -80,6 +81,7 @@ rc2_40_cbc_encrypt, rc2_40_cbc_decrypt, %% idea_cbc_encrypt, idea_cbc_decrypt, aes_cbc_256_encrypt, aes_cbc_256_decrypt, + aes_ctr_encrypt, aes_ctr_decrypt, info_lib]). -type rsa_digest_type() :: 'md5' | 'sha'. @@ -542,6 +544,16 @@ aes_cbc_ivec(Data) when is_binary(Data) -> aes_cbc_ivec(Data) when is_list(Data) -> aes_cbc_ivec(list_to_binary(Data)). +%% +%% AES - in counter mode (CTR) +%% +-spec aes_ctr_encrypt(iodata(), binary(), iodata()) -> + binary(). +-spec aes_ctr_decrypt(iodata(), binary(), iodata()) -> + binary(). + +aes_ctr_encrypt(_Key, _IVec, _Data) -> ?nif_stub. +aes_ctr_decrypt(_Key, _IVec, _Cipher) -> ?nif_stub. %% %% XOR - xor to iolists and return a binary diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 06b284d50d..19e10081d8 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -44,6 +44,7 @@ aes_cfb/1, aes_cbc/1, aes_cbc_iter/1, + aes_ctr/1, mod_exp_test/1, rand_uniform_test/1, rsa_verify_test/1, @@ -79,6 +80,7 @@ all(suite) -> aes_cfb, aes_cbc, aes_cbc_iter, + aes_ctr, des_cbc_iter, des_ecb, rand_uniform_test, @@ -619,6 +621,65 @@ aes_cbc_decrypt_iter(Key,IVec,Data, Acc) -> aes_cbc_decrypt_iter(Key,IVec2,Rest, <<Acc/binary, Plain/binary>>). +aes_ctr(doc) -> "CTR"; +aes_ctr(Config) when is_list(Config) -> + %% Sample data from NIST Spec.Publ. 800-38A + %% F.5.1 CTR-AES128.Encrypt + Key128 = hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + Samples128 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block + "6bc1bee22e409f96e93d7e117393172a", % Plaintext + "874d6191b620e3261bef6864990db6ce"},% Ciphertext + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", + "ae2d8a571e03ac9c9eb76fac45af8e51", + "9806f66b7970fdff8617187bb9fffdff"}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", + "30c81c46a35ce411e5fbc1191a0a52ef", + "5ae4df3edbd5d35e5b4f09020db03eab"}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", + "f69f2445df4f9b17ad2b417be66c3710", + "1e031dda2fbe03d1792170a0f3009cee"}], + lists:foreach(fun(S) -> aes_ctr_do(Key128,S) end, Samples128), + + %% F.5.3 CTR-AES192.Encrypt + Key192 = hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + Samples192 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block + "6bc1bee22e409f96e93d7e117393172a", % Plaintext + "1abc932417521ca24f2b0459fe7e6e0b"},% Ciphertext + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", + "ae2d8a571e03ac9c9eb76fac45af8e51", + "090339ec0aa6faefd5ccc2c6f4ce8e94"}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", + "30c81c46a35ce411e5fbc1191a0a52ef", + "1e36b26bd1ebc670d1bd1d665620abf7"}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", + "f69f2445df4f9b17ad2b417be66c3710", + "4f78a7f6d29809585a97daec58c6b050"}], + lists:foreach(fun(S) -> aes_ctr_do(Key192,S) end, Samples192), + + %% F.5.5 CTR-AES256.Encrypt + Key256 = hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + Samples256 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block + "6bc1bee22e409f96e93d7e117393172a", % Plaintext + "601ec313775789a5b7a7f504bbf3d228"},% Ciphertext + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", + "ae2d8a571e03ac9c9eb76fac45af8e51", + "f443e3ca4d62b59aca84e990cacaf5c5"}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", + "30c81c46a35ce411e5fbc1191a0a52ef", + "2b0930daa23de94ce87017ba2d84988d"}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", + "f69f2445df4f9b17ad2b417be66c3710", + "dfc9c58db67aada613c2dd08457941a6"}], + lists:foreach(fun(S) -> aes_ctr_do(Key256,S) end, Samples256). + + +aes_ctr_do(Key,{IVec, Plain, Cipher}) -> + ?line I = hexstr2bin(IVec), + ?line P = hexstr2bin(Plain), + ?line C = crypto:aes_ctr_encrypt(Key, I, P), + ?line m(C, hexstr2bin(Cipher)), + ?line m(P, crypto:aes_ctr_decrypt(Key, I, C)). + %% %% mod_exp_test(doc) -> diff --git a/lib/inets/doc/src/mod_auth.xml b/lib/inets/doc/src/mod_auth.xml index f3628c8297..9503add2e0 100644 --- a/lib/inets/doc/src/mod_auth.xml +++ b/lib/inets/doc/src/mod_auth.xml @@ -111,7 +111,8 @@ </desc> </func> <func> - <name>list_users(Options) -> {ok, Users} | {error, Reason} <name>list_users(Port, Dir) -> {ok, Users} | {error, Reason}</name> + <name>list_users(Options) -> {ok, Users} | {error, Reason}</name> + <name>list_users(Port, Dir) -> {ok, Users} | {error, Reason}</name> <name>list_users(Address, Port, Dir) -> {ok, Users} | {error, Reason}</name> <fsummary>List users in the user database.</fsummary> <type> diff --git a/lib/mnesia/doc/src/Mnesia_chap2.xmlsrc b/lib/mnesia/doc/src/Mnesia_chap2.xmlsrc index 0714c7b645..2e2cc386b7 100644 --- a/lib/mnesia/doc/src/Mnesia_chap2.xmlsrc +++ b/lib/mnesia/doc/src/Mnesia_chap2.xmlsrc @@ -235,9 +235,7 @@ <seealso marker="Mnesia_chap3#start_mnesia">Starting Mnesia</seealso>. </item> </list> - <p>Continuing the dialogue with the Erlang shell will produce the following - the following: - </p> + <p>Continuing the dialogue with the Erlang shell will produce the following:</p> <pre><![CDATA[ 3> company:init(). {atomic,ok} @@ -418,7 +416,7 @@ In_proj</tcaption> interchangeably throughout this book. </p> <p>A Mnesia table is populated by Mnesia records. For example, - the tuple <c>{boss, klacke, bjarne}</c> is an record. The + the tuple <c>{boss, klacke, bjarne}</c> is a record. The second element in this tuple is the key. In order to uniquely identify a table row both the key and the table name is needed. The term <em>object identifier</em>, @@ -553,7 +551,7 @@ In_proj</tcaption> stored in the database: </p> <pre> -\011 mnesia:select(employee, [{#employee{sex = female, name = '$1', _ = '_'},[], ['$1']}]). +mnesia:select(employee, [{#employee{sex = female, name = '$1', _ = '_'},[], ['$1']}]). </pre> <p>Select must always run within an activity such as a transaction. To be able to call from the shell we might @@ -587,8 +585,8 @@ In_proj</tcaption> </p> <pre> Q = qlc:q([E#employee.name || E <![CDATA[<-]]> mnesia:table(employee), -\011 E#employee.sex == female]), -\011 qlc:e(Q), + E#employee.sex == female]), + qlc:e(Q), </pre> <p>Accessing mnesia tables from a QLC list comprehension must always be done within a transaction. Consider the following diff --git a/lib/mnesia/doc/src/Mnesia_chap3.xml b/lib/mnesia/doc/src/Mnesia_chap3.xml index 9a382bcb5a..2db9af9cf7 100644 --- a/lib/mnesia/doc/src/Mnesia_chap3.xml +++ b/lib/mnesia/doc/src/Mnesia_chap3.xml @@ -132,7 +132,7 @@ function changes the format on all records in table <c>Tab</c>. It applies the argument <c>Fun</c> to all records in the table. <c>Fun</c> shall be a function which - takes an record of the old type, and returns the record of the new + takes a record of the old type, and returns the record of the new type. The table key may not be changed.</p> <code type="none"> -record(old, {key, val}). @@ -418,8 +418,8 @@ skeppet %<input>erl -sname b -mnesia dir '"/ldisc/scratch/Mnesia.company"'</inpu type <c>set</c> and <c>bag</c>: </p> <pre> f() -> F = fun() -> -\011 mnesia:write({foo, 1, 2}), mnesia:write({foo, 1, 3}), -\011 mnesia:read({foo, 1}) end, mnesia:transaction(F). </pre> + mnesia:write({foo, 1, 2}), mnesia:write({foo, 1, 3}), + mnesia:read({foo, 1}) end, mnesia:transaction(F). </pre> <p>This transaction will return the list <c>[{foo,1,3}]</c> if the <c>foo</c> table is of type <c>set</c>. However, list <c>[{foo,1,2}, {foo,1,3}]</c> will return if the table is diff --git a/lib/mnesia/doc/src/Mnesia_chap4.xmlsrc b/lib/mnesia/doc/src/Mnesia_chap4.xmlsrc index 7d89c1b0dd..6e8055326b 100644 --- a/lib/mnesia/doc/src/Mnesia_chap4.xmlsrc +++ b/lib/mnesia/doc/src/Mnesia_chap4.xmlsrc @@ -514,13 +514,13 @@ The behavior is undefined if any process perform a write of the table itself. This is an implementation detail, but remember the dirty functions are low level functions. </item> - <item><c>mnesia:dirty_last(Tab)</c> This function works exactly as + <item><c>mnesia:dirty_last(Tab)</c> This function works exactly like <c>mnesia:dirty_first/1</c> but returns the last object in Erlang term order for the <c>ordered_set</c> table type. For all other table types, <c>mnesia:dirty_first/1</c> and <c>mnesia:dirty_last/1</c> are synonyms. </item> - <item><c>mnesia:dirty_prev(Tab, Key)</c> This function works exactly as + <item><c>mnesia:dirty_prev(Tab, Key)</c> This function works exactly like <c>mnesia:dirty_next/2</c> but returns the previous object in Erlang term order for the ordered_set table type. For all other table types, <c>mnesia:dirty_next/2</c> and diff --git a/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc b/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc index 1c7e3662e1..30a8991465 100644 --- a/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc +++ b/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc @@ -335,7 +335,7 @@ ok explicitly be set at table creation. The default is <c>0</c>, but if <c>n_disc_copies</c> and <c>n_disc_only_copies</c> also are <c>0</c>, - <c>n_ram_copies</c>\011will default be set to <c>1</c>. + <c>n_ram_copies</c> will default be set to <c>1</c>. </p> </item> <tag><c>{n_disc_copies, Int}</c></tag> @@ -408,7 +408,7 @@ ok (a@sam)4> SecProps = [{foreign_key, {prim_dict, sec_val}}]. [{foreign_key,{prim_dict,sec_val}}] (a@sam)5> mnesia:create_table(sec_dict, -\011 [{frag_properties, SecProps}, + [{frag_properties, SecProps}, (a@sam)5> {attributes, [sec_key, sec_val]}]). {atomic,ok} (a@sam)6> Write = fun(Rec) -> mnesia:write(Rec) end. @@ -418,23 +418,23 @@ ok (a@sam)8> SecKey = 42. 42 (a@sam)9> mnesia:activity(sync_dirty, Write, -\011\011 [{prim_dict, PrimKey, -11}], mnesia_frag). + [{prim_dict, PrimKey, -11}], mnesia_frag). ok (a@sam)10> mnesia:activity(sync_dirty, Write, -\011\011 [{sec_dict, SecKey, PrimKey}], mnesia_frag). + [{sec_dict, SecKey, PrimKey}], mnesia_frag). ok (a@sam)11> mnesia:change_table_frag(prim_dict, {add_frag, [node()]}). {atomic,ok} (a@sam)12> SecRead = fun(PrimKey, SecKey) -> -\011\011 mnesia:read({sec_dict, PrimKey}, SecKey, read) end. + mnesia:read({sec_dict, PrimKey}, SecKey, read) end. #Fun<erl_eval> (a@sam)13> mnesia:activity(transaction, SecRead, -\011\011 [PrimKey, SecKey], mnesia_frag). + [PrimKey, SecKey], mnesia_frag). [{sec_dict,42,11}] (a@sam)14> Info = fun(Tab, Item) -> mnesia:table_info(Tab, Item) end. #Fun<erl_eval> (a@sam)15> mnesia:activity(sync_dirty, Info, -\011\011 [prim_dict, frag_size], mnesia_frag). + [prim_dict, frag_size], mnesia_frag). [{prim_dict,0}, {prim_dict_frag2,0}, {prim_dict_frag3,0}, @@ -444,7 +444,7 @@ ok {prim_dict_frag7,0}, {prim_dict_frag8,0}] (a@sam)16> mnesia:activity(sync_dirty, Info, -\011\011 [sec_dict, frag_size], mnesia_frag). + [sec_dict, frag_size], mnesia_frag). [{sec_dict,0}, {sec_dict_frag2,0}, {sec_dict_frag3,0}, @@ -1051,7 +1051,7 @@ ok ActivityID will be received. Note that this event may still be received even if no table events with a corresponding ActivityID were received, depending on the tables to which the receiving process is subscribed.</p> - <p>Dirty operations always only contain one update and thus no activity event is sent.</p> + <p>Dirty operations always only contain one update and thus no activity event is sent.</p> </item> </taglist> </section> diff --git a/lib/mnesia/doc/src/mnesia.xml b/lib/mnesia/doc/src/mnesia.xml index 5d3bcf830e..16e78ea0af 100644 --- a/lib/mnesia/doc/src/mnesia.xml +++ b/lib/mnesia/doc/src/mnesia.xml @@ -799,7 +799,7 @@ mnesia:change_table_copy_type(person, node(), disc_copies) </item> <item> <p><c>{local_content, Bool}</c>, where <c>Bool</c> must be - either <c>true</c> or <c>false</c>. The default value is <c>false</c>.\011 </p> + either <c>true</c> or <c>false</c>. The default value is <c>false</c>.</p> </item> </list> <p>For example, the following call creates the <c>person</c> table @@ -1022,7 +1022,7 @@ mnesia:create_table(person, <name>dirty_last(Tab) -> Key | exit({aborted, Reason}) </name> <fsummary>Return the key for the last record in a table.</fsummary> <desc> - <p>This function works exactly + <p>This function works exactly like <c>mnesia:dirty_first/1</c> but returns the last object in Erlang term order for the <c>ordered_set</c> table type. For all other table types, <c>mnesia:dirty_first/1</c> and @@ -1063,11 +1063,11 @@ mnesia:create_table(person, <name>dirty_prev(Tab, Key) -> Key | exit({aborted, Reason}) </name> <fsummary>Return the previous key in a table. </fsummary> <desc> - <p>This function works exactly + <p>This function works exactly like <c>mnesia:dirty_next/2</c> but returns the previous object in Erlang term order for the ordered_set table type. For all other table types, <c>mnesia:dirty_next/2</c> and - <c>mnesia:dirty_prev/2</c> are synonyms.\011 </p> + <c>mnesia:dirty_prev/2</c> are synonyms.</p> </desc> </func> <func> @@ -1334,7 +1334,7 @@ mnesia:create_table(person, <name>foldr(Function, Acc, Table) -> NewAcc | transaction abort </name> <fsummary>Call Function for each record in Table </fsummary> <desc> - <p>This function works exactly as + <p>This function works exactly like <c>foldl/3</c> but iterates the table in the opposite order for the <c>ordered_set</c> table type. For all other table types, <c>foldr/3</c> and @@ -1512,14 +1512,14 @@ mnesia:create_table(person, <fsummary>Check if code is running in a transaction.</fsummary> <desc> <p>When this function is executed inside a transaction context - it returns <c>true</c>, otherwise <c>false</c>.</p> + it returns <c>true</c>, otherwise <c>false</c>.</p> </desc> </func> <func> <name>last(Tab) -> Key | transaction abort </name> <fsummary>Return the key for the last record in a table.</fsummary> <desc> - <p>This function works exactly + <p>This function works exactly like <c>mnesia:first/1</c> but returns the last object in Erlang term order for the <c>ordered_set</c> table type. For all other table types, <c>mnesia:first/1</c> and @@ -1698,11 +1698,11 @@ mnesia:create_table(person, <name>prev(Tab, Key) -> Key | transaction abort </name> <fsummary>Return the previous key in a table. </fsummary> <desc> - <p>This function works exactly + <p>This function works exactly like <c>mnesia:next/2</c> but returns the previous object in Erlang term order for the ordered_set table type. For all other table types, <c>mnesia:next/2</c> and - <c>mnesia:prev/2</c> are synonyms.\011 </p> + <c>mnesia:prev/2</c> are synonyms.</p> </desc> </func> <func> @@ -1891,10 +1891,10 @@ mnesia:create_table(person, <p>For example to find the names of all male persons with an age over 30 in table Tab do:</p> <code type="none"> -\011 MatchHead = #person{name='$1', sex=male, age='$2', _='_'}, -\011 Guard = {'>', '$2', 30}, -\011 Result = '$1', -\011 mnesia:select(Tab,[{MatchHead, [Guard], [Result]}]), +MatchHead = #person{name='$1', sex=male, age='$2', _='_'}, +Guard = {'>', '$2', 30}, +Result = '$1', +mnesia:select(Tab,[{MatchHead, [Guard], [Result]}]), </code> </desc> </func> @@ -2835,7 +2835,7 @@ raise(Name, Amount) -> </func> <func> <name>write(Tab, Record, LockKind) -> transaction abort | ok </name> - <fsummary>Write an record into the database.</fsummary> + <fsummary>Write a record into the database.</fsummary> <desc> <p>Writes the record <c>Record</c> to the table <c>Tab</c>. </p> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 702e1b928e..746f94d3f4 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -485,6 +485,9 @@ Error: fun containing local Erlang function calls <item><c>Item=protection, Value=public|protected|private</c> <br></br> The table access rights.</item> + <item><c>Item=compressed, Value=true|false</c> <br></br> + + Indicates if the table is compressed or not.</item> </list> </desc> </func> @@ -951,9 +954,10 @@ ets:select(Table,MatchSpec),</code> <type> <v>Name = atom()</v> <v>Options = [Option]</v> - <v> Option = Type | Access | named_table | {keypos,Pos} | {heir,pid(),HeirData} | {heir,none} | {write_concurrency,bool()} | {read_concurrency,bool()}</v> + <v> Option = Type | Access | named_table | {keypos,Pos} | {heir,pid(),HeirData} | {heir,none} | Tweaks</v> <v> Type = set | ordered_set | bag | duplicate_bag</v> <v> Access = public | protected | private</v> + <v> Tweaks = {write_concurrency,bool()} | {read_concurrency,bool()} | compressed</v> <v> Pos = int()</v> <v> HeirData = term()</v> </type> @@ -1047,13 +1051,13 @@ ets:select(Table,MatchSpec),</code> <item> <marker id="new_2_write_concurrency"></marker> <p><c>{write_concurrency,bool()}</c> - Performance tuning. Default is <c>false</c>. An operation that + Performance tuning. Default is <c>false</c>, in which case an operation that mutates (writes to) the table will obtain exclusive access, blocking any concurrent access of the same table until finished. If set to <c>true</c>, the table is optimized towards concurrent write access. Different objects of the same table can be mutated (and read) by concurrent processes. This is achieved to some degree - at the expense of single access and concurrent reader performance. + at the expense of sequential access and concurrent reader performance. The <c>write_concurrency</c> option can be combined with the <seealso marker="#new_2_read_concurrency">read_concurrency</seealso> option. You typically want to combine these when large concurrent @@ -1091,6 +1095,15 @@ ets:select(Table,MatchSpec),</code> option. You typically want to combine these when large concurrent read bursts and large concurrent write bursts are common.</p> </item> + <item> + <marker id="new_2_compressed"></marker> + <p><c>compressed</c> + If this option is present, the table data will be stored in a more compact format to + consume less memory. The downside is that it will make table operations slower. + Especially operations that need to inspect entire objects, + such as <c>match</c> and <c>select</c>, will get much slower. The key element + is not compressed in current implementation.</p> + </item> </list> </desc> </func> diff --git a/lib/stdlib/doc/src/re.xml b/lib/stdlib/doc/src/re.xml index 80adc3e347..056e7bc9b9 100644 --- a/lib/stdlib/doc/src/re.xml +++ b/lib/stdlib/doc/src/re.xml @@ -37,29 +37,24 @@ <modulesummary>Perl like regular expressions for Erlang</modulesummary> <description> - <p>This module contains functions for regular expression - matching for strings and binaries.</p> + <p>This module contains regular expression matching functions for + strings and binaries.</p> <p>The regular expression syntax and semantics resemble that of - Perl. This library in many ways replaces the old regexp library - written purely in Erlang, as it has a richer syntax as well as - many more options. The library is also faster than the - older regexp implementation.</p> - - <p>Although the library's matching algorithms are currently based - on the PCRE library, it is not to be viewed as an Erlang to PCRE - mapping. Only parts of the PCRE library is interfaced and the re - library in some ways extend PCRE. The PCRE documentation contains - many parts of no interest to the Erlang programmer, why only the - relevant part of the documentation is included here. There should - bee no need to go directly to the PCRE library documentation.</p> + Perl. This library replaces the deprecated pure-Erlang regexp + library; it has a richer syntax, more options and is faster.</p> + + <p>The library's matching algorithms are currently based on the + PCRE library, but not all of the PCRE library is interfaced and + some parts of the library go beyond what PCRE offers. The sections of + the PCRE documentation which are relevant to this module are included + here.</p> <note> - <p>The Erlang literal syntax for strings give special - meaning to the "\" (backslash) character. To literally write - a regular expression or a replacement string containing a - backslash in your code or in the shell, two backslashes have to be written: - "\\".</p> + <p>The Erlang literal syntax for strings uses the "\" + (backslash) character as an escape code. You need to escape + backslashes in literal strings, both in your code and in the shell, + with an additional backslash, i.e.: "\\".</p> </note> @@ -72,7 +67,7 @@ - a binary is allowed as the tail of the list</code> <code type="none"> unicode_binary() = binary() with characters encoded in UTF-8 coding standard - unicode_char() = integer() representing valid unicode codepoint + unicode_char() = integer() representing a valid unicode codepoint chardata() = charlist() | unicode_binary() @@ -82,9 +77,9 @@ <code type="none"> mp() = Opaque datatype containing a compiled regular expression. - The mp() is guaranteed to be a tuple() having the atom - 're_pattern' as it's first element, to allow for matching in + 're_pattern' as its first element, to allow for matching in guards. The arity of the tuple() or the content of the other fields - is however not to be trusted.</code> + may change in future releases.</code> </section> <funcs> <func> @@ -132,7 +127,7 @@ <tag><c>dollar_endonly</c></tag> <item>A dollar metacharacter in the pattern matches only at the end of the subject string. Without this option, a dollar also matches immediately before a newline at the end of the string (but not before any other newlines). The <c>dollar_endonly</c> option is ignored if <c>multiline</c> is given. There is no equivalent option in Perl, and no way to set it within a pattern.</item> <tag><c>dotall</c></tag> - <item>A dot maturate in the pattern matches all characters, including those that indicate newline. Without it, a dot does not match when the current position is at a newline. This option is equivalent to Perl's /s option, and it can be changed within a pattern by a (?s) option setting. A negative class such as [^a] always matches newline characters, independent of the setting of this option.</item> + <item>A dot in the pattern matches all characters, including those that indicate newline. Without it, a dot does not match when the current position is at a newline. This option is equivalent to Perl's /s option, and it can be changed within a pattern by a (?s) option setting. A negative class such as [^a] always matches newline characters, independent of this option's setting.</item> <tag><c>extended</c></tag> <item>Whitespace data characters in the pattern are ignored except when escaped or inside a character class. Whitespace does not include the VT character (ASCII 11). In addition, characters between an unescaped # outside a character class and the next newline, inclusive, are also ignored. This is equivalent to Perl's /x option, and it can be changed within a pattern by a (?x) option setting. @@ -214,9 +209,10 @@ This option makes it possible to include comments inside complicated patterns. N or as a pre compiled <c>mp()</c> in which case it is executed against the subject directly.</p> - <p>When compilation is involved, the exception <c>badarg</c> is thrown if - a compilation error occurs. To locate the error in the regular - expression, use the function <c>re:compile/2</c> to get more information.</p> + <p>When compilation is involved, the exception <c>badarg</c> is + thrown if a compilation error occurs. Call <c>re:compile/2</c> + to get information about the location of the error in the + regular expression.</p> <p>If the regular expression is previously compiled, the option list can only contain the options <c>anchored</c>, @@ -246,7 +242,7 @@ This option makes it possible to include comments inside complicated patterns. N how captured substrings are to be returned (as index tuples, lists or binaries). The <c>capture</c> option makes the function quite flexible and powerful. The different options are described - in detail below</p> + in detail below.</p> <p>If the capture options describe that no substring capturing at all is to be done (<c>{capture, none}</c>), the function will @@ -256,7 +252,7 @@ This option makes it possible to include comments inside complicated patterns. N be done either by specifying <c>none</c> or an empty list as <c>ValueSpec</c>.</p> - <p>A description of all the options relevant for execution follows:</p> + <p>The options relevant for execution are:</p> <taglist> <tag><c>anchored</c></tag> @@ -270,27 +266,25 @@ This option makes it possible to include comments inside complicated patterns. N <tag><c>global</c></tag> <item> - <p>Implements global (repetitive) search as the <c>g</c> flag in - i.e. Perl. Each match found is returned as a separate + <p>Implements global (repetitive) search (the <c>g</c> flag in + Perl). Each match is returned as a separate <c>list()</c> containing the specific match as well as any matching subexpressions (or as specified by the <c>capture option</c>). The <c>Captured</c> part of the return value will - hence be a <c>list()</c> of <c>list()</c>'s when this + hence be a <c>list()</c> of <c>list()</c>s when this option is given.</p> - <p>When the regular expression matches an empty string, the - behaviour might seem non-intuitive, why the behaviour requites - some clarifying. With the global option, <c>re:run/3</c> - handles empty matches in the same way as Perl, meaning that a - match at any point giving an empty string (with length 0) will - be retried with the options - <c>[anchored, notempty]</c> as well. If that - search gives a result of length > 0, the result is included. - An example:</p> + <p>The interaction of the global option with a regular + expression which matches an empty string surprises some users. + When the global option is given, <c>re:run/3</c> handles empty + matches in the same way as Perl: a zero-length match at any + point will be retried with the options <c>[anchored, + notempty]</c> as well. If that search gives a result of length + > 0, the result is included. For example:</p> <code> re:run("cat","(|at)",[global]).</code> - <p>The matching will be performed as following:</p> + <p>The following matching will be performed:</p> <taglist> <tag>At offset <c>0</c></tag> <item>The regexp <c>(|at)</c> will first match at the initial @@ -302,11 +296,11 @@ This option makes it possible to include comments inside complicated patterns. N <item> The search is retried with the options <c>[anchored, notempty]</c> at the same position, which does not give any interesting result of longer - length, why the search position is now advanced to the next + length, so the search position is now advanced to the next character (<c>a</c>).</item> <tag>At offset <c>1</c></tag> - <item>Now the search results in - <c>[{1,0},{1,0}]</c> meaning this search will also be repeated + <item>This time, the search results in + <c>[{1,0},{1,0}]</c>, so this search will also be repeated with the extra options.</item> <tag>At offset <c>1</c> with <c>[anchored, notempty]</c></tag> <item>Now the <c>ab</c> alternative @@ -333,16 +327,17 @@ This option makes it possible to include comments inside complicated patterns. N entire match fails. For example, if the pattern</p> <code> a?b?</code> <p>is applied to a string not beginning with "a" or "b", it - matches the empty string at the start of the subject. With - <c>notempty</c> given, this match is not valid, so re:run/3 searches - further into the string for occurrences of "a" or "b".</p> + would normally match the empty string at the start of the + subject. With the <c>notempty</c> option, this match is not + valid, so re:run/3 searches further into the string for + occurrences of "a" or "b".</p> <p>Perl has no direct equivalent of <c>notempty</c>, but it does make a special case of a pattern match of the empty string within its split() function, and when using the /g modifier. It is possible to emulate Perl's behavior after matching a null string by first trying the match again at the same offset with - <c>notempty</c> and <c>anchored</c>, and then if that fails by + <c>notempty</c> and <c>anchored</c>, and then, if that fails, by advancing the starting offset (see below) and trying an ordinary match again.</p> </item> @@ -352,7 +347,7 @@ This option makes it possible to include comments inside complicated patterns. N string is not the beginning of a line, so the circumflex metacharacter should not match before it. Setting this without <c>multiline</c> (at compile time) causes circumflex never to - match. This option affects only the behavior of the circumflex + match. This option only affects the behavior of the circumflex metacharacter. It does not affect \A.</item> <tag><c>noteol</c></tag> @@ -388,7 +383,7 @@ This option makes it possible to include comments inside complicated patterns. N </taglist> </item> <tag><c>bsr_anycrlf</c></tag> - <item>Specifies specifically that \R is to match only the cr, lf or crlf sequences, not the Unicode specific newline characters.(overrides compilation option)</item> + <item>Specifies specifically that \R is to match only the cr, lf or crlf sequences, not the Unicode specific newline characters. (overrides compilation option)</item> <tag><c>bsr_unicode</c></tag> <item>Specifies specifically that \R is to match all the Unicode newline characters (including crlf etc, the default).(overrides compilation option)</item> @@ -444,7 +439,7 @@ This option makes it possible to include comments inside complicated patterns. N <tag><c>none</c></tag> <item>Do not return matching subpatterns at all, yielding the single atom <c>match</c> as the return value of the function when matching successfully instead of the <c>{match, list()}</c> return. Specifying an empty list gives the same behavior.</item> </taglist> - <p>The value list is a list of indexes for the subpatterns to return, where index 0 is for all of the pattern, and 1 is for the first explicit capturing subpattern in the regular expression, and so forth. When using named captured subpatterns (see below) in the regular expression, one can use <c>atom()</c>'s or <c>string()</c>'s to specify the subpatterns to be returned. This deserves an example, consider the following regular expression:</p> + <p>The value list is a list of indexes for the subpatterns to return, where index 0 is for all of the pattern, and 1 is for the first explicit capturing subpattern in the regular expression, and so forth. When using named captured subpatterns (see below) in the regular expression, one can use <c>atom()</c>s or <c>string()</c>s to specify the subpatterns to be returned. For example, consider the regular expression:</p> <code> ".*(abcd).*"</code> <p>matched against the string ""ABCabcdABC", capturing only the "abcd" part (the first explicit subpattern):</p> <code> re:run("ABCabcdABC",".*(abcd).*",[{capture,[1]}]).</code> @@ -455,7 +450,7 @@ This option makes it possible to include comments inside complicated patterns. N <code> ".*(?<FOO>abcd).*"</code> <p>With this expression, we could still give the index of the subpattern with the following call:</p> <code> re:run("ABCabcdABC",".*(?<FOO>abcd).*",[{capture,[1]}]).</code> - <p>giving the same result as before. But as the subpattern is named, we can also give its name in the value list:</p> + <p>giving the same result as before. But, since the subpattern is named, we can also specify its name in the value list:</p> <code> re:run("ABCabcdABC",".*(?<FOO>abcd).*",[{capture,['FOO']}]).</code> <p>which would yield the same result as the earlier examples, namely:</p> <code> {match,[{3,4}]}</code> @@ -473,15 +468,15 @@ This option makes it possible to include comments inside complicated patterns. N <item><p>Optionally specifies how captured substrings are to be returned. If omitted, the default of <c>index</c> is used. The <c>Type</c> can be one of the following:</p> <taglist> <tag><c>index</c></tag> - <item>Return captured substrings as pairs of byte indexes into the subject string and length of the matching string in the subject (as if the subject string was flattened with <c>iolist_to_binary/1</c> or <c>unicode:characters_to_binary/2</c> prior to matching). Note that the <c>unicode</c> option results in <em>byte-oriented</em> indexes in a (possibly imagined) <em>UTF-8 encoded</em> binary. A byte index tuple <c>{0,2}</c> might therefore represent one or two characters when <c>unicode</c> is in effect. This might seem contra-intuitive, but has been deemed the most effective and useful way to way to do it. To return lists instead might result in simpler code if that is desired. This return type is the default.</item> + <item>Return captured substrings as pairs of byte indexes into the subject string and length of the matching string in the subject (as if the subject string was flattened with <c>iolist_to_binary/1</c> or <c>unicode:characters_to_binary/2</c> prior to matching). Note that the <c>unicode</c> option results in <em>byte-oriented</em> indexes in a (possibly virtual) <em>UTF-8 encoded</em> binary. A byte index tuple <c>{0,2}</c> might therefore represent one or two characters when <c>unicode</c> is in effect. This might seem counter-intuitive, but has been deemed the most effective and useful way to way to do it. To return lists instead might result in simpler code if that is desired. This return type is the default.</item> <tag><c>list</c></tag> - <item>Return matching substrings as lists of characters (Erlang <c>string()</c>'s). It the <c>unicode</c> option is used in combination with the \C sequence in the regular expression, a captured subpattern can contain bytes that has is not valid UTF-8 (\C matches bytes regardless of character encoding). In that case the <c>list</c> capturing may result in the same types of tuples that <c>unicode:characters_to_list/2</c> can return, namely three-tuples with the tag <c>incomplete</c> or <c>error</c>, the successfully converted characters and the invalid UTF-8 tail of the conversion as a binary. The best strategy is to avoid using the \C sequence when capturing lists.</item> + <item>Return matching substrings as lists of characters (Erlang <c>string()</c>s). It the <c>unicode</c> option is used in combination with the \C sequence in the regular expression, a captured subpattern can contain bytes that are not valid UTF-8 (\C matches bytes regardless of character encoding). In that case the <c>list</c> capturing may result in the same types of tuples that <c>unicode:characters_to_list/2</c> can return, namely three-tuples with the tag <c>incomplete</c> or <c>error</c>, the successfully converted characters and the invalid UTF-8 tail of the conversion as a binary. The best strategy is to avoid using the \C sequence when capturing lists.</item> <tag><c>binary</c></tag> - <item>Return matching substrings as binaries. If the <c>unicode</c> option is used, these binaries is in UTF-8. If the \C sequence is used together with <c>unicode</c> the binaries may be invalid UTF-8.</item> + <item>Return matching substrings as binaries. If the <c>unicode</c> option is used, these binaries are in UTF-8. If the \C sequence is used together with <c>unicode</c> the binaries may be invalid UTF-8.</item> </taglist> </item> </taglist> - <p>In general, subpatterns that got assigned no value in the match are returned as the tuple <c>{-1,0}</c> when <c>type</c> is <c>index</c>. Unassigned subpatterns are returned as the empty binary or list respectively for other return types. Consider the regular expression:</p> + <p>In general, subpatterns that were not assigned a value in the match are returned as the tuple <c>{-1,0}</c> when <c>type</c> is <c>index</c>. Unassigned subpatterns are returned as the empty binary or list, respectively, for other return types. Consider the regular expression:</p> <code> ".*((?<FOO>abdd)|a(..d)).*"</code> <p>There are three explicitly capturing subpatterns, where the opening parenthesis position determines the order in the result, hence <c>((?<FOO>abdd)|a(..d))</c> is subpattern index 1, <c>(?<FOO>abdd)</c> is subpattern index 2 and <c>(..d)</c> is subpattern index 3. When matched against the following string:</p> <code> "ABCabcdABC"</code> @@ -533,8 +528,8 @@ This option makes it possible to include comments inside complicated patterns. N <v>NLSpec = cr | crlf | lf | anycrlf | any </v> </type> <desc> - <p>Replaces the matched part of the <c>Subject</c> string with the content of <c>Replacement</c>.</p> - <p>Options are given as to the <c>re:run/3</c> function except that the <c>capture</c> option of <c>re:run/3</c> is not allowed. + <p>Replaces the matched part of the <c>Subject</c> string with the contents of <c>Replacement</c>.</p> + <p>The permissible options are the same as for <c>re:run/3</c>, except that the <c>capture</c> option is not allowed. Instead a <c>{return, ReturnType}</c> is present. The default return type is <c>iodata</c>, constructed in a way to minimize copying. The <c>iodata</c> result can be used directly in many i/o-operations. If a flat <c>list()</c> is desired, specify <c>{return, list}</c> and if a binary is preferred, specify <c>{return, binary}</c>.</p> @@ -544,7 +539,7 @@ This option makes it possible to include comments inside complicated patterns. N a Unicode <c>charlist()</c>. If compilation is done implicitly and the <c>unicode</c> compilation option is given to this function, both the regular expression and the <c>Subject</c> - should be given as valid Unicode <c>charlist()</c>'s.</p> + should be given as valid Unicode <c>charlist()</c>s.</p> <p>The replacement string can contain the special character <c>&</c>, which inserts the whole matching expression in the @@ -554,7 +549,7 @@ This option makes it possible to include comments inside complicated patterns. N generated by the regular expression, nothing is inserted.</p> <p>To insert an <c>&</c> or <c>\</c> in the result, precede it with a <c>\</c>. Note that Erlang already gives a special - meaning to <c>\</c> in literal strings, why a single <c>\</c> + meaning to <c>\</c> in literal strings, so a single <c>\</c> has to be written as <c>"\\"</c> and therefore a double <c>\</c> as <c>"\\\\"</c>. Example:</p> <code> re:replace("abcd","c","[&]",[{return,list}]).</code> @@ -611,7 +606,7 @@ This option makes it possible to include comments inside complicated patterns. N a Unicode <c>charlist()</c>. If compilation is done implicitly and the <c>unicode</c> compilation option is given to this function, both the regular expression and the <c>Subject</c> - should be given as valid Unicode <c>charlist()</c>'s.</p> + should be given as valid Unicode <c>charlist()</c>s.</p> <p>The result is given as a list of "strings", the preferred datatype given in the <c>return</c> option (default iodata).</p> @@ -656,25 +651,25 @@ This option makes it possible to include comments inside complicated patterns. N <p>Here the regular expression matched first the "l", causing "Er" to be the first part in the result. When the regular expression matched, the (only) subexpression was - bound to the "l", why the "l" is inserted + bound to the "l", so the "l" is inserted in the group together with "Er". The next match is of the "n", making "a" the next part to be - returned. As the subexpression is bound to the substring + returned. Since the subexpression is bound to the substring "n" in this case, the "n" is inserted into this group. The last group consists of the rest of the string, as no more matches are found.</p> <p>By default, all parts of the string, including the empty - strings are returned from the function. As an example:</p> + strings, are returned from the function. For example:</p> <code> re:split("Erlang","[lg]",[{return,list}]).</code> - <p>The result will be:</p> + <p>will return:</p> <code> ["Er","an",[]]</code> - <p>as the matching of the "g" in the end of the string + <p>since the matching of the "g" in the end of the string leaves an empty rest which is also returned. This behaviour differs from the default behaviour of the split function in Perl, where empty strings at the end are by default removed. To @@ -701,10 +696,10 @@ This option makes it possible to include comments inside complicated patterns. N <p>Note that the last part is "ang", not "an", as we only specified splitting into two parts, - and the splitting stops when enough parts are given, why the - result differs from that of <c>trim</c>.</p> + and the splitting stops when enough parts are given, which is + why the result differs from that of <c>trim</c>.</p> - <p>More than three parts are not possible with this indata, why</p> + <p>More than three parts are not possible with this indata, so</p> <code> re:split("Erlang","[lg]",[{return,list},{parts,4}]).</code> @@ -745,7 +740,7 @@ This option makes it possible to include comments inside complicated patterns. N the parts of the string matching the subexpressions of the regexp.</p> <p>The return value from the function will in this case be a - <c>list()</c> of <c>list()</c>'s. Each sublist begins with the + <c>list()</c> of <c>list()</c>s. Each sublist begins with the string picked out of the subject string, followed by the parts matching each of the subexpressions in order of occurrence in the regular expression.</p> @@ -782,10 +777,8 @@ This option makes it possible to include comments inside complicated patterns. N <title>PERL LIKE REGULAR EXPRESSIONS SYNTAX</title> <p>The following sections contain reference material for the regular expressions used by this module. The regular expression - reference is taken from the PCRE documentation, but converted as - needed.</p> - <p>The documentation is altered where appropriate and where the re - module behaves differently than the PCRE library.</p> + reference is based on the PCRE documentation, with changes in + cases where the re module behaves differently to the PCRE library.</p> </section> <section><title>PCRE regular expression details</title> diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 1d033f6f7b..6e6e949e2c 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -512,7 +512,7 @@ file2tab(File) -> file2tab(File, Opts) -> try - {ok,Verify} = parse_f2t_opts(Opts,false), + {ok,Verify,TabArg} = parse_f2t_opts(Opts,false,[]), Name = make_ref(), {ok, Major, Minor, FtOptions, MD5State, FullHeader, DLContext} = case disk_log:open([{name, Name}, @@ -540,7 +540,7 @@ file2tab(File, Opts) -> true -> ok end, - {ok, Tab, HeadCount} = create_tab(FullHeader), + {ok, Tab, HeadCount} = create_tab(FullHeader, TabArg), StrippedOptions = case Verify of true -> @@ -676,15 +676,17 @@ do_read_and_verify(ReadFun,InitState,Tab,FtOptions,HeadCount,Verify) -> {ok,Tab} end. -parse_f2t_opts([],Verify) -> - {ok,Verify}; -parse_f2t_opts([{verify, true}|T],_OV) -> - parse_f2t_opts(T,true); -parse_f2t_opts([{verify,false}|T],OV) -> - parse_f2t_opts(T,OV); -parse_f2t_opts([Unexpected|_],_) -> +parse_f2t_opts([],Verify,Tab) -> + {ok,Verify,Tab}; +parse_f2t_opts([{verify, true}|T],_OV,Tab) -> + parse_f2t_opts(T,true,Tab); +parse_f2t_opts([{verify,false}|T],OV,Tab) -> + parse_f2t_opts(T,OV,Tab); +parse_f2t_opts([{table,Tab}|T],OV,[]) -> + parse_f2t_opts(T,OV,Tab); +parse_f2t_opts([Unexpected|_],_,_) -> throw({unknown_option,Unexpected}); -parse_f2t_opts(Malformed,_) -> +parse_f2t_opts(Malformed,_,_) -> throw({malformed_option,Malformed}). count_mandatory([]) -> @@ -860,19 +862,28 @@ load_table(ReadFun, State, Tab) -> load_table(ReadFun, NewState, Tab) end. -create_tab(I) -> +create_tab(I, TabArg) -> {name, Name} = lists:keyfind(name, 1, I), {type, Type} = lists:keyfind(type, 1, I), {protection, P} = lists:keyfind(protection, 1, I), {named_table, Val} = lists:keyfind(named_table, 1, I), {keypos, _Kp} = Keypos = lists:keyfind(keypos, 1, I), {size, Sz} = lists:keyfind(size, 1, I), - try - Tab = ets:new(Name, [Type, P, Keypos | named_table(Val)]), - {ok, Tab, Sz} - catch - _:_ -> - throw(cannot_create_table) + Comp = case lists:keyfind(compressed, 1, I) of + {compressed, true} -> [compressed]; + {compressed, false} -> []; + false -> [] + end, + case TabArg of + [] -> + try + Tab = ets:new(Name, [Type, P, Keypos] ++ named_table(Val) ++ Comp), + {ok, Tab, Sz} + catch _:_ -> + throw(cannot_create_table) + end; + _ -> + {ok, TabArg, Sz} end. named_table(true) -> [named_table]; diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 7f39dbe21f..2d8eb08105 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -31,7 +31,7 @@ -export([slot/1]). -export([match/1, match1/1, match2/1, match_object/1, match_object2/1]). -export([misc/1, dups/1, misc1/1, safe_fixtable/1, info/1, tab2list/1]). --export([files/1, tab2file/1, tab2file2/1, tab2file3/1, tabfile_ext1/1, +-export([files/1, tab2file/1, tab2file2/1, tabfile_ext1/1, tabfile_ext2/1, tabfile_ext3/1, tabfile_ext4/1]). -export([heavy/1, heavy_lookup/1, heavy_lookup_element/1, heavy_concurrent/1]). -export([lookup_element/1, lookup_element_mult/1]). @@ -70,7 +70,7 @@ exit_many_tables_owner/1, exit_many_many_tables_owner/1]). -export([write_concurrency/1, heir/1, give_away/1, setopts/1]). --export([bad_table/1]). +-export([bad_table/1, types/1]). -export([init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]). %% Convenience for manual testing @@ -78,7 +78,7 @@ % internal exports -export([dont_make_worse_sub/0, make_better_sub1/0, make_better_sub2/0]). --export([t_repair_continuation_do/1, default_do/1, t_bucket_disappears_do/1, +-export([t_repair_continuation_do/1, t_bucket_disappears_do/1, select_fail_do/1, whitebox_1/1, whitebox_2/1, t_delete_all_objects_do/1, t_delete_object_do/1, t_init_table_do/1, t_insert_list_do/1, update_element_opts/1, update_element_opts/4, update_element/4, update_element_do/4, @@ -91,7 +91,8 @@ slot_do/1, match1_do/1, match2_do/1, match_object_do/1, match_object2_do/1, misc1_do/1, safe_fixtable_do/1, info_do/1, dups_do/1, heavy_lookup_do/1, heavy_lookup_element_do/1, member_do/1, otp_5340_do/1, otp_7665_do/1, meta_wb_do/1, - do_heavy_concurrent/1 + do_heavy_concurrent/1, tab2file2_do/2, exit_large_table_owner_do/2, + types_do/1, sleeper/0, rpc_externals/0, memory_do/1 ]). -export([t_select_reverse/1]). @@ -143,7 +144,7 @@ all(suite) -> exit_many_tables_owner, exit_many_many_tables_owner, write_concurrency, heir, give_away, setopts, - bad_table + bad_table, types ]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -157,7 +158,7 @@ t_bucket_disappears(Config) when is_list(Config) -> t_bucket_disappears_do(Opts) -> ?line EtsMem = etsmem(), - ?line ets:new(abcd, [named_table, public, {keypos, 2} | Opts]), + ?line ets_new(abcd, [named_table, public, {keypos, 2} | Opts]), ?line ets:insert(abcd, {abcd,1,2}), ?line ets:insert(abcd, {abcd,2,2}), ?line ets:insert(abcd, {abcd,3,2}), @@ -213,7 +214,7 @@ t_repair_continuation_do(Opts) -> ?line MS = [{'_',[],[true]}], ?line MS2 = [{{{'$1','_'},'_'},[],['$1']}], (fun() -> - ?line T = ets:new(x,[ordered_set|Opts]), + ?line T = ets_new(x,[ordered_set|Opts]), ?line F = fun(0,_)->ok;(N,F) -> ets:insert(T,{N,N}), F(N-1,F) end, ?line F(1000,F), ?line {_,C} = ets:select(T,MS,5), @@ -225,7 +226,7 @@ t_repair_continuation_do(Opts) -> ?line true = ets:delete(T) end)(), (fun() -> - ?line T = ets:new(x,[ordered_set|Opts]), + ?line T = ets_new(x,[ordered_set|Opts]), ?line F = fun(0,_)->ok;(N,F) -> ets:insert(T,{N,N}), F(N-1,F) end, ?line F(1000,F), ?line {_,C} = ets:select(T,MS,1001), @@ -237,7 +238,7 @@ t_repair_continuation_do(Opts) -> end)(), (fun() -> - ?line T = ets:new(x,[ordered_set|Opts]), + ?line T = ets_new(x,[ordered_set|Opts]), ?line F = fun(0,_)->ok;(N,F) -> ets:insert(T,{integer_to_list(N),N}), F(N-1,F) @@ -252,7 +253,7 @@ t_repair_continuation_do(Opts) -> ?line true = ets:delete(T) end)(), (fun() -> - ?line T = ets:new(x,[ordered_set|Opts]), + ?line T = ets_new(x,[ordered_set|Opts]), ?line F = fun(0,_)->ok;(N,F) -> ets:insert(T,{{integer_to_list(N),N},N}), F(N-1,F) @@ -268,7 +269,7 @@ t_repair_continuation_do(Opts) -> end)(), (fun() -> - ?line T = ets:new(x,[set|Opts]), + ?line T = ets_new(x,[set|Opts]), ?line F = fun(0,_)->ok;(N,F) -> ets:insert(T,{N,N}), F(N-1,F) @@ -283,7 +284,7 @@ t_repair_continuation_do(Opts) -> ?line true = ets:delete(T) end)(), (fun() -> - ?line T = ets:new(x,[set|Opts]), + ?line T = ets_new(x,[set|Opts]), ?line F = fun(0,_)->ok;(N,F) -> ets:insert(T,{integer_to_list(N),N}), F(N-1,F) @@ -298,7 +299,7 @@ t_repair_continuation_do(Opts) -> ?line true = ets:delete(T) end)(), (fun() -> - ?line T = ets:new(x,[bag|Opts]), + ?line T = ets_new(x,[bag|Opts]), ?line F = fun(0,_)->ok;(N,F) -> ets:insert(T,{integer_to_list(N),N}), F(N-1,F) @@ -313,7 +314,7 @@ t_repair_continuation_do(Opts) -> ?line true = ets:delete(T) end)(), (fun() -> - ?line T = ets:new(x,[duplicate_bag|Opts]), + ?line T = ets_new(x,[duplicate_bag|Opts]), ?line F = fun(0,_)->ok;(N,F) -> ets:insert(T,{integer_to_list(N),N}), F(N-1,F) @@ -334,18 +335,20 @@ t_repair_continuation_do(Opts) -> new(suite) -> [default,setbag,badnew,verybadnew,named,keypos2,privacy]. default(doc) -> - ["Test case to check that a new ets table is defined as a `set' and " - "`protected'"]; + ["Check correct default vaules of a new ets table"]; default(suite) -> []; default(Config) when is_list(Config) -> %% Default should be set,protected - repeat_for_opts(default_do). - -default_do(Opts) -> ?line EtsMem = etsmem(), - ?line Def = ets:new(def,Opts), + ?line Def = ets_new(def,[]), ?line set = ets:info(Def,type), ?line protected = ets:info(Def,protection), + Compressed = erlang:system_info(ets_always_compress), + ?line Compressed = ets:info(Def,compressed), + Self = self(), + ?line Self = ets:info(Def,owner), + ?line none = ets:info(Def, heir), + ?line false = ets:info(Def,named_table), ?line ets:delete(Def), ?line verify_etsmem(EtsMem). @@ -359,7 +362,7 @@ select_fail(Config) when is_list(Config) -> ?line verify_etsmem(EtsMem). select_fail_do(Opts) -> - ?line T = ets:new(x,Opts), + ?line T = ets_new(x,Opts), ?line ets:insert(T,{a,a}), ?line case (catch ets:select(T,[{{a,'_'},[],[{snuffla}]}])) of @@ -382,20 +385,27 @@ select_fail_do(Opts) -> -define(S(T),ets:info(T,memory)). -define(TAB_STRUCT_SZ, erts_debug:get_internal_state('DbTable_words')). --define(NORMAL_TAB_STRUCT_SZ, 26). %% SunOS5.8, 32-bit, non smp, private heap +%%-define(NORMAL_TAB_STRUCT_SZ, 26). %% SunOS5.8, 32-bit, non smp, private heap %% %% The hardcoded expected memory sizes (in words) are the ones we expect on: %% SunOS5.8, 32-bit, non smp, private heap %% -memory(doc) -> - ["Whitebox test of ets:info(X,memory)"]; -memory(suite) -> - []; +memory(doc) -> ["Whitebox test of ets:info(X,memory)"]; +memory(suite) -> []; memory(Config) when is_list(Config) -> ?line erts_debug:set_internal_state(available_internal_state, true), ?line ok = chk_normal_tab_struct_size(), - ?line L = [T1,T2,T3,T4] = fill_sets_int(1000), - ?line XRes1 = adjust_xmem(L, {13862,13072,13072,13078}), + repeat_for_opts(memory_do,[compressed]), + ?line catch erts_debug:set_internal_state(available_internal_state, false). + +memory_do(Opts) -> + ?line L = [T1,T2,T3,T4] = fill_sets_int(1000,Opts), + XR1 = case mem_mode(T1) of + {normal,_} -> {13836,13046,13046,13052}; %{13862,13072,13072,13078}; + {compressed,4} -> {11041,10251,10251,10252}; %{11067,10277,10277,10278}; + {compressed,8} -> {10050,9260,9260,9260} %{10076,9286,9286,9286} + end, + ?line XRes1 = adjust_xmem(L, XR1), ?line Res1 = {?S(T1),?S(T2),?S(T3),?S(T4)}, ?line lists:foreach(fun(T) -> Before = ets:info(T,size), @@ -406,7 +416,12 @@ memory(Config) when is_list(Config) -> [Key, ets:info(T,type), Before, ets:info(T,size), Objs]) end, L), - ?line XRes2 = adjust_xmem(L, {13852,13063,13054,13060}), + XR2 = case mem_mode(T1) of + {normal,_} -> {13826,13037,13028,13034}; %{13852,13063,13054,13060}; + {compressed,4} -> {11031,10242,10233,10234}; %{11057,10268,10259,10260}; + {compressed,8} -> {10040,9251,9242,9242} %10066,9277,9268,9268} + end, + ?line XRes2 = adjust_xmem(L, XR2), ?line Res2 = {?S(T1),?S(T2),?S(T3),?S(T4)}, ?line lists:foreach(fun(T) -> Before = ets:info(T,size), @@ -417,13 +432,18 @@ memory(Config) when is_list(Config) -> [Key, ets:info(T,type), Before, ets:info(T,size), Objs]) end, L), - ?line XRes3 = adjust_xmem(L, {13842,13054,13036,13042}), + XR3 = case mem_mode(T1) of + {normal,_} -> {13816,13028,13010,13016}; %{13842,13054,13036,13042}; + {compressed,4} -> {11021,10233,10215,10216}; %{11047,10259,10241,10242}; + {compressed,8} -> {10030,9242,9224,9224} %{10056,9268,9250,9250} + end, + ?line XRes3 = adjust_xmem(L, XR3), ?line Res3 = {?S(T1),?S(T2),?S(T3),?S(T4)}, ?line lists:foreach(fun(T) -> ?line ets:delete_all_objects(T) end, L), - ?line XRes4 = adjust_xmem(L, {76,286,286,286}), + ?line XRes4 = adjust_xmem(L, {50,260,260,260}), %{76,286,286,286}), ?line Res4 = {?S(T1),?S(T2),?S(T3),?S(T4)}, lists:foreach(fun(T) -> ?line ets:delete(T) @@ -434,9 +454,9 @@ memory(Config) when is_list(Config) -> ?line ets:select_delete(T,[{'_',[],[true]}]) end, L2), - ?line XRes5 = adjust_xmem(L2, {76,286,286,286}), + ?line XRes5 = adjust_xmem(L2, {50,260,260,260}), %{76,286,286,286}), ?line Res5 = {?S(T11),?S(T12),?S(T13),?S(T14)}, - ?line ?t:format("XRes1 = ~p~n" + ?line io:format("XRes1 = ~p~n" " Res1 = ~p~n~n" "XRes2 = ~p~n" " Res2 = ~p~n~n" @@ -456,9 +476,15 @@ memory(Config) when is_list(Config) -> ?line XRes3 = Res3, ?line XRes4 = Res4, ?line XRes5 = Res5, - ?line catch erts_debug:set_internal_state(available_internal_state, false), ?line ok. +mem_mode(T) -> + {case ets:info(T,compressed) of + true -> compressed; + false -> normal + end, + erlang:system_info(wordsize)}. + chk_normal_tab_struct_size() -> ?line System = {os:type(), os:version(), @@ -466,36 +492,58 @@ chk_normal_tab_struct_size() -> erlang:system_info(smp_support), erlang:system_info(heap_type)}, ?line ?t:format("System = ~p~n", [System]), - ?line ?t:format("?NORMAL_TAB_STRUCT_SZ=~p~n", [?NORMAL_TAB_STRUCT_SZ]), + %%?line ?t:format("?NORMAL_TAB_STRUCT_SZ=~p~n", [?NORMAL_TAB_STRUCT_SZ]), ?line ?t:format("?TAB_STRUCT_SZ=~p~n", [?TAB_STRUCT_SZ]), - ?line case System of - {{unix, sunos}, {5, 8, 0}, 4, false, private} -> - ?line ?NORMAL_TAB_STRUCT_SZ = ?TAB_STRUCT_SZ, - ?line ok; - _ -> - ?line ok - end. - -adjust_xmem([T1,T2,T3,T4], {A0,B0,C0,D0} = Mem0) -> + ok. +% ?line case System of +% {{unix, sunos}, {5, 8, 0}, 4, false, private} -> +% ?line ?NORMAL_TAB_STRUCT_SZ = ?TAB_STRUCT_SZ, +% ?line ok; +% _ -> +% ?line ok +% end. + +-define(DB_TREE_STACK_NEED,50). % The static stack for a tree, in halfword pointers are two internal words + % so the stack gets twice as big +-define(DB_HASH_SIZEOF_EXTSEG,260). % The segment size in words, in halfword this will be twice as large. + +adjust_xmem([T1,T2,T3,T4], {A0,B0,C0,D0} = _Mem0) -> %% Adjust for 64-bit, smp, and os: %% Table struct size may differ. - Mem1 = case ?TAB_STRUCT_SZ of - ?NORMAL_TAB_STRUCT_SZ -> - Mem0; - TabStructSz -> - TabDiff = TabStructSz - ?NORMAL_TAB_STRUCT_SZ, - {A0+TabDiff, B0+TabDiff, C0+TabDiff, D0+TabDiff} - end, + +% Mem1 = case ?TAB_STRUCT_SZ of +% ?NORMAL_TAB_STRUCT_SZ -> +% Mem0; +% TabStructSz -> +% TabDiff = TabStructSz - ?NORMAL_TAB_STRUCT_SZ, +% {A0+TabDiff, B0+TabDiff, C0+TabDiff, D0+TabDiff} +% end, + + TabDiff = ?TAB_STRUCT_SZ, + Mem1 = {A0+TabDiff, B0+TabDiff, C0+TabDiff, D0+TabDiff}, + + Mem2 = case {erlang:system_info({wordsize,internal}),erlang:system_info({wordsize,external})} of + %% Halfword, corrections for regular pointers occupying two internal words. + {4,8} -> + {A1,B1,C1,D1} = Mem1, + {A1+4*ets:info(T1, size)+?DB_TREE_STACK_NEED, + B1+3*ets:info(T2, size)+?DB_HASH_SIZEOF_EXTSEG, + C1+3*ets:info(T3, size)+?DB_HASH_SIZEOF_EXTSEG, + D1+3*ets:info(T4, size)+?DB_HASH_SIZEOF_EXTSEG}; + _ -> + Mem1 + end, + %% Adjust for hybrid and shared heaps: %% Each record is one word smaller. - Mem2 = case erlang:system_info(heap_type) of - private -> - Mem1; - _ -> - {A1,B1,C1,D1} = Mem1, - {A1-ets:info(T1, size),B1-ets:info(T2, size), - C1-ets:info(T3, size),D1-ets:info(T4, size)} - end, + %%Mem2 = case erlang:system_info(heap_type) of + %% private -> + %% Mem1; + %% _ -> + %% {A1,B1,C1,D1} = Mem1, + %% {A1-ets:info(T1, size),B1-ets:info(T2, size), + %% C1-ets:info(T3, size),D1-ets:info(T4, size)} + %% end, %%{Mem2,{ets:info(T1,stats),ets:info(T2,stats),ets:info(T3,stats),ets:info(T4,stats)}}. Mem2. @@ -514,7 +562,7 @@ t_whitebox(Config) when is_list(Config) -> ?line verify_etsmem(EtsMem). whitebox_1(Opts) -> - ?line T=ets:new(x,[bag | Opts]), + ?line T=ets_new(x,[bag | Opts]), ?line ets:insert(T,[{du,glade},{ta,en}]), ?line ets:insert(T,[{hej,hopp2},{du,glade2},{ta,en2}]), ?line {_,C}=ets:match(T,{ta,'$1'},1), @@ -524,8 +572,8 @@ whitebox_1(Opts) -> ok. whitebox_2(Opts) -> - ?line T=ets:new(x,[ordered_set, {keypos,2} | Opts]), - ?line T2=ets:new(x,[set, {keypos,2}| Opts]), + ?line T=ets_new(x,[ordered_set, {keypos,2} | Opts]), + ?line T2=ets_new(x,[set, {keypos,2}| Opts]), ?line 0 = ets:select_delete(T,[{{hej},[],[true]}]), ?line 0 = ets:select_delete(T,[{{hej,hopp},[],[true]}]), ?line 0 = ets:select_delete(T2,[{{hej},[],[true]}]), @@ -547,7 +595,7 @@ t_ets_dets(Config, Opts) -> ?line (catch file:delete(Fname)), ?line {ok,DTab} = dets:open_file(testdets_1, [{file, Fname}]), - ?line ETab = ets:new(x,Opts), + ?line ETab = ets_new(x,Opts), ?line filltabint(ETab,3000), ?line DTab = ets:to_dets(ETab,DTab), ?line ets:delete_all_objects(ETab), @@ -559,7 +607,7 @@ t_ets_dets(Config, Opts) -> (catch ets:to_dets(ETab,DTab)), ?line {'EXIT',{badarg,[{ets,from_dets,[ETab,DTab]}|_]}} = (catch ets:from_dets(ETab,DTab)), - ?line ETab2 = ets:new(x,Opts), + ?line ETab2 = ets_new(x,Opts), ?line filltabint(ETab2,3000), ?line dets:close(DTab), ?line {'EXIT',{badarg,[{ets,to_dets,[ETab2,DTab]}|_]}} = @@ -580,7 +628,7 @@ t_delete_all_objects(Config) when is_list(Config) -> ?line verify_etsmem(EtsMem). t_delete_all_objects_do(Opts) -> - ?line T=ets:new(x,Opts), + ?line T=ets_new(x,Opts), ?line filltabint(T,4000), ?line O=ets:first(T), ?line ets:next(T,O), @@ -609,7 +657,7 @@ t_delete_object(Config) when is_list(Config) -> ?line verify_etsmem(EtsMem). t_delete_object_do(Opts) -> - ?line T = ets:new(x,Opts), + ?line T = ets_new(x,Opts), ?line filltabint(T,4000), ?line del_one_by_one_set(T,1,4001), ?line filltabint(T,4000), @@ -626,19 +674,19 @@ t_delete_object_do(Opts) -> ?line 3999 = ets:info(T,size), ?line 0 = ets:info(T,kept_objects), ?line ets:delete(T), - ?line T1 = ets:new(x,[ordered_set | Opts]), + ?line T1 = ets_new(x,[ordered_set | Opts]), ?line filltabint(T1,4000), ?line del_one_by_one_set(T1,1,4001), ?line filltabint(T1,4000), ?line del_one_by_one_set(T1,4000,0), ?line ets:delete(T1), - ?line T2 = ets:new(x,[bag | Opts]), + ?line T2 = ets_new(x,[bag | Opts]), ?line filltabint2(T2,4000), ?line del_one_by_one_bag(T2,1,4001), ?line filltabint2(T2,4000), ?line del_one_by_one_bag(T2,4000,0), ?line ets:delete(T2), - ?line T3 = ets:new(x,[duplicate_bag | Opts]), + ?line T3 = ets_new(x,[duplicate_bag | Opts]), ?line filltabint3(T3,4000), ?line del_one_by_one_dbag_1(T3,1,4001), ?line filltabint3(T3,4000), @@ -685,7 +733,7 @@ t_init_table(Config) when is_list(Config)-> ?line verify_etsmem(EtsMem). t_init_table_do(Opts) -> - ?line T = ets:new(x,[duplicate_bag | Opts]), + ?line T = ets_new(x,[duplicate_bag | Opts]), ?line filltabint(T,4000), ?line ets:init_table(T, make_init_fun(1)), ?line del_one_by_one_dbag_1(T,4000,0), @@ -767,7 +815,7 @@ t_insert_list(Config) when is_list(Config) -> ?line verify_etsmem(EtsMem). t_insert_list_do(Opts) -> - ?line T = ets:new(x,[duplicate_bag | Opts]), + ?line T = ets_new(x,[duplicate_bag | Opts]), ?line do_fill_dbag_using_lists(T,4000), ?line del_one_by_one_dbag_2(T,4000,0), ?line ets:delete(T). @@ -795,7 +843,7 @@ t_select_reverse(doc) -> t_select_reverse(suite) -> []; t_select_reverse(Config) when is_list(Config) -> - ?line Table = ets:new(xxx, [ordered_set]), + ?line Table = ets_new(xxx, [ordered_set]), ?line filltabint(Table,1000), ?line A = lists:reverse(ets:select(Table,[{{'$1', '_'}, [{'>', @@ -817,11 +865,11 @@ t_select_reverse(Config) when is_list(Config) -> ['$_']}],3), % A set/bag/duplicate_bag should get the same result regardless % of select or select_reverse - ?line Table2 = ets:new(xxx, [set]), + ?line Table2 = ets_new(xxx, [set]), ?line filltabint(Table2,1000), - ?line Table3 = ets:new(xxx, [bag]), + ?line Table3 = ets_new(xxx, [bag]), ?line filltabint(Table3,1000), - ?line Table4 = ets:new(xxx, [duplicate_bag]), + ?line Table4 = ets_new(xxx, [duplicate_bag]), ?line filltabint(Table4,1000), ?line lists:map(fun(Tab) -> B = ets:select(Tab,[{{'$1', '_'}, @@ -1129,8 +1177,8 @@ random_test() -> do_random_test() -> ?line EtsMem = etsmem(), - ?line OrdSet = ets:new(xxx,[ordered_set]), - ?line Set = ets:new(xxx,[]), + ?line OrdSet = ets_new(xxx,[ordered_set]), + ?line Set = ets_new(xxx,[]), ?line do_n_times(fun() -> ?line Key = create_random_string(25), ?line Value = create_random_tuple(25), @@ -1334,8 +1382,8 @@ update_element_opts(Opts) -> update_element_opts(Tuple,KeyPos,UpdPos,Opts) -> - Set = ets:new(set,[{keypos,KeyPos} | Opts]), - OrdSet = ets:new(ordered_set,[ordered_set,{keypos,KeyPos} | Opts]), + Set = ets_new(set,[{keypos,KeyPos} | Opts]), + OrdSet = ets_new(ordered_set,[ordered_set,{keypos,KeyPos} | Opts]), update_element(Set,Tuple,KeyPos,UpdPos), update_element(OrdSet,Tuple,KeyPos,UpdPos), true = ets:delete(Set), @@ -1343,7 +1391,8 @@ update_element_opts(Tuple,KeyPos,UpdPos,Opts) -> ok. update_element(T,Tuple,KeyPos,UpdPos) -> - KeyList = [Key || Key <- lists:seq(1,100)], + KeyList = [Key || Key <- [17,"seventeen",<<"seventeen">>,{17},list_to_binary(lists:seq(1,100)), + make_ref(), self()]], lists:foreach(fun(Key) -> TupleWithKey = setelement(KeyPos,Tuple,Key), update_element_do(T,TupleWithKey,Key,UpdPos) @@ -1378,21 +1427,13 @@ update_element_do(Tab,Tuple,Key,UpdPos) -> {Pos, element(ToIx+1,Values)} % single {pos,value} arg end, - NewTupleF = fun({Pos,Val}, Tpl, _MeF) -> - setelement(Pos, Tpl, Val); - ([{Pos,Val} | Tail], Tpl, MeF) -> - MeF(Tail,setelement(Pos, Tpl, Val),MeF); - ([], Tpl, _MeF) -> - Tpl - end, - UpdateF = fun(ToIx,Rand) -> PosValArg = PosValArgF(ToIx,[],UpdPos,Rand,PosValArgF), %%io:format("update_element(~p)~n",[PosValArg]), ArgHash = erlang:phash2({Tab,Key,PosValArg}), ?line true = ets:update_element(Tab, Key, PosValArg), ?line ArgHash = erlang:phash2({Tab,Key,PosValArg}), - NewTuple = NewTupleF(PosValArg,Tuple,NewTupleF), + NewTuple = update_tuple(PosValArg,Tuple), ?line [NewTuple] = ets:lookup(Tab,Key) end, @@ -1420,9 +1461,18 @@ update_element_do(Tab,Tuple,Key,UpdPos) -> ?line Checksum = (Length-1)*Length*(Length+1) div 2, % if Length is a prime ok. +update_tuple({Pos,Val}, Tpl) -> + setelement(Pos, Tpl, Val); +update_tuple([{Pos,Val} | Tail], Tpl) -> + update_tuple(Tail,setelement(Pos, Tpl, Val)); +update_tuple([], Tpl) -> + Tpl. + + + update_element_neg(Opts) -> - Set = ets:new(set,Opts), - OrdSet = ets:new(ordered_set,[ordered_set | Opts]), + Set = ets_new(set,Opts), + OrdSet = ets_new(ordered_set,[ordered_set | Opts]), update_element_neg_do(Set), update_element_neg_do(OrdSet), ets:delete(Set), @@ -1430,8 +1480,8 @@ update_element_neg(Opts) -> ets:delete(OrdSet), ?line {'EXIT',{badarg,_}} = (catch ets:update_element(OrdSet,key,{2,1})), - ?line Bag = ets:new(bag,[bag | Opts]), - ?line DBag = ets:new(duplicate_bag,[duplicate_bag | Opts]), + ?line Bag = ets_new(bag,[bag | Opts]), + ?line DBag = ets_new(duplicate_bag,[duplicate_bag | Opts]), ?line {'EXIT',{badarg,_}} = (catch ets:update_element(Bag,key,{2,1})), ?line {'EXIT',{badarg,_}} = (catch ets:update_element(DBag,key,{2,1})), true = ets:delete(Bag), @@ -1481,8 +1531,8 @@ update_counter(Config) when is_list(Config) -> ?line verify_etsmem(EtsMem). update_counter_do(Opts) -> - Set = ets:new(set,Opts), - OrdSet = ets:new(ordered_set,[ordered_set | Opts]), + Set = ets_new(set,Opts), + OrdSet = ets_new(ordered_set,[ordered_set | Opts]), update_counter_for(Set), update_counter_for(OrdSet), ets:delete(Set), @@ -1628,8 +1678,8 @@ uc_adder(Init, {_Pos, Add, Thres, Warp}) -> end. update_counter_neg(Opts) -> - Set = ets:new(set,Opts), - OrdSet = ets:new(ordered_set,[ordered_set | Opts]), + Set = ets_new(set,Opts), + OrdSet = ets_new(ordered_set,[ordered_set | Opts]), update_counter_neg_for(Set), update_counter_neg_for(OrdSet), ets:delete(Set), @@ -1637,8 +1687,8 @@ update_counter_neg(Opts) -> ets:delete(OrdSet), ?line {'EXIT',{badarg,_}} = (catch ets:update_counter(OrdSet,key,1)), - ?line Bag = ets:new(bag,[bag | Opts]), - ?line DBag = ets:new(duplicate_bag,[duplicate_bag | Opts]), + ?line Bag = ets_new(bag,[bag | Opts]), + ?line DBag = ets_new(duplicate_bag,[duplicate_bag | Opts]), ?line {'EXIT',{badarg,_}} = (catch ets:update_counter(Bag,key,1)), ?line {'EXIT',{badarg,_}} = (catch ets:update_counter(DBag,key,1)), true = ets:delete(Bag), @@ -1711,7 +1761,7 @@ wait_for_all(Pids0) -> end. evil_counter(I,Opts) -> - T = ets:new(a, Opts), + T = ets_new(a, Opts), Start0 = case I rem 3 of 0 -> 16#12345678; 1 -> 16#12345678FFFFFFFF; @@ -1719,7 +1769,7 @@ evil_counter(I,Opts) -> end, Start = Start0 + random:uniform(100000), ets:insert(T, {dracula,Start}), - Iter = 90000, + Iter = 40000, End = Start + Iter, End = evil_counter_1(Iter, T), ets:delete(T). @@ -1740,7 +1790,7 @@ fixtable_next(Config) when is_list(Config) -> fixtable_next_do(Opts) -> ?line EtsMem = etsmem(), - ?line do_fixtable_next(ets:new(set,[public | Opts])), + ?line do_fixtable_next(ets_new(set,[public | Opts])), ?line verify_etsmem(EtsMem). do_fixtable_next(Tab) -> @@ -1821,24 +1871,24 @@ write_concurrency(doc) -> ["The 'write_concurrency' option"]; write_concurrency(suite) -> []; write_concurrency(Config) when is_list(Config) -> ?line EtsMem = etsmem(), - Yes1 = ets:new(foo,[public,{write_concurrency,true}]), - Yes2 = ets:new(foo,[protected,{write_concurrency,true}]), - No1 = ets:new(foo,[private,{write_concurrency,true}]), + Yes1 = ets_new(foo,[public,{write_concurrency,true}]), + Yes2 = ets_new(foo,[protected,{write_concurrency,true}]), + No1 = ets_new(foo,[private,{write_concurrency,true}]), - Yes3 = ets:new(foo,[bag,public,{write_concurrency,true}]), - Yes4 = ets:new(foo,[bag,protected,{write_concurrency,true}]), - No2 = ets:new(foo,[bag,private,{write_concurrency,true}]), + Yes3 = ets_new(foo,[bag,public,{write_concurrency,true}]), + Yes4 = ets_new(foo,[bag,protected,{write_concurrency,true}]), + No2 = ets_new(foo,[bag,private,{write_concurrency,true}]), - Yes5 = ets:new(foo,[duplicate_bag,public,{write_concurrency,true}]), - Yes6 = ets:new(foo,[duplicate_bag,protected,{write_concurrency,true}]), - No3 = ets:new(foo,[duplicate_bag,private,{write_concurrency,true}]), + Yes5 = ets_new(foo,[duplicate_bag,public,{write_concurrency,true}]), + Yes6 = ets_new(foo,[duplicate_bag,protected,{write_concurrency,true}]), + No3 = ets_new(foo,[duplicate_bag,private,{write_concurrency,true}]), - No4 = ets:new(foo,[ordered_set,public,{write_concurrency,true}]), - No5 = ets:new(foo,[ordered_set,protected,{write_concurrency,true}]), - No6 = ets:new(foo,[ordered_set,private,{write_concurrency,true}]), + No4 = ets_new(foo,[ordered_set,public,{write_concurrency,true}]), + No5 = ets_new(foo,[ordered_set,protected,{write_concurrency,true}]), + No6 = ets_new(foo,[ordered_set,private,{write_concurrency,true}]), - No7 = ets:new(foo,[public,{write_concurrency,false}]), - No8 = ets:new(foo,[protected,{write_concurrency,false}]), + No7 = ets_new(foo,[public,{write_concurrency,false}]), + No8 = ets_new(foo,[protected,{write_concurrency,false}]), ?line YesMem = ets:info(Yes1,memory), ?line NoHashMem = ets:info(No1,memory), @@ -1865,10 +1915,10 @@ write_concurrency(Config) when is_list(Config) -> ?line true = YesMem =:= NoHashMem end, - ?line {'EXIT',{badarg,_}} = (catch ets:new(foo,[public,{write_concurrency,foo}])), - ?line {'EXIT',{badarg,_}} = (catch ets:new(foo,[public,{write_concurrency}])), - ?line {'EXIT',{badarg,_}} = (catch ets:new(foo,[public,{write_concurrency,true,foo}])), - ?line {'EXIT',{badarg,_}} = (catch ets:new(foo,[public,write_concurrency])), + ?line {'EXIT',{badarg,_}} = (catch ets_new(foo,[public,{write_concurrency,foo}])), + ?line {'EXIT',{badarg,_}} = (catch ets_new(foo,[public,{write_concurrency}])), + ?line {'EXIT',{badarg,_}} = (catch ets_new(foo,[public,{write_concurrency,true,foo}])), + ?line {'EXIT',{badarg,_}} = (catch ets_new(foo,[public,write_concurrency])), lists:foreach(fun(T) -> ets:delete(T) end, [Yes1,Yes2,Yes3,Yes4,Yes5,Yes6, @@ -1945,7 +1995,7 @@ heir_founder(Master, HeirData, Opts) -> none -> {heir,none}; _ -> {heir, Heir, HeirData} end, - ?line T = ets:new(foo,[named_table, private, HeirTpl | Opts]), + ?line T = ets_new(foo,[named_table, private, HeirTpl | Opts]), ?line true = ets:insert(T,{key,1}), ?line [{key,1}] = ets:lookup(T,key), Self = self(), @@ -2017,7 +2067,7 @@ give_away(Config) when is_list(Config) -> repeat_for_opts(give_away_do). give_away_do(Opts) -> - ?line T = ets:new(foo,[named_table, private | Opts]), + ?line T = ets_new(foo,[named_table, private | Opts]), ?line true = ets:insert(T,{key,1}), ?line [{key,1}] = ets:lookup(T,key), Parent = self(), @@ -2043,7 +2093,7 @@ give_away_do(Opts) -> ?line undefined = ets:info(T), %% Give and then kill receiver to get back - ?line T2 = ets:new(foo,[private | Opts]), + ?line T2 = ets_new(foo,[private | Opts]), ?line true = ets:insert(T2,{key,1}), ?line ets:setopts(T2,{heir,self(),"Som en gummiboll..."}), ?line {Receiver2,Mref2} = spawn_monitor(fun()-> give_away_receiver(T2,Parent) end), @@ -2065,7 +2115,7 @@ give_away_do(Opts) -> ?line give_me = receive_any(), ?line {'EXIT',{badarg,_}} = (catch ets:give_away(T2,ReceiverNeg,"A deleted table")), - ?line T3 = ets:new(foo,[public | Opts]), + ?line T3 = ets_new(foo,[public | Opts]), spawn_link(fun()-> {'EXIT',{badarg,_}} = (catch ets:give_away(T3,ReceiverNeg,"From non owner")), Parent ! done end), @@ -2100,7 +2150,7 @@ setopts(Config) when is_list(Config) -> setopts_do(Opts) -> Self = self(), - ?line T = ets:new(foo,[named_table, private | Opts]), + ?line T = ets_new(foo,[named_table, private | Opts]), ?line none = ets:info(T,heir), Heir = spawn_link(fun()->heir_heir(Self) end), ?line ets:setopts(T,{heir,Heir,"Data"}), @@ -2153,10 +2203,10 @@ bad_table(Config) when is_list(Config) -> bad_table_do(Opts, DummyFile) -> Parent = self(), - {Pid,Mref} = spawn_opt(fun()-> ets:new(priv,[private,named_table | Opts]), - Priv = ets:new(priv,[private | Opts]), - ets:new(prot,[protected,named_table | Opts]), - Prot = ets:new(prot,[protected | Opts]), + {Pid,Mref} = spawn_opt(fun()-> ets_new(priv,[private,named_table | Opts]), + Priv = ets_new(priv,[private | Opts]), + ets_new(prot,[protected,named_table | Opts]), + Prot = ets_new(prot,[protected | Opts]), Parent ! {self(),Priv,Prot}, die_please = receive_any() end, @@ -2214,11 +2264,11 @@ bad_table_do(Opts, DummyFile) -> bad_table_op({Opts,Priv,Prot}, Op) -> %%io:format("Doing Op=~p on ~p's\n",[Op,Type]), - T1 = ets:new(noname,Opts), + T1 = ets_new(noname,Opts), bad_table_call(noname,Op), ets:delete(T1), bad_table_call(T1,Op), - T2 = ets:new(named,[named_table | Opts]), + T2 = ets_new(named,[named_table | Opts]), ets:delete(T2), bad_table_call(named,Op), bad_table_call(T2,Op), @@ -2252,7 +2302,7 @@ rename(Config) when is_list(Config) -> rename_do(Opts) -> ?line EtsMem = etsmem(), - ets:new(foobazz,[named_table, public | Opts]), + ets_new(foobazz,[named_table, public | Opts]), ets:insert(foobazz,{foo,bazz}), ungermanbazz = ets:rename(foobazz,ungermanbazz), {'EXIT',{badarg, _}} = (catch ets:lookup(foobazz,foo)), @@ -2270,7 +2320,7 @@ rename_unnamed(Config) when is_list(Config) -> rename_unnamed_do(Opts) -> ?line EtsMem = etsmem(), - ?line Tab = ets:new(bonkz,[public | Opts]), + ?line Tab = ets_new(bonkz,[public | Opts]), ?line {'EXIT',{badarg, _}} = (catch ets:insert(bonkz,{foo,bazz})), ?line bonkz = ets:info(Tab, name), ?line Tab = ets:rename(Tab, tjabonkz), @@ -2289,7 +2339,7 @@ evil_rename(Config) when is_list(Config) -> evil_rename_1(Old, New, Flags) -> ?line process_flag(trap_exit, true), - ?line Old = ets:new(Old, Flags), + ?line Old = ets_new(Old, Flags), ?line Fixer = fun() -> ets:safe_fixtable(Old, true) end, ?line crazy_fixtable(15000, Fixer), ?line erlang:yield(), @@ -2299,7 +2349,7 @@ evil_rename_1(Old, New, Flags) -> ok. crazy_fixtable(N, Fixer) -> - Dracula = ets:new(count_dracula, [public]), + Dracula = ets_new(count_dracula, [public]), ets:insert(Dracula, {count,0}), SpawnFun = fun() -> Fixer(), @@ -2333,7 +2383,7 @@ evil_creater_destroyer() -> ets:delete(T1). evil_create_fixed_tab() -> - T = ets:new(arne, [public]), + T = ets_new(arne, [public]), ets:safe_fixtable(T, true), T. @@ -2347,8 +2397,8 @@ interface_equality(Config) when is_list(Config) -> interface_equality_do(Opts) -> ?line EtsMem = etsmem(), - ?line Set = ets:new(set,[set | Opts]), - ?line OrderedSet = ets:new(ordered_set,[ordered_set | Opts]), + ?line Set = ets_new(set,[set | Opts]), + ?line OrderedSet = ets_new(ordered_set,[ordered_set | Opts]), ?line F = fun(X,T,FF) -> case X of 0 -> true; _ -> @@ -2427,7 +2477,7 @@ ordered_match_do(Opts) -> FF(X-1,T,FF) end end, - ?line T1 = ets:new(xxx,[ordered_set| Opts]), + ?line T1 = ets_new(xxx,[ordered_set| Opts]), ?line F(3000,T1,F), ?line [[3,3],[3,3],[3,3]] = ets:match(T1, {'_','_','$1','$2',3}), ?line F2 = fun(X,Rem,Res,FF) -> case X of @@ -2465,7 +2515,7 @@ ordered(Config) when is_list(Config) -> ordered_do(Opts) -> ?line EtsMem = etsmem(), - ?line T = ets:new(oset, [ordered_set | Opts]), + ?line T = ets_new(oset, [ordered_set | Opts]), ?line InsList = [ 25,26,27,28, 5,6,7,8, @@ -2526,8 +2576,8 @@ setbag(doc) -> ["Small test case for both set and bag type ets tables."]; setbag(suite) -> []; setbag(Config) when is_list(Config) -> ?line EtsMem = etsmem(), - ?line Set = ets:new(set,[set]), - ?line Bag = ets:new(bag,[bag]), + ?line Set = ets_new(set,[set]), + ?line Bag = ets_new(bag,[bag]), ?line Key = {foo,bar}, %% insert some value @@ -2547,15 +2597,15 @@ setbag(Config) when is_list(Config) -> ?line verify_etsmem(EtsMem). badnew(doc) -> - ["Test case to check proper return values for illegal ets:new() calls."]; + ["Test case to check proper return values for illegal ets_new() calls."]; badnew(suite) -> []; badnew(Config) when is_list(Config) -> ?line EtsMem = etsmem(), - ?line {'EXIT',{badarg,_}} = (catch ets:new(12,[])), - ?line {'EXIT',{badarg,_}} = (catch ets:new({a,b},[])), - ?line {'EXIT',{badarg,_}} = (catch ets:new(name,[foo])), - ?line {'EXIT',{badarg,_}} = (catch ets:new(name,{bag})), - ?line {'EXIT',{badarg,_}} = (catch ets:new(name,bag)), + ?line {'EXIT',{badarg,_}} = (catch ets_new(12,[])), + ?line {'EXIT',{badarg,_}} = (catch ets_new({a,b},[])), + ?line {'EXIT',{badarg,_}} = (catch ets_new(name,[foo])), + ?line {'EXIT',{badarg,_}} = (catch ets_new(name,{bag})), + ?line {'EXIT',{badarg,_}} = (catch ets_new(name,bag)), ?line verify_etsmem(EtsMem). verybadnew(doc) -> @@ -2564,7 +2614,7 @@ verybadnew(doc) -> verybadnew(suite) -> []; verybadnew(Config) when is_list(Config) -> ?line EtsMem = etsmem(), - ?line {'EXIT',{badarg,_}} = (catch ets:new(verybad,[set|protected])), + ?line {'EXIT',{badarg,_}} = (catch ets_new(verybad,[set|protected])), ?line verify_etsmem(EtsMem). named(doc) -> ["Small check to see if named tables work."]; @@ -2641,9 +2691,9 @@ privacy_check(Pub,Prot,Priv) -> ?line [] = ets:lookup(Prot,foo). privacy_owner(Boss, Opts) -> - ets:new(pub, [public,named_table | Opts]), - ets:new(prot,[protected,named_table | Opts]), - ets:new(priv,[private,named_table | Opts]), + ets_new(pub, [public,named_table | Opts]), + ets_new(prot,[protected,named_table | Opts]), + ets_new(priv,[private,named_table | Opts]), Boss ! ok, privacy_owner_loop(Boss). @@ -2681,7 +2731,7 @@ empty(Config) when is_list(Config) -> empty_do(Opts) -> ?line EtsMem = etsmem(), - ?line Tab = ets:new(foo,Opts), + ?line Tab = ets_new(foo,Opts), ?line [] = ets:lookup(Tab,key), ?line true = ets:insert(Tab,{key2,val}), ?line [] = ets:lookup(Tab,key), @@ -2698,10 +2748,10 @@ badinsert_do(Opts) -> ?line EtsMem = etsmem(), ?line {'EXIT',{badarg,_}} = (catch ets:insert(foo,{key,val})), - ?line Tab = ets:new(foo,Opts), + ?line Tab = ets_new(foo,Opts), ?line {'EXIT',{badarg,_}} = (catch ets:insert(Tab,{})), - ?line Tab3 = ets:new(foo,[{keypos,3}| Opts]), + ?line Tab3 = ets_new(foo,[{keypos,3}| Opts]), ?line {'EXIT',{badarg,_}} = (catch ets:insert(Tab3,{a,b})), ?line {'EXIT',{badarg,_}} = (catch ets:insert(Tab,[key,val2])), @@ -2725,7 +2775,7 @@ time_lookup(Config) when is_list(Config) -> "~p ets lookups/s",[Values]))}. time_lookup_do(Opts) -> - ?line Tab = ets:new(foo,Opts), + ?line Tab = ets_new(foo,Opts), ?line fill_tab(Tab,foo), ?line ets:insert(Tab,{{a,key},foo}), ?line {Time,_} = ?t:timecall(test_server,do_times, @@ -2740,7 +2790,7 @@ badlookup(suite) -> []; badlookup(Config) when is_list(Config) -> ?line EtsMem = etsmem(), ?line {'EXIT',{badarg,_}} = (catch ets:lookup(foo,key)), - ?line Tab = ets:new(foo,[]), + ?line Tab = ets_new(foo,[]), ?line ets:delete(Tab), ?line {'EXIT',{badarg,_}} = (catch ets:lookup(Tab,key)), ?line verify_etsmem(EtsMem). @@ -2765,7 +2815,7 @@ lookup_order_2(Opts, Fixed) -> Pair = [{A,B},{B,A},{A,C},{C,A},{B,C},{C,B}], Combos = [{D1,D2,D3} || D1<-ABC, D2<-Pair, D3<-Pair], lists:foreach(fun({D1,{D2a,D2b},{D3a,D3b}}) -> - T = ets:new(foo,Opts), + T = ets_new(foo,Opts), case Fixed of true -> ets:safe_fixtable(T,true); false -> ok @@ -2849,10 +2899,12 @@ lookup_element_mult(Config) when is_list(Config) -> lookup_element_mult_do(Opts) -> ?line EtsMem = etsmem(), - ?line T = ets:new(service, [bag, {keypos, 2} | Opts]), + ?line T = ets_new(service, [bag, {keypos, 2} | Opts]), ?line D = lists:reverse(lem_data()), ?line lists:foreach(fun(X) -> ets:insert(T, X) end, D), ?line ok = lem_crash_3(T), + ?line ets:insert(T, {0, "heap_key"}), + ?line ets:lookup_element(T, "heap_key", 2), ?line true = ets:delete(T), ?line verify_etsmem(EtsMem). @@ -2894,7 +2946,7 @@ delete_elem(Config) when is_list(Config) -> delete_elem_do(Opts) -> ?line EtsMem = etsmem(), - ?line Tab = ets:new(foo,Opts), + ?line Tab = ets_new(foo,Opts), ?line fill_tab(Tab,foo), ?line ets:insert(Tab,{{b,key},foo}), ?line ets:insert(Tab,{{c,key},foo}), @@ -2914,17 +2966,17 @@ delete_tab(Config) when is_list(Config) -> delete_tab_do(Opts) -> Name = foo, ?line EtsMem = etsmem(), - ?line Name = ets:new(Name, [named_table | Opts]), + ?line Name = ets_new(Name, [named_table | Opts]), ?line true = ets:delete(foo), %% The name should be available again. - ?line Name = ets:new(Name, [named_table | Opts]), + ?line Name = ets_new(Name, [named_table | Opts]), ?line true = ets:delete(Name), ?line verify_etsmem(EtsMem). delete_large_tab(doc) -> "Check that ets:delete/1 works and that other processes can run."; delete_large_tab(Config) when is_list(Config) -> - ?line Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 500000)], + ?line Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 200000)], ?line EtsMem = etsmem(), repeat_for_opts(fun(Opts) -> delete_large_tab_do(Opts,Data) end), ?line verify_etsmem(EtsMem). @@ -2936,7 +2988,7 @@ delete_large_tab_do(Opts,Data) -> delete_large_tab_1(Name, Flags, Data, Fix) -> - ?line Tab = ets:new(Name, Flags), + ?line Tab = ets_new(Name, Flags), ?line ets:insert(Tab, Data), case Fix of @@ -3003,7 +3055,7 @@ delete_large_named_table_do(Opts,Data) -> ?line delete_large_named_table_1(foo_hash, [named_table | Opts], Data, true). delete_large_named_table_1(Name, Flags, Data, Fix) -> - ?line Tab = ets:new(Name, Flags), + ?line Tab = ets_new(Name, Flags), ?line ets:insert(Tab, Data), case Fix of @@ -3016,7 +3068,7 @@ delete_large_named_table_1(Name, Flags, Data, Fix) -> Pid = spawn_link(fun() -> receive {trace,Parent,call,_} -> - ets:new(Name, [named_table]) + ets_new(Name, [named_table]) end end), ?line erlang:trace(self(), true, [call,{tracer,Pid}]), @@ -3050,7 +3102,7 @@ evil_delete_do(Opts,Data) -> evil_delete_not_owner(Name, Flags, Data, Fix) -> io:format("Not owner: ~p, fix = ~p", [Name,Fix]), - ?line Tab = ets:new(Name, [public|Flags]), + ?line Tab = ets_new(Name, [public|Flags]), ?line ets:insert(Tab, Data), case Fix of false -> ok; @@ -3075,7 +3127,7 @@ evil_delete_not_owner(Name, Flags, Data, Fix) -> evil_delete_owner(Name, Flags, Data, Fix) -> ?line Fun = fun() -> - ?line Tab = ets:new(Name, [public|Flags]), + ?line Tab = ets_new(Name, [public|Flags]), ?line ets:insert(Tab, Data), case Fix of false -> ok; @@ -3102,48 +3154,60 @@ exit_large_table_owner(doc) -> exit_large_table_owner(suite) -> []; exit_large_table_owner(Config) when is_list(Config) -> - ?line Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 500000)], + %%?line Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 500000)], + ?line FEData = fun(Do) -> repeat_while(fun(500000) -> {false,ok}; + (I) -> Do({erlang:phash2(I, 16#ffffff),I}), + {true, I+1} + end, 1) + end, ?line EtsMem = etsmem(), - repeat_for_opts(fun(Opts) -> exit_large_table_owner_do(Opts,Data,Config) end), + repeat_for_opts({exit_large_table_owner_do,{FEData,Config}}), ?line verify_etsmem(EtsMem). -exit_large_table_owner_do(Opts,Data,Config) -> - ?line verify_rescheduling_exit(Config, Data, [named_table | Opts], true, 1, 1), - ?line verify_rescheduling_exit(Config, Data, Opts, false, 1, 1). +exit_large_table_owner_do(Opts,{FEData,Config}) -> + ?line verify_rescheduling_exit(Config, FEData, [named_table | Opts], true, 1, 1), + ?line verify_rescheduling_exit(Config, FEData, Opts, false, 1, 1). exit_many_large_table_owner(doc) -> []; exit_many_large_table_owner(suite) -> []; exit_many_large_table_owner(Config) when is_list(Config) -> - ?line Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 500000)], + %%?line Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 500000)], + ?line FEData = fun(Do) -> repeat_while(fun(500000) -> {false,ok}; + (I) -> Do({erlang:phash2(I, 16#ffffff),I}), + {true, I+1} + end, 1) + end, ?line EtsMem = etsmem(), - repeat_for_opts(fun(Opts) -> exit_many_large_table_owner_do(Opts,Data,Config) end), + repeat_for_opts(fun(Opts) -> exit_many_large_table_owner_do(Opts,FEData,Config) end), ?line verify_etsmem(EtsMem). -exit_many_large_table_owner_do(Opts,Data,Config) -> - ?line verify_rescheduling_exit(Config, Data, Opts, true, 1, 4), - ?line verify_rescheduling_exit(Config, Data, [named_table | Opts], false, 1, 4). +exit_many_large_table_owner_do(Opts,FEData,Config) -> + ?line verify_rescheduling_exit(Config, FEData, Opts, true, 1, 4), + ?line verify_rescheduling_exit(Config, FEData, [named_table | Opts], false, 1, 4). exit_many_tables_owner(doc) -> []; exit_many_tables_owner(suite) -> []; exit_many_tables_owner(Config) when is_list(Config) -> + NoData = fun(_Do) -> ok end, ?line EtsMem = etsmem(), - ?line verify_rescheduling_exit(Config, [], [named_table], false, 1000, 1), - ?line verify_rescheduling_exit(Config, [], [named_table,{write_concurrency,true}], false, 1000, 1), + ?line verify_rescheduling_exit(Config, NoData, [named_table], false, 1000, 1), + ?line verify_rescheduling_exit(Config, NoData, [named_table,{write_concurrency,true}], false, 1000, 1), ?line verify_etsmem(EtsMem). exit_many_many_tables_owner(doc) -> []; exit_many_many_tables_owner(suite) -> []; exit_many_many_tables_owner(Config) when is_list(Config) -> ?line Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 50)], - repeat_for_opts(fun(Opts) -> exit_many_many_tables_owner_do(Opts,Data,Config) end). + ?line FEData = fun(Do) -> lists:foreach(Do, Data) end, + repeat_for_opts(fun(Opts) -> exit_many_many_tables_owner_do(Opts,FEData,Config) end). -exit_many_many_tables_owner_do(Opts,Data,Config) -> - ?line verify_rescheduling_exit(Config, Data, [named_table | Opts], true, 200, 5), - ?line verify_rescheduling_exit(Config, Data, Opts, false, 200, 5), +exit_many_many_tables_owner_do(Opts,FEData,Config) -> + ?line verify_rescheduling_exit(Config, FEData, [named_table | Opts], true, 200, 5), + ?line verify_rescheduling_exit(Config, FEData, Opts, false, 200, 5), ?line wait_for_test_procs(), ?line EtsMem = etsmem(), - ?line verify_rescheduling_exit(Config, Data, Opts, true, 200, 5), - ?line verify_rescheduling_exit(Config, Data, [named_table | Opts], false, 200, 5), + ?line verify_rescheduling_exit(Config, FEData, Opts, true, 200, 5), + ?line verify_rescheduling_exit(Config, FEData, [named_table | Opts], false, 200, 5), ?line verify_etsmem(EtsMem). @@ -3186,7 +3250,7 @@ vre_fix_tables(Tab) -> receive Go -> ok end, ok. -verify_rescheduling_exit(Config, Data, Flags, Fix, NOTabs, NOProcs) -> +verify_rescheduling_exit(Config, ForEachData, Flags, Fix, NOTabs, NOProcs) -> ?line NoFix = 5, ?line TestCase = atom_to_list(?config(test_case, Config)), ?line Parent = self(), @@ -3201,8 +3265,8 @@ verify_rescheduling_exit(Config, Data, Flags, Fix, NOTabs, NOProcs) -> ++ "-" ++ integer_to_list(A) ++ "-" ++ integer_to_list(B) ++ "-" ++ integer_to_list(C)), - Tab = ets:new(Name, Flags), - ets:insert(Tab, Data), + Tab = ets_new(Name, Flags), + ForEachData(fun(Data) -> ets:insert(Tab, Data) end), case Fix of false -> ok; true -> @@ -3210,10 +3274,10 @@ verify_rescheduling_exit(Config, Data, Flags, Fix, NOTabs, NOProcs) -> vre_fix_tables(Tab) end, lists:seq(1,NoFix)), - lists:foreach(fun({K,_}) -> - ets:delete(Tab, K) - end, - Data) + KeyPos = ets:info(Tab,keypos), + ForEachData(fun(Data) -> + ets:delete(Tab, element(KeyPos,Data)) + end) end end, NOTabs), @@ -3260,7 +3324,7 @@ table_leak(Config) when is_list(Config) -> table_leak_1(_,0) -> ok; table_leak_1(Opts,N) -> - ?line T = ets:new(fooflarf, Opts), + ?line T = ets_new(fooflarf, Opts), ?line true = ets:delete(T), table_leak_1(Opts,N-1). @@ -3270,7 +3334,7 @@ baddelete(suite) -> []; baddelete(Config) when is_list(Config) -> ?line EtsMem = etsmem(), ?line {'EXIT',{badarg,_}} = (catch ets:delete(foo)), - ?line Tab = ets:new(foo,[]), + ?line Tab = ets_new(foo,[]), ?line true = ets:delete(Tab), ?line {'EXIT',{badarg,_}} = (catch ets:delete(Tab)), ?line verify_etsmem(EtsMem). @@ -3285,7 +3349,7 @@ match_delete(Config) when is_list(Config) -> match_delete_do(Opts) -> ?line EtsMem = etsmem(), - ?line Tab = ets:new(kad,Opts), + ?line Tab = ets_new(kad,Opts), ?line fill_tab(Tab,foo), ?line ets:insert(Tab,{{c,key},bar}), ?line _ = ets:match_delete(Tab,{'_',foo}), @@ -3329,7 +3393,7 @@ firstnext(Config) when is_list(Config) -> firstnext_do(Opts) -> ?line EtsMem = etsmem(), - ?line Tab = ets:new(foo,Opts), + ?line Tab = ets_new(foo,Opts), ?line [] = firstnext_collect(Tab,ets:first(Tab),[]), ?line fill_tab(Tab,foo), ?line Len = length(ets:tab2list(Tab)), @@ -3355,7 +3419,7 @@ firstnext_concurrent(Config) when is_list(Config) -> end. ets_init(Tab, N) -> - ets:new(Tab, [named_table,public,ordered_set]), + ets_new(Tab, [named_table,public,ordered_set]), cycle(Tab, lists:seq(1,N+1)). cycle(_Tab, [H|T]) when H > length(T)-> ok; @@ -3388,7 +3452,7 @@ slot(Config) when is_list(Config) -> slot_do(Opts) -> ?line EtsMem = etsmem(), - ?line Tab = ets:new(foo,Opts), + ?line Tab = ets_new(foo,Opts), ?line fill_tab(Tab,foo), ?line Elts = ets:info(Tab,size), ?line Elts = slot_loop(Tab,0,0), @@ -3415,7 +3479,7 @@ match1(Config) when is_list(Config) -> match1_do(Opts) -> ?line EtsMem = etsmem(), - ?line Tab = ets:new(foo,Opts), + ?line Tab = ets_new(foo,Opts), ?line fill_tab(Tab,foo), ?line [] = ets:match(Tab,{}), ?line ets:insert(Tab,{{one,4},4}), @@ -3480,7 +3544,7 @@ match_object(Config) when is_list(Config) -> match_object_do(Opts) -> ?line EtsMem = etsmem(), - ?line Tab = ets:new(foobar, Opts), + ?line Tab = ets_new(foobar, Opts), ?line fill_tab(Tab, foo), ?line ets:insert(Tab, {{one, 4}, 4}), ?line ets:insert(Tab,{{one,5},5}), @@ -3524,7 +3588,7 @@ match_object2(Config) when is_list(Config) -> match_object2_do(Opts) -> ?line EtsMem = etsmem(), - ?line Tab = ets:new(foo, [bag, {keypos, 2} | Opts]), + ?line Tab = ets_new(foo, [bag, {keypos, 2} | Opts]), ?line fill_tab2(Tab, 0, 13005), % match_db_object does 1000 % elements per pass, might % change in the future. @@ -3563,7 +3627,7 @@ misc1(Config) when is_list(Config) -> misc1_do(Opts) -> ?line EtsMem = etsmem(), - ?line Tab = ets:new(foo,Opts), + ?line Tab = ets_new(foo,Opts), ?line true = lists:member(Tab,ets:all()), ?line ets:delete(Tab), ?line false = lists:member(Tab,ets:all()), @@ -3582,7 +3646,7 @@ safe_fixtable(Config) when is_list(Config) -> safe_fixtable_do(Opts) -> ?line EtsMem = etsmem(), - ?line Tab = ets:new(foo, Opts), + ?line Tab = ets_new(foo, Opts), ?line fill_tab(Tab, foobar), ?line true = ets:safe_fixtable(Tab, true), ?line receive after 1 -> ok end, @@ -3621,7 +3685,7 @@ info_do(Opts) -> ?line EtsMem = etsmem(), ?line MeMyselfI=self(), ?line ThisNode=node(), - ?line Tab = ets:new(foobar, [{keypos, 2} | Opts]), + ?line Tab = ets_new(foobar, [{keypos, 2} | Opts]), %% Note: ets:info/1 used to return a tuple, but from R11B onwards it %% returns a list. @@ -3675,7 +3739,7 @@ dups_do(Opts) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -files(suite) -> [tab2file, tab2file2, tab2file3, tabfile_ext1, tabfile_ext2, +files(suite) -> [tab2file, tab2file2, tabfile_ext1, tabfile_ext2, tabfile_ext3, tabfile_ext4]. tab2file(doc) -> ["Check the ets:tab2file function on an empty " @@ -3683,7 +3747,7 @@ tab2file(doc) -> ["Check the ets:tab2file function on an empty " tab2file(suite) -> []; tab2file(Config) when is_list(Config) -> %% Write an empty ets table to a file, read back and check properties. - ?line Tab = ets:new(ets_SUITE_foo_tab, [named_table, set, private, + ?line Tab = ets_new(ets_SUITE_foo_tab, [named_table, set, private, {keypos, 2}]), ?line FName = filename:join([?config(priv_dir, Config),"tab2file_case"]), ?line ok = ets:tab2file(Tab, FName), @@ -3699,51 +3763,36 @@ tab2file(Config) when is_list(Config) -> ?line verify_etsmem(EtsMem). tab2file2(doc) -> ["Check the ets:tab2file function on a ", - "filled set type ets table."]; + "filled set/bag type ets table."]; tab2file2(suite) -> []; -tab2file2(Config) when is_list(Config) -> - %% Try the same on a filled set table. - ?line EtsMem = etsmem(), - ?line Tab = ets:new(ets_SUITE_foo_tab, [named_table, set, private, - {keypos, 2}]), - ?line FName = filename:join([?config(priv_dir, Config),"tab2file2_case"]), - ?line ok = fill_tab2(Tab, 0, 10000), % Fill up the table (grucho mucho!) - ?line Len = length(ets:tab2list(Tab)), - ?line ok = ets:tab2file(Tab, FName), - ?line true = ets:delete(Tab), - % - ?line {ok, Tab2} = ets:file2tab(FName), - ?line private = ets:info(Tab2, protection), - ?line true = ets:info(Tab2, named_table), - ?line 2 = ets:info(Tab2, keypos), - ?line set = ets:info(Tab2, type), - ?line Len = length(ets:tab2list(Tab2)), - ?line true = ets:delete(Tab2), - ?line verify_etsmem(EtsMem). +tab2file2(Config) when is_list(Config) -> + repeat_for_opts({tab2file2_do,Config}, [[set,bag],compressed]). -tab2file3(doc) -> ["Check the ets:tab2file function on a ", - "filled bag type ets table."]; -tab2file3(suite) -> []; -tab2file3(Config) when is_list(Config) -> - %% Try the same on a filled bag table. +tab2file2_do(Opts, Config) -> ?line EtsMem = etsmem(), - ?line Tab = ets:new(ets_SUITE_foo_tab, [named_table, bag, private, - {keypos, 2}]), - ?line FName = filename:join([?config(priv_dir, Config),"tab2file3_case"]), + ?line Tab = ets_new(ets_SUITE_foo_tab, [named_table, private, + {keypos, 2} | Opts]), + ?line FName = filename:join([?config(priv_dir, Config),"tab2file2_case"]), ?line ok = fill_tab2(Tab, 0, 10000), % Fill up the table (grucho mucho!) ?line Len = length(ets:tab2list(Tab)), ?line Mem = ets:info(Tab, memory), + ?line Type = ets:info(Tab, type), + %%io:format("org tab: ~p\n",[ets:info(Tab)]), ?line ok = ets:tab2file(Tab, FName), ?line true = ets:delete(Tab), + ?line EtsMem4 = etsmem(), + ?line {ok, Tab2} = ets:file2tab(FName), + %%io:format("loaded tab: ~p\n",[ets:info(Tab2)]), ?line private = ets:info(Tab2, protection), ?line true = ets:info(Tab2, named_table), ?line 2 = ets:info(Tab2, keypos), - ?line bag = ets:info(Tab2, type), + ?line Type = ets:info(Tab2, type), ?line Len = length(ets:tab2list(Tab2)), ?line Mem = ets:info(Tab2, memory), ?line true = ets:delete(Tab2), + io:format("Between = ~p\n", [EtsMem4]), ?line verify_etsmem(EtsMem). -define(test_list, [8,5,4,1,58,125,255, 250, 245, 240, 235, @@ -3787,7 +3836,7 @@ tabfile_ext1_do(Opts,Config) -> ?line FName = filename:join([?config(priv_dir, Config),"nisse.dat"]), ?line FName2 = filename:join([?config(priv_dir, Config),"countflip.dat"]), L = lists:seq(1,10), - T = ets:new(x,Opts), + T = ets_new(x,Opts), Name = make_ref(), [ets:insert(T,{X,integer_to_list(X)}) || X <- L], ok = ets:tab2file(T,FName,[{extended_info,[object_count]}]), @@ -3827,7 +3876,7 @@ tabfile_ext2_do(Opts,Config) -> ?line FName = filename:join([?config(priv_dir, Config),"olle.dat"]), ?line FName2 = filename:join([?config(priv_dir, Config),"bitflip.dat"]), L = lists:seq(1,10), - T = ets:new(x,Opts), + T = ets_new(x,Opts), Name = make_ref(), [ets:insert(T,{X,integer_to_list(X)}) || X <- L], ok = ets:tab2file(T,FName,[{extended_info,[md5sum]}]), @@ -3865,7 +3914,7 @@ tabfile_ext3(Config) when is_list(Config) -> ?line FName2 = filename:join([?config(priv_dir, Config),"ncountflip.dat"]), L = lists:seq(1,10), Name = make_ref(), - ?MODULE = ets:new(?MODULE,[named_table]), + ?MODULE = ets_new(?MODULE,[named_table]), [ets:insert(?MODULE,{X,integer_to_list(X)}) || X <- L], ets:tab2file(?MODULE,FName), {error,cannot_create_table} = ets:file2tab(FName), @@ -3897,7 +3946,7 @@ tabfile_ext4(doc) -> tabfile_ext4(Config) when is_list(Config) -> ?line FName = filename:join([?config(priv_dir, Config),"bauta.dat"]), LL = lists:seq(1,10000), - TL = ets:new(x,[]), + TL = ets_new(x,[]), Name2 = make_ref(), [ets:insert(TL,{X,integer_to_list(X)}) || X <- LL], ok = ets:tab2file(TL,FName,[{extended_info,[md5sum]}]), @@ -3953,7 +4002,7 @@ heavy_lookup(Config) when is_list(Config) -> heavy_lookup_do(Opts) -> ?line EtsMem = etsmem(), - ?line Tab = ets:new(foobar_table, [set, protected, {keypos, 2} | Opts]), + ?line Tab = ets_new(foobar_table, [set, protected, {keypos, 2} | Opts]), ?line ok = fill_tab2(Tab, 0, 7000), ?line ?t:do_times(50, ?MODULE, do_lookup, [Tab, 6999]), ?line true = ets:delete(Tab), @@ -3976,7 +4025,7 @@ heavy_lookup_element(Config) when is_list(Config) -> heavy_lookup_element_do(Opts) -> ?line EtsMem = etsmem(), - ?line Tab = ets:new(foobar_table, [set, protected, {keypos, 2} | Opts]), + ?line Tab = ets_new(foobar_table, [set, protected, {keypos, 2} | Opts]), ?line ok = fill_tab2(Tab, 0, 7000), case os:type() of vxworks -> @@ -4009,9 +4058,9 @@ heavy_concurrent(_Config) -> repeat_for_opts(do_heavy_concurrent). do_heavy_concurrent(Opts) -> - ?line Size = 20000, + ?line Size = 10000, ?line EtsMem = etsmem(), - ?line Tab = ets:new(blupp, [set, public, {keypos, 2} | Opts]), + ?line Tab = ets_new(blupp, [set, public, {keypos, 2} | Opts]), ?line ok = fill_tab2(Tab, 0, Size), ?line Procs = lists:map( fun (N) -> @@ -4115,7 +4164,7 @@ member(Config) when is_list(Config) -> member_do(Opts) -> ?line EtsMem = etsmem(), - ?line T = ets:new(xxx, Opts), + ?line T = ets_new(xxx, Opts), ?line false = ets:member(T,hej), ?line E = fun(0,_F)->ok; (N,F) -> @@ -4140,7 +4189,7 @@ member_do(Opts) -> build_table(L1,L2,Num) -> - T = ets:new(xxx, [ordered_set] + T = ets_new(xxx, [ordered_set] ), lists:foreach( fun(X1) -> @@ -4162,7 +4211,7 @@ build_table(L1,L2,Num) -> T. build_table2(L1,L2,Num) -> - T = ets:new(xxx, [ordered_set] + T = ets_new(xxx, [ordered_set] ), lists:foreach( fun(X1) -> @@ -4293,7 +4342,7 @@ do_n_times(Fun,N) -> do_n_times(Fun,N-1). make_table(Name, Options, Elements) -> - T = ets:new(Name, Options), + T = ets_new(Name, Options), lists:foreach(fun(E) -> ets:insert(T, E) end, Elements), T. filltabint(Tab,0) -> @@ -4357,13 +4406,13 @@ xfilltabstr(Tab,N) -> fill_sets_int(N) -> fill_sets_int(N,[]). fill_sets_int(N,Opts) -> - Tab1 = ets:new(xxx, [ordered_set|Opts]), + Tab1 = ets_new(xxx, [ordered_set|Opts]), filltabint(Tab1,N), - Tab2 = ets:new(xxx, [set|Opts]), + Tab2 = ets_new(xxx, [set|Opts]), filltabint(Tab2,N), - Tab3 = ets:new(xxx, [bag|Opts]), + Tab3 = ets_new(xxx, [bag|Opts]), filltabint2(Tab3,N), - Tab4 = ets:new(xxx, [duplicate_bag|Opts]), + Tab4 = ets_new(xxx, [duplicate_bag|Opts]), filltabint3(Tab4,N), [Tab1,Tab2,Tab3,Tab4]. @@ -4515,7 +4564,7 @@ gen_dets_filename(Config,N) -> "testdets_" ++ integer_to_list(N) ++ ".dets"). otp_6842_select_1000(Config) when is_list(Config) -> - ?line Tab = ets:new(xxx,[ordered_set]), + ?line Tab = ets_new(xxx,[ordered_set]), ?line [ets:insert(Tab,{X,X}) || X <- lists:seq(1,10000)], ?line AllTrue = lists:duplicate(10,true), ?line AllTrue = @@ -4548,7 +4597,7 @@ check_seq(A,B,C) -> otp_6338(Config) when is_list(Config) -> L = binary_to_term(<<131,108,0,0,0,2,104,2,108,0,0,0,2,103,100,0,19,112,112,98,49,95,98,115,49,50,64,98,108,97,100,101,95,48,95,53,0,0,33,50,0,0,0,4,1,98,0,0,23,226,106,100,0,4,101,120,105,116,104,2,108,0,0,0,2,104,2,100,0,3,115,98,109,100,0,19,112,112,98,50,95,98,115,49,50,64,98,108,97,100,101,95,48,95,56,98,0,0,18,231,106,100,0,4,114,101,99,118,106>>), - T = ets:new(xxx,[ordered_set]), + T = ets_new(xxx,[ordered_set]), lists:foreach(fun(X) -> ets:insert(T,X) end,L), [[4839,recv]] = ets:match(T,{[{sbm,ppb2_bs12@blade_0_8},'$1'],'$2'}), ets:delete(T). @@ -4559,7 +4608,7 @@ otp_5340(Config) when is_list(Config) -> otp_5340_do(Opts) -> N = 3000, - T = ets:new(otp_5340, [bag,public | Opts]), + T = ets_new(otp_5340, [bag,public | Opts]), Ids = [1,2,3,4,5], [w(T, N, Id) || Id <- Ids], verify(T, Ids), @@ -4595,7 +4644,7 @@ otp_7665(Config) when is_list(Config) -> repeat_for_opts(otp_7665_do). otp_7665_do(Opts) -> - Tab = ets:new(otp_7665,[bag | Opts]), + Tab = ets_new(otp_7665,[bag | Opts]), Min = 0, Max = 10, lists:foreach(fun(N)-> otp_7665_act(Tab,Min,Max,N) end, @@ -4658,7 +4707,7 @@ meta_wb_do(Opts) -> Names). meta_wb_new(Name, _, Tabs, Opts) -> - case (catch ets:new(Name,[named_table|Opts])) of + case (catch ets_new(Name,[named_table|Opts])) of Name -> ?line false = lists:member(Name, Tabs), [Name | Tabs]; @@ -4706,7 +4755,7 @@ grow_shrink_0([N|Ns], EtsMem) -> grow_shrink_0([], _) -> ok. grow_shrink_1(N, Flags) -> - ?line T = ets:new(a, Flags), + ?line T = ets_new(a, Flags), ?line grow_shrink_2(N, N, T), ?line ets:delete(T). @@ -4736,7 +4785,7 @@ grow_pseudo_deleted_do() -> grow_pseudo_deleted_do(Type) -> process_flag(scheduler,1), Self = self(), - ?line T = ets:new(kalle,[Type,public,{write_concurrency,true}]), + ?line T = ets_new(kalle,[Type,public,{write_concurrency,true}]), Mod = 7, Mult = 10000, filltabint(T,Mod*Mult), ?line true = ets:safe_fixtable(T,true), @@ -4778,7 +4827,7 @@ shrink_pseudo_deleted_do() -> shrink_pseudo_deleted_do(Type) -> process_flag(scheduler,1), Self = self(), - ?line T = ets:new(kalle,[Type,public,{write_concurrency,true}]), + ?line T = ets_new(kalle,[Type,public,{write_concurrency,true}]), Half = 10000, filltabint(T,Half*2), ?line true = ets:safe_fixtable(T,true), @@ -4817,7 +4866,7 @@ meta_smp(suite) -> meta_lookup_unnamed_read(suite) -> []; meta_lookup_unnamed_read(Config) when is_list(Config) -> - InitF = fun(_) -> Tab = ets:new(unnamed,[]), + InitF = fun(_) -> Tab = ets_new(unnamed,[]), true = ets:insert(Tab,{key,data}), Tab end, @@ -4830,7 +4879,7 @@ meta_lookup_unnamed_read(Config) when is_list(Config) -> meta_lookup_unnamed_write(suite) -> []; meta_lookup_unnamed_write(Config) when is_list(Config) -> - InitF = fun(_) -> Tab = ets:new(unnamed,[]), + InitF = fun(_) -> Tab = ets_new(unnamed,[]), {Tab,0} end, ExecF = fun({Tab,N}) -> true = ets:insert(Tab,{key,N}), @@ -4843,7 +4892,7 @@ meta_lookup_unnamed_write(Config) when is_list(Config) -> meta_lookup_named_read(suite) -> []; meta_lookup_named_read(Config) when is_list(Config) -> InitF = fun([ProcN|_]) -> Name = list_to_atom(integer_to_list(ProcN)), - Tab = ets:new(Name,[named_table]), + Tab = ets_new(Name,[named_table]), true = ets:insert(Tab,{key,data}), Tab end, @@ -4857,7 +4906,7 @@ meta_lookup_named_read(Config) when is_list(Config) -> meta_lookup_named_write(suite) -> []; meta_lookup_named_write(Config) when is_list(Config) -> InitF = fun([ProcN|_]) -> Name = list_to_atom(integer_to_list(ProcN)), - Tab = ets:new(Name,[named_table]), + Tab = ets_new(Name,[named_table]), {Tab,0} end, ExecF = fun({Tab,N}) -> true = ets:insert(Tab,{key,N}), @@ -4870,7 +4919,7 @@ meta_lookup_named_write(Config) when is_list(Config) -> meta_newdel_unnamed(suite) -> []; meta_newdel_unnamed(Config) when is_list(Config) -> InitF = fun(_) -> ok end, - ExecF = fun(_) -> Tab = ets:new(unnamed,[]), + ExecF = fun(_) -> Tab = ets_new(unnamed,[]), true = ets:delete(Tab) end, FiniF = fun(_) -> ok end, @@ -4880,7 +4929,7 @@ meta_newdel_named(suite) -> []; meta_newdel_named(Config) when is_list(Config) -> InitF = fun([ProcN|_]) -> list_to_atom(integer_to_list(ProcN)) end, - ExecF = fun(Name) -> Name = ets:new(Name,[named_table]), + ExecF = fun(Name) -> Name = ets_new(Name,[named_table]), true = ets:delete(Name), Name end, @@ -4890,7 +4939,7 @@ meta_newdel_named(Config) when is_list(Config) -> smp_insert(doc) -> ["Concurrent insert's on same table"]; smp_insert(suite) -> []; smp_insert(Config) when is_list(Config) -> - ets:new(smp_insert,[named_table,public,{write_concurrency,true}]), + ets_new(smp_insert,[named_table,public,{write_concurrency,true}]), InitF = fun(_) -> ok end, ExecF = fun(_) -> true = ets:insert(smp_insert,{random:uniform(10000)}) end, @@ -4905,7 +4954,7 @@ smp_fixed_delete(Config) when is_list(Config) -> only_if_smp(fun()->smp_fixed_delete_do() end). smp_fixed_delete_do() -> - T = ets:new(foo,[public,{write_concurrency,true}]), + T = ets_new(foo,[public,{write_concurrency,true}]), %%Mem = ets:info(T,memory), NumOfObjs = 100000, filltabint(T,NumOfObjs), @@ -4941,7 +4990,7 @@ smp_unfix_fix(Config) when is_list(Config) -> smp_unfix_fix_do() -> process_flag(scheduler,1), Parent = self(), - T = ets:new(foo,[public,{write_concurrency,true}]), + T = ets_new(foo,[public,{write_concurrency,true}]), %%Mem = ets:info(T,memory), NumOfObjs = 100000, Deleted = 50000, @@ -5001,7 +5050,7 @@ otp_8166_do(WC) -> %% Bug scenario: One process segv while reading the table because another %% process is doing unfix without write-lock at the end of a trapping match_object. process_flag(scheduler,1), - T = ets:new(foo,[public, {write_concurrency,WC}]), + T = ets_new(foo,[public, {write_concurrency,WC}]), NumOfObjs = 3000, %% Need more than 1000 live objects for match_object to trap one time Deleted = NumOfObjs div 2, filltabint(T,NumOfObjs), @@ -5115,7 +5164,7 @@ verify_table_load(T) -> otp_8732(doc) -> ["ets:select on a tree with NIL key object"]; otp_8732(Config) when is_list(Config) -> - Tab = ets:new(noname,[ordered_set]), + Tab = ets_new(noname,[ordered_set]), filltabstr(Tab,999), ets:insert(Tab,{[],"nasty NIL object"}), ?line [] = ets:match(Tab,{'_',nomatch}), %% Will hang if bug not fixed @@ -5126,7 +5175,7 @@ smp_select_delete(suite) -> []; smp_select_delete(doc) -> ["Run concurrent select_delete (and inserts) on same table."]; smp_select_delete(Config) when is_list(Config) -> - T = ets:new(smp_select_delete,[named_table,public,{write_concurrency,true}]), + T = ets_new(smp_select_delete,[named_table,public,{write_concurrency,true}]), Mod = 17, Zeros = erlang:make_tuple(Mod,0), InitF = fun(_) -> Zeros end, @@ -5179,6 +5228,41 @@ smp_select_delete(Config) when is_list(Config) -> ?line false = ets:info(T,fixed), ets:delete(T). +types(doc) -> ["Test different types"]; +types(Config) when is_list(Config) -> + init_externals(), + io:format("ets:i() before test:\n",[]), + ets:i(), % SVERK: trouble shooting + repeat_for_opts(types_do,[[set,ordered_set],compressed]). + +types_do(Opts) -> + EtsMem = etsmem(), + ?line T = ets_new(xxx,Opts), + Fun = fun(Term) -> + ets:insert(T,{Term}), + ?line [{Term}] = ets:lookup(T,Term), + ets:insert(T,{Term,xxx}), + ?line [{Term,xxx}] = ets:lookup(T,Term), + ets:insert(T,{Term,"xxx"}), + ?line [{Term,"xxx"}] = ets:lookup(T,Term), + ets:insert(T,{xxx,Term}), + ?line [{xxx,Term}] = ets:lookup(T,xxx), + ets:insert(T,{"xxx",Term}), + ?line [{"xxx",Term}] = ets:lookup(T,"xxx"), + ets:delete_all_objects(T), + ?line 0 = ets:info(T,size) + end, + test_terms(Fun), + ets:delete(T), + ?line verify_etsmem(EtsMem). + + + + +% +% Utility functions: +% + add_lists(L1,L2) -> add_lists(L1,L2,[]). add_lists([],[],Acc) -> @@ -5279,6 +5363,7 @@ verify_etsmem(MemInfo) -> Other -> io:format("Expected: ~p", [MemInfo]), io:format("Actual: ~p", [Other]), + ets:i(), ?t:fail() end. @@ -5441,22 +5526,208 @@ only_if_smp(Schedulers, Func) -> {true,_} -> Func() end. +%% Copy-paste from emulator/test/binary_SUITE.erl +-define(heap_binary_size, 64). +test_terms(Test_Func) -> + garbage_collect(), + ?line Pib0 = process_info(self(),binary), + + ?line Test_Func(atom), + ?line Test_Func(''), + ?line Test_Func('a'), + ?line Test_Func('ab'), + ?line Test_Func('abc'), + ?line Test_Func('abcd'), + ?line Test_Func('abcde'), + ?line Test_Func('abcdef'), + ?line Test_Func('abcdefg'), + ?line Test_Func('abcdefgh'), + + ?line Test_Func(fun() -> ok end), + X = id([a,{b,c},c]), + Y = id({x,y,z}), + Z = id(1 bsl 8*257), + ?line Test_Func(fun() -> X end), + ?line Test_Func(fun() -> {X,Y} end), + ?line Test_Func([fun() -> {X,Y,Z} end, + fun() -> {Z,X,Y} end, + fun() -> {Y,Z,X} end]), + + ?line Test_Func({trace_ts,{even_bigger,{some_data,fun() -> ok end}},{1,2,3}}), + ?line Test_Func({trace_ts,{even_bigger,{some_data,<<1,2,3,4,5,6,7,8,9,10>>}}, + {1,2,3}}), + + ?line Test_Func(1), + ?line Test_Func(42), + ?line Test_Func(-23), + ?line Test_Func(256), + ?line Test_Func(25555), + ?line Test_Func(-3333), + + ?line Test_Func(1.0), + + ?line Test_Func(183749783987483978498378478393874), + ?line Test_Func(-37894183749783987483978498378478393874), + Very_Big = very_big_num(), + ?line Test_Func(Very_Big), + ?line Test_Func(-Very_Big+1), + + ?line Test_Func([]), + ?line Test_Func("abcdef"), + ?line Test_Func([a, b, 1, 2]), + ?line Test_Func([a|b]), + + ?line Test_Func({}), + ?line Test_Func({1}), + ?line Test_Func({a, b}), + ?line Test_Func({a, b, c}), + ?line Test_Func(list_to_tuple(lists:seq(0, 255))), + ?line Test_Func(list_to_tuple(lists:seq(0, 256))), + + ?line Test_Func(make_ref()), + ?line Test_Func([make_ref(), make_ref()]), + + ?line Test_Func(make_port()), + + ?line Test_Func(make_pid()), + ?line Test_Func(make_ext_pid()), + ?line Test_Func(make_ext_port()), + ?line Test_Func(make_ext_ref()), + + Bin0 = list_to_binary(lists:seq(0, 14)), + ?line Test_Func(Bin0), + Bin1 = list_to_binary(lists:seq(0, ?heap_binary_size)), + ?line Test_Func(Bin1), + Bin2 = list_to_binary(lists:seq(0, ?heap_binary_size+1)), + ?line Test_Func(Bin2), + Bin3 = list_to_binary(lists:seq(0, 255)), + garbage_collect(), + Pib = process_info(self(),binary), + ?line Test_Func(Bin3), + garbage_collect(), + ?line Pib = process_info(self(),binary), + + ?line Test_Func(make_unaligned_sub_binary(Bin0)), + ?line Test_Func(make_unaligned_sub_binary(Bin1)), + ?line Test_Func(make_unaligned_sub_binary(Bin2)), + ?line Test_Func(make_unaligned_sub_binary(Bin3)), + + ?line Test_Func(make_sub_binary(lists:seq(42, 43))), + ?line Test_Func(make_sub_binary([42,43,44])), + ?line Test_Func(make_sub_binary([42,43,44,45])), + ?line Test_Func(make_sub_binary([42,43,44,45,46])), + ?line Test_Func(make_sub_binary([42,43,44,45,46,47])), + ?line Test_Func(make_sub_binary([42,43,44,45,46,47,48])), + ?line Test_Func(make_sub_binary(lists:seq(42, 49))), + ?line Test_Func(make_sub_binary(lists:seq(0, 14))), + ?line Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size))), + ?line Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size+1))), + ?line Test_Func(make_sub_binary(lists:seq(0, 255))), + + ?line Test_Func(make_unaligned_sub_binary(lists:seq(42, 43))), + ?line Test_Func(make_unaligned_sub_binary([42,43,44])), + ?line Test_Func(make_unaligned_sub_binary([42,43,44,45])), + ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46])), + ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47])), + ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47,48])), + ?line Test_Func(make_unaligned_sub_binary(lists:seq(42, 49))), + ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, 14))), + ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size))), + ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size+1))), + ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, 255))), + + %% Bit level binaries. + ?line Test_Func(<<1:1>>), + ?line Test_Func(<<2:2>>), + ?line Test_Func(<<42:10>>), + ?line Test_Func(list_to_bitstring([<<5:6>>|lists:seq(0, 255)])), + + ?line Test_Func(F = fun(A) -> 42*A end), + ?line Test_Func(lists:duplicate(32, F)), + + ?line Test_Func(FF = fun binary_SUITE:all/1), + ?line Test_Func(lists:duplicate(32, FF)), + + garbage_collect(), + ?line Pib0 = process_info(self(),binary), + ok. + +id(I) -> I. + +very_big_num() -> + very_big_num(33, 1). + +very_big_num(Left, Result) when Left > 0 -> + ?line very_big_num(Left-1, Result*256); +very_big_num(0, Result) -> + ?line Result. + +make_port() -> + ?line open_port({spawn, efile}, [eof]). + +make_pid() -> + ?line spawn_link(?MODULE, sleeper, []). + +sleeper() -> + ?line receive after infinity -> ok end. + +make_ext_pid() -> + {Pid, _, _} = get(externals), + Pid. + +make_ext_port() -> + {_, Port, _} = get(externals), + Port. +make_ext_ref() -> + {_, _, Ref} = get(externals), + Ref. + +init_externals() -> + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line {ok, Node} = test_server:start_node(plopp, slave, [{args, " -pa " ++ Pa}]), + ?line Res = case rpc:call(Node, ?MODULE, rpc_externals, []) of + {badrpc, {'EXIT', E}} -> + test_server:fail({rpcresult, E}); + R -> R + end, + ?line test_server:stop_node(Node), + put(externals, Res). + +rpc_externals() -> + {self(), make_port(), make_ref()}. + +make_sub_binary(Bin) when is_binary(Bin) -> + {_,B} = split_binary(list_to_binary([0,1,3,Bin]), 3), + B; +make_sub_binary(List) -> + make_sub_binary(list_to_binary(List)). + +make_unaligned_sub_binary(Bin0) when is_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin; +make_unaligned_sub_binary(List) -> + make_unaligned_sub_binary(list_to_binary(List)). %% Repeat test function with different combination of table options %% repeat_for_opts(F) -> - repeat_for_opts(F, [write_concurrency, read_concurrency]). + repeat_for_opts(F, [write_concurrency, read_concurrency, compressed]). repeat_for_opts(F, OptGenList) when is_atom(F) -> repeat_for_opts(fun(Opts) -> ?MODULE:F(Opts) end, OptGenList); +repeat_for_opts({F,Args}, OptGenList) when is_atom(F) -> + repeat_for_opts(fun(Opts) -> ?MODULE:F(Opts,Args) end, OptGenList); repeat_for_opts(F, OptGenList) -> repeat_for_opts(F, OptGenList, []). repeat_for_opts(F, [], Acc) -> - lists:map(fun(Opts) -> - io:format("Calling with options ~p\n",[Opts]), - F(Opts) - end, Acc); + lists:map(fun(Opts) -> + OptList = lists:filter(fun(E) -> E =/= void end, Opts), + io:format("Calling with options ~p\n",[OptList]), + F(OptList) + end, Acc); repeat_for_opts(F, [OptList | Tail], []) when is_list(OptList) -> repeat_for_opts(F, Tail, [[Opt] || Opt <- OptList]); repeat_for_opts(F, [OptList | Tail], AccList) when is_list(OptList) -> @@ -5466,6 +5737,9 @@ repeat_for_opts(F, [Atom | Tail], AccList) when is_atom(Atom) -> repeat_for_opts_atom2list(all_types) -> [set,ordered_set,bag,duplicate_bag]; repeat_for_opts_atom2list(write_concurrency) -> [{write_concurrency,false},{write_concurrency,true}]; -repeat_for_opts_atom2list(read_concurrency) -> [{read_concurrency,false},{read_concurrency,true}]. - +repeat_for_opts_atom2list(read_concurrency) -> [{read_concurrency,false},{read_concurrency,true}]; +repeat_for_opts_atom2list(compressed) -> [compressed,void]. +ets_new(Name, Opts) -> + %%ets:new(Name, [compressed | Opts]). + ets:new(Name, Opts). |