diff options
Diffstat (limited to 'erts')
30 files changed, 849 insertions, 480 deletions
diff --git a/erts/configure.in b/erts/configure.in index f03296a89f..c992fb5bd9 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1336,7 +1336,7 @@ TERMCAP_LIB= if test "x$with_termcap" != "xno" && test "X$host" != "Xwin32"; then # try these libs - termcap_libs="ncurses curses termcap termlib" + termcap_libs="tinfo ncurses curses termcap termlib" for termcap_lib in $termcap_libs; do AC_CHECK_LIB($termcap_lib, tgetent, TERMCAP_LIB="-l$termcap_lib") diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 711473afd2..124302a2cb 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -6008,6 +6008,13 @@ ok <seealso marker="#system_info_multi_scheduling">erlang:system_info(multi_scheduling)</seealso>, and <seealso marker="#system_info_schedulers">erlang:system_info(schedulers)</seealso>.</p> </item> + <tag><marker id="system_info_otp_correction_package"><c>otp_correction_package</c></marker></tag> + <item> + <p>Returns a string containing the OTP correction package version + number that currenly executing VM is part of. Note that other + OTP applications in the system may be part of other OTP correction + packages.</p> + </item> <tag><marker id="system_info_otp_release"><c>otp_release</c></marker></tag> <item> <p>Returns a string containing the OTP release number.</p> diff --git a/erts/doc/src/escript.xml b/erts/doc/src/escript.xml index 180447cac4..d2b09d4515 100644 --- a/erts/doc/src/escript.xml +++ b/erts/doc/src/escript.xml @@ -44,6 +44,7 @@ <p><c>escript</c> runs a script written in Erlang.</p> <p>Here follows an example.</p> <pre> +$ <input>chmod u+x factorial</input> $ <input>cat factorial</input> #!/usr/bin/env escript %% -*- erlang -*- @@ -66,12 +67,13 @@ usage() -> fac(0) -> 1; fac(N) -> N * fac(N-1). -$ <input>factorial 5</input> +$ <input>./factorial 5</input> factorial 5 = 120 -$ <input>factorial</input> +$ <input>./factorial</input> usage: factorial integer -$ <input>factorial five</input> -usage: factorial integer </pre> +$ <input>./factorial five</input> +usage: factorial integer + </pre> <p>The header of the Erlang script in the example differs from a normal Erlang module. The first line is intended to be the interpreter line, which invokes <c>escript</c>. However if you diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 5638683f88..b270099566 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -575,7 +575,7 @@ GENERATE += $(TTF_DIR)/erl_alloc_types.h # version include file $(TARGET)/erl_version.h: ../vsn.mk - $(gen_verbose)LANG=C $(PERL) utils/make_version -o $@ $(SYSTEM_VSN) $(VSN)$(SERIALNO) $(TARGET) + $(gen_verbose)LANG=C $(PERL) utils/make_version -o $@ $(SYSTEM_VSN) $(SYSTEM_CP_VSN) $(VSN)$(SERIALNO) $(TARGET) GENERATE += $(TARGET)/erl_version.h # driver table diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 78ab6fa30f..b413f0e859 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. 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 @@ -48,7 +48,7 @@ # define OpCase(OpCode) case op_##OpCode # define CountCase(OpCode) case op_count_##OpCode # define OpCode(OpCode) ((Uint*)op_##OpCode) -# define Goto(Rel) {Go = (int)(Rel); goto emulator_loop;} +# define Goto(Rel) {Go = (int)(UWord)(Rel); goto emulator_loop;} # define LabelAddr(Addr) &&##Addr #else # define OpCase(OpCode) lb_##OpCode @@ -133,7 +133,7 @@ do { \ /* We don't check the range if an ordinary switch is used */ #ifdef NO_JUMP_TABLE -#define VALID_INSTR(IP) (0 <= (int)(IP) && ((int)(IP) < (NUMBER_OF_OPCODES*2+10))) +#define VALID_INSTR(IP) ((UWord)(IP) < (NUMBER_OF_OPCODES*2+10)) #else #define VALID_INSTR(IP) \ ((SWord)LabelAddr(emulator_loop) <= (SWord)(IP) && \ @@ -4326,7 +4326,19 @@ void process_main(void) flags = Arg(2); BsGetFieldSize(tmp_arg2, (flags >> 3), ClauseFail(), size); if (size >= SMALL_BITS) { - Uint wordsneeded = 1+WSIZE(NBYTES((Uint) size)); + Uint wordsneeded; + /* check bits size before potential gc. + * We do not want a gc and then realize we don't need + * the allocated space (i.e. if the op fails) + * + * remember to reacquire the matchbuffer after gc. + */ + + mb = ms_matchbuffer(tmp_arg1); + if (mb->size - mb->offset < size) { + ClauseFail(); + } + wordsneeded = 1+WSIZE(NBYTES((Uint) size)); TestHeapPreserve(wordsneeded, Arg(1), tmp_arg1); } mb = ms_matchbuffer(tmp_arg1); diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 32308fae9b..b4e52770e3 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2013. All Rights Reserved. +# Copyright Ericsson AB 2003-2014. 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 @@ -150,7 +150,7 @@ type LINK_LH STANDARD PROCESSES link_lh type SUSPEND_MON STANDARD PROCESSES suspend_monitor type PEND_SUSPEND SHORT_LIVED PROCESSES pending_suspend type PROC_LIST SHORT_LIVED PROCESSES proc_list -type EXTRA_ROOT SHORT_LIVED PROCESSES extra_root +type SAVED_ESTACK SHORT_LIVED PROCESSES saved_estack type FUN_ENTRY LONG_LIVED CODE fun_entry type ATOM_TXT LONG_LIVED ATOM atom_text type BEAM_REGISTER EHEAP PROCESSES beam_register diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 414ae2f046..e0b654cb22 100755 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -64,8 +64,10 @@ static Export *gather_gc_info_res_trap; #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) +static char otp_correction_package[] = ERLANG_OTP_CORRECTION_PACKAGE; /* Keep erts_system_version as a global variable for easy access from a core */ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE + "%s" " [erts-" ERLANG_VERSION "]" #if !HEAP_ON_C_STACK && !HALFWORD_HEAP " [no-c-stack-objects]" @@ -304,11 +306,28 @@ make_link_list(Process *p, ErtsLink *root, Eterm tail) int erts_print_system_version(int to, void *arg, Process *c_p) { + int i, rc = -1; + char *rc_str = ""; + char rc_buf[100]; + char *ocp = otp_correction_package; #ifdef ERTS_SMP Uint total, online, active; (void) erts_schedulers_state(&total, &online, &active, 0); #endif - return erts_print(to, arg, erts_system_version + for (i = 0; i < sizeof(otp_correction_package)-4; i++) { + if (ocp[i] == '-' && ocp[i+1] == 'r' && ocp[i+2] == 'c') + rc = atoi(&ocp[i+3]); + } + if (rc >= 0) { + if (rc == 0) + rc_str = " [DEVELOPMENT]"; + else { + erts_snprintf(rc_buf, sizeof(rc_buf), " [RELEASE CANDIDATE %d]", rc); + rc_str = rc_buf; + } + } + return erts_print(to, arg, erts_system_version, + rc_str #ifdef ERTS_SMP , total, online #endif @@ -2417,6 +2436,10 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) DECL_AM(unknown); BIF_RET(AM_unknown); } + } else if (ERTS_IS_ATOM_STR("otp_correction_package", BIF_ARG_1)) { + int n = sizeof(ERLANG_OTP_CORRECTION_PACKAGE)-1; + hp = HAlloc(BIF_P, 2*n); + BIF_RET(buf_to_intlist(&hp, ERLANG_OTP_CORRECTION_PACKAGE, n, NIL)); } else if (ERTS_IS_ATOM_STR("otp_release", BIF_ARG_1)) { int n = sizeof(ERLANG_OTP_RELEASE)-1; hp = HAlloc(BIF_P, 2*n); diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index c5585d39e8..8ff6f9a3b9 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2013. All Rights Reserved. + * Copyright Ericsson AB 2002-2014. 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 @@ -1975,17 +1975,6 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) ++n; } - /* - * A trapping BIF can add to rootset by setting the extra_root - * in the process_structure. - */ - if (p->extra_root != NULL) { - roots[n].v = p->extra_root->objv; - roots[n].sz = p->extra_root->sz; - ++n; - } - - ASSERT((is_nil(p->seq_trace_token) || is_tuple(follow_moved(p->seq_trace_token)) || is_atom(p->seq_trace_token))); @@ -2563,11 +2552,6 @@ offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size, p->dictionary->used, offs, area, area_size); } - if (p->extra_root != NULL) { - offset_heap_ptr(p->extra_root->objv, - p->extra_root->sz, - offs, area, area_size); - } offset_heap_ptr(&p->fvalue, 1, offs, area, area_size); offset_heap_ptr(&p->ftrace, 1, offs, area, area_size); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 8c4fffa75b..1af80dd04b 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -553,8 +553,8 @@ void erts_usage(void) erts_fprintf(stderr, " numbers is %d\n", ERTS_MAX_NO_OF_SCHEDULERS); erts_fprintf(stderr, "-SP p1:p2 specify schedulers (p1) and schedulers online (p2)\n"); - erts_fprintf(stderr, " as percentages of logical processors configured and logical\n"); - erts_fprintf(stderr, " processors available, respectively\n"); + erts_fprintf(stderr, " as percentages of logical processors configured and logical\n"); + erts_fprintf(stderr, " processors available, respectively\n"); erts_fprintf(stderr, "-t size set the maximum number of atoms the " "emulator can handle\n"); erts_fprintf(stderr, " valid range is [%d-%d]\n", diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 21fd8dd50a..9983a26688 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. 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 @@ -8755,7 +8755,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->htop = p->heap; p->heap_sz = sz; p->catches = 0; - p->extra_root = NULL; p->bin_vheap_sz = p->min_vheap_size; p->bin_old_vheap_sz = p->min_vheap_size; @@ -10219,12 +10218,6 @@ erts_continue_exit_process(Process *p) if (pbt) erts_free(ERTS_ALC_T_BPD, (void *) pbt); - if (p->extra_root != NULL) { - (p->extra_root->cleanup)(p->extra_root); /* Should deallocate - whole structure */ - p->extra_root = NULL; - } - delete_process(p); #ifdef ERTS_SMP diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 043621125c..e35d1c785c 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. 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 @@ -711,13 +711,6 @@ struct ErtsPendingSuspend_ { #endif -typedef struct ErlExtraRootSet_ ErlExtraRootSet; -struct ErlExtraRootSet_ { - Eterm *objv; - Uint sz; - void (*cleanup)(ErlExtraRootSet *); -}; - /* Defines to ease the change of memory architecture */ # define HEAP_START(p) (p)->heap # define HEAP_TOP(p) (p)->htop @@ -811,8 +804,6 @@ struct process { ErlMessageQueue msg; /* Message queue */ - ErlExtraRootSet *extra_root; /* Used by trapping BIF's */ - union { ErtsBifTimer *bif_timers; /* Bif timers aiming at this process */ void *terminate; diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 2cb44a5b64..5e7a5cab6e 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. 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 @@ -87,7 +87,8 @@ static Export term_to_binary_trap_export; static byte* enc_term(ErtsAtomCacheMap *, Eterm, byte*, Uint32, struct erl_off_heap_header** off_heap); -static int enc_term_int(Process *p,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, +struct TTBEncodeContext_; +static int enc_term_int(struct TTBEncodeContext_*,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, struct erl_off_heap_header** off_heap, Sint *reds, byte **res); static Uint is_external_string(Eterm obj, int* p_is_string); static byte* enc_atom(ErtsAtomCacheMap *, Eterm, byte*, Uint32); @@ -103,7 +104,8 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla Binary *context_b); static Uint encode_size_struct2(ErtsAtomCacheMap *, Eterm, unsigned); -static int encode_size_struct_int(Process *p, ErtsAtomCacheMap *acmp, Eterm obj, +struct TTBSizeContext_; +static int encode_size_struct_int(struct TTBSizeContext_*, ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags, Sint *reds, Uint *res); static Export binary_to_term_trap_export; @@ -1086,7 +1088,6 @@ BIF_RETTYPE term_to_binary_2(BIF_ALIST_2) int level = 0; Uint flags = TERM_TO_BINARY_DFLAGS; Eterm res; - Binary *bin = NULL; while (is_list(Flags)) { Eterm arg = CAR(list_val(Flags)); @@ -1123,7 +1124,7 @@ BIF_RETTYPE term_to_binary_2(BIF_ALIST_2) goto error; } - res = erts_term_to_binary_int(p, Term, level, flags, bin); + res = erts_term_to_binary_int(p, Term, level, flags, NULL); if (is_tuple(res)) { erts_set_gc_state(p, 0); BIF_TRAP1(&term_to_binary_trap_export,BIF_P,res); @@ -1726,14 +1727,20 @@ erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) { typedef enum { TTBSize, TTBEncode, TTBCompress } TTBState; -typedef struct { +typedef struct TTBSizeContext_ { Uint flags; int level; + Uint result; + Eterm obj; + ErtsEStack estack; } TTBSizeContext; -typedef struct { +typedef struct TTBEncodeContext_ { Uint flags; int level; + byte* ep; + Eterm obj; + ErtsWStack wstack; Binary *result_bin; } TTBEncodeContext; @@ -1763,8 +1770,10 @@ static void ttb_context_destructor(Binary *context_bin) context->alive = 0; switch (context->state) { case TTBSize: + DESTROY_SAVED_ESTACK(&context->s.sc.estack); break; case TTBEncode: + DESTROY_SAVED_WSTACK(&context->s.ec.wstack); if (context->s.ec.result_bin != NULL) { /* Set to NULL if ever made alive! */ ASSERT(erts_refc_read(&(context->s.ec.result_bin->refc),0) == 0); erts_bin_free(context->s.ec.result_bin); @@ -1829,6 +1838,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla /* Setup enough to get started */ context->state = TTBSize; context->alive = 1; + context->s.sc.estack.start = NULL; context->s.sc.flags = flags; context->s.sc.level = level; } else { @@ -1844,7 +1854,8 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla int level; Uint flags; /* Try for fast path */ - if (encode_size_struct_int(p, NULL, Term, context->s.sc.flags, &reds, &size) < 0) { + if (encode_size_struct_int(&context->s.sc, NULL, Term, + context->s.sc.flags, &reds, &size) < 0) { EXPORT_CONTEXT(); /* Same state */ RETURN_STATE(); @@ -1870,6 +1881,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla context->state = TTBEncode; context->s.ec.flags = flags; context->s.ec.level = level; + context->s.ec.wstack.wstart = NULL; context->s.ec.result_bin = result_bin; break; } @@ -1881,7 +1893,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla Binary *result_bin; flags = context->s.ec.flags; - if (enc_term_int(p,NULL,Term, bytes+1, flags, NULL, &reds, &endp) < 0) { + if (enc_term_int(&context->s.ec, NULL,Term, bytes+1, flags, NULL, &reds, &endp) < 0) { EXPORT_CONTEXT(); RETURN_STATE(); } @@ -2289,27 +2301,6 @@ dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Ete #define ENC_PATCH_FUN_SIZE ((Eterm) 2) #define ENC_LAST_ARRAY_ELEMENT ((Eterm) 3) -/* Free extra rootset (used when trapping) */ -static void cleanup_ttb_extra_root(ErlExtraRootSet *rs) -{ - if (rs->objv != NULL) { - erts_free(ERTS_ALC_T_EXTRA_ROOT, rs->objv); - } - erts_free(ERTS_ALC_T_EXTRA_ROOT, rs); -} - -/* Same as above, but we have an extra "stack" beyond GC reach, i.e. an array of two extra roots */ -static void cleanup_ttb_extra_root_2(ErlExtraRootSet *rs) -{ - if (rs->objv != NULL) { - erts_free(ERTS_ALC_T_EXTRA_ROOT, rs->objv); - } - if (rs[1].objv != NULL) { - erts_free(ERTS_ALC_T_EXTRA_ROOT, rs[1].objv); - } - - erts_free(ERTS_ALC_T_EXTRA_ROOT, rs); -} static byte* enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, @@ -2321,39 +2312,43 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, } static int -enc_term_int(Process *p,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, +enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, struct erl_off_heap_header** off_heap, Sint *reds, byte **res) { - DECLARE_ESTACK(s); - DECLARE_WSTACK(com); + DECLARE_WSTACK(s); Uint n; Uint i; Uint j; Uint* ptr; Eterm val; FloatDef f; - int count_reds = (p != NULL && reds != NULL); Sint r = 0; +#if HALFWORD_HEAP + UWord wobj; +#endif + - if (count_reds) { - ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_EXTRA_ROOT); - WSTACK_CHANGE_ALLOCATOR(com, ERTS_ALC_T_EXTRA_ROOT); + if (ctx) { + WSTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK); r = *reds; - } - if (p && p->extra_root) { /* restore saved stacks and byte pointer */ - ESTACK_RESTORE(s,p->extra_root[0].objv, p->extra_root[0].sz); - obj = ESTACK_POP(s); - WSTACK_RESTORE(com, p->extra_root[1].objv, p->extra_root[1].sz); - ep = (byte *) WSTACK_POP(com); + if (ctx->wstack.wstart) { /* restore saved stacks and byte pointer */ + WSTACK_RESTORE(s, &ctx->wstack); + ep = ctx->ep; + obj = ctx->obj; + } } goto L_jump_start; outer_loop: - while (!ESTACK_ISEMPTY(s)) { - obj = ESTACK_POP(s); - switch (val = WSTACK_POP(com)) { + while (!WSTACK_ISEMPTY(s)) { +#if HALFWORD_HEAP + obj = (Eterm) (wobj = WSTACK_POP(s)); +#else + obj = WSTACK_POP(s); +#endif + switch (val = WSTACK_POP(s)) { case ENC_TERM: break; case ENC_ONE_CONS: @@ -2364,55 +2359,52 @@ enc_term_int(Process *p,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dfla obj = CAR(cons); tl = CDR(cons); - WSTACK_PUSH(com, is_list(tl) ? ENC_ONE_CONS : ENC_TERM); - ESTACK_PUSH(s, tl); + WSTACK_PUSH(s, is_list(tl) ? ENC_ONE_CONS : ENC_TERM); + WSTACK_PUSH(s, tl); } break; case ENC_PATCH_FUN_SIZE: - /* obj will be discarded, it was NIL */ { - byte* size_p = (byte *) WSTACK_POP(com); +#if HALFWORD_HEAP + byte* size_p = (byte *) wobj; +#else + byte* size_p = (byte *) obj; +#endif put_int32(ep - size_p, size_p); } goto outer_loop; case ENC_LAST_ARRAY_ELEMENT: /* obj is the tuple */ { - Eterm* ptr = tuple_val(obj); - i = arityval(*ptr); - obj = ptr[i]; +#if HALFWORD_HEAP + Eterm* ptr = (Eterm *) wobj; +#else + Eterm* ptr = (Eterm *) obj; +#endif + obj = *ptr; } break; default: /* ENC_LAST_ARRAY_ELEMENT+1 and upwards */ { - Eterm* ptr = tuple_val(obj); - i = arityval(*ptr); - ESTACK_PUSH(s, obj); /* put back tuple and next element index */ - WSTACK_PUSH(com, val-1); - obj = ptr[i - (val - ENC_LAST_ARRAY_ELEMENT)]; /* the index is counting down */ +#if HALFWORD_HEAP + Eterm* ptr = (Eterm *) wobj; +#else + Eterm* ptr = (Eterm *) obj; +#endif + WSTACK_PUSH(s, val-1); + obj = *ptr++; + WSTACK_PUSH(s, (UWord)ptr); } break; } L_jump_start: - if (count_reds && --r == 0) { + if (ctx && --r == 0) { *reds = r; - ESTACK_PUSH(s,obj); /* push back current object, to be popped on restore */ - WSTACK_PUSH(com,((UWord) ep)); - if (p->extra_root == NULL) { - /* NB. Allocate an array of two "extra-roots", of which only the first element - is seen and handled by the GC. Index 1 holds the Wstack. */ - p->extra_root = erts_alloc(ERTS_ALC_T_EXTRA_ROOT, sizeof(ErlExtraRootSet)*2); - p->extra_root->objv = NULL; - p->extra_root->sz = 0; - p->extra_root->cleanup = cleanup_ttb_extra_root_2; - p->extra_root[1].objv = NULL; - p->extra_root[1].sz = 0; - p->extra_root[1].cleanup = NULL; /* Never used */ - } - ESTACK_SAVE(s, p->extra_root[0].objv, p->extra_root[0].sz); - WSTACK_SAVE(com, p->extra_root[1].objv, (p->extra_root[1].sz)); + ctx->obj = obj; + ctx->ep = ep; + WSTACK_SAVE(s, &ctx->wstack); return -1; } switch(tag_val_def(obj)) { @@ -2558,8 +2550,8 @@ enc_term_int(Process *p,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dfla ep += 4; } if (i > 0) { - WSTACK_PUSH(com, ENC_LAST_ARRAY_ELEMENT+i-1); - ESTACK_PUSH(s, obj); + WSTACK_PUSH(s, ENC_LAST_ARRAY_ELEMENT+i-1); + WSTACK_PUSH(s, (UWord)ptr); } break; @@ -2703,9 +2695,8 @@ enc_term_int(Process *p,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dfla int ei; *ep++ = NEW_FUN_EXT; - WSTACK_PUSH(com, (UWord) ep); /* Position for patching in size */ - WSTACK_PUSH(com, ENC_PATCH_FUN_SIZE); - ESTACK_PUSH(s,NIL); /* Will be thrown away */ + WSTACK_PUSH(s, ENC_PATCH_FUN_SIZE); + WSTACK_PUSH(s, (UWord) ep); /* Position for patching in size */ ep += 4; *ep = funp->arity; ep += 1; @@ -2722,8 +2713,8 @@ enc_term_int(Process *p,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dfla fun_env: for (ei = funp->num_free-1; ei > 0; ei--) { - WSTACK_PUSH(com, ENC_TERM); - ESTACK_PUSH(s, (UWord) funp->env[ei]); + WSTACK_PUSH(s, ENC_TERM); + WSTACK_PUSH(s, (UWord) funp->env[ei]); } if (funp->num_free != 0) { obj = funp->env[0]; @@ -2766,13 +2757,9 @@ enc_term_int(Process *p,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dfla break; } } - DESTROY_ESTACK(s); - DESTROY_WSTACK(com); - if (p && p->extra_root) { - cleanup_ttb_extra_root_2(p->extra_root); - p->extra_root = NULL; - } - if (count_reds) { + DESTROY_WSTACK(s); + if (ctx) { + ASSERT(ctx->wstack.wstart == NULL); *reds = r; } *res = ep; @@ -3742,26 +3729,24 @@ static Uint encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dfla } static int -encode_size_struct_int(Process *p, ErtsAtomCacheMap *acmp, Eterm obj, +encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags, Sint *reds, Uint *res) { DECLARE_ESTACK(s); Uint m, i, arity; Uint result = 0; - int count_reds = (p != NULL && reds != 0); Sint r = 0; - if (count_reds) { - ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_EXTRA_ROOT); + if (ctx) { + ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK); r = *reds; - } - - if (p && p->extra_root) { /* restore saved stack */ - ESTACK_RESTORE(s,p->extra_root->objv, p->extra_root->sz + 1); - result = ESTACK_POP(s); /*Untagged, beyond p->extra_root->sz */ - obj = ESTACK_POP(s); - } + if (ctx->estack.start) { /* restore saved stack */ + ESTACK_RESTORE(s, &ctx->estack); + result = ctx->result; + obj = ctx->obj; + } + } goto L_jump_start; @@ -3787,18 +3772,11 @@ encode_size_struct_int(Process *p, ErtsAtomCacheMap *acmp, Eterm obj, } L_jump_start: - if (count_reds && --r == 0) { + if (ctx && --r == 0) { *reds = r; - ESTACK_PUSH(s,obj); /* push back current object */ - ESTACK_PUSH(s,result); /* Untagged, will be out of GC reach */ - if (p->extra_root == NULL) { - p->extra_root = erts_alloc(ERTS_ALC_T_EXTRA_ROOT, sizeof(ErlExtraRootSet)); - p->extra_root->objv = NULL; - p->extra_root->sz = 0; - p->extra_root->cleanup = cleanup_ttb_extra_root; - } - ESTACK_SAVE(s, p->extra_root->objv, p->extra_root->sz); - --p->extra_root->sz; /* Hide result from GC */ + ctx->obj = obj; + ctx->result = result; + ESTACK_SAVE(s, &ctx->estack); return -1; } switch (tag_val_def(obj)) { @@ -4001,11 +3979,8 @@ encode_size_struct_int(Process *p, ErtsAtomCacheMap *acmp, Eterm obj, } DESTROY_ESTACK(s); - if (p && p->extra_root) { - cleanup_ttb_extra_root(p->extra_root); - p->extra_root = NULL; - } - if (count_reds) { + if (ctx) { + ASSERT(ctx->estack.start == NULL); *reds = r; } *res = result; @@ -4074,7 +4049,9 @@ init_done: switch (tag) { case INTEGER_EXT: SKIP(4); +#if !defined(ARCH_64) || HALFWORD_HEAP heap_size += BIG_UINT_HEAP_SIZE; +#endif break; case SMALL_INTEGER_EXT: SKIP(1); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 6e5d352e5b..c183c519ff 100755 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. 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 @@ -370,231 +370,233 @@ extern int stackdump_on_exit; * DESTROY_ESTACK(Stack) */ +typedef struct { + UWord* start; + UWord* sp; + UWord* end; + ErtsAlcType_t alloc_type; +}ErtsEStack; -void erl_grow_stack(ErtsAlcType_t a_type, Eterm** start, Eterm** sp, Eterm** end); -#define ESTK_CONCAT(a,b) a##b -#define ESTK_SUBSCRIPT(s,i) *((Eterm *)((byte *)ESTK_CONCAT(s,_start) + (i))) #define DEF_ESTACK_SIZE (16) -#define DECLARE_ESTACK(s) \ - Eterm ESTK_CONCAT(s,_default_stack)[DEF_ESTACK_SIZE]; \ - Eterm* ESTK_CONCAT(s,_start) = ESTK_CONCAT(s,_default_stack); \ - Eterm* ESTK_CONCAT(s,_sp) = ESTK_CONCAT(s,_start); \ - Eterm* ESTK_CONCAT(s,_end) = ESTK_CONCAT(s,_start) + DEF_ESTACK_SIZE;\ - ErtsAlcType_t ESTK_CONCAT(s,_alloc_type) = ERTS_ALC_T_ESTACK +void erl_grow_estack(ErtsEStack*, Eterm* def_stack); +#define ESTK_CONCAT(a,b) a##b +#define ESTK_DEF_STACK(s) ESTK_CONCAT(s,_default_estack) + +#define DECLARE_ESTACK(s) \ + UWord ESTK_DEF_STACK(s)[DEF_ESTACK_SIZE]; \ + ErtsEStack s = { \ + ESTK_DEF_STACK(s), /* start */ \ + ESTK_DEF_STACK(s), /* sp */ \ + ESTK_DEF_STACK(s) + DEF_ESTACK_SIZE, /* end */ \ + ERTS_ALC_T_ESTACK /* alloc_type */ \ + } #define ESTACK_CHANGE_ALLOCATOR(s,t) \ do { \ - if (ESTK_CONCAT(s,_start) != ESTK_CONCAT(s,_default_stack)) { \ + if (s.start != ESTK_DEF_STACK(s)) { \ erl_exit(1, "Internal error - trying to change allocator " \ "type of active estack\n"); \ } \ - ESTK_CONCAT(s,_alloc_type) = (t); \ + s.alloc_type = (t); \ } while (0) +#define DESTROY_ESTACK(s) \ +do { \ + if (s.start != ESTK_DEF_STACK(s)) { \ + erts_free(s.alloc_type, s.start); \ + } \ +} while(0) + + /* - * Do not free the stack after this, it may have pointers into what - * was saved in 'v'. 'v' and 'vsize' are changed by this macro. If - * 'v' points to anything, it should have been allocated by a previous - * call to this macro. Be careful to set a correct allocator prior to - * saving. - * 'v' can be any lvalue pointer, it will point to an array of UWord - * after calling this macro. + * Do not free the stack after this, it may have pointers into what + * was saved in 'dst'. */ -#define ESTACK_SAVE(s,v,vsize) /* v and vsize are "name parameters" */ \ -do { \ - Uint _esz = ESTACK_COUNT(s); \ - if (ESTK_CONCAT(s,_start) == ESTK_CONCAT(s,_default_stack)) { \ - if ((v) == NULL) { \ - (v) = erts_alloc(ESTK_CONCAT(s,_alloc_type), \ - DEF_ESTACK_SIZE * sizeof(Eterm)); \ - } \ - memcpy((v),ESTK_CONCAT(s,_start),_esz*sizeof(Eterm)); \ - } else { \ - (v) = (void *) ESTK_CONCAT(s,_start); \ - } \ - (vsize) = _esz; \ +#define ESTACK_SAVE(s,dst)\ +do {\ + if (s.start == ESTK_DEF_STACK(s)) {\ + UWord _wsz = ESTACK_COUNT(s);\ + (dst)->start = erts_alloc(s.alloc_type,\ + DEF_ESTACK_SIZE * sizeof(UWord));\ + memcpy((dst)->start, s.start,_wsz*sizeof(UWord));\ + (dst)->sp = (dst)->start + _wsz;\ + (dst)->end = (dst)->start + DEF_ESTACK_SIZE;\ + (dst)->alloc_type = s.alloc_type;\ + } else\ + *(dst) = s;\ } while (0) -/* - * Use on empty stack, only the allocator can be changed before this - * The vector parameter is reset to NULL if the vector is moved to stack, - * otherwise it's kept for reuse, so a saved and restored vector might - * need freeing using the correct allocator parameter. - * 'v' can be any lvalue pointer, it's cast to an (Eterm *). +#define DESTROY_SAVED_ESTACK(estack)\ +do {\ + if ((estack)->start) {\ + erts_free((estack)->alloc_type, (estack)->start);\ + (estack)->start = NULL;\ + }\ +} while(0) + +/* + * Use on empty stack, only the allocator can be changed before this. + * The src stack is reset to NULL. */ -#define ESTACK_RESTORE(s, v, vsize) /*v is a "name parameter"*/ \ -do { \ - if ((vsize) > DEF_ESTACK_SIZE) { \ - Uint _ca = DEF_ESTACK_SIZE; \ - while (_ca < (vsize)) \ - _ca = _ca * 2; \ - ESTK_CONCAT(s,_start) = (Eterm *) (v); \ - ESTK_CONCAT(s,_end) = ((Eterm *)(v)) + _ca; \ - ESTK_CONCAT(s,_sp) = ESTK_CONCAT(s,_start) + (vsize); \ - (v) = NULL; \ - } else { \ - memcpy(ESTK_CONCAT(s,_start),(v),(vsize)*sizeof(Eterm));\ - ESTK_CONCAT(s,_sp) = ESTK_CONCAT(s,_start) + (vsize); \ - } \ - } while (0) +#define ESTACK_RESTORE(s, src) \ +do { \ + ASSERT(s.start == ESTK_DEF_STACK(s)); \ + s = *(src); /* struct copy */ \ + (src)->start = NULL; \ + ASSERT(s.sp >= s.start); \ + ASSERT(s.sp <= s.end); \ +} while (0) -#define ESTACK_IS_STATIC(s) (ESTK_CONCAT(s,_start) == ESTK_CONCAT(s,_default_stack)) +#define ESTACK_IS_STATIC(s) (s.start == ESTK_DEF_STACK(s))) -#define DESTROY_ESTACK(s) \ -do { \ - if (ESTK_CONCAT(s,_start) != ESTK_CONCAT(s,_default_stack)) { \ - erts_free(ESTK_CONCAT(s,_alloc_type), ESTK_CONCAT(s,_start)); \ - } \ +#define ESTACK_PUSH(s, x) \ +do { \ + if (s.sp == s.end) { \ + erl_grow_estack(&s, ESTK_DEF_STACK(s)); \ + } \ + *s.sp++ = (x); \ } while(0) -#define ESTACK_PUSH(s, x) \ -do { \ - if (ESTK_CONCAT(s,_sp) == ESTK_CONCAT(s,_end)) { \ - erl_grow_stack(ESTK_CONCAT(s,_alloc_type),&ESTK_CONCAT(s,_start), \ - &ESTK_CONCAT(s,_sp), &ESTK_CONCAT(s,_end)); \ - } \ - *ESTK_CONCAT(s,_sp)++ = (x); \ +#define ESTACK_PUSH2(s, x, y) \ +do { \ + if (s.sp > s.end - 2) { \ + erl_grow_estack(&s, ESTK_DEF_STACK(s)); \ + } \ + *s.sp++ = (x); \ + *s.sp++ = (y); \ } while(0) -#define ESTACK_PUSH2(s, x, y) \ -do { \ - if (ESTK_CONCAT(s,_sp) > ESTK_CONCAT(s,_end) - 2) { \ - erl_grow_stack(ESTK_CONCAT(s,_alloc_type),&ESTK_CONCAT(s,_start), \ - &ESTK_CONCAT(s,_sp), &ESTK_CONCAT(s,_end)); \ - } \ - *ESTK_CONCAT(s,_sp)++ = (x); \ - *ESTK_CONCAT(s,_sp)++ = (y); \ +#define ESTACK_PUSH3(s, x, y, z) \ +do { \ + if (s.sp > s.end - 3) { \ + erl_grow_estack(&s, ESTK_DEF_STACK(s)); \ + } \ + *s.sp++ = (x); \ + *s.sp++ = (y); \ + *s.sp++ = (z); \ } while(0) -#define ESTACK_PUSH3(s, x, y, z) \ -do { \ - if (ESTK_CONCAT(s,_sp) > ESTK_CONCAT(s,_end) - 3) { \ - erl_grow_stack(&ESTK_CONCAT(s,_start), &ESTK_CONCAT(s,_sp), \ - &ESTK_CONCAT(s,_end)); \ - } \ - *ESTK_CONCAT(s,_sp)++ = (x); \ - *ESTK_CONCAT(s,_sp)++ = (y); \ - *ESTK_CONCAT(s,_sp)++ = (z); \ -} while(0) +#define ESTACK_COUNT(s) (s.sp - s.start) +#define ESTACK_ISEMPTY(s) (s.sp == s.start) +#define ESTACK_POP(s) (*(--s.sp)) -#define ESTACK_COUNT(s) (ESTK_CONCAT(s,_sp) - ESTK_CONCAT(s,_start)) -#define ESTACK_ISEMPTY(s) (ESTK_CONCAT(s,_sp) == ESTK_CONCAT(s,_start)) -#define ESTACK_POP(s) (*(--ESTK_CONCAT(s,_sp))) +/* + * WSTACK: same as ESTACK but with UWord instead of Eterm + */ +typedef struct { + UWord* wstart; + UWord* wsp; + UWord* wend; + ErtsAlcType_t alloc_type; +}ErtsWStack; -void erl_grow_wstack(ErtsAlcType_t a_type, UWord** start, UWord** sp, UWord** end); -#define WSTK_CONCAT(a,b) a##b -#define WSTK_SUBSCRIPT(s,i) *((UWord *)((byte *)WSTK_CONCAT(s,_start) + (i))) #define DEF_WSTACK_SIZE (16) -#define DECLARE_WSTACK(s) \ - UWord WSTK_CONCAT(s,_default_stack)[DEF_WSTACK_SIZE]; \ - UWord* WSTK_CONCAT(s,_start) = WSTK_CONCAT(s,_default_stack); \ - UWord* WSTK_CONCAT(s,_sp) = WSTK_CONCAT(s,_start); \ - UWord* WSTK_CONCAT(s,_end) = WSTK_CONCAT(s,_start) + DEF_WSTACK_SIZE; \ - ErtsAlcType_t WSTK_CONCAT(s,_alloc_type) = ERTS_ALC_T_ESTACK +void erl_grow_wstack(ErtsWStack*, Eterm* def_stack); +#define WSTK_CONCAT(a,b) a##b +#define WSTK_DEF_STACK(s) WSTK_CONCAT(s,_default_wstack) + +#define DECLARE_WSTACK(s) \ + UWord WSTK_DEF_STACK(s)[DEF_WSTACK_SIZE]; \ + ErtsWStack s = { \ + WSTK_DEF_STACK(s), /* wstart */ \ + WSTK_DEF_STACK(s), /* wsp */ \ + WSTK_DEF_STACK(s) + DEF_WSTACK_SIZE, /* wend */ \ + ERTS_ALC_T_ESTACK /* alloc_type */ \ + } #define WSTACK_CHANGE_ALLOCATOR(s,t) \ do { \ - if (WSTK_CONCAT(s,_start) != WSTK_CONCAT(s,_default_stack)) { \ + if (s.wstart != WSTK_DEF_STACK(s)) { \ erl_exit(1, "Internal error - trying to change allocator " \ "type of active wstack\n"); \ } \ - WSTK_CONCAT(s,_alloc_type) = (t); \ + s.alloc_type = (t); \ } while (0) -#define DESTROY_WSTACK(s) \ -do { \ - if (WSTK_CONCAT(s,_start) != WSTK_CONCAT(s,_default_stack)) { \ - erts_free(WSTK_CONCAT(s,_alloc_type), WSTK_CONCAT(s,_start)); \ - } \ +#define DESTROY_WSTACK(s) \ +do { \ + if (s.wstart != WSTK_DEF_STACK(s)) { \ + erts_free(s.alloc_type, s.wstart); \ + } \ } while(0) + /* - * Do not free the stack after this, it may have pointers into what - * was saved in 'v'. 'v' and 'vsize' are changed by this macro. If - * 'v' points to anything, it should have been allocated by a previous - * call to this macro. Be careful to set a correct allocator prior to - * saving. - * 'v' can be any lvalue pointer, it will point to an array of UWord - * after calling this macro. + * Do not free the stack after this, it may have pointers into what + * was saved in 'dst'. */ -#define WSTACK_SAVE(s,v,vsize) /* v and vsize are "name parameters" */ \ -do { \ - Uint _wsz = WSTACK_COUNT(s); \ - if (WSTK_CONCAT(s,_start) == WSTK_CONCAT(s,_default_stack)) { \ - if ((v) == NULL) { \ - (v) = erts_alloc(WSTK_CONCAT(s,_alloc_type), \ - DEF_WSTACK_SIZE * sizeof(UWord)); \ - } \ - memcpy((v),WSTK_CONCAT(s,_start),_wsz*sizeof(UWord)); \ - } else { \ - (v) = (void *) WSTK_CONCAT(s,_start); \ - } \ - (vsize) = _wsz; \ +#define WSTACK_SAVE(s,dst)\ +do {\ + if (s.wstart == WSTK_DEF_STACK(s)) {\ + UWord _wsz = WSTACK_COUNT(s);\ + (dst)->wstart = erts_alloc(s.alloc_type,\ + DEF_WSTACK_SIZE * sizeof(UWord));\ + memcpy((dst)->wstart, s.wstart,_wsz*sizeof(UWord));\ + (dst)->wsp = (dst)->wstart + _wsz;\ + (dst)->wend = (dst)->wstart + DEF_WSTACK_SIZE;\ + (dst)->alloc_type = s.alloc_type;\ + } else\ + *(dst) = s;\ } while (0) -/* - * Use on empty stack, only the allocator can be changed before this - * The vector parameter is reset to NULL if the vector is moved to stack, - * otherwise it's kept for reuse, so a saved and restored vector might - * need freeing using the correct allocator parameter. - * 'v' can be any lvalue pointer, it's cast to an (UWord *). +#define DESTROY_SAVED_WSTACK(wstack)\ +do {\ + if ((wstack)->wstart) {\ + erts_free((wstack)->alloc_type, (wstack)->wstart);\ + (wstack)->wstart = NULL;\ + }\ +} while(0) + +/* + * Use on empty stack, only the allocator can be changed before this. + * The src stack is reset to NULL. */ -#define WSTACK_RESTORE(s, v, vsize) /*v is a "name parameter"*/ \ -do { \ - if ((vsize) > DEF_WSTACK_SIZE) { \ - Uint _ca = DEF_WSTACK_SIZE; \ - while (_ca < (vsize)) \ - _ca = _ca * 2; \ - WSTK_CONCAT(s,_start) = (UWord *) (v); \ - WSTK_CONCAT(s,_end) = ((UWord *)(v)) + _ca; \ - WSTK_CONCAT(s,_sp) = WSTK_CONCAT(s,_start) + (vsize); \ - (v) = NULL; \ - } else { \ - memcpy(WSTK_CONCAT(s,_start),(v),(vsize)*sizeof(UWord));\ - WSTK_CONCAT(s,_sp) = WSTK_CONCAT(s,_start) + (vsize); \ - } \ - } while (0) +#define WSTACK_RESTORE(s, src) \ +do { \ + ASSERT(s.wstart == WSTK_DEF_STACK(s)); \ + s = *(src); /* struct copy */ \ + (src)->wstart = NULL; \ + ASSERT(s.wsp >= s.wstart); \ + ASSERT(s.wsp <= s.wend); \ +} while (0) -#define WSTACK_IS_STATIC(s) (WSTK_CONCAT(s,_start) == WSTK_CONCAT(s,_default_stack)) +#define WSTACK_IS_STATIC(s) (s.wstart == WSTK_DEF_STACK(s))) -#define WSTACK_PUSH(s, x) \ -do { \ - if (WSTK_CONCAT(s,_sp) == WSTK_CONCAT(s,_end)) { \ - erl_grow_wstack(WSTK_CONCAT(s,_alloc_type), &WSTK_CONCAT(s,_start), \ - &WSTK_CONCAT(s,_sp), &WSTK_CONCAT(s,_end)); \ - } \ - *WSTK_CONCAT(s,_sp)++ = (x); \ +#define WSTACK_PUSH(s, x) \ +do { \ + if (s.wsp == s.wend) { \ + erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \ + } \ + *s.wsp++ = (x); \ } while(0) -#define WSTACK_PUSH2(s, x, y) \ -do { \ - if (WSTK_CONCAT(s,_sp) > WSTK_CONCAT(s,_end) - 2) { \ - erl_grow_wstack(WSTK_CONCAT(s,_alloc_type), &WSTK_CONCAT(s,_start), \ - &WSTK_CONCAT(s,_sp), &WSTK_CONCAT(s,_end)); \ - } \ - *WSTK_CONCAT(s,_sp)++ = (x); \ - *WSTK_CONCAT(s,_sp)++ = (y); \ +#define WSTACK_PUSH2(s, x, y) \ +do { \ + if (s.wsp > s.wend - 2) { \ + erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \ + } \ + *s.wsp++ = (x); \ + *s.wsp++ = (y); \ } while(0) -#define WSTACK_PUSH3(s, x, y, z) \ -do { \ - if (WSTK_CONCAT(s,_sp) > WSTK_CONCAT(s,_end) - 3) { \ - erl_grow_wstack(WSTK_CONCAT(s,_alloc_type), &WSTK_CONCAT(s,_start), \ - &WSTK_CONCAT(s,_sp), &WSTK_CONCAT(s,_end)); \ - } \ - *WSTK_CONCAT(s,_sp)++ = (x); \ - *WSTK_CONCAT(s,_sp)++ = (y); \ - *WSTK_CONCAT(s,_sp)++ = (z); \ +#define WSTACK_PUSH3(s, x, y, z) \ +do { \ + if (s.wsp > s.wend - 3) { \ + erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \ + } \ + *s.wsp++ = (x); \ + *s.wsp++ = (y); \ + *s.wsp++ = (z); \ } while(0) -#define WSTACK_COUNT(s) (WSTK_CONCAT(s,_sp) - WSTK_CONCAT(s,_start)) +#define WSTACK_COUNT(s) (s.wsp - s.wstart) +#define WSTACK_ISEMPTY(s) (s.wsp == s.wstart) +#define WSTACK_POP(s) (*(--s.wsp)) -#define WSTACK_ISEMPTY(s) (WSTK_CONCAT(s,_sp) == WSTK_CONCAT(s,_start)) -#define WSTACK_POP(s) (*(--WSTK_CONCAT(s,_sp))) /* binary.c */ diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 297c4bf439..7f8bdcb2ca 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. 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 @@ -185,39 +185,41 @@ erts_set_hole_marker(Eterm* ptr, Uint sz) * Helper function for the ESTACK macros defined in global.h. */ void -erl_grow_stack(ErtsAlcType_t a_type, Eterm** start, Eterm** sp, Eterm** end) +erl_grow_estack(ErtsEStack* s, Eterm* default_estack) { - Uint old_size = (*end - *start); + Uint old_size = (s->end - s->start); Uint new_size = old_size * 2; - Uint sp_offs = *sp - *start; - if (new_size > 2 * DEF_ESTACK_SIZE) { - *start = erts_realloc(a_type, (void *) *start, new_size*sizeof(Eterm)); + Uint sp_offs = s->sp - s->start; + if (s->start != default_estack) { + s->start = erts_realloc(s->alloc_type, s->start, + new_size*sizeof(Eterm)); } else { - Eterm* new_ptr = erts_alloc(a_type, new_size*sizeof(Eterm)); - sys_memcpy(new_ptr, *start, old_size*sizeof(Eterm)); - *start = new_ptr; + Eterm* new_ptr = erts_alloc(s->alloc_type, new_size*sizeof(Eterm)); + sys_memcpy(new_ptr, s->start, old_size*sizeof(Eterm)); + s->start = new_ptr; } - *end = *start + new_size; - *sp = *start + sp_offs; + s->end = s->start + new_size; + s->sp = s->start + sp_offs; } /* - * Helper function for the ESTACK macros defined in global.h. + * Helper function for the WSTACK macros defined in global.h. */ void -erl_grow_wstack(ErtsAlcType_t a_type, UWord** start, UWord** sp, UWord** end) +erl_grow_wstack(ErtsWStack* s, UWord* default_wstack) { - Uint old_size = (*end - *start); + Uint old_size = (s->wend - s->wstart); Uint new_size = old_size * 2; - Uint sp_offs = *sp - *start; - if (new_size > 2 * DEF_ESTACK_SIZE) { - *start = erts_realloc(a_type, (void *) *start, new_size*sizeof(UWord)); + Uint sp_offs = s->wsp - s->wstart; + if (s->wstart != default_wstack) { + s->wstart = erts_realloc(s->alloc_type, s->wstart, + new_size*sizeof(UWord)); } else { - UWord* new_ptr = erts_alloc(a_type, new_size*sizeof(UWord)); - sys_memcpy(new_ptr, *start, old_size*sizeof(UWord)); - *start = new_ptr; + UWord* new_ptr = erts_alloc(s->alloc_type, new_size*sizeof(UWord)); + sys_memcpy(new_ptr, s->wstart, old_size*sizeof(UWord)); + s->wstart = new_ptr; } - *end = *start + new_size; - *sp = *start + sp_offs; + s->wend = s->wstart + new_size; + s->wsp = s->wstart + sp_offs; } /* CTYPE macros */ @@ -2846,7 +2848,7 @@ pop_next: return 0; not_equal: - DESTROY_ESTACK(stack); + DESTROY_WSTACK(stack); return j; #undef CMP_NODES diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 61f9f6a59a..59e34eb819 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -547,6 +547,25 @@ erts_sys_pre_init(void) #endif #endif /* USE_THREADS */ erts_smp_atomic_init_nob(&sys_misc_mem_sz, 0); + + { + /* + * Unfortunately we depend on fd 0,1,2 in the old shell code. + * So if for some reason we do not have those open when we start + * we have to open them here. Not doing this can cause the emulator + * to deadlock when reaping the fd_driver ports :( + */ + int fd; + /* Make sure fd 0 is open */ + if ((fd = open("/dev/null", O_RDONLY)) != 0) + close(fd); + /* Make sure fds 1 and 2 are open */ + while (fd < 3) { + fd = open("/dev/null", O_WRONLY); + } + close(fd); + } + } void diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index bce4278337..a390c536bb 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. 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 @@ -58,10 +58,10 @@ ordering/1,unaligned_order/1,gc_test/1, bit_sized_binary_sizes/1, otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1, - otp_8180/1, ttb_trap/1]). + otp_8180/1, trapping/1]). %% Internal exports. --export([sleeper/0,ttb_loop/2]). +-export([sleeper/0,trapping_loop/4]). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,2}}]. @@ -76,7 +76,7 @@ all() -> bad_term_to_binary, more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order, gc_test, bit_sized_binary_sizes, otp_6817, otp_8117, deep, - obsolete_funs, robustness, otp_8180, ttb_trap]. + obsolete_funs, robustness, otp_8180, trapping]. groups() -> []. @@ -506,8 +506,8 @@ external_size(Config) when is_list(Config) -> io:format("Unaligned size: ~p\n", [Sz2]), ?line ?t:fail() end, - ?line erlang:external_size(Bin) =:= erlang:external_size(Bin, [{minor_version, 1}]), - ?line erlang:external_size(Unaligned) =:= erlang:external_size(Unaligned, [{minor_version, 1}]). + true = (erlang:external_size(Bin) =:= erlang:external_size(Bin, [{minor_version, 1}])), + true = (erlang:external_size(Unaligned) =:= erlang:external_size(Unaligned, [{minor_version, 1}])). external_size_1(Term, Size0, Limit) when Size0 < Limit -> case erlang:external_size(Term) of @@ -1241,16 +1241,27 @@ bsbs_1(A) -> Bin = binary_to_term_stress(<<131,$M,5:32,A,0,0,0,0,0>>), BinSize = bit_size(Bin). +%% lists:foldl(_,_,lists:seq(_,_)) with less heap consumption +lists_foldl_seq(Fun, Acc0, N, To) when N =< To -> + Acc1 = Fun(N, Acc0), + lists_foldl_seq(Fun, Acc1, N+1, To); + +lists_foldl_seq(_, Acc, _, _) -> + Acc. + deep(Config) when is_list(Config) -> - ?line deep_roundtrip(lists:foldl(fun(E, A) -> - [E,A] - end, [], lists:seq(1, 1000000))), - ?line deep_roundtrip(lists:foldl(fun(E, A) -> - {E,A} - end, [], lists:seq(1, 1000000))), - ?line deep_roundtrip(lists:foldl(fun(E, A) -> - fun() -> {E,A} end - end, [], lists:seq(1, 1000000))), + deep_roundtrip(lists_foldl_seq(fun(E, A) -> + [E,A] + end, [], 1, 1000000)), + erlang:garbage_collect(), + deep_roundtrip(lists_foldl_seq(fun(E, A) -> + {E,A} + end, [], 1, 1000000)), + erlang:garbage_collect(), + deep_roundtrip(lists_foldl_seq(fun(E, A) -> + fun() -> {E,A} end + end, [], 1, 1000000)), + erlang:garbage_collect(), ok. deep_roundtrip(T) -> @@ -1334,36 +1345,44 @@ run_otp_8180(Name) -> end || Bin <- Bins], ok. -%% Test that exit and GC during term_to_binary trap does not crash. -ttb_trap(Config) when is_list(Config)-> - case erlang:system_info(wordsize) of - N when N < 8 -> - {skipped, "Only on 64bit machines"}; - _ -> - do_ttb_trap(5) - end. +%% Test that exit and GC during trapping term_to_binary and binary_to_term +%% does not crash. +trapping(Config) when is_list(Config)-> + do_trapping(5, term_to_binary, + fun() -> [lists:duplicate(2000000,2000000)] end), + do_trapping(5, binary_to_term, + fun() -> [term_to_binary(lists:duplicate(2000000,2000000))] end). -do_ttb_trap(0) -> +do_trapping(0, _, _) -> ok; -do_ttb_trap(N) -> - Pid = spawn(?MODULE,ttb_loop,[1000,self()]), +do_trapping(N, Bif, ArgFun) -> + io:format("N=~p: Do ~p ~s gc.\n", [N, Bif, case N rem 2 of 0 -> "with"; 1 -> "without" end]), + Pid = spawn(?MODULE,trapping_loop,[Bif, ArgFun, 1000, self()]), receive ok -> ok end, receive after 100 -> ok end, - erlang:garbage_collect(Pid), - receive after 100 -> ok end, + Ref = make_ref(), + case N rem 2 of + 0 -> erlang:garbage_collect(Pid, [{async,Ref}]), + receive after 100 -> ok end; + 1 -> void + end, exit(Pid,kill), + case N rem 2 of + 0 -> receive {garbage_collect, Ref, _} -> ok end; + 1 -> void + end, receive after 1 -> ok end, - do_ttb_trap(N-1). + do_trapping(N-1, Bif, ArgFun). -ttb_loop(N,Pid) -> - Term = lists:duplicate(2000000,2000000), +trapping_loop(Bif, ArgFun, N, Pid) -> + Args = ArgFun(), Pid ! ok, - ttb_loop2(N,Term). -ttb_loop2(0,_T) -> + trapping_loop2(Bif,Args,N). +trapping_loop2(_,_,0) -> ok; -ttb_loop2(N,T) -> - apply(erlang,term_to_binary,[T]), - ttb_loop2(N-1,T). +trapping_loop2(Bif,Args,N) -> + apply(erlang,Bif,Args), + trapping_loop2(Bif, Args, N-1). %% Utilities. diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index 7087542899..06211406b4 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -2075,6 +2075,21 @@ thr_msg_blast(Config) when is_list(Config) -> Res end. +-define(IN_RANGE(LoW_, VaLuE_, HiGh_), + case in_range(LoW_, VaLuE_, HiGh_) of + true -> ok; + false -> + case erlang:system_info(lock_checking) of + true -> + ?t:format("~p:~p: Ignore bad sched count due to " + "lock checking~n", + [?MODULE,?LINE]); + false -> + ?t:fail({unexpected_sched_counts, VaLuE_}) + end + end). + + consume_timeslice(Config) when is_list(Config) -> %% %% Verify that erl_drv_consume_timeslice() works. @@ -2131,15 +2146,8 @@ consume_timeslice(Config) when is_list(Config) -> Proc1 ! Go, wait_command_msgs(Port, 10), [{Port, Sprt1}, {Proc1, Sproc1}] = count_pp_sched_stop([Port, Proc1]), - case Sprt1 of - 10 -> - true = in_range(5, Sproc1-10, 7); - _ -> - case erlang:system_info(lock_checking) of - true -> ?t:format("Ignore bad sched count due to lock checking", []); - false -> ?t:fail({unexpected_sched_counts, Sprt1, Sproc1}) - end - end, + ?IN_RANGE(10, Sprt1, 10), + ?IN_RANGE(5, Sproc1-10, 7), "disabled" = port_control(Port, $D, ""), Proc2 = spawn_link(fun () -> @@ -2160,15 +2168,8 @@ consume_timeslice(Config) when is_list(Config) -> Proc2 ! Go, wait_command_msgs(Port, 10), [{Port, Sprt2}, {Proc2, Sproc2}] = count_pp_sched_stop([Port, Proc2]), - case Sprt2 of - 10 -> - true = in_range(1, Sproc2-10, 2); - _ -> - case erlang:system_info(lock_checking) of - true -> ?t:format("Ignore bad sched count due to lock checking", []); - false -> ?t:fail({unexpected_sched_counts, Sprt2, Sproc2}) - end - end, + ?IN_RANGE(10, Sprt2, 10), + ?IN_RANGE(1, Sproc2-10, 2), "enabled" = port_control(Port, $E, ""), Proc3 = spawn_link(fun () -> @@ -2188,15 +2189,8 @@ consume_timeslice(Config) when is_list(Config) -> Proc3 ! Go, wait_command_msgs(Port, 10), [{Port, Sprt3}, {Proc3, Sproc3}] = count_pp_sched_stop([Port, Proc3]), - case Sprt3 of - 10 -> - true = in_range(5, Sproc3-10, 7); - _ -> - case erlang:system_info(lock_checking) of - true -> ?t:format("Ignore bad sched count due to lock checking", []); - false -> ?t:fail({unexpected_sched_counts, Sprt3, Sproc3}) - end - end, + ?IN_RANGE(10, Sprt3, 10), + ?IN_RANGE(5, Sproc3-10, 7), "disabled" = port_control(Port, $D, ""), Proc4 = spawn_link(fun () -> @@ -2216,15 +2210,8 @@ consume_timeslice(Config) when is_list(Config) -> Proc4 ! Go, wait_command_msgs(Port, 10), [{Port, Sprt4}, {Proc4, Sproc4}] = count_pp_sched_stop([Port, Proc4]), - case Sprt4 of - 10 -> - true = in_range(1, Sproc4-10, 2); - _ -> - case erlang:system_info(lock_checking) of - true -> ?t:format("Ignore bad sched count due to lock checking", []); - false -> ?t:fail({unexpected_sched_counts, Sprt4, Sproc4}) - end - end, + ?IN_RANGE(10, Sprt4, 10), + ?IN_RANGE(1, Sproc4-10, 2), SOnl = erlang:system_info(schedulers_online), %% If only one scheduler use port with parallelism set to true, @@ -2272,8 +2259,8 @@ consume_timeslice(Config) when is_list(Config) -> wait_procs_exit([W5, Proc5]), wait_command_msgs(Port2, 10), [{Port2, Sprt5}, {Proc5, Sproc5}] = count_pp_sched_stop([Port2, Proc5]), - true = in_range(2, Sproc5, 3), - true = in_range(7, Sprt5, 20), + ?IN_RANGE(2, Sproc5, 3), + ?IN_RANGE(6, Sprt5, 20), count_pp_sched_start(), "disabled" = port_control(Port2, $D, ""), @@ -2307,8 +2294,8 @@ consume_timeslice(Config) when is_list(Config) -> wait_procs_exit([W6, Proc6]), wait_command_msgs(Port2, 10), [{Port2, Sprt6}, {Proc6, Sproc6}] = count_pp_sched_stop([Port2, Proc6]), - true = in_range(2, Sproc6, 3), - true = in_range(3, Sprt6, 6), + ?IN_RANGE(2, Sproc6, 3), + ?IN_RANGE(2, Sprt6, 6), process_flag(scheduler, 0), @@ -2316,6 +2303,7 @@ consume_timeslice(Config) when is_list(Config) -> receive {Port2, closed} -> ok end, ok. + wait_command_msgs(_, 0) -> ok; wait_command_msgs(Port, N) -> diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl index 109cec25cb..09a7a87a9a 100644 --- a/erts/emulator/test/exception_SUITE.erl +++ b/erts/emulator/test/exception_SUITE.erl @@ -589,6 +589,13 @@ line_numbers(Config) when is_list(Config) -> [{file,ModFile},{line,_}]}|_]}} = (catch build_binary2(8, bad_binary)), + <<"abc",357:16>> = build_binary3(<<"abc">>), + {'EXIT',{badarg,[{?MODULE,build_binary3,1, + [{file,"bit_syntax.erl"},{line,72511}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary3(no_binary)), + {'EXIT',{function_clause, [{?MODULE,do_call_abs,[y,y], [{file,"gc_bif.erl"},{line,18}]}, @@ -691,6 +698,10 @@ build_binary2(Size, Bin) -> %Line 72505 id(0), %Line 72506 <<7:Size,Bin/binary>>. %Line 72507 +build_binary3(Bin) -> %Line 72509 + id(0), %Line 72510 + <<Bin/binary,357:16>>. %Line 72511 + -file("gc_bif.erl", 17). do_call_abs(x, Arg) -> %Line 18 abs(Arg). %Line 19 diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 81539faa09..6a43e2b0e7 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -1495,7 +1495,7 @@ mcall(Node, Funs) -> end, Refs). erl_rel_flag_var() -> - "ERL_"++erlang:system_info(otp_release)++"_FLAGS". + "ERL_OTP"++erlang:system_info(otp_release)++"_FLAGS". clear_erl_rel_flags() -> EnvVar = erl_rel_flag_var(), diff --git a/erts/emulator/utils/make_version b/erts/emulator/utils/make_version index 7757fa8138..02b68f2b39 100755 --- a/erts/emulator/utils/make_version +++ b/erts/emulator/utils/make_version @@ -41,6 +41,9 @@ if ($ARGV[0] eq '-o') { my $release = shift; defined $release or die "No release specified"; +my $correction_package = shift; +defined $correction_package or die "No correction package specified"; + my $version = shift; defined $version or die "No version name specified"; @@ -53,6 +56,7 @@ open(FILE, ">$outputfile") or die "Can't create $outputfile: $!"; print FILE <<EOF; /* This file was created by 'make_version' -- don't modify. */ #define ERLANG_OTP_RELEASE "$release" +#define ERLANG_OTP_CORRECTION_PACKAGE "$correction_package" #define ERLANG_VERSION "$version" #define ERLANG_COMPILE_DATE "$time_str" #define ERLANG_ARCHITECTURE "$architecture" diff --git a/erts/epmd/src/epmd_cli.c b/erts/epmd/src/epmd_cli.c index 8817bde8d7..bd30bc35d9 100644 --- a/erts/epmd/src/epmd_cli.c +++ b/erts/epmd/src/epmd_cli.c @@ -118,7 +118,7 @@ void epmd_call(EpmdVars *g,int what) if (!g->silent) { rval = erts_snprintf(buf, OUTBUF_SIZE, "epmd: up and running on port %d with data:\n", j); - write(1, buf, rval); + fwrite(buf, 1, rval, stdout); } while(1) { if ((rval = read(fd,buf,OUTBUF_SIZE)) <= 0) { @@ -126,7 +126,7 @@ void epmd_call(EpmdVars *g,int what) epmd_cleanup_exit(g,0); } if (!g->silent) - write(1, buf, rval); /* Potentially UTF-8 encoded */ + fwrite(buf, 1, rval, stdout); /* Potentially UTF-8 encoded */ } } diff --git a/erts/epmd/test/epmd_SUITE.erl b/erts/epmd/test/epmd_SUITE.erl index cc24a556a3..a752abf33b 100644 --- a/erts/epmd/test/epmd_SUITE.erl +++ b/erts/epmd/test/epmd_SUITE.erl @@ -69,6 +69,8 @@ returns_valid_empty_extra/1, returns_valid_populated_extra_with_nulls/1, + names_stdout/1, + buffer_overrun_1/1, buffer_overrun_2/1, no_nonlocal_register/1, @@ -118,6 +120,7 @@ all() -> too_large, alive_req_too_small_1, alive_req_too_small_2, alive_req_too_large, returns_valid_empty_extra, returns_valid_populated_extra_with_nulls, + names_stdout, {group, buffer_overrun}, no_nonlocal_register, no_nonlocal_kill, no_live_killing]. @@ -759,6 +762,24 @@ returns_valid_populated_extra_with_nulls(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +names_stdout(doc) -> + ["Test that epmd -names prints registered nodes to stdout"]; +names_stdout(suite) -> + []; +names_stdout(Config) when is_list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock} = register_node("foobar"), + ?line ok = epmdrun("-names"), + ?line {ok, Data} = receive {_Port, {data, D}} -> {ok, D} + after 10000 -> {error, timeout} + end, + ?line {match,_} = re:run(Data, "^epmd: up and running", [multiline]), + ?line {match,_} = re:run(Data, "^name foobar at port", [multiline]), + ?line ok = close(Sock), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + buffer_overrun_1(suite) -> []; buffer_overrun_1(doc) -> @@ -968,7 +989,7 @@ epmdrun(Epmd,Args0) -> O -> " "++O end, - osrun("\"" ++ Epmd ++ "\"" ++ Args ++ " " ?EPMDARGS " -port " ++ integer_to_list(?PORT)). + osrun("\"" ++ Epmd ++ "\"" ++ " " ?EPMDARGS " -port " ++ integer_to_list(?PORT) ++ Args). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 1d7811d570..c30203c632 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -1972,35 +1972,8 @@ get_file_args(char *filename, argv_buf *abp, argv_buf *xabp) } static void -write_erl_otp_flags(char *bufp) -{ - /* ERL_OTP<MAJOR-VSN>_FLAGS */ - int ix = 0; - char *otp_p; - char otp[] = OTP_SYSTEM_VERSION; - - bufp[ix++] = 'E'; - bufp[ix++] = 'R'; - bufp[ix++] = 'L'; - bufp[ix++] = '_'; - bufp[ix++] = 'O'; - bufp[ix++] = 'T'; - bufp[ix++] = 'P'; - for (otp_p = &otp[0]; '0' <= *otp_p && *otp_p <= '9'; otp_p++) - bufp[ix++] = *otp_p; - bufp[ix++] = '_'; - bufp[ix++] = 'F'; - bufp[ix++] = 'L'; - bufp[ix++] = 'A'; - bufp[ix++] = 'G'; - bufp[ix++] = 'S'; - bufp[ix] = '\0'; -} - -static void initial_argv_massage(int *argc, char ***argv) { - char erl_otp_flags_buf[] = "ERL_OTP" OTP_SYSTEM_VERSION "_FLAGS"; argv_buf ab = {0}, xab = {0}; int ix, vix, ac; char **av; @@ -2016,8 +1989,7 @@ initial_argv_massage(int *argc, char ***argv) vix = 0; - write_erl_otp_flags(erl_otp_flags_buf); - av = build_args_from_env(erl_otp_flags_buf); + av = build_args_from_env("ERL_OTP" OTP_SYSTEM_VERSION "_FLAGS"); if (av) avv[vix++].argv = av; diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index 73887931cc..8520d58f47 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -652,7 +652,7 @@ end define etp-ct-atom-1 # Args: int # -# Determines if integer is a atom first character +# Determines if integer is an atom first character # # Non-reentrant # Returns: $etp_ct_atom @@ -1278,6 +1278,250 @@ document etpf-stackdump %--------------------------------------------------------------------------- end +define etp-heapdump +# Args: Process* +# +# Non-reentrant + etp-heapdump-1 ($arg0)->heap ($arg0)->htop +end + +document etp-heapdump +%--------------------------------------------------------------------------- +% etp-heapdump Process* +% +% Take an Process* and print a heapdump for the process heap. +%--------------------------------------------------------------------------- +end + +define etp-heapdump-old +# Args: Process* +# +# Non-reentrant + etp-heapdump-1 ($arg0)->old_heap ($arg0)->old_htop +end + +document etp-heapdump +%--------------------------------------------------------------------------- +% etp-heapdump-old Process* +% +% Take an Process* and print a heapdump for the process old heap (gen-heap). +%--------------------------------------------------------------------------- +end + + +define etp-heapdump-1 +# Args: Eterm* heap, Eterm* htop +# +# Non-reentrant + set $etp_heapdump_heap = (Eterm*)($arg0) + set $etp_heapdump_p = (Eterm*)($arg0) + set $etp_heapdump_end = (Eterm*)($arg1) + set $etp_heapdump_skips = 0 + printf "%% heapdump (%u):\n", $etp_heapdump_end-$etp_heapdump_p + while $etp_heapdump_p < $etp_heapdump_end + set $etp_heapdump_ix = 0 + printf " %p: ", $etp_heapdump_p + while $etp_heapdump_p < $etp_heapdump_end && $etp_heapdump_ix < 8 + if ($etp_heapdump_skips > 0) + printf "| 0x%08x ", ($etp_heapdump_p) + set $etp_heapdump_skips-- + else + etp-term-dump $etp_heapdump_p[0] + end + set $etp_heapdump_p++ + set $etp_heapdump_ix++ + end + printf "\n" + end +end + + +define etp-term-dump +# Args: Eterm + if (($arg0) & 0x3) == 0 + etp-term-dump-header ($arg0) + else + if (($arg0) & 0x3) == 1 + # Cons pointer + set $etp_term_dump_cons_p = ((Eterm*)(($arg0) & ~0x3)) + if $etp_term_dump_cons_p > $etp_heapdump_heap && $etp_term_dump_cons_p < $etp_heapdump_end + printf "| C:0x%08x ", $etp_term_dump_cons_p + #printf "| C: --> %5d ", $etp_heapdump_p - $etp_term_dump_cons_p - 1 + else + printf "| C:0x%08x ", $etp_term_dump_cons_p + end + else + if (($arg0) & 0x3) == 2 + # Box pointer + printf "| B:0x%08x ", ($arg0) + else + if (($arg0) & 0x3) == 3 + # immediate + etp-term-dump-immediate ($arg0) + else + printf "| U:0x%08x ", ($arg0) + end + end + end + end +end + +define etp-term-dump-immediate +# Args: immediate term + if (($arg0) & 0xF) == 0xf + # Fixnum + etp-ct-printable-1 ((long)((Sint)($arg0)>>4)) + if $etp_ct_printable + if $etp_ct_printable < 0 + printf "| I: %c (%3ld) ", (long)((Sint)($arg0)>>4), (long)((Sint)($arg0)>>4) + else + printf "| I: \\%c (%3ld) ", (long)((Sint)($arg0)>>4), (long)((Sint)($arg0)>>4) + end + else + printf "| I:%10ld ", (long)((Sint)($arg0)>>4) + end + else + if (($arg0) & 0xF) == 0x3 + etp-term-dump-pid ($arg0) + else + if (($arg0) & 0xF) == 0x7 + printf "| port:0x%05x ", ($arg0) + else + # Immediate2 - 0xB + if (($arg0) & 0x3f) == 0x0b + etp-term-dump-atom ($arg0) + else + if (($arg0) & 0x3f) == 0x1b + printf "| #Catch<%06d> ", ($arg0)>>6 + else + if (($arg0) == $etp_nil) + printf "| [] (NIL) " + else + printf "| I:0x%08x ", ($arg0) + end + end + end + end + end + end +end + +define etp-term-dump-atom +# Args: atom term + set $etp_atom_1_ap = (Atom*)erts_atom_table.seg_table[(Eterm)($arg0)>>16][((Eterm)($arg0)>>6)&0x3FF] + set $etp_atom_1_i = ($etp_atom_1_ap)->len + set $etp_atom_1_p = ($etp_atom_1_ap)->name + set $etp_atom_1_quote = 1 + set $etp_atom_indent = 13 + + if ($etp_atom_1_i < 11) + if ($etp_atom_1_i > 0) + etp-ct-atom-1 (*$etp_atom_1_p) + if $etp_ct_atom + set $etp_atom_indent = 13 + else + set $etp_atom_indent = 11 + end + end + # perform indentation + printf "|" + while ($etp_atom_1_i < $etp_atom_indent) + printf " " + set $etp_atom_1_i++ + end + set $etp_atom_1_i = ($etp_atom_1_ap)->len + # Check if atom has to be quoted + if ($etp_atom_1_i > 0) + etp-ct-atom-1 (*$etp_atom_1_p) + if $etp_ct_atom + # Atom start character + set $etp_atom_1_p++ + set $etp_atom_1_i-- + set $etp_atom_1_quote = 0 + else + set $etp_atom_1_i = 0 + end + end + while $etp_atom_1_i > 0 + etp-ct-name-1 (*$etp_atom_1_p) + if $etp_ct_name + # Name character + set $etp_atom_1_p++ + set $etp_atom_1_i-- + else + set $etp_atom_1_quote = 1 + set $etp_atom_1_i = 0 + end + end + # Print the atom + if $etp_atom_1_quote + printf "'" + end + set $etp_atom_1_i = ($etp_atom_1_ap)->len + set $etp_atom_1_p = ($etp_atom_1_ap)->name + while $etp_atom_1_i > 0 + etp-char-1 (*$etp_atom_1_p) '\'' + set $etp_atom_1_p++ + set $etp_atom_1_i-- + end + if $etp_atom_1_quote + printf "'" + end + printf " " + else + printf "| A:0x%08x ", ($arg0) + end +end + +define etp-term-dump-pid +# Args: Eterm pid +# +# Non-reentrant +# + set $etp_pid_1 = (Eterm)($arg0) + if ($etp_pid_1 & 0xF) == 0x3 + if (etp_arch_bits == 64 && etp_halfword == 0) + if (etp_big_endian) + set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 36) & 0x0fffffff) + else + set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 4) & 0x0fffffff) + end + else + set $etp_pid_data = (unsigned) (((((Uint32) $etp_pid_1) >> 4) & ~erts_proc.r.o.pix_mask) | ((((Uint32) $etp_pid_1) >> (erts_proc.r.o.pix_cl_shift + 4)) & erts_proc.r.o.pix_cl_mask) | (((((Uint32) $etp_pid_1) >> 4) & erts_proc.r.o.pix_cli_mask) << erts_proc.r.o.pix_cli_shift)) + end + # Internal pid + printf "| <0.%04u.%03u> ", $etp_pid_data & 0x7fff, ($etp_pid_data >> 15) & 0x1fff + else + printf "| #NotPid<%#x> ", ($arg0) + end +end + +define etp-term-dump-header +# Args: Header term + if (($arg0) & 0x3f) == 0 + printf "| H:%4d-tuple ", ($arg0) >> 6 + else + set $etp_heapdump_skips = ($arg0) >> 6 + if ((($arg0) & 0x3f) == 0x18) + printf "| H: float %3d ", ($arg0) >> 6 + else + if ((($arg0) & 0x3f) == 0x28) + # sub-binary + printf "| H: sub-bin " + else + if ((($arg0) & 0x3f) == 0x8) + # pos-bignum + printf "| H:bignum %3u ", ($arg0) >> 6 + else + printf "| header %5d ", ($arg0) >> 6 + end + end + end + end +end + + + define etp-pid2pix-1 # Args: Eterm # @@ -1445,7 +1689,7 @@ define etp-process-info # Args: Process* # printf " Pid: " - etp-1 $arg0->common.id + etp-1 ($arg0)->common.id printf "\n State: " etp-proc-state $arg0 if $proxy_process != 0 @@ -1523,11 +1767,104 @@ end document etp-processes %--------------------------------------------------------------------------- % etp-processes -% +% % Print misc info about all processes %--------------------------------------------------------------------------- end +define etp-processes-memory + if (!erts_initialized) + printf "No processes, since system isn't initialized!\n" + else + set $proc_ix = 0 + printf "--- (%ld processes in wheel)\n", erts_proc.r.o.max + while $proc_ix < erts_proc.r.o.max + set $proc = (Process *) *((UWord *) &erts_proc.r.o.tab[$proc_ix]) + if ($proc != ((Process *) 0) && $proc != &erts_invalid_process) + etp-process-memory-info $proc + end + set $proc_ix++ + end + printf "---\n", + end +end + +document etp-processes-memory +%--------------------------------------------------------------------------- +% etp-processes-memory +% +% Print memory info about all processes +%--------------------------------------------------------------------------- +end + +define etp-process-memory-info +# Args: Process* +# + if ((*(((Uint32 *) &(((Process *) $arg0)->state)))) & 0x400000) + set $proxy_process = 1 + else + set $proxy_process = 0 + end + printf " " + etp-1 $arg0->common.id + printf ": (Process *) %p ", $arg0 + if $proxy_process != 0 + printf "(Process *) %p ", $arg0 + printf " *** PROXY process struct *** refer to next: \n" + etp-pid2proc-1 $arg0->common.id + printf " -" + etp-process-memory-info $proc + else + printf " [Heap: %5ld", $arg0->heap_sz + if ($arg0->old_heap) + printf " | %5ld", $arg0->old_hend - $arg0->old_heap + else + printf " | none " + end + printf "] [Mbuf: %5ld", $arg0->mbuf_sz + if (etp_smp_compiled) + printf " | %3ld (%3ld | %3ld)", ($arg0->msg.len + $arg0->msg_inq.len), $arg0->msg.len, $arg0->msg_inq.len + else + printf " | %3ld", $arg0->msg.len + end + printf "] " + if ($arg0->i) + printf " I: " + etp-cp-1 $arg0->i + printf " " + end + + if ($arg0->current) + etp-1 $arg0->current[0] + printf ":" + etp-1 $arg0->current[1] + printf "/%d ", $arg0->current[2] + end + + if (*(((Uint32 *) &(((Process *) $arg0)->state))) & 0x4) == 0 + if ($arg0->common.u.alive.reg) + etp-1 $arg0->common.u.alive.reg->name + printf " " + end + end + + if ($arg0->cp) + printf " CP: " + etp-cp-1 $arg0->cp + printf " " + end + printf "\n" + end +end + +document etp-process-memory-info +%--------------------------------------------------------------------------- +% etp-process-memory-info Process* +% +% Print memory info about process +%--------------------------------------------------------------------------- +end + define etp-port-id2pix-1 # Args: Eterm # diff --git a/erts/etc/win32/erlang.ico b/erts/etc/win32/erlang.ico Binary files differindex cee8b58af9..7b62d31aa9 100644 --- a/erts/etc/win32/erlang.ico +++ b/erts/etc/win32/erlang.ico diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 73fac27161..3c77d6ae0f 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 0ed677c3d8..f99d5bfdd0 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2246,6 +2246,7 @@ tuple_to_list(_Tuple) -> (modified_timing_level) -> integer() | undefined; (multi_scheduling) -> disabled | blocked | enabled; (multi_scheduling_blockers) -> [PID :: pid()]; + (otp_correction_package) -> string(); (otp_release) -> string(); (port_count) -> non_neg_integer(); (port_limit) -> pos_integer(); diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl index ed7a43c7e7..5002836954 100644 --- a/erts/test/erlc_SUITE.erl +++ b/erts/test/erlc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. 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 @@ -334,7 +334,7 @@ make_dep_options(Config) -> run(Config, Cmd0, Name, Options, Expect) -> Cmd = Cmd0 ++ " " ++ Options ++ " " ++ Name, - io:format("~s", [Cmd]), + io:format("~ts", [Cmd]), Result = run_command(Config, Cmd), verify_result(Result, Expect). @@ -356,7 +356,7 @@ split([], Current, Lines) -> split([], [], [lists:reverse(Current)|Lines]). match_messages([Msg|Rest1], [Regexp|Rest2]) -> - case re:run(Msg, Regexp, [{capture,none}]) of + case re:run(Msg, Regexp, [{capture,none}, unicode]) of match -> ok; nomatch -> @@ -398,7 +398,7 @@ run_command(Config, Cmd) -> TmpDir = filename:join(?config(priv_dir, Config), "tmp"), file:make_dir(TmpDir), {RunFile, Run, Script} = run_command(TmpDir, os:type(), Cmd), - ok = file:write_file(filename:join(TmpDir, RunFile), Script), + ok = file:write_file(filename:join(TmpDir, RunFile), unicode:characters_to_binary(Script)), os:cmd(Run). run_command(Dir, {win32, _}, Cmd) -> diff --git a/erts/test/erlexec_SUITE.erl b/erts/test/erlexec_SUITE.erl index 0dfe6c2e5f..f5ea8f160a 100644 --- a/erts/test/erlexec_SUITE.erl +++ b/erts/test/erlexec_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2013. 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 @@ -433,10 +433,10 @@ verify_not_args(Xs, Ys) -> Xs). emu_args(CmdLineArgs) -> - io:format("CmdLineArgs = ~s~n", [CmdLineArgs]), + io:format("CmdLineArgs = ~ts~n", [CmdLineArgs]), {ok,[[Erl]]} = init:get_argument(progname), EmuCL = os:cmd(Erl ++ " -emu_args_exit " ++ CmdLineArgs), - io:format("EmuCL = ~s", [EmuCL]), + io:format("EmuCL = ~ts", [EmuCL]), split_emu_clt(string:tokens(EmuCL, [$ ,$\t,$\n,$\r])). split_emu_clt(EmuCLT) -> diff --git a/erts/vsn.mk b/erts/vsn.mk index 30aa870144..8e77a9a26e 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,11 @@ # VSN = 6.0 -SYSTEM_VSN = 17.0-rc0 + +# OTP major version +SYSTEM_VSN = 17 +# OTP correction package version +SYSTEM_CP_VSN = 17.0-rc0 # Port number 4365 in 4.2 # Port number 4366 in 4.3 |