diff options
Diffstat (limited to 'erts/emulator')
33 files changed, 932 insertions, 376 deletions
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 2561d7a630..8c1f85ea37 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -66,8 +66,6 @@ load_module_2(BIF_ALIST_2) erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_smp_block_system(0); - erts_export_consolidate(); - hp = HAlloc(BIF_P, 3); sz = binary_size(BIF_ARG_2); if ((i = erts_load_module(BIF_P, 0, diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 773baad01f..c90795c343 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -612,9 +612,13 @@ static void bp_hash_delete(bp_time_hash_t *hash) { static void bp_time_diff(bp_data_time_item_t *item, /* out */ process_breakpoint_time_t *pbt, /* in */ Uint ms, Uint s, Uint us) { - int dms,ds,dus; + int ds,dus; +#ifdef DEBUG + int dms; + dms = ms - pbt->ms; +#endif ds = s - pbt->s; dus = us - pbt->us; @@ -622,7 +626,9 @@ static void bp_time_diff(bp_data_time_item_t *item, /* out */ * this is ok. */ +#ifdef DEBUG ASSERT(dms >= 0 || ds >= 0 || dus >= 0); +#endif if (dus < 0) { dus += 1000000; diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 4b5b5cbdaa..76912ebbd6 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -3967,8 +3967,7 @@ void process_main(void) * too big numbers). */ if (is_not_small(val) || val > make_small(0x10FFFFUL) || - (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL)) || - val == make_small(0xFFFEUL) || val == make_small(0xFFFFUL)) { + (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL))) { goto badarg; } Next(2); @@ -3987,8 +3986,8 @@ void process_main(void) * the valid range). */ if (is_not_small(tmp_arg1) || tmp_arg1 > make_small(0x10FFFFUL) || - (make_small(0xD800UL) <= tmp_arg1 && tmp_arg1 <= make_small(0xDFFFUL)) || - tmp_arg1 == make_small(0xFFFEUL) || tmp_arg1 == make_small(0xFFFFUL)) { + (make_small(0xD800UL) <= tmp_arg1 && + tmp_arg1 <= make_small(0xDFFFUL))) { ErlBinMatchBuffer *mb = ms_matchbuffer(tmp_arg2); mb->offset -= 32; @@ -4863,92 +4862,6 @@ void process_main(void) } /* - * Instructions for allocating on the message area. - */ - - OpCase(i_global_cons): - { - BeamInstr *next; -#ifdef HYBRID - Eterm *hp; - - PreFetch(0,next); - TestGlobalHeap(2,2,hp); - hp[0] = r(0); - hp[1] = x(1); - r(0) = make_list(hp); -#ifndef INCREMENTAL - global_htop += 2; -#endif - NextPF(0,next); -#else - PreFetch(0,next); - c_p->freason = EXC_INTERNAL_ERROR; - goto find_func_info; -#endif - } - - OpCase(i_global_tuple): - { - BeamInstr *next; - int len; -#ifdef HYBRID - Eterm list; - Eterm *hp; -#endif - - if ((len = list_length(r(0))) < 0) { - goto badarg; - } - - PreFetch(0,next); -#ifdef HYBRID - TestGlobalHeap(len + 1,1,hp); - list = r(0); - r(0) = make_tuple(hp); - *hp++ = make_arityval(len); - while(is_list(list)) - { - Eterm* cons = list_val(list); - *hp++ = CAR(cons); - list = CDR(cons); - } -#ifndef INCREMENTAL - global_htop += len + 1; -#endif - NextPF(0,next); -#else - c_p->freason = EXC_INTERNAL_ERROR; - goto find_func_info; -#endif - } - - OpCase(i_global_copy): - { - BeamInstr *next; - PreFetch(0,next); -#ifdef HYBRID - if (!IS_CONST(r(0))) - { - BM_SWAP_TIMER(system,copy); - SWAPOUT; - reg[0] = r(0); - reg[1] = NIL; - r(0) = copy_struct_lazy(c_p,r(0),0); - ASSERT(ma_src_top == 0); - ASSERT(ma_dst_top == 0); - ASSERT(ma_offset_top == 0); - SWAPIN; - BM_SWAP_TIMER(copy,system); - } - NextPF(0,next); -#else - c_p->freason = EXC_INTERNAL_ERROR; - goto find_func_info; -#endif - } - - /* * New floating point instructions. */ @@ -5241,7 +5154,6 @@ void process_main(void) OpCase(int_code_end): OpCase(label_L): - OpCase(too_old_compiler): OpCase(on_load): OpCase(line_I): erl_exit(1, "meta op\n"); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 16dd5795c7..d82b5dbcac 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -758,6 +758,14 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks, } /* + * Since the literal table *may* have contained external + * funs (containing references to export entries), now is + * the time to consolidate the export tables. + */ + + erts_export_consolidate(); + + /* * Load the code chunk. */ @@ -1570,10 +1578,15 @@ read_code_header(LoaderState* stp) /* * Verify the number of the highest opcode used. */ - GetInt(stp, 4, opcode_max); if (opcode_max > MAX_GENERIC_OPCODE) { - LoadError2(stp, "use of opcode %d; this emulator supports only up to %d", + LoadError2(stp, + "This BEAM file was compiled for a later version" + " of the run-time system than " ERLANG_OTP_RELEASE ".\n" + " To fix this, please recompile this module with an " + ERLANG_OTP_RELEASE " compiler.\n" + " (Use of opcode %d; this emulator supports " + "only up to %d.)", opcode_max, MAX_GENERIC_OPCODE); } @@ -1887,14 +1900,6 @@ load_code(LoaderState* stp) } /* - * Special error message instruction. - */ - if (stp->genop->op == genop_too_old_compiler_0) { - LoadError0(stp, "please re-compile this module with an " - ERLANG_OTP_RELEASE " compiler"); - } - - /* * From the collected generic instruction, find the specific * instruction. */ @@ -1945,7 +1950,27 @@ load_code(LoaderState* stp) ERLANG_OTP_RELEASE " compiler "); } - LoadError0(stp, "no specific operation found"); + /* + * Some generic instructions should have a special + * error message. + */ + switch (stp->genop->op) { + case genop_too_old_compiler_0: + LoadError0(stp, "please re-compile this module with an " + ERLANG_OTP_RELEASE " compiler"); + case genop_unsupported_guard_bif_3: + { + Eterm Mod = (Eterm) stp->genop->a[0].val; + Eterm Name = (Eterm) stp->genop->a[1].val; + Uint arity = (Uint) stp->genop->a[2].val; + FREE_GENOP(stp, stp->genop); + stp->genop = 0; + LoadError3(stp, "unsupported guard BIF: %T:%T/%d\n", + Mod, Name, arity); + } + default: + LoadError0(stp, "no specific operation found"); + } } stp->specific_op = specific; @@ -2409,6 +2434,8 @@ load_code(LoaderState* stp) #define no_fpe_signals(St) 0 #endif +#define never(St) 0 + /* * Predicate that tests whether a jump table can be used. */ @@ -3664,10 +3691,7 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, BifFunction bf; NEW_GENOP(stp, op); - op->op = genop_i_gc_bif1_5; - op->arity = 5; - op->a[0] = Fail; - op->a[1].type = TAG_u; + op->next = NULL; bf = stp->import[Bif.val].bf; /* The translations here need to have a reverse counterpart in beam_emu.c:translate_gc_bif for error handling to work properly. */ @@ -3688,19 +3712,30 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, } else if (bf == trunc_1) { op->a[1].val = (BeamInstr) (void *) erts_gc_trunc_1; } else { - abort(); + op->op = genop_unsupported_guard_bif_3; + op->arity = 3; + op->a[0].type = TAG_a; + op->a[0].val = stp->import[Bif.val].module; + op->a[1].type = TAG_a; + op->a[1].val = stp->import[Bif.val].function; + op->a[2].type = TAG_u; + op->a[2].val = stp->import[Bif.val].arity; + return op; } + op->op = genop_i_gc_bif1_5; + op->arity = 5; + op->a[0] = Fail; + op->a[1].type = TAG_u; op->a[2] = Src; op->a[3] = Live; op->a[4] = Dst; - op->next = NULL; return op; } /* - * This is used by the ops.tab rule that rewrites gc_bifs with two parameters + * This is used by the ops.tab rule that rewrites gc_bifs with two parameters. * The instruction returned is then again rewritten to an i_load instruction - * folowed by i_gc_bif2_jIId, to handle literals properly. + * followed by i_gc_bif2_jIId, to handle literals properly. * As opposed to the i_gc_bif1_jIsId, the instruction i_gc_bif2_jIId is * always rewritten, regardless of if there actually are any literals. */ @@ -3712,31 +3747,39 @@ gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, BifFunction bf; NEW_GENOP(stp, op); - op->op = genop_ii_gc_bif2_6; - op->arity = 6; - op->a[0] = Fail; - op->a[1].type = TAG_u; + op->next = NULL; bf = stp->import[Bif.val].bf; /* The translations here need to have a reverse counterpart in beam_emu.c:translate_gc_bif for error handling to work properly. */ if (bf == binary_part_2) { op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_2; } else { - abort(); + op->op = genop_unsupported_guard_bif_3; + op->arity = 3; + op->a[0].type = TAG_a; + op->a[0].val = stp->import[Bif.val].module; + op->a[1].type = TAG_a; + op->a[1].val = stp->import[Bif.val].function; + op->a[2].type = TAG_u; + op->a[2].val = stp->import[Bif.val].arity; + return op; } + op->op = genop_ii_gc_bif2_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1].type = TAG_u; op->a[2] = S1; op->a[3] = S2; op->a[4] = Live; op->a[5] = Dst; - op->next = NULL; return op; } /* - * This is used by the ops.tab rule that rewrites gc_bifs with three parameters + * This is used by the ops.tab rule that rewrites gc_bifs with three parameters. * The instruction returned is then again rewritten to a move instruction that * uses r[0] for temp storage, followed by an i_load instruction, - * folowed by i_gc_bif3_jIsId, to handle literals properly. Rewriting + * followed by i_gc_bif3_jIsId, to handle literals properly. Rewriting * always occur, as with the gc_bif2 counterpart. */ static GenOp* @@ -3747,18 +3790,27 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, BifFunction bf; NEW_GENOP(stp, op); - op->op = genop_ii_gc_bif3_7; - op->arity = 7; - op->a[0] = Fail; - op->a[1].type = TAG_u; + op->next = NULL; bf = stp->import[Bif.val].bf; /* The translations here need to have a reverse counterpart in beam_emu.c:translate_gc_bif for error handling to work properly. */ if (bf == binary_part_3) { op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_3; } else { - abort(); + op->op = genop_unsupported_guard_bif_3; + op->arity = 3; + op->a[0].type = TAG_a; + op->a[0].val = stp->import[Bif.val].module; + op->a[1].type = TAG_a; + op->a[1].val = stp->import[Bif.val].function; + op->a[2].type = TAG_u; + op->a[2].val = stp->import[Bif.val].arity; + return op; } + op->op = genop_ii_gc_bif3_7; + op->arity = 7; + op->a[0] = Fail; + op->a[1].type = TAG_u; op->a[2] = S1; op->a[3] = S2; op->a[4] = S3; @@ -4225,6 +4277,7 @@ transform_engine(LoaderState* st) GenOp* instr; Uint* pc; int rval; + static Uint restart_fail[1] = {TOP_fail}; ASSERT(gen_opc[st->genop->op].transform != -1); pc = op_transform + gen_opc[st->genop->op].transform; @@ -4238,7 +4291,6 @@ transform_engine(LoaderState* st) ASSERT(restart != NULL); pc = restart; ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ - ASSERT(*pc == TOP_try_me_else || *pc == TOP_fail); instr = st->genop; #define RETURN(r) rval = (r); goto do_return; @@ -4251,7 +4303,9 @@ transform_engine(LoaderState* st) op = *pc++; switch (op) { - case TOP_is_op: + case TOP_next_instr: + instr = instr->next; + ap = 0; if (instr == NULL) { /* * We'll need at least one more instruction to decide whether @@ -4438,10 +4492,6 @@ transform_engine(LoaderState* st) case TOP_next_arg: ap++; break; - case TOP_next_instr: - instr = instr->next; - ap = 0; - break; case TOP_commit: instr = instr->next; /* The next_instr was optimized away. */ @@ -4459,8 +4509,8 @@ transform_engine(LoaderState* st) #endif break; -#if defined(TOP_call) - case TOP_call: +#if defined(TOP_call_end) + case TOP_call_end: { GenOp** lastp; GenOp* new_instr; @@ -4497,7 +4547,7 @@ transform_engine(LoaderState* st) *lastp = st->genop; st->genop = new_instr; } - break; + RETURN(TE_OK); #endif case TOP_new_instr: /* @@ -4506,12 +4556,10 @@ transform_engine(LoaderState* st) NEW_GENOP(st, instr); instr->next = st->genop; st->genop = instr; + instr->op = op = *pc++; + instr->arity = gen_opc[op].arity; ap = 0; break; - case TOP_store_op: - instr->op = *pc++; - instr->arity = *pc++; - break; case TOP_store_type: i = *pc++; instr->a[ap].type = i; @@ -4521,21 +4569,25 @@ transform_engine(LoaderState* st) i = *pc++; instr->a[ap].val = i; break; - case TOP_store_var: + case TOP_store_var_next_arg: i = *pc++; ASSERT(i < TE_MAX_VARS); instr->a[ap].type = var[i].type; instr->a[ap].val = var[i].val; + ap++; break; case TOP_try_me_else: restart = pc + 1; restart += *pc++; ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ break; + case TOP_try_me_else_fail: + restart = restart_fail; + break; case TOP_end: RETURN(TE_OK); case TOP_fail: - RETURN(TE_FAIL) + RETURN(TE_FAIL); default: ASSERT(0); } diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 5b3261077b..76086860dd 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -4291,8 +4291,7 @@ void erts_bif_prep_await_proc_exit_data_trap(Process *c_p, Eterm pid, Eterm ret) { if (skip_current_msgq(c_p)) { - Eterm unused; - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_data, ret); + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_data, ret); } } @@ -4300,8 +4299,7 @@ void erts_bif_prep_await_proc_exit_reason_trap(Process *c_p, Eterm pid) { if (skip_current_msgq(c_p)) { - Eterm unused; - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_reason, am_undefined); } } @@ -4316,7 +4314,6 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, { ASSERT(is_atom(module) && is_atom(function)); if (skip_current_msgq(c_p)) { - Eterm unused; Eterm term; Eterm *hp; int i; @@ -4328,7 +4325,7 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, hp += 2; } term = TUPLE3(hp, module, function, term); - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_apply, term); + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_apply, term); } } diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index 8faa09feb8..66f152a6ea 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -160,6 +160,17 @@ do { \ (Ret) = THE_NON_VALUE; \ } while (0) +#define ERTS_BIF_PREP_TRAP3_NO_RET(Trap, Proc, A0, A1, A2)\ +do { \ + (Proc)->arity = 3; \ + (Proc)->def_arg_reg[0] = (Eterm) (A0); \ + (Proc)->def_arg_reg[1] = (Eterm) (A1); \ + (Proc)->def_arg_reg[2] = (Eterm) (A2); \ + *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \ + (Proc)->freason = TRAP; \ +} while (0) + + #define BIF_TRAP0(p, Trap_) do { \ (p)->arity = 0; \ *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \ diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index d18de9ae5d..b90ea6b478 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1584,6 +1584,62 @@ big_to_double(Wterm x, double* resp) return 0; } +/* + * Logic has been copied from erl_bif_guard.c and slightly + * modified to use a static instead of dynamic heap + */ +Eterm +double_to_big(double x, Eterm *heap) +{ + int is_negative; + int ds; + ErtsDigit* xp; + Eterm res; + int i; + size_t sz; + Eterm* hp; + double dbase; + + if (x >= 0) { + is_negative = 0; + } else { + is_negative = 1; + x = -x; + } + + /* Unscale & (calculate exponent) */ + ds = 0; + dbase = ((double) (D_MASK) + 1); + while (x >= 1.0) { + x /= dbase; /* "shift" right */ + ds++; + } + sz = BIG_NEED_SIZE(ds); /* number of words including arity */ + + hp = heap; + res = make_big(hp); + xp = (ErtsDigit*) (hp + 1); + + for (i = ds - 1; i >= 0; i--) { + ErtsDigit d; + + x *= dbase; /* "shift" left */ + d = x; /* trunc */ + xp[i] = d; /* store digit */ + x -= d; /* remove integer part */ + } + while ((ds & (BIG_DIGITS_PER_WORD - 1)) != 0) { + xp[ds++] = 0; + } + + if (is_negative) { + *hp = make_neg_bignum_header(sz-1); + } else { + *hp = make_pos_bignum_header(sz-1); + } + return res; +} + /* ** Estimate the number of decimal digits (include sign) diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 2afc37004f..256f1c2b45 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -140,6 +140,7 @@ Eterm big_lshift(Eterm, Sint, Eterm*); int big_comp (Wterm, Wterm); int big_ucomp (Eterm, Eterm); int big_to_double(Wterm x, double* resp); +Eterm double_to_big(double, Eterm*); Eterm small_to_big(Sint, Eterm*); Eterm uint_to_big(Uint, Eterm*); Eterm uword_to_big(UWord, Eterm*); diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index 1fb39c6c67..29461877c5 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -356,8 +356,10 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg) { Eterm bin; Uint size; - int offset; byte* bytes; +#ifdef DEBUG + int offset; +#endif if (is_nil(arg)) { BIF_RET(new_binary(p,(byte*)"",0)); @@ -372,7 +374,11 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg) } bin = new_binary(p, (byte *)NULL, size); bytes = binary_bytes(bin); - offset = io_list_to_buf(arg, (char*) bytes, size); +#ifdef DEBUG + offset = +#endif + io_list_to_buf(arg, (char*) bytes, size); + ASSERT(offset == 0); BIF_RET(bin); diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index e17325b64f..de5e4046fa 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -119,6 +119,10 @@ static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE # define PERFMON_GETPCR _IOR('P', 2, unsigned long long) #endif +/* Cached, pre-built {OsType,OsFlavor} and {Major,Minor,Build} tuples */ +static Eterm os_type_tuple; +static Eterm os_version_tuple; + static Eterm current_function(Process* p, Process* rp, Eterm** hpp, int full_info); static Eterm current_stacktrace(Process* p, Process* rp, Eterm** hpp); @@ -2227,16 +2231,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) return erts_instr_get_type_info(BIF_P); } else if (BIF_ARG_1 == am_os_type) { - Eterm type = am_atom_put(os_type, strlen(os_type)); - Eterm flav, tup; - char *buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */ - - os_flavor(buf, 1024); - flav = am_atom_put(buf, strlen(buf)); - hp = HAlloc(BIF_P, 3); - tup = TUPLE2(hp, type, flav); - erts_free(ERTS_ALC_T_TMP, (void *) buf); - BIF_RET(tup); + BIF_RET(os_type_tuple); } else if (BIF_ARG_1 == am_allocator) { BIF_RET(erts_allocator_options((void *) BIF_P)); @@ -2262,16 +2257,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(am_false); } else if (BIF_ARG_1 == am_os_version) { - int major, minor, build; - Eterm tup; - - os_version(&major, &minor, &build); - hp = HAlloc(BIF_P, 4); - tup = TUPLE3(hp, - make_small(major), - make_small(minor), - make_small(build)); - BIF_RET(tup); + BIF_RET(os_version_tuple); } else if (BIF_ARG_1 == am_version) { int n = strlen(ERLANG_VERSION); @@ -4107,6 +4093,27 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } +static void os_info_init(void) +{ + Eterm type = am_atom_put(os_type, strlen(os_type)); + Eterm flav; + int major, minor, build; + char* buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */ + Eterm* hp; + + os_flavor(buf, 1024); + flav = am_atom_put(buf, strlen(buf)); + erts_free(ERTS_ALC_T_TMP, (void *) buf); + hp = erts_alloc(ERTS_ALC_T_LL_TEMP_TERM, (3+4)*sizeof(Eterm)); + os_type_tuple = TUPLE2(hp, type, flav); + hp += 3; + os_version(&major, &minor, &build); + os_version_tuple = TUPLE3(hp, + make_small(major), + make_small(minor), + make_small(build)); +} + void erts_bif_info_init(void) { @@ -4114,4 +4121,5 @@ erts_bif_info_init(void) erts_smp_atomic_init_nob(&hipe_test_reschedule_flag, 0); process_info_init(); + os_info_init(); } diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c index 326a5c136b..6f7309f493 100644 --- a/erts/emulator/beam/erl_bits.c +++ b/erts/emulator/beam/erl_bits.c @@ -845,8 +845,7 @@ erts_bs_put_utf8(ERL_BITS_PROTO_1(Eterm arg)) dst[1] = 0x80 | (val & 0x3F); num_bits = 16; } else if (val < 0x10000UL) { - if ((0xD800 <= val && val <= 0xDFFF) || - val == 0xFFFE || val == 0xFFFF) { + if (0xD800 <= val && val <= 0xDFFF) { return 0; } dst[0] = 0xE0 | (val >> 12); @@ -886,8 +885,7 @@ erts_bs_put_utf16(ERL_BITS_PROTO_2(Eterm arg, Uint flags)) return 0; } val = unsigned_val(arg); - if (val > 0x10FFFF || (0xD800 <= val && val <= 0xDFFF) || - val == 0xFFFE || val == 0xFFFF) { + if (val > 0x10FFFF || (0xD800 <= val && val <= 0xDFFF)) { return 0; } @@ -1652,8 +1650,7 @@ erts_bs_get_utf8(ErlBinMatchBuffer* mb) return THE_NON_VALUE; } result = (((result << 6) + a) << 6) + b - (Eterm) 0x000E2080UL; - if ((0xD800 <= result && result <= 0xDFFF) || - result == 0xFFFE || result == 0xFFFF) { + if (0xD800 <= result && result <= 0xDFFF) { return THE_NON_VALUE; } mb->offset += 24; @@ -1723,9 +1720,6 @@ erts_bs_get_utf16(ErlBinMatchBuffer* mb, Uint flags) w1 = (src[0] << 8) | src[1]; } if (w1 < 0xD800 || w1 > 0xDFFF) { - if (w1 == 0xFFFE || w1 == 0xFFFF) { - return THE_NON_VALUE; - } mb->offset += 16; return make_small(w1); } else if (w1 > 0xDBFF) { diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 0327850cb9..ee6e1771d0 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -1297,7 +1297,9 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) Uint32 status; Sint keypos; int is_named, is_fine_locked, frequent_read, is_compressed; +#ifdef DEBUG int cret; +#endif DeclareTmpHeap(meta_tuple,3,BIF_P); DbTableMethod* meth; erts_smp_rwmtx_t *mmtl; @@ -1445,7 +1447,10 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) tb->common.fixations = NULL; tb->common.compress = is_compressed; - cret = meth->db_create(BIF_P, tb); +#ifdef DEBUG + cret = +#endif + meth->db_create(BIF_P, tb); ASSERT(cret == DB_ERROR_NONE); erts_smp_spin_lock(&meta_main_tab_main_lock); @@ -2606,7 +2611,9 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1) int i; Eterm* hp; /*Process* rp = NULL;*/ + /* If/when we implement lockless private tables: Eterm owner; + */ if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) { if (is_atom(BIF_ARG_1) || is_small(BIF_ARG_1)) { @@ -2615,7 +2622,9 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } + /* If/when we implement lockless private tables: owner = tb->common.owner; + */ /* If/when we implement lockless private tables: if ((tb->common.status & DB_PRIVATE) && owner != BIF_P->id) { diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 7dfbb2ed02..42079a7cee 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -2846,7 +2846,9 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) Uint new_sz = offset + db_size_dbterm_comp(tb, obj); byte* basep; DbTerm* newp; +#ifdef DEBUG byte* top; +#endif ASSERT(tb->compress); if (old != 0) { @@ -2868,7 +2870,10 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) } newp->size = size_object(obj); - top = copy_to_comp(tb, obj, newp, new_sz); +#ifdef DEBUG + top = +#endif + copy_to_comp(tb, obj, newp, new_sz); ASSERT(top <= basep + new_sz); /* ToDo: Maybe realloc if ((basep+new_sz) - top) > WASTED_SPACE_LIMIT */ diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index f3db3f9326..224931c3fb 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -435,6 +435,11 @@ int enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term) return term == THE_NON_VALUE; } +int enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term) +{ + return is_number(term); +} + static void aligned_binary_dtor(struct enif_tmp_obj_t* obj) { erts_free_aligned_binary_bytes_extra((byte*)obj,ERTS_ALC_T_TMP); @@ -676,6 +681,7 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, ErlSubBin* sb; Eterm orig; Uint offset, bit_offset, bit_size; +#ifdef DEBUG unsigned src_size; ASSERT(is_binary(bin_term)); @@ -683,6 +689,7 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, ASSERT(pos <= src_size); ASSERT(size <= src_size); ASSERT(pos + size <= src_size); +#endif sb = (ErlSubBin*) alloc_heap(env, ERL_SUB_BIN_SIZE); ERTS_GET_REAL_BIN(bin_term, orig, offset, bit_offset, bit_size); sb->thing_word = HEADER_SUB_BIN; diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index 4af9f61000..6396af09d0 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -137,6 +137,7 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64)); #endif ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term)); ERL_NIF_API_FUNC_DECL(int,enif_make_reverse_list,(ErlNifEnv*, ERL_NIF_TERM term, ERL_NIF_TERM *list)); +ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term)); /* ** Add new entries here to keep compatibility on Windows!!! @@ -258,12 +259,206 @@ ERL_NIF_API_FUNC_DECL(int,enif_make_reverse_list,(ErlNifEnv*, ERL_NIF_TERM term, # define enif_is_exception ERL_NIF_API_FUNC_MACRO(enif_is_exception) # define enif_make_reverse_list ERL_NIF_API_FUNC_MACRO(enif_make_reverse_list) +# define enif_is_number ERL_NIF_API_FUNC_MACRO(enif_is_number) /* ** Add new entries here */ #endif + +#if defined(__GNUC__) && !(defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) + +/* Inline functions for compile time type checking of arguments to + variadic functions. +*/ + +# define ERL_NIF_INLINE __inline__ + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple1(ErlNifEnv* env, + ERL_NIF_TERM e1) +{ + return enif_make_tuple(env, 1, e1); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple2(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2) +{ + return enif_make_tuple(env, 2, e1, e2); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple3(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3) +{ + return enif_make_tuple(env, 3, e1, e2, e3); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple4(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4) +{ + return enif_make_tuple(env, 4, e1, e2, e3, e4); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple5(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5) +{ + return enif_make_tuple(env, 5, e1, e2, e3, e4, e5); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple6(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6) +{ + return enif_make_tuple(env, 6, e1, e2, e3, e4, e5, e6); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple7(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7) +{ + return enif_make_tuple(env, 7, e1, e2, e3, e4, e5, e6, e7); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple8(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8) +{ + return enif_make_tuple(env, 8, e1, e2, e3, e4, e5, e6, e7, e8); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple9(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8, + ERL_NIF_TERM e9) +{ + return enif_make_tuple(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list1(ErlNifEnv* env, + ERL_NIF_TERM e1) +{ + return enif_make_list(env, 1, e1); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list2(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2) +{ + return enif_make_list(env, 2, e1, e2); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list3(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3) +{ + return enif_make_list(env, 3, e1, e2, e3); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list4(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4) +{ + return enif_make_list(env, 4, e1, e2, e3, e4); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list5(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5) +{ + return enif_make_list(env, 5, e1, e2, e3, e4, e5); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list6(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6) +{ + return enif_make_list(env, 6, e1, e2, e3, e4, e5, e6); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list7(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7) +{ + return enif_make_list(env, 7, e1, e2, e3, e4, e5, e6, e7); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list8(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8) +{ + return enif_make_list(env, 8, e1, e2, e3, e4, e5, e6, e7, e8); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list9(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8, + ERL_NIF_TERM e9) +{ + return enif_make_list(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9); +} + +# undef ERL_NIF_INLINE + +#else /* fallback with macros */ + #ifndef enif_make_list1 # define enif_make_list1(ENV,E1) enif_make_list(ENV,1,E1) # define enif_make_list2(ENV,E1,E2) enif_make_list(ENV,2,E1,E2) @@ -283,6 +478,11 @@ ERL_NIF_API_FUNC_DECL(int,enif_make_reverse_list,(ErlNifEnv*, ERL_NIF_TERM term, # define enif_make_tuple7(ENV,E1,E2,E3,E4,E5,E6,E7) enif_make_tuple(ENV,7,E1,E2,E3,E4,E5,E6,E7) # define enif_make_tuple8(ENV,E1,E2,E3,E4,E5,E6,E7,E8) enif_make_tuple(ENV,8,E1,E2,E3,E4,E5,E6,E7,E8) # 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) +#endif + +#endif /* __GNUC__ && !WIN32 */ + +#ifndef enif_make_pid # define enif_make_pid(ENV, PID) ((const ERL_NIF_TERM)((PID)->pid)) diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c index 83379d7352..b4d20480c5 100644 --- a/erts/emulator/beam/erl_process_lock.c +++ b/erts/emulator/beam/erl_process_lock.c @@ -669,7 +669,9 @@ proc_safelock(Process *a_proc, ErtsProcLocks b_need_locks) { Process *p1, *p2; +#ifdef ERTS_ENABLE_LOCK_CHECK Eterm pid1, pid2; +#endif erts_pix_lock_t *pix_lck1, *pix_lck2; ErtsProcLocks need_locks1, have_locks1, need_locks2, have_locks2; ErtsProcLocks unlock_mask; @@ -684,24 +686,32 @@ proc_safelock(Process *a_proc, if (a_proc) { if (a_proc->id < b_proc->id) { p1 = a_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = a_proc->id; +#endif pix_lck1 = a_pix_lck; need_locks1 = a_need_locks; have_locks1 = a_have_locks; p2 = b_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = b_proc->id; +#endif pix_lck2 = b_pix_lck; need_locks2 = b_need_locks; have_locks2 = b_have_locks; } else if (a_proc->id > b_proc->id) { p1 = b_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = b_proc->id; +#endif pix_lck1 = b_pix_lck; need_locks1 = b_need_locks; have_locks1 = b_have_locks; p2 = a_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = a_proc->id; +#endif pix_lck2 = a_pix_lck; need_locks2 = a_need_locks; have_locks2 = a_have_locks; @@ -710,12 +720,16 @@ proc_safelock(Process *a_proc, ERTS_LC_ASSERT(a_proc == b_proc); ERTS_LC_ASSERT(a_proc->id == b_proc->id); p1 = a_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = a_proc->id; +#endif pix_lck1 = a_pix_lck; need_locks1 = a_need_locks | b_need_locks; have_locks1 = a_have_locks | b_have_locks; p2 = NULL; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = 0; +#endif pix_lck2 = NULL; need_locks2 = 0; have_locks2 = 0; @@ -723,12 +737,16 @@ proc_safelock(Process *a_proc, } else { p1 = b_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = b_proc->id; +#endif pix_lck1 = b_pix_lck; need_locks1 = b_need_locks; have_locks1 = b_have_locks; p2 = NULL; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = 0; +#endif pix_lck2 = NULL; need_locks2 = 0; have_locks2 = 0; diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index 158eb361a4..bd5f3cc4c1 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -348,12 +348,6 @@ static int copy_utf8_bin(byte *target, byte *source, Uint size, return copied; } - if (((*source) == 0xEF) && (source[1] == 0xBF) && - ((source[2] == 0xBE) || (source[2] == 0xBF))) { - *err_pos = source; - return copied; - } - *(target++) = *(source++); *(target++) = *(source++); *(target++) = *(source++); @@ -714,9 +708,8 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */ target[(*pos)++] = (((byte) (x & 0x3F)) | ((byte) 0x80)); } else if (x < 0x10000) { - if ((x >= 0xD800 && x <= 0xDFFF) || - (x == 0xFFFE) || - (x == 0xFFFF)) { /* Invalid unicode range */ + if (x >= 0xD800 && x <= 0xDFFF) { + /* Invalid unicode range */ *err = 1; goto done; } @@ -1230,10 +1223,6 @@ int erts_analyze_utf8(byte *source, Uint size, ((source[1] & 0x20) != 0)) { return ERTS_UTF8_ERROR; } - if (((*source) == 0xEF) && (source[1] == 0xBF) && - ((source[2] == 0xBE) || (source[2] == 0xBF))) { - return ERTS_UTF8_ERROR; - } source += 3; size -= 3; } else if (((*source) & ((byte) 0xF8)) == 0xF0) { @@ -2166,9 +2155,8 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */ } else if (x < 0x800) { need += 2; } else if (x < 0x10000) { - if ((x >= 0xD800 && x <= 0xDFFF) || - (x == 0xFFFE) || - (x == 0xFFFF)) { /* Invalid unicode range */ + if (x >= 0xD800 && x <= 0xDFFF) { + /* Invalid unicode range */ DESTROY_ESTACK(stack); return ((Sint) -1); } @@ -2314,9 +2302,7 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */ *p++ = (((byte) (x & 0x3F)) | ((byte) 0x80)); } else if (x < 0x10000) { - ASSERT(!((x >= 0xD800 && x <= 0xDFFF) || - (x == 0xFFFE) || - (x == 0xFFFF))); + ASSERT(!(x >= 0xD800 && x <= 0xDFFF)); *p++ = (((byte) (x >> 12)) | ((byte) 0xE0)); *p++ = ((((byte) (x >> 6)) & 0x3F) | diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index e7fd144ec3..f810392e60 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -55,7 +55,7 @@ heap data on the C stack or if we use the buffers in the scheduler data. */ #define TMP_HEAP_SIZE 128 /* Number of Eterm in the schedulers small heap for transient heap data */ -#define CMP_TMP_HEAP_SIZE 2 /* cmp wants its own tmp-heap... */ +#define CMP_TMP_HEAP_SIZE 32 /* cmp wants its own tmp-heap... */ #define ERL_ARITH_TMP_HEAP_SIZE 4 /* as does erl_arith... */ #define BEAM_EMU_TMP_HEAP_SIZE 2 /* and beam_emu... */ diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 538f0b94af..34bd5d0653 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -25,30 +25,12 @@ # instruction transformations; thus, they never occur in BEAM files. # -# Special instruction used to generate an error message when -# trying to load a module compiled by the V1 compiler (R5 & R6). -# (Specially treated in beam_load.c.) +# The too_old_compiler/0 instruction is specially handled in beam_load.c +# to produce a user-friendly message informing the user that the module +# needs to be re-compiled with a modern compiler. too_old_compiler/0 -too_old_compiler - -# -# Obsolete instruction usage follow. (Nowdays we use f with -# a zero label instead of p.) -# - -is_list p S => too_old_compiler -is_nonempty_list p R => too_old_compiler -is_nil p R => too_old_compiler - -is_tuple p S => too_old_compiler -test_arity p S Arity => too_old_compiler - -is_integer p R => too_old_compiler -is_float p R => too_old_compiler -is_atom p R => too_old_compiler - -is_eq_exact p S1 S2 => too_old_compiler +too_old_compiler | never() => # In R9C and earlier, the loader used to insert special instructions inside # the module_info/0,1 functions. (In R10B and later, the compiler inserts @@ -88,9 +70,6 @@ i_time_breakpoint i_return_time_trace i_return_to_trace i_yield -i_global_cons -i_global_tuple -i_global_copy return @@ -310,8 +289,6 @@ raise s s badarg j system_limit j -move R R => - move C=cxy r | jump Lbl => move_jump Lbl C %macro: move_jump MoveJump -nonext @@ -618,8 +595,6 @@ get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst | original_reg Reg original_reg Reg Pos => -get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst - original_reg/2 extract_next_element D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \ @@ -908,23 +883,6 @@ call_ext_last u==3 u$func:erlang:hibernate/3 D => i_hibernate call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate # -# Hybrid memory architecture need special cons and tuple instructions -# that allocate on the message area. These looks like BIFs in the BEAM code. -# - -call_ext u==2 u$func:hybrid:cons/2 => i_global_cons -call_ext_last u==2 u$func:hybrid:cons/2 D => i_global_cons | deallocate_return D -call_ext_only Ar=u==2 u$func:hybrid:cons/2 => i_global_cons | return - -call_ext u==1 u$func:hybrid:tuple/1 => i_global_tuple -call_ext_last u==1 u$func:hybrid:tuple/1 D => i_global_tuple | deallocate_return D -call_ext_only Ar=u==1 u$func:hybrid:tuple/1 => i_global_tuple | return - -call_ext u==1 u$func:hybrid:copy/1 => i_global_copy -call_ext_last u==1 u$func:hybrid:copy/1 D => i_global_copy | deallocate_return D -call_ext_only u==1 Ar=u$func:hybrid:copy/1 => i_global_copy | return - -# # The general case for BIFs that have no special instructions. # A BIF used in the tail must be followed by a return instruction. # @@ -961,9 +919,9 @@ move S=c r | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S r Func move S=c r | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S r move S=c r | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S r -call_ext Ar=u Func => i_call_ext Func -call_ext_last Ar=u Func D => i_call_ext_last Func D -call_ext_only Ar=u Func => i_call_ext_only Func +call_ext Ar Func => i_call_ext Func +call_ext_last Ar Func D => i_call_ext_last Func D +call_ext_only Ar Func => i_call_ext_only Func i_apply i_apply_last P @@ -997,7 +955,7 @@ bif1 p Bif S1 Dst => bif1_body Bif S1 Dst bif1_body Bif Literal=q Dst => move Literal x | bif1_body Bif x Dst bif2 p Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2_body Bif Dst -bif2 Fail=f Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst +bif2 Fail Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst i_get s d @@ -1080,8 +1038,8 @@ i_move_call_ext_only e c r # Fun calls. -call_fun Arity=u | deallocate D | return => i_call_fun_last Arity D -call_fun Arity=u => i_call_fun Arity +call_fun Arity | deallocate D | return => i_call_fun_last Arity D +call_fun Arity => i_call_fun Arity i_call_fun I i_call_fun_last I P @@ -1337,13 +1295,13 @@ i_bs_utf16_size s d bs_put_utf8 Fail=j Flags=u Literal=q => \ move Literal x | bs_put_utf8 Fail Flags x -bs_put_utf8 Fail=j u Src=s => i_bs_put_utf8 Fail Src +bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src i_bs_put_utf8 j s bs_put_utf16 Fail=j Flags=u Literal=q => \ move Literal x | bs_put_utf16 Fail Flags x -bs_put_utf16 Fail=j Flags=u Src=s => i_bs_put_utf16 Fail Flags Src +bs_put_utf16 Fail Flags=u Src=s => i_bs_put_utf16 Fail Flags Src i_bs_put_utf16 j I s @@ -1508,34 +1466,13 @@ bif1 Fail u$bif:erlang:trunc/1 s d => too_old_compiler # # Guard BIFs. # -gc_bif1 Fail I Bif=u$bif:erlang:length/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:size/1 Src Dst=d => \ +gc_bif1 Fail I Bif Src Dst => \ gen_guard_bif1(Fail, I, Bif, Src, Dst) -gc_bif1 Fail I Bif=u$bif:erlang:bit_size/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:byte_size/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:abs/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:float/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:round/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:trunc/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif2 Fail I Bif=u$bif:erlang:binary_part/2 S1 S2 Dst=d => \ +gc_bif2 Fail I Bif S1 S2 Dst => \ gen_guard_bif2(Fail, I, Bif, S1, S2, Dst) -gc_bif3 Fail I Bif=u$bif:erlang:binary_part/3 S1 S2 S3 Dst=d => \ +gc_bif3 Fail I Bif S1 S2 S3 Dst => \ gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst) i_gc_bif1 Fail Bif V=q Live D => move V x | i_gc_bif1 Fail Bif x Live D @@ -1553,6 +1490,15 @@ ii_gc_bif3/7 ii_gc_bif3 Fail Bif S1 S2 S3 Live D => move S1 x | i_fetch S2 S3 | i_gc_bif3 Fail Bif x Live D i_gc_bif3 j I s I d + +# +# The following instruction is specially handled in beam_load.c +# to produce a user-friendly message if an unsupported guard BIF is +# encountered. +# +unsupported_guard_bif/3 +unsupported_guard_bif A B C | never() => + # # R13B03 # diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 3f6accba2d..825cb140b2 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2642,7 +2642,7 @@ tailrecur_ne: FloatDef f1, f2; Eterm big; #if HEAP_ON_C_STACK - Eterm big_buf[2]; /* If HEAP_ON_C_STACK */ + Eterm big_buf[32]; /* If HEAP_ON_C_STACK */ #else Eterm *big_buf = erts_get_scheduler_data()->cmp_tmp_heap; #endif @@ -2653,41 +2653,108 @@ tailrecur_ne: Eterm aw = a; Eterm bw = b; #endif +#define MAX_LOSSLESS_FLOAT ((double)((1LL << 53) - 2)) +#define MIN_LOSSLESS_FLOAT ((double)(((1LL << 53) - 2)*-1)) b_tag = tag_val_def(bw); switch(_NUMBER_CODE(a_tag, b_tag)) { case SMALL_BIG: - big = small_to_big(signed_val(a), big_buf); - j = big_comp(big, bw); + j = big_sign(bw) ? 1 : -1; + break; + case BIG_SMALL: + j = big_sign(aw) ? -1 : 1; break; case SMALL_FLOAT: - f1.fd = signed_val(a); GET_DOUBLE(bw, f2); - j = float_comp(f1.fd, f2.fd); - break; - case BIG_SMALL: - big = small_to_big(signed_val(b), big_buf); - j = big_comp(aw, big); + if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) { + // Float is within the no loss limit + f1.fd = signed_val(aw); + j = float_comp(f1.fd, f2.fd); +#if ERTS_SIZEOF_ETERM == 8 + } else if (f2.fd > (double) (MAX_SMALL + 1)) { + // Float is a positive bignum, i.e. bigger + j = -1; + } else if (f2.fd < (double) (MIN_SMALL - 1)) { + // Float is a negative bignum, i.e. smaller + j = 1; + } else { // Float is a Sint but less precise + j = signed_val(aw) - (Sint) f2.fd; + } +#else + } else { + // If float is positive it is bigger than small + j = (f2.fd > 0.0) ? -1 : 1; + } +#endif // ERTS_SIZEOF_ETERM == 8 break; case BIG_FLOAT: - if (big_to_double(aw, &f1.fd) < 0) { - j = big_sign(a) ? -1 : 1; + GET_DOUBLE(bw, f2); + if ((f2.fd < (double) (MAX_SMALL + 1)) + && (f2.fd > (double) (MIN_SMALL - 1))) { + // Float is a Sint + j = big_sign(aw) ? -1 : 1; + } else if ((pow(2.0,(big_arity(aw)-1.0)*D_EXP)-1.0) > fabs(f2.fd)) { + // If bignum size shows that it is bigger than the abs float + j = big_sign(aw) ? -1 : 1; + } else if ((pow(2.0,(big_arity(aw))*D_EXP)-1.0) < fabs(f2.fd)) { + // If bignum size shows that it is smaller than the abs float + j = f2.fd < 0 ? 1 : -1; + } else if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) { + // Float is within the no loss limit + if (big_to_double(aw, &f1.fd) < 0) { + j = big_sign(aw) ? -1 : 1; + } else { + j = float_comp(f1.fd, f2.fd); + } } else { - GET_DOUBLE(bw, f2); - j = float_comp(f1.fd, f2.fd); + big = double_to_big(f2.fd, big_buf); + j = big_comp(aw, big); } break; case FLOAT_SMALL: GET_DOUBLE(aw, f1); - f2.fd = signed_val(b); - j = float_comp(f1.fd, f2.fd); + if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) { + // Float is within the no loss limit + f2.fd = signed_val(bw); + j = float_comp(f1.fd, f2.fd); +#if ERTS_SIZEOF_ETERM == 8 + } else if (f1.fd > (double) (MAX_SMALL + 1)) { + // Float is a positive bignum, i.e. bigger + j = 1; + } else if (f1.fd < (double) (MIN_SMALL - 1)) { + // Float is a negative bignum, i.e. smaller + j = -1; + } else { // Float is a Sint but less precise it + j = (Sint) f1.fd - signed_val(bw); + } +#else + } else { + // If float is positive it is bigger than small + j = (f1.fd > 0.0) ? 1 : -1; + } +#endif // ERTS_SIZEOF_ETERM == 8 break; case FLOAT_BIG: - if (big_to_double(bw, &f2.fd) < 0) { - j = big_sign(b) ? 1 : -1; + GET_DOUBLE(aw, f1); + if ((f1.fd < (double) (MAX_SMALL + 1)) + && (f1.fd > (double) (MIN_SMALL - 1))) { // Float is a Sint + j = big_sign(bw) ? 1 : -1; + } else if ((pow(2.0, (big_arity(bw) - 1.0) * D_EXP) - 1.0) > fabs(f1.fd)) { + // If bignum size shows that it is bigger than the abs float + j = big_sign(bw) ? 1 : -1; + } else if ((pow(2.0,(big_arity(bw))*D_EXP)-1.0) < fabs(f1.fd)) { + // If bignum size shows that it is smaller than the abs float + j = f1.fd < 0 ? -1 : 1; + } else if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) { + // Float is within the no loss limit + if (big_to_double(bw, &f2.fd) < 0) { + j = big_sign(bw) ? 1 : -1; + } else { + j = float_comp(f1.fd, f2.fd); + } } else { - GET_DOUBLE(aw, f1); - j = float_comp(f1.fd, f2.fd); + big = double_to_big(f1.fd, big_buf); + j = big_comp(big, bw); } break; default: diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 68987b3493..52f1b5312b 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -2493,13 +2493,20 @@ file_flush(ErlDrvData e) { static int file_control(ErlDrvData e, unsigned int command, char* buf, int len, char **rbuf, int rlen) { + /* + * warning: variable ‘desc’ set but not used + * [-Wunused-but-set-variable] + * ... no kidding ... + * + * file_descriptor *desc = (file_descriptor *)e; switch (command) { default: return 0; - } /* switch (command) */ + } ASSERT(0); - desc = NULL; /* XXX Avoid warning while empty switch */ + desc = NULL; + */ return 0; } diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 43114c6039..426917bd2c 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -9307,7 +9307,7 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event) goto done; } } -#endif /* SOCKOPT_CONNECT_STAT */ +#endif /* SO_ERROR */ #endif /* !__WIN32__ */ desc->inet.state = TCP_STATE_CONNECTED; @@ -10112,7 +10112,7 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event) goto done; } } -#endif /* SOCKOPT_CONNECT_STAT */ +#endif /* SO_ERROR */ #endif /* !__WIN32__ */ desc->state = PACKET_STATE_CONNECTED; diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index d782b044a9..45d39a559f 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -242,7 +242,7 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) #ifndef HAVE_TERMCAP return ERL_DRV_ERROR_GENERAL; #else - char *s, *t, c, *l; + char *s, *t, *l; int canon, echo, sig; /* Terminal characteristics */ int flag; extern int using_oldshell; /* set this to let the rest of erts know */ @@ -262,7 +262,6 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) s++; /* Find end of this argument (start of next) and insert NUL. */ if ((t = strchr(s, ' '))) { - c = *t; *t = '\0'; } if ((flag = ((*s == '+') ? 1 : ((*s == '-') ? -1 : 0)))) { diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 82d2c64d81..20bfaad9aa 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -931,18 +931,13 @@ void os_flavor(char* namebuf, /* Where to return the name. */ unsigned size) /* Size of name buffer. */ { - static int called = 0; - static struct utsname uts; /* Information about the system. */ - - if (!called) { - char* s; + struct utsname uts; /* Information about the system. */ + char* s; - (void) uname(&uts); - called = 1; - for (s = uts.sysname; *s; s++) { - if (isupper((int) *s)) { - *s = tolower((int) *s); - } + (void) uname(&uts); + for (s = uts.sysname; *s; s++) { + if (isupper((int) *s)) { + *s = tolower((int) *s); } } strcpy(namebuf, uts.sysname); @@ -2892,8 +2887,8 @@ smp_sig_notify(char c) static void * signal_dispatcher_thread_func(void *unused) { - int initialized = 0; #if !CHLDWTHR + int initialized = 0; int notify_check_children = 0; #endif #ifdef ERTS_ENABLE_LOCK_CHECK @@ -2933,8 +2928,8 @@ signal_dispatcher_thread_func(void *unused) */ switch (buf[i]) { case 0: /* Emulator initialized */ - initialized = 1; #if !CHLDWTHR + initialized = 1; if (!notify_check_children) #endif break; diff --git a/erts/emulator/sys/vxworks/sys.c b/erts/emulator/sys/vxworks/sys.c index c6e7b65f32..a59e4ec26a 100644 --- a/erts/emulator/sys/vxworks/sys.c +++ b/erts/emulator/sys/vxworks/sys.c @@ -2025,9 +2025,6 @@ int erl_memory_show(int p0, int p1, int p2, int p3, int p4, int p5, erts_printf("The memory block used by elib is save_malloc'ed " "at 0x%08x.\n", (unsigned int) alloc_pool_ptr); } -#ifdef NO_FIX_ALLOC - erts_printf("Fix_alloc is disabled in this build\n"); -#endif erts_printf("Statistics from elib_malloc:\n"); ELIB_LOCK; diff --git a/erts/emulator/test/bs_utf_SUITE.erl b/erts/emulator/test/bs_utf_SUITE.erl index 72c656c400..4ab7d674a6 100644 --- a/erts/emulator/test/bs_utf_SUITE.erl +++ b/erts/emulator/test/bs_utf_SUITE.erl @@ -64,8 +64,7 @@ end_per_group(_GroupName, Config) -> utf8_roundtrip(Config) when is_list(Config) -> ?line utf8_roundtrip(0, 16#D7FF), - ?line utf8_roundtrip(16#E000, 16#FFFD), - ?line utf8_roundtrip(16#10000, 16#10FFFF), + ?line utf8_roundtrip(16#E000, 16#10FFFF), ok. utf8_roundtrip(First, Last) when First =< Last -> @@ -91,8 +90,7 @@ utf16_roundtrip(Config) when is_list(Config) -> do_utf16_roundtrip(Fun) -> do_utf16_roundtrip(0, 16#D7FF, Fun), - do_utf16_roundtrip(16#E000, 16#FFFD, Fun), - do_utf16_roundtrip(16#10000, 16#10FFFF, Fun). + do_utf16_roundtrip(16#E000, 16#10FFFF, Fun). do_utf16_roundtrip(First, Last, Fun) when First =< Last -> Fun(First), @@ -129,8 +127,7 @@ utf32_roundtrip(Config) when is_list(Config) -> do_utf32_roundtrip(Fun) -> do_utf32_roundtrip(0, 16#D7FF, Fun), - do_utf32_roundtrip(16#E000, 16#FFFD, Fun), - do_utf32_roundtrip(16#10000, 16#10FFFF, Fun). + do_utf32_roundtrip(16#E000, 16#10FFFF, Fun). do_utf32_roundtrip(First, Last, Fun) when First =< Last -> Fun(First), @@ -158,7 +155,6 @@ utf32_little_roundtrip(Char) -> utf8_illegal_sequences(Config) when is_list(Config) -> ?line fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line fail_range(16#FFFE, 16#FFFF), %Non-characters. %% Illegal first character. ?line [fail(<<I,16#8F,16#8F,16#8F>>) || I <- lists:seq(16#80, 16#BF)], @@ -251,7 +247,6 @@ fail_1(_) -> ok. utf16_illegal_sequences(Config) when is_list(Config) -> ?line utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line utf16_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line utf16_fail_range(16#FFFE, 16#FFFF), %Non-characters. ?line lonely_hi_surrogate(16#D800, 16#DFFF), ?line leading_lo_surrogate(16#DC00, 16#DFFF), @@ -300,7 +295,6 @@ leading_lo_surrogate(_, _, _) -> ok. utf32_illegal_sequences(Config) when is_list(Config) -> ?line utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line utf32_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line utf32_fail_range(16#FFFE, 16#FFFF), %Non-characters. ?line utf32_fail_range(-100, -1), ok. diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 29cbdedd17..61eeec5ffd 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -25,7 +25,7 @@ t_check_process_code_ets/1, external_fun/1,get_chunk/1,module_md5/1,make_stub/1, make_stub_many_funs/1,constant_pools/1, - false_dependency/1,coverage/1]). + false_dependency/1,coverage/1,fun_confusion/1]). -include_lib("test_server/include/test_server.hrl"). @@ -35,7 +35,7 @@ all() -> [new_binary_types, t_check_process_code, t_check_process_code_ets, t_check_old_code, external_fun, get_chunk, module_md5, make_stub, make_stub_many_funs, - constant_pools, false_dependency, coverage]. + constant_pools, false_dependency, coverage, fun_confusion]. groups() -> []. @@ -278,7 +278,8 @@ t_check_old_code(Config) when is_list(Config) -> external_fun(Config) when is_list(Config) -> ?line false = erlang:function_exported(another_code_test, x, 1), - ?line ExtFun = erlang:make_fun(id(another_code_test), x, 1), + AnotherCodeTest = id(another_code_test), + ExtFun = fun AnotherCodeTest:x/1, ?line {'EXIT',{undef,_}} = (catch ExtFun(answer)), ?line false = erlang:function_exported(another_code_test, x, 1), ?line false = lists:member(another_code_test, erlang:loaded()), @@ -555,6 +556,30 @@ coverage(Config) when is_list(Config) -> ?line {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)), ok. +fun_confusion(Config) when is_list(Config) -> + Data = ?config(data_dir, Config), + Src = filename:join(Data, "fun_confusion"), + Mod = fun_confusion, + + %% Load first version of module. + compile_load(Mod, Src, 1), + F1 = Mod:f(), + 1 = F1(), + + %% Load second version of module. + compile_load(Mod, Src, 2), + F2 = Mod:f(), + + %% F1 should refer to the old code, not the newly loaded code. + 1 = F1(), + 2 = F2(), + ok. + +compile_load(Mod, Src, Ver) -> + {ok,Mod,Code1} = compile:file(Src, [binary,{d,version,Ver}]), + {module,Mod} = code:load_binary(Mod, "fun_confusion.beam", Code1), + ok. + %% Utilities. make_sub_binary(Bin) when is_binary(Bin) -> diff --git a/erts/emulator/test/code_SUITE_data/fun_confusion.erl b/erts/emulator/test/code_SUITE_data/fun_confusion.erl new file mode 100644 index 0000000000..16000861df --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/fun_confusion.erl @@ -0,0 +1,31 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. 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 +%% 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/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(fun_confusion). + +-export([f/0]). + +f() -> + fun() -> version() end. + +version() -> + %% Changing the value returned here should change + %% the identity of the fun in f/0. + ?version. + diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index 736510339f..46466427c5 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -25,7 +25,7 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1, - bad_float_unpack/1]). + bad_float_unpack/1,cmp_zero/1, cmp_integer/1, cmp_bignum/1]). -export([otp_7178/1]). @@ -41,10 +41,10 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [fpe, fp_drv, fp_drv_thread, otp_7178, denormalized, - match, bad_float_unpack]. + match, bad_float_unpack, {group, comparison}]. groups() -> - []. + [{comparison, [parallel], [cmp_zero, cmp_integer, cmp_bignum]}]. init_per_suite(Config) -> Config. @@ -187,6 +187,101 @@ bad_float_unpack(Config) when is_list(Config) -> bad_float_unpack_match(<<F:64/float>>) -> F; bad_float_unpack_match(<<I:64/integer-signed>>) -> I. +cmp_zero(_Config) -> + cmp(0.5e-323,0). + +cmp_integer(_Config) -> + Axis = (1 bsl 53)-2.0, %% The point where floating points become unprecise + span_cmp(Axis,2,200), + cmp(Axis*Axis,round(Axis)). + +cmp_bignum(_Config) -> + span_cmp((1 bsl 58) - 1.0),%% Smallest bignum float + + %% Test when the big num goes from I to I+1 in size + [span_cmp((1 bsl (32*I)) - 1.0) || I <- lists:seq(2,30)], + + %% Test bignum greater then largest float + cmp((1 bsl (64*16)) - 1, (1 bsl (64*15)) * 1.0), + %% Test when num is much larger then float + [cmp((1 bsl (32*I)) - 1, (1 bsl (32*(I-2))) * 1.0) || I <- lists:seq(3,30)], + %% Test when float is much larger than num + [cmp((1 bsl (64*15)) * 1.0, (1 bsl (32*(I)))) || I <- lists:seq(1,29)], + + %% Test that all int == float works as they should + [true = 1 bsl N == (1 bsl N)*1.0 || N <- lists:seq(0, 1023)], + [true = (1 bsl N)*-1 == (1 bsl N)*-1.0 || N <- lists:seq(0, 1023)]. + +span_cmp(Axis) -> + span_cmp(Axis, 25). +span_cmp(Axis, Length) -> + span_cmp(Axis, round(Axis) bsr 52, Length). +span_cmp(Axis, Incr, Length) -> + [span_cmp(Axis, Incr, Length, 1 bsl (1 bsl I)) || I <- lists:seq(0,6)]. +%% This function creates tests around number axis. Both <, > and == is tested +%% for both negative and positive numbers. +%% +%% Axis: The number around which to do the tests eg. (1 bsl 58) - 1.0 +%% Incr: How much to increment the test numbers inbetween each test. +%% Length: Length/2 is the number of Incr away from Axis to test on the +%% negative and positive plane. +%% Diff: How much the float and int should differ when comparing +span_cmp(Axis, Incr, Length, Diff) -> + [begin + cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr), + cmp(Axis*-1.0+I*Incr,round(Axis*-1.0)-Diff+I*Incr) + end || I <- lists:seq((Length div 2)*-1,(Length div 2))], + [begin + cmp(round(Axis)+Diff+I*Incr,Axis+I*Incr), + cmp(Axis+I*Incr,round(Axis)-Diff+I*Incr) + end || I <- lists:seq((Length div 2)*-1,(Length div 2))]. + +cmp(Big,Small) when is_float(Big) -> + BigGtSmall = lists:flatten( + io_lib:format("~f > ~p",[Big,Small])), + BigLtSmall = lists:flatten( + io_lib:format("~f < ~p",[Big,Small])), + BigEqSmall = lists:flatten( + io_lib:format("~f == ~p",[Big,Small])), + SmallGtBig = lists:flatten( + io_lib:format("~p > ~f",[Small,Big])), + SmallLtBig = lists:flatten( + io_lib:format("~p < ~f",[Small,Big])), + SmallEqBig = lists:flatten( + io_lib:format("~p == ~f",[Small,Big])), + cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, + SmallEqBig,BigEqSmall); +cmp(Big,Small) when is_float(Small) -> + BigGtSmall = lists:flatten( + io_lib:format("~p > ~f",[Big,Small])), + BigLtSmall = lists:flatten( + io_lib:format("~p < ~f",[Big,Small])), + BigEqSmall = lists:flatten( + io_lib:format("~p == ~f",[Big,Small])), + SmallGtBig = lists:flatten( + io_lib:format("~f > ~p",[Small,Big])), + SmallLtBig = lists:flatten( + io_lib:format("~f < ~p",[Small,Big])), + SmallEqBig = lists:flatten( + io_lib:format("~f == ~p",[Small,Big])), + cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, + SmallEqBig,BigEqSmall). + +cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, + SmallEqBig,BigEqSmall) -> + {_,_,_,true} = {Big,Small,BigGtSmall, + Big > Small}, + {_,_,_,false} = {Big,Small,BigLtSmall, + Big < Small}, + {_,_,_,false} = {Big,Small,SmallGtBig, + Small > Big}, + {_,_,_,true} = {Big,Small,SmallLtBig, + Small < Big}, + {_,_,_,false} = {Big,Small,SmallEqBig, + Small == Big}, + {_,_,_,false} = {Big,Small,BigEqSmall, + Big == Small}. + id(I) -> I. start_node(Config) when is_list(Config) -> diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index d95789fa6e..5c82a01bd1 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1165,7 +1165,28 @@ is_checks(Config) when is_list(Config) -> ?line ensure_lib_loaded(Config, 1), ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], - {hejsan, "hejsan", [$h,"ejs",<<"an">>]}), + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 12), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -12), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551617), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551617), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 99.146), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -99.146), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551616.2e2), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551616.2e2), try ?line error = check_is_exception(), ?line throw(expected_badarg) @@ -1303,7 +1324,7 @@ get_resource(_,_) -> ?nif_stub. release_resource(_) -> ?nif_stub. last_resource_dtor_call() -> ?nif_stub. make_new_resource(_,_) -> ?nif_stub. -check_is(_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. +check_is(_,_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. check_is_exception() -> ?nif_stub. length_test(_,_,_,_,_) -> ?nif_stub. make_atoms() -> ?nif_stub. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index cf2ec4aaf0..35f54d62c5 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -832,6 +832,7 @@ static ERL_NIF_TERM release_resource(ErlNifEnv* env, int argc, const ERL_NIF_TER * argv[7] an empty list * argv[8] a non-empty list * argv[9] a tuple + * argv[10] a number (small, big integer or float) */ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { @@ -848,6 +849,7 @@ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] if (!enif_is_list(env, argv[7])) return enif_make_badarg(env); if (!enif_is_list(env, argv[8])) return enif_make_badarg(env); if (!enif_is_tuple(env, argv[9])) return enif_make_badarg(env); + if (!enif_is_number(env, argv[10])) return enif_make_badarg(env); return ok_atom; } @@ -1455,7 +1457,7 @@ static ErlNifFunc nif_funcs[] = {"release_resource", 1, release_resource}, {"last_resource_dtor_call", 0, last_resource_dtor_call}, {"make_new_resource", 2, make_new_resource}, - {"check_is", 10, check_is}, + {"check_is", 11, check_is}, {"check_is_exception", 0, check_is_exception}, {"length_test", 5, length_test}, {"make_atoms", 0, make_atoms}, diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index ebf7db3277..58c36c3bdc 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -105,7 +105,9 @@ my %match_engine_ops; # All opcodes for the match engine. my %gen_transform_offset; my @transformations; my @call_table; +my %call_table; my @pred_table; +my %pred_table; # Operand types for generic instructions. @@ -187,6 +189,12 @@ sub define_type_bit { } # +# Pre-define the 'fail' instruction. It is used internally +# by the 'try_me_else_fail' instruction. +# +$match_engine_ops{'TOP_fail'} = 1; + +# # Sanity checks. # @@ -1304,7 +1312,8 @@ sub tr_gen { foreach $ref (@g) { my($line, $orig_transform, $from_ref, $to_ref) = @$ref; - my $so_far = tr_gen_from($line, @$from_ref); + my $used_ref = used_vars($from_ref, $to_ref); + my $so_far = tr_gen_from($line, $used_ref, @$from_ref); tr_gen_to($line, $orig_transform, $so_far, @$to_ref); } @@ -1313,9 +1322,22 @@ sub tr_gen { # my($offset) = 0; print "Uint op_transform[] = {\n"; - foreach $key (keys %gen_transform) { + foreach $key (sort keys %gen_transform) { $gen_transform_offset{$key} = $offset; - foreach $instr (@{$gen_transform{$key}}) { + my @instr = @{$gen_transform{$key}}; + + # + # If the last instruction is 'fail', remove it and + # convert the previous 'try_me_else' to 'try_me_else_fail'. + # + if (is_instr($instr[$#instr], 'fail')) { + pop(@instr); + my $i = $#instr; + $i-- while !is_instr($instr[$i], 'try_me_else'); + $instr[$i] = make_op('', 'try_me_else_fail'); + } + + foreach $instr (@instr) { my($size, $instr_ref, $comment) = @$instr; my($op, @args) = @$instr_ref; print " "; @@ -1342,8 +1364,48 @@ sub tr_gen { print "};\n\n"; } +sub used_vars { + my($from_ref,$to_ref) = @_; + my %used; + my %seen; + + foreach my $ref (@$from_ref) { + my($name,$arity,@ops) = @$ref; + if ($name =~ /^[.]/) { + foreach my $var (@ops) { + $used{$var} = 1; + } + } else { + # Any variable that is used at least twice on the + # left-hand side is used. (E.g. "move R R".) + foreach my $op (@ops) { + my($var, $type, $type_val) = @$op; + next if $var eq ''; + $used{$var} = 1 if $seen{$var}; + $seen{$var} = 1; + } + } + } + + foreach my $ref (@$to_ref) { + my($name, $arity, @ops) = @$ref; + if ($name =~ /^[.]/) { + foreach my $var (@ops) { + $used{$var} = 1; + } + } else { + foreach my $op (@ops) { + my($var, $type, $type_val) = @$op; + next if $var eq ''; + $used{$var} = 1; + } + } + } + \%used; +} + sub tr_gen_from { - my($line, @tr) = @_; + my($line,$used_ref,@tr) = @_; my(%var) = (); my(%var_type); my($var_num) = 0; @@ -1353,25 +1415,30 @@ sub tr_gen_from { my(@fix_pred_funcs); my($op, $ref); # Loop variables. my $where = "left side of transformation in line $line: "; + my %var_used = %$used_ref; + my $may_fail = 0; + my $is_first = 1; foreach $ref (@tr) { my($name, $arity, @ops) = @$ref; my($key) = "$name/$arity"; my($opnum); + $may_fail = 1 unless $is_first; + $is_first = 0; + # # A name starting with a period is a C pred function to be called. # if ($name =~ /^\.(\w+)/) { $name = $1; + $may_fail = 1; my $var; my(@args); - my $next_instr = pop(@code); # Get rid of 'next_instr' push(@fix_pred_funcs, scalar(@code)); push(@code, [$name, @ops]); - push(@code, $next_instr); next; } @@ -1383,17 +1450,21 @@ sub tr_gen_from { unless defined $gen_opnum{$name,$arity}; $opnum = $gen_opnum{$name,$arity}; - push(@code, &make_op("$name/$arity", 'is_op', $opnum)); + push(@code, make_op("$name/$arity", 'next_instr', $opnum)); $min_window++; foreach $op (@ops) { my($var, $type, $type_val, $cond, $val) = @$op; + my $ignored_var = "$var (ignored)"; if ($type ne '' && $type ne '*') { + $may_fail = 1; + # # The is_bif, is_not_bif, and is_func instructions have # their own built-in type test and don't need to # be guarded with a type test instruction. # + $ignored_var = ''; unless ($cond eq 'is_bif' or $cond eq 'is_not_bif' or $cond eq 'is_func') { @@ -1407,7 +1478,7 @@ sub tr_gen_from { push(@code, &make_op($types, 'is_type', $type_mask)); } else { $cond = ''; - push(@code, &make_op($types, 'is_type_eq', + push(@code, &make_op("$types== $val", 'is_type_eq', $type_mask, $val)); } } @@ -1415,46 +1486,55 @@ sub tr_gen_from { if ($cond eq 'is_func') { my($m, $f, $a) = split(/:/, $val); + $ignored_var = ''; + $may_fail = 1; push(@code, &make_op('', "$cond", "am_$m", "am_$f", $a)); } elsif ($cond ne '') { + $ignored_var = ''; + $may_fail = 1; push(@code, &make_op('', "$cond", $val)); } if ($var ne '') { if (defined $var{$var}) { + $ignored_var = ''; + $may_fail = 1; push(@code, &make_op($var, 'is_same_var', $var{$var})); } elsif ($type eq '*') { # # Reserve a hole for a 'rest_args' instruction. # + $ignored_var = ''; push(@fix_rest_args, scalar(@code)); push(@code, $var); - } else { + } elsif ($var_used{$var}) { + $ignored_var = ''; $var_type{$var} = 'scalar'; $var{$var} = $var_num; $var_num++; push(@code, &make_op($var, 'set_var', $var{$var})); } } - if (is_set_var_instr($code[$#code])) { + if (is_instr($code[$#code], 'set_var')) { my $ref = pop @code; my $comment = $ref->[2]; my $var = $ref->[1][1]; push(@code, make_op($comment, 'set_var_next_arg', $var)); } else { - push(@code, &make_op('', 'next_arg')); + push(@code, &make_op($ignored_var, 'next_arg')); } } - push(@code, &make_op('', 'next_instr')); - pop(@code) if $code[$#code]->[1][0] eq 'next_arg'; + + # Remove redundant 'next_arg' instructions before the end + # of the instruction. + pop(@code) while is_instr($code[$#code], 'next_arg'); } # # Insert the commit operation. # - pop(@code); # Get rid of 'next_instr' - push(@code, &make_op('', 'commit')); + push(@code, make_op($may_fail ? '' : 'always reached', 'commit')); # # If there is an rest_args instruction, we must insert its correct @@ -1484,9 +1564,8 @@ sub tr_gen_from { push(@args, "var+$var{$var}"); } } - splice(@code, $index, 1, &make_op("$name()", - 'pred', scalar(@pred_table))); - push(@pred_table, [$name, @args]); + my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args); + splice(@code, $index, 1, make_op("$name()", 'pred', $pi)); } $te_max_vars = $var_num @@ -1503,6 +1582,10 @@ sub tr_gen_to { my($op, $ref); # Loop variables. my($where) = "right side of transformation in line $line: "; + my $last_instr = $code[$#code]; + my $cannot_fail = is_instr($last_instr, 'commit') && + (get_comment($last_instr) =~ /^always/); + foreach $ref (@tr) { my($name, $arity, @ops) = @$ref; @@ -1524,9 +1607,10 @@ sub tr_gen_to { push(@args, "var+$var{$var}"); } } - pop(@code); # Get rid of 'next_instr' - push(@code, &make_op("$name()", 'call', scalar(@call_table))); - push(@call_table, [$name, @args]); + pop(@code); # Get rid of 'commit' instruction + my $index = tr_next_index(\@call_table, \%call_table, + $name, @args); + push(@code, make_op("$name()", 'call_end', $index)); last; } @@ -1543,27 +1627,27 @@ sub tr_gen_to { # Create code to build the generic instruction. # - push(@code, &make_op('', 'new_instr')); - push(@code, &make_op("$name/$arity", 'store_op', $opnum, $arity)); + push(@code, make_op("$name/$arity", 'new_instr', $opnum)); foreach $op (@ops) { my($var, $type, $type_val) = @$op; if ($var ne '') { &error($where, "variable '$var' unbound") unless defined $var{$var}; - push(@code, &make_op($var, 'store_var', $var{$var})); + push(@code, &make_op($var, 'store_var_next_arg', $var{$var})); } elsif ($type ne '') { push(@code, &make_op('', 'store_type', "TAG_$type")); if ($type_val) { push(@code, &make_op('', 'store_val', $type_val)); } + push(@code, make_op('', 'next_arg')); } - push(@code, &make_op('', 'next_arg')); } - pop(@code) if $code[$#code]->[1][0] eq 'next_arg'; + pop(@code) if is_instr($code[$#code], 'next_arg'); } - push(@code, &make_op('', 'end')); + push(@code, make_op('', 'end')) + unless is_instr($code[$#code], 'call_end'); # # Chain together all codes segments having the same first operation. @@ -1575,11 +1659,20 @@ sub tr_gen_to { $min_window{$key} = $min_window if $min_window{$key} > $min_window; - pop(@{$gen_transform{$key}}) + my $prev_last; + $prev_last = pop(@{$gen_transform{$key}}) if defined @{$gen_transform{$key}}; # Fail - my(@prefix) = (&make_op($comment), &make_op('', 'try_me_else', &tr_code_len(@code))); - unshift(@code, @prefix); - push(@{$gen_transform{$key}}, @code, &make_op('', 'fail')); + + if ($prev_last && !is_instr($prev_last, 'fail')) { + error("Line $line: A previous transformation shadows '$orig_transform'"); + } + unless ($cannot_fail) { + unshift(@code, make_op('', 'try_me_else', + tr_code_len(@code))); + push(@code, make_op(""), make_op("$key", 'fail')); + } + unshift(@code, make_op($comment)); + push(@{$gen_transform{$key}}, @code), } sub tr_code_len { @@ -1597,21 +1690,38 @@ sub make_op { [scalar(@op), [@op], $comment]; } -sub is_set_var_instr { - my($ref) = @_; +sub is_instr { + my($ref,$op) = @_; return 0 unless ref($ref) eq 'ARRAY'; - $ref->[1][0] eq 'set_var'; + $ref->[1][0] eq $op; +} + +sub get_comment { + my($ref,$op) = @_; + return '' unless ref($ref) eq 'ARRAY'; + $ref->[2]; +} + +sub tr_next_index { + my($lref,$href,$name,@args) = @_; + my $code = "RVAL = $name(" . join(', ', 'st', @args) . "); break;\n"; + my $index; + + if (defined $$href{$code}) { + $index = $$href{$code}; + } else { + $index = scalar(@$lref); + push(@$lref, $code); + $$href{$code} = $index; + } + $index; } sub tr_gen_call { my(@call_table) = @_; my($i); - print "\n"; for ($i = 0; $i < @call_table; $i++) { - my $ref = $call_table[$i]; - my($name, @args) = @$ref; - print "case $i: RVAL = $name(", join(', ', 'st', @args), "); break;\n"; + print "case $i: $call_table[$i]"; } - print "\n"; } diff --git a/erts/emulator/utils/make_preload b/erts/emulator/utils/make_preload index d0671e998d..d22f08f993 100755 --- a/erts/emulator/utils/make_preload +++ b/erts/emulator/utils/make_preload @@ -88,6 +88,7 @@ foreach $file (@ARGV) { print "unsigned char preloaded_$module", "[] = {\n"; for ($i = 0; $i < length($_); $i++) { if ($i % 8 == 0 && $comment ne '') { + $comment =~ s@/\*@..@g; # Comment start -- avoid warning. $comment =~ s@\*/@..@g; # Comment terminator. print " /* $comment */\n "; $comment = ''; |