diff options
37 files changed, 1095 insertions, 798 deletions
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index ff919082c3..5b3f091ccc 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -471,6 +471,9 @@ static BMData *create_bmdata(MyAllocator *my, byte *x, Uint len, Binary **the_bin /* out */) { Uint datasize; + BMData *bmd; + Binary *mb; + byte *data; if(len > 1) { datasize = BM_SIZE_MULTI(len); @@ -478,9 +481,8 @@ static BMData *create_bmdata(MyAllocator *my, byte *x, Uint len, datasize = BM_SIZE_SINGLE(); } - BMData *bmd; - Binary *mb = erts_create_magic_binary(datasize,cleanup_my_data_bm); - byte *data = ERTS_MAGIC_BIN_DATA(mb); + mb = erts_create_magic_binary(datasize,cleanup_my_data_bm); + data = ERTS_MAGIC_BIN_DATA(mb); init_my_allocator(my, datasize, data); bmd = my_alloc(my, sizeof(BMData)); bmd->x = my_alloc(my,len); diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 1df972f4b6..3653c0bf7c 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -409,30 +409,17 @@ static void free_dbtable(void *vtb) { DbTable *tb = (DbTable *) vtb; -#ifdef HARDDEBUG - if (erts_atomic_read_nob(&tb->common.memory_size) != sizeof(DbTable)) { - erts_fprintf(stderr, "ets: free_dbtable memory remain=%ld fix=%x\n", - erts_atomic_read_nob(&tb->common.memory_size)-sizeof(DbTable), - tb->common.fixations); - } -#endif - if (erts_atomic_read_nob(&tb->common.memory_size) > sizeof(DbTable)) { - /* The CA tree implementation use delayed freeing and the DbTable needs to - be freed after all other memory blocks that are allocated by the table. */ - erts_schedule_thr_prgr_later_cleanup_op(free_dbtable, - (void *) tb, - &tb->release.data, - sizeof(DbTable)); - return; - } - erts_rwmtx_destroy(&tb->common.rwlock); - erts_mtx_destroy(&tb->common.fixlock); - ASSERT(is_immed(tb->common.heir_data)); - if (tb->common.btid) - erts_bin_release(tb->common.btid); + ASSERT(erts_atomic_read_nob(&tb->common.memory_size) == sizeof(DbTable)); + + erts_rwmtx_destroy(&tb->common.rwlock); + erts_mtx_destroy(&tb->common.fixlock); + ASSERT(is_immed(tb->common.heir_data)); + + if (tb->common.btid) + erts_bin_release(tb->common.btid); - erts_db_free(ERTS_ALC_T_DB_TABLE, tb, (void *) tb, sizeof(DbTable)); + erts_db_free(ERTS_ALC_T_DB_TABLE, tb, (void *) tb, sizeof(DbTable)); } static void schedule_free_dbtable(DbTable* tb) diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h index 45d120ac0e..7a915ccea2 100644 --- a/erts/emulator/beam/erl_db.h +++ b/erts/emulator/beam/erl_db.h @@ -286,6 +286,12 @@ ERTS_GLB_INLINE void erts_db_free(ErtsAlcType_t type, void *ptr, Uint size); +ERTS_GLB_INLINE void erts_schedule_db_free(DbTableCommon* tab, + void (*free_func)(void *), + void *ptr, + ErtsThrPrgrLaterOp *lop, + Uint size); + ERTS_GLB_INLINE void erts_db_free_nt(ErtsAlcType_t type, void *ptr, Uint size); @@ -306,6 +312,26 @@ erts_db_free(ErtsAlcType_t type, DbTable *tab, void *ptr, Uint size) } ERTS_GLB_INLINE void +erts_schedule_db_free(DbTableCommon* tab, + void (*free_func)(void *), + void *ptr, + ErtsThrPrgrLaterOp *lop, + Uint size) +{ + ASSERT(ptr != 0); + ASSERT(((void *) tab) != ptr); + ASSERT(size == ERTS_ALC_DBG_BLK_SZ(ptr)); + + /* + * We update table memory stats here as table may already be gone + * when 'free_func' is finally called. + */ + ERTS_DB_ALC_MEM_UPDATE_((DbTable*)tab, size, 0); + + erts_schedule_thr_prgr_later_cleanup_op(free_func, ptr, lop, size); +} + +ERTS_GLB_INLINE void erts_db_free_nt(ErtsAlcType_t type, void *ptr, Uint size) { ASSERT(ptr != 0); diff --git a/erts/emulator/beam/erl_db_catree.c b/erts/emulator/beam/erl_db_catree.c index 37a299df35..a8e48bce1b 100644 --- a/erts/emulator/beam/erl_db_catree.c +++ b/erts/emulator/beam/erl_db_catree.c @@ -210,33 +210,32 @@ DbTableMethod db_catree = * Internal CA tree related helper functions and macros */ -#define GET_ROUTE_NODE_KEY(node) (node->baseOrRoute.route.key.tpl[0]) -#define GET_BASE_NODE_LOCK(node) (&(node->baseOrRoute.base.lock)) -#define GET_ROUTE_NODE_LOCK(node) (&(node->baseOrRoute.route.lock)) +#define GET_ROUTE_NODE_KEY(node) (node->u.route.key.term) +#define GET_BASE_NODE_LOCK(node) (&(node->u.base.lock)) +#define GET_ROUTE_NODE_LOCK(node) (&(node->u.route.lock)) /* Helpers for reading and writing shared atomic variables */ /* No memory barrier */ #define GET_ROOT(tb) ((DbTableCATreeNode*)erts_atomic_read_nob(&(tb->root))) -#define GET_LEFT(ca_tree_route_node) ((DbTableCATreeNode*)erts_atomic_read_nob(&(ca_tree_route_node->baseOrRoute.route.left))) -#define GET_RIGHT(ca_tree_route_node) ((DbTableCATreeNode*)erts_atomic_read_nob(&(ca_tree_route_node->baseOrRoute.route.right))) +#define GET_LEFT(ca_tree_route_node) ((DbTableCATreeNode*)erts_atomic_read_nob(&(ca_tree_route_node->u.route.left))) +#define GET_RIGHT(ca_tree_route_node) ((DbTableCATreeNode*)erts_atomic_read_nob(&(ca_tree_route_node->u.route.right))) #define SET_ROOT(tb, v) erts_atomic_set_nob(&((tb)->root), (erts_aint_t)(v)) -#define SET_LEFT(ca_tree_route_node, v) erts_atomic_set_nob(&(ca_tree_route_node->baseOrRoute.route.left), (erts_aint_t)(v)); -#define SET_RIGHT(ca_tree_route_node, v) erts_atomic_set_nob(&(ca_tree_route_node->baseOrRoute.route.right), (erts_aint_t)(v)); +#define SET_LEFT(ca_tree_route_node, v) erts_atomic_set_nob(&(ca_tree_route_node->u.route.left), (erts_aint_t)(v)); +#define SET_RIGHT(ca_tree_route_node, v) erts_atomic_set_nob(&(ca_tree_route_node->u.route.right), (erts_aint_t)(v)); /* Release or acquire barriers */ #define GET_ROOT_ACQB(tb) ((DbTableCATreeNode*)erts_atomic_read_acqb(&(tb->root))) -#define GET_LEFT_ACQB(ca_tree_route_node) ((DbTableCATreeNode*)erts_atomic_read_acqb(&(ca_tree_route_node->baseOrRoute.route.left))) -#define GET_RIGHT_ACQB(ca_tree_route_node) ((DbTableCATreeNode*)erts_atomic_read_acqb(&(ca_tree_route_node->baseOrRoute.route.right))) +#define GET_LEFT_ACQB(ca_tree_route_node) ((DbTableCATreeNode*)erts_atomic_read_acqb(&(ca_tree_route_node->u.route.left))) +#define GET_RIGHT_ACQB(ca_tree_route_node) ((DbTableCATreeNode*)erts_atomic_read_acqb(&(ca_tree_route_node->u.route.right))) #define SET_ROOT_RELB(tb, v) erts_atomic_set_relb(&((tb)->root), (erts_aint_t)(v)) -#define SET_LEFT_RELB(ca_tree_route_node, v) erts_atomic_set_relb(&(ca_tree_route_node->baseOrRoute.route.left), (erts_aint_t)(v)); -#define SET_RIGHT_RELB(ca_tree_route_node, v) erts_atomic_set_relb(&(ca_tree_route_node->baseOrRoute.route.right), (erts_aint_t)(v)); +#define SET_LEFT_RELB(ca_tree_route_node, v) erts_atomic_set_relb(&(ca_tree_route_node->u.route.left), (erts_aint_t)(v)); +#define SET_RIGHT_RELB(ca_tree_route_node, v) erts_atomic_set_relb(&(ca_tree_route_node->u.route.right), (erts_aint_t)(v)); /* Compares a key to the key in a route node */ -static ERTS_INLINE Sint cmp_key_route(DbTableCommon * tb, - Eterm key, +static ERTS_INLINE Sint cmp_key_route(Eterm key, DbTableCATreeNode *obj) { return CMP(key, GET_ROUTE_NODE_KEY(obj)); @@ -279,7 +278,7 @@ int less_than_two_elements(TreeDbTerm *root) * Inserts a TreeDbTerm into a tree. Returns the new root. */ static ERTS_INLINE -TreeDbTerm* insert_TreeDbTerm(DbTableCommon *common_table_data, +TreeDbTerm* insert_TreeDbTerm(DbTableCATree *tb, TreeDbTerm *insert_to_root, TreeDbTerm *value_to_insert) { /* Non recursive insertion in AVL tree, building our own stack */ @@ -295,7 +294,7 @@ TreeDbTerm* insert_TreeDbTerm(DbTableCommon *common_table_data, int dir; TreeDbTerm *p1, *p2, *p; - key = GETKEY(common_table_data, value_to_insert->dbterm.tpl); + key = GETKEY(tb, value_to_insert->dbterm.tpl); dstack[dpos++] = DIR_END; for (;;) @@ -305,7 +304,7 @@ TreeDbTerm* insert_TreeDbTerm(DbTableCommon *common_table_data, (*this)->balance = 0; (*this)->left = (*this)->right = NULL; break; - } else if ((c = cmp_key(common_table_data, key, *this)) < 0) { + } else if ((c = cmp_key(&tb->common, key, *this)) < 0) { /* go lefts */ dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; @@ -392,7 +391,7 @@ TreeDbTerm* insert_TreeDbTerm(DbTableCommon *common_table_data, * left_wb and the tree containing the rest of the keys in the write * back parameter right_wb. */ -static void split_tree(DbTableCommon *tb, +static void split_tree(DbTableCATree *tb, TreeDbTerm *root, TreeDbTerm **split_key_node_wb, TreeDbTerm **left_wb, @@ -413,9 +412,7 @@ static void split_tree(DbTableCommon *tb, split_node->left = NULL; right_root = split_node->right; split_node->right = NULL; - right_root = insert_TreeDbTerm(tb, - right_root, - split_node); + right_root = insert_TreeDbTerm(tb, right_root, split_node); *split_key_node_wb = split_node; *left_wb = left_root; *right_wb = right_root; @@ -700,15 +697,17 @@ void runlock_base_node(DbTableCATreeBaseNode *base_node) } static ERTS_INLINE -void lock_route_node(DbTableCATreeRouteNode *route_node) +void lock_route_node(DbTableCATreeNode *route_node) { - erts_mtx_lock(&route_node->lock); + ASSERT(!route_node->is_base_node); + erts_mtx_lock(&route_node->u.route.lock); } static ERTS_INLINE -void unlock_route_node(DbTableCATreeRouteNode *route_node) +void unlock_route_node(DbTableCATreeNode *route_node) { - erts_mtx_unlock(&route_node->lock); + ASSERT(!route_node->is_base_node); + erts_mtx_unlock(&route_node->u.route.lock); } @@ -722,7 +721,6 @@ void unlock_route_node(DbTableCATreeRouteNode *route_node) int retry; \ DbTableCATreeNode *current_node; \ DbTableCATreeNode *prev_node; \ - DbTableCommon* common_table_data = &tb->common; \ DbTableCATreeBaseNode *base_node; \ int current_level; \ (void)prev_node; \ @@ -734,13 +732,13 @@ void unlock_route_node(DbTableCATreeRouteNode *route_node) while ( ! current_node->is_base_node ) { \ current_level = current_level + 1; \ prev_node = current_node; \ - if (cmp_key_route(common_table_data,key,current_node) < 0) { \ + if (cmp_key_route(key,current_node) < 0) { \ current_node = GET_LEFT_ACQB(current_node); \ } else { \ current_node = GET_RIGHT_ACQB(current_node); \ } \ } \ - base_node = ¤t_node->baseOrRoute.base; \ + base_node = ¤t_node->u.base; \ LOCK(base_node); \ if ( ! base_node->is_valid ) { \ /* Retry */ \ @@ -753,7 +751,7 @@ void unlock_route_node(DbTableCATreeRouteNode *route_node) #define ERL_DB_CATREE_CREATE_DO_OPERATION_FUNCTION_ADAPT_AND_UNLOCK_PART \ if (base_node->lock_statistics > ERL_DB_CATREE_HIGH_CONTENTION_LIMIT \ && current_level < ERL_DB_CATREE_MAX_ROUTE_NODE_LAYER_HEIGHT) { \ - split_catree(&tb->common, prev_node, current_node); \ + split_catree(tb, prev_node, current_node); \ } else if (base_node->lock_statistics < ERL_DB_CATREE_LOW_CONTENTION_LIMIT) { \ join_catree(tb, prev_node, current_node); \ } else { \ @@ -784,141 +782,189 @@ void unlock_route_node(DbTableCATreeRouteNode *route_node) } +static ERTS_INLINE +void copy_route_key(DbRouteKey* dst, Eterm key, Uint key_size) +{ + dst->size = key_size; + if (key_size != 0) { + Eterm* hp = &dst->heap[0]; + ErlOffHeap tmp_offheap; + tmp_offheap.first = NULL; + dst->term = copy_struct(key, key_size, &hp, &tmp_offheap); + dst->oh = tmp_offheap.first; + } + else { + ASSERT(is_immed(key)); + dst->term = key; + dst->oh = NULL; + } +} -static DbTableCATreeNode *create_catree_base_node(DbTableCATree *tb) +static ERTS_INLINE +void destroy_route_key(DbRouteKey* key) { - DbTableCATreeNode *new_base_node_container = - erts_db_alloc(ERTS_ALC_T_DB_TABLE, - (DbTable *) tb, - sizeof(DbTableCATreeNode)); - DbTableCATreeBaseNode *new_base_node = - &new_base_node_container->baseOrRoute.base; + if (key->oh) { + ErlOffHeap oh; + oh.first = key->oh; + erts_cleanup_offheap(&oh); + } +} + + +#ifdef ERTS_ENABLE_LOCK_CHECK +# define sizeof_base_node(KEY_SZ) \ + (offsetof(DbTableCATreeNode, u.base.lc_key.heap) \ + + (KEY_SZ)*sizeof(Eterm)) +# define LC_ORDER(ORDER) ORDER +#else +# define sizeof_base_node(KEY_SZ) \ + offsetof(DbTableCATreeNode, u.base.end_of_struct__) +# define LC_ORDER(ORDER) NIL +#endif + +static DbTableCATreeNode *create_base_node(DbTableCATree *tb, + TreeDbTerm* root, + Eterm lc_key) +{ + DbTableCATreeNode *p; erts_rwmtx_opt_t rwmtx_opt = ERTS_RWMTX_OPT_DEFAULT_INITER; - new_base_node_container->is_base_node = 1; - new_base_node->root = NULL; +#ifdef ERTS_ENABLE_LOCK_CHECK + Eterm lc_key_size = size_object(lc_key); +#endif + p = erts_db_alloc(ERTS_ALC_T_DB_TABLE, (DbTable *) tb, + sizeof_base_node(lc_key_size)); + + p->is_base_node = 1; + p->u.base.root = root; if (tb->common.type & DB_FREQ_READ) rwmtx_opt.type = ERTS_RWMTX_TYPE_FREQUENT_READ; if (erts_ets_rwmtx_spin_count >= 0) rwmtx_opt.main_spincount = erts_ets_rwmtx_spin_count; - erts_rwmtx_init_opt(&new_base_node->lock, &rwmtx_opt, - "erl_db_catree_base_node", tb->common.the_name, ERTS_LOCK_FLAGS_CATEGORY_DB); - new_base_node->lock_statistics = 0; - new_base_node->is_valid = 1; - new_base_node->tab = (DbTable *) tb; - return new_base_node_container; + +#ifdef ERTS_ENABLE_LOCK_CHECK + copy_route_key(&p->u.base.lc_key, lc_key, lc_key_size); +#endif + erts_rwmtx_init_opt(&p->u.base.lock, &rwmtx_opt, + "erl_db_catree_base_node", + lc_key, + ERTS_LOCK_FLAGS_CATEGORY_DB); + p->u.base.lock_statistics = 0; + p->u.base.is_valid = 1; + return p; +} + +static ERTS_INLINE +DbTableCATreeNode *create_wlocked_base_node(DbTableCATree *tb, + TreeDbTerm* root, + Eterm lc_key) +{ + DbTableCATreeNode* p = create_base_node(tb, root, lc_key); + ethr_rwmutex_rwlock(&p->u.base.lock.rwmtx); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_trylock_flg(-1, &p->u.base.lock.lc, ERTS_LOCK_OPTIONS_RDWR); +#endif + return p; +} + + +static ERTS_INLINE Uint sizeof_route_node(Uint key_size) +{ + return (offsetof(DbTableCATreeNode, u.route.key.heap) + + key_size*sizeof(Eterm)); } static DbTableCATreeNode* -create_catree_route_node(DbTableCommon * common_table_data, - DbTableCATreeNode *left, - DbTableCATreeNode *right, - DbTerm * keyTerm) +create_route_node(DbTableCATree *tb, + DbTableCATreeNode *left, + DbTableCATreeNode *right, + DbTerm * keyTerm, + DbTableCATreeNode* lc_parent) { - Eterm* top; - Eterm key = GETKEY(common_table_data,keyTerm->tpl); + Eterm key = GETKEY(tb,keyTerm->tpl); int key_size = size_object(key); - Uint offset = offsetof(DbTableCATreeNode,baseOrRoute) + - offsetof(DbTableCATreeRouteNode,key); - size_t route_node_container_size = - offset + - sizeof(DbTerm) + - sizeof(Eterm)*key_size; - ErlOffHeap tmp_offheap; - byte* new_route_node_container_bytes = - erts_db_alloc(ERTS_ALC_T_DB_TABLE, - (DbTable *) common_table_data, - route_node_container_size); - DbTerm* newp = (DbTerm*) (new_route_node_container_bytes + offset); - DbTableCATreeNode *new_route_node_container = - (DbTableCATreeNode*)new_route_node_container_bytes; - DbTableCATreeRouteNode *new_route_node = - &new_route_node_container->baseOrRoute.route; - new_route_node->tab = (DbTable *)common_table_data; - if (key_size != 0) { - newp->size = key_size; - top = &newp->tpl[1]; - tmp_offheap.first = NULL; - newp->tpl[0] = copy_struct(key, key_size, &top, &tmp_offheap); - newp->first_oh = tmp_offheap.first; - } else { - newp->size = key_size; - newp->first_oh = NULL; - newp->tpl[0] = key; - } - new_route_node_container->is_base_node = 0; - new_route_node->is_valid = 1; - erts_atomic_init_nob(&(new_route_node->left), (erts_aint_t)left); - erts_atomic_init_nob(&(new_route_node->right), (erts_aint_t)right); - erts_mtx_init(&new_route_node->lock, "erl_db_catree_route_node", - NIL, ERTS_LOCK_FLAGS_CATEGORY_DB); - return new_route_node_container; + DbTableCATreeNode* p = erts_db_alloc(ERTS_ALC_T_DB_TABLE, + (DbTable *) tb, + sizeof_route_node(key_size)); + + copy_route_key(&p->u.route.key, key, key_size); + p->is_base_node = 0; + p->u.route.is_valid = 1; + erts_atomic_init_nob(&p->u.route.left, (erts_aint_t)left); + erts_atomic_init_nob(&p->u.route.right, (erts_aint_t)right); +#ifdef ERTS_ENABLE_LOCK_CHECK + /* Route node lock order is inverse tree depth (from leafs toward root) */ + p->u.route.lc_order = (lc_parent == NULL ? MAX_SMALL : + lc_parent->u.route.lc_order - 1); + /* + * This assert may eventually fail as we don't increase 'lc_order' in join + * operations when route nodes move up in the tree. + * Tough luck if you run a lock-checking VM for such a long time on 32-bit. + */ + ERTS_LC_ASSERT(p->u.route.lc_order >= 0); +#endif + erts_mtx_init(&p->u.route.lock, "erl_db_catree_route_node", + LC_ORDER(make_small(p->u.route.lc_order)), + ERTS_LOCK_FLAGS_CATEGORY_DB); + return p; } -static void free_catree_base_node(void* base_node_container_ptr) +static void do_free_base_node(void* vptr) { - DbTableCATreeNode *base_node_container = - (DbTableCATreeNode *)base_node_container_ptr; - DbTableCATreeBaseNode *base_node = - &base_node_container->baseOrRoute.base; - erts_rwmtx_destroy(&base_node->lock); - erts_db_free(ERTS_ALC_T_DB_TABLE, - base_node->tab, base_node_container, - sizeof(DbTableCATreeNode)); -} - -static void free_catree_routing_node(void *route_node_container_ptr) -{ - size_t route_node_container_size; - byte* route_node_container_bytes = route_node_container_ptr; - DbTableCATreeNode *route_node_container = - (DbTableCATreeNode *)route_node_container_bytes; - DbTableCATreeRouteNode *route_node = - &route_node_container->baseOrRoute.route; - int key_size = route_node->key.size; - Uint offset = offsetof(DbTableCATreeNode,baseOrRoute) + - offsetof(DbTableCATreeRouteNode,key); - ErlOffHeap tmp_oh; - DbTerm* db_term = (DbTerm*) (route_node_container_bytes + offset); - erts_mtx_destroy(&route_node->lock); - route_node_container_size = - offset + - sizeof(DbTerm) + - sizeof(Eterm)*key_size; - if (key_size != 0) { - tmp_oh.first = db_term->first_oh; - erts_cleanup_offheap(&tmp_oh); - } - erts_db_free(ERTS_ALC_T_DB_TABLE, - route_node->tab, - route_node_container, - route_node_container_size); + DbTableCATreeNode *p = (DbTableCATreeNode *)vptr; + ASSERT(p->is_base_node); + erts_rwmtx_destroy(&p->u.base.lock); +#ifdef ERTS_ENABLE_LOCK_CHECK + destroy_route_key(&p->u.base.lc_key); +#endif + erts_free(ERTS_ALC_T_DB_TABLE, p); +} + +static void free_catree_base_node(DbTableCATree* tb, DbTableCATreeNode* p) +{ + ASSERT(p->is_base_node); + ERTS_DB_ALC_MEM_UPDATE_(tb, sizeof_base_node(p->u.base.lc_key.size), 0); + do_free_base_node(p); +} + +static void do_free_route_node(void *vptr) +{ + DbTableCATreeNode *p = (DbTableCATreeNode *)vptr; + ASSERT(!p->is_base_node); + erts_mtx_destroy(&p->u.route.lock); + destroy_route_key(&p->u.route.key); + erts_free(ERTS_ALC_T_DB_TABLE, p); } +static void free_catree_route_node(DbTableCATree* tb, DbTableCATreeNode* p) +{ + ASSERT(!p->is_base_node); + ERTS_DB_ALC_MEM_UPDATE_(tb, sizeof_route_node(p->u.route.key.size), 0); + do_free_route_node(p); +} + + /* * Returns the parent routing node of the specified - * route_node_container if such a routing node exists or NULL if - * route_node_container is attached to the root + * route node 'child' if such a parent exists + * or NULL if 'child' is attached to the root. */ static ERTS_INLINE DbTableCATreeNode * parent_of(DbTableCATree *tb, - DbTableCATreeNode *route_node_container) + DbTableCATreeNode *child) { + Eterm key = GET_ROUTE_NODE_KEY(child); + DbTableCATreeNode *current = GET_ROOT_ACQB(tb); + DbTableCATreeNode *prev = NULL; - Eterm key = GET_ROUTE_NODE_KEY(route_node_container); - DbTableCATreeNode *current_node = GET_ROOT_ACQB(tb); - DbTableCATreeNode *prev_node = NULL; - if (current_node == route_node_container) { - return NULL; - } - while (current_node != route_node_container) { - prev_node = current_node; - if (cmp_key_route((DbTableCommon *)tb, key, current_node) < 0) { - current_node = GET_LEFT_ACQB(current_node); + while (current != child) { + prev = current; + if (cmp_key_route(key, current) < 0) { + current = GET_LEFT_ACQB(current); } else { - current_node = GET_RIGHT_ACQB(current_node); + current = GET_RIGHT_ACQB(current); } } - return prev_node; + return prev; } @@ -953,11 +999,7 @@ leftmost_route_node(DbTableCATreeNode *root) prev_node = node; node = GET_LEFT_ACQB(node); } - if (prev_node == NULL) { - return NULL; - } else { - return prev_node; - } + return prev_node; } static ERTS_INLINE DbTableCATreeNode* @@ -969,11 +1011,7 @@ rightmost_route_node(DbTableCATreeNode *root) prev_node = node; node = GET_RIGHT_ACQB(node); } - if (prev_node == NULL) { - return NULL; - } else { - return prev_node; - } + return prev_node; } static ERTS_INLINE DbTableCATreeNode* @@ -988,8 +1026,7 @@ leftmost_base_node_and_path(DbTableCATreeNode *root, CATreeNodeStack * stack) } static ERTS_INLINE DbTableCATreeNode* -get_next_base_node_and_path(DbTableCommon *common_table_data, - DbTableCATreeNode *base_node, +get_next_base_node_and_path(DbTableCATreeNode *base_node, CATreeNodeStack *stack) { if (EMPTY_NODE(stack)) { /* The parent of b is the root */ @@ -1001,11 +1038,11 @@ get_next_base_node_and_path(DbTableCommon *common_table_data, stack); } else { Eterm pkey = - TOP_NODE(stack)->baseOrRoute.route.key.tpl[0]; /* pKey = key of parent */ + TOP_NODE(stack)->u.route.key.term; /* pKey = key of parent */ POP_NODE(stack); while (!EMPTY_NODE(stack)) { - if (TOP_NODE(stack)->baseOrRoute.route.is_valid && - cmp_key_route(common_table_data, pkey, TOP_NODE(stack)) <= 0) { + if (TOP_NODE(stack)->u.route.is_valid && + cmp_key_route(pkey, TOP_NODE(stack)) <= 0) { return leftmost_base_node_and_path(GET_RIGHT_ACQB(TOP_NODE(stack)), stack); } else { POP_NODE(stack); @@ -1034,25 +1071,23 @@ lock_first_base_node(DbTable *tbl, CATreeNodeStack *search_stack_ptr, CATreeNodeStack *locked_base_nodes_stack_ptr) { - int retry; DbTableCATreeNode *current_node; DbTableCATreeBaseNode *base_node; DbTableCATree* tb = &tbl->catree; - do { - retry = 0; + while (1) { current_node = GET_ROOT_ACQB(tb); while ( ! current_node->is_base_node ) { PUSH_NODE(search_stack_ptr, current_node); current_node = GET_LEFT_ACQB(current_node); } - base_node = ¤t_node->baseOrRoute.base; + base_node = ¤t_node->u.base; rlock_base_node(base_node); - if ( ! base_node->is_valid ) { - /* Retry */ - runlock_base_node(base_node); - retry = 1; - } - } while(retry); + if (base_node->is_valid) + break; + /* Retry */ + runlock_base_node(base_node); + search_stack_ptr->pos = 0; + } push_node_dyn_array(tbl, locked_base_nodes_stack_ptr, current_node); return current_node; } @@ -1066,19 +1101,20 @@ find_and_lock_next_base_node_and_path(DbTable *tbl, DbTableCATreeNode *current_node; DbTableCATreeBaseNode *base_node; CATreeNodeStack * tmp_stack_ptr; - DbTableCommon* common_table_data; - retry_find_and_lock_next_base_node: - current_node = TOP_NODE(locked_base_nodes_stack_ptr); - common_table_data = &tbl->common; - clone_stack(*search_stack_ptr_ptr, *search_stack_copy_ptr_ptr); - current_node = - get_next_base_node_and_path(common_table_data, current_node, *search_stack_ptr_ptr); - if (current_node == NULL) { - return NULL; - } - base_node = ¤t_node->baseOrRoute.base; - rlock_base_node(base_node); - if ( ! base_node->is_valid ) { + + while (1) { + current_node = TOP_NODE(locked_base_nodes_stack_ptr); + clone_stack(*search_stack_ptr_ptr, *search_stack_copy_ptr_ptr); + current_node = + get_next_base_node_and_path(current_node, *search_stack_ptr_ptr); + if (current_node == NULL) { + return NULL; + } + base_node = ¤t_node->u.base; + rlock_base_node(base_node); + if (base_node->is_valid) + break; + /* Retry */ runlock_base_node(base_node); /* Revert to previous state */ @@ -1086,10 +1122,9 @@ find_and_lock_next_base_node_and_path(DbTable *tbl, tmp_stack_ptr = *search_stack_ptr_ptr; *search_stack_ptr_ptr = *search_stack_copy_ptr_ptr; *search_stack_copy_ptr_ptr = tmp_stack_ptr; - goto retry_find_and_lock_next_base_node; - } else { - push_node_dyn_array(tbl, locked_base_nodes_stack_ptr, current_node); } + + push_node_dyn_array(tbl, locked_base_nodes_stack_ptr, current_node); return base_node; } @@ -1102,7 +1137,7 @@ void unlock_and_release_locked_base_node_stack(DbTable *tbl, int i; for (i = 0; i < locked_base_nodes_stack_ptr->pos; i++) { current_node = locked_base_nodes_stack_ptr->array[i]; - base_node = ¤t_node->baseOrRoute.base; + base_node = ¤t_node->u.base; if (locked_base_nodes_stack_ptr->pos > 1) { base_node->lock_statistics = /* This is not atomic which is fine as */ base_node->lock_statistics + /* correctness does not depend on that. */ @@ -1166,19 +1201,18 @@ lock_base_node_with_key(DbTable *tbl, DbTableCATreeNode *current_node; DbTableCATreeBaseNode *base_node; DbTableCATree* tb = &tbl->catree; - DbTableCommon* common_table_data = &tbl->common; do { retry = 0; current_node = GET_ROOT_ACQB(tb); while ( ! current_node->is_base_node ) { PUSH_NODE(search_stack_ptr, current_node); - if( cmp_key_route(common_table_data,key,current_node) < 0 ) { + if( cmp_key_route(key,current_node) < 0 ) { current_node = GET_LEFT_ACQB(current_node); } else { current_node = GET_RIGHT_ACQB(current_node); } } - base_node = ¤t_node->baseOrRoute.base; + base_node = ¤t_node->u.base; rlock_base_node(base_node); if ( ! base_node->is_valid ) { /* Retry */ @@ -1196,100 +1230,90 @@ lock_base_node_with_key(DbTable *tbl, * node to join with. */ static DbTableCATreeNode* -erl_db_catree_force_join_right(DbTableCommon *common_table_data, - DbTableCATreeNode *parent_container, - DbTableCATreeNode *base_container, +erl_db_catree_force_join_right(DbTableCATree *tb, + DbTableCATreeNode *parent, + DbTableCATreeNode *thiz, DbTableCATreeNode **result_parent_wb) { - DbTableCATreeRouteNode *parent; - DbTableCATreeNode *gparent_container; - DbTableCATreeRouteNode *gparent; - DbTableCATreeBaseNode *base = &base_container->baseOrRoute.base; - DbTableCATree *tb = (DbTableCATree *)common_table_data; - DbTableCATreeNode *neighbor_base_container; - DbTableCATreeBaseNode *neighbor_base; - DbTableCATreeNode *new_neighbor_base; - DbTableCATreeNode *neighbor_base_parent; - int neighbour_not_valid; - if (parent_container == NULL) { + DbTableCATreeNode *gparent; + DbTableCATreeNode *neighbor; + DbTableCATreeNode *new_neighbor; + DbTableCATreeNode *neighbor_parent; + TreeDbTerm* new_root; + + if (parent == NULL) { return NULL; } - parent = &parent_container->baseOrRoute.route; - do { - neighbor_base_container = leftmost_base_node(GET_RIGHT_ACQB(parent_container)); - neighbor_base = &neighbor_base_container->baseOrRoute.base; - wlock_base_node_no_stats(neighbor_base); - neighbour_not_valid = !neighbor_base->is_valid; - if (neighbour_not_valid) { - wunlock_base_node(neighbor_base); - } - } while (neighbour_not_valid); + ASSERT(thiz == GET_LEFT(parent)); + while (1) { + neighbor = leftmost_base_node(GET_RIGHT_ACQB(parent)); + wlock_base_node_no_stats(&neighbor->u.base); + if (neighbor->u.base.is_valid) + break; + wunlock_base_node(&neighbor->u.base); + } lock_route_node(parent); - parent->is_valid = 0; - neighbor_base->is_valid = 0; - base->is_valid = 0; - gparent = NULL; - gparent_container = NULL; - do { - if (gparent != NULL) { - unlock_route_node(gparent); - } - gparent_container = parent_of(tb, parent_container); - if (gparent_container != NULL) { - gparent = &gparent_container->baseOrRoute.route; - lock_route_node(gparent); - } else { - gparent = NULL; - } - } while (gparent != NULL && !gparent->is_valid); + parent->u.route.is_valid = 0; + neighbor->u.base.is_valid = 0; + thiz->u.base.is_valid = 0; + while (1) { + gparent = parent_of(tb, parent); + if (gparent == NULL) + break; + lock_route_node(gparent); + if (gparent->u.route.is_valid) + break; + unlock_route_node(gparent); + } if (gparent == NULL) { - SET_ROOT_RELB(tb, GET_RIGHT(parent_container)); - } else if (GET_LEFT(gparent_container) == parent_container) { - SET_LEFT_RELB(gparent_container, GET_RIGHT(parent_container)); + SET_ROOT_RELB(tb, GET_RIGHT(parent)); + } else if (GET_LEFT(gparent) == parent) { + SET_LEFT_RELB(gparent, GET_RIGHT(parent)); } else { - SET_RIGHT_RELB(gparent_container, GET_RIGHT(parent_container)); + SET_RIGHT_RELB(gparent, GET_RIGHT(parent)); } unlock_route_node(parent); if (gparent != NULL) { unlock_route_node(gparent); } - new_neighbor_base = create_catree_base_node(tb); - new_neighbor_base->baseOrRoute.base.root = - join_trees(base->root, neighbor_base->root); - wlock_base_node_no_stats(&(new_neighbor_base->baseOrRoute.base)); - neighbor_base_parent = NULL; - if (GET_RIGHT(parent_container) == neighbor_base_container) { - neighbor_base_parent = gparent_container; + + new_root = join_trees(thiz->u.base.root, neighbor->u.base.root); + new_neighbor = create_wlocked_base_node(tb, new_root, + LC_ORDER(thiz->u.base.lc_key.term)); + + if (GET_RIGHT(parent) == neighbor) { + neighbor_parent = gparent; } else { - neighbor_base_parent = - leftmost_route_node(GET_RIGHT(parent_container)); + neighbor_parent = leftmost_route_node(GET_RIGHT(parent)); } - if(neighbor_base_parent == NULL) { - SET_ROOT_RELB(tb, new_neighbor_base); - } else if (GET_LEFT(neighbor_base_parent) == neighbor_base_container) { - SET_LEFT_RELB(neighbor_base_parent, new_neighbor_base); + if(neighbor_parent == NULL) { + SET_ROOT_RELB(tb, new_neighbor); + } else if (GET_LEFT(neighbor_parent) == neighbor) { + SET_LEFT_RELB(neighbor_parent, new_neighbor); } else { - SET_RIGHT_RELB(neighbor_base_parent, new_neighbor_base); + SET_RIGHT_RELB(neighbor_parent, new_neighbor); } - wunlock_base_node(base); - wunlock_base_node(neighbor_base); + wunlock_base_node(&thiz->u.base); + wunlock_base_node(&neighbor->u.base); /* Free the parent and base */ - erts_schedule_thr_prgr_later_op(free_catree_routing_node, - parent_container, - &parent->free_item); - erts_schedule_thr_prgr_later_op(free_catree_base_node, - base_container, - &base->free_item); - erts_schedule_thr_prgr_later_op(free_catree_base_node, - neighbor_base_container, - &neighbor_base->free_item); - - if (parent_container == neighbor_base_container) { - *result_parent_wb = gparent_container; - } else { - *result_parent_wb = neighbor_base_parent; - } - return new_neighbor_base; + erts_schedule_db_free(&tb->common, + do_free_route_node, + parent, + &parent->u.route.free_item, + sizeof_route_node(parent->u.route.key.size)); + erts_schedule_db_free(&tb->common, + do_free_base_node, + thiz, + &thiz->u.base.free_item, + sizeof_base_node(thiz->u.base.lc_key.size)); + erts_schedule_db_free(&tb->common, + do_free_base_node, + neighbor, + &neighbor->u.base.free_item, + sizeof_base_node(neighbor->u.base.lc_key.size)); + + *result_parent_wb = neighbor_parent; + return new_neighbor; } /* @@ -1298,243 +1322,232 @@ erl_db_catree_force_join_right(DbTableCommon *common_table_data, * locked state. */ static DbTableCATreeNode * -merge_to_one_locked_base_node(DbTableCommon * common_table_data) +merge_to_one_locked_base_node(DbTableCATree* tb) { - DbTableCATreeNode *parent_container; - DbTableCATreeNode *new_parent_container; - DbTableCATree *tb = (DbTableCATree *)common_table_data; - DbTableCATreeNode *base_container; - DbTableCATreeNode *new_base_container; + DbTableCATreeNode *parent; + DbTableCATreeNode *new_parent; + DbTableCATreeNode *base; + DbTableCATreeNode *new_base; int is_not_valid; /* Find first base node */ do { - parent_container = NULL; - base_container = GET_ROOT_ACQB(tb); - while ( ! base_container->is_base_node ) { - parent_container = base_container; - base_container = GET_LEFT_ACQB(base_container); + parent = NULL; + base = GET_ROOT_ACQB(tb); + while ( ! base->is_base_node ) { + parent = base; + base = GET_LEFT_ACQB(base); } - wlock_base_node_no_stats(&(base_container->baseOrRoute.base)); - is_not_valid = ! base_container->baseOrRoute.base.is_valid; + wlock_base_node_no_stats(&(base->u.base)); + is_not_valid = ! base->u.base.is_valid; if (is_not_valid) { - wunlock_base_node(&(base_container->baseOrRoute.base)); + wunlock_base_node(&(base->u.base)); } } while(is_not_valid); do { - new_base_container = erl_db_catree_force_join_right(common_table_data, - parent_container, - base_container, - &new_parent_container); - if (new_base_container != NULL) { - base_container = new_base_container; - parent_container = new_parent_container; + new_base = erl_db_catree_force_join_right(tb, + parent, + base, + &new_parent); + if (new_base != NULL) { + base = new_base; + parent = new_parent; } - } while(new_base_container != NULL); - return base_container; + } while(new_base != NULL); + return base; } static void join_catree(DbTableCATree *tb, - DbTableCATreeNode *parent_container, - DbTableCATreeNode *base_container) -{ - DbTableCATreeRouteNode *parent; - DbTableCATreeNode *gparent_container; - DbTableCATreeRouteNode *gparent; - DbTableCATreeBaseNode *base = &base_container->baseOrRoute.base; - DbTableCATreeNode *neighbor_base_container; - DbTableCATreeBaseNode *neighbor_base; - DbTableCATreeNode *new_neighbor_base; - DbTableCATreeNode *neighbor_base_parent; - if (parent_container == NULL) { - base->lock_statistics = 0; - wunlock_base_node(base); + DbTableCATreeNode *parent, + DbTableCATreeNode *thiz) +{ + DbTableCATreeNode *gparent; + DbTableCATreeNode *neighbor; + DbTableCATreeNode *new_neighbor; + DbTableCATreeNode *neighbor_parent; + + ASSERT(thiz->is_base_node); + if (parent == NULL) { + thiz->u.base.lock_statistics = 0; + wunlock_base_node(&thiz->u.base); return; } - parent = &parent_container->baseOrRoute.route; - if (GET_LEFT(parent_container) == base_container) { - neighbor_base_container = leftmost_base_node(GET_RIGHT_ACQB(parent_container)); - neighbor_base = &neighbor_base_container->baseOrRoute.base; - if (try_wlock_base_node(neighbor_base)) { + ASSERT(!parent->is_base_node); + if (GET_LEFT(parent) == thiz) { + neighbor = leftmost_base_node(GET_RIGHT_ACQB(parent)); + if (try_wlock_base_node(&neighbor->u.base)) { /* Failed to acquire lock */ - base->lock_statistics = 0; - wunlock_base_node(base); + thiz->u.base.lock_statistics = 0; + wunlock_base_node(&thiz->u.base); return; - } else if (!neighbor_base->is_valid) { - base->lock_statistics = 0; - wunlock_base_node(base); - wunlock_base_node(neighbor_base); + } else if (!neighbor->u.base.is_valid) { + thiz->u.base.lock_statistics = 0; + wunlock_base_node(&thiz->u.base); + wunlock_base_node(&neighbor->u.base); return; } else { lock_route_node(parent); - parent->is_valid = 0; - neighbor_base->is_valid = 0; - base->is_valid = 0; + parent->u.route.is_valid = 0; + neighbor->u.base.is_valid = 0; + thiz->u.base.is_valid = 0; gparent = NULL; - gparent_container = NULL; do { if (gparent != NULL) { unlock_route_node(gparent); } - gparent_container = parent_of(tb, parent_container); - if (gparent_container != NULL) { - gparent = &gparent_container->baseOrRoute.route; + gparent = parent_of(tb, parent); + if (gparent != NULL) lock_route_node(gparent); - } else { - gparent = NULL; - } - } while (gparent != NULL && !gparent->is_valid); + } while (gparent != NULL && !gparent->u.route.is_valid); + if (gparent == NULL) { - SET_ROOT_RELB(tb, GET_RIGHT(parent_container)); - } else if (GET_LEFT(gparent_container) == parent_container) { - SET_LEFT_RELB(gparent_container, GET_RIGHT(parent_container)); + SET_ROOT_RELB(tb, GET_RIGHT(parent)); + } else if (GET_LEFT(gparent) == parent) { + SET_LEFT_RELB(gparent, GET_RIGHT(parent)); } else { - SET_RIGHT_RELB(gparent_container, GET_RIGHT(parent_container)); + SET_RIGHT_RELB(gparent, GET_RIGHT(parent)); } unlock_route_node(parent); if (gparent != NULL) { unlock_route_node(gparent); } - new_neighbor_base = create_catree_base_node(tb); - new_neighbor_base->baseOrRoute.base.root = - join_trees(base->root, neighbor_base->root); - neighbor_base_parent = NULL; - if (GET_RIGHT(parent_container) == neighbor_base_container) { - neighbor_base_parent = gparent_container; + { + TreeDbTerm* new_root = join_trees(thiz->u.base.root, + neighbor->u.base.root); + new_neighbor = create_base_node(tb, new_root, + LC_ORDER(thiz->u.base.lc_key.term)); + } + if (GET_RIGHT(parent) == neighbor) { + neighbor_parent = gparent; } else { - neighbor_base_parent = - leftmost_route_node(GET_RIGHT(parent_container)); + neighbor_parent = leftmost_route_node(GET_RIGHT(parent)); } } } else { /* Symetric case */ - neighbor_base_container = rightmost_base_node(GET_LEFT_ACQB(parent_container)); - neighbor_base = &neighbor_base_container->baseOrRoute.base; - if (try_wlock_base_node(neighbor_base)) { + ASSERT(GET_RIGHT(parent) == thiz); + neighbor = rightmost_base_node(GET_LEFT_ACQB(parent)); + if (try_wlock_base_node(&neighbor->u.base)) { /* Failed to acquire lock */ - base->lock_statistics = 0; - wunlock_base_node(base); + thiz->u.base.lock_statistics = 0; + wunlock_base_node(&thiz->u.base); return; - } else if (!neighbor_base->is_valid) { - base->lock_statistics = 0; - wunlock_base_node(base); - wunlock_base_node(neighbor_base); + } else if (!neighbor->u.base.is_valid) { + thiz->u.base.lock_statistics = 0; + wunlock_base_node(&thiz->u.base); + wunlock_base_node(&neighbor->u.base); return; } else { lock_route_node(parent); - parent->is_valid = 0; - neighbor_base->is_valid = 0; - base->is_valid = 0; + parent->u.route.is_valid = 0; + neighbor->u.base.is_valid = 0; + thiz->u.base.is_valid = 0; gparent = NULL; - gparent_container = NULL; do { if (gparent != NULL) { unlock_route_node(gparent); } - gparent_container = parent_of(tb, parent_container); - if (gparent_container != NULL) { - gparent = &gparent_container->baseOrRoute.route; + gparent = parent_of(tb, parent); + if (gparent != NULL) { lock_route_node(gparent); } else { gparent = NULL; } - } while (gparent != NULL && !gparent->is_valid); + } while (gparent != NULL && !gparent->u.route.is_valid); if (gparent == NULL) { - SET_ROOT_RELB(tb, GET_LEFT(parent_container)); - } else if (GET_RIGHT(gparent_container) == parent_container) { - SET_RIGHT_RELB(gparent_container, GET_LEFT(parent_container)); + SET_ROOT_RELB(tb, GET_LEFT(parent)); + } else if (GET_RIGHT(gparent) == parent) { + SET_RIGHT_RELB(gparent, GET_LEFT(parent)); } else { - SET_LEFT_RELB(gparent_container, GET_LEFT(parent_container)); + SET_LEFT_RELB(gparent, GET_LEFT(parent)); } unlock_route_node(parent); if (gparent != NULL) { unlock_route_node(gparent); } - new_neighbor_base = create_catree_base_node(tb); - new_neighbor_base->baseOrRoute.base.root = - join_trees(neighbor_base->root, base->root); - neighbor_base_parent = NULL; - if (GET_LEFT(parent_container) == neighbor_base_container) { - neighbor_base_parent = gparent_container; + { + TreeDbTerm* new_root = join_trees(neighbor->u.base.root, + thiz->u.base.root); + new_neighbor = create_base_node(tb, new_root, + LC_ORDER(thiz->u.base.lc_key.term)); + } + if (GET_LEFT(parent) == neighbor) { + neighbor_parent = gparent; } else { - neighbor_base_parent = - rightmost_route_node(GET_LEFT(parent_container)); + neighbor_parent = + rightmost_route_node(GET_LEFT(parent)); } } } /* Link in new neighbor and free nodes that are no longer in the tree */ - if (neighbor_base_parent == NULL) { - SET_ROOT_RELB(tb, new_neighbor_base); - } else if (GET_LEFT(neighbor_base_parent) == neighbor_base_container) { - SET_LEFT_RELB(neighbor_base_parent, new_neighbor_base); + if (neighbor_parent == NULL) { + SET_ROOT_RELB(tb, new_neighbor); + } else if (GET_LEFT(neighbor_parent) == neighbor) { + SET_LEFT_RELB(neighbor_parent, new_neighbor); } else { - SET_RIGHT_RELB(neighbor_base_parent, new_neighbor_base); + SET_RIGHT_RELB(neighbor_parent, new_neighbor); } - wunlock_base_node(base); - wunlock_base_node(neighbor_base); + wunlock_base_node(&thiz->u.base); + wunlock_base_node(&neighbor->u.base); /* Free the parent and base */ - erts_schedule_thr_prgr_later_op(free_catree_routing_node, - parent_container, - &parent->free_item); - erts_schedule_thr_prgr_later_op(free_catree_base_node, - base_container, - &base->free_item); - erts_schedule_thr_prgr_later_op(free_catree_base_node, - neighbor_base_container, - &neighbor_base->free_item); -} - - -static void split_catree(DbTableCommon *tb, - DbTableCATreeNode *parent_container, - DbTableCATreeNode *base_container) { + erts_schedule_db_free(&tb->common, + do_free_route_node, + parent, + &parent->u.route.free_item, + sizeof_route_node(parent->u.route.key.size)); + erts_schedule_db_free(&tb->common, + do_free_base_node, + thiz, + &thiz->u.base.free_item, + sizeof_base_node(thiz->u.base.lc_key.size)); + erts_schedule_db_free(&tb->common, + do_free_base_node, + neighbor, + &neighbor->u.base.free_item, + sizeof_base_node(neighbor->u.base.lc_key.size)); +} + +static void split_catree(DbTableCATree *tb, + DbTableCATreeNode* ERTS_RESTRICT parent, + DbTableCATreeNode* ERTS_RESTRICT base) { TreeDbTerm *splitOutWriteBack; - TreeDbTerm *leftWriteBack; - TreeDbTerm *rightWriteBack; - DbTableCATreeNode *left_base_node; - DbTableCATreeNode *right_base_node; - DbTableCATreeNode *routing_node_container; - DbTableCATreeBaseNode *base = &base_container->baseOrRoute.base; - DbTableCATreeRouteNode *parent; - if (parent_container == NULL) { - parent = NULL; - } else { - parent = &parent_container->baseOrRoute.route; - } + DbTableCATreeNode* ERTS_RESTRICT new_left; + DbTableCATreeNode* ERTS_RESTRICT new_right; + DbTableCATreeNode* ERTS_RESTRICT new_route; - if (less_than_two_elements(base->root)) { - base->lock_statistics = 0; - wunlock_base_node(base); + if (less_than_two_elements(base->u.base.root)) { + base->u.base.lock_statistics = 0; + wunlock_base_node(&base->u.base); return; } else { - /* Split the tree */ - split_tree(tb, - base->root, - &splitOutWriteBack, - &leftWriteBack, - &rightWriteBack); - /* Create new base nodes */ - left_base_node = - create_catree_base_node((DbTableCATree*)tb); - right_base_node = - create_catree_base_node((DbTableCATree*)tb); - left_base_node->baseOrRoute.base.root = leftWriteBack; - right_base_node->baseOrRoute.base.root = rightWriteBack; - routing_node_container = create_catree_route_node(tb, - left_base_node, - right_base_node, - &splitOutWriteBack->dbterm); + TreeDbTerm *left_tree; + TreeDbTerm *right_tree; + + split_tree(tb, base->u.base.root, &splitOutWriteBack, + &left_tree, &right_tree); + + new_left = create_base_node(tb, left_tree, + LC_ORDER(GETKEY(tb, left_tree->dbterm.tpl))); + new_right = create_base_node(tb, right_tree, + LC_ORDER(GETKEY(tb, right_tree->dbterm.tpl))); + new_route = create_route_node(tb, + new_left, + new_right, + &splitOutWriteBack->dbterm, + parent); if (parent == NULL) { - SET_ROOT_RELB((DbTableCATree*)tb, routing_node_container); - } else if(GET_LEFT(parent_container) == base_container) { - SET_LEFT_RELB(parent_container, routing_node_container); + SET_ROOT_RELB(tb, new_route); + } else if(GET_LEFT(parent) == base) { + SET_LEFT_RELB(parent, new_route); } else { - SET_RIGHT_RELB(parent_container, routing_node_container); + SET_RIGHT_RELB(parent, new_route); } - base->is_valid = 0; - wunlock_base_node(base); - erts_schedule_thr_prgr_later_op(free_catree_base_node, - base_container, - &base->free_item); + base->u.base.is_valid = 0; + wunlock_base_node(&base->u.base); + erts_schedule_db_free(&tb->common, + do_free_base_node, + base, + &base->u.base.free_item, + sizeof_base_node(base->u.base.lc_key.size)); } } @@ -1546,7 +1559,7 @@ static void catree_add_base_node_to_free_list( DbTableCATree *tb, DbTableCATreeNode *base_node_container) { - base_node_container->baseOrRoute.base.next = + base_node_container->u.base.next = tb->base_nodes_to_free_list; tb->base_nodes_to_free_list = base_node_container; } @@ -1557,7 +1570,7 @@ static void catree_deque_base_node_from_free_list(DbTableCATree *tb) return; /* List empty */ } else { DbTableCATreeNode *first = tb->base_nodes_to_free_list; - tb->base_nodes_to_free_list = first->baseOrRoute.base.next; + tb->base_nodes_to_free_list = first->u.base.next; } } @@ -1596,7 +1609,7 @@ static SWord do_free_routing_nodes_catree_cont(DbTableCATree *tb, SWord num_left PUSH_NODE(&tb->free_stack_rnodes, root); root = p; } else { - free_catree_routing_node(root); + free_catree_route_node(tb, root); if (--num_left >= 0) { break; } else { @@ -1637,10 +1650,10 @@ static SWord do_free_base_node_cont(DbTableCATree *tb, SWord num_left) } } catree_deque_base_node_from_free_list(tb); - free_catree_base_node(base_node_container); + free_catree_base_node(tb, base_node_container); base_node_container = catree_first_base_node_from_free_list(tb); if (base_node_container != NULL) { - PUSH_NODE(&tb->free_stack_elems, base_node_container->baseOrRoute.base.root); + PUSH_NODE(&tb->free_stack_elems, base_node_container->u.base.root); } return num_left; } @@ -1662,7 +1675,7 @@ void db_initialize_catree(void) int db_create_catree(Process *p, DbTable *tbl) { DbTableCATree *tb = &tbl->catree; - DbTableCATreeNode *root = create_catree_base_node(tb); + DbTableCATreeNode *root = create_base_node(tb, NULL, NIL); tb->deletion = 0; tb->base_nodes_to_free_list = NULL; erts_atomic_init_relb(&(tb->root), (erts_aint_t)root); @@ -1675,7 +1688,7 @@ static int db_first_catree(Process *p, DbTable *tbl, Eterm *ret) int result; DECLARE_AND_INIT_BASE_NODE_SEARCH_STACKS; /* Find first base node */ - base_node = &(lock_first_base_node(tbl, &search_stack, &locked_base_nodes_stack)->baseOrRoute.base); + base_node = &(lock_first_base_node(tbl, &search_stack, &locked_base_nodes_stack)->u.base); /* Find next base node until non-empty base node is found */ while (base_node != NULL && base_node->root == NULL) { base_node = find_and_lock_next_base_node_and_path(tbl, &search_stack_ptr, &search_stack_copy_ptr, locked_base_nodes_stack_ptr); @@ -1716,10 +1729,9 @@ static int db_next_catree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) static int db_last_catree(Process *p, DbTable *tbl, Eterm *ret) { - DbTableCATree *tb = &tbl->catree; - DbTableCATreeNode *base = merge_to_one_locked_base_node(&tb->common); - int result = db_last_tree_common(p, tbl, base->baseOrRoute.base.root, ret, NULL); - wunlock_base_node(&(base->baseOrRoute.base)); + DbTableCATreeNode *base = merge_to_one_locked_base_node(&tbl->catree); + int result = db_last_tree_common(p, tbl, base->u.base.root, ret, NULL); + wunlock_base_node(&(base->u.base)); return result; } @@ -1728,13 +1740,12 @@ static int db_prev_catree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) { DbTreeStack stack; TreeDbTerm * stack_array[STACK_NEED]; - DbTableCATree *tb = &tbl->catree; int result; DbTableCATreeNode *base; init_tree_stack(&stack, stack_array, 0); - base = merge_to_one_locked_base_node(&tb->common); - result = db_prev_tree_common(p, tbl, base->baseOrRoute.base.root, key, ret, &stack); - wunlock_base_node(&(base->baseOrRoute.base)); + base = merge_to_one_locked_base_node(&tbl->catree); + result = db_prev_tree_common(p, tbl, base->u.base.root, key, ret, &stack); + wunlock_base_node(&(base->u.base)); return result; } @@ -1835,13 +1846,12 @@ static int db_erase_object_catree(DbTable *tbl, Eterm object, Eterm *ret) static int db_slot_catree(Process *p, DbTable *tbl, Eterm slot_term, Eterm *ret) { - DbTableCATree *tb = &tbl->catree; int result; DbTableCATreeNode *base; - base = merge_to_one_locked_base_node(&tb->common); - result = db_slot_tree_common(p, tbl, base->baseOrRoute.base.root, + base = merge_to_one_locked_base_node(&tbl->catree); + result = db_slot_tree_common(p, tbl, base->u.base.root, slot_term, ret, NULL); - wunlock_base_node(&(base->baseOrRoute.base)); + wunlock_base_node(&(base->u.base)); return result; } @@ -1850,13 +1860,12 @@ static int db_select_continue_catree(Process *p, Eterm continuation, Eterm *ret) { - DbTableCATree *tb = &tbl->catree; int result; DbTableCATreeNode *base; - base = merge_to_one_locked_base_node(&tb->common); - result = db_select_continue_tree_common(p, &tb->common, &base->baseOrRoute.base.root, + base = merge_to_one_locked_base_node(&tbl->catree); + result = db_select_continue_tree_common(p, &tbl->common, &base->u.base.root, continuation, ret, NULL); - wunlock_base_node(&(base->baseOrRoute.base)); + wunlock_base_node(&(base->u.base)); return result; } @@ -1864,14 +1873,13 @@ static int db_select_continue_catree(Process *p, static int db_select_catree(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, int reverse, Eterm *ret) { - DbTableCATree *tb = &tbl->catree; int result; DbTableCATreeNode *base; - base = merge_to_one_locked_base_node(&tb->common); - result = db_select_tree_common(p, &tb->common, &base->baseOrRoute.base.root, + base = merge_to_one_locked_base_node(&tbl->catree); + result = db_select_tree_common(p, &tbl->common, &base->u.base.root, tid, pattern, reverse, ret, NULL); - wunlock_base_node(&(base->baseOrRoute.base)); + wunlock_base_node(&(base->u.base)); return result; } @@ -1880,27 +1888,25 @@ static int db_select_count_continue_catree(Process *p, Eterm continuation, Eterm *ret) { - DbTableCATree *tb = &tbl->catree; int result; DbTableCATreeNode *base; - base = merge_to_one_locked_base_node(&tb->common); - result = db_select_count_continue_tree_common(p, &tb->common, - &base->baseOrRoute.base.root, + base = merge_to_one_locked_base_node(&tbl->catree); + result = db_select_count_continue_tree_common(p, &tbl->common, + &base->u.base.root, continuation, ret, NULL); - wunlock_base_node(&(base->baseOrRoute.base)); + wunlock_base_node(&(base->u.base)); return result; } static int db_select_count_catree(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret) { - DbTableCATree *tb = &tbl->catree; int result; DbTableCATreeNode *base; - base = merge_to_one_locked_base_node(&tb->common); - result = db_select_count_tree_common(p, &tb->common, &base->baseOrRoute.base.root, + base = merge_to_one_locked_base_node(&tbl->catree); + result = db_select_count_tree_common(p, &tbl->common, &base->u.base.root, tid, pattern, ret, NULL); - wunlock_base_node(&(base->baseOrRoute.base)); + wunlock_base_node(&(base->u.base)); return result; } @@ -1908,13 +1914,12 @@ static int db_select_chunk_catree(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Sint chunk_size, int reversed, Eterm *ret) { - DbTableCATree *tb = &tbl->catree; int result; DbTableCATreeNode *base; - base = merge_to_one_locked_base_node(&tb->common); - result = db_select_chunk_tree_common(p, &tb->common, &base->baseOrRoute.base.root, + base = merge_to_one_locked_base_node(&tbl->catree); + result = db_select_chunk_tree_common(p, &tbl->common, &base->u.base.root, tid, pattern, chunk_size, reversed, ret, NULL); - wunlock_base_node(&(base->baseOrRoute.base)); + wunlock_base_node(&(base->u.base)); return result; } @@ -1923,60 +1928,56 @@ static int db_select_delete_continue_catree(Process *p, Eterm continuation, Eterm *ret) { - DbTableCATree *tb = &tbl->catree; DbTreeStack stack; TreeDbTerm * stack_array[STACK_NEED]; int result; DbTableCATreeNode *base; init_tree_stack(&stack, stack_array, 0); - base = merge_to_one_locked_base_node(&tb->common); - result = db_select_delete_continue_tree_common(p, tbl, &base->baseOrRoute.base.root, + base = merge_to_one_locked_base_node(&tbl->catree); + result = db_select_delete_continue_tree_common(p, tbl, &base->u.base.root, continuation, ret, &stack); - wunlock_base_node(&(base->baseOrRoute.base)); + wunlock_base_node(&(base->u.base)); return result; } static int db_select_delete_catree(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret) { - DbTableCATree *tb = &tbl->catree; DbTreeStack stack; TreeDbTerm * stack_array[STACK_NEED]; int result; DbTableCATreeNode *base; init_tree_stack(&stack, stack_array, 0); - base = merge_to_one_locked_base_node(&tb->common); - result = db_select_delete_tree_common(p, tbl, &base->baseOrRoute.base.root, + base = merge_to_one_locked_base_node(&tbl->catree); + result = db_select_delete_tree_common(p, tbl, &base->u.base.root, tid, pattern, ret, &stack); - wunlock_base_node(&(base->baseOrRoute.base)); + wunlock_base_node(&(base->u.base)); return result; } static int db_select_replace_catree(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret) { - DbTableCATree *tb = &tbl->catree; int result; DbTableCATreeNode *base; - base = merge_to_one_locked_base_node(&tb->common); - result = db_select_replace_tree_common(p, &tb->common, - &base->baseOrRoute.base.root, + base = merge_to_one_locked_base_node(&tbl->catree); + result = db_select_replace_tree_common(p, &tbl->common, + &base->u.base.root, tid, pattern, ret, NULL); - wunlock_base_node(&(base->baseOrRoute.base)); + wunlock_base_node(&(base->u.base)); return result; } static int db_select_replace_continue_catree(Process *p, DbTable *tbl, Eterm continuation, Eterm *ret) { - DbTableCATree *tb = &tbl->catree; int result; DbTableCATreeNode *base; - base = merge_to_one_locked_base_node(&tb->common); - result = db_select_replace_continue_tree_common(p, &tb->common, - &base->baseOrRoute.base.root, + base = merge_to_one_locked_base_node(&tbl->catree); + result = db_select_replace_continue_tree_common(p, &tbl->common, + &base->u.base.root, continuation, ret, NULL); - wunlock_base_node(&(base->baseOrRoute.base)); + wunlock_base_node(&(base->u.base)); return result; } @@ -2002,10 +2003,9 @@ static int db_take_catree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) static void db_print_catree(fmtfn_t to, void *to_arg, int show, DbTable *tbl) { - DbTableCATree *tb = &tbl->catree; - DbTableCATreeNode *base = merge_to_one_locked_base_node(&tb->common); - db_print_tree_common(to, to_arg, show, base->baseOrRoute.base.root, tbl); - wunlock_base_node(&(base->baseOrRoute.base)); + DbTableCATreeNode *base = merge_to_one_locked_base_node(&tbl->catree); + db_print_tree_common(to, to_arg, show, base->u.base.root, tbl); + wunlock_base_node(&(base->u.base)); } /* Release all memory occupied by a single table */ @@ -2045,7 +2045,7 @@ static SWord db_free_table_continue_catree(DbTable *tbl, SWord reds) } else { tb->is_routing_nodes_freed = 1; /* Ready with the routing nodes */ first_base_node = catree_first_base_node_from_free_list(tb); - PUSH_NODE(&tb->free_stack_elems, first_base_node->baseOrRoute.base.root); + PUSH_NODE(&tb->free_stack_elems, first_base_node->u.base.root); } } while (catree_first_base_node_from_free_list(tb) != NULL) { @@ -2081,10 +2081,9 @@ static void db_foreach_offheap_catree(DbTable *tbl, void (*func)(ErlOffHeap *, void *), void *arg) { - DbTableCATree *tb = &tbl->catree; - DbTableCATreeNode *base = merge_to_one_locked_base_node(&tb->common); - db_foreach_offheap_tree_common(base->baseOrRoute.base.root, func, arg); - wunlock_base_node(&(base->baseOrRoute.base)); + DbTableCATreeNode *base = merge_to_one_locked_base_node(&tbl->catree); + db_foreach_offheap_tree_common(base->u.base.root, func, arg); + wunlock_base_node(&(base->u.base)); } static int db_lookup_dbterm_catree(Process *p, DbTable *tbl, Eterm key, Eterm obj, @@ -2111,7 +2110,7 @@ static void db_finalize_dbterm_catree(int cret, DbUpdateHandle *handle) DbTableCATreeNode *prev_node = handle->lck; DbTableCATreeNode *current_node = handle->lck2; int current_level = handle->current_level; - DbTableCATreeBaseNode *base_node = ¤t_node->baseOrRoute.base; + DbTableCATreeBaseNode *base_node = ¤t_node->u.base; db_finalize_dbterm_tree_common(cret, handle, NULL); ERL_DB_CATREE_CREATE_DO_OPERATION_FUNCTION_ADAPT_AND_UNLOCK_PART; return; diff --git a/erts/emulator/beam/erl_db_catree.h b/erts/emulator/beam/erl_db_catree.h index 1f2c7da091..f9c0784289 100644 --- a/erts/emulator/beam/erl_db_catree.h +++ b/erts/emulator/beam/erl_db_catree.h @@ -34,23 +34,36 @@ struct DbTableCATreeNode; typedef struct { + Eterm term; + struct erl_off_heap_header* oh; + Uint size; + Eterm heap[1]; +} DbRouteKey; + +typedef struct { erts_rwmtx_t lock; /* The lock for this base node */ Sint lock_statistics; int is_valid; /* If this base node is still valid */ TreeDbTerm *root; /* The root of the sequential tree */ - DbTable * tab; /* Table ptr, used when freeing using thread progress */ ErtsThrPrgrLaterOp free_item; /* Used when freeing using thread progress */ struct DbTableCATreeNode * next; /* Used when gradually deleting */ + +#ifdef ERTS_ENABLE_LOCK_CHECK + DbRouteKey lc_key; +#endif + char end_of_struct__; } DbTableCATreeBaseNode; typedef struct { +#ifdef ERTS_ENABLE_LOCK_CHECK + Sint lc_order; +#endif ErtsThrPrgrLaterOp free_item; /* Used when freeing using thread progress */ - DbTable* tab; /* Table ptr, used when freeing using thread progress */ erts_mtx_t lock; /* Used when joining route nodes */ int is_valid; /* If this route node is still valid */ erts_atomic_t left; erts_atomic_t right; - DbTerm key; + DbRouteKey key; } DbTableCATreeRouteNode; typedef struct DbTableCATreeNode { @@ -58,7 +71,7 @@ typedef struct DbTableCATreeNode { union { DbTableCATreeRouteNode route; DbTableCATreeBaseNode base; - } baseOrRoute; + } u; } DbTableCATreeNode; typedef struct { diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 752d3ae3a8..61806876a7 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -2731,13 +2731,9 @@ static int free_seg(DbTableHash *tb, int free_records) * sure no lingering threads are still hanging in BUCKET macro * with an old segtab pointer. */ - Uint sz = SIZEOF_EXT_SEGTAB(est->nsegs); - ASSERT(sz == ERTS_ALC_DBG_BLK_SZ(est)); - ERTS_DB_ALC_MEM_UPDATE_(tb, sz, 0); - erts_schedule_thr_prgr_later_cleanup_op(dealloc_ext_segtab, - est, - &est->lop, - sz); + erts_schedule_db_free(&tb->common, dealloc_ext_segtab, + est, &est->lop, + SIZEOF_EXT_SEGTAB(est->nsegs)); } else erts_db_free(ERTS_ALC_T_DB_SEG, (DbTable*)tb, est, diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index f643344477..c6f1a0fc6d 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -1995,22 +1995,14 @@ int db_select_replace_tree_common(Process *p, DbTableCommon *tb, TreeDbTerm **ro sc.mp = mpi.mp; - stack = get_static_stack(stack_container); if (!mpi.got_partial && mpi.some_limitation && CMP_EQ(mpi.least,mpi.most)) { - TreeDbTerm* term = *(mpi.save_term); doit_select_replace(tb,mpi.save_term,&sc,0 /* dummy */); - if (stack != NULL) { - if (TOP_NODE(stack) == term) - // throw away potentially invalid reference - REPLACE_TOP_NODE(stack, *(mpi.save_term)); - release_stack((DbTable*)tb,stack_container, stack); - } + reset_static_stack(stack_container); /* may refer replaced term */ RET_TO_BIF(erts_make_integer(sc.replaced,p),DB_ERROR_NONE); } - if (stack == NULL) - stack = get_any_stack((DbTable*)tb,stack_container); + stack = get_any_stack((DbTable*)tb,stack_container); if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, *root, stack, mpi.most)) != NULL) { diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 3b10ef8c25..987e370341 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -42,6 +42,7 @@ #include "erl_term.h" #include "erl_threads.h" #include "erl_atom_table.h" +#include "erl_utils.h" typedef struct { char *name; @@ -91,8 +92,8 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "db_tab", "address" }, { "db_tab_fix", "address" }, { "db_hash_slot", "address" }, - { "erl_db_catree_base_node", "dynamic" }, - { "erl_db_catree_route_node", "dynamic" }, + { "erl_db_catree_base_node", "term" }, + { "erl_db_catree_route_node", "index" }, { "resource_monitors", "address" }, { "driver_list", NULL }, { "proc_msgq", "pid" }, @@ -709,26 +710,14 @@ erts_lc_get_lock_order_id(char *name) return (Sint16) -1; } -int -erts_lc_is_check_order(char *name) +static int +lc_is_term_order(Sint16 id) { - int i; - if (!name || name[0] == '\0') - erts_fprintf(stderr, "Missing lock name\n"); - - for (i = 0; i < ERTS_LOCK_ORDER_SIZE; i++) { - if (sys_strcmp(erts_lock_order[i].name, name) == 0) { - if (erts_lock_order[i].internal_order != NULL && - sys_strcmp(erts_lock_order[i].internal_order, "dynamic") == 0) { - return 0; - }else{ - return 1; - } - } - } - return 1; + return erts_lock_order[id].internal_order != NULL + && sys_strcmp(erts_lock_order[id].internal_order, "term") == 0; } + static int compare_locked_by_id(lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand) { if(locked_lock->id < comparand->id) { @@ -740,18 +729,23 @@ static int compare_locked_by_id(lc_locked_lock_t *locked_lock, erts_lc_lock_t *c return 0; } -static int compare_locked_by_id_extra(lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand) +static int compare_locked_by_id_extra(lc_locked_lock_t *ll, erts_lc_lock_t *comparand) { - int order = compare_locked_by_id(locked_lock, comparand); + int order = compare_locked_by_id(ll, comparand); if(order) { return order; - } else if(locked_lock->extra < comparand->extra) { + } + if (ll->flags & ERTS_LOCK_FLAGS_PROPERTY_TERM_ORDER) { + ASSERT(!is_header(ll->extra) && !is_header(comparand->extra)); + return CMP(ll->extra, comparand->extra); + } + + if(ll->extra < comparand->extra) { return -1; - } else if(locked_lock->extra > comparand->extra) { + } else if(ll->extra > comparand->extra) { return 1; } - return 0; } @@ -990,7 +984,8 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options) return 0; } else { - lc_locked_lock_t *tl_lck; + lc_locked_lock_t *ll; + int order; ASSERT(thr->locked.last); @@ -999,26 +994,27 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options) type_order_violation("trylocking ", thr, lck); #endif - if (thr->locked.last->id < lck->id - || (thr->locked.last->id == lck->id - && thr->locked.last->extra < lck->extra)) - return 0; + ll = thr->locked.last; + order = compare_locked_by_id_extra(ll, lck); + + if (order < 0) + return 0; /* - * Lock order violation + * TryLock order violation */ - - if (lck->check_order) { - /* Check that we are not trying to lock this lock twice */ - for (tl_lck = thr->locked.last; tl_lck; tl_lck = tl_lck->prev) { - if (tl_lck->id < lck->id - || (tl_lck->id == lck->id && tl_lck->extra <= lck->extra)) { - if (tl_lck->id == lck->id && tl_lck->extra == lck->extra) - lock_twice("Trylocking", thr, lck, options); - break; - } + /* Check that we are not trying to lock this lock twice */ + while (1) { + if (order <= 0) { + if (order == 0) + lock_twice("Trylocking", thr, lck, options); + break; } + ll = ll->prev; + if (!ll) + break; + order = compare_locked_by_id_extra(ll, lck); } #ifndef ERTS_LC_ALLWAYS_FORCE_BUSY_TRYLOCK_ON_LOCK_ORDER_VIOLATION @@ -1038,6 +1034,11 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options) #endif } +/* + * locked = 0 trylock failed + * locked > 0 trylock succeeded + * locked < 0 prelocking of newly created lock (no lock order check) + */ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t options, char *file, unsigned int line) { @@ -1066,9 +1067,9 @@ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t #endif for (tl_lck = thr->locked.last; tl_lck; tl_lck = tl_lck->prev) { - if (tl_lck->id < lck->id - || (tl_lck->id == lck->id && tl_lck->extra <= lck->extra)) { - if (tl_lck->id == lck->id && tl_lck->extra == lck->extra && lck->check_order) + int order = compare_locked_by_id_extra(tl_lck, lck); + if (order <= 0) { + if (order == 0 && locked >= 0) lock_twice("Trylocking", thr, lck, options); if (locked) { ll->next = tl_lck->next; @@ -1111,10 +1112,10 @@ void erts_lc_require_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options, for (l_lck2 = thr->required.last; l_lck2; l_lck2 = l_lck2->prev) { - if (l_lck2->id < lck->id - || (l_lck2->id == lck->id && l_lck2->extra < lck->extra)) + int order = compare_locked_by_id_extra(l_lck2, lck); + if (order < 0) break; - else if (l_lck2->id == lck->id && l_lck2->extra == lck->extra) + if (order == 0) require_twice(thr, lck); } if (!l_lck2) { @@ -1172,6 +1173,7 @@ void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options, { lc_thread_t *thr; lc_locked_lock_t *new_ll; + int order; if (lck->inited != ERTS_LC_INITITALIZED) uninitialized_lock(); @@ -1187,11 +1189,10 @@ void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options, thr->locked.last = thr->locked.first = new_ll; ASSERT(0 < lck->id && lck->id < ERTS_LOCK_ORDER_SIZE); thr->matrix.m[lck->id][0] = 1; + return; } - else if (( ! lck->check_order && thr->locked.last->id == lck->id) || - (thr->locked.last->id < lck->id - || (thr->locked.last->id == lck->id - && thr->locked.last->extra < lck->extra))) { + order = compare_locked_by_id_extra(thr->locked.last, lck); + if (order < 0) { lc_locked_lock_t* ll; if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, thr->locked.last->flags)) { type_order_violation("locking ", thr, lck); @@ -1321,7 +1322,6 @@ void erts_lc_init_lock(erts_lc_lock_t *lck, char *name, erts_lock_flags_t flags) { lck->id = erts_lc_get_lock_order_id(name); - lck->check_order = erts_lc_is_check_order(name); lck->extra = (UWord) &lck->extra; ASSERT(is_not_immed(lck->extra)); lck->flags = flags; @@ -1333,10 +1333,14 @@ void erts_lc_init_lock_x(erts_lc_lock_t *lck, char *name, erts_lock_flags_t flags, Eterm extra) { lck->id = erts_lc_get_lock_order_id(name); - lck->check_order = erts_lc_is_check_order(name); lck->extra = extra; - ASSERT(is_immed(lck->extra)); lck->flags = flags; + if (lc_is_term_order(lck->id)) { + lck->flags |= ERTS_LOCK_FLAGS_PROPERTY_TERM_ORDER; + ASSERT(!is_header(lck->extra)); + } + else + ASSERT(is_immed(lck->extra)); lck->taken_options = 0; lck->inited = ERTS_LC_INITITALIZED; } diff --git a/erts/emulator/beam/erl_lock_check.h b/erts/emulator/beam/erl_lock_check.h index 472e88ad65..b32f27d9f9 100644 --- a/erts/emulator/beam/erl_lock_check.h +++ b/erts/emulator/beam/erl_lock_check.h @@ -46,7 +46,6 @@ typedef struct { int inited; Sint16 id; - int check_order; erts_lock_flags_t flags; erts_lock_options_t taken_options; UWord extra; @@ -54,12 +53,11 @@ typedef struct { #define ERTS_LC_INITITALIZED 0x7f7f7f7f -#define ERTS_LC_LOCK_INIT(ID, X, F) {ERTS_LC_INITITALIZED, (ID), 1, (F), 0, (X)} +#define ERTS_LC_LOCK_INIT(ID, X, F) {ERTS_LC_INITITALIZED, (ID), (F), 0, (X)} void erts_lc_init(void); void erts_lc_late_init(void); Sint16 erts_lc_get_lock_order_id(char *name); -int erts_lc_is_check_order(char *name); void erts_lc_check(erts_lc_lock_t *have, int have_len, erts_lc_lock_t *have_not, int have_not_len); void erts_lc_check_exact(erts_lc_lock_t *have, int have_len); @@ -106,7 +104,7 @@ Eterm erts_lc_dump_graph(void); #define erts_lc_lock(lck) erts_lc_lock_x(lck,__FILE__,__LINE__) #define erts_lc_trylock(res,lck) erts_lc_trylock_x(res,lck,__FILE__,__LINE__) -#define erts_lc_lock_flg(lck) erts_lc_lock_flg_x(lck,__FILE__,__LINE__) -#define erts_lc_trylock_flg(res,lck) erts_lc_trylock_flg_x(res,lck,__FILE__,__LINE__) +#define erts_lc_lock_flg(lck,flg) erts_lc_lock_flg_x(lck,flg,__FILE__,__LINE__) +#define erts_lc_trylock_flg(res,lck,flg) erts_lc_trylock_flg_x(res,lck,flg,__FILE__,__LINE__) #endif /* #ifndef ERTS_LOCK_CHECK_H__ */ diff --git a/erts/emulator/beam/erl_lock_flags.h b/erts/emulator/beam/erl_lock_flags.h index d711f69456..2db133b598 100644 --- a/erts/emulator/beam/erl_lock_flags.h +++ b/erts/emulator/beam/erl_lock_flags.h @@ -28,15 +28,17 @@ /* Property/category are bitfields to simplify their use in masks. */ #define ERTS_LOCK_FLAGS_MASK_CATEGORY (0xFFC0) -#define ERTS_LOCK_FLAGS_MASK_PROPERTY (0x0030) +#define ERTS_LOCK_FLAGS_MASK_PROPERTY (0x0038) /* Type is a plain number. */ -#define ERTS_LOCK_FLAGS_MASK_TYPE (0x000F) +#define ERTS_LOCK_FLAGS_MASK_TYPE (0x0007) #define ERTS_LOCK_FLAGS_TYPE_SPINLOCK (1) #define ERTS_LOCK_FLAGS_TYPE_MUTEX (2) #define ERTS_LOCK_FLAGS_TYPE_PROCLOCK (3) +/* Lock checker use real term order instead of raw word compare */ +#define ERTS_LOCK_FLAGS_PROPERTY_TERM_ORDER (1 << 3) /* "Static" guarantees that the lock will never be destroyed once created. */ #define ERTS_LOCK_FLAGS_PROPERTY_STATIC (1 << 4) #define ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE (1 << 5) diff --git a/erts/emulator/test/smoke_test_SUITE.erl b/erts/emulator/test/smoke_test_SUITE.erl index 26c610e3a8..5b46342127 100644 --- a/erts/emulator/test/smoke_test_SUITE.erl +++ b/erts/emulator/test/smoke_test_SUITE.erl @@ -56,7 +56,7 @@ end_per_testcase(_Case, Config) when is_list(Config) -> %%% boot_combo(Config) when is_list(Config) -> - ZFlags = os:getenv("ERL_ZFLAGS"), + ZFlags = os:getenv("ERL_ZFLAGS", ""), NOOP = fun () -> ok end, A42 = fun () -> case erlang:system_info(threads) of @@ -87,10 +87,7 @@ boot_combo(Config) when is_list(Config) -> %% A lot more combos could be implemented... ok after - os:putenv("ERL_ZFLAGS", case ZFlags of - false -> ""; - _ -> ZFlags - end) + os:putenv("ERL_ZFLAGS", ZFlags) end. native_atomics(Config) when is_list(Config) -> diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 778ea2e9e2..bfa7b25862 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -390,11 +390,7 @@ testcases(TestDir, Suite) -> end. make_and_load(Dir, Suite) -> - EnvInclude = - case os:getenv("CT_INCLUDE_PATH") of - false -> []; - CtInclPath -> string:lexemes(CtInclPath, [$:,$ ,$,]) - end, + EnvInclude = string:lexemes(os:getenv("CT_INCLUDE_PATH", ""), [$:,$ ,$,]), StartInclude = case init:get_argument(include) of {ok,[Dirs]} -> Dirs; diff --git a/lib/common_test/test/ct_config_SUITE.erl b/lib/common_test/test/ct_config_SUITE.erl index 5ffc735d6a..ec5278b96d 100644 --- a/lib/common_test/test/ct_config_SUITE.erl +++ b/lib/common_test/test/ct_config_SUITE.erl @@ -211,18 +211,12 @@ reformat_events(Events, EH) -> %%% Test related to 'localtime' will often fail if the test host is %%% time warping, so let's just skip the 'dynamic' tests then. skip_dynamic() -> - case os:getenv("TS_EXTRA_PLATFORM_LABEL") of - TSExtraPlatformLabel when is_list(TSExtraPlatformLabel) -> - case string:find(TSExtraPlatformLabel,"TimeWarpingOS") of - nomatch -> false; - _ -> true - end; - _ -> - false + case string:find(os:getenv("TS_EXTRA_PLATFORM_LABEL", ""), "TimeWarpingOS") of + nomatch -> false; + _ -> true end. - %%%----------------------------------------------------------------- %%% TEST EVENTS %%%----------------------------------------------------------------- diff --git a/lib/common_test/test_server/ts_install.erl b/lib/common_test/test_server/ts_install.erl index 048e5493d2..09f3da860a 100644 --- a/lib/common_test/test_server/ts_install.erl +++ b/lib/common_test/test_server/ts_install.erl @@ -112,12 +112,6 @@ get_vars([], name, [], Result) -> get_vars(_, _, _, _) -> {error, fatal_bad_conf_vars}. -config_flags() -> - case os:getenv("CONFIG_FLAGS") of - false -> []; - CF -> string:lexemes(CF, " \t\n") - end. - unix_autoconf(XConf) -> Configure = filename:absname("configure"), Flags = proplists:get_value(crossflags,XConf,[]), @@ -128,7 +122,7 @@ unix_autoconf(XConf) -> erlang:system_info(threads) /= false], Debug = [" --enable-debug-mode" || string:find(erlang:system_info(system_version),"debug") =/= nomatch], - MXX_Build = [Y || Y <- config_flags(), + MXX_Build = [Y || Y <- string:lexemes(os:getenv("CONFIG_FLAGS", ""), " \t\n"), Y == "--enable-m64-build" orelse Y == "--enable-m32-build"], Args = Host ++ Build ++ Threads ++ Debug ++ " " ++ MXX_Build, @@ -164,7 +158,7 @@ assign_vars(FlagsStr) -> assign_all_vars([$$ | Rest], FlagSoFar) -> {VarName,Rest1} = get_var_name(Rest, []), - assign_all_vars(Rest1, FlagSoFar ++ assign_var(VarName)); + assign_all_vars(Rest1, FlagSoFar ++ os:getenv(VarName, "")); assign_all_vars([Char | Rest], FlagSoFar) -> assign_all_vars(Rest, FlagSoFar ++ [Char]); assign_all_vars([], Flag) -> @@ -177,12 +171,6 @@ get_var_name([Ch | Rest] = Str, VarR) -> end; get_var_name([], VarR) -> {lists:reverse(VarR),[]}. - -assign_var(VarName) -> - case os:getenv(VarName) of - false -> ""; - Val -> Val - end. valid_char(Ch) when Ch >= $a, Ch =< $z -> true; valid_char(Ch) when Ch >= $A, Ch =< $Z -> true; @@ -280,7 +268,7 @@ add_vars(Vars0, Opts0) -> {Opts, [{longnames, LongNames}, {platform_id, PlatformId}, {platform_filename, PlatformFilename}, - {rsh_name, get_rsh_name()}, + {rsh_name, os:getenv("ERL_RSH", "rsh")}, {platform_label, PlatformLabel}, {ts_net_dir, Mounted}, {erl_flags, []}, @@ -301,16 +289,10 @@ get_testcase_callback() -> end end. -get_rsh_name() -> - case os:getenv("ERL_RSH") of - false -> "rsh"; - Str -> Str - end. - platform_id(Vars) -> {Id,_,_,_} = platform(Vars), Id. - + platform(Vars) -> Hostname = hostname(), diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index f64986d55c..45e442f5c2 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -203,7 +203,8 @@ <tag><c>deterministic</c></tag> <item> <p>Omit the <c>options</c> and <c>source</c> tuples in - the list returned by <c>Module:module_info(compile)</c>. + the list returned by <c>Module:module_info(compile)</c>, and + reduce the paths in stack traces to the module name alone. This option will make it easier to achieve reproducible builds. </p> </item> @@ -347,8 +348,8 @@ module.beam: module.erl \ <tag><c>{source,FileName}</c></tag> <item> - <p>Sets the value of the source, as returned by - <c>module_info(compile)</c>.</p> + <p>Overrides the source file name as presented in + <c>module_info(compile)</c> and stack traces.</p> </item> <tag><c>{outdir,Dir}</c></tag> diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl index 40742e441a..9175931375 100644 --- a/lib/compiler/src/beam_ssa_pre_codegen.erl +++ b/lib/compiler/src/beam_ssa_pre_codegen.erl @@ -1043,11 +1043,11 @@ need_frame_1([#b_set{op=call,args=[Func|_]}|Is], Context) -> #b_remote{} -> %% This is an apply(), which always needs a frame. true; - #b_var{} -> - %% A fun call always needs a frame. - true; + #b_local{} -> + Context =:= body orelse Is =/= []; _ -> - Context =:= body orelse Is =/= [] + %% A fun call always needs a frame. + true end; need_frame_1([I|Is], Context) -> beam_ssa:clobbers_xregs(I) orelse need_frame_1(Is, Context); diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index a11dc691bc..27e6e8fe00 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1012,11 +1012,17 @@ parse_module(_Code, St0) -> end. do_parse_module(DefEncoding, #compile{ifile=File,options=Opts,dir=Dir}=St) -> + SourceName0 = proplists:get_value(source, Opts, File), + SourceName = case member(deterministic, Opts) of + true -> filename:basename(SourceName0); + false -> SourceName0 + end, R = epp:parse_file(File, - [{includes,[".",Dir|inc_paths(Opts)]}, - {macros,pre_defs(Opts)}, - {default_encoding,DefEncoding}, - extra]), + [{includes,[".",Dir|inc_paths(Opts)]}, + {source_name, SourceName}, + {macros,pre_defs(Opts)}, + {default_encoding,DefEncoding}, + extra]), case R of {ok,Forms,Extra} -> Encoding = proplists:get_value(encoding, Extra), diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index b79b4171d3..5656743c76 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -36,7 +36,7 @@ core_roundtrip/1, asm/1, optimized_guards/1, sys_pre_attributes/1, dialyzer/1, warnings/1, pre_load_check/1, env_compiler_options/1, - bc_options/1, deterministic_include/1 + bc_options/1, deterministic_include/1, deterministic_paths/1 ]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -53,7 +53,7 @@ all() -> cover, env, core_pp, core_roundtrip, asm, optimized_guards, sys_pre_attributes, dialyzer, warnings, pre_load_check, env_compiler_options, custom_debug_info, bc_options, - custom_compile_info, deterministic_include]. + custom_compile_info, deterministic_include, deterministic_paths]. groups() -> []. @@ -1533,6 +1533,30 @@ deterministic_include(Config) when is_list(Config) -> ok. +deterministic_paths(Config) when is_list(Config) -> + DataDir = proplists:get_value(data_dir, Config), + + %% Files without +deterministic should differ if they were compiled from a + %% different directory. + true = deterministic_paths_1(DataDir, "simple", []), + + %% ... but files with +deterministic shouldn't. + false = deterministic_paths_1(DataDir, "simple", [deterministic]), + + ok. + +deterministic_paths_1(DataDir, Name, Opts) -> + Simple = filename:join(DataDir, "simple"), + {ok, Cwd} = file:get_cwd(), + try + {ok,_,A} = compile:file(Simple, [binary | Opts]), + ok = file:set_cwd(DataDir), + {ok,_,B} = compile:file(Name, [binary | Opts]), + A =/= B + after + file:set_cwd(Cwd) + end. + %%% %%% Utilities. %%% diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index e00885fcd6..1df0a05275 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -249,6 +249,13 @@ badfun(_Config) -> expect_badfun(X, catch X(put(?FUNCTION_NAME, of_course))), of_course = erase(?FUNCTION_NAME), + %% A literal as a Fun used to crash the code generator. This only happened + %% when type optimization had reduced `Fun` to a literal, hence the match. + Literal = fun(literal = Fun) -> + Fun() + end, + expect_badfun(literal, catch Literal(literal)), + ok. expect_badfun(Term, Exit) -> diff --git a/lib/inets/src/http_client/httpc_request.erl b/lib/inets/src/http_client/httpc_request.erl index 9b81bd7a80..0f20d93bc1 100644 --- a/lib/inets/src/http_client/httpc_request.erl +++ b/lib/inets/src/http_client/httpc_request.erl @@ -213,15 +213,18 @@ update_body(Headers, Body) -> update_headers(Headers, ContentType, Body, []) -> case Body of [] -> - Headers#http_request_h{'content-length' = "0"}; + Headers1 = Headers#http_request_h{'content-length' = "0"}, + handle_content_type(Headers1, ContentType); <<>> -> - Headers#http_request_h{'content-length' = "0"}; + Headers1 = Headers#http_request_h{'content-length' = "0"}, + handle_content_type(Headers1, ContentType); {Fun, _Acc} when is_function(Fun, 1) -> %% A client MUST NOT generate a 100-continue expectation in a request %% that does not include a message body. This implies that either the %% Content-Length or the Transfer-Encoding header MUST be present. %% DO NOT send content-type when Body is empty. - Headers#http_request_h{'content-type' = ContentType}; + Headers1 = Headers#http_request_h{'content-type' = ContentType}, + handle_transfer_encoding(Headers1); _ -> Headers#http_request_h{ 'content-length' = body_length(Body), @@ -230,12 +233,26 @@ update_headers(Headers, ContentType, Body, []) -> update_headers(_, _, _, HeadersAsIs) -> HeadersAsIs. +handle_transfer_encoding(Headers = #http_request_h{'transfer-encoding' = undefined}) -> + Headers; +handle_transfer_encoding(Headers) -> + %% RFC7230 3.3.2 + %% A sender MUST NOT send a 'Content-Length' header field in any message + %% that contains a 'Transfer-Encoding' header field. + Headers#http_request_h{'content-length' = undefined}. + body_length(Body) when is_binary(Body) -> integer_to_list(size(Body)); body_length(Body) when is_list(Body) -> integer_to_list(length(Body)). +%% Set 'Content-Type' when it is explicitly set. +handle_content_type(Headers, "") -> + Headers; +handle_content_type(Headers, ContentType) -> + Headers#http_request_h{'content-type' = ContentType}. + method(Method) -> http_util:to_upper(atom_to_list(Method)). diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 3d375222b5..8357e02014 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -156,6 +156,7 @@ only_simulated() -> multipart_chunks, get_space, delete_no_body, + post_with_content_type, stream_fun_server_close ]. @@ -170,7 +171,8 @@ misc() -> server_does_not_exist, timeout_memory_leak, wait_for_whole_response, - post_204_chunked + post_204_chunked, + chunkify_fun ]. sim_mixed() -> @@ -1408,7 +1410,8 @@ post_204_chunked(_Config) -> {ok, ListenSocket} = gen_tcp:listen(0, [{active,once}, binary]), {ok,{_,Port}} = inet:sockname(ListenSocket), - spawn(fun () -> custom_server(Msg, Chunk, ListenSocket) end), + spawn(fun () -> custom_server(Msg, Chunk, ListenSocket, + fun post_204_receive/0) end), {ok,Host} = inet:gethostname(), End = "/cgi-bin/erl/httpd_example:post_204", @@ -1418,16 +1421,26 @@ post_204_chunked(_Config) -> %% Second request times out in the faulty case. {ok, _} = httpc:request(post, {URL, [], "text/html", []}, [], []). -custom_server(Msg, Chunk, ListenSocket) -> +post_204_receive() -> + receive + {tcp, _, Msg} -> + ct:log("Message received: ~p", [Msg]) + after + 1000 -> + ct:fail("Timeout: did not recive packet") + end. + +%% Custom server is used to test special cases when using chunked encoding +custom_server(Msg, Chunk, ListenSocket, ReceiveFun) -> {ok, Accept} = gen_tcp:accept(ListenSocket), - receive_packet(), + ReceiveFun(), send_response(Msg, Chunk, Accept), - custom_server_loop(Msg, Chunk, Accept). + custom_server_loop(Msg, Chunk, Accept, ReceiveFun). -custom_server_loop(Msg, Chunk, Accept) -> - receive_packet(), +custom_server_loop(Msg, Chunk, Accept, ReceiveFun) -> + ReceiveFun(), send_response(Msg, Chunk, Accept), - custom_server_loop(Msg, Chunk, Accept). + custom_server_loop(Msg, Chunk, Accept, ReceiveFun). send_response(Msg, Chunk, Socket) -> inet:setopts(Socket, [{active, once}]), @@ -1435,15 +1448,54 @@ send_response(Msg, Chunk, Socket) -> timer:sleep(250), gen_tcp:send(Socket, Chunk). -receive_packet() -> +%%-------------------------------------------------------------------- +chunkify_fun() -> + [{doc,"Test that a chunked encoded request does not include the 'Content-Length header'"}]. +chunkify_fun(_Config) -> + Msg = "HTTP/1.1 204 No Content\r\n" ++ + "Date: Thu, 23 Aug 2018 13:36:29 GMT\r\n" ++ + "Content-Type: text/html\r\n" ++ + "Server: inets/6.5.2.3\r\n" ++ + "Cache-Control: no-cache\r\n" ++ + "Pragma: no-cache\r\n" ++ + "Expires: Fri, 24 Aug 2018 07:49:35 GMT\r\n" ++ + "Transfer-Encoding: chunked\r\n" ++ + "\r\n", + Chunk = "0\r\n\r\n", + + {ok, ListenSocket} = gen_tcp:listen(0, [{active,once}, binary]), + {ok,{_,Port}} = inet:sockname(ListenSocket), + spawn(fun () -> custom_server(Msg, Chunk, ListenSocket, + fun chunkify_receive/0) end), + + {ok,Host} = inet:gethostname(), + End = "/cgi-bin/erl/httpd_example", + URL = ?URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ End, + Fun = fun(_) -> {ok,<<1>>,eof_body} end, + Acc = start, + + {ok, {{_,204,_}, _, _}} = + httpc:request(put, {URL, [], "text/html", {chunkify, Fun, Acc}}, [], []). + +chunkify_receive() -> + Error = "HTTP/1.1 500 Internal Server Error\r\n" ++ + "Content-Length: 0\r\n\r\n", receive - {tcp, _, Msg} -> - ct:log("Message received: ~p", [Msg]) + {tcp, Port, Msg} -> + case binary:match(Msg, <<"content-length">>) of + nomatch -> + ct:log("Message received: ~s", [binary_to_list(Msg)]); + {_, _} -> + ct:log("Message received (negative): ~s", [binary_to_list(Msg)]), + %% Signal a testcase failure when the received HTTP request + %% contains a 'Content-Length' header. + gen_tcp:send(Port, Error), + ct:fail("Content-Length present in received headers.") + end after 1000 -> ct:fail("Timeout: did not recive packet") end. - %%-------------------------------------------------------------------- stream_fun_server_close() -> [{doc, "Test that an error msg is received when using a receiver fun as stream target"}]. @@ -1550,6 +1602,15 @@ delete_no_body(Config) when is_list(Config) -> httpc:request(delete, {URL, [], "text/plain", "TEST"}, [], []). %%-------------------------------------------------------------------- +post_with_content_type(doc) -> + ["Test that a POST request with explicit 'Content-Type' does not drop the 'Content-Type' header - Solves ERL-736"]; +post_with_content_type(Config) when is_list(Config) -> + URL = url(group_name(Config), "/delete_no_body.html", Config), + %% Simulated server replies 500 if 'Content-Type' header is present + {ok, {{_,500,_}, _, _}} = + httpc:request(post, {URL, [], "application/x-www-form-urlencoded", ""}, [], []). + +%%-------------------------------------------------------------------- request_options() -> [{doc, "Test http get request with socket options against local server (IPv6)"}]. request_options(Config) when is_list(Config) -> diff --git a/lib/observer/src/cdv_wx.erl b/lib/observer/src/cdv_wx.erl index 78a897111c..e546997879 100644 --- a/lib/observer/src/cdv_wx.erl +++ b/lib/observer/src/cdv_wx.erl @@ -448,10 +448,7 @@ maybe_warn_filename(FileName) -> true -> continue; false -> - DumpName = case os:getenv("ERL_CRASH_DUMP") of - false -> filename:absname("erl_crash.dump"); - Name -> filename:absname(Name) - end, + DumpName = filename:absname(os:getenv("ERL_CRASH_DUMP", "erl_crash.dump")), case filename:absname(FileName) of DumpName -> Warning = diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index ef9aac34bf..18d94adc18 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -614,6 +614,25 @@ getopts(#sslsocket{}, OptionTags) -> %% %% Description: Sets options %%-------------------------------------------------------------------- +setopts(#sslsocket{pid = [Pid, Sender]}, Options0) when is_pid(Pid), is_list(Options0) -> + try proplists:expand([{binary, [{mode, binary}]}, + {list, [{mode, list}]}], Options0) of + Options -> + case proplists:get_value(packet, Options, undefined) of + undefined -> + ssl_connection:set_opts(Pid, Options); + PacketOpt -> + case tls_sender:setopts(Sender, [{packet, PacketOpt}]) of + ok -> + ssl_connection:set_opts(Pid, Options); + Error -> + Error + end + end + catch + _:_ -> + {error, {options, {not_a_proplist, Options0}}} + end; setopts(#sslsocket{pid = [Pid|_]}, Options0) when is_pid(Pid), is_list(Options0) -> try proplists:expand([{binary, [{mode, binary}]}, {list, [{mode, list}]}], Options0) of diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 33d60ee0e6..3eb3b0a980 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -335,21 +335,12 @@ prf(ConnectionPid, Secret, Label, Seed, WantedLength) -> %%==================================================================== %% Alert and close handling %%==================================================================== -handle_own_alert(Alert, Version, StateName, +handle_own_alert(Alert, _, StateName, #state{role = Role, - transport_cb = Transport, - socket = Socket, protocol_cb = Connection, - connection_states = ConnectionStates, ssl_options = SslOpts} = State) -> try %% Try to tell the other side - {BinMsg, _} = - Connection:encode_alert(Alert, Version, ConnectionStates), - Connection:send(Transport, Socket, BinMsg), - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinMsg}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}) + send_alert(Alert, StateName, State) catch _:_ -> %% Can crash if we are in a uninitialized state ignore end, @@ -1170,24 +1161,20 @@ handle_call({close, {Pid, Timeout}}, From, StateName, State0, Connection) when i %% we must recive the close alert from the peer before releasing the %% transport socket. {next_state, downgrade, State#state{terminated = true}, [{timeout, Timeout, downgrade}]}; -handle_call({close, _} = Close, From, StateName, State, Connection) -> +handle_call({close, _} = Close, From, StateName, State, _Connection) -> %% Run terminate before returning so that the reuseaddr %% inet-option works properly - Result = Connection:terminate(Close, StateName, State#state{terminated = true}), + Result = terminate(Close, StateName, State), stop_and_reply( {shutdown, normal}, - {reply, From, Result}, State); -handle_call({shutdown, How0}, From, _, + {reply, From, Result}, State#state{terminated = true}); +handle_call({shutdown, How0}, From, StateName, #state{transport_cb = Transport, - negotiated_version = Version, - connection_states = ConnectionStates, - socket = Socket} = State, Connection) -> + socket = Socket} = State, _) -> case How0 of How when How == write; How == both -> - Alert = ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), - {BinMsg, _} = - Connection:encode_alert(Alert, Version, ConnectionStates), - Connection:send(Transport, Socket, BinMsg); + send_alert(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), + StateName, State); _ -> ok end, @@ -1353,14 +1340,20 @@ terminate({shutdown, own_alert}, _StateName, #state{ _ -> Connection:close({timeout, ?DEFAULT_TIMEOUT}, Socket, Transport, undefined, undefined) end; +terminate(downgrade = Reason, connection, #state{protocol_cb = Connection, + transport_cb = Transport, socket = Socket + } = State) -> + handle_trusted_certs_db(State), + Connection:close(Reason, Socket, Transport, undefined, undefined); terminate(Reason, connection, #state{protocol_cb = Connection, - connection_states = ConnectionStates, - ssl_options = #ssl_options{padding_check = Check}, - transport_cb = Transport, socket = Socket - } = State) -> + connection_states = ConnectionStates, + ssl_options = #ssl_options{padding_check = Check}, + transport_cb = Transport, socket = Socket + } = State) -> handle_trusted_certs_db(State), Alert = terminate_alert(Reason), - ok = Connection:send_alert_in_connection(Alert, State), + %% Send the termination ALERT if possible + catch (ok = Connection:send_alert_in_connection(Alert, State)), Connection:close(Reason, Socket, Transport, ConnectionStates, Check); terminate(Reason, _StateName, #state{transport_cb = Transport, protocol_cb = Connection, socket = Socket @@ -1397,6 +1390,11 @@ format_status(terminate, [_, StateName, State]) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- +send_alert(Alert, connection, #state{protocol_cb = Connection} = State) -> + Connection:send_alert_in_connection(Alert, State); +send_alert(Alert, _, #state{protocol_cb = Connection} = State) -> + Connection:send_alert(Alert, State). + connection_info(#state{sni_hostname = SNIHostname, session = #session{session_id = SessionId, cipher_suite = CipherSuite, ecc = ECCCurve}, diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index f85e00ea50..8ded2cbff7 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -57,7 +57,9 @@ empty_connection_state/2]). %% Alert and close handling --export([send_alert/2, send_alert_in_connection/2, encode_alert/3, close/5, protocol_name/0]). +-export([send_alert/2, send_alert_in_connection/2, + send_sync_alert/2, + encode_alert/3, close/5, protocol_name/0]). %% Data handling -export([encode_data/3, passive_receive/2, next_record_if_active/1, @@ -364,21 +366,38 @@ encode_alert(#alert{} = Alert, Version, ConnectionStates) -> send_alert(Alert, #state{negotiated_version = Version, socket = Socket, - protocol_cb = Connection, transport_cb = Transport, connection_states = ConnectionStates0, ssl_options = SslOpts} = StateData0) -> - {BinMsg, ConnectionStates} = - Connection:encode_alert(Alert, Version, ConnectionStates0), - Connection:send(Transport, Socket, BinMsg), + {BinMsg, ConnectionStates} = encode_alert(Alert, Version, ConnectionStates0), + send(Transport, Socket, BinMsg), Report = #{direction => outbound, protocol => 'tls_record', message => BinMsg}, ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), StateData0#state{connection_states = ConnectionStates}. -send_alert_in_connection(Alert, #state{protocol_specific = #{sender := Sender}}) -> +%% If an ALERT sent in the connection state, should cause the TLS +%% connection to end, we need to synchronize with the tls_sender +%% process so that the ALERT if possible (that is the tls_sender process is +%% not blocked) is sent before the connection process terminates and +%% thereby closes the transport socket. +send_alert_in_connection(#alert{level = ?FATAL} = Alert, State) -> + send_sync_alert(Alert, State); +send_alert_in_connection(#alert{description = ?CLOSE_NOTIFY} = Alert, State) -> + send_sync_alert(Alert, State); +send_alert_in_connection(Alert, + #state{protocol_specific = #{sender := Sender}}) -> tls_sender:send_alert(Sender, Alert). +send_sync_alert(Alert, #state{protocol_specific = #{sender := Sender}}= State) -> + tls_sender:send_and_ack_alert(Sender, Alert), + receive + {Sender, ack_alert} -> + ok + after ?DEFAULT_TIMEOUT -> + %% Sender is blocked terminate anyway + throw({stop, {shutdown, own_alert}, State}) + end. %% User closes or recursive call! close({close, Timeout}, Socket, Transport = gen_tcp, _,_) -> @@ -536,7 +555,9 @@ hello(internal, #client_hello{client_version = ClientVersion} = Hello, case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, KeyExAlg}, Renegotiation) of #alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, ClientVersion, hello, State); + ssl_connection:handle_own_alert(Alert, ClientVersion, hello, + State#state{negotiated_version + = ClientVersion}); {Version, {Type, Session}, ConnectionStates, Protocol0, ServerHelloExt, HashSign} -> Protocol = case Protocol0 of @@ -559,7 +580,8 @@ hello(internal, #server_hello{} = Hello, ssl_options = SslOptions} = State) -> case tls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of #alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, ReqVersion, hello, State); + ssl_connection:handle_own_alert(Alert, ReqVersion, hello, + State#state{negotiated_version = ReqVersion}); {Version, NewId, ConnectionStates, ProtoExt, Protocol} -> ssl_connection:handle_session(Hello, Version, NewId, ConnectionStates, ProtoExt, Protocol, State) @@ -667,8 +689,8 @@ callback_mode() -> state_functions. terminate(Reason, StateName, State) -> - ensure_sender_terminate(Reason, State), - catch ssl_connection:terminate(Reason, StateName, State). + catch ssl_connection:terminate(Reason, StateName, State), + ensure_sender_terminate(Reason, State). format_status(Type, Data) -> ssl_connection:format_status(Type, Data). @@ -827,8 +849,8 @@ handle_info({CloseTag, Socket}, StateName, %% and then receive the final message. next_event(StateName, no_record, State) end; -handle_info({'EXIT', Pid, Reason}, _, - #state{protocol_specific = Pid} = State) -> +handle_info({'EXIT', Sender, Reason}, _, + #state{protocol_specific = #{sender := Sender}} = State) -> {stop, {shutdown, sender_died, Reason}, State}; handle_info(Msg, StateName, State) -> ssl_connection:StateName(info, Msg, State, ?MODULE). diff --git a/lib/ssl/src/tls_sender.erl b/lib/ssl/src/tls_sender.erl index db67d7ddff..ad6e462279 100644 --- a/lib/ssl/src/tls_sender.erl +++ b/lib/ssl/src/tls_sender.erl @@ -28,7 +28,8 @@ -include("ssl_api.hrl"). %% API --export([start/0, start/1, initialize/2, send_data/2, send_alert/2, renegotiate/1, +-export([start/0, start/1, initialize/2, send_data/2, send_alert/2, + send_and_ack_alert/2, setopts/2, renegotiate/1, update_connection_state/3, dist_tls_socket/1, dist_handshake_complete/3]). %% gen_statem callbacks @@ -80,7 +81,7 @@ initialize(Pid, InitMsg) -> gen_statem:call(Pid, {self(), InitMsg}). %%-------------------------------------------------------------------- --spec send_data(pid(), iodata()) -> ok. +-spec send_data(pid(), iodata()) -> ok | {error, term()}. %% Description: Send application data %%-------------------------------------------------------------------- send_data(Pid, AppData) -> @@ -89,13 +90,28 @@ send_data(Pid, AppData) -> %%-------------------------------------------------------------------- -spec send_alert(pid(), #alert{}) -> _. -%% Description: TLS connection process wants to end an Alert +%% Description: TLS connection process wants to send an Alert %% in the connection state. %%-------------------------------------------------------------------- send_alert(Pid, Alert) -> gen_statem:cast(Pid, Alert). %%-------------------------------------------------------------------- +-spec send_and_ack_alert(pid(), #alert{}) -> _. +%% Description: TLS connection process wants to send an Alert +%% in the connection state and recive an ack. +%%-------------------------------------------------------------------- +send_and_ack_alert(Pid, Alert) -> + gen_statem:cast(Pid, {ack_alert, Alert}). + +%%-------------------------------------------------------------------- +-spec setopts(pid(), [{packet, integer() | atom()}]) -> ok | {error, term()}. +%% Description: Send application data +%%-------------------------------------------------------------------- +setopts(Pid, Opts) -> + call(Pid, {set_opts, Opts}). + +%%-------------------------------------------------------------------- -spec renegotiate(pid()) -> {ok, WriteState::map()} | {error, closed}. %% Description: So TLS connection process can synchronize the %% encryption state to be used when handshaking. @@ -192,6 +208,8 @@ connection({call, From}, {application_data, AppData}, Data -> send_application_data(Data, From, ?FUNCTION_NAME, StateData) end; +connection({call, From}, {set_opts, _} = Call, StateData) -> + handle_call(From, Call, ?FUNCTION_NAME, StateData); connection({call, From}, dist_get_tls_socket, #data{protocol_cb = Connection, transport_cb = Transport, @@ -207,6 +225,10 @@ connection({call, From}, {dist_handshake_complete, _Node, DHandle}, #data{connec process_flag(priority, normal), Events = dist_data_events(DHandle, []), {next_state, ?FUNCTION_NAME, StateData#data{dist_handle = DHandle}, [{reply, From, ok} | Events]}; +connection(cast, {ack_alert, #alert{} = Alert}, #data{connection_pid = Pid} =StateData0) -> + StateData = send_tls_alert(Alert, StateData0), + Pid ! {self(), ack_alert}, + {next_state, ?FUNCTION_NAME, StateData}; connection(cast, #alert{} = Alert, StateData0) -> StateData = send_tls_alert(Alert, StateData0), {next_state, ?FUNCTION_NAME, StateData}; @@ -241,6 +263,8 @@ connection(info, Msg, StateData) -> StateData :: term()) -> gen_statem:event_handler_result(atom()). %%-------------------------------------------------------------------- +handshake({call, From}, {set_opts, _} = Call, StateData) -> + handle_call(From, Call, ?FUNCTION_NAME, StateData); handshake({call, _}, _, _) -> {keep_state_and_data, [postpone]}; handshake(cast, {new_write, WritesState, Version}, @@ -285,6 +309,9 @@ code_change(_OldVsn, State, Data, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== +handle_call(From, {set_opts, Opts}, StateName, #data{socket_options = SockOpts} = StateData) -> + {next_state, StateName, StateData#data{socket_options = set_opts(SockOpts, Opts)}, [{reply, From, ok}]}. + handle_info({'DOWN', Monitor, _, _, Reason}, _, #data{connection_monitor = Monitor, dist_handle = Handle} = StateData) when Handle =/= undefined-> @@ -303,6 +330,11 @@ send_tls_alert(Alert, #data{negotiated_version = Version, {BinMsg, ConnectionStates} = Connection:encode_alert(Alert, Version, ConnectionStates0), Connection:send(Transport, Socket, BinMsg), + %% TODO: fix ssl_options for this process + %% Report = #{direction => outbound, + %% protocol => 'tls_record', + %% message => BinMsg}, + %% ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), StateData0#data{connection_states = ConnectionStates}. send_application_data(Data, From, StateName, @@ -351,6 +383,10 @@ encode_size_packet(Bin, Size, Max) -> false -> <<Len:Size, Bin/binary>> end. + +set_opts(SocketOptions, [{packet, N}]) -> + SocketOptions#socket_options{packet = N}. + time_to_renegotiate(_Data, #{current_write := #{sequence_number := Num}}, RenegotiateAt) -> diff --git a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl index 27062d4801..04c4b257d9 100644 --- a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl @@ -155,7 +155,7 @@ empty_client(Config) when is_list(Config) -> run_failing_handshake(Config, [{alpn_advertised_protocols, []}], [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}], - {connect_failed,{tls_alert,"no application protocol"}}). + {error,{tls_alert,"no application protocol"}}). %-------------------------------------------------------------------------------- @@ -163,7 +163,7 @@ empty_server(Config) when is_list(Config) -> run_failing_handshake(Config, [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], [{alpn_preferred_protocols, []}], - {connect_failed,{tls_alert,"no application protocol"}}). + {error,{tls_alert,"no application protocol"}}). %-------------------------------------------------------------------------------- @@ -171,7 +171,7 @@ empty_client_empty_server(Config) when is_list(Config) -> run_failing_handshake(Config, [{alpn_advertised_protocols, []}], [{alpn_preferred_protocols, []}], - {connect_failed,{tls_alert,"no application protocol"}}). + {error,{tls_alert,"no application protocol"}}). %-------------------------------------------------------------------------------- @@ -179,7 +179,7 @@ no_matching_protocol(Config) when is_list(Config) -> run_failing_handshake(Config, [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}], - {connect_failed,{tls_alert,"no application protocol"}}). + {error,{tls_alert,"no application protocol"}}). %-------------------------------------------------------------------------------- @@ -342,18 +342,19 @@ run_failing_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedResult) ServerOpts = ServerExtraOpts ++ ssl_test_lib:ssl_options(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, {from, self()}, {mfa, {?MODULE, placeholder, []}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - ExpectedResult - = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {?MODULE, placeholder, []}}, - {options, ClientOpts}]). + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, placeholder, []}}, + {options, ClientOpts}]), + ssl_test_lib:check_result(Server, ExpectedResult, + Client, ExpectedResult). run_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) -> Data = "hello world", diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 1970c16f1d..a0cc9f5c08 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -1183,16 +1183,16 @@ fallback(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(Server), - Client = - ssl_test_lib:start_client_error([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {from, self()}, {options, - [{fallback, true}, - {versions, ['tlsv1']} - | ClientOpts]}]), + Client = + ssl_test_lib:start_client_error([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {from, self()}, {options, + [{fallback, true}, + {versions, ['tlsv1']} + | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error,{tls_alert,"inappropriate fallback"}}, - Client, {error,{tls_alert,"inappropriate fallback"}}). + ssl_test_lib:check_result(Server, {error,{tls_alert,"inappropriate fallback"}}, + Client, {error,{tls_alert,"inappropriate fallback"}}). %%-------------------------------------------------------------------- cipher_format() -> @@ -2645,14 +2645,14 @@ default_reject_anonymous(Config) when is_list(Config) -> {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {options, - [{ciphers,[CipherSuite]} | - ClientOpts]}]), + {host, Hostname}, + {from, self()}, + {options, + [{ciphers,[CipherSuite]} | + ClientOpts]}]), ssl_test_lib:check_result(Server, {error, {tls_alert, "insufficient security"}}, - Client, {error, {tls_alert, "insufficient security"}}). + Client, {error, {tls_alert, "insufficient security"}}). %%-------------------------------------------------------------------- ciphers_ecdsa_signed_certs() -> @@ -3605,14 +3605,14 @@ no_common_signature_algs(Config) when is_list(Config) -> | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {options, [{signature_algs, [{sha384, rsa}]} - | ClientOpts]}]), + {host, Hostname}, + {from, self()}, + {options, [{signature_algs, [{sha384, rsa}]} + | ClientOpts]}]), ssl_test_lib:check_result(Server, {error, {tls_alert, "insufficient security"}}, - Client, {error, {tls_alert, "insufficient security"}}). - + Client, {error, {tls_alert, "insufficient security"}}). + %%-------------------------------------------------------------------- tls_dont_crash_on_handshake_garbage() -> diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index f677bf8a6e..bddcc2514d 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -620,8 +620,8 @@ cert_expired(Config) when is_list(Config) -> {from, self()}, {options, [{verify, verify_peer}, {active, Active} | ClientOpts]}]), - tcp_delivery_workaround(Server, {error, {tls_alert, "certificate expired"}}, - Client, {error, {tls_alert, "certificate expired"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "certificate expired"}}, + Client, {error, {tls_alert, "certificate expired"}}). two_digits_str(N) when N < 10 -> lists:flatten(io_lib:format("0~p", [N])); @@ -729,8 +729,8 @@ critical_extension_verify_server(Config) when is_list(Config) -> %% This certificate has a critical extension that we don't %% understand. Therefore, verification should fail. - tcp_delivery_workaround(Server, {error, {tls_alert, "unsupported certificate"}}, - Client, {error, {tls_alert, "unsupported certificate"}}), + ssl_test_lib:check_result(Server, {error, {tls_alert, "unsupported certificate"}}, + Client, {error, {tls_alert, "unsupported certificate"}}), ssl_test_lib:close(Server). %%-------------------------------------------------------------------- @@ -909,8 +909,8 @@ invalid_signature_server(Config) when is_list(Config) -> {from, self()}, {options, [{verify, verify_peer} | ClientOpts]}]), - tcp_delivery_workaround(Server, {error, {tls_alert, "unknown ca"}}, - Client, {error, {tls_alert, "unknown ca"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "unknown ca"}}, + Client, {error, {tls_alert, "unknown ca"}}). %%-------------------------------------------------------------------- @@ -946,8 +946,8 @@ invalid_signature_client(Config) when is_list(Config) -> {from, self()}, {options, NewClientOpts}]), - tcp_delivery_workaround(Server, {error, {tls_alert, "unknown ca"}}, - Client, {error, {tls_alert, "unknown ca"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "unknown ca"}}, + Client, {error, {tls_alert, "unknown ca"}}). %%-------------------------------------------------------------------- @@ -1236,41 +1236,3 @@ incomplete_chain(Config) when is_list(Config) -> %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- -tcp_delivery_workaround(Server, ServerMsg, Client, ClientMsg) -> - receive - {Server, ServerMsg} -> - client_msg(Client, ClientMsg); - {Client, ClientMsg} -> - server_msg(Server, ServerMsg); - {Client, {error,closed}} -> - server_msg(Server, ServerMsg); - {Server, {error,closed}} -> - client_msg(Client, ClientMsg) - end. - -client_msg(Client, ClientMsg) -> - receive - {Client, ClientMsg} -> - ok; - {Client, {error,closed}} -> - ct:log("client got close"), - ok; - {Client, {error, Reason}} -> - ct:log("client got econnaborted: ~p", [Reason]), - ok; - Unexpected -> - ct:fail(Unexpected) - end. -server_msg(Server, ServerMsg) -> - receive - {Server, ServerMsg} -> - ok; - {Server, {error,closed}} -> - ct:log("server got close"), - ok; - {Server, {error, Reason}} -> - ct:log("server got econnaborted: ~p", [Reason]), - ok; - Unexpected -> - ct:fail(Unexpected) - end. diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index 3261244ace..ebf8ddbfac 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -141,6 +141,7 @@ socket_active_packet_tests() -> packet_4_active_some_big, packet_wait_active, packet_size_active, + packet_switch, %% inet header option should be deprecated! header_decode_one_byte_active, header_decode_two_bytes_active, @@ -702,6 +703,34 @@ packet_size_passive(Config) when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- +packet_switch() -> + [{doc,"Test packet option {packet, 2} followd by {packet, 4}"}]. + +packet_switch(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_switch_packet ,["Hello World", 4]}}, + {options, [{nodelay, true},{packet, 2} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, recv_switch_packet, ["Hello World", 4]}}, + {options, [{nodelay, true}, {packet, 2} | + ClientOpts]}]), + + ssl_test_lib:check_result(Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + %%-------------------------------------------------------------------- packet_cdr_decode() -> [{doc,"Test setting the packet option {packet, cdr}, {mode, binary}"}]. @@ -2286,3 +2315,26 @@ client_reject_packet_opt(Config, PacketOpt) -> ClientOpts]}]), ssl_test_lib:check_result(Client, {error, {options, {not_supported, PacketOpt}}}). + + +send_switch_packet(SslSocket, Data, NextPacket) -> + ssl:send(SslSocket, Data), + receive + {ssl, SslSocket, "Hello World"} -> + ssl:setopts(SslSocket, [{packet, NextPacket}]), + ssl:send(SslSocket, Data), + receive + {ssl, SslSocket, "Hello World"} -> + ok + end + end. +recv_switch_packet(SslSocket, Data, NextPacket) -> + receive + {ssl, SslSocket, "Hello World"} -> + ssl:send(SslSocket, Data), + ssl:setopts(SslSocket, [{packet, NextPacket}]), + receive + {ssl, SslSocket, "Hello World"} -> + ssl:send(SslSocket, Data) + end + end. diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index f3235f5614..39a5bcaad6 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1003,7 +1003,6 @@ ecc_test_error(COpts, SOpts, CECCOpts, SECCOpts, Config) -> Error = {error, {tls_alert, "insufficient security"}}, check_result(Server, Error, Client, Error). - start_client(openssl, Port, ClientOpts, Config) -> Cert = proplists:get_value(certfile, ClientOpts), Key = proplists:get_value(keyfile, ClientOpts), @@ -2061,3 +2060,40 @@ hardcode_dsa_key(3) -> y = 48598545580251057979126570873881530215432219542526130654707948736559463436274835406081281466091739849794036308281564299754438126857606949027748889019480936572605967021944405048011118039171039273602705998112739400664375208228641666852589396502386172780433510070337359132965412405544709871654840859752776060358, x = 1457508827177594730669011716588605181448418352823}. +tcp_delivery_workaround(Server, ServerMsg, Client, ClientMsg) -> + receive + {Server, ServerMsg} -> + client_msg(Client, ClientMsg); + {Client, ClientMsg} -> + server_msg(Server, ServerMsg); + {Client, {error,closed}} -> + server_msg(Server, ServerMsg); + {Server, {error,closed}} -> + client_msg(Client, ClientMsg) + end. +client_msg(Client, ClientMsg) -> + receive + {Client, ClientMsg} -> + ok; + {Client, {error,closed}} -> + ct:log("client got close"), + ok; + {Client, {error, Reason}} -> + ct:log("client got econnaborted: ~p", [Reason]), + ok; + Unexpected -> + ct:fail(Unexpected) + end. +server_msg(Server, ServerMsg) -> + receive + {Server, ServerMsg} -> + ok; + {Server, {error,closed}} -> + ct:log("server got close"), + ok; + {Server, {error, Reason}} -> + ct:log("server got econnaborted: ~p", [Reason]), + ok; + Unexpected -> + ct:fail(Unexpected) + end. diff --git a/lib/stdlib/doc/src/epp.xml b/lib/stdlib/doc/src/epp.xml index 1dc0161398..d803d259aa 100644 --- a/lib/stdlib/doc/src/epp.xml +++ b/lib/stdlib/doc/src/epp.xml @@ -124,6 +124,10 @@ <fsummary>Open a file for preprocessing.</fsummary> <desc> <p>Opens a file for preprocessing.</p> + <p>If you want to change the file name of the implicit -file() + attributes inserted during preprocessing, you can do with + <c>{source_name, <anno>SourceName</anno>}</c>. If unset it will + default to the name of the opened file.</p> <p>If <c>extra</c> is specified in <c><anno>Options</anno></c>, the return value is <c>{ok, <anno>Epp</anno>, <anno>Extra</anno>}</c> instead @@ -169,6 +173,10 @@ <p>Preprocesses and parses an Erlang source file. Notice that tuple <c>{eof, <anno>Line</anno>}</c> returned at the end of the file is included as a "form".</p> + <p>If you want to change the file name of the implicit -file() + attributes inserted during preprocessing, you can do with + <c>{source_name, <anno>SourceName</anno>}</c>. If unset it will + default to the name of the opened file.</p> <p>If <c>extra</c> is specified in <c><anno>Options</anno></c>, the return value is <c>{ok, [<anno>Form</anno>], <anno>Extra</anno>}</c> instead diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index cc34d4bdd3..181a524db6 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -117,6 +117,7 @@ open(Name, File, StartLocation, Path, Pdm) -> {'ok', Epp} | {'ok', Epp, Extra} | {'error', ErrorDescriptor} when Options :: [{'default_encoding', DefEncoding :: source_encoding()} | {'includes', IncludePath :: [DirectoryName :: file:name()]} | + {'source_name', SourceName :: file:name()} | {'macros', PredefMacros :: macros()} | {'name',FileName :: file:name()} | 'extra'], @@ -248,6 +249,7 @@ parse_file(Ifile, Path, Predefs) -> {'ok', [Form]} | {'ok', [Form], Extra} | {error, OpenError} when FileName :: file:name(), Options :: [{'includes', IncludePath :: [DirectoryName :: file:name()]} | + {'source_name', SourceName :: file:name()} | {'macros', PredefMacros :: macros()} | {'default_encoding', DefEncoding :: source_encoding()} | 'extra'], @@ -540,9 +542,10 @@ server(Pid, Name, Options, #epp{pre_opened=PreOpened}=St) -> init_server(Pid, Name, Options, St) end. -init_server(Pid, Name, Options, St0) -> +init_server(Pid, FileName, Options, St0) -> + SourceName = proplists:get_value(source_name, Options, FileName), Pdm = proplists:get_value(macros, Options, []), - Ms0 = predef_macros(Name), + Ms0 = predef_macros(FileName), case user_predef(Pdm, Ms0) of {ok,Ms1} -> #epp{file = File, location = AtLocation} = St0, @@ -552,14 +555,14 @@ init_server(Pid, Name, Options, St0) -> epp_reply(Pid, {ok,self(),Encoding}), %% ensure directory of current source file is %% first in path - Path = [filename:dirname(Name) | + Path = [filename:dirname(FileName) | proplists:get_value(includes, Options, [])], - St = St0#epp{delta=0, name=Name, name2=Name, + St = St0#epp{delta=0, name=SourceName, name2=SourceName, path=Path, macs=Ms1, default_encoding=DefEncoding}, From = wait_request(St), Anno = erl_anno:new(AtLocation), - enter_file_reply(From, file_name(Name), Anno, + enter_file_reply(From, file_name(SourceName), Anno, AtLocation, code), wait_req_scan(St); {error,E} -> diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 10e1b75e0f..a90beed4f3 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -29,7 +29,7 @@ otp_8562/1, otp_8665/1, otp_8911/1, otp_10302/1, otp_10820/1, otp_11728/1, encoding/1, extends/1, function_macro/1, test_error/1, test_warning/1, otp_14285/1, - test_if/1]). + test_if/1,source_name/1]). -export([epp_parse_erl_form/2]). @@ -70,7 +70,7 @@ all() -> overload_mac, otp_8388, otp_8470, otp_8562, otp_8665, otp_8911, otp_10302, otp_10820, otp_11728, encoding, extends, function_macro, test_error, test_warning, - otp_14285, test_if]. + otp_14285, test_if, source_name]. groups() -> [{upcase_mac, [], [upcase_mac_1, upcase_mac_2]}, @@ -1702,6 +1702,18 @@ function_macro(Config) -> ok. +source_name(Config) when is_list(Config) -> + DataDir = proplists:get_value(data_dir, Config), + File = filename:join(DataDir, "source_name.erl"), + + source_name_1(File, "/test/gurka.erl"), + source_name_1(File, "gaffel.erl"), + + ok. + +source_name_1(File, Expected) -> + Res = epp:parse_file(File, [{source_name, Expected}]), + {ok, [{attribute,_,file,{Expected,_}} | _Forms]} = Res. check(Config, Tests) -> eval_tests(Config, fun check_test/2, Tests). diff --git a/lib/stdlib/test/epp_SUITE_data/source_name.erl b/lib/stdlib/test/epp_SUITE_data/source_name.erl new file mode 100644 index 0000000000..71ad2dddb9 --- /dev/null +++ b/lib/stdlib/test/epp_SUITE_data/source_name.erl @@ -0,0 +1,27 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(source_name). +-export([ok/0]). + +%% Changing source name should not affect headers +-include("bar.hrl"). + +ok() -> ok. diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 0014793588..2c0692855f 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -41,7 +41,7 @@ -export([t_delete_object/1, t_init_table/1, t_whitebox/1, select_bound_chunk/1, t_delete_all_objects/1, t_insert_list/1, t_test_ms/1, - t_select_delete/1,t_select_replace/1,t_ets_dets/1]). + t_select_delete/1,t_select_replace/1,t_select_replace_next_bug/1,t_ets_dets/1]). -export([ordered/1, ordered_match/1, interface_equality/1, fixtable_next/1, fixtable_insert/1, rename/1, rename_unnamed/1, evil_rename/1, @@ -126,6 +126,7 @@ all() -> select_bound_chunk, t_init_table, t_whitebox, t_delete_all_objects, t_insert_list, t_test_ms, t_select_delete, t_select_replace, + t_select_replace_next_bug, t_ets_dets, memory, t_select_reverse, t_bucket_disappears, t_named_select, select_fail, t_insert_new, t_repair_continuation, @@ -1471,6 +1472,25 @@ t_select_replace(Config) when is_list(Config) -> verify_etsmem(EtsMem). +%% OTP-15346: Bug caused select_replace of bound key to corrupt static stack +%% used by ets:next and ets:prev. +t_select_replace_next_bug(Config) when is_list(Config) -> + T = ets:new(k, [ordered_set]), + [ets:insert(T, {I, value}) || I <- lists:seq(1,10)], + 1 = ets:first(T), + + %% Make sure select_replace does not leave pointer + %% to deallocated {2,value} in static stack. + MS = [{{2,value}, [], [{{2,"new_value"}}]}], + 1 = ets:select_replace(T, MS), + + %% This would crash or give wrong result at least on DEBUG emulator + %% where deallocated memory is overwritten. + 2 = ets:next(T, 1), + + ets:delete(T). + + %% Test that partly bound keys gives faster matches. partly_bound(Config) when is_list(Config) -> case os:type() of diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc index 1dca9608cb..ef753c7148 100644 --- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc @@ -3679,7 +3679,7 @@ create_tempfile(Template) -> false -> case os:getenv("TEMP") of false -> - throw({error, "Variabel TMP or TEMP doesn't exist"}); + throw({error, "Variable TMP or TEMP doesn't exist"}); P2 -> P2 end; |