diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index d3296846b1f7..53ed97cf6365 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -601,6 +601,7 @@ atom protected atom protection atom ptab_list_continue atom public +atom put_common_trap atom queue_size atom raw atom re diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 95fcb0589f11..610961993f06 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -813,7 +813,6 @@ bif erts_internal:processes_next/1 bif code:get_debug_info/1 bif erlang:exit/3 bif erlang:link/2 - bif erl_debugger:supported/0 bif erl_debugger:instrumentations/0 bif erl_debugger:toggle_instrumentations/1 @@ -834,3 +833,4 @@ bif erl_debugger:peek_xreg/3 # bif erts_debug:unaligned_bitstring/2 bif re:import/1 +bif persistent_term:put_new/2 diff --git a/erts/emulator/beam/erl_bif_persistent.c b/erts/emulator/beam/erl_bif_persistent.c index 7ff7c53d8a3a..6f95e1f65714 100644 --- a/erts/emulator/beam/erl_bif_persistent.c +++ b/erts/emulator/beam/erl_bif_persistent.c @@ -113,11 +113,11 @@ typedef struct { } ErtsPersistentTermCpyTableCtx; typedef enum { - PUT2_TRAP_LOCATION_NEW_KEY -} ErtsPersistentTermPut2TrapLocation; + PUT_COMMON_TRAP_LOCATION_NEW_KEY, +} ErtsPersistentTermPutCommonTrapLocation; typedef struct { - ErtsPersistentTermPut2TrapLocation trap_location; + ErtsPersistentTermPutCommonTrapLocation trap_location; Eterm key; Eterm term; Uint entry_index; @@ -125,7 +125,7 @@ typedef struct { Eterm heap[3]; Eterm tuple; ErtsPersistentTermCpyTableCtx cpy_ctx; -} ErtsPersistentTermPut2Context; +} ErtsPersistentTermPutCommonContext; typedef enum { ERASE1_TRAP_LOCATION_TMP_COPY, @@ -148,6 +148,7 @@ typedef struct { * Declarations of local functions. */ +static Eterm put_common(Process* process, Eterm key, Eterm term, Eterm new); static HashTable* create_initial_table(void); static Uint lookup(HashTable* hash_table, Eterm key, Eterm *bucket); static int is_erasable(HashTable* hash_table, Uint idx); @@ -172,6 +173,8 @@ static int cleanup_trap_data(Binary *bp); * Traps */ +static Export persistent_term_put_common_export; +static BIF_RETTYPE persistent_term_put_common_trap(BIF_ALIST_3); static Export persistent_term_get_all_export; static BIF_RETTYPE persistent_term_get_all_trap(BIF_ALIST_2); static Export persistent_term_info_export; @@ -253,6 +256,10 @@ void erts_init_bif_persistent_term(void) * Initialize export entry for traps */ + + erts_init_trap_export(&persistent_term_put_common_export, + am_persistent_term, am_put_common_trap, 3, + &persistent_term_put_common_trap); erts_init_trap_export(&persistent_term_get_all_export, am_persistent_term, am_get_all_trap, 2, &persistent_term_get_all_trap); @@ -262,10 +269,10 @@ void erts_init_bif_persistent_term(void) } /* - * Macro used for trapping in persistent_term_put_2 and - * persistent_term_erase_1 + * Macro used for trapping in persistent_term_put_2, + * persistent_term_put_new_2 and persistent_term_erase_1 */ -#define TRAPPING_COPY_TABLE(TABLE_DEST, OLD_TABLE, NEW_SIZE, COPY_TYPE, LOC_NAME, TRAP_CODE) \ +#define TRAPPING_COPY_TABLE(TABLE_DEST, OLD_TABLE, NEW_SIZE, COPY_TYPE, LOC_NAME, TRAP_CODE, BIF_PROCESS) \ do { \ ctx->cpy_ctx = (ErtsPersistentTermCpyTableCtx){ \ .old_table = OLD_TABLE, \ @@ -279,15 +286,15 @@ void erts_init_bif_persistent_term(void) iterations_until_trap -= ctx->cpy_ctx.total_iterations_done; \ if (TABLE_DEST == NULL) { \ ctx->trap_location = LOC_NAME; \ - erts_set_gc_state(BIF_P, 0); \ - BUMP_ALL_REDS(BIF_P); \ + erts_set_gc_state(BIF_PROCESS, 0); \ + BUMP_ALL_REDS(BIF_PROCESS); \ TRAP_CODE; \ } \ } while (0) -static int persistent_term_put_2_ctx_bin_dtor(Binary *context_bin) +static int persistent_term_put_common_bin_dtor(Binary *context_bin) { - ErtsPersistentTermPut2Context* ctx = ERTS_MAGIC_BIN_DATA(context_bin); + ErtsPersistentTermPutCommonContext* ctx = ERTS_MAGIC_BIN_DATA(context_bin); if (ctx->cpy_ctx.new_table != NULL) { erts_free(ERTS_ALC_T_PERSISTENT_TERM, ctx->cpy_ctx.new_table); release_update_permission(0); @@ -295,9 +302,9 @@ static int persistent_term_put_2_ctx_bin_dtor(Binary *context_bin) return 1; } /* - * A linear congruential generator that is used in the debug emulator - * to trap after a random number of iterations in - * persistent_term_put_2 and persistent_term_erase_1. + * A linear congruential generator that is used in the debug emulator to trap + * after a random number of iterations in persistent_term_put_common and + * persistent_term_erase_1. * * https://en.wikipedia.org/wiki/Linear_congruential_generator */ @@ -306,140 +313,12 @@ static int persistent_term_put_2_ctx_bin_dtor(Binary *context_bin) BIF_RETTYPE persistent_term_put_2(BIF_ALIST_2) { - static const Uint ITERATIONS_PER_RED = 32; - ErtsPersistentTermPut2Context* ctx; - Eterm state_mref = THE_NON_VALUE; - Eterm old_bucket; - long iterations_until_trap; - long max_iterations; -#define PUT_TRAP_CODE \ - BIF_TRAP2(BIF_TRAP_EXPORT(BIF_persistent_term_put_2), BIF_P, state_mref, BIF_ARG_2) -#define TRAPPING_COPY_TABLE_PUT(TABLE_DEST, OLD_TABLE, NEW_SIZE, COPY_TYPE, LOC_NAME) \ - TRAPPING_COPY_TABLE(TABLE_DEST, OLD_TABLE, NEW_SIZE, COPY_TYPE, LOC_NAME, PUT_TRAP_CODE) - -#ifdef DEBUG - (void)ITERATIONS_PER_RED; - iterations_until_trap = max_iterations = - GET_SMALL_RANDOM_INT(ERTS_BIF_REDS_LEFT(BIF_P) + (Uint)&ctx); -#else - iterations_until_trap = max_iterations = - ITERATIONS_PER_RED * ERTS_BIF_REDS_LEFT(BIF_P); -#endif - if (is_internal_magic_ref(BIF_ARG_1) && - (ERTS_MAGIC_BIN_DESTRUCTOR(erts_magic_ref2bin(BIF_ARG_1)) == - persistent_term_put_2_ctx_bin_dtor)) { - /* Restore state after a trap */ - Binary* state_bin; - state_mref = BIF_ARG_1; - state_bin = erts_magic_ref2bin(state_mref); - ctx = ERTS_MAGIC_BIN_DATA(state_bin); - ASSERT(BIF_P->flags & F_DISABLE_GC); - erts_set_gc_state(BIF_P, 1); - ASSERT(ctx->trap_location == PUT2_TRAP_LOCATION_NEW_KEY); - goto L_PUT2_TRAP_LOCATION_NEW_KEY; - } else { - /* Save state in magic bin in case trapping is necessary */ - Eterm* hp; - Binary* state_bin = erts_create_magic_binary(sizeof(ErtsPersistentTermPut2Context), - persistent_term_put_2_ctx_bin_dtor); - hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE); - state_mref = erts_mk_magic_ref(&hp, &MSO(BIF_P), state_bin); - ctx = ERTS_MAGIC_BIN_DATA(state_bin); - /* - * IMPORTANT: The following field is used to detect if - * persistent_term_put_2_ctx_bin_dtor needs to free memory - */ - ctx->cpy_ctx.new_table = NULL; - } - - - if (!try_seize_update_permission(BIF_P)) { - ERTS_BIF_YIELD2(BIF_TRAP_EXPORT(BIF_persistent_term_put_2), - BIF_P, BIF_ARG_1, BIF_ARG_2); - } - ctx->hash_table = (HashTable *) erts_atomic_read_nob(&the_hash_table); - - ctx->key = BIF_ARG_1; - ctx->term = BIF_ARG_2; - - ctx->entry_index = lookup(ctx->hash_table, ctx->key, &old_bucket); - - ctx->heap[0] = make_arityval(2); - ctx->heap[1] = ctx->key; - ctx->heap[2] = ctx->term; - ctx->tuple = make_tuple(ctx->heap); - - if (is_nil(old_bucket)) { - if (MUST_GROW(ctx->hash_table)) { - Uint new_size = ctx->hash_table->allocated * 2; - TRAPPING_COPY_TABLE_PUT(ctx->hash_table, - ctx->hash_table, - new_size, - ERTS_PERSISTENT_TERM_CPY_NO_REHASH, - PUT2_TRAP_LOCATION_NEW_KEY); - ctx->entry_index = lookup(ctx->hash_table, - ctx->key, - &old_bucket); - } - ctx->hash_table->num_entries++; - } else { - Eterm old_term; - - ASSERT(is_tuple_arity(old_bucket, 2)); - old_term = boxed_val(old_bucket)[2]; - - if (EQ(ctx->term, old_term)) { - /* Same value. No need to update anything. */ - release_update_permission(0); - BIF_RET(am_ok); - } - } - - { - Uint term_size; - Uint lit_area_size; - ErlOffHeap code_off_heap; - ErtsLiteralArea* literal_area; - erts_shcopy_t info; - Eterm* ptr; - /* - * Preserve internal sharing in the term by using the - * sharing-preserving functions. However, literals must - * be copied in case the module holding them are unloaded. - */ - INITIALIZE_SHCOPY(info); - info.copy_literals = 1; - term_size = copy_shared_calculate(ctx->tuple, &info); - ERTS_INIT_OFF_HEAP(&code_off_heap); - lit_area_size = ERTS_LITERAL_AREA_ALLOC_SIZE(term_size); - literal_area = erts_alloc(ERTS_ALC_T_LITERAL, lit_area_size); - ptr = &literal_area->start[0]; - literal_area->end = ptr + term_size; - ctx->tuple = copy_shared_perform(ctx->tuple, term_size, &info, &ptr, &code_off_heap); - ASSERT(tuple_val(ctx->tuple) == literal_area->start); - literal_area->off_heap = code_off_heap.first; - DESTROY_SHCOPY(info); - erts_set_literal_tag(&ctx->tuple, literal_area->start, term_size); - - if (ctx->hash_table == (HashTable *) erts_atomic_read_nob(&the_hash_table)) { - /* Schedule fast update in active hash table */ - fast_update_index = ctx->entry_index; - fast_update_term = ctx->tuple; - } - else { - /* Do update in copied table */ - set_bucket(ctx->hash_table, ctx->entry_index, ctx->tuple); - } + return put_common(BIF_P, BIF_ARG_1, BIF_ARG_2, am_false); +} - /* - * Now wait thread progress before making update visible to guarantee - * consistent view of table&term without memory barrier in every get/1. - */ - erts_schedule_thr_prgr_later_op(table_updater, ctx->hash_table, &thr_prog_op); - suspend_updater(BIF_P); - } - BUMP_REDS(BIF_P, (max_iterations - iterations_until_trap) / ITERATIONS_PER_RED); - ERTS_BIF_YIELD_RETURN(BIF_P, am_ok); +BIF_RETTYPE persistent_term_put_new_2(BIF_ALIST_2) +{ + return put_common(BIF_P, BIF_ARG_1, BIF_ARG_2, am_true); } BIF_RETTYPE persistent_term_get_0(BIF_ALIST_0) @@ -543,17 +422,17 @@ BIF_RETTYPE persistent_term_erase_1(BIF_ALIST_1) long iterations_until_trap; long max_iterations; #ifdef DEBUG - (void)ITERATIONS_PER_RED; - iterations_until_trap = max_iterations = - GET_SMALL_RANDOM_INT(ERTS_BIF_REDS_LEFT(BIF_P) + (Uint)&ctx); + (void)ITERATIONS_PER_RED; + iterations_until_trap = max_iterations = + GET_SMALL_RANDOM_INT(ERTS_BIF_REDS_LEFT(BIF_P) + (Uint)&ctx); #else - iterations_until_trap = max_iterations = - ITERATIONS_PER_RED * ERTS_BIF_REDS_LEFT(BIF_P); + iterations_until_trap = max_iterations = + ITERATIONS_PER_RED * ERTS_BIF_REDS_LEFT(BIF_P); #endif #define ERASE_TRAP_CODE \ BIF_TRAP1(BIF_TRAP_EXPORT(BIF_persistent_term_erase_1), BIF_P, state_mref); #define TRAPPING_COPY_TABLE_ERASE(TABLE_DEST, OLD_TABLE, NEW_SIZE, REHASH, LOC_NAME) \ - TRAPPING_COPY_TABLE(TABLE_DEST, OLD_TABLE, NEW_SIZE, REHASH, LOC_NAME, ERASE_TRAP_CODE) + TRAPPING_COPY_TABLE(TABLE_DEST, OLD_TABLE, NEW_SIZE, REHASH, LOC_NAME, ERASE_TRAP_CODE, BIF_P) if (is_internal_magic_ref(BIF_ARG_1) && (ERTS_MAGIC_BIN_DESTRUCTOR(erts_magic_ref2bin(BIF_ARG_1)) == persistent_term_erase_1_ctx_bin_dtor)) { @@ -586,7 +465,7 @@ BIF_RETTYPE persistent_term_erase_1(BIF_ALIST_1) ctx->tmp_table = NULL; } if (!try_seize_update_permission(BIF_P)) { - ERTS_BIF_YIELD1(BIF_TRAP_EXPORT(BIF_persistent_term_erase_1), + ERTS_BIF_YIELD1(BIF_TRAP_EXPORT(BIF_persistent_term_erase_1), BIF_P, BIF_ARG_1); } @@ -750,6 +629,160 @@ erts_init_persistent_dumping(void) * Local functions. */ +/* + * put and put_new helpers. + */ + +static BIF_RETTYPE +persistent_term_put_common_trap(BIF_ALIST_3) +{ + return put_common(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +static Eterm put_common(Process* c_p, Eterm key, Eterm term, Eterm new) +{ + static const Uint ITERATIONS_PER_RED = 32; + ErtsPersistentTermPutCommonContext* ctx; + Eterm state_mref = THE_NON_VALUE; + Eterm old_bucket; + long iterations_until_trap; + long max_iterations; +#define PUT_COMMON_TRAP_CODE \ + BIF_TRAP3(&persistent_term_put_common_export, c_p, state_mref, term, new) + +#define TRAPPING_COPY_TABLE_PUT_COMMON(TABLE_DEST, OLD_TABLE, NEW_SIZE, COPY_TYPE, LOC_NAME) \ + TRAPPING_COPY_TABLE(TABLE_DEST, OLD_TABLE, NEW_SIZE, COPY_TYPE, LOC_NAME, PUT_COMMON_TRAP_CODE, c_p) + +#ifdef DEBUG + (void)ITERATIONS_PER_RED; + iterations_until_trap = max_iterations = + GET_SMALL_RANDOM_INT(ERTS_BIF_REDS_LEFT(c_p) + (Uint)&ctx); +#else + iterations_until_trap = max_iterations = + ITERATIONS_PER_RED * ERTS_BIF_REDS_LEFT(c_p); +#endif + if (is_internal_magic_ref(key) && + (ERTS_MAGIC_BIN_DESTRUCTOR(erts_magic_ref2bin(key)) == + persistent_term_put_common_bin_dtor)) { + /* Restore state after a trap */ + Binary* state_bin; + state_mref = key; + state_bin = erts_magic_ref2bin(state_mref); + ctx = ERTS_MAGIC_BIN_DATA(state_bin); + ASSERT(c_p->flags & F_DISABLE_GC); + erts_set_gc_state(c_p, 1); + ASSERT(ctx->trap_location == PUT_COMMON_TRAP_LOCATION_NEW_KEY); + goto L_PUT_COMMON_TRAP_LOCATION_NEW_KEY; + } else { + /* Save state in magic bin in case trapping is necessary */ + Eterm* hp; + Binary* state_bin = erts_create_magic_binary(sizeof(ErtsPersistentTermPutCommonContext), + persistent_term_put_common_bin_dtor); + hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE); + state_mref = erts_mk_magic_ref(&hp, &MSO(c_p), state_bin); + ctx = ERTS_MAGIC_BIN_DATA(state_bin); + /* + * IMPORTANT: The following field is used to detect if + * persistent_term_put_common_ctx_bin_dtor needs to free memory + */ + ctx->cpy_ctx.new_table = NULL; + } + + + if (!try_seize_update_permission(c_p)) { + ERTS_BIF_YIELD3(&persistent_term_put_common_export, c_p, key, term, new); + } + ctx->hash_table = (HashTable *) erts_atomic_read_nob(&the_hash_table); + + ctx->key = key; + ctx->term = term; + + ctx->entry_index = lookup(ctx->hash_table, ctx->key, &old_bucket); + + ctx->heap[0] = make_arityval(2); + ctx->heap[1] = ctx->key; + ctx->heap[2] = ctx->term; + ctx->tuple = make_tuple(ctx->heap); + + if (is_nil(old_bucket)) { + if (MUST_GROW(ctx->hash_table)) { + Uint new_size = ctx->hash_table->allocated * 2; + TRAPPING_COPY_TABLE_PUT_COMMON(ctx->hash_table, + ctx->hash_table, + new_size, + ERTS_PERSISTENT_TERM_CPY_NO_REHASH, + PUT_COMMON_TRAP_LOCATION_NEW_KEY); + ctx->entry_index = lookup(ctx->hash_table, + ctx->key, + &old_bucket); + } + ctx->hash_table->num_entries++; + } else { + Eterm old_term; + + ASSERT(is_tuple_arity(old_bucket, 2)); + old_term = boxed_val(old_bucket)[2]; + + if (EQ(ctx->term, old_term)) { + /* Same value. No need to update anything. */ + release_update_permission(0); + BIF_RET(am_ok); + } else if (new == am_true) { + /* Different value. Raise badarg. */ + release_update_permission(0); + BIF_ERROR(c_p, BADARG); + } + } + + { + Uint term_size; + Uint lit_area_size; + ErlOffHeap code_off_heap; + ErtsLiteralArea* literal_area; + erts_shcopy_t info; + Eterm* ptr; + /* + * Preserve internal sharing in the term by using the + * sharing-preserving functions. However, literals must + * be copied in case the module holding them are unloaded. + */ + INITIALIZE_SHCOPY(info); + info.copy_literals = 1; + term_size = copy_shared_calculate(ctx->tuple, &info); + ERTS_INIT_OFF_HEAP(&code_off_heap); + lit_area_size = ERTS_LITERAL_AREA_ALLOC_SIZE(term_size); + literal_area = erts_alloc(ERTS_ALC_T_LITERAL, lit_area_size); + ptr = &literal_area->start[0]; + literal_area->end = ptr + term_size; + ctx->tuple = copy_shared_perform(ctx->tuple, term_size, &info, &ptr, &code_off_heap); + ASSERT(tuple_val(ctx->tuple) == literal_area->start); + literal_area->off_heap = code_off_heap.first; + DESTROY_SHCOPY(info); + erts_set_literal_tag(&ctx->tuple, literal_area->start, term_size); + + if (ctx->hash_table == (HashTable *) erts_atomic_read_nob(&the_hash_table)) { + /* Schedule fast update in active hash table */ + fast_update_index = ctx->entry_index; + fast_update_term = ctx->tuple; + } + else { + /* Do update in copied table */ + set_bucket(ctx->hash_table, ctx->entry_index, ctx->tuple); + } + + /* + * Now wait thread progress before making update visible to guarantee + * consistent view of table&term without memory barrier in every get/1. + */ + erts_schedule_thr_prgr_later_op(table_updater, ctx->hash_table, + &thr_prog_op); + suspend_updater(c_p); + } + + BUMP_REDS(c_p, (max_iterations - iterations_until_trap) / ITERATIONS_PER_RED); + ERTS_BIF_YIELD_RETURN(c_p, am_ok); +} + static HashTable* create_initial_table(void) { @@ -817,7 +850,7 @@ do_get_all(Process* c_p, TrapData* trap_data, Eterm res) max_iter = ERTS_BIF_REDS_LEFT(c_p); #endif remaining = trap_data->remaining < max_iter ? - trap_data->remaining : max_iter; + trap_data->remaining : max_iter; trap_data->remaining -= remaining; copy_data = (struct copy_term *) erts_alloc(ERTS_ALC_T_TMP, @@ -917,7 +950,7 @@ do_info(Process* c_p, TrapData* trap_data) ErtsLiteralArea* area = term_to_area(bucket); trap_data->memory += sizeof(ErtsLiteralArea) + - sizeof(Eterm) * (area->end - area->start - 1); + sizeof(Eterm) * (area->end - area->start - 1); remaining--; } @@ -936,7 +969,7 @@ do_info(Process* c_p, TrapData* trap_data) Uint hsz = MAP_SZ(2); memory = sizeof(HashTable) + (trap_data->table->allocated-1) * - sizeof(Eterm) + trap_data->memory; + sizeof(Eterm) + trap_data->memory; (void) erts_bld_uint(NULL, &hsz, hash_table->num_entries); (void) erts_bld_uint(NULL, &hsz, memory); hp = HAlloc(c_p, hsz); diff --git a/erts/emulator/test/persistent_term_SUITE.erl b/erts/emulator/test/persistent_term_SUITE.erl index 37fc17e0a5b0..019a429f6f2f 100644 --- a/erts/emulator/test/persistent_term_SUITE.erl +++ b/erts/emulator/test/persistent_term_SUITE.erl @@ -32,6 +32,7 @@ off_heap_values/1,keys/1,collisions/1, init_restart/1, put_erase_trapping/1, killed_while_trapping_put/1, + killed_while_trapping_put_new/1, killed_while_trapping_erase/1, error_info/1, whole_message/1, @@ -91,10 +92,18 @@ basic(_Config) -> seq(3, Seq, Chk), %Same values. _ = [begin Key = {?MODULE,{key,I}}, + true = persistent_term:erase(Key), false = persistent_term:erase(Key), + {'EXIT',{badarg,_}} = (catch persistent_term:get(Key)), - {not_present,Key} = persistent_term:get(Key, {not_present,Key}) + {not_present,Key} = persistent_term:get(Key, {not_present,Key}), + + ok = persistent_term:put_new(Key, {value, I}), + ok = persistent_term:put_new(Key, {value, I}), + {'EXIT',{badarg,_}} = (catch persistent_term:put_new(Key, {new_value, I})), + {value, I} = persistent_term:get(Key), + true = persistent_term:erase(Key) end || I <- Seq], [] = [P || {{?MODULE,_},_}=P <- pget(Chk)], chk(Chk). @@ -937,6 +946,21 @@ killed_while_trapping_put(_Config) -> 10), ok. +killed_while_trapping_put_new(_Config) -> + repeat( + fun() -> + NrOfPutsInChild = 10000, + Pid = + spawn(fun() -> + do_put_news(NrOfPutsInChild, my_value) + end), + timer:sleep(1), + erlang:exit(Pid, kill), + do_erases(NrOfPutsInChild) + end, + 10), + ok. + killed_while_trapping_erase(_Config) -> repeat( fun() -> @@ -960,14 +984,20 @@ put_erase_trapping(_Config) -> do_erases(NrOfItems), ok. -do_puts(0, _) -> ok; do_puts(NrOfPuts, ValuePrefix) -> + do_puts_iter(NrOfPuts, ValuePrefix, put). + +do_put_news(NrOfPuts, ValuePrefix) -> + do_puts_iter(NrOfPuts, ValuePrefix, put_new). + +do_puts_iter(0, _, _) -> ok; +do_puts_iter(NrOfPuts, ValuePrefix, PutFun) -> Key = {?MODULE, NrOfPuts}, Value = {ValuePrefix, NrOfPuts}, erts_debug:set_internal_state(reds_left, rand:uniform(250)), - persistent_term:put(Key, Value), + erlang:apply(persistent_term, PutFun, [Key, Value]), Value = persistent_term:get(Key), - do_puts(NrOfPuts - 1, ValuePrefix). + do_puts_iter(NrOfPuts - 1, ValuePrefix, PutFun). do_erases(0) -> ok; do_erases(NrOfErases) -> @@ -987,7 +1017,8 @@ error_info(_Config) -> L = [{erase, [{?MODULE,my_key}], [no_fail]}, {get, [{?MODULE,certainly_not_existing}]}, {get, [{?MODULE,certainly_not_existing}, default], [no_fail]}, - {put, 2} %Can't fail. + {put, 2}, %Can't fail. + {put_new, [{?MODULE,new_key}, default], [no_fail]} ], do_error_info(L). diff --git a/erts/preloaded/ebin/persistent_term.beam b/erts/preloaded/ebin/persistent_term.beam index 5010e090a594..978cf7aca245 100644 Binary files a/erts/preloaded/ebin/persistent_term.beam and b/erts/preloaded/ebin/persistent_term.beam differ diff --git a/erts/preloaded/src/persistent_term.erl b/erts/preloaded/src/persistent_term.erl index 2e5576d61aae..bf0f2aebc0a9 100644 --- a/erts/preloaded/src/persistent_term.erl +++ b/erts/preloaded/src/persistent_term.erl @@ -139,7 +139,7 @@ tables are stored as a single persistent term: """. -moduledoc(#{since => "OTP 21.2"}). --export([erase/1,get/0,get/1,get/2,info/0,put/2]). +-export([erase/1,get/0,get/1,get/2,info/0,put/2, put_new/2]). -doc "Any Erlang term.". -type key() :: term(). @@ -250,3 +250,20 @@ GC has been initiated when [`put/2`](`put/2`) returns. See Value :: value(). put(_Key, _Value) -> erlang:nif_error(undef). + +-doc """ +Store the value `Value` as a persistent term and associate it with the key +`Key` if the key `Key` doesn't already exist. + +If the value `Value` is equal to the value previously stored for the key, +[`put_new/2`](`put_new/2`) will do nothing and return quickly. + +If there existed a previous persistent term associated with key `Key`, the +function fails with a `badarg` exception. +""". +-doc(#{since => <<"OTP 28.1">>}). +-spec put_new(Key, Value) -> 'ok' when + Key :: key(), + Value :: value(). +put_new(_Key, _Value) -> + erlang:nif_error(undef).