diff options
52 files changed, 1177 insertions, 391 deletions
diff --git a/erts/configure.in b/erts/configure.in index d5dccdbb83..6b494ef127 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1719,6 +1719,9 @@ AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlop gethrtime localtime_r gmtime_r mmap mremap memcpy mallopt \ sbrk _sbrk __sbrk brk _brk __brk \ flockfile fstat strlcpy strlcat setsid posix2time setlocale nl_langinfo poll]) + +AC_CHECK_DECLS([posix2time],,,[#include <time.h>]) + if test "X$host" = "Xwin32"; then ac_cv_func_setvbuf_reversed=yes fi diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index f7b7b2f346..8e4d8130f5 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -34,11 +34,10 @@ <lib>erl_nif</lib> <libsummary>API functions for an Erlang NIF library</libsummary> <description> - <warning><p>The NIF concept was introduced in R13B03 as an - EXPERIMENTAL feature. The interfaces may be changed in any way - in coming releases. The plan is however to lift the experimental label and - maintain interface backward compatibility from R14B.</p> - <p>Incompatible changes in <em>R14A</em>:</p> + <note><p>The NIF concept is officially supported from R14B. NIF source code + written for earlier experimental versions might need adaption to run on R14B.</p> + <p>No incompatible changes between <em>R14B</em> and R14A.</p> + <p>Incompatible changes between <em>R14A</em> and R13B04:</p> <list> <item>Environment argument removed for <c>enif_alloc</c>, <c>enif_realloc</c>, <c>enif_free</c>, <c>enif_alloc_binary</c>, @@ -50,14 +49,14 @@ <item>Module argument added to <c>enif_open_resource_type</c> while changing name spaces of resource types from global to module local.</item> </list> - <p>Incompatible changes in <em>R13B04</em>:</p> + <p>Incompatible changes between <em>R13B04</em> and R13B03:</p> <list> <item>The function prototypes of the NIFs have changed to expect <c>argc</c> and <c>argv</c> arguments. The arity of a NIF is by that no longer limited to 3.</item> <item><c>enif_get_data</c> renamed as <c>enif_priv_data</c>.</item> <item><c>enif_make_string</c> got a third argument for character encoding.</item> </list> - </warning> + </note> <p>A NIF library contains native implementation of some functions of an Erlang module. The native implemented functions (NIFs) are @@ -456,6 +455,10 @@ typedef enum { to return information about the runtime system. Contains currently the exact same content as <seealso marker="erl_driver#ErlDrvSysInfo">ErlDrvSysInfo</seealso>.</p> </item> + <tag><marker id="ErlNifSInt64"/>ErlNifSInt64</tag> + <item><p>A native signed 64-bit integer type.</p></item> + <tag><marker id="ErlNifUInt64"/>ErlNifUInt64</tag> + <item><p>A native unsigned 64-bit integer type.</p></item> </taglist> </section> @@ -571,7 +574,13 @@ typedef enum { <fsummary>Read an integer term</fsummary> <desc><p>Set <c>*ip</c> to the integer value of <c>term</c>. Return true on success or false if <c>term</c> is not an - integer or is outside the bounds of type <c>int</c></p></desc> + integer or is outside the bounds of type <c>int</c>.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_get_int64(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifSInt64* ip)</nametext></name> + <fsummary>Read a 64-bit integer term</fsummary> + <desc><p>Set <c>*ip</c> to the integer value of + <c>term</c>. Return true on success or false if <c>term</c> is not an + integer or is outside the bounds of a signed 64-bit integer.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_local_pid(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifPid* pid)</nametext></name> <fsummary>Read an local pid term</fsummary> @@ -633,7 +642,12 @@ typedef enum { return true, or return false if <c>term</c> is not an unsigned integer or is outside the bounds of type <c>unsigned int</c>.</p></desc> </func> - + <func><name><ret>int</ret><nametext>enif_get_uint64(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifUInt64* ip)</nametext></name> + <fsummary>Read an unsigned 64-bit integer term.</fsummary> + <desc><p>Set <c>*ip</c> to the unsigned integer value of <c>term</c> and + return true, or return false if <c>term</c> is not an unsigned integer or + is outside the bounds of an unsigned 64-bit integer.</p></desc> + </func> <func><name><ret>int</ret><nametext>enif_get_ulong(ErlNifEnv* env, ERL_NIF_TERM term, unsigned long* ip)</nametext></name> <fsummary>Read an unsigned integer term.</fsummary> <desc><p>Set <c>*ip</c> to the unsigned long integer value of <c>term</c> @@ -758,6 +772,10 @@ typedef enum { <fsummary>Create an integer term</fsummary> <desc><p>Create an integer term.</p></desc> </func> + <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_int64(ErlNifEnv* env, ErlNifSInt64 i)</nametext></name> + <fsummary>Create an integer term</fsummary> + <desc><p>Create an integer term from a signed 64-bit integer.</p></desc> + </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_list(ErlNifEnv* env, unsigned cnt, ...)</nametext></name> <fsummary>Create a list term.</fsummary> <desc><p>Create an ordinary list term of length <c>cnt</c>. Expects @@ -894,6 +912,10 @@ typedef enum { <fsummary>Create an unsigned integer term</fsummary> <desc><p>Create an integer term from an <c>unsigned int</c>.</p></desc> </func> + <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_uint64(ErlNifEnv* env, ErlNifUInt64 i)</nametext></name> + <fsummary>Create an unsigned integer term</fsummary> + <desc><p>Create an integer term from an unsigned 64-bit integer.</p></desc> + </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_ulong(ErlNifEnv* env, unsigned long i)</nametext></name> <fsummary>Create an integer term from an unsigned long int</fsummary> <desc><p>Create an integer term from an <c>unsigned long int</c>.</p></desc> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 5d8a96a910..1eec45e0f3 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -4513,7 +4513,7 @@ true</pre> </desc> </func> <func> - <name>spawn(Node, Module, Function, ArgumentList) -> pid()</name> + <name>spawn(Node, Module, Function, Args) -> pid()</name> <fsummary>Create a new process with a function as entry point on a given node</fsummary> <type> <v>Node = node()</v> diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 23b267d5cd..b0bf14b94f 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -125,7 +125,7 @@ erts_debug_breakpoint_2(Process* p, Eterm MFA, Eterm bool) BIF_ERROR(p, BADARG); } -#if 0 /* XXX:PaN - not used */ +#if 0 /* Kept for conveninence when hard debugging. */ void debug_dump_code(BeamInstr *I, int num) { BeamInstr *code_ptr = I; diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 260f349563..8a0e12dd4f 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -3390,7 +3390,7 @@ apply_bif_or_nif_epilogue: pb->val = bptr; pb->bytes = (byte*) bptr->orig_bytes; pb->flags = 0; - MSO(c_p).overhead += pb->size / sizeof(Eterm); + OH_OVERHEAD(&(MSO(c_p)), pb->size / sizeof(Eterm)); new_binary = make_binary(pb); goto do_bits_sub_bin; } @@ -3492,7 +3492,7 @@ apply_bif_or_nif_epilogue: pb->bytes = (byte*) bptr->orig_bytes; pb->flags = 0; - MSO(c_p).overhead += tmp_arg1 / sizeof(Eterm); + OH_OVERHEAD(&(MSO(c_p)), tmp_arg1 / sizeof(Eterm)); StoreBifResult(2, make_binary(pb)); } @@ -4373,7 +4373,7 @@ apply_bif_or_nif_epilogue: ASSERT(is_CP((BeamInstr)(ep->code))); ASSERT(is_internal_pid(c_p->tracer_proc) || is_internal_port(c_p->tracer_proc)); - E[2] = make_cp(c_p->cp); /* XXX:PaN - code in lower range on halfword */ + E[2] = make_cp(c_p->cp); /* Code in lower range on halfword */ E[1] = am_true; /* Process tracer */ E[0] = make_cp(ep->code); c_p->cp = (flags & MATCH_SET_EXCEPTION_TRACE) @@ -4889,7 +4889,7 @@ apply_bif_or_nif_epilogue: neg_o_reds = -c_p->def_arg_reg[4]; FCALLS = c_p->fcalls; SWAPIN; - switch( c_p->def_arg_reg[3] ) { /* XXX:PaN - Halfword wont work with hipe yet... */ + switch( c_p->def_arg_reg[3] ) { /* Halfword wont work with hipe yet! */ case HIPE_MODE_SWITCH_RES_RETURN: ASSERT(is_value(reg[0])); MoveReturn(reg[0], r(0)); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 30f276b95a..74777e4c26 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -1566,7 +1566,8 @@ load_code(LoaderState* stp) case 0: /* Floating point number */ { Eterm* hp; -#if !defined(ARCH_64) || HALFWORD_HEAP /* XXX:PaN - Should use ARCH_64 variant instead */ +/* XXX:PaN - Halfword should use ARCH_64 variant instead */ +#if !defined(ARCH_64) || HALFWORD_HEAP Uint high, low; # endif last_op->a[arg].val = new_literal(stp, &hp, @@ -1933,7 +1934,7 @@ load_code(LoaderState* stp) } code[ci++] = (BeamInstr) stp->import[i].bf; break; - case 'P': /* Byte offset into tuple */ /* XXX:PaN - * sizeof(Eterm or Eterm *) ? */ + case 'P': /* Byte offset into tuple */ VerifyTag(stp, tag, TAG_u); tmp = tmp_op->a[arg].val; code[ci++] = (BeamInstr) ((tmp_op->a[arg].val+1) * sizeof(Eterm)); diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 2d250f32cf..ff15d834ab 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1881,6 +1881,9 @@ term_to_Uint(Eterm term, Uint *up) int term_to_UWord(Eterm term, UWord *up) { +#if SIZEOF_VOID_P == ERTS_SIZEOF_ETERM + return term_to_Uint(term,up); +#else if (is_small(term)) { Sint i = signed_val(term); if (i < 0) { @@ -1903,7 +1906,47 @@ term_to_UWord(Eterm term, UWord *up) return 0; } while (xl-- > 0) { - uval |= ((Uint)(*xr++)) << n; + uval |= ((UWord)(*xr++)) << n; + n += D_EXP; + } + *up = uval; + return 1; + } else { + *up = BADARG; + return 0; + } +#endif +} + +int +term_to_Uint64(Eterm term, Uint64 *up) +{ +#if SIZEOF_VOID_P == 8 + return term_to_UWord(term,up); +#else + if (is_small(term)) { + Sint i = signed_val(term); + if (i < 0) { + *up = BADARG; + return 0; + } + *up = (Uint64) i; + return 1; + } else if (is_big(term)) { + ErtsDigit* xr = big_v(term); + dsize_t xl = big_size(term); + Uint64 uval = 0; + int n = 0; + + if (big_sign(term)) { + *up = BADARG; + return 0; + } else if (xl*D_EXP > sizeof(Uint64)*8) { + *up = SYSTEM_LIMIT; + return 0; + } + while (xl-- > 0) { + uval |= ((Uint64)(*xr++)) << n; n += D_EXP; } *up = uval; @@ -1912,8 +1955,10 @@ term_to_UWord(Eterm term, UWord *up) *up = BADARG; return 0; } +#endif } + int term_to_Sint(Eterm term, Sint *sp) { if (is_small(term)) { @@ -1948,6 +1993,47 @@ int term_to_Sint(Eterm term, Sint *sp) } } +#if HAVE_INT64 +int term_to_Sint64(Eterm term, Sint64 *sp) +{ +#if ERTS_SIZEOF_ETERM == 8 + return term_to_Sint(term, sp); +#else + if (is_small(term)) { + *sp = signed_val(term); + return 1; + } else if (is_big(term)) { + ErtsDigit* xr = big_v(term); + dsize_t xl = big_size(term); + int sign = big_sign(term); + Uint64 uval = 0; + int n = 0; + + if (xl*D_EXP > sizeof(Uint64)*8) { + return 0; + } + while (xl-- > 0) { + uval |= ((Uint64)(*xr++)) << n; + n += D_EXP; + } + if (sign) { + uval = -uval; + if ((Sint64)uval > 0) + return 0; + } else { + if ((Sint64)uval < 0) + return 0; + } + *sp = uval; + return 1; + } else { + return 0; + } +#endif +} +#endif /* HAVE_INT64 */ + + /* ** Add and subtract */ diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 56f3be372a..25466cd3c2 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -152,6 +152,10 @@ byte* big_to_bytes(Eterm, byte*); int term_to_Uint(Eterm, Uint*); int term_to_UWord(Eterm, UWord*); int term_to_Sint(Eterm, Sint*); +#if HAVE_INT64 +int term_to_Uint64(Eterm, Uint64*); +int term_to_Sint64(Eterm, Sint64*); +#endif Uint32 big_to_uint32(Eterm b); int term_equals_2pow32(Eterm); diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index 3fd714f9c2..8ee8fbcb29 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -97,7 +97,7 @@ new_binary(Process *p, byte *buf, int len) /* * Miscellanous updates. Return the tagged binary. */ - MSO(p).overhead += pb->size / sizeof(Eterm); + OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); return make_binary(pb); } @@ -136,7 +136,7 @@ Eterm erts_new_mso_binary(Process *p, byte *buf, int len) /* * Miscellanous updates. Return the tagged binary. */ - MSO(p).overhead += pb->size / sizeof(Eterm); + OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); return make_binary(pb); } diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 57be0169ba..8bee47232e 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -317,7 +317,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) pb->next = off_heap->first; pb->flags = 0; off_heap->first = (struct erl_off_heap_header*) pb; - off_heap->overhead += pb->size / sizeof(Eterm); + OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm)); } break; case SUB_BINARY_SUBTAG: @@ -366,7 +366,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) to->next = off_heap->first; to->flags = 0; off_heap->first = (struct erl_off_heap_header*) to; - off_heap->overhead += to->size / sizeof(Eterm); + OH_OVERHEAD(off_heap, to->size / sizeof(Eterm)); } *argp = make_binary(hbot); if (extra_bytes != 0) { @@ -652,7 +652,7 @@ Eterm copy_struct_lazy(Process *from, Eterm orig, Uint offs) erts_refc_inc(&pb->val->refc, 2); pb->next = erts_global_offheap.first; erts_global_offheap.first = pb; - erts_global_offheap.overhead += pb->size / sizeof(Eterm); + OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm)); continue; } @@ -777,7 +777,7 @@ Eterm copy_struct_lazy(Process *from, Eterm orig, Uint offs) to_bin->bytes = from_bin->bytes + sub_offset; to_bin->next = erts_global_offheap.first; erts_global_offheap.first = to_bin; - erts_global_offheap.overhead += to_bin->size / sizeof(Eterm); + OH_OVERHEAD(&erts_global_offheap, to_bin->size / sizeof(Eterm)); res_binary=make_binary(to_bin); hp += PROC_BIN_SIZE; } @@ -912,7 +912,7 @@ copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) { ProcBin* pb = (ProcBin *) (tp-1); erts_refc_inc(&pb->val->refc, 2); - off_heap->overhead += pb->size / sizeof(Eterm); + OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm)); } goto off_heap_common; @@ -977,7 +977,7 @@ void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first, for (bp=first; bp!=NULL; bp=bp->next) { move_one_frag(hpp, bp->mem, bp->used_size, off_heap); - off_heap->overhead += bp->off_heap.overhead; + OH_OVERHEAD(off_heap, bp->off_heap.overhead); } hp_end = *hpp; for (hp=hp_start; hp<hp_end; ++hp) { diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index be691317ee..12c7631448 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -70,7 +70,6 @@ static ErlAsync* async_ready_list = NULL; /* Detach from driver */ static void async_detach(DE_Handle* dh) { - /* XXX:PaN what should happen here? we want to unload the driver or??? */ return; } @@ -176,7 +175,6 @@ int exit_async() static void async_add(ErlAsync* a, AsyncQueue* q) { - /* XXX:PaN Is this still necessary when ports lock drivers? */ if (is_internal_port(a->port)) { ERTS_LC_ASSERT(erts_drvportid2port(a->port)); /* make sure the driver will stay around */ diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index 1d8fd11b7b..024ff2a684 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -2517,7 +2517,7 @@ BIF_RETTYPE binary_copy_trap(BIF_ALIST_2) pb->bytes = t; pb->flags = 0; - MSO(BIF_P).overhead += target_size / sizeof(Eterm); + OH_OVERHEAD(&(MSO(BIF_P)), target_size / sizeof(Eterm)); BUMP_REDS(BIF_P,(pos - opos) / BINARY_COPY_LOOP_FACTOR); BIF_RET(make_binary(pb)); @@ -2551,7 +2551,8 @@ BIF_RETTYPE binary_referenced_byte_size_1(BIF_ALIST_1) } pb = (ProcBin *) binary_val(bin); if (pb->thing_word == HEADER_PROC_BIN) { - res = erts_make_integer((Uint) pb->val->orig_size, BIF_P); /* XXX:PaN Halfword? orig_size is a long */ + /* XXX:PaN - Halfword - orig_size is a long, we should handle that */ + res = erts_make_integer((Uint) pb->val->orig_size, BIF_P); } else { /* heap binary */ res = erts_make_integer((Uint) ((ErlHeapBin *) pb)->size, BIF_P); } diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index 9d5f0d9c02..2c2e283f65 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * Copyright Ericsson AB 2006-2010. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -1646,7 +1646,8 @@ static int do_unload_driver_entry(DE_Handle *dh, Eterm *save_name) if (save_name != NULL) { *save_name = mkatom(q->name); } - /* XXX:PaN Future locking problems? Don't dare to let go of the diver_list lock here!*/ + /* Future locking problems? Don't dare to let go of the + diver_list lock here!*/ if (q->finish) { int fpe_was_unmasked = erts_block_fpe(); (*(q->finish))(); diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c index 96faa673f6..88d2c06246 100644 --- a/erts/emulator/beam/erl_bits.c +++ b/erts/emulator/beam/erl_bits.c @@ -1340,7 +1340,7 @@ erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term, pb->val = bptr; pb->bytes = (byte*) bptr->orig_bytes; pb->flags = PB_IS_WRITABLE | PB_ACTIVE_WRITER; - MSO(c_p).overhead += pb->size / sizeof(Eterm); + OH_OVERHEAD(&(MSO(c_p)), pb->size / sizeof(Eterm)); /* * Now allocate the sub binary and set its size to include the @@ -1511,7 +1511,7 @@ erts_bs_init_writable(Process* p, Eterm sz) pb->val = bptr; pb->bytes = (byte*) bptr->orig_bytes; pb->flags = PB_IS_WRITABLE | PB_ACTIVE_WRITER; - MSO(p).overhead += pb->size / sizeof(Eterm); + OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); /* * Now allocate the sub binary. diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 08117bb6e5..5abd2e50fa 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -2745,6 +2745,7 @@ static void db_finalize_dbterm_hash(DbUpdateHandle* handle) ASSERT(&oldp->dbterm == handle->dbterm); if (handle->mustResize) { + ErlOffHeap tmp_offheap; Eterm* top; Eterm copy; DbTerm* newDbTerm; @@ -2755,14 +2756,15 @@ static void db_finalize_dbterm_hash(DbUpdateHandle* handle) newDbTerm = &newp->dbterm; newDbTerm->size = handle->new_size; - newDbTerm->off_heap.first = NULL; - newDbTerm->off_heap.overhead = 0; + tmp_offheap.first = NULL; + tmp_offheap.overhead = 0; /* make a flat copy */ top = DBTERM_BUF(newDbTerm); copy = copy_struct(make_tuple(handle->dbterm->tpl), handle->new_size, - &top, &newDbTerm->off_heap); + &top, &tmp_offheap); + newDbTerm->first_oh = tmp_offheap.first; DBTERM_SET_TPL(newDbTerm,tuple_val(copy)); WUNLOCK_HASH(lck); @@ -2805,7 +2807,11 @@ void db_foreach_offheap_hash(DbTable *tbl, for (i = 0; i < nactive; i++) { list = BUCKET(tb,i); while(list != 0) { - (*func)(&(list->dbterm.off_heap), arg); + ErlOffHeap tmp_offheap; + tmp_offheap.first = list->dbterm.first_oh; + tmp_offheap.overhead = 0; + (*func)(&tmp_offheap, arg); + list->dbterm.first_oh = tmp_offheap.first; list = list->next; } } diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index da2696163a..5644e85f97 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -1818,10 +1818,14 @@ do_db_tree_foreach_offheap(TreeDbTerm *tdbt, void (*func)(ErlOffHeap *, void *), void * arg) { + ErlOffHeap tmp_offheap; if(!tdbt) return; do_db_tree_foreach_offheap(tdbt->left, func, arg); - (*func)(&(tdbt->dbterm.off_heap), arg); + tmp_offheap.first = tdbt->dbterm.first_oh; + tmp_offheap.overhead = 0; + (*func)(&tmp_offheap, arg); + tdbt->dbterm.first_oh = tmp_offheap.first; do_db_tree_foreach_offheap(tdbt->right, func, arg); } @@ -2575,6 +2579,7 @@ static int db_lookup_dbterm_tree(DbTable *tbl, Eterm key, DbUpdateHandle* handle static void db_finalize_dbterm_tree(DbUpdateHandle* handle) { if (handle->mustResize) { + ErlOffHeap tmp_offheap; Eterm* top; Eterm copy; DbTerm* newDbTerm; @@ -2589,14 +2594,15 @@ static void db_finalize_dbterm_tree(DbUpdateHandle* handle) newDbTerm = &newp->dbterm; newDbTerm->size = handle->new_size; - newDbTerm->off_heap.first = NULL; - newDbTerm->off_heap.overhead = 0; + tmp_offheap.first = NULL; + tmp_offheap.overhead = 0; /* make a flat copy */ top = DBTERM_BUF(newDbTerm); copy = copy_struct(make_tuple(handle->dbterm->tpl), handle->new_size, - &top, &newDbTerm->off_heap); + &top, &tmp_offheap); + newDbTerm->first_oh = tmp_offheap.first; DBTERM_SET_TPL(newDbTerm,tuple_val(copy)); db_free_term_data(handle->dbterm); diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 48e0080525..2f34561234 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -1733,8 +1733,7 @@ restart: FAIL(); ep = termp; break; - case matchArrayBind: /* When the array size is unknown. */ /* XXX:PaN - where does - this array come from? */ + case matchArrayBind: /* When the array size is unknown. */ n = *pc++; hp[n] = dpm_array_to_list(psp, termp, arity); break; @@ -2452,9 +2451,13 @@ void* db_get_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) DbTerm* p; Eterm copy; Eterm *top; + ErlOffHeap tmp_offheap; if (old != 0) { - erts_cleanup_offheap(&old->off_heap); + tmp_offheap.first = old->first_oh; + tmp_offheap.overhead = 0; + erts_cleanup_offheap(&tmp_offheap); + old->first_oh = tmp_offheap.first; if (size == old->size) { p = old; } else { @@ -2490,11 +2493,12 @@ void* db_get_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) p = (DbTerm*) ((void *)(((char *) structp) + offset)); } p->size = size; - p->off_heap.first = NULL; - p->off_heap.overhead = 0; + tmp_offheap.first = NULL; + tmp_offheap.overhead = 0; top = DBTERM_BUF(p); - copy = copy_struct(obj, size, &top, &p->off_heap); + copy = copy_struct(obj, size, &top, &tmp_offheap); + p->first_oh = tmp_offheap.first; DBTERM_SET_TPL(p,tuple_val(copy)); return structp; @@ -2503,7 +2507,10 @@ void* db_get_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) void db_free_term_data(DbTerm* p) { - erts_cleanup_offheap(&p->off_heap); + ErlOffHeap tmp_offheap; + tmp_offheap.first = p->first_oh; + tmp_offheap.overhead = 0; + erts_cleanup_offheap(&tmp_offheap); } diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 672c5f2cd1..0f333e8b34 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -57,7 +57,7 @@ * A datatype for a database entry stored out of a process heap */ typedef struct db_term { - ErlOffHeap off_heap; /* Off heap data for term. */ + struct erl_off_heap_header* first_oh; /* Off heap data for term. */ Uint size; /* Size of term in "words" */ Eterm tpl[1]; /* Untagged "constant pointer" to top tuple */ /* (assumed to be first in buffer) */ diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index adc50675bf..0f4d2a2ef9 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -743,7 +743,10 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) * is large enough. */ - if (OLD_HEAP(p) && mature <= OLD_HEND(p) - OLD_HTOP(p)) { + if (OLD_HEAP(p) && + ((mature <= OLD_HEND(p) - OLD_HTOP(p)) && + ((BIN_VHEAP_MATURE(p) < ( BIN_OLD_VHEAP_SZ(p) - BIN_OLD_VHEAP(p)))) && + ((BIN_OLD_VHEAP_SZ(p) > BIN_OLD_VHEAP(p))) ) ) { ErlMessage *msgp; Uint size_after; Uint need_after; @@ -1982,8 +1985,8 @@ shrink_new_heap(Process *p, Uint new_sz, Eterm *objv, int nobj) HEAP_SIZE(p) = new_sz; } -static Uint -do_next_vheap_size(Uint vheap, Uint vheap_sz) { +static Uint64 +do_next_vheap_size(Uint64 vheap, Uint64 vheap_sz) { /* grow * @@ -2000,27 +2003,33 @@ do_next_vheap_size(Uint vheap, Uint vheap_sz) { * ---------------------- */ - if (vheap > (Uint) (vheap_sz*3/4)) { + if ((Uint64) vheap/3 > (Uint64) (vheap_sz/4)) { + Uint64 new_vheap_sz = vheap_sz; - while(vheap > (Uint) (vheap_sz*3/4)) { - vheap_sz = vheap_sz*2; + while((Uint64) vheap/3 > (Uint64) (vheap_sz/4)) { + /* the golden ratio = 1.618 */ + new_vheap_sz = (Uint64) vheap_sz * 1.618; + if (new_vheap_sz < vheap_sz ) { + return vheap_sz; + } + vheap_sz = new_vheap_sz; } - return erts_next_heap_size(vheap_sz, 0); + return vheap_sz; } - if (vheap < (Uint) (vheap_sz/4)) { - return erts_next_heap_size((Uint) (vheap_sz / 2), 0); + if (vheap < (Uint64) (vheap_sz/4)) { + return (vheap_sz >> 1); } return vheap_sz; } -static Uint -next_vheap_size(Process* p, Uint vheap, Uint vheap_sz) { - vheap_sz = do_next_vheap_size(vheap, vheap_sz); - return vheap_sz < p->min_vheap_size ? p->min_vheap_size : vheap_sz; +static Uint64 +next_vheap_size(Process* p, Uint64 vheap, Uint64 vheap_sz) { + Uint64 new_vheap_sz = do_next_vheap_size(vheap, vheap_sz); + return new_vheap_sz < p->min_vheap_size ? p->min_vheap_size : new_vheap_sz; } struct shrink_cand_data { @@ -2079,7 +2088,7 @@ link_live_proc_bin(struct shrink_cand_data *shrink, } -static void +static void sweep_off_heap(Process *p, int fullsweep) { struct shrink_cand_data shrink = {0}; @@ -2087,7 +2096,7 @@ sweep_off_heap(Process *p, int fullsweep) struct erl_off_heap_header** prev; char* oheap = NULL; Uint oheap_sz = 0; - Uint bin_vheap = 0; + Uint64 bin_vheap = 0; #ifdef DEBUG int seen_mature = 0; #endif @@ -2171,13 +2180,12 @@ sweep_off_heap(Process *p, int fullsweep) } } - if (BIN_OLD_VHEAP(p) >= BIN_OLD_VHEAP_SZ(p)) { - FLAGS(p) |= F_NEED_FULLSWEEP; + if (fullsweep) { + BIN_OLD_VHEAP_SZ(p) = next_vheap_size(p, BIN_OLD_VHEAP(p) + MSO(p).overhead, BIN_OLD_VHEAP_SZ(p)); } - - BIN_VHEAP_SZ(p) = next_vheap_size(p, bin_vheap, BIN_VHEAP_SZ(p)); - BIN_OLD_VHEAP_SZ(p) = next_vheap_size(p, BIN_OLD_VHEAP(p), BIN_OLD_VHEAP_SZ(p)); - MSO(p).overhead = bin_vheap; + BIN_VHEAP_SZ(p) = next_vheap_size(p, bin_vheap, BIN_VHEAP_SZ(p)); + MSO(p).overhead = bin_vheap; + BIN_VHEAP_MATURE(p) = bin_vheap; /* * If we got any shrink candidates, check them out. diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 99cc80e259..d6138fa4e4 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -1258,7 +1258,6 @@ erts_lc_init_lock(erts_lc_lock_t *lck, char *name, Uint16 flags) { lck->id = erts_lc_get_lock_order_id(name); - /* XXX:PaN What to do with the extra information? */ lck->extra = make_boxed(&lck->extra); lck->flags = flags; lck->inited = ERTS_LC_INITITALIZED; diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 1f61dca230..82f272d28a 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -220,7 +220,7 @@ link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp) *next_p = MSO(proc).first; MSO(proc).first = bp->off_heap.first; bp->off_heap.first = NULL; - MSO(proc).overhead += bp->off_heap.overhead; + OH_OVERHEAD(&(MSO(proc)), bp->off_heap.overhead); } } } @@ -535,7 +535,7 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg) goto copy_done; } - off_heap->overhead += bp->off_heap.overhead; + OH_OVERHEAD(off_heap, bp->off_heap.overhead); sz = bp->used_size; ASSERT(is_immed(term) || in_heapfrag(ptr_val(term),bp)); diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index 55ea92860a..5aca0db6fe 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -37,9 +37,13 @@ struct erl_off_heap_header { struct erl_off_heap_header* next; }; +#define OH_OVERHEAD(oh, size) do { \ + (oh)->overhead += size; \ +} while(0) + typedef struct erl_off_heap { struct erl_off_heap_header* first; - int overhead; /* Administrative overhead (used to force GC). */ + Uint64 overhead; /* Administrative overhead (used to force GC). */ } ErlOffHeap; #include "external.h" diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index e95d9c4f75..1dd9c8bd4a 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -631,7 +631,7 @@ Eterm enif_make_binary(ErlNifEnv* env, ErlNifBinary* bin) pb->bytes = (byte*) bptr->orig_bytes; pb->flags = 0; - MSO(env->proc).overhead += pb->size / sizeof(Eterm); + OH_OVERHEAD(&(MSO(env->proc)), pb->size / sizeof(Eterm)); bin_term = make_binary(pb); if (erts_refc_read(&bptr->refc, 1) == 1) { /* Total ownership transfer */ @@ -750,7 +750,19 @@ int enif_get_ulong(ErlNifEnv* env, Eterm term, unsigned long* ip) #endif } -int enif_get_double(ErlNifEnv* env, Eterm term, double* dp) +#if HAVE_INT64 && SIZEOF_LONG != 8 +int enif_get_int64(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifSInt64* ip) +{ + return term_to_Sint64(term, ip); +} + +int enif_get_uint64(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifUInt64* ip) +{ + return term_to_Uint64(term, ip); +} +#endif /* HAVE_INT64 && SIZEOF_LONG != 8 */ + +int enif_get_double(ErlNifEnv* env, ERL_NIF_TERM term, double* dp) { FloatDef f; if (is_not_float(term)) { @@ -817,6 +829,26 @@ ERL_NIF_TERM enif_make_ulong(ErlNifEnv* env, unsigned long i) return IS_USMALL(0,i) ? make_small(i) : uint_to_big(i,alloc_heap(env,2)); } +#if HAVE_INT64 && SIZEOF_LONG != 8 +ERL_NIF_TERM enif_make_int64(ErlNifEnv* env, ErlNifSInt64 i) +{ + Uint* hp; + Uint need = 0; + erts_bld_sint64(NULL, &need, i); + hp = alloc_heap(env, need); + return erts_bld_sint64(&hp, NULL, i); +} + +ERL_NIF_TERM enif_make_uint64(ErlNifEnv* env, ErlNifUInt64 i) +{ + Uint* hp; + Uint need = 0; + erts_bld_uint64(NULL, &need, i); + hp = alloc_heap(env, need); + return erts_bld_uint64(&hp, NULL, i); +} +#endif /* HAVE_INT64 && SIZEOF_LONG != 8 */ + ERL_NIF_TERM enif_make_double(ErlNifEnv* env, double d) { Eterm* hp = alloc_heap(env,FLOAT_SIZE_OBJECT); diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 936f03bce1..ee3a7cd5f4 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -66,6 +66,19 @@ extern "C" { #endif +#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) +typedef unsigned __int64 ErlNifUInt64; +typedef __int64 ErlNifSInt64; +#elif SIZEOF_LONG == 8 +typedef unsigned long ErlNifUInt64; +typedef long ErlNifSInt64; +#elif SIZEOF_LONG_LONG == 8 +typedef unsigned long long ErlNifUInt64; +typedef long long ErlNifSInt64; +#else +#error No 64-bit integer type +#endif + #ifdef HALFWORD_HEAP_EMULATOR typedef unsigned int ERL_NIF_TERM; #else diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index ef4e9580b0..eca506593d 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -122,6 +122,12 @@ ERL_NIF_API_FUNC_DECL(ErlNifPid*,enif_self,(ErlNifEnv* caller_env, ErlNifPid* pi ERL_NIF_API_FUNC_DECL(int,enif_get_local_pid,(ErlNifEnv* env, ERL_NIF_TERM, ErlNifPid* pid)); ERL_NIF_API_FUNC_DECL(void,enif_keep_resource,(void* obj)); ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_resource_binary,(ErlNifEnv*,void* obj,const void* data, size_t size)); +#if SIZEOF_LONG != 8 +ERL_NIF_API_FUNC_DECL(int,enif_get_int64,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifSInt64* ip)); +ERL_NIF_API_FUNC_DECL(int,enif_get_uint64,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifUInt64* ip)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int64,(ErlNifEnv*, ErlNifSInt64)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64)); +#endif /* ** Add last to keep compatibility on Windows!!! @@ -230,6 +236,13 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_resource_binary,(ErlNifEnv*,void* o # define enif_get_local_pid ERL_NIF_API_FUNC_MACRO(enif_get_local_pid) # define enif_keep_resource ERL_NIF_API_FUNC_MACRO(enif_keep_resource) # define enif_make_resource_binary ERL_NIF_API_FUNC_MACRO(enif_make_resource_binary) +#if SIZEOF_LONG != 8 +# define enif_get_int64 ERL_NIF_API_FUNC_MACRO(enif_get_int64) +# define enif_get_uint64 ERL_NIF_API_FUNC_MACRO(enif_get_uint64) +# define enif_make_int64 ERL_NIF_API_FUNC_MACRO(enif_make_int64) +# define enif_make_uint64 ERL_NIF_API_FUNC_MACRO(enif_make_uint64) +#endif + #endif #ifndef enif_make_list1 @@ -253,5 +266,13 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_resource_binary,(ErlNifEnv*,void* o # define enif_make_tuple9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_tuple(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9) # define enif_make_pid(ENV, PID) ((const ERL_NIF_TERM)((PID)->pid)) + +#if SIZEOF_LONG == 8 +# define enif_get_int64 enif_get_long +# define enif_get_uint64 enif_get_ulong +# define enif_make_int64 enif_make_long +# define enif_make_uint64 enif_make_ulong +#endif + #endif diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 0417109a8a..761096e9ad 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -7840,6 +7840,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->bin_vheap_sz = p->min_vheap_size; p->bin_old_vheap_sz = p->min_vheap_size; p->bin_old_vheap = 0; + p->bin_vheap_mature = 0; /* No need to initialize p->fcalls. */ @@ -8092,6 +8093,7 @@ void erts_init_empty_process(Process *p) p->bin_vheap_sz = BIN_VH_MIN_SIZE; p->bin_old_vheap_sz = BIN_VH_MIN_SIZE; p->bin_old_vheap = 0; + p->bin_vheap_mature = 0; #ifdef ERTS_SMP p->u.ptimer = NULL; p->bound_runq = NULL; diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 0cc4a715ad..e49710a7ed 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -537,6 +537,7 @@ struct ErtsPendingSuspend_ { # define MIN_VHEAP_SIZE(p) (p)->min_vheap_size # define BIN_VHEAP_SZ(p) (p)->bin_vheap_sz +# define BIN_VHEAP_MATURE(p) (p)->bin_vheap_mature # define BIN_OLD_VHEAP_SZ(p) (p)->bin_old_vheap_sz # define BIN_OLD_VHEAP(p) (p)->bin_old_vheap @@ -654,9 +655,10 @@ struct process { Uint mbuf_sz; /* Size of all message buffers */ ErtsPSD *psd; /* Rarely used process specific data */ - Uint bin_vheap_sz; /* Virtual heap block size for binaries */ - Uint bin_old_vheap_sz; /* Virtual old heap block size for binaries */ - Uint bin_old_vheap; /* Virtual old heap size for binaries */ + Uint64 bin_vheap_sz; /* Virtual heap block size for binaries */ + Uint64 bin_vheap_mature; /* Virtual heap block size for binaries */ + Uint64 bin_old_vheap_sz; /* Virtual old heap block size for binaries */ + Uint64 bin_old_vheap; /* Virtual old heap size for binaries */ union { #ifdef ERTS_SMP diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c index c15f85f8f1..7b8706ea13 100644 --- a/erts/emulator/beam/erl_time_sup.c +++ b/erts/emulator/beam/erl_time_sup.c @@ -650,6 +650,22 @@ local_to_univ(Sint *year, Sint *month, Sint *day, t.tm_sec = *second; t.tm_isdst = isdst; the_clock = mktime(&t); + if (the_clock == -1) { + if (isdst) { + /* If this is a timezone without DST and the OS (correctly) + refuses to give us a DST time, we simulate the Linux/Solaris + behaviour of giving the same data as if is_dst was not set. */ + t.tm_isdst = 0; + the_clock = mktime(&t); + if (the_clock == -1) { + /* Failed anyway, something else is bad - will be a badarg */ + return 0; + } + } else { + /* Something else is the matter, badarg. */ + return 0; + } + } #ifdef HAVE_GMTIME_R gmtime_r(&the_clock, (tm = &tmbuf)); #else @@ -663,6 +679,10 @@ local_to_univ(Sint *year, Sint *month, Sint *day, *second = tm->tm_sec; return 1; } +#if defined(HAVE_POSIX2TIME) && defined(HAVE_DECL_POSIX2TIME) && \ + !HAVE_DECL_POSIX2TIME +extern time_t posix2time(time_t); +#endif int univ_to_local(Sint *year, Sint *month, Sint *day, diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index b840f65cdd..79022d5dd7 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1582,7 +1582,7 @@ static void deliver_read_message(Port* prt, Eterm to, pb->flags = 0; hp += PROC_BIN_SIZE; - ohp->overhead += pb->size / sizeof(Eterm); + OH_OVERHEAD(ohp, pb->size / sizeof(Eterm)); listp = make_binary(pb); } @@ -1732,7 +1732,7 @@ deliver_vec_message(Port* prt, /* Port */ pb->flags = 0; hp += PROC_BIN_SIZE; - ohp->overhead += iov->iov_len / sizeof(Eterm); + OH_OVERHEAD(ohp, iov->iov_len / sizeof(Eterm)); if (listp == NIL) { /* compatible with deliver_bin_message */ listp = make_binary(pb); @@ -2264,7 +2264,7 @@ erts_port_control(Process* p, Port* prt, Uint command, Eterm iolist) pb->val = ErlDrvBinary2Binary(dbin); pb->bytes = (byte*) dbin->orig_bytes; pb->flags = 0; - MSO(p).overhead += dbin->orig_size / sizeof(Eterm); + OH_OVERHEAD(&(MSO(p)), dbin->orig_size / sizeof(Eterm)); return make_binary(pb); } port_resp = dbin->orig_bytes; @@ -3040,7 +3040,7 @@ driver_deliver_term(ErlDrvPort port, pb->flags = 0; mess = make_binary(pb); hp += PROC_BIN_SIZE; - ohp->overhead += pb->size / sizeof(Eterm); + OH_OVERHEAD(ohp, pb->size / sizeof(Eterm)); } ptr += 3; break; @@ -3077,7 +3077,7 @@ driver_deliver_term(ErlDrvPort port, pbp->val = bp; pbp->bytes = (byte*) bp->orig_bytes; pbp->flags = 0; - ohp->overhead += (pbp->size / sizeof(Eterm)); + OH_OVERHEAD(ohp, pbp->size / sizeof(Eterm)); mess = make_binary(pbp); } ptr += 2; diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c index d6d06d0036..5a682ab045 100644 --- a/erts/emulator/sys/unix/sys_float.c +++ b/erts/emulator/sys/unix/sys_float.c @@ -799,8 +799,17 @@ sys_chars_to_double(char* buf, double* fp) } #ifdef NO_FPE_SIGNALS - if (errno == ERANGE && (*fp == 0.0 || *fp == HUGE_VAL || *fp == -HUGE_VAL)) { - return -1; + if (errno == ERANGE) { + if (*fp == HUGE_VAL || *fp == -HUGE_VAL) { + /* overflow, should give error */ + return -1; + } else if (t == s && *fp == 0.0) { + /* This should give 0.0 - OTP-7178 */ + errno = 0; + + } else if (*fp == 0.0) { + return -1; + } } #endif return 0; diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index 102e472ea6..99e9457985 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -22,7 +22,10 @@ -include("test_server.hrl"). -export([all/1,init_per_testcase/2,fin_per_testcase/2, - fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1,bad_float_unpack/1]). + fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1, + bad_float_unpack/1]). +-export([otp_7178/1]). + init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog = ?t:timetrap(?t:minutes(3)), @@ -33,7 +36,29 @@ fin_per_testcase(_Func, Config) -> ?t:timetrap_cancel(Dog). all(suite) -> - [fpe,fp_drv,fp_drv_thread,denormalized,match,bad_float_unpack]. + [fpe, + fp_drv, + fp_drv_thread, + otp_7178, + denormalized, + match, + bad_float_unpack]. + +%% +%% OTP-7178, list_to_float on very small numbers should give 0.0 +%% instead of exception, i.e. ignore underflow. +%% +otp_7178(suite) -> + []; +otp_7178(doc) -> + ["test that list_to_float on very small numbers give 0.0"]; +otp_7178(Config) when is_list(Config) -> + ?line X = list_to_float("1.0e-325"), + ?line true = (X < 0.00000001) and (X > -0.00000001), + ?line Y = list_to_float("1.0e-325325325"), + ?line true = (Y < 0.00000001) and (Y > -0.00000001), + ?line {'EXIT', {badarg,_}} = (catch list_to_float("1.0e83291083210")), + ok. %% Forces floating point exceptions and tests that subsequent, legal, %% operations are calculated correctly. Original version by Sebastian diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 17f644829f..5384a32f21 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -296,6 +296,30 @@ static int test_ulong(ErlNifEnv* env, unsigned long i1) return 1; } +static int test_int64(ErlNifEnv* env, ErlNifSInt64 i1) +{ + ErlNifSInt64 i2 = 0; + ERL_NIF_TERM int_term = enif_make_int64(env, i1); + if (!enif_get_int64(env,int_term, &i2) || i1 != i2) { + fprintf(stderr, "test_int64(%ld) ...FAILED i2=%ld\r\n", + (long)i1, (long)i2); + return 0; + } + return 1; +} + +static int test_uint64(ErlNifEnv* env, ErlNifUInt64 i1) +{ + ErlNifUInt64 i2 = 0; + ERL_NIF_TERM int_term = enif_make_uint64(env, i1); + if (!enif_get_uint64(env,int_term, &i2) || i1 != i2) { + fprintf(stderr, "test_ulong(%lu) ...FAILED i2=%lu\r\n", + (unsigned long)i1, (unsigned long)i2); + return 0; + } + return 1; +} + static int test_double(ErlNifEnv* env, double d1) { double d2 = 0; @@ -319,6 +343,8 @@ static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ unsigned uint; long slong; unsigned long ulong; + ErlNifSInt64 sint64; + ErlNifUInt64 uint64; double d; ERL_NIF_TERM atom, ref1, ref2; @@ -352,11 +378,25 @@ static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ slong -= slong / 3 + 1; } while (slong >= 0); + sint64 = ((ErlNifSInt64)1 << 63); /* INT64_MIN */ + do { + if (!test_int64(env,sint64)) { + goto error; + } + sint64 += ~sint64 / 3 + 1; + } while (sint64 < 0); + sint64 = ((ErlNifUInt64)1 << 63) - 1; /* INT64_MAX */ + do { + if (!test_int64(env,sint64)) { + goto error; + } + sint64 -= sint64 / 3 + 1; + } while (sint64 >= 0); uint = UINT_MAX; for (;;) { if (!test_uint(env,uint)) { - + goto error; } if (uint == 0) break; uint -= uint / 3 + 1; @@ -364,11 +404,19 @@ static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ ulong = ULONG_MAX; for (;;) { if (!test_ulong(env,ulong)) { - + goto error; } if (ulong == 0) break; ulong -= ulong / 3 + 1; } + uint64 = (ErlNifUInt64)-1; /* UINT64_MAX */ + for (;;) { + if (!test_uint64(env,uint64)) { + goto error; + } + if (uint64 == 0) break; + uint64 -= uint64 / 3 + 1; + } if (MAX_SMALL < INT_MAX) { /* 32-bit */ for (i=-10 ; i <= 10; i++) { @@ -391,11 +439,18 @@ static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ for (i=-10 ; i < 10; i++) { if (!test_long(env,MAX_SMALL+i) || !test_ulong(env,MAX_SMALL+i) || - !test_long(env,MIN_SMALL+i)) { + !test_long(env,MIN_SMALL+i) || + !test_int64(env,MAX_SMALL+i) || !test_uint64(env,MAX_SMALL+i) || + !test_int64(env,MIN_SMALL+i)) { goto error; } + if (MAX_SMALL < INT_MAX) { + if (!test_int(env,MAX_SMALL+i) || !test_uint(env,MAX_SMALL+i) || + !test_int(env,MIN_SMALL+i)) { + goto error; + } + } } - for (d=3.141592e-100 ; d < 1e100 ; d *= 9.97) { if (!test_double(env,d) || !test_double(env,-d)) { goto error; diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl index 2ad1f0d201..095e9dd1af 100644 --- a/erts/emulator/test/time_SUITE.erl +++ b/erts/emulator/test/time_SUITE.erl @@ -34,6 +34,8 @@ consistency/1, now/1, now_unique/1, now_update/1, timestamp/1]). +-export([local_to_univ_utc/1]). + -include("test_server.hrl"). -export([linear_time/1]). @@ -53,7 +55,40 @@ -define(dst_timezone, 2). all(suite) -> [univ_to_local, local_to_univ, - bad_univ_to_local, bad_local_to_univ, consistency, now, timestamp]. + local_to_univ_utc, + bad_univ_to_local, bad_local_to_univ, + consistency, now, timestamp]. + +local_to_univ_utc(suite) -> + []; +local_to_univ_utc(doc) -> + ["Test that DST = true on timezones without DST is ignored"]; +local_to_univ_utc(Config) when is_list(Config) -> + case os:type() of + {unix,_} -> + %% TZ variable has a meaning + ?line {ok, Node} = + test_server:start_node(local_univ_utc,peer, + [{args, "-env TZ UTC"}]), + ?line {{2008,8,1},{0,0,0}} = + rpc:call(Node, + erlang,localtime_to_universaltime, + [{{2008, 8, 1}, {0, 0, 0}}, + false]), + ?line {{2008,8,1},{0,0,0}} = + rpc:call(Node, + erlang,localtime_to_universaltime, + [{{2008, 8, 1}, {0, 0, 0}}, + true]), + ?line [{{2008,8,1},{0,0,0}}] = + rpc:call(Node, + calendar,local_time_to_universal_time_dst, + [{{2008, 8, 1}, {0, 0, 0}}]), + ?line test_server:stop_node(Node), + ok; + _ -> + {skip,"Only valid on Unix"} + end. %% Tests conversion from univeral to local time. diff --git a/erts/etc/win32/cygwin_tools/vc/ld.sh b/erts/etc/win32/cygwin_tools/vc/ld.sh index ac39bf871c..b04935ed9b 100755 --- a/erts/etc/win32/cygwin_tools/vc/ld.sh +++ b/erts/etc/win32/cygwin_tools/vc/ld.sh @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# Copyright Ericsson AB 2002-2010. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -167,6 +167,9 @@ eval link.exe "$CMD" >/tmp/link.exe.${p}.1 2>/tmp/link.exe.${p}.2 RES=$? CMANIFEST=`cygpath $MANIFEST` if [ "$RES" = "0" -a -f "$CMANIFEST" ]; then + # Add stuff to manifest to turn off "virtualization" + sed -i "s/<\/assembly>/ <ms_asmv2:trustInfo xmlns:ms_asmv2=\"urn:schemas-microsoft-com:asm.v2\">\n <ms_asmv2:security>\n <ms_asmv2:requestedPrivileges>\n <ms_asmv2:requestedExecutionLevel level=\"AsInvoker\" uiAccess=\"false\"\/>\n <\/ms_asmv2:requestedPrivileges>\n <\/ms_asmv2:security>\n <\/ms_asmv2:trustInfo>\n<\/assembly>/" $CMANIFEST + eval mt.exe -nologo -manifest "$MANIFEST" -outputresource:"$OUTPUTRES" >>/tmp/link.exe.${p}.1 2>>/tmp/link.exe.${p}.2 RES=$? if [ "$RES" != "0" ]; then diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index ed7a9144a8..26da3ecad2 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -824,6 +824,10 @@ foldl_transform(St, [T|Ts]) -> {'EXIT',R} -> Es = [{St#compile.ifile,[{none,compile,{parse_transform,T,R}}]}], {error,St#compile{errors=St#compile.errors ++ Es}}; + {warning, Forms, Ws} -> + foldl_transform( + St#compile{code=Forms, + warnings=St#compile.warnings ++ Ws}, Ts); Forms -> foldl_transform(St#compile{code=Forms}, Ts) end; diff --git a/lib/docbuilder/src/docb_edoc_xml_cb.erl b/lib/docbuilder/src/docb_edoc_xml_cb.erl index f5cfc0fe18..90491bc007 100644 --- a/lib/docbuilder/src/docb_edoc_xml_cb.erl +++ b/lib/docbuilder/src/docb_edoc_xml_cb.erl @@ -340,9 +340,7 @@ otp_xmlify_e(#xmlElement{name=code} = E) -> % 4) [E#xmlElement{content=Content}] end; otp_xmlify_e(#xmlElement{name=Tag} = E) % 5a - when Tag==h1; Tag==h2; Tag==h3; Tag==h4; Tag==h5; - Tag==center; - Tag==font -> + when Tag==h1; Tag==h2; Tag==h3; Tag==h4; Tag==h5 -> Content = text_only(E#xmlElement.content), [E#xmlElement{name=b, content=Content}]; otp_xmlify_e(#xmlElement{name=Tag} = E) % 5b-c) @@ -354,21 +352,16 @@ otp_xmlify_e(#xmlElement{name=table} = E) -> % 6) module -> otp_xmlify_table(E#xmlElement.content); overview -> - case get_attrval(border, E) of - "" -> % implies border="0" - [{p, otp_xmlify_table(E#xmlElement.content)}]; - "0" -> - [{p, otp_xmlify_table(E#xmlElement.content)}]; - _Val -> - Content0 = otp_xmlify_e(E#xmlElement.content), - Summary = #xmlText{value=get_attrval(summary, E)}, - TCaption = E#xmlElement{name=tcaption, - attributes=[], - content=[Summary]}, - Content = Content0 ++ [TCaption], - [E#xmlElement{attributes=[], content=Content}] - end + Content0 = otp_xmlify_e(E#xmlElement.content), + Summary = #xmlText{value=get_attrval(summary, E)}, + TCaption = E#xmlElement{name=tcaption, + attributes=[], + content=[Summary]}, + Content = Content0 ++ [TCaption], + [E#xmlElement{attributes=[], content=Content}] end; +otp_xmlify_e(#xmlElement{name=tbody} = E) -> + otp_xmlify_e(E#xmlElement.content); otp_xmlify_e(#xmlElement{name=sup} = E) -> % 7) Text = get_text(E), [#xmlText{parents = E#xmlElement.parents, diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index 5614b02bb7..bba0f97645 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -1157,6 +1157,7 @@ </xsl:template> + <xsl:template match="name"> <xsl:variable name="tmpstring"> @@ -1208,6 +1209,9 @@ </xsl:variable> <a name="{$fname}-{$arity}"><span class="bold_code"><xsl:value-of select="."/></span></a><br/> </xsl:when> + <xsl:otherwise> + <span class="bold_code"><xsl:value-of select="."/></span> + </xsl:otherwise> </xsl:choose> </xsl:template> diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 76422155a5..dd8f77a0ca 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -334,14 +334,12 @@ hello(start, #state{host = Host, port = Port, role = client, ssl_options = SslOpts, transport_cb = Transport, socket = Socket, connection_states = ConnectionStates, - own_cert = Cert, renegotiation = {Renegotiation, _}} = State0) -> Hello = ssl_handshake:client_hello(Host, Port, ConnectionStates, - SslOpts, Cert, - Renegotiation), + SslOpts, Renegotiation), Version = Hello#client_hello.client_version, Hashes0 = ssl_handshake:init_hashes(), @@ -353,7 +351,7 @@ hello(start, #state{host = Host, port = Port, role = client, session = #session{session_id = Hello#client_hello.session_id, is_resumable = false}, - tls_handshake_hashes = Hashes1}, + tls_handshake_hashes = Hashes1}, {Record, State} = next_record(State1), next_state(hello, Record, State); @@ -579,58 +577,61 @@ certify(#client_key_exchange{} = Msg, %% We expect a certificate here handle_unexpected_message(Msg, certify_client_key_exchange, State); -certify(#client_key_exchange{exchange_keys - = #encrypted_premaster_secret{premaster_secret - = EncPMS}}, - #state{negotiated_version = Version, - connection_states = ConnectionStates0, - session = Session0, - private_key = Key} = State0) -> - try ssl_handshake:decrypt_premaster_secret(EncPMS, Key) of - PremasterSecret -> - case ssl_handshake:master_secret(Version, PremasterSecret, - ConnectionStates0, server) of - {MasterSecret, ConnectionStates} -> - Session = Session0#session{master_secret = MasterSecret}, - State1 = State0#state{connection_states = ConnectionStates, - session = Session}, - {Record, State} = next_record(State1), - next_state(cipher, Record, State); - #alert{} = Alert -> - handle_own_alert(Alert, Version, - certify_client_key_exchange, State0), - {stop, normal, State0} - end +certify(#client_key_exchange{exchange_keys = Keys}, + State = #state{key_algorithm = KeyAlg, negotiated_version = Version}) -> + try + certify_client_key_exchange(ssl_handshake:decode_client_key(Keys, KeyAlg, Version), State) catch #alert{} = Alert -> - handle_own_alert(Alert, Version, certify_client_key_exchange, - State0), + handle_own_alert(Alert, Version, certify_client_key_exchange, State), + {stop, normal, State} + end; + +certify(Msg, State) -> + handle_unexpected_message(Msg, certify, State). + +certify_client_key_exchange(#encrypted_premaster_secret{premaster_secret= EncPMS}, + #state{negotiated_version = Version, + connection_states = ConnectionStates0, + session = Session0, + private_key = Key} = State0) -> + PremasterSecret = ssl_handshake:decrypt_premaster_secret(EncPMS, Key), + case ssl_handshake:master_secret(Version, PremasterSecret, + ConnectionStates0, server) of + {MasterSecret, ConnectionStates} -> + Session = Session0#session{master_secret = MasterSecret}, + State1 = State0#state{connection_states = ConnectionStates, + session = Session}, + {Record, State} = next_record(State1), + next_state(cipher, Record, State); + #alert{} = Alert -> + handle_own_alert(Alert, Version, + certify_client_key_exchange, State0), {stop, normal, State0} end; -certify(#client_key_exchange{exchange_keys = #client_diffie_hellman_public{ - dh_public = ClientPublicDhKey}}, - #state{negotiated_version = Version, - diffie_hellman_params = #'DHParameter'{prime = P, - base = G}, - diffie_hellman_keys = {_, ServerDhPrivateKey}, - role = Role, - session = Session, - connection_states = ConnectionStates0} = State0) -> - +certify_client_key_exchange(#client_diffie_hellman_public{dh_public = ClientPublicDhKey}, + #state{negotiated_version = Version, + diffie_hellman_params = #'DHParameter'{prime = P, + base = G}, + diffie_hellman_keys = {_, ServerDhPrivateKey}, + role = Role, + session = Session, + connection_states = ConnectionStates0} = State0) -> + PMpint = crypto:mpint(P), GMpint = crypto:mpint(G), PremasterSecret = crypto:dh_compute_key(mpint_binary(ClientPublicDhKey), ServerDhPrivateKey, [PMpint, GMpint]), - + case ssl_handshake:master_secret(Version, PremasterSecret, ConnectionStates0, Role) of {MasterSecret, ConnectionStates} -> State1 = State0#state{session = - Session#session{master_secret - = MasterSecret}, - connection_states = ConnectionStates}, + Session#session{master_secret + = MasterSecret}, + connection_states = ConnectionStates}, {Record, State} = next_record(State1), next_state(cipher, Record, State); @@ -638,10 +639,7 @@ certify(#client_key_exchange{exchange_keys = #client_diffie_hellman_public{ handle_own_alert(Alert, Version, certify_client_key_exchange, State0), {stop, normal, State0} - end; - -certify(Msg, State) -> - handle_unexpected_message(Msg, certify, State). + end. %%-------------------------------------------------------------------- -spec cipher(#hello_request{} | #certificate_verify{} | #finished{} | term(), @@ -701,14 +699,13 @@ connection(#hello_request{}, #state{host = Host, port = Port, socket = Socket, ssl_options = SslOpts, negotiated_version = Version, - own_cert = Cert, transport_cb = Transport, connection_states = ConnectionStates0, renegotiation = {Renegotiation, _}, tls_handshake_hashes = Hashes0} = State0) -> - Hello = ssl_handshake:client_hello(Host, Port, - ConnectionStates0, SslOpts, Cert, Renegotiation), + Hello = ssl_handshake:client_hello(Host, Port, ConnectionStates0, + SslOpts, Renegotiation), {BinMsg, ConnectionStates1, Hashes1} = encode_handshake(Hello, Version, ConnectionStates0, Hashes0), @@ -1638,8 +1635,6 @@ application_data(Data, #state{user_application = {_Mon, Pid}, true -> <<Buffer0/binary, Data/binary>> end, case get_data(SOpts, BytesToRead, Buffer1) of - {ok, <<>>, Buffer} -> % no reply, we need more data - next_record(State0#state{user_data_buffer = Buffer}); {ok, ClientData, Buffer} -> % Send data SocketOpt = deliver_app_data(SOpts, ClientData, Pid, From), State = State0#state{user_data_buffer = Buffer, @@ -1655,12 +1650,16 @@ application_data(Data, #state{user_application = {_Mon, Pid}, true -> %% We have more data application_data(<<>>, State) end; + {more, Buffer} -> % no reply, we need more data + next_record(State0#state{user_data_buffer = Buffer}); {error,_Reason} -> %% Invalid packet in packet mode deliver_packet_error(SOpts, Buffer1, Pid, From), {stop, normal, State0} end. %% Picks ClientData +get_data(_, _, <<>>) -> + {more, <<>>}; get_data(#socket_options{active=Active, packet=Raw}, BytesToRead, Buffer) when Raw =:= raw; Raw =:= 0 -> %% Raw Mode if @@ -1673,13 +1672,13 @@ get_data(#socket_options{active=Active, packet=Raw}, BytesToRead, Buffer) {ok, Data, Rest}; true -> %% Passive Mode not enough data - {ok, <<>>, Buffer} + {more, Buffer} end; get_data(#socket_options{packet=Type, packet_size=Size}, _, Buffer) -> PacketOpts = [{packet_size, Size}], case decode_packet(Type, Buffer, PacketOpts) of {more, _} -> - {ok, <<>>, Buffer}; + {more, Buffer}; Decoded -> Decoded end. @@ -1794,9 +1793,7 @@ next_state(Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, State) -> handle_alerts(Alerts, {next_state, Next, State}); next_state(StateName, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, - State0 = #state{key_algorithm = KeyAlg, - tls_handshake_buffer = Buf0, - negotiated_version = Version}) -> + State0 = #state{tls_handshake_buffer = Buf0, negotiated_version = Version}) -> Handle = fun({#hello_request{} = Packet, _}, {next_state, connection = SName, State}) -> %% This message should not be included in handshake @@ -1819,7 +1816,7 @@ next_state(StateName, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, (_, StopState) -> StopState end, try - {Packets, Buf} = ssl_handshake:get_tls_handshake(Data,Buf0, KeyAlg,Version), + {Packets, Buf} = ssl_handshake:get_tls_handshake(Data,Buf0), State = State0#state{tls_packets = Packets, tls_handshake_buffer = Buf}, handle_tls_handshake(Handle, StateName, State) catch throw:#alert{} = Alert -> @@ -1831,7 +1828,7 @@ next_state(StateName, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, State case application_data(Data, State0) of Stop = {stop,_,_} -> Stop; - {Record, State} -> + {Record, State} -> next_state(StateName, Record, State) end; next_state(StateName, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} = diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 3d831eae02..ee725997a4 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -31,13 +31,13 @@ -include("ssl_debug.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([master_secret/4, client_hello/6, server_hello/4, hello/4, +-export([master_secret/4, client_hello/5, server_hello/4, hello/4, hello_request/0, certify/7, certificate/3, client_certificate_verify/6, certificate_verify/6, certificate_request/2, key_exchange/2, server_key_exchange_hash/2, finished/4, verify_connection/5, - get_tls_handshake/4, + get_tls_handshake/2, decode_client_key/3, server_hello_done/0, sig_alg/1, encode_handshake/3, init_hashes/0, update_hashes/2, decrypt_premaster_secret/2]). @@ -52,13 +52,13 @@ %%==================================================================== %%-------------------------------------------------------------------- -spec client_hello(host(), port_num(), #connection_states{}, - #ssl_options{}, binary(), boolean()) -> #client_hello{}. + #ssl_options{}, boolean()) -> #client_hello{}. %% %% Description: Creates a client hello message. %%-------------------------------------------------------------------- client_hello(Host, Port, ConnectionStates, #ssl_options{versions = Versions, ciphers = UserSuites} - = SslOpts, Cert, Renegotiation) -> + = SslOpts, Renegotiation) -> Fun = fun(Version) -> ssl_record:protocol_version(Version) @@ -461,29 +461,36 @@ encode_handshake(Package, Version, KeyAlg) -> [MsgType, ?uint24(Len), Bin]. %%-------------------------------------------------------------------- --spec get_tls_handshake(binary(), binary() | iolist(), key_algo(), tls_version()) -> +-spec get_tls_handshake(binary(), binary() | iolist()) -> {[tls_handshake()], binary()}. %% %% Description: Given buffered and new data from ssl_record, collects %% and returns it as a list of handshake messages, also returns leftover %% data. %%-------------------------------------------------------------------- -get_tls_handshake(Data, <<>>, KeyAlg, Version) -> - get_tls_handshake_aux(Data, KeyAlg, Version, []); -get_tls_handshake(Data, Buffer, KeyAlg, Version) -> - get_tls_handshake_aux(list_to_binary([Buffer, Data]), - KeyAlg, Version, []). +get_tls_handshake(Data, <<>>) -> + get_tls_handshake_aux(Data, []); +get_tls_handshake(Data, Buffer) -> + get_tls_handshake_aux(list_to_binary([Buffer, Data]), []). + +%%-------------------------------------------------------------------- +-spec dec_client_key(binary(), key_algo(), tls_version()) -> + #encrypted_premaster_secret{} | #client_diffie_hellman_public{}. +%% +%% Description: Decode client_key data and return appropriate type +%%-------------------------------------------------------------------- +decode_client_key(ClientKey, Type, Version) -> + dec_client_key(ClientKey, key_exchange_alg(Type), Version). %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- get_tls_handshake_aux(<<?BYTE(Type), ?UINT24(Length), - Body:Length/binary,Rest/binary>>, KeyAlg, - Version, Acc) -> + Body:Length/binary,Rest/binary>>, Acc) -> Raw = <<?BYTE(Type), ?UINT24(Length), Body/binary>>, - H = dec_hs(Type, Body, key_exchange_alg(KeyAlg), Version), - get_tls_handshake_aux(Rest, KeyAlg, Version, [{H,Raw} | Acc]); -get_tls_handshake_aux(Data, _KeyAlg, _Version, Acc) -> + H = dec_hs(Type, Body), + get_tls_handshake_aux(Rest, [{H,Raw} | Acc]); +get_tls_handshake_aux(Data, Acc) -> {lists:reverse(Acc), Data}. verify_bool(verify_peer) -> @@ -729,7 +736,7 @@ master_secret(Version, MasterSecret, #security_parameters{ ServerCipherState, Role)}. -dec_hs(?HELLO_REQUEST, <<>>, _, _) -> +dec_hs(?HELLO_REQUEST, <<>>) -> #hello_request{}; %% Client hello v2. @@ -739,8 +746,7 @@ dec_hs(?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), ?UINT16(CSLength), ?UINT16(0), ?UINT16(CDLength), CipherSuites:CSLength/binary, - ChallengeData:CDLength/binary>>, - _, _) -> + ChallengeData:CDLength/binary>>) -> ?DBG_HEX(CipherSuites), ?DBG_HEX(CipherSuites), #client_hello{client_version = {Major, Minor}, @@ -754,8 +760,7 @@ dec_hs(?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID:SID_length/binary, ?UINT16(Cs_length), CipherSuites:Cs_length/binary, ?BYTE(Cm_length), Comp_methods:Cm_length/binary, - Extensions/binary>>, - _, _) -> + Extensions/binary>>) -> RenegotiationInfo = proplists:get_value(renegotiation_info, dec_hello_extensions(Extensions), undefined), @@ -770,7 +775,7 @@ dec_hs(?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, dec_hs(?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID:SID_length/binary, - Cipher_suite:2/binary, ?BYTE(Comp_method)>>, _, _) -> + Cipher_suite:2/binary, ?BYTE(Comp_method)>>) -> #server_hello{ server_version = {Major,Minor}, random = Random, @@ -782,7 +787,7 @@ dec_hs(?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, dec_hs(?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID:SID_length/binary, Cipher_suite:2/binary, ?BYTE(Comp_method), - ?UINT16(ExtLen), Extensions:ExtLen/binary>>, _, _) -> + ?UINT16(ExtLen), Extensions:ExtLen/binary>>) -> RenegotiationInfo = proplists:get_value(renegotiation_info, dec_hello_extensions(Extensions, []), undefined), @@ -793,44 +798,42 @@ dec_hs(?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, cipher_suite = Cipher_suite, compression_method = Comp_method, renegotiation_info = RenegotiationInfo}; -dec_hs(?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>, _, _) -> +dec_hs(?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>) -> #certificate{asn1_certificates = certs_to_list(ASN1Certs)}; dec_hs(?SERVER_KEY_EXCHANGE, <<?UINT16(PLen), P:PLen/binary, ?UINT16(GLen), G:GLen/binary, ?UINT16(YLen), Y:YLen/binary, - ?UINT16(Len), Sig:Len/binary>>, - ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> + ?UINT16(Len), Sig:Len/binary>>) -> #server_key_exchange{params = #server_dh_params{dh_p = P,dh_g = G, dh_y = Y}, signed_params = Sig}; dec_hs(?CERTIFICATE_REQUEST, <<?BYTE(CertTypesLen), CertTypes:CertTypesLen/binary, - ?UINT16(CertAuthsLen), CertAuths:CertAuthsLen/binary>>, _, _) -> + ?UINT16(CertAuthsLen), CertAuths:CertAuthsLen/binary>>) -> #certificate_request{certificate_types = CertTypes, certificate_authorities = CertAuths}; -dec_hs(?SERVER_HELLO_DONE, <<>>, _, _) -> +dec_hs(?SERVER_HELLO_DONE, <<>>) -> #server_hello_done{}; -dec_hs(?CERTIFICATE_VERIFY,<<?UINT16(_), Signature/binary>>, _, _)-> +dec_hs(?CERTIFICATE_VERIFY,<<?UINT16(_), Signature/binary>>)-> #certificate_verify{signature = Signature}; -dec_hs(?CLIENT_KEY_EXCHANGE, PKEPMS, ?KEY_EXCHANGE_RSA, {3, 0}) -> - PreSecret = #encrypted_premaster_secret{premaster_secret = PKEPMS}, - #client_key_exchange{exchange_keys = PreSecret}; -dec_hs(?CLIENT_KEY_EXCHANGE, <<?UINT16(_), PKEPMS/binary>>, - ?KEY_EXCHANGE_RSA, _) -> - PreSecret = #encrypted_premaster_secret{premaster_secret = PKEPMS}, - #client_key_exchange{exchange_keys = PreSecret}; -dec_hs(?CLIENT_KEY_EXCHANGE, <<>>, ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> - throw(?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE)); -dec_hs(?CLIENT_KEY_EXCHANGE, <<?UINT16(DH_YLen), DH_Y:DH_YLen/binary>>, - ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> - #client_key_exchange{exchange_keys = - #client_diffie_hellman_public{dh_public = DH_Y}}; -dec_hs(?FINISHED, VerifyData, _, _) -> +dec_hs(?CLIENT_KEY_EXCHANGE, PKEPMS) -> + #client_key_exchange{exchange_keys = PKEPMS}; +dec_hs(?FINISHED, VerifyData) -> #finished{verify_data = VerifyData}; -dec_hs(_, _, _, _) -> +dec_hs(_, _) -> throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). +dec_client_key(PKEPMS, ?KEY_EXCHANGE_RSA, {3, 0}) -> + #encrypted_premaster_secret{premaster_secret = PKEPMS}; +dec_client_key(<<?UINT16(_), PKEPMS/binary>>, ?KEY_EXCHANGE_RSA, _) -> + #encrypted_premaster_secret{premaster_secret = PKEPMS}; +dec_client_key(<<>>, ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> + throw(?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE)); +dec_client_key(<<?UINT16(DH_YLen), DH_Y:DH_YLen/binary>>, + ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> + #client_diffie_hellman_public{dh_public = DH_Y}. + dec_hello_extensions(<<>>) -> []; dec_hello_extensions(<<?UINT16(ExtLen), Extensions:ExtLen/binary>>) -> diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 53142250e8..c6807c7b32 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -7,7 +7,7 @@ %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% retrieved online at http://www.erlang.org/.2 %% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See @@ -1553,25 +1553,26 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> process_flag(trap_exit, true), test_server:format("Testing CipherSuite ~p~n", [CipherSuite]), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + ErlangCipherSuite = erlang_cipher_suite(CipherSuite), + + ConnectionInfo = {ok, {Version, ErlangCipherSuite}}, + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, connection_info_result, []}}, + {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {?MODULE, connection_info_result, []}}, + {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}}, {options, [{ciphers,[CipherSuite]} | ClientOpts]}]), - - ErlangCipherSuite = erlang_cipher_suite(CipherSuite), - - ServerMsg = ClientMsg = {ok, {Version, ErlangCipherSuite}}, - - Result = ssl_test_lib:wait_for_result(Server, ServerMsg, - Client, ClientMsg), + + Result = ssl_test_lib:wait_for_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), receive {'EXIT', Server, normal} -> @@ -2907,6 +2908,7 @@ send_recv_result_active_once(Socket) -> result_ok(_Socket) -> ok. + renegotiate(Socket, Data) -> test_server:format("Renegotiating ~n", []), Result = ssl:renegotiate(Socket), diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index 9553241ad4..1e7cde1c25 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -2196,21 +2196,29 @@ header_decode_two_bytes_one_sent(Config) when is_list(Config) -> %%-------------------------------------------------------------------- %% Internal functions -send_raw(_,_, 0) -> +send_raw(Socket,_, 0) -> + ssl:send(Socket, <<>>), no_result_msg; send_raw(Socket, Data, N) -> ssl:send(Socket, Data), send_raw(Socket, Data, N-1). -passive_raw(_, _, 0) -> +passive_raw(Socket, _, 0) -> + {error, timeout} = ssl:recv(Socket, 0, 500), ok; passive_raw(Socket, Data, N) -> Length = length(Data), {ok, Data} = ssl:recv(Socket, Length), passive_raw(Socket, Data, N-1). -passive_recv_packet(_, _, 0) -> - ok; +passive_recv_packet(Socket, _, 0) -> + case ssl:recv(Socket, 0) of + {ok, []} -> + {error, timeout} = ssl:recv(Socket, 0, 500), + ok; + Other -> + {other, Other, ssl:session_info(Socket), 0} + end; passive_recv_packet(Socket, Data, N) -> case ssl:recv(Socket, 0) of {ok, Data} -> @@ -2219,7 +2227,8 @@ passive_recv_packet(Socket, Data, N) -> {other, Other, ssl:session_info(Socket), N} end. -send(_,_, 0) -> +send(Socket,_, 0) -> + ssl:send(Socket, <<>>), no_result_msg; send(Socket, Data, N) -> case ssl:send(Socket, [Data]) of @@ -2233,6 +2242,7 @@ send_incomplete(Socket, Data, N) -> send_incomplete(Socket, Data, N, <<>>). send_incomplete(Socket, _Data, 0, Prev) -> ssl:send(Socket, Prev), + ssl:send(Socket, [?uint32(0)]), no_result_msg; send_incomplete(Socket, Data, N, Prev) -> Length = size(Data), @@ -2261,8 +2271,13 @@ active_once_raw(Socket, Data, N, Acc) -> end end. -active_once_packet(_,_, 0) -> - ok; +active_once_packet(Socket,_, 0) -> + receive + {ssl, Socket, []} -> + ok; + {ssl, Socket, Other} -> + {other, Other, ssl:session_info(Socket), 0} + end; active_once_packet(Socket, Data, N) -> receive {ssl, Socket, Data} -> @@ -2274,7 +2289,7 @@ active_once_packet(Socket, Data, N) -> active_raw(Socket, Data, N) -> active_raw(Socket, Data, N, []). -active_raw(_, _, 0, _) -> +active_raw(_Socket, _, 0, _) -> ok; active_raw(Socket, Data, N, Acc) -> receive @@ -2289,8 +2304,13 @@ active_raw(Socket, Data, N, Acc) -> end end. -active_packet(_, _, 0) -> - ok; +active_packet(Socket, _, 0) -> + receive + {ssl, Socket, []} -> + ok; + Other -> + {other, Other, ssl:session_info(Socket), 0} + end; active_packet(Socket, Data, N) -> receive {ssl, Socket, Data} -> diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index c7ff015034..c35178460f 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -623,3 +623,20 @@ pem_to_der(File) -> der_to_pem(File, Entries) -> PemBin = public_key:pem_encode(Entries), file:write_file(File, PemBin). + +cipher_result(Socket, Result) -> + Result = ssl:connection_info(Socket), + test_server:format("Successfull connect: ~p~n", [Result]), + %% Importante to send two packets here + %% to properly test "cipher state" handling + ssl:send(Socket, "Hello\n"), + receive + {ssl, Socket, "Hello\n"} -> + ssl:send(Socket, " world\n"), + receive + {ssl, Socket, " world\n"} -> + ok + end; + Other -> + {unexpected, Other} + end. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 75cfce0052..7f512f2ab9 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1136,17 +1136,31 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> wait_for_openssl_server(), + ConnectionInfo = {ok, {Version, CipherSuite}}, + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {?MODULE, connection_info_result, []}}, + {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}}, {options, [{ciphers,[CipherSuite]} | ClientOpts]}]), - - ClientMsg = {ok, {Version, CipherSuite}}, - - Result = ssl_test_lib:wait_for_result(Client, ClientMsg), + + port_command(OpenSslPort, "Hello\n"), + + receive + {Port, {data, _}} when is_port(Port) -> + ok + after 500 -> + test_server:format("Time out on openssl port, check that" + " the messages Hello and world are received" + " during close of port" , []), + ok + end, + + port_command(OpenSslPort, " world\n"), + + Result = ssl_test_lib:wait_for_result(Client, ok), close_port(OpenSslPort), %% Clean close down! diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 5df60a92e5..dd4a289c61 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -1385,6 +1385,28 @@ is_integer(X), is_integer(Y), X + Y < 4711]]></code> </desc> </func> <func> + <name>select_count(Tab, MatchSpec) -> NumMatched</name> + <fsummary>Match the objects in an ETS table against a match_spec and returns the number of objects for which the match_spec returned 'true'</fsummary> + <type> + <v>Tab = tid() | atom()</v> + <v>Object = tuple()</v> + <v>MatchSpec = match_spec()</v> + <v>NumMatched = integer()</v> + </type> + <desc> + <p>Matches the objects in the table <c>Tab</c> using a + <seealso marker="#match_spec">match_spec</seealso>. If the + match_spec returns <c>true</c> for an object, that object + considered a match and is counted. For any other result from + the match_spec the object is not considered a match and is + therefore not counted.</p> + <p>The function could be described as a <c>match_delete/2</c> + that does not actually delete any elements, but only counts + them.</p> + <p>The function returns the number of objects matched.</p> + </desc> + </func> + <func> <name>select_delete(Tab, MatchSpec) -> NumDeleted</name> <fsummary>Match the objects in an ETS table against a match_spec and deletes objects where the match_spec returns 'true'</fsummary> <type> @@ -1411,25 +1433,82 @@ is_integer(X), is_integer(Y), X + Y < 4711]]></code> </desc> </func> <func> - <name>select_count(Tab, MatchSpec) -> NumMatched</name> - <fsummary>Match the objects in an ETS table against a match_spec and returns the number of objects for which the match_spec returned 'true'</fsummary> + <name>select_reverse(Tab, MatchSpec) -> [Match]</name> + <fsummary>Match the objects in an ETS table against a match_spec.</fsummary> <type> <v>Tab = tid() | atom()</v> - <v>Object = tuple()</v> + <v>Match = term()</v> <v>MatchSpec = match_spec()</v> - <v>NumMatched = integer()</v> </type> <desc> - <p>Matches the objects in the table <c>Tab</c> using a - <seealso marker="#match_spec">match_spec</seealso>. If the - match_spec returns <c>true</c> for an object, that object - considered a match and is counted. For any other result from - the match_spec the object is not considered a match and is - therefore not counted.</p> - <p>The function could be described as a <c>match_delete/2</c> - that does not actually delete any elements, but only counts - them.</p> - <p>The function returns the number of objects matched.</p> + + <p>Works like <c>select/2</c>, but returns the list in reverse + order for the <c>ordered_set</c> table type. For all other table + types, the return value is identical to that of <c>select/2</c>.</p> + + </desc> + </func> + <func> + <name>select_reverse(Tab, MatchSpec, Limit) -> {[Match],Continuation} | '$end_of_table'</name> + <fsummary>Match the objects in an ETS table against a match_spec and returns part of the answers.</fsummary> + <type> + <v>Tab = tid() | atom()</v> + <v>Match = term()</v> + <v>MatchSpec = match_spec()</v> + <v>Continuation = term()</v> + </type> + <desc> + + <p>Works like <c>select/3</c>, but for the <c>ordered_set</c> + table type, traversing is done starting at the last object in + Erlang term order and moves towards the first. For all other + table types, the return value is identical to that of + <c>select/3</c>.</p> + + <p>Note that this is <em>not</em> equivalent to + reversing the result list of a <c>select/3</c> call, as the result list + is not only reversed, but also contains the last <c>Limit</c> + matching objects in the table, not the first.</p> + + </desc> + </func> + <func> + <name>select_reverse(Continuation) -> {[Match],Continuation} | '$end_of_table'</name> + <fsummary>Continue matching objects in an ETS table.</fsummary> + <type> + <v>Match = term()</v> + <v>Continuation = term()</v> + </type> + <desc> + + <p>Continues a match started with + <c>ets:select_reverse/3</c>. If the table is an + <c>ordered_set</c>, the traversal of the table will continue + towards objects with keys earlier in the Erlang term order. The + returned list will also contain objects with keys in reverse + order.</p> + + <p>For all other table types, the behaviour is exatly that of <c>select/1</c>.</p> + <p>Example:</p> + <code> +1> T = ets:new(x,[ordered_set]). +2> [ ets:insert(T,{N}) || N <- lists:seq(1,10) ]. +... +3> {R0,C0} = ets:select_reverse(T,[{'_',[],['$_']}],4). +... +4> R0. +[{10},{9},{8},{7}] +5> {R1,C1} = ets:select_reverse(C0). +... +6> R1. +[{6},{5},{4},{3}] +7> {R2,C2} = ets:select_reverse(C1). +... +8> R2. +[{2},{1}] +9> '$end_of_table' = ets:select_reverse(C2). +... + </code> </desc> </func> <func> diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 78b1de6e16..a249dea525 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -43,6 +43,7 @@ -define(ERR_GENREMOTECALL,22). -define(ERR_GENBINCONSTRUCT,23). -define(ERR_GENDISALLOWEDOP,24). +-define(WARN_SHADOW_VAR,50). -define(ERR_GUARDMATCH,?ERR_GENMATCH+?ERROR_BASE_GUARD). -define(ERR_BODYMATCH,?ERR_GENMATCH+?ERROR_BASE_BODY). -define(ERR_GUARDLOCALCALL,?ERR_GENLOCALCALL+?ERROR_BASE_GUARD). @@ -63,8 +64,13 @@ -define(ERR_BODYDISALLOWEDOP,?ERR_GENDISALLOWEDOP+?ERROR_BASE_BODY). %% -%% Called by compiler or ets/dbg:fun2ms when errors occur +%% Called by compiler or ets/dbg:fun2ms when errors/warnings occur %% +format_error({?WARN_SHADOW_VAR,Name}) -> + lists:flatten( + io_lib:format("variable ~p shadowed in ms_transform fun head", + [Name])); + format_error(?ERR_NOFUN) -> "Parameter of ets/dbg:fun2ms/1 is not a literal fun"; format_error(?ERR_ETS_HEAD) -> @@ -182,7 +188,7 @@ format_error(Else) -> %% transform_from_shell(Dialect, Clauses, BoundEnvironment) -> SaveFilename = setup_filename(), - case catch ms_clause_list(1,Clauses,Dialect) of + case catch ms_clause_list(1,Clauses,Dialect,gb_sets:new()) of {'EXIT',Reason} -> cleanup_filename(SaveFilename), exit(Reason); @@ -207,6 +213,7 @@ transform_from_shell(Dialect, Clauses, BoundEnvironment) -> %% parse_transform(Forms, _Options) -> SaveFilename = setup_filename(), + %io:format("Forms: ~p~n",[Forms]), case catch forms(Forms) of {'EXIT',Reason} -> cleanup_filename(SaveFilename), @@ -215,12 +222,31 @@ parse_transform(Forms, _Options) -> {error, [{cleanup_filename(SaveFilename), [{Line, ?MODULE, R}]}], []}; Else -> - cleanup_filename(SaveFilename), + %io:format("Transformed into: ~p~n",[Else]), + case get_warnings() of + [] -> + cleanup_filename(SaveFilename), + Else; + WL -> + FName = cleanup_filename(SaveFilename) , + WList = [ {FName, [{L, ?MODULE, R}]} || {L,R} <- WL ], + {warning, Else, WList} + end + end. + +get_warnings() -> + case get(warnings) of + undefined -> + []; + Else -> Else end. +add_warning(Line,R) -> + put(warnings,[{Line,R}| get_warnings()]). + setup_filename() -> - {erase(filename),erase(records)}. + {erase(filename),erase(records),erase(warnings)}. put_filename(Name) -> put(filename,Name). @@ -235,7 +261,7 @@ get_records() -> Else -> Else end. -cleanup_filename({Old,OldRec}) -> +cleanup_filename({Old,OldRec,OldWarnings}) -> Ret = case erase(filename) of undefined -> "TOP_LEVEL"; @@ -248,6 +274,12 @@ cleanup_filename({Old,OldRec}) -> Rec -> put(records,Rec) end, + case OldWarnings of + undefined -> + erase(warnings); + Warn -> + put(warnings,Warn) + end, case Old of undefined -> Ret; @@ -285,42 +317,77 @@ form({function,Line,Name0,Arity0,Clauses0}) -> form(AnyOther) -> AnyOther. function(Name, Arity, Clauses0) -> - Clauses1 = clauses(Clauses0), + {Clauses1,_} = clauses(Clauses0,gb_sets:new()), {Name,Arity,Clauses1}. -clauses([C0|Cs]) -> - C1 = clause(C0), - [C1|clauses(Cs)]; -clauses([]) -> []. -clause({clause,Line,H0,G0,B0}) -> - B1 = copy(B0), - {clause,Line,H0,G0,B1}. +clauses([C0|Cs],Bound) -> + {C1,Bound1} = clause(C0,Bound), + {C2,Bound2} = clauses(Cs,Bound1), + {[C1|C2],Bound2}; +clauses([],Bound) -> {[],Bound}. +clause({clause,Line,H0,G0,B0},Bound) -> + {H1,Bound1} = copy(H0,Bound), + {B1,Bound2} = copy(B0,Bound1), + {{clause,Line,H1,G0,B1},Bound2}. copy({call,Line,{remote,_Line2,{atom,_Line3,ets},{atom,_Line4,fun2ms}}, - As0}) -> - transform_call(ets,Line,As0); + As0},Bound) -> + {transform_call(ets,Line,As0,Bound),Bound}; copy({call,Line,{remote,_Line2,{record_field,_Line3, {atom,_Line4,''},{atom,_Line5,ets}}, - {atom,_Line6,fun2ms}}, As0}) -> + {atom,_Line6,fun2ms}}, As0},Bound) -> %% Packages... - transform_call(ets,Line,As0); + {transform_call(ets,Line,As0,Bound),Bound}; copy({call,Line,{remote,_Line2,{atom,_Line3,dbg},{atom,_Line4,fun2ms}}, - As0}) -> - transform_call(dbg,Line,As0); -copy(T) when is_tuple(T) -> - list_to_tuple(copy_list(tuple_to_list(T))); -copy(L) when is_list(L) -> - copy_list(L); -copy(AnyOther) -> - AnyOther. + As0},Bound) -> + {transform_call(dbg,Line,As0,Bound),Bound}; +copy({match,Line,A,B},Bound) -> + {B1,Bound1} = copy(B,Bound), + {A1,Bound2} = copy(A,Bound), + {{match,Line,A1,B1},gb_sets:union(Bound1,Bound2)}; +copy({var,_Line,'_'} = VarDef,Bound) -> + {VarDef,Bound}; +copy({var,_Line,Name} = VarDef,Bound) -> + Bound1 = gb_sets:add(Name,Bound), + {VarDef,Bound1}; +copy({'fun',Line,{clauses,Clauses}},Bound) -> % Dont export bindings from funs + {NewClauses,_IgnoredBindings} = copy_list(Clauses,Bound), + {{'fun',Line,{clauses,NewClauses}},Bound}; +copy({'case',Line,Of,ClausesList},Bound) -> % Dont export bindings from funs + {NewOf,NewBind0} = copy(Of,Bound), + {NewClausesList,NewBindings} = copy_case_clauses(ClausesList,NewBind0,[]), + {{'case',Line,NewOf,NewClausesList},NewBindings}; +copy(T,Bound) when is_tuple(T) -> + {L,Bound1} = copy_list(tuple_to_list(T),Bound), + {list_to_tuple(L),Bound1}; +copy(L,Bound) when is_list(L) -> + copy_list(L,Bound); +copy(AnyOther,Bound) -> + {AnyOther,Bound}. -copy_list([H|T]) -> - [copy(H)|copy_list(T)]; -copy_list([]) -> - []. +copy_case_clauses([],Bound,AddSets) -> + ReallyAdded = gb_sets:intersection(AddSets), + {[],gb_sets:union(Bound,ReallyAdded)}; +copy_case_clauses([{clause,Line,Match,Guard,Clauses}|T],Bound,AddSets) -> + {NewMatch,MatchBinds} = copy(Match,Bound), + {NewGuard,GuardBinds} = copy(Guard,MatchBinds), %% Really no new binds + {NewClauses,AllBinds} = copy(Clauses,GuardBinds), + %% To limit the setsizes, I subtract what I had before the case clause + %% and add it in the end + AddedBinds = gb_sets:subtract(AllBinds,Bound), + {NewTail,ExportedBindings} = + copy_case_clauses(T,Bound,[AddedBinds | AddSets]), + {[{clause,Line,NewMatch,NewGuard,NewClauses}|NewTail],ExportedBindings}. -transform_call(Type,_Line,[{'fun',Line2,{clauses, ClauseList}}]) -> - ms_clause_list(Line2, ClauseList,Type); -transform_call(_Type,Line,_NoAbstractFun) -> +copy_list([H|T],Bound) -> + {C1,Bound1} = copy(H,Bound), + {C2,Bound2} = copy_list(T,Bound1), + {[C1|C2],Bound2}; +copy_list([],Bound) -> + {[],Bound}. + +transform_call(Type,_Line,[{'fun',Line2,{clauses, ClauseList}}],Bound) -> + ms_clause_list(Line2, ClauseList,Type,Bound); +transform_call(_Type,Line,_NoAbstractFun,_) -> throw({error,Line,?ERR_NOFUN}). % Fixup semicolons in guards @@ -329,18 +396,19 @@ ms_clause_expand({clause, Line, Parameters, Guard = [_,_|_], Body}) -> ms_clause_expand(_Other) -> false. -ms_clause_list(Line,[H|T],Type) -> +ms_clause_list(Line,[H|T],Type,Bound) -> case ms_clause_expand(H) of NewHead when is_list(NewHead) -> - ms_clause_list(Line,NewHead ++ T, Type); + ms_clause_list(Line,NewHead ++ T, Type, Bound); false -> - {cons, Line, ms_clause(H,Type), ms_clause_list(Line, T,Type)} + {cons, Line, ms_clause(H, Type, Bound), + ms_clause_list(Line, T, Type, Bound)} end; -ms_clause_list(Line,[],_) -> +ms_clause_list(Line,[],_,_) -> {nil,Line}. -ms_clause({clause, Line, Parameters, Guards, Body},Type) -> +ms_clause({clause, Line, Parameters, Guards, Body},Type,Bound) -> check_type(Line,Parameters,Type), - {MSHead,Bindings} = transform_head(Parameters), + {MSHead,Bindings} = transform_head(Parameters,Bound), MSGuards = transform_guards(Line, Guards, Bindings), MSBody = transform_body(Line,Body,Bindings), {tuple, Line, [MSHead,MSGuards,MSBody]}. @@ -627,29 +695,31 @@ tg(Other,B) -> Element = io_lib:format("unknown element ~w", [Other]), throw({error,unknown,{?ERR_GENELEMENT+B#tgd.eb,Element}}). -transform_head([V]) -> +transform_head([V],OuterBound) -> Bind = cre_bind(), - {NewV,NewBind} = toplevel_head_match(V,Bind), - th(NewV,NewBind). + {NewV,NewBind} = toplevel_head_match(V,Bind,OuterBound), + th(NewV,NewBind,OuterBound). -toplevel_head_match({match,_,{var,_,VName},Expr},B) -> +toplevel_head_match({match,Line,{var,_,VName},Expr},B,OB) -> + warn_var_clash(Line,VName,OB), {Expr,new_bind({VName,'$_'},B)}; -toplevel_head_match({match,_,Expr,{var,_,VName}},B) -> +toplevel_head_match({match,Line,Expr,{var,_,VName}},B,OB) -> + warn_var_clash(Line,VName,OB), {Expr,new_bind({VName,'$_'},B)}; -toplevel_head_match(Other,B) -> +toplevel_head_match(Other,B,_OB) -> {Other,B}. -th({record,Line,RName,RFields},B) -> +th({record,Line,RName,RFields},B,OB) -> % youch... RDefs = get_records(), {KeyList0,NewB} = lists:foldl(fun({record_field,_,{atom,_,Key},Value}, {L,B0}) -> - {NV,B1} = th(Value,B0), + {NV,B1} = th(Value,B0,OB), {[{Key,NV}|L],B1}; ({record_field,_,{var,_,'_'},Value}, {L,B0}) -> - {NV,B1} = th(Value,B0), + {NV,B1} = th(Value,B0,OB), {[{{default},NV}|L],B1}; (_,_) -> throw({error,Line,{?ERR_HEADBADREC, @@ -692,9 +762,9 @@ th({record,Line,RName,RFields},B) -> _ -> throw({error,Line,{?ERR_HEADBADREC,RName}}) end; -th({match,Line,_,_},_) -> +th({match,Line,_,_},_,_) -> throw({error,Line,?ERR_HEADMATCH}); -th({atom,Line,A},B) -> +th({atom,Line,A},B,_OB) -> case atom_to_list(A) of [$$|NL] -> case (catch list_to_integer(NL)) of @@ -706,10 +776,11 @@ th({atom,Line,A},B) -> _ -> {{atom,Line,A},B} end; -th({bin_element,_Line0,{var, Line, A},_,_},_) -> +th({bin_element,_Line0,{var, Line, A},_,_},_,_) -> throw({error,Line,{?ERR_HEADBINMATCH,A}}); -th({var,Line,Name},B) -> +th({var,Line,Name},B,OB) -> + warn_var_clash(Line,Name,OB), case lkup_bind(Name,B) of undefined -> NewB = new_bind(Name,B), @@ -717,16 +788,24 @@ th({var,Line,Name},B) -> Trans -> {{atom,Line,Trans},B} end; -th([H|T],B) -> - {NH,NB} = th(H,B), - {NT,NNB} = th(T,NB), +th([H|T],B,OB) -> + {NH,NB} = th(H,B,OB), + {NT,NNB} = th(T,NB,OB), {[NH|NT],NNB}; -th(T,B) when is_tuple(T) -> - {L,NB} = th(tuple_to_list(T),B), +th(T,B,OB) when is_tuple(T) -> + {L,NB} = th(tuple_to_list(T),B,OB), {list_to_tuple(L),NB}; -th(Nonstruct,B) -> +th(Nonstruct,B,_OB) -> {Nonstruct,B}. +warn_var_clash(Line,Name,OuterBound) -> + case gb_sets:is_member(Name,OuterBound) of + true -> + add_warning(Line,{?WARN_SHADOW_VAR,Name}); + _ -> + ok + end. + %% Could be more efficient... check_multi_field(_, _, [], _) -> ok; diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 5d7e558601..7f39dbe21f 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -94,6 +94,8 @@ do_heavy_concurrent/1 ]). +-export([t_select_reverse/1]). + -include("test_server.hrl"). init_per_testcase(Case, Config) -> @@ -128,7 +130,7 @@ all(suite) -> match_heavy, fold, member, t_delete_object, t_init_table, t_whitebox, t_delete_all_objects, t_insert_list, t_test_ms, - t_select_delete, t_ets_dets, memory, + t_select_delete, t_ets_dets, memory, t_select_reverse, t_bucket_disappears, select_fail,t_insert_new, t_repair_continuation, otp_5340, otp_6338, otp_6842_select_1000, otp_7665, otp_8732, @@ -393,7 +395,7 @@ memory(Config) when is_list(Config) -> ?line erts_debug:set_internal_state(available_internal_state, true), ?line ok = chk_normal_tab_struct_size(), ?line L = [T1,T2,T3,T4] = fill_sets_int(1000), - ?line XRes1 = adjust_xmem(L, {14862,14072,14072,14078}), + ?line XRes1 = adjust_xmem(L, {13862,13072,13072,13078}), ?line Res1 = {?S(T1),?S(T2),?S(T3),?S(T4)}, ?line lists:foreach(fun(T) -> Before = ets:info(T,size), @@ -404,7 +406,7 @@ memory(Config) when is_list(Config) -> [Key, ets:info(T,type), Before, ets:info(T,size), Objs]) end, L), - ?line XRes2 = adjust_xmem(L, {14851,14062,14052,14058}), + ?line XRes2 = adjust_xmem(L, {13852,13063,13054,13060}), ?line Res2 = {?S(T1),?S(T2),?S(T3),?S(T4)}, ?line lists:foreach(fun(T) -> Before = ets:info(T,size), @@ -415,7 +417,7 @@ memory(Config) when is_list(Config) -> [Key, ets:info(T,type), Before, ets:info(T,size), Objs]) end, L), - ?line XRes3 = adjust_xmem(L, {14840,14052,14032,14038}), + ?line XRes3 = adjust_xmem(L, {13842,13054,13036,13042}), ?line Res3 = {?S(T1),?S(T2),?S(T3),?S(T4)}, ?line lists:foreach(fun(T) -> ?line ets:delete_all_objects(T) @@ -788,6 +790,67 @@ t_test_ms(Config) when is_list(Config) -> ?line true = (if is_list(String) -> true; true -> false end), ?line verify_etsmem(EtsMem). +t_select_reverse(doc) -> + ["Test the select reverse BIF's"]; +t_select_reverse(suite) -> + []; +t_select_reverse(Config) when is_list(Config) -> + ?line Table = ets:new(xxx, [ordered_set]), + ?line filltabint(Table,1000), + ?line A = lists:reverse(ets:select(Table,[{{'$1', '_'}, + [{'>', + {'rem', + '$1', 5}, + 2}], + ['$_']}])), + ?line A = ets:select_reverse(Table,[{{'$1', '_'}, + [{'>', + {'rem', + '$1', 5}, + 2}], + ['$_']}]), + ?line A = reverse_chunked(Table,[{{'$1', '_'}, + [{'>', + {'rem', + '$1', 5}, + 2}], + ['$_']}],3), + % A set/bag/duplicate_bag should get the same result regardless + % of select or select_reverse + ?line Table2 = ets:new(xxx, [set]), + ?line filltabint(Table2,1000), + ?line Table3 = ets:new(xxx, [bag]), + ?line filltabint(Table3,1000), + ?line Table4 = ets:new(xxx, [duplicate_bag]), + ?line filltabint(Table4,1000), + ?line lists:map(fun(Tab) -> + B = ets:select(Tab,[{{'$1', '_'}, + [{'>', + {'rem', + '$1', 5}, + 2}], + ['$_']}]), + B = ets:select_reverse(Tab,[{{'$1', '_'}, + [{'>', + {'rem', + '$1', 5}, + 2}], + ['$_']}]) + end,[Table2, Table3, Table4]), + ok. + + + +reverse_chunked(T,MS,N) -> + do_reverse_chunked(ets:select_reverse(T,MS,N),[]). + +do_reverse_chunked('$end_of_table',Acc) -> + lists:reverse(Acc); +do_reverse_chunked({L,C},Acc) -> + NewAcc = lists:reverse(L)++Acc, + do_reverse_chunked(ets:select_reverse(C), NewAcc). + + t_select_delete(doc) -> ["Test the ets:select_delete/2 and ets:select_count/2 BIF's"]; t_select_delete(suite) -> @@ -3942,7 +4005,7 @@ do_lookup_element(Tab, N, M) -> end. -heavy_concurrent(Config) -> +heavy_concurrent(_Config) -> repeat_for_opts(do_heavy_concurrent). do_heavy_concurrent(Opts) -> @@ -3961,7 +4024,7 @@ do_heavy_concurrent(Opts) -> ?line lists:foreach(fun (P) -> M = erlang:monitor(process, P), receive - {'DOWN', Mon, process, P, _} -> + {'DOWN', M, process, P, _} -> ok end end, diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl index 79a0a9af89..2d90d5b823 100644 --- a/lib/stdlib/test/ms_transform_SUITE.erl +++ b/lib/stdlib/test/ms_transform_SUITE.erl @@ -37,6 +37,7 @@ -export([andalso_orelse/1]). -export([float_1_function/1]). -export([action_function/1]). +-export([warnings/1]). -export([init_per_testcase/2, fin_per_testcase/2]). init_per_testcase(_Func, Config) -> @@ -50,8 +51,90 @@ fin_per_testcase(_Func, Config) -> all(suite) -> [from_shell,basic_ets,basic_dbg,records,record_index,multipass, bitsyntax, record_defaults, andalso_orelse, float_1_function, action_function, + warnings, top_match, old_guards, autoimported, semicolon]. +%% This may be subject to change +-define(WARN_NUMBER_SHADOW,50). +warnings(suite) -> + []; +warnings(doc) -> + ["Check that shadowed variables in fun head generate warning"]; +warnings(Config) when is_list(Config) -> + ?line setup(Config), + Prog = <<"A=5, " + "ets:fun2ms(fun({A,B}) " + " when is_integer(A) and (A+5 > B) -> " + " A andalso B " + " end)">>, + ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}}]}] = + compile_ww(Prog), + Prog2 = <<"C=5, " + "ets:fun2ms(fun({A,B} = C) " + " when is_integer(A) and (A+5 > B) -> " + " {A andalso B,C} " + " end)">>, + ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] = + compile_ww(Prog2), + Rec3 = <<"-record(a,{a,b,c,d=foppa}).">>, + Prog3 = <<"A=3,C=5, " + "ets:fun2ms(fun(#a{a = A, b = B} = C) " + " when is_integer(A) and (A+5 > B) -> " + " {A andalso B,C} " + " end)">>, + ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}}, + {_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] = + compile_ww(Rec3,Prog3), + Rec4 = <<"-record(a,{a,b,c,d=foppa}).">>, + Prog4 = <<"A=3,C=5, " + "F = fun(B) -> B*3 end," + "erlang:display(F(A))," + "ets:fun2ms(fun(#a{a = A, b = B} = C) " + " when is_integer(A) and (A+5 > B) -> " + " {A andalso B,C} " + " end)">>, + ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}}, + {_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] = + compile_ww(Rec4,Prog4), + Rec5 = <<"-record(a,{a,b,c,d=foppa}).">>, + Prog5 = <<"A=3,C=5, " + "F = fun(B) -> B*3 end," + "erlang:display(F(A))," + "B = ets:fun2ms(fun(#a{a = A, b = B} = C) " + " when is_integer(A) and (A+5 > B) -> " + " {A andalso B,C} " + " end)">>, + ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}}, + {_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] = + compile_ww(Rec5,Prog5), + Prog6 = <<" X=bar, " + " A = case X of" + " foo ->" + " foo;" + " Y ->" + " ets:fun2ms(fun(Y) ->" % This is a warning + " 3*Y" + " end)" + " end," + " ets:fun2ms(fun(Y) ->" % Y out of "scope" here, so no warning + " {3*Y,A}" + " end)">>, + ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'Y'}}]}] = + compile_ww(Prog6), + Prog7 = <<" X=bar, " + " A = case X of" + " foo ->" + " Y = foo;" + " Y ->" + " bar" + " end," + " ets:fun2ms(fun(Y) ->" % Y exported from case and safe, so warn + " {3*Y,A}" + " end)">>, + ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'Y'}}]}] = + compile_ww(Prog7), + ok. + andalso_orelse(suite) -> []; andalso_orelse(doc) -> @@ -721,6 +804,24 @@ compile_and_run(Records,Expr) -> code:load_binary(tmp,FN,Bin), tmp:tmp(). +compile_ww(Expr) -> + compile_ww(<<>>,Expr). +compile_ww(Records,Expr) -> + Prog = << + "-module(tmp).\n", + "-include_lib(\"stdlib/include/ms_transform.hrl\").\n", + "-export([tmp/0]).\n", + Records/binary,"\n", + "tmp() ->\n", + Expr/binary,".\n">>, + FN=temp_name(), + file:write_file(FN,Prog), + {ok,Forms} = epp:parse_file(FN,"",""), + {ok,tmp,_Bin,Wlist} = compile:forms(Forms,[return_warnings, + nowarn_unused_vars, + nowarn_unused_record]), + Wlist. + do_eval(String) -> {done,{ok,T,_},[]} = erl_scan:tokens( [], diff --git a/lib/xmerl/src/xmerl_dtd.erl b/lib/xmerl/src/xmerl_dtd.erl deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/xmerl/src/xmerl_dtd.erl +++ /dev/null diff --git a/system/doc/top/Makefile b/system/doc/top/Makefile index 154deb006b..148fefaf13 100644 --- a/system/doc/top/Makefile +++ b/system/doc/top/Makefile @@ -111,6 +111,10 @@ GLOSSARY = $(HTMLDIR)/glossary.html GLOSSARY_SRC = $(ERL_TOP)/system/internal_tools/doctools/src/glossary.erl GLOSSARY_SCRIPT = $(EBIN)/glossary.$(EMULATOR) +TEMPLATES = \ + templates/index.html.src \ + templates/applications.html.src + #-------------------------------------------------------------------------- $(INDEX_SCRIPT): $(INDEX_SRC) @@ -119,8 +123,14 @@ $(INDEX_SCRIPT): $(INDEX_SRC) # We don't list toc_*.html as targets because we don't know $(HTMLDIR)/index.html + $(HTMLDIR)/applications.html: $(INDEX_SCRIPT) echo "Generating index $@" - $(ERL) -noshell -pa $(EBIN) -s erl_html_tools top_index $(ERL_TOP) \ - $(HTMLDIR) $(SYSTEM_VSN) -s erlang halt +# Check if we are building the index from source or an installed release + if test "$$RELEASE_ROOT" = "" ; then \ + $(ERL) -noshell -pa $(EBIN) -s erl_html_tools top_index src $(ERL_TOP) \ + $(HTMLDIR) $(SYSTEM_VSN) -s erlang halt ;\ + else \ + $(ERL) -noshell -pa $(EBIN) -s erl_html_tools top_index rel $(RELEASE_ROOT) \ + $(HTMLDIR) $(SYSTEM_VSN) -s erlang halt ;\ + fi #-------------------------------------------------------------------------- @@ -139,8 +149,15 @@ $(MAN_INDEX_SCRIPT): $(MAN_INDEX_SRC) $(ERLC) -o$(EBIN) +warn_unused_vars $< $(MAN_INDEX): $(MAN_INDEX_SCRIPT) - $(ERL) -noshell -pa $(EBIN) -s otp_man_index gen $(ERL_TOP) $@ \ - -s erlang halt +# Check if we are building the index from source or an installed release + if test "$$RELEASE_ROOT" = "" ; then \ + $(ERL) -noshell -pa $(EBIN) -s otp_man_index gen src $(ERL_TOP) $@ \ + -s erlang halt ;\ + else \ + $(ERL) -noshell -pa $(EBIN) -s otp_man_index gen rel $(RELEASE_ROOT) $@ \ + -s erlang halt ;\ + fi + #-------------------------------------------------------------------------- @@ -226,7 +243,11 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/js $(INSTALL_DATA) \ $(JAVASCRIPT) $(RELSYSDIR)/js - $(INSTALL_DATA) $(INDEX_FILES) $(MAN_INDEX) $(TOP_HTML_FILES) $(RELSYSDIR) + $(INSTALL_DATA) $(INDEX_FILES) $(MAN_INDEX) $(TOP_HTML_FILES) $(RELSYSDIR) + $(INSTALL_DIR) $(RELSYSDIR)/docbuild + $(INSTALL_DATA) $(INDEX_SCRIPT) $(MAN_INDEX_SCRIPT) $(JAVASCRIPT_BUILD_SCRIPT) \ + $(INDEX_SCRIPT_SRC) $(MAN_INDEX_SCRIPT_SRC) $(JAVASCRIPT_BUILD_SCRIPT_SRC) \ + $(TEMPLATES) $(RELSYSDIR)/docbuild release_spec: diff --git a/system/doc/top/src/erl_html_tools.erl b/system/doc/top/src/erl_html_tools.erl index c920245f94..fef56331fc 100644 --- a/system/doc/top/src/erl_html_tools.erl +++ b/system/doc/top/src/erl_html_tools.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(erl_html_tools). --export([top_index/0,top_index/1,top_index/3,top_index_silent/3]). +-export([top_index/0,top_index/1,top_index/4,top_index_silent/3]). -include_lib("kernel/include/file.hrl"). @@ -49,19 +49,22 @@ top_index() -> io:format("Variable ERL_TOP is required\n",[]); Value -> {_,RelName} = init:script_id(), - top_index(Value, filename:join(Value, "doc"), RelName) + top_index(src, Value, filename:join(Value, "doc"), RelName) end. -top_index([RootDir, DestDir, OtpRel]) +top_index([src, RootDir, DestDir, OtpRel]) when is_atom(RootDir), is_atom(DestDir), is_atom(OtpRel) -> - top_index(atom_to_list(RootDir), atom_to_list(DestDir), atom_to_list(OtpRel)); -top_index(RootDir) when is_atom(RootDir) -> + top_index(src, atom_to_list(RootDir), atom_to_list(DestDir), atom_to_list(OtpRel)); +top_index([rel, RootDir, DestDir, OtpRel]) + when is_atom(RootDir), is_atom(DestDir), is_atom(OtpRel) -> + top_index(rel, atom_to_list(RootDir), atom_to_list(DestDir), atom_to_list(OtpRel)); +top_index(RootDir) when is_atom(RootDir) -> {_,RelName} = init:script_id(), - top_index(RootDir, filename:join(RootDir, "doc"), RelName). + top_index(rel, RootDir, filename:join(RootDir, "doc"), RelName). -top_index(RootDir, DestDir, OtpRel) -> +top_index(Source, RootDir, DestDir, OtpRel) -> report("****\nRootDir: ~p", [RootDir]), report("****\nDestDir: ~p", [DestDir]), report("****\nOtpRel: ~p", [OtpRel]), @@ -72,13 +75,13 @@ top_index(RootDir, DestDir, OtpRel) -> report("****\nTemplates: ~p", [Templates]), Bases = [{"../lib/", filename:join(RootDir,"lib")}, {"../", RootDir}], - Groups = find_information(Bases), + Groups = find_information(Source, Bases), report("****\nGroups: ~p", [Groups]), process_templates(Templates, DestDir, Groups). top_index_silent(RootDir, DestDir, OtpRel) -> put(silent,true), - Result = top_index(RootDir, DestDir, OtpRel), + Result = top_index(rel, RootDir, DestDir, OtpRel), erase(silent), Result. @@ -159,8 +162,8 @@ find_templates([], AllSearchPaths) -> % This function read all application names and if present all "info" files. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -find_information(Bases) -> - Paths = find_application_paths(Bases), +find_information(Source, Bases) -> + Paths = find_application_paths(Source, Bases), % report("****\nPaths: ~p", [Paths]), Apps = find_application_infos(Paths), % report("****\nApps: ~p", [Apps]), @@ -176,35 +179,47 @@ find_information(Bases) -> % % We know URL ends in a slash. -find_application_paths([]) -> +find_application_paths(_, []) -> []; -find_application_paths([{URL, Dir} | Paths]) -> +find_application_paths(Source, [{URL, Dir} | Paths]) -> + + AppDirs = get_app_dirs(Dir), + AppPaths = get_app_paths(Source, AppDirs, URL), + AppPaths ++ find_application_paths(Source, Paths). + + +get_app_paths(src, AppDirs, URL) -> Sub1 = "doc/html/index.html", %% Sub2 = "doc/index.html", + lists:map( + fun({App, AppPath}) -> + VsnFile = filename:join(AppPath, "vsn.mk"), + VsnStr = + case file:read_file(VsnFile) of + {ok, Bin} -> + case re:run(Bin, ".*VSN\s*=\s*([0-9\.]+).*",[{capture,[1],list}]) of + {match, [V]} -> + V; + nomatch -> + exit(io_lib:format("No VSN variable found in ~s\n", + [VsnFile])) + end; + {error, Reason} -> + exit(io_lib:format("~p : ~s\n", [Reason, VsnFile])) + end, + AppURL = URL ++ App ++ "-" ++ VsnStr, + {App, VsnStr, AppPath, AppURL ++ "/" ++ Sub1} + end, AppDirs); +get_app_paths(rel, AppDirs, URL) -> + Sub1 = "doc/html/index.html", +%% Sub2 = "doc/index.html", + lists:map( + fun({App, AppPath}) -> + [AppName, VsnStr] = string:tokens(App, "-"), + AppURL = URL ++ App, + {AppName, VsnStr, AppPath, AppURL ++ "/" ++ Sub1} + end, AppDirs). - AppDirs = get_app_dirs(Dir), - - AppPaths = - lists:map( - fun({App, AppPath}) -> - VsnFile = filename:join(AppPath, "vsn.mk"), - VsnStr = - case file:read_file(VsnFile) of - {ok, Bin} -> - case re:run(Bin, ".*VSN\s*=\s*([0-9\.]+).*",[{capture,[1],list}]) of - {match, [V]} -> - V; - nomatch -> - exit(io_lib:format("No VSN variable found in ~s\n", - [VsnFile])) - end; - {error, Reason} -> - exit(io_lib:format("~p : ~s\n", [Reason, VsnFile])) - end, - AppURL = URL ++ App ++ "-" ++ VsnStr, - {App, VsnStr, AppPath, AppURL ++ "/" ++ Sub1} - end, AppDirs), - AppPaths ++ find_application_paths(Paths). get_app_dirs(Dir) -> {ok, Files} = file:list_dir(Dir), @@ -212,7 +227,7 @@ get_app_dirs(Dir) -> lists:map(fun(File) -> {File, filename:join([Dir, File])} end, Files), lists:zf(fun is_app_with_doc/1, AFiles). -is_app_with_doc({"." ++ ADir, _APath}) -> +is_app_with_doc({"." ++ _ADir, _APath}) -> false; is_app_with_doc({ADir, APath}) -> case file:read_file_info(filename:join([APath, "info"])) of diff --git a/system/doc/top/src/otp_man_index.erl b/system/doc/top/src/otp_man_index.erl index 0fdc531b37..4ad975c53d 100644 --- a/system/doc/top/src/otp_man_index.erl +++ b/system/doc/top/src/otp_man_index.erl @@ -27,14 +27,20 @@ -module(otp_man_index). --export([gen/1]). +-export([gen/1, gen/2]). -include_lib("kernel/include/file.hrl"). -gen([RootDir, OutFile]) when is_atom(RootDir), is_atom(OutFile)-> +gen([Source, RootDir, OutFile]) when is_atom(RootDir), is_atom(OutFile)-> + gen(Source, RootDir, OutFile). + +gen(RootDir, OutFile) -> + gen(rel, RootDir, OutFile). + +gen(Source, RootDir, OutFile) -> Bases = [{"../lib/", filename:join(RootDir, "lib")}, {"../", RootDir}], - Apps = find_application_paths(Bases), + Apps = find_application_paths(Source, Bases), RefPages = find_ref_files(Apps), gen_html(RefPages, atom_to_list(OutFile)). @@ -81,43 +87,52 @@ find_ref_files([{App, Vsn, AppPath, RelPath} |Apps], Acc) -> find_ref_files(Apps, Refs2 ++ Acc) end. -find_application_paths([]) -> +find_application_paths(_, []) -> []; -find_application_paths([{URL, Dir} | Paths]) -> - Sub1 = "doc/html", +find_application_paths(Source, [{URL, Dir} | Paths]) -> AppDirs = get_app_dirs(Dir), - - AppPaths = - lists:map( - fun({App, AppPath}) -> - VsnFile = filename:join(AppPath, "vsn.mk"), - VsnStr = - case file:read_file(VsnFile) of - {ok, Bin} -> - case re:run(Bin, ".*VSN\s*=\s*([0-9\.]+).*",[{capture,[1],list}]) of - {match, [V]} -> - V; - nomatch -> - exit(io_lib:format("No VSN variable found in ~s\n", - [VsnFile])) - end; - {error, Reason} -> - exit(io_lib:format("~p : ~s\n", [Reason, VsnFile])) - end, - AppURL = URL ++ App ++ "-" ++ VsnStr, - {App, VsnStr, AppPath ++ "/" ++ Sub1, AppURL ++ "/" ++ Sub1} - end, AppDirs), - AppPaths ++ find_application_paths(Paths). - + AppPaths = get_app_paths(Source, AppDirs, URL), + AppPaths ++ find_application_paths(Source, Paths). +get_app_paths(src, AppDirs, URL) -> + Sub1 = "doc/html", + lists:map( + fun({App, AppPath}) -> + VsnFile = filename:join(AppPath, "vsn.mk"), + VsnStr = + case file:read_file(VsnFile) of + {ok, Bin} -> + case re:run(Bin, ".*VSN\s*=\s*([0-9\.]+).*",[{capture,[1],list}]) of + {match, [V]} -> + V; + nomatch -> + exit(io_lib:format("No VSN variable found in ~s\n", + [VsnFile])) + end; + {error, Reason} -> + exit(io_lib:format("~p : ~s\n", [Reason, VsnFile])) + end, + AppURL = URL ++ App ++ "-" ++ VsnStr, + {App, VsnStr, AppPath ++ "/" ++ Sub1, AppURL ++ "/" ++ Sub1} + end, AppDirs); +get_app_paths(rel, AppDirs, URL) -> + Sub1 = "doc/html", + lists:map( + fun({App, AppPath}) -> + [AppName, VsnStr] = string:tokens(App, "-"), + AppURL = URL ++ App, + {AppName, VsnStr, AppPath ++ "/" ++ Sub1, AppURL ++ "/" ++ Sub1} + end, AppDirs). + + get_app_dirs(Dir) -> {ok, Files} = file:list_dir(Dir), AFiles = lists:map(fun(File) -> {File, filename:join([Dir, File])} end, Files), lists:zf(fun is_app_with_doc/1, AFiles). -is_app_with_doc({"." ++ ADir, _APath}) -> +is_app_with_doc({"." ++ _ADir, _APath}) -> false; is_app_with_doc({ADir, APath}) -> case file:read_file_info(filename:join([APath, "info"])) of diff --git a/system/doc/top/templates/index.html.src b/system/doc/top/templates/index.html.src index 88d425ac1d..655f532a5d 100644 --- a/system/doc/top/templates/index.html.src +++ b/system/doc/top/templates/index.html.src @@ -39,10 +39,6 @@ under the License. <small><a href="applications.html">Applications</a><br> <a href="man_index.html">Modules</a></small> <p/> -<small><a href="highlights.html">Release highlights</a><br/> -<a href="incompatible.html">Potential incompatibilities</a><br/> -</small> -<br> <a href="javascript:openAllFlips()">Expand All</a><br> <a href="javascript:closeAllFlips()">Contract All</a> <p/> |