diff --git a/erts/emulator/beam/atom.h b/erts/emulator/beam/atom.h index 08a5256177c8..69ed93ccdbd7 100644 --- a/erts/emulator/beam/atom.h +++ b/erts/emulator/beam/atom.h @@ -63,6 +63,7 @@ extern IndexTable erts_atom_table; ERTS_GLB_INLINE Atom* atom_tab(Uint i); ERTS_GLB_INLINE int erts_is_atom_utf8_bytes(byte *text, size_t len, Eterm term); ERTS_GLB_INLINE int erts_is_atom_str(const char *str, Eterm term, int is_latin1); +ERTS_GLB_INLINE int erts_is_atom_index_ok(Uint ix); const byte *erts_atom_get_name(const Atom *atom); @@ -119,6 +120,21 @@ ERTS_GLB_INLINE int erts_is_atom_str(const char *str, Eterm term, int is_latin1) return *s == '\0'; } +ERTS_GLB_INLINE int erts_is_atom_index_ok(Uint ix) +{ + /* + * This is technincally a thread-unsafe read, but we assume + * + the hardware will get us a constistent integer value even during + * concurrent writes. + * + the tested 'ix' (if ok) comes from an earlier read of 'entries' + * and 'entries' is never decremented. + * + * So we don't care if we race and miss some unrelated increments. + */ + return ix < (Uint)erts_atom_table.entries; +} + + #endif typedef enum { diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 39fb4d26c623..b114fbbf9c90 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -480,7 +480,6 @@ demonitor(Process *c_p, Eterm ref, Eterm *multip) } case ERTS_ML_STATE_ALIAS_ONCE: case ERTS_ML_STATE_ALIAS_DEMONITOR: - /* fall through... */ default: erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p), mon); if (mon->flags & ERTS_ML_FLG_PRIO_ML) @@ -641,8 +640,7 @@ BIF_RETTYPE demonitor_2(BIF_ALIST_2) BIF_TRAP3(flush_monitor_messages_trap, BIF_P, BIF_ARG_1, multi, res); } - /* Fall through... */ - + ERTS_FALLTHROUGH(); case am_true: if (multi == am_true && flush) goto flush_messages; @@ -1136,12 +1134,13 @@ BIF_RETTYPE erts_internal_spawn_request_4(BIF_ALIST_4) badarg: BIF_RET(am_badarg); + system_limit: error = am_system_limit; goto send_error; + badopt: error = am_badopt; - /* fall through... */ send_error: { Eterm ref = erts_make_ref(BIF_P); if (!(so.flags & SPO_NO_EMSG)) @@ -2208,7 +2207,7 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2) BIF_RET(old_value); } } - /* Fall through and try process_flag_aux() ... */ + /* Continue and try process_flag_aux() ... */ } old_value = process_flag_aux(BIF_P, NULL, BIF_ARG_1, BIF_ARG_2); @@ -2397,7 +2396,7 @@ static Sint remote_send(Process *p, DistEntry *dep, res = 0; break; } - /* Fall through... */ + ERTS_FALLTHROUGH(); case ERTS_DSIG_PREP_PENDING: { code = erts_dsig_send_msg(&ctx, to, full_to, msg, prio); @@ -2571,7 +2570,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm return_term, Eterm *refp, ret_val = SEND_YIELD_RETURN; break; } - /* Fall through */ + ERTS_FALLTHROUGH(); case ERTS_PORT_OP_SCHEDULED: if (is_not_nil(*refp)) { ASSERT(is_internal_ordinary_ref(*refp)); diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 3eb41b33fe9b..5a1202a9d4f6 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -705,7 +705,6 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, break; } argp = hp++; - /* Fall through */ L_copy_list: tailp = argp; @@ -916,7 +915,7 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, erts_refc_inc(&mreft->mb->intern.refc, 2); goto L_off_heap_node_container_common; } - /* Fall through... */ + ERTS_FALLTHROUGH(); default: i = thing_arityval(hdr)+1; hbot -= i; @@ -1723,7 +1722,7 @@ Uint copy_shared_perform_x(Eterm obj, Uint size, erts_shcopy_t *info, erts_refc_inc(&mreft->mb->intern.refc, 2); goto off_heap_node_container_common; } - /* Fall through... */ + ERTS_FALLTHROUGH(); default: sz = thing_arityval(hdr); *resp = make_boxed(hp); diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index e6d277ef86ab..085f15c48344 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -2131,7 +2131,7 @@ int erts_net_message(Port *prt, } } - /* fall through, the first fragment in the sequence was the last fragment */ + /* The first fragment in the sequence was also the last fragment */ ERTS_FALLTHROUGH(); case ERTS_PREP_DIST_EXT_FRAG_CONT: { DistSeqNode *seq; @@ -2461,8 +2461,7 @@ int erts_net_message(Port *prt, if (tuple_arity != 5) { goto invalid_message; } - - /* Fall through ... */ + ERTS_FALLTHROUGH(); case DOP_REG_SEND: /* {DOP_REG_SEND, From, Cookie, ToName} -- Message */ /* {DOP_REG_SEND_TT, From, Cookie, ToName, TraceToken} -- Message */ @@ -6091,7 +6090,7 @@ BIF_RETTYPE erts_internal_dist_spawn_request_4(BIF_ALIST_4) erts_de_runlock(dep); goto notsup; } - /* Fall through... */ + ERTS_FALLTHROUGH(); case ERTS_DSIG_PREP_PENDING: { int inserted; ErtsMonitorData *mdp; @@ -6200,9 +6199,9 @@ BIF_RETTYPE erts_internal_dist_spawn_request_4(BIF_ALIST_4) notsup: error = am_notsup; goto send_error; + badopt: error = am_badopt; - /* fall through... */ send_error: ASSERT(is_value(ok_result)); if (!(monitor_oflags & ERTS_ML_FLG_SPAWN_NO_EMSG)) @@ -6578,7 +6577,7 @@ monitor_node(Process* p, Eterm Node, Eterm Bool, Eterm Options) erts_de_runlock(dep); goto do_trap; } - /*fall through*/ + ERTS_FALLTHROUGH(); case ERTS_DSIG_PREP_CONNECTED: { ErtsMonitor *mon; ErtsMonitorDataExtended *mdep; diff --git a/erts/emulator/beam/emu/emu_load.c b/erts/emulator/beam/emu/emu_load.c index e5eb108ed033..1c1cbc23fe43 100644 --- a/erts/emulator/beam/emu/emu_load.c +++ b/erts/emulator/beam/emu/emu_load.c @@ -948,7 +948,7 @@ int beam_load_emit_op(LoaderState *stp, BeamOp *tmp_op) { break; case TAG_n: ASSERT(tmp_op->a[arg].val == NIL); - /* ! Fall through ! */ + ERTS_FALLTHROUGH(); case TAG_a: code[ci++] = tmp_op->a[arg].val; break; diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c index dbaaf2d93516..dcc4f06171b2 100644 --- a/erts/emulator/beam/erl_arith.c +++ b/erts/emulator/beam/erl_arith.c @@ -260,7 +260,6 @@ erts_shift(Process* p, Eterm arg1, Eterm arg2, int right) } BIF_ERROR(p, SYSTEM_LIMIT); } - /* Fall through if the left argument is not an integer. */ } } BIF_ERROR(p, BADARITH); @@ -888,7 +887,7 @@ erts_mul_add(Process* p, Eterm arg1, Eterm arg2, Eterm arg3, Eterm* pp) break; } big_arg1 = small_to_big(signed_val(big_arg1), tmp_big1); - /* Fall through */ + ERTS_FALLTHROUGH(); case TAG_PRIMARY_BOXED: hdr = *boxed_val(big_arg1); switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { @@ -900,7 +899,7 @@ erts_mul_add(Process* p, Eterm arg1, Eterm arg2, Eterm arg3, Eterm* pp) break; } big_arg2 = small_to_big(signed_val(big_arg2), tmp_big2); - /* Fall through */ + ERTS_FALLTHROUGH(); case TAG_PRIMARY_BOXED: hdr = *boxed_val(big_arg2); switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { @@ -912,7 +911,7 @@ erts_mul_add(Process* p, Eterm arg1, Eterm arg2, Eterm arg3, Eterm* pp) break; } big_arg3 = small_to_big(signed_val(big_arg3), tmp_big3); - /* Fall through */ + ERTS_FALLTHROUGH(); case TAG_PRIMARY_BOXED: hdr = *boxed_val(big_arg3); switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { @@ -1131,7 +1130,7 @@ int erts_int_div_rem(Process* p, Eterm arg1, Eterm arg2, Eterm *q, Eterm *r) ASSERT(rhs == make_small(-1)); lhs = small_to_big(signed_val(lhs), tmp_big1); - /* ! Fall through ! */ + ERTS_FALLTHROUGH(); case BIG_SMALL: rhs = small_to_big(signed_val(rhs), tmp_big2); break; diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c index e396cfb93f21..6641655b33de 100644 --- a/erts/emulator/beam/erl_bif_lists.c +++ b/erts/emulator/beam/erl_bif_lists.c @@ -519,7 +519,7 @@ static void subtract_ctx_move(ErtsSubtractContext *from, break; case SUBTRACT_STAGE_SET_FINISH: uses_result_cdr = 1; - /* FALL THROUGH */ + ERTS_FALLTHROUGH(); case SUBTRACT_STAGE_SET_BUILD: to->u.rhs_set.alloc_start = from->u.rhs_set.alloc_start; to->u.rhs_set.alloc = from->u.rhs_set.alloc; diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c index 4a1c0c5d236a..cfa351a7550e 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -220,7 +220,7 @@ BIF_RETTYPE erts_internal_port_command_3(BIF_ALIST_3) break; case ERTS_PORT_OP_BUSY_SCHEDULED: ASSERT(!(flags & ERTS_PORT_SIG_FLG_FORCE)); - /* Fall through... */ + ERTS_FALLTHROUGH(); case ERTS_PORT_OP_SCHEDULED: ASSERT(is_internal_ordinary_ref(ref)); /* Signal order preserved by reply... */ diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c index 51492184fb73..d6db22245faf 100644 --- a/erts/emulator/beam/erl_bif_re.c +++ b/erts/emulator/beam/erl_bif_re.c @@ -1767,7 +1767,6 @@ re_run(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, bool first) case PCRE2_ERROR_UTF8_ERR20: case PCRE2_ERROR_UTF8_ERR21: BUMP_ALL_REDS(p); /* Unknown amount of work done... */ - /* Fall through for badarg... */ ERTS_FALLTHROUGH(); case PCRE2_ERROR_BADOFFSET: @@ -1886,7 +1885,6 @@ static BIF_RETTYPE re_match_trap(BIF_ALIST_3) case PCRE2_ERROR_UTF8_ERR20: case PCRE2_ERROR_UTF8_ERR21: BUMP_ALL_REDS(BIF_P); /* Unknown amount of work done... */ - /* Fall through for badarg... */ ERTS_FALLTHROUGH(); case PCRE2_ERROR_BADOFFSET: diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 3ab153e2a683..f1ad6d80356d 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -2666,7 +2666,7 @@ erts_finish_breakpointing(void) } /* Neither local or global set for event tracing */ } - /* Nothing to do here. Fall through to next stage. */ + /* Nothing to do here. Continue to next stage. */ finish_bp.current++; ERTS_FALLTHROUGH(); case 1: @@ -2703,7 +2703,7 @@ erts_finish_breakpointing(void) if (finish_bp.local || finish_bp.global) { return 1; } - /* Nothing done here. Fall through to next stage. */ + /* Nothing done here. Continue to next stage. */ finish_bp.current++; ERTS_FALLTHROUGH(); case 3: diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index eb102e80669a..d3c5eecd5663 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -1493,7 +1493,7 @@ do_update_counter(Process *p, DbTable* tb, else if (is_not_small(warp)) { goto finalize; } - /* Fall through */ + ERTS_FALLTHROUGH(); case 2: if (!is_small(tpl[1])) { goto finalize; diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index de67d804c0ab..bf2adac9573a 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -2050,7 +2050,7 @@ Binary *db_match_compile(Eterm *matchexpr, #endif /* - * Fall through to cleanup code, but context.save should not be free'd + * Continue to cleanup code, but context.save should not be free'd */ context.save = NULL; error: /* Here is were we land when compilation failed. */ @@ -5606,8 +5606,8 @@ static DMCRet dmc_expr(DMCContext *context, != retOk) return ret; break; - } - /* Fall through */ + } + ERTS_FALLTHROUGH(); default: simple_term: *constant = true; @@ -5861,7 +5861,7 @@ static Uint my_size_object(Eterm t, bool is_hashmap_node) } break; } - /* fall through */ + ERTS_FALLTHROUGH(); default: sum += size_object(t); break; diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index fe3c77a4d95c..d52dacbe792e 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -1377,6 +1377,8 @@ void erts_reserve_heap__(ErtsHeapFactory* factory, Uint need, Uint xtra) { /* internal... */ ErlHeapFragment* bp; + int replace_oh; + int replace_msg_hfrag; switch (factory->mode) { case FACTORY_HALLOC: @@ -1385,65 +1387,61 @@ void erts_reserve_heap__(ErtsHeapFactory* factory, Uint need, Uint xtra) factory->hp_end = factory->hp + need; return; - case FACTORY_MESSAGE: { - int replace_oh; - int replace_msg_hfrag; - if (!factory->heap_frags) { + case FACTORY_MESSAGE: + if (!factory->heap_frags) { ASSERT(factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG); bp = &factory->message->hfrag; + break; } - else { - /* Fall through */ - case FACTORY_HEAP_FRAGS: - case FACTORY_TMP: - bp = factory->heap_frags; - } - - replace_oh = 0; - replace_msg_hfrag = 0; - - if (bp) { - ASSERT(factory->hp >= bp->mem); - ASSERT(factory->hp <= factory->hp_end); - ASSERT(factory->hp_end == bp->mem + bp->alloc_size); - - bp->used_size = factory->hp - bp->mem; - if (!bp->used_size && factory->heap_frags) { - factory->heap_frags = bp->next; - bp->next = NULL; - ASSERT(!bp->off_heap.first); - if (factory->off_heap == &bp->off_heap) - replace_oh = !0; - if (factory->message && factory->message->data.heap_frag == bp) - replace_msg_hfrag = !0; - free_message_buffer(bp); - } - } - bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(factory->alloc_type, - ERTS_HEAP_FRAG_SIZE(need+xtra)); - bp->next = factory->heap_frags; - factory->heap_frags = bp; - bp->alloc_size = need + xtra; - bp->used_size = need + xtra; - bp->off_heap.first = NULL; - bp->off_heap.overhead = 0; - if (replace_oh) { - factory->off_heap = &bp->off_heap; - factory->off_heap_saved.first = factory->off_heap->first; - factory->off_heap_saved.overhead = factory->off_heap->overhead; - } - if (replace_msg_hfrag) - factory->message->data.heap_frag = bp; - factory->hp = bp->mem; - factory->hp_end = bp->mem + bp->alloc_size; - return; - } + ERTS_FALLTHROUGH(); + case FACTORY_HEAP_FRAGS: + case FACTORY_TMP: + bp = factory->heap_frags; + break; case FACTORY_STATIC: case FACTORY_CLOSED: default: - ASSERT(!"Invalid factory mode"); + erts_exit(ERTS_ABORT_EXIT, "Invalid factory mode %d\n", factory->mode); + } + + replace_oh = 0; + replace_msg_hfrag = 0; + + if (bp) { + ASSERT(factory->hp >= bp->mem); + ASSERT(factory->hp <= factory->hp_end); + ASSERT(factory->hp_end == bp->mem + bp->alloc_size); + + bp->used_size = factory->hp - bp->mem; + if (!bp->used_size && factory->heap_frags) { + factory->heap_frags = bp->next; + bp->next = NULL; + ASSERT(!bp->off_heap.first); + if (factory->off_heap == &bp->off_heap) + replace_oh = !0; + if (factory->message && factory->message->data.heap_frag == bp) + replace_msg_hfrag = !0; + free_message_buffer(bp); + } + } + bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(factory->alloc_type, + ERTS_HEAP_FRAG_SIZE(need+xtra)); + bp->next = factory->heap_frags; + factory->heap_frags = bp; + bp->alloc_size = need + xtra; + bp->used_size = need + xtra; + bp->off_heap.first = NULL; + bp->off_heap.overhead = 0; + if (replace_oh) { + factory->off_heap = &bp->off_heap; + factory->off_heap_saved.first = factory->off_heap->first; + factory->off_heap_saved.overhead = factory->off_heap->overhead; } + if (replace_msg_hfrag) + factory->message->data.heap_frag = bp; + factory->hp = bp->mem; + factory->hp_end = bp->mem + bp->alloc_size; } void erts_factory_close(ErtsHeapFactory* factory) @@ -1468,7 +1466,7 @@ void erts_factory_close(ErtsHeapFactory* factory) else factory->message->data.heap_frag = factory->heap_frags; - /* Fall through */ + ERTS_FALLTHROUGH(); case FACTORY_HEAP_FRAGS: bp = factory->heap_frags; } diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index 3f03adf0079d..f9b380f20440 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -484,7 +484,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) { case REF_DEF: if (!ERTS_IS_CRASH_DUMPING) erts_magic_ref_save_bin(obj); - /* fall through... */ + ERTS_FALLTHROUGH(); case EXTERNAL_REF_DEF: PRINT_STRING(res, fn, arg, "#Ref<"); PRINT_UWORD(res, fn, arg, 'u', 0, 1, @@ -720,7 +720,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) { PRINT_STRING(res, fn, arg, "#{"); WSTACK_PUSH(s, PRT_CLOSE_TUPLE); head++; - /* fall through */ + ERTS_FALLTHROUGH(); case MAP_HEADER_TAG_HAMT_NODE_BITMAP: n = hashmap_bitcount(mapval); ASSERT(0 < n && n < 17); diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c index e42b9d94440c..73ccf147dfd1 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.c +++ b/erts/emulator/beam/erl_proc_sig_queue.c @@ -3540,7 +3540,7 @@ erts_proc_sig_init_flush_signals(Process *c_p, int flags, Eterm id) case ERTS_PROC_SIG_FLUSH_FLG_FROM_ALL: id = c_p->common.id; force_flush_buffers = !0; - /* Fall through... */ + ERTS_FALLTHROUGH(); case ERTS_PROC_SIG_FLUSH_FLG_FROM_ID: if (!proc_queue_signal(NULL, id, c_p->common.id, sig, force_flush_buffers, ERTS_SIG_Q_OP_FLUSH)) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index ca8c7216e8e9..133d08416432 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -1585,7 +1585,7 @@ erts_sched_finish_poke(ErtsSchedulerSleepInfo *ssi, * to signal on both... */ erts_check_io_interrupt(ssi->psi, 1); - /* fall through */ + ERTS_FALLTHROUGH(); case ERTS_SSI_FLG_TSE_SLEEPING: erts_tse_set(ssi->event); break; @@ -10706,7 +10706,7 @@ fetch_sys_task(Process *c_p, erts_aint32_t state, int *qmaskp, int *priop) } c_p->sys_task_qs->ncount = 0; qbit = LOW_BIT; - /* Fall through */ + ERTS_FALLTHROUGH(); case LOW_BIT: qp = &c_p->sys_task_qs->q[PRIORITY_LOW]; *priop = PRIORITY_LOW; @@ -11031,7 +11031,7 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds) case ERTS_PSTT_PRIO_SIG: state = erts_atomic32_read_nob(&c_p->state); exit_permanent_prio_elevation(c_p, state, st_prio); - /* fall through... */ + ERTS_FALLTHROUGH(); case ERTS_PSTT_GC_MAJOR: case ERTS_PSTT_GC_MINOR: case ERTS_PSTT_CPC: diff --git a/erts/emulator/beam/erl_term_hashing.c b/erts/emulator/beam/erl_term_hashing.c index 5b8f23bd34a3..501c9cb64543 100644 --- a/erts/emulator/beam/erl_term_hashing.c +++ b/erts/emulator/beam/erl_term_hashing.c @@ -303,7 +303,7 @@ Uint32 make_hash(Eterm term_arg) WSTACK_PUSH(stack, (UWord) MAKE_HASH_CDR_POST_OP); goto tail_recur; } - /* fall through */ + ERTS_FALLTHROUGH(); case LIST_DEF: { Eterm* list = list_val(term); @@ -370,7 +370,8 @@ Uint32 make_hash(Eterm term_arg) WSTACK_PUSH3(stack, (UWord) arity, (UWord)(ptr+1), (UWord) arity); op = MAKE_HASH_TUPLE_OP; - }/*fall through*/ + } + ERTS_FALLTHROUGH(); case MAKE_HASH_TUPLE_OP: case MAKE_HASH_TERM_ARRAY_OP: { diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 924163cef372..5e48b475edbb 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -98,9 +98,10 @@ static int is_external_string(Eterm obj, Uint* lenp); static byte* enc_atom(ErtsAtomCacheMap *, Eterm, byte*, Uint64); static byte* enc_pid(ErtsAtomCacheMap *, Eterm, byte*, Uint64); struct B2TContext_t; -static const byte* dec_term(ErtsDistExternal*, ErtsHeapFactory*, const byte*, Eterm*, struct B2TContext_t*, int); -static const byte* dec_atom(ErtsDistExternal *, const byte*, Eterm*, int); -static const byte* dec_pid(ErtsDistExternal *, ErtsHeapFactory*, const byte*, Eterm*, byte tag, int); +static const byte* dec_term(ErtsDistExternal*, ErtsHeapFactory*, const byte*, Eterm*, struct B2TContext_t*, Uint32 flags); +static const byte* dec_atom(ErtsDistExternal *, const byte*, Eterm*, Uint32 flags); +static const byte* dec_sysname(ErtsDistExternal *, const byte*, Eterm*, Uint32 flags); +static const byte* dec_pid(ErtsDistExternal *, ErtsHeapFactory*, const byte*, Eterm*, byte tag, Uint32 flags); static Sint decoded_size(const byte *ep, const byte* endp, int internal_tags, struct B2TContext_t*); static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1); @@ -119,11 +120,6 @@ static void store_in_vec(TTBEncodeContext *ctx, byte *ep, Binary *ohbin, Eterm o static Uint32 calc_iovec_fun_size(SysIOVec* iov, Uint32 fun_high_ix, byte* size_p); void erts_init_external(void) { - ERTS_CT_ASSERT(offsetof(ErtsDistExternalFake,data) == - offsetof(ErtsDistExternal,data)); - ERTS_CT_ASSERT(offsetof(ErtsDistExternalFake,flags) == - offsetof(ErtsDistExternal,flags)); - erts_init_trap_export(&term_to_binary_trap_export, am_erts_internal, am_term_to_binary_trap, 1, &term_to_binary_trap_1); @@ -1315,23 +1311,14 @@ erts_decode_dist_ext(ErtsHeapFactory* factory, Eterm erts_decode_ext(ErtsHeapFactory* factory, const byte **ext, Uint32 flags) { - ErtsDistExternalFake ede; - ErtsDistExternal *edep; Eterm obj; const byte *ep = *ext; if (*ep++ != VERSION_MAGIC) { erts_factory_undo(factory); return THE_NON_VALUE; } - if (flags) { - ASSERT(flags == ERTS_DIST_EXT_BTT_SAFE); - ede.flags = flags; /* a dummy struct just for the flags */ - ede.data = NULL; - edep = (ErtsDistExternal*) &ede; - } else { - edep = NULL; - } - ep = dec_term(edep, factory, ep, &obj, NULL, 0); + ASSERT(!(flags & ~ERTS_DIST_EXT_BTT_SAFE)); + ep = dec_term(NULL, factory, ep, &obj, NULL, flags); if (!ep) { return THE_NON_VALUE; } @@ -1342,7 +1329,7 @@ Eterm erts_decode_ext(ErtsHeapFactory* factory, const byte **ext, Uint32 flags) Eterm erts_decode_ext_ets(ErtsHeapFactory* factory, const byte *ext) { Eterm obj; - ext = dec_term(NULL, factory, ext, &obj, NULL, 1); + ext = dec_term(NULL, factory, ext, &obj, NULL, ERTS_DIST_EXT_INTERNAL_NC); ASSERT(ext); return obj; } @@ -1694,7 +1681,6 @@ typedef struct { Eterm* next; ErtsHeapFactory factory; int remaining_n; - int internal_nc; char* remaining_bytes; ErtsPStack map_array; } B2TDecodeContext; @@ -2035,7 +2021,7 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Eterm bin, B2TContext *ctx) case B2TSizeInit: ctx->u.sc.ep = NULL; ctx->state = B2TSize; - /*fall through*/ + ERTS_FALLTHROUGH(); case B2TSize: ctx->heap_size = decoded_size(ctx->b2ts.extp, ctx->b2ts.extp + ctx->b2ts.extsize, @@ -2052,24 +2038,19 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Eterm bin, B2TContext *ctx) ctx->u.dc.ep = ctx->b2ts.extp; ctx->u.dc.res = (Eterm) (UWord) NULL; ctx->u.dc.next = &ctx->u.dc.res; - ctx->u.dc.internal_nc = 0; erts_factory_proc_prealloc_init(&ctx->u.dc.factory, p, ctx->heap_size); ctx->u.dc.map_array.pstart = NULL; ctx->state = B2TDecode; - /*fall through*/ + ERTS_FALLTHROUGH(); case B2TDecode: case B2TDecodeList: case B2TDecodeTuple: case B2TDecodeString: case B2TDecodeBinary: { - ErtsDistExternalFake fakedep; - fakedep.flags = ctx->flags; - fakedep.data = NULL; - dec_term((ErtsDistExternal*)&fakedep, NULL, NULL, NULL, ctx, 0); + dec_term(NULL, NULL, NULL, NULL, ctx, 0); break; } case B2TDecodeFail: - /*fall through*/ case B2TBadArg: BUMP_REDS(p, (initial_reds - ctx->reds) / B2T_BYTES_PER_REDUCTION); @@ -3034,15 +3015,17 @@ enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint64 dflags) /* Expect an atom in plain text or cached */ static const byte* -dec_atom(ErtsDistExternal *edep, const byte* ep, Eterm* objp, int internal_nc) +dec_atom(ErtsDistExternal *edep, const byte* ep, Eterm* objp, Uint32 flags) { Uint len; int n; ErtsAtomEncoding char_enc; + ASSERT(edep || !(flags & ERTS_DIST_EXT_ATOM_TRANS_TAB)); + switch (*ep++) { case ATOM_CACHE_REF: - if (!(edep && (edep->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB))) + if (!(flags & ERTS_DIST_EXT_ATOM_TRANS_TAB)) goto error; n = get_int8(ep); ep++; @@ -3071,7 +3054,7 @@ dec_atom(ErtsDistExternal *edep, const byte* ep, Eterm* objp, int internal_nc) ep++; char_enc = ERTS_ATOM_ENC_UTF8; dec_atom_common: - if (edep && (edep->flags & ERTS_DIST_EXT_BTT_SAFE)) { + if (flags & ERTS_DIST_EXT_BTT_SAFE) { if (!erts_atom_get((char*)ep, len, objp, char_enc)) { goto error; } @@ -3099,12 +3082,6 @@ dec_atom(ErtsDistExternal *edep, const byte* ep, Eterm* objp, int internal_nc) } *objp = make_atom(n); break; - case NIL_EXT: - if (!internal_nc) { - goto error; - } - *objp = INTERNAL_LOCAL_SYSNAME; - break; default: error: *objp = NIL; /* Don't leave a hole in the heap */ @@ -3113,6 +3090,20 @@ dec_atom(ErtsDistExternal *edep, const byte* ep, Eterm* objp, int internal_nc) return ep; } +static const byte* +dec_sysname(ErtsDistExternal *edep, const byte* ep, Eterm* objp, Uint32 flags) +{ + const byte* ret_ep = dec_atom(edep, ep, objp, flags); + + if (!ret_ep && (flags & ERTS_DIST_EXT_INTERNAL_NC)) { + if (*ep == NIL_EXT) { + *objp = INTERNAL_LOCAL_SYSNAME; + ret_ep = ep+1; + } + } + return ret_ep; +} + static ERTS_INLINE int dec_is_this_node(Eterm sysname, Uint32 creation) { return (sysname == INTERNAL_LOCAL_SYSNAME @@ -3132,7 +3123,7 @@ static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint32 creation, Eterm b static const byte* dec_pid(ErtsDistExternal *edep, ErtsHeapFactory* factory, const byte* ep, - Eterm* objp, byte tag, int internal_nc) + Eterm* objp, byte tag, Uint32 flags) { Eterm sysname; Uint data; @@ -3143,7 +3134,7 @@ dec_pid(ErtsDistExternal *edep, ErtsHeapFactory* factory, const byte* ep, *objp = NIL; /* In case we fail, don't leave a hole in the heap */ /* eat first atom */ - if ((ep = dec_atom(edep, ep, &sysname, internal_nc)) == NULL) + if ((ep = dec_sysname(edep, ep, &sysname, flags)) == NULL) return NULL; num = get_uint32(ep); ep += 4; @@ -3799,7 +3790,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, next_map_element = map_array = alloc_map_array(*ptr); WSTACK_PUSH2(s, ENC_START_SORTING_MAP, THE_NON_VALUE); } - /*fall through*/ + ERTS_FALLTHROUGH(); case HAMT_SUBTAG_NODE_BITMAP: node_sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); ASSERT(node_sz < 17); @@ -3889,7 +3880,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, case BITSTRING_INTERNAL_REF: sys_memcpy(ep, boxed_val(obj), sizeof(ErlSubBits)); ep += sizeof(ErlSubBits); - /* Fall through! */ + ERTS_FALLTHROUGH(); case BINARY_INTERNAL_REF: { BinRef tmp_ref; @@ -4256,11 +4247,11 @@ dec_term(ErtsDistExternal *edep, const byte* ep, Eterm* objp, B2TContext* ctx, - int ets_decode) + Uint32 flags) { #define PSTACK_TYPE struct dec_term_map PSTACK_DECLARE(map_array, 10); - int n, internal_nc = ets_decode; + int n; ErtsAtomEncoding char_enc; register Eterm* hp; /* Please don't take the address of hp */ Eterm* next; @@ -4270,11 +4261,13 @@ dec_term(ErtsDistExternal *edep, #endif if (ctx) { + ASSERT(!edep); + ASSERT(!flags); + flags = ctx->flags; reds = ctx->reds; next = ctx->u.dc.next; ep = ctx->u.dc.ep; factory = &ctx->u.dc.factory; - internal_nc = ctx->u.dc.internal_nc; if (ctx->state != B2TDecode) { int n_limit = reds; @@ -4355,6 +4348,13 @@ dec_term(ErtsDistExternal *edep, } } else { + if (edep) { + if (!flags) { + flags = edep->flags; + } + } else { + ASSERT(!(flags & ERTS_DIST_EXT_ATOM_TRANS_TAB)); + } reds = ERTS_SWORD_MAX; next = objp; *next = (Eterm) (UWord) NULL; @@ -4433,9 +4433,10 @@ dec_term(ErtsDistExternal *edep, break; } case ATOM_CACHE_REF: - if (edep == 0 || (edep->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB) == 0) { + if (!(flags & ERTS_DIST_EXT_ATOM_TRANS_TAB)) { goto error; } + ASSERT(edep); n = get_int8(ep); ep++; if (n >= edep->attab.size) @@ -4463,7 +4464,7 @@ dec_term(ErtsDistExternal *edep, ep++; char_enc = ERTS_ATOM_ENC_UTF8; dec_term_atom_common: - if (edep && (edep->flags & ERTS_DIST_EXT_BTT_SAFE)) { + if (flags & ERTS_DIST_EXT_BTT_SAFE) { if (!erts_atom_get((char*)ep, n, objp, char_enc)) { goto error; } @@ -4611,7 +4612,7 @@ dec_term(ErtsDistExternal *edep, case PID_EXT: case NEW_PID_EXT: factory->hp = hp; - ep = dec_pid(edep, factory, ep, objp, ep[-1], internal_nc); + ep = dec_pid(edep, factory, ep, objp, ep[-1], flags); hp = factory->hp; if (ep == NULL) { goto error; @@ -4627,7 +4628,7 @@ dec_term(ErtsDistExternal *edep, Uint32 cre; byte tag = ep[-1]; - if ((ep = dec_atom(edep, ep, &sysname, internal_nc)) == NULL) { + if ((ep = dec_sysname(edep, ep, &sysname, flags)) == NULL) { goto error; } if (tag == V4_PORT_EXT) { @@ -4687,7 +4688,7 @@ dec_term(ErtsDistExternal *edep, ref_words = 1; - if ((ep = dec_atom(edep, ep, &sysname, internal_nc)) == NULL) + if ((ep = dec_sysname(edep, ep, &sysname, flags)) == NULL) goto error; if ((r0 = get_int32(ep)) >= MAX_REFERENCE ) goto error; @@ -4704,7 +4705,7 @@ dec_term(ErtsDistExternal *edep, ref_words = get_int16(ep); ep += 2; - if ((ep = dec_atom(edep, ep, &sysname, internal_nc)) == NULL) + if ((ep = dec_sysname(edep, ep, &sysname, flags)) == NULL) goto error; cre = get_int8(ep); @@ -4722,7 +4723,7 @@ dec_term(ErtsDistExternal *edep, ref_words = get_int16(ep); ep += 2; - if ((ep = dec_atom(edep, ep, &sysname, internal_nc)) == NULL) + if ((ep = dec_sysname(edep, ep, &sysname, flags)) == NULL) goto error; cre = get_int32(ep); @@ -4921,14 +4922,14 @@ dec_term(ErtsDistExternal *edep, Eterm temp; Sint arity; - if ((ep = dec_atom(edep, ep, &mod, 0)) == NULL) { + if ((ep = dec_atom(edep, ep, &mod, flags)) == NULL) { goto error; } - if ((ep = dec_atom(edep, ep, &name, 0)) == NULL) { + if ((ep = dec_atom(edep, ep, &name, flags)) == NULL) { goto error; } factory->hp = hp; - ep = dec_term(edep, factory, ep, &temp, NULL, 0); + ep = dec_term(edep, factory, ep, &temp, NULL, flags); if (ep == NULL) { goto error; } @@ -4939,7 +4940,7 @@ dec_term(ErtsDistExternal *edep, if (arity < 0) { goto error; } - if (edep && (edep->flags & ERTS_DIST_EXT_BTT_SAFE)) { + if (flags & ERTS_DIST_EXT_BTT_SAFE) { if (!erts_active_export_entry(mod, name, arity)) { goto error; } @@ -5038,12 +5039,12 @@ dec_term(ErtsDistExternal *edep, hp += ERL_FUN_SIZE + num_free; /* Module */ - if ((ep = dec_atom(edep, ep, &module, 0)) == NULL) { + if ((ep = dec_atom(edep, ep, &module, flags)) == NULL) { goto error; } factory->hp = hp; /* Index */ - if ((ep = dec_term(edep, factory, ep, &temp, NULL, 0)) == NULL) { + if ((ep = dec_term(edep, factory, ep, &temp, NULL, flags)) == NULL) { goto error; } if (!is_small(temp)) { @@ -5052,7 +5053,7 @@ dec_term(ErtsDistExternal *edep, old_index = unsigned_val(temp); /* Uniq */ - if ((ep = dec_term(edep, factory, ep, &temp, NULL, 0)) == NULL) { + if ((ep = dec_term(edep, factory, ep, &temp, NULL, flags)) == NULL) { goto error; } if (!is_small(temp)) { @@ -5062,7 +5063,7 @@ dec_term(ErtsDistExternal *edep, /* Creator pid, discarded */ if ((ep = dec_term(edep, factory, ep, &temp, NULL, - internal_nc)) == NULL) { + flags)) == NULL) { goto error; } if (!is_pid(temp)) { @@ -5087,10 +5088,7 @@ dec_term(ErtsDistExternal *edep, case ATOM_INTERNAL_REF2: n = get_int16(ep); ep += 2; - /* If this is an ets_decode we know that - the atom is valid, so we can skip the - validation check */ - if (!ets_decode && n >= atom_table_size()) { + if (!erts_is_atom_index_ok(n)) { goto error; } *objp = make_atom(n); @@ -5098,10 +5096,7 @@ dec_term(ErtsDistExternal *edep, case ATOM_INTERNAL_REF3: n = get_int24(ep); ep += 3; - /* If this is an ets_decode we know that - the atom is valid, so we can skip the - validation check */ - if (!ets_decode && n >= atom_table_size()) { + if (!erts_is_atom_index_ok(n)) { goto error; } *objp = make_atom(n); @@ -5164,9 +5159,9 @@ dec_term(ErtsDistExternal *edep, } case LOCAL_EXT: - internal_nc = !0; + flags |= ERTS_DIST_EXT_INTERNAL_NC; if (ctx) - ctx->u.dc.internal_nc = !0; + ctx->flags = flags; ep += 4; /* 32-bit hash (verified in decoded_size()) */ goto continue_this_obj; @@ -5544,7 +5539,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, case HAMT_SUBTAG_HEAD_BITMAP: ptr++; result += 1 + 4; /* tag + 4 bytes size */ - /*fall through*/ + ERTS_FALLTHROUGH(); case HAMT_SUBTAG_NODE_BITMAP: node_sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); ASSERT(node_sz < 17); @@ -5617,14 +5612,14 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, switch (encoding) { case BITSTRING_INTERNAL_REF: result += sizeof(ErlSubBits); - /* !! FALL THROUGH !! */ + ERTS_FALLTHROUGH(); case BINARY_INTERNAL_REF: result += 1 /* [BIT_]BINARY_INTERNAL_REF */ + sizeof(BinRef); break; case BIT_BINARY_EXT: result += 1; /* Trailing bit count. */ - /* !! FALL THROUGH !! */ + ERTS_FALLTHROUGH(); case BINARY_EXT: result += 1 /* [BIT_]BINARY_EXT */ + 4 /* Size in bytes */; @@ -6167,7 +6162,7 @@ decoded_size(const byte *ep, const byte* endp, int internal_tags, B2TContext* ct goto error; } SKIP(sizeof(ErlSubBits)); - /* !!! FALL THROUGH !!! */ + ERTS_FALLTHROUGH(); case BINARY_INTERNAL_REF: if (!internal_tags) { goto error; diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index cfe4b956b2f5..f95992f5bd88 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -131,6 +131,7 @@ typedef struct { #define ERTS_DIST_EXT_DFLAG_HDR ((Uint32) 0x1) #define ERTS_DIST_EXT_ATOM_TRANS_TAB ((Uint32) 0x2) #define ERTS_DIST_EXT_BTT_SAFE ((Uint32) 0x4) +#define ERTS_DIST_EXT_INTERNAL_NC ((Uint32) 0x8) #define ERTS_DIST_CON_ID_MASK ((Uint32) 0x00ffffff) @@ -148,7 +149,6 @@ struct erl_dist_external_data { typedef struct erl_dist_external { ErtsDistExternalData *data; Uint32 flags; - Uint32 connection_id; Sint heap_size; DistEntry *dep; @@ -156,14 +156,6 @@ typedef struct erl_dist_external { ErtsAtomTranslationTable attab; } ErtsDistExternal; -/* This fake one is used to impersonate ErtsDistExternal for dec_term() - * just for the flags without a large unused ErtsAtomTranslationTable. - */ -typedef struct { - ErtsDistExternalData *data; - Uint32 flags; -} ErtsDistExternalFake; - typedef struct { byte *extp; int exttmp; diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index d5b3b9d52b71..a1215883844d 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1894,7 +1894,7 @@ erts_port_output(Process *c_p, finalize_force_imm_drv_call(&try_call_state); else finalize_imm_drv_call(&try_call_state); - /* Fall through... */ + ERTS_FALLTHROUGH(); case ERTS_TRY_IMM_DRV_CALL_INVALID_PORT: driver_free_binary(&cbin->driver); if (evp != &ev) { @@ -2062,7 +2062,7 @@ erts_port_output(Process *c_p, finalize_force_imm_drv_call(&try_call_state); else finalize_imm_drv_call(&try_call_state); - /* Fall through... */ + ERTS_FALLTHROUGH(); case ERTS_TRY_IMM_DRV_CALL_INVALID_PORT: erts_free(ERTS_ALC_T_TMP, buf); if (try_call_res != ERTS_TRY_IMM_DRV_CALL_OK) diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 664a523011f2..a24b4d0a0044 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2298,12 +2298,14 @@ Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only) #endif /* ERTS_SIZEOF_ETERM == 8 */ break; case FLOAT_BIG: - if (exact) goto exact_fall_through; - { - Eterm tmp = aw; - aw = bw; - bw = tmp; - }/* fall through */ + if (exact) { + goto exact_fall_through; + } else { + Eterm tmp = aw; + aw = bw; + bw = tmp; + } + ERTS_FALLTHROUGH(); case BIG_FLOAT: if (exact) goto exact_fall_through; GET_DOUBLE(bw, f2); diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index b9267041de24..e7b0de7c8cba 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -7204,7 +7204,7 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len) "inet_set_opts(reuseport) -> %s\r\n", __LINE__, desc->s, driver_caller(desc->port), B2S(ival)) ); #if defined(__WIN32__) - /* fall through to INET_OPT_REUSEADDR */ + ERTS_FALLTHROUGH(); /* to INET_OPT_REUSEADDR */ #elif defined(SO_REUSEPORT) type = SO_REUSEPORT; break; @@ -8308,7 +8308,7 @@ static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len) "sctp_set_opts -> REUSEPORT\r\n", __LINE__, desc->s, driver_caller(desc->port)) ); #if defined(__WIN32__) - /* fall through to INET_OPT_REUSEADDR */ + ERTS_FALLTHROUGH(); /* to INET_OPT_REUSEADDR */ #elif defined(SO_REUSEPORT) arg.ival= get_int32 (curr); curr += 4; proto = SOL_SOCKET;