diff options
153 files changed, 5533 insertions, 2566 deletions
diff --git a/.travis.yml b/.travis.yml index 42151a16d2..baa55b383d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -29,7 +29,7 @@ before_script: - kerl_deactivate script: - - ./otp_build all -a + - ./scripts/build-otp after_success: - $ERL_TOP/bin/dialyzer --build_plt --apps asn1 compiler crypto dialyzer edoc erts et hipe inets kernel mnesia observer public_key runtime_tools snmp ssh ssl stdlib syntax_tools wx xmerl --statistics diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam Binary files differindex fae275107e..0ebd85824c 100644 --- a/bootstrap/lib/kernel/ebin/code.beam +++ b/bootstrap/lib/kernel/ebin/code.beam diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam Binary files differindex 95089f3ce0..75baaa543d 100644 --- a/bootstrap/lib/stdlib/ebin/dets.beam +++ b/bootstrap/lib/stdlib/ebin/dets.beam diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam Binary files differindex a26e189dfe..e66749048d 100644 --- a/bootstrap/lib/stdlib/ebin/ets.beam +++ b/bootstrap/lib/stdlib/ebin/ets.beam diff --git a/erts/configure.in b/erts/configure.in index e1233cee59..1c4a3e90ef 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1911,7 +1911,25 @@ case X$erl_xcomp_bigendian in *) AC_MSG_ERROR([Bad erl_xcomp_bigendian value: $erl_xcomp_bigendian]);; esac -AC_C_BIGENDIAN +AC_C_BIGENDIAN( + [ + AC_DEFINE([WORDS_BIGENDIAN], [1], [Define if big-endian]) + AC_DEFINE([ERTS_ENDIANNESS], [1], [Define > 0 if big-endian < 0 if little-endian, or 0 if unknown]) + ], + [ + AC_DEFINE([ERTS_ENDIANNESS], [-1], [Define > 0 if big-endian < 0 if little-endian, or 0 if unknown]) + ], + [ + case "$erl_xcomp_bigendian" in + yes) + AC_DEFINE([ERTS_ENDIANNESS], [1], [Define > 0 if big-endian < 0 if little-endian, or 0 if unknown]);; + no) + AC_DEFINE([ERTS_ENDIANNESS], [-1], [Define > 0 if big-endian < 0 if little-endian, or 0 if unknown]);; + *) + AC_DEFINE([ERTS_ENDIANNESS], [0], [Define > 0 if big-endian < 0 if little-endian, or 0 if unknown]);; + esac + ]) + AC_C_DOUBLE_MIDDLE_ENDIAN dnl fdatasync syscall (Unix only) diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index d8bf45c523..7fbe97bc0b 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -1103,8 +1103,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code> <marker id="driver_binary_dec_refc"></marker> <p>Decrements the reference count on <c>bin</c> and returns the reference count reached after the decrement.</p> - <p>This function is only thread-safe when the emulator with SMP - support is used.</p> + <p>This function is thread-safe.</p> <note> <p>The reference count of driver binary is normally to be decremented by calling <seealso marker="#driver_free_binary"> @@ -1124,8 +1123,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code> <desc> <marker id="driver_binary_get_refc"></marker> <p>Returns the current reference count on <c>bin</c>.</p> - <p>This function is only thread-safe when the emulator with SMP - support is used.</p> + <p>This function is thread-safe.</p> </desc> </func> @@ -1137,8 +1135,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code> <marker id="driver_binary_inc_refc"></marker> <p>Increments the reference count on <c>bin</c> and returns the reference count reached after the increment.</p> - <p>This function is only thread-safe when the emulator with SMP - support is used.</p> + <p>This function is thread-safe.</p> </desc> </func> @@ -1434,8 +1431,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code> <seealso marker="#driver_alloc_binary"> <c>driver_alloc_binary</c></seealso>. As binaries in Erlang are reference counted, the binary can still be around.</p> - <p>This function is only thread-safe when the emulator with SMP - support is used.</p> + <p>This function is thread-safe.</p> </desc> </func> @@ -1872,8 +1868,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code> <p>Resizes a driver binary, while keeping the data.</p> <p>Returns the resized driver binary on success. Returns <c>NULL</c> on failure (out of memory).</p> - <p>This function is only thread-safe when the emulator with SMP - support is used.</p> + <p>This function is thread-safe.</p> </desc> </func> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 14fcdb7e0e..ae1d2b1d93 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -32,6 +32,34 @@ <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 8.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix bug in <c>binary_to_term</c> for binaries created by + <c>term_to_binary </c> with option <c>compressed</c>. The + bug can cause <c>badarg</c> exception for a valid binary + when Erlang VM is linked against a <c>zlib</c> library of + version 1.2.9 or newer. Bug exists since OTP 17.0.</p> + <p> + Own Id: OTP-14159 Aux Id: ERL-340 </p> + </item> + <item> + <p> + The driver efile_drv when opening a file now use fstat() + on the open file instead of stat() before opening, if + fstat() exists. This avoids a race when the file happens + to change between stat() and open().</p> + <p> + Own Id: OTP-14184 Aux Id: seq-13266 </p> + </item> + </list> + </section> + +</section> + <section><title>Erts 8.2.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 1efe5fe300..df2866b40e 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -379,6 +379,7 @@ atom long_schedule atom low atom Lt='<' atom machine +atom magic_ref atom major atom match atom match_limit diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index a5891a0ec2..4ba8c2a669 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -156,11 +156,13 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3) Module* modp; Eterm res, mod; - if (!ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_1) || - is_not_atom(mod = erts_module_for_prepared_code - (((ProcBin*)binary_val(BIF_ARG_1))->val))) { + if (!is_internal_magic_ref(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + + mod = erts_module_for_prepared_code(erts_magic_ref2bin(BIF_ARG_1)); + + if (is_not_atom(mod)) BIF_ERROR(BIF_P, BADARG); - } if (!erts_try_seize_code_write_permission(BIF_P)) { ERTS_BIF_YIELD3(bif_export[BIF_code_make_stub_module_3], @@ -229,8 +231,8 @@ prepare_loading_2(BIF_ALIST_2) res = TUPLE2(hp, am_error, reason); BIF_RET(res); } - hp = HAlloc(BIF_P, PROC_BIN_SIZE); - res = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), magic); + hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE); + res = erts_mk_magic_ref(&hp, &MSO(BIF_P), magic); erts_refc_dec(&magic->refc, 1); BIF_RET(res); } @@ -239,15 +241,13 @@ BIF_RETTYPE has_prepared_code_on_load_1(BIF_ALIST_1) { Eterm res; - ProcBin* pb; - if (!ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_1)) { + if (!is_internal_magic_ref(BIF_ARG_1)) { error: BIF_ERROR(BIF_P, BADARG); } - pb = (ProcBin*) binary_val(BIF_ARG_1); - res = erts_has_code_on_load(pb->val); + res = erts_has_code_on_load(erts_magic_ref2bin(BIF_ARG_1)); if (res == NIL) { goto error; } @@ -333,13 +333,11 @@ finish_loading_1(BIF_ALIST_1) for (i = 0; i < n; i++) { Eterm* cons = list_val(BIF_ARG_1); Eterm term = CAR(cons); - ProcBin* pb; - if (!ERTS_TERM_IS_MAGIC_BINARY(term)) { + if (!is_internal_magic_ref(term)) { goto badarg; } - pb = (ProcBin*) binary_val(term); - p[i].code = pb->val; + p[i].code = erts_magic_ref2bin(term); p[i].module = erts_module_for_prepared_code(p[i].code); if (p[i].module == NIL) { goto badarg; diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 27329a339e..b32c74ce7a 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -392,17 +392,17 @@ consolidate_bp_data(Module* modp, ErtsCodeInfo *ci, int local) } if (flags & ERTS_BPF_META_TRACE) { dst->meta_tracer = src->meta_tracer; - erts_refc_inc(&dst->meta_tracer->refc, 1); + erts_smp_refc_inc(&dst->meta_tracer->refc, 1); dst->meta_ms = src->meta_ms; MatchSetRef(dst->meta_ms); } if (flags & ERTS_BPF_COUNT) { dst->count = src->count; - erts_refc_inc(&dst->count->refc, 1); + erts_smp_refc_inc(&dst->count->refc, 1); } if (flags & ERTS_BPF_TIME_TRACE) { dst->time = src->time; - erts_refc_inc(&dst->time->refc, 1); + erts_smp_refc_inc(&dst->time->refc, 1); ASSERT(dst->time->hash); } } @@ -1576,7 +1576,7 @@ set_function_break(ErtsCodeInfo *ci, Binary *match_spec, Uint break_flags, MatchSetRef(match_spec); bp->meta_ms = match_spec; bmt = Alloc(sizeof(BpMetaTracer)); - erts_refc_init(&bmt->refc, 1); + erts_smp_refc_init(&bmt->refc, 1); erts_tracer_update(&meta_tracer, tracer); /* copy tracer */ erts_smp_atomic_init_nob(&bmt->tracer, (erts_aint_t)meta_tracer); bp->meta_tracer = bmt; @@ -1585,7 +1585,7 @@ set_function_break(ErtsCodeInfo *ci, Binary *match_spec, Uint break_flags, ASSERT((bp->flags & ERTS_BPF_COUNT) == 0); bcp = Alloc(sizeof(BpCount)); - erts_refc_init(&bcp->refc, 1); + erts_smp_refc_init(&bcp->refc, 1); erts_smp_atomic_init_nob(&bcp->acount, 0); bp->count = bcp; } else if (break_flags & ERTS_BPF_TIME_TRACE) { @@ -1594,7 +1594,7 @@ set_function_break(ErtsCodeInfo *ci, Binary *match_spec, Uint break_flags, ASSERT((bp->flags & ERTS_BPF_TIME_TRACE) == 0); bdt = Alloc(sizeof(BpDataTime)); - erts_refc_init(&bdt->refc, 1); + erts_smp_refc_init(&bdt->refc, 1); #ifdef ERTS_DIRTY_SCHEDULERS bdt->n = erts_no_schedulers + 1; #else @@ -1664,7 +1664,7 @@ clear_function_break(ErtsCodeInfo *ci, Uint break_flags) static void bp_meta_unref(BpMetaTracer* bmt) { - if (erts_refc_dectest(&bmt->refc, 0) <= 0) { + if (erts_smp_refc_dectest(&bmt->refc, 0) <= 0) { ErtsTracer trc = erts_smp_atomic_read_nob(&bmt->tracer); ERTS_TRACER_CLEAR(&trc); Free(bmt); @@ -1674,7 +1674,7 @@ bp_meta_unref(BpMetaTracer* bmt) static void bp_count_unref(BpCount* bcp) { - if (erts_refc_dectest(&bcp->refc, 0) <= 0) { + if (erts_smp_refc_dectest(&bcp->refc, 0) <= 0) { Free(bcp); } } @@ -1682,7 +1682,7 @@ bp_count_unref(BpCount* bcp) static void bp_time_unref(BpDataTime* bdt) { - if (erts_refc_dectest(&bdt->refc, 0) <= 0) { + if (erts_smp_refc_dectest(&bdt->refc, 0) <= 0) { Uint i = 0; Uint j = 0; Process *h_p = NULL; diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h index cccd395e0a..3dba3cc1b5 100644 --- a/erts/emulator/beam/beam_bp.h +++ b/erts/emulator/beam/beam_bp.h @@ -41,7 +41,7 @@ typedef struct { typedef struct bp_data_time { /* Call time */ Uint n; bp_time_hash_t *hash; - erts_refc_t refc; + erts_smp_refc_t refc; } BpDataTime; typedef struct { @@ -51,12 +51,12 @@ typedef struct { typedef struct { erts_smp_atomic_t acount; - erts_refc_t refc; + erts_smp_refc_t refc; } BpCount; typedef struct { erts_smp_atomic_t tracer; - erts_refc_t refc; + erts_smp_refc_t refc; } BpMetaTracer; typedef struct generic_bp_data { diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 85d92321b8..5e275c8fc5 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -6846,7 +6846,7 @@ new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free) p->htop = hp + needed; funp = (ErlFunThing *) hp; hp = funp->env; - erts_refc_inc(&fe->refc, 2); + erts_smp_refc_inc(&fe->refc, 2); funp->thing_word = HEADER_FUN; funp->next = MSO(p).first; MSO(p).first = (struct erl_off_heap_header*) funp; diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index d298a4ff26..e75e7afd54 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -4862,7 +4862,7 @@ final_touch(LoaderState* stp, struct erl_module_instance* inst_p) /* * We are hiding a pointer into older code. */ - erts_refc_dec(&fe->refc, 1); + erts_smp_refc_dec(&fe->refc, 1); } fe->address = code_ptr; #ifdef HIPE @@ -6274,7 +6274,7 @@ patch_funentries(Eterm Patchlist) * * Reproduced on a debug emulator with stdlib_test/qlc_SUITE:join_merge * - * erts_refc_dec(&fe->refc, 1); + * erts_smp_refc_dec(&fe->refc, 1); */ if (!patch(Addresses, (Uint) fe)) @@ -6322,8 +6322,8 @@ erts_make_stub_module(Process* p, Eterm hipe_magic_bin, Eterm Beam, Eterm Info) stp = ERTS_MAGIC_BIN_DATA(magic); hipe_code = erts_alloc(ERTS_ALC_T_HIPE, sizeof(*hipe_code)); - if (!ERTS_TERM_IS_MAGIC_BINARY(hipe_magic_bin) || - !(hipe_magic = ((ProcBin*)binary_val(hipe_magic_bin))->val, + if (!is_internal_magic_ref(hipe_magic_bin) || + !(hipe_magic = erts_magic_ref2bin(hipe_magic_bin), hipe_stp = hipe_get_loader_state(hipe_magic)) || hipe_stp->module == NIL || hipe_stp->text_segment == 0) { goto error; @@ -6568,8 +6568,8 @@ int erts_commit_hipe_patch_load(Eterm hipe_magic_bin) HipeModule *hipe_code; Module* modp; - if (!ERTS_TERM_IS_MAGIC_BINARY(hipe_magic_bin) || - !(hipe_magic = ((ProcBin*)binary_val(hipe_magic_bin))->val, + if (!is_internal_magic_ref(hipe_magic_bin) || + !(hipe_magic = erts_magic_ref2bin(hipe_magic_bin), hipe_stp = hipe_get_loader_state(hipe_magic)) || hipe_stp->module == NIL || hipe_stp->text_segment == 0) { return 0; diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index a2d2433ed8..2190c47262 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -199,7 +199,7 @@ BIF_RETTYPE link_1(BIF_ALIST_1) goto res_no_proc; case ERTS_PORT_OP_SCHEDULED: if (refp) { - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true); } default: @@ -782,7 +782,7 @@ local_name_monitor(Process *self, Eterm type, Eterm target_name) case ERTS_PORT_OP_DONE: return ret; case ERTS_PORT_OP_SCHEDULED: { /* Scheduled a signal */ - ASSERT(is_internal_ref(ret)); + ASSERT(is_internal_ordinary_ref(ret)); BIF_TRAP3(await_port_send_result_trap, self, ret, am_true, ret); /* bif_trap returns */ @@ -1180,7 +1180,7 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) res = erts_port_unlink(BIF_P, prt, BIF_P->common.id, refp); if (refp && res == ERTS_PORT_OP_SCHEDULED) { - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true); } } @@ -1586,7 +1586,7 @@ BIF_RETTYPE exit_2(BIF_ALIST_2) ERTS_BIF_CHK_EXITED(BIF_P); if (refp && res == ERTS_PORT_OP_SCHEDULED) { - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true); } @@ -2221,7 +2221,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) /* Fall through */ case ERTS_PORT_OP_SCHEDULED: if (is_not_nil(*refp)) { - ASSERT(is_internal_ref(*refp)); + ASSERT(is_internal_ordinary_ref(*refp)); ret_val = SEND_AWAIT_RESULT; } break; @@ -2409,7 +2409,7 @@ BIF_RETTYPE send_3(BIF_ALIST_3) ERTS_BIF_PREP_YIELD_RETURN(retval, p, am_ok); break; case SEND_AWAIT_RESULT: - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); ERTS_BIF_PREP_TRAP3(retval, await_port_send_result_trap, p, ref, am_nosuspend, am_ok); break; case SEND_BADARG: @@ -2446,7 +2446,7 @@ BIF_RETTYPE send_2(BIF_ALIST_2) static BIF_RETTYPE dsend_continue_trap_1(BIF_ALIST_1) { - Binary* bin = ((ProcBin*) binary_val(BIF_ARG_1))->val; + Binary* bin = erts_magic_ref2bin(BIF_ARG_1); ErtsSendContext* ctx = (ErtsSendContext*) ERTS_MAGIC_BIN_DATA(bin); Sint initial_reds = (Sint) (ERTS_BIF_REDS_LEFT(BIF_P) * TERM_TO_BINARY_LOOP_FACTOR); int result; @@ -2526,7 +2526,7 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) ERTS_BIF_PREP_YIELD_RETURN(retval, p, msg); break; case SEND_AWAIT_RESULT: - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); ERTS_BIF_PREP_TRAP3(retval, await_port_send_result_trap, p, ref, msg, msg); break; @@ -4109,6 +4109,7 @@ BIF_RETTYPE ref_to_list_1(BIF_ALIST_1) { if (is_not_ref(BIF_ARG_1)) BIF_ERROR(BIF_P, BADARG); + erts_magic_ref_save_bin(BIF_ARG_1); BIF_RET(term2list_dsprintf(BIF_P, BIF_ARG_1)); } diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index 071a356260..d38097fb12 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -47,13 +47,8 @@ void erts_init_binary(void) { /* Verify Binary alignment... */ - if ((((UWord) &((Binary *) 0)->orig_bytes[0]) % ((UWord) 8)) != 0) { - /* I assume that any compiler should be able to optimize this - away. If not, this test is not very expensive... */ - erts_exit(ERTS_ABORT_EXIT, - "Internal error: Address of orig_bytes[0] of a Binary" - " is *not* 8-byte aligned\n"); - } + ERTS_CT_ASSERT((offsetof(Binary,orig_bytes) % 8) == 0); + ERTS_CT_ASSERT((offsetof(ErtsMagicBinary,u.aligned.data) % 8) == 0); erts_init_trap_export(&binary_to_list_continue_export, am_erts_internal, am_binary_to_list_continue, 1, @@ -445,18 +440,17 @@ binary_to_list(Process *c_p, Eterm *hp, Eterm tail, byte *bytes, sp->size = size; sp->bitoffs = bitoffs; - hp = HAlloc(c_p, PROC_BIN_SIZE); - mb = erts_mk_magic_binary_term(&hp, &MSO(c_p), mbp); + hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE); + mb = erts_mk_magic_ref(&hp, &MSO(c_p), mbp); return binary_to_list_chunk(c_p, mb, sp, reds_left, 0); } } static BIF_RETTYPE binary_to_list_continue(BIF_ALIST_1) { - Binary *mbp = ((ProcBin *) binary_val(BIF_ARG_1))->val; + Binary *mbp = erts_magic_ref2bin(BIF_ARG_1); ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == b2l_state_destructor); - ASSERT(BIF_P->flags & F_DISABLE_GC); return binary_to_list_chunk(BIF_P, @@ -792,8 +786,8 @@ list_to_binary_chunk(Eterm mb_eterm, ERTS_L2B_STATE_MOVE(new_sp, sp); sp = new_sp; - hp = HAlloc(c_p, PROC_BIN_SIZE); - mb_eterm = erts_mk_magic_binary_term(&hp, &MSO(c_p), mbp); + hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE); + mb_eterm = erts_mk_magic_ref(&hp, &MSO(c_p), mbp); ASSERT(is_value(mb_eterm)); @@ -839,9 +833,9 @@ list_to_binary_chunk(Eterm mb_eterm, static BIF_RETTYPE list_to_binary_continue(BIF_ALIST_1) { - Binary *mbp = ((ProcBin *) binary_val(BIF_ARG_1))->val; - ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == l2b_state_destructor); + Binary *mbp = erts_magic_ref2bin(BIF_ARG_1); + ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == l2b_state_destructor); ASSERT(BIF_P->flags & F_DISABLE_GC); return list_to_binary_chunk(BIF_ARG_1, diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 2fc61ab436..e57c2f5f6b 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -647,7 +647,7 @@ bin_check(void) erts_printf("%p orig_size: %bpd, norefs = %bpd\n", bp->val, bp->val->orig_size, - erts_smp_atomic_read_nob(&bp->val->refc)); + erts_refc_read(&bp->val->refc, 1)); } } if (printed) { diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index c4dcd6a3cc..85db23393c 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -850,7 +850,7 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint funp = (ErlFunThing *) tp; funp->next = off_heap->first; off_heap->first = (struct erl_off_heap_header*) funp; - erts_refc_inc(&funp->fe->refc, 2); + erts_smp_refc_inc(&funp->fe->refc, 2); *argp = make_fun(tp); } break; @@ -858,20 +858,24 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint case EXTERNAL_PORT_SUBTAG: case EXTERNAL_REF_SUBTAG: { - ExternalThing *etp = (ExternalThing *) htop; - + ExternalThing *etp = (ExternalThing *) objp; + erts_smp_refc_inc(&etp->node->refc, 2); + } + L_off_heap_node_container_common: + { + struct erl_off_heap_header *ohhp; + ohhp = (struct erl_off_heap_header *) htop; i = thing_arityval(hdr) + 1; + *argp = make_boxed(htop); tp = htop; while (i--) { *htop++ = *objp++; } - etp->next = off_heap->first; - off_heap->first = (struct erl_off_heap_header*)etp; - erts_refc_inc(&etp->node->refc, 2); + ohhp->next = off_heap->first; + off_heap->first = ohhp; - *argp = make_external(tp); } break; case MAP_SUBTAG: @@ -899,6 +903,13 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint case BIN_MATCHSTATE_SUBTAG: erts_exit(ERTS_ABORT_EXIT, "copy_struct: matchstate term not allowed"); + case REF_SUBTAG: + if (is_magic_ref_thing(objp)) { + ErtsMRefThing *mreft = (ErtsMRefThing *) objp; + erts_refc_inc(&mreft->mb->refc, 2); + goto L_off_heap_node_container_common; + } + /* Fall through... */ default: i = thing_arityval(hdr)+1; hbot -= i; @@ -1525,7 +1536,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, } funp->next = off_heap->first; off_heap->first = (struct erl_off_heap_header*) funp; - erts_refc_inc(&funp->fe->refc, 2); + erts_smp_refc_inc(&funp->fe->refc, 2); goto cleanup_next; } case MAP_SUBTAG: @@ -1649,20 +1660,33 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, } case EXTERNAL_PID_SUBTAG: case EXTERNAL_PORT_SUBTAG: - case EXTERNAL_REF_SUBTAG: { - ExternalThing *etp = (ExternalThing *) hp; + case EXTERNAL_REF_SUBTAG: + { + ExternalThing *etp = (ExternalThing *) ptr; + erts_smp_refc_inc(&etp->node->refc, 2); + } + off_heap_node_container_common: + { + struct erl_off_heap_header *ohhp; + ohhp = (struct erl_off_heap_header *) hp; sz = thing_arityval(hdr); - *resp = make_external(hp); + *resp = make_boxed(hp); *hp++ = hdr; ptr++; while (sz-- > 0) { *hp++ = *ptr++; } - etp->next = off_heap->first; - off_heap->first = (struct erl_off_heap_header*) etp; - erts_refc_inc(&etp->node->refc, 2); + ohhp->next = off_heap->first; + off_heap->first = ohhp; goto cleanup_next; } + case REF_SUBTAG: + if (is_magic_ref_thing(ptr)) { + ErtsMRefThing *mreft = (ErtsMRefThing *) ptr; + erts_refc_inc(&mreft->mb->refc, 2); + goto off_heap_node_container_common; + } + /* Fall through... */ default: sz = thing_arityval(hdr); *resp = make_boxed(hp); @@ -1836,7 +1860,7 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) case FUN_SUBTAG: { ErlFunThing* funp = (ErlFunThing *) (tp-1); - erts_refc_inc(&funp->fe->refc, 2); + erts_smp_refc_inc(&funp->fe->refc, 2); } goto off_heap_common; case EXTERNAL_PID_SUBTAG: @@ -1844,7 +1868,7 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) case EXTERNAL_REF_SUBTAG: { ExternalThing* etp = (ExternalThing *) (tp-1); - erts_refc_inc(&etp->node->refc, 2); + erts_smp_refc_inc(&etp->node->refc, 2); } off_heap_common: { @@ -1859,6 +1883,15 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) off_heap->first = ohh; } break; + case REF_SUBTAG: { + ErtsRefThing *rtp = (ErtsRefThing *) (tp - 1); + if (is_magic_ref_thing(rtp)) { + ErtsMRefThing *mreft = (ErtsMRefThing *) rtp; + erts_refc_inc(&mreft->mb->refc, 2); + goto off_heap_common; + } + /* Fall through... */ + } default: { int tari = header_arity(val); @@ -1959,6 +1992,9 @@ move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap, int lite ASSERT(ptr + header_arity(val) < end); MOVE_BOXED(ptr, val, hp, &dummy_ref); switch (val & _HEADER_SUBTAG_MASK) { + case REF_SUBTAG: + if (is_ordinary_ref_thing(hdr)) + break; case REFC_BINARY_SUBTAG: case FUN_SUBTAG: case EXTERNAL_PID_SUBTAG: diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 990edb274e..390f2a0db3 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -741,7 +741,7 @@ Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx) Binary* ctx_bin = erts_create_magic_binary(sizeof(struct exported_ctx), erts_dsend_context_dtor); struct exported_ctx* dst = ERTS_MAGIC_BIN_DATA(ctx_bin); - Eterm* hp = HAlloc(p, PROC_BIN_SIZE); + Eterm* hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); sys_memcpy(&dst->ctx, ctx, sizeof(ErtsSendContext)); ASSERT(ctx->dss.ctl == make_tuple(ctx->ctl_heap)); @@ -750,7 +750,7 @@ Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx) sys_memcpy(&dst->acm, ctx->dss.acmp, sizeof(ErtsAtomCacheMap)); dst->ctx.dss.acmp = &dst->acm; } - return erts_mk_magic_binary_term(&hp, &MSO(p), ctx_bin); + return erts_mk_magic_ref(&hp, &MSO(p), ctx_bin); } @@ -2082,7 +2082,7 @@ erts_dist_command(Port *prt, int reds_limit) ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - erts_refc_inc(&dep->refc, 1); /* Otherwise dist_entry might be + erts_smp_refc_inc(&dep->refc, 1); /* Otherwise dist_entry might be removed if port command fails */ erts_smp_atomic_set_mb(&dep->dist_cmd_scheduled, 0); @@ -2515,7 +2515,7 @@ info_dist_entry(fmtfn_t to, void *arg, DistEntry *dep, int visible, int connecte erts_print(to, arg, "Name: %T", dep->sysname); #ifdef DEBUG - erts_print(to, arg, " (refc=%d)", erts_refc_read(&dep->refc, 0)); + erts_print(to, arg, " (refc=%d)", erts_smp_refc_read(&dep->refc, 0)); #endif erts_print(to, arg, "\n"); if (!connected && is_nil(dep->cid)) { diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 4d990a9c56..e433de0f35 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -48,6 +48,7 @@ #if defined(ERTS_ALC_T_DRV_SEL_D_STATE) || defined(ERTS_ALC_T_DRV_EV_D_STATE) #include "erl_check_io.h" #endif +#include "erl_bif_unique.h" #define GET_ERL_GF_ALLOC_IMPL #include "erl_goodfit_alloc.h" @@ -152,8 +153,7 @@ typedef struct { int internal; Uint req_sched; Process *proc; - Eterm ref; - Eterm ref_heap[REF_THING_SIZE]; + ErtsIRefStorage iref; int allocs[ERTS_ALC_INFO_A_END - ERTS_ALC_A_MIN + 1]; } ErtsAllocInfoReq; @@ -682,6 +682,8 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) #endif fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_NIF_EXP_TRACE)] = sizeof(NifExportTrace); + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MREF_NSCHED_ENT)] + = sizeof(ErtsNSchedMagicRefTableEntry); #ifdef HARD_DEBUG hdbg_init(); @@ -3139,9 +3141,10 @@ reply_alloc_info(void *vair) while (1) { if (hpp) - ref_copy = STORE_NC(hpp, ohp, air->ref); + ref_copy = erts_iref_storage_make_ref(&air->iref, + hpp, ohp, 0); else - *szp += REF_THING_SIZE; + *szp += erts_iref_storage_heap_size(&air->iref); ai_list = NIL; for (i = 0; air->allocs[i] != ERTS_ALC_A_INVALID; i++); @@ -3370,8 +3373,10 @@ reply_alloc_info(void *vair) erts_smp_proc_unlock(rp, rp_locks); erts_proc_dec_refc(rp); - if (erts_smp_atomic32_dec_read_nob(&air->refc) == 0) + if (erts_smp_atomic32_dec_read_nob(&air->refc) == 0) { + erts_iref_storage_clean(&air->iref); aireq_free(air); + } } int @@ -3384,7 +3389,6 @@ erts_request_alloc_info(struct process *c_p, ErtsAllocInfoReq *air = aireq_alloc(); Eterm req_ai[ERTS_ALC_INFO_A_END] = {0}; Eterm alist; - Eterm *hp; int airix = 0, ai; air->req_sched = erts_get_scheduler_id(); @@ -3398,8 +3402,7 @@ erts_request_alloc_info(struct process *c_p, if (is_not_internal_ref(ref)) return 0; - hp = &air->ref_heap[0]; - air->ref = STORE_NC(&hp, NULL, ref); + erts_iref_storage_save(&air->iref, ref); if (is_not_list(allocs)) return 0; diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 70eca5b49c..c253ea82c8 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -280,6 +280,10 @@ type TRACE_MSG_QUEUE SHORT_LIVED SYSTEM trace_message_queue type SCHED_ASYNC_JOB SHORT_LIVED SYSTEM async_calls type DIRTY_START STANDARD PROCESSES dirty_start type DIRTY_SL SHORT_LIVED SYSTEM dirty_short_lived +type MREF_NSCHED_ENT FIXED_SIZE SYSTEM nsched_magic_ref_entry +type MREF_ENT STANDARD SYSTEM magic_ref_entry +type MREF_TAB_BKTS STANDARD SYSTEM magic_ref_table_buckets +type MREF_TAB LONG_LIVED SYSTEM magic_ref_table +if threads_no_smp # Need thread safe allocs, but std_alloc and fix_alloc are not; diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index 6e10980b6b..e57cd06cec 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -1010,8 +1010,8 @@ BIF_RETTYPE binary_compile_pattern_1(BIF_ALIST_1) if (do_binary_match_compile(BIF_ARG_1,&tag,&bin)) { BIF_ERROR(BIF_P,BADARG); } - hp = HAlloc(BIF_P, PROC_BIN_SIZE+3); - ret = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin); + hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE+3); + ret = erts_mk_magic_ref(&hp, &MSO(BIF_P), bin); ret = TUPLE2(hp, tag, ret); BIF_RET(ret); } @@ -1426,11 +1426,11 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Uint flags) goto badarg; } if (((tp[1] != am_bm) && (tp[1] != am_ac)) || - !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) { + !is_internal_magic_ref(tp[2])) { goto badarg; } bfs.type = tp[1]; - bin = ((ProcBin *) binary_val(tp[2]))->val; + bin = erts_magic_ref2bin(tp[2]); if (bfs.type == am_bm && ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) { goto badarg; @@ -1448,8 +1448,8 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Uint flags) bfs.global_result = &do_match_global_result; runres = do_binary_find(p, arg1, &bfs, bin, NIL, &result); if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) { - Eterm *hp = HAlloc(p, PROC_BIN_SIZE); - bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin); + Eterm *hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + bin_term = erts_mk_magic_ref(&hp, &MSO(p), bin); } else if (bin_term == NIL) { erts_bin_free(bin); } @@ -1512,11 +1512,11 @@ binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) goto badarg; } if (((tp[1] != am_bm) && (tp[1] != am_ac)) || - !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) { + !is_internal_magic_ref(tp[2])) { goto badarg; } bfs.type = tp[1]; - bin = ((ProcBin *) binary_val(tp[2]))->val; + bin = erts_magic_ref2bin(tp[2]); if (bfs.type == am_bm && ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) { goto badarg; @@ -1534,8 +1534,8 @@ binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) bfs.global_result = &do_split_global_result; runres = do_binary_find(p, arg1, &bfs, bin, NIL, &result); if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) { - Eterm *hp = HAlloc(p, PROC_BIN_SIZE); - bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin); + Eterm *hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + bin_term = erts_mk_magic_ref(&hp, &MSO(p), bin); } else if (bin_term == NIL) { erts_bin_free(bin); } @@ -1767,7 +1767,8 @@ static BIF_RETTYPE binary_find_trap(BIF_ALIST_3) { int runres; Eterm result; - Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val; + Binary *bin = erts_magic_ref2bin(BIF_ARG_3); + runres = do_binary_find(BIF_P, BIF_ARG_1, NULL, bin, BIF_ARG_2, &result); if (runres == DO_BIN_MATCH_OK) { BIF_RET(result); @@ -2186,8 +2187,8 @@ static BIF_RETTYPE do_longest_common(Process *p, Eterm list, int direction) cd[i].type = CL_TYPE_HEAP; } } - hp = HAlloc(p, PROC_BIN_SIZE); - bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), mb); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + bin_term = erts_mk_magic_ref(&hp, &MSO(p), mb); BUMP_ALL_REDS(p); BIF_TRAP3(trapper, p, bin_term, epos,list); } @@ -2214,8 +2215,7 @@ static BIF_RETTYPE do_longest_common_trap(Process *p, Eterm bin_term, Eterm curr #else term_to_Uint(current_pos, &pos); #endif - ASSERT(ERTS_TERM_IS_MAGIC_BINARY(bin_term)); - bin = ((ProcBin *) binary_val(bin_term))->val; + bin = erts_magic_ref2bin(bin_term); cd = (CommonData *) ERTS_MAGIC_BIN_DATA(bin); if (direction == DIRECTION_PREFIX) { trapper = &binary_longest_prefix_trap_export; @@ -2680,8 +2680,8 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en) cbs->source_size = size; cbs->result_pos = pos; cbs->times_left = n-i; - hp = HAlloc(p,PROC_BIN_SIZE); - trap_term = erts_mk_magic_binary_term(&hp, &MSO(p), mb); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + trap_term = erts_mk_magic_ref(&hp, &MSO(p), mb); BUMP_ALL_REDS(p); BIF_TRAP2(&binary_copy_trap_export, p, bin, trap_term); } else { @@ -2716,7 +2716,7 @@ BIF_RETTYPE binary_copy_trap(BIF_ALIST_2) Uint reds = get_reds(BIF_P, BINARY_COPY_LOOP_FACTOR); byte *t; Uint pos; - Binary *mb = ((ProcBin *) binary_val(BIF_ARG_2))->val; + Binary *mb = erts_magic_ref2bin(BIF_ARG_2); CopyBinState *cbs = (CopyBinState *) ERTS_MAGIC_BIN_DATA(mb); Uint opos; diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index 587859e413..2ce872d2bc 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -1109,25 +1109,25 @@ void erts_ddll_decrement_port_count(DE_Handle *dh) static void first_ddll_reference(DE_Handle *dh) { assert_drv_list_rwlocked(); - erts_refc_init(&(dh->refc),1); + erts_smp_refc_init(&(dh->refc),1); } void erts_ddll_reference_driver(DE_Handle *dh) { assert_drv_list_locked(); - if (erts_refc_inctest(&(dh->refc),1) == 1) { - erts_refc_inc(&(dh->refc),2); /* add a reference for the scheduled operation */ + if (erts_smp_refc_inctest(&(dh->refc),1) == 1) { + erts_smp_refc_inc(&(dh->refc),2); /* add a reference for the scheduled operation */ } } void erts_ddll_reference_referenced_driver(DE_Handle *dh) { - erts_refc_inc(&(dh->refc),2); + erts_smp_refc_inc(&(dh->refc),2); } void erts_ddll_dereference_driver(DE_Handle *dh) { - if (erts_refc_dectest(&(dh->refc),0) == 0) { + if (erts_smp_refc_dectest(&(dh->refc),0) == 0) { /* No lock here, but if the driver is referenced again, the scheduled deletion is added as a reference too, see above */ erts_schedule_misc_op(ddll_no_more_references, (void *) dh); @@ -1150,11 +1150,11 @@ static void restore_process_references(DE_Handle *dh) { DE_ProcEntry *p; assert_drv_list_rwlocked(); - ASSERT(erts_refc_read(&(dh->refc),0) == 0); + ASSERT(erts_smp_refc_read(&(dh->refc),0) == 0); for(p = dh->procs;p != NULL; p = p->next) { if (p->awaiting_status == ERL_DE_PROC_LOADED) { ASSERT(p->flags & ERL_DE_FL_DEREFERENCED); - erts_refc_inc(&(dh->refc),1); + erts_smp_refc_inc(&(dh->refc),1); p->flags &= ~ERL_DE_FL_DEREFERENCED; } } @@ -1176,9 +1176,9 @@ static void ddll_no_more_references(void *vdh) lock_drv_list(); - x = erts_refc_read(&(dh->refc),0); + x = erts_smp_refc_read(&(dh->refc),0); if (x > 0) { - x = erts_refc_dectest(&(dh->refc),0); /* delete the reference added for me */ + x = erts_smp_refc_dectest(&(dh->refc),0); /* delete the reference added for me */ } @@ -1476,8 +1476,10 @@ static void add_proc_loaded_deref(DE_Handle *dh, Process *proc) static Eterm copy_ref(Eterm ref, Eterm *hp) { - RefThing *ptr = ref_thing_ptr(ref); - memcpy(hp, ptr, sizeof(RefThing)); + ErtsORefThing *ptr; + ASSERT(is_internal_ordinary_ref(ref)); + ptr = ordinary_ref_thing_ptr(ref); + memcpy(hp, ptr, sizeof(ErtsORefThing)); return (make_internal_ref(hp)); } @@ -1643,7 +1645,7 @@ static int load_driver_entry(DE_Handle **dhp, char *path, char *name) dh->handle = NULL; dh->procs = NULL; erts_smp_atomic32_init_nob(&dh->port_count, 0); - erts_refc_init(&(dh->refc), (erts_aint_t) 0); + erts_smp_refc_init(&(dh->refc), (erts_aint_t) 0); dh->status = -1; dh->reload_full_path = NULL; dh->reload_driver_name = NULL; @@ -1681,7 +1683,7 @@ static int reload_driver_entry(DE_Handle *dh) dh->reload_full_path = NULL; dh->reload_driver_name = NULL; - ASSERT(erts_refc_read(&(dh->refc),0) == 0); + ASSERT(erts_smp_refc_read(&(dh->refc),0) == 0); ASSERT(dh->full_path != NULL); erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh->full_path); dh->full_path = NULL; @@ -1720,10 +1722,10 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type, Eterm e; mp = erts_alloc_message_heap(proc, &rp_locks, (6 /* tuple */ + 3 /* Error tuple */ + - REF_THING_SIZE + need), + ERTS_REF_THING_SIZE + need), &hp, &ohp); r = copy_ref(ref,hp); - hp += REF_THING_SIZE; + hp += ERTS_REF_THING_SIZE; e = build_load_error_hp(hp, errcode); hp += need; mess = TUPLE2(hp,tag,e); @@ -1731,10 +1733,10 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type, mess = TUPLE5(hp,type,r,am_driver,driver_name,mess); } else { mp = erts_alloc_message_heap(proc, &rp_locks, - 6 /* tuple */ + REF_THING_SIZE, + 6 /* tuple */ + ERTS_REF_THING_SIZE, &hp, &ohp); r = copy_ref(ref,hp); - hp += REF_THING_SIZE; + hp += ERTS_REF_THING_SIZE; mess = TUPLE5(hp,type,r,am_driver,driver_name,tag); } erts_queue_message(proc, rp_locks, mp, mess, am_system); diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 5ee19aead8..be113b7c88 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -177,7 +177,33 @@ bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh) if (szp) *szp += 4+2; if (hpp) { - Uint refc = (Uint) erts_smp_atomic_read_nob(&pb->val->refc); + Uint refc = (Uint) erts_refc_read(&pb->val->refc, 1); + tuple = TUPLE3(*hpp, val, orig_size, make_small(refc)); + res = CONS(*hpp + 4, tuple, res); + *hpp += 4+2; + } + } + } + return res; +} + +static Eterm +bld_magic_ref_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh) +{ + struct erl_off_heap_header* ohh; + Eterm res = NIL; + Eterm tuple; + + for (ohh = oh->first; ohh; ohh = ohh->next) { + if (is_ref_thing_header((*((Eterm *) ohh)))) { + ErtsMRefThing *mrtp = (ErtsMRefThing *) ohh; + Eterm val = erts_bld_uword(hpp, szp, (UWord) mrtp->mb); + Eterm orig_size = erts_bld_uint(hpp, szp, mrtp->mb->orig_size); + + if (szp) + *szp += 4+2; + if (hpp) { + Uint refc = (Uint) erts_refc_read(&mrtp->mb->refc, 1); tuple = TUPLE3(*hpp, val, orig_size, make_small(refc)); res = CONS(*hpp + 4, tuple, res); *hpp += 4+2; @@ -613,7 +639,8 @@ static Eterm pi_args[] = { am_current_location, am_current_stacktrace, am_message_queue_data, - am_garbage_collection_info + am_garbage_collection_info, + am_magic_ref }; #define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm))) @@ -664,6 +691,7 @@ pi_arg2ix(Eterm arg) case am_current_stacktrace: return 31; case am_message_queue_data: return 32; case am_garbage_collection_info: return 33; + case am_magic_ref: return 34; default: return -1; } } @@ -1599,6 +1627,14 @@ process_info_aux(Process *BIF_P, hp = HAlloc(BIF_P, 3); break; + case am_magic_ref: { + Uint sz = 3; + (void) bld_magic_ref_bin_list(NULL, &sz, &MSO(rp)); + hp = HAlloc(BIF_P, sz); + res = bld_magic_ref_bin_list(&hp, NULL, &MSO(rp)); + break; + } + default: return THE_NON_VALUE; /* will produce badarg */ @@ -3531,6 +3567,11 @@ BIF_RETTYPE error_logger_warning_map_0(BIF_ALIST_0) static erts_smp_atomic_t available_internal_state; +static void empty_magic_ref_destructor(Binary *bin) +{ + +} + BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) { /* @@ -3896,6 +3937,34 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) } return make_atom(ix); } + else if (ERTS_IS_ATOM_STR("magic_ref", tp[1])) { + Binary *bin; + UWord bin_addr, refc; + Eterm bin_addr_term, refc_term, test_type; + Uint sz; + Eterm *hp; + if (!is_internal_magic_ref(tp[2])) { + if (is_internal_ordinary_ref(tp[2])) { + ErtsORefThing *rtp; + rtp = (ErtsORefThing *) internal_ref_val(tp[2]); + if (erts_is_ref_numbers_magic(rtp->num)) + BIF_RET(am_true); + } + BIF_RET(am_false); + } + bin = erts_magic_ref2bin(tp[2]); + refc = erts_refc_read(&bin->refc, 1); + bin_addr = (UWord) bin; + sz = 4; + erts_bld_uword(NULL, &sz, bin_addr); + erts_bld_uword(NULL, &sz, refc); + hp = HAlloc(BIF_P, sz); + bin_addr_term = erts_bld_uword(&hp, NULL, bin_addr); + refc_term = erts_bld_uword(&hp, NULL, refc); + test_type = (ERTS_MAGIC_BIN_DESTRUCTOR(bin) == empty_magic_ref_destructor + ? am_true : am_false); + BIF_RET(TUPLE3(hp, bin_addr_term, refc_term, test_type)); + } break; } @@ -3984,7 +4053,6 @@ static void broken_halt_test(Eterm bif_arg_2) erts_exit(ERTS_DUMP_EXIT, "%T", bif_arg_2); } - BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) { /* @@ -4314,6 +4382,21 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) /* Used by ets_SUITE (stdlib) */ BIF_RET(erts_ets_restore_meta_state(BIF_P, BIF_ARG_2)); } + else if (ERTS_IS_ATOM_STR("make", BIF_ARG_1)) { + if (ERTS_IS_ATOM_STR("magic_ref", BIF_ARG_2)) { + Binary *bin = erts_create_magic_binary(0, empty_magic_ref_destructor); + UWord bin_addr = (UWord) bin; + Eterm bin_addr_term, magic_ref, res; + Eterm *hp; + Uint sz = ERTS_MAGIC_REF_THING_SIZE + 3; + erts_bld_uword(NULL, &sz, bin_addr); + hp = HAlloc(BIF_P, sz); + bin_addr_term = erts_bld_uword(&hp, NULL, bin_addr); + magic_ref = erts_mk_magic_ref(&hp, &BIF_P->off_heap, bin); + res = TUPLE2(hp, magic_ref, bin_addr_term); + BIF_RET(res); + } + } } BIF_ERROR(BIF_P, BADARG); diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c index 90e78a9b0b..09d2c5376b 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -214,7 +214,7 @@ BIF_RETTYPE erts_internal_port_command_3(BIF_ALIST_3) ASSERT(!(flags & ERTS_PORT_SIG_FLG_FORCE)); /* Fall through... */ case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); ERTS_BIF_PREP_RET(res, ref); break; case ERTS_PORT_OP_DONE: @@ -260,7 +260,7 @@ BIF_RETTYPE erts_internal_port_call_3(BIF_ALIST_3) retval = am_badarg; break; case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(retval)); + ASSERT(is_internal_ordinary_ref(retval)); break; case ERTS_PORT_OP_DONE: ASSERT(is_not_internal_ref(retval)); @@ -310,7 +310,7 @@ BIF_RETTYPE erts_internal_port_control_3(BIF_ALIST_3) retval = am_badarg; break; case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(retval)); + ASSERT(is_internal_ordinary_ref(retval)); break; case ERTS_PORT_OP_DONE: ASSERT(is_not_internal_ref(retval)); @@ -356,7 +356,7 @@ BIF_RETTYPE erts_internal_port_close_1(BIF_ALIST_1) case ERTS_PORT_OP_DROPPED: BIF_RET(am_badarg); case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); BIF_RET(ref); case ERTS_PORT_OP_DONE: BIF_RET(am_true); @@ -389,7 +389,7 @@ BIF_RETTYPE erts_internal_port_connect_2(BIF_ALIST_2) case ERTS_PORT_OP_DROPPED: BIF_RET(am_badarg); case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); BIF_RET(ref); break; case ERTS_PORT_OP_DONE: @@ -428,7 +428,7 @@ BIF_RETTYPE erts_internal_port_info_1(BIF_ALIST_1) case ERTS_PORT_OP_DROPPED: BIF_RET(am_undefined); case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(retval)); + ASSERT(is_internal_ordinary_ref(retval)); BIF_RET(retval); case ERTS_PORT_OP_DONE: ASSERT(is_not_internal_ref(retval)); @@ -467,7 +467,7 @@ BIF_RETTYPE erts_internal_port_info_2(BIF_ALIST_2) case ERTS_PORT_OP_DROPPED: BIF_RET(am_undefined); case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(retval)); + ASSERT(is_internal_ordinary_ref(retval)); BIF_RET(retval); case ERTS_PORT_OP_DONE: ASSERT(is_not_internal_ref(retval)); diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c index ff7746ce1d..ba183f24e8 100644 --- a/erts/emulator/beam/erl_bif_re.c +++ b/erts/emulator/beam/erl_bif_re.c @@ -1319,17 +1319,17 @@ handle_iolist: Binary *mbp = erts_create_magic_binary(sizeof(RestartContext), cleanup_restart_context_bin); RestartContext *restartp = ERTS_MAGIC_BIN_DATA(mbp); - Eterm magic_bin; + Eterm magic_ref; Eterm *hp; memcpy(restartp,&restart,sizeof(RestartContext)); BUMP_ALL_REDS(p); - hp = HAlloc(p, PROC_BIN_SIZE); - magic_bin = erts_mk_magic_binary_term(&hp, &MSO(p), mbp); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + magic_ref = erts_mk_magic_ref(&hp, &MSO(p), mbp); BIF_TRAP3(&re_exec_trap_export, p, arg1, arg2 /* To avoid GC of precompiled code, XXX: not utilized yet */, - magic_bin); + magic_ref); } res = build_exec_return(p, rc, &restart, arg1); @@ -1366,9 +1366,7 @@ static BIF_RETTYPE re_exec_trap(BIF_ALIST_3) Uint loop_limit_tmp; Eterm res; - ASSERT(ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_3)); - - mbp = ((ProcBin *) binary_val(BIF_ARG_3))->val; + mbp = erts_magic_ref2bin(BIF_ARG_3); ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == cleanup_restart_context_bin); diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index a480754bdb..f471390501 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -2363,7 +2363,7 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2) typedef struct { Process *proc; Eterm ref; - Eterm ref_heap[REF_THING_SIZE]; + Eterm ref_heap[ERTS_REF_THING_SIZE]; Eterm target; erts_smp_atomic32_t refc; } ErtsTraceDeliveredAll; diff --git a/erts/emulator/beam/erl_bif_unique.c b/erts/emulator/beam/erl_bif_unique.c index 7c70217d8d..3fd4c87094 100644 --- a/erts/emulator/beam/erl_bif_unique.c +++ b/erts/emulator/beam/erl_bif_unique.c @@ -22,12 +22,15 @@ # include "config.h" #endif +#define ERL_BIF_UNIQUE_C__ #include "sys.h" #include "erl_vm.h" #include "erl_alloc.h" #include "export.h" #include "bif.h" #include "erl_bif_unique.h" +#include "hash.h" +#include "erl_binary.h" /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * Reference * @@ -58,9 +61,20 @@ static union { static Uint32 max_thr_id; #endif +static void init_magic_ref_tables(void); + +static Uint64 ref_init_value; + static void init_reference(void) { + SysTimeval tv; + sys_gettimeofday(&tv); + ref_init_value = 0; + ref_init_value |= (Uint64) tv.tv_sec; + ref_init_value |= ((Uint64) tv.tv_usec) << 32; + ref_init_value *= (Uint64) 268438039; + ref_init_value += (Uint64) tv.tv_usec; #ifdef DEBUG max_thr_id = (Uint32) erts_no_schedulers; #ifdef ERTS_DIRTY_SCHEDULERS @@ -68,11 +82,13 @@ init_reference(void) max_thr_id += (Uint32) erts_no_dirty_io_schedulers; #endif #endif - erts_atomic64_init_nob(&global_reference.count, 0); + erts_atomic64_init_nob(&global_reference.count, + (erts_aint64_t) ref_init_value); + init_magic_ref_tables(); } static ERTS_INLINE void -global_make_ref_in_array(Uint32 thr_id, Uint32 ref[ERTS_MAX_REF_NUMBERS]) +global_make_ref_in_array(Uint32 thr_id, Uint32 ref[ERTS_REF_NUMBERS]) { Uint64 value; @@ -82,7 +98,7 @@ global_make_ref_in_array(Uint32 thr_id, Uint32 ref[ERTS_MAX_REF_NUMBERS]) } static ERTS_INLINE void -make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]) +make_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS]) { ErtsSchedulerData *esdp = erts_get_scheduler_data(); if (esdp) @@ -92,15 +108,23 @@ make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]) } void -erts_make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]) +erts_make_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS]) +{ + make_ref_in_array(ref); +} + +void +erts_make_magic_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS]) { make_ref_in_array(ref); + ASSERT(!(ref[1] & ERTS_REF1_MAGIC_MARKER_BIT__)); + ref[1] |= ERTS_REF1_MAGIC_MARKER_BIT__; } -Eterm erts_make_ref_in_buffer(Eterm buffer[REF_THING_SIZE]) +Eterm erts_make_ref_in_buffer(Eterm buffer[ERTS_REF_THING_SIZE]) { Eterm* hp = buffer; - Uint32 ref[ERTS_MAX_REF_NUMBERS]; + Uint32 ref[ERTS_REF_NUMBERS]; make_ref_in_array(ref); write_ref_thing(hp, ref[0], ref[1], ref[2]); @@ -110,11 +134,11 @@ Eterm erts_make_ref_in_buffer(Eterm buffer[REF_THING_SIZE]) Eterm erts_make_ref(Process *c_p) { Eterm* hp; - Uint32 ref[ERTS_MAX_REF_NUMBERS]; + Uint32 ref[ERTS_REF_NUMBERS]; ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p)); - hp = HAlloc(c_p, REF_THING_SIZE); + hp = HAlloc(c_p, ERTS_REF_THING_SIZE); make_ref_in_array(ref); write_ref_thing(hp, ref[0], ref[1], ref[2]); @@ -122,6 +146,272 @@ Eterm erts_make_ref(Process *c_p) return make_internal_ref(hp); } +/* + * Magic reference tables + */ + +typedef struct { + HashBucket hash; + ErtsMagicBinary *mb; + Uint64 value; + Uint32 thr_id; +} ErtsMagicRefTableEntry; + +typedef struct { + erts_rwmtx_t rwmtx; + Hash hash; + char name[32]; +} ErtsMagicRefTable; + +typedef struct { + union { + ErtsMagicRefTable table; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsMagicRefTable))]; + } u; +} ErtsAlignedMagicRefTable; + +ErtsAlignedMagicRefTable *magic_ref_table; + +ErtsMagicBinary * +erts_magic_ref_lookup_bin__(Uint32 refn[ERTS_REF_NUMBERS]) +{ + ErtsMagicRefTableEntry tmpl; + ErtsMagicRefTableEntry *tep; + ErtsMagicBinary *mb; + ErtsMagicRefTable *tblp; + + ASSERT(erts_is_ref_numbers_magic(refn)); + + tmpl.value = erts_get_ref_numbers_value(refn); + tmpl.thr_id = erts_get_ref_numbers_thr_id(refn); + if (tmpl.thr_id > erts_no_schedulers) + tblp = &magic_ref_table[0].u.table; + else + tblp = &magic_ref_table[tmpl.thr_id].u.table; + + erts_rwmtx_rlock(&tblp->rwmtx); + + tep = (ErtsMagicRefTableEntry *) hash_get(&tblp->hash, &tmpl); + if (!tep) + mb = NULL; + else { + erts_aint_t refc; + mb = tep->mb; + refc = erts_refc_inc_unless(&mb->refc, 0, 0); + if (refc == 0) + mb = NULL; + } + + erts_rwmtx_runlock(&tblp->rwmtx); + + return mb; +} + +void +erts_magic_ref_save_bin__(Eterm ref) +{ + ErtsMagicRefTableEntry tmpl; + ErtsMagicRefTableEntry *tep; + ErtsMRefThing *mrtp; + ErtsMagicRefTable *tblp; + Uint32 *refn; + + ASSERT(is_internal_magic_ref(ref)); + + mrtp = (ErtsMRefThing *) internal_ref_val(ref); + refn = mrtp->mb->refn; + + tmpl.value = erts_get_ref_numbers_value(refn); + tmpl.thr_id = erts_get_ref_numbers_thr_id(refn); + + if (tmpl.thr_id > erts_no_schedulers) + tblp = &magic_ref_table[0].u.table; + else + tblp = &magic_ref_table[tmpl.thr_id].u.table; + + erts_rwmtx_rlock(&tblp->rwmtx); + + tep = (ErtsMagicRefTableEntry *) hash_get(&tblp->hash, &tmpl); + + erts_rwmtx_runlock(&tblp->rwmtx); + + if (!tep) { + ErtsMagicRefTableEntry *used_tep; + + ASSERT(tmpl.value == erts_get_ref_numbers_value(refn)); + ASSERT(tmpl.thr_id == erts_get_ref_numbers_thr_id(refn)); + + if (tblp != &magic_ref_table[0].u.table) { + tep = erts_alloc(ERTS_ALC_T_MREF_NSCHED_ENT, + sizeof(ErtsNSchedMagicRefTableEntry)); + } + else { + tep = erts_alloc(ERTS_ALC_T_MREF_ENT, + sizeof(ErtsMagicRefTableEntry)); + tep->thr_id = tmpl.thr_id; + } + + tep->value = tmpl.value; + tep->mb = mrtp->mb; + + erts_rwmtx_rwlock(&tblp->rwmtx); + + used_tep = hash_put(&tblp->hash, tep); + + erts_rwmtx_rwunlock(&tblp->rwmtx); + + if (used_tep != tep) { + if (tblp != &magic_ref_table[0].u.table) + erts_free(ERTS_ALC_T_MREF_NSCHED_ENT, (void *) tep); + else + erts_free(ERTS_ALC_T_MREF_ENT, (void *) tep); + } + } +} + +void +erts_magic_ref_remove_bin(Uint32 refn[ERTS_REF_NUMBERS]) +{ + ErtsMagicRefTableEntry tmpl; + ErtsMagicRefTableEntry *tep; + ErtsMagicRefTable *tblp; + + tmpl.value = erts_get_ref_numbers_value(refn); + tmpl.thr_id = erts_get_ref_numbers_thr_id(refn); + + if (tmpl.thr_id > erts_no_schedulers) + tblp = &magic_ref_table[0].u.table; + else + tblp = &magic_ref_table[tmpl.thr_id].u.table; + + erts_rwmtx_rlock(&tblp->rwmtx); + + tep = (ErtsMagicRefTableEntry *) hash_get(&tblp->hash, &tmpl); + + erts_rwmtx_runlock(&tblp->rwmtx); + + if (tep) { + + ASSERT(tmpl.value == erts_get_ref_numbers_value(refn)); + ASSERT(tmpl.thr_id == erts_get_ref_numbers_thr_id(refn)); + + erts_rwmtx_rwlock(&tblp->rwmtx); + + tep = hash_remove(&tblp->hash, &tmpl); + ASSERT(tep); + + erts_rwmtx_rwunlock(&tblp->rwmtx); + + if (tblp != &magic_ref_table[0].u.table) + erts_free(ERTS_ALC_T_MREF_NSCHED_ENT, (void *) tep); + else + erts_free(ERTS_ALC_T_MREF_ENT, (void *) tep); + } +} + +static int nsched_mreft_cmp(void *ve1, void *ve2) +{ + ErtsNSchedMagicRefTableEntry *e1 = ve1; + ErtsNSchedMagicRefTableEntry *e2 = ve2; + return e1->value != e2->value; +} + +static int non_nsched_mreft_cmp(void *ve1, void *ve2) +{ + ErtsMagicRefTableEntry *e1 = ve1; + ErtsMagicRefTableEntry *e2 = ve2; + return e1->value != e2->value || e1->thr_id != e2->thr_id; +} + +static HashValue nsched_mreft_hash(void *ve) +{ + ErtsNSchedMagicRefTableEntry *e = ve; + return (HashValue) e->value; +} + +static HashValue non_nsched_mreft_hash(void *ve) +{ + ErtsMagicRefTableEntry *e = ve; + HashValue h; + h = (HashValue) e->thr_id; + h *= 268440163; + h += (HashValue) e->value; + return h; +} + +static void *mreft_alloc(void *ve) +{ + /* + * We allocate the element before + * hash_put() and pass it as + * template which we get as + * input... + */ + return ve; +} + +static void mreft_free(void *ve) +{ + /* + * We free the element ourselves + * after hash_remove()... + */ +} + +static void *mreft_meta_alloc(int i, size_t size) +{ + return erts_alloc(ERTS_ALC_T_MREF_TAB_BKTS, size); +} + +static void mreft_meta_free(int i, void *ptr) +{ + erts_free(ERTS_ALC_T_MREF_TAB_BKTS, ptr); +} + +static void +init_magic_ref_tables(void) +{ + HashFunctions hash_funcs; + int i; + ErtsMagicRefTable *tblp; + + magic_ref_table = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_MREF_TAB, + (sizeof(ErtsAlignedMagicRefTable) + * (erts_no_schedulers + 1))); + + hash_funcs.hash = non_nsched_mreft_hash; + hash_funcs.cmp = non_nsched_mreft_cmp; + + hash_funcs.alloc = mreft_alloc; + hash_funcs.free = mreft_free; + hash_funcs.meta_alloc = mreft_meta_alloc; + hash_funcs.meta_free = mreft_meta_free; + hash_funcs.meta_print = erts_print; + + tblp = &magic_ref_table[0].u.table; + erts_snprintf(&tblp->name[0], sizeof(tblp->name), + "magic_ref_table_0"); + hash_init(0, &tblp->hash, &tblp->name[0], 1, hash_funcs); + erts_rwmtx_init(&tblp->rwmtx, "magic_ref_table"); + + hash_funcs.hash = nsched_mreft_hash; + hash_funcs.cmp = nsched_mreft_cmp; + + for (i = 1; i <= erts_no_schedulers; i++) { + ErtsMagicRefTable *tblp = &magic_ref_table[i].u.table; + erts_snprintf(&tblp->name[0], sizeof(tblp->name), + "magic_ref_table_%d", i); + hash_init(0, &tblp->hash, &tblp->name[0], 1, hash_funcs); + erts_rwmtx_init(&tblp->rwmtx, "magic_ref_table"); + } +} + +void erts_ref_bin_free(ErtsMagicBinary *mb) +{ + erts_bin_free((Binary *) mb); +} + + /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * Unique Integer * \* */ @@ -498,7 +788,7 @@ void erts_sched_bif_unique_init(ErtsSchedulerData *esdp) { esdp->unique = (Uint64) 0; - esdp->ref = (Uint64) 0; + esdp->ref = (Uint64) ref_init_value; } /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ @@ -513,7 +803,7 @@ BIF_RETTYPE make_ref_0(BIF_ALIST_0) ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P)); - hp = HAlloc(BIF_P, REF_THING_SIZE); + hp = HAlloc(BIF_P, ERTS_REF_THING_SIZE); res = erts_sched_make_ref_in_buffer(erts_proc_sched_data(BIF_P), hp); diff --git a/erts/emulator/beam/erl_bif_unique.h b/erts/emulator/beam/erl_bif_unique.h index c6481864d0..27c2a15a5e 100644 --- a/erts/emulator/beam/erl_bif_unique.h +++ b/erts/emulator/beam/erl_bif_unique.h @@ -21,16 +21,25 @@ #ifndef ERTS_BIF_UNIQUE_H__ #define ERTS_BIF_UNIQUE_H__ +#include "erl_term.h" #include "erl_process.h" #include "big.h" +#define ERTS_BINARY_TYPES_ONLY__ +#include "erl_binary.h" +#undef ERTS_BINARY_TYPES_ONLY__ void erts_bif_unique_init(void); void erts_sched_bif_unique_init(ErtsSchedulerData *esdp); /* reference */ Eterm erts_make_ref(Process *); -Eterm erts_make_ref_in_buffer(Eterm buffer[REF_THING_SIZE]); -void erts_make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]); +Eterm erts_make_ref_in_buffer(Eterm buffer[ERTS_REF_THING_SIZE]); +void erts_make_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS]); +void erts_make_magic_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS]); +void erts_magic_ref_remove_bin(Uint32 refn[ERTS_REF_NUMBERS]); +void erts_magic_ref_save_bin__(Eterm ref); +ErtsMagicBinary *erts_magic_ref_lookup_bin__(Uint32 refn[ERTS_REF_NUMBERS]); + /* strict monotonic counter */ @@ -67,19 +76,35 @@ Eterm erts_debug_make_unique_integer(Process *c_p, Eterm etval1); -ERTS_GLB_INLINE void erts_set_ref_numbers(Uint32 ref[ERTS_MAX_REF_NUMBERS], +ERTS_GLB_INLINE void erts_set_ref_numbers(Uint32 ref[ERTS_REF_NUMBERS], Uint32 thr_id, Uint64 value); -ERTS_GLB_INLINE Uint32 erts_get_ref_numbers_thr_id(Uint32 ref[ERTS_MAX_REF_NUMBERS]); -ERTS_GLB_INLINE Uint64 erts_get_ref_numbers_value(Uint32 ref[ERTS_MAX_REF_NUMBERS]); +ERTS_GLB_INLINE Uint32 erts_get_ref_numbers_thr_id(Uint32 ref[ERTS_REF_NUMBERS]); +ERTS_GLB_INLINE int erts_is_ref_numbers_magic(Uint32 ref[ERTS_REF_NUMBERS]); +ERTS_GLB_INLINE Uint64 erts_get_ref_numbers_value(Uint32 ref[ERTS_REF_NUMBERS]); ERTS_GLB_INLINE void erts_sched_make_ref_in_array(ErtsSchedulerData *esdp, - Uint32 ref[ERTS_MAX_REF_NUMBERS]); + Uint32 ref[ERTS_REF_NUMBERS]); +ERTS_GLB_INLINE void erts_sched_make_magic_ref_in_array(ErtsSchedulerData *esdp, + Uint32 ref[ERTS_REF_NUMBERS]); ERTS_GLB_INLINE Eterm erts_sched_make_ref_in_buffer(ErtsSchedulerData *esdp, - Eterm buffer[REF_THING_SIZE]); + Eterm buffer[ERTS_REF_THING_SIZE]); +ERTS_GLB_INLINE Eterm erts_mk_magic_ref(Eterm **hpp, ErlOffHeap *ohp, Binary *mbp); +ERTS_GLB_INLINE Binary *erts_magic_ref2bin(Eterm mref); +ERTS_GLB_INLINE void erts_magic_ref_save_bin(Eterm ref); +ERTS_GLB_INLINE ErtsMagicBinary *erts_magic_ref_lookup_bin(Uint32 ref[ERTS_REF_NUMBERS]); + +#define ERTS_REF1_MAGIC_MARKER_BIT_NO__ \ + (_REF_NUM_SIZE-1) +#define ERTS_REF1_MAGIC_MARKER_BIT__ \ + (((Uint32) 1) << ERTS_REF1_MAGIC_MARKER_BIT_NO__) +#define ERTS_REF1_THR_ID_MASK__ \ + (ERTS_REF1_MAGIC_MARKER_BIT__-1) +#define ERTS_REF1_NUM_MASK__ \ + (~(ERTS_REF1_THR_ID_MASK__|ERTS_REF1_MAGIC_MARKER_BIT__)) #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE void -erts_set_ref_numbers(Uint32 ref[ERTS_MAX_REF_NUMBERS], Uint32 thr_id, Uint64 value) +erts_set_ref_numbers(Uint32 ref[ERTS_REF_NUMBERS], Uint32 thr_id, Uint64 value) { /* * We cannot use thread id in the first 18-bit word since @@ -87,30 +112,39 @@ erts_set_ref_numbers(Uint32 ref[ERTS_MAX_REF_NUMBERS], Uint32 thr_id, Uint64 val * we did, we would get really poor hash values. Instead * we have to shuffle the bits a bit. */ - ASSERT(thr_id == (thr_id & ((Uint32) 0x3ffff))); - ref[0] = (Uint32) (value & ((Uint64) 0x3ffff)); - ref[1] = (((Uint32) (value & ((Uint64) 0xfffc0000))) - | (thr_id & ((Uint32) 0x3ffff))); + ASSERT(thr_id == (thr_id & ((Uint32) ERTS_REF1_THR_ID_MASK__))); + ref[0] = (Uint32) (value & ((Uint64) REF_MASK)); + ref[1] = (((Uint32) (value & ((Uint64) ERTS_REF1_NUM_MASK__))) + | (thr_id & ((Uint32) ERTS_REF1_THR_ID_MASK__))); ref[2] = (Uint32) ((value >> 32) & ((Uint64) 0xffffffff)); } ERTS_GLB_INLINE Uint32 -erts_get_ref_numbers_thr_id(Uint32 ref[ERTS_MAX_REF_NUMBERS]) +erts_get_ref_numbers_thr_id(Uint32 ref[ERTS_REF_NUMBERS]) { - return ref[1] & ((Uint32) 0x3ffff); + return ref[1] & ((Uint32) ERTS_REF1_THR_ID_MASK__); +} + +ERTS_GLB_INLINE int +erts_is_ref_numbers_magic(Uint32 ref[ERTS_REF_NUMBERS]) +{ + return !!(ref[1] & ERTS_REF1_MAGIC_MARKER_BIT__); } ERTS_GLB_INLINE Uint64 -erts_get_ref_numbers_value(Uint32 ref[ERTS_MAX_REF_NUMBERS]) +erts_get_ref_numbers_value(Uint32 ref[ERTS_REF_NUMBERS]) { + ERTS_CT_ASSERT((ERTS_REF1_NUM_MASK__ | REF_MASK) == 0xffffffff); + ERTS_CT_ASSERT((ERTS_REF1_NUM_MASK__ & REF_MASK) == 0); + return (((((Uint64) ref[2]) & ((Uint64) 0xffffffff)) << 32) - | (((Uint64) ref[1]) & ((Uint64) 0xfffc0000)) - | (((Uint64) ref[0]) & ((Uint64) 0x3ffff))); + | (((Uint64) ref[1]) & ((Uint64) ERTS_REF1_NUM_MASK__)) + | (((Uint64) ref[0]) & ((Uint64) REF_MASK))); } ERTS_GLB_INLINE void erts_sched_make_ref_in_array(ErtsSchedulerData *esdp, - Uint32 ref[ERTS_MAX_REF_NUMBERS]) + Uint32 ref[ERTS_REF_NUMBERS]) { Uint64 value; @@ -119,18 +153,288 @@ erts_sched_make_ref_in_array(ErtsSchedulerData *esdp, erts_set_ref_numbers(ref, (Uint32) esdp->thr_id, value); } +ERTS_GLB_INLINE void +erts_sched_make_magic_ref_in_array(ErtsSchedulerData *esdp, + Uint32 ref[ERTS_REF_NUMBERS]) +{ + erts_sched_make_ref_in_array(esdp, ref); + ASSERT(!(ref[1] & ERTS_REF1_MAGIC_MARKER_BIT__)); + ref[1] |= ERTS_REF1_MAGIC_MARKER_BIT__; +} + ERTS_GLB_INLINE Eterm erts_sched_make_ref_in_buffer(ErtsSchedulerData *esdp, - Eterm buffer[REF_THING_SIZE]) + Eterm buffer[ERTS_REF_THING_SIZE]) { Eterm* hp = buffer; - Uint32 ref[ERTS_MAX_REF_NUMBERS]; + Uint32 ref[ERTS_REF_NUMBERS]; erts_sched_make_ref_in_array(esdp, ref); write_ref_thing(hp, ref[0], ref[1], ref[2]); return make_internal_ref(hp); } +ERTS_GLB_INLINE Eterm +erts_mk_magic_ref(Eterm **hpp, ErlOffHeap *ohp, Binary *bp) +{ + Eterm *hp = *hpp; + ASSERT(bp->flags & BIN_FLAG_MAGIC); + write_magic_ref_thing(hp, ohp, (ErtsMagicBinary *) bp); + *hpp += ERTS_MAGIC_REF_THING_SIZE; + erts_refc_inc(&bp->refc, 1); + OH_OVERHEAD(ohp, bp->orig_size / sizeof(Eterm)); + return make_internal_ref(hp); +} + +ERTS_GLB_INLINE Binary * +erts_magic_ref2bin(Eterm mref) +{ + ErtsMRefThing *mrtp; + ASSERT(is_internal_magic_ref(mref)); + mrtp = (ErtsMRefThing *) internal_ref_val(mref); + return (Binary *) mrtp->mb; +} + +/* + * Save the magic binary of a ref when the + * ref is exposed to the outside world... + */ +ERTS_GLB_INLINE void +erts_magic_ref_save_bin(Eterm ref) +{ + if (is_internal_magic_ref(ref)) + erts_magic_ref_save_bin__(ref); +} + +/* + * Look up the magic binary of a magic ref + * when the ref comes from the outside world... + */ +ERTS_GLB_INLINE ErtsMagicBinary * +erts_magic_ref_lookup_bin(Uint32 ref[ERTS_REF_NUMBERS]) +{ + if (!erts_is_ref_numbers_magic(ref)) + return NULL; + return erts_magic_ref_lookup_bin__(ref); +} + + #endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +/* + * Storage of internal refs in misc structures... + */ + +#include "erl_message.h" + +#if ERTS_REF_NUMBERS != 3 +# error fix this... +#endif + +ERTS_GLB_INLINE int erts_internal_ref_number_cmp(Uint32 num1[ERTS_REF_NUMBERS], + Uint32 num2[ERTS_REF_NUMBERS]); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE int +erts_internal_ref_number_cmp(Uint32 num1[ERTS_REF_NUMBERS], + Uint32 num2[ERTS_REF_NUMBERS]) +{ + if (num1[2] != num2[2]) + return (int) ((Sint64) num1[2] - (Sint64) num2[2]); + if (num1[1] != num2[1]) + return (int) ((Sint64) num1[1] - (Sint64) num2[1]); + if (num1[0] != num2[0]) + return (int) ((Sint64) num1[0] - (Sint64) num2[0]); + return 0; +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +/* Iref storage for all internal references... */ +typedef struct { + Uint32 is_magic; + union { + ErtsMagicBinary *mb; + Uint32 num[ERTS_REF_NUMBERS]; + } u; +} ErtsIRefStorage; + +void erts_ref_bin_free(ErtsMagicBinary *mb); + +ERTS_GLB_INLINE void erts_iref_storage_save(ErtsIRefStorage *iref, Eterm ref); +ERTS_GLB_INLINE void erts_iref_storage_clean(ErtsIRefStorage *iref); +ERTS_GLB_INLINE Uint erts_iref_storage_heap_size(ErtsIRefStorage *iref); +ERTS_GLB_INLINE Eterm erts_iref_storage_make_ref(ErtsIRefStorage *iref, + Eterm **hpp, ErlOffHeap *ohp, + int clean_storage); +ERTS_GLB_INLINE int erts_iref_storage_cmp(ErtsIRefStorage *iref1, + ErtsIRefStorage *iref2); + + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_iref_storage_save(ErtsIRefStorage *iref, Eterm ref) +{ + Eterm *hp; + + ERTS_CT_ASSERT(ERTS_REF_NUMBERS == 3); + ASSERT(is_internal_ref(ref)); + + hp = boxed_val(ref); + + if (is_ordinary_ref_thing(hp)) { + ErtsORefThing *rtp = (ErtsORefThing *) hp; + iref->is_magic = 0; + iref->u.num[0] = rtp->num[0]; + iref->u.num[1] = rtp->num[1]; + iref->u.num[2] = rtp->num[2]; + } + else { + ErtsMRefThing *mrtp = (ErtsMRefThing *) hp; + ASSERT(is_magic_ref_thing(hp)); + iref->is_magic = 1; + iref->u.mb = mrtp->mb; + erts_refc_inc(&mrtp->mb->refc, 1); + } +} + +ERTS_GLB_INLINE void +erts_iref_storage_clean(ErtsIRefStorage *iref) +{ + if (iref->is_magic && erts_refc_dectest(&iref->u.mb->refc, 0) == 0) + erts_ref_bin_free(iref->u.mb); +#ifdef DEBUG + memset((void *) iref, 0xf, sizeof(ErtsIRefStorage)); +#endif +} + +ERTS_GLB_INLINE Uint +erts_iref_storage_heap_size(ErtsIRefStorage *iref) +{ + return iref->is_magic ? ERTS_MAGIC_REF_THING_SIZE : ERTS_REF_THING_SIZE; +} + +ERTS_GLB_INLINE Eterm +erts_iref_storage_make_ref(ErtsIRefStorage *iref, + Eterm **hpp, ErlOffHeap *ohp, + int clean_storage) +{ + Eterm *hp = *hpp; + if (!iref->is_magic) { + write_ref_thing(hp, iref->u.num[0], iref->u.num[1], + iref->u.num[2]); + *hpp += ERTS_REF_THING_SIZE; + } + else { + write_magic_ref_thing(hp, ohp, iref->u.mb); + OH_OVERHEAD(ohp, iref->u.mb->orig_size / sizeof(Eterm)); + *hpp += ERTS_MAGIC_REF_THING_SIZE; + /* + * If we clean storage, the term inherits the + * refc increment of the cleaned storage... + */ + if (!clean_storage) + erts_refc_inc(&iref->u.mb->refc, 1); + } + +#ifdef DEBUG + if (clean_storage) + memset((void *) iref, 0xf, sizeof(ErtsIRefStorage)); +#endif + + return make_internal_ref(hp); +} + +ERTS_GLB_INLINE int +erts_iref_storage_cmp(ErtsIRefStorage *iref1, + ErtsIRefStorage *iref2) +{ + Uint32 *num1 = iref1->is_magic ? iref1->u.mb->refn : iref1->u.num; + Uint32 *num2 = iref2->is_magic ? iref2->u.mb->refn : iref2->u.num; + return erts_internal_ref_number_cmp(num1, num2); +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + + +/* OIref storage for ordinary internal references only... */ +typedef struct { + Uint32 num[ERTS_REF_NUMBERS]; +} ErtsOIRefStorage; + +ERTS_GLB_INLINE void erts_oiref_storage_save(ErtsOIRefStorage *oiref, + Eterm ref); +ERTS_GLB_INLINE Eterm erts_oiref_storage_make_ref(ErtsOIRefStorage *oiref, + Eterm **hpp); +ERTS_GLB_INLINE int erts_oiref_storage_cmp(ErtsOIRefStorage *oiref1, + ErtsOIRefStorage *oiref2); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_oiref_storage_save(ErtsOIRefStorage *oiref, Eterm ref) +{ + ErtsORefThing *rtp; + ERTS_CT_ASSERT(ERTS_REF_NUMBERS == 3); + ASSERT(is_internal_ordinary_ref(ref)); + + rtp = (ErtsORefThing *) internal_ref_val(ref); + + oiref->num[0] = rtp->num[0]; + oiref->num[1] = rtp->num[1]; + oiref->num[2] = rtp->num[2]; +} + +ERTS_GLB_INLINE Eterm +erts_oiref_storage_make_ref(ErtsOIRefStorage *oiref, Eterm **hpp) +{ + Eterm *hp = *hpp; + ERTS_CT_ASSERT(ERTS_REF_NUMBERS == 3); + write_ref_thing(hp, oiref->num[0], oiref->num[1], oiref->num[2]); + *hpp += ERTS_REF_THING_SIZE; + return make_internal_ref(hp); +} + +ERTS_GLB_INLINE int +erts_oiref_storage_cmp(ErtsOIRefStorage *oiref1, + ErtsOIRefStorage *oiref2) +{ + return erts_internal_ref_number_cmp(oiref1->num, oiref2->num); +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + + +ERTS_GLB_INLINE Eterm +erts_proc_store_ref(Process *c_p, Uint32 ref[ERTS_MAX_REF_NUMBERS]); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE Eterm +erts_proc_store_ref(Process *c_p, Uint32 ref[ERTS_MAX_REF_NUMBERS]) +{ + Eterm *hp = HAlloc(c_p, ERTS_REF_THING_SIZE); + write_ref_thing(hp, ref[0], ref[1], ref[2]); + return make_internal_ref(hp); +} + +#endif + #endif /* ERTS_BIF_UNIQUE_H__ */ + +#if (defined(ERTS_ALLOC_C__) || defined(ERL_BIF_UNIQUE_C__)) \ + && !defined(ERTS_BIF_UNIQUE_H__FIX_ALLOC_TYPES__) +#define ERTS_BIF_UNIQUE_H__FIX_ALLOC_TYPES__ + +#include "hash.h" + +typedef struct { + HashBucket hash; + ErtsMagicBinary *mb; + Uint64 value; +} ErtsNSchedMagicRefTableEntry; + +#endif diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index fdc5efea98..c811a002ce 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -18,11 +18,146 @@ * %CopyrightEnd% */ -#ifndef __ERL_BINARY_H -#define __ERL_BINARY_H +#ifndef ERL_BINARY_H__TYPES__ +#define ERL_BINARY_H__TYPES__ + +/* +** Just like the driver binary but with initial flags +** Note that the two structures Binary and ErlDrvBinary HAVE to +** be equal except for extra fields in the beginning of the struct. +** ErlDrvBinary is defined in erl_driver.h. +** When driver_alloc_binary is called, a Binary is allocated, but +** the pointer returned is to the address of the first element that +** also occurs in the ErlDrvBinary struct (driver.*binary takes care if this). +** The driver need never know about additions to the internal Binary of the +** emulator. One should however NEVER be sloppy when mixing ErlDrvBinary +** and Binary, the macros below can convert one type to the other, as they both +** in reality are equal. +*/ + +#ifdef ARCH_32 + /* *DO NOT USE* only for alignment. */ +#define ERTS_BINARY_STRUCT_ALIGNMENT Uint32 align__; +#else +#define ERTS_BINARY_STRUCT_ALIGNMENT +#endif + +/* Add fields in ERTS_INTERNAL_BINARY_FIELDS, otherwise the drivers crash */ +#define ERTS_INTERNAL_BINARY_FIELDS \ + UWord flags; \ + erts_refc_t refc; \ + ERTS_BINARY_STRUCT_ALIGNMENT + +typedef struct binary { + ERTS_INTERNAL_BINARY_FIELDS + SWord orig_size; + char orig_bytes[1]; /* to be continued */ +} Binary; + +#define ERTS_SIZEOF_Binary(Sz) \ + (offsetof(Binary,orig_bytes) + (Sz)) + +#if ERTS_REF_NUMBERS != 3 +#error "Update ErtsMagicBinary" +#endif + +typedef struct magic_binary ErtsMagicBinary; +struct magic_binary { + ERTS_INTERNAL_BINARY_FIELDS + SWord orig_size; + void (*destructor)(Binary *); + Uint32 refn[ERTS_REF_NUMBERS]; + ErtsAlcType_t alloc_type; + union { + struct { + ERTS_BINARY_STRUCT_ALIGNMENT + char data[1]; + } aligned; + struct { + char data[1]; + } unaligned; + } u; +}; + +#ifdef ARCH_32 +#define ERTS_MAGIC_BIN_BYTES_TO_ALIGN 4 +#else +#define ERTS_MAGIC_BIN_BYTES_TO_ALIGN 0 +#endif + +typedef union { + Binary binary; + ErtsMagicBinary magic_binary; + struct { + ERTS_INTERNAL_BINARY_FIELDS + ErlDrvBinary binary; + } driver; +} ErtsBinary; + +/* + * 'Binary' alignment: + * Address of orig_bytes[0] of a Binary should always be 8-byte aligned. + * It is assumed that the flags, refc, and orig_size fields are 4 bytes on + * 32-bits architectures and 8 bytes on 64-bits architectures. + */ + +#define ERTS_MAGIC_BIN_REFN(BP) \ + ((ErtsBinary *) (BP))->magic_binary.refn +#define ERTS_MAGIC_BIN_ATYPE(BP) \ + ((ErtsBinary *) (BP))->magic_binary.alloc_type +#define ERTS_MAGIC_DATA_OFFSET \ + (offsetof(ErtsMagicBinary,u.aligned.data) - offsetof(Binary,orig_bytes)) +#define ERTS_MAGIC_BIN_DESTRUCTOR(BP) \ + ((ErtsBinary *) (BP))->magic_binary.destructor +#define ERTS_MAGIC_BIN_DATA(BP) \ + ((void *) ((ErtsBinary *) (BP))->magic_binary.u.aligned.data) +#define ERTS_MAGIC_BIN_DATA_SIZE(BP) \ + ((BP)->orig_size - ERTS_MAGIC_DATA_OFFSET) +#define ERTS_MAGIC_DATA_OFFSET \ + (offsetof(ErtsMagicBinary,u.aligned.data) - offsetof(Binary,orig_bytes)) +#define ERTS_MAGIC_BIN_ORIG_SIZE(Sz) \ + (ERTS_MAGIC_DATA_OFFSET + (Sz)) +#define ERTS_MAGIC_BIN_SIZE(Sz) \ + (offsetof(ErtsMagicBinary,u.aligned.data) + (Sz)) +#define ERTS_MAGIC_BIN_FROM_DATA(DATA) \ + ((ErtsBinary*)((char*)(DATA) - offsetof(ErtsMagicBinary,u.aligned.data))) + +/* On 32-bit arch these macro variants will save memory + by not forcing 8-byte alignment for the magic payload. +*/ +#define ERTS_MAGIC_BIN_UNALIGNED_DATA(BP) \ + ((void *) ((ErtsBinary *) (BP))->magic_binary.u.unaligned.data) +#define ERTS_MAGIC_UNALIGNED_DATA_OFFSET \ + (offsetof(ErtsMagicBinary,u.unaligned.data) - offsetof(Binary,orig_bytes)) +#define ERTS_MAGIC_BIN_UNALIGNED_DATA_SIZE(BP) \ + ((BP)->orig_size - ERTS_MAGIC_UNALIGNED_DATA_OFFSET) +#define ERTS_MAGIC_BIN_UNALIGNED_ORIG_SIZE(Sz) \ + (ERTS_MAGIC_UNALIGNED_DATA_OFFSET + (Sz)) +#define ERTS_MAGIC_BIN_UNALIGNED_SIZE(Sz) \ + (offsetof(ErtsMagicBinary,u.unaligned.data) + (Sz)) +#define ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(DATA) \ + ((ErtsBinary*)((char*)(DATA) - offsetof(ErtsMagicBinary,u.unaligned.data))) + + +#define Binary2ErlDrvBinary(B) (&((ErtsBinary *) (B))->driver.binary) +#define ErlDrvBinary2Binary(D) ((Binary *) \ + (((char *) (D)) \ + - offsetof(ErtsBinary, driver.binary))) + +/* A "magic" binary flag */ +#define BIN_FLAG_MAGIC 1 +#define BIN_FLAG_USR1 2 /* Reserved for use by different modules too mark */ +#define BIN_FLAG_USR2 4 /* certain binaries as special (used by ets) */ +#define BIN_FLAG_DRV 8 + +#endif /* ERL_BINARY_H__TYPES__ */ + +#if !defined(ERL_BINARY_H__) && !defined(ERTS_BINARY_TYPES_ONLY__) +#define ERL_BINARY_H__ #include "erl_threads.h" #include "bif.h" +#include "erl_bif_unique.h" /* * Maximum number of bytes to place in a heap binary. @@ -190,6 +325,7 @@ ERTS_GLB_INLINE Binary *erts_bin_realloc(Binary *bp, Uint size); ERTS_GLB_INLINE void erts_bin_free(Binary *bp); ERTS_GLB_INLINE Binary *erts_create_magic_binary_x(Uint size, void (*destructor)(Binary *), + ErtsAlcType_t alloc_type, int unaligned); ERTS_GLB_INLINE Binary *erts_create_magic_binary(Uint size, void (*destructor)(Binary *)); @@ -320,9 +456,12 @@ erts_bin_realloc(Binary *bp, Uint size) ERTS_GLB_INLINE void erts_bin_free(Binary *bp) { - if (bp->flags & BIN_FLAG_MAGIC) + if (bp->flags & BIN_FLAG_MAGIC) { ERTS_MAGIC_BIN_DESTRUCTOR(bp)(bp); - if (bp->flags & BIN_FLAG_DRV) + erts_magic_ref_remove_bin(ERTS_MAGIC_BIN_REFN(bp)); + erts_free(ERTS_MAGIC_BIN_ATYPE(bp), (void *) bp); + } + else if (bp->flags & BIN_FLAG_DRV) erts_free(ERTS_ALC_T_DRV_BINARY, (void *) bp); else erts_free(ERTS_ALC_T_BINARY, (void *) bp); @@ -330,29 +469,33 @@ erts_bin_free(Binary *bp) ERTS_GLB_INLINE Binary * erts_create_magic_binary_x(Uint size, void (*destructor)(Binary *), + ErtsAlcType_t alloc_type, int unaligned) { Uint bsize = unaligned ? ERTS_MAGIC_BIN_UNALIGNED_SIZE(size) : ERTS_MAGIC_BIN_SIZE(size); - Binary* bptr = erts_alloc_fnf(ERTS_ALC_T_BINARY, bsize); + Binary* bptr = erts_alloc_fnf(alloc_type, bsize); ASSERT(bsize > size); if (!bptr) - erts_alloc_n_enomem(ERTS_ALC_T2N(ERTS_ALC_T_BINARY), bsize); + erts_alloc_n_enomem(ERTS_ALC_T2N(alloc_type), bsize); ERTS_CHK_BIN_ALIGNMENT(bptr); bptr->flags = BIN_FLAG_MAGIC; bptr->orig_size = unaligned ? ERTS_MAGIC_BIN_UNALIGNED_ORIG_SIZE(size) : ERTS_MAGIC_BIN_ORIG_SIZE(size); erts_refc_init(&bptr->refc, 0); ERTS_MAGIC_BIN_DESTRUCTOR(bptr) = destructor; + ERTS_MAGIC_BIN_ATYPE(bptr) = alloc_type; + erts_make_magic_ref_in_array(ERTS_MAGIC_BIN_REFN(bptr)); return bptr; } ERTS_GLB_INLINE Binary * erts_create_magic_binary(Uint size, void (*destructor)(Binary *)) { - return erts_create_magic_binary_x(size, destructor, 0); + return erts_create_magic_binary_x(size, destructor, + ERTS_ALC_T_BINARY, 0); } #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ -#endif /* !__ERL_BINARY_H */ +#endif /* !ERL_BINARY_H__ */ diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index fd092015bd..9f077dd407 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -266,7 +266,7 @@ static void schedule_free_dbtable(DbTable* tb) * Caller is *not* allowed to access the specialized part * (hash or tree) of *tb after this function has returned. */ - ASSERT(erts_refc_read(&tb->common.ref, 0) == 0); + ASSERT(erts_smp_refc_read(&tb->common.ref, 0) == 0); erts_schedule_thr_prgr_later_cleanup_op(free_dbtable, (void *) tb, &tb->release.data, @@ -600,11 +600,11 @@ done: */ static ERTS_INLINE void local_fix_table(DbTable* tb) { - erts_refc_inc(&tb->common.ref, 1); + erts_smp_refc_inc(&tb->common.ref, 1); } static ERTS_INLINE void local_unfix_table(DbTable* tb) { - if (erts_refc_dectest(&tb->common.ref, 0) == 0) { + if (erts_smp_refc_dectest(&tb->common.ref, 0) == 0) { ASSERT(IS_HASH_TABLE(tb->common.status)); db_unfix_table_hash(&(tb->hash)); } @@ -1487,7 +1487,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) tb->common.type = status & ERTS_ETS_TABLE_TYPES; /* Note, 'type' is *read only* from now on... */ #endif - erts_refc_init(&tb->common.ref, 0); + erts_smp_refc_init(&tb->common.ref, 0); db_init_lock(tb, status & (DB_FINE_LOCKED|DB_FREQ_READ), "db_tab", "db_tab_fix"); tb->common.keypos = keypos; @@ -2779,7 +2779,7 @@ BIF_RETTYPE ets_info_2(BIF_ALIST_2) BIF_RETTYPE ets_is_compiled_ms_1(BIF_ALIST_1) { - if (erts_db_is_compiled_ms(BIF_ARG_1)) { + if (erts_db_get_match_prog_binary(BIF_ARG_1)) { BIF_RET(am_true); } else { BIF_RET(am_false); @@ -2794,9 +2794,9 @@ BIF_RETTYPE ets_match_spec_compile_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } - hp = HAlloc(BIF_P, PROC_BIN_SIZE); + hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE); - BIF_RET(erts_mk_magic_binary_term(&hp, &MSO(BIF_P), mp)); + BIF_RET(erts_db_make_match_prog_ref(BIF_P, mp, &hp)); } BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3) @@ -2805,24 +2805,18 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3) int i = 0; Eterm *hp; Eterm lst; - ProcBin *bp; Binary *mp; Eterm res; Uint32 dummy; - if (!(is_list(BIF_ARG_1) || BIF_ARG_1 == NIL) || !is_binary(BIF_ARG_2)) { + if (!(is_list(BIF_ARG_1) || BIF_ARG_1 == NIL)) { error: BIF_ERROR(BIF_P, BADARG); } - bp = (ProcBin*) binary_val(BIF_ARG_2); - if (thing_subtag(bp->thing_word) != REFC_BINARY_SUBTAG) { + mp = erts_db_get_match_prog_binary(BIF_ARG_2); + if (!mp) goto error; - } - mp = bp->val; - if (!IsMatchProgBinary(mp)) { - goto error; - } if (BIF_ARG_1 == NIL) { BIF_RET(BIF_ARG_3); @@ -2990,7 +2984,7 @@ void init_db(ErtsDbSpinCount db_spin_count) meta_pid_to_tab->common.meth = &db_hash; meta_pid_to_tab->common.compress = 0; - erts_refc_init(&meta_pid_to_tab->common.ref, 0); + erts_smp_refc_init(&meta_pid_to_tab->common.ref, 0); /* Neither rwlock or fixlock used db_init_lock(meta_pid_to_tab, "meta_pid_to_tab", "meta_pid_to_tab_FIX");*/ @@ -3021,7 +3015,7 @@ void init_db(ErtsDbSpinCount db_spin_count) meta_pid_to_fixed_tab->common.meth = &db_hash; meta_pid_to_fixed_tab->common.compress = 0; - erts_refc_init(&meta_pid_to_fixed_tab->common.ref, 0); + erts_smp_refc_init(&meta_pid_to_fixed_tab->common.ref, 0); /* Neither rwlock or fixlock used db_init_lock(meta_pid_to_fixed_tab, "meta_pid_to_fixed_tab", "meta_pid_to_fixed_tab_FIX");*/ @@ -3382,7 +3376,7 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) if ((*pp)->pid == pid) { DbFixation* fix = *pp; erts_aint_t diff = -((erts_aint_t) fix->counter); - erts_refc_add(&tb->common.ref,diff,0); + erts_smp_refc_add(&tb->common.ref,diff,0); *pp = fix->next; erts_db_free(ERTS_ALC_T_DB_FIXATION, tb, fix, sizeof(DbFixation)); @@ -3458,7 +3452,7 @@ static void fix_table_locked(Process* p, DbTable* tb) #ifdef ERTS_SMP erts_smp_mtx_lock(&tb->common.fixlock); #endif - erts_refc_inc(&tb->common.ref,1); + erts_smp_refc_inc(&tb->common.ref,1); fix = tb->common.fixations; if (fix == NULL) { tb->common.time.monotonic @@ -3514,7 +3508,7 @@ static void unfix_table_locked(Process* p, DbTable* tb, for (pp = &tb->common.fixations; *pp != NULL; pp = &(*pp)->next) { if ((*pp)->pid == p->common.id) { DbFixation* fix = *pp; - erts_refc_dec(&tb->common.ref,0); + erts_smp_refc_dec(&tb->common.ref,0); --(fix->counter); ASSERT(fix->counter >= 0); if (fix->counter > 0) { @@ -3563,7 +3557,7 @@ static void free_fixations_locked(DbTable *tb) fix = tb->common.fixations; while (fix != NULL) { erts_aint_t diff = -((erts_aint_t) fix->counter); - erts_refc_add(&tb->common.ref,diff,0); + erts_smp_refc_add(&tb->common.ref,diff,0); next_fix = fix->next; db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC); db_erase_bag_exact2(meta_pid_to_fixed_tab, diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index b2a231467b..bb29d56aa7 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -1287,15 +1287,13 @@ static int db_select_continue_hash(Process *p, if (arityval(*tptr) != 6) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - if (!is_small(tptr[2]) || !is_small(tptr[3]) || !is_binary(tptr[4]) || + if (!is_small(tptr[2]) || !is_small(tptr[3]) || !(is_list(tptr[5]) || tptr[5] == NIL) || !is_small(tptr[6])) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); if ((chunk_size = signed_val(tptr[3])) < 0) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - if (!(thing_subtag(*binary_val(tptr[4])) == REFC_BINARY_SUBTAG)) - RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - mp = ((ProcBin *) binary_val(tptr[4]))->val; - if (!IsMatchProgBinary(mp)) + mp = erts_db_get_match_prog_binary(tptr[4]); + if (!mp) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); all_objects = mp->flags & BIN_FLAG_ALL_OBJECTS; match_list = tptr[5]; @@ -1554,8 +1552,8 @@ done: been in 'user space' */ } if (rest != NIL || slot_ix >= 0) { /* Need more calls */ - hp = HAlloc(p,3+7+PROC_BIN_SIZE); - mpb =db_make_mp_binary(p,(mpi.mp),&hp); + hp = HAlloc(p,3+7+ERTS_MAGIC_REF_THING_SIZE); + mpb = erts_db_make_match_prog_ref(p,(mpi.mp),&hp); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; continuation = TUPLE6(hp, tb->common.id,make_small(slot_ix), @@ -1580,8 +1578,8 @@ trap: BUMP_ALL_REDS(p); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; - hp = HAlloc(p,7+PROC_BIN_SIZE); - mpb =db_make_mp_binary(p,(mpi.mp),&hp); + hp = HAlloc(p,7+ERTS_MAGIC_REF_THING_SIZE); + mpb = erts_db_make_match_prog_ref(p,(mpi.mp),&hp); continuation = TUPLE6(hp, tb->common.id, make_small(slot_ix), make_small(chunk_size), mpb, match_list, @@ -1693,15 +1691,15 @@ done: trap: BUMP_ALL_REDS(p); if (IS_USMALL(0, got)) { - hp = HAlloc(p, PROC_BIN_SIZE + 5); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE + 5); egot = make_small(got); } else { - hp = HAlloc(p, BIG_UINT_HEAP_SIZE + PROC_BIN_SIZE + 5); + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + ERTS_MAGIC_REF_THING_SIZE + 5); egot = uint_to_big(got, hp); hp += BIG_UINT_HEAP_SIZE; } - mpb = db_make_mp_binary(p,mpi.mp,&hp); + mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix), mpb, egot); @@ -1838,15 +1836,15 @@ done: trap: BUMP_ALL_REDS(p); if (IS_USMALL(0, got)) { - hp = HAlloc(p, PROC_BIN_SIZE + 5); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE + 5); egot = make_small(got); } else { - hp = HAlloc(p, BIG_UINT_HEAP_SIZE + PROC_BIN_SIZE + 5); + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + ERTS_MAGIC_REF_THING_SIZE + 5); egot = uint_to_big(got, hp); hp += BIG_UINT_HEAP_SIZE; } - mpb = db_make_mp_binary(p,mpi.mp,&hp); + mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix), mpb, egot); @@ -1887,7 +1885,7 @@ static int db_select_delete_continue_hash(Process *p, tptr = tuple_val(continuation); slot_ix = unsigned_val(tptr[2]); - mp = ((ProcBin *) binary_val(tptr[3]))->val; + mp = erts_db_get_match_prog_binary_unchecked(tptr[3]); if (is_big(tptr[4])) { got = big_to_uint32(tptr[4]); } else { @@ -1999,7 +1997,7 @@ static int db_select_count_continue_hash(Process *p, tptr = tuple_val(continuation); slot_ix = unsigned_val(tptr[2]); - mp = ((ProcBin *) binary_val(tptr[3]))->val; + mp = erts_db_get_match_prog_binary_unchecked(tptr[3]); if (is_big(tptr[4])) { got = big_to_uint32(tptr[4]); } else { diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index dd9403e132..c4ecd2ba37 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -935,17 +935,15 @@ static int db_select_continue_tree(Process *p, if (arityval(*tptr) != 8) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - if (!is_small(tptr[4]) || !is_binary(tptr[5]) || + if (!is_small(tptr[4]) || !(is_list(tptr[6]) || tptr[6] == NIL) || !is_small(tptr[7]) || !is_small(tptr[8])) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); lastkey = tptr[2]; end_condition = tptr[3]; - if (!(thing_subtag(*binary_val(tptr[5])) == REFC_BINARY_SUBTAG)) - RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - mp = ((ProcBin *) binary_val(tptr[5]))->val; - if (!IsMatchProgBinary(mp)) + mp = erts_db_get_match_prog_binary(tptr[5]); + if (!mp) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); chunk_size = signed_val(tptr[4]); @@ -1145,11 +1143,11 @@ static int db_select_tree(Process *p, DbTable *tbl, key = GETKEY(tb, sc.lastobj); sz = size_object(key); - hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); + hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE); key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; - mpb=db_make_mp_binary(p,mpi.mp,&hp); + mpb= erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE8 (hp, @@ -1208,10 +1206,8 @@ static int db_select_count_continue_tree(Process *p, lastkey = tptr[2]; end_condition = tptr[3]; - if (!(thing_subtag(*binary_val(tptr[4])) == REFC_BINARY_SUBTAG)) - RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - mp = ((ProcBin *) binary_val(tptr[4]))->val; - if (!IsMatchProgBinary(mp)) + mp = erts_db_get_match_prog_binary(tptr[4]); + if (!mp) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); sc.p = p; @@ -1338,18 +1334,18 @@ static int db_select_count_tree(Process *p, DbTable *tbl, key = GETKEY(tb, sc.lastobj); sz = size_object(key); if (IS_USMALL(0, sc.got)) { - hp = HAlloc(p, sz + PROC_BIN_SIZE + 6); + hp = HAlloc(p, sz + ERTS_MAGIC_REF_THING_SIZE + 6); egot = make_small(sc.got); } else { - hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + PROC_BIN_SIZE + 6); + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + ERTS_MAGIC_REF_THING_SIZE + 6); egot = uint_to_big(sc.got, hp); hp += BIG_UINT_HEAP_SIZE; } key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; - mpb = db_make_mp_binary(p,mpi.mp,&hp); + mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE5 (hp, @@ -1470,11 +1466,11 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, key = GETKEY(tb, sc.lastobj); sz = size_object(key); - hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); + hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE); key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; - mpb = db_make_mp_binary(p,mpi.mp,&hp); + mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE8 (hp, @@ -1495,12 +1491,12 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, key = GETKEY(tb, sc.lastobj); sz = size_object(key); - hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); + hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE); key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; - mpb = db_make_mp_binary(p,mpi.mp,&hp); + mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE8 (hp, tb->common.id, @@ -1558,7 +1554,7 @@ static int db_select_delete_continue_tree(Process *p, sc.erase_lastterm = 0; /* Before first RET_TO_BIF */ sc.lastterm = NULL; - mp = ((ProcBin *) binary_val(tptr[4]))->val; + mp = erts_db_get_match_prog_binary_unchecked(tptr[4]); sc.p = p; sc.tb = tb; if (is_big(tptr[5])) { @@ -1682,16 +1678,16 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, key = GETKEY(tb, (sc.lastterm)->dbterm.tpl); sz = size_object(key); if (IS_USMALL(0, sc.accum)) { - hp = HAlloc(p, sz + PROC_BIN_SIZE + 6); + hp = HAlloc(p, sz + ERTS_MAGIC_REF_THING_SIZE + 6); eaccsum = make_small(sc.accum); } else { - hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + PROC_BIN_SIZE + 6); + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + ERTS_MAGIC_REF_THING_SIZE + 6); eaccsum = uint_to_big(sc.accum, hp); hp += BIG_UINT_HEAP_SIZE; } key = copy_struct(key, sz, &hp, &MSO(p)); - mpb = db_make_mp_binary(p,mpi.mp,&hp); + mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE5 (hp, diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 4e987d5bee..070e29578f 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -2545,14 +2545,6 @@ success: } -/* - * Convert a match program to a "magic" binary to return up to erlang - */ -Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp) -{ - return erts_mk_magic_binary_term(hpp, &MSO(p), mp); -} - DMCErrInfo *db_new_dmc_err_info(void) { DMCErrInfo *ret = erts_alloc(ERTS_ALC_T_DB_DMC_ERR_INFO, @@ -3107,7 +3099,7 @@ void db_cleanup_offheap_comp(DbTerm* obj) break; case FUN_SUBTAG: ASSERT(u.pb != &tmp); - if (erts_refc_dectest(&u.fun->fe->refc, 0) == 0) { + if (erts_smp_refc_dectest(&u.fun->fe->refc, 0) == 0) { erts_erase_fun_entry(u.fun->fe); } break; @@ -3266,13 +3258,6 @@ int db_has_variable(Eterm node) { return 0; } -int erts_db_is_compiled_ms(Eterm term) -{ - return (is_binary(term) - && (thing_subtag(*binary_val(term)) == REFC_BINARY_SUBTAG) - && IsMatchProgBinary((((ProcBin *) binary_val(term))->val))); -} - /* ** Local (static) utilities. */ @@ -5289,24 +5274,35 @@ void db_match_dis(Binary *bp) case matchEqRef: ++t; { - RefThing *rt = (RefThing *) t; + Uint32 *num; int ri; - n = thing_arityval(rt->header); - erts_printf("EqRef\t(%d) {", (int) n); + + if (is_ordinary_ref_thing(t)) { + ErtsORefThing *rt = (ErtsORefThing *) t; + num = rt->num; + t += TermWords(ERTS_REF_THING_SIZE); + } + else { + ErtsMRefThing *mrt = (ErtsMRefThing *) t; + ASSERT(is_magic_ref_thing(t)); + num = mrt->mb->refn; + t += TermWords(ERTS_MAGIC_REF_THING_SIZE); + } + + erts_printf("EqRef\t(%d) {", (int) ERTS_REF_NUMBERS); first = 1; - for (ri = 0; ri < n; ++ri) { + for (ri = 0; ri < ERTS_REF_NUMBERS; ++ri) { if (first) first = 0; else erts_printf(", "); #if defined(ARCH_64) - erts_printf("0x%016bex", rt->data.ui[ri]); + erts_printf("0x%016bex", num[ri]); #else - erts_printf("0x%08bex", rt->data.ui[ri]); + erts_printf("0x%08bex", num[ri]); #endif } } - t += TermWords(REF_THING_SIZE); erts_printf("}\n"); break; case matchEqBig: diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 49e5f6b4cf..b2a3bb6c20 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -23,6 +23,7 @@ #include "global.h" #include "erl_message.h" +#include "erl_bif_unique.h" /*#define HARDDEBUG 1*/ @@ -211,7 +212,7 @@ typedef struct db_fixation { */ typedef struct db_table_common { - erts_refc_t ref; /* fixation counter */ + erts_smp_refc_t ref; /* fixation counter */ #ifdef ERTS_SMP erts_smp_rwmtx_t rwlock; /* rw lock on table */ erts_smp_mtx_t fixlock; /* Protects fixations,megasec,sec,microsec */ @@ -260,7 +261,7 @@ typedef struct db_table_common { (DB_BAG | DB_SET | DB_DUPLICATE_BAG))) #define IS_TREE_TABLE(Status) (!!((Status) & \ DB_ORDERED_SET)) -#define NFIXED(T) (erts_refc_read(&(T)->common.ref,0)) +#define NFIXED(T) (erts_smp_refc_read(&(T)->common.ref,0)) #define IS_FIXED(T) (NFIXED(T) != 0) /* @@ -456,10 +457,44 @@ Eterm db_format_dmc_err_info(Process *p, DMCErrInfo *ei); void db_free_dmc_err_info(DMCErrInfo *ei); /* Completely free's an error info structure, including all recorded errors */ -Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp); -/* Convert a match program to a erlang "magic" binary to be returned to userspace, - increments the reference counter. */ -int erts_db_is_compiled_ms(Eterm term); + +ERTS_GLB_INLINE Eterm erts_db_make_match_prog_ref(Process *p, Binary *mp, Eterm **hpp); +ERTS_GLB_INLINE Binary *erts_db_get_match_prog_binary(Eterm term); +ERTS_GLB_INLINE Binary *erts_db_get_match_prog_binary_unchecked(Eterm term); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +/* + * Convert a match program to a "magic" ref to return up to erlang + */ +ERTS_GLB_INLINE Eterm erts_db_make_match_prog_ref(Process *p, Binary *mp, Eterm **hpp) +{ + return erts_mk_magic_ref(hpp, &MSO(p), mp); +} + +ERTS_GLB_INLINE Binary * +erts_db_get_match_prog_binary_unchecked(Eterm term) +{ + Binary *bp = erts_magic_ref2bin(term); + ASSERT(bp->flags & BIN_FLAG_MAGIC); + ASSERT((ERTS_MAGIC_BIN_DESTRUCTOR(bp) == erts_db_match_prog_destructor)); + return bp; +} + +ERTS_GLB_INLINE Binary * +erts_db_get_match_prog_binary(Eterm term) +{ + Binary *bp; + if (!is_internal_magic_ref(term)) + return NULL; + bp = erts_magic_ref2bin(term); + ASSERT(bp->flags & BIN_FLAG_MAGIC); + if (ERTS_MAGIC_BIN_DESTRUCTOR(bp) != erts_db_match_prog_destructor) + return NULL; + return bp; +} + +#endif /* ** Convenience when compiling into Binary structures diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c index 3526bb684d..517dad9cbb 100644 --- a/erts/emulator/beam/erl_debug.c +++ b/erts/emulator/beam/erl_debug.c @@ -130,7 +130,7 @@ pdisplay1(fmtfn_t to, void *to_arg, Process* p, Eterm obj) Uint32 *ref_num; erts_print(to, to_arg, "#Ref<%lu", ref_channel_no(obj)); ref_num = ref_numbers(obj); - for (i = ref_no_of_numbers(obj)-1; i >= 0; i--) + for (i = ref_no_numbers(obj)-1; i >= 0; i--) erts_print(to, to_arg, ",%lu", ref_num[i]); erts_print(to, to_arg, ">"); break; diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c index 41097203d4..cedc0517e1 100644 --- a/erts/emulator/beam/erl_fun.c +++ b/erts/emulator/beam/erl_fun.c @@ -113,9 +113,9 @@ erts_put_fun_entry(Eterm mod, int uniq, int index) fe = (ErlFunEntry *) hash_put(&erts_fun_table, (void*) &template); sys_memset(fe->uniq, 0, sizeof(fe->uniq)); fe->index = 0; - refc = erts_refc_inctest(&fe->refc, 0); + refc = erts_smp_refc_inctest(&fe->refc, 0); if (refc < 2) /* New or pending delete */ - erts_refc_inc(&fe->refc, 1); + erts_smp_refc_inc(&fe->refc, 1); erts_fun_write_unlock(); return fe; } @@ -137,9 +137,9 @@ erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index, sys_memcpy(fe->uniq, uniq, sizeof(fe->uniq)); fe->index = index; fe->arity = arity; - refc = erts_refc_inctest(&fe->refc, 0); + refc = erts_smp_refc_inctest(&fe->refc, 0); if (refc < 2) /* New or pending delete */ - erts_refc_inc(&fe->refc, 1); + erts_smp_refc_inc(&fe->refc, 1); erts_fun_write_unlock(); return fe; } @@ -164,9 +164,9 @@ erts_get_fun_entry(Eterm mod, int uniq, int index) erts_fun_read_lock(); ret = (ErlFunEntry *) hash_get(&erts_fun_table, (void*) &template); if (ret) { - erts_aint_t refc = erts_refc_inctest(&ret->refc, 1); + erts_aint_t refc = erts_smp_refc_inctest(&ret->refc, 1); if (refc < 2) /* Pending delete */ - erts_refc_inc(&ret->refc, 1); + erts_smp_refc_inc(&ret->refc, 1); } erts_fun_read_unlock(); return ret; @@ -187,7 +187,7 @@ erts_erase_fun_entry(ErlFunEntry* fe) * We have to check refc again since someone might have looked up * the fun entry and incremented refc after last check. */ - if (erts_refc_dectest(&fe->refc, -1) <= 0) + if (erts_smp_refc_dectest(&fe->refc, -1) <= 0) #endif { if (fe->address != unloaded_fun) @@ -274,7 +274,7 @@ erts_fun_purge_complete(ErlFunEntry **funs, Uint no) #ifdef HIPE fe->pend_purge_native_address = NULL; #endif - if (erts_refc_dectest(&fe->refc, 0) == 0) + if (erts_smp_refc_dectest(&fe->refc, 0) == 0) erts_erase_fun_entry(fe); } ERTS_SMP_WRITE_MEMORY_BARRIER; @@ -306,7 +306,7 @@ erts_dump_fun_entries(fmtfn_t to, void *to_arg) #ifdef HIPE erts_print(to, to_arg, "Native_address: %p\n", fe->native_address); #endif - erts_print(to, to_arg, "Refc: %ld\n", erts_refc_read(&fe->refc, 1)); + erts_print(to, to_arg, "Refc: %ld\n", erts_smp_refc_read(&fe->refc, 1)); b = b->next; } } @@ -337,7 +337,7 @@ fun_alloc(ErlFunEntry* template) obj->old_uniq = template->old_uniq; obj->old_index = template->old_index; obj->module = template->module; - erts_refc_init(&obj->refc, -1); + erts_smp_refc_init(&obj->refc, -1); obj->address = unloaded_fun; obj->pend_purge_address = NULL; #ifdef HIPE diff --git a/erts/emulator/beam/erl_fun.h b/erts/emulator/beam/erl_fun.h index 83899f24a6..e3073eb874 100644 --- a/erts/emulator/beam/erl_fun.h +++ b/erts/emulator/beam/erl_fun.h @@ -42,7 +42,7 @@ typedef struct erl_fun_entry { Uint arity; /* The arity of the fun. */ Eterm module; /* Tagged atom for module. */ - erts_refc_t refc; /* Reference count: One for code + one for each + erts_smp_refc_t refc; /* Reference count: One for code + one for each fun object in each process. */ BeamInstr *pend_purge_address; /* address stored during a pending purge */ #ifdef HIPE diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 3a3ad820b5..cb3a189e8f 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -178,7 +178,7 @@ Uint erts_test_long_gc_sleep; /* Only used for testing... */ typedef struct { Process *proc; Eterm ref; - Eterm ref_heap[REF_THING_SIZE]; + Eterm ref_heap[ERTS_REF_THING_SIZE]; Uint req_sched; erts_smp_atomic32_t refc; } ErtsGCInfoReq; @@ -2354,6 +2354,9 @@ copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap, switch (val & _HEADER_SUBTAG_MASK) { case ARITYVAL_SUBTAG: break; + case REF_SUBTAG: + if (is_ordinary_ref_thing(fhp - 1)) + goto the_default; case REFC_BINARY_SUBTAG: case FUN_SUBTAG: case EXTERNAL_PID_SUBTAG: @@ -2363,6 +2366,7 @@ copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap, cpy_sz = thing_arityval(val); goto cpy_words; default: + the_default: cpy_sz = header_arity(val); cpy_words: @@ -2796,6 +2800,16 @@ link_live_proc_bin(struct shrink_cand_data *shrink, *prevppp = &pbp->next; } +#ifdef ERTS_MAGIC_REF_THING_HEADER +/* + * ERTS_MAGIC_REF_THING_HEADER only defined when there + * is a size difference between magic and ordinary references... + */ +# define ERTS_USED_MAGIC_REF_THING_HEADER__ ERTS_MAGIC_REF_THING_HEADER +#else +# define ERTS_USED_MAGIC_REF_THING_HEADER__ ERTS_REF_THING_HEADER +#endif + static void sweep_off_heap(Process *p, int fullsweep) @@ -2828,7 +2842,8 @@ sweep_off_heap(Process *p, int fullsweep) ASSERT(!ErtsInArea(ptr, oheap, oheap_sz)); *prev = ptr = (struct erl_off_heap_header*) boxed_val(ptr->thing_word); ASSERT(!IS_MOVED_BOXED(ptr->thing_word)); - if (ptr->thing_word == HEADER_PROC_BIN) { + switch (ptr->thing_word) { + case HEADER_PROC_BIN: { int to_new_heap = !ErtsInArea(ptr, oheap, oheap_sz); ASSERT(to_new_heap == !seen_mature || (!to_new_heap && (seen_mature=1))); if (to_new_heap) { @@ -2837,13 +2852,28 @@ sweep_off_heap(Process *p, int fullsweep) BIN_OLD_VHEAP(p) += ptr->size / sizeof(Eterm); /* for binary gc (words)*/ } link_live_proc_bin(&shrink, &prev, &ptr, to_new_heap); - } - else { + break; + } + case ERTS_USED_MAGIC_REF_THING_HEADER__: { + Uint size; + int to_new_heap = !ErtsInArea(ptr, oheap, oheap_sz); + ASSERT(is_magic_ref_thing(ptr)); + ASSERT(to_new_heap == !seen_mature || (!to_new_heap && (seen_mature=1))); + size = (Uint) ((ErtsMRefThing *) ptr)->mb->orig_size; + if (to_new_heap) + bin_vheap += size / sizeof(Eterm); + else + BIN_OLD_VHEAP(p) += size / sizeof(Eterm); /* for binary gc (words)*/ + /* fall through... */ + } + default: prev = &ptr->next; ptr = ptr->next; } } - else if (!ErtsInArea(ptr, oheap, oheap_sz)) { + else if (ErtsInArea(ptr, oheap, oheap_sz)) + break; /* and let old-heap loop continue */ + else { /* garbage */ switch (thing_subtag(ptr->thing_word)) { case REFC_BINARY_SUBTAG: @@ -2857,18 +2887,26 @@ sweep_off_heap(Process *p, int fullsweep) case FUN_SUBTAG: { ErlFunEntry* fe = ((ErlFunThing*)ptr)->fe; - if (erts_refc_dectest(&fe->refc, 0) == 0) { + if (erts_smp_refc_dectest(&fe->refc, 0) == 0) { erts_erase_fun_entry(fe); } break; } + case REF_SUBTAG: + { + ErtsMagicBinary *bptr; + ASSERT(is_magic_ref_thing(ptr)); + bptr = ((ErtsMRefThing *) ptr)->mb; + if (erts_refc_dectest(&bptr->refc, 0) == 0) + erts_bin_free((Binary *) bptr); + break; + } default: ASSERT(is_external_header(ptr->thing_word)); erts_deref_node_entry(((ExternalThing*)ptr)->node); } *prev = ptr = ptr->next; } - else break; /* and let old-heap loop continue */ } /* The rest of the list resides on old-heap, and we just did a @@ -2877,15 +2915,24 @@ sweep_off_heap(Process *p, int fullsweep) while (ptr) { ASSERT(ErtsInArea(ptr, oheap, oheap_sz)); ASSERT(!IS_MOVED_BOXED(ptr->thing_word)); - if (ptr->thing_word == HEADER_PROC_BIN) { + switch (ptr->thing_word) { + case HEADER_PROC_BIN: BIN_OLD_VHEAP(p) += ptr->size / sizeof(Eterm); /* for binary gc (words)*/ link_live_proc_bin(&shrink, &prev, &ptr, 0); - } - else { - ASSERT(is_fun_header(ptr->thing_word) || - is_external_header(ptr->thing_word)); - prev = &ptr->next; - ptr = ptr->next; + break; + case ERTS_USED_MAGIC_REF_THING_HEADER__: + ASSERT(is_magic_ref_thing(ptr)); + BIN_OLD_VHEAP(p) += + (((Uint) ((ErtsMRefThing *) ptr)->mb->orig_size) + / sizeof(Eterm)); /* for binary gc (words)*/ + /* fall through... */ + default: + ASSERT(is_fun_header(ptr->thing_word) || + is_external_header(ptr->thing_word) + || is_magic_ref_thing(ptr)); + prev = &ptr->next; + ptr = ptr->next; + break; } } @@ -2978,6 +3025,9 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size) } tari = thing_arityval(val); switch (thing_subtag(val)) { + case REF_SUBTAG: + if (is_ordinary_ref_thing(hp)) + break; case REFC_BINARY_SUBTAG: case FUN_SUBTAG: case EXTERNAL_PID_SUBTAG: @@ -3175,7 +3225,7 @@ reply_gc_info(void *vgcirp) if (hpp) ref_copy = STORE_NC(hpp, ohp, gcirp->ref); else - *szp += REF_THING_SIZE; + *szp += ERTS_REF_THING_SIZE; msg = erts_bld_tuple(hpp, szp, 3, make_small(esdp->no), @@ -3519,12 +3569,16 @@ erts_check_off_heap2(Process *p, Eterm *htop) refc = erts_refc_read(&u.pb->val->refc, 1); break; case FUN_SUBTAG: - refc = erts_refc_read(&u.fun->fe->refc, 1); + refc = erts_smp_refc_read(&u.fun->fe->refc, 1); break; case EXTERNAL_PID_SUBTAG: case EXTERNAL_PORT_SUBTAG: case EXTERNAL_REF_SUBTAG: - refc = erts_refc_read(&u.ext->node->refc, 1); + refc = erts_smp_refc_read(&u.ext->node->refc, 1); + break; + case REF_SUBTAG: + ASSERT(is_magic_ref_thing(u.hdr)); + refc = erts_refc_read(&u.mref->mb->refc, 1); break; default: ASSERT(!"erts_check_off_heap2: Invalid thing_word"); diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c index 647fa26811..26be8c7edf 100644 --- a/erts/emulator/beam/erl_hl_timer.c +++ b/erts/emulator/beam/erl_hl_timer.c @@ -1771,7 +1771,7 @@ setup_bif_timer(Process *c_p, ErtsMonotonicTime timeout_pos, esdp = erts_proc_sched_data(c_p); - hp = HAlloc(c_p, REF_THING_SIZE); + hp = HAlloc(c_p, ERTS_REF_THING_SIZE); ref = erts_sched_make_ref_in_buffer(esdp, hp); ASSERT(erts_get_ref_numbers_thr_id( @@ -1939,7 +1939,7 @@ access_sched_local_btm(Process *c_p, Eterm pid, Eterm *hp_end; #endif - hsz = REF_THING_SIZE; + hsz = ERTS_REF_THING_SIZE; if (async) { refn = trefn; /* timer ref */ hsz += 4; /* 3-tuple */ @@ -1973,7 +1973,7 @@ access_sched_local_btm(Process *c_p, Eterm pid, refn[1], refn[2]); ref = make_internal_ref(hp); - hp += REF_THING_SIZE; + hp += ERTS_REF_THING_SIZE; msg = (async ? TUPLE3(hp, (cancel @@ -2087,7 +2087,7 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp, ErtsProcLocks proc_locks = ERTS_PROC_LOCK_MAIN; ErlOffHeap *ohp; - hsz = 4 + REF_THING_SIZE; + hsz = 4 + ERTS_REF_THING_SIZE; if (time_left > (Sint64) MAX_SMALL) hsz += ERTS_SINT64_HEAP_SIZE(time_left); @@ -2103,7 +2103,7 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp, trefn[1], trefn[2]); tref = make_internal_ref(hp); - hp += REF_THING_SIZE; + hp += ERTS_REF_THING_SIZE; if (time_left < 0) res = am_false; @@ -2189,7 +2189,7 @@ access_bif_timer(Process *c_p, Eterm tref, int cancel, int async, int info) Eterm *hp, rref; Uint32 *rrefn; - hp = HAlloc(c_p, REF_THING_SIZE); + hp = HAlloc(c_p, ERTS_REF_THING_SIZE); rref = erts_sched_make_ref_in_buffer(esdp, hp); rrefn = internal_ref_numbers(rref); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 88bd002a8c..b2c307e826 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -111,12 +111,19 @@ const int etp_lock_check = 1; #else const int etp_lock_check = 0; #endif -#ifdef WORDS_BIGENDIAN -const int etp_big_endian = 1; +const int etp_endianness = ERTS_ENDIANNESS; +const Eterm etp_ref_header = ERTS_REF_THING_HEADER; +#ifdef ERTS_MAGIC_REF_THING_HEADER +const Eterm etp_magic_ref_header = ERTS_MAGIC_REF_THING_HEADER; #else -const int etp_big_endian = 0; +const Eterm etp_magic_ref_header = ERTS_REF_THING_HEADER; #endif const Eterm etp_the_non_value = THE_NON_VALUE; +#ifdef ERTS_HOLE_MARKER +const Eterm etp_hole_marker = ERTS_HOLE_MARKER; +#else +const Eterm etp_hole_marker = 0; +#endif /* * Note about VxWorks: All variables must be initialized by executable code, @@ -767,6 +774,8 @@ early_init(int *argc, char **argv) /* H_MAX_SIZE = H_DEFAULT_MAX_SIZE; H_MAX_FLAGS = MAX_HEAP_SIZE_KILL|MAX_HEAP_SIZE_LOG; + erts_term_init(); + erts_initialized = 0; erts_use_sender_punish = 1; @@ -1138,6 +1147,8 @@ early_init(int *argc, char **argv) /* no_schedulers_online = schdlrs_onln; erts_no_schedulers = (Uint) no_schedulers; +#else + erts_no_schedulers = 1; #endif #ifdef ERTS_DIRTY_SCHEDULERS erts_no_dirty_cpu_schedulers = no_dirty_cpu_schedulers = dirty_cpu_scheds; diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 08dcbed91c..c98581a45e 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -156,6 +156,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "tracer_mtx", NULL }, { "port_table", NULL }, #endif + { "magic_ref_table", "address" }, { "mtrace_op", NULL }, { "instr_x", NULL }, { "instr", NULL }, diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index 979a0040b0..990be8efb2 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -1197,7 +1197,7 @@ static void hashmap_merge_ctx_destructor(Binary* ctx_bin) } BIF_RETTYPE maps_merge_trap_1(BIF_ALIST_1) { - Binary* ctx_bin = ((ProcBin *) binary_val(BIF_ARG_1))->val; + Binary* ctx_bin = erts_magic_ref2bin(BIF_ARG_1); ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(ctx_bin) == hashmap_merge_ctx_destructor); @@ -1453,9 +1453,9 @@ trap: /* Yield */ hashmap_merge_ctx_destructor); ctx = ERTS_MAGIC_BIN_DATA(ctx_b); sys_memcpy(ctx, &local_ctx, sizeof(HashmapMergeContext)); - hp = HAlloc(p, PROC_BIN_SIZE); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); ASSERT(ctx->trap_bin == THE_NON_VALUE); - ctx->trap_bin = erts_mk_magic_binary_term(&hp, &MSO(p), ctx_b); + ctx->trap_bin = erts_mk_magic_ref(&hp, &MSO(p), ctx_b); erts_set_gc_state(p, 0); } diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 547e9cac64..f181c1e3cb 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -172,10 +172,15 @@ erts_cleanup_offheap(ErlOffHeap *offheap) } break; case FUN_SUBTAG: - if (erts_refc_dectest(&u.fun->fe->refc, 0) == 0) { + if (erts_smp_refc_dectest(&u.fun->fe->refc, 0) == 0) { erts_erase_fun_entry(u.fun->fe); } break; + case REF_SUBTAG: + ASSERT(is_magic_ref_thing(u.hdr)); + if (erts_refc_dectest(&u.mref->mb->refc, 0) == 0) + erts_bin_free((Binary *)u.mref->mb); + break; default: ASSERT(is_external_header(u.hdr->thing_word)); erts_deref_node_entry(u.ext->node); diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c index 910598690d..bdfc7f30d9 100644 --- a/erts/emulator/beam/erl_monitors.c +++ b/erts/emulator/beam/erl_monitors.c @@ -45,6 +45,7 @@ #include "bif.h" #include "big.h" #include "erl_monitors.h" +#include "erl_bif_unique.h" #define STACK_NEED 50 #define MAX_MONITORS 0xFFFFFFFFUL @@ -79,7 +80,24 @@ static ERTS_INLINE int cmp_mon_ref(Eterm ref1, Eterm ref2) b2 = boxed_val(ref2); if (is_ref_thing_header(*b1)) { if (is_ref_thing_header(*b2)) { - return memcmp(b1+1,b2+1,ERTS_REF_WORDS*sizeof(Uint)); + Uint32 *num1, *num2; + if (is_ordinary_ref_thing(b1)) { + ErtsORefThing *rtp = (ErtsORefThing *) b1; + num1 = rtp->num; + } + else { + ErtsMRefThing *mrtp = (ErtsMRefThing *) b1; + num1 = mrtp->mb->refn; + } + if (is_ordinary_ref_thing(b2)) { + ErtsORefThing *rtp = (ErtsORefThing *) b2; + num2 = rtp->num; + } + else { + ErtsMRefThing *mrtp = (ErtsMRefThing *) b2; + num2 = mrtp->mb->refn; + } + return erts_internal_ref_number_cmp(num1, num2); } return -1; } @@ -97,14 +115,15 @@ do { \ Uint i__; \ Uint len__; \ ASSERT((Hp)); \ - ASSERT(is_internal_ref((From)) || is_external((From))); \ + ASSERT(is_internal_ordinary_ref((From)) \ + || is_external((From))); \ (To) = make_boxed((Hp)); \ len__ = thing_arityval(*boxed_val((From))) + 1; \ for(i__ = 0; i__ < len__; i__++) \ (*((Hp)++)) = boxed_val((From))[i__]; \ if (is_external((To))) { \ external_thing_ptr((To))->next = NULL; \ - erts_refc_inc(&(external_thing_ptr((To))->node->refc), 2);\ + erts_smp_refc_inc(&(external_thing_ptr((To))->node->refc), 2);\ } \ } \ } while (0) @@ -339,6 +358,8 @@ void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, Eterm pid, int state = 0; ErtsMonitor **this = root; Sint c; + + ASSERT(is_internal_ordinary_ref(ref) || is_external_ref(ref)); dstack[0] = DIR_END; for (;;) { diff --git a/erts/emulator/beam/erl_monitors.h b/erts/emulator/beam/erl_monitors.h index 9e2beedea3..bb493bf336 100644 --- a/erts/emulator/beam/erl_monitors.h +++ b/erts/emulator/beam/erl_monitors.h @@ -91,7 +91,7 @@ /* Size of a monitor without heap, in words (fixalloc) */ #define ERTS_MONITOR_SIZE ((sizeof(ErtsMonitor) - sizeof(Uint))/sizeof(Uint)) -#define ERTS_MONITOR_SH_SIZE (ERTS_MONITOR_SIZE + REF_THING_SIZE) +#define ERTS_MONITOR_SH_SIZE (ERTS_MONITOR_SIZE + ERTS_REF_THING_SIZE) #define ERTS_LINK_SIZE ((sizeof(ErtsLink) - sizeof(Uint))/sizeof(Uint)) #define ERTS_LINK_SH_SIZE ERTS_LINK_SIZE /* Size of fix-alloced links */ diff --git a/erts/emulator/beam/erl_msacc.c b/erts/emulator/beam/erl_msacc.c index 66bb55e6c8..1c3160efaf 100644 --- a/erts/emulator/beam/erl_msacc.c +++ b/erts/emulator/beam/erl_msacc.c @@ -66,9 +66,9 @@ static Uint msacc_unmanaged_count = 0; #endif #if ERTS_MSACC_STATE_COUNT < MAP_SMALL_MAP_LIMIT -#define DEFAULT_MSACC_MSG_SIZE (3 + 1 + ERTS_MSACC_STATE_COUNT * 2 + 3 + REF_THING_SIZE) +#define DEFAULT_MSACC_MSG_SIZE (3 + 1 + ERTS_MSACC_STATE_COUNT * 2 + 3 + ERTS_REF_THING_SIZE) #else -#define DEFAULT_MSACC_MSG_SIZE (3 + ERTS_MSACC_STATE_COUNT * 3 + 3 + REF_THING_SIZE) +#define DEFAULT_MSACC_MSG_SIZE (3 + ERTS_MSACC_STATE_COUNT * 3 + 3 + ERTS_REF_THING_SIZE) #endif /* we have to split initiation as atoms are not inited in early init */ @@ -212,7 +212,7 @@ typedef struct { int action; Process *proc; Eterm ref; - Eterm ref_heap[REF_THING_SIZE]; + Eterm ref_heap[ERTS_REF_THING_SIZE]; Uint req_sched; erts_smp_atomic32_t refc; } ErtsMSAccReq; @@ -245,7 +245,7 @@ static void send_reply(ErtsMsAcc *msacc, ErtsMSAccReq *msaccrp) { if (msacc->unmanaged) erts_mtx_lock(&msacc->mtx); - hp = erts_produce_heap(&factory, REF_THING_SIZE + 3 /* tuple */, 0); + hp = erts_produce_heap(&factory, ERTS_REF_THING_SIZE + 3 /* tuple */, 0); ref_copy = STORE_NC(&hp, &msgp->hfrag.off_heap, msaccrp->ref); msg = erts_msacc_gather_stats(msacc, &factory); msg = TUPLE2(hp, ref_copy, msg); @@ -255,7 +255,7 @@ static void send_reply(ErtsMsAcc *msacc, ErtsMSAccReq *msaccrp) { erts_factory_close(&factory); } else { ErlOffHeap *ohp = NULL; - msgp = erts_alloc_message_heap(rp, &rp_locks, REF_THING_SIZE, &hp, &ohp); + msgp = erts_alloc_message_heap(rp, &rp_locks, ERTS_REF_THING_SIZE, &hp, &ohp); msg = STORE_NC(&hp, &msgp->hfrag.off_heap, msaccrp->ref); } diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 7c7a32f234..3674a29bf8 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1721,7 +1721,7 @@ ERL_NIF_TERM enif_make_string_len(ErlNifEnv* env, const char* string, ERL_NIF_TERM enif_make_ref(ErlNifEnv* env) { - Eterm* hp = alloc_heap(env, REF_THING_SIZE); + Eterm* hp = alloc_heap(env, ERTS_REF_THING_SIZE); return erts_make_ref_in_buffer(hp); } @@ -1967,7 +1967,6 @@ typedef struct enif_resource_t byte align__[4]; # endif #endif - char data[1]; }ErlNifResource; @@ -2166,6 +2165,7 @@ void* enif_alloc_resource(ErlNifResourceType* type, size_t size) { Binary* bin = erts_create_magic_binary_x(SIZEOF_ErlNifResource(size), &nif_resource_dtor, + ERTS_ALC_T_BINARY, 1); /* unaligned */ ErlNifResource* resource = ERTS_MAGIC_BIN_UNALIGNED_DATA(bin); @@ -2209,34 +2209,56 @@ ERL_NIF_TERM enif_make_resource(ErlNifEnv* env, void* obj) { ErlNifResource* resource = DATA_TO_RESOURCE(obj); ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource); - Eterm* hp = alloc_heap(env,PROC_BIN_SIZE); - return erts_mk_magic_binary_term(&hp, &MSO(env->proc), &bin->binary); + Eterm* hp = alloc_heap(env, ERTS_MAGIC_REF_THING_SIZE); + return erts_mk_magic_ref(&hp, &MSO(env->proc), &bin->binary); } ERL_NIF_TERM enif_make_resource_binary(ErlNifEnv* env, void* obj, const void* data, size_t size) { - Eterm bin = enif_make_resource(env, obj); - ProcBin* pb = (ProcBin*) binary_val(bin); - pb->bytes = (byte*) data; + ErlNifResource* resource = DATA_TO_RESOURCE(obj); + ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource); + ErlOffHeap *ohp = &MSO(env->proc); + Eterm* hp = alloc_heap(env,PROC_BIN_SIZE); + ProcBin* pb = (ProcBin *) hp; + + pb->thing_word = HEADER_PROC_BIN; pb->size = size; - return bin; + pb->next = ohp->first; + ohp->first = (struct erl_off_heap_header*) pb; + pb->val = &bin->binary; + pb->bytes = (byte*) data; + pb->flags = 0; + + OH_OVERHEAD(ohp, size / sizeof(Eterm)); + erts_refc_inc(&bin->binary.refc, 1); + + return make_binary(hp); } int enif_get_resource(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifResourceType* type, void** objp) { - ProcBin* pb; Binary* mbin; ErlNifResource* resource; - if (!ERTS_TERM_IS_MAGIC_BINARY(term)) { - return 0; + if (is_internal_magic_ref(term)) + mbin = erts_magic_ref2bin(term); + else { + Eterm *hp; + if (!is_binary(term)) + return 0; + hp = binary_val(term); + if (thing_subtag(*hp) != REFC_BINARY_SUBTAG) + return 0; + /* + if (((ProcBin *) hp)->size != 0) { + return 0; / * Or should we allow "resource binaries" as handles? * / + } + */ + mbin = ((ProcBin *) hp)->val; + if (!(mbin->flags & BIN_FLAG_MAGIC)) + return 0; } - pb = (ProcBin*) binary_val(term); - /*if (pb->size != 0) { - return 0; / * Or should we allow "resource binaries" as handles? * / - }*/ - mbin = pb->val; resource = (ErlNifResource*) ERTS_MAGIC_BIN_UNALIGNED_DATA(mbin); if (ERTS_MAGIC_BIN_DESTRUCTOR(mbin) != &nif_resource_dtor || resource->type != type) { diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h index 0c76c6fe7d..e27f1d121a 100644 --- a/erts/emulator/beam/erl_node_container_utils.h +++ b/erts/emulator/beam/erl_node_container_utils.h @@ -255,19 +255,16 @@ extern ErtsPTab erts_port; * Refs * \* */ +#define internal_ref_no_numbers(x) ERTS_REF_NUMBERS +#define internal_ref_numbers(x) (is_internal_ordinary_ref((x)) \ + ? internal_ordinary_ref_numbers((x)) \ + : (ASSERT(is_internal_magic_ref((x))), \ + internal_magic_ref_numbers((x)))) #if defined(ARCH_64) -#define internal_ref_no_of_numbers(x) \ - (internal_ref_data((x))[0]) -#define internal_thing_ref_no_of_numbers(thing) \ - (internal_thing_ref_data(thing)[0]) -#define internal_ref_numbers(x) \ - (&internal_ref_data((x))[1]) -#define internal_thing_ref_numbers(thing) \ - (&internal_thing_ref_data(thing)[1]) -#define external_ref_no_of_numbers(x) \ +#define external_ref_no_numbers(x) \ (external_ref_data((x))[0]) -#define external_thing_ref_no_of_numbers(thing) \ +#define external_thing_ref_no_numbers(thing) \ (external_thing_ref_data(thing)[0]) #define external_ref_numbers(x) \ (&external_ref_data((x))[1]) @@ -277,12 +274,8 @@ extern ErtsPTab erts_port; #else -#define internal_ref_no_of_numbers(x) (internal_ref_data_words((x))) -#define internal_thing_ref_no_of_numbers(t) (internal_thing_ref_data_words(t)) -#define internal_ref_numbers(x) (internal_ref_data((x))) -#define internal_thing_ref_numbers(t) (internal_thing_ref_data(t)) -#define external_ref_no_of_numbers(x) (external_ref_data_words((x))) -#define external_thing_ref_no_of_numbers(t) (external_thing_ref_data_words((t))) +#define external_ref_no_numbers(x) (external_ref_data_words((x))) +#define external_thing_ref_no_numbers(t) (external_thing_ref_data_words((t))) #define external_ref_numbers(x) (external_ref_data((x))) #define external_thing_ref_numbers(t) (external_thing_ref_data((t))) @@ -299,15 +292,9 @@ extern ErtsPTab erts_port; #define internal_ref_channel_no(x) (internal_channel_no((x))) #define external_ref_channel_no(x) (external_channel_no((x))) -#define ref_data_words(x) (is_internal_ref((x)) \ - ? internal_ref_data_words((x)) \ - : external_ref_data_words((x))) -#define ref_data(x) (is_internal_ref((x)) \ - ? internal_ref_data((x)) \ - : external_ref_data((x))) -#define ref_no_of_numbers(x) (is_internal_ref((x)) \ - ? internal_ref_no_of_numbers((x))\ - : external_ref_no_of_numbers((x))) +#define ref_no_numbers(x) (is_internal_ref((x)) \ + ? internal_ref_no_numbers((x))\ + : external_ref_no_numbers((x))) #define ref_numbers(x) (is_internal_ref((x)) \ ? internal_ref_numbers((x)) \ : external_ref_numbers((x))) diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index 70500ed6e1..5e54e5aef2 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -98,7 +98,7 @@ dist_table_alloc(void *dep_tmpl) dist_entries++; dep->prev = NULL; - erts_refc_init(&dep->refc, -1); + erts_smp_refc_init(&dep->refc, -1); erts_smp_rwmtx_init_opt_x(&dep->rwmtx, &rwmtx_opt, "dist_entry", chnl_nr); dep->sysname = sysname; dep->cid = NIL; @@ -208,7 +208,7 @@ erts_channel_no_to_dist_entry(Uint cno) * to the node name is used as channel no. */ if(cno == ERST_INTERNAL_CHANNEL_NO) { - erts_refc_inc(&erts_this_dist_entry->refc, 2); + erts_smp_refc_inc(&erts_this_dist_entry->refc, 2); return erts_this_dist_entry; } @@ -231,16 +231,16 @@ erts_sysname_to_connected_dist_entry(Eterm sysname) de.sysname = sysname; if(erts_this_dist_entry->sysname == sysname) { - erts_refc_inc(&erts_this_dist_entry->refc, 2); + erts_smp_refc_inc(&erts_this_dist_entry->refc, 2); return erts_this_dist_entry; } erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx); res_dep = (DistEntry *) hash_get(&erts_dist_table, (void *) &de); if (res_dep) { - erts_aint_t refc = erts_refc_inctest(&res_dep->refc, 1); + erts_aint_t refc = erts_smp_refc_inctest(&res_dep->refc, 1); if (refc < 2) /* Pending delete */ - erts_refc_inc(&res_dep->refc, 1); + erts_smp_refc_inc(&res_dep->refc, 1); } erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx); if (res_dep) { @@ -267,9 +267,9 @@ DistEntry *erts_find_or_insert_dist_entry(Eterm sysname) de.sysname = sysname; erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); res = hash_put(&erts_dist_table, (void *) &de); - refc = erts_refc_inctest(&res->refc, 0); + refc = erts_smp_refc_inctest(&res->refc, 0); if (refc < 2) /* New or pending delete */ - erts_refc_inc(&res->refc, 1); + erts_smp_refc_inc(&res->refc, 1); erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); return res; } @@ -282,9 +282,9 @@ DistEntry *erts_find_dist_entry(Eterm sysname) erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx); res = hash_get(&erts_dist_table, (void *) &de); if (res) { - erts_aint_t refc = erts_refc_inctest(&res->refc, 1); + erts_aint_t refc = erts_smp_refc_inctest(&res->refc, 1); if (refc < 2) /* Pending delete */ - erts_refc_inc(&res->refc, 1); + erts_smp_refc_inc(&res->refc, 1); } erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx); return res; @@ -311,7 +311,7 @@ static void try_delete_dist_entry(void *vdep) * * If refc > 0, the entry is in use. Keep the entry. */ - refc = erts_refc_dectest(&dep->refc, -1); + refc = erts_smp_refc_dectest(&dep->refc, -1); if (refc == -1) (void) hash_erase(&erts_dist_table, (void *) dep); erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); @@ -518,7 +518,7 @@ node_table_alloc(void *venp_tmpl) node_entries++; - erts_refc_init(&enp->refc, -1); + erts_smp_refc_init(&enp->refc, -1); enp->creation = ((ErlNode *) venp_tmpl)->creation; enp->sysname = ((ErlNode *) venp_tmpl)->sysname; enp->dist_entry = erts_find_or_insert_dist_entry(((ErlNode *) venp_tmpl)->sysname); @@ -585,9 +585,9 @@ ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation) erts_smp_rwmtx_rlock(&erts_node_table_rwmtx); res = hash_get(&erts_node_table, (void *) &ne); if (res && res != erts_this_node) { - erts_aint_t refc = erts_refc_inctest(&res->refc, 0); + erts_aint_t refc = erts_smp_refc_inctest(&res->refc, 0); if (refc < 2) /* New or pending delete */ - erts_refc_inc(&res->refc, 1); + erts_smp_refc_inc(&res->refc, 1); } erts_smp_rwmtx_runlock(&erts_node_table_rwmtx); if (res) @@ -597,9 +597,9 @@ ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation) res = hash_put(&erts_node_table, (void *) &ne); ASSERT(res); if (res != erts_this_node) { - erts_aint_t refc = erts_refc_inctest(&res->refc, 0); + erts_aint_t refc = erts_smp_refc_inctest(&res->refc, 0); if (refc < 2) /* New or pending delete */ - erts_refc_inc(&res->refc, 1); + erts_smp_refc_inc(&res->refc, 1); } erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); return res; @@ -626,7 +626,7 @@ static void try_delete_node(void *venp) * * If refc > 0, the entry is in use. Keep the entry. */ - refc = erts_refc_dectest(&enp->refc, -1); + refc = erts_smp_refc_dectest(&enp->refc, -1); if (refc == -1) (void) hash_erase(&erts_node_table, (void *) enp); erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); @@ -672,7 +672,7 @@ static void print_node(void *venp, void *vpndp) erts_print(pndp->to, pndp->to_arg, " %d", enp->creation); #ifdef DEBUG erts_print(pndp->to, pndp->to_arg, " (refc=%ld)", - erts_refc_read(&enp->refc, 0)); + erts_smp_refc_read(&enp->refc, 0)); #endif pndp->no_sysname++; } @@ -715,19 +715,19 @@ void erts_set_this_node(Eterm sysname, Uint creation) { ERTS_SMP_LC_ASSERT(erts_thr_progress_is_blocking()); - ASSERT(erts_refc_read(&erts_this_dist_entry->refc, 2)); + ASSERT(erts_smp_refc_read(&erts_this_dist_entry->refc, 2)); - if (erts_refc_dectest(&erts_this_node->refc, 0) == 0) + if (erts_smp_refc_dectest(&erts_this_node->refc, 0) == 0) try_delete_node(erts_this_node); - if (erts_refc_dectest(&erts_this_dist_entry->refc, 0) == 0) + if (erts_smp_refc_dectest(&erts_this_dist_entry->refc, 0) == 0) try_delete_dist_entry(erts_this_dist_entry); erts_this_node = NULL; /* to make sure refc is bumped for this node */ erts_this_node = erts_find_or_insert_node(sysname, creation); erts_this_dist_entry = erts_this_node->dist_entry; - erts_refc_inc(&erts_this_dist_entry->refc, 2); + erts_smp_refc_inc(&erts_this_dist_entry->refc, 2); erts_this_node_sysname = erts_this_node_sysname_BUFFER; erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname_BUFFER), @@ -789,13 +789,13 @@ void erts_init_node_tables(int dd_sec) node_tmpl.creation = 0; erts_this_node = hash_put(&erts_node_table, &node_tmpl); /* +1 for erts_this_node */ - erts_refc_init(&erts_this_node->refc, 1); + erts_smp_refc_init(&erts_this_node->refc, 1); ASSERT(erts_this_node->dist_entry != NULL); erts_this_dist_entry = erts_this_node->dist_entry; /* +1 for erts_this_dist_entry */ /* +1 for erts_this_node->dist_entry */ - erts_refc_init(&erts_this_dist_entry->refc, 2); + erts_smp_refc_init(&erts_this_dist_entry->refc, 2); erts_this_node_sysname = erts_this_node_sysname_BUFFER; @@ -1126,12 +1126,12 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id) for (u.hdr = oh->first; u.hdr; u.hdr = u.hdr->next) { switch (thing_subtag(u.hdr->thing_word)) { - case REFC_BINARY_SUBTAG: - if(IsMatchProgBinary(u.pb->val)) { + case REF_SUBTAG: + if(IsMatchProgBinary(u.mref->mb)) { InsertedBin *ib; int insert_bin = 1; for (ib = inserted_bins; ib; ib = ib->next) - if(ib->bin_val == u.pb->val) { + if(ib->bin_val == (Binary *) u.mref->mb) { insert_bin = 0; break; } @@ -1140,18 +1140,19 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id) Uint *hp = &id_heap[0]; InsertedBin *nib; UseTmpHeapNoproc(BIG_UINT_HEAP_SIZE); - a.id = erts_bld_uint(&hp, NULL, (Uint) u.pb->val); - erts_match_prog_foreach_offheap(u.pb->val, + a.id = erts_bld_uint(&hp, NULL, (Uint) u.mref->mb); + erts_match_prog_foreach_offheap((Binary *) u.mref->mb, insert_offheap2, (void *) &a); nib = erts_alloc(ERTS_ALC_T_NC_TMP, sizeof(InsertedBin)); - nib->bin_val = u.pb->val; + nib->bin_val = (Binary *) u.mref->mb; nib->next = inserted_bins; inserted_bins = nib; UnUseTmpHeapNoproc(BIG_UINT_HEAP_SIZE); } } break; + case REFC_BINARY_SUBTAG: case FUN_SUBTAG: break; /* No need to */ default: @@ -1623,7 +1624,7 @@ reference_table_term(Uint **hpp, Uint *szp) tup = MK_2TUP(referred_nodes[i].node->sysname, MK_UINT(referred_nodes[i].node->creation)); - tup = MK_3TUP(tup, MK_UINT(erts_refc_read(&referred_nodes[i].node->refc, 0)), nril); + tup = MK_3TUP(tup, MK_UINT(erts_smp_refc_read(&referred_nodes[i].node->refc, 0)), nril); nl = MK_CONS(tup, nl); } @@ -1684,7 +1685,7 @@ reference_table_term(Uint **hpp, Uint *szp) /* DistList = [{Dist, Refc, ReferenceIdList}] */ tup = MK_3TUP(referred_dists[i].dist->sysname, - MK_UINT(erts_refc_read(&referred_dists[i].dist->refc, 0)), + MK_UINT(erts_smp_refc_read(&referred_dists[i].dist->refc, 0)), dril); dl = MK_CONS(tup, dl); } diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h index 47a6724c21..35051173d0 100644 --- a/erts/emulator/beam/erl_node_tables.h +++ b/erts/emulator/beam/erl_node_tables.h @@ -107,7 +107,7 @@ typedef struct dist_entry_ { HashBucket hash_bucket; /* Hash bucket */ struct dist_entry_ *next; /* Next entry in dist_table (not sorted) */ struct dist_entry_ *prev; /* Previous entry in dist_table (not sorted) */ - erts_refc_t refc; /* Reference count */ + erts_smp_refc_t refc; /* Reference count */ erts_smp_rwmtx_t rwmtx; /* Protects all fields below until lck_mtx. */ Eterm sysname; /* name@host atom for efficiency */ @@ -149,7 +149,7 @@ typedef struct dist_entry_ { typedef struct erl_node_ { HashBucket hash_bucket; /* Hash bucket */ - erts_refc_t refc; /* Reference count */ + erts_smp_refc_t refc; /* Reference count */ Eterm sysname; /* name@host atom for efficiency */ Uint32 creation; /* Creation */ DistEntry *dist_entry; /* Corresponding dist entry */ @@ -210,7 +210,7 @@ ERTS_GLB_INLINE void erts_deref_dist_entry(DistEntry *dep) { ASSERT(dep); - if (erts_refc_dectest(&dep->refc, 0) == 0) + if (erts_smp_refc_dectest(&dep->refc, 0) == 0) erts_schedule_delete_dist_entry(dep); } @@ -218,7 +218,7 @@ ERTS_GLB_INLINE void erts_deref_node_entry(ErlNode *np) { ASSERT(np); - if (erts_refc_dectest(&np->refc, 0) == 0) + if (erts_smp_refc_dectest(&np->refc, 0) == 0) erts_schedule_delete_node(np); } diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index b43a1b0190..6b64bbd2f1 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -382,12 +382,15 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) { break; } case REF_DEF: + if (!ERTS_IS_CRASH_DUMPING) + erts_magic_ref_save_bin(obj); + /* fall through... */ case EXTERNAL_REF_DEF: PRINT_STRING(res, fn, arg, "#Ref<"); PRINT_UWORD(res, fn, arg, 'u', 0, 1, (ErlPfUWord) ref_channel_no(wobj)); ref_num = ref_numbers(wobj); - for (i = ref_no_of_numbers(wobj)-1; i >= 0; i--) { + for (i = ref_no_numbers(wobj)-1; i >= 0; i--) { PRINT_CHAR(res, fn, arg, '.'); PRINT_UWORD(res, fn, arg, 'u', 0, 1, (ErlPfUWord) ref_num[i]); } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 641a8fb3e8..87d71fdd22 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -1173,7 +1173,7 @@ typedef struct { int enable; Process *proc; Eterm ref; - Eterm ref_heap[REF_THING_SIZE]; + Eterm ref_heap[ERTS_REF_THING_SIZE]; Uint req_sched; erts_smp_atomic32_t refc; #ifdef ERTS_DIRTY_SCHEDULERS @@ -1185,7 +1185,7 @@ typedef struct { typedef struct { Process *proc; Eterm ref; - Eterm ref_heap[REF_THING_SIZE]; + Eterm ref_heap[ERTS_REF_THING_SIZE]; Uint req_sched; erts_smp_atomic32_t refc; } ErtsSystemCheckReq; @@ -1297,7 +1297,7 @@ reply_sched_wall_time(void *vswtrp) if (hpp) ref_copy = STORE_NC(hpp, ohp, swtrp->ref); else - *szp += REF_THING_SIZE; + *szp += ERTS_REF_THING_SIZE; ASSERT(!swtrp->set); @@ -1342,7 +1342,7 @@ reply_sched_wall_time(void *vswtrp) if (hpp) ref_copy = STORE_NC(hpp, ohp, swtrp->ref); else - *szp += REF_THING_SIZE; + *szp += ERTS_REF_THING_SIZE; if (swtrp->set) msg = ref_copy; @@ -1444,7 +1444,7 @@ reply_system_check(void *vscrp) ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp)); #endif - sz = REF_THING_SIZE; + sz = ERTS_REF_THING_SIZE; mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); hpp = &hp; msg = STORE_NC(hpp, ohp, scrp->ref); @@ -6381,7 +6381,6 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online erts_tsd_set(sched_data_key, (void *) esdp); #endif } - erts_no_schedulers = 1; erts_no_dirty_cpu_schedulers = 0; erts_no_dirty_io_schedulers = 0; #endif @@ -10176,7 +10175,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) esdp->current_process = NULL; #ifdef ERTS_SMP - p->scheduler_data = NULL; + if (is_normal_sched) + p->scheduler_data = NULL; #endif erts_smp_proc_unlock(p, (ERTS_PROC_LOCK_MAIN @@ -10633,8 +10633,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) state = erts_smp_atomic32_read_nob(&p->state); - ASSERT(!p->scheduler_data); #ifndef ERTS_DIRTY_SCHEDULERS + ASSERT(!p->scheduler_data); p->scheduler_data = esdp; #else /* ERTS_DIRTY_SCHEDULERS */ if (is_normal_sched) { @@ -10645,6 +10645,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); goto sched_out_proc; } + ASSERT(!p->scheduler_data); p->scheduler_data = esdp; } else { diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 7c23b5c76a..77c7c5e73c 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -447,7 +447,7 @@ heap_dump(fmtfn_t to, void *to_arg, Eterm x) ProcBin* pb = (ProcBin *) binary_val(x); Binary* val = pb->val; - if (erts_smp_atomic_xchg_nob(&val->refc, 0) != 0) { + if (erts_atomic_xchg_nob(&val->refc, 0) != 0) { val->flags = (UWord) all_binaries; all_binaries = val; } diff --git a/erts/emulator/beam/erl_ptab.c b/erts/emulator/beam/erl_ptab.c index 22830a19c4..a132b1d334 100644 --- a/erts/emulator/beam/erl_ptab.c +++ b/erts/emulator/beam/erl_ptab.c @@ -771,18 +771,18 @@ erts_ptab_list(Process *c_p, ErtsPTab *ptab) } else { Eterm *hp; - Eterm magic_bin; + Eterm magic_ref; ERTS_PTAB_LIST_DBG_CHK_RESLIST(res_acc); - hp = HAlloc(c_p, PROC_BIN_SIZE); - ERTS_PTAB_LIST_DBG_SAVE_HEAP_ALLOC(ptlbdp, hp, PROC_BIN_SIZE); - magic_bin = erts_mk_magic_binary_term(&hp, &MSO(c_p), mbp); + hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE); + ERTS_PTAB_LIST_DBG_SAVE_HEAP_ALLOC(ptlbdp, hp, ERTS_MAGIC_REF_THING_SIZE); + magic_ref = erts_mk_magic_ref(&hp, &MSO(c_p), mbp); ERTS_PTAB_LIST_DBG_VERIFY_HEAP_ALLOC_USED(ptlbdp, hp); ERTS_PTAB_LIST_DBG_TRACE(c_p->common.id, trap); ERTS_BIF_PREP_YIELD2(ret_val, &ptab_list_continue_export, c_p, res_acc, - magic_bin); + magic_ref); } return ret_val; } @@ -1287,9 +1287,7 @@ static BIF_RETTYPE ptab_list_continue(BIF_ALIST_2) res_acc = BIF_ARG_1; - ERTS_PTAB_LIST_ASSERT(ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_2)); - - mbp = ((ProcBin *) binary_val(BIF_ARG_2))->val; + mbp = erts_magic_ref2bin(BIF_ARG_2); ERTS_PTAB_LIST_ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == cleanup_ptab_list_bif_data); diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c index 7d857ad326..6b25728af7 100644 --- a/erts/emulator/beam/erl_term.c +++ b/erts/emulator/beam/erl_term.c @@ -59,6 +59,42 @@ erts_set_literal_tag(Eterm *term, Eterm *hp_start, Eterm hsz) #endif } +void +erts_term_init(void) +{ +#ifdef ERTS_ORDINARY_REF_MARKER + /* Ordinary and magic references of same size... */ + + ErtsRefThing ref_thing; + + ERTS_CT_ASSERT(ERTS_ORDINARY_REF_MARKER == ~((Uint32)0)); + ref_thing.m.header = ERTS_REF_THING_HEADER; + ref_thing.m.mb = (ErtsMagicBinary *) ~((UWord) 3); + ref_thing.m.next = (struct erl_off_heap_header *) ~((UWord) 3); + if (ref_thing.o.marker == ERTS_ORDINARY_REF_MARKER) + ERTS_INTERNAL_ERROR("Cannot differentiate between magic and ordinary references"); + + ERTS_CT_ASSERT(offsetof(ErtsORefThing,marker) != 0); + ERTS_CT_ASSERT(sizeof(ErtsORefThing) == sizeof(ErtsMRefThing)); +# ifdef ERTS_MAGIC_REF_THING_HEADER +# error Magic ref thing header should not have been defined... +# endif + +#else + /* Ordinary and magic references of different sizes... */ + +# ifndef ERTS_MAGIC_REF_THING_HEADER +# error Magic ref thing header should have been defined... +# endif + ERTS_CT_ASSERT(sizeof(ErtsORefThing) != sizeof(ErtsMRefThing)); + +#endif + + ERTS_CT_ASSERT(ERTS_REF_THING_SIZE*sizeof(Eterm) == sizeof(ErtsORefThing)); + ERTS_CT_ASSERT(ERTS_MAGIC_REF_THING_SIZE*sizeof(Eterm) == sizeof(ErtsMRefThing)); + +} + /* * XXX: define NUMBER_CODE() here when new representation is used */ @@ -95,8 +131,8 @@ ET_DEFINE_CHECKED(Eterm*,tuple_val,Wterm,is_tuple); ET_DEFINE_CHECKED(struct erl_node_*,internal_pid_node,Eterm,is_internal_pid); ET_DEFINE_CHECKED(struct erl_node_*,internal_port_node,Eterm,is_internal_port); ET_DEFINE_CHECKED(Eterm*,internal_ref_val,Wterm,is_internal_ref); -ET_DEFINE_CHECKED(Uint,internal_ref_data_words,Wterm,is_internal_ref); -ET_DEFINE_CHECKED(Uint32*,internal_ref_data,Wterm,is_internal_ref); +ET_DEFINE_CHECKED(Uint32*,internal_magic_ref_numbers,Wterm,is_internal_magic_ref); +ET_DEFINE_CHECKED(Uint32*,internal_ordinary_ref_numbers,Wterm,is_internal_ordinary_ref); ET_DEFINE_CHECKED(struct erl_node_*,internal_ref_node,Eterm,is_internal_ref); ET_DEFINE_CHECKED(Eterm*,external_val,Wterm,is_external); ET_DEFINE_CHECKED(Uint,external_data_words,Wterm,is_external); diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index c3234ee349..a602a8f7c6 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -23,6 +23,8 @@ #include "erl_mmap.h" +void erts_term_init(void); + typedef UWord Wterm; /* Full word terms */ struct erl_node_; /* Declared in erl_node_tables.h */ @@ -718,73 +720,224 @@ _ET_DECLARE_CHECKED(struct erl_node_*,internal_port_node,Eterm) #define ERTS_MAX_REF_NUMBERS 3 #define ERTS_REF_NUMBERS ERTS_MAX_REF_NUMBERS -#if defined(ARCH_64) -# define ERTS_REF_WORDS (ERTS_REF_NUMBERS/2 + 1) -# define ERTS_REF_32BIT_WORDS (ERTS_REF_NUMBERS+1) -#else -# define ERTS_REF_WORDS ERTS_REF_NUMBERS -# define ERTS_REF_32BIT_WORDS ERTS_REF_NUMBERS +#ifndef ERTS_ENDIANNESS +# error ERTS_ENDIANNESS not defined... #endif -typedef struct { - Eterm header; - union { - Uint32 ui32[ERTS_REF_32BIT_WORDS]; - Uint ui[ERTS_REF_WORDS]; - } data; -} RefThing; - -#define REF_THING_SIZE (sizeof(RefThing)/sizeof(Uint)) -#define REF_THING_HEAD_SIZE (sizeof(Eterm)/sizeof(Uint)) +#if ERTS_REF_NUMBERS != 3 +# error "A new reference layout for 64-bit needs to be implemented..." +#endif -#define make_ref_thing_header(DW) \ - _make_header((DW)+REF_THING_HEAD_SIZE-1,_TAG_HEADER_REF) +struct magic_binary; #if defined(ARCH_64) +# define ERTS_ORDINARY_REF_MARKER (~((Uint32) 0)) + +typedef struct { + Eterm header; +#if ERTS_ENDIANNESS <= 0 + Uint32 marker; +#endif + Uint32 num[ERTS_REF_NUMBERS]; +#if ERTS_ENDIANNESS > 0 + Uint32 marker; +#endif +} ErtsORefThing; + +typedef struct { + Eterm header; + struct magic_binary *mb; + struct erl_off_heap_header* next; +#if !ERTS_ENDIANNESS + Uint32 num[ERTS_REF_NUMBERS]; + Uint32 marker; +#endif +} ErtsMRefThing; + /* - * Ref layout on a 64-bit little endian machine: + * Ordinary ref layout on a 64-bit little endian machine: * * 63 31 0 * +--------------+--------------+ * | Thing word | * +--------------+--------------+ - * | Data 0 | 32-bit arity | + * | Data 0 | 0xffffffff | * +--------------+--------------+ * | Data 2 | Data 1 | * +--------------+--------------+ * - * Data is stored as an Uint32 array with 32-bit arity as first number. + * Ordinary ref layout on a 64-bit big endian machine: + * + * 63 31 0 + * +--------------+--------------+ + * | Thing word | + * +--------------+--------------+ + * | Data 0 | Data 1 | + * +--------------+--------------+ + * | Data 2 | 0xffffffff | + * +--------------+--------------+ + * + * Magic Ref layout on a 64-bit machine: + * + * 63 31 0 + * +--------------+--------------+ + * | Thing word | + * +--------------+--------------+ + * | Magic Binary Pointer | + * +--------------+--------------+ + * | Next Off Heap Pointer | + * +--------------+--------------+ + * + * Both pointers in the magic ref are 64-bit aligned. That is, + * least significant bits are zero. The marker 32-bit word is + * placed over the least significant bits of one of the pointers. + * That is, we can distinguish between magic and ordinary ref + * by looking at the marker field. + * */ #define write_ref_thing(Hp, R0, R1, R2) \ do { \ - ((RefThing *) (Hp))->header = make_ref_thing_header(ERTS_REF_WORDS); \ - ((RefThing *) (Hp))->data.ui32[0] = ERTS_REF_NUMBERS; \ - ((RefThing *) (Hp))->data.ui32[1] = (R0); \ - ((RefThing *) (Hp))->data.ui32[2] = (R1); \ - ((RefThing *) (Hp))->data.ui32[3] = (R2); \ + ((ErtsORefThing *) (Hp))->header = ERTS_REF_THING_HEADER; \ + ((ErtsORefThing *) (Hp))->marker = ERTS_ORDINARY_REF_MARKER; \ + ((ErtsORefThing *) (Hp))->num[0] = (R0); \ + ((ErtsORefThing *) (Hp))->num[1] = (R1); \ + ((ErtsORefThing *) (Hp))->num[2] = (R2); \ } while (0) -#else +#if ERTS_ENDIANNESS +/* Known big or little endian */ + +#define write_magic_ref_thing(Hp, Ohp, Binp) \ +do { \ + ((ErtsMRefThing *) (Hp))->header = ERTS_REF_THING_HEADER; \ + ((ErtsMRefThing *) (Hp))->mb = (Binp); \ + ((ErtsMRefThing *) (Hp))->next = (Ohp)->first; \ + (Ohp)->first = (struct erl_off_heap_header*) (Hp); \ + ASSERT(erts_is_ref_numbers_magic((Binp)->refn)); \ +} while (0) + +#else /* !ERTS_ENDIANNESS */ + +#define write_magic_ref_thing(Hp, Ohp, Binp) \ +do { \ + ((ErtsMRefThing *) (Hp))->header = ERTS_MAGIC_REF_THING_HEADER; \ + ((ErtsMRefThing *) (Hp))->mb = (Binp); \ + ((ErtsMRefThing *) (Hp))->next = (Ohp)->first; \ + (Ohp)->first = (struct erl_off_heap_header*) (Hp); \ + ((ErtsMRefThing *) (Hp))->marker = 0; \ + ((ErtsMRefThing *) (Hp))->num[0] = (Binp)->refn[0]; \ + ((ErtsMRefThing *) (Hp))->num[1] = (Binp)->refn[1]; \ + ((ErtsMRefThing *) (Hp))->num[2] = (Binp)->refn[2]; \ + ASSERT(erts_is_ref_numbers_magic((Binp)->refn)); \ +} while (0) + +#endif /* !ERTS_ENDIANNESS */ + +#else /* ARCH_32 */ + +typedef struct { + Eterm header; + Uint32 num[ERTS_REF_NUMBERS]; +} ErtsORefThing; + +typedef struct { + Eterm header; + struct magic_binary *mb; + struct erl_off_heap_header* next; +} ErtsMRefThing; + #define write_ref_thing(Hp, R0, R1, R2) \ do { \ - ((RefThing *) (Hp))->header = make_ref_thing_header(ERTS_REF_WORDS); \ - ((RefThing *) (Hp))->data.ui32[0] = (R0); \ - ((RefThing *) (Hp))->data.ui32[1] = (R1); \ - ((RefThing *) (Hp))->data.ui32[2] = (R2); \ + ((ErtsORefThing *) (Hp))->header = ERTS_REF_THING_HEADER; \ + ((ErtsORefThing *) (Hp))->num[0] = (R0); \ + ((ErtsORefThing *) (Hp))->num[1] = (R1); \ + ((ErtsORefThing *) (Hp))->num[2] = (R2); \ } while (0) +#define write_magic_ref_thing(Hp, Ohp, Binp) \ +do { \ + ((ErtsMRefThing *) (Hp))->header = ERTS_MAGIC_REF_THING_HEADER; \ + ((ErtsMRefThing *) (Hp))->mb = (Binp); \ + ((ErtsMRefThing *) (Hp))->next = (Ohp)->first; \ + (Ohp)->first = (struct erl_off_heap_header*) (Hp); \ + ASSERT(erts_is_ref_numbers_magic(&(Binp)->refn)); \ +} while (0) + +#endif /* ARCH_32 */ + +typedef union { + ErtsMRefThing m; + ErtsORefThing o; +} ErtsRefThing; + +#define ERTS_REF_THING_SIZE (sizeof(ErtsORefThing)/sizeof(Uint)) +#define ERTS_MAGIC_REF_THING_SIZE (sizeof(ErtsMRefThing)/sizeof(Uint)) +#define ERTS_MAX_INTERNAL_REF_SIZE (sizeof(ErtsRefThing)/sizeof(Uint)) + +#define make_ref_thing_header(Words) \ + _make_header((Words)-1,_TAG_HEADER_REF) + +#define ERTS_REF_THING_HEADER _make_header(ERTS_REF_THING_SIZE-1,_TAG_HEADER_REF) + +#if defined(ARCH_64) && ERTS_ENDIANNESS /* All internal refs of same size... */ + +# undef ERTS_MAGIC_REF_THING_HEADER + +# define is_ref_thing_header(x) ((x) == ERTS_REF_THING_HEADER) + +#define is_ordinary_ref_thing(x) \ + (ASSERT(is_ref_thing_header(*((Eterm *)(x)))), \ + ((ErtsRefThing *) (x))->o.marker == ERTS_ORDINARY_REF_MARKER) + +#define is_magic_ref_thing(x) \ + (!is_ordinary_ref_thing((x))) + +#define is_internal_magic_ref(x) \ + ((_unchecked_is_boxed((x)) && *boxed_val((x)) == ERTS_REF_THING_HEADER) \ + && is_magic_ref_thing(boxed_val((x)))) + +#define is_internal_ordinary_ref(x) \ + ((_unchecked_is_boxed((x)) && *boxed_val((x)) == ERTS_REF_THING_HEADER) \ + && is_ordinary_ref_thing(boxed_val((x)))) + +#else /* Ordinary and magic references of different sizes... */ + +# define ERTS_MAGIC_REF_THING_HEADER \ + _make_header(ERTS_MAGIC_REF_THING_SIZE-1,_TAG_HEADER_REF) + +# define is_ref_thing_header(x) \ + (((x) & _TAG_HEADER_MASK) == _TAG_HEADER_REF) + +#define is_ordinary_ref_thing(x) \ + (ASSERT(is_ref_thing_header(*((Eterm *)(x)))), \ + *((Eterm *)(x)) == ERTS_REF_THING_HEADER) + +#define is_magic_ref_thing(x) \ + (ASSERT(is_ref_thing_header(*((Eterm *)(x)))), \ + *((Eterm *)(x)) == ERTS_MAGIC_REF_THING_HEADER) + +#define is_internal_magic_ref(x) \ + (_unchecked_is_boxed((x)) && *boxed_val((x)) == ERTS_MAGIC_REF_THING_HEADER) + +#define is_internal_ordinary_ref(x) \ + (_unchecked_is_boxed((x)) && *boxed_val((x)) == ERTS_REF_THING_HEADER) + #endif -#define is_ref_thing_header(x) (((x) & _TAG_HEADER_MASK) == _TAG_HEADER_REF) #define make_internal_ref(x) make_boxed((Eterm*)(x)) -#define _unchecked_ref_thing_ptr(x) \ - ((RefThing*) _unchecked_internal_ref_val(x)) -#define ref_thing_ptr(x) \ - ((RefThing*) internal_ref_val(x)) +#define _unchecked_ordinary_ref_thing_ptr(x) \ + ((ErtsORefThing*) _unchecked_internal_ref_val(x)) +#define ordinary_ref_thing_ptr(x) \ + ((ErtsORefThing*) internal_ref_val(x)) + +#define _unchecked_magic_ref_thing_ptr(x) \ + ((ErtsMRefThing*) _unchecked_internal_ref_val(x)) +#define magic_ref_thing_ptr(x) \ + ((ErtsMRefThing*) internal_ref_val(x)) #define is_internal_ref(x) \ (_unchecked_is_boxed((x)) && is_ref_thing_header(*boxed_val((x)))) @@ -796,16 +949,21 @@ do { \ _ET_DECLARE_CHECKED(Eterm*,internal_ref_val,Wterm) #define internal_ref_val(x) _ET_APPLY(internal_ref_val,(x)) -#define internal_thing_ref_data_words(t) (thing_arityval(*(Eterm*)(t))) -#define _unchecked_internal_ref_data_words(x) \ - (_unchecked_thing_arityval(*_unchecked_internal_ref_val(x))) -_ET_DECLARE_CHECKED(Uint,internal_ref_data_words,Wterm) -#define internal_ref_data_words(x) _ET_APPLY(internal_ref_data_words,(x)) +#define internal_ordinary_thing_ref_numbers(ort) (((ErtsORefThing *)(ort))->num) +#define _unchecked_internal_ordinary_ref_numbers(x) (internal_ordinary_thing_ref_numbers(_unchecked_ordinary_ref_thing_ptr(x))) +_ET_DECLARE_CHECKED(Uint32*,internal_ordinary_ref_numbers,Wterm) +#define internal_ordinary_ref_numbers(x) _ET_APPLY(internal_ordinary_ref_numbers,(x)) + +#if defined(ARCH_64) && !ERTS_ENDIANNESS +#define internal_magic_thing_ref_numbers(mrt) (((ErtsMRefThing *)(mrt))->num) +#else +#define internal_magic_thing_ref_numbers(mrt) (((ErtsMRefThing *)(mrt))->mb->refn) +#endif + +#define _unchecked_internal_magic_ref_numbers(x) (internal_magic_thing_ref_numbers(_unchecked_magic_ref_thing_ptr(x))) +_ET_DECLARE_CHECKED(Uint32*,internal_magic_ref_numbers,Wterm) +#define internal_magic_ref_numbers(x) _ET_APPLY(internal_magic_ref_numbers,(x)) -#define internal_thing_ref_data(thing) ((thing)->data.ui32) -#define _unchecked_internal_ref_data(x) (internal_thing_ref_data(_unchecked_ref_thing_ptr(x))) -_ET_DECLARE_CHECKED(Uint32*,internal_ref_data,Wterm) -#define internal_ref_data(x) _ET_APPLY(internal_ref_data,(x)) #define _unchecked_internal_ref_node(x) erts_this_node _ET_DECLARE_CHECKED(struct erl_node_*,internal_ref_node,Eterm) diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c index 6aa2a7500f..1d747e5fab 100644 --- a/erts/emulator/beam/erl_time_sup.c +++ b/erts/emulator/beam/erl_time_sup.c @@ -1831,7 +1831,10 @@ erts_demonitor_time_offset(Eterm ref) ErtsMonitor *mon; ASSERT(is_internal_ref(ref)); erts_smp_mtx_lock(&erts_get_time_mtx); - mon = erts_remove_monitor(&time_offset_monitors, ref); + if (is_internal_ordinary_ref(ref)) + mon = erts_remove_monitor(&time_offset_monitors, ref); + else + mon = NULL; if (!mon) res = 0; else { @@ -1848,7 +1851,7 @@ erts_demonitor_time_offset(Eterm ref) typedef struct { Eterm pid; Eterm ref; - Eterm heap[REF_THING_SIZE]; + Eterm heap[ERTS_REF_THING_SIZE]; } ErtsTimeOffsetMonitorInfo; typedef struct { @@ -1869,11 +1872,11 @@ save_time_offset_monitor(ErtsMonitor *mon, void *vcntxt) cntxt->to_mon_info[mix].pid = mon->pid; to_hp = &cntxt->to_mon_info[mix].heap[0]; - ASSERT(is_internal_ref(mon->ref)); + ASSERT(is_internal_ordinary_ref(mon->ref)); from_hp = internal_ref_val(mon->ref); - ASSERT(thing_arityval(*from_hp) + 1 == REF_THING_SIZE); + ASSERT(thing_arityval(*from_hp) + 1 == ERTS_REF_THING_SIZE); - for (hix = 0; hix < REF_THING_SIZE; hix++) + for (hix = 0; hix < ERTS_REF_THING_SIZE; hix++) to_hp[hix] = from_hp[hix]; cntxt->to_mon_info[mix].ref @@ -1933,7 +1936,7 @@ send_time_offset_changed_notifications(void *new_offsetp) hp = (Eterm *) (tmp + no_monitors*sizeof(ErtsTimeOffsetMonitorInfo)); hsz = 6; /* 5-tuple */ - hsz += REF_THING_SIZE; + hsz += ERTS_REF_THING_SIZE; hsz += ERTS_SINT64_HEAP_SIZE(new_offset); if (IS_SSMALL(new_offset)) diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index 8919898181..dd7c589c3d 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -129,13 +129,9 @@ static void cleanup_restart_context_bin(Binary *bp) cleanup_restart_context(rc); } -static RestartContext *get_rc_from_bin(Eterm bin) +static RestartContext *get_rc_from_bin(Eterm mref) { - Binary *mbp; - ASSERT(ERTS_TERM_IS_MAGIC_BINARY(bin)); - - mbp = ((ProcBin *) binary_val(bin))->val; - + Binary *mbp = erts_magic_ref2bin(mref); ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == cleanup_restart_context_bin); return (RestartContext *) ERTS_MAGIC_BIN_DATA(mbp); @@ -148,8 +144,8 @@ static Eterm make_magic_bin_for_restart(Process *p, RestartContext *rc) RestartContext *restartp = ERTS_MAGIC_BIN_DATA(mbp); Eterm *hp; memcpy(restartp,rc,sizeof(RestartContext)); - hp = HAlloc(p, PROC_BIN_SIZE); - return erts_mk_magic_binary_term(&hp, &MSO(p), mbp); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + return erts_mk_magic_ref(&hp, &MSO(p), mbp); } diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index d88cafc5bf..5366ee3644 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -110,8 +110,21 @@ #define HeapWordsLeft(p) (HEAP_LIMIT(p) - HEAP_TOP(p)) #if defined(DEBUG) || defined(CHECK_FOR_HOLES) -# define ERTS_HOLE_MARKER (((0xdeadbeef << 24) << 8) | 0xdeadbeef) -#endif /* egil: 32-bit ? */ + +/* + * ERTS_HOLE_MARKER must *not* be mistaken for a valid term + * on the heap... + */ +# ifdef ARCH_64 +# define ERTS_HOLE_MARKER \ + make_catch(UWORD_CONSTANT(0xdeadbeaf00000000) >> _TAG_IMMED2_SIZE) +/* Will (at the time of writing) appear as 0xdeadbeaf0000001b */ +# else +# define ERTS_HOLE_MARKER \ + make_catch(UWORD_CONSTANT(0xdead0000) >> _TAG_IMMED2_SIZE) +/* Will (at the time of writing) appear as 0xdead001b */ +# endif +#endif /* * Allocate heap memory on the ordinary heap, NEVER in a heap diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index e84ba1cac0..f9cba0aec0 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -616,7 +616,7 @@ erts_make_dist_ext_copy(ErtsDistExternal *edep, Uint xsize) sys_memcpy((void *) ep, (void *) edep, dist_ext_sz); ep += dist_ext_sz; if (new_edep->dep) - erts_refc_inc(&new_edep->dep->refc, 1); + erts_smp_refc_inc(&new_edep->dep->refc, 1); new_edep->extp = ep; new_edep->ext_endp = ep + ext_sz; new_edep->heap_size = -1; @@ -1079,7 +1079,7 @@ static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1) Eterm *tp = tuple_val(BIF_ARG_1); Eterm Term = tp[1]; Eterm bt = tp[2]; - Binary *bin = ((ProcBin *) binary_val(bt))->val; + Binary *bin = erts_magic_ref2bin(bt); Eterm res = erts_term_to_binary_int(BIF_P, Term, 0, 0,bin); if (is_tuple(res)) { ASSERT(BIF_P->flags & F_DISABLE_GC); @@ -1408,7 +1408,7 @@ static void b2t_context_destructor(Binary *context_bin) static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1) { - Binary *context_bin = ((ProcBin *) binary_val(BIF_ARG_1))->val; + Binary *context_bin = erts_magic_ref2bin(BIF_ARG_1); ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(context_bin) == b2t_context_destructor); return binary_to_term_int(BIF_P, 0, THE_NON_VALUE, context_bin, NULL, @@ -1442,8 +1442,8 @@ static B2TContext* b2t_export_context(Process* p, B2TContext* src) if (ctx->state >= B2TDecode && ctx->u.dc.next == &src->u.dc.res) { ctx->u.dc.next = &ctx->u.dc.res; } - hp = HAlloc(p, PROC_BIN_SIZE); - ctx->trap_bin = erts_mk_magic_binary_term(&hp, &MSO(p), context_b); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + ctx->trap_bin = erts_mk_magic_ref(&hp, &MSO(p), context_b); return ctx; } @@ -1871,8 +1871,8 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla #define RETURN_STATE() \ do { \ - hp = HAlloc(p, PROC_BIN_SIZE+3); \ - c_term = erts_mk_magic_binary_term(&hp, &MSO(p), context_b); \ + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE+3); \ + c_term = erts_mk_magic_ref(&hp, &MSO(p), context_b); \ res = TUPLE2(hp, Term, c_term); \ BUMP_ALL_REDS(p); \ return res; \ @@ -2579,7 +2579,9 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); - i = ref_no_of_numbers(obj); + erts_magic_ref_save_bin(obj); + + i = ref_no_numbers(obj); put_int16(i, ep); ep += 2; ep = enc_atom(acmp, sysname, ep, dflags); @@ -3435,26 +3437,35 @@ dec_term_atom_common: r0 = get_int32(ep); /* allow full word */ ep += 4; - ref_ext_common: + ref_ext_common: { + ErtsORefThing *rtp; + if (ref_words > ERTS_MAX_REF_NUMBERS) goto error; node = dec_get_node(sysname, cre); if(node == erts_this_node) { - RefThing *rtp = (RefThing *) hp; - ref_num = (Uint32 *) (hp + REF_THING_HEAD_SIZE); + + rtp = (ErtsORefThing *) hp; + ref_num = &rtp->num[0]; + if (ref_words != ERTS_REF_NUMBERS) { + int i; + if (ref_words > ERTS_REF_NUMBERS) + goto error; /* Not a ref that we created... */ + for (i = ref_words; i < ERTS_REF_NUMBERS; i++) + ref_num[i] = 0; + } -#if defined(ARCH_64) - hp += REF_THING_HEAD_SIZE + ref_words/2 + 1; - rtp->header = make_ref_thing_header(ref_words/2 + 1); -#else - hp += REF_THING_HEAD_SIZE + ref_words; - rtp->header = make_ref_thing_header(ref_words); +#ifdef ERTS_ORDINARY_REF_MARKER + rtp->marker = ERTS_ORDINARY_REF_MARKER; #endif + hp += ERTS_REF_THING_SIZE; + rtp->header = ERTS_REF_THING_HEADER; *objp = make_internal_ref(rtp); } else { ExternalThing *etp = (ExternalThing *) hp; + rtp = NULL; #if defined(ARCH_64) hp += EXTERNAL_THING_HEAD_SIZE + ref_words/2 + 1; #else @@ -3472,12 +3483,13 @@ dec_term_atom_common: factory->off_heap->first = (struct erl_off_heap_header*)etp; *objp = make_external_ref(etp); ref_num = &(etp->data.ui32[0]); - } - #if defined(ARCH_64) - *(ref_num++) = ref_words /* 32-bit arity */; + *(ref_num++) = ref_words /* 32-bit arity */; #endif + } + ref_num[0] = r0; + for(i = 1; i < ref_words; i++) { ref_num[i] = get_int32(ep); ep += 4; @@ -3486,8 +3498,26 @@ dec_term_atom_common: if ((1 + ref_words) % 2) ref_num[ref_words] = 0; #endif + if (node == erts_this_node) { + /* Check if it was a magic reference... */ + ErtsMagicBinary *mb = erts_magic_ref_lookup_bin(ref_num); + if (mb) { + /* + * Was a magic ref; adjust it... + * + * Refc on binary was increased by lookup above... + */ + ASSERT(rtp); + hp = (Eterm *) rtp; + write_magic_ref_thing(hp, factory->off_heap, mb); + OH_OVERHEAD(factory->off_heap, + mb->orig_size / sizeof(Eterm)); + hp += ERTS_MAGIC_REF_THING_SIZE; + } + } break; } + } case BINARY_EXT: { n = get_int32(ep); @@ -4109,7 +4139,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, /*fall through*/ case REF_DEF: ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); - i = ref_no_of_numbers(obj); + i = ref_no_numbers(obj); result += (1 + 2 + encode_size_struct2(acmp, ref_node_name(obj), dflags) + 1 + 4*i); break; diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index bc15f2a6f1..fff22fe9c1 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -42,6 +42,9 @@ #include "erl_utils.h" #include "erl_port.h" #include "erl_gc.h" +#define ERTS_BINARY_TYPES_ONLY__ +#include "erl_binary.h" +#undef ERTS_BINARY_TYPES_ONLY__ struct enif_func_t; @@ -126,7 +129,7 @@ typedef struct de_proc_entry { PROC_AWAIT_LOAD == Wants to be notified when we reloaded the driver (old was locked) */ Uint flags; /* ERL_FL_DE_DEREFERENCED when reload in progress */ - Eterm heap[REF_THING_SIZE]; /* "ref heap" */ + Eterm heap[ERTS_REF_THING_SIZE]; /* "ref heap" */ struct de_proc_entry *next; } DE_ProcEntry; @@ -134,7 +137,7 @@ typedef struct { void *handle; /* Handle for DLL or SO (for dyn. drivers). */ DE_ProcEntry *procs; /* List of pids that have loaded this driver, or that wait for it to change state */ - erts_refc_t refc; /* Number of ports/processes having + erts_smp_refc_t refc; /* Number of ports/processes having references to the driver */ erts_smp_atomic32_t port_count; /* Number of ports using the driver */ Uint flags; /* ERL_DE_FL_KILL_PORTS */ @@ -214,118 +217,6 @@ extern Eterm erts_ddll_monitor_driver(Process *p, ErtsProcLocks plocks); /* -** Just like the driver binary but with initial flags -** Note that the two structures Binary and ErlDrvBinary HAVE to -** be equal except for extra fields in the beginning of the struct. -** ErlDrvBinary is defined in erl_driver.h. -** When driver_alloc_binary is called, a Binary is allocated, but -** the pointer returned is to the address of the first element that -** also occurs in the ErlDrvBinary struct (driver.*binary takes care if this). -** The driver need never know about additions to the internal Binary of the -** emulator. One should however NEVER be sloppy when mixing ErlDrvBinary -** and Binary, the macros below can convert one type to the other, as they both -** in reality are equal. -*/ - -#ifdef ARCH_32 - /* *DO NOT USE* only for alignment. */ -#define ERTS_BINARY_STRUCT_ALIGNMENT Uint32 align__; -#else -#define ERTS_BINARY_STRUCT_ALIGNMENT -#endif - -/* Add fields in ERTS_INTERNAL_BINARY_FIELDS, otherwise the drivers crash */ -#define ERTS_INTERNAL_BINARY_FIELDS \ - UWord flags; \ - erts_refc_t refc; \ - ERTS_BINARY_STRUCT_ALIGNMENT - -typedef struct binary { - ERTS_INTERNAL_BINARY_FIELDS - SWord orig_size; - char orig_bytes[1]; /* to be continued */ -} Binary; - -#define ERTS_SIZEOF_Binary(Sz) \ - (offsetof(Binary,orig_bytes) + (Sz)) - -typedef struct { - ERTS_INTERNAL_BINARY_FIELDS - SWord orig_size; - void (*destructor)(Binary *); - union { - struct { - ERTS_BINARY_STRUCT_ALIGNMENT - char data[1]; - } aligned; - struct { - char data[1]; - } unaligned; - } u; -} ErtsMagicBinary; - -#ifdef ARCH_32 -#define ERTS_MAGIC_BIN_BYTES_TO_ALIGN 4 -#else -#define ERTS_MAGIC_BIN_BYTES_TO_ALIGN 0 -#endif - -typedef union { - Binary binary; - ErtsMagicBinary magic_binary; - struct { - ERTS_INTERNAL_BINARY_FIELDS - ErlDrvBinary binary; - } driver; -} ErtsBinary; - -/* - * 'Binary' alignment: - * Address of orig_bytes[0] of a Binary should always be 8-byte aligned. - * It is assumed that the flags, refc, and orig_size fields are 4 bytes on - * 32-bits architectures and 8 bytes on 64-bits architectures. - */ - -#define ERTS_MAGIC_BIN_DESTRUCTOR(BP) \ - ((ErtsBinary *) (BP))->magic_binary.destructor -#define ERTS_MAGIC_BIN_DATA(BP) \ - ((void *) ((ErtsBinary *) (BP))->magic_binary.u.aligned.data) -#define ERTS_MAGIC_DATA_OFFSET \ - (offsetof(ErtsMagicBinary,u.aligned.data) - offsetof(Binary,orig_bytes)) -#define ERTS_MAGIC_BIN_ORIG_SIZE(Sz) \ - (ERTS_MAGIC_DATA_OFFSET + (Sz)) -#define ERTS_MAGIC_BIN_SIZE(Sz) \ - (offsetof(ErtsMagicBinary,u.aligned.data) + (Sz)) - -/* On 32-bit arch these macro variants will save memory - by not forcing 8-byte alignment for the magic payload. -*/ -#define ERTS_MAGIC_BIN_UNALIGNED_DATA(BP) \ - ((void *) ((ErtsBinary *) (BP))->magic_binary.u.unaligned.data) -#define ERTS_MAGIC_UNALIGNED_DATA_OFFSET \ - (offsetof(ErtsMagicBinary,u.unaligned.data) - offsetof(Binary,orig_bytes)) -#define ERTS_MAGIC_BIN_UNALIGNED_DATA_SIZE(BP) \ - ((BP)->orig_size - ERTS_MAGIC_UNALIGNED_DATA_OFFSET) -#define ERTS_MAGIC_BIN_UNALIGNED_ORIG_SIZE(Sz) \ - (ERTS_MAGIC_UNALIGNED_DATA_OFFSET + (Sz)) -#define ERTS_MAGIC_BIN_UNALIGNED_SIZE(Sz) \ - (offsetof(ErtsMagicBinary,u.unaligned.data) + (Sz)) -#define ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(DATA) \ - ((ErtsBinary*)((char*)(DATA) - offsetof(ErtsMagicBinary,u.unaligned.data))) - - -#define Binary2ErlDrvBinary(B) (&((ErtsBinary *) (B))->driver.binary) -#define ErlDrvBinary2Binary(D) ((Binary *) \ - (((char *) (D)) \ - - offsetof(ErtsBinary, driver.binary))) - -/* A "magic" binary flag */ -#define BIN_FLAG_MAGIC 1 -#define BIN_FLAG_USR1 2 /* Reserved for use by different modules too mark */ -#define BIN_FLAG_USR2 4 /* certain binaries as special (used by ets) */ -#define BIN_FLAG_DRV 8 - -/* * This structure represents one type of a binary in a process. */ @@ -346,46 +237,12 @@ typedef struct proc_bin { */ #define PROC_BIN_SIZE (sizeof(ProcBin)/sizeof(Eterm)) -ERTS_GLB_INLINE Eterm erts_mk_magic_binary_term(Eterm **hpp, - ErlOffHeap *ohp, - Binary *mbp); - -#if ERTS_GLB_INLINE_INCL_FUNC_DEF - -ERTS_GLB_INLINE Eterm -erts_mk_magic_binary_term(Eterm **hpp, ErlOffHeap *ohp, Binary *mbp) -{ - ProcBin *pb = (ProcBin *) *hpp; - *hpp += PROC_BIN_SIZE; - - ASSERT(mbp->flags & BIN_FLAG_MAGIC); - - pb->thing_word = HEADER_PROC_BIN; - pb->size = 0; - pb->next = ohp->first; - ohp->first = (struct erl_off_heap_header*) pb; - pb->val = mbp; - pb->bytes = (byte *) mbp->orig_bytes; - pb->flags = 0; - - erts_refc_inc(&mbp->refc, 1); - - return make_binary(pb); -} - -#endif - -#define ERTS_TERM_IS_MAGIC_BINARY(T) \ - (is_binary((T)) \ - && (thing_subtag(*binary_val((T))) == REFC_BINARY_SUBTAG) \ - && (((ProcBin *) binary_val((T)))->val->flags & BIN_FLAG_MAGIC)) - - union erl_off_heap_ptr { struct erl_off_heap_header* hdr; ProcBin *pb; struct erl_fun_thing* fun; struct external_thing_* ext; + ErtsMRefThing *mref; Eterm* ep; void* voidp; }; @@ -978,21 +835,6 @@ void erts_bif_info_init(void); /* bif.c */ -ERTS_GLB_INLINE Eterm -erts_proc_store_ref(Process *c_p, Uint32 ref[ERTS_MAX_REF_NUMBERS]); - -#if ERTS_GLB_INLINE_INCL_FUNC_DEF - -ERTS_GLB_INLINE Eterm -erts_proc_store_ref(Process *c_p, Uint32 ref[ERTS_MAX_REF_NUMBERS]) -{ - Eterm *hp = HAlloc(c_p, REF_THING_SIZE); - write_ref_thing(hp, ref[0], ref[1], ref[2]); - return make_internal_ref(hp); -} - -#endif - void erts_queue_monitor_message(Process *, ErtsProcLocks*, Eterm, diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 33b74f30b7..dad24d7ef6 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1445,7 +1445,7 @@ finalize_force_imm_drv_call(ErtsTryImmDrvCallState *sp) erts_unblock_fpe(sp->fpe_was_unmasked); } -#define ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE (REF_THING_SIZE + 3) +#define ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE (ERTS_REF_THING_SIZE + 3) static ERTS_INLINE void queue_port_sched_op_reply(Process *rp, @@ -1460,7 +1460,7 @@ queue_port_sched_op_reply(Process *rp, ref= make_internal_ref(hp); write_ref_thing(hp, ref_num[0], ref_num[1], ref_num[2]); - hp += REF_THING_SIZE; + hp += ERTS_REF_THING_SIZE; msg = TUPLE2(hp, ref, msg); @@ -3099,7 +3099,7 @@ port_monitor(Port *prt, erts_aint32_t state, Eterm origin, ASSERT(is_pid(origin)); ASSERT(is_atom(name) || is_port(name) || name == NIL); - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); if (!(state & ERTS_PORT_SFLGS_INVALID_LOOKUP)) { ErtsProcLocks p_locks = ERTS_PROC_LOCK_LINK; @@ -3124,7 +3124,7 @@ static int port_sig_monitor(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *sigdp) { - Eterm hp[REF_THING_SIZE]; + Eterm hp[ERTS_REF_THING_SIZE]; Eterm ref = make_internal_ref(&hp); write_ref_thing(hp, sigdp->ref[0], sigdp->ref[1], sigdp->ref[2]); @@ -3245,7 +3245,7 @@ static int port_sig_demonitor(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *sigdp) { - Eterm hp[REF_THING_SIZE]; + Eterm hp[ERTS_REF_THING_SIZE]; Eterm ref = make_internal_ref(&hp); write_ref_thing(hp, sigdp->u.demonitor.ref[0], sigdp->u.demonitor.ref[1], @@ -3302,10 +3302,10 @@ ErtsPortOpResult erts_port_demonitor(Process *origin, ErtsDemonitorMode mode, sigdp->u.demonitor.origin = origin->common.id; sigdp->u.demonitor.name = target->common.id; { - RefThing *reft = ref_thing_ptr(ref); + Uint32 *nums = internal_ref_numbers(ref); /* Start from 1 skip ref arity */ sys_memcpy(sigdp->u.demonitor.ref, - internal_thing_ref_numbers(reft), + nums, sizeof(sigdp->u.demonitor.ref)); } @@ -5413,7 +5413,7 @@ reply_io_bytes(void *vreq) rp_locks = ERTS_PROC_LOCK_MAIN; } - hsz = 5 /* 4-tuple */ + REF_THING_SIZE; + hsz = 5 /* 4-tuple */ + ERTS_REF_THING_SIZE; erts_bld_uint64(NULL, &hsz, in); erts_bld_uint64(NULL, &hsz, out); @@ -5422,7 +5422,7 @@ reply_io_bytes(void *vreq) ref = make_internal_ref(hp); write_ref_thing(hp, req->refn[0], req->refn[1], req->refn[2]); - hp += REF_THING_SIZE; + hp += ERTS_REF_THING_SIZE; ein = erts_bld_uint64(&hp, NULL, in); eout = erts_bld_uint64(&hp, NULL, out); @@ -5451,7 +5451,7 @@ erts_request_io_bytes(Process *c_p) ErtsIOBytesReq *req = erts_alloc(ERTS_ALC_T_IOB_REQ, sizeof(ErtsIOBytesReq)); - hp = HAlloc(c_p, REF_THING_SIZE); + hp = HAlloc(c_p, ERTS_REF_THING_SIZE); ref = erts_sched_make_ref_in_buffer(esdp, hp); refn = internal_ref_numbers(ref); @@ -6888,12 +6888,6 @@ ErlDrvSizeT driver_vec_to_buf(ErlIOVec *vec, char *buf, ErlDrvSizeT len) return (orig_len - len); } - -/* - * - driver_alloc_binary() is thread safe (efile driver depend on it). - * - driver_realloc_binary(), and driver_free_binary() are *not* thread safe. - */ - /* * reference count on driver binaries... */ @@ -6936,26 +6930,15 @@ driver_alloc_binary(ErlDrvSizeT size) return Binary2ErlDrvBinary(bin); } -/* Reallocate space hold by binary */ +/* Reallocate space held by binary */ ErlDrvBinary* driver_realloc_binary(ErlDrvBinary* bin, ErlDrvSizeT size) { Binary* oldbin; Binary* newbin; - if (!bin) { - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf(dsbufp, - "Bad use of driver_realloc_binary(%p, %lu): " - "called with ", - bin, (unsigned long)size); - if (!bin) { - erts_dsprintf(dsbufp, "NULL pointer as first argument"); - } - erts_send_warning_to_logger_nogl(dsbufp); - if (!bin) - return driver_alloc_binary(size); - } + if (!bin) + return driver_alloc_binary(size); oldbin = ErlDrvBinary2Binary(bin); newbin = (Binary *) erts_bin_realloc_fnf(oldbin, size); @@ -6969,14 +6952,8 @@ ErlDrvBinary* driver_realloc_binary(ErlDrvBinary* bin, ErlDrvSizeT size) void driver_free_binary(ErlDrvBinary* dbin) { Binary *bin; - if (!dbin) { - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf(dsbufp, - "Bad use of driver_free_binary(%p): called with " - "NULL pointer as argument", dbin); - erts_send_warning_to_logger_nogl(dsbufp); + if (!dbin) return; - } bin = ErlDrvBinary2Binary(dbin); if (erts_refc_dectest(&bin->refc, 0) == 0) @@ -7632,20 +7609,16 @@ erl_drv_convert_time_unit(ErlDrvTime val, static void ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon) { - RefThing *refp; - ASSERT(is_internal_ref(ref)); - ERTS_CT_ASSERT(sizeof(RefThing) <= sizeof(ErlDrvMonitor)); - refp = ref_thing_ptr(ref); - memset(mon,0,sizeof(ErlDrvMonitor)); - memcpy(mon,refp,sizeof(RefThing)); + ERTS_CT_ASSERT(sizeof(ErtsOIRefStorage) <= sizeof(ErlDrvMonitor)); + erts_oiref_storage_save((ErtsOIRefStorage *) mon, ref); } static int do_driver_monitor_process(Port *prt, - Eterm *buf, ErlDrvTermData process, ErlDrvMonitor *monitor) { + Eterm buf[ERTS_REF_THING_SIZE]; Process *rp; Eterm ref; @@ -7688,26 +7661,22 @@ int driver_monitor_process(ErlDrvPort drvport, /* Now (in SMP) we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock)); - { - DeclareTmpHeapNoproc(buf,REF_THING_SIZE); - UseTmpHeapNoproc(REF_THING_SIZE); - ret = do_driver_monitor_process(prt,buf,process,monitor); - UnUseTmpHeapNoproc(REF_THING_SIZE); - } + ret = do_driver_monitor_process(prt,process,monitor); DRV_MONITOR_UNLOCK_PDL(prt); return ret; } -static int do_driver_demonitor_process(Port *prt, Eterm *buf, - const ErlDrvMonitor *monitor) +static int do_driver_demonitor_process(Port *prt, const ErlDrvMonitor *monitor) { + Eterm heap[ERTS_REF_THING_SIZE]; + Eterm *hp = &heap[0]; Process *rp; Eterm ref; ErtsMonitor *mon; Eterm to; - memcpy(buf,monitor,sizeof(Eterm)*REF_THING_SIZE); - ref = make_internal_ref(buf); + ref = erts_oiref_storage_make_ref((ErtsOIRefStorage *) monitor, &hp), + mon = erts_lookup_monitor(ERTS_P_MONITORS(prt), ref); if (mon == NULL) { return 1; @@ -7751,25 +7720,21 @@ int driver_demonitor_process(ErlDrvPort drvport, /* Now we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock)); - { - DeclareTmpHeapNoproc(buf,REF_THING_SIZE); - UseTmpHeapNoproc(REF_THING_SIZE); - ret = do_driver_demonitor_process(prt,buf,monitor); - UnUseTmpHeapNoproc(REF_THING_SIZE); - } + ret = do_driver_demonitor_process(prt,monitor); DRV_MONITOR_UNLOCK_PDL(prt); return ret; } -static ErlDrvTermData do_driver_get_monitored_process(Port *prt, Eterm *buf, - const ErlDrvMonitor *monitor) +static ErlDrvTermData do_driver_get_monitored_process(Port *prt,const ErlDrvMonitor *monitor) { Eterm ref; ErtsMonitor *mon; Eterm to; + Eterm heap[ERTS_REF_THING_SIZE]; + Eterm *hp = &heap[0]; + + ref = erts_oiref_storage_make_ref((ErtsOIRefStorage *) monitor, &hp), - memcpy(buf,monitor,sizeof(Eterm)*REF_THING_SIZE); - ref = make_internal_ref(buf); mon = erts_lookup_monitor(ERTS_P_MONITORS(prt), ref); if (mon == NULL) { return driver_term_nil; @@ -7797,12 +7762,7 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport, /* Now we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock)); - { - DeclareTmpHeapNoproc(buf,REF_THING_SIZE); - UseTmpHeapNoproc(REF_THING_SIZE); - ret = do_driver_get_monitored_process(prt,buf,monitor); - UnUseTmpHeapNoproc(REF_THING_SIZE); - } + ret = do_driver_get_monitored_process(prt,monitor); DRV_MONITOR_UNLOCK_PDL(prt); return ret; } @@ -7811,7 +7771,8 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport, int driver_compare_monitors(const ErlDrvMonitor *monitor1, const ErlDrvMonitor *monitor2) { - return memcmp(monitor1,monitor2,sizeof(ErlDrvMonitor)); + return erts_oiref_storage_cmp((ErtsOIRefStorage *) monitor1, + (ErtsOIRefStorage *) monitor2); } void erts_fire_port_monitor(Port *prt, Eterm ref) diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index a11fb16b39..c6ea8049c3 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -889,10 +889,13 @@ void sys_alloc_stat(SysAllocStat *); #define ERTS_REFC_DEBUG #endif -typedef erts_smp_atomic_t erts_refc_t; +typedef erts_atomic_t erts_refc_t; ERTS_GLB_INLINE void erts_refc_init(erts_refc_t *refcp, erts_aint_t val); ERTS_GLB_INLINE void erts_refc_inc(erts_refc_t *refcp, erts_aint_t min_val); +ERTS_GLB_INLINE erts_aint_t erts_refc_inc_unless(erts_refc_t *refcp, + erts_aint_t unless_val, + erts_aint_t min_val); ERTS_GLB_INLINE erts_aint_t erts_refc_inctest(erts_refc_t *refcp, erts_aint_t min_val); ERTS_GLB_INLINE void erts_refc_dec(erts_refc_t *refcp, erts_aint_t min_val); @@ -908,27 +911,51 @@ ERTS_GLB_INLINE erts_aint_t erts_refc_read(erts_refc_t *refcp, ERTS_GLB_INLINE void erts_refc_init(erts_refc_t *refcp, erts_aint_t val) { - erts_smp_atomic_init_nob((erts_smp_atomic_t *) refcp, val); + erts_atomic_init_nob((erts_atomic_t *) refcp, val); } ERTS_GLB_INLINE void erts_refc_inc(erts_refc_t *refcp, erts_aint_t min_val) { #ifdef ERTS_REFC_DEBUG - erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp); + erts_aint_t val = erts_atomic_inc_read_nob((erts_atomic_t *) refcp); if (val < min_val) erts_exit(ERTS_ABORT_EXIT, "erts_refc_inc(): Bad refc found (refc=%ld < %ld)!\n", val, min_val); #else - erts_smp_atomic_inc_nob((erts_smp_atomic_t *) refcp); + erts_atomic_inc_nob((erts_atomic_t *) refcp); #endif } ERTS_GLB_INLINE erts_aint_t +erts_refc_inc_unless(erts_refc_t *refcp, + erts_aint_t unless_val, + erts_aint_t min_val) +{ + erts_aint_t val = erts_atomic_read_nob((erts_atomic_t *) refcp); + while (1) { + erts_aint_t exp, new; +#ifdef ERTS_REFC_DEBUG + if (val < 0) + erts_exit(ERTS_ABORT_EXIT, + "erts_refc_inc_unless(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#endif + if (val == unless_val) + return val; + new = val + 1; + exp = val; + val = erts_atomic_cmpxchg_nob((erts_atomic_t *) refcp, new, exp); + if (val == exp) + return new; + } +} + +ERTS_GLB_INLINE erts_aint_t erts_refc_inctest(erts_refc_t *refcp, erts_aint_t min_val) { - erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp); + erts_aint_t val = erts_atomic_inc_read_nob((erts_atomic_t *) refcp); #ifdef ERTS_REFC_DEBUG if (val < min_val) erts_exit(ERTS_ABORT_EXIT, @@ -942,20 +969,20 @@ ERTS_GLB_INLINE void erts_refc_dec(erts_refc_t *refcp, erts_aint_t min_val) { #ifdef ERTS_REFC_DEBUG - erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp); + erts_aint_t val = erts_atomic_dec_read_nob((erts_atomic_t *) refcp); if (val < min_val) erts_exit(ERTS_ABORT_EXIT, "erts_refc_dec(): Bad refc found (refc=%ld < %ld)!\n", val, min_val); #else - erts_smp_atomic_dec_nob((erts_smp_atomic_t *) refcp); + erts_atomic_dec_nob((erts_atomic_t *) refcp); #endif } ERTS_GLB_INLINE erts_aint_t erts_refc_dectest(erts_refc_t *refcp, erts_aint_t min_val) { - erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp); + erts_aint_t val = erts_atomic_dec_read_nob((erts_atomic_t *) refcp); #ifdef ERTS_REFC_DEBUG if (val < min_val) erts_exit(ERTS_ABORT_EXIT, @@ -969,20 +996,20 @@ ERTS_GLB_INLINE void erts_refc_add(erts_refc_t *refcp, erts_aint_t diff, erts_aint_t min_val) { #ifdef ERTS_REFC_DEBUG - erts_aint_t val = erts_smp_atomic_add_read_nob((erts_smp_atomic_t *) refcp, diff); + erts_aint_t val = erts_atomic_add_read_nob((erts_atomic_t *) refcp, diff); if (val < min_val) erts_exit(ERTS_ABORT_EXIT, "erts_refc_add(%ld): Bad refc found (refc=%ld < %ld)!\n", diff, val, min_val); #else - erts_smp_atomic_add_nob((erts_smp_atomic_t *) refcp, diff); + erts_atomic_add_nob((erts_atomic_t *) refcp, diff); #endif } ERTS_GLB_INLINE erts_aint_t erts_refc_read(erts_refc_t *refcp, erts_aint_t min_val) { - erts_aint_t val = erts_smp_atomic_read_nob((erts_smp_atomic_t *) refcp); + erts_aint_t val = erts_atomic_read_nob((erts_atomic_t *) refcp); #ifdef ERTS_REFC_DEBUG if (val < min_val) erts_exit(ERTS_ABORT_EXIT, @@ -994,6 +1021,140 @@ erts_refc_read(erts_refc_t *refcp, erts_aint_t min_val) #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ +typedef erts_smp_atomic_t erts_smp_refc_t; + +ERTS_GLB_INLINE void erts_smp_refc_init(erts_smp_refc_t *refcp, erts_aint_t val); +ERTS_GLB_INLINE void erts_smp_refc_inc(erts_smp_refc_t *refcp, erts_aint_t min_val); +ERTS_GLB_INLINE erts_aint_t erts_smp_refc_inc_unless(erts_smp_refc_t *refcp, + erts_aint_t unless_val, + erts_aint_t min_val); +ERTS_GLB_INLINE erts_aint_t erts_smp_refc_inctest(erts_smp_refc_t *refcp, + erts_aint_t min_val); +ERTS_GLB_INLINE void erts_smp_refc_dec(erts_smp_refc_t *refcp, erts_aint_t min_val); +ERTS_GLB_INLINE erts_aint_t erts_smp_refc_dectest(erts_smp_refc_t *refcp, + erts_aint_t min_val); +ERTS_GLB_INLINE void erts_smp_refc_add(erts_smp_refc_t *refcp, erts_aint_t diff, + erts_aint_t min_val); +ERTS_GLB_INLINE erts_aint_t erts_smp_refc_read(erts_smp_refc_t *refcp, + erts_aint_t min_val); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_smp_refc_init(erts_smp_refc_t *refcp, erts_aint_t val) +{ + erts_smp_atomic_init_nob((erts_smp_atomic_t *) refcp, val); +} + +ERTS_GLB_INLINE void +erts_smp_refc_inc(erts_smp_refc_t *refcp, erts_aint_t min_val) +{ +#ifdef ERTS_REFC_DEBUG + erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp); + if (val < min_val) + erts_exit(ERTS_ABORT_EXIT, + "erts_smp_refc_inc(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#else + erts_smp_atomic_inc_nob((erts_smp_atomic_t *) refcp); +#endif +} + +ERTS_GLB_INLINE erts_aint_t +erts_smp_refc_inc_unless(erts_smp_refc_t *refcp, + erts_aint_t unless_val, + erts_aint_t min_val) +{ + erts_aint_t val = erts_smp_atomic_read_nob((erts_smp_atomic_t *) refcp); + while (1) { + erts_aint_t exp, new; +#ifdef ERTS_REFC_DEBUG + if (val < 0) + erts_exit(ERTS_ABORT_EXIT, + "erts_smp_refc_inc_unless(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#endif + if (val == unless_val) + return val; + new = val + 1; + exp = val; + val = erts_smp_atomic_cmpxchg_nob((erts_smp_atomic_t *) refcp, new, exp); + if (val == exp) + return new; + } +} + + +ERTS_GLB_INLINE erts_aint_t +erts_smp_refc_inctest(erts_smp_refc_t *refcp, erts_aint_t min_val) +{ + erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp); +#ifdef ERTS_REFC_DEBUG + if (val < min_val) + erts_exit(ERTS_ABORT_EXIT, + "erts_smp_refc_inctest(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#endif + return val; +} + +ERTS_GLB_INLINE void +erts_smp_refc_dec(erts_smp_refc_t *refcp, erts_aint_t min_val) +{ +#ifdef ERTS_REFC_DEBUG + erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp); + if (val < min_val) + erts_exit(ERTS_ABORT_EXIT, + "erts_smp_refc_dec(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#else + erts_smp_atomic_dec_nob((erts_smp_atomic_t *) refcp); +#endif +} + +ERTS_GLB_INLINE erts_aint_t +erts_smp_refc_dectest(erts_smp_refc_t *refcp, erts_aint_t min_val) +{ + erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp); +#ifdef ERTS_REFC_DEBUG + if (val < min_val) + erts_exit(ERTS_ABORT_EXIT, + "erts_smp_refc_dectest(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#endif + return val; +} + +ERTS_GLB_INLINE void +erts_smp_refc_add(erts_smp_refc_t *refcp, erts_aint_t diff, erts_aint_t min_val) +{ +#ifdef ERTS_REFC_DEBUG + erts_aint_t val = erts_smp_atomic_add_read_nob((erts_smp_atomic_t *) refcp, diff); + if (val < min_val) + erts_exit(ERTS_ABORT_EXIT, + "erts_smp_refc_add(%ld): Bad refc found (refc=%ld < %ld)!\n", + diff, val, min_val); +#else + erts_smp_atomic_add_nob((erts_smp_atomic_t *) refcp, diff); +#endif +} + +ERTS_GLB_INLINE erts_aint_t +erts_smp_refc_read(erts_smp_refc_t *refcp, erts_aint_t min_val) +{ + erts_aint_t val = erts_smp_atomic_read_nob((erts_smp_atomic_t *) refcp); +#ifdef ERTS_REFC_DEBUG + if (val < min_val) + erts_exit(ERTS_ABORT_EXIT, + "erts_smp_refc_read(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#endif + return val; +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + + #ifdef ERTS_ENABLE_KERNEL_POLL extern int erts_use_kernel_poll; #endif diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 323f61c9f3..092a5320ba 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -1838,7 +1838,7 @@ make_internal_hash(Eterm term) break; case REF_SUBTAG: UINT32_HASH(internal_ref_numbers(term)[0], HCONST_7); - ASSERT(internal_ref_no_of_numbers(term) == 3); + ASSERT(internal_ref_no_numbers(term) == 3); UINT32_HASH_2(internal_ref_numbers(term)[1], internal_ref_numbers(term)[2], HCONST_8); goto pop_next; @@ -1847,7 +1847,7 @@ make_internal_hash(Eterm term) { ExternalThing* thing = external_thing_ptr(term); - ASSERT(external_thing_ref_no_of_numbers(thing) == 3); + ASSERT(external_thing_ref_no_numbers(thing) == 3); /* See limitation #2 */ #ifdef ARCH_64 POINTER_HASH(thing->node, HCONST_7); @@ -2486,22 +2486,20 @@ tailrecur_ne: anum = external_thing_ref_numbers(athing); bnum = external_thing_ref_numbers(bthing); - alen = external_thing_ref_no_of_numbers(athing); - blen = external_thing_ref_no_of_numbers(bthing); + alen = external_thing_ref_no_numbers(athing); + blen = external_thing_ref_no_numbers(bthing); goto ref_common; + case REF_SUBTAG: - if (!is_internal_ref(b)) - goto not_equal; - { - RefThing* athing = ref_thing_ptr(a); - RefThing* bthing = ref_thing_ptr(b); - alen = internal_thing_ref_no_of_numbers(athing); - blen = internal_thing_ref_no_of_numbers(bthing); - anum = internal_thing_ref_numbers(athing); - bnum = internal_thing_ref_numbers(bthing); - } + if (!is_internal_ref(b)) + goto not_equal; + + alen = internal_ref_no_numbers(a); + anum = internal_ref_numbers(a); + blen = internal_ref_no_numbers(b); + bnum = internal_ref_numbers(b); ref_common: ASSERT(alen > 0 && blen > 0); @@ -3133,25 +3131,21 @@ tailrecur_ne: */ if (is_internal_ref(b)) { - RefThing* bthing = ref_thing_ptr(b); bnode = erts_this_node; - bnum = internal_thing_ref_numbers(bthing); - blen = internal_thing_ref_no_of_numbers(bthing); + blen = internal_ref_no_numbers(b); + bnum = internal_ref_numbers(b); } else if(is_external_ref(b)) { ExternalThing* bthing = external_thing_ptr(b); bnode = bthing->node; bnum = external_thing_ref_numbers(bthing); - blen = external_thing_ref_no_of_numbers(bthing); + blen = external_thing_ref_no_numbers(bthing); } else { a_tag = REF_DEF; goto mixed_types; } - { - RefThing* athing = ref_thing_ptr(a); - anode = erts_this_node; - anum = internal_thing_ref_numbers(athing); - alen = internal_thing_ref_no_of_numbers(athing); - } + anode = erts_this_node; + alen = internal_ref_no_numbers(a); + anum = internal_ref_numbers(a); ref_common: CMP_NODES(anode, bnode); @@ -3181,15 +3175,14 @@ tailrecur_ne: goto pop_next; case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): if (is_internal_ref(b)) { - RefThing* bthing = ref_thing_ptr(b); bnode = erts_this_node; - bnum = internal_thing_ref_numbers(bthing); - blen = internal_thing_ref_no_of_numbers(bthing); + blen = internal_ref_no_numbers(b); + bnum = internal_ref_numbers(b); } else if (is_external_ref(b)) { ExternalThing* bthing = external_thing_ptr(b); bnode = bthing->node; bnum = external_thing_ref_numbers(bthing); - blen = external_thing_ref_no_of_numbers(bthing); + blen = external_thing_ref_no_numbers(bthing); } else { a_tag = EXTERNAL_REF_DEF; goto mixed_types; @@ -3198,7 +3191,7 @@ tailrecur_ne: ExternalThing* athing = external_thing_ptr(a); anode = athing->node; anum = external_thing_ref_numbers(athing); - alen = external_thing_ref_no_of_numbers(athing); + alen = external_thing_ref_no_numbers(athing); } goto ref_common; default: @@ -3575,40 +3568,41 @@ not_equal: Eterm store_external_or_ref_(Uint **hpp, ErlOffHeap* oh, Eterm ns) { + struct erl_off_heap_header *ohhp; Uint i; Uint size; - Uint *from_hp; - Uint *to_hp = *hpp; + Eterm *from_hp; + Eterm *to_hp = *hpp; ASSERT(is_external(ns) || is_internal_ref(ns)); - if(is_external(ns)) { - from_hp = external_val(ns); - size = thing_arityval(*from_hp) + 1; - *hpp += size; - - for(i = 0; i < size; i++) - to_hp[i] = from_hp[i]; - - erts_refc_inc(&((ExternalThing *) to_hp)->node->refc, 2); - - ((struct erl_off_heap_header*) to_hp)->next = oh->first; - oh->first = (struct erl_off_heap_header*) to_hp; - - return make_external(to_hp); - } - - /* Internal ref */ - from_hp = internal_ref_val(ns); - + from_hp = boxed_val(ns); size = thing_arityval(*from_hp) + 1; - *hpp += size; for(i = 0; i < size; i++) to_hp[i] = from_hp[i]; - return make_internal_ref(to_hp); + if (is_external_header(*from_hp)) { + ExternalThing *etp = (ExternalThing *) from_hp; + ASSERT(is_external(ns)); + erts_smp_refc_inc(&etp->node->refc, 2); + } + else if (is_ordinary_ref_thing(from_hp)) + return make_internal_ref(to_hp); + else { + ErtsMRefThing *mreft = (ErtsMRefThing *) from_hp; + ErtsMagicBinary *mb = mreft->mb; + ASSERT(is_magic_ref_thing(from_hp)); + erts_refc_inc(&mb->refc, 2); + OH_OVERHEAD(oh, mb->orig_size / sizeof(Eterm)); + } + + ohhp = (struct erl_off_heap_header*) to_hp; + ohhp->next = oh->first; + oh->first = ohhp; + + return make_boxed(to_hp); } Eterm diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index bfe0807df8..3ff68a8859 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2016. All Rights Reserved. + * Copyright Ericsson AB 1997-2017. 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. @@ -79,11 +79,10 @@ * Macros for testing file types. */ -#define ISDIR(st) (((st).st_mode & S_IFMT) == S_IFDIR) -#define ISREG(st) (((st).st_mode & S_IFMT) == S_IFREG) -#define ISDEV(st) \ - (((st).st_mode&S_IFMT) == S_IFCHR || ((st).st_mode&S_IFMT) == S_IFBLK) -#define ISLNK(st) (((st).st_mode & S_IFLNK) == S_IFLNK) +#define ISDIR(st) (S_ISDIR((st).st_mode)) +#define ISREG(st) (S_ISREG((st).st_mode)) +#define ISDEV(st) (S_ISCHR((st).st_mode) || S_ISBLK((st).st_mode)) +#define ISLNK(st) (S_ISLNK((st).st_mode)) #ifdef NO_UMASK #define FILE_MODE 0644 #define DIR_MODE 0755 @@ -366,33 +365,6 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ int fd; int mode; /* Open mode. */ - if (stat(name, &statbuf) < 0) { - /* statbuf is undefined: if the caller depends on it, - i.e. invoke_read_file(), fail the call immediately */ - if (pSize && flags == EFILE_MODE_READ) - return check_error(-1, errInfo); - } else if (!ISREG(statbuf)) { - /* - * For UNIX only, here is some ugly code to allow - * /dev/null to be opened as a file. - * - * Assumption: The i-node number for /dev/null cannot be zero. - */ - static ino_t dev_null_ino = 0; - - if (dev_null_ino == 0) { - struct stat nullstatbuf; - - if (stat("/dev/null", &nullstatbuf) >= 0) { - dev_null_ino = nullstatbuf.st_ino; - } - } - if (!(dev_null_ino && statbuf.st_ino == dev_null_ino)) { - errno = EISDIR; - return check_error(-1, errInfo); - } - } - switch (flags & (EFILE_MODE_READ|EFILE_MODE_WRITE)) { case EFILE_MODE_READ: mode = O_RDONLY; @@ -411,16 +383,13 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ return check_error(-1, errInfo); } - if (flags & EFILE_MODE_APPEND) { mode &= ~O_TRUNC; mode |= O_APPEND; } - if (flags & EFILE_MODE_EXCL) { mode |= O_EXCL; } - if (flags & EFILE_MODE_SYNC) { #ifdef O_SYNC mode |= O_SYNC; @@ -430,15 +399,49 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ #endif } - fd = open(name, mode, FILE_MODE); +#ifdef HAVE_FSTAT + while (((fd = open(name, mode, FILE_MODE)) < 0) && (errno == EINTR)); + if (!check_error(fd, errInfo)) return 0; +#endif + + if ( +#ifdef HAVE_FSTAT + fstat(fd, &statbuf) < 0 +#else + stat(name, &statbuf) < 0 +#endif + ) { + /* statbuf is undefined: if the caller depends on it, + i.e. invoke_read_file(), fail the call immediately */ + if (pSize && flags == EFILE_MODE_READ) { + check_error(-1, errInfo); +#ifdef HAVE_FSTAT + efile_closefile(fd); +#endif + return 0; + } + } + else if (! ISREG(statbuf)) { + struct stat nullstatbuf; + /* + * For UNIX only, here is some ugly code to allow + * /dev/null to be opened as a file. + */ + if ( (stat("/dev/null", &nullstatbuf) < 0) + || (statbuf.st_ino != nullstatbuf.st_ino) + || (statbuf.st_dev != nullstatbuf.st_dev) ) { + errno = EISDIR; + return check_error(-1, errInfo); + } + } - if (!check_error(fd, errInfo)) - return 0; +#ifndef HAVE_FSTAT + while (((fd = open(name, mode, FILE_MODE)) < 0) && (errno == EINTR)); + if (!check_error(fd, errInfo)) return 0; +#endif *pfd = fd; - if (pSize) { - *pSize = statbuf.st_size; - } + if (pSize) *pSize = statbuf.st_size; return 1; } @@ -460,7 +463,7 @@ efile_may_openfile(Efile_error* errInfo, char *name) { void efile_closefile(int fd) { - close(fd); + while((close(fd) < 0) && (errno == EINTR)); } int diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index 9c6ac4bd9c..688c82ab7a 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -381,12 +381,9 @@ BIF_RETTYPE hipe_bifs_ref_set_2(BIF_ALIST_2) static HipeLoaderState *get_loader_state(Eterm term) { - ProcBin *pb; + if (!is_internal_magic_ref(term)) return NULL; - if (!ERTS_TERM_IS_MAGIC_BINARY(term)) return NULL; - - pb = (ProcBin*) binary_val(term); - return hipe_get_loader_state(pb->val); + return hipe_get_loader_state(erts_magic_ref2bin(term)); } @@ -1008,7 +1005,7 @@ BIF_RETTYPE hipe_bifs_set_native_address_in_fe_2(BIF_ALIST_2) BIF_ERROR(BIF_P, BADARG); fe->native_address = native_address; - if (erts_refc_dectest(&fe->refc, 0) == 0) + if (erts_smp_refc_dectest(&fe->refc, 0) == 0) erts_erase_fun_entry(fe); BIF_RET(am_true); } @@ -1982,8 +1979,8 @@ BIF_RETTYPE hipe_bifs_alloc_loader_state_1(BIF_ALIST_1) if (!magic) BIF_ERROR(BIF_P, BADARG); - hp = HAlloc(BIF_P, PROC_BIN_SIZE); - res = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), magic); + hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE); + res = erts_mk_magic_ref(&hp, &MSO(BIF_P), magic); erts_refc_dec(&magic->refc, 1); BIF_RET(res); } diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 9a9252e8b8..e581f07f56 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -323,7 +323,7 @@ char *hipe_bs_allocate(int len) Binary *bptr; bptr = erts_bin_nrml_alloc(len); - erts_smp_atomic_init_nob(&bptr->refc, 1); + erts_refc_init(&bptr->refc, 1); return bptr->orig_bytes; } diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 36d512e388..8959be8690 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -748,7 +748,7 @@ resource_hugo_do(Type) -> HugoBin = <<"Hugo Hacker">>, HugoPtr = alloc_resource(Type, HugoBin), Hugo = make_resource(HugoPtr), - <<>> = Hugo, + true = is_reference(Hugo), release_resource(HugoPtr), erlang:garbage_collect(), {HugoPtr,HugoBin} = get_resource(Type,Hugo), @@ -782,7 +782,7 @@ resource_otto_do(Type) -> OttoBin = <<"Otto Ordonnans">>, OttoPtr = alloc_resource(Type, OttoBin), Otto = make_resource(OttoPtr), - <<>> = Otto, + true = is_reference(Otto), %% forget resource term but keep referenced by NIF {OttoPtr, OttoBin}. @@ -805,8 +805,9 @@ resource_new_do2(Type) -> BinB = <<"NewB">>, ResA = make_new_resource(Type, BinA), ResB = make_new_resource(Type, BinB), - <<>> = ResA, - <<>> = ResB, + true = is_reference(ResA), + true = is_reference(ResB), + ResA /= ResB, {PtrA,BinA} = get_resource(Type, ResA), {PtrB,BinB} = get_resource(Type, ResB), true = (PtrA =/= PtrB), diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 4decb7f418..7331c5b2cd 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1027,6 +1027,7 @@ struct make_term_info unsigned reuse_push; unsigned reuse_pull; ErlNifResourceType* resource_type; + void *resource; ERL_NIF_TERM other_term; ERL_NIF_TERM blob; ErlNifPid to_pid; @@ -1139,12 +1140,7 @@ static ERL_NIF_TERM make_term_list0(struct make_term_info* mti, int n) } static ERL_NIF_TERM make_term_resource(struct make_term_info* mti, int n) { - void* resource = enif_alloc_resource(mti->resource_type, 10); - ERL_NIF_TERM term; - fill(resource, 10, n); - term = enif_make_resource(mti->dst_env, resource); - enif_release_resource(resource); - return term; + return enif_make_resource(mti->dst_env, mti->resource); } static ERL_NIF_TERM make_term_new_binary(struct make_term_info* mti, int n) { @@ -1249,23 +1245,39 @@ static int make_term_n(struct make_term_info* mti, int n, ERL_NIF_TERM* res) return 0; } -static ERL_NIF_TERM make_blob(ErlNifEnv* caller_env, ErlNifEnv* dst_env, - ERL_NIF_TERM other_term) + +static void +init_make_blob(struct make_term_info *mti, + ErlNifEnv* caller_env, + ERL_NIF_TERM other_term) { PrivData* priv = (PrivData*) enif_priv_data(caller_env); + mti->caller_env = caller_env; + mti->resource_type = priv->rt_arr[0].t; + mti->resource = enif_alloc_resource(mti->resource_type, 10); + fill(mti->resource, 10, 17); + mti->other_term = other_term; +} + +static void +fini_make_blob(struct make_term_info *mti) +{ + enif_release_resource(mti->resource); +} + +static ERL_NIF_TERM make_blob(struct make_term_info *mti, + ErlNifEnv* dst_env) +{ ERL_NIF_TERM term, list; int n = 0; - struct make_term_info mti; - mti.caller_env = caller_env; - mti.dst_env = dst_env; - mti.dst_env_valid = 1; - mti.reuse_push = 0; - mti.reuse_pull = 0; - mti.resource_type = priv->rt_arr[0].t; - mti.other_term = other_term; + + mti->reuse_push = 0; + mti->reuse_pull = 0; + mti->dst_env = dst_env; + mti->dst_env_valid = 1; list = enif_make_list(dst_env, 0); - while (make_term_n(&mti, n++, &term)) { + while (make_term_n(mti, n++, &term)) { list = enif_make_list_cell(dst_env, term, list); } return list; @@ -1277,13 +1289,16 @@ static ERL_NIF_TERM send_new_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM a ERL_NIF_TERM msg, copy; ErlNifEnv* msg_env; int res; + struct make_term_info mti; if (!enif_get_local_pid(env, argv[0], &to)) { return enif_make_badarg(env); } msg_env = enif_alloc_env(); - msg = make_blob(env,msg_env, argv[1]); - copy = make_blob(env,env, argv[1]); + init_make_blob(&mti, env, argv[1]); + msg = make_blob(&mti,msg_env); + copy = make_blob(&mti,env); + fini_make_blob(&mti); res = enif_send(env, &to, msg_env, msg); enif_free_env(msg_env); return enif_make_tuple3(env, atom_ok, enif_make_int(env,res), copy); @@ -1303,6 +1318,8 @@ static ERL_NIF_TERM alloc_msgenv(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar mti->reuse_push = 0; mti->reuse_pull = 0; mti->resource_type = priv->rt_arr[0].t; + mti->resource = enif_alloc_resource(mti->resource_type, 10); + fill(mti->resource, 10, 17); mti->other_term = enif_make_list(mti->dst_env, 0); mti->blob = enif_make_list(mti->dst_env, 0); mti->mtx = enif_mutex_create("nif_SUITE:mtx"); @@ -1320,6 +1337,7 @@ static void msgenv_dtor(ErlNifEnv* env, void* obj) if (mti->dst_env != NULL) { enif_free_env(mti->dst_env); } + enif_release_resource(mti->resource); enif_mutex_destroy(mti->mtx); enif_cond_destroy(mti->cond); } diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index af18545bff..7356f31b75 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -50,7 +50,8 @@ port_wrap/1, bad_nc/1, unique_pid/1, - iter_max_procs/1]). + iter_max_procs/1, + magic_ref/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -62,7 +63,7 @@ all() -> node_table_gc, dist_link_refc, dist_monitor_refc, node_controller_refc, ets_refc, match_spec_refc, timer_refc, otp_4715, pid_wrap, port_wrap, bad_nc, - unique_pid, iter_max_procs]. + unique_pid, iter_max_procs, magic_ref]. init_per_suite(Config) -> Config. @@ -889,10 +890,46 @@ chk_max_proc_line_until(NoMoreTests, Res) -> chk_max_proc_line_until(NoMoreTests, Res) end. +magic_ref(Config) when is_list(Config) -> + {MRef0, Addr0} = erts_debug:set_internal_state(make, magic_ref), + true = is_reference(MRef0), + {Addr0, 1, true} = erts_debug:get_internal_state({magic_ref,MRef0}), + MRef1 = binary_to_term(term_to_binary(MRef0)), + {Addr0, 2, true} = erts_debug:get_internal_state({magic_ref,MRef1}), + MRef0 = MRef1, + Me = self(), + {Pid, Mon} = spawn_opt(fun () -> + receive + {Me, MRef} -> + Me ! {self(), erts_debug:get_internal_state({magic_ref,MRef})} + end + end, + [link, monitor]), + Pid ! {self(), MRef0}, + receive + {Pid, Info} -> + {Addr0, 3, true} = Info + end, + receive + {'DOWN', Mon, process, Pid, _} -> + ok + end, + {Addr0, 2, true} = erts_debug:get_internal_state({magic_ref,MRef0}), + id(MRef0), + id(MRef1), + MRefExt = term_to_binary(erts_debug:set_internal_state(make, magic_ref)), + garbage_collect(), + {MRef2, _Addr2} = binary_to_term(MRefExt), + true = is_reference(MRef2), + true = erts_debug:get_internal_state({magic_ref,MRef2}), + ok. %% %% -- Internal utils --------------------------------------------------------- %% +id(X) -> + X. + -define(ND_REFS, erts_debug:get_internal_state(node_and_dist_references)). node_container_refc_check(Node) when is_atom(Node) -> diff --git a/erts/etc/common/escript.c b/erts/etc/common/escript.c index 71c278881c..4134a3ff36 100644 --- a/erts/etc/common/escript.c +++ b/erts/etc/common/escript.c @@ -428,14 +428,6 @@ main(int argc, char** argv) argv[argc] = NULL; #endif - emulator = env = get_env("ESCRIPT_EMULATOR"); - if (emulator == NULL) { - emulator = get_default_emulator(argv[0]); - } - - if (strlen(emulator) >= PMAX) - error("Value of environment variable ESCRIPT_EMULATOR is too large"); - /* * Allocate the argv vector to be used for arguments to Erlang. * Arrange for starting to pushing information in the middle of @@ -446,21 +438,10 @@ main(int argc, char** argv) eargv_base = (char **) emalloc(eargv_size*sizeof(char*)); eargv = eargv_base; eargc = 0; - push_words(emulator); eargc_base = eargc; eargv = eargv + eargv_size/2; eargc = 0; - free_env_val(env); - - /* - * Push initial arguments. - */ - - PUSH("+B"); - PUSH2("-boot", "start_clean"); - PUSH("-noshell"); - /* Determine basename of the executable */ for (basename = argv[0]+strlen(argv[0]); basename > argv[0] && !(IS_DIRSEP(basename[-1])); @@ -510,6 +491,27 @@ main(int argc, char** argv) efree(absname); } + /* Determine path to emulator */ + emulator = env = get_env("ESCRIPT_EMULATOR"); + + if (emulator == NULL) { + emulator = get_default_emulator(scriptname); + } + + if (strlen(emulator) >= PMAX) + error("Value of environment variable ESCRIPT_EMULATOR is too large"); + + /* + * Push initial arguments. + */ + + push_words(emulator); + free_env_val(env); + + PUSH("+B"); + PUSH2("-boot", "start_clean"); + PUSH("-noshell"); + /* * Read options from the %%! row in the script and add them as args */ diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index c7e2ac169d..2bf04a6518 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -775,7 +775,7 @@ define etp-pid-1 set $etp_pid_1 = (Eterm)($arg0) if ($etp_pid_1 & 0xF) == 0x3 if (etp_arch_bits == 64) - if (etp_big_endian) + if (etp_endianness > 0) set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 35) & 0x0fffffff) else set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 4) & 0x0fffffff) @@ -835,7 +835,7 @@ define etp-port-1 set $etp_port_1 = (Eterm)($arg0) if ($etp_port_1 & 0xF) == 0x7 if (etp_arch_bits == 64) - if (etp_big_endian) + if (etp_endianness > 0) set $etp_port_data = (unsigned) ((((Uint64) $etp_port_1) >> 36) & 0x0fffffff) else set $etp_port_data = (unsigned) ((((Uint64) $etp_port_1) >> 4) & 0x0fffffff) @@ -952,30 +952,31 @@ define etp-ref-1 if ((Eterm)($arg0) & 0x3) != 0x2 printf "#NotBoxed<%#x>", (Eterm)($arg0) else - set $etp_ref_1_p = (RefThing *)((Eterm)($arg0) & ~0x3) + set $etp_ref_1_p = (ErtsORefThing *)((Eterm)($arg0) & ~0x3) if ($etp_ref_1_p->header & 0x3b) != 0x10 printf "#NotRef<%#x>", $etp_ref_1_p->header else - set $etp_ref_1_nump = (Uint32 *) 0 - set $etp_ref_1_error = 0 - if ($etp_ref_1_p->header >> 6) == 0 - set $etp_ref_1_error = 1 + if $etp_ref_1_p->header != etp_ref_header && $etp_ref_1_p->header != etp_magic_ref_header + printf "#InternalRefError<%#x>", ($arg0) else - if $etp_arch64 - set $etp_ref_1_i = (int) $etp_ref_1_p->data.ui32[0] - if (($etp_ref_1_i + 1) > (2 * ($etp_ref_1_p->header >> 6))) - set $etp_ref_1_error = 1 - else - set $etp_ref_1_nump = &$etp_ref_1_p->data.ui32[1] + set $etp_magic_ref = 0 + set $etp_ref_1_i = 3 + set $etp_ref_1_error = 0 + set $etp_ref_1_nump = (Uint32 *) 0 + if etp_ref_header == etp_magic_ref_header + if $etp_ref_1_p->marker != 0xffffffff + set $etp_magic_ref = 1 end + else + if $etp_ref_1_p->header == etp_magic_ref_header + set $etp_magic_ref = 1 + end + end + if $etp_magic_ref == 0 + set $etp_ref_1_nump = $etp_ref_1_p->num else - set $etp_ref_1_i = (int) ($etp_ref_1_p->header >> 6) - set $etp_ref_1_nump = &$etp_ref_1_p->data.ui32[0] + set $etp_ref_1_nump = ((ErtsMRefThing *) $etp_ref_1_p)->mb->refn end - end - if $etp_ref_1_error - printf "#InternalRefError<%#x>", ($arg0) - else printf "#Ref<0" set $etp_ref_1_i-- while $etp_ref_1_i >= 0 @@ -1593,7 +1594,7 @@ define etp-term-dump-pid set $etp_pid_1 = (Eterm)($arg0) if ($etp_pid_1 & 0xF) == 0x3 if (etp_arch_bits == 64) - if (etp_big_endian) + if (etp_endianness > 0) set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 36) & 0x0fffffff) else set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 4) & 0x0fffffff) @@ -1638,7 +1639,7 @@ define etp-pid2pix-1 # Args: Eterm # if (etp_arch_bits == 64) - if (etp_big_endian) + if (etp_endianness > 0) set $etp_pix = (int) (((Uint64) $arg0) & 0x0fffffff) else set $etp_pix = (int) ((((Uint64) $arg0) >> 32) & 0x0fffffff) @@ -2271,7 +2272,7 @@ define etp-port-id2pix-1 # Args: Eterm # if (etp_arch_bits == 64) - if (etp_big_endian) + if (etp_endianness > 0) set $etp_pix = (int) (((Uint64) $arg0) & 0x0fffffff) elser set $etp_pix = (int) ((((Uint64) $arg0) >> 32) & 0x0fffffff) @@ -2906,10 +2907,14 @@ define etp-system-info printf "Compile date: %s\n", etp_compile_date printf "Arch: %s\n", etp_arch printf "Endianness: " - if (etp_big_endian) + if (etp_endianness > 0) printf "Big\n" else - printf "Little\n" + if (etp_endianness < 0) + printf "Little\n" + else + printf "Unknown\n" + end end printf "Word size: %d-bit\n", etp_arch_bits printf "HiPE support: " diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 0799546c60..7cdf2931a1 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex ffddf2d54d..8123d63a9e 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index be7ceb928b..ca181343e3 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -83,6 +83,10 @@ | 'micro_seconds' | 'nano_seconds'. +-opaque prepared_code() :: reference(). + +-export_type([prepared_code/0]). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Native code BIF stubs and their types %% (BIF's actually implemented in this module goes last in the file) @@ -791,9 +795,9 @@ external_size(_Term, _Options) -> erlang:nif_error(undefined). %% finish_loading/2 --spec erlang:finish_loading(PreparedCodeBinaries) -> ok | Error when - PreparedCodeBinaries :: [PreparedCodeBinary], - PreparedCodeBinary :: binary(), +-spec erlang:finish_loading(PreparedCodeList) -> ok | Error when + PreparedCodeList :: [PreparedCode], + PreparedCode :: prepared_code(), ModuleList :: [module()], Error :: {not_purged,ModuleList} | {on_load,ModuleList}. finish_loading(_List) -> @@ -1030,7 +1034,7 @@ halt(_Status, _Options) -> %% has_prepared_code_on_load/1 -spec erlang:has_prepared_code_on_load(PreparedCode) -> boolean() when - PreparedCode :: binary(). + PreparedCode :: prepared_code(). has_prepared_code_on_load(_PreparedCode) -> erlang:nif_error(undefined). @@ -1447,7 +1451,7 @@ timestamp() -> -spec erlang:prepare_loading(Module, Code) -> PreparedCode | {error, Reason} when Module :: module(), Code :: binary(), - PreparedCode :: binary(), + PreparedCode :: prepared_code(), Reason :: bad_file. prepare_loading(_Module, _Code) -> erlang:nif_error(undefined). @@ -2007,8 +2011,8 @@ load_module(Mod, Code) -> case erlang:prepare_loading(Mod, Code) of {error,_}=Error -> Error; - Bin when erlang:is_binary(Bin) -> - case erlang:finish_loading([Bin]) of + Prep when erlang:is_reference(Prep) -> + case erlang:finish_loading([Prep]) of ok -> {module,Mod}; {Error,[Mod]} -> diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index 551ca4ea40..86dc9a2957 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -932,15 +932,15 @@ load_rest([], _) -> prepare_loading_fun() -> fun(Mod, FullName, Beam) -> case erlang:prepare_loading(Mod, Beam) of - Prepared when is_binary(Prepared) -> + {error,_}=Error -> + Error; + Prepared -> case erlang:has_prepared_code_on_load(Prepared) of true -> {ok,{on_load,Beam,FullName}}; false -> {ok,{prepared,Prepared,FullName}} - end; - {error,_}=Error -> - Error + end end end. diff --git a/erts/test/system_smoke.spec b/erts/test/system_smoke.spec index 933d1ba22d..99092c1dab 100644 --- a/erts/test/system_smoke.spec +++ b/erts/test/system_smoke.spec @@ -1,3 +1,8 @@ {suites,"../system_test",[ethread_SUITE]}. -{cases,"../system_test",otp_SUITE,[undefined_functions]}. +{cases,"../system_test",otp_SUITE, + [undefined_functions, + deprecated_not_in_obsolete, + obsolete_but_not_deprecated, + call_to_size_1, + call_to_now_0]}. {skip_cases,"../system_test",ethread_SUITE,[max_threads],"Skip"}. diff --git a/erts/vsn.mk b/erts/vsn.mk index 028b114068..a0a991f5a9 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 8.2.1 +VSN = 8.2.2 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/asn1/doc/src/asn1_getting_started.xml b/lib/asn1/doc/src/asn1_getting_started.xml index d40b294c39..d2b73d63c3 100644 --- a/lib/asn1/doc/src/asn1_getting_started.xml +++ b/lib/asn1/doc/src/asn1_getting_started.xml @@ -187,6 +187,14 @@ erlc -o ../asnfiles -I ../asnfiles -I /usr/local/standards/asn1 Person.asn</pre> <item> <p>DER encoding rule. Only when using option <c>-ber</c>.</p> </item> + <tag><c>+maps</c></tag> + <item> + <p>Use maps instead of records to represent the <c>SEQUENCE</c> and + <c>SET</c> types. No <c>.hrl</c> files will be generated. + See the Section <seealso marker="asn1_getting_started#MAP_SEQ_SET"> + Map representation for SEQUENCE and SET</seealso> + for more information.</p> + </item> <tag><c>+asn1config</c></tag> <item> <p>This functionality works together with option @@ -766,8 +774,11 @@ Pdu ::= SEQUENCE { b REAL, c OBJECT IDENTIFIER, d NULL } </pre> - <p>This is a 4-component structure called <c>Pdu</c>. The record format - is the major format for representation of <c>SEQUENCE</c> in Erlang. + <p>This is a 4-component structure called <c>Pdu</c>. By default, + a <c>SEQUENCE</c> is represented by a record in Erlang. + It can also be represented as a map; see + <seealso marker="asn1_getting_started#MAP_SEQ_SET"> + Map representation for SEQUENCE and SET</seealso>. For each <c>SEQUENCE</c> and <c>SET</c> in an ASN.1 module an Erlang record declaration is generated. For <c>Pdu</c>, a record like the following is defined:</p> @@ -878,6 +889,48 @@ SExt ::= SEQUENCE { </section> <section> + <marker id="MAP_SEQ_SET"></marker> + <title>Map representation for SEQUENCE and SET</title> + <p>If the ASN.1 module has been compiled with option <c>maps</c>, + the types <c>SEQUENCE</c> and <c>SET</c> are represented as maps.</p> + <p>In the following example, this ASN.1 specification is used:</p> + <pre> +File DEFINITIONS AUTOMATIC TAGS ::= +BEGIN +Seq1 ::= SEQUENCE { + a INTEGER DEFAULT 42, + b BOOLEAN OPTIONAL, + c IA5String +} +END </pre> + + <p>Optional fields are to be omitted from the map if they have + no value:</p> + + <pre> +1> <input>asn1ct:compile('File', [per,maps]).</input> +ok +2> <input>{ok,E} = 'File':encode('Seq1', #{a=>0,c=>"string"}).</input> +{ok,<<128,1,0,6,115,116,114,105,110,103>>} </pre> + + <p>When decoding, optional fields will be omitted from the map:</p> + + <pre> +3> <input>'File':decode('Seq1', E).</input> +{ok,#{a => 0,c => "string"}} </pre> + + <p>Default values can be omitted from the map:</p> + <pre> +4> <input>{ok,E2} = 'File':encode('Seq1', #{c=>"string"}).</input> +{ok,<<0,6,115,116,114,105,110,103>>} +5> <input>'File':decode('Seq1', E2).</input> +{ok,#{a => 42,c => "string"}} </pre> + + <note><p>It is not allowed to use the atoms <c>asn1_VALUE</c> and + <c>asn1_DEFAULT</c> with maps.</p></note> + </section> + + <section> <marker id="CHOICE"></marker> <title>CHOICE</title> <p>The type <c>CHOICE</c> is a space saver and is similar to the @@ -1004,11 +1057,16 @@ T ::= CHOICE { <section> <title>Naming of Records in .hrl Files</title> + <p>When the option <c>maps</c> is given, no <c>.hrl</c> files + will be generated. The rest of this section describes the behavior + of the compiler when <c>maps</c> is not used.</p> + <p>When an ASN.1 specification is compiled, all defined types of type - <c>SET</c> or <c>SEQUENCE</c> result in a corresponding record in the - generated <c>.hrl</c> file. This is because the values for - <c>SET</c> and <c>SEQUENCE</c> are represented as records as - mentioned earlier.</p> + <c>SET</c> or <c>SEQUENCE</c> result in a corresponding record in the + generated <c>.hrl</c> file. This is because the values for + <c>SET</c> and <c>SEQUENCE</c> are represented as records + by default.</p> + <p>Some special cases of this functionality are presented in the next section.</p> @@ -1144,9 +1202,10 @@ SS ::= SET { <p>This example shows that a function is generated by the compiler that returns a valid Erlang representation of the value, although the value is of a complex type.</p> - <p>Furthermore, a macro is generated for each value in the <c>.hrl</c> - file. So, the defined value <c>tt</c> can also be extracted by - <c>?tt</c> in application code.</p> + <p>Furthermore, if the option <c>maps</c> is not used, + a macro is generated for each value in the <c>.hrl</c> + file. So, the defined value <c>tt</c> can also be extracted by + <c>?tt</c> in application code.</p> </section> <section> diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml index ebe1ce44dc..859d6a50bb 100644 --- a/lib/asn1/doc/src/asn1ct.xml +++ b/lib/asn1/doc/src/asn1ct.xml @@ -170,11 +170,24 @@ File3.asn</pre> as for <c>ber</c>. </p> </item> + <tag><c>maps</c></tag> + <item> + <p>This option changes the representation of the types + <c>SEQUENCE</c> and <c>SET</c> to use maps (instead of + records). This option also suppresses the generation of + <c>.hrl</c> files.</p> + <p>For details, see Section + <seealso marker="asn1_getting_started#MAP_SEQ_SET"> + Map representation for SEQUENCE and SET</seealso> + in the User's Guide. + </p> + </item> <tag><c>compact_bit_string</c></tag> <item> <p> The <c>BIT STRING</c> type is decoded to "compact notation". <em>This option is not recommended for new code.</em> + This option cannot be combined with the option <c>maps</c>. </p> <p>For details, see Section <seealso marker="asn1_getting_started#BIT STRING"> @@ -188,6 +201,7 @@ File3.asn</pre> The <c>BIT STRING</c> type is decoded to the legacy format, that is, a list of zeroes and ones. <em>This option is not recommended for new code.</em> + This option cannot be combined with the option <c>maps</c>. </p> <p>For details, see Section <seealso marker="asn1_getting_started#BIT STRING">BIT STRING</seealso> @@ -202,7 +216,8 @@ File3.asn</pre> marker="asn1_getting_started#BIT STRING">BIT STRING</seealso> and Section <seealso marker="asn1_getting_started#OCTET STRING">OCTET STRING</seealso> in the User's Guide.</p> - <p><em>This option is not recommended for new code.</em></p> + <p><em>This option is not recommended for new code.</em> + This option cannot be combined with the option <c>maps</c>.</p> </item> <tag><c>{n2n, EnumTypeName}</c></tag> <item> diff --git a/lib/asn1/src/asn1_db.erl b/lib/asn1/src/asn1_db.erl index 869ea310aa..a3e45ca915 100644 --- a/lib/asn1/src/asn1_db.erl +++ b/lib/asn1/src/asn1_db.erl @@ -20,7 +20,7 @@ %% -module(asn1_db). --export([dbstart/1,dbnew/2,dbload/1,dbload/3,dbsave/2,dbput/2, +-export([dbstart/1,dbnew/3,dbload/1,dbload/4,dbsave/2,dbput/2, dbput/3,dbget/2]). -export([dbstop/0]). @@ -37,13 +37,13 @@ dbstart(Includes0) -> put(?MODULE, spawn_link(fun() -> init(Parent, Includes) end)), ok. -dbload(Module, Erule, Mtime) -> - req({load, Module, Erule, Mtime}). +dbload(Module, Erule, Maps, Mtime) -> + req({load, Module, {Erule,Maps}, Mtime}). dbload(Module) -> req({load, Module, any, {{0,0,0},{0,0,0}}}). -dbnew(Module, Erule) -> req({new, Module, Erule}). +dbnew(Module, Erule, Maps) -> req({new, Module, {Erule,Maps}}). dbsave(OutFile, Module) -> cast({save, OutFile, Module}). dbput(Module, K, V) -> cast({set, Module, K, V}). dbput(Module, Kvs) -> cast({set, Module, Kvs}). @@ -110,19 +110,19 @@ loop(#state{parent = Parent, monitor = MRef, table = Table, ok = ets:tab2file(Mtab, TempFile), ok = file:rename(TempFile, OutFile), loop(State); - {From, {new, Mod, Erule}} -> + {From, {new, Mod, EruleMaps}} -> [] = ets:lookup(Table, Mod), %Assertion. ModTableId = ets:new(list_to_atom(lists:concat(["asn1_",Mod])), []), ets:insert(Table, {Mod, ModTableId}), - ets:insert(ModTableId, {?MAGIC_KEY, info(Erule)}), + ets:insert(ModTableId, {?MAGIC_KEY, info(EruleMaps)}), reply(From, ok), loop(State); - {From, {load, Mod, Erule, Mtime}} -> + {From, {load, Mod, EruleMaps, Mtime}} -> case ets:member(Table, Mod) of true -> reply(From, ok); false -> - case load_table(Mod, Erule, Mtime, Includes) of + case load_table(Mod, EruleMaps, Mtime, Includes) of {ok, ModTableId} -> ets:insert(Table, {Mod, ModTableId}), reply(From, ok); @@ -151,20 +151,20 @@ lookup(Tab, K) -> [{K,V}] -> V end. -info(Erule) -> - {asn1ct:vsn(),Erule}. +info(EruleMaps) -> + {asn1ct:vsn(),EruleMaps}. -load_table(Mod, Erule, Mtime, Includes) -> +load_table(Mod, EruleMaps, Mtime, Includes) -> Base = lists:concat([Mod, ".asn1db"]), case path_find(Includes, Mtime, Base) of error -> error; - {ok,ModTab} when Erule =:= any -> + {ok,ModTab} when EruleMaps =:= any -> {ok,ModTab}; {ok,ModTab} -> Vsn = asn1ct:vsn(), case ets:lookup(ModTab, ?MAGIC_KEY) of - [{_,{Vsn,Erule}}] -> + [{_,{Vsn,EruleMaps}}] -> %% Correct version and encoding rule. {ok,ModTab}; _ -> diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl index af10c1771c..d3d76f9566 100644 --- a/lib/asn1/src/asn1_records.hrl +++ b/lib/asn1/src/asn1_records.hrl @@ -28,6 +28,7 @@ -define('COMPLETE_ENCODE',1). -define('TLV_DECODE',2). +-define(MISSING_IN_MAP, asn1__MISSING_IN_MAP). -record(module,{pos,name,defid,tagdefault='EXPLICIT',exports={exports,[]},imports={imports,[]}, extensiondefault=empty,typeorval}). @@ -96,6 +97,17 @@ error_context %Top-level thingie (contains line numbers) }). +%% Code generation parameters and options. +-record(gen, + {erule=ber :: 'ber' | 'per', + der=false :: boolean(), + aligned=false :: boolean(), + rec_prefix="" :: string(), + macro_prefix="" :: string(), + pack=record :: 'record' | 'map', + options=[] :: [any()] + }). + %% state record used by back-end at partial decode %% active is set to 'yes' when a partial decode function is generated. %% prefix is set to 'dec-inc-' or 'dec-partial-' is for diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 4e030861f5..d27f8897af 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -193,7 +193,7 @@ check_pass(#st{code=M,file=File,includes=Includes, erule=Erule,dbfile=DbFile,opts=Opts, inputmodules=InputModules}=St) -> start(Includes), - case asn1ct_check:storeindb(#state{erule=Erule}, M) of + case asn1ct_check:storeindb(#state{erule=Erule,options=Opts}, M) of ok -> Module = asn1_db:dbget(M#module.name, 'MODULE'), State = #state{mname=Module#module.name, @@ -216,8 +216,8 @@ check_pass(#st{code=M,file=File,includes=Includes, {error,St#st{error=Reason}} end. -save_pass(#st{code=M,erule=Erule}=St) -> - ok = asn1ct_check:storeindb(#state{erule=Erule}, M), +save_pass(#st{code=M,erule=Erule,opts=Opts}=St) -> + ok = asn1ct_check:storeindb(#state{erule=Erule,options=Opts}, M), {ok,St}. parse_listing(#st{code=Code,outfile=OutFile0}=St) -> @@ -838,33 +838,53 @@ generate({M,GenTOrV}, OutFile, EncodingRule, Options) -> debug_on(Options), setup_bit_string_format(Options), setup_legacy_erlang_types(Options), - put(encoding_options,Options), asn1ct_table:new(check_functions), + Gen = init_gen_record(EncodingRule, Options), + + check_maps_option(Gen), + %% create decoding function names and taglists for partial decode - case (catch specialized_decode_prepare(EncodingRule,M,GenTOrV,Options)) of - {error, Reason} -> warning("Error in configuration file: ~n~p~n", - [Reason], Options, - "Error in configuration file"); - _ -> ok + try + specialized_decode_prepare(Gen, M) + catch + throw:{error, Reason} -> + warning("Error in configuration file: ~n~p~n", + [Reason], Options, + "Error in configuration file") end, - Result = - case (catch asn1ct_gen:pgen(OutFile,EncodingRule, - M#module.name,GenTOrV,Options)) of - {'EXIT',Reason2} -> - error("~p~n",[Reason2],Options), - {error,Reason2}; - _ -> - ok - end, + Res = case catch asn1ct_gen:pgen(OutFile, Gen, M#module.name, GenTOrV) of + {'EXIT',Reason2} -> + error("~p~n",[Reason2],Options), + {error,Reason2}; + _ -> + ok + end, debug_off(Options), - erase(encoding_options), cleanup_bit_string_format(), erase(tlv_format), % used in ber erase(class_default_type),% used in ber asn1ct_table:delete(check_functions), - Result. + Res. + +init_gen_record(EncodingRule, Options) -> + Erule = case EncodingRule of + uper -> per; + _ -> EncodingRule + end, + Der = proplists:get_bool(der, Options), + Aligned = EncodingRule =:= per, + RecPrefix = proplists:get_value(record_name_prefix, Options, ""), + MacroPrefix = proplists:get_value(macro_name_prefix, Options, ""), + Pack = case proplists:get_value(maps, Options, false) of + true -> map; + false -> record + end, + #gen{erule=Erule,der=Der,aligned=Aligned, + rec_prefix=RecPrefix,macro_prefix=MacroPrefix, + pack=Pack,options=Options}. + setup_legacy_erlang_types(Opts) -> F = case lists:member(legacy_erlang_types, Opts) of @@ -910,6 +930,26 @@ cleanup_bit_string_format() -> get_bit_string_format() -> get(bit_string_format). +check_maps_option(#gen{pack=map}) -> + case get_bit_string_format() of + bitstring -> + ok; + _ -> + Message1 = "The 'maps' option must not be combined with " + "'compact_bit_string' or 'legacy_bit_string'", + exit({error,{asn1,Message1}}) + end, + case use_legacy_types() of + false -> + ok; + true -> + Message2 = "The 'maps' option must not be combined with " + "'legacy_erlang_types'", + exit({error,{asn1,Message2}}) + end; +check_maps_option(#gen{}) -> + ok. + %% parse_and_save parses an asn1 spec and saves the unchecked parse %% tree in a data base file. @@ -919,22 +959,27 @@ parse_and_save(Module,S) -> SourceDir = S#state.sourcedir, Includes = [I || {i,I} <- Options], Erule = S#state.erule, + Maps = lists:member(maps, Options), case get_input_file(Module, [SourceDir|Includes]) of %% search for asn1 source {file,SuffixedASN1source} -> Mtime = filelib:last_modified(SuffixedASN1source), - case asn1_db:dbload(Module, Erule, Mtime) of + case asn1_db:dbload(Module, Erule, Maps, Mtime) of ok -> ok; error -> parse_and_save1(S, SuffixedASN1source, Options) end; - Err -> + Err when not Maps -> case asn1_db:dbload(Module) of ok -> + %% FIXME: This should be an error. warning("could not do a consistency check of the ~p file: no asn1 source file was found.~n", [lists:concat([Module,".asn1db"])],Options); error -> ok end, + {error,{asn1,input_file_error,Err}}; + Err -> + %% Always fail directly when the 'maps' option is used. {error,{asn1,input_file_error,Err}} end. @@ -997,9 +1042,8 @@ input_file_type(File) -> end end; ".asn1config" -> - case read_config_file(File,asn1_module) of + case read_config_file_info(File, asn1_module) of {ok,Asn1Module} -> -% put(asn1_config_file,File), input_file_type(Asn1Module); Error -> Error @@ -1092,16 +1136,27 @@ translate_options([H|T]) -> translate_options([]) -> []. remove_asn_flags(Options) -> - [X || X <- Options, - X /= get_rule(Options), - X /= optimize, - X /= compact_bit_string, - X /= legacy_bit_string, - X /= legacy_erlang_types, - X /= debug, - X /= asn1config, - X /= record_name_prefix]. - + [X || X <- Options, not is_asn1_flag(X)]. + +is_asn1_flag(asn1config) -> true; +is_asn1_flag(ber) -> true; +is_asn1_flag(compact_bit_string) -> true; +is_asn1_flag(debug) -> true; +is_asn1_flag(der) -> true; +is_asn1_flag(legacy_bit_string) -> true; +is_asn1_flag({macro_name_prefix,_}) -> true; +is_asn1_flag({n2n,_}) -> true; +is_asn1_flag(noobj) -> true; +is_asn1_flag(no_ok_wrapper) -> true; +is_asn1_flag(optimize) -> true; +is_asn1_flag(per) -> true; +is_asn1_flag({record_name_prefix,_}) -> true; +is_asn1_flag(undec_rec) -> true; +is_asn1_flag(uper) -> true; +is_asn1_flag(verbose) -> true; +%% 'warnings_as_errors' is intentionally passed through to the compiler. +is_asn1_flag(_) -> false. + debug_on(Options) -> case lists:member(debug,Options) of true -> @@ -1370,25 +1425,26 @@ prepare_bytes(Bytes) -> list_to_binary(Bytes). vsn() -> ?vsn. -specialized_decode_prepare(Erule,M,TsAndVs,Options) -> - case lists:member(asn1config,Options) of +specialized_decode_prepare(#gen{erule=ber,options=Options}=Gen, M) -> + case lists:member(asn1config, Options) of true -> - partial_decode_prepare(Erule,M,TsAndVs,Options); - _ -> + special_decode_prepare_1(Gen, M); + false -> ok - end. + end; +specialized_decode_prepare(_, _) -> + ok. + %% Reads the configuration file if it exists and stores information %% about partial decode and incomplete decode -partial_decode_prepare(ber,M,TsAndVs,Options) when is_tuple(TsAndVs) -> +special_decode_prepare_1(#gen{options=Options}=Gen, M) -> %% read configure file - - ModName = - case lists:keysearch(asn1config,1,Options) of - {value,{_,MName}} -> MName; - _ -> M#module.name - end, + ModName = case lists:keyfind(asn1config, 1, Options) of + {_,MName} -> MName; + false -> M#module.name + end, %% io:format("ModName: ~p~nM#module.name: ~p~n~n",[ModName,M#module.name]), - case read_config_file(ModName) of + case read_config_file(Gen, ModName) of no_config_file -> ok; CfgList -> @@ -1407,11 +1463,7 @@ partial_decode_prepare(ber,M,TsAndVs,Options) when is_tuple(TsAndVs) -> Part_inc_tlv_tags = tlv_tags(CommandList2), save_config(partial_incomplete_decode,Part_inc_tlv_tags), save_gen_state(exclusive_decode,ExclusiveDecode,Part_inc_tlv_tags) - end; -partial_decode_prepare(_,_,_,_) -> - ok. - - + end. %% create_partial_inc_decode_gen_info/2 %% @@ -1863,46 +1915,38 @@ tlv_tag1(<<0:1,PartialTag:7>>,Acc) -> tlv_tag1(<<1:1,PartialTag:7,Buffer/binary>>,Acc) -> tlv_tag1(Buffer,(Acc bsl 7) bor PartialTag). -%% reads the content from the configuration file and returns the -%% selected part choosen by InfoType. Assumes that the config file +%% Reads the content from the configuration file and returns the +%% selected part chosen by InfoType. Assumes that the config file %% content is an Erlang term. -read_config_file(ModuleName,InfoType) when is_atom(InfoType) -> - CfgList = read_config_file(ModuleName), - get_config_info(CfgList,InfoType). +read_config_file_info(ModuleName, InfoType) when is_atom(InfoType) -> + Name = ensure_ext(ModuleName, ".asn1config"), + CfgList = read_config_file0(Name, []), + get_config_info(CfgList, InfoType). +read_config_file(#gen{options=Options}, ModuleName) -> + Name = ensure_ext(ModuleName, ".asn1config"), + Includes = [I || {i,I} <- Options], + read_config_file0(Name, ["."|Includes]). -read_config_file(ModuleName) -> - case file:consult(lists:concat([ModuleName,'.asn1config'])) of +read_config_file0(Name, [D|Dirs]) -> + case file:consult(filename:join(D, Name)) of {ok,CfgList} -> CfgList; {error,enoent} -> - Options = get(encoding_options), - Includes = [I || {i,I} <- Options], - read_config_file1(ModuleName,Includes); + read_config_file0(Name, Dirs); {error,Reason} -> Error = "error reading asn1 config file: " ++ file:format_error(Reason), throw({error,Error}) - end. -read_config_file1(ModuleName,[]) -> - case filename:extension(ModuleName) of - ".asn1config" -> - no_config_file; - _ -> - read_config_file(lists:concat([ModuleName,".asn1config"])) end; -read_config_file1(ModuleName,[H|T]) -> -% File = filename:join([H,lists:concat([ModuleName,'.asn1config'])]), - File = filename:join([H,ModuleName]), - case file:consult(File) of - {ok,CfgList} -> - CfgList; - {error,enoent} -> - read_config_file1(ModuleName,T); - {error,Reason} -> - Error = "error reading asn1 config file: " ++ - file:format_error(Reason), - throw({error,Error}) +read_config_file0(_, []) -> + no_config_file. + +ensure_ext(ModuleName, Ext) -> + Name = filename:join([ModuleName]), + case filename:extension(Name) of + Ext -> Name; + _ -> Name ++ Ext end. get_config_info(CfgList,InfoType) -> @@ -2382,8 +2426,10 @@ format_error({write_error,File,Reason}) -> io_lib:format("writing output file ~s failed: ~s", [File,file:format_error(Reason)]). -is_error(S) when is_record(S, state) -> - is_error(S#state.options); +is_error(#state{options=Opts}) -> + is_error(Opts); +is_error(#gen{options=Opts}) -> + is_error(Opts); is_error(O) -> lists:member(errors, O) orelse is_verbose(O). @@ -2392,8 +2438,10 @@ is_warning(S) when is_record(S, state) -> is_warning(O) -> lists:member(warnings, O) orelse is_verbose(O). -is_verbose(S) when is_record(S, state) -> - is_verbose(S#state.options); +is_verbose(#state{options=Opts}) -> + is_verbose(Opts); +is_verbose(#gen{options=Opts}) -> + is_verbose(Opts); is_verbose(O) -> lists:member(verbose, O). diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index f2c895bfaa..321f4147f5 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2239,12 +2239,18 @@ normalized_record(SorS,S,Value,Components,NameList) -> case is_record_normalized(S,NewName,Value,length(Components)) of true -> Value; - _ -> + false -> NoComps = length(Components), ListOfVals = normalize_seq_or_set(SorS,S,Value,Components,NameList,[]), - NoComps = length(ListOfVals), %% Assert - list_to_tuple([NewName|ListOfVals]) + NoComps = length(ListOfVals), %Assertion. + case use_maps(S) of + false -> + list_to_tuple([NewName|ListOfVals]); + true -> + create_map_value(Components, ListOfVals) + end end. + is_record_normalized(S,Name,V = #'Externalvaluereference'{},NumComps) -> case get_referenced_type(S,V) of {_M,#valuedef{type=_T1,value=V2}} -> @@ -2253,9 +2259,20 @@ is_record_normalized(S,Name,V = #'Externalvaluereference'{},NumComps) -> end; is_record_normalized(_S,Name,Value,NumComps) when is_tuple(Value) -> (tuple_size(Value) =:= (NumComps + 1)) andalso (element(1, Value) =:= Name); +is_record_normalized(_S, _Name, Value, _NumComps) when is_map(Value) -> + true; is_record_normalized(_,_,_,_) -> false. +use_maps(#state{options=Opts}) -> + lists:member(maps, Opts). + +create_map_value(Components, ListOfVals) -> + Zipped = lists:zip(Components, ListOfVals), + L = [{Name,V} || {#'ComponentType'{name=Name},V} <- Zipped, + V =/= asn1_NOVALUE], + maps:from_list(L). + normalize_seq_or_set(SorS, S, [{#seqtag{val=Cname},V}|Vs], [#'ComponentType'{name=Cname,typespec=TS}|Cs], @@ -4192,7 +4209,7 @@ iof_associated_type1(S,C) -> %% fieldname=[{typefieldreference,'Type'}], fieldname={'Type',[]}, type=Typefield_type}, - IOFComponents = + IOFComponents0 = [#'ComponentType'{name='type-id', typespec=#type{tag=C1TypeTag, def=ObjectIdentifier, @@ -4209,6 +4226,7 @@ iof_associated_type1(S,C) -> tablecinf=Comp2tablecinf}, prop=mandatory, tags=[{'CONTEXT',0}]}], + IOFComponents = textual_order(IOFComponents0), #'SEQUENCE'{tablecinf=TableCInf, components=simplify_comps(IOFComponents)}. @@ -5673,7 +5691,8 @@ storeindb(S0, #module{name=ModName,typeorval=TVlist0}=M) -> storeindb_1(S, #module{name=ModName}=M, TVlist0, TVlist) -> NewM = M#module{typeorval=findtypes_and_values(TVlist0)}, - asn1_db:dbnew(ModName, S#state.erule), + Maps = lists:member(maps, S#state.options), + asn1_db:dbnew(ModName, S#state.erule, Maps), asn1_db:dbput(ModName, 'MODULE', NewM), asn1_db:dbput(ModName, TVlist), include_default_class(S, NewM#module.name), diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index 325bea5879..16af09bca9 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -32,7 +32,7 @@ -include("asn1_records.hrl"). --import(asn1ct_gen, [emit/1,demit/1,get_record_name_prefix/0]). +-import(asn1ct_gen, [emit/1,demit/1,get_record_name_prefix/1]). -define(ASN1CT_GEN_BER,asn1ct_gen_ber_bin_v2). @@ -57,7 +57,7 @@ %%=============================================================================== %%=============================================================================== -gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> +gen_encode_sequence(Gen, Typename, #type{}=D) -> asn1ct_name:start(), asn1ct_name:new(term), asn1ct_name:new(bytes), @@ -67,8 +67,12 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> ValName = case Typename of ['EXTERNAL'] -> + Tr = case Gen of + #gen{pack=record} -> transform_to_EXTERNAL1990; + #gen{pack=map} -> transform_to_EXTERNAL1990_maps + end, emit([indent(4),"NewVal = ", - {call,ext,transform_to_EXTERNAL1990,["Val"]}, + {call,ext,Tr,["Val"]}, com,nl]), "NewVal"; _ -> @@ -90,18 +94,9 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> {Rl,El} -> Rl ++ El; _ -> CompList end, - -%% don't match recordname for now, because of compatibility reasons -%% emit(["{'",asn1ct_gen:list2rname(Typename),"'"]), - emit(["{_"]), - case length(CompList1) of - 0 -> - true; - CompListLen -> - emit([","]), - mkcindexlist([Tc || Tc <- lists:seq(1,CompListLen)]) - end, - emit(["} = ",ValName,",",nl]), + + enc_match_input(Gen, ValName, CompList1), + EncObj = case TableConsInfo of #simpletableattributes{usedclassfield=Used, @@ -125,7 +120,7 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> emit([ObjectEncode," = ",nl, " ",{asis,ObjSetMod},":'getenc_",ObjSetName, "'("]), - ValueMatch = value_match(ValueIndex, + ValueMatch = value_match(Gen, ValueIndex, lists:concat(["Cindex",N])), emit([indent(35),ValueMatch,"),",nl]), {AttrN,ObjectEncode}; @@ -144,7 +139,7 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> end end, - gen_enc_sequence_call(Erules,Typename,CompList1,1,Ext,EncObj), + gen_enc_sequence_call(Gen, Typename, CompList1, 1, Ext, EncObj), emit([nl," BytesSoFar = "]), case SeqOrSet of @@ -168,7 +163,36 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> call(encode_tags, ["TagIn","BytesSoFar","LenSoFar"]), emit([".",nl]). -gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> +enc_match_input(#gen{pack=record}, ValName, CompList) -> + Len = length(CompList), + Vars = [lists:concat(["Cindex",N]) || N <- lists:seq(1, Len)], + RecordName = "_", + emit(["{",lists:join(",", [RecordName|Vars]),"} = ",ValName,com,nl]); +enc_match_input(#gen{pack=map}, ValName, CompList) -> + Len = length(CompList), + Vars = [lists:concat(["Cindex",N]) || N <- lists:seq(1, Len)], + Zipped = lists:zip(CompList, Vars), + M = [[{asis,Name},":=",Var] || + {#'ComponentType'{prop=mandatory,name=Name},Var} <- Zipped], + case M of + [] -> + ok; + [_|_] -> + emit(["#{",lists:join(",", M),"} = ",ValName,com,nl]) + end, + Os0 = [{Name,Var} || + {#'ComponentType'{prop=Prop,name=Name},Var} <- Zipped, + Prop =/= mandatory], + F = fun({Name,Var}) -> + [Var," = case ",ValName," of\n" + " #{",{asis,Name},":=",Var,"_0} -> ", + Var,"_0;\n" + " _ -> ",atom_to_list(?MISSING_IN_MAP),"\n" + "end"] + end, + emit(lists:join(",\n", [F(E) || E <- Os0]++[[]])). + +gen_decode_sequence(Gen, Typename, #type{}=D) -> asn1ct_name:start(), asn1ct_name:new(tag), #'SEQUENCE'{tablecinf=TableConsInfo,components=CList0} = D#type.def, @@ -225,15 +249,20 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> _ -> {false,false} end, - RecordName = lists:concat([get_record_name_prefix(), - asn1ct_gen:list2rname(Typename)]), - case gen_dec_sequence_call(Erules,Typename,CompList2,Ext,DecObjInf) of - no_terms -> % an empty sequence - emit([nl,nl]), - demit(["Result = "]), %dbg - %% return value as record + RecordName0 = lists:concat([get_record_name_prefix(Gen), + asn1ct_gen:list2rname(Typename)]), + RecordName = list_to_atom(RecordName0), + case gen_dec_sequence_call(Gen, Typename, CompList2, Ext, DecObjInf) of + no_terms -> % an empty sequence asn1ct_name:new(rb), - emit([" {'",RecordName,"'}.",nl,nl]); + case Gen of + #gen{pack=record} -> + emit([nl,nl, + " {'",RecordName,"'}.",nl,nl]); + #gen{pack=map} -> + emit([nl,nl, + " #{}.",nl,nl]) + end; {LeadingAttrTerm,PostponedDecArgs} -> emit([nl]), case {LeadingAttrTerm,PostponedDecArgs} of @@ -243,7 +272,7 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> ok; {[{ObjSetRef,LeadingAttr,Term}],PostponedDecArgs} -> DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])), - ValueMatch = value_match(ValueIndex,Term), + ValueMatch = value_match(Gen, ValueIndex,Term), {ObjSetMod,ObjSetName} = ObjSetRef, emit([DecObj," =",nl, " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(", @@ -263,22 +292,64 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> "end,",nl]) end, asn1ct_name:new(rb), - case Typename of - ['EXTERNAL'] -> - emit([" OldFormat={'",RecordName, - "', "]), - mkvlist(asn1ct_name:all(term)), - emit(["},",nl]), - emit([" ", - {call,ext,transform_to_EXTERNAL1994, - ["OldFormat"]},".",nl]); - _ -> - emit([" {'",RecordName,"', "]), - mkvlist(asn1ct_name:all(term)), - emit(["}.",nl,nl]) - end + gen_dec_pack(Gen, RecordName, Typename, CompList), + emit([".",nl]) end. +gen_dec_pack(Gen, RecordName, Typename, CompList) -> + case Typename of + ['EXTERNAL'] -> + dec_external(Gen, RecordName); + _ -> + asn1ct_name:new(res), + gen_dec_do_pack(Gen, RecordName, CompList), + emit([com,nl, + {curr,res}]) + end. + +dec_external(#gen{pack=record}, RecordName) -> + All = [{var,Term} || Term <- asn1ct_name:all(term)], + Record = [{asis,RecordName}|All], + emit(["OldFormat={",lists:join(",", Record),"},",nl, + {call,ext,transform_to_EXTERNAL1994, + ["OldFormat"]}]); +dec_external(#gen{pack=map}, _RecordName) -> + Vars = asn1ct_name:all(term), + Names = ['direct-reference','indirect-reference', + 'data-value-descriptor',encoding], + Zipped = lists:zip(Names, Vars), + MapInit = lists:join(",", [["'",N,"'=>",{var,V}] || {N,V} <- Zipped]), + emit(["OldFormat = #{",MapInit,"}",com,nl, + "ASN11994Format =",nl, + {call,ext,transform_to_EXTERNAL1994_maps, + ["OldFormat"]}]). + +gen_dec_do_pack(#gen{pack=record}, RecordName, _CompList) -> + All = asn1ct_name:all(term), + L = [{asis,RecordName}|[{var,Var} || Var <- All]], + emit([{curr,res}," = {",lists:join(",", L),"}"]); +gen_dec_do_pack(#gen{pack=map}, _, CompList) -> + Zipped = lists:zip(CompList, asn1ct_name:all(term)), + PF = fun({#'ComponentType'{prop='OPTIONAL'},_}) -> false; + ({_,_}) -> true + end, + {Mandatory,Optional} = lists:partition(PF, Zipped), + L = [[{asis,Name},"=>",{var,Var}] || + {#'ComponentType'{name=Name},Var} <- Mandatory], + emit([{curr,res}," = #{",lists:join(",", L),"}"]), + gen_dec_map_optional(Optional). + +gen_dec_map_optional([{#'ComponentType'{name=Name},Var}|T]) -> + asn1ct_name:new(res), + emit([com,nl, + {curr,res}," = case ",{var,Var}," of",nl, + " asn1_NOVALUE -> ",{prev,res},";",nl, + " _ -> ",{prev,res},"#{",{asis,Name},"=>",{var,Var},"}",nl, + "end"]), + gen_dec_map_optional(T); +gen_dec_map_optional([]) -> + ok. + gen_dec_postponed_decs(_,[]) -> emit(nl); gen_dec_postponed_decs(DecObj,[{_Cname,{FirstPFN,PFNList},Term, @@ -327,7 +398,7 @@ emit_opt_or_mand_check(Value,TmpTerm) -> gen_encode_set(Erules,Typename,D) when is_record(D,type) -> gen_encode_sequence(Erules,Typename,D). -gen_decode_set(Erules,Typename,D) when is_record(D,type) -> +gen_decode_set(Gen, Typename, #type{}=D) -> asn1ct_name:start(), %% asn1ct_name:new(term), asn1ct_name:new(tag), @@ -393,7 +464,7 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> _ -> emit(["SetFun = fun(FunTlv) ->", nl]), emit(["case FunTlv of ",nl]), - NextNum = gen_dec_set_cases(Erules,Typename,CompList,1), + NextNum = gen_dec_set_cases(Gen, Typename, CompList, 1), emit([indent(6), {curr,else}," -> ",nl, indent(9),"{",NextNum,", ",{curr,else},"}",nl]), emit([indent(3),"end",nl]), @@ -405,14 +476,17 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> asn1ct_name:new(tlv) end, - RecordName = lists:concat([get_record_name_prefix(), - asn1ct_gen:list2rname(Typename)]), - case gen_dec_sequence_call(Erules,Typename,CompList,Ext,DecObjInf) of - no_terms -> % an empty sequence - emit([nl,nl]), - demit(["Result = "]), %dbg - %% return value as record - emit([" {'",RecordName,"'}.",nl]); + RecordName0 = lists:concat([get_record_name_prefix(Gen), + asn1ct_gen:list2rname(Typename)]), + RecordName = list_to_atom(RecordName0), + case gen_dec_sequence_call(Gen, Typename, CompList, Ext, DecObjInf) of + no_terms -> % an empty SET + case Gen of + #gen{pack=record} -> + emit([nl,nl," {'",RecordName,"'}.",nl,nl]); + #gen{pack=map} -> + emit([nl,nl," #{}.",nl,nl]) + end; {LeadingAttrTerm,PostponedDecArgs} -> emit([nl]), case {LeadingAttrTerm,PostponedDecArgs} of @@ -422,7 +496,7 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> ok; {[{ObjSetRef,LeadingAttr,Term}],PostponedDecArgs} -> DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])), - ValueMatch = value_match(ValueIndex,Term), + ValueMatch = value_match(Gen, ValueIndex, Term), {ObjSetMod,ObjSetName} = ObjSetRef, emit([DecObj," =",nl, " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(", @@ -441,9 +515,8 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> "}}}) % extra fields not allowed",nl, "end,",nl]) end, - emit([" {'",RecordName,"', "]), - mkvlist(asn1ct_name:all(term)), - emit(["}.",nl]) + gen_dec_pack(Gen, RecordName, Typename, CompList), + emit([".",nl]) end. @@ -504,10 +577,8 @@ gen_decode_sof(Erules,TypeName,_InnerTypeName,D) when is_record(D,type) -> emit([" || ",{curr,v}," <- ",{curr,tlv},"].",nl,nl,nl]). -gen_encode_sof_components(Erules,Typename,SeqOrSetOf,Cont) - when is_record(Cont,type)-> - - {Objfun,Objfun_novar,EncObj} = +gen_encode_sof_components(Gen, Typename, SeqOrSetOf, #type{}=Cont) -> + {Objfun,Objfun_novar,EncObj} = case Cont#type.tablecinf of [{objfun,_}|_R] -> {", ObjFun",", _",{no_attr,"ObjFun"}}; @@ -517,20 +588,19 @@ gen_encode_sof_components(Erules,Typename,SeqOrSetOf,Cont) emit(["'enc_",asn1ct_gen:list2name(Typename), "_components'([]",Objfun_novar,", AccBytes, AccLen) -> ",nl]), - case catch lists:member(der,get(encoding_options)) of - true when SeqOrSetOf=='SET OF'-> + case {Gen,SeqOrSetOf} of + {#gen{der=true},'SET OF'} -> asn1ct_func:need({ber,dynamicsort_SETOF,1}), emit([indent(3), "{dynamicsort_SETOF(AccBytes),AccLen};",nl,nl]); - _ -> + {_,_} -> emit([indent(3),"{lists:reverse(AccBytes),AccLen};",nl,nl]) end, emit(["'enc_",asn1ct_gen:list2name(Typename), "_components'([H|T]",Objfun,",AccBytes, AccLen) ->",nl]), TypeNameSuffix = asn1ct_gen:constructed_suffix(SeqOrSetOf,Cont#type.def), - gen_enc_line(Erules,Typename,TypeNameSuffix,Cont,"H",3, -% mandatory,"{EncBytes,EncLen} = ",EncObj), - mandatory,EncObj), + gen_enc_line(Gen, Typename, TypeNameSuffix, Cont, "H", 3, + mandatory, EncObj), emit([",",nl]), emit([indent(3),"'enc_",asn1ct_gen:list2name(Typename), "_components'(T",Objfun,","]), @@ -1028,35 +1098,44 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj) emit([nl,indent(7),"end"]) end. -gen_optormand_case(mandatory, _Erules, _TopType, _Cname, _Type, _Element) -> +gen_optormand_case(mandatory, _Gen, _TopType, _Cname, _Type, _Element) -> ok; -gen_optormand_case('OPTIONAL', Erules, _TopType, _Cname, _Type, Element) -> +gen_optormand_case('OPTIONAL', Gen, _TopType, _Cname, _Type, Element) -> emit([" case ",Element," of",nl]), - emit([indent(9),"asn1_NOVALUE -> {", - empty_lb(Erules),",0};",nl]), + Missing = case Gen of + #gen{pack=record} -> asn1_NOVALUE; + #gen{pack=map} -> ?MISSING_IN_MAP + end, + emit([indent(9),Missing," -> {", + empty_lb(Gen),",0};",nl]), emit([indent(9),"_ ->",nl,indent(12)]); -gen_optormand_case({'DEFAULT',DefaultValue}, Erules, _TopType, +gen_optormand_case({'DEFAULT',DefaultValue}, Gen, _TopType, _Cname, Type, Element) -> CurrMod = get(currmod), - case catch lists:member(der,get(encoding_options)) of - true -> - asn1ct_gen_check:emit(Type, DefaultValue, Element); - _ -> - emit([" case ",Element," of",nl]), - emit([indent(9),"asn1_DEFAULT -> {", - empty_lb(Erules), - ",0};",nl]), - case DefaultValue of - #'Externalvaluereference'{module=CurrMod, - value=V} -> - emit([indent(9),"?",{asis,V}," -> {", - empty_lb(Erules),",0};",nl]); - _ -> - emit([indent(9),{asis, - DefaultValue}," -> {", - empty_lb(Erules),",0};",nl]) - end, - emit([indent(9),"_ ->",nl,indent(12)]) + case Gen of + #gen{erule=ber,der=true} -> + asn1ct_gen_check:emit(Gen, Type, DefaultValue, Element); + #gen{erule=ber,der=false,pack=Pack} -> + Ind9 = indent(9), + DefMarker = case Pack of + record -> asn1_DEFAULT; + map -> ?MISSING_IN_MAP + end, + emit([" case ",Element," of",nl, + Ind9,{asis,DefMarker}," ->",nl, + Ind9,indent(3),"{",empty_lb(Gen),",0};",nl, + Ind9,"_ when ",Element," =:= "]), + Dv = case DefaultValue of + #'Externalvaluereference'{module=CurrMod, + value=V} -> + ["?",{asis,V}]; + _ -> + [{asis,DefaultValue}] + end, + emit(Dv++[" ->",nl, + Ind9,indent(3),"{",empty_lb(Gen),",0};",nl, + Ind9,"_ ->",nl, + indent(12)]) end. %% Use for SEQUENCE OF and CHOICE. @@ -1207,7 +1286,7 @@ gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandC (Type#type.def)#'ObjectClassFieldType'.fieldname, [{Cname,RefedFieldName,asn1ct_gen:mk_var(asn1ct_name:curr(term)), asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; -gen_dec_call(InnerType, _Erules, TopType, Cname, Type, BytesVar, +gen_dec_call(InnerType, Gen, TopType, Cname, Type, BytesVar, Tag, _PrimOptOrMand, _OptOrMand, DecObjInf,_) -> WhatKind = asn1ct_gen:type(InnerType), gen_dec_call1(WhatKind, InnerType, TopType, Cname, @@ -1215,7 +1294,7 @@ gen_dec_call(InnerType, _Erules, TopType, Cname, Type, BytesVar, case DecObjInf of {Cname,{_,OSet,_UniqueFName,ValIndex}} -> Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)), - ValueMatch = value_match(ValIndex,Term), + ValueMatch = value_match(Gen, ValIndex, Term), {ObjSetMod,ObjSetName} = OSet, emit([",",nl,"ObjFun = ",{asis,ObjSetMod},":'getdec_",ObjSetName, "'(",ValueMatch,")"]); @@ -1340,19 +1419,6 @@ gen_dec_call1(WhatKind, _, TopType, Cname, Type, BytesVar, Tag) -> indent(N) -> lists:duplicate(N,32). % 32 = space -mkcindexlist([H,T1|T], Sep) -> % Sep is a string e.g ", " or "+ " - emit(["Cindex",H,Sep]), - mkcindexlist([T1|T], Sep); -mkcindexlist([H|T], Sep) -> - emit(["Cindex",H]), - mkcindexlist(T, Sep); -mkcindexlist([], _) -> - true. - -mkcindexlist(L) -> - mkcindexlist(L,", "). - - mkvlist([H,T1|T], Sep) -> % Sep is a string e.g ", " or "+ " emit([{var,H},Sep]), mkvlist([T1|T], Sep); @@ -1429,19 +1495,25 @@ mkfuncname(TopType,Cname,WhatKind,Prefix,Suffix) -> {F, "?MODULE", F} end. -empty_lb(ber) -> +empty_lb(#gen{erule=ber}) -> "<<>>". -value_match(Index,Value) when is_atom(Value) -> - value_match(Index,atom_to_list(Value)); -value_match([],Value) -> +value_match(#gen{pack=record}, VIs, Value) -> + value_match_rec(VIs, Value); +value_match(#gen{pack=map}, VIs, Value) -> + value_match_map(VIs, Value). + +value_match_rec([], Value) -> + Value; +value_match_rec([{VI,_}|VIs], Value0) -> + Value = value_match_rec(VIs, Value0), + lists:concat(["element(",VI,", ",Value,")"]). + +value_match_map([], Value) -> Value; -value_match([{VI,_}|VIs],Value) -> - value_match1(Value,VIs,lists:concat(["element(",VI,","]),1). -value_match1(Value,[],Acc,Depth) -> - Acc ++ Value ++ lists:concat(lists:duplicate(Depth,")")); -value_match1(Value,[{VI,_}|VIs],Acc,Depth) -> - value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1). +value_match_map([{_,Name}|VIs], Value0) -> + Value = value_match_map(VIs, Value0), + lists:concat(["maps:get(",Name,", ",Value,")"]). call(F, Args) -> asn1ct_func:call(ber, F, Args). diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index a34b25182c..b7579c8065 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -32,17 +32,27 @@ -include("asn1_records.hrl"). %-compile(export_all). --import(asn1ct_gen, [emit/1,demit/1,get_record_name_prefix/0]). --import(asn1ct_func, [call/3]). +-import(asn1ct_gen, [emit/1,demit/1,get_record_name_prefix/1]). + +-type type_name() :: any(). + %% ENCODE GENERATOR FOR SEQUENCE TYPE ** ********** -gen_encode_set(Erules,TypeName,D) -> - gen_encode_constructed(Erules,TypeName,D). +-spec gen_encode_set(Gen, TypeName, #type{}) -> 'ok' when + Gen :: #gen{}, + TypeName :: type_name(). + +gen_encode_set(Gen, TypeName, D) -> + gen_encode_constructed(Gen, TypeName, D). + +-spec gen_encode_sequence(Gen, TypeName, #type{}) -> 'ok' when + Gen :: #gen{}, + TypeName :: type_name(). -gen_encode_sequence(Erules,TypeName,D) -> - gen_encode_constructed(Erules,TypeName,D). +gen_encode_sequence(Gen, TypeName, D) -> + gen_encode_constructed(Gen, TypeName, D). gen_encode_constructed(Erule, Typename, #type{}=D) -> asn1ct_name:start(), @@ -50,88 +60,23 @@ gen_encode_constructed(Erule, Typename, #type{}=D) -> asn1ct_imm:enc_cg(Imm, is_aligned(Erule)), emit([".",nl]). -gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> - {ExtAddGroup,TmpCompList,TableConsInfo} = - case D#type.def of - #'SEQUENCE'{tablecinf=TCI,components=CL,extaddgroup=ExtAddGroup0} -> - {ExtAddGroup0,CL,TCI}; - #'SET'{tablecinf=TCI,components=CL} -> - {undefined,CL,TCI} - end, - - CompList = case ExtAddGroup of - undefined -> - TmpCompList; - _ when is_integer(ExtAddGroup) -> - %% This is a fake SEQUENCE representing an ExtensionAdditionGroup - %% Reset the textual order so we get the right - %% index of the components - [Comp#'ComponentType'{textual_order=undefined}|| - Comp<-TmpCompList] - end, - ExternalImm = - case Typename of - ['EXTERNAL'] -> - Next = asn1ct_gen:mk_var(asn1ct_name:next(val)), - Curr = asn1ct_gen:mk_var(asn1ct_name:curr(val)), - asn1ct_name:new(val), - [{call,ext,transform_to_EXTERNAL1990,[{var,Curr}],{var,Next}}]; - _ -> - [] - end, - Aligned = is_aligned(Erule), - Value0 = make_var(val), +gen_encode_constructed_imm(Gen, Typename, #type{}=D) -> + {CompList,TableConsInfo} = enc_complist(D), + ExternalImm = external_imm(Gen, Typename), Optionals = optionals(to_textual_order(CompList)), - ImmOptionals = [asn1ct_imm:per_enc_optional(Value0, Opt, Aligned) || - Opt <- Optionals], + ImmOptionals = enc_optionals(Gen, Optionals), Ext = extensible_enc(CompList), + Aligned = is_aligned(Gen), ExtImm = case Ext of {ext,ExtPos,NumExt} when NumExt > 0 -> - gen_encode_extaddgroup(CompList), + gen_encode_extaddgroup(Gen, CompList), Value = make_var(val), - asn1ct_imm:per_enc_extensions(Value, ExtPos, - NumExt, Aligned); + enc_extensions(Gen, Value, ExtPos, NumExt, Aligned); _ -> [] end, - {EncObj,ObjSetImm} = - case TableConsInfo of - #simpletableattributes{usedclassfield=Used, - uniqueclassfield=Unique} when Used /= Unique -> - {false,[]}; - %% ObjectSet, name of the object set in constraints - %% - %%{ObjectSet,AttrN,N,UniqueFieldName} -> %% N is index of attribute that determines constraint - #simpletableattributes{objectsetname=ObjectSet, - c_name=AttrN, - c_index=N, - usedclassfield=UniqueFieldName, - uniqueclassfield=UniqueFieldName, - valueindex=ValueIndex0 - } -> %% N is index of attribute that determines constraint - {Module,ObjSetName} = ObjectSet, - #typedef{typespec=#'ObjectSet'{gen=Gen}} = - asn1_db:dbget(Module, ObjSetName), - case Gen of - true -> - ValueIndex = ValueIndex0 ++ [{N+1,top}], - Val = make_var(val), - {ObjSetImm0,Dst} = enc_dig_out_value(ValueIndex, Val), - {{AttrN,Dst},ObjSetImm0}; - false -> - {false,[]} - end; - _ -> - case D#type.tablecinf of - [{objfun,_}|_] -> - %% when the simpletableattributes was at an outer - %% level and the objfun has been passed through the - %% function call - {{"got objfun through args",{var,"ObjFun"}},[]}; - _ -> - {false,[]} - end - end, + MatchImm = enc_map_match(Gen, CompList), + {EncObj,ObjSetImm} = enc_table(Gen, TableConsInfo, D), ImmSetExt = case Ext of {ext,_Pos,NumExt2} when NumExt2 > 0 -> @@ -141,38 +86,195 @@ gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> _ -> [] end, - ImmBody = gen_enc_components_call(Erule, Typename, CompList, EncObj, Ext), - ExternalImm ++ ExtImm ++ ObjSetImm ++ + ImmBody = gen_enc_components_call(Gen, Typename, CompList, EncObj, Ext), + ExternalImm ++ MatchImm ++ ExtImm ++ ObjSetImm ++ asn1ct_imm:enc_append([ImmSetExt] ++ ImmOptionals ++ ImmBody). -gen_encode_extaddgroup(CompList) -> +external_imm(Gen, ['EXTERNAL']) -> + Next = asn1ct_gen:mk_var(asn1ct_name:next(val)), + Curr = asn1ct_gen:mk_var(asn1ct_name:curr(val)), + asn1ct_name:new(val), + F = case Gen of + #gen{pack=record} -> transform_to_EXTERNAL1990; + #gen{pack=map} -> transform_to_EXTERNAL1990_maps + end, + [{call,ext,F,[{var,Curr}],{var,Next}}]; +external_imm(_, _) -> + []. + +enc_extensions(#gen{pack=record}, Value, ExtPos, NumExt, Aligned) -> + asn1ct_imm:per_enc_extensions(Value, ExtPos, NumExt, Aligned); +enc_extensions(#gen{pack=map}, Value, ExtPos, NumExt, Aligned) -> + Vars = [{var,lists:concat(["Input@",Pos])} || + Pos <- lists:seq(ExtPos, ExtPos+NumExt-1)], + Undefined = atom_to_list(?MISSING_IN_MAP), + asn1ct_imm:per_enc_extensions_map(Value, Vars, Undefined, Aligned). + +enc_complist(#type{def=Def}) -> + case Def of + #'SEQUENCE'{tablecinf=TCI,components=CL0,extaddgroup=ExtAddGroup} -> + case ExtAddGroup of + undefined -> + {CL0,TCI}; + _ when is_integer(ExtAddGroup) -> + %% This is a fake SEQUENCE representing an + %% ExtensionAdditionGroup. Renumber the textual + %% order so we get the right index of the + %% components. + CL = add_textual_order(CL0), + {CL,TCI} + end; + #'SET'{tablecinf=TCI,components=CL} -> + {CL,TCI} + end. + +enc_table(Gen, #simpletableattributes{objectsetname=ObjectSet, + c_name=AttrN, + c_index=N, + usedclassfield=UniqueFieldName, + uniqueclassfield=UniqueFieldName, + valueindex=ValueIndex0}, _) -> + {Module,ObjSetName} = ObjectSet, + #typedef{typespec=#'ObjectSet'{gen=MustGen}} = + asn1_db:dbget(Module, ObjSetName), + case MustGen of + true -> + ValueIndex = ValueIndex0 ++ [{N+1,'ASN1_top'}], + Val = make_var(val), + {ObjSetImm,Dst} = enc_dig_out_value(Gen, ValueIndex, Val), + {{AttrN,Dst},ObjSetImm}; + false -> + {false,[]} + end; +enc_table(_Gen, #simpletableattributes{}, _) -> + {false,[]}; +enc_table(_Gen, _, #type{tablecinf=TCInf}) -> + case TCInf of + [{objfun,_}|_] -> + %% The simpletableattributes was at an outer + %% level and the objfun has been passed through the + %% function call. + {{"got objfun through args",{var,"ObjFun"}},[]}; + _ -> + {false,[]} + end. + +enc_optionals(Gen, Optionals) -> + Var = make_var(val), + enc_optionals_1(Gen, Optionals, Var). + +enc_optionals_1(#gen{pack=record}=Gen, [{Pos,DefVals}|T], Var) -> + {Imm0,Element} = asn1ct_imm:enc_element(Pos+1, Var), + Imm = asn1ct_imm:per_enc_optional(Element, DefVals), + [Imm0++Imm|enc_optionals_1(Gen, T, Var)]; +enc_optionals_1(#gen{pack=map}=Gen, [{Pos,DefVals0}|T], V) -> + Var = {var,lists:concat(["Input@",Pos])}, + DefVals = translate_missing_value(Gen, DefVals0), + Imm = asn1ct_imm:per_enc_optional(Var, DefVals), + [Imm|enc_optionals_1(Gen, T, V)]; +enc_optionals_1(_, [], _) -> + []. + +enc_map_match(#gen{pack=record}, _Cs) -> + []; +enc_map_match(#gen{pack=map}, Cs0) -> + Var0 = "Input", + Cs = enc_flatten_components(Cs0), + M = [[quote_atom(Name),":=",lists:concat([Var0,"@",Order])] || + #'ComponentType'{prop=mandatory,name=Name, + textual_order=Order} <- Cs], + Mand = case M of + [] -> + []; + [_|_] -> + Patt = {expr,lists:flatten(["#{",lists:join(",", M),"}"])}, + [{assign,Patt,{var,asn1ct_name:curr(val)}}] + end, + + Os0 = [{Name,Order} || + #'ComponentType'{prop=Prop,name=Name, + textual_order=Order} <- Cs, + Prop =/= mandatory], + {var,Val} = make_var(val), + F = fun({Name,Order}) -> + Var = lists:concat([Var0,"@",Order]), + P0 = ["case ",Val," of\n" + " #{",quote_atom(Name),":=",Var,"_0} -> ", + Var,"_0;\n" + " _ -> ",atom_to_list(?MISSING_IN_MAP),"\n" + "end"], + P = lists:flatten(P0), + {assign,{var,Var},P} + end, + Os = [F(O) || O <- Os0], + Mand ++ Os. + +enc_flatten_components({Root1,Ext0,Root2}=CL) -> + {_,Gs} = extgroup_pos_and_length(CL), + Ext = wrap_extensionAdditionGroups(Ext0, Gs), + Root1 ++ Root2 ++ [mark_optional(C) || C <- Ext]; +enc_flatten_components({Root,Ext}) -> + enc_flatten_components({Root,Ext,[]}); +enc_flatten_components(Cs) -> + Cs. + +gen_encode_extaddgroup(#gen{pack=record}, CompList) -> case extgroup_pos_and_length(CompList) of {extgrouppos,[]} -> ok; {extgrouppos,ExtGroupPosLenList} -> - _ = [do_gen_encode_extaddgroup(G) || G <- ExtGroupPosLenList], + _ = [gen_encode_eag_record(G) || + G <- ExtGroupPosLenList], ok - end. + end; +gen_encode_extaddgroup(#gen{pack=map}, Cs0) -> + Cs = enc_flatten_components(Cs0), + gen_encode_eag_map(Cs). + +gen_encode_eag_map([#'ComponentType'{name=Group,typespec=Type}|Cs]) -> + case Type of + #type{def=#'SEQUENCE'{extaddgroup=G,components=GCs0}} + when is_integer(G) -> + Ns = [N || #'ComponentType'{name=N,prop=mandatory} <- GCs0], + test_for_mandatory(Ns, Group), + gen_encode_eag_map(Cs); + _ -> + gen_encode_eag_map(Cs) + end; +gen_encode_eag_map([]) -> + ok. + +test_for_mandatory([Mand|_], Group) -> + emit([{next,val}," = case ",{curr,val}," of",nl, + "#{",quote_atom(Mand),":=_} -> ", + {curr,val},"#{",{asis,Group},"=>",{curr,val},"};",nl, + "#{} -> ",{curr,val},nl, + "end,",nl]), + asn1ct_name:new(val); +test_for_mandatory([], _) -> + ok. -do_gen_encode_extaddgroup({ActualGroupPos,GroupVirtualPos,GroupLen}) -> +gen_encode_eag_record({ActualPos,VirtualPos,Len}) -> Val = asn1ct_gen:mk_var(asn1ct_name:curr(val)), - Elements = make_elements(GroupVirtualPos+1, - Val, - lists:seq(1, GroupLen)), - Expr = any_non_value(GroupVirtualPos+1, Val, GroupLen, ""), + Elements = get_input_vars(Val, VirtualPos, Len), + Expr = any_non_value(Val, VirtualPos, Len), emit([{next,val}," = case ",Expr," of",nl, - "false -> setelement(",{asis,ActualGroupPos+1},", ", + "false -> setelement(",{asis,ActualPos+1},", ", {curr,val},", asn1_NOVALUE);",nl, - "true -> setelement(",{asis,ActualGroupPos+1},", ", + "true -> setelement(",{asis,ActualPos+1},", ", {curr,val},", {extaddgroup,", Elements,"})",nl, "end,",nl]), asn1ct_name:new(val). -any_non_value(_, _, 0, _) -> +any_non_value(Val, Pos, N) -> + L = any_non_value_1(Val, Pos, N), + lists:join(" orelse ", L). + +any_non_value_1(_, _, 0) -> []; -any_non_value(Pos, Val, N, Sep) -> - Sep ++ [make_element(Pos, Val)," =/= asn1_NOVALUE"] ++ - any_non_value(Pos+1, Val, N-1, [" orelse",nl]). +any_non_value_1(Val, Pos, N) -> + Var = get_input_var(Val, Pos), + [Var ++ " =/= asn1_NOVALUE"|any_non_value_1(Val, Pos+1, N-1)]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% generate decode function for SEQUENCE and SET @@ -306,55 +408,105 @@ gen_dec_constructed_imm(Erule, Typename, #type{}=D) -> {DecObjInf,_,_} = ObjSetInfo, EmitComp = gen_dec_components_call(Erule, Typename, CompList, DecObjInf, Ext, length(Optionals)), - EmitRest = fun({AccTerm,AccBytes}) -> - gen_dec_constructed_imm_2(Erule, Typename, - CompList, - ObjSetInfo, - AccTerm, AccBytes) - end, - [EmitExt,EmitOpt|EmitComp++[{safe,EmitRest}]]. + EmitObjSets = gen_dec_objsets_fun(Erule, ObjSetInfo), + EmitPack = fun(_) -> + gen_dec_pack(Erule, Typename, CompList) + end, + RestGroup = {group,[{safe,EmitObjSets},{safe,EmitPack}]}, + [EmitExt,EmitOpt|EmitComp++[RestGroup]]. + +gen_dec_objsets_fun(Gen, ObjSetInfo) -> + fun({AccTerm,AccBytes}) -> + {_,_UniqueFName,ValueIndex} = ObjSetInfo, + case {AccTerm,AccBytes} of + {[],[]} -> + ok; + {_,[]} -> + ok; + {[{ObjSet,LeadingAttr,Term}],ListOfOpenTypes} -> + ValueMatch = value_match(Gen, ValueIndex, Term), + _ = [begin + gen_dec_open_type(Gen, ValueMatch, ObjSet, + LeadingAttr, T), + emit([com,nl]) + end || T <- ListOfOpenTypes], + ok + end + end. -gen_dec_constructed_imm_2(Erule, Typename, CompList, - ObjSetInfo, AccTerm, AccBytes) -> - {_,_UniqueFName,ValueIndex} = ObjSetInfo, - case {AccTerm,AccBytes} of - {[],[]} -> - ok; - {_,[]} -> - ok; - {[{ObjSet,LeadingAttr,Term}],ListOfOpenTypes} -> - ValueMatch = value_match(ValueIndex, Term), - _ = [begin - gen_dec_open_type(Erule, ValueMatch, ObjSet, - LeadingAttr, T), - emit([com,nl]) - end || T <- ListOfOpenTypes], - ok - end, - %% we don't return named lists any more Cnames = mkcnamelist(CompList), - demit({"Result = "}), %dbg - %% return value as record - RecordName = record_name(Typename), +gen_dec_pack(Gen, Typename, CompList) -> case Typename of ['EXTERNAL'] -> - emit({" OldFormat={'",RecordName, - "'"}), - mkvlist(asn1ct_name:all(term)), - emit({"},",nl}), - emit([" ASN11994Format =",nl, - " ", - {call,ext,transform_to_EXTERNAL1994, - ["OldFormat"]},com,nl]), - emit(" {ASN11994Format,"); + dec_external(Gen, Typename); _ -> - emit(["{{'",RecordName,"'"]), - %% CompList is used here because we don't want - %% ExtensionAdditionGroups to be wrapped in SEQUENCES when - %% we are ordering the fields according to textual order - mkvlist(textual_order(to_encoding_order(CompList),asn1ct_name:all(term))), - emit("},") - end, - emit({{curr,bytes},"}"}). + asn1ct_name:new(res), + gen_dec_do_pack(Gen, Typename, CompList), + emit([com,nl, + "{",{curr,res},",",{curr,bytes},"}"]) + end. + +dec_external(#gen{pack=record}=Gen, Typename) -> + RecordName = list_to_atom(record_name(Gen, Typename)), + All = [{var,Term} || Term <- asn1ct_name:all(term)], + Record = [{asis,RecordName}|All], + emit(["OldFormat={",lists:join(",", Record),"},",nl, + "ASN11994Format =",nl, + {call,ext,transform_to_EXTERNAL1994, + ["OldFormat"]},com,nl, + "{ASN11994Format,",{curr,bytes},"}"]); +dec_external(#gen{pack=map}, _Typename) -> + Vars = asn1ct_name:all(term), + Names = ['direct-reference','indirect-reference', + 'data-value-descriptor',encoding], + Zipped = lists:zip(Names, Vars), + MapInit = lists:join(",", [["'",N,"'=>",{var,V}] || {N,V} <- Zipped]), + emit(["OldFormat = #{",MapInit,"}",com,nl, + "ASN11994Format =",nl, + {call,ext,transform_to_EXTERNAL1994_maps, + ["OldFormat"]},com,nl, + "{ASN11994Format,",{curr,bytes},"}"]). + +gen_dec_do_pack(#gen{pack=record}=Gen, TypeName, CompList) -> + Zipped0 = zip_components(CompList, asn1ct_name:all(term)), + Zipped = textual_order(Zipped0), + RecordName = ["'",record_name(Gen, TypeName),"'"], + L = [RecordName|[{var,Var} || {_,Var} <- Zipped]], + emit([{curr,res}," = {",lists:join(",", L),"}"]); +gen_dec_do_pack(#gen{pack=map}, _, CompList0) -> + CompList = enc_flatten_components(CompList0), + Zipped0 = zip_components(CompList, asn1ct_name:all(term)), + Zipped = textual_order(Zipped0), + PF = fun({#'ComponentType'{prop='OPTIONAL'},_}) -> false; + ({_,_}) -> true + end, + {Mandatory,Optional} = lists:partition(PF, Zipped), + L = [[{asis,Name},"=>",{var,Var}] || + {#'ComponentType'{name=Name},Var} <- Mandatory], + emit([{curr,res}," = #{",lists:join(",", L),"}"]), + gen_dec_map_optional(Optional), + gen_dec_merge_maps(asn1ct_name:all(map)). + +gen_dec_map_optional([{#'ComponentType'{name=Name},Var}|T]) -> + asn1ct_name:new(res), + emit([com,nl, + {curr,res}," = case ",{var,Var}," of",nl, + " asn1_NOVALUE -> ",{prev,res},";",nl, + " _ -> ",{prev,res},"#{",{asis,Name},"=>",{var,Var},"}",nl, + "end"]), + gen_dec_map_optional(T); +gen_dec_map_optional([]) -> + ok. + +gen_dec_merge_maps([M|Ms]) -> + asn1ct_name:new(res), + emit([com,nl, + {curr,res}," = maps:merge(",{prev,res},", ",{var,M},")"]), + gen_dec_merge_maps(Ms); +gen_dec_merge_maps([]) -> + ok. + +quote_atom(A) when is_atom(A) -> + io_lib:format("~p", [A]). %% record_name([TypeName]) -> RecordNameString %% Construct a record name for the constructed type, ignoring any @@ -362,10 +514,10 @@ gen_dec_constructed_imm_2(Erule, Typename, CompList, %% group. Such fake sequences never appear as a top type, and their %% name always start with "ExtAddGroup". -record_name(Typename0) -> +record_name(Gen, Typename0) -> [TopType|Typename1] = lists:reverse(Typename0), Typename = filter_ext_add_groups(Typename1, [TopType]), - lists:concat([get_record_name_prefix(), + lists:concat([get_record_name_prefix(Gen), asn1ct_gen:list2rname(Typename)]). filter_ext_add_groups([H|T], Acc) when is_atom(H) -> @@ -379,17 +531,26 @@ filter_ext_add_groups([H|T], Acc) -> filter_ext_add_groups(T, [H|Acc]); filter_ext_add_groups([], Acc) -> Acc. -textual_order([#'ComponentType'{textual_order=undefined}|_],TermList) -> - TermList; -textual_order(CompList,TermList) when is_list(CompList) -> - OrderList = [Ix||#'ComponentType'{textual_order=Ix} <- CompList], - [Term||{_,Term}<- - lists:sort(lists:zip(OrderList, - lists:sublist(TermList,length(OrderList))))]; - %% sublist is just because Termlist can sometimes be longer than - %% OrderList, which it really shouldn't -textual_order({Root,Ext},TermList) -> - textual_order(Root ++ Ext,TermList). +zip_components({Root,Ext}, Vars) -> + zip_components({Root,Ext,[]}, Vars); +zip_components({R1,Ext0,R2}, Vars) -> + Ext = [mark_optional(C) || C <- Ext0], + zip_components(R1++R2++Ext, Vars); +zip_components(Cs, Vars) when is_list(Cs) -> + zip_components_1(Cs, Vars). + +zip_components_1([#'ComponentType'{}=C|Cs], [V|Vs]) -> + [{C,V}|zip_components_1(Cs, Vs)]; +zip_components_1([_|Cs], Vs) -> + zip_components_1(Cs, Vs); +zip_components_1([], []) -> + []. + +textual_order([{#'ComponentType'{textual_order=undefined},_}|_]=L) -> + L; +textual_order(L0) -> + L = [{Ix,P} || {#'ComponentType'{textual_order=Ix},_}=P <- L0], + [C || {_,C} <- lists:sort(L)]. to_textual_order({Root,Ext}) -> {to_textual_order(Root),Ext}; @@ -458,7 +619,7 @@ dec_objset_default(N, _, _, true) -> end]). dec_objset_1(Erule, N, {Id,Obj}, RestFields, Typename) -> - emit([{asis,N},"(Bytes, ",{asis,Id},") ->",nl]), + emit([{asis,N},"(Bytes, Id) when Id =:= ",{asis,Id}," ->",nl]), dec_objset_2(Erule, Obj, RestFields, Typename). dec_objset_2(Erule, Obj, RestFields0, Typename) -> @@ -595,8 +756,7 @@ do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D) -> emit([",",nl, {asis,F},"(",Num,", ",Buf,ObjFun,", [])"]). -is_aligned(per) -> true; -is_aligned(uper) -> false. +is_aligned(#gen{erule=per,aligned=Aligned}) -> Aligned. gen_decode_length(Constraint, Erule) -> emit(["%% Length with constraint ",{asis,Constraint},nl]), @@ -640,22 +800,7 @@ gen_decode_sof_components(Erule, Name, Typename, SeqOrSetOf, Cont) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% General and special help functions (not exported) - -mkvlist([H|T]) -> - emit(","), - mkvlist2([H|T]); -mkvlist([]) -> - true. -mkvlist2([H,T1|T]) -> - emit({{var,H},","}), - mkvlist2([T1|T]); -mkvlist2([H|T]) -> - emit({{var,H}}), - mkvlist2(T); -mkvlist2([]) -> - true. - +%% General and special help functions (not exported) extensible_dec(CompList) when is_list(CompList) -> noext; @@ -728,28 +873,26 @@ gen_dec_optionals(Optionals) -> {imm,Imm0,E}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Produce a list with positions (in the Value record) where -%% there are optional components, start with 2 because first element -%% is the record name - -optionals({L1,Ext,L2}) -> - Opt1 = optionals(L1,[],2), - ExtComps = length([C||C = #'ComponentType'{}<-Ext]), - Opt2 = optionals(L2,[],2+length(L1)+ExtComps), - Opt1 ++ Opt2; -optionals({L,_Ext}) -> optionals(L,[],2); -optionals(L) -> optionals(L,[],2). -optionals([#'ComponentType'{prop='OPTIONAL'}|Rest], Acc, Pos) -> - optionals(Rest, [Pos|Acc], Pos+1); -optionals([#'ComponentType'{typespec=T,prop={'DEFAULT',Val}}|Rest], - Acc, Pos) -> +optionals({Root1,Ext,Root2}) -> + Opt1 = optionals(Root1, 1), + ExtComps = length([C || C = #'ComponentType'{} <- Ext]), + Opt2 = optionals(Root2, 1 + length(Root1) + ExtComps), + Opt1 ++ Opt2; +optionals({L,_Ext}) -> + optionals(L, 1); +optionals(L) -> + optionals(L, 1). + +optionals([#'ComponentType'{prop='OPTIONAL'}|Rest], Pos) -> + [{Pos,[asn1_NOVALUE]}|optionals(Rest, Pos+1)]; +optionals([#'ComponentType'{typespec=T,prop={'DEFAULT',Val}}|Cs], Pos) -> Vals = def_values(T, Val), - optionals(Rest, [{Pos,Vals}|Acc], Pos+1); -optionals([#'ComponentType'{}|Rest], Acc, Pos) -> - optionals(Rest, Acc, Pos+1); -optionals([], Acc, _) -> - lists:reverse(Acc). + [{Pos,Vals}|optionals(Cs, Pos+1)]; +optionals([#'ComponentType'{}|Rest], Pos) -> + optionals(Rest, Pos+1); +optionals([], _) -> + []. %%%%%%%%%%%%%%%%%%%%%% %% create_optionality_table(Cs=[#'ComponentType'{textual_order=undefined}|_]) -> @@ -779,13 +922,6 @@ get_optionality_pos(TextPos,OptTable) -> no_num end. -to_encoding_order(Cs) when is_list(Cs) -> - Cs; -to_encoding_order(Cs = {_Root,_Ext}) -> - Cs; -to_encoding_order({R1,Ext,R2}) -> - {R1++R2,Ext}. - add_textual_order(Cs) when is_list(Cs) -> {NewCs,_} = add_textual_order1(Cs,1), NewCs; @@ -810,69 +946,77 @@ add_textual_order1(Cs,NumIn) -> end, NumIn,Cs). -gen_enc_components_call(Erule,TopType,{Root,ExtList}, DynamicEnc,Ext) -> - gen_enc_components_call(Erule,TopType,{Root,ExtList,[]}, DynamicEnc,Ext); -gen_enc_components_call(Erule,TopType,CL={Root,ExtList,Root2}, DynamicEnc,Ext) -> - %% The type has extensionmarker - {Imm0,Rpos} = gen_enc_components_call1(Erule,TopType,Root++Root2,1, DynamicEnc,noext,[]), +gen_enc_components_call(Erule, TopType, {Root,ExtList}, DynamicEnc, Ext) -> + gen_enc_components_call(Erule, TopType, {Root,ExtList,[]}, DynamicEnc, Ext); +gen_enc_components_call(Erule, TopType, {R1,ExtList0,R2}=CL, DynamicEnc, Ext) -> + Root = R1 ++ R2, + Imm0 = gen_enc_components_call1(Erule, TopType, Root, DynamicEnc, noext), ExtImm = case Ext of {ext,_,ExtNum} when ExtNum > 0 -> [{var,"Extensions"}]; _ -> [] end, - %handle extensions {extgrouppos,ExtGroupPosLen} = extgroup_pos_and_length(CL), - NewExtList = wrap_extensionAdditionGroups(ExtList,ExtGroupPosLen), - {Imm1,_} = gen_enc_components_call1(Erule,TopType,NewExtList,Rpos,DynamicEnc,Ext,[]), + ExtList1 = wrap_extensionAdditionGroups(ExtList0, ExtGroupPosLen), + ExtList = [mark_optional(C) || C <- ExtList1], + Imm1 = gen_enc_components_call1(Erule, TopType, ExtList, DynamicEnc, Ext), Imm0 ++ [ExtImm|Imm1]; -gen_enc_components_call(Erule,TopType, CompList, DynamicEnc, Ext) -> - %% The type has no extensionmarker - {Imm,_} = gen_enc_components_call1(Erule,TopType,CompList,1,DynamicEnc,Ext,[]), - Imm. - -gen_enc_components_call1(Erule,TopType, - [C=#'ComponentType'{name=Cname,typespec=Type,prop=Prop}|Rest], - Tpos, - DynamicEnc, Ext, Acc) -> - - TermNo = - case C#'ComponentType'.textual_order of - undefined -> - Tpos; - CanonicalNum -> - CanonicalNum - end, - Val = make_var(val), - {Imm0,Element} = asn1ct_imm:enc_element(TermNo+1, Val), - Imm1 = gen_enc_line_imm(Erule, TopType, Cname, Type, Element, DynamicEnc, Ext), - Category = case {Prop,Ext} of - {'OPTIONAL',_} -> - optional; - {{'DEFAULT',DefVal},_} -> - {default,DefVal}; - {_,{ext,ExtPos,_}} when Tpos >= ExtPos -> - optional; - {_,_} -> - mandatory - end, - Imm2 = case Category of +gen_enc_components_call(Erule, TopType, CompList, DynamicEnc, Ext) -> + %% No extension marker. + gen_enc_components_call1(Erule, TopType, CompList, DynamicEnc, Ext). + +mark_optional(#'ComponentType'{prop=Prop0}=C) -> + Prop = case Prop0 of + mandatory -> 'OPTIONAL'; + 'OPTIONAL'=Keep -> Keep; + {'DEFAULT',_}=Keep -> Keep + end, + C#'ComponentType'{prop=Prop}; +mark_optional(Other) -> + Other. + +gen_enc_components_call1(Gen, TopType, [C|Rest], DynamicEnc, Ext) -> + #'ComponentType'{name=Cname,typespec=Type, + prop=Prop,textual_order=Num} = C, + {Imm0,Element} = enc_fetch_field(Gen, Num, Prop), + Imm1 = gen_enc_line_imm(Gen, TopType, Cname, Type, + Element, DynamicEnc, Ext), + Imm2 = case Prop of mandatory -> Imm1; - optional -> - asn1ct_imm:enc_absent(Element, [asn1_NOVALUE], Imm1); - {default,Def} -> + 'OPTIONAL' -> + enc_absent(Gen, Element, [asn1_NOVALUE], Imm1); + {'DEFAULT',Def} -> DefValues = def_values(Type, Def), - asn1ct_imm:enc_absent(Element, DefValues, Imm1) + enc_absent(Gen, Element, DefValues, Imm1) end, Imm = case Imm2 of [] -> []; _ -> Imm0 ++ Imm2 end, - gen_enc_components_call1(Erule, TopType, Rest, Tpos+1, DynamicEnc, Ext, [Imm|Acc]); -gen_enc_components_call1(_Erule,_TopType,[],Pos,_,_, Acc) -> - ImmList = lists:reverse(Acc), - {ImmList,Pos}. + [Imm|gen_enc_components_call1(Gen, TopType, Rest, DynamicEnc, Ext)]; +gen_enc_components_call1(_Gen, _TopType, [], _, _) -> + []. + +enc_absent(Gen, Var, Absent0, Imm) -> + Absent = translate_missing_value(Gen, Absent0), + asn1ct_imm:enc_absent(Var, Absent, Imm). + +translate_missing_value(#gen{pack=record}, Optionals) -> + Optionals; +translate_missing_value(#gen{pack=map}, Optionals) -> + case Optionals of + [asn1_NOVALUE|T] -> [?MISSING_IN_MAP|T]; + [asn1_DEFAULT|T] -> [?MISSING_IN_MAP|T]; + {call,_,_,_} -> Optionals + end. + +enc_fetch_field(#gen{pack=record}, Num, _Prop) -> + Val = make_var(val), + asn1ct_imm:enc_element(Num+1, Val); +enc_fetch_field(#gen{pack=map}, Num, _) -> + {[],{var,lists:concat(["Input@",Num])}}. def_values(#type{def=#'Externaltypereference'{module=Mod,type=Type}}, Def) -> #typedef{typespec=T} = asn1_db:dbget(Mod, Type), @@ -1115,27 +1259,31 @@ gen_dec_components_call(Erule, TopType, {Root,ExtList}, DecInfObj, Ext, NumberOfOptionals) -> gen_dec_components_call(Erule,TopType,{Root,ExtList,[]}, DecInfObj,Ext,NumberOfOptionals); -gen_dec_components_call(Erule,TopType,CL={Root1,ExtList,Root2}, - DecInfObj,Ext,NumberOfOptionals) -> +gen_dec_components_call(Gen, TopType, {Root1,ExtList,Root2}=CL, + DecInfObj, Ext, NumberOfOptionals) -> %% The type has extensionmarker OptTable = create_optionality_table(Root1++Root2), Init = {ignore,fun(_) -> {[],[]} end}, {EmitRoot,Tpos} = - gen_dec_comp_calls(Root1++Root2, Erule, TopType, OptTable, + gen_dec_comp_calls(Root1++Root2, Gen, TopType, OptTable, DecInfObj, noext, NumberOfOptionals, 1, []), - EmitGetExt = gen_dec_get_extension(Erule), + EmitGetExt = gen_dec_get_extension(Gen), {extgrouppos,ExtGroupPosLen} = extgroup_pos_and_length(CL), NewExtList = wrap_extensionAdditionGroups(ExtList, ExtGroupPosLen), - {EmitExts,_} = gen_dec_comp_calls(NewExtList, Erule, TopType, OptTable, + {EmitExts,_} = gen_dec_comp_calls(NewExtList, Gen, TopType, OptTable, DecInfObj, Ext, NumberOfOptionals, Tpos, []), NumExtsToSkip = ext_length(ExtList), Finish = fun(St) -> emit([{next,bytes},"= "]), - call(Erule, skipextensions, - [{curr,bytes},NumExtsToSkip+1,"Extensions"]), + Mod = case Gen of + #gen{erule=per,aligned=false} -> uper; + #gen{erule=per,aligned=true} -> per + end, + asn1ct_func:call(Mod, skipextensions, + [{curr,bytes},NumExtsToSkip+1,"Extensions"]), asn1ct_name:new(bytes), St end, @@ -1178,7 +1326,7 @@ gen_dec_comp_calls([C|Cs], Erule, TopType, OptTable, DecInfObj, gen_dec_comp_calls([], _, _, _, _, _, _, Tpos, Acc) -> {lists:append(lists:reverse(Acc)),Tpos}. -gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, +gen_dec_comp_call(Comp, Gen, TopType, Tpos, OptTable, DecInfObj, Ext, NumberOfOptionals) -> #'ComponentType'{typespec=Type,prop=Prop,textual_order=TextPos} = Comp, Pos = case Ext of @@ -1219,15 +1367,9 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, _ -> case Type of #type{def=#'SEQUENCE'{ - extaddgroup=Number1, - components=ExtGroupCompList1}} when is_integer(Number1)-> - fun(St) -> - emit(["{{_,"]), - emit_extaddgroupTerms(term,ExtGroupCompList1), - emit(["}"]), - emit([",",{next,bytes},"} = "]), - St - end; + extaddgroup=GroupNum, + components=CompList}} when is_integer(GroupNum)-> + dec_match_extadd_fun(Gen, CompList); _ -> fun(St) -> asn1ct_name:new(term), @@ -1237,9 +1379,9 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, end end end, - {Pre,Post} = comp_call_pre_post(Ext, Prop, Pos, Type, TextPos, + {Pre,Post} = comp_call_pre_post(Gen, Ext, Prop, Pos, Type, TextPos, OptTable, NumberOfOptionals, Ext), - Lines = gen_dec_seq_line_imm(Erule, TopType, Comp, Tpos, DecInfObj, Ext), + Lines = gen_dec_seq_line_imm(Gen, TopType, Comp, Tpos, DecInfObj, Ext), AdvBuffer = {ignore,fun(St) -> asn1ct_name:new(bytes), St @@ -1247,9 +1389,24 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, [{group,[{safe,Comment},{safe,Preamble}] ++ Pre ++ Lines ++ Post ++ [{safe,AdvBuffer}]}]. -comp_call_pre_post(noext, mandatory, _, _, _, _, _, _) -> +dec_match_extadd_fun(#gen{pack=record}, CompList) -> + fun(St) -> + emit(["{{_,"]), + emit_extaddgroupTerms(term, CompList), + emit(["}"]), + emit([",",{next,bytes},"} = "]), + St + end; +dec_match_extadd_fun(#gen{pack=map}, _CompList) -> + fun(St) -> + asn1ct_name:new(map), + emit(["{",{curr,map},",",{next,bytes},"} = "]), + St + end. + +comp_call_pre_post(_Gen, noext, mandatory, _, _, _, _, _, _) -> {[],[]}; -comp_call_pre_post(noext, Prop, _, Type, TextPos, +comp_call_pre_post(_Gen, noext, Prop, _, Type, TextPos, OptTable, NumOptionals, Ext) -> %% OPTIONAL or DEFAULT OptPos = get_optionality_pos(TextPos, OptTable), @@ -1273,32 +1430,53 @@ comp_call_pre_post(noext, Prop, _, Type, TextPos, "end"]), St end]}; -comp_call_pre_post({ext,_,_}, Prop, Pos, Type, _, _, _, Ext) -> +comp_call_pre_post(Gen, {ext,_,_}, Prop, Pos, Type, _, _, _, Ext) -> %% Extension {[fun(St) -> emit(["case Extensions of",nl, " <<_:",Pos-1,",1:1,_/bitstring>> ->",nl]), St end], - [fun(St) -> - emit([";",nl, - "_ ->",nl, - "{"]), - case Type of - #type{def=#'SEQUENCE'{ - extaddgroup=Number2, - components=ExtGroupCompList2}} - when is_integer(Number2)-> - emit("{extAddGroup,"), - gen_dec_extaddGroup_no_val(Ext, Type, ExtGroupCompList2), - emit("}"); - _ -> - gen_dec_component_no_val(Ext, Type, Prop) - end, - emit([",",{curr,bytes},"}",nl, - "end"]), - St - end]}. + [extadd_group_fun(Gen, Prop, Type, Ext)]}. + +extadd_group_fun(#gen{pack=record}, Prop, Type, Ext) -> + fun(St) -> + emit([";",nl, + "_ ->",nl, + "{"]), + case Type of + #type{def=#'SEQUENCE'{ + extaddgroup=Number2, + components=ExtGroupCompList2}} + when is_integer(Number2)-> + emit("{extAddGroup,"), + gen_dec_extaddGroup_no_val(Ext, Type, ExtGroupCompList2), + emit("}"); + _ -> + gen_dec_component_no_val(Ext, Type, Prop) + end, + emit([",",{curr,bytes},"}",nl, + "end"]), + St + end; +extadd_group_fun(#gen{pack=map}, Prop, Type, Ext) -> + fun(St) -> + emit([";",nl, + "_ ->",nl, + "{"]), + case Type of + #type{def=#'SEQUENCE'{ + extaddgroup=Number2, + components=Comp}} + when is_integer(Number2)-> + dec_map_extaddgroup_no_val(Ext, Type, Comp); + _ -> + gen_dec_component_no_val(Ext, Type, Prop) + end, + emit([",",{curr,bytes},"}",nl, + "end"]), + St + end. is_mandatory_predef_tab_c(noext, mandatory, {"got objfun through args","ObjFun"}) -> @@ -1325,7 +1503,20 @@ gen_dec_component_no_val(_, _, 'OPTIONAL') -> emit({"asn1_NOVALUE"}); gen_dec_component_no_val({ext,_,_}, _, mandatory) -> emit({"asn1_NOVALUE"}). - + +dec_map_extaddgroup_no_val(Ext, Type, Comp) -> + L0 = [dec_map_extaddgroup_no_val_1(N, P, Ext, Type) || + #'ComponentType'{name=N,prop=P} <- Comp], + L = [E || E <- L0, E =/= []], + emit(["#{",lists:join(",", L),"}"]). + +dec_map_extaddgroup_no_val_1(Name, {'DEFAULT',DefVal0}, _Ext, Type) -> + DefVal = asn1ct_gen:conform_value(Type, DefVal0), + [Name,"=>",{asis,DefVal}]; +dec_map_extaddgroup_no_val_1(_Name, 'OPTIONAL', _, _) -> + []; +dec_map_extaddgroup_no_val_1(_Name, mandatory, {ext,_,_}, _) -> + []. gen_dec_choice_line(Erule, TopType, Comp, Pre) -> Imm0 = gen_dec_line_imm(Erule, TopType, Comp, false, Pre), @@ -1461,29 +1652,29 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp, Prop}],PrevSt} end end; -gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj) -> - case gen_dec_line_other(Erule, Atype, TopType, Comp) of +gen_dec_line_special(Gen, Atype, TopType, Comp, DecInfObj) -> + case gen_dec_line_other(Gen, Atype, TopType, Comp) of Fun when is_function(Fun, 1) -> fun({BytesVar,PrevSt}) -> Fun(BytesVar), - gen_dec_line_dec_inf(Comp, DecInfObj), + gen_dec_line_dec_inf(Gen,Comp, DecInfObj), {[],PrevSt} end; Imm0 -> {imm,Imm0, fun(Imm, {BytesVar,PrevSt}) -> asn1ct_imm:dec_code_gen(Imm, BytesVar), - gen_dec_line_dec_inf(Comp, DecInfObj), + gen_dec_line_dec_inf(Gen, Comp, DecInfObj), {[],PrevSt} end} end. -gen_dec_line_dec_inf(Comp, DecInfObj) -> +gen_dec_line_dec_inf(Gen, Comp, DecInfObj) -> #'ComponentType'{name=Cname} = Comp, case DecInfObj of {Cname,{_,_OSet,_UniqueFName,ValIndex}} -> Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)), - ValueMatch = value_match(ValIndex,Term), + ValueMatch = value_match(Gen, ValIndex,Term), emit([",",nl, "ObjFun = ",ValueMatch]); _ -> @@ -1705,20 +1896,17 @@ gen_dec_choice2(Erule, TopType, [H0|T], Pos, Sep0, Pre) -> gen_dec_choice2(Erule, TopType, T, Pos+1, Sep, Pre); gen_dec_choice2(_, _, [], _, _, _) -> ok. -make_elements(I,Val,ExtCnames) -> - make_elements(I,Val,ExtCnames,[]). +get_input_vars(Val, I, N) -> + L = get_input_vars_1(Val, I, N), + lists:join(",", L). -make_elements(I,Val,[_ExtCname],Acc)-> % the last one, no comma needed - Element = make_element(I, Val), - make_elements(I+1,Val,[],[Element|Acc]); -make_elements(I,Val,[_ExtCname|Rest],Acc)-> - Element = make_element(I, Val), - make_elements(I+1,Val,Rest,[", ",Element|Acc]); -make_elements(_I,_,[],Acc) -> - lists:reverse(Acc). +get_input_vars_1(_Val, _I, 0) -> + []; +get_input_vars_1(Val, I, N) -> + [get_input_var(Val, I)|get_input_vars_1(Val, I+1, N-1)]. -make_element(I, Val) -> - lists:flatten(io_lib:format("element(~w, ~s)", [I,Val])). +get_input_var(Val, I) -> + lists:flatten(io_lib:format("element(~w, ~s)", [I+1,Val])). emit_extaddgroupTerms(VarSeries,[_]) -> asn1ct_name:new(VarSeries), @@ -1735,62 +1923,66 @@ flat_complist({Rl1,El,Rl2}) -> Rl1 ++ El ++ Rl2; flat_complist({Rl,El}) -> Rl ++ El; flat_complist(CompList) -> CompList. -%%wrap_compList({Root1,Ext,Root2}) -> -%% {Root1,wrap_extensionAdditionGroups(Ext),Root2}; -%%wrap_compList({Root1,Ext}) -> -%% {Root1,wrap_extensionAdditionGroups(Ext)}; -%%wrap_compList(CompList) -> -%% CompList. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Will convert all componentTypes following 'ExtensionAdditionGroup' +%% Convert all componentTypes following 'ExtensionAdditionGroup' %% up to the matching 'ExtensionAdditionGroupEnd' into one componentType -%% of type SEQUENCE with the componentTypes as components +%% of type SEQUENCE with the componentTypes as components. %% -wrap_extensionAdditionGroups(ExtCompList,ExtGroupPosLen) -> - wrap_extensionAdditionGroups(ExtCompList,ExtGroupPosLen,[],0,0). +wrap_extensionAdditionGroups(ExtCompList, ExtGroupPosLen) -> + wrap_eags(ExtCompList, ExtGroupPosLen, 0, 0). -wrap_extensionAdditionGroups([{'ExtensionAdditionGroup',_Number}|Rest], - [{ActualPos,_,_}|ExtGroupPosLenRest],Acc,_ExtAddGroupDiff,ExtGroupNum) -> - {ExtGroupCompList,['ExtensionAdditionGroupEnd'|Rest2]} = +wrap_eags([{'ExtensionAdditionGroup',_Number}|T0], + [{ActualPos,_,_}|Gs], _ExtAddGroupDiff, ExtGroupNum) -> + {ExtGroupCompList,['ExtensionAdditionGroupEnd'|T]} = lists:splitwith(fun(#'ComponentType'{}) -> true; (_) -> false - end, - Rest), - wrap_extensionAdditionGroups(Rest2,ExtGroupPosLenRest, - [#'ComponentType'{ - name=list_to_atom("ExtAddGroup"++ - integer_to_list(ExtGroupNum+1)), - typespec=#type{def=#'SEQUENCE'{ - extaddgroup=ExtGroupNum+1, - components=ExtGroupCompList}}, - textual_order = ActualPos, - prop='OPTIONAL'}|Acc],length(ExtGroupCompList)-1, - ExtGroupNum+1); -wrap_extensionAdditionGroups([H=#'ComponentType'{textual_order=Tord}|T], - ExtAddGrpLenPos,Acc,ExtAddGroupDiff,ExtGroupNum) when is_integer(Tord) -> - wrap_extensionAdditionGroups(T,ExtAddGrpLenPos,[H#'ComponentType'{ - textual_order=Tord - ExtAddGroupDiff}|Acc],ExtAddGroupDiff,ExtGroupNum); -wrap_extensionAdditionGroups([H|T],ExtAddGrpLenPos,Acc,ExtAddGroupDiff,ExtGroupNum) -> - wrap_extensionAdditionGroups(T,ExtAddGrpLenPos,[H|Acc],ExtAddGroupDiff,ExtGroupNum); -wrap_extensionAdditionGroups([],_,Acc,_,_) -> - lists:reverse(Acc). - -value_match(Index,Value) when is_atom(Value) -> - value_match(Index,atom_to_list(Value)); -value_match([],Value) -> + end, T0), + Name = list_to_atom(lists:concat(["ExtAddGroup",ExtGroupNum+1])), + Seq = #type{def=#'SEQUENCE'{extaddgroup=ExtGroupNum+1, + components=ExtGroupCompList}}, + Comp = #'ComponentType'{name=Name, + typespec=Seq, + textual_order=ActualPos, + prop='OPTIONAL'}, + [Comp|wrap_eags(T, Gs, length(ExtGroupCompList)-1, ExtGroupNum+1)]; +wrap_eags([#'ComponentType'{textual_order=Tord}=H|T], + ExtAddGrpLenPos, ExtAddGroupDiff, ExtGroupNum) + when is_integer(Tord) -> + Comp = H#'ComponentType'{textual_order=Tord - ExtAddGroupDiff}, + [Comp|wrap_eags(T, ExtAddGrpLenPos, ExtAddGroupDiff, ExtGroupNum)]; +wrap_eags([H|T], ExtAddGrpLenPos, ExtAddGroupDiff, ExtGroupNum) -> + [H|wrap_eags(T, ExtAddGrpLenPos, ExtAddGroupDiff, ExtGroupNum)]; +wrap_eags([], _, _, _) -> + []. + +value_match(#gen{pack=record}, VIs, Value) -> + value_match_rec(VIs, Value); +value_match(#gen{pack=map}, VIs, Value) -> + value_match_map(VIs, Value). + +value_match_rec([], Value) -> Value; -value_match([{VI,_}|VIs],Value) -> - value_match1(Value,VIs,lists:concat(["element(",VI,","]),1). -value_match1(Value,[],Acc,Depth) -> - Acc ++ Value ++ lists:concat(lists:duplicate(Depth,")")); -value_match1(Value,[{VI,_}|VIs],Acc,Depth) -> - value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1). - -enc_dig_out_value([], Value) -> +value_match_rec([{VI,_}|VIs], Value0) -> + Value = value_match_rec(VIs, Value0), + lists:concat(["element(",VI,", ",Value,")"]). + +value_match_map([], Value) -> + Value; +value_match_map([{_,Name}|VIs], Value0) -> + Value = value_match_map(VIs, Value0), + lists:concat(["maps:get(",Name,", ",Value,")"]). + +enc_dig_out_value(_Gen, [], Value) -> {[],Value}; -enc_dig_out_value([{N,_}|T], Value) -> - {Imm0,Dst0} = enc_dig_out_value(T, Value), +enc_dig_out_value(#gen{pack=record}=Gen, [{N,_}|T], Value) -> + {Imm0,Dst0} = enc_dig_out_value(Gen, T, Value), {Imm,Dst} = asn1ct_imm:enc_element(N, Dst0), + {Imm0++Imm,Dst}; +enc_dig_out_value(#gen{pack=map}, [{N,'ASN1_top'}], _Value) -> + {[],{var,lists:concat(["Input@",N-1])}}; +enc_dig_out_value(#gen{pack=map}=Gen, [{_,Name}|T], Value) -> + {Imm0,Dst0} = enc_dig_out_value(Gen, T, Value), + {Imm,Dst} = asn1ct_imm:enc_maps_get(Name, Dst0), {Imm0++Imm,Dst}. make_var(Base) -> diff --git a/lib/asn1/src/asn1ct_eval_ext.funcs b/lib/asn1/src/asn1ct_eval_ext.funcs index 5761901f89..01c67e7b5a 100644 --- a/lib/asn1/src/asn1ct_eval_ext.funcs +++ b/lib/asn1/src/asn1ct_eval_ext.funcs @@ -1 +1,2 @@ {ext,transform_to_EXTERNAL1994,1}. +{ext,transform_to_EXTERNAL1994_maps,1}. diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index bfaffa13bf..4fa830d7d9 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -34,10 +34,10 @@ insert_once/2, ct_gen_module/1, index2suffix/1, - get_record_name_prefix/0, + get_record_name_prefix/1, conform_value/2, named_bitstring_value/2]). --export([pgen/5, +-export([pgen/4, mk_var/1, un_hyphen_var/1]). -export([gen_encode_constructed/4, @@ -45,23 +45,20 @@ -define(SUPPRESSION_FUNC, 'dialyzer-suppressions'). + %% pgen(Outfile, Erules, Module, TypeOrVal, Options) -%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module -%% .hrl file is only generated if necessary -%% Erules = per | ber -%% Module = atom() -%% TypeOrVal = {TypeList,ValueList} -%% TypeList = ValueList = [atom()] -%% Options = [Options] from asn1ct:compile() - -pgen(OutFile,Erules,Module,TypeOrVal,Options) -> - pgen_module(OutFile,Erules,Module,TypeOrVal,Options,true). - - -pgen_module(OutFile,Erules,Module, - TypeOrVal = {Types,_Values,_Ptypes,_Classes,_Objects,_ObjectSets}, - Options,Indent) -> - N2nConvEnums = [CName|| {n2n,CName} <- get(encoding_options)], +%% Generate Erlang module (.erl) and (.hrl) file corresponding to +%% an ASN.1 module. The .hrl file is only generated if necessary. + +-spec pgen(Outfile, Gen, Module, Contents) -> 'ok' when + Outfile :: any(), + Gen :: #gen{}, + Module :: module(), + Contents :: tuple(). + +pgen(OutFile, #gen{options=Options}=Gen, Module, Contents) -> + {Types,_Values,_Ptypes,_Classes,_Objects,_ObjectSets} = Contents, + N2nConvEnums = [CName|| {n2n,CName} <- Options], case N2nConvEnums -- Types of [] -> ok; @@ -70,29 +67,28 @@ pgen_module(OutFile,Erules,Module, UnmatchedTypes}) end, put(outfile,OutFile), - HrlGenerated = pgen_hrl(Erules,Module,TypeOrVal,Options,Indent), + put(currmod, Module), + HrlGenerated = pgen_hrl(Gen, Module, Contents), asn1ct_name:start(), ErlFile = lists:concat([OutFile,".erl"]), _ = open_output_file(ErlFile), asn1ct_func:start_link(), - gen_head(Erules,Module,HrlGenerated), - pgen_exports(Erules,Module,TypeOrVal), - pgen_dispatcher(Erules,Module,TypeOrVal), + gen_head(Gen, Module, HrlGenerated), + pgen_exports(Gen, Module, Contents), + pgen_dispatcher(Gen, Contents), pgen_info(), - pgen_typeorval(Erules,Module,N2nConvEnums,TypeOrVal), - pgen_partial_incomplete_decode(Erules), -% gen_vars(asn1_db:mod_to_vars(Module)), -% gen_tag_table(AllTypes), + pgen_typeorval(Gen, Module, N2nConvEnums, Contents), + pgen_partial_incomplete_decode(Gen), emit([nl, "%%%",nl, "%%% Run-time functions.",nl, "%%%",nl]), - dialyzer_suppressions(Erules), + dialyzer_suppressions(Gen), Fd = get(gen_file_out), asn1ct_func:generate(Fd), close_output_file(), _ = erase(outfile), - asn1ct:verbose("--~p--~n",[{generated,ErlFile}],Options). + asn1ct:verbose("--~p--~n", [{generated,ErlFile}], Gen). dialyzer_suppressions(Erules) -> emit([nl, @@ -181,10 +177,10 @@ pgen_objectsets(Rtmod,Erules,Module,[H|T]) -> Rtmod:gen_objectset_code(Erules,TypeDef), pgen_objectsets(Rtmod,Erules,Module,T). -pgen_partial_decode(Rtmod,Erule,Module) when Erule == ber -> - pgen_partial_inc_dec(Rtmod,Erule,Module), - pgen_partial_dec(Rtmod,Erule,Module); -pgen_partial_decode(_,_,_) -> +pgen_partial_decode(Rtmod, #gen{erule=ber}=Gen, Module) -> + pgen_partial_inc_dec(Rtmod, Gen, Module), + pgen_partial_dec(Rtmod, Gen, Module); +pgen_partial_decode(_, _, _) -> ok. pgen_partial_inc_dec(Rtmod,Erules,Module) -> @@ -225,7 +221,7 @@ pgen_partial_inc_dec1(Rtmod,Erules,Module,[P|Ps]) -> pgen_partial_inc_dec1(_,_,_,[]) -> ok. -gen_partial_inc_dec_refed_funcs(Rtmod,Erule) when Erule == ber -> +gen_partial_inc_dec_refed_funcs(Rtmod, #gen{erule=ber}=Gen) -> case asn1ct:next_refed_func() of [] -> ok; @@ -233,19 +229,17 @@ gen_partial_inc_dec_refed_funcs(Rtmod,Erule) when Erule == ber -> TypeDef = asn1_db:dbget(M,Name), asn1ct:update_gen_state(namelist,Pattern), asn1ct:set_current_sindex(Sindex), - Rtmod:gen_inc_decode(Erule,TypeDef), - gen_dec_part_inner_constr(Rtmod,Erule,TypeDef,[Name]), - gen_partial_inc_dec_refed_funcs(Rtmod,Erule); + Rtmod:gen_inc_decode(Gen, TypeDef), + gen_dec_part_inner_constr(Rtmod, Gen, TypeDef, [Name]), + gen_partial_inc_dec_refed_funcs(Rtmod, Gen); {Name,Sindex,Pattern,Type} -> TypeDef=#typedef{name=asn1ct_gen:list2name(Name),typespec=Type}, asn1ct:update_gen_state(namelist,Pattern), asn1ct:set_current_sindex(Sindex), - Rtmod:gen_inc_decode(Erule,TypeDef), - gen_dec_part_inner_constr(Rtmod,Erule,TypeDef,Name), - gen_partial_inc_dec_refed_funcs(Rtmod,Erule) - end; -gen_partial_inc_dec_refed_funcs(_,_) -> - ok. + Rtmod:gen_inc_decode(Gen, TypeDef), + gen_dec_part_inner_constr(Rtmod, Gen, TypeDef, Name), + gen_partial_inc_dec_refed_funcs(Rtmod, Gen) + end. pgen_partial_dec(_Rtmod,Erules,_Module) -> Type_pattern = asn1ct:get_gen_state_field(type_pattern), @@ -254,16 +248,16 @@ pgen_partial_dec(_Rtmod,Erules,_Module) -> pgen_partial_types(Erules,Type_pattern), ok. -pgen_partial_types(Erules,Type_pattern) -> - % until this functionality works on all back-ends - Options = get(encoding_options), - case lists:member(asn1config,Options) of +pgen_partial_types(#gen{options=Options}=Gen, TypePattern) -> + %% until this functionality works on all back-ends + case lists:member(asn1config, Options) of true -> - pgen_partial_types1(Erules,Type_pattern); - _ -> ok + pgen_partial_types1(Gen, TypePattern); + false -> + ok end. - + pgen_partial_types1(Erules,[{FuncName,[TopType|RestTypes]}|Rest]) -> % emit([FuncName,"(Bytes) ->",nl]), CurrMod = get(currmod), @@ -441,7 +435,8 @@ pgen_partial_incomplete_decode(Erule) -> _ -> ok end. -pgen_partial_incomplete_decode1(ber) -> + +pgen_partial_incomplete_decode1(#gen{erule=ber}) -> case asn1ct:read_config_data(partial_incomplete_decode) of undefined -> ok; @@ -451,7 +446,7 @@ pgen_partial_incomplete_decode1(ber) -> GeneratedFs= asn1ct:get_gen_state_field(gen_refed_funcs), % io:format("GeneratedFs :~n~p~n",[GeneratedFs]), gen_part_decode_funcs(GeneratedFs,0); -pgen_partial_incomplete_decode1(_) -> ok. +pgen_partial_incomplete_decode1(#gen{}) -> ok. emit_partial_incomplete_decode({FuncName,TopType,Pattern}) -> TypePattern = asn1ct:get_gen_state_field(inc_type_pattern), @@ -654,29 +649,30 @@ gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,typedef) -> gen_decode_constructed(Erules,Typename,InnerType,D#typedef.typespec). -pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> - emit(["-export([encoding_rule/0,bit_string_format/0,",nl, +pgen_exports(#gen{options=Options}=Gen, _Module, Contents) -> + {Types,Values,_,_,Objects,ObjectSets} = Contents, + emit(["-export([encoding_rule/0,maps/0,bit_string_format/0,",nl, " legacy_erlang_types/0]).",nl]), emit(["-export([",{asis,?SUPPRESSION_FUNC},"/1]).",nl]), case Types of [] -> ok; _ -> emit({"-export([",nl}), - case Erules of - ber -> + case Gen of + #gen{erule=ber} -> gen_exports1(Types,"enc_",2); _ -> gen_exports1(Types,"enc_",1) end, emit({"-export([",nl}), - case Erules of - ber -> + case Gen of + #gen{erule=ber} -> gen_exports1(Types, "dec_", 2); _ -> gen_exports1(Types, "dec_", 1) end end, - case [X || {n2n,X} <- get(encoding_options)] of + case [X || {n2n,X} <- Options] of [] -> ok; A2nNames -> emit({"-export([",nl}), @@ -693,10 +689,10 @@ pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> case Objects of [] -> ok; _ -> - case erule(Erules) of - per -> - ok; - ber -> + case Gen of + #gen{erule=per} -> + ok; + #gen{erule=ber} -> emit({"-export([",nl}), gen_exports1(Objects,"enc_",3), emit({"-export([",nl}), @@ -706,10 +702,10 @@ pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> case ObjectSets of [] -> ok; _ -> - case erule(Erules) of - per -> - ok; - ber -> + case Gen of + #gen{erule=per} -> + ok; + #gen{erule=ber} -> emit({"-export([",nl}), gen_exports1(ObjectSets, "getenc_",1), emit({"-export([",nl}), @@ -735,16 +731,17 @@ gen_partial_inc_decode_exports() -> {_,undefined} -> ok; {Data,_} -> - gen_partial_inc_decode_exports(Data), + gen_partial_inc_decode_exports0(Data), emit(["-export([decode_part/2]).",nl]) end. -gen_partial_inc_decode_exports([]) -> + +gen_partial_inc_decode_exports0([]) -> ok; -gen_partial_inc_decode_exports([{Name,_,_}|Rest]) -> +gen_partial_inc_decode_exports0([{Name,_,_}|Rest]) -> emit(["-export([",Name,"/1"]), gen_partial_inc_decode_exports1(Rest); -gen_partial_inc_decode_exports([_|Rest]) -> - gen_partial_inc_decode_exports(Rest). +gen_partial_inc_decode_exports0([_|Rest]) -> + gen_partial_inc_decode_exports0(Rest). gen_partial_inc_decode_exports1([]) -> emit(["]).",nl]); @@ -773,27 +770,27 @@ gen_selected_decode_exports1([{FuncName,_}|Rest]) -> emit([",",nl," ",FuncName,"/1"]), gen_selected_decode_exports1(Rest). -pgen_dispatcher(Erules,_Module,{[],_Values,_,_,_Objects,_ObjectSets}) -> +pgen_dispatcher(Erules, {[],_Values,_,_,_Objects,_ObjectSets}) -> gen_info_functions(Erules); -pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> +pgen_dispatcher(Gen, {Types,_Values,_,_,_Objects,_ObjectSets}) -> emit(["-export([encode/2,decode/2]).",nl,nl]), - gen_info_functions(Erules), + gen_info_functions(Gen), - Options = get(encoding_options), + Options = Gen#gen.options, NoFinalPadding = lists:member(no_final_padding, Options), NoOkWrapper = proplists:get_bool(no_ok_wrapper, Options), - Call = case Erules of - per -> - asn1ct_func:need({Erules,complete,1}), + Call = case Gen of + #gen{erule=per,aligned=true} -> + asn1ct_func:need({per,complete,1}), "complete(encode_disp(Type, Data))"; - ber -> + #gen{erule=ber} -> "iolist_to_binary(element(1, encode_disp(Type, Data)))"; - uper when NoFinalPadding == true -> - asn1ct_func:need({Erules,complete_NFP,1}), + #gen{erule=per,aligned=false} when NoFinalPadding -> + asn1ct_func:need({uper,complete_NFP,1}), "complete_NFP(encode_disp(Type, Data))"; - uper -> - asn1ct_func:need({Erules,complete,1}), + #gen{erule=per,aligned=false} -> + asn1ct_func:need({uper,complete,1}), "complete(encode_disp(Type, Data))" end, @@ -809,36 +806,36 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> end, emit([nl,nl]), - Return_rest = proplists:get_bool(undec_rest, Options), - Data = case {Erules,Return_rest} of - {ber,true} -> "Data0"; - _ -> "Data" + ReturnRest = proplists:get_bool(undec_rest, Gen#gen.options), + Data = case Gen#gen.erule =:= ber andalso ReturnRest of + true -> "Data0"; + false -> "Data" end, emit(["decode(Type,",Data,") ->",nl]), DecWrap = - case {Erules,Return_rest} of - {ber,false} -> + case {Gen,ReturnRest} of + {#gen{erule=ber},false} -> asn1ct_func:need({ber,ber_decode_nif,1}), "element(1, ber_decode_nif(Data))"; - {ber,true} -> + {#gen{erule=ber},true} -> asn1ct_func:need({ber,ber_decode_nif,1}), emit(["{Data,Rest} = ber_decode_nif(Data0),",nl]), "Data"; - _ -> + {_,_} -> "Data" end, emit([case NoOkWrapper of false -> "try"; true -> "case" end, " decode_disp(Type, ",DecWrap,") of",nl]), - case erule(Erules) of - ber -> + case Gen of + #gen{erule=ber} -> emit([" Result ->",nl]); - per -> + #gen{erule=per} -> emit([" {Result,Rest} ->",nl]) end, - case Return_rest of + case ReturnRest of false -> result_line(NoOkWrapper, ["Result"]); true -> result_line(NoOkWrapper, ["Result","Rest"]) end, @@ -849,14 +846,14 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> emit([nl,"end.",nl,nl]) end, - gen_decode_partial_incomplete(Erules), + gen_decode_partial_incomplete(Gen), - case Erules of - ber -> + case Gen of + #gen{erule=ber} -> gen_dispatcher(Types,"encode_disp","enc_",""), gen_dispatcher(Types,"decode_disp","dec_",""), gen_partial_inc_dispatcher(); - _PerOrPer_bin -> + #gen{} -> gen_dispatcher(Types,"encode_disp","enc_",""), gen_dispatcher(Types,"decode_disp","dec_","") end, @@ -885,15 +882,26 @@ try_catch() -> " end",nl, "end."]. -gen_info_functions(Erules) -> +gen_info_functions(Gen) -> + Erule = case Gen of + #gen{erule=ber} -> ber; + #gen{erule=per,aligned=false} -> uper; + #gen{erule=per,aligned=true} -> per + end, + Maps = case Gen of + #gen{pack=record} -> false; + #gen{pack=map} -> true + end, emit(["encoding_rule() -> ", - {asis,Erules},".",nl,nl, + {asis,Erule},".",nl,nl, + "maps() -> ", + {asis,Maps},".",nl,nl, "bit_string_format() -> ", {asis,asn1ct:get_bit_string_format()},".",nl,nl, "legacy_erlang_types() -> ", {asis,asn1ct:use_legacy_types()},".",nl,nl]). -gen_decode_partial_incomplete(ber) -> +gen_decode_partial_incomplete(#gen{erule=ber}) -> case {asn1ct:read_config_data(partial_incomplete_decode), asn1ct:get_gen_state_field(inc_type_pattern)} of {undefined,_} -> @@ -931,7 +939,7 @@ gen_decode_partial_incomplete(ber) -> EmitCaseClauses(), emit([".",nl,nl]) end; -gen_decode_partial_incomplete(_Erule) -> +gen_decode_partial_incomplete(#gen{}) -> ok. gen_partial_inc_dispatcher() -> @@ -1092,22 +1100,21 @@ open_output_file(F) -> close_output_file() -> ok = file:close(erase(gen_file_out)). -pgen_hrl(Erules,Module,TypeOrVal,Options,_Indent) -> - put(currmod,Module), - {Types,Values,Ptypes,_,_,_} = TypeOrVal, +pgen_hrl(#gen{pack=record}=Gen, Module, Contents) -> + {Types,Values,Ptypes,_,_,_} = Contents, Ret = - case pgen_hrltypes(Erules,Module,Ptypes++Types,0) of + case pgen_hrltypes(Gen, Module, Ptypes++Types, 0) of 0 -> case Values of [] -> 0; _ -> - open_hrl(get(outfile),get(currmod)), - pgen_macros(Erules,Module,Values), + open_hrl(get(outfile), Module), + pgen_macros(Gen, Module, Values), 1 end; X -> - pgen_macros(Erules,Module,Values), + pgen_macros(Gen, Module, Values), X end, case Ret of @@ -1119,62 +1126,61 @@ pgen_hrl(Erules,Module,TypeOrVal,Options,_Indent) -> close_output_file(), asn1ct:verbose("--~p--~n", [{generated,lists:concat([get(outfile),".hrl"])}], - Options), + Gen), Y - end. + end; +pgen_hrl(#gen{pack=map}, _, _) -> + 0. pgen_macros(_,_,[]) -> true; -pgen_macros(Erules,Module,[H|T]) -> - Valuedef = asn1_db:dbget(Module,H), - gen_macro(Valuedef), - pgen_macros(Erules,Module,T). +pgen_macros(Gen, Module, [H|T]) -> + Valuedef = asn1_db:dbget(Module, H), + gen_macro(Gen, Valuedef), + pgen_macros(Gen, Module, T). pgen_hrltypes(_,_,[],NumRecords) -> NumRecords; -pgen_hrltypes(Erules,Module,[H|T],NumRecords) -> -% io:format("records = ~p~n",NumRecords), - Typedef = asn1_db:dbget(Module,H), - AddNumRecords = gen_record(Typedef,NumRecords), - pgen_hrltypes(Erules,Module,T,NumRecords+AddNumRecords). +pgen_hrltypes(Gen, Module, [H|T], NumRecords) -> + Typedef = asn1_db:dbget(Module, H), + AddNumRecords = gen_record(Gen, Typedef, NumRecords), + pgen_hrltypes(Gen, Module, T, NumRecords+AddNumRecords). %% Generates a macro for value Value defined in the ASN.1 module -gen_macro(Value) when is_record(Value,valuedef) -> - Prefix = get_macro_name_prefix(), - emit({"-define('",Prefix,Value#valuedef.name,"', ", - {asis,Value#valuedef.value},").",nl}). +gen_macro(Gen, #valuedef{name=Name,value=Value}) -> + Prefix = get_macro_name_prefix(Gen), + emit(["-define('",Prefix,Name,"', ",{asis,Value},").",nl]). %% Generate record functions ************** %% Generates an Erlang record for each named and unnamed SEQUENCE and SET in the ASN.1 %% module. If no SEQUENCE or SET is found there is no .hrl file generated -gen_record(Tdef,NumRecords) when is_record(Tdef,typedef) -> +gen_record(Gen, #typedef{}=Tdef, NumRecords) -> Name = [Tdef#typedef.name], Type = Tdef#typedef.typespec, - gen_record(type,Name,Type,NumRecords); - -gen_record(Tdef,NumRecords) when is_record(Tdef,ptypedef) -> + gen_record(Gen, type, Name, Type, NumRecords); +gen_record(Gen, #ptypedef{}=Tdef, NumRecords) -> Name = [Tdef#ptypedef.name], Type = Tdef#ptypedef.typespec, - gen_record(ptype,Name,Type,NumRecords). - -gen_record(TorPtype,Name,[#'ComponentType'{name=Cname,typespec=Type}|T],Num) -> - Num2 = gen_record(TorPtype,[Cname|Name],Type,Num), - gen_record(TorPtype,Name,T,Num2); -gen_record(TorPtype,Name,{Clist1,Clist2},Num) + gen_record(Gen, ptype, Name, Type, NumRecords). + +gen_record(Gen, TorPtype, Name, + [#'ComponentType'{name=Cname,typespec=Type}|T], Num) -> + Num2 = gen_record(Gen, TorPtype, [Cname|Name], Type, Num), + gen_record(Gen, TorPtype, Name, T, Num2); +gen_record(Gen, TorPtype, Name, {Clist1,Clist2}, Num) when is_list(Clist1), is_list(Clist2) -> - gen_record(TorPtype,Name,Clist1++Clist2,Num); -gen_record(TorPtype,Name,{Clist1,EClist,Clist2},Num) + gen_record(Gen, TorPtype, Name, Clist1++Clist2, Num); +gen_record(Gen, TorPtype, Name, {Clist1,EClist,Clist2}, Num) when is_list(Clist1), is_list(EClist), is_list(Clist2) -> - gen_record(TorPtype,Name,Clist1++EClist++Clist2,Num); -gen_record(TorPtype,Name,[_|T],Num) -> % skip EXTENSIONMARK - gen_record(TorPtype,Name,T,Num); -gen_record(_TorPtype,_Name,[],Num) -> + gen_record(Gen, TorPtype, Name, Clist1++EClist++Clist2, Num); +gen_record(Gen, TorPtype, Name, [_|T], Num) -> % skip EXTENSIONMARK + gen_record(Gen, TorPtype, Name, T, Num); +gen_record(_Gen, _TorPtype, _Name, [], Num) -> Num; - -gen_record(TorPtype,Name,Type,Num) when is_record(Type,type) -> +gen_record(Gen, TorPtype, Name, #type{}=Type, Num) -> Def = Type#type.def, Rec = case Def of Seq when is_record(Seq,'SEQUENCE') -> @@ -1209,7 +1215,7 @@ gen_record(TorPtype,Name,Type,Num) when is_record(Type,type) -> 0 -> open_hrl(get(outfile),get(currmod)); _ -> true end, - Prefix = get_record_name_prefix(), + Prefix = get_record_name_prefix(Gen), emit({"-record('",Prefix,list2name(Name),"',{",nl}), RootList = case CompList of _ when is_list(CompList) -> @@ -1260,33 +1266,28 @@ gen_record(TorPtype,Name,Type,Num) when is_record(Type,type) -> emit({"}).",nl,nl}), CompList end, - gen_record(TorPtype,Name,NewCompList,Num+1); + gen_record(Gen, TorPtype, Name, NewCompList, Num+1); {inner,{'CHOICE', CompList}} -> - gen_record(TorPtype,Name,CompList,Num); + gen_record(Gen, TorPtype, Name, CompList, Num); {NewName,{_, CompList}} -> - gen_record(TorPtype,NewName,CompList,Num) + gen_record(Gen, TorPtype, NewName, CompList, Num) end; -gen_record(_,_,_,NumRecords) -> % skip CLASS etc for now. +gen_record(_, _, _, _, NumRecords) -> % skip CLASS etc for now. NumRecords. - -gen_head(Erules,Mod,Hrl) -> - Options = get(encoding_options), - case Erules of - per -> - emit(["%% Generated by the Erlang ASN.1 PER-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl]); - ber -> - emit(["%% Generated by the Erlang ASN.1 BER_V2-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl]); - uper -> - emit(["%% Generated by the Erlang ASN.1 UNALIGNED" - " PER-compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl]) - end, - emit({"%% Purpose: encoder and decoder to the types in mod ",Mod,nl,nl}), - emit({"-module('",Mod,"').",nl}), + +gen_head(#gen{options=Options}=Gen, Mod, Hrl) -> + Name = case Gen of + #gen{erule=per,aligned=false} -> + "PER (unaligned)"; + #gen{erule=per,aligned=true} -> + "PER (aligned)"; + #gen{erule=ber} -> + "BER" + end, + emit(["%% Generated by the Erlang ASN.1 ",Name, + "compiler. Version:",asn1ct:vsn(),nl, + "%% Purpose: encoder and decoder of the types in ",Mod,nl,nl, + "-module('",Mod,"').",nl]), put(currmod,Mod), emit({"-compile(nowarn_unused_vars).",nl}), emit({"-dialyzer(no_improper_lists).",nl}), @@ -1297,7 +1298,7 @@ gen_head(Erules,Mod,Hrl) -> emit(["-asn1_info([{vsn,'",asn1ct:vsn(),"'},",nl, " {module,'",Mod,"'},",nl, " {options,",io_lib:format("~p",[Options]),"}]).",nl,nl]). - + gen_hrlhead(Mod) -> emit({"%% Generated by the Erlang ASN.1 compiler version:",asn1ct:vsn(),nl}), @@ -1585,27 +1586,19 @@ constructed_suffix('SEQUENCE OF',_) -> constructed_suffix('SET OF',_) -> 'SETOF'. -erule(ber) -> ber; -erule(per) -> per; -erule(uper) -> per. - index2suffix(0) -> ""; index2suffix(N) -> lists:concat(["_",N]). -ct_gen_module(ber) -> +ct_gen_module(#gen{erule=ber}) -> asn1ct_gen_ber_bin_v2; -ct_gen_module(per) -> - asn1ct_gen_per; -ct_gen_module(uper) -> +ct_gen_module(#gen{erule=per}) -> asn1ct_gen_per. -ct_constructed_module(ber) -> +ct_constructed_module(#gen{erule=ber}) -> asn1ct_constructed_ber_bin_v2; -ct_constructed_module(per) -> - asn1ct_constructed_per; -ct_constructed_module(uper) -> +ct_constructed_module(#gen{erule=per}) -> asn1ct_constructed_per. get_constraint(C,Key) -> @@ -1617,19 +1610,9 @@ get_constraint(C,Key) -> {value,Cnstr} -> Cnstr end. - -get_record_name_prefix() -> - case lists:keysearch(record_name_prefix,1,get(encoding_options)) of - false -> - ""; - {value,{_,Prefix}} -> - Prefix - end. -get_macro_name_prefix() -> - case lists:keysearch(macro_name_prefix,1,get(encoding_options)) of - false -> - ""; - {value,{_,Prefix}} -> - Prefix - end. +get_record_name_prefix(#gen{rec_prefix=Prefix}) -> + Prefix. + +get_macro_name_prefix(#gen{macro_prefix=Prefix}) -> + Prefix. diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index b884d14b0d..6c6d4193f3 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -1200,11 +1200,13 @@ gen_objset_enc(Erules, ObjSetName, UniqueName, {no_mod,no_name} -> gen_inlined_enc_funs(Fields, ClFields, ObjSetName, Val, NthObj); {CurrMod,Name} -> - emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl, + emit(["'getenc_",ObjSetName,"'(Id) when Id =:= ", + {asis,Val}," ->",nl, " fun 'enc_",Name,"'/3;",nl]), {[],NthObj}; {ModuleName,Name} -> - emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl]), + emit(["'getenc_",ObjSetName,"'(Id) when Id =:= ", + {asis,Val}," ->",nl]), emit_ext_fun(enc,ModuleName,Name), emit([";",nl]), {[],NthObj}; @@ -1382,11 +1384,13 @@ gen_objset_dec(Erules, ObjSName, UniqueName, [{ObjName,Val,Fields}|T], {no_mod,no_name} -> gen_inlined_dec_funs(Fields,ClFields,ObjSName,Val,NthObj); {CurrMod,Name} -> - emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl, + emit(["'getdec_",ObjSName,"'(Id) when Id =:= ", + {asis,Val}," ->",nl, " fun 'dec_",Name,"'/3;", nl]), NthObj; {ModuleName,Name} -> - emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl]), + emit(["'getdec_",ObjSName,"'(Id) when Id =:= ", + {asis,Val}," ->",nl]), emit_ext_fun(dec,ModuleName,Name), emit([";",nl]), NthObj; diff --git a/lib/asn1/src/asn1ct_gen_check.erl b/lib/asn1/src/asn1ct_gen_check.erl index abe77dd0cb..ccc62a3ce3 100644 --- a/lib/asn1/src/asn1ct_gen_check.erl +++ b/lib/asn1/src/asn1ct_gen_check.erl @@ -21,45 +21,51 @@ %% -module(asn1ct_gen_check). --export([emit/3]). +-export([emit/4]). -import(asn1ct_gen, [emit/1]). -include("asn1_records.hrl"). -emit(Type, Default, Value) -> +emit(Gen, Type, Default, Value) -> Key = {Type,Default}, - Gen = fun(Fd, Name) -> - file:write(Fd, gen(Name, Type, Default)) - end, + DoGen = fun(Fd, Name) -> + file:write(Fd, gen(Gen, Name, Type, Default)) + end, emit(" case "), - asn1ct_func:call_gen("is_default_", Key, Gen, [Value]), + asn1ct_func:call_gen("is_default_", Key, DoGen, [Value]), emit([" of",nl, "true -> {[],0};",nl, "false ->",nl]). -gen(Name, #type{def=T}, Default) -> +gen(#gen{pack=Pack}=Gen, Name, #type{def=T}, Default) -> + DefMarker = case Pack of + record -> "asn1_DEFAULT"; + map -> atom_to_list(?MISSING_IN_MAP) + end, NameStr = atom_to_list(Name), - [NameStr,"(asn1_DEFAULT) ->\n", - "true;\n"|case do_gen(T, Default) of - {literal,Literal} -> - [NameStr,"(",term2str(Literal),") ->\n","true;\n", - NameStr,"(_) ->\n","false.\n\n"]; - {exception,Func,Args} -> - [NameStr,"(Value) ->\n", - "try ",Func,"(Value",arg2str(Args),") of\n", - "_ -> true\n" - "catch throw:false -> false\n" - "end.\n\n"] - end]. + [NameStr,"(",DefMarker,") ->\n", + "true;\n"| + case do_gen(Gen, T, Default) of + {literal,Literal} -> + [NameStr,"(Def) when Def =:= ",term2str(Literal)," ->\n", + "true;\n", + NameStr,"(_) ->\n","false.\n\n"]; + {exception,Func,Args} -> + [NameStr,"(Value) ->\n", + "try ",Func,"(Value",arg2str(Args),") of\n", + "_ -> true\n" + "catch throw:false -> false\n" + "end.\n\n"] + end]. -do_gen(_, asn1_NOVALUE) -> +do_gen(_Gen, _, asn1_NOVALUE) -> {literal,asn1_NOVALUE}; -do_gen(#'Externaltypereference'{module=M,type=T}, Default) -> +do_gen(Gen, #'Externaltypereference'{module=M,type=T}, Default) -> #typedef{typespec=#type{def=Td}} = asn1_db:dbget(M, T), - do_gen(Td, Default); -do_gen('BOOLEAN', Default) -> + do_gen(Gen, Td, Default); +do_gen(_Gen, 'BOOLEAN', Default) -> {literal,Default}; -do_gen({'BIT STRING',[]}, Default) -> +do_gen(_Gen, {'BIT STRING',[]}, Default) -> true = is_bitstring(Default), %Assertion. case asn1ct:use_legacy_types() of false -> @@ -67,17 +73,17 @@ do_gen({'BIT STRING',[]}, Default) -> true -> {exception,need(check_legacy_bitstring, 2),[Default]} end; -do_gen({'BIT STRING',[_|_]=NBL}, Default) -> +do_gen(_Gen, {'BIT STRING',[_|_]=NBL}, Default) -> do_named_bitstring(NBL, Default); -do_gen({'ENUMERATED',_}, Default) -> +do_gen(_Gen, {'ENUMERATED',_}, Default) -> {literal,Default}; -do_gen('INTEGER', Default) -> +do_gen(_Gen, 'INTEGER', Default) -> {literal,Default}; -do_gen({'INTEGER',NNL}, Default) -> +do_gen(_Gen, {'INTEGER',NNL}, Default) -> {exception,need(check_int, 3),[Default,NNL]}; -do_gen('NULL', Default) -> +do_gen(_Gen, 'NULL', Default) -> {literal,Default}; -do_gen('OCTET STRING', Default) -> +do_gen(_Gen, 'OCTET STRING', Default) -> true = is_binary(Default), %Assertion. case asn1ct:use_legacy_types() of false -> @@ -85,34 +91,34 @@ do_gen('OCTET STRING', Default) -> true -> {exception,need(check_octetstring, 2),[Default]} end; -do_gen('OBJECT IDENTIFIER', Default0) -> +do_gen(_Gen, 'OBJECT IDENTIFIER', Default0) -> Default = pre_process_oid(Default0), {exception,need(check_objectidentifier, 2),[Default]}; -do_gen({'CHOICE',Cs}, Default) -> +do_gen(Gen, {'CHOICE',Cs}, Default) -> {Tag,Value} = Default, [Type] = [Type || #'ComponentType'{name=T,typespec=Type} <- Cs, T =:= Tag], - case do_gen(Type#type.def, Value) of + case do_gen(Gen, Type#type.def, Value) of {literal,Lit} -> {literal,{Tag,Lit}}; {exception,Func0,Args} -> Key = {Tag,Func0,Args}, - Gen = fun(Fd, Name) -> - S = gen_choice(Name, Tag, Func0, Args), - ok = file:write(Fd, S) + DoGen = fun(Fd, Name) -> + S = gen_choice(Name, Tag, Func0, Args), + ok = file:write(Fd, S) end, - Func = asn1ct_func:call_gen("is_default_choice", Key, Gen), + Func = asn1ct_func:call_gen("is_default_choice", Key, DoGen), {exception,atom_to_list(Func),[]} end; -do_gen(#'SEQUENCE'{components=Cs}, Default) -> - do_seq_set(Cs, Default); -do_gen({'SEQUENCE OF',Type}, Default) -> - do_sof(Type, Default); -do_gen(#'SET'{components=Cs}, Default) -> - do_seq_set(Cs, Default); -do_gen({'SET OF',Type}, Default) -> - do_sof(Type, Default); -do_gen(Type, Default) -> +do_gen(Gen, #'SEQUENCE'{components=Cs}, Default) -> + do_seq_set(Gen, Cs, Default); +do_gen(Gen, {'SEQUENCE OF',Type}, Default) -> + do_sof(Gen, Type, Default); +do_gen(Gen, #'SET'{components=Cs}, Default) -> + do_seq_set(Gen, Cs, Default); +do_gen(Gen, {'SET OF',Type}, Default) -> + do_sof(Gen, Type, Default); +do_gen(_Gen, Type, Default) -> case asn1ct_gen:unify_if_string(Type) of restrictedstring -> {exception,need(check_restrictedstring, 2),[Default]}; @@ -136,39 +142,58 @@ do_named_bitstring(_, Default) when is_bitstring(Default) -> end, {exception,need(Func, 3),[Default,bit_size(Default)]}. -do_seq_set(Cs0, Default) -> +do_seq_set(#gen{pack=record}=Gen, Cs0, Default) -> Tag = element(1, Default), Cs1 = [T || #'ComponentType'{typespec=T} <- Cs0], - Cs = components(Cs1, tl(tuple_to_list(Default))), + Cs = components(Gen, Cs1, tl(tuple_to_list(Default))), case are_all_literals(Cs) of true -> Literal = list_to_tuple([Tag|[L || {literal,L} <- Cs]]), {literal,Literal}; false -> Key = {Cs,Default}, - Gen = fun(Fd, Name) -> - S = gen_components(Name, Tag, Cs), - ok = file:write(Fd, S) - end, - Func = asn1ct_func:call_gen("is_default_cs_", Key, Gen), + DoGen = fun(Fd, Name) -> + S = gen_components(Name, Tag, Cs), + ok = file:write(Fd, S) + end, + Func = asn1ct_func:call_gen("is_default_cs_", Key, DoGen), + {exception,atom_to_list(Func),[]} + end; +do_seq_set(#gen{pack=map}=Gen, Cs0, Default) -> + Cs1 = [{N,T} || #'ComponentType'{name=N,typespec=T} <- Cs0], + Cs = map_components(Gen, Cs1, Default), + AllLiterals = lists:all(fun({_,{literal,_}}) -> true; + ({_,_}) -> false + end, Cs), + case AllLiterals of + true -> + L = [{Name,Lit} || {Name,{literal,Lit}} <- Cs], + {literal,maps:from_list(L)}; + false -> + Key = {Cs,Default}, + DoGen = fun(Fd, Name) -> + S = gen_map_components(Name, Cs), + ok = file:write(Fd, S) + end, + Func = asn1ct_func:call_gen("is_default_cs_", Key, DoGen), {exception,atom_to_list(Func),[]} end. -do_sof(Type, Default0) -> +do_sof(Gen, Type, Default0) -> Default = lists:sort(Default0), Cs0 = lists:duplicate(length(Default), Type), - Cs = components(Cs0, Default), + Cs = components(Gen, Cs0, Default), case are_all_literals(Cs) of true -> Literal = [Lit || {literal,Lit} <- Cs], {exception,need(check_literal_sof, 2),[Literal]}; false -> Key = Cs, - Gen = fun(Fd, Name) -> - S = gen_sof(Name, Cs), - ok = file:write(Fd, S) + DoGen = fun(Fd, Name) -> + S = gen_sof(Name, Cs), + ok = file:write(Fd, S) end, - Func = asn1ct_func:call_gen("is_default_sof", Key, Gen), + Func = asn1ct_func:call_gen("is_default_sof", Key, DoGen), {exception,atom_to_list(Func),[]} end. @@ -199,6 +224,39 @@ gen_cs_2([], _) -> "throw(false)\n" "end.\n"]. +gen_map_components(Name, Cs) -> + [atom_to_list(Name),"(Value) ->\n", + "case Value of\n", + "#{"|gen_map_cs_1(Cs, 1, "", [])]. + +gen_map_cs_1([{Name,{literal,Lit}}|T], I, Sep, Acc) -> + Var = "E"++integer_to_list(I), + G = Var ++ " =:= " ++ term2str(Lit), + [Sep,term2str(Name),":=",Var| + gen_map_cs_1(T, I+1, ",\n", [{guard,G}|Acc])]; +gen_map_cs_1([{Name,Exc}|T], I, Sep, Acc) -> + Var = "E"++integer_to_list(I), + [Sep,term2str(Name),":=",Var| + gen_map_cs_1(T, I+1, ",\n", [{exc,{Var,Exc}}|Acc])]; +gen_map_cs_1([], _, _, Acc) -> + G = lists:join(", ", [S || {guard,S} <- Acc]), + Exc = [E || {exc,E} <- Acc], + Body = gen_map_cs_2(Exc, ""), + case G of + [] -> + ["} ->\n"|Body]; + [_|_] -> + ["} when ",G," ->\n"|Body] + end. + +gen_map_cs_2([{Var,{exception,Func,Args}}|T], Sep) -> + [Sep,Func,"(",Var,arg2str(Args),")"|gen_map_cs_2(T, ",\n")]; +gen_map_cs_2([], _) -> + [";\n", + "_ ->\n" + "throw(false)\n" + "end.\n"]. + gen_sof(Name, Cs) -> [atom_to_list(Name),"(Value) ->\n", "case length(Value) of\n", @@ -221,9 +279,18 @@ gen_sof_1([{exception,Func,Args}|Cs], I) -> gen_sof_1([], _) -> ".\n". -components([#type{def=Def}|Ts], [V|Vs]) -> - [do_gen(Def, V)|components(Ts, Vs)]; -components([], []) -> []. +components(Gen, [#type{def=Def}|Ts], [V|Vs]) -> + [do_gen(Gen, Def, V)|components(Gen, Ts, Vs)]; +components(_Gen, [], []) -> []. + +map_components(Gen, [{Name,#type{def=Def}}|Ts], Value) -> + case maps:find(Name, Value) of + {ok,V} -> + [{Name,do_gen(Gen, Def, V)}|map_components(Gen, Ts, Value)]; + error -> + map_components(Gen, Ts, Value) + end; +map_components(_Gen, [], _Value) -> []. gen_choice(Name, Tag, Func, Args) -> NameStr = atom_to_list(Name), diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index aa7223904e..9671a566bf 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -113,11 +113,7 @@ gen_encode_prim(Erules, D) -> Value = {var,atom_to_list(asn1ct_gen:mk_var(asn1ct_name:curr(val)))}, gen_encode_prim(Erules, D, Value). -gen_encode_prim(Erules, #type{}=D, Value) -> - Aligned = case Erules of - uper -> false; - per -> true - end, +gen_encode_prim(#gen{erule=per,aligned=Aligned}, #type{}=D, Value) -> Imm = gen_encode_prim_imm(Value, D, Aligned), asn1ct_imm:enc_cg(Imm, Aligned). @@ -284,11 +280,7 @@ gen_dec_external(Ext, BytesVar) -> _ -> [{asis,Mod},":"] end,{asis,dec_func(Type)},"(",BytesVar,")"]). -gen_dec_imm(Erule, #type{def=Name,constraint=C}) -> - Aligned = case Erule of - uper -> false; - per -> true - end, +gen_dec_imm(#gen{erule=per,aligned=Aligned}, #type{def=Name,constraint=C}) -> gen_dec_imm_1(Name, C, Aligned). gen_dec_imm_1('ASN1_OPEN_TYPE', Constraint, Aligned) -> diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 8b96242c56..2ab848652e 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -37,9 +37,11 @@ per_enc_open_type/2, per_enc_restricted_string/3, per_enc_small_number/2]). --export([per_enc_extension_bit/2,per_enc_extensions/4,per_enc_optional/3]). +-export([per_enc_extension_bit/2,per_enc_extensions/4, + per_enc_extensions_map/4, + per_enc_optional/2]). -export([per_enc_sof/5]). --export([enc_absent/3,enc_append/1,enc_element/2]). +-export([enc_absent/3,enc_append/1,enc_element/2,enc_maps_get/2]). -export([enc_cg/2]). -export([optimize_alignment/1,optimize_alignment/2, dec_slim_cg/2,dec_code_gen/2]). @@ -349,27 +351,32 @@ per_enc_extensions(Val0, Pos0, NumBits, Aligned) when NumBits > 0 -> ['_'|Length ++ PutBits]]}], {var,"Extensions"}}]. -per_enc_optional(Val0, {Pos,DefVals}, _Aligned) when is_integer(Pos), - is_list(DefVals) -> - {B,Val} = enc_element(Pos, Val0), +per_enc_extensions_map(Val0, Vars, Undefined, Aligned) -> + NumBits = length(Vars), + {B,[_Val,Bitmap]} = mk_vars(Val0, [bitmap]), + Length = per_enc_small_length(NumBits, Aligned), + PutBits = case NumBits of + 1 -> [{put_bits,1,1,[1]}]; + _ -> [{put_bits,Bitmap,NumBits,[1]}] + end, + BitmapExpr = extensions_bitmap(Vars, Undefined), + B++[{assign,Bitmap,BitmapExpr}, + {list,[{'cond',[[{eq,Bitmap,0}], + ['_'|Length ++ PutBits]]}], + {var,"Extensions"}}]. + +per_enc_optional(Val, DefVals) when is_list(DefVals) -> Zero = {put_bits,0,1,[1]}, One = {put_bits,1,1,[1]}, - B++[{'cond', - [[{eq,Val,DefVal},Zero] || DefVal <- DefVals] ++ [['_',One]]}]; -per_enc_optional(Val0, {Pos,{call,M,F,A}}, _Aligned) when is_integer(Pos) -> - {B,Val} = enc_element(Pos, Val0), + [{'cond', + [[{eq,Val,DefVal},Zero] || DefVal <- DefVals] ++ [['_',One]]}]; +per_enc_optional(Val, {call,M,F,A}) -> {[],[[],Tmp]} = mk_vars([], [tmp]), Zero = {put_bits,0,1,[1]}, One = {put_bits,1,1,[1]}, - B++[{call,M,F,[Val|A],Tmp}, - {'cond', - [[{eq,Tmp,true},Zero],['_',One]]}]; -per_enc_optional(Val0, Pos, _Aligned) when is_integer(Pos) -> - {B,Val} = enc_element(Pos, Val0), - Zero = {put_bits,0,1,[1]}, - One = {put_bits,1,1,[1]}, - B++[{'cond',[[{eq,Val,asn1_NOVALUE},Zero], - ['_',One]]}]. + [{call,M,F,[Val|A],Tmp}, + {'cond', + [[{eq,Tmp,true},Zero],['_',One]]}]. per_enc_sof(Val0, Constraint, ElementVar, ElementImm, Aligned) -> {B,[Val,Len]} = mk_vars(Val0, [len]), @@ -423,6 +430,13 @@ enc_element(N, Val0) -> {[],[Val,Dst]} = mk_vars(Val0, [element]), {[{call,erlang,element,[N,Val],Dst}],Dst}. +enc_maps_get(N, Val0) -> + {[],[Val,Dst0]} = mk_vars(Val0, [element]), + {var,Dst} = Dst0, + DstExpr = {expr,lists:concat(["#{",N,":=",Dst,"}"])}, + {var,SrcVar} = Val, + {[{assign,DstExpr,SrcVar}],Dst0}. + enc_cg(Imm0, false) -> Imm1 = enc_cse(Imm0), Imm2 = enc_pre_cg(Imm1), @@ -1240,6 +1254,20 @@ enc_length(Len, {Lb,Ub}, Aligned) when is_integer(Lb) -> enc_length(Len, Sv, _Aligned) when is_integer(Sv) -> [{'cond',[[{eq,Len,Sv}]]}]. +extensions_bitmap(Vs, Undefined) -> + Highest = 1 bsl (length(Vs)-1), + Cs = extensions_bitmap_1(Vs, Undefined, Highest), + lists:flatten(lists:join(" bor ", Cs)). + +extensions_bitmap_1([{var,V}|Vs], Undefined, Power) -> + S = ["case ",V," of\n", + " ",Undefined," -> 0;\n" + " _ -> ",integer_to_list(Power),"\n" + "end"], + [S|extensions_bitmap_1(Vs, Undefined, Power bsr 1)]; +extensions_bitmap_1([], _, _) -> + []. + put_bits_binary(Bin, _Unit, Aligned) when is_binary(Bin) -> Sz = byte_size(Bin), <<Int:Sz/unit:8>> = Bin, diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index b3d41dd9f3..8bd99d995b 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -64,7 +64,11 @@ from_type(M,Typename,Type) when is_record(Type,type) -> end; {constructed,bif} when Typename == ['EXTERNAL'] -> Val=from_type_constructed(M,Typename,InnerType,Type), - asn1ct_eval_ext:transform_to_EXTERNAL1994(Val); + T = case M:maps() of + false -> transform_to_EXTERNAL1994; + true -> transform_to_EXTERNAL1994_maps + end, + asn1ct_eval_ext:T(Val); {constructed,bif} -> from_type_constructed(M,Typename,InnerType,Type) end; @@ -118,11 +122,13 @@ get_sequence(M,Typename,Type) -> #'SEQUENCE'{components=Cl} -> {'SEQUENCE',Cl}; #'SET'{components=Cl} -> {'SET',to_textual_order(Cl)} end, - case get_components(M,Typename,CompList) of - [] -> - {list_to_atom(asn1ct_gen:list2rname(Typename))}; - C -> - list_to_tuple([list_to_atom(asn1ct_gen:list2rname(Typename))|C]) + Cs = get_components(M, Typename, CompList), + case M:maps() of + false -> + RecordTag = list_to_atom(asn1ct_gen:list2rname(Typename)), + list_to_tuple([RecordTag|[Val || {_,Val} <- Cs]]); + true -> + maps:from_list(Cs) end. get_components(M,Typename,{Root,Ext}) -> @@ -130,9 +136,9 @@ get_components(M,Typename,{Root,Ext}) -> %% Should enhance this *** HERE *** with proper handling of extensions -get_components(M,Typename,[H|T]) -> - [from_type(M,Typename,H)| - get_components(M,Typename,T)]; +get_components(M, Typename, [H|T]) -> + #'ComponentType'{name=Name} = H, + [{Name,from_type(M, Typename, H)}|get_components(M, Typename, T)]; get_components(_,_,[]) -> []. diff --git a/lib/asn1/src/asn1rtt_ext.erl b/lib/asn1/src/asn1rtt_ext.erl index 3bf01823db..161b2db691 100644 --- a/lib/asn1/src/asn1rtt_ext.erl +++ b/lib/asn1/src/asn1rtt_ext.erl @@ -19,7 +19,8 @@ %% -module(asn1rtt_ext). --export([transform_to_EXTERNAL1990/1,transform_to_EXTERNAL1994/1]). +-export([transform_to_EXTERNAL1990/1,transform_to_EXTERNAL1990_maps/1, + transform_to_EXTERNAL1994/1,transform_to_EXTERNAL1994_maps/1]). transform_to_EXTERNAL1990({_,_,_,_}=Val) -> transform_to_EXTERNAL1990(tuple_to_list(Val), []); @@ -51,6 +52,30 @@ transform_to_EXTERNAL1990([Data_value], Acc) list_to_tuple(lists:reverse([{'octet-aligned',Data_value}|Acc])). +transform_to_EXTERNAL1990_maps(#{identification:=Id,'data-value':=Value}=V) -> + M0 = case Id of + {syntax,DRef} -> + #{'direct-reference'=>DRef}; + {'presentation-context-id',IndRef} -> + #{'indirect-reference'=>IndRef}; + {'context-negotiation', + #{'presentation-context-id':=IndRef, + 'transfer-syntax':=DRef}} -> + #{'direct-reference'=>DRef, + 'indirect-reference'=>IndRef} + end, + M = case V of + #{'data-value-descriptor':=Dvd} -> + M0#{'data-value-descriptor'=>Dvd}; + #{} -> + M0 + end, + M#{encoding=>{'octet-aligned',Value}}; +transform_to_EXTERNAL1990_maps(#{encoding:=_}=V) -> + %% Already in the EXTERNAL 1990 format. + V. + + transform_to_EXTERNAL1994({'EXTERNAL',DRef,IndRef,Data_v_desc,Encoding}=V) -> Identification = case {DRef,IndRef} of @@ -71,3 +96,38 @@ transform_to_EXTERNAL1994({'EXTERNAL',DRef,IndRef,Data_v_desc,Encoding}=V) -> %% information. V end. + +transform_to_EXTERNAL1994_maps(V0) -> + Identification = + case V0 of + #{'direct-reference':=DRef, + 'indirect-reference':=asn1_NOVALUE} -> + {syntax,DRef}; + #{'direct-reference':=asn1_NOVALUE, + 'indirect-reference':=IndRef} -> + {'presentation-context-id',IndRef}; + #{'direct-reference':=DRef, + 'indirect-reference':=IndRef} -> + {'context-negotiation', + #{'transfer-syntax'=>DRef, + 'presentation-context-id'=>IndRef}} + end, + case V0 of + #{encoding:={'octet-aligned',Val}} + when is_list(Val); is_binary(Val) -> + %% Transform to the EXTERNAL 1994 definition. + V = #{identification=>Identification, + 'data-value'=>Val}, + case V0 of + #{'data-value-descriptor':=asn1_NOVALUE} -> + V; + #{'data-value-descriptor':=Dvd} -> + V#{'data-value-descriptor'=>Dvd} + end; + _ -> + %% Keep the EXTERNAL 1990 definition to avoid losing + %% information. + V = [{K,V} || {K,V} <- maps:to_list(V0), + V =/= asn1_NOVALUE], + maps:from_list(V) + end. diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile index 40575e8a2f..d346bb9e12 100644 --- a/lib/asn1/test/Makefile +++ b/lib/asn1/test/Makefile @@ -82,6 +82,7 @@ MODULES= \ testInfObjExtract \ testParameterizedInfObj \ testFragmented \ + testMaps \ testMergeCompile \ testMultipleLevels \ testDeepTConstr \ diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index b6430134ab..6769a38b12 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -21,6 +21,9 @@ -module(asn1_SUITE). +%% Suppress compilation of an addititional module compiled for maps. +-define(NO_MAPS_MODULE, asn1_test_lib_no_maps). + -define(only_ber(Func), if Rule =:= ber -> Func; true -> ok @@ -102,6 +105,7 @@ groups() -> testMultipleLevels, testOpt, testSeqDefault, + testMaps, % Uses 'External' {group, [], [testExternal, testSeqExtension]}, @@ -176,8 +180,11 @@ groups() -> {performance, [], [testTimer_ber, + testTimer_ber_maps, testTimer_per, - testTimer_uper]}]. + testTimer_per_maps, + testTimer_uper, + testTimer_uper_maps]}]. %%------------------------------------------------------------------------------ %% Init/end @@ -441,6 +448,16 @@ testDEFAULT(Config, Rule, Opts) -> testDef:main(Rule), testSeqSetDefaultVal:main(Rule, Opts). +testMaps(Config) -> + test(Config, fun testMaps/3, + [{ber,[maps,no_ok_wrapper]}, + {ber,[maps,der,no_ok_wrapper]}, + {per,[maps,no_ok_wrapper]}, + {uper,[maps,no_ok_wrapper]}]). +testMaps(Config, Rule, Opts) -> + asn1_test_lib:compile_all(['Maps'], Config, [Rule|Opts]), + testMaps:main(Rule). + testOpt(Config) -> test(Config, fun testOpt/3). testOpt(Config, Rule, Opts) -> asn1_test_lib:compile("Opt", Config, [Rule|Opts]), @@ -614,12 +631,12 @@ parse(Config) -> [asn1_test_lib:compile(M, Config, [abs]) || M <- test_modules()]. per(Config) -> - test(Config, fun per/3, [per,uper]). + test(Config, fun per/3, [per,uper,{per,[maps]},{uper,[maps]}]). per(Config, Rule, Opts) -> [module_test(M, Config, Rule, Opts) || M <- per_modules()]. ber_other(Config) -> - test(Config, fun ber_other/3, [ber]). + test(Config, fun ber_other/3, [ber,{ber,[maps]}]). ber_other(Config, Rule, Opts) -> [module_test(M, Config, Rule, Opts) || M <- ber_modules()]. @@ -628,7 +645,7 @@ der(Config) -> asn1_test_lib:compile_all(ber_modules(), Config, [der]). module_test(M0, Config, Rule, Opts) -> - asn1_test_lib:compile(M0, Config, [Rule|Opts]), + asn1_test_lib:compile(M0, Config, [Rule,?NO_MAPS_MODULE|Opts]), case list_to_atom(M0) of 'LDAP' -> %% Because of the recursive definition of 'Filter' in @@ -995,7 +1012,9 @@ testS1AP(Config, Rule, Opts) -> testRfcs() -> [{timetrap,{minutes,90}}]. -testRfcs(Config) -> test(Config, fun testRfcs/3, [{ber,[der]}]). +testRfcs(Config) -> test(Config, fun testRfcs/3, + [{ber,[der,?NO_MAPS_MODULE]}, + {ber,[der,maps]}]). testRfcs(Config, Rule, Opts) -> case erlang:system_info(system_architecture) of "sparc-sun-solaris2.10" -> @@ -1010,7 +1029,8 @@ test_compile_options(Config) -> ok = test_compile_options:path(Config), ok = test_compile_options:noobj(Config), ok = test_compile_options:record_name_prefix(Config), - ok = test_compile_options:verbose(Config). + ok = test_compile_options:verbose(Config), + ok = test_compile_options:maps(Config). testDoubleEllipses(Config) -> test(Config, fun testDoubleEllipses/3). testDoubleEllipses(Config, Rule, Opts) -> @@ -1069,7 +1089,7 @@ test_x691(Config, Rule, Opts) -> ok. ticket_6143(Config) -> - ok = test_compile_options:ticket_6143(Config). + asn1_test_lib:compile("AA1", Config, [?NO_MAPS_MODULE]). testExtensionAdditionGroup(Config) -> test(Config, fun testExtensionAdditionGroup/3). @@ -1157,20 +1177,33 @@ END ok = asn1ct:compile(File, [{outdir, PrivDir}]). -timer_compile(Config, Rule) -> - asn1_test_lib:compile_all(["H235-SECURITY-MESSAGES", "H323-MESSAGES"], - Config, [no_ok_wrapper,Rule]). +timer_compile(Config, Opts0) -> + Files = ["H235-SECURITY-MESSAGES", "H323-MESSAGES"], + Opts = [no_ok_wrapper,?NO_MAPS_MODULE|Opts0], + asn1_test_lib:compile_all(Files, Config, Opts). testTimer_ber(Config) -> - timer_compile(Config, ber), + timer_compile(Config, [ber]), testTimer:go(). testTimer_per(Config) -> - timer_compile(Config, per), + timer_compile(Config, [per]), testTimer:go(). testTimer_uper(Config) -> - timer_compile(Config, uper), + timer_compile(Config, [uper]), + testTimer:go(). + +testTimer_ber_maps(Config) -> + timer_compile(Config, [ber,maps]), + testTimer:go(). + +testTimer_per_maps(Config) -> + timer_compile(Config, [per,maps]), + testTimer:go(). + +testTimer_uper_maps(Config) -> + timer_compile(Config, [uper,maps]), testTimer:go(). %% Test of multiple-line comment, OTP-8043 @@ -1179,9 +1212,11 @@ testComment(Config) -> asn1_test_lib:roundtrip('Comment', 'Seq', {'Seq',12,true}). testName2Number(Config) -> - N2NOptions = [{n2n,Type} || Type <- ['CauseMisc', 'CauseProtocol', - 'CauseRadioNetwork', - 'CauseTransport','CauseNas']], + N2NOptions0 = [{n2n,Type} || + Type <- ['CauseMisc', 'CauseProtocol', + 'CauseRadioNetwork', + 'CauseTransport','CauseNas']], + N2NOptions = [?NO_MAPS_MODULE|N2NOptions0], asn1_test_lib:compile("S1AP-IEs", Config, N2NOptions), 0 = 'S1AP-IEs':name2num_CauseMisc('control-processing-overload'), @@ -1191,8 +1226,9 @@ testName2Number(Config) -> %% Test that n2n option generates name2num and num2name functions supporting %% values not within the extension root if the enumeration type has an %% extension marker. - N2NOptionsExt = [{n2n, 'NoExt'}, {n2n, 'Ext'}, {n2n, 'Ext2'}], + N2NOptionsExt = [?NO_MAPS_MODULE,{n2n,'NoExt'},{n2n,'Ext'},{n2n,'Ext2'}], asn1_test_lib:compile("EnumN2N", Config, N2NOptionsExt), + %% Previously, name2num and num2name was not generated if the type didn't %% have an extension marker: 0 = 'EnumN2N':name2num_NoExt('blue'), @@ -1210,9 +1246,11 @@ testName2Number(Config) -> ok. ticket_7407(Config) -> - asn1_test_lib:compile("EUTRA-extract-7407", Config, [uper]), + Opts = [uper,?NO_MAPS_MODULE], + asn1_test_lib:compile("EUTRA-extract-7407", Config, Opts), ticket_7407_code(true), - asn1_test_lib:compile("EUTRA-extract-7407", Config, [uper,no_final_padding]), + asn1_test_lib:compile("EUTRA-extract-7407", Config, + [no_final_padding|Opts]), ticket_7407_code(false). ticket_7407_code(FinalPadding) -> diff --git a/lib/asn1/test/asn1_SUITE_data/Maps.asn1 b/lib/asn1/test/asn1_SUITE_data/Maps.asn1 new file mode 100644 index 0000000000..fd5f373e45 --- /dev/null +++ b/lib/asn1/test/asn1_SUITE_data/Maps.asn1 @@ -0,0 +1,17 @@ +Maps DEFINITIONS AUTOMATIC TAGS ::= +BEGIN + +XY ::= SEQUENCE { x INTEGER DEFAULT 0, y INTEGER DEFAULT 0 } + +xy1 XY ::= { x 42, y 17 } +xy2 XY ::= { } +xy3 XY ::= { y 999 } + +S ::= SEQUENCE { + xy XY DEFAULT { x 100, y 100 }, + os OCTET STRING OPTIONAL +} + +s1 S ::= {} + +END diff --git a/lib/asn1/test/asn1_SUITE_data/SeqExtension.asn1 b/lib/asn1/test/asn1_SUITE_data/SeqExtension.asn1 index 5fda19303a..e866ef2f4f 100644 --- a/lib/asn1/test/asn1_SUITE_data/SeqExtension.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/SeqExtension.asn1 @@ -48,6 +48,17 @@ SeqExt6 ::= SEQUENCE [[ i6 [106] INTEGER, i7 [107] INTEGER ]] } +SeqExt7 ::= SEQUENCE +{ + -- The spaces between the ellipsis and the comma will prevent them + -- from being removed. + ... , + [[ a INTEGER (0..65535) OPTIONAL, + b OCTET STRING OPTIONAL, + c BOOLEAN + ]] +} + SeqExt1X ::= XSeqExt1 SeqExt2X ::= XSeqExt2 diff --git a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Discriptions.asn b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Descriptions.asn index b9be9934e4..12a4475422 100644 --- a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Discriptions.asn +++ b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Descriptions.asn @@ -4,7 +4,7 @@ --
-- **************************************************************
-NBAP-PDU-Discriptions {
+NBAP-PDU-Descriptions {
itu-t (0) identified-organization (4) etsi (0) mobileDomain (0)
umts-Access (20) modules (3) nbap (2) version1 (1) nbap-PDU-Descriptions (0) }
diff --git a/lib/asn1/test/asn1_SUITE_data/test_records.erl b/lib/asn1/test/asn1_SUITE_data/test_records.erl index 9fd07c1449..afb1c8c80b 100644 --- a/lib/asn1/test/asn1_SUITE_data/test_records.erl +++ b/lib/asn1/test/asn1_SUITE_data/test_records.erl @@ -25,7 +25,7 @@ -define(line,put(test_server_loc,{?MODULE,?LINE}),). --include("NBAP-PDU-Discriptions.hrl"). +-include("NBAP-PDU-Descriptions.hrl"). -include("NBAP-PDU-Contents.hrl"). -include("NBAP-Containers.hrl"). -include("NBAP-CommonDataTypes.hrl"). diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl index dc614db4f2..a79958d229 100644 --- a/lib/asn1/test/asn1_test_lib.erl +++ b/lib/asn1/test/asn1_test_lib.erl @@ -25,7 +25,8 @@ hex_to_bin/1, match_value/2, parallel/0, - roundtrip/3,roundtrip/4,roundtrip_enc/3,roundtrip_enc/4]). + roundtrip/3,roundtrip/4,roundtrip_enc/3,roundtrip_enc/4, + map_roundtrip/3]). -include_lib("common_test/include/ct.hrl"). @@ -94,15 +95,58 @@ module(F0) -> list_to_atom(F). %% filename:join(CaseDir, F ++ ".beam"). -compile_file(File, Options) -> +compile_file(File, Options0) -> + Options = [warnings_as_errors|Options0], try - ok = asn1ct:compile(File, [warnings_as_errors|Options]) + ok = asn1ct:compile(File, Options), + ok = compile_maps(File, Options) catch _:Reason -> ct:print("Failed to compile ~s\n~p", [File,Reason]), error end. +compile_maps(File, Options) -> + unload_map_mod(File), + Incompat = [abs,compact_bit_string,legacy_bit_string, + legacy_erlang_types,maps,asn1_test_lib_no_maps], + case lists:any(fun(E) -> lists:member(E, Incompat) end, Options) of + true -> + ok; + false -> + compile_maps_1(File, Options) + end. + +compile_maps_1(File, Options) -> + ok = asn1ct:compile(File, [maps,no_ok_wrapper,noobj|Options]), + OutDir = proplists:get_value(outdir, Options), + Base0 = filename:rootname(filename:basename(File)), + Base = case filename:extension(Base0) of + ".set" -> + filename:rootname(Base0); + _ -> + Base0 + end, + ErlBase = Base ++ ".erl", + ErlFile = filename:join(OutDir, ErlBase), + {ok,Erl0} = file:read_file(ErlFile), + Erl = re:replace(Erl0, <<"-module\\('">>, "&maps_"), + MapsErlFile = filename:join(OutDir, "maps_" ++ ErlBase), + ok = file:write_file(MapsErlFile, Erl), + {ok,_} = compile:file(MapsErlFile, [report,{outdir,OutDir},{i,OutDir}]), + ok. + +unload_map_mod(File0) -> + File1 = filename:basename(File0), + File2 = filename:rootname(File1, ".asn"), + File3 = filename:rootname(File2, ".asn1"), + File4 = filename:rootname(File3, ".py"), + File = filename:rootname(File4, ".set"), + MapMod = list_to_atom("maps_"++File), + code:delete(MapMod), + code:purge(MapMod), + ok. + compile_erlang(Mod, Config, Options) -> DataDir = proplists:get_value(data_dir, Config), CaseDir = proplists:get_value(case_dir, Config), @@ -147,24 +191,60 @@ roundtrip(Mod, Type, Value) -> roundtrip(Mod, Type, Value, Value). roundtrip(Mod, Type, Value, ExpectedValue) -> - {ok,Encoded} = Mod:encode(Type, Value), - {ok,ExpectedValue} = Mod:decode(Type, Encoded), - test_ber_indefinite(Mod, Type, Encoded, ExpectedValue), - ok. + roundtrip_enc(Mod, Type, Value, ExpectedValue). roundtrip_enc(Mod, Type, Value) -> roundtrip_enc(Mod, Type, Value, Value). roundtrip_enc(Mod, Type, Value, ExpectedValue) -> - {ok,Encoded} = Mod:encode(Type, Value), - {ok,ExpectedValue} = Mod:decode(Type, Encoded), + case Mod:encode(Type, Value) of + {ok,Encoded} -> + {ok,ExpectedValue} = Mod:decode(Type, Encoded); + Encoded when is_binary(Encoded) -> + ExpectedValue = Mod:decode(Type, Encoded) + end, + map_roundtrip(Mod, Type, Encoded), test_ber_indefinite(Mod, Type, Encoded, ExpectedValue), Encoded. +map_roundtrip(Mod, Type, Encoded) -> + MapMod = list_to_atom("maps_"++atom_to_list(Mod)), + try MapMod:maps() of + true -> + map_roundtrip_1(MapMod, Type, Encoded) + catch + error:undef -> + ok + end. + %%% %%% Internal functions. %%% +map_roundtrip_1(Mod, Type, Encoded) -> + Decoded = Mod:decode(Type, Encoded), + case Mod:encode(Type, Decoded) of + Encoded -> + ok; + OtherEncoding -> + case is_named_bitstring(Decoded) of + true -> + %% In BER, named BIT STRINGs with different number of + %% trailing zeroes decode to the same value. + ok; + false -> + error({encode_mismatch,Decoded,Encoded,OtherEncoding}) + end + end, + ok. + +is_named_bitstring([H|T]) -> + is_atom(H) andalso is_named_bitstring(T); +is_named_bitstring([]) -> + true; +is_named_bitstring(_) -> + false. + hex2num(C) when $0 =< C, C =< $9 -> C - $0; hex2num(C) when $A =< C, C =< $F -> C - $A + 10; hex2num(C) when $a =< C, C =< $f -> C - $a + 10. @@ -179,7 +259,12 @@ test_ber_indefinite(Mod, Type, Encoded, ExpectedValue) -> case Mod:encoding_rule() of ber -> Indefinite = iolist_to_binary(ber_indefinite(Encoded)), - {ok,ExpectedValue} = Mod:decode(Type, Indefinite); + case Mod:decode(Type, Indefinite) of + {ok,ExpectedValue} -> + ok; + ExpectedValue -> + ok + end; _ -> ok end. diff --git a/lib/asn1/test/h323test.erl b/lib/asn1/test/h323test.erl index 935af0ba09..41a9159335 100644 --- a/lib/asn1/test/h323test.erl +++ b/lib/asn1/test/h323test.erl @@ -27,6 +27,8 @@ run(per) -> run(); run(_Rules) -> ok. run() -> + roundtrip('EndpointType', endpoint()), + roundtrip('Alerting-UUIE', alerting_uuie()), roundtrip('H323-UserInformation', alerting_val(), alerting_enc()), roundtrip('H323-UserInformation', connect_val(), connect_enc()), general_string(), @@ -36,18 +38,24 @@ alerting_val() -> {'H323-UserInformation', {'H323-UU-PDU', {alerting, - {'Alerting-UUIE', - {0,0,8,2250,0,2}, - {'EndpointType',asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE, - asn1_NOVALUE,asn1_NOVALUE, - {'TerminalInfo',asn1_NOVALUE}, - false,false}, - asn1_NOVALUE, - {'CallIdentifier',<<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0>>}, - asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}}, + alerting_uuie()}, asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}, asn1_NOVALUE}. +endpoint() -> + {'EndpointType',asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE, + asn1_NOVALUE,asn1_NOVALUE, + {'TerminalInfo',asn1_NOVALUE}, + false,false}. + +alerting_uuie() -> + {'Alerting-UUIE', + {0,0,8,2250,0,2}, + endpoint(), + asn1_NOVALUE, + {'CallIdentifier',<<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0>>}, + asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}. + alerting_enc() -> "0380060008914a0002020120110000000000000000000000000000000000". @@ -82,6 +90,9 @@ general_string() -> UI = <<109,64,1,57>>, {ok, _V} = 'MULTIMEDIA-SYSTEM-CONTROL':decode(Type, UI). +roundtrip(T, V) -> + asn1_test_lib:roundtrip('H323-MESSAGES', T, V). + roundtrip(T, V, HexString) -> Enc = asn1_test_lib:hex_to_bin(HexString), Enc = asn1_test_lib:roundtrip_enc('H323-MESSAGES', T, V), diff --git a/lib/asn1/test/testContextSwitchingTypes.erl b/lib/asn1/test/testContextSwitchingTypes.erl index 10012908a9..5688d8afd6 100644 --- a/lib/asn1/test/testContextSwitchingTypes.erl +++ b/lib/asn1/test/testContextSwitchingTypes.erl @@ -90,5 +90,6 @@ check_object_identifier(Tuple) when is_tuple(Tuple) -> enc_dec(T, V0) -> M = 'ContextSwitchingTypes', {ok,Enc} = M:encode(T, V0), + asn1_test_lib:map_roundtrip(M, T, Enc), {ok,V} = M:decode(T, Enc), V. diff --git a/lib/asn1/test/testInfObj.erl b/lib/asn1/test/testInfObj.erl index 5a9f47d865..c519c70cdf 100644 --- a/lib/asn1/test/testInfObj.erl +++ b/lib/asn1/test/testInfObj.erl @@ -197,5 +197,6 @@ roundtrip(M, T, V) -> enc_dec(M, T, V0) -> {ok,Enc} = M:encode(T, V0), + asn1_test_lib:map_roundtrip(M, T, Enc), {ok,V} = M:decode(T, Enc), V. diff --git a/lib/asn1/test/testMaps.erl b/lib/asn1/test/testMaps.erl new file mode 100644 index 0000000000..45dd2255ba --- /dev/null +++ b/lib/asn1/test/testMaps.erl @@ -0,0 +1,50 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. 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(testMaps). + +-export([main/1]). + +main(_) -> + M = 'Maps', + true = M:maps(), + + true = M:xy1() =:= #{x=>42,y=>17}, + true = M:xy2() =:= #{x=>0,y=>0}, + true = M:xy3() =:= #{x=>0,y=>999}, + true = M:s1() =:= #{xy=>#{x=>100,y=>100}}, + + roundtrip('XY', M:xy1()), + roundtrip('XY', M:xy2()), + roundtrip('XY', M:xy3()), + roundtrip('XY', #{}, #{x=>0,y=>0}), + + roundtrip('S', M:s1()), + roundtrip('S', #{}, #{xy=>#{x=>100,y=>100}}), + roundtrip('S', #{os=><<1,2,3>>}, #{xy=>#{x=>100,y=>100}, + os=><<1,2,3>>}), + + ok. + +roundtrip(Type, Value) -> + roundtrip(Type, Value, Value). + +roundtrip(Type, Value, Expected) -> + asn1_test_lib:roundtrip('Maps', Type, Value, Expected). diff --git a/lib/asn1/test/testMultipleLevels.erl b/lib/asn1/test/testMultipleLevels.erl index c610e59f3d..e9d83665aa 100644 --- a/lib/asn1/test/testMultipleLevels.erl +++ b/lib/asn1/test/testMultipleLevels.erl @@ -24,5 +24,7 @@ main(_) -> Data = {'Top',{short,"abc"},{long,"a long string follows here"}}, - {ok,B} = 'MultipleLevels':encode('Top', Data), - {ok,Data} = 'MultipleLevels':decode('Top', iolist_to_binary(B)). + roundtrip('Top', Data). + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('MultipleLevels', T, V). diff --git a/lib/asn1/test/testNBAPsystem.erl b/lib/asn1/test/testNBAPsystem.erl index 1af283af42..8d61ca18ce 100644 --- a/lib/asn1/test/testNBAPsystem.erl +++ b/lib/asn1/test/testNBAPsystem.erl @@ -84,7 +84,7 @@ compile(Config, Options) -> M <- ["NBAP-CommonDataTypes.asn", "NBAP-IEs.asn", "NBAP-PDU-Contents.asn", - "NBAP-PDU-Discriptions.asn", + "NBAP-PDU-Descriptions.asn", "NBAP-Constants.asn", "NBAP-Containers.asn"]], asn1_test_lib:compile_all(Fs, Config, Options), @@ -98,16 +98,16 @@ test(_Erule,Config) -> ticket_5812(Config) -> Msg = v_5812(), - {ok,B2} = 'NBAP-PDU-Discriptions':encode('NBAP-PDU', Msg), + {ok,B2} = 'NBAP-PDU-Descriptions':encode('NBAP-PDU', Msg), V = <<0,28,74,0,3,48,0,0,1,0,123,64,41,0,0,0,126,64,35,95,208,2,89,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,145,0,1,205,0,0,0,0,2,98,64,1,128>>, ok = compare(V,B2), - {ok,Msg2} = 'NBAP-PDU-Discriptions':decode('NBAP-PDU', B2), + {ok,Msg2} = 'NBAP-PDU-Descriptions':decode('NBAP-PDU', B2), ok = check_record_names(Msg2,Config). enc_audit_req_msg() -> Msg = {initiatingMessage, audit_req_msg()}, - {ok,B} = 'NBAP-PDU-Discriptions':encode('NBAP-PDU', Msg), - {ok,_Msg} = 'NBAP-PDU-Discriptions':decode('NBAP-PDU', B), + {ok,B} = 'NBAP-PDU-Descriptions':encode('NBAP-PDU', Msg), + {ok,_Msg} = 'NBAP-PDU-Descriptions':decode('NBAP-PDU', B), {initiatingMessage, #'InitiatingMessage'{value=#'AuditRequest'{protocolIEs=[{_,114,ignore,_}], protocolExtensions = asn1_NOVALUE}}} = _Msg, @@ -116,8 +116,8 @@ enc_audit_req_msg() -> cell_setup_req_msg_test() -> Msg = {initiatingMessage, cell_setup_req_msg()}, - {ok,B} = 'NBAP-PDU-Discriptions':encode('NBAP-PDU', Msg), - {ok,_Msg} = 'NBAP-PDU-Discriptions':decode('NBAP-PDU', B), + {ok,B} = 'NBAP-PDU-Descriptions':encode('NBAP-PDU', Msg), + {ok,_Msg} = 'NBAP-PDU-Descriptions':decode('NBAP-PDU', B), io:format("Msg: ~P~n~n_Msg: ~P~n",[Msg,15,_Msg,15]), ok. diff --git a/lib/asn1/test/testRfcs.erl b/lib/asn1/test/testRfcs.erl index da7333ef98..20176e35eb 100644 --- a/lib/asn1/test/testRfcs.erl +++ b/lib/asn1/test/testRfcs.erl @@ -35,22 +35,27 @@ compile(Config, Erules, Options0) -> asn1_test_lib:compile_all(Specs, Config, [Erules,{i,CaseDir}|Options]). test() -> - {1,3,6,1,5,5,7,48,1,2} = - IdPkixOcspNonce = - 'OCSP-2009':'id-pkix-ocsp-nonce'(), - roundtrip('OCSP-2009', 'OCSPRequest', - {'OCSPRequest', - {'TBSRequest', - 0, - {rfc822Name,"name string"}, - [{'Request', - {'CertID',{'_',{2,9,3,4,5},asn1_NOVALUE}, - <<"POTATOHASH">>,<<"HASHBROWN">>,42}, - [{'_',IdPkixOcspNonce,true,<<34,159,16,57,199>>}]}], - asn1_NOVALUE}, - asn1_NOVALUE}), - otp_7759(), - ok. + M = 'OCSP-2009', + case M:maps() of + false -> + {1,3,6,1,5,5,7,48,1,2} = + IdPkixOcspNonce = + 'OCSP-2009':'id-pkix-ocsp-nonce'(), + roundtrip('OCSP-2009', 'OCSPRequest', + {'OCSPRequest', + {'TBSRequest', + 0, + {rfc822Name,"name string"}, + [{'Request', + {'CertID',{'_',{2,9,3,4,5},asn1_NOVALUE}, + <<"POTATOHASH">>,<<"HASHBROWN">>,42}, + [{'_',IdPkixOcspNonce,true,<<34,159,16,57,199>>}]}], + asn1_NOVALUE}, + asn1_NOVALUE}), + otp_7759(records); + true -> + otp_7759(maps) + end. roundtrip(Module, Type, Value0) -> Enc = Module:encode(Type, Value0), @@ -58,7 +63,7 @@ roundtrip(Module, Type, Value0) -> asn1_test_lib:match_value(Value0, Value1), ok. -otp_7759() -> +otp_7759(Pack) -> %% The release note for asn-1.6.6 says: %% Decode of an open_type when the value was empty tagged %% type encoded with indefinite length failed. @@ -66,10 +71,15 @@ otp_7759() -> Encoded = encoded_msg(), ContentInfo = Mod:decode('ContentInfo', Encoded), io:format("~p\n", [ContentInfo]), - {'ContentInfo',_Id,PKCS7_content} = ContentInfo, - X = Mod:decode('SignedData', PKCS7_content), + Content = case ContentInfo of + {'ContentInfo',_Id,Content0} when Pack =:= records -> + Content0; + #{'content-type':=_,'pkcs7-content':=Content0} + when Pack =:= maps -> + Content0 + end, + X = Mod:decode('SignedData', Content), io:format("~p\n", [X]), - io:nl(), ok. encoded_msg() -> diff --git a/lib/asn1/test/testSeqExtension.erl b/lib/asn1/test/testSeqExtension.erl index f7885cb002..be1d1c2490 100644 --- a/lib/asn1/test/testSeqExtension.erl +++ b/lib/asn1/test/testSeqExtension.erl @@ -31,6 +31,7 @@ -record('SeqExt4',{bool, int}). -record('SeqExt5',{name, shoesize}). -record('SeqExt6',{i1,i2,i3,i4,i5,i6,i7}). +-record('SeqExt7',{a=asn1_NOVALUE,b=asn1_NOVALUE,c}). -record('SuperSeq',{s1,s2,s3,s4,s5,s6,i}). main(Erule, DataDir, Opts) -> @@ -45,8 +46,35 @@ main(Erule, DataDir, Opts) -> roundtrip('SeqExt4', #'SeqExt4'{bool=true,int=12345}), roundtrip('SeqExt4', #'SeqExt4'{bool=false,int=123456}), + case Erule of + ber -> + %% BER currently does not handle Extension Addition Groups + %% correctly. + ok; + _ -> + v_roundtrip3('SeqExt5', #'SeqExt5'{name=asn1_NOVALUE, + shoesize=asn1_NOVALUE}, + Erule, #{per=>"00", + uper=>"00"}), + v_roundtrip3('SeqExt7', #'SeqExt7'{c=asn1_NOVALUE}, + Erule, #{per=>"00", + uper=>"00"}) + end, roundtrip('SeqExt5', #'SeqExt5'{name = <<"Arne">>,shoesize=47}), + v_roundtrip3('SeqExt7', #'SeqExt7'{c=false}, + Erule, #{per=>"80800100", + uper=>"80808000"}), + v_roundtrip3('SeqExt7', #'SeqExt7'{c=true}, + Erule, #{per=>"80800120", + uper=>"80809000"}), + v_roundtrip3('SeqExt7', #'SeqExt7'{a=777,b = <<16#AA>>,c=false}, + Erule, #{per=>"808006C0 030901AA 00", + uper=>"8082E061 20354000"}), + v_roundtrip3('SeqExt7', #'SeqExt7'{a=8888,c=false}, + Erule, #{per=>"80800480 22B800", + uper=>"8081C457 0000"}), + %% Encode a value with this version of the specification. BigInt = 128638468966, SuperSeq = #'SuperSeq'{s1=#'SeqExt1'{}, @@ -106,6 +134,7 @@ main(Erule, DataDir, Opts) -> v_roundtrip2(Erule, 'SeqExt130', list_to_tuple(['SeqExt130'| lists:duplicate(129, asn1_NOVALUE)++[199]])), + ok. roundtrip(Type, Value) -> @@ -118,6 +147,15 @@ v_roundtrip2(Erule, Type, Value) -> roundtrip2(Type, Value) -> asn1_test_lib:roundtrip_enc('SeqExtension2', Type, Value). +v_roundtrip3(Type, Value, Erule, Map) -> + case maps:find(Erule, Map) of + {ok,Hex} -> + Encoded = asn1_test_lib:hex_to_bin(Hex), + Encoded = asn1_test_lib:roundtrip_enc('SeqExtension', Type, Value); + error -> + asn1_test_lib:roundtrip('SeqExtension', Type, Value) + end. + v(ber, 'SeqExt66') -> "30049F41 017D"; v(per, 'SeqExt66') -> "C0420000 00000000 00004001 FA"; v(uper, 'SeqExt66') -> "D0800000 00000000 00101FA0"; diff --git a/lib/asn1/test/testTCAP.erl b/lib/asn1/test/testTCAP.erl index 422ae1f0fc..a6f0f9fad7 100644 --- a/lib/asn1/test/testTCAP.erl +++ b/lib/asn1/test/testTCAP.erl @@ -92,5 +92,6 @@ test_asn1config() -> enc_dec(T, V0) -> M = 'TCAPPackage', {ok,Enc} = M:encode(T, V0), + asn1_test_lib:map_roundtrip(M, T, Enc), {ok,V} = M:decode(T, Enc), V. diff --git a/lib/asn1/test/testTimer.erl b/lib/asn1/test/testTimer.erl index bd8da85735..3edeb1b712 100644 --- a/lib/asn1/test/testTimer.erl +++ b/lib/asn1/test/testTimer.erl @@ -25,7 +25,42 @@ -define(times, 5000). -val() -> +go() -> + Module = 'H323-MESSAGES', + Type = 'H323-UserInformation', + Value = case Module:maps() of + false -> val_records(); + true -> val_maps() + end, + Bytes = Module:encode(Type, Value), + Value = Module:decode(Type, Bytes), + + {ValWr,done} = timer:tc(fun() -> encode(?times, Module, Type, Value) end), + io:format("ASN.1 encoding: ~p micro~n", [ValWr / ?times]), + + done = decode(2, Module, Type, Bytes), + + {ValRead,done} = timer:tc(fun() -> decode(?times, Module, Type, Bytes) end), + io:format("ASN.1 decoding: ~p micro~n", [ValRead /?times]), + + Comment = "encode: "++integer_to_list(round(ValWr/?times)) ++ + " micro, decode: "++integer_to_list(round(ValRead /?times)) ++ + " micro. [" ++ atom_to_list(Module:encoding_rule()) ++ "]", + {comment,Comment}. + +encode(0, _Module,_Type,_Value) -> + done; +encode(N, Module,Type,Value) -> + Module:encode(Type, Value), + encode(N-1, Module, Type, Value). + +decode(0, _Module, _Type, _Value) -> + done; +decode(N, Module, Type, Value) -> + Module:decode(Type, Value), + decode(N-1, Module, Type, Value). + +val_records() -> {'H323-UserInformation',{'H323-UU-PDU', {callProceeding, {'CallProceeding-UUIE', @@ -126,34 +161,66 @@ val() -> {'H323-UserInformation_user-data',24,<<"O">>}}. -go() -> - Module = 'H323-MESSAGES', - Type = 'H323-UserInformation', - Value = val(), - Bytes = Module:encode(Type, Value), - Value = Module:decode(Type, Bytes), - - {ValWr,done} = timer:tc(fun() -> encode(?times, Module, Type, Value) end), - io:format("ASN.1 encoding: ~p micro~n", [ValWr / ?times]), - - done = decode(2, Module, Type, Bytes), - - {ValRead,done} = timer:tc(fun() -> decode(?times, Module, Type, Bytes) end), - io:format("ASN.1 decoding: ~p micro~n", [ValRead /?times]), - - Comment = "encode: "++integer_to_list(round(ValWr/?times)) ++ - " micro, decode: "++integer_to_list(round(ValRead /?times)) ++ - " micro. [" ++ atom_to_list(Module:encoding_rule()) ++ "]", - {comment,Comment}. - -encode(0, _Module,_Type,_Value) -> - done; -encode(N, Module,Type,Value) -> - Module:encode(Type, Value), - encode(N-1, Module, Type, Value). - -decode(0, _Module, _Type, _Value) -> - done; -decode(N, Module, Type, Value) -> - Module:decode(Type, Value), - decode(N-1, Module, Type, Value). +val_maps() -> +#{'h323-uu-pdu' => #{h245Control => [], + h245Tunneling => true, + 'h323-message-body' => {callProceeding,#{callIdentifier => #{guid => <<"OCTET STRINGOCTE">>}, + cryptoTokens => [{cryptoGKPwdEncr,#{algorithmOID => {1,18,467,467}, + encryptedData => <<"OC">>, + paramS => #{iv8 => <<"OCTET ST">>, + ranInt => -7477016}}}, + {cryptoGKPwdEncr,#{algorithmOID => {1,19,486,486}, + encryptedData => <<>>, + paramS => #{iv8 => <<"OCTET ST">>, + ranInt => -2404513}}}], + destinationInfo => #{gatekeeper => #{nonStandardData => #{data => <<"O">>, + nonStandardIdentifier => {object,{0,10,260}}}}, + gateway => #{nonStandardData => #{data => <<"O">>, + nonStandardIdentifier => {object,{0,13,326}}}, + protocol => [{h320,#{dataRatesSupported => [#{channelMultiplier => 78, + channelRate => 1290470518, + nonStandardData => #{data => <<"O">>, + nonStandardIdentifier => {object,{0,11,295}}}}], + nonStandardData => #{data => <<"O">>, + nonStandardIdentifier => {object,{0,11,282}}}, + supportedPrefixes => [#{nonStandardData => #{data => <<"O">>, + nonStandardIdentifier => {object,{0,12,312}}}, + prefix => {'h323-ID',"BM"}}]}}]}, + mc => true, + mcu => #{nonStandardData => #{data => <<"OC">>, + nonStandardIdentifier => {object,{1,13,340,340}}}}, + nonStandardData => #{data => <<"O">>,nonStandardIdentifier => {object,{0,9,237}}}, + terminal => #{nonStandardData => #{data => <<"OC">>, + nonStandardIdentifier => {object,{1,14,353,354}}}}, + undefinedNode => true, + vendor => #{productId => <<"OC">>, + vendor => #{manufacturerCode => 16282, + t35CountryCode => 62, + t35Extension => 63}, + versionId => <<"OC">>}}, + fastStart => [], + h245Address => {ipxAddress,#{netnum => <<"OCTE">>, + node => <<"OCTET ">>, + port => <<"OC">>}}, + h245SecurityMode => {noSecurity,'NULL'}, + protocolIdentifier => {0,8,222}, + tokens => [#{certificate => #{certificate => <<"OC">>,type => {1,16,405,406}}, + challenge => <<"OCTET STR">>, + dhkey => #{generator => <<1:1>>,halfkey => <<1:1>>,modSize => <<1:1>>}, + generalID => "BMP", + nonStandard => #{data => <<"OC">>,nonStandardIdentifier => {1,16,414,415}}, + password => "BM", + random => -26430296, + timeStamp => 1667517741}, + #{certificate => #{certificate => <<"OC">>,type => {1,17,442,443}}, + challenge => <<"OCTET STRI">>, + dhkey => #{generator => <<1:1>>,halfkey => <<1:1>>,modSize => <<1:1>>}, + generalID => "BMP", + nonStandard => #{data => <<"OC">>,nonStandardIdentifier => {1,18,452,452}}, + password => "BMP", + random => -16356110, + timeStamp => 1817656756}]}}, + h4501SupplementaryService => [], + nonStandardControl => [], + nonStandardData => #{data => <<>>,nonStandardIdentifier => {object,{0,3,84}}}}, + 'user-data' => #{'protocol-discriminator' => 24,'user-information' => <<"O">>}}. diff --git a/lib/asn1/test/testUniqueObjectSets.erl b/lib/asn1/test/testUniqueObjectSets.erl index 4d3ec94391..30cbceb577 100644 --- a/lib/asn1/test/testUniqueObjectSets.erl +++ b/lib/asn1/test/testUniqueObjectSets.erl @@ -27,6 +27,7 @@ seq_roundtrip(I, D0) -> M = 'UniqueObjectSets', try {ok,Enc} = M:encode('Seq', {'Seq',I,D0}), + asn1_test_lib:map_roundtrip(M, 'Seq', Enc), {ok,{'Seq',I,D}} = M:decode('Seq', Enc), D catch C:E -> diff --git a/lib/asn1/test/test_compile_options.erl b/lib/asn1/test/test_compile_options.erl index ac74470537..c15e61550c 100644 --- a/lib/asn1/test/test_compile_options.erl +++ b/lib/asn1/test/test_compile_options.erl @@ -24,8 +24,8 @@ -include_lib("common_test/include/ct.hrl"). --export([wrong_path/1,comp/2,path/1,ticket_6143/1,noobj/1, - record_name_prefix/1,verbose/1]). +-export([wrong_path/1,comp/2,path/1,noobj/1, + record_name_prefix/1,verbose/1,maps/1]). %% OTP-5689 wrong_path(Config) -> @@ -64,8 +64,6 @@ path(Config) -> file:set_cwd(CWD), ok. -ticket_6143(Config) -> asn1_test_lib:compile("AA1", Config, []). - noobj(Config) -> DataDir = proplists:get_value(data_dir,Config), OutDir = proplists:get_value(priv_dir,Config), @@ -130,6 +128,28 @@ verbose(Config) when is_list(Config) -> [] = test_server:capture_get(), ok. +maps(Config) -> + DataDir = proplists:get_value(data_dir, Config), + OutDir = proplists:get_value(case_dir, Config), + InFile = filename:join(DataDir, "P-Record"), + + do_maps(ber, InFile, OutDir), + do_maps(per, InFile, OutDir), + do_maps(uper, InFile, OutDir). + +do_maps(Erule, InFile, OutDir) -> + Opts = [Erule,maps,{outdir,OutDir}], + ok = asn1ct:compile(InFile, Opts), + + %% Make sure that no .hrl files are generated. + [] = filelib:wildcard(filename:join(OutDir, "*.hrl")), + + %% Remove all generated files. + All = filelib:wildcard(filename:join(OutDir, "*")), + _ = [file:delete(N) || N <- All], + + ok. + outfiles_check(OutDir) -> outfiles_check(OutDir,outfiles1()). diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl index 460d4e2240..fbfa979e1b 100644 --- a/lib/dialyzer/test/plt_SUITE.erl +++ b/lib/dialyzer/test/plt_SUITE.erl @@ -26,6 +26,8 @@ build_plt(Config) -> end. beam_tests(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Plt = filename:join(PrivDir, "beam_tests.plt"), Prog = <<" -module(no_auto_import). @@ -42,10 +44,12 @@ beam_tests(Config) when is_list(Config) -> ">>, Opts = [no_auto_import], {ok, BeamFile} = compile(Config, Prog, no_auto_import, Opts), - [] = run_dialyzer(plt_build, [BeamFile], []), + [] = run_dialyzer(plt_build, [BeamFile], [{output_plt, Plt}]), ok. run_plt_check(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Plt = filename:join(PrivDir, "run_plt_check.plt"), Mod1 = <<" -module(run_plt_check1). ">>, @@ -56,7 +60,7 @@ run_plt_check(Config) when is_list(Config) -> {ok, BeamFile1} = compile(Config, Mod1, run_plt_check1, []), {ok, BeamFile2} = compile(Config, Mod2A, run_plt_check2, []), - [] = run_dialyzer(plt_build, [BeamFile1, BeamFile2], []), + [] = run_dialyzer(plt_build, [BeamFile1, BeamFile2], [{output_plt, Plt}]), Mod2B = <<" -module(run_plt_check2). @@ -70,11 +74,13 @@ run_plt_check(Config) when is_list(Config) -> % callgraph warning as run_plt_check2:call/1 makes a call to unexported % function run_plt_check1:call/1. - [_] = run_dialyzer(plt_check, [], []), + [_] = run_dialyzer(plt_check, [], [{init_plt, Plt}]), ok. run_succ_typings(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Plt = filename:join(PrivDir, "run_succ_typings.plt"), Mod1A = <<" -module(run_succ_typings1). @@ -84,7 +90,7 @@ run_succ_typings(Config) when is_list(Config) -> ">>, {ok, BeamFile1} = compile(Config, Mod1A, run_succ_typings1, []), - [] = run_dialyzer(plt_build, [BeamFile1], []), + [] = run_dialyzer(plt_build, [BeamFile1], [{output_plt, Plt}]), Mod1B = <<" -module(run_succ_typings1). @@ -107,9 +113,11 @@ run_succ_typings(Config) when is_list(Config) -> {ok, BeamFile2} = compile(Config, Mod2, run_succ_typings2, []), % contract types warning as run_succ_typings2:call/0 makes a call to % run_succ_typings1:call/0, which returns a (not b) in the PLT. - [_] = run_dialyzer(succ_typings, [BeamFile2], [{check_plt, false}]), + [_] = run_dialyzer(succ_typings, [BeamFile2], + [{check_plt, false}, {init_plt, Plt}]), % warning not returned as run_succ_typings1 is updated in the PLT. - [] = run_dialyzer(succ_typings, [BeamFile2], [{check_plt, true}]), + [] = run_dialyzer(succ_typings, [BeamFile2], + [{check_plt, true}, {init_plt, Plt}]), ok. @@ -252,12 +260,9 @@ remove_plt(Config) -> ok. bad_dialyzer_attr(Config) -> - PrivDir = ?config(priv_dir, Config), - Prog1 = <<"-module(dial). -dialyzer({no_return, [undef/0]}).">>, {ok, Beam1} = compile(Config, Prog1, dial, []), - Plt = filename:join(PrivDir, "bad_attr.plt"), {dialyzer_error, "Analysis failed with error:\n" "Could not scan the following file(s):\n" diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 90ef84ca51..06facae5c1 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -441,7 +441,7 @@ compile(Name, File, Opts0) when is_atom(Name) -> ?error_msg("Cannot get Core Erlang code from BEAM binary.",[]), ?EXIT({cant_compile_core_from_binary}); true -> - case filename:find_src(filename:rootname(File, ".beam")) of + case filelib:find_source(filename:rootname(File,".beam") ++ ".beam") of {error, _} -> ?error_msg("Cannot find source code for ~p.", [File]), ?EXIT({cant_find_source_code}); diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 398fc7e5b6..5c3b5a2d3c 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,22 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.3.4</title> + <section><title>Inets 6.3.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct misstakes in ftp client introduced in inets-6.3.4</p> + <p> + Own Id: OTP-14203 Aux Id: OTP-13982 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.3.4</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl index 911f5b71a7..23d6483291 100644 --- a/lib/inets/src/ftp/ftp.erl +++ b/lib/inets/src/ftp/ftp.erl @@ -1477,10 +1477,7 @@ handle_info({Trpt, Socket, Data}, #state{dsock = {Trpt,Socket}} = State0) when T handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket}, caller = {recv_file, Fd}} = State) when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} -> - case file_close(Fd) of - ok -> ok; - {error,einval} -> ok - end, + file_close(Fd), progress_report({transfer_size, 0}, State), activate_ctrl_connection(State), {noreply, State#state{dsock = undefined, data = <<>>}}; @@ -2066,10 +2063,7 @@ handle_ctrl_result({pos_prel, _}, #state{caller = {recv_file, _}} = State0) -> end; handle_ctrl_result({Status, _}, #state{caller = {recv_file, Fd}} = State) -> - case file_close(Fd) of - ok -> ok; - {error, einval} -> ok - end, + file_close(Fd), close_data_connection(State), ctrl_result_response(Status, State#state{dsock = undefined}, {error, epath}); @@ -2345,7 +2339,7 @@ accept_data_connection(#state{mode = passive} = State) -> send_ctrl_message(_S=#state{csock = Socket, verbose = Verbose}, Message) -> verbose(lists:flatten(Message),Verbose,send), ?DBG('<--ctrl ~p ---- ~s~p~n',[Socket,Message,_S]), - ok = send_message(Socket, Message). + _ = send_message(Socket, Message). send_data_message(_S=#state{dsock = Socket}, Message) -> ?DBG('<==data ~p ==== ~s~n~p~n',[Socket,Message,_S]), @@ -2366,37 +2360,44 @@ send_message({tcp, Socket}, Message) -> send_message({ssl, Socket}, Message) -> ssl:send(Socket, Message). -activate_ctrl_connection(#state{csock = Socket, ctrl_data = {<<>>, _, _}}) -> - ok = activate_connection(Socket); -activate_ctrl_connection(#state{csock = Socket}) -> - ok = activate_connection(Socket), +activate_ctrl_connection(#state{csock = CSock, ctrl_data = {<<>>, _, _}}) -> + activate_connection(CSock); +activate_ctrl_connection(#state{csock = CSock}) -> + activate_connection(CSock), %% We have already received at least part of the next control message, %% that has been saved in ctrl_data, process this first. - self() ! {socket_type(Socket), unwrap_socket(Socket), <<>>}, + self() ! {socket_type(CSock), unwrap_socket(CSock), <<>>}, ok. +activate_data_connection(#state{dsock = DSock} = State) -> + activate_connection(DSock), + State. + +activate_connection(Socket) -> + ignore_return_value( + case socket_type(Socket) of + tcp -> inet:setopts(unwrap_socket(Socket), [{active, once}]); + ssl -> ssl:setopts(unwrap_socket(Socket), [{active, once}]) + end). + + +ignore_return_value(_) -> ok. + unwrap_socket({tcp,Socket}) -> Socket; unwrap_socket({ssl,Socket}) -> Socket. socket_type({tcp,_Socket}) -> tcp; socket_type({ssl,_Socket}) -> ssl. -activate_data_connection(#state{dsock = Socket} = State) -> - ok = activate_connection(Socket), - State. - -activate_connection({tcp, Socket}) -> inet:setopts(Socket, [{active, once}]); -activate_connection({ssl, Socket}) -> ssl:setopts(Socket, [{active, once}]). - close_ctrl_connection(#state{csock = undefined}) -> ok; close_ctrl_connection(#state{csock = Socket}) -> close_connection(Socket). close_data_connection(#state{dsock = undefined}) -> ok; close_data_connection(#state{dsock = Socket}) -> close_connection(Socket). -close_connection({lsock,Socket}) -> gen_tcp:close(Socket); -close_connection({tcp, Socket}) -> gen_tcp:close(Socket); -close_connection({ssl, Socket}) -> ssl:close(Socket). +close_connection({lsock,Socket}) -> ignore_return_value( gen_tcp:close(Socket) ); +close_connection({tcp, Socket}) -> ignore_return_value( gen_tcp:close(Socket) ); +close_connection({ssl, Socket}) -> ignore_return_value( ssl:close(Socket) ). %% ------------ FILE HANDLING ---------------------------------------- send_file(#state{tls_upgrading_data_connection = {true, CTRL, _}} = State, Fd) -> @@ -2408,7 +2409,7 @@ send_file(State, Fd) -> progress_report({binary, Bin}, State), send_file(State, Fd); {ok, _, _} -> - ok = file_close(Fd), + file_close(Fd), close_data_connection(State), progress_report({transfer_size, 0}, State), activate_ctrl_connection(State), @@ -2423,7 +2424,7 @@ file_open(File, Option) -> file:open(File, [raw, binary, Option]). file_close(Fd) -> - file:close(Fd). + ignore_return_value( file:close(Fd) ). file_read(Fd) -> case file:read(Fd, ?FILE_BUFSIZE) of diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index eef5abd610..9591ab22ed 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.3.4 +INETS_VSN = 6.3.5 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index c581fa9d1e..b342fff0d3 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -433,6 +433,28 @@ MaxT = TickTime + TickTime / 4</code> return as soon as possible for <c>application_controller</c> to terminate properly.</p> </item> + <tag><c>source_search_rules = [DirRule] | [SuffixRule] </c></tag> + <item> + <marker id="source_search_rules"></marker> + <p>Where:</p> + <list type="bulleted"> + <item><c>DirRule = {ObjDirSuffix,SrcDirSuffix}</c></item> + <item><c>SuffixRule = {ObjSuffix,SrcSuffix,[DirRule]}</c></item> + <item><c>ObjDirSuffix = string()</c></item> + <item><c>SrcDirSuffix = string()</c></item> + <item><c>ObjSuffix = string()</c></item> + <item><c>SrcSuffix = string()</c></item> + </list> + <p>Specifies a list of rules for use by <c>filelib:find_file/2</c> and + <c>filelib:find_source/2</c>. If this is set to some other value + than the empty list, it replaces the default rules. Rules can be + simple pairs of directory suffixes, such as <c>{"ebin", + "src"}</c>, which are used by <c>filelib:find_file/2</c>, or + triples specifying separate directory suffix rules depending on + file name extensions, for example <c>[{".beam", ".erl", [{"ebin", + "src"}]}</c>, which are used by <c>filelib:find_source/2</c>. Both + kinds of rules can be mixed in the list.</p> + </item> </taglist> </section> diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 5a7ca493cc..2a06d0cb15 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -489,13 +489,13 @@ prepare_check_uniq_1([], [_|_]=Errors) -> {error,Errors}. partition_on_load(Prep) -> - P = fun({_,{Bin,_,_}}) -> - erlang:has_prepared_code_on_load(Bin) + P = fun({_,{PC,_,_}}) -> + erlang:has_prepared_code_on_load(PC) end, lists:partition(P, Prep). verify_prepared([{M,{Prep,Name,_Native}}|T]) - when is_atom(M), is_binary(Prep), is_list(Name) -> + when is_atom(M), is_list(Name) -> try erlang:has_prepared_code_on_load(Prep) of false -> verify_prepared(T); @@ -562,10 +562,10 @@ prepare_loading_fun() -> GetNative = get_native_fun(), fun(Mod, FullName, Beam) -> case erlang:prepare_loading(Mod, Beam) of - Prepared when is_binary(Prepared) -> - {ok,{Prepared,FullName,GetNative(Beam)}}; {error,_}=Error -> - Error + Error; + Prepared -> + {ok,{Prepared,FullName,GetNative(Beam)}} end end. diff --git a/lib/kernel/test/multi_load_SUITE.erl b/lib/kernel/test/multi_load_SUITE.erl index 369e25ac64..920839f4f9 100644 --- a/lib/kernel/test/multi_load_SUITE.erl +++ b/lib/kernel/test/multi_load_SUITE.erl @@ -144,14 +144,14 @@ prep_magic([H|T]) -> prep_magic(Tuple) when is_tuple(Tuple) -> L = prep_magic(tuple_to_list(Tuple)), list_to_tuple(L); -prep_magic(Bin) when is_binary(Bin) -> - try erlang:has_prepared_code_on_load(Bin) of +prep_magic(Ref) when is_reference(Ref) -> + try erlang:has_prepared_code_on_load(Ref) of false -> - %% Create a different kind of magic binary. + %% Create a different kind of magic ref. ets:match_spec_compile([{'_',[true],['$_']}]) catch _:_ -> - Bin + Ref end; prep_magic(Other) -> Other. diff --git a/lib/observer/src/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl index 0cea1fdcf0..200c728a62 100644 --- a/lib/observer/src/cdv_bin_cb.erl +++ b/lib/observer/src/cdv_bin_cb.erl @@ -58,7 +58,7 @@ binary_to_term_fun(Bin) -> try binary_to_term(Bin) of Term -> plain_html(io_lib:format("~p",[Term])) catch error:badarg -> - Warning = "This binary can not be coverted to an Erlang term", + Warning = "This binary can not be converted to an Erlang term", observer_html_lib:warning(Warning) end end. diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 02209d5dfd..5d178a202d 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -84,11 +84,6 @@ default_algorithms(kex) -> 'diffie-hellman-group1-sha1' % Gone in OpenSSH 7.3.p1 ]); -default_algorithms(public_key) -> - supported_algorithms(public_key, [ - 'ssh-dss' % Gone in OpenSSH 7.3.p1 - ]); - default_algorithms(cipher) -> supported_algorithms(cipher, same(['AEAD_AES_128_GCM', 'AEAD_AES_256_GCM'])); diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 84290c7ffd..2c4fa8be88 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -115,7 +115,10 @@ init_per_testcase(TC, Config) when TC == gex_client_init_option_groups ; TC == gex_client_old_request_noexact -> Opts = case TC of gex_client_init_option_groups -> - [{dh_gex_groups, [{2345, 3, 41}]}]; + [{dh_gex_groups, + [{1023, 5, + 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F + }]}]; gex_client_init_option_groups_file -> DataDir = proplists:get_value(data_dir, Config), F = filename:join(DataDir, "dh_group_test"), @@ -127,10 +130,12 @@ init_per_testcase(TC, Config) when TC == gex_client_init_option_groups ; _ when TC == gex_server_gex_limit ; TC == gex_client_old_request_exact ; TC == gex_client_old_request_noexact -> - [{dh_gex_groups, [{ 500, 3, 17}, - {1000, 7, 91}, - {3000, 5, 61}]}, - {dh_gex_limits,{500,1500}} + [{dh_gex_groups, + [{1023, 2, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A771225323}, + {1535, 5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827}, + {3071, 2, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9429825A2B} + ]}, + {dh_gex_limits, {1023,2000}} ]; _ -> [] @@ -367,20 +372,25 @@ no_common_alg_client_disconnects(Config) -> %%%-------------------------------------------------------------------- gex_client_init_option_groups(Config) -> - do_gex_client_init(Config, {2000, 2048, 4000}, - {3,41}). + do_gex_client_init(Config, {512, 2048, 4000}, + {5,16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F} + ). gex_client_init_option_groups_file(Config) -> do_gex_client_init(Config, {2000, 2048, 4000}, - {5,61}). + {5, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9424273F1F} + ). gex_client_init_option_groups_moduli_file(Config) -> do_gex_client_init(Config, {2000, 2048, 4000}, - {5,16#B7}). + {5, 16#DD2047CBDBB6F8E919BC63DE885B34D0FD6E3DB2887D8B46FE249886ACED6B46DFCD5553168185FD376122171CD8927E60120FA8D01F01D03E58281FEA9A1ABE97631C828E41815F34FDCDF787419FE13A3137649AA93D2584230DF5F24B5C00C88B7D7DE4367693428C730376F218A53E853B0851BAB7C53C15DA7839CBE1285DB63F6FA45C1BB59FE1C5BB918F0F8459D7EF60ACFF5C0FA0F3FCAD1C5F4CE4416D4F4B36B05CDCEBE4FB879E95847EFBC6449CD190248843BC7EDB145FBFC4EDBB1A3C959298F08F3BA2CFBE231BBE204BE6F906209D28BD4820AB3E7BE96C26AE8A809ADD8D1A5A0B008E9570FA4C4697E116B8119892C604293683A9635F} + ). gex_server_gex_limit(Config) -> do_gex_client_init(Config, {1000, 3000, 4000}, - {7,91}). + %% {7,91}). + {5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827} + ). do_gex_client_init(Config, {Min,N,Max}, {G,P}) -> @@ -408,8 +418,15 @@ do_gex_client_init(Config, {Min,N,Max}, {G,P}) -> ). %%%-------------------------------------------------------------------- -gex_client_old_request_exact(Config) -> do_gex_client_init_old(Config, 500, {3,17}). -gex_client_old_request_noexact(Config) -> do_gex_client_init_old(Config, 800, {7,91}). +gex_client_old_request_exact(Config) -> + do_gex_client_init_old(Config, 1023, + {2, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A771225323} + ). + +gex_client_old_request_noexact(Config) -> + do_gex_client_init_old(Config, 1400, + {5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827} + ). do_gex_client_init_old(Config, N, {G,P}) -> {ok,_} = diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test index 2887bb4b60..87c4b4afc8 100644 --- a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test +++ b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test @@ -1,3 +1,3 @@ -{2222, 5, 61}. -{1111, 7, 91}. +{1023, 5, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F}. +{3071, 5, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9424273F1F}. diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli index f6995ba4c9..6d2b4bcb59 100644 --- a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli +++ b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli @@ -1,3 +1,2 @@ -20151021104105 2 6 100 2222 5 B7 -20151021104106 2 6 100 1111 5 4F - +20120821044046 2 6 100 1023 2 D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A7711F2C6B +20120821050554 2 6 100 2047 5 DD2047CBDBB6F8E919BC63DE885B34D0FD6E3DB2887D8B46FE249886ACED6B46DFCD5553168185FD376122171CD8927E60120FA8D01F01D03E58281FEA9A1ABE97631C828E41815F34FDCDF787419FE13A3137649AA93D2584230DF5F24B5C00C88B7D7DE4367693428C730376F218A53E853B0851BAB7C53C15DA7839CBE1285DB63F6FA45C1BB59FE1C5BB918F0F8459D7EF60ACFF5C0FA0F3FCAD1C5F4CE4416D4F4B36B05CDCEBE4FB879E95847EFBC6449CD190248843BC7EDB145FBFC4EDBB1A3C959298F08F3BA2CFBE231BBE204BE6F906209D28BD4820AB3E7BE96C26AE8A809ADD8D1A5A0B008E9570FA4C4697E116B8119892C604293683A9635F diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 286ac6e882..1673f52821 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -690,13 +690,16 @@ ssh_type() -> ssh_type1() -> try + ct:log("~p:~p os:find_executable(\"ssh\")",[?MODULE,?LINE]), case os:find_executable("ssh") of false -> ct:log("~p:~p Executable \"ssh\" not found",[?MODULE,?LINE]), not_found; - _ -> + Path -> + ct:log("~p:~p Found \"ssh\" at ~p",[?MODULE,?LINE,Path]), case os:cmd("ssh -V") of - "OpenSSH" ++ _ -> + Version = "OpenSSH" ++ _ -> + ct:log("~p:~p Found OpenSSH ~p",[?MODULE,?LINE,Version]), openSSH; Str -> ct:log("ssh client ~p is unknown",[Str]), diff --git a/lib/stdlib/doc/src/c.xml b/lib/stdlib/doc/src/c.xml index 55a77d1bc5..7666699183 100644 --- a/lib/stdlib/doc/src/c.xml +++ b/lib/stdlib/doc/src/c.xml @@ -52,13 +52,27 @@ <func> <name name="c" arity="1"/> <name name="c" arity="2"/> - <fsummary>Compile and load code in a file.</fsummary> + <name name="c" arity="3"/> + <fsummary>Compile and load a file or module.</fsummary> <desc> - <p>Compiles and then purges and loads the code for a file. - <c><anno>Options</anno></c> defaults to <c>[]</c>. Compilation is - equivalent to:</p> - <code type="none"> -compile:file(<anno>File</anno>, <anno>Options</anno> ++ [report_errors, report_warnings])</code> + <p>Compiles and then purges and loads the code for a module. + <c><anno>Module</anno></c> can be either a module name or a source + file path, with or without <c>.erl</c> extension. + <c><anno>Options</anno></c> defaults to <c>[]</c>.</p> + <p>If <c><anno>Module</anno></c> is an atom and is not the path of a + source file, then the code path is searched to locate the object + file for the module and extract its original compiler options and + source path. If the source file is not found in the original + location, <seealso + marker="filelib#find_source/1"><c>filelib:find_source/1</c></seealso> + is used to search for it relative to the directory of the object + file.</p> + <p>The source file is compiled with the the original + options appended to the given <c><anno>Options</anno></c>, the + output replacing the old object file if and only if compilation + succeeds. A function <c><anno>Filter</anno></c> can be specified + for removing elements from from the original compiler options + before the new options are added.</p> <p>Notice that purging the code means that any processes lingering in old code for the module are killed without warning. For more information, see <c>code/3</c>.</p> diff --git a/lib/stdlib/doc/src/filelib.xml b/lib/stdlib/doc/src/filelib.xml index 7c6380ce28..ad73fc254a 100644 --- a/lib/stdlib/doc/src/filelib.xml +++ b/lib/stdlib/doc/src/filelib.xml @@ -60,6 +60,12 @@ <datatype> <name name="filename_all"/> </datatype> + <datatype> + <name name="find_file_rule"/> + </datatype> + <datatype> + <name name="find_source_rule"/> + </datatype> </datatypes> <funcs> @@ -226,7 +232,51 @@ filelib:wildcard("lib/**/*.{erl,hrl}")</code> directory.</p> </desc> </func> + + <func> + <name name="find_file" arity="2"/> + <name name="find_file" arity="3"/> + <fsummary>Find a file relative to a given directory.</fsummary> + <desc> + <p>Looks for a file of the given name by applying suffix rules to + the given directory path. For example, a rule <c>{"ebin", "src"}</c> + means that if the directory path ends with <c>"ebin"</c>, the + corresponding path ending in <c>"src"</c> should be searched.</p> + <p>If <c><anno>Rules</anno></c> is left out or is an empty list, the + default system rules are used. See also the Kernel application + parameter <seealso + marker="kernel:kernel_app#source_search_rules"><c>source_search_rules</c></seealso>.</p> + </desc> + </func> + <func> + <name name="find_source" arity="1"/> + <fsummary>Find the source file for a given object file.</fsummary> + <desc> + <p>Equivalent to <c>find_source(Base, Dir)</c>, where <c>Dir</c> is + <c>filename:dirname(<anno>FilePath</anno>)</c> and <c>Base</c> is + <c>filename:basename(<anno>FilePath</anno>)</c>.</p> + </desc> + </func> + <func> + <name name="find_source" arity="2"/> + <name name="find_source" arity="3"/> + <fsummary>Find a source file relative to a given directory.</fsummary> + <desc> + <p>Applies file extension specific rules to find the source file for + a given object file relative to the object directory. For example, + for a file with the extension <c>.beam</c>, the default rule is to + look for a file with a corresponding extension <c>.erl</c> by + replacing the suffix <c>"ebin"</c> of the object directory path with + <c>"src"</c>. + The file search is done through <seealso + marker="#find_file/3"><c>find_file/3</c></seealso>. The directory of + the object file is always tried before any other directory specified + by the rules.</p> + <p>If <c><anno>Rules</anno></c> is left out or is an empty list, the + default system rules are used. See also the Kernel application + parameter <seealso + marker="kernel:kernel_app#source_search_rules"><c>source_search_rules</c></seealso>.</p> + </desc> + </func> </funcs> </erlref> - - diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml index 2a413835d0..7acef51ca1 100644 --- a/lib/stdlib/doc/src/filename.xml +++ b/lib/stdlib/doc/src/filename.xml @@ -356,10 +356,12 @@ true <p>Finds the source filename and compiler options for a module. The result can be fed to <seealso marker="compiler:compile#file/2"> <c>compile:file/2</c></seealso> to compile the file again.</p> - <warning><p>It is not recommended to use this function. If possible, - use the <seealso marker="beam_lib"><c>beam_lib(3)</c></seealso> - module to extract the abstract code format from the Beam file and - compile that instead.</p></warning> + <warning> + <p>This function is deprecated. Use <seealso marker="filelib#find_source/1"> + <c>filelib:find_source/1</c></seealso> instead for finding source files.</p> + <p>If possible, use the <seealso marker="beam_lib"><c>beam_lib(3)</c></seealso> + module to extract the compiler options and the abstract code + format from the Beam file and compile that instead.</p></warning> <p>Argument <c><anno>Beam</anno></c>, which can be a string or an atom, specifies either the module name or the path to the source code, with or without extension <c>".erl"</c>. In either diff --git a/lib/stdlib/doc/src/shell.xml b/lib/stdlib/doc/src/shell.xml index d6e8036d4e..f52bc39deb 100644 --- a/lib/stdlib/doc/src/shell.xml +++ b/lib/stdlib/doc/src/shell.xml @@ -165,12 +165,12 @@ <item> <p>Evaluates <c>shell_default:help()</c>.</p> </item> - <tag><c>c(File)</c></tag> + <tag><c>c(Mod)</c></tag> <item> - <p>Evaluates <c>shell_default:c(File)</c>. This compiles - and loads code in <c>File</c> and purges old versions of - code, if necessary. Assumes that the file and module names - are the same.</p> + <p>Evaluates <c>shell_default:c(Mod)</c>. This compiles and + loads the module <c>Mod</c> and purges old versions of the + code, if necessary. <c>Mod</c> can be either a module name or a + a source file path, with or without <c>.erl</c> extension.</p> </item> <tag><c>catch_exception(Bool)</c></tag> <item> diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl index ccc827ca2d..45666fbcb4 100644 --- a/lib/stdlib/src/binary.erl +++ b/lib/stdlib/src/binary.erl @@ -24,7 +24,7 @@ -export_type([cp/0]). --opaque cp() :: {'am' | 'bm', binary()}. +-opaque cp() :: {'am' | 'bm', reference()}. -type part() :: {Start :: non_neg_integer(), Length :: integer()}. %%% BIFs. diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index d36630214c..d3f9a9c7af 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -23,7 +23,7 @@ %% Avoid warning for local function error/2 clashing with autoimported BIF. -compile({no_auto_import,[error/2]}). --export([help/0,lc/1,c/1,c/2,nc/1,nc/2, nl/1,l/1,i/0,i/1,ni/0, +-export([help/0,lc/1,c/1,c/2,c/3,nc/1,nc/2, nl/1,l/1,i/0,i/1,ni/0, y/1, y/2, lc_batch/0, lc_batch/1, i/3,pid/3,m/0,m/1,mm/0,lm/0, @@ -44,7 +44,7 @@ help() -> io:put_chars(<<"bt(Pid) -- stack backtrace for a process\n" - "c(File) -- compile and load code in <File>\n" + "c(Mod) -- compile and load module or file <Mod>\n" "cd(Dir) -- change working directory\n" "flush() -- flush any messages sent to the shell\n" "help() -- help info\n" @@ -72,32 +72,222 @@ help() -> "xm(M) -- cross reference check a module\n" "y(File) -- generate a Yecc parser\n">>). -%% c(FileName) -%% Compile a file/module. +%% c(Module) +%% Compile a module/file. --spec c(File) -> {'ok', Module} | 'error' when - File :: file:name(), - Module :: module(). +-spec c(Module) -> {'ok', ModuleName} | 'error' when + Module :: file:name(), + ModuleName :: module(). -c(File) -> c(File, []). +c(Module) -> c(Module, []). --spec c(File, Options) -> {'ok', Module} | 'error' when - File :: file:name(), +-spec c(Module, Options) -> {'ok', ModuleName} | 'error' when + Module :: file:name(), Options :: [compile:option()], - Module :: module(). + ModuleName :: module(). + +c(Module, Opts) when is_atom(Module) -> + %% either a module name or a source file name (possibly without + %% suffix); if such a source file exists, it is used to compile from + %% scratch with the given options, otherwise look for an object file + Suffix = case filename:extension(Module) of + "" -> src_suffix(Opts); + S -> S + end, + SrcFile = filename:rootname(Module, Suffix) ++ Suffix, + case filelib:is_file(SrcFile) of + true -> + compile_and_load(SrcFile, Opts); + false -> + c(Module, Opts, fun (_) -> true end) + end; +c(Module, Opts) -> + %% we never interpret a string as a module name, only as a file + compile_and_load(Module, Opts). + +%% This tries to find an existing object file and use its compile_info and +%% source path to recompile the module, overwriting the old object file. +%% The Filter parameter is applied to the old compile options + +-spec c(Module, Options, Filter) -> {'ok', ModuleName} | 'error' when + Module :: atom(), + Options :: [compile:option()], + Filter :: fun ((compile:option()) -> boolean()), + ModuleName :: module(). + +c(Module, Options, Filter) when is_atom(Module) -> + case find_beam(Module) of + BeamFile when is_list(BeamFile) -> + c(Module, Options, Filter, BeamFile); + Error -> + {error, Error} + end. + +c(Module, Options, Filter, BeamFile) -> + case compile_info(Module, BeamFile) of + Info when is_list(Info) -> + case find_source(BeamFile, Info) of + SrcFile when is_list(SrcFile) -> + c(SrcFile, Options, Filter, BeamFile, Info); + Error -> + Error + end; + Error -> + Error + end. + +c(SrcFile, NewOpts, Filter, BeamFile, Info) -> + %% Filter old options; also remove options that will be replaced. + %% Write new beam over old beam unless other outdir is specified. + F = fun (Opt) -> not is_outdir_opt(Opt) andalso Filter(Opt) end, + Options = (NewOpts ++ [{outdir,filename:dirname(BeamFile)}] + ++ lists:filter(F, old_options(Info))), + format("Recompiling ~s\n", [SrcFile]), + safe_recompile(SrcFile, Options, BeamFile). + +old_options(Info) -> + case lists:keyfind(options, 1, Info) of + {options, Opts} -> Opts; + false -> [] + end. + +%% prefer the source path in the compile info if the file exists, +%% otherwise do a standard source search relative to the beam file +find_source(BeamFile, Info) -> + case lists:keyfind(source, 1, Info) of + {source, SrcFile} -> + case filelib:is_file(SrcFile) of + true -> SrcFile; + false -> find_source(BeamFile) + end; + _ -> + find_source(BeamFile) + end. + +find_source(BeamFile) -> + case filelib:find_source(BeamFile) of + {ok, SrcFile} -> SrcFile; + _ -> {error, no_source} + end. -c(File, Opts0) when is_list(Opts0) -> - Opts = [report_errors,report_warnings|Opts0], +%% find the beam file for a module, preferring the path reported by code:which() +%% if it still exists, or otherwise by searching the code path +find_beam(Module) when is_atom(Module) -> + case code:which(Module) of + Beam when is_list(Beam), Beam =/= "" -> + case erlang:module_loaded(Module) of + false -> + Beam; % code:which/1 found this in the path + true -> + case filelib:is_file(Beam) of + true -> Beam; + false -> find_beam_1(Module) % file moved? + end + end; + Other when Other =:= ""; Other =:= cover_compiled -> + %% module is loaded but not compiled directly from source + find_beam_1(Module); + Error -> + Error + end. + +find_beam_1(Module) -> + File = atom_to_list(Module) ++ code:objfile_extension(), + case code:where_is_file(File) of + Beam when is_list(Beam) -> + Beam; + Error -> + Error + end. + +%% get the compile_info for a module +%% -will report the info for the module in memory, if loaded +%% -will try to find and examine the beam file if not in memory +%% -will not cause a module to become loaded by accident +compile_info(Module, Beam) when is_atom(Module) -> + case erlang:module_loaded(Module) of + true -> + %% getting the compile info for a loaded module should normally + %% work, but return an empty info list if it fails + try erlang:get_module_info(Module, compile) + catch _:_ -> [] + end; + false -> + case beam_lib:chunks(Beam, [compile_info]) of + {ok, {_Module, [{compile_info, Info}]}} -> + Info; + Error -> + Error + end + end. + +%% compile module, backing up any existing target file and restoring the +%% old version if compilation fails (this should only be used when we have +%% an old beam file that we want to preserve) +safe_recompile(File, Options, BeamFile) -> + %% Note that it's possible that because of options such as 'to_asm', + %% the compiler might not actually write a new beam file at all + Backup = BeamFile ++ ".bak", + case file:rename(BeamFile, Backup) of + Status when Status =:= ok; Status =:= {error,enoent} -> + case compile_and_load(File, Options) of + {ok, _} = Result -> + _ = if Status =:= ok -> file:delete(Backup); + true -> ok + end, + Result; + Error -> + _ = if Status =:= ok -> file:rename(Backup, BeamFile); + true -> ok + end, + Error + end; + Error -> + Error + end. + +%% Compile the file and load the resulting object code (if any). +%% Automatically ensures that there is an outdir option, by default the +%% directory of File, and that a 'from' option will be passed to match the +%% actual source suffix if needed (unless already specified). +compile_and_load(File, Opts0) when is_list(Opts0) -> + Opts = [report_errors, report_warnings + | ensure_from(filename:extension(File), + ensure_outdir(filename:dirname(File), Opts0))], case compile:file(File, Opts) of {ok,Mod} -> %Listing file. - machine_load(Mod, File, Opts); + purge_and_load(Mod, File, Opts); {ok,Mod,_Ws} -> %Warnings maybe turned on. - machine_load(Mod, File, Opts); + purge_and_load(Mod, File, Opts); Other -> %Errors go here Other end; -c(File, Opt) -> - c(File, [Opt]). +compile_and_load(File, Opt) -> + compile_and_load(File, [Opt]). + +ensure_from(Suffix, Opts0) -> + case lists:partition(fun is_from_opt/1, Opts0++from_opt(Suffix)) of + {[Opt|_], Opts} -> [Opt | Opts]; + {[], Opts} -> Opts + end. + +ensure_outdir(Dir, Opts0) -> + {[Opt|_], Opts} = lists:partition(fun is_outdir_opt/1, + Opts0++[{outdir,Dir}]), + [Opt | Opts]. + +is_outdir_opt({outdir, _}) -> true; +is_outdir_opt(_) -> false. + +is_from_opt(from_core) -> true; +is_from_opt(from_asm) -> true; +is_from_opt(from_beam) -> true; +is_from_opt(_) -> false. + +from_opt(".core") -> [from_core]; +from_opt(".S") -> [from_asm]; +from_opt(".beam") -> [from_beam]; +from_opt(_) -> []. %%% Obtain the 'outdir' option from the argument. Return "." if no %%% such option was given. @@ -113,18 +303,29 @@ outdir([Opt|Rest]) -> outdir(Rest) end. +%% mimic how suffix is selected in compile:file(). +src_suffix([from_core|_]) -> ".core"; +src_suffix([from_asm|_]) -> ".S"; +src_suffix([from_beam|_]) -> ".beam"; +src_suffix([_|Opts]) -> src_suffix(Opts); +src_suffix([]) -> ".erl". + %%% We have compiled File with options Opts. Find out where the -%%% output file went to, and load it. -machine_load(Mod, File, Opts) -> +%%% output file went and load it, purging any old version. +purge_and_load(Mod, File, Opts) -> Dir = outdir(Opts), - File2 = filename:join(Dir, filename:basename(File, ".erl")), + Base = filename:basename(File, src_suffix(Opts)), + OutFile = filename:join(Dir, Base), case compile:output_generated(Opts) of true -> - Base = atom_to_list(Mod), - case filename:basename(File, ".erl") of + case atom_to_list(Mod) of Base -> code:purge(Mod), - check_load(code:load_abs(File2,Mod), Mod); + %% Note that load_abs() adds the object file suffix + case code:load_abs(OutFile, Mod) of + {error, _R}=Error -> Error; + _ -> {ok, Mod} + end; _OtherMod -> format("** Module name '~p' does not match file name '~tp' **~n", [Mod,File]), @@ -135,13 +336,6 @@ machine_load(Mod, File, Opts) -> ok end. -%%% This function previously warned if the loaded module was -%%% loaded from some other place than current directory. -%%% Now, loading from other than current directory is supposed to work. -%%% so this function does nothing special. -check_load({error, _R} = Error, _) -> Error; -check_load(_, Mod) -> {ok, Mod}. - %% Compile a list of modules %% enables the nice unix shell cmd %% erl -s c lc f1 f2 f3 @d c1=v1 @c2 @i IDir @o ODir -s erlang halt diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 5bc9475fc8..e81383775b 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1063,11 +1063,8 @@ foldl_bins([Bin | Bins], MP, Terms) -> compile_match_spec(select, ?PATTERN_TO_OBJECT_MATCH_SPEC('_') = Spec) -> {Spec, true}; compile_match_spec(select, Spec) -> - case catch ets:match_spec_compile(Spec) of - X when is_binary(X) -> - {Spec, {match_spec, X}}; - _ -> - badarg + try {Spec, {match_spec, ets:match_spec_compile(Spec)}} + catch error:_ -> badarg end; compile_match_spec(object, Pat) -> compile_match_spec(select, ?PATTERN_TO_OBJECT_MATCH_SPEC(Pat)); diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 20de06fd0b..d6fd1e3ea1 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -51,8 +51,8 @@ -type tab() :: atom() | tid(). -type type() :: set | ordered_set | bag | duplicate_bag. -type continuation() :: '$end_of_table' - | {tab(),integer(),integer(),binary(),list(),integer()} - | {tab(),_,_,integer(),binary(),list(),integer(),integer()}. + | {tab(),integer(),integer(),comp_match_spec(),list(),integer()} + | {tab(),_,_,integer(),comp_match_spec(),list(),integer(),integer()}. -opaque tid() :: integer(). @@ -488,7 +488,7 @@ update_element(_, _, _) -> %%% End of BIFs --opaque comp_match_spec() :: binary(). %% this one is REALLY opaque +-opaque comp_match_spec() :: reference(). -spec match_spec_run(List, CompiledMatchSpec) -> list() when List :: [tuple()], @@ -505,28 +505,28 @@ match_spec_run(List, CompiledMS) -> repair_continuation('$end_of_table', _) -> '$end_of_table'; %% ordered_set -repair_continuation(Untouched = {Table,Lastkey,EndCondition,N2,Bin,L2,N3,N4}, MS) +repair_continuation(Untouched = {Table,Lastkey,EndCondition,N2,MSRef,L2,N3,N4}, MS) when %% (is_atom(Table) or is_integer(Table)), is_integer(N2), - byte_size(Bin) =:= 0, + %% is_reference(MSRef), is_list(L2), is_integer(N3), is_integer(N4) -> - case ets:is_compiled_ms(Bin) of + case ets:is_compiled_ms(MSRef) of true -> Untouched; false -> {Table,Lastkey,EndCondition,N2,ets:match_spec_compile(MS),L2,N3,N4} end; %% set/bag/duplicate_bag -repair_continuation(Untouched = {Table,N1,N2,Bin,L,N3}, MS) +repair_continuation(Untouched = {Table,N1,N2,MSRef,L,N3}, MS) when %% (is_atom(Table) or is_integer(Table)), is_integer(N1), is_integer(N2), - byte_size(Bin) =:= 0, + %% is_reference(MSRef), is_list(L), is_integer(N3) -> - case ets:is_compiled_ms(Bin) of + case ets:is_compiled_ms(MSRef) of true -> Untouched; false -> diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index 7029389e2f..daa18da9aa 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -24,6 +24,7 @@ -export([fold_files/5, last_modified/1, file_size/1, ensure_dir/1]). -export([wildcard/3, is_dir/2, is_file/2, is_regular/2]). -export([fold_files/6, last_modified/2, file_size/2]). +-export([find_file/2, find_file/3, find_source/1, find_source/2, find_source/3]). %% For debugging/testing. -export([compile_wildcard/1]). @@ -517,3 +518,124 @@ eval_list_dir(Dir, erl_prim_loader) -> end; eval_list_dir(Dir, Mod) -> Mod:list_dir(Dir). + +%% Getting the rules to use for file search + +keep_dir_search_rules(Rules) -> + [T || {_,_}=T <- Rules]. + +keep_suffix_search_rules(Rules) -> + [T || {_,_,_}=T <- Rules]. + +get_search_rules() -> + case application:get_env(kernel, source_search_rules) of + undefined -> default_search_rules(); + {ok, []} -> default_search_rules(); + {ok, R} when is_list(R) -> R + end. + +default_search_rules() -> + [%% suffix-speficic rules for source search + {".beam", ".erl", erl_source_search_rules()}, + {".erl", ".yrl", []}, + {"", ".src", erl_source_search_rules()}, + {".so", ".c", c_source_search_rules()}, + {".o", ".c", c_source_search_rules()}, + {"", ".c", c_source_search_rules()}, + {"", ".in", basic_source_search_rules()}, + %% plain old directory rules, backwards compatible + {"", ""}, + {"ebin","src"}, + {"ebin","esrc"} + ]. + +basic_source_search_rules() -> + (erl_source_search_rules() + ++ c_source_search_rules()). + +erl_source_search_rules() -> + [{"ebin","src"}, {"ebin","esrc"}]. + +c_source_search_rules() -> + [{"priv","c_src"}, {"priv","src"}, {"bin","c_src"}, {"bin","src"}, {"", "src"}]. + +%% Looks for a file relative to a given directory + +-type find_file_rule() :: {ObjDirSuffix::string(), SrcDirSuffix::string()}. + +-spec find_file(filename(), filename()) -> + {ok, filename()} | {error, not_found}. +find_file(Filename, Dir) -> + find_file(Filename, Dir, []). + +-spec find_file(filename(), filename(), [find_file_rule()]) -> + {ok, filename()} | {error, not_found}. +find_file(Filename, Dir, []) -> + find_file(Filename, Dir, get_search_rules()); +find_file(Filename, Dir, Rules) -> + try_dir_rules(keep_dir_search_rules(Rules), Filename, Dir). + +%% Looks for a source file relative to the object file name and directory + +-type find_source_rule() :: {ObjExtension::string(), SrcExtension::string(), + [find_file_rule()]}. + +-spec find_source(filename()) -> + {ok, filename()} | {error, not_found}. +find_source(FilePath) -> + find_source(filename:basename(FilePath), filename:dirname(FilePath)). + +-spec find_source(filename(), filename()) -> + {ok, filename()} | {error, not_found}. +find_source(Filename, Dir) -> + find_source(Filename, Dir, []). + +-spec find_source(filename(), filename(), [find_source_rule()]) -> + {ok, filename()} | {error, not_found}. +find_source(Filename, Dir, []) -> + find_source(Filename, Dir, get_search_rules()); +find_source(Filename, Dir, Rules) -> + try_suffix_rules(keep_suffix_search_rules(Rules), Filename, Dir). + +try_suffix_rules(Rules, Filename, Dir) -> + Ext = filename:extension(Filename), + try_suffix_rules(Rules, filename:rootname(Filename, Ext), Dir, Ext). + +try_suffix_rules([{Ext,Src,Rules}|Rest], Root, Dir, Ext) + when is_list(Src), is_list(Rules) -> + case try_dir_rules(add_local_search(Rules), Root ++ Src, Dir) of + {ok, File} -> {ok, File}; + _Other -> + try_suffix_rules(Rest, Root, Dir, Ext) + end; +try_suffix_rules([_|Rest], Root, Dir, Ext) -> + try_suffix_rules(Rest, Root, Dir, Ext); +try_suffix_rules([], _Root, _Dir, _Ext) -> + {error, not_found}. + +%% ensuring we check the directory of the object file before any other directory +add_local_search(Rules) -> + Local = {"",""}, + [Local] ++ lists:filter(fun (X) -> X =/= Local end, Rules). + +try_dir_rules([{From, To}|Rest], Filename, Dir) + when is_list(From), is_list(To) -> + case try_dir_rule(Dir, Filename, From, To) of + {ok, File} -> {ok, File}; + error -> try_dir_rules(Rest, Filename, Dir) + end; +try_dir_rules([], _Filename, _Dir) -> + {error, not_found}. + +try_dir_rule(Dir, Filename, From, To) -> + case lists:suffix(From, Dir) of + true -> + NewDir = lists:sublist(Dir, 1, length(Dir)-length(From))++To, + Src = filename:join(NewDir, Filename), + case is_regular(Src) of + true -> {ok, Src}; + false -> error + end; + false -> + error + end. diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index c4586171ca..2a2f25dcd2 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -19,6 +19,9 @@ %% -module(filename). +-deprecated({find_src,1,next_major_release}). +-deprecated({find_src,2,next_major_release}). + %% Purpose: Provides generic manipulation of filenames. %% %% Generally, these functions accept filenames in the native format @@ -34,8 +37,8 @@ -export([absname/1, absname/2, absname_join/2, basename/1, basename/2, dirname/1, extension/1, join/1, join/2, pathtype/1, - rootname/1, rootname/2, split/1, nativename/1]). --export([find_src/1, find_src/2, flatten/1]). + rootname/1, rootname/2, split/1, flatten/1, nativename/1]). +-export([find_src/1, find_src/2]). % deprecated -export([basedir/2, basedir/3]). %% Undocumented and unsupported exports. @@ -750,8 +753,12 @@ separators() -> _ -> {false, false} end. - - +%% NOTE: The find_src/1/2 functions are deprecated; they try to do too much +%% at once and are not a good fit for this module. Parts of the code have +%% been moved to filelib:find_file/2 instead. Only this part of this +%% module is allowed to call the filelib module; such mutual dependency +%% should otherwise be avoided! This code should eventually be removed. +%% %% find_src(Module) -- %% find_src(Module, Rules) -- %% @@ -793,14 +800,7 @@ separators() -> | {'d', atom()}, ErrorReason :: 'non_existing' | 'preloaded' | 'interpreted'. find_src(Mod) -> - Default = [{"", ""}, {"ebin", "src"}, {"ebin", "esrc"}], - Rules = - case application:get_env(kernel, source_search_rules) of - undefined -> Default; - {ok, []} -> Default; - {ok, R} when is_list(R) -> R - end, - find_src(Mod, Rules). + find_src(Mod, []). -spec find_src(Beam, Rules) -> {SourceFile, Options} | {error, {ErrorReason, Module}} when @@ -816,44 +816,47 @@ find_src(Mod) -> ErrorReason :: 'non_existing' | 'preloaded' | 'interpreted'. find_src(Mod, Rules) when is_atom(Mod) -> find_src(atom_to_list(Mod), Rules); -find_src(File0, Rules) when is_list(File0) -> - Mod = list_to_atom(basename(File0, ".erl")), - File = rootname(File0, ".erl"), - case readable_file(File++".erl") of - true -> - try_file(File, Mod, Rules); - false -> - try_file(undefined, Mod, Rules) - end. - -try_file(File, Mod, Rules) -> +find_src(ModOrFile, Rules) when is_list(ModOrFile) -> + Extension = ".erl", + Mod = list_to_atom(basename(ModOrFile, Extension)), case code:which(Mod) of Possibly_Rel_Path when is_list(Possibly_Rel_Path) -> - {ok, Cwd} = file:get_cwd(), - Path = join(Cwd, Possibly_Rel_Path), - try_file(File, Path, Mod, Rules); + {ok, Cwd} = file:get_cwd(), + ObjPath = make_abs_path(Cwd, Possibly_Rel_Path), + find_src_1(ModOrFile, ObjPath, Mod, Extension, Rules); Ecode when is_atom(Ecode) -> % Ecode :: ecode() {error, {Ecode, Mod}} end. %% At this point, the Mod is known to be valid. %% If the source name is not known, find it. -%% Then get the compilation options. -%% Returns: {SrcFile, Options} +find_src_1(ModOrFile, ObjPath, Mod, Extension, Rules) -> + %% The documentation says this function must return the found path + %% without extension in all cases. Also, ModOrFile could be given with + %% or without extension. Hence the calls to rootname below. + ModOrFileRoot = rootname(ModOrFile, Extension), + case filelib:is_regular(ModOrFileRoot++Extension) of + true -> + find_src_2(ModOrFileRoot, Mod); + false -> + SrcName = basename(ObjPath, code:objfile_extension()) ++ Extension, + case filelib:find_file(SrcName, dirname(ObjPath), Rules) of + {ok, SrcFile} -> + find_src_2(rootname(SrcFile, Extension), Mod); + Error -> + Error + end + end. -try_file(undefined, ObjFilename, Mod, Rules) -> - case get_source_file(ObjFilename, Mod, Rules) of - {ok, File} -> try_file(File, ObjFilename, Mod, Rules); - Error -> Error - end; -try_file(Src, _ObjFilename, Mod, _Rules) -> +%% Get the compilation options and return {SrcFileRoot, Options} +find_src_2(SrcRoot, Mod) -> List = case Mod:module_info(compile) of none -> []; List0 -> List0 end, Options = proplists:get_value(options, List, []), {ok, Cwd} = file:get_cwd(), - AbsPath = make_abs_path(Cwd, Src), + AbsPath = make_abs_path(Cwd, SrcRoot), {AbsPath, filter_options(dirname(AbsPath), Options, [])}. %% Filters the options. @@ -884,42 +887,6 @@ filter_options(Base, [_|Rest], Result) -> filter_options(_Base, [], Result) -> Result. -%% Gets the source file given path of object code and module name. - -get_source_file(Obj, Mod, Rules) -> - source_by_rules(dirname(Obj), atom_to_list(Mod), Rules). - -source_by_rules(Dir, Base, [{From, To}|Rest]) -> - case try_rule(Dir, Base, From, To) of - {ok, File} -> {ok, File}; - error -> source_by_rules(Dir, Base, Rest) - end; -source_by_rules(_Dir, _Base, []) -> - {error, source_file_not_found}. - -try_rule(Dir, Base, From, To) -> - case lists:suffix(From, Dir) of - true -> - NewDir = lists:sublist(Dir, 1, length(Dir)-length(From))++To, - Src = join(NewDir, Base), - case readable_file(Src++".erl") of - true -> {ok, Src}; - false -> error - end; - false -> - error - end. - -readable_file(File) -> - case file:read_file_info(File) of - {ok, #file_info{type=regular, access=read}} -> - true; - {ok, #file_info{type=regular, access=read_write}} -> - true; - _Other -> - false - end. - make_abs_path(BasePath, Path) -> join(BasePath, Path). diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 5bf77a5160..2a0e3118d0 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -550,6 +550,13 @@ obsolete_1(overload, _, _) -> obsolete_1(rpc, safe_multi_server_call, A) when A =:= 2; A =:= 3 -> {removed, {rpc, multi_server_call, A}}; +%% Added in OTP 20. + +obsolete_1(filename, find_src, 1) -> + {deprecated, "deprecated; use filelib:find_source/1 instead"}; +obsolete_1(filename, find_src, 2) -> + {deprecated, "deprecated; use filelib:find_source/3 instead"}; + %% Removed in OTP 20. obsolete_1(erlang, hash, 2) -> diff --git a/lib/stdlib/src/shell_default.erl b/lib/stdlib/src/shell_default.erl index cd63ab28b5..a0c1d98513 100644 --- a/lib/stdlib/src/shell_default.erl +++ b/lib/stdlib/src/shell_default.erl @@ -23,7 +23,7 @@ -module(shell_default). --export([help/0,lc/1,c/1,c/2,nc/1,nl/1,l/1,i/0,pid/3,i/3,m/0,m/1,lm/0,mm/0, +-export([help/0,lc/1,c/1,c/2,c/3,nc/1,nl/1,l/1,i/0,pid/3,i/3,m/0,m/1,lm/0,mm/0, memory/0,memory/1,uptime/0, erlangrc/1,bi/1, regs/0, flush/0,pwd/0,ls/0,ls/1,cd/1, y/1, y/2, @@ -72,6 +72,7 @@ bi(I) -> c:bi(I). bt(Pid) -> c:bt(Pid). c(File) -> c:c(File). c(File, Opt) -> c:c(File, Opt). +c(File, Opt, Filter) -> c:c(File, Opt, Filter). cd(D) -> c:cd(D). erlangrc(X) -> c:erlangrc(X). flush() -> c:flush(). diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index aa31fdde5a..95c9b47465 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -3012,8 +3012,13 @@ repair_continuation(Config) -> MS = [{'_',[],[true]}], - {[true], C1} = dets:select(Tab, MS, 1), - C2 = binary_to_term(term_to_binary(C1)), + SRes = term_to_binary(dets:select(Tab, MS, 1)), + %% Get rid of compiled match spec + lists:foreach(fun (P) -> + garbage_collect(P) + end, processes()), + {[true], C2} = binary_to_term(SRes), + {'EXIT', {badarg, _}} = (catch dets:select(C2)), C3 = dets:repair_continuation(C2, MS), {[true], C4} = dets:select(C3), diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 4f8936edbf..87fba815d2 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -25,7 +25,8 @@ init_per_testcase/2,end_per_testcase/2, wildcard_one/1,wildcard_two/1,wildcard_errors/1, fold_files/1,otp_5960/1,ensure_dir_eexist/1,ensure_dir_symlink/1, - wildcard_symlink/1, is_file_symlink/1, file_props_symlink/1]). + wildcard_symlink/1, is_file_symlink/1, file_props_symlink/1, + find_source/1]). -import(lists, [foreach/2]). @@ -45,7 +46,8 @@ suite() -> all() -> [wildcard_one, wildcard_two, wildcard_errors, fold_files, otp_5960, ensure_dir_eexist, ensure_dir_symlink, - wildcard_symlink, is_file_symlink, file_props_symlink]. + wildcard_symlink, is_file_symlink, file_props_symlink, + find_source]. groups() -> []. @@ -503,3 +505,52 @@ file_props_symlink(Config) -> FileSize = filelib:file_size(Alias, erl_prim_loader), FileSize = filelib:file_size(Alias, prim_file) end. + +find_source(Config) when is_list(Config) -> + BeamFile = code:which(lists), + BeamName = filename:basename(BeamFile), + BeamDir = filename:dirname(BeamFile), + SrcName = filename:basename(BeamFile, ".beam") ++ ".erl", + + {ok, BeamFile} = filelib:find_file(BeamName, BeamDir), + {ok, BeamFile} = filelib:find_file(BeamName, BeamDir, []), + {ok, BeamFile} = filelib:find_file(BeamName, BeamDir, [{"",""},{"ebin","src"}]), + {error, not_found} = filelib:find_file(BeamName, BeamDir, [{"ebin","src"}]), + + {ok, SrcFile} = filelib:find_file(SrcName, BeamDir), + {ok, SrcFile} = filelib:find_file(SrcName, BeamDir, []), + {ok, SrcFile} = filelib:find_file(SrcName, BeamDir, [{"foo","bar"},{"ebin","src"}]), + {error, not_found} = filelib:find_file(SrcName, BeamDir, [{"",""}]), + + {ok, SrcFile} = filelib:find_source(BeamFile), + {ok, SrcFile} = filelib:find_source(BeamName, BeamDir), + {ok, SrcFile} = filelib:find_source(BeamName, BeamDir, + [{".erl",".yrl",[{"",""}]}, + {".beam",".erl",[{"ebin","src"}]}]), + {error, not_found} = filelib:find_source(BeamName, BeamDir, + [{".erl",".yrl",[{"",""}]}]), + + {ok, ParserErl} = filelib:find_source(code:which(erl_parse)), + {ok, ParserYrl} = filelib:find_source(ParserErl), + "lry." ++ _ = lists:reverse(ParserYrl), + {ok, ParserYrl} = filelib:find_source(ParserErl, + [{".beam",".erl",[{"ebin","src"}]}, + {".erl",".yrl",[{"",""}]}]), + + %% find_source automatically checks the local directory regardless of rules + {ok, ParserYrl} = filelib:find_source(ParserErl), + {ok, ParserYrl} = filelib:find_source(ParserErl, + [{".beam",".erl",[{"ebin","src"}]}]), + + %% find_file does not check the local directory unless in the rules + ParserYrlName = filename:basename(ParserYrl), + ParserYrlDir = filename:dirname(ParserYrl), + {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir, + [{"",""}]), + {error, not_found} = filelib:find_file(ParserYrlName, ParserYrlDir, + [{"ebin","src"}]), + + %% local directory is in the default list for find_file + {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir), + {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir, []), + ok. diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl index b7c4d3a6e5..54066021fb 100644 --- a/lib/stdlib/test/filename_SUITE.erl +++ b/lib/stdlib/test/filename_SUITE.erl @@ -421,8 +421,10 @@ t_nativename(Config) when is_list(Config) -> find_src(Config) when is_list(Config) -> {Source,_} = filename:find_src(file), ["file"|_] = lists:reverse(filename:split(Source)), - {_,_} = filename:find_src(init, [{".","."}, {"ebin","src"}]), - + {Source,_} = filename:find_src(file, [{"",""}, {"ebin","src"}]), + {Source,_} = filename:find_src(Source), + {Source,_} = filename:find_src(Source ++ ".erl"), + %% Try to find the source for a preloaded module. {error,{preloaded,init}} = filename:find_src(init), diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 15ccdea284..4864bc3d72 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -282,7 +282,7 @@ restricted_local(Config) when is_list(Config) -> comm_err(<<"begin F=fun() -> hello end, foo(F) end.">>), "exception error: undefined shell command banan/1" = comm_err(<<"begin F=fun() -> hello end, banan(F) end.">>), - "{error,"++_ = t(<<"begin F=fun() -> hello end, c(F) end.">>), + "Recompiling "++_ = t(<<"c(shell_SUITE).">>), "exception exit: restricted shell does not allow l(" ++ _ = comm_err(<<"begin F=fun() -> hello end, l(F) end.">>), "exception error: variable 'F' is unbound" = diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index 72170ec5da..b92cd8d607 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -417,7 +417,7 @@ merge_files(Name, Files, Options) -> %% %% <dd>Specifies a list of rules for associating object files with %% source files, to be passed to the function -%% `filename:find_src/2'. This can be used to change the +%% `filelib:find_source/2'. This can be used to change the %% way Igor looks for source files. If this option is not specified, %% the default system rules are used. The first occurrence of this %% option completely overrides any later in the option list.</dd> @@ -462,7 +462,7 @@ merge_files(Name, Files, Options) -> %% @see merge/3 %% @see merge_files/3 %% @see merge_sources/3 -%% @see //stdlib/filename:find_src/2 +%% @see //stdlib/filelib:find_source/2 %% @see epp_dodger -spec merge_files(atom(), erl_syntax:forms(), [file:filename()], [option()]) -> @@ -2746,8 +2746,8 @@ read_module(Name, Options) -> %% It seems that we have no file - go on anyway, %% just to get a decent error message. read_module_1(Name, Options); - {Name1, _} -> - read_module_1(Name1 ++ ".erl", Options) + {ok, Name1} -> + read_module_1(Name1, Options) end end. @@ -2807,9 +2807,9 @@ check_forms([], _) -> ok. find_src(Name, undefined) -> - filename:find_src(filename(Name)); + filelib:find_source(filename(Name)); find_src(Name, Rules) -> - filename:find_src(filename(Name), Rules). + filelib:find_source(filename(Name), Rules). %% file_type(filename()) -> {value, Type} | none diff --git a/lib/tools/emacs/erlang-edoc.el b/lib/tools/emacs/erlang-edoc.el index 2801aa8ae7..d0dcc81028 100644 --- a/lib/tools/emacs/erlang-edoc.el +++ b/lib/tools/emacs/erlang-edoc.el @@ -36,7 +36,7 @@ "Tags that can be used anywhere within a module.") (defvar erlang-edoc-overview-tags - '("author" "copyright" "reference" "see" "since" "title" "version") + '("author" "copyright" "doc" "reference" "see" "since" "title" "version") "Tags that can be used in an overview file.") (defvar erlang-edoc-module-tags @@ -45,8 +45,8 @@ "Tags that can be used before a module declaration.") (defvar erlang-edoc-function-tags - '("deprecated" "doc" "equiv" "hidden" "private" "see" "since" "spec" - "throws" "type") + '("deprecated" "doc" "equiv" "hidden" "param" "private" "returns" + "see" "since" "spec" "throws" "type") "Tags that can be used before a function definition.") (defvar erlang-edoc-predefined-macros @@ -169,4 +169,10 @@ (jit-lock-refontify)) (provide 'erlang-edoc) + +;; Local variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + ;;; erlang-edoc.el ends here diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el index 3b85e6680a..38c40927f4 100644 --- a/lib/tools/emacs/erlang-eunit.el +++ b/lib/tools/emacs/erlang-eunit.el @@ -68,7 +68,7 @@ buffer and vice versa" ;;; (defun erlang-eunit-open-src-file-other-window (test-file-path) "Open the src file which corresponds to the an EUnit test file" - (find-file-other-window (erlang-eunit-src-filename test-file-path))) + (find-file-other-window (erlang-eunit-src-filename test-file-path))) ;;; Return the name and path of the EUnit test file ;;, (input may be either the source filename itself or the EUnit test filename) @@ -154,7 +154,7 @@ buffer and vice versa" ;;; Join filenames (defun filename-join (dir file) (if (or (= (elt file 0) ?/) - (= (car (last (append dir nil))) ?/)) + (= (car (last (append dir nil))) ?/)) (concat dir file) (concat dir "/" file))) @@ -299,7 +299,7 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." ;;; Compile source and EUnit test file and finally run EUnit tests for ;;; the current module (defun erlang-eunit-compile-and-test (test-fun test-args &optional under-cover) - "Compile the source and test files and run the EUnit test suite. + "Compile the source and test files and run the EUnit test suite. If under-cover is set to t, the module under test is compile for code coverage analysis. If under-cover is left out or not set, @@ -311,7 +311,7 @@ and the number of times each line is covered). With prefix arg, compiles for debug and runs tests with the verbose flag set." (erlang-eunit-record-recent-compile under-cover) (let ((src-filename (erlang-eunit-src-filename buffer-file-name)) - (test-filename (erlang-eunit-test-filename buffer-file-name))) + (test-filename (erlang-eunit-test-filename buffer-file-name))) ;; The purpose of out-maneuvering `save-some-buffers', as is done ;; below, is to ask the question about saving buffers only once, @@ -326,9 +326,9 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." ;; be placed in the source file instead. Any compilation error ;; will prevent the subsequent steps to be run (hence the `and') (and (erlang-eunit-compile-file src-filename under-cover) - (if (file-readable-p test-filename) - (erlang-eunit-compile-file test-filename) - t) + (if (file-readable-p test-filename) + (erlang-eunit-compile-file test-filename) + t) (apply test-fun test-args) (if under-cover (save-excursion @@ -381,16 +381,16 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (goto-char compilation-parsing-end) (erlang-eunit-all-list-elems-fulfill-p (lambda (re) (let ((continue t) - (result t)) - (while continue ; ignore warnings, stop at errors - (if (re-search-forward re (point-max) t) - (if (erlang-eunit-is-compilation-warning) - t - (setq result nil) - (setq continue nil)) - (setq result t) - (setq continue nil))) - result)) + (result t)) + (while continue ; ignore warnings, stop at errors + (if (re-search-forward re (point-max) t) + (if (erlang-eunit-is-compilation-warning) + t + (setq result nil) + (setq continue nil)) + (setq result t) + (setq continue nil))) + result)) (mapcar (lambda (e) (car e)) erlang-error-regexp-alist)))) (defun erlang-eunit-is-compilation-warning () @@ -402,7 +402,7 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (let ((matches-p t)) (while (and list matches-p) (if (not (funcall pred (car list))) - (setq matches-p nil)) + (setq matches-p nil)) (setq list (cdr list))) matches-p)) @@ -439,15 +439,21 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (defun erlang-eunit-ensure-keymap-for-key (key-seq) (let ((prefix-keys (butlast (append key-seq nil))) - (prefix-seq "")) + (prefix-seq "")) (while prefix-keys (setq prefix-seq (concat prefix-seq (make-string 1 (car prefix-keys)))) (setq prefix-keys (cdr prefix-keys)) (if (not (keymapp (lookup-key (current-local-map) prefix-seq))) - (local-set-key prefix-seq (make-sparse-keymap)))))) + (local-set-key prefix-seq (make-sparse-keymap)))))) (add-hook 'erlang-mode-hook 'erlang-eunit-add-key-bindings) (provide 'erlang-eunit) -;; erlang-eunit ends here + +;; Local variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;; erlang-eunit.el ends here diff --git a/lib/tools/emacs/erlang-pkg.el b/lib/tools/emacs/erlang-pkg.el index 4d0aa6fcd3..02d6bebbf4 100644 --- a/lib/tools/emacs/erlang-pkg.el +++ b/lib/tools/emacs/erlang-pkg.el @@ -1,3 +1,3 @@ (define-package "erlang" "2.7.0" - "Erlang major mode" - '()) + "Erlang major mode" + '((emacs "24.1"))) diff --git a/lib/tools/emacs/erlang-start.el b/lib/tools/emacs/erlang-start.el index 160057e179..c35f280bf4 100644 --- a/lib/tools/emacs/erlang-start.el +++ b/lib/tools/emacs/erlang-start.el @@ -39,7 +39,7 @@ ;; ;; Please state as exactly as possible: ;; - Version number of Erlang Mode (see the menu), Emacs, Erlang, -;; and of any other relevant software. +;; and of any other relevant software. ;; - What the expected result was. ;; - What you did, preferably in a repeatable step-by-step form. ;; - A description of the unexpected result. @@ -60,7 +60,7 @@ ;; (autoload 'erlang-mode "erlang" "Major mode for editing Erlang code." t) -(autoload 'erlang-version "erlang" +(autoload 'erlang-version "erlang" "Return the current version of Erlang mode." t) (autoload 'erlang-shell "erlang" "Start a new Erlang shell." t) (autoload 'run-erlang "erlang" "Start a new Erlang shell." t) @@ -68,7 +68,7 @@ (autoload 'erlang-compile "erlang" "Compile Erlang module in current buffer." t) -(autoload 'erlang-man-module "erlang" +(autoload 'erlang-man-module "erlang" "Find manual page for MODULE." t) (autoload 'erlang-man-function "erlang" "Find manual page for NAME, where NAME is module:function." t) @@ -108,25 +108,22 @@ A function suitable for `eldoc-documentation-function'.\n\n(fn)" nil nil) ;; ;; Associate files using interpreter "escript" with Erlang mode. -;; +;; ;;;###autoload (add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode)) ;; ;; Ignore files ending in ".jam", ".vee", and ".beam" when performing -;; file completion. +;; file completion and in dired omit mode. ;; ;;;###autoload (let ((erl-ext '(".jam" ".vee" ".beam"))) (while erl-ext - (let ((cie completion-ignored-extensions)) - (while (and cie (not (string-equal (car cie) (car erl-ext)))) - (setq cie (cdr cie))) - (if (null cie) - (setq completion-ignored-extensions - (cons (car erl-ext) completion-ignored-extensions)))) + (add-to-list 'completion-ignored-extensions (car erl-ext)) + (when (boundp 'dired-omit-extensions) + (add-to-list 'dired-omit-extensions (car erl-ext))) (setq erl-ext (cdr erl-ext)))) @@ -136,4 +133,9 @@ A function suitable for `eldoc-documentation-function'.\n\n(fn)" nil nil) (provide 'erlang-start) +;; Local variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + ;; erlang-start.el ends here. diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el index ba6190d194..ea5d637199 100644 --- a/lib/tools/emacs/erlang-test.el +++ b/lib/tools/emacs/erlang-test.el @@ -2,7 +2,7 @@ ;;; Unit tests for erlang.el. -;; Author: Johan Claesson +;; Author: Johan Claesson ;; Created: 2016-05-07 ;; Keywords: erlang, languages @@ -28,6 +28,27 @@ ;;; Commentary: ;; This library require GNU Emacs 25 or later. +;; +;; There are two ways to run emacs unit tests. +;; +;; 1. Within a running emacs process. Load this file. Then to run +;; all defined test cases: +;; +;; M-x ert RET t RET +;; +;; To run only the erlang test cases: +;; +;; M-x ert RET "^erlang" RET +;; +;; +;; 2. In a new stand-alone emacs process. This process exits +;; when it executed the tests. For example: +;; +;; emacs -Q -batch -L . -l erlang.el -l erlang-test.el \ +;; -f ert-run-tests-batch-and-exit +;; +;; The -L option adds a directory to the load-path. It should be the +;; directory containing erlang.el and erlang-test.el. ;;; Code: @@ -59,11 +80,12 @@ concatenated to form an erlang file to test on.") tags-file-name tags-table-list tags-table-set-list + tags-add-tables + tags-completion-table erlang-buffer erlang-mode-hook prog-mode-hook - erlang-shell-mode-hook - tags-add-tables) + erlang-shell-mode-hook) (unwind-protect (progn (setq-default tags-file-name nil) @@ -71,11 +93,14 @@ concatenated to form an erlang file to test on.") (erlang-test-create-erlang-file erlang-file) (erlang-test-compile-tags erlang-file tags-file) (setq erlang-buffer (find-file-noselect erlang-file)) - (with-current-buffer erlang-buffer - (setq-local tags-file-name tags-file)) - ;; Setting global tags-file-name is a workaround for - ;; GNU Emacs bug#23164. - (setq tags-file-name tags-file) + (if (< emacs-major-version 26) + (progn + (with-current-buffer erlang-buffer + (setq-local tags-file-name tags-file)) + ;; Setting global tags-file-name is a workaround for + ;; GNU Emacs bug#23164. + (setq tags-file-name tags-file)) + (visit-tags-table tags-file t)) (erlang-test-complete-at-point tags-file) (erlang-test-completion-table) (erlang-test-xref-find-definitions erlang-file erlang-buffer)) @@ -117,12 +142,20 @@ concatenated to form an erlang file to test on.") for line = 1 then (1+ line) do (when tagname (switch-to-buffer erlang-buffer) - (xref-find-definitions tagname) - (erlang-test-verify-pos erlang-file line) - (xref-find-definitions (concat "erlang_test:" tagname)) - (erlang-test-verify-pos erlang-file line))) - (xref-find-definitions "erlang_test:") - (erlang-test-verify-pos erlang-file 1)) + (erlang-test-xref-jump tagname erlang-file line) + (erlang-test-xref-jump (concat "erlang_test:" tagname) + erlang-file line))) + (erlang-test-xref-jump "erlang_test:" erlang-file 1)) + +(defun erlang-test-xref-jump (id expected-file expected-line) + (goto-char (point-max)) + (insert "\n%% " id) + (save-buffer) + (if (fboundp 'xref-find-definitions) + (xref-find-definitions (erlang-id-to-string + (erlang-get-identifier-at-point))) + (error "xref-find-definitions not defined (too old emacs?)")) + (erlang-test-verify-pos expected-file expected-line)) (defun erlang-test-verify-pos (expected-file expected-line) (should (string-equal (file-truename expected-file) @@ -136,13 +169,13 @@ concatenated to form an erlang file to test on.") (setq-local tags-file-name tags-file) (insert "\nerlang_test:fun") (erlang-complete-tag) - (should (looking-back "erlang_test:function")) + (should (looking-back "erlang_test:function" (point-at-bol))) (insert "\nfun") (erlang-complete-tag) - (should (looking-back "function")) + (should (looking-back "function" (point-at-bol))) (insert "\nerlang_") (erlang-complete-tag) - (should (looking-back "erlang_test:")))) + (should (looking-back "erlang_test:" (point-at-bol))))) (ert-deftest erlang-test-compile-options () @@ -179,6 +212,30 @@ concatenated to form an erlang file to test on.") erlang)) +(ert-deftest erlang-test-parse-id () + (cl-loop for id-string in '("fun/10" + "qualified-function module:fun/10" + "record reko" + "macro _SYMBOL" + "macro MACRO/10" + "module modula" + "macro" + nil) + for id-list in '((nil nil "fun" 10) + (qualified-function "module" "fun" 10) + (record nil "reko" nil) + (macro nil "_SYMBOL" nil) + (macro nil "MACRO" 10) + (module nil "modula" nil) + (nil nil "macro" nil) + nil) + for id-list2 = (erlang-id-to-list id-string) + do (should (equal id-list id-list2)) + for id-string2 = (erlang-id-to-string id-list) + do (should (equal id-string id-string2)) + collect id-list2)) + + (provide 'erlang-test) ;;; erlang-test.el ends here diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 51f7e8e26c..59b20c552e 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -4,6 +4,8 @@ ;; Author: Anders Lindgren ;; Keywords: erlang, languages, processes ;; Date: 2011-12-11 +;; Version: 2.7.0 +;; Package-Requires: ((emacs "24.1")) ;; %CopyrightBegin% ;; @@ -24,7 +26,7 @@ ;; %CopyrightEnd% ;; -;; Lars Thors�n's modifications of 2000-06-07 included. +;; Lars Thorsén's modifications of 2000-06-07 included. ;; The original version of this package was written by Robert Virding. ;; ;;; Commentary: @@ -85,30 +87,15 @@ (defconst erlang-version "2.7" "The version number of Erlang mode.") -(defvar erlang-root-dir nil +(defcustom erlang-root-dir nil "The directory where the Erlang system is installed. The name should not contain the trailing slash. Should this variable be nil, no manual pages will show up in the -Erlang mode menu.") - -(eval-and-compile - (defconst erlang-emacs-major-version - (if (boundp 'emacs-major-version) - emacs-major-version - (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) - (erlang-string-to-int (substring emacs-version - (match-beginning 1) (match-end 1)))) - "Major version number of Emacs.")) - -(eval-and-compile - (defconst erlang-emacs-minor-version - (if (boundp 'emacs-minor-version) - emacs-minor-version - (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) - (erlang-string-to-int (substring emacs-version - (match-beginning 2) (match-end 2)))) - "Minor version number of Emacs.")) +Erlang mode menu." + :group 'erlang + :type '(restricted-sexp :match-alternatives (stringp 'nil)) + :safe (lambda (val) (or (eq nil val) (stringp val)))) (defconst erlang-xemacs-p (string-match "Lucid\\|XEmacs" emacs-version) "Non-nil when running under XEmacs or Lucid Emacs.") @@ -129,7 +116,7 @@ Never EVER set this variable!") erlang-menu-man-items erlang-menu-personal-items erlang-menu-version-items) - "*List of menu item list to combine to create Erlang mode menu. + "List of menu item list to combine to create Erlang mode menu. External programs which temporarily add menu items to the Erlang mode menu may use this variable. Please use the function `add-hook' to add @@ -238,7 +225,7 @@ This variable is added to the list of Erlang menus stored in The menu is in the form described by the variable `erlang-menu-base-items'.") (defvar erlang-mode-hook nil - "*Functions to run when Erlang mode is activated. + "Functions to run when Erlang mode is activated. This hook is used to change the behaviour of Erlang mode. It is normally used by the user to personalise the programming environment. @@ -272,7 +259,7 @@ To use the example, copy the following lines to your `~/.emacs' file: (imenu-add-to-menubar \"Imenu\")))") (defvar erlang-load-hook nil - "*Functions to run when Erlang mode is loaded. + "Functions to run when Erlang mode is loaded. This hook is used to change the behaviour of Erlang mode. It is normally used by the user to personalise the programming environment. @@ -304,17 +291,20 @@ manual pages can be retrieved (note that you must set the value of A useful function is `tempo-template-erlang-normal-header'. \(This function only exists when the `tempo' package is available.)") -(defvar erlang-check-module-name 'ask - "*Non-nil means check that module name and file name agrees when saving. +(defcustom erlang-check-module-name 'ask + "Non-nil means check that module name and file name agrees when saving. -If the value of this variable is the atom `ask', the user is -prompted. If the value is t the source is silently changed.") +If the value of this variable is the symbol `ask', the user is +prompted. If the value is t the source is silently changed." + :group 'erlang + :type '(choice (const :tag "Check on save" 'ask) + (const :tag "Don't check on save" t))) (defvar erlang-electric-commands '(erlang-electric-comma erlang-electric-semicolon erlang-electric-gt) - "*List of activated electric commands. + "List of activated electric commands. The list should contain the electric commands which should be active. Currently, the available electric commands are: @@ -328,8 +318,8 @@ are activated. To deactivate all electric commands, set this variable to nil.") -(defvar erlang-electric-newline-inhibit t - "*Set to non-nil to inhibit newline after electric command. +(defcustom erlang-electric-newline-inhibit t + "Set to non-nil to inhibit newline after electric command. This is useful since a lot of people press return after executing an electric command. @@ -339,28 +329,32 @@ list `erlang-electric-newline-inhibit-list'. Note that commands in this list are required to set the variable `erlang-electric-newline-inhibit' to nil when the newline shouldn't be -inhibited.") +inhibited." + :group 'erlang + :type 'boolean + :safe 'booleanp) (defvar erlang-electric-newline-inhibit-list '(erlang-electric-semicolon erlang-electric-comma erlang-electric-gt) - "*Commands which can inhibit the next newline.") + "Commands which can inhibit the next newline.") -(defvar erlang-electric-semicolon-insert-blank-lines nil - "*Number of blank lines inserted before header, or nil. +(defcustom erlang-electric-semicolon-insert-blank-lines nil + "Number of blank lines inserted before header, or nil. This variable controls the behaviour of `erlang-electric-semicolon' when a new function header is generated. When nil, no blank line is inserted between the current line and the new header. When bound to a number it represents the number of blank lines which should be -inserted.") +inserted." + :group 'erlang) (defvar erlang-electric-semicolon-criteria '(erlang-next-lines-empty-p erlang-at-keyword-end-p erlang-at-end-of-function-p) - "*List of functions controlling `erlang-electric-semicolon'. + "List of functions controlling `erlang-electric-semicolon'. The functions in this list are called, in order, whenever a semicolon is typed. Each function in the list is called with no arguments, and should return one of the following values: @@ -381,7 +375,7 @@ The test is performed by the function `erlang-test-criteria-list'.") erlang-at-keyword-end-p erlang-at-end-of-clause-p erlang-at-end-of-function-p) - "*List of functions controlling `erlang-electric-comma'. + "List of functions controlling `erlang-electric-comma'. The functions in this list are called, in order, whenever a comma is typed. Each function in the list is called with no arguments, and should return one of the following values: @@ -399,7 +393,7 @@ The test is performed by the function `erlang-test-criteria-list'.") '(erlang-stop-when-in-type-spec erlang-next-lines-empty-p erlang-at-end-of-function-p) - "*List of functions controlling the arrow aspect of `erlang-electric-gt'. + "List of functions controlling the arrow aspect of `erlang-electric-gt'. The functions in this list are called, in order, whenever a `>' is typed. Each function in the list is called with no arguments, and should return one of the following values: @@ -415,7 +409,7 @@ The test is performed by the function `erlang-test-criteria-list'.") (defvar erlang-electric-newline-criteria '(t) - "*List of functions controlling `erlang-electric-newline'. + "List of functions controlling `erlang-electric-newline'. The electric newline commands indents the next line. Should the current line begin with a comment the comment start is copied to @@ -435,8 +429,8 @@ list, it is treated as a function triggering the electric command. The test is performed by the function `erlang-test-criteria-list'.") -(defvar erlang-next-lines-empty-threshold 2 - "*Number of blank lines required to activate an electric command. +(defcustom erlang-next-lines-empty-threshold 2 + "Number of blank lines required to activate an electric command. Actually, this value controls the behaviour of the function `erlang-next-lines-empty-p' which normally is a member of the @@ -457,46 +451,67 @@ function `erlang-next-lines-empty-p' would be removed from the criteria lists. Note that even if `erlang-next-lines-empty-p' should not trigger an -electric command, other functions in the criteria list could.") +electric command, other functions in the criteria list could." + :group 'erlang + :type '(restricted-sexp :match-alternatives (integerp 'nil)) + :safe (lambda (val) (or (eq val nil) (integerp val)))) -(defvar erlang-new-clause-with-arguments nil - "*Non-nil means that the arguments are cloned when a clause is generated. +(defcustom erlang-new-clause-with-arguments nil + "Non-nil means that the arguments are cloned when a clause is generated. A new function header can be generated by calls to the function -`erlang-generate-new-clause' and by use of the electric semicolon.") +`erlang-generate-new-clause' and by use of the electric semicolon." + :group 'erlang + :type 'boolean + :safe 'booleanp) -(defvar erlang-compile-use-outdir t - "*When nil, go to the directory containing source file when compiling. +(defcustom erlang-compile-use-outdir t + "When nil, go to the directory containing source file when compiling. This is a workaround for a bug in the `outdir' option of compile. If the outdir is not in the current load path, Erlang doesn't load the object module after it has been compiled. To activate the workaround, place the following in your `~/.emacs' file: - (setq erlang-compile-use-outdir nil)") - -(defvar erlang-indent-level 4 - "*Indentation of Erlang calls/clauses within blocks.") -(put 'erlang-indent-level 'safe-local-variable 'integerp) - -(defvar erlang-icr-indent nil - "*Indentation of Erlang if/case/receive/ patterns. `nil' means - keeping default behavior. When non-nil, indent to th column of - if/case/receive.") - -(defvar erlang-indent-guard 2 - "*Indentation of Erlang guards.") -(put 'erlang-indent-guard 'safe-local-variable 'integerp) - -(defvar erlang-argument-indent 2 - "*Indentation of the first argument in a function call. + (setq erlang-compile-use-outdir nil)" + :group 'erlang + :type 'boolean + :safe 'booleanp) + +(defcustom erlang-indent-level 4 + "Indentation of Erlang calls/clauses within blocks." + :group 'erlang + :type 'integer + :safe 'integerp) + +(defcustom erlang-icr-indent nil + "Indentation of Erlang if/case/receive patterns. +nil means keeping default behavior. When non-nil, indent to the column of +if/case/receive." + :group 'erlang + :type 'boolean + :safe 'booleanp) + +(defcustom erlang-indent-guard 2 + "Indentation of Erlang guards." + :group 'erlang + :type 'integer + :safe 'integerp) + +(defcustom erlang-argument-indent 2 + "Indentation of the first argument in a function call. When nil, indent to the column after the `(' of the -function.") -(put 'erlang-argument-indent 'safe-local-variable '(lambda (val) (or (null val) (integerp val)))) - -(defvar erlang-tab-always-indent t - "*Non-nil means TAB in Erlang mode should always re-indent the current line, -regardless of where in the line point is when the TAB command is used.") +function." + :group 'erlang + :type '(restricted-sexp :match-alternatives (integerp 'nil)) + :safe (lambda (val) (or (eq val nil) (integerp val)))) + +(defcustom erlang-tab-always-indent t + "Non-nil means TAB in Erlang mode should always re-indent the current line, +regardless of where in the line point is when the TAB command is used." + :group 'erlang + :type 'boolean + :safe 'booleanp) (defvar erlang-man-inhibit (eq system-type 'windows-nt) "Inhibit the creation of the Erlang Manual Pages menu. @@ -509,7 +524,7 @@ there is no attempt to create the menu.") ("Man - Modules" "/man/man3" t) ("Man - Files" "/man/man4" t) ("Man - Applications" "/man/man6" t)) - "*The man directories displayed in the Erlang menu. + "The man directories displayed in the Erlang menu. Each item in the list should be a list with three elements, the first the name of the menu, the second the directory, and the last a flag. @@ -517,17 +532,17 @@ Should the flag the nil, the directory is absolute, should it be non-nil the directory is relative to the variable `erlang-root-dir'.") (defvar erlang-man-max-menu-size 35 - "*The maximum number of menu items in one menu allowed.") + "The maximum number of menu items in one menu allowed.") (defvar erlang-man-display-function 'erlang-man-display - "*Function used to display man page. + "Function used to display man page. The function is called with one argument, the name of the file containing the man page. Use this variable when the default function, `erlang-man-display', does not work on your system.") (defvar erlang-compile-extra-opts '() - "*Additional options to the compilation command. + "Additional options to the compilation command. This is an elisp list of options. Each option can be either: - an atom - a dotted pair @@ -539,7 +554,7 @@ Example: '(bin_opt_info (i . \"/path1/include\") (i . \"/path2/include\"))") (".xrl\\'" . inferior-erlang-compute-leex-compile-command) (".yrl\\'" . inferior-erlang-compute-yecc-compile-command) ("." . inferior-erlang-compute-erl-compile-command)) - "*Alist of filename patterns vs corresponding compilation functions. + "Alist of filename patterns vs corresponding compilation functions. Each element looks like (REGEXP . FUNCTION). Compiling a file whose name matches REGEXP specifies FUNCTION to use to compute the compilation command. The FUNCTION will be called with two arguments: module name and @@ -547,14 +562,14 @@ default compilation options, like output directory. The FUNCTION is expected to return a string.") (defvar erlang-leex-compile-opts '() - "*Options to pass to leex when compiling xrl files. + "Options to pass to leex when compiling xrl files. This is an elisp list of options. Each option can be either: - an atom - a dotted pair - a string") (defvar erlang-yecc-compile-opts '() - "*Options to pass to yecc when compiling yrl files. + "Options to pass to yecc when compiling yrl files. This is an elisp list of options. Each option can be either: - an atom - a dotted pair @@ -562,7 +577,7 @@ This is an elisp list of options. Each option can be either: (eval-and-compile (defvar erlang-regexp-modern-p - (if (> erlang-emacs-major-version 21) t nil) + (if (> emacs-major-version 21) t nil) "Non-nil when this version of Emacs uses a modern version of regexp. Supporting \_< and \_> This is determined by checking the version of Emacs used.")) @@ -608,6 +623,24 @@ The regexp must be surrounded with a pair of regexp parentheses.")) This is used to determine matches in complex regexps which contains `erlang-variable-regexp'.")) +(defconst erlang-module-function-regexp + (eval-when-compile + (concat erlang-atom-regexp ":" erlang-atom-regexp)) + "Regexp matching an erlang module:function.") + +(defconst erlang-name-regexp + (concat "\\(" + "\\(?:\\sw\\|\\s_\\)+" + "\\|" + erlang-atom-quoted-regexp + "\\)") + "Matches a name of a function, macro or record") + +(defconst erlang-id-regexp + (concat "\\(?:\\(qualified-function\\|record\\|macro\\|module\\) \\)?" + "\\(?:" erlang-atom-regexp ":\\)?" + erlang-name-regexp "?" + "\\(?:/\\([0-9]+\\)\\)?")) (eval-and-compile (defun erlang-regexp-opt (strings &optional paren) @@ -983,7 +1016,7 @@ resulting regexp is surrounded by \\_< and \\_>." "Regexp which should match beginning of a clause.") (defvar erlang-file-name-extension-regexp "\\.erl$" - "*Regexp which should match an Erlang file name. + "Regexp which should match an Erlang file name. This regexp is used when an Erlang module name is extracted from the name of an Erlang source file. @@ -997,7 +1030,7 @@ tags system should interpret tags on the form `module:tag' for files written in other languages than Erlang.") (defvar erlang-inferior-shell-split-window t - "*If non-nil, when starting an inferior shell, split windows. + "If non-nil, when starting an inferior shell, split windows. If nil, the inferior shell replaces the window. This is the traditional behaviour.") @@ -1043,7 +1076,7 @@ behaviour.") (unless inferior-erlang-use-cmm (define-key map "\C-x`" 'erlang-next-error)) map) - "*Keymap used in Erlang mode.") + "Keymap used in Erlang mode.") (defvar erlang-mode-abbrev-table nil "Abbrev table in use in Erlang-mode buffers.") (defvar erlang-mode-syntax-table nil @@ -1310,29 +1343,6 @@ replaced by `erlang-etags-tags-completion-table'.") ;;; Avoid errors while compiling this file. -;; `eval-when-compile' is not defined in Emacs 18. We define it as a -;; no-op. -(or (fboundp 'eval-when-compile) - (defmacro eval-when-compile (&rest rest) nil)) - -;; These umm...functions are new in Emacs 20. And, yes, until version -;; 19.27 Emacs backquotes were this ugly. - -(or (fboundp 'unless) - (defmacro unless (condition &rest body) - "(unless CONDITION BODY...): If CONDITION is false, do BODY, else return nil." - `((if (, condition) nil ,@body)))) - -(or (fboundp 'when) - (defmacro when (condition &rest body) - "(when CONDITION BODY...): If CONDITION is true, do BODY, else return nil." - `((if (, condition) (progn ,@body) nil)))) - -(or (fboundp 'char-before) - (defmacro char-before (&optional pos) - "Return the character in the current buffer just before POS." - `( (char-after (1- (or ,pos (point))))))) - ;; defvar some obsolete variables, which we still support for ;; backwards compatibility reasons. (eval-when-compile @@ -1360,20 +1370,11 @@ replaced by `erlang-etags-tags-completion-table'.") (defun erlang-version () "Return the current version of Erlang mode." (interactive) - (if (erlang-interactive-p) + (if (called-interactively-p 'interactive) (message "Erlang mode version %s, written by Anders Lindgren" erlang-version)) erlang-version) -(defun erlang-interactive-p () - (if (fboundp 'called-interactively-p) - (called-interactively-p 'interactive) - (funcall (symbol-function 'interactive-p)))) - -(unless (fboundp 'prog-mode) - (defun prog-mode () - (use-local-map (make-keymap)))) - ;;;###autoload (define-derived-mode erlang-mode prog-mode "Erlang" "Major mode for editing Erlang source files in Emacs. @@ -1462,40 +1463,43 @@ Other commands: (add-to-list 'auto-mode-alist (cons r 'erlang-mode))) (defun erlang-syntax-table-init () - (if (null erlang-mode-syntax-table) - (let ((table (make-syntax-table))) - (modify-syntax-entry ?\n ">" table) - (modify-syntax-entry ?\" "\"" table) - (modify-syntax-entry ?# "." table) - ;; (modify-syntax-entry ?$ "\\" table) ;; Creates problems with indention afterwards - ;; (modify-syntax-entry ?$ "'" table) ;; Creates syntax highlighting and indention problems - (modify-syntax-entry ?$ "/" table) ;; Misses the corner case "string that ends with $" - ;; we have to live with that for now..it is the best alternative - ;; that can be worked around with "string hat ends with \$" - (modify-syntax-entry ?% "<" table) - (modify-syntax-entry ?& "." table) - (modify-syntax-entry ?\' "\"" table) - (modify-syntax-entry ?* "." table) - (modify-syntax-entry ?+ "." table) - (modify-syntax-entry ?- "." table) - (modify-syntax-entry ?/ "." table) - (modify-syntax-entry ?: "." table) - (modify-syntax-entry ?< "." table) - (modify-syntax-entry ?= "." table) - (modify-syntax-entry ?> "." table) - (modify-syntax-entry ?\\ "\\" table) - (modify-syntax-entry ?_ "_" table) - (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?^ "'" table) - - ;; Pseudo bit-syntax: Latin1 double angle quotes as parens. - ;;(modify-syntax-entry ?\253 "(?\273" table) - ;;(modify-syntax-entry ?\273 ")?\253" table) - - (setq erlang-mode-syntax-table table))) - + (erlang-ensure-syntax-table-is-initialized) (set-syntax-table erlang-mode-syntax-table)) +(defun erlang-ensure-syntax-table-is-initialized () + (unless erlang-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?# "." table) + ;; (modify-syntax-entry ?$ "\\" table) ;; Creates problems with indention afterwards + ;; (modify-syntax-entry ?$ "'" table) ;; Creates syntax highlighting and indention problems + (modify-syntax-entry ?$ "/" table) ;; Misses the corner case "string that ends with $" + ;; we have to live with that for now..it is the best alternative + ;; that can be worked around with "string that ends with \$" + (modify-syntax-entry ?% "<" table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?\' "\"" table) + (modify-syntax-entry ?* "." table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?/ "." table) + (modify-syntax-entry ?: "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?^ "'" table) + + ;; Pseudo bit-syntax: Latin1 double angle quotes as parens. + ;;(modify-syntax-entry ?\253 "(?\273" table) + ;;(modify-syntax-entry ?\273 ")?\253" table) + + (setq erlang-mode-syntax-table table)))) + + (defun erlang-electric-init () ;; Set up electric character functions to work with @@ -1541,7 +1545,7 @@ Other commands: (make-local-variable 'indent-region-function) (setq indent-region-function 'erlang-indent-region) (set (make-local-variable 'comment-indent-function) 'erlang-comment-indent) - (if (<= erlang-emacs-major-version 18) + (if (<= emacs-major-version 18) (set (make-local-variable 'comment-indent-hook) 'erlang-comment-indent)) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'dabbrev-case-fold-search) nil) @@ -1778,7 +1782,7 @@ Please see the variable `erlang-menu-base-items'." (if (and popup (boundp 'mode-popup-menu)) (funcall (symbol-function 'set) 'mode-popup-menu erlang-xemacs-popup-menu)))) - ((>= erlang-emacs-major-version 19) + ((>= emacs-major-version 19) (define-key keymap (vector 'menu-bar (intern name)) (erlang-menu-make-keymap name items))) (t nil))) @@ -1961,7 +1965,9 @@ menu is left unchanged." The variable `erlang-man-dirs' contains entries describing the location of the manual pages." (interactive) - (if erlang-man-inhibit + (if (or erlang-man-inhibit + (and (boundp 'menu-bar-mode) + (not menu-bar-mode))) () (setq erlang-menu-man-items '(nil @@ -2000,7 +2006,7 @@ The format is described in the documentation of `erlang-man-dirs'." (setq dir (cond ((nth 2 (car dir-list)) ;; Relative to `erlang-root-dir'. (and (stringp erlang-root-dir) - (concat erlang-root-dir (nth 1 (car dir-list))))) + (erlang-man-dir (nth 1 (car dir-list))))) (t ;; Absolute (nth 1 (car dir-list))))) @@ -2018,6 +2024,8 @@ The format is described in the documentation of `erlang-man-dirs'." '(("Man Pages" (("Error! Why?" erlang-man-describe-error))))))) +(defun erlang-man-dir (subdir) + (concat erlang-root-dir "/lib/erlang/" subdir)) ;; Should the menu be to long, let's split it into a number of ;; smaller menus. Warning, this code contains beautiful @@ -2080,7 +2088,7 @@ menus is created." "Find manual page for MODULE, defaults to module of function under point. This function is aware of imported functions." (interactive - (list (let* ((mod (car-safe (erlang-get-function-under-point))) + (list (let* ((mod (erlang-default-module)) (input (read-string (format "Manual entry for module%s: " (if (or (null mod) (string= mod "")) @@ -2089,26 +2097,36 @@ This function is aware of imported functions." (if (string= input "") mod input)))) - (or module (setq module (car (erlang-get-function-under-point)))) - (if (or (null module) (string= module "")) - (error "No Erlang module name given")) + (setq module (or module + (erlang-default-module))) + (when (or (null module) (string= module "")) + (error "No Erlang module name given")) (let ((dir-list erlang-man-dirs) - (pat (concat "/" (regexp-quote module) "\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$")) + (pat (concat "/" (regexp-quote module) + "\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$")) (file nil) file-list) (while (and dir-list (null file)) - (setq file-list (erlang-man-get-files - (if (nth 2 (car dir-list)) - (concat erlang-root-dir (nth 1 (car dir-list))) - (nth 1 (car dir-list))))) - (while (and file-list (null file)) - (if (string-match pat (car file-list)) - (setq file (car file-list))) - (setq file-list (cdr file-list))) - (setq dir-list (cdr dir-list))) + (let ((dir (if (nth 2 (car dir-list)) + (erlang-man-dir (nth 1 (car dir-list))) + (nth 1 (car dir-list))))) + (when (file-directory-p dir) + (setq file-list (erlang-man-get-files dir)) + (while (and file-list (null file)) + (if (string-match pat (car file-list)) + (setq file (car file-list))) + (setq file-list (cdr file-list)))) + (setq dir-list (cdr dir-list)))) (if file (funcall erlang-man-display-function file) - (error "No manual page for module %s found" module)))) + ;; Did not found the manual file. Fallback to manual-entry. + (manual-entry module)))) + +(defun erlang-default-module () + (let ((id (erlang-get-identifier-at-point))) + (if (eq (erlang-id-kind id) 'qualified-function) + (erlang-id-module id) + (erlang-id-name id)))) ;; Warning, the function `erlang-man-function' is a hack! @@ -2128,37 +2146,28 @@ The entry for `function' is displayed. This function is aware of imported functions." (interactive - (list (let* ((mod-func (erlang-get-function-under-point)) - (mod (car-safe mod-func)) - (func (nth 1 mod-func)) + (list (let* ((default (erlang-default-function-or-module)) (input (read-string (format "Manual entry for `module:func' or `module'%s: " - (if (or (null mod) (string= mod "")) - "" - (format " (default %s:%s)" mod func)))))) + (if default + (format " (default %s)" default) + ""))))) (if (string= input "") - (if (and mod func) - (concat mod ":" func) - mod) + default input)))) - ;; Emacs 18 doesn't provide `man'... - (condition-case nil - (require 'man) - (error nil)) + (require 'man) + (setq name (or name + (erlang-default-function-or-module))) (let ((modname nil) (funcname nil)) - (cond ((null name) - (let ((mod-func (erlang-get-function-under-point))) - (setq modname (car-safe mod-func)) - (setq funcname (nth 1 mod-func)))) - ((string-match ":" name) + (cond ((string-match ":" name) (setq modname (substring name 0 (match-beginning 0))) (setq funcname (substring name (match-end 0) nil))) ((stringp name) (setq modname name))) - (if (or (null modname) (string= modname "")) - (error "No Erlang module name given")) + (when (or (null modname) (string= modname "")) + (error "No Erlang module name given")) (cond ((fboundp 'Man-notify-when-ready) ;; Emacs 19: The man command could possibly start an ;; asynchronous process, i.e. we must hook ourselves into @@ -2168,16 +2177,20 @@ This function is aware of imported functions." () (erlang-man-patch-notify) (setq erlang-man-function-name funcname)) - (condition-case nil + (condition-case err (erlang-man-module modname) - (error (setq erlang-man-function-name nil)))) + (error (setq erlang-man-function-name nil) + (signal (car err) (cdr err))))) (t (erlang-man-module modname) - (if funcname - (erlang-man-find-function - (or (get-buffer "*Manual Entry*") ; Emacs 18 - (current-buffer)) ; XEmacs - funcname)))))) + (when funcname + (erlang-man-find-function (current-buffer) funcname)))))) + +(defun erlang-default-function-or-module () + (let ((id (erlang-get-identifier-at-point))) + (if (eq (erlang-id-kind id) 'qualified-function) + (format "%s:%s" (erlang-id-module id) (erlang-id-name id)) + (erlang-id-name id)))) ;; Should the defadvice be at the top level, the package `advice' would @@ -2222,36 +2235,22 @@ command is executed asynchronously." (set-window-point win (point))) (message "Could not find function `%s'" func))))))) +(defvar erlang-man-file-regexp + "\\(.*\\)/man[^/]*/\\([^.]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$") (defun erlang-man-display (file) "Display FILE as a `man' file. This is the default manual page display function. The variables `erlang-man-display-function' contains the function to be used." - ;; Emacs 18 doesn't `provide' man. - (condition-case nil - (require 'man) - (error nil)) + (require 'man) (if file (let ((process-environment (copy-sequence process-environment))) - (if (string-match "\\(.*\\)/man[^/]*/\\([^.]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$" file) + (if (string-match erlang-man-file-regexp file) (let ((dir (substring file (match-beginning 1) (match-end 1))) (page (substring file (match-beginning 2) (match-end 2)))) - (if (fboundp 'setenv) - (setenv "MANPATH" dir) - ;; Emacs 18 - (setq process-environment (cons (concat "MANPATH=" dir) - process-environment))) - (cond ((not (and (not erlang-xemacs-p) - (= erlang-emacs-major-version 19) - (< erlang-emacs-minor-version 29))) - (manual-entry page)) - (t - ;; Emacs 19.28 and earlier versions of 19: - ;; The manual-entry command unconditionally prompts - ;; the user :-( - (funcall (symbol-function 'Man-getpage-in-background) - page)))) + (setenv "MANPATH" dir) + (manual-entry page)) (error "Can't find man page for %s\n" file))))) @@ -2394,7 +2393,7 @@ can contain other `tempo' attributes. Please see the function The first character of DD is space if the value is less than 10." (let ((date (current-time-string))) (format "%2d %s %s" - (erlang-string-to-int (substring date 8 10)) + (string-to-number (substring date 8 10)) (substring date 4 7) (substring date -4)))) @@ -2956,10 +2955,10 @@ Return nil if inside string, t if in a comment." ((eq (car stack-top) '->) ;; If in fun definition use standard indent level not double ;;(if (not (eq (car (car (cdr stack))) 'fun)) - ;; Removed it made multi clause fun's look to bad + ;; Removed it made multi clause fun's look too bad (setq off (+ erlang-indent-level (if (not erlang-icr-indent) erlang-indent-level - erlang-icr-indent))))) + erlang-icr-indent))))) (let ((base (erlang-indent-find-base stack indent-point off skip))) ;; Special cases (goto-char indent-point) @@ -3597,7 +3596,7 @@ corresponds to the order of the parsed Erlang list." (erlang-remove-quotes (erlang-buffer-substring (match-beginning 1) (match-end 1))) - (erlang-string-to-int + (string-to-number (erlang-buffer-substring (match-beginning (+ 1 erlang-atom-regexp-matches)) @@ -3696,34 +3695,50 @@ Normally used in conjunction with `erlang-beginning-of-clause', e.g.: (defun erlang-get-function-arity () "Return the number of arguments of function at point, or nil." - (and (looking-at (eval-when-compile - (concat "^" erlang-atom-regexp "\\s *("))) - (save-excursion - (goto-char (match-end 0)) - (condition-case nil - (let ((res 0) - (cont t)) - (while cont - (cond ((eobp) - (setq res nil) - (setq cont nil)) - ((looking-at "\\s *)") - (setq cont nil)) - ((looking-at "\\s *\\($\\|%\\)") - (forward-line 1)) - ((looking-at "\\s *<<[^>]*?>>") - (when (zerop res) - (setq res (+ 1 res))) - (goto-char (match-end 0))) - ((looking-at "\\s *,") - (setq res (+ 1 res)) - (goto-char (match-end 0))) - (t - (when (zerop res) - (setq res (+ 1 res))) - (forward-sexp 1)))) - res) - (error nil))))) + (erlang-get-arity-after-regexp (concat "^" erlang-atom-regexp "\\s *("))) + +(defun erlang-get-argument-list-arity () + "Return the number of arguments in argument list at point, or nil. +The point should be before the opening parenthesis of the +argument list before calling this function." + (erlang-get-arity-after-regexp "\\s *(")) + +(defun erlang-get-arity-after-regexp (regexp) + "Return the number of arguments in argument list after REGEXP, or nil." + (when (looking-at regexp) + (save-excursion + (goto-char (match-end 0)) + (erlang-get-arity)))) + +(defun erlang-get-arity () + "Return the number of arguments in argument list at point, or nil. +The point should be after the opening parenthesis of the argument +list before calling this function." + (condition-case nil + (let ((res 0) + (cont t)) + (while cont + (cond ((eobp) + (setq res nil) + (setq cont nil)) + ((looking-at "\\s *)") + (setq cont nil)) + ((looking-at "\\s *\\($\\|%\\)") + (forward-line 1)) + ((looking-at "\\s *<<[^>]*?>>") + (when (zerop res) + (setq res (+ 1 res))) + (goto-char (match-end 0))) + ((looking-at "\\s *,") + (setq res (+ 1 res)) + (goto-char (match-end 0))) + (t + (when (zerop res) + (setq res (+ 1 res))) + (forward-sexp 1)))) + res) + (error nil))) + (defun erlang-get-function-name-and-arity () "Return the name and arity of the function at point, or nil. @@ -3746,6 +3761,8 @@ The return value is a string of the form \"foo/1\"." (error nil))))) +;; Keeping erlang-get-function-under-point for backward compatibility. +;; It is used by erldoc.el and maybe other code out there. (defun erlang-get-function-under-point () "Return the module and function under the point, or nil. @@ -3755,44 +3772,141 @@ list of imported functions is searched. The following could be returned: (\"module\" \"function\") -- Both module and function name found. (nil \"function\") -- No module name was found. - nil -- No function name found + nil -- No function name found. + +See also `erlang-get-identifier-at-point'." + (let* ((id (erlang-get-identifier-at-point)) + (kind (erlang-id-kind id)) + (module (erlang-id-module id)) + (name (erlang-id-name id))) + (cond ((eq kind 'qualified-function) + (list module name)) + (name + (list nil name))))) + +(defun erlang-get-identifier-at-point () + "Return the erlang identifier at point, or nil. + +Should no explicit module name be present at the point, the +list of imported functions is searched. + +When an identifier is found return a list with 4 elements: + +1. Kind - One of the symbols qualified-function, record, macro, +module or nil. + +2. Module - Module name string or nil. In case of a +qualified-function a search fails if no entries with correct +module are found. For other kinds the module is just a +preference. If no matching entries are found the search will be +retried without regard to module. + +3. Name - String name of function, module, record or macro. -In the future the list may contain more elements." +4. Arity - Integer in case of functions and macros if the number +of arguments could be found, otherwise nil." (save-excursion - (let ((md (match-data)) - (res nil)) + (save-match-data (if (eq (char-syntax (following-char)) ? ) (skip-chars-backward " \t")) - (skip-chars-backward "a-zA-Z0-9_:'") - (cond ((looking-at (eval-when-compile - (concat erlang-atom-regexp ":" erlang-atom-regexp))) - (setq res (list - (erlang-remove-quotes - (erlang-buffer-substring - (match-beginning 1) (match-end 1))) - (erlang-remove-quotes - (erlang-buffer-substring - (match-beginning (1+ erlang-atom-regexp-matches)) - (match-end (1+ erlang-atom-regexp-matches))))))) - ((looking-at erlang-atom-regexp) - (let ((fk (erlang-remove-quotes - (erlang-buffer-substring - (match-beginning 0) (match-end 0)))) - (mod nil) - (imports (erlang-get-import))) - (while (and imports (null mod)) - (if (assoc fk (cdr (car imports))) - (setq mod (car (car imports))) - (setq imports (cdr imports)))) - (cond ((eq (preceding-char) ?#) - (setq fk (concat "-record(" fk))) - ((eq (preceding-char) ??) - (setq fk (concat "-define(" fk))) - ((and (null mod) (not (member fk erlang-int-bifs))) - (setq mod (erlang-get-module)))) - (setq res (list mod fk))))) - (store-match-data md) - res))) + (skip-chars-backward "[:word:]_:'") + (cond ((looking-at erlang-module-function-regexp) + (erlang-get-qualified-function-id-at-point)) + ((looking-at (concat erlang-atom-regexp ":")) + (erlang-get-module-id-at-point)) + ((looking-at erlang-name-regexp) + (erlang-get-some-other-id-at-point)))))) + +(defun erlang-get-qualified-function-id-at-point () + (let ((kind 'qualified-function) + (module (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning 1) (match-end 1)))) + (name (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning (1+ erlang-atom-regexp-matches)) + (match-end (1+ erlang-atom-regexp-matches))))) + (arity (progn + (goto-char (match-end 0)) + (erlang-get-argument-list-arity)))) + (list kind module name arity))) + +(defun erlang-get-module-id-at-point () + (let ((kind 'module) + (module nil) + (name (erlang-remove-quotes + (erlang-buffer-substring (match-beginning 1) + (match-end 1)))) + (arity nil)) + (list kind module name arity))) + +(defun erlang-get-some-other-id-at-point () + (let ((name (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning 0) (match-end 0)))) + (imports (erlang-get-import)) + kind module arity) + (while (and imports (null module)) + (if (assoc name (cdr (car imports))) + (setq module (car (car imports))) + (setq imports (cdr imports)))) + (cond ((eq (preceding-char) ?#) + (setq kind 'record)) + ((eq (preceding-char) ??) + (setq kind 'macro)) + ((and (null module) (not (member name erlang-int-bifs))) + (setq module (erlang-get-module)))) + (setq arity (progn + (goto-char (match-end 0)) + (erlang-get-argument-list-arity))) + (list kind module name arity))) + +(defmacro erlang-with-id (slots id-string &rest body) + (declare (indent 2)) + (let ((id-var (make-symbol "id"))) + `(let* ((,id-var (erlang-id-to-list ,id-string)) + ,@(mapcar (lambda (slot) + (list slot + (list (intern (format "erlang-id-%s" slot)) + id-var))) + slots)) + ,@body))) + +(defun erlang-id-to-string (id) + (when id + (erlang-with-id (kind module name arity) id + (format "%s%s%s%s" + (if kind (format "%s " kind) "") + (if module (format "%s:" module) "") + name + (if arity (format "/%s" arity) ""))))) + +(defun erlang-id-to-list (id) + (if (listp id) + id + (save-match-data + (erlang-ensure-syntax-table-is-initialized) + (with-syntax-table erlang-mode-syntax-table + (let (case-fold-search) + (when (string-match erlang-id-regexp id) + (list (when (match-string 1 id) + (intern (match-string 1 id))) + (match-string 2 id) + (match-string 3 id) + (when (match-string 4 id) + (string-to-number (match-string 4 id)))))))))) + +(defun erlang-id-kind (id) + (car (erlang-id-to-list id))) + +(defun erlang-id-module (id) + (nth 1 (erlang-id-to-list id))) + +(defun erlang-id-name (id) + (nth 2 (erlang-id-to-list id))) + +(defun erlang-id-arity (id) + (nth 3 (erlang-id-to-list id))) ;; TODO: Escape single quotes inside the string without @@ -3822,10 +3936,10 @@ In the future the list may contain more elements." "Returns non-nil if there is an exported function in the current buffer between point and MAX." (block nil - (while (and (not erlang-inhibit-exported-function-name-face) - (erlang-match-next-function max)) - (when (erlang-last-match-exported-p) - (return (match-data)))))) + (while (and (not erlang-inhibit-exported-function-name-face) + (erlang-match-next-function max)) + (when (erlang-last-match-exported-p) + (return (match-data)))))) (defun erlang-match-next-function (max) "Searches forward in current buffer for the next erlang function, @@ -4084,7 +4198,7 @@ non-whitespace characters following the point on the current line." nil))) -(defun erlang-electric-arrow\ off (&optional arg) +(defun erlang-electric-arrow (&optional arg) "Insert a '>'-sign and possibly a new indented line. This command is only `electric' when the `>' is part of an `->' arrow. @@ -4310,8 +4424,8 @@ This function is designed to be a member of a criteria list." (looking-at "end[^_a-zA-Z0-9]"))) -;; Erlang tags support which is aware of erlang modules. -;; +;;; Erlang tags support which is aware of erlang modules. + ;; Not yet implemented under XEmacs. (Hint: The Emacs 19 etags ;; package works under XEmacs.) @@ -4369,7 +4483,7 @@ This function only works under Emacs 18 and Emacs 19. Currently, It is not implemented under XEmacs. (Hint: The Emacs 19 etags module works under XEmacs.)" (interactive) - (cond ((= erlang-emacs-major-version 18) + (cond ((= emacs-major-version 18) (require 'tags) (erlang-tags-define-keys (current-local-map)) (setq erlang-tags-installed t)) @@ -4409,20 +4523,6 @@ works under XEmacs.)" (erlang-menu-substitute erlang-menu-base-items erlang-tags-function-alist) (erlang-menu-init)) - -(defun erlang-find-tag-default () - "Return the default tag. -Search `-import' list of imported functions. -Single quotes are been stripped away." - (let ((mod-func (erlang-get-function-under-point))) - (cond ((null mod-func) - nil) - ((null (car mod-func)) - (nth 1 mod-func)) - (t - (concat (car mod-func) ":" (nth 1 mod-func)))))) - - ;; Return `t' since it is used inside `tags-loop-form'. ;;;###autoload (defun erlang-find-tag (modtagname &optional next-p regexp-p) @@ -4609,7 +4709,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (list nil (if (< (prefix-numeric-value current-prefix-arg) 0) '- t)) - (let* ((default (erlang-find-tag-default)) + (let* ((default (erlang-default-function-or-module)) (prompt (if default (format "%s(default %s) " prompt default) prompt)) @@ -4633,7 +4733,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." ;; Make sure our functions are installed in TAGS files loaded ;; into Emacs while searching. (cond - ((>= erlang-emacs-major-version 20) + ((>= emacs-major-version 20) (setq erlang-tags-orig-format-functions (symbol-value 'tags-table-format-functions)) (funcall (symbol-function 'set) 'tags-table-format-functions @@ -4711,7 +4811,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (defun erlang-tags-remove-module-check () "Remove our own tags search functions." (cond - ((>= erlang-emacs-major-version 20) + ((>= emacs-major-version 20) (funcall (symbol-function 'set) 'tags-table-format-functions erlang-tags-orig-format-functions) @@ -4961,6 +5061,14 @@ about Erlang modules." ;; It adds awareness of the module:tag syntax in a similar way that is ;; done above for the old etags commands. +(defvar erlang-current-arity nil + "The arity of the function currently being searched. + +There is no information about arity in the TAGS file. +Consecutive functions with same name but different arity will +only get one entry in the TAGS file. Matching TAGS entries are +therefore selected without regarding arity. The arity is +considered first when it is time to jump to the definition.") (defun erlang-etags--xref-backend () 'erlang-etags) @@ -4970,13 +5078,14 @@ about Erlang modules." (and (erlang-soft-require 'xref) (erlang-soft-require 'cl-generic) + (erlang-soft-require 'eieio) ;; The purpose of using eval here is to avoid compilation - ;; warnings in emacsen without cl-defmethod. + ;; warnings in emacsen without cl-defmethod etc. (eval '(progn (cl-defmethod xref-backend-identifier-at-point ((_backend (eql erlang-etags))) - (erlang-find-tag-default)) + (erlang-id-to-string (erlang-get-identifier-at-point))) (cl-defmethod xref-backend-definitions ((_backend (eql erlang-etags)) identifier) @@ -4989,42 +5098,99 @@ about Erlang modules." (cl-defmethod xref-backend-identifier-completion-table ((_backend (eql erlang-etags))) (let ((erlang-replace-etags-tags-completion-table t)) - (tags-completion-table)))))) - - + (tags-completion-table))) + + (defclass erlang-xref-location (xref-etags-location) ()) + + (defun erlang-convert-xrefs (xrefs) + (mapcar (lambda (xref) + (oset xref location (erlang-make-location + (oref xref location))) + xref) + xrefs)) + + (defun erlang-make-location (etags-location) + (with-slots (tag-info file) etags-location + (make-instance 'erlang-xref-location :tag-info tag-info + :file file))) + + (cl-defmethod xref-location-marker ((locus erlang-xref-location)) + (with-slots (tag-info file) locus + (with-current-buffer (find-file-noselect file) + (save-excursion + (or (erlang-goto-tag-location-by-arity tag-info) + (etags-goto-tag-location tag-info)) + ;; Reset erlang-current-arity. We want to jump to + ;; correct arity in the first attempt. That is now + ;; done. Possible remaining jumps will be from + ;; entries in the *xref* buffer and then we want to + ;; ignore the arity. (Alternatively we could remove + ;; all but one xref entry per file when we know the + ;; arity). + (setq erlang-current-arity nil) + (point-marker))))) + + (defun erlang-xref-context (xref) + (with-slots (tag-info) (xref-item-location xref) + (car tag-info)))))) + + +(defun erlang-goto-tag-location-by-arity (tag-info) + (when erlang-current-arity + (let* ((tag-text (car tag-info)) + (tag-pos (cdr (cdr tag-info))) + (tag-line (car (cdr tag-info))) + (regexp (erlang-tag-info-regexp tag-text)) + (startpos (or tag-pos + (when tag-line + (goto-char (point-min)) + (forward-line (1- tag-line)) + (point)) + (point-min)))) + (setq startpos (max (- startpos 2000) + (point-min))) + (goto-char startpos) + (let ((pos (or (erlang-search-by-arity regexp) + (unless (eq startpos (point-min)) + (goto-char (point-min)) + (erlang-search-by-arity regexp))))) + (when pos + (goto-char pos) + t))))) + +(defun erlang-tag-info-regexp (tag-text) + (concat "^" + (regexp-quote tag-text) + ;; Erlang function entries in TAGS includes the opening + ;; parenthesis for the argument list. Erlang macro entries + ;; do not. Add it here in order to end up in correct + ;; position for erlang-get-arity. + (if (string-prefix-p "-define" tag-text) + "\\s-*(" + ""))) + +(defun erlang-search-by-arity (regexp) + (let (pos) + (while (and (null pos) + (re-search-forward regexp nil t)) + (when (eq erlang-current-arity (save-excursion (erlang-get-arity))) + (setq pos (point-at-bol)))) + pos)) (defun erlang-xref-find-definitions (identifier &optional is-regexp) - (let ((id-list (split-string identifier ":"))) - (cond - ;; Handle "tag" - ((null (cdr id-list)) - (erlang-xref-find-definitions-tag identifier is-regexp)) - ;; Handle "module:" - ((string-equal (cadr id-list) "") - (erlang-xref-find-definitions-module (car id-list))) - ;; Handle "module:tag" - (t - (erlang-xref-find-definitions-module-tag (car id-list) - (cadr id-list) - is-regexp))))) - -(defun erlang-xref-find-definitions-tag (tag is-regexp) - "Find all definitions of TAG and reorder them so that -definitions in the currently visited file comes first." - (when (fboundp 'etags--xref-find-definitions) - (let* ((current-file (and (buffer-file-name) - (file-truename (buffer-file-name)))) - (xrefs (etags--xref-find-definitions tag is-regexp)) - local-xrefs non-local-xrefs) - (while xrefs - (if (string-equal (erlang-xref-truename-file (car xrefs)) - current-file) - (push (car xrefs) local-xrefs) - (push (car xrefs) non-local-xrefs)) - (setq xrefs (cdr xrefs))) - (append (reverse local-xrefs) - (reverse non-local-xrefs))))) + (erlang-with-id (kind module name arity) identifier + (setq erlang-current-arity arity) + (cond ((eq kind 'module) + (erlang-xref-find-definitions-module name)) + (module + (erlang-xref-find-definitions-module-tag module + name + (eq kind + 'qualified-function) + is-regexp)) + (t + (erlang-xref-find-definitions-tag kind name is-regexp))))) (defun erlang-xref-find-definitions-module (module) (and (fboundp 'xref-make) @@ -5048,17 +5214,58 @@ definitions in the currently visited file comes first." (setq files (cdr files)))))) (nreverse xrefs)))) -(defun erlang-xref-find-definitions-module-tag (module tag is-regexp) - "Find all definitions of TAG and filter away definitions -outside of MODULE." - (when (fboundp 'etags--xref-find-definitions) - (let ((xrefs (etags--xref-find-definitions tag is-regexp)) - xrefs-in-module) - (while xrefs - (when (string-equal module (erlang-xref-module (car xrefs))) - (push (car xrefs) xrefs-in-module)) - (setq xrefs (cdr xrefs))) - xrefs-in-module))) + +(defun erlang-xref-find-definitions-module-tag (module + tag + is-qualified + is-regexp) + "Find definitions of TAG and filter away definitions outside of +MODULE. If IS-QUALIFIED is nil and no definitions was found inside +the MODULE then return any definitions found outside. If +IS-REGEXP is non-nil then TAG is a regexp." + (and (fboundp 'etags--xref-find-definitions) + (fboundp 'erlang-convert-xrefs) + (let ((xrefs (erlang-convert-xrefs + (etags--xref-find-definitions tag is-regexp))) + xrefs-in-module) + (dolist (xref xrefs) + (when (string-equal module (erlang-xref-module xref)) + (push xref xrefs-in-module))) + (cond (is-qualified xrefs-in-module) + (xrefs-in-module xrefs-in-module) + (t xrefs))))) + +(defun erlang-xref-find-definitions-tag (kind tag is-regexp) + "Find all definitions of TAG and reorder them so that +definitions in the currently visited file comes first." + (and (fboundp 'etags--xref-find-definitions) + (fboundp 'erlang-convert-xrefs) + (let* ((current-file (and (buffer-file-name) + (file-truename (buffer-file-name)))) + (regexp (erlang-etags-regexp kind tag is-regexp)) + (xrefs (erlang-convert-xrefs + (etags--xref-find-definitions regexp t))) + local-xrefs non-local-xrefs) + (while xrefs + (let ((xref (car xrefs))) + (if (string-equal (erlang-xref-truename-file xref) + current-file) + (push xref local-xrefs) + (push xref non-local-xrefs)) + (setq xrefs (cdr xrefs)))) + (append (reverse local-xrefs) + (reverse non-local-xrefs))))) + +(defun erlang-etags-regexp (kind tag is-regexp) + (let ((tag-regexp (if is-regexp + tag + (regexp-quote tag)))) + (cond ((eq kind 'record) + (concat "-record\\s-*(\\s-*" tag-regexp)) + ((eq kind 'macro) + (concat "-define\\s-*(\\s-*" tag-regexp)) + (t tag-regexp)))) + (defun erlang-xref-module (xref) (erlang-get-module-from-file-name (erlang-xref-file xref))) @@ -5174,7 +5381,7 @@ future, a new shell on an already running host will be started." (defvar erlang-shell-mode-hook nil - "*User functions to run when an Erlang shell is started. + "User functions to run when an Erlang shell is started. This hook is used to change the behaviour of Erlang mode. It is normally used by the user to personalise the programming environment. @@ -5190,7 +5397,7 @@ Erlang source file is loaded into Emacs.") (defvar erlang-input-ring-file-name "~/.erlang_history" - "*When non-nil, file name used to store Erlang shell history information.") + "When non-nil, file name used to store Erlang shell history information.") (defun erlang-shell-mode () @@ -5290,7 +5497,7 @@ Selects Comint or Compilation mode command as appropriate." ;;; (defvar inferior-erlang-display-buffer-any-frame nil - "*When nil, `inferior-erlang-display-buffer' use only selected frame. + "When nil, `inferior-erlang-display-buffer' use only selected frame. When t, all frames are searched. When 'raise, the frame is raised.") (defvar inferior-erlang-shell-type 'newshell @@ -5303,10 +5510,10 @@ nil, the default shell is used. This variable influence the setting of other variables.") (defvar inferior-erlang-machine "erl" - "*The name of the Erlang shell.") + "The name of the Erlang shell.") (defvar inferior-erlang-machine-options '() - "*The options used when activating the Erlang shell. + "The options used when activating the Erlang shell. This must be a list of strings.") @@ -5317,7 +5524,7 @@ This must be a list of strings.") "The name of the inferior Erlang buffer.") (defvar inferior-erlang-prompt-timeout 60 - "*Number of seconds before `inferior-erlang-wait-prompt' timeouts. + "Number of seconds before `inferior-erlang-wait-prompt' timeouts. The time specified is waited after every output made by the inferior Erlang shell. When this variable is t, we assume that we always have @@ -5383,7 +5590,7 @@ editing control characters: (setq inferior-erlang-process (get-buffer-process inferior-erlang-buffer)) - (if (> 21 erlang-emacs-major-version) ; funcalls to avoid compiler warnings + (if (> 21 emacs-major-version) ; funcalls to avoid compiler warnings (funcall (symbol-function 'set-process-query-on-exit-flag) inferior-erlang-process nil) (funcall (symbol-function 'process-kill-without-query) inferior-erlang-process)) @@ -5454,7 +5661,7 @@ frame will become deselected before the next command." (defun inferior-erlang-window (&optional all-frames) "Return the window containing the inferior Erlang, or nil." (and (inferior-erlang-running-p) - (if (and all-frames (>= erlang-emacs-major-version 19)) + (if (and all-frames (>= emacs-major-version 19)) (get-buffer-window inferior-erlang-buffer t) (get-buffer-window inferior-erlang-buffer)))) @@ -5551,7 +5758,7 @@ Return the position after the newly inserted command." (boundp 'comint-last-output-start)) (save-excursion (goto-char - (if (erlang-interactive-p) + (if (called-interactively-p 'interactive) (symbol-value 'comint-last-input-end) (symbol-value 'comint-last-output-start))) (while (progn (skip-chars-forward "^\C-h") @@ -5570,7 +5777,7 @@ Return the position after the newly inserted command." (let ((pmark (process-mark (get-buffer-process (current-buffer))))) (save-excursion (goto-char - (if (erlang-interactive-p) + (if (called-interactively-p 'interactive) (symbol-value 'comint-last-input-end) (symbol-value 'comint-last-output-start))) (while (re-search-forward "\r+$" pmark t) @@ -5938,12 +6145,6 @@ it assumes that NEWDEF is loaded." (ad-unadvise 'Man-notify-when-ready) (ad-unadvise 'set-visited-file-name))))) - -(defun erlang-string-to-int (string) - (if (fboundp 'string-to-number) - (string-to-number string) - (funcall (symbol-function 'string-to-int) string))) - ;; The end... (provide 'erlang) @@ -5951,7 +6152,7 @@ it assumes that NEWDEF is loaded." (run-hooks 'erlang-load-hook) ;; Local variables: -;; coding: iso-8859-1 +;; coding: utf-8 ;; indent-tabs-mode: nil ;; End: diff --git a/lib/tools/emacs/erldoc.el b/lib/tools/emacs/erldoc.el index cb355374d9..e1fd661348 100644 --- a/lib/tools/emacs/erldoc.el +++ b/lib/tools/emacs/erldoc.el @@ -23,8 +23,8 @@ ;; Crawl Erlang/OTP HTML documentation and generate lookup tables. ;; ;; This package depends on `cl-lib', `pcase' and -;; `libxml-parse-html-region'; emacs 24+ compiled with libxml2 should -;; work. On emacs 24.1 and 24.2 do `M-x package-install RET cl-lib +;; `libxml-parse-html-region'. Emacs 24+ compiled with libxml2 should +;; work. On Emacs 24.1 and 24.2 do `M-x package-install RET cl-lib ;; RET' to install `cl-lib'. ;; ;; Please customise `erldoc-man-index' to point to your local OTP @@ -505,4 +505,10 @@ up the indexing." (browse-url (cdr (assoc topic (erldoc-user-guides))))) (provide 'erldoc) + +;; Local variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + ;;; erldoc.el ends here diff --git a/otp_versions.table b/otp_versions.table index 6ca9636c37..dbc656a543 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-19.2.3 : erts-8.2.2 inets-6.3.5 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 mnesia-4.14.3 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 : OTP-19.2.2 : mnesia-4.14.3 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 erts-8.2.1 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 inets-6.3.4 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 : OTP-19.2.1 : erts-8.2.1 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 inets-6.3.4 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 mnesia-4.14.2 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 : OTP-19.2 : common_test-1.13 compiler-7.0.3 crypto-3.7.2 dialyzer-3.0.3 edoc-0.8.1 erl_docgen-0.6.1 erl_interface-3.9.2 erts-8.2 eunit-2.3.2 hipe-3.15.3 inets-6.3.4 kernel-5.1.1 mnesia-4.14.2 observer-2.3 odbc-2.12 parsetools-2.1.4 public_key-1.3 runtime_tools-1.11 sasl-3.0.2 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 wx-1.8 # asn1-4.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 debugger-4.2.1 diameter-1.12.1 eldap-1.2.2 et-1.6 gs-1.6.2 ic-4.4.2 jinterface-1.7.1 megaco-3.18.1 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 percept-0.9 reltool-0.7.2 snmp-5.2.4 typer-0.9.11 xmerl-1.3.12 : diff --git a/scripts/build-otp b/scripts/build-otp new file mode 100755 index 0000000000..388fa8c276 --- /dev/null +++ b/scripts/build-otp @@ -0,0 +1,20 @@ +#!/bin/bash + +function do_and_log { + log="scripts/latest-log.$$" + echo -n "$1... " + if ./otp_build $2 $3 >$log 2>&1; then + echo "done." + else + echo "failed." + tail -n 200 $log + echo "*** Failed ***" + exit 1 + fi +} + +do_and_log "Autoconfing" autoconf +do_and_log "Configuring" configure +do_and_log "Building OTP" boot -a + +exit 0 |