diff options
107 files changed, 2039 insertions, 1385 deletions
diff --git a/bootstrap/lib/compiler/ebin/beam_dead.beam b/bootstrap/lib/compiler/ebin/beam_dead.beam Binary files differindex 4fda5157fa..d2dc2f7688 100644 --- a/bootstrap/lib/compiler/ebin/beam_dead.beam +++ b/bootstrap/lib/compiler/ebin/beam_dead.beam diff --git a/bootstrap/lib/compiler/ebin/beam_except.beam b/bootstrap/lib/compiler/ebin/beam_except.beam Binary files differindex e5d2c51c4d..03fc2edd02 100644 --- a/bootstrap/lib/compiler/ebin/beam_except.beam +++ b/bootstrap/lib/compiler/ebin/beam_except.beam diff --git a/bootstrap/lib/compiler/ebin/beam_jump.beam b/bootstrap/lib/compiler/ebin/beam_jump.beam Binary files differindex 7382cafb48..2d1961570f 100644 --- a/bootstrap/lib/compiler/ebin/beam_jump.beam +++ b/bootstrap/lib/compiler/ebin/beam_jump.beam diff --git a/bootstrap/lib/compiler/ebin/beam_receive.beam b/bootstrap/lib/compiler/ebin/beam_receive.beam Binary files differindex fef3fcc816..f864c15ae1 100644 --- a/bootstrap/lib/compiler/ebin/beam_receive.beam +++ b/bootstrap/lib/compiler/ebin/beam_receive.beam diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex 664140540c..25cd7ce430 100644 --- a/bootstrap/lib/compiler/ebin/beam_utils.beam +++ b/bootstrap/lib/compiler/ebin/beam_utils.beam diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex a3fced0154..ee86a8144d 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex 0923d4e678..648cd3dea1 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam Binary files differindex d3249b120e..59627fb4df 100644 --- a/bootstrap/lib/stdlib/ebin/proc_lib.beam +++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 57e047af08..4efd155b09 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -322,13 +322,13 @@ ok <p>The <seealso marker="#enif_consume_timeslice">enif_consume_timeslice()</seealso> - function can be used to inform the runtime system about the lenght of the + function can be used to inform the runtime system about the length of the NIF call. It should typically always be used unless the NIF executes very quickly.</p> - <p>If the NIF call is too lenghty one needs to handle this in one of the + <p>If the NIF call is too lengthy one needs to handle this in one of the following ways in order to avoid degraded responsiveness, scheduler load - balancing problems, and other strange behaviours:</p> + balancing problems, and other strange behaviors:</p> <taglist> <tag>Yielding NIF</tag> @@ -410,14 +410,14 @@ ok <seealso marker="erlang#system_flag_multi_scheduling"><c>erlang:system_flag(multi_scheduling, block)</c></seealso>, might also take a very long time to complete. This since all ongoing dirty operations on all - dirty schedulers need to complete before the the block + dirty schedulers need to complete before the block operation can complete. </p> <p> A lot of operations communicating with a process executing a dirty NIF can, however, complete while it is executing the - dirty NIF. For example, retreiving information about it via + dirty NIF. For example, retrieving information about it via <c>process_info()</c>, setting its group leader, register/unregister its name, etc. </p> @@ -425,10 +425,10 @@ ok <p> Termination of a process executing a dirty NIF can only be completed up to a certain point while it is executing the - dirty NIF. All Erlang resources such as registered names, - ETS tables, etc will be released. All links and monitors + dirty NIF. All Erlang resources such as its registered name, + its ETS tables, etc will be released. All links and monitors will be triggered. The actual execution of the NIF will - however <em>not</em> be stopped. The NIF can safely contiue + however <em>not</em> be stopped. The NIF can safely continue execution, allocate heap memory, etc, but it is of course better to stop executing as soon as possible. The NIF can check whether current process is alive or not using @@ -450,8 +450,8 @@ ok collect a process in order to determine if it has references to the module, a process executing a dirty NIF might delay purging for a very long time. Delaying - a purge operatin implies delaying <em>all</em> code - loding operations which might cause severe problems for + a purge operation implies delaying <em>all</em> code + loading operations which might cause severe problems for the system as a whole. </p> </item> diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index f8f2e29c95..0a59f8785c 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1323,11 +1323,7 @@ void process_main(void) if (start_time != 0) { Sint64 diff = erts_timestamp_millis() - start_time; - if (diff > 0 && (Uint) diff > erts_system_monitor_long_schedule -#if defined(ERTS_SMP) && defined(ERTS_DIRTY_SCHEDULERS) - && !ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(c_p)) -#endif - ) { + if (diff > 0 && (Uint) diff > erts_system_monitor_long_schedule) { BeamInstr *inptr = find_function_from_pc(start_time_i); BeamInstr *outptr = find_function_from_pc(c_p->i); monitor_long_schedule_proc(c_p,inptr,outptr,(Uint) diff); @@ -1337,7 +1333,7 @@ void process_main(void) PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - c_p = schedule(c_p, reds_used); + c_p = erts_schedule(NULL, c_p, reds_used); ASSERT(!(c_p->flags & F_HIPE_MODE)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); start_time = 0; @@ -3559,12 +3555,10 @@ do { \ typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]); NifF* fp = vbf = (NifF*) I[1]; struct enif_environment_t env; -#ifdef ERTS_DIRTY_SCHEDULERS - if (!c_p->scheduler_data) - live_hf_end = ERTS_INVALID_HFRAG_PTR; /* On dirty scheduler */ - else +#ifdef ERTS_SMP + ASSERT(c_p->scheduler_data); #endif - live_hf_end = c_p->mbuf; + live_hf_end = c_p->mbuf; erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2], NULL); nif_bif_result = (*fp)(&env, bif_nif_arity, reg); if (env.exception_thrown) @@ -3574,10 +3568,7 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); - if (env.exiting) { - ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); - goto do_schedule; - } + ASSERT(!env.exiting); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); } @@ -5162,6 +5153,283 @@ do { \ } } +/* + * erts_dirty_process_main() is what dirty schedulers execute. Since they handle + * only NIF calls they do not need to be able to execute all BEAM + * instructions. + */ +void erts_dirty_process_main(ErtsSchedulerData *esdp) +{ +#ifdef ERTS_DIRTY_SCHEDULERS + Process* c_p = NULL; + ErtsMonotonicTime start_time; +#ifdef DEBUG + ERTS_DECLARE_DUMMY(Eterm pid); +#endif + + /* Pointer to X registers: x(1)..x(N); reg[0] is used when doing GC, + * in all other cases x0 is used. + */ + register Eterm* reg REG_xregs = NULL; + + /* + * Top of heap (next free location); grows upwards. + */ + register Eterm* HTOP REG_htop = NULL; + + /* Stack pointer. Grows downwards; points + * to last item pushed (normally a saved + * continuation pointer). + */ + register Eterm* E REG_stop = NULL; + + /* + * Pointer to next threaded instruction. + */ + register BeamInstr *I REG_I = NULL; + + ERTS_MSACC_DECLARE_CACHE_X() /* a cached value of the tsd pointer for msacc */ + + /* + * start_time always positive for dirty CPU schedulers, + * and negative for dirty I/O schedulers. + */ + + if (ERTS_SCHEDULER_IS_DIRTY_CPU(esdp)) { + start_time = erts_get_monotonic_time(NULL); + ASSERT(start_time >= 0); + } + else { + start_time = ERTS_SINT64_MIN; + ASSERT(start_time < 0); + } + + goto do_dirty_schedule; + + context_switch: + c_p->arity = I[-1]; + c_p->current = I-3; /* Pointer to Mod, Func, Arity */ + + { + int reds_used; + Eterm* argp; + int i; + + /* + * Make sure that there is enough room for the argument registers to be saved. + */ + if (c_p->arity > c_p->max_arg_reg) { + /* + * Yes, this is an expensive operation, but you only pay it the first + * time you call a function with more than 6 arguments which is + * scheduled out. This is better than paying for 26 words of wasted + * space for most processes which never call functions with more than + * 6 arguments. + */ + Uint size = c_p->arity * sizeof(c_p->arg_reg[0]); + if (c_p->arg_reg != c_p->def_arg_reg) { + c_p->arg_reg = (Eterm *) erts_realloc(ERTS_ALC_T_ARG_REG, + (void *) c_p->arg_reg, + size); + } else { + c_p->arg_reg = (Eterm *) erts_alloc(ERTS_ALC_T_ARG_REG, size); + } + c_p->max_arg_reg = c_p->arity; + } + + /* + * Save the argument registers and everything else. + */ + + argp = c_p->arg_reg; + for (i = c_p->arity - 1; i >= 0; i--) { + argp[i] = reg[i]; + } + SWAPOUT; + c_p->i = I; + + do_dirty_schedule: + + if (start_time < 0) { + /* + * Dirty I/O scheduler: + * One reduction consumed regardless of + * time spent in the dirty NIF. + */ + reds_used = esdp->virtual_reds + 1; + } + else { + /* + * Dirty CPU scheduler: + * Currently two reductions consumed per + * micro second spent in the dirty NIF. + */ + ErtsMonotonicTime time; + time = erts_get_monotonic_time(esdp); + time -= start_time; + time = ERTS_MONOTONIC_TO_USEC(time); + time *= (CONTEXT_REDS-1)/1000 + 1; + ASSERT(time >= 0); + if (time == 0) + time = 1; /* At least one reduction */ + time += esdp->virtual_reds; + reds_used = time > INT_MAX ? INT_MAX : (int) time; + } + + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + c_p = erts_schedule(esdp, c_p, reds_used); + + if (start_time >= 0) { + start_time = erts_get_monotonic_time(esdp); + ASSERT(start_time >= 0); + } + } + + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); +#ifdef DEBUG + pid = c_p->common.id; /* Save for debugging purposes */ +#endif + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + + ASSERT(!(c_p->flags & F_HIPE_MODE)); + ERTS_MSACC_UPDATE_CACHE_X(); + + reg = esdp->x_reg_array; + { + Eterm* argp; + int i; + + argp = c_p->arg_reg; + for (i = c_p->arity - 1; i >= 0; i--) { + reg[i] = argp[i]; + CHECK_TERM(reg[i]); + } + + /* + * We put the original reduction count in the process structure, to reduce + * the code size (referencing a field in a struct through a pointer stored + * in a register gives smaller code than referencing a global variable). + */ + + I = c_p->i; + + ASSERT(BeamOp(op_call_nif) == (BeamInstr *) *I); + + if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p) + && (ERTS_TRACE_FLAGS(c_p) & F_SENSITIVE) == 0) { + c_p->fcalls = REDS_IN(c_p) = 0; + } + + SWAPIN; + +#ifdef USE_VM_PROBES + if (DTRACE_ENABLED(process_scheduled)) { + DTRACE_CHARBUF(process_buf, DTRACE_TERM_BUF_SIZE); + DTRACE_CHARBUF(fun_buf, DTRACE_TERM_BUF_SIZE); + dtrace_proc_str(c_p, process_buf); + + if (ERTS_PROC_IS_EXITING(c_p)) { + strcpy(fun_buf, "<exiting>"); + } else { + BeamInstr *fptr = find_function_from_pc(c_p->i); + if (fptr) { + dtrace_fun_decode(c_p, (Eterm)fptr[0], + (Eterm)fptr[1], (Uint)fptr[2], + NULL, fun_buf); + } else { + erts_snprintf(fun_buf, sizeof(DTRACE_CHARBUF_NAME(fun_buf)), + "<unknown/%p>", next); + } + } + + DTRACE2(process_scheduled, process_buf, fun_buf); + } +#endif + } + + { + Eterm nif_bif_result; + Eterm bif_nif_arity; + + { + /* + * call_nif is always first instruction in function: + * + * I[-3]: Module + * I[-2]: Function + * I[-1]: Arity + * I[0]: &&call_nif + * I[1]: Function pointer to NIF function + * I[2]: Pointer to erl_module_nif + * I[3]: Function pointer to dirty NIF + */ + BifFunction vbf; + + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF); + + DTRACE_NIF_ENTRY(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); + c_p->current = I-3; /* current and vbf set to please handle_error */ + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + bif_nif_arity = I[-1]; + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + { + typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]); + NifF* fp = vbf = (NifF*) I[1]; + struct enif_environment_t env; + ASSERT(!c_p->scheduler_data); + erts_pre_dirty_nif(esdp, &env, c_p, (struct erl_module_nif*)I[2], NULL); + nif_bif_result = (*fp)(&env, bif_nif_arity, reg); + if (env.exception_thrown) + nif_bif_result = THE_NON_VALUE; + erts_post_nif(&env); + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); + if (env.exiting) { + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + goto do_dirty_schedule; + } + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + } + DTRACE_NIF_RETURN(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + ERTS_HOLE_CHECK(c_p); + if (ERTS_IS_GC_DESIRED(c_p)) { + nif_bif_result = erts_gc_after_bif_call(c_p, + nif_bif_result, + reg, bif_nif_arity); + } + SWAPIN; /* There might have been a garbage collection. */ + if (is_value(nif_bif_result)) { + r(0) = nif_bif_result; + CHECK_TERM(r(0)); + I = c_p->cp; + c_p->cp = 0; + Goto(*I); + } else if (c_p->freason == TRAP) { + I = c_p->i; + ASSERT(!(c_p->flags & F_HIBERNATE_SCHED)); + goto context_switch; + } + I = handle_error(c_p, c_p->cp, reg, vbf); + } + } + if (I == 0) { + goto do_dirty_schedule; + } else { + ASSERT(!is_value(r(0))); + SWAPIN; + goto context_switch; + } +#endif /* ERTS_DIRTY_SCHEDULERS */ +} + static BifFunction translate_gc_bif(void* gcf) { diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c index fbe4724047..7e239d1f5d 100644 --- a/erts/emulator/beam/erl_ao_firstfit_alloc.c +++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c @@ -123,7 +123,7 @@ struct AOFF_Carrier_t_ { AOFF_RBTree_t rbt_node; /* My node in the carrier tree */ AOFF_RBTree_t* root; /* Root of my block tree */ }; -#define RBT_NODE_TO_MBC(PTR) ((AOFF_Carrier_t*)((char*)(PTR) - offsetof(AOFF_Carrier_t, rbt_node))) +#define RBT_NODE_TO_MBC(PTR) ErtsContainerStruct((PTR), AOFF_Carrier_t, rbt_node) /* To support carrier migration we keep two kinds of rb-trees: diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index ac7b9d6606..71ab92937d 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -1345,7 +1345,7 @@ erts_prep_msgq_for_inspection(Process *c_p, Process *rp, mpp = i == 0 ? &rp->msg.first : &mip[i-1].msgp->next; - ASSERT((*mpp)->next == bad_mp); + ASSERT(*mpp == bad_mp); erts_msgq_update_internal_pointers(&rp->msg, mpp, &bad_mp->next); @@ -1725,7 +1725,7 @@ void erts_factory_trim_and_close(ErtsHeapFactory* factory, case FACTORY_MESSAGE: { ErtsMessage *mp = factory->message; if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG) { - if (!mp->hfrag.next) { + if (!factory->heap_frags) { Uint sz = factory->hp - factory->hp_start; mp = erts_shrink_message(mp, sz, brefs, brefs_size); factory->message = mp; diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 2bbb8e3c91..f1c35cd5a5 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -178,9 +178,6 @@ static ERTS_INLINE void ensure_heap(ErlNifEnv* env, size_t may_need) void erts_pre_nif(ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif, Process* tracee) { -#ifdef ERTS_DIRTY_SCHEDULERS - ErtsSchedulerData *esdp; -#endif env->mod_nif = mod_nif; env->proc = p; env->hp = HEAP_TOP(p); @@ -193,57 +190,65 @@ void erts_pre_nif(ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif, ASSERT(p->common.id != ERTS_INVALID_PID); -#ifdef ERTS_DIRTY_SCHEDULERS - esdp = erts_get_scheduler_data(); - ASSERT(esdp); +#if defined(DEBUG) && defined(ERTS_DIRTY_SCHEDULERS) + { + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + ASSERT(esdp); - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { -#ifdef DEBUG - erts_aint32_t state = erts_smp_atomic32_read_nob(&p->state); + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + erts_aint32_t state = erts_smp_atomic32_read_nob(&p->state); - ASSERT(p->scheduler_data == esdp); - ASSERT((state & (ERTS_PSFLG_RUNNING - | ERTS_PSFLG_RUNNING_SYS)) - && !(state & (ERTS_PSFLG_DIRTY_RUNNING - | ERTS_PSFLG_DIRTY_RUNNING_SYS))); + ASSERT(p->scheduler_data == esdp); + ASSERT((state & (ERTS_PSFLG_RUNNING + | ERTS_PSFLG_RUNNING_SYS)) + && !(state & (ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_DIRTY_RUNNING_SYS))); + } + } #endif +} - } - else { - Process *sproc; +void erts_pre_dirty_nif(ErtsSchedulerData *esdp, + ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif, + Process* tracee) +{ +#ifdef ERTS_DIRTY_SCHEDULERS + Process *sproc; #ifdef DEBUG - erts_aint32_t state = erts_smp_atomic32_read_nob(&p->state); + erts_aint32_t state = erts_smp_atomic32_read_nob(&p->state); - ASSERT(!p->scheduler_data); - ASSERT((state & ERTS_PSFLG_DIRTY_RUNNING) - && !(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))); + ASSERT(!p->scheduler_data); + ASSERT((state & ERTS_PSFLG_DIRTY_RUNNING) + && !(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))); + ASSERT(esdp); #endif - sproc = esdp->dirty_shadow_process; - ASSERT(sproc); - ASSERT(sproc->static_flags & ERTS_STC_FLG_SHADOW_PROC); - ASSERT(erts_smp_atomic32_read_nob(&sproc->state) - == (ERTS_PSFLG_ACTIVE - | ERTS_PSFLG_DIRTY_RUNNING - | ERTS_PSFLG_PROXY)); - - sproc->next = p; - sproc->common.id = p->common.id; - sproc->htop = p->htop; - sproc->stop = p->stop; - sproc->hend = p->hend; - sproc->heap = p->heap; - sproc->abandoned_heap = p->abandoned_heap; - sproc->heap_sz = p->heap_sz; - sproc->high_water = p->high_water; - sproc->old_hend = p->old_hend; - sproc->old_htop = p->old_htop; - sproc->old_heap = p->old_heap; - sproc->mbuf = NULL; - sproc->mbuf_sz = 0; - ERTS_INIT_OFF_HEAP(&sproc->off_heap); - env->proc = sproc; - } + erts_pre_nif(env, p, mod_nif, tracee); + + sproc = esdp->dirty_shadow_process; + ASSERT(sproc); + ASSERT(sproc->static_flags & ERTS_STC_FLG_SHADOW_PROC); + ASSERT(erts_smp_atomic32_read_nob(&sproc->state) + == (ERTS_PSFLG_ACTIVE + | ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_PROXY)); + + sproc->next = p; + sproc->common.id = p->common.id; + sproc->htop = p->htop; + sproc->stop = p->stop; + sproc->hend = p->hend; + sproc->heap = p->heap; + sproc->abandoned_heap = p->abandoned_heap; + sproc->heap_sz = p->heap_sz; + sproc->high_water = p->high_water; + sproc->old_hend = p->old_hend; + sproc->old_htop = p->old_htop; + sproc->old_heap = p->old_heap; + sproc->mbuf = NULL; + sproc->mbuf_sz = 0; + ERTS_INIT_OFF_HEAP(&sproc->off_heap); + env->proc = sproc; #endif } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index f8cbe60e76..c0b1d7246c 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -8197,7 +8197,7 @@ sched_dirty_cpu_thread_func(void *vesdp) #endif erts_thread_init_float(); - process_main(); + erts_dirty_process_main(esdp); /* No schedulers should *ever* terminate */ erts_exit(ERTS_ABORT_EXIT, "Dirty CPU scheduler thread number %beu terminated\n", @@ -8242,7 +8242,7 @@ sched_dirty_io_thread_func(void *vesdp) #endif erts_thread_init_float(); - process_main(); + erts_dirty_process_main(esdp); /* No schedulers should *ever* terminate */ erts_exit(ERTS_ABORT_EXIT, "Dirty I/O scheduler thread number %beu terminated\n", @@ -9377,77 +9377,6 @@ scheduler_gc_proc(Process *c_p, int reds_left) return reds; } -static ERTS_INLINE void -clean_dirty_start(Process *p) -{ -#if defined(ERTS_DIRTY_SCHEDULERS) && !defined(ARCH_64) - void *ptr = ERTS_PROC_SET_DIRTY_CPU_START(p, NULL); - if (ptr) - erts_free(ERTS_ALC_T_DIRTY_START, ptr); -#endif -} - -static ERTS_INLINE void -save_dirty_start(ErtsSchedulerData *esdp, Process *c_p) -{ -#ifdef ERTS_DIRTY_SCHEDULERS - if (ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(esdp->run_queue)) { - ErtsMonotonicTime time = erts_get_monotonic_time(esdp); -#ifdef ARCH_64 - ERTS_PROC_SET_DIRTY_CPU_START(c_p, (void *) time); -#else - ErtsMonotonicTime *stimep; - - stimep = (ErtsMonotonicTime *) ERTS_PROC_GET_DIRTY_CPU_START(c_p); - if (!stimep) { - stimep = erts_alloc(ERTS_ALC_T_DIRTY_START, - sizeof(ErtsMonotonicTime)); - ERTS_PROC_SET_DIRTY_CPU_START(c_p, (void *) stimep); - } - *stimep = time; -#endif - } -#endif -} - -static ERTS_INLINE int -get_dirty_reds(ErtsSchedulerData *esdp, Process *c_p) -{ - -#ifndef ERTS_DIRTY_SCHEDULERS - return -1; -#else - ErtsMonotonicTime stime, time; - - if (!ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(esdp->run_queue)) - return 1; - -#ifdef ARCH_64 - stime = (ErtsMonotonicTime) ERTS_PROC_GET_DIRTY_CPU_START(c_p); -#else - { - ErtsMonotonicTime *stimep; - stimep = (ErtsMonotonicTime *) ERTS_PROC_GET_DIRTY_CPU_START(c_p); - ASSERT(stimep); - stime = *stimep; - } -#endif - - time = erts_get_monotonic_time(esdp); - - ASSERT(stime && stime < time); - - time -= stime; - time = ERTS_MONOTONIC_TO_USEC(time); - time *= 2; - - if (time > INT_MAX) - return INT_MAX; - return (int) time; -#endif - -} - /* * schedule() is called from BEAM (process_main()) or HiPE * (hipe_mode_switch()) when the current process is to be @@ -9466,11 +9395,10 @@ get_dirty_reds(ErtsSchedulerData *esdp, Process *c_p) * so that normal processes get to run more frequently. */ -Process *schedule(Process *p, int calls) +Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) { Process *proxy_p = NULL; ErtsRunQueue *rq; - ErtsSchedulerData *esdp; int context_reds; int fcalls; int input_reductions; @@ -9507,8 +9435,19 @@ Process *schedule(Process *p, int calls) * Clean up after the process being scheduled out. */ if (!p) { /* NULL in the very first schedule() call */ +#ifdef ERTS_DIRTY_SCHEDULERS + is_normal_sched = !esdp; + if (is_normal_sched) { + esdp = erts_get_scheduler_data(); + ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp)); + } + else { + ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp)); + } +#else esdp = erts_get_scheduler_data(); - is_normal_sched = !ERTS_SCHEDULER_IS_DIRTY(esdp); + is_normal_sched = 1; +#endif rq = erts_get_runq_current(esdp); ASSERT(esdp); fcalls = (int) erts_smp_atomic32_read_acqb(&function_calls); @@ -9517,12 +9456,12 @@ Process *schedule(Process *p, int calls) } else { #ifdef ERTS_SMP #ifdef ERTS_DIRTY_SCHEDULERS - esdp = p->scheduler_data; - is_normal_sched = esdp != NULL; - if (is_normal_sched) + is_normal_sched = !esdp; + if (is_normal_sched) { + esdp = p->scheduler_data; ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp)); + } else { - esdp = erts_get_scheduler_data(); ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp)); } #else @@ -9541,10 +9480,7 @@ Process *schedule(Process *p, int calls) ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); - if (is_normal_sched) - reds = actual_reds = calls - esdp->virtual_reds; - else - reds = actual_reds = get_dirty_reds(esdp, p); + reds = actual_reds = calls - esdp->virtual_reds; ASSERT(actual_reds >= 0); if (reds < ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST) @@ -9994,17 +9930,10 @@ Process *schedule(Process *p, int calls) calls = 0; reds = context_reds; -#ifdef ERTS_SMP - erts_smp_runq_unlock(rq); -#endif /* ERTS_SMP */ - } - if (!is_normal_sched) - save_dirty_start(esdp, p); - #ifdef ERTS_SMP if (flags & ERTS_RUNQ_FLG_PROTECTED) @@ -11745,8 +11674,6 @@ delete_process(Process* p) if (nif_export) erts_destroy_nif_export(nif_export); - clean_dirty_start(p); - /* Cleanup psd */ psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd); diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index b44ac442aa..7569fd81bd 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -810,25 +810,13 @@ erts_smp_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi) #define ERTS_PSD_DELAYED_GC_TASK_QS 4 #define ERTS_PSD_NIF_TRAP_EXPORT 5 #define ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF 6 -#define ERTS_PSD_DIRTY_CPU_START 7 -#define ERTS_PSD_SIZE 8 +#define ERTS_PSD_SIZE 7 -#if !defined(HIPE) && !defined(ERTS_DIRTY_SCHEDULERS) +#if !defined(HIPE) # undef ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF -# undef ERTS_PSD_DIRTY_CPU_START # undef ERTS_PSD_SIZE # define ERTS_PSD_SIZE 6 -#elif !defined(HIPE) -# undef ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF -# undef ERTS_PSD_DIRTY_CPU_START -# undef ERTS_PSD_SIZE -# define ERTS_PSD_DIRTY_CPU_START 6 -# define ERTS_PSD_SIZE 7 -#elif !defined(ERTS_DIRTY_SCHEDULERS) -# undef ERTS_PSD_DIRTY_CPU_START -# undef ERTS_PSD_SIZE -# define ERTS_PSD_SIZE 7 #endif typedef struct { @@ -1831,7 +1819,7 @@ Eterm erts_get_schedulers_binds(Process *c_p); Eterm erts_set_cpu_topology(Process *c_p, Eterm term); Eterm erts_bind_schedulers(Process *c_p, Eterm how); ErtsRunQueue *erts_schedid2runq(Uint); -Process *schedule(Process*, int); +Process *erts_schedule(ErtsSchedulerData *, Process*, int); void erts_schedule_misc_op(void (*)(void *), void *); Eterm erl_create_process(Process*, Eterm, Eterm, Eterm, ErlSpawnOpts*); void erts_do_exit_process(Process*, Eterm); @@ -2061,13 +2049,6 @@ erts_psd_set(Process *p, int ix, void *data) ((struct saved_calls *) erts_psd_set((P), ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF, (void *) (SCB))) #endif -#ifdef ERTS_DIRTY_SCHEDULERS -#define ERTS_PROC_GET_DIRTY_CPU_START(P) \ - ((void *) erts_psd_get((P), ERTS_PSD_DIRTY_CPU_START)) -#define ERTS_PROC_SET_DIRTY_CPU_START(P, DCS) \ - ((void *) erts_psd_set((P), ERTS_PSD_DIRTY_CPU_START, (void *) (DCS))) -#endif - ERTS_GLB_INLINE Eterm erts_proc_get_error_handler(Process *p); ERTS_GLB_INLINE Eterm erts_proc_set_error_handler(Process *p, Eterm handler); diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c index 02c24557c1..2a19211987 100644 --- a/erts/emulator/beam/export.c +++ b/erts/emulator/beam/export.c @@ -31,7 +31,7 @@ #define EXPORT_INITIAL_SIZE 4000 #define EXPORT_LIMIT (512*1024) -#define EXPORT_HASH(m,f,a) ((m)*(f)+(a)) +#define EXPORT_HASH(m,f,a) ((atom_val(m) * atom_val(f)) ^ (a)) #ifdef DEBUG # define IF_DEBUG(x) x @@ -79,8 +79,7 @@ struct export_templ static struct export_blob* entry_to_blob(struct export_entry* ee) { - return (struct export_blob*) - ((char*)ee->ep - offsetof(struct export_blob,exp)); + return ErtsContainerStruct(ee->ep, struct export_blob, exp); } void diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index b76b9cd874..f3d4ac56cd 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -62,6 +62,9 @@ struct enif_environment_t /* ErlNifEnv */ extern void erts_pre_nif(struct enif_environment_t*, Process*, struct erl_module_nif*, Process* tracee); extern void erts_post_nif(struct enif_environment_t* env); +extern void erts_pre_dirty_nif(ErtsSchedulerData *, + struct enif_environment_t*, Process*, + struct erl_module_nif*, Process* tracee); extern Eterm erts_nif_taints(Process* p); extern void erts_print_nif_taints(int to, void* to_arg); void erts_unload_nif(struct erl_module_nif* nif); @@ -1152,6 +1155,7 @@ void print_pass_through(int, byte*, int); int catchlevel(Process*); void init_emulator(void); void process_main(void); +void erts_dirty_process_main(ErtsSchedulerData *); Eterm build_stacktrace(Process* c_p, Eterm exc); Eterm expand_error_value(Process* c_p, Uint freason, Eterm Value); void erts_save_stacktrace(Process* p, struct StackTrace* s, int depth); diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index f303d4f167..9a205d50d3 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -97,7 +97,7 @@ ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes)) #define ErtsContainerStruct(ptr, type, member) \ - (type *)((char *)(1 ? (ptr) : &((type *)0)->member) - offsetof(type, member)) + ((type *)((char *)(1 ? (ptr) : &((type *)0)->member) - offsetof(type, member))) #if defined (__WIN32__) # include "erl_win_sys.h" diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index f0418446a8..675fafa726 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2210,7 +2210,9 @@ do_allocate_logger_message(Eterm gleader, Eterm **hp, ErlOffHeap **ohp, #ifndef ERTS_SMP #ifdef USE_THREADS - if (erts_get_scheduler_data()) /* Must be scheduler thread */ + if (!erts_get_scheduler_data()) /* Must be scheduler thread */ + *p = NULL; + else #endif { *p = erts_whereis_process(NULL, 0, am_error_logger, 0, 0); @@ -2226,18 +2228,10 @@ do_allocate_logger_message(Eterm gleader, Eterm **hp, ErlOffHeap **ohp, } /* So we have an error logger, lets build the message */ - if (sz <= HeapWordsLeft(*p)) { - *ohp = &MSO(*p); - *hp = HEAP_TOP(*p); - HEAP_TOP(*p) += sz; - } else { -#endif - *bp = new_message_buffer(sz); - *ohp = &(*bp)->off_heap; - *hp = (*bp)->mem; -#ifndef ERTS_SMP - } #endif + *bp = new_message_buffer(sz); + *ohp = &(*bp)->off_heap; + *hp = (*bp)->mem; return (is_nil(gleader) ? am_noproc diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index 58b5be3906..3336fded7a 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -697,7 +697,7 @@ static struct nbif nbifs[BIF_SIZE] = { #undef BIF_LIST }; -#define NBIF_HASH(m,f,a) ((m)*(f)+(a)) +#define NBIF_HASH(m,f,a) (atom_val(m) ^ atom_val(f) ^ (a)) static Hash nbif_table; static HashValue nbif_hash(struct nbif *x) @@ -1063,7 +1063,7 @@ static inline void hipe_mfa_info_table_rwunlock(void) erts_smp_rwmtx_rwunlock(&hipe_mfa_info_table.lock); } -#define HIPE_MFA_HASH(M,F,A) ((M) * (F) + (A)) +#define HIPE_MFA_HASH(M,F,A) (atom_val(M) ^ atom_val(F) ^ (A)) static struct hipe_mfa_info **hipe_mfa_info_table_alloc_bucket(unsigned int size) { @@ -1144,10 +1144,13 @@ static inline struct hipe_mfa_info *hipe_mfa_info_table_get_locked(Eterm m, Eter h = HIPE_MFA_HASH(m, f, arity); i = h & hipe_mfa_info_table.mask; p = hipe_mfa_info_table.bucket[i]; - for (; p; p = p->bucket.next) - /* XXX: do we want to compare p->bucket.hvalue as well? */ - if (p->m == m && p->f == f && p->a == arity) - return p; + for (; p; p = p->bucket.next) { + if (p->bucket.hvalue == h) { + if (p->m == m && p->f == f && p->a == arity) + return p; + } + else ASSERT(!(p->m == m && p->f == f && p->a == arity)); + } return NULL; } @@ -1171,10 +1174,13 @@ static struct hipe_mfa_info *hipe_mfa_info_table_put_rwlocked(Eterm m, Eterm f, h = HIPE_MFA_HASH(m, f, arity); i = h & hipe_mfa_info_table.mask; p = hipe_mfa_info_table.bucket[i]; - for (; p; p = p->bucket.next) - /* XXX: do we want to compare p->bucket.hvalue as well? */ - if (p->m == m && p->f == f && p->a == arity) - return p; + for (; p; p = p->bucket.next) { + if (p->bucket.hvalue == h) { + if (p->m == m && p->f == f && p->a == arity) + return p; + } + else ASSERT(!(p->m == m && p->f == f && p->a == arity)); + } p = hipe_mfa_info_table_alloc(m, f, arity); p->bucket.hvalue = h; p->bucket.next = hipe_mfa_info_table.bucket[i]; diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index 884331e969..ed95045292 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -547,7 +547,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) p->flags &= ~F_HIPE_MODE; ERTS_SMP_UNREQ_PROC_MAIN_LOCK(p); - p = schedule(p, reds_in - p->fcalls); + p = erts_schedule(NULL, p, reds_in - p->fcalls); ERTS_SMP_REQ_PROC_MAIN_LOCK(p); ASSERT(!(p->flags & F_HIPE_MODE)); #ifdef ERTS_SMP diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index ec6cb6ab72..d31399e4af 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -141,9 +141,11 @@ guard_bifs_in_erl_bif_types(_Config) -> shadow_comments(_Config) -> ensure_erl_bif_types_compiled(), + ErlangList = [{erlang,F,A} || {F,A} <- erlang:module_info(exports), + not is_operator(F,A)], List0 = erlang:system_info(snifs), - List1 = [MFA || {M,_,_}=MFA <- List0, M =/= hipe_bifs], - List = [MFA || MFA <- List1, not is_operator(MFA)], + List1 = [MFA || {M,_,_}=MFA <- List0, M =/= hipe_bifs, M =/= erlang], + List = List1 ++ ErlangList, HasTypes = [MFA || {M,F,A}=MFA <- List, erl_bif_types:is_known(M, F, A)], Path = get_code_path(), @@ -253,12 +255,15 @@ specs(_) -> end. is_operator({erlang,F,A}) -> + is_operator(F,A); +is_operator(_) -> false. + +is_operator(F,A) -> erl_internal:arith_op(F, A) orelse erl_internal:bool_op(F, A) orelse erl_internal:comp_op(F, A) orelse erl_internal:list_op(F, A) orelse - erl_internal:send_op(F, A); -is_operator(_) -> false. + erl_internal:send_op(F, A). extract_specs(M, Abstr) -> [{make_mfa(M, Name),Spec} || {attribute,_,spec,{Name,Spec}} <- Abstr]. diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index 941cb435f7..22a1c0b765 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -527,7 +527,7 @@ huge_float_check({'EXIT',{system_limit,_}}) -> ok; huge_float_check({'EXIT',{badarg,_}}) -> ok. huge_binary(Config) when is_list(Config) -> - ct:timetrap({seconds, 30}), + ct:timetrap({seconds, 60}), 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>), garbage_collect(), {Shift,Return} = case free_mem() of @@ -561,30 +561,13 @@ huge_binary(Config) when is_list(Config) -> end. free_mem() -> - Cmd = "uname; free", - Output = string:tokens(os:cmd(Cmd), "\n"), - io:format("Output from command ~p\n~p\n",[Cmd,Output]), - case Output of - [OS, ColumnNames, Values | _] -> - case string:str(OS,"Linux") of - 0 -> - io:format("Unknown OS\n",[]), - undefined; - _ -> - case {string:tokens(ColumnNames, " \t"), - string:tokens(Values, " \t")} of - {[_,_,"free"|_],["Mem:",_,_,FreeKb|_]} -> - list_to_integer(FreeKb) div 1024; - _ -> - io:format("Failed to parse output from 'free':\n",[]), - undefined - end - end; - _ -> - io:format("Too few lines in output\n",[]), - undefined + {ok,Apps} = application:ensure_all_started(os_mon), + Mem = memsup:get_system_memory_data(), + [ok = application:stop(App)||App <- Apps], + case proplists:get_value(free_memory,Mem) of + undefined -> undefined; + Val -> Val div 1024 end. - system_limit(Config) when is_list(Config) -> WordSize = erlang:system_info(wordsize), @@ -614,8 +597,7 @@ system_limit_32() -> {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), - {'EXIT',{system_limit,_}} = - (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), %% The size would be silently truncated, resulting in a crash. {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>), @@ -627,16 +609,10 @@ system_limit_32() -> ok. badarg(Config) when is_list(Config) -> - {'EXIT',{badarg,_}} = - (catch <<0:(id(1 bsl 100)),0:(id(-1))>>), - {'EXIT',{badarg,_}} = - (catch <<0:(id(1 bsl 100)),0:(id(-(1 bsl 70)))>>), - {'EXIT',{badarg,_}} = - (catch <<0:(id(-(1 bsl 70))),0:(id(1 bsl 100))>>), - - {'EXIT',{badarg,_}} = - (catch <<(id(<<>>))/binary,0:(id(-(1 bsl 100)))>>), - + {'EXIT',{badarg,_}} = (catch <<0:(id(1 bsl 100)),0:(id(-1))>>), + {'EXIT',{badarg,_}} = (catch <<0:(id(1 bsl 100)),0:(id(-(1 bsl 70)))>>), + {'EXIT',{badarg,_}} = (catch <<0:(id(-(1 bsl 70))),0:(id(1 bsl 100))>>), + {'EXIT',{badarg,_}} = (catch <<(id(<<>>))/binary,0:(id(-(1 bsl 100)))>>), ok. copy_writable_binary(Config) when is_list(Config) -> diff --git a/erts/emulator/test/dirty_nif_SUITE.erl b/erts/emulator/test/dirty_nif_SUITE.erl index c3afbc0803..83b098a704 100644 --- a/erts/emulator/test/dirty_nif_SUITE.erl +++ b/erts/emulator/test/dirty_nif_SUITE.erl @@ -32,19 +32,23 @@ dirty_nif/1, dirty_nif_send/1, dirty_nif_exception/1, call_dirty_nif_exception/1, dirty_scheduler_exit/1, dirty_call_while_terminated/1, - dirty_heap_access/1]). + dirty_heap_access/1, dirty_process_info/1, + dirty_process_register/1, dirty_process_trace/1]). -define(nif_stub,nif_stub_error(?LINE)). suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [dirty_nif, dirty_nif_send, dirty_nif_exception, dirty_scheduler_exit, dirty_call_while_terminated, - dirty_heap_access]. + dirty_heap_access, + dirty_process_info, + dirty_process_register, + dirty_process_trace]. init_per_suite(Config) -> try erlang:system_info(dirty_cpu_schedulers) of @@ -187,7 +191,7 @@ dirty_call_while_terminated(Config) when is_list(Config) -> blipp:blupp(Bin) end, [monitor,link]), - receive {dirty_alive, Pid} -> ok end, + receive {dirty_alive, _Pid} -> ok end, {value, {BinAddr, 4711, 2}} = lists:keysearch(4711, 2, element(2, process_info(self(), @@ -241,7 +245,7 @@ dirty_heap_access(Config) when is_list(Config) -> end), {N, R} = access_dirty_heap(Dirty, RGL, 0, 0), receive - {Pid, Res} -> + {_Pid, Res} -> 1000 = length(Res), lists:foreach(fun (X) -> Ref = X end, Res) end, @@ -269,12 +273,123 @@ access_dirty_heap(Dirty, RGL, N, R) -> end) end. +%% These tests verify that processes that access a process executing a +%% dirty NIF where the main lock is needed for that access do not get +%% blocked. Each test passes its pid to dirty_sleeper, which sends a +%% 'ready' message when it's running on a dirty scheduler and just before +%% it starts a 6 second sleep. When it receives the message, it verifies +%% that access to the dirty process is as it expects. After the dirty +%% process finishes its 6 second sleep but before it returns from the dirty +%% scheduler, it sends a 'done' message. If the tester already received +%% that message, the test fails because it means attempting to access the +%% dirty process waited for that process to return to a regular scheduler, +%% so verify that we haven't received that message, and also verify that +%% the dirty process is still alive immediately after accessing it. +dirty_process_info(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> ok end, + fun(NifPid) -> + PI = process_info(NifPid), + {current_function,{?MODULE,dirty_sleeper,1}} = + lists:keyfind(current_function, 1, PI), + ok + end, + fun(_) -> ok end). + +dirty_process_register(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> ok end, + fun(NifPid) -> + register(test_dirty_process_register, NifPid), + NifPid = whereis(test_dirty_process_register), + unregister(test_dirty_process_register), + false = lists:member(test_dirty_process_register, + registered()), + ok + end, + fun(_) -> ok end). + +dirty_process_trace(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> + erlang:trace_pattern({?MODULE,dirty_sleeper,1}, + [{'_',[],[{return_trace}]}], + [local,meta]), + ok + end, + fun(NifPid) -> + erlang:trace(NifPid, true, [call,timestamp]), + ok + end, + fun(NifPid) -> + receive + done -> + receive + {trace_ts,NifPid,call,{?MODULE,dirty_sleeper,_},_} -> + ok + after + 0 -> + error(missing_trace_call_message) + end, + receive + {trace_ts,NifPid,return_from,{?MODULE,dirty_sleeper,1}, + ok,_} -> + ok + after + 100 -> + error(missing_trace_return_message) + end + after + 6500 -> + error(missing_done_message) + end, + ok + end). + %% %% Internal... %% +access_dirty_process(Config, Start, Test, Finish) -> + {ok, Node} = start_node(Config, ""), + [ok] = mcall(Node, + [fun() -> + Path = ?config(data_dir, Config), + Lib = atom_to_list(?MODULE), + ok = erlang:load_nif(filename:join(Path,Lib), []), + ok = test_dirty_process_access(Start, Test, Finish) + end]), + stop_node(Node), + ok. + +test_dirty_process_access(Start, Test, Finish) -> + ok = Start(), + Self = self(), + NifPid = spawn_link(fun() -> + ok = dirty_sleeper(Self) + end), + ok = receive + ready -> + ok = Test(NifPid), + receive + done -> + error(dirty_process_info_blocked) + after + 0 -> + true = erlang:is_process_alive(NifPid), + ok + end + after + 3000 -> + error(timeout) + end, + ok = Finish(NifPid). + receive_any() -> - receive M -> M end. + receive M -> M end. start_node(Config) -> start_node(Config, ""). @@ -314,13 +429,13 @@ mcall(Node, Funs) -> %% The NIFs: lib_loaded() -> false. -call_nif_schedule(_,_) -> ?nif_stub. call_dirty_nif(_,_,_) -> ?nif_stub. send_from_dirty_nif(_) -> ?nif_stub. call_dirty_nif_exception(_) -> ?nif_stub. call_dirty_nif_zero_args() -> ?nif_stub. dirty_call_while_terminated_nif(_) -> ?nif_stub. dirty_sleeper() -> ?nif_stub. +dirty_sleeper(_) -> ?nif_stub. dirty_heap_access_nif(_) -> ?nif_stub. nif_stub_error(Line) -> diff --git a/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c index 2013c88167..e38bececde 100644 --- a/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c +++ b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c @@ -19,7 +19,9 @@ */ #include "erl_nif.h" #include <assert.h> -#ifndef __WIN32__ +#ifdef __WIN32__ +#include <windows.h> +#else #include <unistd.h> #endif @@ -146,12 +148,31 @@ static ERL_NIF_TERM call_dirty_nif_zero_args(ErlNifEnv* env, int argc, const ERL static ERL_NIF_TERM dirty_sleeper(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + ErlNifPid pid; + ErlNifEnv* msg_env = NULL; + assert(enif_is_on_dirty_scheduler(env)); + + /* If we get a pid argument, it indicates a process involved in the + test wants a message from us. Prior to the sleep we send a 'ready' + message, and then after the sleep, send a 'done' message. */ + if (argc == 1 && enif_get_local_pid(env, argv[0], &pid)) { + msg_env = enif_alloc_env(); + enif_send(env, &pid, msg_env, enif_make_atom(msg_env, "ready")); + } + #ifdef __WIN32__ Sleep(6000); #else sleep(6); #endif + + if (argc == 1) { + assert(msg_env != NULL); + enif_send(env, &pid, msg_env, enif_make_atom(msg_env, "done")); + enif_free_env(msg_env); + } + return enif_make_atom(env, "ok"); } @@ -216,6 +237,7 @@ static ErlNifFunc nif_funcs[] = {"call_dirty_nif_exception", 1, call_dirty_nif_exception, ERL_NIF_DIRTY_JOB_IO_BOUND}, {"call_dirty_nif_zero_args", 0, call_dirty_nif_zero_args, ERL_NIF_DIRTY_JOB_CPU_BOUND}, {"dirty_sleeper", 0, dirty_sleeper, ERL_NIF_DIRTY_JOB_IO_BOUND}, + {"dirty_sleeper", 1, dirty_sleeper, ERL_NIF_DIRTY_JOB_CPU_BOUND}, {"dirty_call_while_terminated_nif", 1, dirty_call_while_terminated_nif, ERL_NIF_DIRTY_JOB_CPU_BOUND}, {"dirty_heap_access_nif", 1, dirty_heap_access_nif, ERL_NIF_DIRTY_JOB_CPU_BOUND} }; diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 5283519c0a..94f3078173 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -977,11 +977,13 @@ group_leader(_GroupLeader, _Pid) -> erlang:nif_error(undefined). %% halt/0 +%% Shadowed by erl_bif_types: erlang:halt/0 -spec halt() -> no_return(). halt() -> erlang:halt(0, []). %% halt/1 +%% Shadowed by erl_bif_types: erlang:halt/1 -spec halt(Status) -> no_return() when Status :: non_neg_integer() | 'abort' | string(). halt(Status) -> @@ -2576,6 +2578,7 @@ universaltime_to_localtime(_Universaltime) -> %%-------------------------------------------------------------------------- +%% Shadowed by erl_bif_types: erlang:apply/2 -spec apply(Fun, Args) -> term() when Fun :: function(), Args :: [term()]. diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src index 98e0224a5f..e18da28905 100644 --- a/erts/preloaded/src/erts.app.src +++ b/erts/preloaded/src/erts.app.src @@ -37,7 +37,7 @@ {registered, []}, {applications, []}, {env, []}, - {runtime_dependencies, ["stdlib-2.5", "kernel-4.0", "sasl-2.4"]} + {runtime_dependencies, ["stdlib-3.0", "kernel-5.0", "sasl-3.0"]} ]}. %% vim: ft=erlang diff --git a/lib/common_test/test_server/ts_install.erl b/lib/common_test/test_server/ts_install.erl index b906eb21f5..5734bd0787 100644 --- a/lib/common_test/test_server/ts_install.erl +++ b/lib/common_test/test_server/ts_install.erl @@ -332,11 +332,12 @@ platform(Vars) -> LC = lock_checking(), MT = modified_timing(), AsyncThreads = async_threads(), + OffHeapMsgQ = off_heap_msgq(), Debug = debug(), CpuBits = word_size(), Common = lists:concat([Hostname,"/",OsType,"/",CpuType,CpuBits,LinuxDist, Schedulers,BindType,KP,IOTHR,LC,MT,AsyncThreads, - Debug,ExtraLabel]), + OffHeapMsgQ,Debug,ExtraLabel]), PlatformId = lists:concat([ErlType, " ", Version, Common]), PlatformLabel = ErlType ++ Common, PlatformFilename = platform_as_filename(PlatformId), @@ -400,6 +401,12 @@ async_threads() -> _ -> "" end. +off_heap_msgq() -> + case catch erlang:system_info(message_queue_data) of + off_heap -> "/OffHeapMsgQ"; + _ -> "" + end. + schedulers() -> case catch erlang:system_info(smp_support) of true -> diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index dd42add433..b01f58f683 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -262,7 +262,7 @@ backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) -> backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) -> To = shortcut_select_label(To0, Reg, Src, D), Jump = {jump,{f,To}}, - case beam_utils:is_killed_at(Reg, To, D) of + case is_killed_at(Reg, To, D) of false -> backward([Move|Is], D, [Jump|Acc]); true -> backward([Jump|Is], D, Acc) end; @@ -420,7 +420,7 @@ comp_op_find_shortcut(To0, Reg, Val, D) -> To0 -> not_possible(); To -> - case beam_utils:is_killed_at(Reg, To, D) of + case is_killed_at(Reg, To, D) of false -> not_possible(); true -> To end @@ -863,3 +863,17 @@ get_literal(nil) -> get_literal({literal,_}=Lit) -> Lit; get_literal({_,_}) -> error. + + +%%% +%%% Removing stores to Y registers is not always safe +%%% if there is an instruction that causes an exception +%%% within a catch. In practice, there are few or no +%%% opportunities for removing stores to Y registers anyway +%%% if sys_core_fold has been run. +%%% + +is_killed_at({x,_}=Reg, Lbl, D) -> + beam_utils:is_killed_at(Reg, Lbl, D); +is_killed_at({y,_}, _, _) -> + false. diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index cb3a6b79de..4a181c1923 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -133,10 +133,12 @@ translate_exception(_, _, _, _) -> no. fix_block(Is, 0) -> reverse(Is); fix_block(Is, Words) -> - fix_block_1(reverse(Is), Words). + reverse(fix_block_1(Is, Words)). -fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is], Words) -> - [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is]; +fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed0,F3}}}|Is], Words) -> + Needed = Needed0 - Words, + true = Needed >= 0, %Assertion. + [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is]; fix_block_1([I|Is], Words) -> [I|fix_block_1(Is, Words)]. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 359248c6af..09cd3aa2d4 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -266,17 +266,17 @@ extract_seq_1(_, _) -> no. %%% (3) (4) (5) (6) Jump and unreachable code optimizations. %%% --record(st, {fc, %Label for function class errors. - entry, %Entry label (must not be moved). - mlbl, %Moved labels. - labels :: cerl_sets:set() %Set of referenced labels. - }). - -opt([{label,Fc}|_]=Is0, CLabel) -> - Lbls = initial_labels(Is0), +-record(st, + { + entry, %Entry label (must not be moved). + mlbl, %Moved labels. + labels :: cerl_sets:set() %Set of referenced labels. + }). + +opt(Is0, CLabel) -> find_fixpoint(fun(Is) -> - St = #st{fc=Fc,entry=CLabel,mlbl=#{}, - labels=Lbls}, + Lbls = initial_labels(Is), + St = #st{entry=CLabel,mlbl=#{},labels=Lbls}, opt(Is, [], St) end, Is0). @@ -327,7 +327,8 @@ opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) -> %% since we will rescan the inserted labels. We MUST rescan. St = St0#st{mlbl=maps:remove(Lbl, Mlbl)}, insert_labels([Lbl|Lbls], Is, Acc, St); - error -> opt(Is, [I|Acc], St0) + error -> + opt(Is, [I|Acc], St0) end; opt([{jump,{f,_}=X}|[{label,_},{jump,X}|_]=Is], Acc, St) -> opt(Is, Acc, St); @@ -362,12 +363,19 @@ opt([I|Is], Acc, #st{labels=Used0}=St0) -> true -> skip_unreachable(Is, [I|Acc], St); false -> opt(Is, [I|Acc], St) end; -opt([], Acc, #st{fc=Fc,mlbl=Mlbl}) -> +opt([], Acc, #st{mlbl=Mlbl}) -> Code = reverse(Acc), - case maps:find(Fc, Mlbl) of - {ok,Lbls} -> insert_fc_labels(Lbls, Mlbl, Code); - error -> Code - end. + insert_fc_labels(Code, Mlbl). + +insert_fc_labels([{label,L}=I|Is0], Mlbl) -> + case maps:find(L, Mlbl) of + error -> + [I|insert_fc_labels(Is0, Mlbl)]; + {ok,Lbls} -> + Is = [{label,Lb} || Lb <- Lbls] ++ Is0, + [I|insert_fc_labels(Is, maps:remove(L, Mlbl))] + end; +insert_fc_labels([_|_]=Is, _) -> Is. maps_append_list(K,Vs,M) -> case M of @@ -375,16 +383,6 @@ maps_append_list(K,Vs,M) -> _ -> M#{K => Vs} end. -insert_fc_labels([L|Ls], Mlbl, Acc0) -> - Acc = [{label,L}|Acc0], - case maps:find(L, Mlbl) of - error -> - insert_fc_labels(Ls, Mlbl, Acc); - {ok,Lbls} -> - insert_fc_labels(Lbls++Ls, Mlbl, Acc) - end; -insert_fc_labels([], _, Acc) -> Acc. - collect_labels(Is, #st{entry=Entry}) -> collect_labels_1(Is, Entry, []). diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl index c593184746..89cafe27ce 100644 --- a/lib/compiler/src/beam_receive.erl +++ b/lib/compiler/src/beam_receive.erl @@ -177,7 +177,8 @@ opt_recv([I|Is], D, R0, L0, Acc) -> no; false -> opt_recv(Is, D, R, L, [I|Acc]) - end. + end; +opt_recv([], _, _, _, _) -> no. opt_update_regs({block,Bl}, R, L) -> {opt_update_regs_bl(Bl, R),L}; diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 47703b4aa3..a15ecf633e 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -167,8 +167,7 @@ bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}. %% is_pure_test({test,Op,Fail,Ops}) -> true|false. %% Return 'true' if the test instruction does not modify any -%% registers and/or bit syntax matching state, nor modifies -%% any bit syntax matching state. +%% registers and/or bit syntax matching state. %% is_pure_test({test,is_eq,_,[_,_]}) -> true; is_pure_test({test,is_ne,_,[_,_]}) -> true; @@ -180,6 +179,8 @@ is_pure_test({test,is_nil,_,[_]}) -> true; is_pure_test({test,is_nonempty_list,_,[_]}) -> true; is_pure_test({test,test_arity,_,[_,_]}) -> true; is_pure_test({test,has_map_fields,_,[_|_]}) -> true; +is_pure_test({test,is_bitstr,_,[_]}) -> true; +is_pure_test({test,is_function2,_,[_,_]}) -> true; is_pure_test({test,Op,_,Ops}) -> erl_internal:new_type_test(Op, length(Ops)). @@ -324,8 +325,11 @@ check_liveness(R, [{deallocate,_}|Is], St) -> {y,_} -> {killed,St}; _ -> check_liveness(R, Is, St) end; -check_liveness(R, [return|_], St) -> - check_liveness_live_ret(R, 1, St); +check_liveness({x,_}=R, [return|_], St) -> + case R of + {x,0} -> {used,St}; + {x,_} -> {killed,St} + end; check_liveness(R, [{call,Live,_}|Is], St) -> case R of {x,X} when X < Live -> {used,St}; @@ -534,14 +538,6 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) -> check_liveness_ret(R, R, St) -> {used,St}; check_liveness_ret(_, _, St) -> {killed,St}. -check_liveness_live_ret({x,R}, Live, St) -> - if - R < Live -> {used,St}; - true -> {killed,St} - end; -check_liveness_live_ret({y,_}, _, St) -> - {killed,St}. - check_liveness_fail(_, _, _, 0, St) -> {killed,St}; check_liveness_fail(R, Op, Args, Fail, St) -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index faff9940ec..1af17dc641 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1510,7 +1510,6 @@ bif_type(node, [_], _) -> {atom,[]}; bif_type(hd, [_], _) -> term; bif_type(tl, [_], _) -> term; bif_type(get, [_], _) -> term; -bif_type(raise, [_,_], _) -> exception; bif_type(Bif, _, _) when is_atom(Bif) -> term. is_bif_safe('/=', 2) -> true; @@ -1524,6 +1523,7 @@ is_bif_safe('>=', 2) -> true; is_bif_safe(is_atom, 1) -> true; is_bif_safe(is_boolean, 1) -> true; is_bif_safe(is_binary, 1) -> true; +is_bif_safe(is_bitstring, 1) -> true; is_bif_safe(is_float, 1) -> true; is_bif_safe(is_function, 1) -> true; is_bif_safe(is_integer, 1) -> true; diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index f531056591..f5f3c73793 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1089,6 +1089,23 @@ protected_cg(Ts, Rs, _Fail, I, Vdb, Bef, St0) -> %% test_cg(TestName, Args, Fail, I, Vdb, Bef, St) -> {[Ainstr],Aft,St}. %% Generate test instruction. Use explicit fail label here. +test_cg(is_map, [A], Fail, I, Vdb, Bef, St) -> + %% We must avoid creating code like this: + %% + %% move x(0) y(0) + %% is_map Fail [x(0)] + %% make_fun => x(0) %% Overwrite x(0) + %% put_map_assoc y(0) ... + %% + %% The code is safe, but beam_validator does not understand that. + %% Extending beam_validator to handle such (rare) code as the + %% above would make it slower for all programs. Instead, change + %% the code generator to always prefer the Y register for is_map() + %% and put_map_assoc() instructions, ensuring that they use the + %% same register. + Arg = cg_reg_arg_prefer_y(A, Bef), + Aft = clear_dead(Bef, I, Vdb), + {[{test,is_map,{f,Fail},[Arg]}],Aft,St}; test_cg(Test, As, Fail, I, Vdb, Bef, St) -> Args = cg_reg_args(As, Bef), Aft = clear_dead(Bef, I, Vdb), @@ -1155,19 +1172,15 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> %% Inside a guard. The only allowed function call is to %% erlang:error/1,2. We will generate the following code: %% - %% jump FailureLabel %% move {atom,ok} DestReg - %% - %% The 'move' instruction will never be executed, but we - %% generate it anyway in case the beam_validator is run - %% on unoptimized code. + %% jump FailureLabel {remote,{atom,erlang},{atom,error}} = Func, %Assertion. [{var,DestVar}] = Rs, Int0 = clear_dead(Bef, Le#l.i, Vdb), Reg = put_reg(DestVar, Int0#sr.reg), Int = Int0#sr{reg=Reg}, Dst = fetch_reg(DestVar, Reg), - {[{jump,{f,Fail}},{move,{atom,ok},Dst}], + {[{move,{atom,ok},Dst},{jump,{f,Fail}}], clear_dead(Int, Le#l.i, Vdb),St0}; #cg{} -> %% Ordinary function call in a function body. @@ -1545,7 +1558,7 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, Fail = {f,Bfail}, {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), - SrcReg = cg_reg_arg(Map,Int0), + SrcReg = cg_reg_arg_prefer_y(Map, Int0), Line = line(Le#l.a), List = [cg_reg_arg(K,Int0),cg_reg_arg(V,Int0)], @@ -1572,7 +1585,7 @@ set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, Fail = {f,Bfail}, {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), - SrcReg = cg_reg_arg(Map,Int0), + SrcReg = cg_reg_arg_prefer_y(Map, Int0), Line = line(Le#l.a), %% fetch registers for values to be put into the map @@ -1845,6 +1858,9 @@ cg_reg_args(As, Bef) -> [cg_reg_arg(A, Bef) || A <- As]. cg_reg_arg({var,V}, Bef) -> fetch_var(V, Bef); cg_reg_arg(Literal, _) -> Literal. +cg_reg_arg_prefer_y({var,V}, Bef) -> fetch_var_prefer_y(V, Bef); +cg_reg_arg_prefer_y(Literal, _) -> Literal. + %% cg_setup_call([Arg], Bef, Cur, Vdb) -> {[Instr],Aft}. %% Do the complete setup for a call/enter. @@ -2086,6 +2102,12 @@ fetch_var(V, Sr) -> error -> fetch_stack(V, Sr#sr.stk) end. +fetch_var_prefer_y(V, #sr{reg=Reg,stk=Stk}) -> + case find_stack(V, Stk) of + {ok,R} -> R; + error -> fetch_reg(V, Reg) + end. + load_vars(Vs, Regs) -> foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs). @@ -2159,11 +2181,11 @@ fetch_stack(Var, Stk) -> fetch_stack(Var, Stk, 0). fetch_stack(V, [{V}|_], I) -> {yy,I}; fetch_stack(V, [_|Stk], I) -> fetch_stack(V, Stk, I+1). -% find_stack(Var, Stk) -> find_stack(Var, Stk, 0). +find_stack(Var, Stk) -> find_stack(Var, Stk, 0). -% find_stack(V, [{V}|Stk], I) -> {ok,{yy,I}}; -% find_stack(V, [O|Stk], I) -> find_stack(V, Stk, I+1); -% find_stack(V, [], I) -> error. +find_stack(V, [{V}|_], I) -> {ok,{yy,I}}; +find_stack(V, [_|Stk], I) -> find_stack(V, Stk, I+1); +find_stack(_, [], _) -> error. on_stack(V, Stk) -> keymember(V, 1, Stk). diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 203a50db55..f0185acbc7 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -13,9 +13,11 @@ MODULES= \ beam_validator_SUITE \ beam_disasm_SUITE \ beam_except_SUITE \ + beam_jump_SUITE \ beam_reorder_SUITE \ beam_type_SUITE \ beam_utils_SUITE \ + bif_SUITE \ bs_bincomp_SUITE \ bs_bit_binaries_SUITE \ bs_construct_SUITE \ @@ -49,9 +51,11 @@ NO_OPT= \ beam_block \ beam_bool \ beam_except \ + beam_jump \ beam_reorder \ beam_type \ beam_utils \ + bif \ bs_construct \ bs_match \ bs_utf \ diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl index 8746e62fb9..47367d6eab 100644 --- a/lib/compiler/test/beam_except_SUITE.erl +++ b/lib/compiler/test/beam_except_SUITE.erl @@ -21,15 +21,18 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - coverage/1]). + multiple_allocs/1,coverage/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [coverage]. + test_lib:recompile(?MODULE), + [{group,p}]. groups() -> - []. + [{p,[parallel], + [multiple_allocs, + coverage]}]. init_per_suite(Config) -> Config. @@ -43,6 +46,23 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +multiple_allocs(_Config) -> + {'EXIT',{{badmatch,#{true:=[p]}},_}} = + (catch could(pda, 0.0, {false,true}, {p})), + {'EXIT',{function_clause,_}} = (catch place(lee)), + {'EXIT',{{badmatch,wanted},_}} = (catch conditions()), + + ok. + +could(Coupons = pda, Favorite = _pleasure = 0.0, {_, true}, {Presents}) -> + (0 = true) = #{true => [Presents]}. + +place(lee) -> + (pregnancy = presentations) = [hours | [purchase || _ <- 0]] + wine. + +conditions() -> + (talking = going) = storage + [large = wanted]. + coverage(_) -> File = {file,"fake.erl"}, ok = fc(a), diff --git a/lib/compiler/test/beam_jump_SUITE.erl b/lib/compiler/test/beam_jump_SUITE.erl new file mode 100644 index 0000000000..0b13adaff2 --- /dev/null +++ b/lib/compiler/test/beam_jump_SUITE.erl @@ -0,0 +1,59 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(beam_jump_SUITE). + +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + undefined_label/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [{group,p}]. + +groups() -> + [{p,[parallel], + [undefined_label + ]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +undefined_label(_Config) -> + {'EXIT',{function_clause,_}} = (catch flights(0, [], [])), + ok. + +%% Would lose a label when compiled with no_copt. + +flights(0, [], []) when [], 0; 0.0, [], false -> + clark; +flights(_, Reproduction, introduction) when false, Reproduction -> + responsible. diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl index ae813d563b..f6d4a311bb 100644 --- a/lib/compiler/test/beam_utils_SUITE.erl +++ b/lib/compiler/test/beam_utils_SUITE.erl @@ -23,7 +23,8 @@ init_per_group/2,end_per_group/2, apply_fun/1,apply_mf/1,bs_init/1,bs_save/1, is_not_killed/1,is_not_used_at/1, - select/1,y_catch/1,otp_8949_b/1,liveopt/1,coverage/1]). + select/1,y_catch/1,otp_8949_b/1,liveopt/1,coverage/1, + y_registers/1]). -export([id/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -44,7 +45,8 @@ groups() -> y_catch, otp_8949_b, liveopt, - coverage + coverage, + y_registers ]}]. init_per_suite(Config) -> @@ -311,6 +313,45 @@ clinic(Damage) -> end, carefully. +y_registers(_Config) -> + {'EXIT',{{badfun,0},_}} = (catch economic(0.0, jim)), + {'EXIT',{{badmatch,apartments},_}} = (catch louisiana()), + {a,b} = (boxes(true))({a,b}), + {'EXIT',{{case_clause,webmaster},_}} = (catch yellow(true)), + ok. + +economic(0.0 = Serves, Existence) -> + case Serves of + Serves -> 0 + end, + Existence = jim, + 0(), + Serves, + Existence. + +louisiana() -> + {catch necessarily, + try + [] == reg, + true = apartments + catch [] -> barbara + end}. + +boxes(Call) -> + case Call of + Call -> approval + end, + Call, + fun id/1. + +yellow(Hill) -> + case webmaster of + station -> eyes; Hill -> + "under" + end, + Hill, + id(42). + %% The identity function. id(I) -> I. diff --git a/lib/compiler/test/bif_SUITE.erl b/lib/compiler/test/bif_SUITE.erl new file mode 100644 index 0000000000..51bc71da81 --- /dev/null +++ b/lib/compiler/test/bif_SUITE.erl @@ -0,0 +1,65 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(bif_SUITE). + +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + beam_validator/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [{group,p}]. + +groups() -> + [{p,[parallel], + [beam_validator + ]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +%% Cover code in beam_validator. + +beam_validator(Config) -> + [false,Config] = food(Config), + + true = is_number(42.0), + false = is_port(Config), + + ok. + +food(Curriculum) -> + [try + is_bitstring(functions) + catch _ -> + 0 + end, Curriculum]. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 83298e546e..6302f82f29 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -1835,6 +1835,8 @@ bad_guards(Config) when is_list(Config) -> fc(catch bad_guards_3(not_a_map, [x])), fc(catch bad_guards_3(42, [x])), + fc(catch bad_guards_4()), + ok. %% beam_bool used to produce GC BIF instructions whose @@ -1852,6 +1854,12 @@ bad_guards_2(M, [_]) when M#{a := 0, b => 0}, map_size(M) -> bad_guards_3(M, [_]) when is_map(M) andalso M#{a := 0, b => 0}, length(M) -> ok. +%% v3_codegen would generate a jump to the failure label, but +%% without initializing x(0). The code at the failure label expected +%% x(0) to be initialized. + +bad_guards_4() when not (error#{}); {not 0.0} -> freedom. + %% Building maps in a guard in a 'catch' would crash v3_codegen. guard_in_catch(_Config) -> diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 14d175b92c..c3c4862794 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -66,7 +66,9 @@ t_export/1, %% errors in 18 - t_register_corruption/1 + t_register_corruption/1, + t_bad_update/1 + ]). suite() -> []. @@ -117,7 +119,8 @@ all() -> t_export, %% errors in 18 - t_register_corruption + t_register_corruption, + t_bad_update ]. groups() -> []. @@ -1922,6 +1925,19 @@ validate_frequency([{T,C}|Fs],Tf) -> validate_frequency([], _) -> ok. +t_bad_update(_Config) -> + {#{0.0:=Id},#{}} = properly(#{}), + 42 = Id(42), + {'EXIT',{{badmap,_},_}} = (catch increase(0)), + ok. + +properly(Item) -> + {Item#{0.0 => fun id/1},Item}. + +increase(Allows) -> + catch fun() -> Allows end#{[] => +Allows, "warranty" => fun id/1}. + + %% aux rand_terms(0) -> []; diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 3c397561fc..8304672558 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -118,8 +118,14 @@ coverage(Config) when is_list(Config) -> 59 = tuple_to_values(infinity, x), 61 = tuple_to_values(999999, x), 0 = tuple_to_values(1, x), + + {'EXIT',{{badmap,[]},_}} = (catch monitor_plus_badmap(self())), + ok. +monitor_plus_badmap(Pid) -> + monitor(process, Pid) + []#{}. + receive_all() -> receive Any -> diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 067e220863..7183c395ae 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -55,51 +55,69 @@ #include <openssl/evp.h> #include <openssl/hmac.h> -#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + +/* Helper macro to construct a OPENSSL_VERSION_NUMBER. + * See openssl/opensslv.h + */ +#define OpenSSL_version(MAJ, MIN, FIX, P) \ + ((((((((MAJ << 8) | MIN) << 8 ) | FIX) << 8) | (P-'a'+1)) << 4) | 0xf) + +#define OpenSSL_version_plain(MAJ, MIN, FIX) \ + OpenSSL_version(MAJ,MIN,FIX,('a'-1)) + + +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) #include <openssl/modes.h> #endif #include "crypto_callback.h" -#if OPENSSL_VERSION_NUMBER >= 0x00908000L && !defined(OPENSSL_NO_SHA224) && defined(NID_sha224)\ - && !defined(OPENSSL_NO_SHA256) /* disabled like this in my sha.h (?) */ +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(0,9,8) \ + && !defined(OPENSSL_NO_SHA224) && defined(NID_sha224) \ + && !defined(OPENSSL_NO_SHA256) /* disabled like this in my sha.h (?) */ # define HAVE_SHA224 #endif -#if OPENSSL_VERSION_NUMBER >= 0x00908000L && !defined(OPENSSL_NO_SHA256) && defined(NID_sha256) +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(0,9,8) \ + && !defined(OPENSSL_NO_SHA256) && defined(NID_sha256) # define HAVE_SHA256 #endif -#if OPENSSL_VERSION_NUMBER >= 0x00908000L && !defined(OPENSSL_NO_SHA384) && defined(NID_sha384)\ - && !defined(OPENSSL_NO_SHA512) /* disabled like this in my sha.h (?) */ +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(0,9,8) \ + && !defined(OPENSSL_NO_SHA384) && defined(NID_sha384)\ + && !defined(OPENSSL_NO_SHA512) /* disabled like this in my sha.h (?) */ # define HAVE_SHA384 #endif -#if OPENSSL_VERSION_NUMBER >= 0x00908000L && !defined(OPENSSL_NO_SHA512) && defined(NID_sha512) +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(0,9,8) \ + && !defined(OPENSSL_NO_SHA512) && defined(NID_sha512) # define HAVE_SHA512 #endif -#if OPENSSL_VERSION_NUMBER >= 0x0090705FL +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version(0,9,7,'e') # define HAVE_DES_ede3_cfb_encrypt #endif -#if OPENSSL_VERSION_NUMBER >= 0x009080ffL \ +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version(0,9,8,'o') \ && !defined(OPENSSL_NO_EC) \ && !defined(OPENSSL_NO_ECDH) \ && !defined(OPENSSL_NO_ECDSA) # define HAVE_EC #endif -#if OPENSSL_VERSION_NUMBER >= 0x0090803fL +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version(0,9,8,'c') # define HAVE_AES_IGE #endif -#if OPENSSL_VERSION_NUMBER >= 0x1000100fL +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,1) # define HAVE_EVP_AES_CTR # define HAVE_GCM +# if OPENSSL_VERSION_NUMBER < OpenSSL_version(1,0,1,'d') +# define HAVE_GCM_EVP_DECRYPT_BUG +# endif #endif #if defined(NID_chacha20) && !defined(OPENSSL_NO_CHACHA) && !defined(OPENSSL_NO_POLY1305) # define HAVE_CHACHA20_POLY1305 #endif -#if OPENSSL_VERSION_NUMBER <= 0x009080cfL +#if OPENSSL_VERSION_NUMBER <= OpenSSL_version(0,9,8,'l') # define HAVE_ECB_IVEC_BUG #endif @@ -244,6 +262,9 @@ static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +#ifdef HAVE_GCM_EVP_DECRYPT_BUG +static ERL_NIF_TERM aes_gcm_decrypt_NO_EVP(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +#endif static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -479,7 +500,7 @@ static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len); #define PRINTF_ERR1(FMT,A1) #define PRINTF_ERR2(FMT,A1,A2) -#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) /* Define resource types for OpenSSL context structures. */ static ErlNifResourceType* evp_md_ctx_rtype; static void evp_md_ctx_dtor(ErlNifEnv* env, EVP_MD_CTX* ctx) { @@ -578,7 +599,7 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) PRINTF_ERR0("CRYPTO: Could not open resource type 'hmac_context'"); return 0; } -#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) evp_md_ctx_rtype = enif_open_resource_type(env, NULL, "EVP_MD_CTX", (ErlNifResourceDtor*) evp_md_ctx_dtor, ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, @@ -877,7 +898,7 @@ static ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] return ret; } -#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type) */ @@ -1253,7 +1274,7 @@ static ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a obj = enif_alloc_resource(hmac_context_rtype, sizeof(struct hmac_context)); obj->mtx = enif_mutex_create("crypto.hmac"); obj->alive = 1; -#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) // Check the return value of HMAC_Init: it may fail in FIPS mode // for disabled algorithms if (!HMAC_Init(&obj->ctx, key.data, key.size, digp->md.p)) { @@ -1710,7 +1731,9 @@ out_err: static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In,Tag) */ -#if defined(HAVE_GCM) +#if defined(HAVE_GCM_EVP_DECRYPT_BUG) + return aes_gcm_decrypt_NO_EVP(env, argc, argv); +#elif defined(HAVE_GCM) EVP_CIPHER_CTX ctx; const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in, tag; @@ -1763,12 +1786,58 @@ static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM out_err: EVP_CIPHER_CTX_cleanup(&ctx); return atom_error; - #else return enif_raise_exception(env, atom_notsup); #endif } +#ifdef HAVE_GCM_EVP_DECRYPT_BUG +static ERL_NIF_TERM aes_gcm_decrypt_NO_EVP(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + GCM128_CONTEXT *ctx; + ErlNifBinary key, iv, aad, in, tag; + AES_KEY aes_key; + unsigned char *outp; + ERL_NIF_TERM out; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) + || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 + || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0 + || !enif_inspect_iolist_as_binary(env, argv[2], &aad) + || !enif_inspect_iolist_as_binary(env, argv[3], &in) + || !enif_inspect_iolist_as_binary(env, argv[4], &tag)) { + return enif_make_badarg(env); + } + + if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt))) + return atom_error; + + CRYPTO_gcm128_setiv(ctx, iv.data, iv.size); + + if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size)) + goto out_err; + + outp = enif_make_new_binary(env, in.size, &out); + + /* decrypt */ + if (CRYPTO_gcm128_decrypt(ctx, in.data, outp, in.size)) + goto out_err; + + /* calculate and check the tag */ + if (CRYPTO_gcm128_finish(ctx, tag.data, tag.size)) + goto out_err; + + CRYPTO_gcm128_release(ctx); + CONSUME_REDS(env, in); + + return out; + +out_err: + CRYPTO_gcm128_release(ctx); + return atom_error; +} +#endif /* HAVE_GCM_EVP_DECRYPT_BUG */ + #if defined(HAVE_CHACHA20_POLY1305) static void poly1305_update_with_length(poly1305_state *poly1305, @@ -2157,7 +2226,7 @@ static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ERL_NIF_TERM head, tail, ret; int i; RSA *rsa; -#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) EVP_PKEY *pkey; EVP_PKEY_CTX *ctx; #endif @@ -2189,7 +2258,7 @@ static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM goto done; } -#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) pkey = EVP_PKEY_new(); EVP_PKEY_set1_RSA(pkey, rsa); @@ -2316,7 +2385,7 @@ static int get_rsa_private_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa) static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type, Digest, Key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C]) */ ErlNifBinary digest_bin, ret_bin; -#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) EVP_PKEY *pkey; EVP_PKEY_CTX *ctx; size_t rsa_s_len; @@ -2349,7 +2418,7 @@ static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar } -#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) pkey = EVP_PKEY_new(); EVP_PKEY_set1_RSA(pkey, rsa); rsa_s_len=(size_t)EVP_PKEY_size(pkey); diff --git a/lib/hipe/amd64/Makefile b/lib/hipe/amd64/Makefile index 0d81ff4d72..8dc2af2679 100644 --- a/lib/hipe/amd64/Makefile +++ b/lib/hipe/amd64/Makefile @@ -73,7 +73,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += -DHIPE_AMD64 +warn_exported_vars +ERL_COMPILE_FLAGS += -DHIPE_AMD64 -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/arm/Makefile b/lib/hipe/arm/Makefile index 6622680ee1..00b6732afa 100644 --- a/lib/hipe/arm/Makefile +++ b/lib/hipe/arm/Makefile @@ -74,7 +74,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/cerl/Makefile b/lib/hipe/cerl/Makefile index 78930154a9..9f50d6bf91 100644 --- a/lib/hipe/cerl/Makefile +++ b/lib/hipe/cerl/Makefile @@ -66,7 +66,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += -Werror +inline +warn_exported_vars +warn_unused_import +warn_missing_spec #+warn_untyped_record +ERL_COMPILE_FLAGS += +inline -Werror +warn_export_vars +warn_unused_import +warn_missing_spec #+warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index f649c6e599..9453ca6c6f 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -154,6 +154,8 @@ type(M, F, A, Xs) -> erl_types:erl_type(). %%-- erlang ------------------------------------------------------------------- +type(erlang, halt, 0, _, _) -> t_none(); +type(erlang, halt, 1, _, _) -> t_none(); type(erlang, halt, 2, _, _) -> t_none(); type(erlang, exit, 1, _, _) -> t_none(); type(erlang, error, 1, _, _) -> t_none(); @@ -2339,6 +2341,10 @@ arg_types(erlang, bit_size, 1) -> %% Guard bif, needs to be here. arg_types(erlang, byte_size, 1) -> [t_bitstr()]; +arg_types(erlang, halt, 0) -> + []; +arg_types(erlang, halt, 1) -> + [t_sup([t_non_neg_fixnum(), t_atom('abort'), t_string()])]; arg_types(erlang, halt, 2) -> [t_sup([t_non_neg_fixnum(), t_atom('abort'), t_string()]), t_list(t_tuple([t_atom('flush'), t_boolean()]))]; diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index b037a4360c..c383541020 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -1751,14 +1751,14 @@ map_def_val(?map(_,_,DefV)) -> -spec mapdict_store(t_map_pair(), t_map_dict()) -> t_map_dict(). mapdict_store(E={K,_,_}, [{K,_,_}|T]) -> [E|T]; -mapdict_store(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2-> +mapdict_store(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2 -> [E2|mapdict_store(E1, T)]; mapdict_store(E={_,_,_}, T) -> [E|T]. -spec mapdict_insert(t_map_pair(), t_map_dict()) -> t_map_dict(). mapdict_insert(E={K,_,_}, D=[{K,_,_}|_]) -> error(badarg, [E, D]); -mapdict_insert(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2-> +mapdict_insert(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2 -> [E2|mapdict_insert(E1, T)]; mapdict_insert(E={_,_,_}, T) -> [E|T]. @@ -1769,25 +1769,26 @@ mapdict_insert(E={_,_,_}, T) -> [E|T]. t_map_mandatoriness(), erl_type()) -> t_map_pair() | false), erl_type(), erl_type()) -> t_map_dict(). -map_pairwise_merge(F, ?map(APairs, ADefK, ADefV), - ?map(BPairs, BDefK, BDefV)) -> +map_pairwise_merge(F, ?map(APairs, ADefK, ADefV), ?map(BPairs, BDefK, BDefV)) -> map_pairwise_merge(F, APairs, ADefK, ADefV, BPairs, BDefK, BDefV). map_pairwise_merge(_, [], _, _, [], _, _) -> []; map_pairwise_merge(F, As0, ADefK, ADefV, Bs0, BDefK, BDefV) -> - case {As0, Bs0} of - {[{K,AMNess,AV}|As], [{K, BMNess,BV}|Bs]} -> ok; - {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> - {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)}; - {As, [{K, BMNess,BV}|Bs]} -> - {AMNess, AV} = {?opt, mapmerge_otherv(K, ADefK, ADefV)}; - {[{K,AMNess,AV}|As], []=Bs} -> - {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)} - end, - MK = K, %% Rename to make clear that we are matching below - case F(K, AMNess, AV, BMNess, BV) of - false -> map_pairwise_merge(F,As,ADefK,ADefV,Bs,BDefK,BDefV); - M={MK,_,_} -> [M|map_pairwise_merge(F,As,ADefK,ADefV,Bs,BDefK,BDefV)] + {K1, AMNess1, AV1, As1, BMNess1, BV1, Bs1} = + case {As0, Bs0} of + {[{K,AMNess,AV}|As], [{K, BMNess,BV}|Bs]} -> + {K, AMNess, AV, As, BMNess, BV, Bs}; + {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> + {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs}; + {As, [{K, BMNess,BV}|Bs]} -> + {K, ?opt, mapmerge_otherv(K, ADefK, ADefV), As, BMNess, BV, Bs}; + {[{K,AMNess,AV}|As], []=Bs} -> + {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs} + end, + MK = K1, %% Rename to make clear that we are matching below + case F(K1, AMNess1, AV1, BMNess1, BV1) of + false -> map_pairwise_merge(F,As1,ADefK,ADefV,Bs1,BDefK,BDefV); + {MK,_,_}=M -> [M|map_pairwise_merge(F,As1,ADefK,ADefV,Bs1,BDefK,BDefV)] end. %% Folds over the pairs in two maps simultaneously in reverse key order. Missing @@ -1804,17 +1805,19 @@ map_pairwise_merge_foldr(F, AccIn, ?map(APairs, ADefK, ADefV), map_pairwise_merge_foldr(_, Acc, [], _, _, [], _, _) -> Acc; map_pairwise_merge_foldr(F, AccIn, As0, ADefK, ADefV, Bs0, BDefK, BDefV) -> - case {As0, Bs0} of - {[{K,AMNess,AV}|As], [{K, BMNess,BV}|Bs]} -> ok; - {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> - {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)}; - {As, [{K, BMNess,BV}|Bs]} -> - {AMNess, AV} = {?opt, mapmerge_otherv(K, ADefK, ADefV)}; - {[{K,AMNess,AV}|As], []=Bs} -> - {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)} - end, - F(K, AMNess, AV, BMNess, BV, - map_pairwise_merge_foldr(F,AccIn,As,ADefK,ADefV,Bs,BDefK,BDefV)). + {K1, AMNess1, AV1, As1, BMNess1, BV1, Bs1} = + case {As0, Bs0} of + {[{K,AMNess,AV}|As], [{K,BMNess,BV}|Bs]} -> + {K, AMNess, AV, As, BMNess, BV, Bs}; + {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> + {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs}; + {As, [{K,BMNess,BV}|Bs]} -> + {K, ?opt, mapmerge_otherv(K, ADefK, ADefV), As, BMNess, BV, Bs}; + {[{K,AMNess,AV}|As], []=Bs} -> + {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs} + end, + F(K1, AMNess1, AV1, BMNess1, BV1, + map_pairwise_merge_foldr(F,AccIn,As1,ADefK,ADefV,Bs1,BDefK,BDefV)). %% By observing that a missing pair in a map is equivalent to an optional pair, %% with ?none or DefV value, depending on whether K \in DefK, we can simplify diff --git a/lib/hipe/flow/Makefile b/lib/hipe/flow/Makefile index fe1675b7dd..d883eecf36 100644 --- a/lib/hipe/flow/Makefile +++ b/lib/hipe/flow/Makefile @@ -66,7 +66,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec # +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/flow/cfg.hrl b/lib/hipe/flow/cfg.hrl index 641ec102db..2575b9e38a 100644 --- a/lib/hipe/flow/cfg.hrl +++ b/lib/hipe/flow/cfg.hrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -38,8 +38,8 @@ is_closure :: boolean(), closure_arity = none :: 'none' | arity(), is_leaf :: boolean(), - params, % :: list() - info = []}). %% this field seems not needed; take out?? + params :: list(), %% XXX: refine + info = [] :: list()}). %% seems not needed; take out?? -type cfg_info() :: #cfg_info{}. %% diff --git a/lib/hipe/flow/hipe_dominators.erl b/lib/hipe/flow/hipe_dominators.erl index 1b147607c7..72c16b5688 100644 --- a/lib/hipe/flow/hipe_dominators.erl +++ b/lib/hipe/flow/hipe_dominators.erl @@ -59,7 +59,7 @@ -record(domTree, {root :: cfg_lbl(), size = 0 :: non_neg_integer(), nodes = gb_trees:empty() :: gb_trees:tree()}). --type domTree() :: #domTree{}. +-opaque domTree() :: #domTree{}. %%>----------------------------------------------------------------------< %% Procedure : domTree_create/1 diff --git a/lib/hipe/icode/Makefile b/lib/hipe/icode/Makefile index c86562a981..b220bc16a0 100644 --- a/lib/hipe/icode/Makefile +++ b/lib/hipe/icode/Makefile @@ -84,7 +84,7 @@ DOC_FILES= $(DOC_MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_unused_import +warn_exported_vars +warn_missing_spec # +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_unused_import +warn_export_vars +warn_missing_spec # +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl index 07d230491d..78508dff22 100644 --- a/lib/hipe/icode/hipe_icode.erl +++ b/lib/hipe/icode/hipe_icode.erl @@ -610,7 +610,9 @@ %% Exported types %% --export_type([icode/0]). +-export_type([icode/0, params/0]). + +-type params() :: [icode_var()]. %%--------------------------------------------------------------------- %% @@ -618,7 +620,7 @@ %% %%--------------------------------------------------------------------- --spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()], +-spec mk_icode(mfa(), params(), boolean(), boolean(), [icode_instr()], {non_neg_integer(),non_neg_integer()}, {icode_lbl(),icode_lbl()}) -> icode(). mk_icode(Fun, Params, IsClosure, IsLeaf, Code, VarRange, LabelRange) -> @@ -629,7 +631,7 @@ mk_icode(Fun, Params, IsClosure, IsLeaf, Code, VarRange, LabelRange) -> var_range=VarRange, label_range=LabelRange}. --spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()], +-spec mk_icode(mfa(), params(), boolean(), boolean(), [icode_instr()], hipe_consttab(), {non_neg_integer(),non_neg_integer()}, {icode_lbl(),icode_lbl()}) -> icode(). mk_icode(Fun, Params, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) -> @@ -640,11 +642,11 @@ mk_icode(Fun, Params, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) -> -spec icode_fun(icode()) -> mfa(). icode_fun(#icode{'fun' = MFA}) -> MFA. --spec icode_params(icode()) -> [icode_var()]. +-spec icode_params(icode()) -> params(). icode_params(#icode{params = Params}) -> Params. --spec icode_params_update(icode(), [icode_var()]) -> icode(). -icode_params_update(Icode, Params) -> +-spec icode_params_update(icode(), params()) -> icode(). +icode_params_update(Icode, Params) -> Icode#icode{params = Params}. -spec icode_is_closure(icode()) -> boolean(). diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl index 999c54732b..b2e0d86b28 100644 --- a/lib/hipe/icode/hipe_icode.hrl +++ b/lib/hipe/icode/hipe_icode.hrl @@ -169,7 +169,7 @@ %%--------------------------------------------------------------------- -record(icode, {'fun' :: mfa(), - params :: [icode_var()], + params :: hipe_icode:params(), %% TODO: merge is_closure and closure_arity into one field is_closure :: boolean(), closure_arity = none :: 'none' | arity(), diff --git a/lib/hipe/icode/hipe_icode_cfg.erl b/lib/hipe/icode/hipe_icode_cfg.erl index b9969fa69d..9a602c0283 100644 --- a/lib/hipe/icode/hipe_icode_cfg.erl +++ b/lib/hipe/icode/hipe_icode_cfg.erl @@ -55,6 +55,9 @@ -spec postorder(cfg()) -> [icode_lbl()]. -spec reverse_postorder(cfg()) -> [icode_lbl()]. +-spec params(cfg()) -> hipe_icode:params(). +-spec params_update(cfg(), hipe_icode:params()) -> cfg(). + -spec is_visited(icode_lbl(), gb_sets:set()) -> boolean(). -spec visit(icode_lbl(), gb_sets:set()) -> gb_sets:set(). diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl index 24ffc71237..12ed796690 100644 --- a/lib/hipe/icode/hipe_icode_range.erl +++ b/lib/hipe/icode/hipe_icode_range.erl @@ -89,6 +89,7 @@ ret_type :: range(), lookup_fun :: call_fun(), result_action :: final_fun()}). +-type state() :: #state{}. -define(WIDEN, 1). @@ -172,7 +173,7 @@ analyse(Cfg, Data) -> catch throw:no_input -> ok end. --spec safe_analyse(cfg(), data()) -> #state{}. +-spec safe_analyse(cfg(), data()) -> state(). safe_analyse(CFG, Data={MFA,_,_,_}) -> State = state__init(CFG, Data), @@ -181,14 +182,14 @@ safe_analyse(CFG, Data={MFA,_,_,_}) -> (state__result_action(NewState))(MFA, [state__ret_type(NewState)]), NewState. --spec rewrite_blocks(#state{}) -> #state{}. +-spec rewrite_blocks(state()) -> state(). rewrite_blocks(State) -> CFG = state__cfg(State), Start = hipe_icode_cfg:start_label(CFG), rewrite_blocks([Start], State, [Start]). --spec rewrite_blocks([label()], #state{}, [label()]) -> #state{}. +-spec rewrite_blocks([label()], state(), [label()]) -> state(). rewrite_blocks([Next|Rest], State, Visited) -> Info = state__info_in(State, Next), @@ -201,7 +202,7 @@ rewrite_blocks([Next|Rest], State, Visited) -> rewrite_blocks([], State, _) -> State. --spec analyse_blocks(#state{}, work_list()) -> #state{}. +-spec analyse_blocks(state(), work_list()) -> state(). analyse_blocks(State, Work) -> case get_work(Work) of @@ -218,7 +219,7 @@ analyse_blocks(State, Work) -> analyse_blocks(NewState, NewWork2) end. --spec analyse_block(label(), info(), #state{}, boolean()) -> {#state{}, [label()]}. +-spec analyse_block(label(), info(), state(), boolean()) -> {state(), [label()]}. analyse_block(Label, Info, State, Rewrite) -> BB = state__bb(State, Label), @@ -612,36 +613,32 @@ analyse_if(If, Info, Rewrite) -> {#icode_goto{} | #icode_if{}, [{label(), info()}]}. analyse_sane_if(If, Info, [Arg1, Arg2], [Range1, Range2], Rewrite) -> - case normalize_name(hipe_icode:if_op(If)) of - '>' -> - {TrueRange2, TrueRange1, FalseRange2, FalseRange1} = - range_inequality_propagation(Range2, Range1); - '<' -> - {TrueRange1, TrueRange2, FalseRange1, FalseRange2} = + {TrueRange1, TrueRange2, FalseRange1, FalseRange2} = + case normalize_name(hipe_icode:if_op(If)) of + '>' -> + {TR2, TR1, FR2, FR1} = range_inequality_propagation(Range2, Range1), + {TR1, TR2, FR1, FR2}; + '<' -> range_inequality_propagation(Range1, Range2); - '>=' -> - {FalseRange1, FalseRange2, TrueRange1, TrueRange2} = - range_inequality_propagation(Range1, Range2); - '=<' -> - {FalseRange2, FalseRange1, TrueRange2, TrueRange1} = - range_inequality_propagation(Range2, Range1); - '=:=' -> - {TrueRange1, TrueRange2, FalseRange1, FalseRange2} = - range_equality_propagation(Range1, Range2); - '=/=' -> - {FalseRange1, FalseRange2, TrueRange1, TrueRange2} = - range_equality_propagation(Range1, Range2); - '==' -> - {TempTrueRange1, TempTrueRange2, FalseRange1, FalseRange2} = - range_equality_propagation(Range1, Range2), - TrueRange1 = set_other(TempTrueRange1, other(Range1)), - TrueRange2 = set_other(TempTrueRange2, other(Range2)); - '/=' -> - {TempFalseRange1, TempFalseRange2, TrueRange1, TrueRange2} = - range_equality_propagation(Range1, Range2), - FalseRange1 = set_other(TempFalseRange1, other(Range1)), - FalseRange2 = set_other(TempFalseRange2, other(Range2)) - end, + '>=' -> + {FR1, FR2, TR1, TR2} = range_inequality_propagation(Range1, Range2), + {TR1, TR2, FR1, FR2}; + '=<' -> + {FR2, FR1, TR2, TR1} = range_inequality_propagation(Range2, Range1), + {TR1, TR2, FR1, FR2}; + '=:=' -> + {TR1, TR2, FR1, FR2} = range_equality_propagation(Range1, Range2), + {TR1, TR2, FR1, FR2}; + '=/=' -> + {FR1, FR2, TR1, TR2} = range_equality_propagation(Range1, Range2), + {TR1, TR2, FR1, FR2}; + '==' -> + {TR1, TR2, FR1, FR2} = range_equality_propagation(Range1, Range2), + {set_other(TR1,other(Range1)), set_other(TR2,other(Range2)), FR1, FR2}; + '/=' -> + {FR1, FR2, TR1, TR2} = range_equality_propagation(Range1, Range2), + {TR1, TR2, set_other(FR1,other(Range1)), set_other(FR2,other(Range2))} + end, %% io:format("TR1 = ~w\nTR2 = ~w\n", [TrueRange1, TrueRange2]), True = case lists:all(fun range__is_none/1, [TrueRange1, TrueRange2]) of @@ -694,26 +691,24 @@ normalize_name(Name) -> -spec range_equality_propagation(range(), range()) -> {range(), range(), range(), range()}. -range_equality_propagation(Range_1, Range_2) -> - True_range = inf(Range_1, Range_2), - case {range(Range_1), range(Range_2)} of - {{N,N}, {N,N}} -> - False_range_1 = none_range(), - False_range_2 = none_range(); - {{N1,N1}, {N2,N2}} -> - False_range_1 = Range_1, - False_range_2 = Range_2; - {{N,N}, _} -> - False_range_1 = Range_1, - {_,False_range_2} = compare_with_integer(N, Range_2); - {_, {N,N}} -> - False_range_2 = Range_2, - {_,False_range_1} = compare_with_integer(N, Range_1); - {_, _} -> - False_range_1 = Range_1, - False_range_2 = Range_2 - end, - {True_range, True_range, False_range_1, False_range_2}. +range_equality_propagation(Range1, Range2) -> + TrueRange = inf(Range1, Range2), + {FalseRange1, FalseRange2} = + case {range(Range1), range(Range2)} of + {{N,N}, {N,N}} -> + {none_range(), none_range()}; + {{N1,N1}, {N2,N2}} -> + {Range1, Range2}; + {{N,N}, _} -> + {_,FR2} = compare_with_integer(N, Range2), + {Range1, FR2}; + {_, {N,N}} -> + {_,FR1} = compare_with_integer(N, Range1), + {FR1, Range2}; + {_, _} -> + {Range1, Range2} + end, + {TrueRange, TrueRange, FalseRange1, FalseRange2}. -spec range_inequality_propagation(range(), range()) -> {range(), range(), range(), range()}. @@ -779,18 +774,17 @@ analyse_type(Type, Info, Rewrite) -> TypeTest = hipe_icode:type_test(Type), [Arg|_] = hipe_icode:type_args(Type), OldVarRange = get_range_from_arg(Arg), - case TypeTest of - {integer, N} -> - {TrueRange,FalseRange} = compare_with_integer(N,OldVarRange); - integer -> - TrueRange = inf(any_range(), OldVarRange), - FalseRange = inf(none_range(), OldVarRange); - number -> - TrueRange = FalseRange = OldVarRange; - _ -> - TrueRange = inf(none_range(), OldVarRange), - FalseRange = OldVarRange - end, + {TrueRange, FalseRange} = + case TypeTest of + {integer, N} -> + compare_with_integer(N, OldVarRange); + integer -> + {inf(any_range(), OldVarRange), inf(none_range(), OldVarRange)}; + number -> + {OldVarRange, OldVarRange}; + _ -> + {inf(none_range(), OldVarRange), OldVarRange} + end, TrueLabel = hipe_icode:type_true_label(Type), FalseLabel = hipe_icode:type_false_label(Type), TrueInfo = enter_define({Arg, TrueRange}, Info), @@ -1201,14 +1195,12 @@ basic_type(#unsafe_update_element{}) -> not_analysed. analyse_bs_get_integer(Size, Flags, true) -> Signed = Flags band 4, - if Signed =:= 0 -> - Max = inf_add(inf_bsl(1, Size), -1), - Min = 0; - true -> - Max = inf_add(inf_bsl(1, Size-1), -1), - Min = inf_inv(inf_bsl(1, Size-1)) - end, - {Min, Max}; + case Signed =:= 0 of + true -> + {0, inf_add(inf_bsl(1, Size), -1)}; % return {Min, Max} + false -> + {inf_inv(inf_bsl(1, Size-1)), inf_add(inf_bsl(1, Size-1), -1)} + end; analyse_bs_get_integer(Size, Flags, false) when is_integer(Size), is_integer(Flags) -> any_r(). @@ -1653,7 +1645,7 @@ inf_bsl(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> %% State --spec state__init(cfg(), data()) -> #state{}. +-spec state__init(cfg(), data()) -> state(). state__init(Cfg, {MFA, ArgsFun, CallFun, FinalFun}) -> Start = hipe_icode_cfg:start_label(Cfg), @@ -1676,19 +1668,19 @@ state__init(Cfg, {MFA, ArgsFun, CallFun, FinalFun}) -> lookup_fun=CallFun, result_action=FinalFun} end. --spec state__cfg(#state{}) -> cfg(). +-spec state__cfg(state()) -> cfg(). state__cfg(#state{cfg=Cfg}) -> Cfg. --spec state__bb(#state{}, label()) -> bb(). +-spec state__bb(state(), label()) -> bb(). state__bb(#state{cfg=Cfg}, Label) -> BB = hipe_icode_cfg:bb(Cfg, Label), true = hipe_bb:is_bb(BB), % Just an assert BB. --spec state__bb_add(#state{}, label(), bb()) -> #state{}. +-spec state__bb_add(state(), label(), bb()) -> state(). state__bb_add(S=#state{cfg=Cfg}, Label, BB) -> NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, BB), @@ -1774,14 +1766,12 @@ join_info_in([Var|Left], Info1, Info2, Acc, Changed) -> NewTree = gb_trees:insert(Var, Val, Acc), join_info_in(Left, Info1, Info2, NewTree, Changed); {{value, Val1}, {value, Val2}} -> - NewVal = + {NewChanged, NewVal} = case sup(Val1, Val2) of Val1 -> - NewChanged = Changed, - Val1; + {Changed, Val1}; Val -> - NewChanged = true, - Val + {true, Val} end, NewTree = gb_trees:insert(Var, NewVal, Acc), join_info_in(Left, Info1, Info2, NewTree, NewChanged) diff --git a/lib/hipe/icode/hipe_icode_type.erl b/lib/hipe/icode/hipe_icode_type.erl index 5eae8d440a..794c27ebcc 100644 --- a/lib/hipe/icode/hipe_icode_type.erl +++ b/lib/hipe/icode/hipe_icode_type.erl @@ -105,6 +105,7 @@ ret_type = [t_none()] :: [erl_types:erl_type()], lookupfun :: call_fun(), resultaction :: final_fun()}). +-type state() :: #state{}. %%----------------------------------------------------------------------- %% The main exported function @@ -193,7 +194,7 @@ analyse(Cfg, Data) -> catch throw:no_input -> ok % No need to do anything since we have no input end. --spec safe_analyse(cfg(), data()) -> #state{}. +-spec safe_analyse(cfg(), data()) -> state(). safe_analyse(Cfg, {MFA,_,_,_}=Data) -> State = new_state(Cfg, Data), @@ -461,24 +462,24 @@ integer_range_inequality_propagation(Op, A1, A2, TrueLab, FalseLab, Info) -> NonIntArg1 = t_subtract(Arg1, t_integer()), NonIntArg2 = t_subtract(Arg2, t_integer()), ?ineq_debug("nonintargs", [NonIntArg1,NonIntArg2]), - case t_is_none(IntArg1) or t_is_none(IntArg2) of + case t_is_none(IntArg1) orelse t_is_none(IntArg2) of true -> ?ineq_debug("one is none", [IntArg1,IntArg2]), [{TrueLab, Info}, {FalseLab, Info}]; false -> - case Op of - '>=' -> - {FalseArg1, FalseArg2, TrueArg1, TrueArg2} = - integer_range_less_then_propagator(IntArg1, IntArg2); - '>' -> - {TrueArg2, TrueArg1, FalseArg2, FalseArg1} = - integer_range_less_then_propagator(IntArg2, IntArg1); - '<' -> - {TrueArg1, TrueArg2, FalseArg1, FalseArg2} = - integer_range_less_then_propagator(IntArg1, IntArg2); - '=<' -> - {FalseArg2, FalseArg1, TrueArg2, TrueArg1} = - integer_range_less_then_propagator(IntArg2, IntArg1) + {TrueArg1, TrueArg2, FalseArg1, FalseArg2} = + case Op of + '>=' -> + {FA1, FA2, TA1, TA2} = int_range_lt_propagator(IntArg1, IntArg2), + {TA1, TA2, FA1, FA2}; + '>' -> + {TA2, TA1, FA2, FA1} = int_range_lt_propagator(IntArg2, IntArg1), + {TA1, TA2, FA1, FA2}; + '<' -> + int_range_lt_propagator(IntArg1, IntArg2); + '=<' -> + {FA2, FA1, TA2, TA1} = int_range_lt_propagator(IntArg2, IntArg1), + {TA1, TA2, FA1, FA2} end, ?ineq_debug("int res", [TrueArg1, TrueArg2, FalseArg1, FalseArg2]), False = {FalseLab, enter(A1, t_sup(FalseArg1, NonIntArg1), @@ -488,7 +489,7 @@ integer_range_inequality_propagation(Op, A1, A2, TrueLab, FalseLab, Info) -> [True, False] end. -integer_range_less_then_propagator(IntArg1, IntArg2) -> +int_range_lt_propagator(IntArg1, IntArg2) -> Min1 = number_min(IntArg1), Max1 = number_max(IntArg1), Min2 = number_min(IntArg2), diff --git a/lib/hipe/llvm/Makefile b/lib/hipe/llvm/Makefile index 25b47a580f..88016a7d8b 100644 --- a/lib/hipe/llvm/Makefile +++ b/lib/hipe/llvm/Makefile @@ -52,8 +52,7 @@ endif MODULES = $(HIPE_MODULES) -HRL_FILES= elf_format.hrl elf32_format.hrl elf64_format.hrl \ - hipe_llvm_arch.hrl +HRL_FILES= elf_format.hrl elf32_format.hrl elf64_format.hrl hipe_llvm_arch.hrl ERL_FILES= $(MODULES:%=%.erl) TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) @@ -71,7 +70,7 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) include ../native.mk -ERL_COMPILE_FLAGS += +inline +warn_export_vars #+warn_missing_spec +ERL_COMPILE_FLAGS += -Werror +inline +warn_export_vars #+warn_missing_spec # if in 32 bit backend define BIT32 symbol ARCH = $(shell echo $(TARGET) | sed 's/^\(x86_64\)-.*/64bit/') diff --git a/lib/hipe/llvm/hipe_llvm.erl b/lib/hipe/llvm/hipe_llvm.erl index c2547dd89e..b22f8fb320 100644 --- a/lib/hipe/llvm/hipe_llvm.erl +++ b/lib/hipe/llvm/hipe_llvm.erl @@ -199,10 +199,9 @@ adj_stack_register/1, adj_stack_type/1, - mk_branch_meta/3, - branch_meta_id/1, - branch_meta_true_weight/1, - branch_meta_false_weight/1 + mk_meta/2, + meta_id/1, + meta_operands/1 ]). -export([ @@ -343,8 +342,9 @@ -record(llvm_adj_stack, {offset, 'register', type}). -type llvm_adj_stack() :: #llvm_adj_stack{}. --record(llvm_branch_meta, {id, true_weight, false_weight}). --type llvm_branch_meta() :: #llvm_branch_meta{}. +-record(llvm_meta, {id :: string(), + operands :: [string() | integer() | llvm_meta()]}). +-type llvm_meta() :: #llvm_meta{}. %% A type for any LLVM instruction -type llvm_instr() :: llvm_ret() | llvm_br() | llvm_br_cond() @@ -357,7 +357,7 @@ | llvm_call() | llvm_fun_def() | llvm_fun_decl() | llvm_landingpad() | llvm_comment() | llvm_label() | llvm_const_decl() | llvm_asm() | llvm_adj_stack() - | llvm_branch_meta(). + | llvm_meta(). %% Types -record(llvm_void, {}). @@ -701,7 +701,7 @@ is_label(#llvm_comment{}) -> false; is_label(#llvm_const_decl{}) -> false; is_label(#llvm_asm{}) -> false; is_label(#llvm_adj_stack{}) -> false; -is_label(#llvm_branch_meta{}) -> false. +is_label(#llvm_meta{}) -> false. %% const_decl mk_const_decl(Dst, Decl_type, Type, Value) -> @@ -722,14 +722,11 @@ adj_stack_offset(#llvm_adj_stack{offset=Offset}) -> Offset. adj_stack_register(#llvm_adj_stack{'register'=Register}) -> Register. adj_stack_type(#llvm_adj_stack{type=Type}) -> Type. -%% branch meta-data -mk_branch_meta(Id, True_weight, False_weight) -> - #llvm_branch_meta{id=Id, true_weight=True_weight, false_weight=False_weight}. -branch_meta_id(#llvm_branch_meta{id=Id}) -> Id. -branch_meta_true_weight(#llvm_branch_meta{true_weight=True_weight}) -> - True_weight. -branch_meta_false_weight(#llvm_branch_meta{false_weight=False_weight}) -> - False_weight. +%% meta-data +mk_meta(Id, Operands) -> + #llvm_meta{id=Id, operands=Operands}. +meta_id(#llvm_meta{id=Id}) -> Id. +meta_operands(#llvm_meta{operands=Operands}) -> Operands. %% types mk_void() -> #llvm_void{}. @@ -1013,13 +1010,22 @@ pp_ins(Dev, Ver, I) -> adj_stack_register(I), "\", \"r\"("]), pp_type(Dev, adj_stack_type(I)), write(Dev, [" ", adj_stack_offset(I),")\n"]); - #llvm_branch_meta{} -> - write(Dev, ["!", branch_meta_id(I), " = "]), - if Ver < {3,6} -> write(Dev, "metadata !{metadata "); - Ver >= {3,6} -> write(Dev, "!{ ") + #llvm_meta{} -> + write(Dev, ["!", meta_id(I), " = "]), + Named = case string:to_integer(meta_id(I)) of + {_, ""} -> false; + _ -> true + end, + case Ver < {3,6} andalso not Named of + true -> write(Dev, "metadata !{metadata "); + false -> write(Dev, "!{ ") end, - write(Dev, ["!\"branch_weights\", i32 ", branch_meta_true_weight(I), - ", i32 ", branch_meta_false_weight(I), "}\n"]); + write(Dev, string:join([if is_list(Op) -> ["!\"", Op, "\""]; + is_integer(Op) -> ["i32 ", integer_to_list(Op)]; + is_record(Op, llvm_meta) -> + ["!", meta_id(Op)] + end || Op <- meta_operands(I)], ", ")), + write(Dev, " }\n"); Other -> exit({?MODULE, pp_ins, {"Unknown LLVM instruction", Other}}) end. @@ -1140,7 +1146,7 @@ indent(I) -> #llvm_fun_def{} -> false; #llvm_fun_decl{} -> false; #llvm_const_decl{} -> false; - #llvm_branch_meta{} -> false; + #llvm_meta{} -> false; _ -> true end. diff --git a/lib/hipe/llvm/hipe_rtl_to_llvm.erl b/lib/hipe/llvm/hipe_rtl_to_llvm.erl index b23d756d6c..66b2e10fb8 100644 --- a/lib/hipe/llvm/hipe_rtl_to_llvm.erl +++ b/lib/hipe/llvm/hipe_rtl_to_llvm.erl @@ -13,6 +13,8 @@ -define(WORD_WIDTH, (?bytes_to_bits(hipe_rtl_arch:word_size()))). -define(BRANCH_META_TAKEN, "0"). -define(BRANCH_META_NOT_TAKEN, "1"). +-define(FIRST_FREE_META_NO, 2). +-define(HIPE_LITERALS_META, "hipe.literals"). %%------------------------------------------------------------------------------ %% @doc Main function for translating an RTL function to LLVM Assembly. Takes as @@ -51,8 +53,9 @@ translate(RTL, Roots) -> translate_instr_list(Code1, [], Relocs, Data), %% Create LLVM code to declare relocation symbols as external symbols along %% with local variables in order to use them as just any other variable - {FinalRelocs, ExternalDecl, LocalVars} = + {FinalRelocs, ExternalDecl0, LocalVars} = handle_relocations(Relocs1, Data, Fun), + ExternalDecl = add_literals_metadata(ExternalDecl0), %% Pass on LLVM code in order to create Fail blocks and a landingpad %% instruction to each one LLVM_Code2 = add_landingpads(LLVM_Code1, FailLabels), @@ -1458,8 +1461,8 @@ handle_relocations(Relocs, Data, Fun) -> Relocs4 = dict:store("hipe_bifs.llvm_fix_pinned_regs.0", {call, {hipe_bifs, llvm_fix_pinned_regs, 0}}, Relocs3), BranchMetaData = [ - hipe_llvm:mk_branch_meta(?BRANCH_META_TAKEN, "99", "1") - , hipe_llvm:mk_branch_meta(?BRANCH_META_NOT_TAKEN, "1", "99") + hipe_llvm:mk_meta(?BRANCH_META_TAKEN, ["branch_weights", 99, 1]) + , hipe_llvm:mk_meta(?BRANCH_META_NOT_TAKEN, ["branch_weights", 1, 99]) ], ExternalDeclarations = AtomDecl ++ ClosureDecl ++ ConstDecl ++ FunDecl ++ ClosureLabelDecl ++ SwitchDecl ++ BranchMetaData, @@ -1612,3 +1615,16 @@ load_constant(Label) -> const_to_dict(Elem, Dict) -> Name = "DL" ++ integer_to_list(Elem), dict:store(Name, {'constant', Elem}, Dict). + +%% @doc Export the hipe literals that LLVM needs to generate the prologue as +%% metadata. +add_literals_metadata(ExternalDecls) -> + Pairs = [hipe_llvm:mk_meta(integer_to_list(?FIRST_FREE_META_NO), + ["P_NSP_LIMIT", ?P_NSP_LIMIT]) + ,hipe_llvm:mk_meta(integer_to_list(?FIRST_FREE_META_NO + 1), + ["X86_LEAF_WORDS", ?X86_LEAF_WORDS]) + ,hipe_llvm:mk_meta(integer_to_list(?FIRST_FREE_META_NO + 2), + ["AMD64_LEAF_WORDS", ?AMD64_LEAF_WORDS]) + ], + [hipe_llvm:mk_meta(?HIPE_LITERALS_META, Pairs) | + Pairs ++ ExternalDecls]. diff --git a/lib/hipe/main/Makefile b/lib/hipe/main/Makefile index 6b6cad3ed3..8ef31dbb46 100644 --- a/lib/hipe/main/Makefile +++ b/lib/hipe/main/Makefile @@ -70,7 +70,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) include ../native.mk -ERL_COMPILE_FLAGS += +nowarn_shadow_vars +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +nowarn_shadow_vars +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 981265b3e9..6c525dd143 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -449,16 +449,16 @@ compile(Name, File, Opts0) when is_atom(Name) -> true -> case filename:find_src(filename:rootname(File, ".beam")) of {error, _} -> - ?error_msg("Cannot find source code for ~p.",[File]), + ?error_msg("Cannot find source code for ~p.", [File]), ?EXIT({cant_find_source_code}); {Source, CompOpts} -> CoreOpts = [X || X = {core_transform, _} <- Opts], - %%io:format("Using: ~w\n", [CoreOpts]), + %% io:format("Using: ~w\n", [CoreOpts]), case compile:file(Source, CoreOpts ++ [to_core, binary|CompOpts]) of {ok, _, Core} -> compile_core(Name, Core, File, Opts); Error -> - ?error_msg("Error compiling ~p:\n~p.",[File, Error]), + ?error_msg("Error compiling ~p:\n~p.", [File, Error]), ?EXIT({cant_compile_source_code}) end end; @@ -470,7 +470,7 @@ compile(Name, File, Opts0) when is_atom(Name) -> {ok, _, Core} -> compile_core(Name, Core, File, Opts); Error -> - ?error_msg("Error compiling ~p:\n~p\n",[Source, Error]), + ?error_msg("Error compiling ~p:\n~p\n", [Source, Error]), ?EXIT({cant_compile_source_code, Error}) end; Other when Other =:= false; Other =:= undefined -> @@ -573,8 +573,7 @@ file(File, Options) when is_atom(File) -> disasm(File) -> case beam_disasm:file(File) of #beam_file{labeled_exports = LabeledExports, - compile_info = CompInfo, - code = BeamCode} -> + compile_info = CompInfo, code = BeamCode} -> CompOpts = proplists:get_value(options, CompInfo, []), HCompOpts = case lists:keyfind(hipe, 1, CompOpts) of {hipe, L} when is_list(L) -> L; @@ -597,16 +596,16 @@ fix_beam_exports([], Exports) -> Exports. get_beam_icode(Mod, {BeamCode, Exports}, File, Options) -> - ?option_time({ok, Icode} = - (catch {ok, hipe_beam_to_icode:module(BeamCode, Options)}), - "BEAM-to-Icode", Options), + {ok, Icode} = + ?option_time((catch {ok, hipe_beam_to_icode:module(BeamCode, Options)}), + "BEAM-to-Icode", Options), BeamBin = get_beam_code(File), {{Mod, Exports, Icode}, BeamBin}. get_core_icode(Mod, Core, File, Options) -> - ?option_time({ok, Icode} = - (catch {ok, cerl_to_icode:module(Core, Options)}), - "BEAM-to-Icode", Options), + {ok, Icode} = + ?option_time((catch {ok, cerl_to_icode:module(Core, Options)}), + "BEAM-to-Icode", Options), NeedBeamCode = not proplists:get_bool(load, Options), BeamBin = case NeedBeamCode of @@ -619,7 +618,7 @@ get_core_icode(Mod, Core, File, Options) -> get_beam_code(Bin) when is_binary(Bin) -> Bin; get_beam_code(FileName) -> case erl_prim_loader:get_file(FileName) of - {ok,Bin,_} -> + {ok, Bin, _} -> Bin; error -> ?EXIT(no_beam_file) diff --git a/lib/hipe/main/hipe.hrl.src b/lib/hipe/main/hipe.hrl.src index 3be824ac34..53b59f88f0 100644 --- a/lib/hipe/main/hipe.hrl.src +++ b/lib/hipe/main/hipe.hrl.src @@ -152,7 +152,7 @@ STMNT, ?untagged_msg(Msg ++ "~.2f s\n",[hipe_timing:stop_timer(Timer)/1000])). -else. --define(TIME_STMNT(STMNT,Msg,Timer),STMNT). +-define(TIME_STMNT(STMNT,Msg,Timer), STMNT). -endif. -define(start_timer(Text), hipe_timing:start(Text, ?MODULE)). @@ -162,22 +162,24 @@ -define(get_hipe_timer_val(Timer), get(Timer)). -define(set_hipe_timer_val(Timer, Val), put(Timer, Val)). -define(option_time(Stmnt, Text, Options), - if true -> ?when_option(time, Options, ?start_timer(Text)), - fun(R) -> - ?when_option(time, Options, ?stop_timer(Text)), - R - end(Stmnt)end). + begin + ?when_option(time, Options, ?start_timer(Text)), + fun(R) -> + ?when_option(time, Options, ?stop_timer(Text)), + R + end(Stmnt) + end). --define(option_start_time(Text,Options), +-define(option_start_time(Text, Options), ?when_option(time, Options, ?start_timer(Text))). --define(option_stop_time(Text,Options), +-define(option_stop_time(Text, Options), ?when_option(time, Options, ?stop_timer(Text))). -define(opt_start_timer(Text), - hipe_timing:start_optional_timer(Text,?MODULE)). + hipe_timing:start_optional_timer(Text, ?MODULE)). -define(opt_stop_timer(Text), - hipe_timing:stop_optional_timer(Text,?MODULE)). + hipe_timing:stop_optional_timer(Text, ?MODULE)). %% %% Turn on instrumentation of the compiler. @@ -187,15 +189,15 @@ -define(count_pre_ra_instructions(Options, NoInstrs), ?when_option(count_instrs, Options, put(pre_ra_instrs, - get(pre_ra_instrs)+ NoInstrs))). + get(pre_ra_instrs) + NoInstrs))). -define(count_post_ra_instructions(Options, NoInstrs), ?when_option(count_instrs, Options, put(post_ra_instrs, - get(post_ra_instrs)+ NoInstrs))). + get(post_ra_instrs) + NoInstrs))). -define(start_time_regalloc(Options), ?when_option(timeregalloc, Options, - put(regalloctime1,erlang:statistics(runtime)))). + put(regalloctime1, erlang:statistics(runtime)))). -define(stop_time_regalloc(Options), ?when_option(timeregalloc, Options, put(regalloctime, @@ -215,11 +217,11 @@ -define(count_pre_ra_temps(Options, NoTemps), ?when_option(count_temps, Options, put(pre_ra_temps, - get(pre_ra_temps)+ NoTemps))). + get(pre_ra_temps) + NoTemps))). -define(count_post_ra_temps(Options, NoTemps), ?when_option(count_temps, Options, put(post_ra_temps, - get(post_ra_temps)+ NoTemps))). + get(post_ra_temps) + NoTemps))). -define(inc_counter(Counter, Val), case get(Counter) of @@ -255,7 +257,7 @@ ?count_post_ra_instructions(Options, NoInstrs), ?cons_counter(counter_mem_temps, get(counter_mfa_mem_temps)), ?cons_counter(ra_all_iterations_counter, get(ra_iteration_counter)), - put(ra_iteration_counter,0), + put(ra_iteration_counter, 0), ?count_post_ra_temps(Options, NoTemps) end). @@ -264,12 +266,12 @@ put(spilledtemps, get(spilledtemps) + NoSpills))). -define(optional_start_timer(Timer, Options), - case lists:member(Timer, proplists:get_value(timers,Options++[{timers,[]}])) of + case lists:member(Timer, proplists:get_value(timers, Options++[{timers,[]}])) of true -> ?start_hipe_timer(Timer); false -> true end). -define(optional_stop_timer(Timer, Options), - case lists:member(Timer, proplists:get_value(timers,Options++[{timers,[]}])) of + case lists:member(Timer, proplists:get_value(timers, Options++[{timers,[]}])) of true -> ?stop_hipe_timer(Timer); false -> true end). @@ -316,4 +318,4 @@ 'unknown' | {'reg' | 'fp_reg' | 'spill', non_neg_integer()}}]. -type hipe_temp_map() :: tuple(). --type hipe_spill_map() :: [{non_neg_integer(), {'spill',non_neg_integer()}}]. +-type hipe_spill_map() :: [{non_neg_integer(), {'spill', non_neg_integer()}}]. diff --git a/lib/hipe/main/hipe_main.erl b/lib/hipe/main/hipe_main.erl index b9d783d20a..4b89feb48a 100644 --- a/lib/hipe/main/hipe_main.erl +++ b/lib/hipe/main/hipe_main.erl @@ -296,7 +296,7 @@ icode_ssa_convert(IcodeCfg, Options) -> icode_ssa_const_prop(IcodeSSA, Options) -> case proplists:get_bool(icode_ssa_const_prop, Options) of true -> - ?option_time(Tmp=hipe_icode_ssa_const_prop:propagate(IcodeSSA), + Tmp = ?option_time(hipe_icode_ssa_const_prop:propagate(IcodeSSA), "Icode SSA sparse conditional constant propagation", Options), ?option_time(hipe_icode_ssa:remove_dead_code(Tmp), "Icode SSA dead code elimination pass 1", Options); diff --git a/lib/hipe/misc/Makefile b/lib/hipe/misc/Makefile index 60d2861c62..72cfff21a8 100644 --- a/lib/hipe/misc/Makefile +++ b/lib/hipe/misc/Makefile @@ -69,7 +69,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/opt/Makefile b/lib/hipe/opt/Makefile index ec0d01b42e..684d6f45b4 100644 --- a/lib/hipe/opt/Makefile +++ b/lib/hipe/opt/Makefile @@ -64,7 +64,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec # +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec # +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/ppc/Makefile b/lib/hipe/ppc/Makefile index 576c089f15..1901dfa671 100644 --- a/lib/hipe/ppc/Makefile +++ b/lib/hipe/ppc/Makefile @@ -76,7 +76,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/regalloc/Makefile b/lib/hipe/regalloc/Makefile index 2b94f5ecfe..aaa4418f37 100644 --- a/lib/hipe/regalloc/Makefile +++ b/lib/hipe/regalloc/Makefile @@ -77,7 +77,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars# +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars #+warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/rtl/Makefile b/lib/hipe/rtl/Makefile index e0ff225a25..b4cdf8b1f2 100644 --- a/lib/hipe/rtl/Makefile +++ b/lib/hipe/rtl/Makefile @@ -75,7 +75,7 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) include ../native.mk -ERL_COMPILE_FLAGS += -Werror +inline +warn_unused_import +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +inline +warn_unused_import +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl index 1d627ed024..0726827299 100644 --- a/lib/hipe/rtl/hipe_rtl.erl +++ b/lib/hipe/rtl/hipe_rtl.erl @@ -366,7 +366,7 @@ -export([subst_uses_llvm/2]). --export_type([alub_cond/0]). +-export_type([alub_cond/0, rtl/0]). %% %% RTL @@ -384,6 +384,7 @@ label_range, %% {Min,Max} First and last name used for labels info=[] %% A keylist with arbitrary information. }). +-opaque rtl() :: #rtl{}. mk_rtl(Fun, ArgList, Closure, Leaf, Code, Data, VarRange, LabelRange) -> #rtl{'fun'=Fun, arglist=ArgList, code=Code, @@ -414,7 +415,9 @@ rtl_info_update(Rtl, Info) -> Rtl#rtl{info=Info}. %% move %% -mk_move(Dst, Src) -> false = is_fpreg(Dst), false = is_fpreg(Src), #move{dst=Dst, src=Src}. +mk_move(Dst, Src) -> + false = is_fpreg(Dst), false = is_fpreg(Src), + #move{dst=Dst, src=Src}. move_dst(#move{dst=Dst}) -> Dst. move_dst_update(M, NewDst) -> false = is_fpreg(NewDst), M#move{dst=NewDst}. move_src(#move{src=Src}) -> Src. diff --git a/lib/hipe/rtl/hipe_rtl_arith.inc b/lib/hipe/rtl/hipe_rtl_arith.inc index 645bc83f9f..0c396c8e76 100644 --- a/lib/hipe/rtl/hipe_rtl_arith.inc +++ b/lib/hipe/rtl/hipe_rtl_arith.inc @@ -47,73 +47,80 @@ eval_alu(Op, Arg1, Arg2) Res = (Arg1 - Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), - V = (Sign1 and (not Sign2) and (not N)) + V = (Sign1 andalso (not Sign2) andalso (not N)) or - ((not Sign1) and Sign2 and N), - C = ((not Sign1) and Sign2) + ((not Sign1) andalso Sign2 andalso N), + C = ((not Sign1) andalso Sign2) or - (N and ((not Sign1) or Sign2)); + (N andalso ((not Sign1) orelse Sign2)), + {Res, N, Z, V, C}; 'add' -> Res = (Arg1 + Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), - V = (Sign1 and Sign2 and (not N)) + V = (Sign1 andalso Sign2 andalso (not N)) or - ((not Sign1) and (not Sign2) and N), - C = (Sign1 and Sign2) + ((not Sign1) andalso (not Sign2) andalso N), + C = (Sign1 andalso Sign2) or - ((not N) and (Sign1 or Sign2)); + ((not N) andalso (Sign1 orelse Sign2)), + {Res, N, Z, V, C}; 'mul' -> FullRes = Arg1 * Arg2, Res = FullRes band ?WORDMASK, ResHi = FullRes bsr ?BITS, N = sign_bit(Res), Z = zero(Res), - V = (N and (ResHi =/= -1)) or ((not N) and (ResHi =/= 0)), - C = V; + V = (N andalso (ResHi =/= -1)) orelse ((not N) andalso (ResHi =/= 0)), + C = V, + {Res, N, Z, V, C}; 'sra' -> Res = (Arg1 bsr Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'srl' -> Res = (Arg1 bsr Arg2) band shiftmask(Arg2), N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'sll' -> Res = (Arg1 bsl Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'or' -> Res = (Arg1 bor Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'and' -> Res = (Arg1 band Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'xor' -> Res = (Arg1 bxor Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; Op -> - Res = N = Z = V = C = 0, ?EXIT({"unknown alu op", Op}) - end, - {Res, N, Z, V, C}; + end; eval_alu(Op, Arg1, Arg2) -> - ?EXIT({argument_overflow,Op,Arg1,Arg2}). + ?EXIT({argument_overflow, Op, Arg1, Arg2}). %% Björn & Bjarni: %% We need to be able to do evaluations based only on the bits, since @@ -130,9 +137,9 @@ eval_cond_bits(Cond, N, Z, V, C) -> 'ne' -> not Z; 'gt' -> - not (Z or (N xor V)); + not (Z orelse (N xor V)); 'gtu' -> - not (C or Z); + not (C orelse Z); 'ge' -> not (N xor V); 'geu'-> @@ -142,9 +149,9 @@ eval_cond_bits(Cond, N, Z, V, C) -> 'ltu'-> C; 'le' -> - Z or (N xor V); + Z orelse (N xor V); 'leu'-> - C or Z; + C orelse Z; 'overflow' -> V; 'not_overflow' -> diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl index 4403aa552f..367d76b24d 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,25 +19,21 @@ %% %CopyrightEnd% %% %% ==================================================================== -%% Module : hipe_rtl_inline_bs_ops +%% Module : hipe_rtl_binary_construct %% Purpose : %% Notes : -%% History : * 2001-06-14 Erik Johansson ([email protected]): Created. +%% History : Written mostly by Per Gustafsson %% ==================================================================== %% Exports : %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -module(hipe_rtl_binary_construct). + -export([gen_rtl/7]). --import(hipe_tagscheme, [set_field_from_term/3, - get_field_from_term/3, - set_field_from_pointer/3, - get_field_from_pointer/3]). - --import(hipe_rtl_binary, [floorlog2/1, - get_word_integer/4, - make_size/4]). + +-import(hipe_rtl_binary, [get_word_integer/4]). + %%------------------------------------------------------------------------- -include("../main/hipe.hrl"). @@ -50,7 +46,6 @@ -define(BYTE_SIZE, 8). -define(MAX_BINSIZE, ((1 bsl ((hipe_rtl_arch:word_size()*?BYTE_SIZE)-3)) - 1)). - %% ------------------------------------------------------------------------- %% The code is generated as a list of lists, it will be flattened later. %% @@ -61,12 +56,12 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab {bs_put_string, String, SizeInBytes} -> [NewOffset] = get_real(Dst), [Base, Offset] = Args, - put_string(NewOffset, ConstTab, String, SizeInBytes, Base, Offset, + put_string(NewOffset, ConstTab, String, SizeInBytes, Base, Offset, TrueLblName); - _ -> - Code = + _ -> + Code = case BsOP of - {bs_init, Size, _Flags} -> + {bs_init, Size, _Flags} -> [] = Args, [Dst0, Base, Offset] = Dst, case is_illegal_const(Size bsl 3) of @@ -75,14 +70,14 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab false -> const_init2(Size, Dst0, Base, Offset, TrueLblName) end; - - {bs_init, _Flags} -> + + {bs_init, _Flags} -> [Size] = Args, [Dst0, Base, Offset] = Dst, - var_init2(Size, Dst0, Base, Offset, TrueLblName, + var_init2(Size, Dst0, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName); - {bs_init_bits, Size, _Flags} -> + {bs_init_bits, Size, _Flags} -> [] = Args, [Dst0, Base, Offset] = Dst, case is_illegal_const(Size) of @@ -91,19 +86,19 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab false -> const_init_bits(Size, Dst0, Base, Offset, TrueLblName) end; - - {bs_init_bits, _Flags} -> + + {bs_init_bits, _Flags} -> [Size] = Args, [Dst0, Base, Offset] = Dst, - var_init_bits(Size, Dst0, Base, Offset, TrueLblName, + var_init_bits(Size, Dst0, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName); - + {bs_put_binary_all, Unit, _Flags} -> [Src, Base, Offset] = Args, [NewOffset] = get_real(Dst), put_binary_all(NewOffset, Src, Base, Offset, Unit, TrueLblName, FalseLblName); - + {bs_put_binary, Size, _Flags} -> case is_illegal_const(Size) of true -> @@ -112,19 +107,19 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab [NewOffset] = get_real(Dst), case Args of [Src, Base, Offset] -> - put_static_binary(NewOffset, Src, Size, Base, Offset, + put_static_binary(NewOffset, Src, Size, Base, Offset, TrueLblName, FalseLblName); [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, - SystemLimitLblName, - FalseLblName), - InCode = put_dynamic_binary(NewOffset, Src, SizeReg, Base, + {SizeCode, SizeReg} = + hipe_rtl_binary:make_size(Size, Bits, SystemLimitLblName, + FalseLblName), + InCode = put_dynamic_binary(NewOffset, Src, SizeReg, Base, Offset, TrueLblName, FalseLblName), SizeCode ++ InCode end end; - - {bs_put_float, Size, Flags, ConstInfo} -> + + {bs_put_float, Size, Flags, ConstInfo} -> [NewOffset] = get_real(Dst), Aligned = aligned(Flags), LittleEndian = littleendian(Flags), @@ -134,106 +129,108 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab false -> case Args of [Src, Base, Offset] -> - CCode = static_float_c_code(NewOffset, Src, Base, Offset, Size, Flags, + CCode = static_float_c_code(NewOffset, Src, Base, Offset, Size, Flags, TrueLblName, FalseLblName), - put_float(NewOffset, Src, Base, Offset, Size, CCode, Aligned, + put_float(NewOffset, Src, Base, Offset, Size, CCode, Aligned, LittleEndian, ConstInfo, TrueLblName); [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, - SystemLimitLblName, - FalseLblName), - InCode = float_c_code(NewOffset, Src, Base, Offset, SizeReg, + {SizeCode, SizeReg} = + hipe_rtl_binary:make_size(Size, Bits, SystemLimitLblName, + FalseLblName), + InCode = float_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, TrueLblName, FalseLblName), SizeCode ++ InCode end end; - {bs_put_integer, Size, Flags, ConstInfo} -> - Aligned = aligned(Flags), + {bs_put_integer, Size, Flags, ConstInfo} -> + Aligned = aligned(Flags), LittleEndian = littleendian(Flags), [NewOffset] = get_real(Dst), case is_illegal_const(Size) of true -> [hipe_rtl:mk_goto(FalseLblName)]; false -> - case ConstInfo of + case ConstInfo of fail -> [hipe_rtl:mk_goto(FalseLblName)]; - _ -> - case Args of - [Src, Base, Offset] -> + _ -> + case Args of + [Src, Base, Offset] -> CCode = static_int_c_code(NewOffset, Src, - Base, Offset, Size, - Flags, TrueLblName, + Base, Offset, Size, + Flags, TrueLblName, FalseLblName), - put_static_int(NewOffset, Src, Base, Offset, Size, - CCode, Aligned, LittleEndian, TrueLblName); - [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, + put_static_int(NewOffset, Src, Base, Offset, Size, + CCode, Aligned, LittleEndian, TrueLblName); + [Src, Bits, Base, Offset] -> + {SizeCode, SizeReg} = + hipe_rtl_binary:make_size(Size, Bits, SystemLimitLblName, FalseLblName), CCode = int_c_code(NewOffset, Src, Base, - Offset, SizeReg, Flags, - TrueLblName, FalseLblName), + Offset, SizeReg, Flags, + TrueLblName, FalseLblName), InCode = - put_dynamic_int(NewOffset, Src, Base, Offset, + put_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, - LittleEndian, TrueLblName), - SizeCode ++ InCode - end - end + LittleEndian, TrueLblName), + SizeCode ++ InCode + end + end end; - - {unsafe_bs_put_integer, 0, _Flags, _ConstInfo} -> - [NewOffset] = get_real(Dst), + + {unsafe_bs_put_integer, 0, _Flags, _ConstInfo} -> + [NewOffset] = get_real(Dst), case Args of [_Src, _Base, Offset] -> [hipe_rtl:mk_move(NewOffset,Offset), - hipe_rtl:mk_goto(TrueLblName)]; - [_Src, _Bits, _Base, Offset] -> + hipe_rtl:mk_goto(TrueLblName)]; + [_Src, _Bits, _Base, Offset] -> [hipe_rtl:mk_move(NewOffset,Offset), - hipe_rtl:mk_goto(TrueLblName)] - end; - - {unsafe_bs_put_integer, Size, Flags, ConstInfo} -> + hipe_rtl:mk_goto(TrueLblName)] + end; + + {unsafe_bs_put_integer, Size, Flags, ConstInfo} -> case is_illegal_const(Size) of true -> [hipe_rtl:mk_goto(FalseLblName)]; false -> Aligned = aligned(Flags), - LittleEndian = littleendian(Flags), - [NewOffset] = get_real(Dst), - case ConstInfo of + LittleEndian = littleendian(Flags), + [NewOffset] = get_real(Dst), + case ConstInfo of fail -> - [hipe_rtl:mk_goto(FalseLblName)]; - _ -> - case Args of - [Src, Base, Offset] -> + [hipe_rtl:mk_goto(FalseLblName)]; + _ -> + case Args of + [Src, Base, Offset] -> CCode = static_int_c_code(NewOffset, Src, - Base, Offset, Size, - Flags, TrueLblName, + Base, Offset, Size, + Flags, TrueLblName, FalseLblName), - put_unsafe_static_int(NewOffset, Src, Base, + put_unsafe_static_int(NewOffset, Src, Base, Offset, Size, - CCode, Aligned, LittleEndian, - TrueLblName); - [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, - SystemLimitLblName, - FalseLblName), + CCode, Aligned, LittleEndian, + TrueLblName); + [Src, Bits, Base, Offset] -> + {SizeCode, SizeReg} = + hipe_rtl_binary:make_size(Size, Bits, + SystemLimitLblName, + FalseLblName), CCode = int_c_code(NewOffset, Src, Base, - Offset, SizeReg, Flags, - TrueLblName, FalseLblName), + Offset, SizeReg, Flags, + TrueLblName, FalseLblName), InCode = - put_unsafe_dynamic_int(NewOffset, Src, Base, - Offset, SizeReg, CCode, - Aligned, LittleEndian, + put_unsafe_dynamic_int(NewOffset, Src, Base, + Offset, SizeReg, CCode, + Aligned, LittleEndian, TrueLblName), - SizeCode ++ InCode - end + SizeCode ++ InCode + end end - end; - + end; + bs_utf8_size -> case Dst of [_DstVar] -> @@ -276,13 +273,13 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab [hipe_rtl:mk_call([], bs_validate_unicode, Args, TrueLblName, FalseLblName, not_remote)]; - bs_final -> + bs_final -> Zero = hipe_rtl:mk_imm(0), - [Src, Offset] = Args, + [Src, Offset] = Args, [BitSize, ByteSize] = create_regs(2), [ShortLbl, LongLbl] = create_lbls(2), - case Dst of - [DstVar] -> + case Dst of + [DstVar] -> [hipe_rtl:mk_alub(BitSize, Offset, 'and', ?LOW_BITS, eq, hipe_rtl:label_name(ShortLbl), hipe_rtl:label_name(LongLbl)), ShortLbl, @@ -292,11 +289,11 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab hipe_rtl:mk_alu(ByteSize, Offset, 'srl', ?BYTE_SHIFT), hipe_tagscheme:mk_sub_binary(DstVar, ByteSize, Zero, BitSize, Zero, Src), - hipe_rtl:mk_goto(TrueLblName)]; + hipe_rtl:mk_goto(TrueLblName)]; [] -> - [hipe_rtl:mk_goto(TrueLblName)] - end; - + [hipe_rtl:mk_goto(TrueLblName)] + end; + bs_init_writable -> Zero = hipe_rtl:mk_imm(0), [Size] = Args, @@ -306,29 +303,29 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab [hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE + ?SUB_BIN_WORDSIZE), get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), allocate_writable(DstVar, Base, SizeReg, Zero, Zero), - hipe_rtl:mk_goto(TrueLblName)]; - + hipe_rtl:mk_goto(TrueLblName)]; + {bs_private_append, _U, _F} -> - [Size, Bin] = Args, + [Size, Bin] = Args, [DstVar, Base, Offset] = Dst, [ProcBin] = create_vars(1), [SubSize, SizeReg, EndSubSize, EndSubBitSize] = create_regs(4), SubBinSize = {sub_binary, binsize}, - [get_field_from_term({sub_binary, orig}, Bin, ProcBin), - get_field_from_term(SubBinSize, Bin, SubSize), + [hipe_tagscheme:get_field_from_term({sub_binary, orig}, Bin, ProcBin), + hipe_tagscheme:get_field_from_term(SubBinSize, Bin, SubSize), get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), realloc_binary(SizeReg, ProcBin, Base), calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), - set_field_from_term(SubBinSize, Bin, EndSubSize), - set_field_from_term({sub_binary, bitsize}, Bin, EndSubBitSize), + hipe_tagscheme:set_field_from_term(SubBinSize, Bin, EndSubSize), + hipe_tagscheme:set_field_from_term({sub_binary, bitsize}, Bin, EndSubBitSize), hipe_rtl:mk_move(DstVar, Bin), hipe_rtl:mk_goto(TrueLblName)]; {bs_append, _U, _F, Unit, _Bla} -> - [Size, Bin] = Args, - [DstVar, Base, Offset] = Dst, + [Size, Bin] = Args, + [DstVar, Base, Offset] = Dst, [ProcBin] = create_vars(1), - [Flags, SizeReg, IsWritable, EndSubSize, EndSubBitSize] = + [Flags, SizeReg, IsWritable, EndSubSize, EndSubBitSize] = create_regs(5), [ContLbl,ContLbl2,ContLbl3,ContLbl4,WritableLbl,NotWritableLbl] = Lbls = create_lbls(6), @@ -339,24 +336,24 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab SubIsWritable = {sub_binary, is_writable}, [hipe_rtl:mk_gctest(?SUB_BIN_WORDSIZE + ?PROC_BIN_WORDSIZE), get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), - hipe_tagscheme:test_bitstr(Bin, ContLblName, FalseLblName, 0.99), - ContLbl, - hipe_tagscheme:test_subbinary(Bin,ContLbl2Name, NotWritable), + hipe_tagscheme:test_bitstr(Bin, ContLblName, FalseLblName, 0.99), + ContLbl, + hipe_tagscheme:test_subbinary(Bin,ContLbl2Name, NotWritable), ContLbl2, - get_field_from_term(SubIsWritable, Bin, IsWritable), + hipe_tagscheme:get_field_from_term(SubIsWritable, Bin, IsWritable), hipe_rtl:mk_branch(IsWritable, 'ne', Zero, ContLbl3Name, NotWritable), ContLbl3, - get_field_from_term({sub_binary, orig}, Bin, ProcBin), - get_field_from_term({proc_bin, flags}, ProcBin, Flags), + hipe_tagscheme:get_field_from_term({sub_binary, orig}, Bin, ProcBin), + hipe_tagscheme:get_field_from_term({proc_bin, flags}, ProcBin, Flags), hipe_rtl:mk_alub(Flags, Flags, 'and', - hipe_rtl:mk_imm(?PB_IS_WRITABLE), + hipe_rtl:mk_imm(?PB_IS_WRITABLE), eq, NotWritable, ContLbl4Name, 0.01), ContLbl4, calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), is_divisible(Offset, Unit, Writable, FalseLblName), WritableLbl, - set_field_from_term(SubIsWritable, Bin, Zero), + hipe_tagscheme:set_field_from_term(SubIsWritable, Bin, Zero), realloc_binary(SizeReg, ProcBin, Base), hipe_tagscheme:mk_sub_binary(DstVar, EndSubSize, Zero, EndSubBitSize, Zero, @@ -394,7 +391,7 @@ not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit, allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize), put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0), Unit, TrueLblName, FalseLblName)]. - + allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> Zero = hipe_rtl:mk_imm(0), [NextLbl] = create_lbls(1), @@ -411,7 +408,7 @@ allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> hipe_tagscheme:mk_sub_binary(Dst, EndSubSize, Zero, EndSubBitSize, Zero, hipe_rtl:mk_imm(1), ProcBin)]. -realloc_binary(SizeReg, ProcBin, Base) -> +realloc_binary(SizeReg, ProcBin, Base) -> [NoReallocLbl, ReallocLbl, NextLbl, ContLbl] = Lbls = create_lbls(4), [NoReallocLblName, ReallocLblName, NextLblName, ContLblName] = [hipe_rtl:label_name(Lbl) || Lbl <- Lbls], @@ -422,36 +419,36 @@ realloc_binary(SizeReg, ProcBin, Base) -> ProcBinValTag = {proc_bin, val}, ProcBinBytesTag = {proc_bin, bytes}, BinOrigSizeTag = {binary, orig_size}, - [get_field_from_term(ProcBinSizeTag, ProcBin, PBSize), + [hipe_tagscheme:get_field_from_term(ProcBinSizeTag, ProcBin, PBSize), hipe_rtl:mk_alu(Tmp, SizeReg, 'add', ?LOW_BITS), hipe_rtl:mk_alu(ByteSize, Tmp, 'srl', ?BYTE_SHIFT), hipe_rtl:mk_alu(ResultingSize, ByteSize, 'add', PBSize), - set_field_from_term(ProcBinSizeTag, ProcBin, ResultingSize), - get_field_from_term(ProcBinFlagsTag, ProcBin, Flags), + hipe_tagscheme:set_field_from_term(ProcBinSizeTag, ProcBin, ResultingSize), + hipe_tagscheme:get_field_from_term(ProcBinFlagsTag, ProcBin, Flags), hipe_rtl:mk_alu(Flags, Flags, 'or', hipe_rtl:mk_imm(?PB_ACTIVE_WRITER)), - set_field_from_term(ProcBinFlagsTag, ProcBin, Flags), - get_field_from_term(ProcBinValTag, ProcBin, BinPointer), - get_field_from_pointer(BinOrigSizeTag, BinPointer, OrigSize), + hipe_tagscheme:set_field_from_term(ProcBinFlagsTag, ProcBin, Flags), + hipe_tagscheme:get_field_from_term(ProcBinValTag, ProcBin, BinPointer), + hipe_tagscheme:get_field_from_pointer(BinOrigSizeTag, BinPointer, OrigSize), hipe_rtl:mk_branch(OrigSize, 'ltu', ResultingSize, ReallocLblName, NoReallocLblName), NoReallocLbl, - get_field_from_term(ProcBinBytesTag, ProcBin, Base), + hipe_tagscheme:get_field_from_term(ProcBinBytesTag, ProcBin, Base), hipe_rtl:mk_goto(ContLblName), ReallocLbl, hipe_rtl:mk_alu(NewSize, ResultingSize, 'sll', hipe_rtl:mk_imm(1)), - hipe_rtl:mk_call([BinPointer], bs_reallocate, [BinPointer, NewSize], + hipe_rtl:mk_call([BinPointer], bs_reallocate, [BinPointer, NewSize], NextLblName, [], not_remote), NextLbl, - set_field_from_pointer(BinOrigSizeTag, BinPointer, NewSize), - set_field_from_term(ProcBinValTag, ProcBin, BinPointer), + hipe_tagscheme:set_field_from_pointer(BinOrigSizeTag, BinPointer, NewSize), + hipe_tagscheme:set_field_from_term(ProcBinValTag, ProcBin, BinPointer), hipe_tagscheme:extract_binary_bytes(BinPointer, Base), - set_field_from_term(ProcBinBytesTag, ProcBin, Base), + hipe_tagscheme:set_field_from_term(ProcBinBytesTag, ProcBin, Base), ContLbl]. calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize) -> [SubSize, SubBitSize, EndSize] = create_regs(3), - [get_field_from_term({sub_binary, binsize}, Bin, SubSize), - get_field_from_term({sub_binary, bitsize}, Bin, SubBitSize), + [hipe_tagscheme:get_field_from_term({sub_binary, binsize}, Bin, SubSize), + hipe_tagscheme:get_field_from_term({sub_binary, bitsize}, Bin, SubBitSize), hipe_rtl:mk_alu(Offset, SubSize, 'sll', ?BYTE_SHIFT), hipe_rtl:mk_alu(Offset, Offset, 'add', SubBitSize), hipe_rtl:mk_alu(EndSize, Offset, 'add', SizeReg), @@ -492,7 +489,7 @@ static_int_c_code(NewOffset, Src, Base, Offset, Size, Flags, int_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, TrueLblName, FalseLblName) -> - put_c_code(bs_put_big_integer, NewOffset, Src, Base, Offset, SizeReg, + put_c_code(bs_put_big_integer, NewOffset, Src, Base, Offset, SizeReg, Flags, TrueLblName, FalseLblName). binary_c_code(NewOffset, Src, Base, Offset, Size, TrueLblName) -> @@ -500,8 +497,8 @@ binary_c_code(NewOffset, Src, Base, Offset, Size, TrueLblName) -> [SizeReg, FlagsReg] = create_regs(2), [hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(0)), hipe_rtl:mk_move(SizeReg, Size), - hipe_rtl:mk_call([], bs_put_bits, [Src, SizeReg, Base, Offset, FlagsReg], - hipe_rtl:label_name(PassedLbl),[],not_remote), + hipe_rtl:mk_call([], bs_put_bits, [Src, SizeReg, Base, Offset, FlagsReg], + hipe_rtl:label_name(PassedLbl), [], not_remote), PassedLbl, hipe_rtl:mk_alu(NewOffset, Offset, add, SizeReg), hipe_rtl:mk_goto(TrueLblName)]. @@ -511,7 +508,7 @@ put_c_code(Func, NewOffset, Src, Base, Offset, SizeReg, Flags, PassedLbl = hipe_rtl:mk_new_label(), [FlagsReg] = create_regs(1), [hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)), - gen_test_sideffect_bs_call(Func, [Src, SizeReg, Base, Offset, FlagsReg], + gen_test_sideffect_bs_call(Func, [Src, SizeReg, Base, Offset, FlagsReg], hipe_rtl:label_name(PassedLbl), FalseLblName), PassedLbl, hipe_rtl:mk_alu(NewOffset, Offset, add, SizeReg), @@ -523,7 +520,7 @@ gen_test_sideffect_bs_call(Name, Args, TrueLblName, FalseLblName) -> [hipe_rtl:mk_call([Tmp1], Name, Args, hipe_rtl:label_name(RetLbl), [], not_remote), RetLbl, - hipe_rtl:mk_branch(Tmp1, eq, hipe_rtl:mk_imm(0), + hipe_rtl:mk_branch(Tmp1, eq, hipe_rtl:mk_imm(0), FalseLblName, TrueLblName, 0.01)]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -544,7 +541,7 @@ create_unsafe_regs(0) -> create_vars(X) when X > 0 -> [hipe_rtl:mk_new_var()|create_vars(X-1)]; -create_vars(0) -> +create_vars(0) -> []. create_lbls(X) when X > 0 -> @@ -582,7 +579,7 @@ get_real(Dst) -> %% The following functions are called from the translation switch: %% %% - put_string/7 creates code to copy a string to a binary -%% starting at base+offset and ending at base+newoffset +%% starting at base+offset and ending at base+newoffset %% %% - const_init2/6 initializes the creation of a binary of constant size %% @@ -609,10 +606,9 @@ put_string(NewOffset, ConstTab, String, SizeInBytes, Base, Offset, TLName) -> [StringBase] = create_regs(1), {NewTab, Lbl} = hipe_consttab:insert_block(ConstTab, byte, String), {[hipe_rtl:mk_load_address(StringBase, Lbl, constant)| - copy_string(StringBase, SizeInBytes, Base, Offset, - NewOffset, TLName)], + copy_string(StringBase, SizeInBytes, Base, Offset, NewOffset, TLName)], NewTab}. - + const_init2(Size, Dst, Base, Offset, TrueLblName) -> Log2WordSize = hipe_rtl_arch:log2_word_size(), WordSize = hipe_rtl_arch:word_size(), @@ -642,27 +638,29 @@ const_init_bits(Size, Dst, Base, Offset, TrueLblName) -> TmpDst = hipe_rtl:mk_new_var(), Zero = hipe_rtl:mk_imm(0), {ExtraSpace, SubBinCode} = - if (Size rem ?BYTE_SIZE) =:= 0 -> - {0,[hipe_rtl:mk_move(Dst, TmpDst)]}; - true -> + case (Size rem ?BYTE_SIZE) =:= 0 of + true -> + {0, [hipe_rtl:mk_move(Dst, TmpDst)]}; + false -> {?SUB_BIN_WORDSIZE, - hipe_tagscheme:mk_sub_binary(Dst, hipe_rtl:mk_imm(Size bsr 3), Zero, + hipe_tagscheme:mk_sub_binary(Dst, hipe_rtl:mk_imm(Size bsr 3), Zero, hipe_rtl:mk_imm(Size band ?LOW_BITS_INT), Zero, TmpDst)} end, BaseBinCode = - if Size =< (?MAX_HEAP_BIN_SIZE * 8) -> - ByteSize = (Size + 7) div 8, - [hipe_rtl:mk_gctest(((ByteSize+ 3*WordSize-1) bsr Log2WordSize)+ ExtraSpace), + case Size =< (?MAX_HEAP_BIN_SIZE * 8) of + true -> + ByteSize = (Size + 7) div 8, + [hipe_rtl:mk_gctest(((ByteSize + 3*WordSize-1) bsr Log2WordSize) + ExtraSpace), hipe_tagscheme:create_heap_binary(Base, ByteSize, TmpDst), hipe_rtl:mk_move(Offset, Zero)]; - true -> + false -> ByteSize = hipe_rtl:mk_new_reg(), [hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE+ExtraSpace), hipe_rtl:mk_move(Offset, Zero), hipe_rtl:mk_move(ByteSize, hipe_rtl:mk_imm((Size+7) bsr 3)), hipe_rtl:mk_call([Base], bs_allocate, [ByteSize], - hipe_rtl:label_name(NextLbl),[],not_remote), + hipe_rtl:label_name(NextLbl), [], not_remote), NextLbl, hipe_tagscheme:create_refc_binary(Base, ByteSize, TmpDst)] end, @@ -671,12 +669,12 @@ const_init_bits(Size, Dst, Base, Offset, TrueLblName) -> var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) -> Log2WordSize = hipe_rtl_arch:log2_word_size(), WordSize = hipe_rtl_arch:word_size(), - [ContLbl,HeapLbl,REFCLbl,NextLbl] = create_lbls(4), - [USize,Tmp] = create_unsafe_regs(2), + [ContLbl, HeapLbl, REFCLbl, NextLbl] = create_lbls(4), + [USize, Tmp] = create_unsafe_regs(2), [get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_BINSIZE), - hipe_rtl:label_name(ContLbl), - SystemLimitLblName), + hipe_rtl:label_name(ContLbl), + SystemLimitLblName), ContLbl, hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)), hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), @@ -698,20 +696,20 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName hipe_rtl:mk_goto(TrueLblName)]. var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) -> - [HeapLbl,REFCLbl,NextLbl,NoSubLbl,SubLbl, + [HeapLbl, REFCLbl, NextLbl, NoSubLbl, SubLbl, NoCreateSubBin, CreateSubBin, JoinLbl, JoinLbl2] = create_lbls(9), - [USize,ByteSize,TotByteSize,OffsetBits] = create_regs(4), + [USize, ByteSize, TotByteSize, OffsetBits] = create_regs(4), [TmpDst] = create_unsafe_regs(1), Log2WordSize = hipe_rtl_arch:log2_word_size(), WordSize = hipe_rtl_arch:word_size(), - MaximumWords = + MaximumWords = erlang:max((?MAX_HEAP_BIN_SIZE + 3*WordSize) bsr Log2WordSize, ?PROC_BIN_WORDSIZE) + ?SUB_BIN_WORDSIZE, Zero = hipe_rtl:mk_imm(0), [hipe_rtl:mk_gctest(MaximumWords), get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), hipe_rtl:mk_alu(ByteSize, USize, srl, ?BYTE_SHIFT), - hipe_rtl:mk_alub(OffsetBits, USize, 'and', ?LOW_BITS, eq, + hipe_rtl:mk_alub(OffsetBits, USize, 'and', ?LOW_BITS, eq, hipe_rtl:label_name(NoSubLbl), hipe_rtl:label_name(SubLbl)), NoSubLbl, @@ -721,20 +719,20 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl hipe_rtl:mk_alu(TotByteSize, ByteSize, 'add', hipe_rtl:mk_imm(1)), JoinLbl, hipe_rtl:mk_branch(TotByteSize, 'leu', hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), - hipe_rtl:label_name(HeapLbl), + hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, hipe_tagscheme:create_heap_binary(Base, TotByteSize, TmpDst), hipe_rtl:mk_goto(hipe_rtl:label_name(JoinLbl2)), REFCLbl, hipe_rtl:mk_call([Base], bs_allocate, [TotByteSize], - hipe_rtl:label_name(NextLbl),[],not_remote), + hipe_rtl:label_name(NextLbl), [], not_remote), NextLbl, hipe_tagscheme:create_refc_binary(Base, TotByteSize, TmpDst), JoinLbl2, hipe_rtl:mk_move(Offset, Zero), hipe_rtl:mk_branch(OffsetBits, 'eq', Zero, - hipe_rtl:label_name(NoCreateSubBin), + hipe_rtl:label_name(NoCreateSubBin), hipe_rtl:label_name(CreateSubBin)), CreateSubBin, hipe_tagscheme:mk_sub_binary(Dst, ByteSize, Zero, OffsetBits, Zero, TmpDst), @@ -744,10 +742,10 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl hipe_rtl:mk_goto(TrueLblName)]. put_binary_all(NewOffset, Src, Base, Offset, Unit, TLName, FLName) -> - [SrcBase,SrcOffset,NumBits] = create_regs(3), + [SrcBase, SrcOffset, NumBits] = create_regs(3), [ContLbl] = create_lbls(1), CCode = binary_c_code(NewOffset, Src, Base, Offset, NumBits, TLName), - AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, NumBits, Base, Offset, + AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, NumBits, Base, Offset, NewOffset, TLName), [get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName), is_divisible(NumBits, Unit, hipe_rtl:label_name(ContLbl), FLName), @@ -755,11 +753,11 @@ put_binary_all(NewOffset, Src, Base, Offset, Unit, TLName, FLName) -> |test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode)]. test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode) -> - [Tmp] = create_regs(1), - [AlignedLbl,CLbl] = create_lbls(2), + [Tmp] = create_regs(1), + [AlignedLbl, CLbl] = create_lbls(2), [hipe_rtl:mk_alu(Tmp, SrcOffset, 'or', NumBits), hipe_rtl:mk_alu(Tmp, Tmp, 'or', Offset), - hipe_rtl:mk_alub(Tmp, Tmp, 'and', ?LOW_BITS, 'eq', + hipe_rtl:mk_alub(Tmp, Tmp, 'and', ?LOW_BITS, 'eq', hipe_rtl:label_name(AlignedLbl), hipe_rtl:label_name(CLbl)), AlignedLbl, @@ -768,12 +766,12 @@ test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode) -> CCode]. put_static_binary(NewOffset, Src, Size, Base, Offset, TLName, FLName) -> - [SrcBase] = create_unsafe_regs(1), + [SrcBase] = create_unsafe_regs(1), [SrcOffset, SrcSize] = create_regs(2), case Size of 0 -> get_base_offset_size(Src, SrcBase, SrcOffset, SrcSize, FLName) ++ - [hipe_rtl:mk_move(NewOffset, Offset), + [hipe_rtl:mk_move(NewOffset, Offset), hipe_rtl:mk_goto(TLName)]; _ -> SizeImm = hipe_rtl:mk_imm(Size), @@ -789,13 +787,13 @@ put_dynamic_binary(NewOffset, Src, SizeReg, Base, Offset, TLName, FLName) -> [SrcBase] = create_unsafe_regs(1), [SrcOffset, SrcSize] = create_regs(2), CCode = binary_c_code(NewOffset, Src, Base, Offset, SizeReg, TLName), - AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, SizeReg, Base, Offset, + AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, SizeReg, Base, Offset, NewOffset, TLName), get_base_offset_size(Src, SrcBase, SrcOffset, SrcSize, FLName) ++ small_check(SizeReg, SrcSize, FLName) ++ test_alignment(SrcOffset, SizeReg, Offset, AlignedCode, CCode). -put_float(NewOffset, Src, Base, Offset, 64, CCode, Aligned, LittleEndian, +put_float(NewOffset, Src, Base, Offset, 64, CCode, Aligned, LittleEndian, ConstInfo, TrueLblName) -> [CLbl] = create_lbls(1), case {Aligned, LittleEndian} of @@ -829,12 +827,12 @@ put_static_int(NewOffset, Src, Base, Offset, Size, CCode, Aligned, {false, true} -> CCode; {false, false} -> - Init ++ + Init ++ copy_offset_int_big(Base, Offset, NewOffset, Size, UntaggedSrc) ++ End end. -put_unsafe_static_int(NewOffset, Src, Base, Offset, Size, CCode, Aligned, +put_unsafe_static_int(NewOffset, Src, Base, Offset, Size, CCode, Aligned, LittleEndian, TrueLblName) -> {Init, End, UntaggedSrc} = make_init_end(Src, TrueLblName), case {Aligned, LittleEndian} of @@ -849,7 +847,7 @@ put_unsafe_static_int(NewOffset, Src, Base, Offset, Size, CCode, Aligned, {false, true} -> CCode; {false, false} -> - Init ++ + Init ++ copy_offset_int_big(Base, Offset, NewOffset, Size, UntaggedSrc) ++ End end. @@ -861,7 +859,7 @@ put_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, true -> case LittleEndian of true -> - Init ++ + Init ++ copy_int_little(Base, Offset, NewOffset, SizeReg, UntaggedSrc) ++ End; false -> @@ -880,7 +878,7 @@ put_unsafe_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, true -> case LittleEndian of true -> - Init ++ + Init ++ copy_int_little(Base, Offset, NewOffset, SizeReg, UntaggedSrc) ++ End; false -> @@ -891,7 +889,7 @@ put_unsafe_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, false -> CCode end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @@ -902,7 +900,7 @@ put_unsafe_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, make_init_end(Src, CCode, TrueLblName) -> [CLbl, SuccessLbl] = create_lbls(2), [UntaggedSrc] = create_regs(1), - Init = [hipe_tagscheme:test_fixnum(Src, hipe_rtl:label_name(SuccessLbl), + Init = [hipe_tagscheme:test_fixnum(Src, hipe_rtl:label_name(SuccessLbl), hipe_rtl:label_name(CLbl), 0.99), SuccessLbl, hipe_tagscheme:untag_fixnum(UntaggedSrc,Src)], @@ -915,28 +913,28 @@ make_init_end(Src, TrueLblName) -> End = [hipe_rtl:mk_goto(TrueLblName)], {Init, End, UntaggedSrc}. -get_base_offset_size(Binary, SrcBase, SrcOffset, SrcSize, FLName) -> +get_base_offset_size(Binary, SrcBase, SrcOffset, SrcSize, FLName) -> [JoinLbl, EndLbl, SuccessLbl, SubLbl, OtherLbl, HeapLbl, REFCLbl] = Lbls = create_lbls(7), - [JoinLblName, EndLblName, SuccessLblName, SubLblName, + [JoinLblName, EndLblName, SuccessLblName, SubLblName, OtherLblName, HeapLblName, REFCLblName] = get_label_names(Lbls), - [BitSize,BitOffset] = create_regs(2), + [BitSize, BitOffset] = create_regs(2), [Orig] = create_vars(1), [hipe_tagscheme:test_bitstr(Binary, SuccessLblName, FLName, 0.99), SuccessLbl, - get_field_from_term({sub_binary,binsize}, Binary, SrcSize), + hipe_tagscheme:get_field_from_term({sub_binary,binsize}, Binary, SrcSize), hipe_rtl:mk_alu(SrcSize, SrcSize, sll, ?BYTE_SHIFT), hipe_tagscheme:test_subbinary(Binary, SubLblName, OtherLblName), SubLbl, - get_field_from_term({sub_binary,bitsize}, Binary, BitSize), - get_field_from_term({sub_binary,offset}, Binary, SrcOffset), + hipe_tagscheme:get_field_from_term({sub_binary,bitsize}, Binary, BitSize), + hipe_tagscheme:get_field_from_term({sub_binary,offset}, Binary, SrcOffset), hipe_rtl:mk_alu(SrcSize, SrcSize, add, BitSize), - get_field_from_term({sub_binary,bitoffset}, Binary, BitOffset), + hipe_tagscheme:get_field_from_term({sub_binary,bitoffset}, Binary, BitOffset), hipe_rtl:mk_alu(SrcOffset, SrcOffset, sll, ?BYTE_SHIFT), hipe_rtl:mk_alu(SrcOffset, SrcOffset, add, BitOffset), - get_field_from_term({sub_binary,orig}, Binary, Orig), + hipe_tagscheme:get_field_from_term({sub_binary,orig}, Binary, Orig), hipe_rtl:mk_goto(JoinLblName), - OtherLbl, + OtherLbl, hipe_rtl:mk_move(SrcOffset, hipe_rtl:mk_imm(0)), hipe_rtl:mk_move(Orig, Binary), JoinLbl, @@ -945,29 +943,29 @@ get_base_offset_size(Binary, SrcBase, SrcOffset, SrcSize, FLName) -> hipe_rtl:mk_alu(SrcBase, Orig, add, hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)), hipe_rtl:mk_goto(EndLblName), REFCLbl, - get_field_from_term({proc_bin,bytes}, Orig, SrcBase), + hipe_tagscheme:get_field_from_term({proc_bin,bytes}, Orig, SrcBase), EndLbl]. copy_aligned_bytes(CopyBase, CopyOffset, Size, Base, Offset, NewOffset, TrueLblName) -> [BaseDst, BaseSrc] = create_unsafe_regs(2), [Iter, Extra, BothOffset] = create_regs(3), initializations(BaseSrc, BaseDst, BothOffset, CopyOffset, Offset, CopyBase, Base) ++ - [hipe_rtl:mk_alu(Extra, Size, 'and', ?LOW_BITS), - hipe_rtl:mk_alu(Iter, Size, srl, ?BYTE_SHIFT), + [hipe_rtl:mk_alu(Extra, Size, 'and', ?LOW_BITS), + hipe_rtl:mk_alu(Iter, Size, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(NewOffset, Offset, 'add', Size)] ++ easy_loop(BaseSrc, BaseDst, BothOffset, Iter, Extra, TrueLblName). copy_string(StringBase, StringSize, BinBase, BinOffset, NewOffset, TrueLblName) -> [TmpOffset,BothOffset,InitOffs] = create_regs(3), [NewBinBase] = create_unsafe_regs(1), - [EasyLbl,HardLbl] = create_lbls(2), + [EasyLbl, HardLbl] = create_lbls(2), [hipe_rtl:mk_alu(TmpOffset, BinOffset, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(NewBinBase, BinBase, add, TmpOffset), hipe_rtl:mk_move(BothOffset, hipe_rtl:mk_imm(0)), hipe_rtl:mk_alub(InitOffs, BinOffset, 'and', ?LOW_BITS, eq, hipe_rtl:label_name(EasyLbl), hipe_rtl:label_name(HardLbl)), EasyLbl, - hipe_rtl:mk_alu(NewOffset, BinOffset, add, + hipe_rtl:mk_alu(NewOffset, BinOffset, add, hipe_rtl:mk_imm(?bytes_to_bits(StringSize)))] ++ easy_loop(StringBase, NewBinBase, BothOffset, hipe_rtl:mk_imm(StringSize), hipe_rtl:mk_imm(0), TrueLblName) ++ @@ -983,9 +981,9 @@ small_check(SizeVar, CopySize, FalseLblName) -> hipe_rtl:label_name(SuccessLbl), FalseLblName), SuccessLbl]. -easy_loop(BaseSrc, BaseDst, BothOffset, Iterations, Extra, TrueLblName) -> - [Tmp1,Shift] = create_regs(2), - [LoopLbl,TopLbl,EndLbl,ExtraLbl] = create_lbls(4), +easy_loop(BaseSrc, BaseDst, BothOffset, Iterations, Extra, TrueLblName) -> + [Tmp1, Shift] = create_regs(2), + [LoopLbl, TopLbl, EndLbl, ExtraLbl] = create_lbls(4), [TopLbl, hipe_rtl:mk_branch(BothOffset, ne, Iterations, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl), 0.99), @@ -1005,17 +1003,17 @@ easy_loop(BaseSrc, BaseDst, BothOffset, Iterations, Extra, TrueLblName) -> hipe_rtl:mk_store(BaseDst, BothOffset, Tmp1, byte), hipe_rtl:mk_goto(TrueLblName)]. -hard_loop(BaseSrc, BaseDst, BothOffset, Iterations, +hard_loop(BaseSrc, BaseDst, BothOffset, Iterations, InitOffset, TrueLblName) -> [Tmp1, Tmp2, OldByte, NewByte, SaveByte] = create_regs(5), - [LoopLbl,EndLbl,TopLbl] = create_lbls(3), + [LoopLbl, EndLbl, TopLbl] = create_lbls(3), [hipe_rtl:mk_load(OldByte, BaseDst, BothOffset, byte, unsigned), - hipe_rtl:mk_alu(Tmp1, hipe_rtl:mk_imm(?BYTE_SIZE), sub, InitOffset), + hipe_rtl:mk_alu(Tmp1, hipe_rtl:mk_imm(?BYTE_SIZE), sub, InitOffset), TopLbl, - hipe_rtl:mk_branch(BothOffset, ne, Iterations, - hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(BothOffset, ne, Iterations, + hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), - LoopLbl, + LoopLbl, hipe_rtl:mk_load(NewByte, BaseSrc, BothOffset, byte, unsigned), hipe_rtl:mk_alu(Tmp2, NewByte, srl, InitOffset), hipe_rtl:mk_alu(SaveByte, OldByte, 'or', Tmp2), @@ -1037,12 +1035,12 @@ initializations(BaseTmp1, BaseTmp2, BothOffset, CopyOffset, Offset, CopyBase, Ba copy_int_little(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) -> [Tmp2,TmpOffset] = create_regs(2), - ByteSize = Size div ?BYTE_SIZE, - [hipe_rtl:mk_alu(TmpOffset, Offset, srl, ?BYTE_SHIFT), - hipe_rtl:mk_alu(Tmp2, hipe_rtl:mk_imm(ByteSize), 'add', TmpOffset)] ++ - + ByteSize = Size div ?BYTE_SIZE, + [hipe_rtl:mk_alu(TmpOffset, Offset, srl, ?BYTE_SHIFT), + hipe_rtl:mk_alu(Tmp2, hipe_rtl:mk_imm(ByteSize), 'add', TmpOffset)] ++ + little_loop(Tmp1, Tmp2, TmpOffset, Base) ++ - + case Size band 7 of 0 -> [hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))]; @@ -1051,18 +1049,16 @@ copy_int_little(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) -> hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))] end; - copy_int_little(Base, Offset, NewOffset, Size, Tmp1) -> [Tmp2, Tmp3, Tmp4, TmpOffset] = create_regs(4), - [hipe_rtl:mk_alu(Tmp2, Size, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(TmpOffset, Offset, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(Tmp3, Tmp2, 'add', TmpOffset)] ++ - + little_loop(Tmp1, Tmp3, TmpOffset, Base) ++ - + [hipe_rtl:mk_alu(Tmp4, Size, 'and', ?LOW_BITS), - hipe_rtl:mk_alu(Tmp4, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', Tmp4), + hipe_rtl:mk_alu(Tmp4, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', Tmp4), hipe_rtl:mk_alu(Tmp1, Tmp1, sll, Tmp4), hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), hipe_rtl:mk_alu(NewOffset, Offset, 'add', Size)]. @@ -1097,37 +1093,37 @@ copy_int_big(_Base, Offset, NewOffset, 0, _Tmp1) -> [hipe_rtl:mk_move(NewOffset, Offset)]; copy_int_big(Base, Offset, NewOffset, ?BYTE_SIZE, Tmp1) -> TmpOffset = hipe_rtl:mk_new_reg(), - [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(8))]; + [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(8))]; copy_int_big(Base, Offset, NewOffset, 2*?BYTE_SIZE, Tmp1) -> TmpOffset = hipe_rtl:mk_new_reg(), - [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'add', hipe_rtl:mk_imm(1)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), - hipe_rtl:mk_alu(Tmp1, Tmp1, 'sra', hipe_rtl:mk_imm(8)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(16))]; + [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'add', hipe_rtl:mk_imm(1)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), + hipe_rtl:mk_alu(Tmp1, Tmp1, 'sra', hipe_rtl:mk_imm(8)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(16))]; copy_int_big(Base, Offset, NewOffset, 3*?BYTE_SIZE, Tmp1) -> - TmpOffset = hipe_rtl:mk_new_reg(), - [hipe_rtl:mk_alu(TmpOffset, Offset, srl, hipe_rtl:mk_imm(3)), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, add, hipe_rtl:mk_imm(2)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), - hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(8)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), - hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(8)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(NewOffset, Offset, add, hipe_rtl:mk_imm(24))]; + TmpOffset = hipe_rtl:mk_new_reg(), + [hipe_rtl:mk_alu(TmpOffset, Offset, srl, hipe_rtl:mk_imm(3)), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, add, hipe_rtl:mk_imm(2)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), + hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(8)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), + hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(8)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(NewOffset, Offset, add, hipe_rtl:mk_imm(24))]; copy_int_big(Base, Offset,NewOffset, 4*?BYTE_SIZE, Tmp1) -> copy_big_word(Base, Offset, NewOffset, Tmp1); copy_int_big(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) -> [OldOffset, TmpOffset, Bits] = create_regs(3), ByteSize = (Size + 7) div ?BYTE_SIZE, - case Size band 7 of - 0 -> + case Size band 7 of + 0 -> [hipe_rtl:mk_alu(OldOffset, Offset, sra, hipe_rtl:mk_imm(3)), hipe_rtl:mk_alu(TmpOffset, OldOffset, add, hipe_rtl:mk_imm(ByteSize))]; Rest -> @@ -1138,7 +1134,7 @@ copy_int_big(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) -> hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(Rest))] end ++ big_loop(Tmp1, OldOffset, TmpOffset, Base) ++ - [hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))]; + [hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))]; copy_int_big(Base, Offset, NewOffset, Size, Tmp1) -> Tmp2 = hipe_rtl:mk_new_reg(), Tmp3 = hipe_rtl:mk_new_reg(), @@ -1151,7 +1147,7 @@ copy_int_big(Base, Offset, NewOffset, Size, Tmp1) -> [hipe_rtl:mk_alu(Tmp2, Size, 'srl', hipe_rtl:mk_imm(3)), hipe_rtl:mk_alu(Tmp3, Offset, 'srl', hipe_rtl:mk_imm(3)), hipe_rtl:mk_alu(TmpOffset, Tmp2, 'add', Tmp3), - hipe_rtl:mk_alub(Tmp4, Size, 'and', hipe_rtl:mk_imm(7), 'eq', + hipe_rtl:mk_alub(Tmp4, Size, 'and', hipe_rtl:mk_imm(7), 'eq', hipe_rtl:label_name(EvenLbl), hipe_rtl:label_name(OddLbl)), OddLbl, hipe_rtl:mk_alu(Tmp6, hipe_rtl:mk_imm(8), 'sub', Tmp4), @@ -1159,9 +1155,7 @@ copy_int_big(Base, Offset, NewOffset, Size, Tmp1) -> hipe_rtl:mk_store(Base, TmpOffset, Tmp5, byte), EvenLbl, hipe_rtl:mk_alu(Tmp1, Tmp1, srl, Tmp4)] ++ - big_loop(Tmp1, Tmp3, TmpOffset, Base) ++ - [hipe_rtl:mk_alu(NewOffset, Offset, 'add', Size)]. copy_big_word(Base, Offset, NewOffset, Word) -> @@ -1224,8 +1218,8 @@ copy_offset_int_big(Base, Offset, NewOffset, Size, Tmp1) hipe_rtl:mk_alu(Tmp6, Tmp6, 'and', ?LOW_BITS), hipe_rtl:mk_alu(Tmp4, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', Tmp6), hipe_rtl:mk_move(Tmp5, Tmp1), - hipe_rtl:mk_alu(Tmp1, Tmp1, 'sll', Tmp6), - hipe_rtl:mk_branch(TmpOffset, 'ne', Tmp3, hipe_rtl:label_name(NextLbl), + hipe_rtl:mk_alu(Tmp1, Tmp1, 'sll', Tmp6), + hipe_rtl:mk_branch(TmpOffset, 'ne', Tmp3, hipe_rtl:label_name(NextLbl), hipe_rtl:label_name(EndLbl)), NextLbl, hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), @@ -1272,7 +1266,7 @@ copy_float_big(_Base, _Offset, _NewOffset, _Src, FalseLblName, _TrueLblName, fai copy_float_big(Base, Offset, NewOffset, Src, _FalseLblName, TrueLblName,pass) -> FloatLo = hipe_rtl:mk_new_reg(), FloatHi = hipe_rtl:mk_new_reg(), - TmpOffset =hipe_rtl:mk_new_reg(), + TmpOffset = hipe_rtl:mk_new_reg(), hipe_tagscheme:unsafe_load_float(FloatLo, FloatHi, Src) ++ copy_big_word(Base, Offset, TmpOffset, FloatHi) ++ copy_big_word(Base, TmpOffset, NewOffset, FloatLo) ++ @@ -1285,7 +1279,7 @@ copy_float_big(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, var) -> is_divisible(_Dividend, 1, SuccLbl, _FailLbl) -> [hipe_rtl:mk_goto(SuccLbl)]; is_divisible(Dividend, Divisor, SuccLbl, FailLbl) -> - Log2 = floorlog2(Divisor), + Log2 = hipe_rtl_binary:floorlog2(Divisor), case Divisor =:= 1 bsl Log2 of true -> %% Divisor is a power of 2 %% Test that the Log2-1 lowest bits are clear diff --git a/lib/hipe/rtl/hipe_rtl_lcm.erl b/lib/hipe/rtl/hipe_rtl_lcm.erl index ef866d0843..71bd06c0df 100644 --- a/lib/hipe/rtl/hipe_rtl_lcm.erl +++ b/lib/hipe/rtl/hipe_rtl_lcm.erl @@ -63,10 +63,10 @@ rtl_lcm(CFG, Options) -> pp_debug("-------------------------------------------------~n",[]), %% pp_debug( "~w~n", [MFA]), - + %% A check if we should pretty print the result. case proplists:get_bool(pp_rtl_lcm, Options) of - true-> + true -> pp_debug("-------------------------------------------------~n",[]), %% pp_debug("AllExpr: ~w~n", [AllExpr]), pp_debug("AllExpr:~n", []), @@ -76,21 +76,21 @@ rtl_lcm(CFG, Options) -> _ -> ok end, - + pp_debug("-------------------------------------------------~n",[]), - ?option_time({CFG1, MoveSet} = perform_lcm(CFG, NodeInfo, EdgeInfo, ExprMap, - IdMap, AllExpr, mk_edge_bb_map(), + {CFG1, MoveSet} = ?option_time(perform_lcm(CFG, NodeInfo, EdgeInfo, ExprMap, + IdMap, AllExpr, mk_edge_bb_map(), ?SETS:new(), Labels), - "RTL LCM perform_lcm", Options), + "RTL LCM perform_lcm", Options), %% Scan through list of moved expressions and replace their %% assignments with the new temporary created for that expression MoveList = ?SETS:to_list(MoveSet), - ?option_time(CFG2 = moved_expr_replace_assignments(CFG1, ExprMap, IdMap, + CFG2 = ?option_time(moved_expr_replace_assignments(CFG1, ExprMap, IdMap, MoveList), - "RTL LCM moved_expr_replace_assignments", Options), + "RTL LCM moved_expr_replace_assignments", Options), pp_debug("-------------------------------------------------~n~n",[]), - + CFG2. %%============================================================================= @@ -466,10 +466,10 @@ expr_clear_dst(I) -> %% easy access later. lcm_precalc(CFG, Options) -> %% Calculate use map and expression map. - ?option_time({ExprMap, IdMap} = mk_expr_map(CFG), - "RTL LCM mk_expr_map", Options), - ?option_time(UseMap = mk_use_map(CFG, ExprMap), - "RTL LCM mk_use_map", Options), + {ExprMap, IdMap} = ?option_time(mk_expr_map(CFG), + "RTL LCM mk_expr_map", Options), + UseMap = ?option_time(mk_use_map(CFG, ExprMap), + "RTL LCM mk_use_map", Options), %% Labels = hipe_rtl_cfg:reverse_postorder(CFG), Labels = hipe_rtl_cfg:labels(CFG), %% StartLabel = hipe_rtl_cfg:start_label(CFG), @@ -477,28 +477,28 @@ lcm_precalc(CFG, Options) -> AllExpr = ?SETS:from_list(gb_trees:keys(IdMap)), %% Calculate the data sets. - ?option_time(NodeInfo0 = mk_node_info(Labels), "RTL LCM mk_node_info", - Options), + NodeInfo0 = ?option_time(mk_node_info(Labels), + "RTL LCM mk_node_info", Options), %% ?option_time(EdgeInfo0 = mk_edge_info(), "RTL LCM mk_edge_info", %% Options), EdgeInfo0 = mk_edge_info(), - ?option_time(NodeInfo1 = calc_up_exp(CFG, ExprMap, NodeInfo0, Labels), - "RTL LCM calc_up_exp", Options), - ?option_time(NodeInfo2 = calc_down_exp(CFG, ExprMap, NodeInfo1, Labels), - "RTL LCM calc_down_exp", Options), - ?option_time(NodeInfo3 = calc_killed_expr(CFG, NodeInfo2, UseMap, AllExpr, + NodeInfo1 = ?option_time(calc_up_exp(CFG, ExprMap, NodeInfo0, Labels), + "RTL LCM calc_up_exp", Options), + NodeInfo2 = ?option_time(calc_down_exp(CFG, ExprMap, NodeInfo1, Labels), + "RTL LCM calc_down_exp", Options), + NodeInfo3 = ?option_time(calc_killed_expr(CFG, NodeInfo2, UseMap, AllExpr, IdMap, Labels), - "RTL LCM calc_killed_exp", Options), - ?option_time(NodeInfo4 = calc_avail(CFG, NodeInfo3), - "RTL LCM calc_avail", Options), - ?option_time(NodeInfo5 = calc_antic(CFG, NodeInfo4, AllExpr), - "RTL LCM calc_antic", Options), - ?option_time(EdgeInfo1 = calc_earliest(CFG, NodeInfo5, EdgeInfo0, Labels), - "RTL LCM calc_earliest", Options), - ?option_time({NodeInfo6, EdgeInfo2} = calc_later(CFG, NodeInfo5, EdgeInfo1), - "RTL LCM calc_later", Options), - ?option_time(NodeInfo7 = calc_delete(CFG, NodeInfo6, Labels), - "RTL LCM calc_delete", Options), + "RTL LCM calc_killed_exp", Options), + NodeInfo4 = ?option_time(calc_avail(CFG, NodeInfo3), + "RTL LCM calc_avail", Options), + NodeInfo5 = ?option_time(calc_antic(CFG, NodeInfo4, AllExpr), + "RTL LCM calc_antic", Options), + EdgeInfo1 = ?option_time(calc_earliest(CFG, NodeInfo5, EdgeInfo0, Labels), + "RTL LCM calc_earliest", Options), + {NodeInfo6, EdgeInfo2} = ?option_time(calc_later(CFG, NodeInfo5, EdgeInfo1), + "RTL LCM calc_later", Options), + NodeInfo7 = ?option_time(calc_delete(CFG, NodeInfo6, Labels), + "RTL LCM calc_delete", Options), {NodeInfo7, EdgeInfo2, AllExpr, ExprMap, IdMap, Labels}. %%%%%%%%%%%%%%%%%%% AVAILABLE IN/OUT FLOW ANALYSIS %%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -941,15 +941,16 @@ calc_insert_edge(NodeInfo, EdgeInfo, From, To) -> calc_delete(_, NodeInfo, []) -> NodeInfo; calc_delete(CFG, NodeInfo, [Label|Labels]) -> - case Label =:= hipe_rtl_cfg:start_label(CFG) of - true -> - NewNodeInfo = set_delete(NodeInfo, Label, ?SETS:new()); - false -> - UpExp = up_exp(NodeInfo, Label), - LaterIn = later_in(NodeInfo, Label), - Delete = ?SETS:subtract(UpExp, LaterIn), - NewNodeInfo = set_delete(NodeInfo, Label, Delete) - end, + NewNodeInfo = + case Label =:= hipe_rtl_cfg:start_label(CFG) of + true -> + set_delete(NodeInfo, Label, ?SETS:new()); + false -> + UpExp = up_exp(NodeInfo, Label), + LaterIn = later_in(NodeInfo, Label), + Delete = ?SETS:subtract(UpExp, LaterIn), + set_delete(NodeInfo, Label, Delete) + end, calc_delete(CFG, NewNodeInfo, Labels). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/hipe/rtl/hipe_rtl_ssapre.erl b/lib/hipe/rtl/hipe_rtl_ssapre.erl index e248457806..df1a4b9376 100644 --- a/lib/hipe/rtl/hipe_rtl_ssapre.erl +++ b/lib/hipe/rtl/hipe_rtl_ssapre.erl @@ -107,7 +107,7 @@ rtl_ssapre(RtlSSACfg, Options) -> case XsiList of [] -> %% No Xsi - ?option_time(?pp_debug("~n~n################ No Xsi Inserted ################~n",[]),"RTL A-SSAPRE No Xsi inserted (skip Downsafety and Will Be Available)",Options), + ?pp_debug("~n~n################ No Xsi Inserted ################~n",[]), ok; _ -> ?pp_debug("~n############ Downsafety ##########~n",[]), @@ -126,7 +126,7 @@ rtl_ssapre(RtlSSACfg, Options) -> ?pp_debug("~n~n################ Xsi CFG ################~n",[]),pp_cfg(CFG2,XsiGraph), init_redundancy_count(), - ?option_time(FinalCFG=perform_code_motion(Labels,CFG2,XsiGraph),"RTL A-SSAPRE Code Motion",Options), + FinalCFG = ?option_time(perform_code_motion(Labels,CFG2,XsiGraph),"RTL A-SSAPRE Code Motion",Options), ?pp_debug("\n############ No more need for the Xsi Graph....Deleting...",[]),?GRAPH:delete(XsiGraph), @@ -146,7 +146,7 @@ perform_Xsi_insertion(Cfg, Options) -> init_counters(), %% Init counters for Bottoms and Temps DigraphOpts = [cyclic, private], XsiGraph = digraph:new(DigraphOpts), - %% Be carefull, the digraph component is NOT garbage collected, + %% Be careful, the digraph component is NOT garbage collected, %% so don't create 20 millions of instances! %% finds the longest depth %% Depth-first, preorder traversal over Basic Blocks. @@ -154,13 +154,13 @@ perform_Xsi_insertion(Cfg, Options) -> Labels = ?CFG:preorder(Cfg), ?pp_debug("~n~n############# Finding definitions for computation~n~n",[]), - ?option_time({Cfg2,XsiGraph} = find_definition_for_computations(Labels,Cfg,XsiGraph),"RTL A-SSAPRE Xsi Insertion, searching from instructions",Options), + {Cfg2,XsiGraph} = ?option_time(find_definition_for_computations(Labels,Cfg,XsiGraph),"RTL A-SSAPRE Xsi Insertion, searching from instructions",Options), %% Active List creation GeneratorXsiList = lists:sort(?GRAPH:vertices(XsiGraph)), ?pp_debug("~n~n############# Inserted Xsis ~w",[GeneratorXsiList]), ?pp_debug("~n~n############# Finding operands~n",[]), - ?option_time({Cfg3,XsiGraph} = find_operands(Cfg2,XsiGraph,GeneratorXsiList,0),"RTL A-SSAPRE Xsi Insertion, finding operands",Options), + {Cfg3,XsiGraph} = ?option_time(find_operands(Cfg2,XsiGraph,GeneratorXsiList,0),"RTL A-SSAPRE Xsi Insertion, finding operands",Options), %% Creating the CFGGraph ?pp_debug("~n~n############# Creating CFG Graph",[]), @@ -170,9 +170,9 @@ perform_Xsi_insertion(Cfg, Options) -> ?pp_debug("~nAdding a vertex for the start label: ~w",[StartLabel]), ?GRAPH:add_vertex(CFGGraph, StartLabel, #block{type = top}), % Doing the others - ?option_time(MPs=create_cfggraph(Others,Cfg3,CFGGraph,[],[],[],XsiGraph),"RTL A-SSAPRE Xsi Insertion, creating intermediate 'SSAPRE Graph'",Options), + MPs = ?option_time(create_cfggraph(Others,Cfg3,CFGGraph,[],[],[],XsiGraph),"RTL A-SSAPRE Xsi Insertion, creating intermediate 'SSAPRE Graph'",Options), - %% Return the bloody collected information + %% Return the collected information {Cfg3,XsiGraph,CFGGraph,MPs}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -221,22 +221,21 @@ find_definition_for_computations_in_block(BlockLabel,[Inst|Rest],Cfg, ?pp_debug(" Inserting Xsi: ",[]),pp_xsi(Xsi), Label = Xsi#xsi.label, - case BlockLabel =:= Label of - false -> - %% Insert the Xsi in the appropriate block - Code = hipe_bb:code(?CFG:bb(Cfg,Label)), - {BeforeCode,AfterCode} = split_for_xsi(lists:reverse(Code),[]), - NewCode = BeforeCode++[XsiLink|AfterCode], - NewBB = hipe_bb:mk_bb(NewCode), - NewCfg = ?CFG:bb_add(Cfg,Label,NewBB), - NewVisited = [NewInst|VisitedInstructions]; - _-> - {BeforeCode,AfterCode} = split_for_xsi(VisitedInstructions,[]), - TempVisited = BeforeCode++[XsiLink|AfterCode], - TempVisited2 = lists:reverse(TempVisited), - NewVisited = [NewInst|TempVisited2], - NewCfg = Cfg - end, + {NewCfg, NewVisited} = + case BlockLabel =:= Label of + false -> + %% Insert the Xsi in the appropriate block + Code = hipe_bb:code(?CFG:bb(Cfg,Label)), + {BeforeCode,AfterCode} = split_for_xsi(lists:reverse(Code),[]), + NewCode = BeforeCode++[XsiLink|AfterCode], + NewBB = hipe_bb:mk_bb(NewCode), + {?CFG:bb_add(Cfg,Label,NewBB), [NewInst|VisitedInstructions]}; + _-> + {BeforeCode,AfterCode} = split_for_xsi(VisitedInstructions,[]), + TempVisited = BeforeCode++[XsiLink|AfterCode], + TempVisited2 = lists:reverse(TempVisited), + {Cfg, [NewInst|TempVisited2]} + end, find_definition_for_computations_in_block(BlockLabel, Rest, NewCfg, NewVisited, XsiGraph) end; @@ -787,14 +786,15 @@ create_cfggraph([Label|Ls],Cfg,CFGGraph,ToBeFactorizedAcc,MPAcc,LateEdges,XsiGra Defs = get_defs_in_non_merge_block(Code, []), ?pp_debug("~nAdding a vertex for ~w", [Label]), Succs = ?CFG:succ(Cfg, Label), - case Succs of - [] -> %% Exit point - ?GRAPH:add_vertex(CFGGraph, Label, #block{type = exit}), - NewToBeFactorizedAcc = ToBeFactorizedAcc; - _ -> %% Split point - ?GRAPH:add_vertex(CFGGraph,Label,#block{type=not_mp,attributes={P,Succs}}), - NewToBeFactorizedAcc = [Label|ToBeFactorizedAcc] - end, + NewToBeFactorizedAcc = + case Succs of + [] -> %% Exit point + ?GRAPH:add_vertex(CFGGraph, Label, #block{type = exit}), + ToBeFactorizedAcc; + _ -> %% Split point + ?GRAPH:add_vertex(CFGGraph,Label,#block{type=not_mp,attributes={P,Succs}}), + [Label|ToBeFactorizedAcc] + end, ?pp_debug("~nAdding an edge ~w -> ~w (~w)",[P,Label,Defs]), case ?GRAPH:add_edge(CFGGraph,P,Label,Defs) of {error,Reason} -> @@ -862,56 +862,53 @@ add_edges_for_mp([P|Ps], Label, LateEdges) -> %% Doesn't do anything so far add_map_and_uses([], _Key, Maps, Uses) -> - {Maps,Uses}; + {Maps, Uses}; add_map_and_uses([XsiOp|Ops], Key, Maps, Uses) -> - case XsiOp#xsi_op.op of - #bottom{} -> - Set = case gb_trees:lookup(XsiOp,Maps) of - {value, V} -> - ?SETS:add_element(Key,V); - none -> - ?SETS:from_list([Key]) - end, - NewMaps = gb_trees:enter(XsiOp,Set,Maps), - NewUses = Uses; - #temp{} -> - Set = case gb_trees:lookup(XsiOp,Maps) of - {value, V} -> - ?SETS:add_element(Key,V); - none -> - ?SETS:from_list([Key]) - end, - NewMaps = gb_trees:enter(XsiOp,Set,Maps), - Pred = XsiOp#xsi_op.pred, - OOP = XsiOp#xsi_op.op, - SSet = case gb_trees:lookup(Pred,Uses) of - {value, VV} -> - ?SETS:add_element(OOP#temp.key,VV); - none -> - ?SETS:from_list([OOP#temp.key]) - end, - NewUses = gb_trees:enter(Pred,SSet,Uses); - #eop{} -> - Set = case gb_trees:lookup(XsiOp,Maps) of - {value, V} -> - ?SETS:add_element(Key,V); - none -> - ?SETS:from_list([Key]) - end, - NewMaps = gb_trees:enter(XsiOp,Set,Maps), - Pred = XsiOp#xsi_op.pred, - Op = XsiOp#xsi_op.op, - SSet = case gb_trees:lookup(Pred,Uses) of - {value, VV} -> - ?SETS:add_element(Op#eop.stopped_by,VV); - none -> - ?SETS:from_list([Op#eop.stopped_by]) - end, - NewUses = gb_trees:enter(Pred,SSet,Uses); - _-> - NewMaps = Maps, - NewUses = Uses - end, + {NewMaps, NewUses} = + case XsiOp#xsi_op.op of + #bottom{} -> + Set = case gb_trees:lookup(XsiOp, Maps) of + {value, V} -> + ?SETS:add_element(Key, V); + none -> + ?SETS:from_list([Key]) + end, + {gb_trees:enter(XsiOp, Set, Maps), Uses}; + #temp{} -> + Set = case gb_trees:lookup(XsiOp, Maps) of + {value, V} -> + ?SETS:add_element(Key, V); + none -> + ?SETS:from_list([Key]) + end, + Pred = XsiOp#xsi_op.pred, + OOP = XsiOp#xsi_op.op, + SSet = case gb_trees:lookup(Pred, Uses) of + {value, VV} -> + ?SETS:add_element(OOP#temp.key, VV); + none -> + ?SETS:from_list([OOP#temp.key]) + end, + {gb_trees:enter(XsiOp, Set, Maps), gb_trees:enter(Pred, SSet, Uses)}; + #eop{} -> + Set = case gb_trees:lookup(XsiOp, Maps) of + {value, V} -> + ?SETS:add_element(Key, V); + none -> + ?SETS:from_list([Key]) + end, + Pred = XsiOp#xsi_op.pred, + Op = XsiOp#xsi_op.op, + SSet = case gb_trees:lookup(Pred, Uses) of + {value, VV} -> + ?SETS:add_element(Op#eop.stopped_by, VV); + none -> + ?SETS:from_list([Op#eop.stopped_by]) + end, + {gb_trees:enter(XsiOp, Set, Maps), gb_trees:enter(Pred, SSet, Uses)}; + _-> + {Maps, Uses} + end, add_map_and_uses(Ops, Key, NewMaps, NewUses). post_process([], _CFGGraph) -> ok; @@ -1162,37 +1159,38 @@ code_motion_in_block(L,[Inst|Insts],Cfg,XsiG,Visited,InsertionsAcc) -> #pre_candidate{} -> Def = Inst#pre_candidate.def, Alu = Inst#pre_candidate.alu, - case Def of - bottom -> - InstToAdd = Alu; - #temp{} -> - Key = Def#temp.key, - {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), - case Xsi#xsi.wba of - true -> - %% Turn into a move - Dst = ?RTL:alu_dst(Alu), - Move = ?RTL:mk_move(Dst,Def#temp.var), - pp_instr(Inst#pre_candidate.alu,nil), ?pp_debug(" ==> ",[]), pp_instr(Move,nil), - %% Counting redundancies - redundancy_add(), - InstToAdd = Move; - _ -> - InstToAdd = Alu - end; - _ -> %% Def is a real variable - %% Turn into a move - Dst = ?RTL:alu_dst(Alu), - Move = ?RTL:mk_move(Dst,Def), - pp_instr(Alu,nil), ?pp_debug(" ==> ",[]), pp_instr(Move,nil), - %% Counting redundancies - redundancy_add(), - InstToAdd = Move - end, + InstToAdd = + case Def of + bottom -> + Alu; + #temp{} -> + Key = Def#temp.key, + {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), + case Xsi#xsi.wba of + true -> + %% Turn into a move + Dst = ?RTL:alu_dst(Alu), + Move = ?RTL:mk_move(Dst,Def#temp.var), + pp_instr(Inst#pre_candidate.alu,nil), ?pp_debug(" ==> ",[]), pp_instr(Move,nil), + %% Counting redundancies + redundancy_add(), + Move; + _ -> + Alu + end; + _ -> %% Def is a real variable + %% Turn into a move + Dst = ?RTL:alu_dst(Alu), + Move = ?RTL:mk_move(Dst,Def), + pp_instr(Alu,nil), ?pp_debug(" ==> ",[]), pp_instr(Move,nil), + %% Counting redundancies + redundancy_add(), + Move + end, code_motion_in_block(L,Insts,Cfg,XsiG,[InstToAdd|Visited],InsertionsAcc); #xsi_link{} -> Key = Inst#xsi_link.num, - {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), + {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), case Xsi#xsi.wba of true -> %% Xsi is a WBA, it might trigger insertions @@ -1235,139 +1233,133 @@ get_insertions([],OpAcc,InsertionsAcc,_Visited,_Expr,_XsiG) -> get_insertions([XsiOp|Ops],OpAcc,InsertionsAcc,Visited,Expr,XsiG) -> Pred = XsiOp#xsi_op.pred, Op = XsiOp#xsi_op.op, - case Op of - #bottom{} -> - case gb_trees:lookup(Pred,InsertionsAcc) of - {value,Insertion} -> - From = Insertion#insertion.from, - case lists:keyfind(Op, 1, From) of - false -> - ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), - Dst = Op#bottom.var, - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - Code = Insertion#insertion.code, - NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]}, - NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc); - {_, Val} -> - ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), - Dst = Val, - NewInsertionsAcc = InsertionsAcc - end; - none -> - ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), - Dst = Op#bottom.var, - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]}, - NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc) - end; - #const_expr{} -> - case gb_trees:lookup(Pred,InsertionsAcc) of - {value,Insertion} -> - From = Insertion#insertion.from, - case lists:keyfind(Op, 1, From) of - false -> - ?pp_debug("~nThere have been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), - Dst = Op#const_expr.var, - Val = Op#const_expr.value, - Inst = ?RTL:mk_move(Dst,Val), - Code = Insertion#insertion.code, - NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]}, - NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc); - {_, Val} -> - ?pp_debug("~nThere have been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), - Dst = Val, - NewInsertionsAcc = InsertionsAcc - end; - none -> - ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), - Dst = Op#const_expr.var, - Val = Op#const_expr.value, - Inst = ?RTL:mk_move(Dst,Val), - NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]}, - NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc) - end; - #eop{} -> - %% We treat expressions like bottoms - %% The value must be recomputed, and therefore not available... - case gb_trees:lookup(Pred,InsertionsAcc) of - {value,Insertion} -> - From = Insertion#insertion.from, - case lists:keyfind(Op, 1, From) of - false -> - ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), - Dst = Op#eop.var, - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - Code = Insertion#insertion.code, - NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]}, - NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc); - {_, Val} -> - ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), - Dst = Val, - NewInsertionsAcc = InsertionsAcc - end; - none -> - ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), - Dst = Op#eop.var, - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]}, - NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc) - end; - #temp{} -> - case gb_trees:lookup(Pred,InsertionsAcc) of - {value,Insertion} -> - From = Insertion#insertion.from, - case lists:keyfind(Op, 1, From) of - false -> - ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), - Key = Op#temp.key, - {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), - case Xsi#xsi.wba of - true -> - ?pp_debug("~nBut the operand is a WBA Xsi: no need for insertion",[]), - Dst = Op#temp.var, - NewInsertionsAcc = InsertionsAcc; - _ -> - ?pp_debug("~nBut the operand is a NOT WBA Xsi: we must make an insertion",[]), - Dst = ?RTL:mk_new_var(), - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - Code = Insertion#insertion.code, - NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]}, - NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc) - end; - {_, Val} -> - ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too (Op=~w)",[Pred,Op]), - ?pp_debug("~nThis means, this temp is a WBA Xsi's definition",[]), - Dst = Val, - NewInsertionsAcc = InsertionsAcc - end; - none -> - ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course | Op=",[Pred]),pp_arg(Op), - Key = Op#temp.key, - {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), - case Xsi#xsi.wba of - true -> - ?pp_debug("~nBut the operand is a WBA Xsi: no need for insertion",[]), - Dst = Op#temp.var, - NewInsertionsAcc = InsertionsAcc; - _ -> - ?pp_debug("~nBut the operand is a NOT WBA Xsi: we must make an insertion",[]), - Dst = ?RTL:mk_new_var(), - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]}, - NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc) - end - end; - _ -> - ?pp_debug("~nThe operand (Op=",[]),pp_arg(Op),?pp_debug(") is a real variable, no need for insertion along L~w",[Pred]), - Dst = Op, - NewInsertionsAcc = InsertionsAcc - end, + {Dst, NewInsertionsAcc} = + case Op of + #bottom{} -> + case gb_trees:lookup(Pred,InsertionsAcc) of + {value,Insertion} -> + From = Insertion#insertion.from, + case lists:keyfind(Op, 1, From) of + false -> + ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), + D = Op#bottom.var, + Expr2 = ?RTL:alu_dst_update(Expr,D), + Inst = manufacture_computation(Pred,Expr2,Visited), + Code = Insertion#insertion.code, + NewInsertion = Insertion#insertion{from=[{Op,D}|From],code=[Inst|Code]}, + {D, gb_trees:update(Pred, NewInsertion, InsertionsAcc)}; + {_, Val} -> + ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), + {Val, InsertionsAcc} + end; + none -> + ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), + D = Op#bottom.var, + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + NewInsertion = #insertion{from=[{Op,D}],code=[Inst]}, + {D, gb_trees:insert(Pred,NewInsertion, InsertionsAcc)} + end; + #const_expr{} -> + case gb_trees:lookup(Pred,InsertionsAcc) of + {value,Insertion} -> + From = Insertion#insertion.from, + case lists:keyfind(Op, 1, From) of + false -> + ?pp_debug("~nThere have been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), + D = Op#const_expr.var, + Val = Op#const_expr.value, + Inst = ?RTL:mk_move(D, Val), + Code = Insertion#insertion.code, + NewInsertion = Insertion#insertion{from=[{Op,D}|From],code=[Inst|Code]}, + {D, gb_trees:update(Pred,NewInsertion,InsertionsAcc)}; + {_, Val} -> + ?pp_debug("~nThere have been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), + {Val, InsertionsAcc} + end; + none -> + ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), + D = Op#const_expr.var, + Val = Op#const_expr.value, + Inst = ?RTL:mk_move(D, Val), + NewInsertion = #insertion{from=[{Op,D}],code=[Inst]}, + {D, gb_trees:insert(Pred,NewInsertion, InsertionsAcc)} + end; + #eop{} -> + %% We treat expressions like bottoms + %% The value must be recomputed, and therefore not available... + case gb_trees:lookup(Pred,InsertionsAcc) of + {value,Insertion} -> + From = Insertion#insertion.from, + case lists:keyfind(Op, 1, From) of + false -> + ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), + D = Op#eop.var, + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + Code = Insertion#insertion.code, + NewInsertion = Insertion#insertion{from=[{Op,D}|From],code=[Inst|Code]}, + {D, gb_trees:update(Pred,NewInsertion, InsertionsAcc)}; + {_, Val} -> + ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), + {Val, InsertionsAcc} + end; + none -> + ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), + D = Op#eop.var, + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + NewInsertion = #insertion{from=[{Op,D}],code=[Inst]}, + {D, gb_trees:insert(Pred, NewInsertion, InsertionsAcc)} + end; + #temp{} -> + case gb_trees:lookup(Pred,InsertionsAcc) of + {value,Insertion} -> + From = Insertion#insertion.from, + case lists:keyfind(Op, 1, From) of + false -> + ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), + Key = Op#temp.key, + {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), + case Xsi#xsi.wba of + true -> + ?pp_debug("~nBut the operand is a WBA Xsi: no need for insertion",[]), + {Op#temp.var, InsertionsAcc}; + _ -> + ?pp_debug("~nBut the operand is a NOT WBA Xsi: we must make an insertion",[]), + D = ?RTL:mk_new_var(), + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + Code = Insertion#insertion.code, + NewInsertion = Insertion#insertion{from=[{Op,D}|From],code=[Inst|Code]}, + {D, gb_trees:update(Pred, NewInsertion, InsertionsAcc)} + end; + {_, Val} -> + ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too (Op=~w)",[Pred,Op]), + ?pp_debug("~nThis means, this temp is a WBA Xsi's definition",[]), + {Val, InsertionsAcc} + end; + none -> + ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course | Op=",[Pred]),pp_arg(Op), + Key = Op#temp.key, + {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), + case Xsi#xsi.wba of + true -> + ?pp_debug("~nBut the operand is a WBA Xsi: no need for insertion",[]), + {Op#temp.var, InsertionsAcc}; + _ -> + ?pp_debug("~nBut the operand is a NOT WBA Xsi: we must make an insertion",[]), + D = ?RTL:mk_new_var(), + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + NewInsertion = #insertion{from=[{Op,D}],code=[Inst]}, + {D, gb_trees:insert(Pred, NewInsertion, InsertionsAcc)} + end + end; + _ -> + ?pp_debug("~nThe operand (Op=",[]),pp_arg(Op),?pp_debug(") is a real variable, no need for insertion along L~w",[Pred]), + {Op, InsertionsAcc} + end, NewXsiOp = XsiOp#xsi_op{op=Dst}, get_insertions(Ops, [NewXsiOp|OpAcc], NewInsertionsAcc, Visited, Expr, XsiG). diff --git a/lib/hipe/sparc/Makefile b/lib/hipe/sparc/Makefile index 9fea887ebd..0e36a43d8e 100644 --- a/lib/hipe/sparc/Makefile +++ b/lib/hipe/sparc/Makefile @@ -76,7 +76,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/tools/Makefile b/lib/hipe/tools/Makefile index 4e3b93d464..7a62896c31 100644 --- a/lib/hipe/tools/Makefile +++ b/lib/hipe/tools/Makefile @@ -65,7 +65,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/util/Makefile b/lib/hipe/util/Makefile index 32135d60dd..66e9421c25 100644 --- a/lib/hipe/util/Makefile +++ b/lib/hipe/util/Makefile @@ -69,7 +69,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/x86/Makefile b/lib/hipe/x86/Makefile index e8a73bbc42..93f8b955dd 100644 --- a/lib/hipe/x86/Makefile +++ b/lib/hipe/x86/Makefile @@ -84,7 +84,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index 15e0ec02a9..1acd6803b2 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -116,6 +116,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-8.0", "stdlib-2.6", "sasl-2.6"]} + {runtime_dependencies, ["erts-8.0", "stdlib-3.0", "sasl-3.0"]} ] }. diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index cc7f2f6713..8be94f1e57 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -1023,7 +1023,7 @@ file_write_file_info_opts(Config) when is_list(Config) -> Time <- [ 0,1,-1,100,-100,1000,-1000,10000,-10000 ] ]), - %% REM: determine date range dependent on time_t = Uint32 | Sint32 | Sint64 + %% REM: determine date range dependent on time_t = Uint32 | Sint32 | Sint64 | Uint64 %% Determine time_t on os:type()? lists:foreach(fun ({FI, Opts}) -> ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, FI, Opts]) @@ -1072,9 +1072,10 @@ file_write_read_file_info_opts(Config) when is_list(Config) -> %ok = file_write_read_file_info_opts(Handle, Name, {{1930, 04, 28}, {19,30,22}}, [{time, local}]), %ok = file_write_read_file_info_opts(Handle, Name, {{1930, 04, 28}, {19,30,22}}, [{time, universal}]), ok = file_write_read_file_info_opts(Handle, Name, 1, [{time, posix}]), - ok = file_write_read_file_info_opts(Handle, Name, -1, [{time, posix}]), + %% will not work on platforms with unsigned time_t + %ok = file_write_read_file_info_opts(Handle, Name, -1, [{time, posix}]), + %ok = file_write_read_file_info_opts(Handle, Name, -300000, [{time, posix}]), ok = file_write_read_file_info_opts(Handle, Name, 300000, [{time, posix}]), - ok = file_write_read_file_info_opts(Handle, Name, -300000, [{time, posix}]), ok = file_write_read_file_info_opts(Handle, Name, 0, [{time, posix}]), ok = ?PRIM_FILE:stop(Handle), diff --git a/lib/sasl/src/sasl.app.src b/lib/sasl/src/sasl.app.src index 9c912fb8c3..4ee8a7d6c8 100644 --- a/lib/sasl/src/sasl.app.src +++ b/lib/sasl/src/sasl.app.src @@ -45,6 +45,6 @@ {env, [{sasl_error_logger, tty}, {errlog_type, all}]}, {mod, {sasl, []}}, - {runtime_dependencies, ["tools-2.6.14","stdlib-2.8","kernel-4.1", - "erts-6.0"]}]}. + {runtime_dependencies, ["tools-2.6.14","stdlib-3.0","kernel-5.0", + "erts-8.0"]}]}. diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index 3e35e24527..db71b16d80 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -73,10 +73,14 @@ reason_code(#alert{description = Description}, _) -> %% %% Description: Returns the error string for given alert. %%-------------------------------------------------------------------- - -alert_txt(#alert{level = Level, description = Description, where = {Mod,Line}}) -> +alert_txt(#alert{level = Level, description = Description, where = {Mod,Line}, reason = undefined}) -> Mod ++ ":" ++ integer_to_list(Line) ++ ":" ++ - level_txt(Level) ++" "++ description_txt(Description). + level_txt(Level) ++" "++ description_txt(Description); +alert_txt(#alert{reason = Reason} = Alert) -> + BaseTxt = alert_txt(Alert#alert{reason = undefined}), + FormatDepth = 9, % Some limit on printed representation of an error + ReasonTxt = lists:flatten(io_lib:format("~P", [Reason, FormatDepth])), + BaseTxt ++ " - " ++ ReasonTxt. %%-------------------------------------------------------------------- %%% Internal functions @@ -85,7 +89,7 @@ alert_txt(#alert{level = Level, description = Description, where = {Mod,Line}}) %% It is very unlikely that an correct implementation will send more than one alert at the time %% So it there is more than 10 warning alerts we consider it an error decode(<<?BYTE(Level), ?BYTE(_), _/binary>>, _, N) when Level == ?WARNING, N > ?MAX_ALERTS -> - ?ALERT_REC(?FATAL, ?DECODE_ERROR); + ?ALERT_REC(?FATAL, ?DECODE_ERROR, too_many_remote_alerts); decode(<<?BYTE(Level), ?BYTE(Description), Rest/binary>>, Acc, N) when Level == ?WARNING -> Alert = ?ALERT_REC(Level, Description), decode(Rest, [Alert | Acc], N + 1); @@ -93,7 +97,7 @@ decode(<<?BYTE(Level), ?BYTE(Description), _Rest/binary>>, Acc, _) when Level == Alert = ?ALERT_REC(Level, Description), lists:reverse([Alert | Acc]); %% No need to decode rest fatal alert will end the connection decode(<<?BYTE(_Level), _/binary>>, _, _) -> - ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER); + ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER, failed_to_decode_remote_alert); decode(<<>>, Acc, _) -> lists:reverse(Acc, []). diff --git a/lib/ssl/src/ssl_alert.hrl b/lib/ssl/src/ssl_alert.hrl index 8c4bd08d31..38facb964f 100644 --- a/lib/ssl/src/ssl_alert.hrl +++ b/lib/ssl/src/ssl_alert.hrl @@ -109,6 +109,7 @@ -define(NO_APPLICATION_PROTOCOL, 120). -define(ALERT_REC(Level,Desc), #alert{level=Level,description=Desc,where={?FILE, ?LINE}}). +-define(ALERT_REC(Level,Desc,Reason), #alert{level=Level,description=Desc,where={?FILE, ?LINE},reason=Reason}). -define(MAX_ALERTS, 10). @@ -116,6 +117,7 @@ -record(alert, { level, description, - where = {?FILE, ?LINE} + where = {?FILE, ?LINE}, + reason }). -endif. % -ifdef(ssl_alert). diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index dc0a0c2cc4..e935c033c7 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -214,7 +214,7 @@ decipher(?RC4, HashSz, CipherState = #cipher_state{state = State0}, Fragment, _, %% alerts may permit certain attacks against CBC mode as used in %% TLS [CBCATT]. It is preferable to uniformly use the %% bad_record_mac alert to hide the specific type of the error." - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, decryption_failed) end; decipher(?DES, HashSz, CipherState, Fragment, Version, PaddingCheck) -> @@ -272,7 +272,7 @@ block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, %% alerts may permit certain attacks against CBC mode as used in %% TLS [CBCATT]. It is preferable to uniformly use the %% bad_record_mac alert to hide the specific type of the error." - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, decryption_failed) end. aead_ciphertext_to_state(chacha20_poly1305, SeqNo, _IV, AAD0, Fragment, _Version) -> @@ -296,11 +296,11 @@ aead_decipher(Type, #cipher_state{key = Key, iv = IV} = CipherState, Content when is_binary(Content) -> {Content, CipherState}; _ -> - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, decryption_failed) end catch _:_ -> - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, decryption_failed) end. %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 089b3615c6..22d107ff9c 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -1488,7 +1488,7 @@ rsa_key_exchange(Version, PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) {premaster_secret, PremasterSecret, PublicKeyInfo}); rsa_key_exchange(_, _, _) -> - throw (?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE)). + throw (?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE, pub_key_is_not_rsa)). rsa_psk_key_exchange(Version, PskIdentity, PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) @@ -1505,7 +1505,7 @@ rsa_psk_key_exchange(Version, PskIdentity, PremasterSecret, {psk_premaster_secret, PskIdentity, PremasterSecret, PublicKeyInfo}); rsa_psk_key_exchange(_, _, _, _) -> - throw (?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE)). + throw (?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE, pub_key_is_not_rsa)). request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer, signature_algs = SupportedHashSigns}, diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 598d4e4112..0787e151c0 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -167,7 +167,7 @@ certificate(OwnCert, CertDbHandle, CertDbRef, server) -> {ok, _, Chain} -> #certificate{asn1_certificates = Chain}; {error, _} -> - ?ALERT_REC(?FATAL, ?INTERNAL_ERROR) + ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, server_has_no_suitable_certificates) end. %%-------------------------------------------------------------------- @@ -195,7 +195,7 @@ client_certificate_verify(OwnCert, MasterSecret, Version, PrivateKey, {Handshake, _}) -> case public_key:pkix_is_fixed_dh_cert(OwnCert) of true -> - ?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE); + ?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE, fixed_diffie_hellman_prohibited); false -> Hashes = calc_certificate_verify(Version, HashAlgo, MasterSecret, Handshake), @@ -353,7 +353,7 @@ verify_server_key(#server_key_params{params_bin = EncParams, %% Description: Checks that the certificate_verify message is valid. %%-------------------------------------------------------------------- certificate_verify(_, _, _, undefined, _, _) -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, invalid_certificate_verify_message); certificate_verify(Signature, PublicKeyInfo, Version, HashSign = {HashAlgo, _}, MasterSecret, {_, Handshake}) -> @@ -417,7 +417,7 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, catch error:_ -> %% ASN-1 decode of certificate somehow failed - ?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN) + ?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN, failed_to_decode_certificate) end. %%-------------------------------------------------------------------- @@ -605,7 +605,7 @@ select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, KeyExAlgo, false end, HashSigns) of [] -> - ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY); + ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm); [HashSign | _] -> HashSign end; @@ -664,11 +664,8 @@ master_secret(RecordCB, Version, #session{master_secret = Mastersecret}, try master_secret(RecordCB, Version, Mastersecret, SecParams, ConnectionStates, Role) catch - exit:Reason -> - Report = io_lib:format("Key calculation failed due to ~p", - [Reason]), - error_logger:error_report(Report), - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) + exit:_ -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, key_calculation_failure) end; master_secret(RecordCB, Version, PremasterSecret, ConnectionStates, Role) -> @@ -683,11 +680,8 @@ master_secret(RecordCB, Version, PremasterSecret, ConnectionStates, Role) -> ClientRandom, ServerRandom), SecParams, ConnectionStates, Role) catch - exit:Reason -> - Report = io_lib:format("Master secret calculation failed" - " due to ~p", [Reason]), - error_logger:error_report(Report), - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) + exit:_ -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, master_secret_calculation_failure) end. %%-------------Encode/Decode -------------------------------- @@ -958,8 +952,8 @@ decode_handshake(_Version, ?CLIENT_KEY_EXCHANGE, PKEPMS) -> #client_key_exchange{exchange_keys = PKEPMS}; decode_handshake(_Version, ?FINISHED, VerifyData) -> #finished{verify_data = VerifyData}; -decode_handshake(_, _, _) -> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). +decode_handshake(_, Message, _) -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {unknown_or_malformed_handshake, Message})). %%-------------------------------------------------------------------- -spec decode_hello_extensions({client, binary()} | binary()) -> #hello_extensions{}. @@ -1031,8 +1025,8 @@ dec_server_key(<<?UINT16(NLen), N:NLen/binary, params_bin = BinMsg, hashsign = HashSign, signature = Signature}; -dec_server_key(_, _, _) -> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). +dec_server_key(_, KeyExchange, _) -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {unknown_or_malformed_key_exchange, KeyExchange})). %%-------------------------------------------------------------------- -spec decode_suites('2_bytes'|'3_bytes', binary()) -> list(). @@ -1253,8 +1247,12 @@ handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression, Protocol -> {ConnectionStates, npn, Protocol} end; - _ -> %% {error, _Reason} or a list of 0/2+ protocols. - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) + {error, Reason} -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, Reason); + [] -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, no_protocols_in_server_hello); + [_|_] -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, too_many_protocols_in_server_hello) end. select_version(RecordCB, ClientVersion, Versions) -> @@ -1316,14 +1314,14 @@ handle_renegotiation_info(_RecordCB, client, #renegotiation_info{renegotiated_co true -> {ok, ConnectionStates}; false -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, client_renegotiation) end; handle_renegotiation_info(_RecordCB, server, #renegotiation_info{renegotiated_connection = ClientVerify}, ConnectionStates, true, _, CipherSuites) -> case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of true -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {server_renegotiation, empty_renegotiation_info_scsv}); false -> CS = ssl_record:current_connection_state(ConnectionStates, read), Data = CS#connection_state.client_verify_data, @@ -1331,7 +1329,7 @@ handle_renegotiation_info(_RecordCB, server, #renegotiation_info{renegotiated_co true -> {ok, ConnectionStates}; false -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, server_renegotiation) end end; @@ -1341,7 +1339,7 @@ handle_renegotiation_info(RecordCB, client, undefined, ConnectionStates, true, S handle_renegotiation_info(RecordCB, server, undefined, ConnectionStates, true, SecureRenegotation, CipherSuites) -> case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of true -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {server_renegotiation, empty_renegotiation_info_scsv}); false -> handle_renegotiation_info(RecordCB, ConnectionStates, SecureRenegotation) end. @@ -1350,7 +1348,7 @@ handle_renegotiation_info(_RecordCB, ConnectionStates, SecureRenegotation) -> CS = ssl_record:current_connection_state(ConnectionStates, read), case {SecureRenegotation, CS#connection_state.secure_renegotiation} of {_, true} -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, already_secure); {true, false} -> ?ALERT_REC(?FATAL, ?NO_RENEGOTIATION); {false, false} -> @@ -1523,8 +1521,8 @@ path_validation_alert({bad_cert, selfsigned_peer}) -> ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE); path_validation_alert({bad_cert, unknown_ca}) -> ?ALERT_REC(?FATAL, ?UNKNOWN_CA); -path_validation_alert(_) -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE). +path_validation_alert(Reason) -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, Reason). encrypted_premaster_secret(Secret, RSAPublicKey) -> try @@ -1533,18 +1531,27 @@ encrypted_premaster_secret(Secret, RSAPublicKey) -> rsa_pkcs1_padding}]), #encrypted_premaster_secret{premaster_secret = PreMasterSecret} catch - _:_-> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)) + _:_-> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, premaster_encryption_failed)) end. -digitally_signed({3, Minor}, Hash, HashAlgo, Key) when Minor >= 3 -> +digitally_signed(Version, Hashes, HashAlgo, PrivateKey) -> + try do_digitally_signed(Version, Hashes, HashAlgo, PrivateKey) of + Signature -> + Signature + catch + error:badkey-> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, bad_key(PrivateKey))) + end. + +do_digitally_signed({3, Minor}, Hash, HashAlgo, Key) when Minor >= 3 -> public_key:sign({digest, Hash}, HashAlgo, Key); -digitally_signed(_Version, Hash, HashAlgo, #'DSAPrivateKey'{} = Key) -> +do_digitally_signed(_Version, Hash, HashAlgo, #'DSAPrivateKey'{} = Key) -> public_key:sign({digest, Hash}, HashAlgo, Key); -digitally_signed(_Version, Hash, _HashAlgo, #'RSAPrivateKey'{} = Key) -> +do_digitally_signed(_Version, Hash, _HashAlgo, #'RSAPrivateKey'{} = Key) -> public_key:encrypt_private(Hash, Key, [{rsa_pad, rsa_pkcs1_padding}]); -digitally_signed(_Version, Hash, HashAlgo, Key) -> +do_digitally_signed(_Version, Hash, HashAlgo, Key) -> public_key:sign({digest, Hash}, HashAlgo, Key). calc_certificate_verify({3, 0}, HashAlgo, MasterSecret, Handshake) -> @@ -1751,12 +1758,12 @@ dec_client_key(PKEPMS, ?KEY_EXCHANGE_RSA, {3, 0}) -> dec_client_key(<<?UINT16(_), PKEPMS/binary>>, ?KEY_EXCHANGE_RSA, _) -> #encrypted_premaster_secret{premaster_secret = PKEPMS}; dec_client_key(<<>>, ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> - throw(?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE)); + throw(?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE, empty_dh_public)); dec_client_key(<<?UINT16(DH_YLen), DH_Y:DH_YLen/binary>>, ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> #client_diffie_hellman_public{dh_public = DH_Y}; dec_client_key(<<>>, ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, _) -> - throw(?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE)); + throw(?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE, empty_dh_public)); dec_client_key(<<?BYTE(DH_YLen), DH_Y:DH_YLen/binary>>, ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, _) -> #client_ec_diffie_hellman_public{dh_public = DH_Y}; @@ -1800,7 +1807,7 @@ dec_server_key_signature(Params, <<?UINT16(0)>>, _) -> dec_server_key_signature(Params, <<?UINT16(Len), Signature:Len/binary>>, _) -> {Params, undefined, Signature}; dec_server_key_signature(_, _, _) -> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, failed_to_decrypt_server_key_sign)). dec_hello_extensions(<<>>, Acc) -> Acc; @@ -1955,8 +1962,8 @@ key_exchange_alg(_) -> %%-------------Extension handling -------------------------------- %% Receive protocols, choose one from the list, return it. -handle_alpn_extension(_, {error, _Reason}) -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); +handle_alpn_extension(_, {error, Reason}) -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, Reason); handle_alpn_extension([], _) -> ?ALERT_REC(?FATAL, ?NO_APPLICATION_PROTOCOL); handle_alpn_extension([ServerProtocol|Tail], ClientProtocols) -> @@ -1976,7 +1983,7 @@ handle_next_protocol(#next_protocol_negotiation{} = NextProtocols, true -> select_next_protocol(decode_next_protocols(NextProtocols), NextProtocolSelector); false -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) % unexpected next protocol extension + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, unexpected_next_protocol_extension) end. @@ -1996,17 +2003,17 @@ handle_next_protocol_on_server(#next_protocol_negotiation{extension_data = <<>>} Protocols; handle_next_protocol_on_server(_Hello, _Renegotiation, _SSLOpts) -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE). % unexpected next protocol extension + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, unexpected_next_protocol_extension). next_protocol_extension_allowed(NextProtocolSelector, Renegotiating) -> NextProtocolSelector =/= undefined andalso not Renegotiating. -select_next_protocol({error, _Reason}, _NextProtocolSelector) -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); +select_next_protocol({error, Reason}, _NextProtocolSelector) -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, Reason); select_next_protocol(Protocols, NextProtocolSelector) -> case NextProtocolSelector(Protocols) of ?NO_PROTOCOL -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, no_next_protocol); Protocol when is_binary(Protocol) -> Protocol end. @@ -2169,3 +2176,9 @@ is_acceptable_hash_sign(_,_,_,_) -> is_acceptable_hash_sign(Algos, SupportedHashSigns) -> lists:member(Algos, SupportedHashSigns). +bad_key(#'DSAPrivateKey'{}) -> + unacceptable_dsa_key; +bad_key(#'RSAPrivateKey'{}) -> + unacceptable_rsa_key; +bad_key(#'ECPrivateKey'{}) -> + unacceptable_ecdsa_key. diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index f34eebb0e4..871eb970eb 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -167,7 +167,7 @@ handle_client_hello(Version, #client_hello{session_id = SugesstedId, SslOpts, Cache, CacheCb, Cert), case CipherSuite of no_suite -> - ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY); + ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_ciphers); _ -> {KeyExAlg,_,_,_} = ssl_cipher:suite_definition(CipherSuite), case ssl_handshake:select_hashsign(ClientHashSigns, Cert, KeyExAlg, SupportedHashSigns, Version) of diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index cd06b97ab2..686cdc569d 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -96,6 +96,8 @@ basic_tests() -> [app, appup, alerts, + alert_details, + alert_details_not_too_big, version_option, connect_twice, connect_dist, @@ -477,6 +479,33 @@ alerts(Config) when is_list(Config) -> end end, Alerts). %%-------------------------------------------------------------------- +alert_details() -> + [{doc, "Test that ssl_alert:alert_txt/1 result contains extendend error description"}]. +alert_details(Config) when is_list(Config) -> + Unique = make_ref(), + UniqueStr = lists:flatten(io_lib:format("~w", [Unique])), + Alert = ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY, Unique), + case string:str(ssl_alert:alert_txt(Alert), UniqueStr) of + 0 -> + ct:fail(error_details_missing); + _ -> + ok + end. + +%%-------------------------------------------------------------------- +alert_details_not_too_big() -> + [{doc, "Test that ssl_alert:alert_txt/1 limits printed depth of extended error description"}]. +alert_details_not_too_big(Config) when is_list(Config) -> + Reason = lists:duplicate(10, lists:duplicate(10, lists:duplicate(10, {some, data}))), + Alert = ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY, Reason), + case length(ssl_alert:alert_txt(Alert)) < 1000 of + true -> + ok; + false -> + ct:fail(ssl_alert_text_too_big) + end. + +%%-------------------------------------------------------------------- new_options_in_accept() -> [{doc,"Test that you can set ssl options in ssl_accept/3 and not only in tcp upgrade"}]. new_options_in_accept(Config) when is_list(Config) -> @@ -2611,7 +2640,7 @@ client_no_wrap_sequence_number(Config) when is_list(Config) -> {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - Version = ssl_test_lib:protocol_version(Config), + Version = ssl_test_lib:protocol_version(Config, tuple), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index 6a73acb704..042d57c0e2 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -167,7 +167,7 @@ end_per_group(_GroupName, Config) -> Config. init_per_testcase(_TestCase, Config) -> - ct:timetrap({seconds, 30}), + ct:timetrap({seconds, 90}), Config. diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl index 5e6137d2a6..b352844ba0 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -118,7 +118,7 @@ init_customized_session_cache(Type, Config) -> Config)), ets:new(ssl_test, [named_table, public, set]), ets:insert(ssl_test, {type, Type}), - ct:timetrap({seconds, 5}), + ct:timetrap({seconds, 20}), Config. end_per_testcase(session_cache_process_list, Config) -> diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 543728627e..27c670cdc2 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1315,11 +1315,22 @@ ssl_options(Option, Config) -> Opts ++ ProtocolOpts. protocol_version(Config) -> + protocol_version(Config, atom). + +protocol_version(Config, tuple) -> case proplists:get_value(protocol, Config) of dtls -> dtls_record:protocol_version(dtls_record:highest_protocol_version([])); _ -> - tls_record:protocol_version(tls_record:highest_protocol_version([])) + tls_record:highest_protocol_version(tls_record:supported_protocol_versions()) + end; + +protocol_version(Config, atom) -> + case proplists:get_value(protocol, Config) of + dtls -> + dtls_record:protocol_version(protocol_version(Config, tuple)); + _ -> + tls_record:protocol_version(protocol_version(Config, tuple)) end. protocol_options(Config, Options) -> diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 32bcdc4f2a..09176d2ca0 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -106,7 +106,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.3","crypto-3.3", + {runtime_dependencies, ["sasl-3.0","kernel-5.0","erts-8.0","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl index 55fdcdd054..c5cfea5e9e 100644 --- a/lib/stdlib/test/binary_module_SUITE.erl +++ b/lib/stdlib/test/binary_module_SUITE.erl @@ -19,9 +19,7 @@ %% -module(binary_module_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_testcase/2, end_per_testcase/2, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, interesting/1,scope_return/1,random_ref_comp/1,random_ref_sr_comp/1, random_ref_fla_comp/1,parts/1, bin_to_list/1, list_to_bin/1, copy/1, referenced/1,guard/1,encode_decode/1,badargs/1,longest_common_trap/1]). @@ -30,15 +28,9 @@ -include_lib("common_test/include/ct.hrl"). -init_per_testcase(_Case, Config) -> - Config. - -end_per_testcase(_Case, _Config) -> - ok. - suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{minutes,30}}]. + {timetrap,{minutes,10}}]. all() -> [scope_return,interesting, random_ref_fla_comp, random_ref_sr_comp, @@ -46,21 +38,6 @@ all() -> referenced, guard, encode_decode, badargs, longest_common_trap]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))). @@ -961,6 +938,7 @@ random_parts(X,N) -> %% Test pseudorandomly generated cases against reference implementation. random_ref_comp(Config) when is_list(Config) -> + ct:timetrap({minutes,30}), %% valgrind needs a lot of time put(success_counter,0), rand:seed(exsplus, {1271,769940,559934}), Nr = {1,40}, @@ -991,6 +969,7 @@ random_ref_comp(Config) when is_list(Config) -> %% Test pseudorandomly generated cases against reference implementation %% of split and replace. random_ref_sr_comp(Config) when is_list(Config) -> + ct:timetrap({minutes,30}), %% valgrind needs a lot put(success_counter,0), rand:seed(exsplus, {1271,769940,559934}), Nr = {1,40}, diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 15e3142408..8c1c625676 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -125,7 +125,7 @@ end_per_testcase(_Func, _Config) -> suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{minutes,20}}]. + {timetrap,{minutes,5}}]. all() -> [{group, new}, {group, insert}, {group, lookup}, @@ -698,7 +698,7 @@ chk_normal_tab_struct_size() -> io:format("?TAB_STRUCT_SZ=~p~n", [?TAB_STRUCT_SZ]), ok. -adjust_xmem([T1,T2,T3,T4], {A0,B0,C0,D0} = _Mem0) -> +adjust_xmem([_T1,_T2,_T3,_T4], {A0,B0,C0,D0} = _Mem0) -> %% Adjust for 64-bit, smp, and os: %% Table struct size may differ. @@ -2809,16 +2809,22 @@ privacy_do(Opts) -> privacy_check(pub,prot,priv), Owner ! {shift,1,{pub,prot,priv}}, - receive {Pub1,Prot1,Priv1} -> ok end, - privacy_check(Pub1,Prot1,Priv1), + receive + {Pub1,Prot1,Priv1} -> + ok = privacy_check(Pub1,Prot1,Priv1), + Owner ! {shift,2,{Pub1,Prot1,Priv1}} + end, - Owner ! {shift,2,{Pub1,Prot1,Priv1}}, - receive {Pub2,Prot2,Priv2} -> ok end, - privacy_check(Pub2,Prot2,Priv2), + receive + {Pub2,Prot2,Priv2} -> + ok = privacy_check(Pub2,Prot2,Priv2), + Owner ! {shift,0,{Pub2,Prot2,Priv2}} + end, - Owner ! {shift,0,{Pub2,Prot2,Priv2}}, - receive {Pub2,Prot2,Priv2} -> ok end, - privacy_check(Pub2,Prot2,Priv2), + receive + {Pub3,Prot3,Priv3} -> + ok = privacy_check(Pub3,Prot3,Priv3) + end, Owner ! die, receive {'EXIT',Owner,_} -> ok end, @@ -2836,7 +2842,8 @@ privacy_check(Pub,Prot,Priv) -> {'EXIT',{badarg,_}} = (catch ets:insert(Priv,{3,foo})), %% check that it really wasn't written, either - [] = ets:lookup(Prot,foo). + [] = ets:lookup(Prot,foo), + ok. privacy_owner(Boss, Opts) -> ets_new(pub, [public,named_table | Opts]), @@ -3197,7 +3204,6 @@ delete_large_named_table_1(Name, Flags, Data, Fix) -> true = ets:safe_fixtable(Tab, true), lists:foreach(fun({K,_}) -> ets:delete(Tab, K) end, Data) end, - Parent = self(), {Pid, MRef} = my_spawn_opt(fun() -> receive ets_new -> @@ -3297,6 +3303,7 @@ exit_large_table_owner_do(Opts,{FEData,Config}) -> verify_rescheduling_exit(Config, FEData, Opts, false, 1, 1). exit_many_large_table_owner(Config) when is_list(Config) -> + ct:timetrap({minutes,30}), %% valgrind needs a lot %%Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 500000)], FEData = fun(Do) -> repeat_while(fun(500000) -> {false,ok}; (I) -> Do({erlang:phash2(I, 16#ffffff),I}), @@ -4270,6 +4277,7 @@ do_lookup_element(Tab, N, M) -> heavy_concurrent(Config) when is_list(Config) -> + ct:timetrap({minutes,30}), %% valgrind needs a lot of time repeat_for_opts(do_heavy_concurrent). do_heavy_concurrent(Opts) -> diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index be6b470ca7..7d48cbc97c 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -19,10 +19,7 @@ %% -module(io_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). - --export([init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0]). -export([error_1/1, float_g/1, otp_5403/1, otp_5813/1, otp_6230/1, otp_6282/1, otp_6354/1, otp_6495/1, otp_6517/1, otp_6502/1, @@ -51,12 +48,6 @@ -define(privdir(Conf), proplists:get_value(priv_dir, Conf)). -endif. -init_per_testcase(_Case, Config) -> - Config. - -end_per_testcase(_Case, _Config) -> - ok. - suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,1}}]. @@ -72,22 +63,6 @@ all() -> io_lib_width_too_small, io_with_huge_message_queue, format_string, maps, coverage]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - %% Error cases for output. error_1(Config) when is_list(Config) -> %% We don't do erroneous output on stdout - the test server @@ -952,7 +927,7 @@ otp_6708(Config) when is_list(Config) -> otp_7084() -> - [{timetrap,{minutes,3}}]. + [{timetrap,{minutes,6}}]. %% valgrind needs a lot of time %% OTP-7084. Printing floating point numbers nicely. otp_7084(Config) when is_list(Config) -> @@ -1830,13 +1805,14 @@ bad_printable_range(Config) when is_list(Config) -> Cmd = lists:concat([lib:progname()," +pcunnnnnicode -run erlang halt"]), P = open_port({spawn, Cmd}, [stderr_to_stdout, {line, 200}]), ok = receive - {P, {data, {eol , "bad range of printable characters" ++ _}}} -> - ok; - Other -> - Other - after 1000 -> - timeout - end, + {P, {data, {eol , "bad range of printable characters" ++ _}}} -> + ok; + Other -> + Other + %% valgrind needs a lot of time + after 6000 -> + timeout + end, catch port_close(P), flush_from_port(P), ok. diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl index 4e39f011f6..1e286a9306 100644 --- a/lib/stdlib/test/io_proto_SUITE.erl +++ b/lib/stdlib/test/io_proto_SUITE.erl @@ -75,7 +75,7 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{minutes,20}}]. + {timetrap,{minutes,5}}]. all() -> [setopts_getopts, unicode_options, unicode_options_gen, @@ -462,6 +462,7 @@ unicode_options(Config) when is_list(Config) -> %% Tests various unicode options on random generated files. unicode_options_gen(Config) when is_list(Config) -> + ct:timetrap({minutes,30}), %% valgrind needs a alot of time random:seed(1240, 900586, 553728), PrivDir = proplists:get_value(priv_dir, Config), AllModes = [utf8,utf16,{utf16,big},{utf16,little}, diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index 1bcdc3ccd0..cb778c96d4 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -18,18 +18,13 @@ %% %CopyrightEnd% -module(rand_SUITE). --export([all/0, suite/0,groups/0, - init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2 - ]). +-export([all/0, suite/0,groups/0]). -export([interval_int/1, interval_float/1, seed/1, api_eq/1, reference/1, basic_stats_uniform_1/1, basic_stats_uniform_2/1, basic_stats_normal/1, - plugin/1, measure/1 - ]). + plugin/1, measure/1]). -export([test/0, gen/1]). @@ -37,12 +32,6 @@ -define(LOOP, 1000000). -init_per_testcase(_Case, Config) -> - Config. - -end_per_testcase(_Case, _Config) -> - ok. - suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,3}}]. @@ -52,19 +41,12 @@ all() -> api_eq, reference, {group, basic_stats}, - plugin, measure - ]. + plugin, measure]. groups() -> [{basic_stats, [parallel], [basic_stats_uniform_1, basic_stats_uniform_2, basic_stats_normal]}]. -init_per_suite(Config) -> Config. -end_per_suite(_Config) -> ok. - -init_per_group(_GroupName, Config) -> Config. -end_per_group(_GroupName, Config) -> Config. - %% A simple helper to test without test_server during dev test() -> Tests = all(), @@ -285,16 +267,19 @@ gen(_, _, Acc) -> lists:reverse(Acc). %% Check that the algorithms generate sound values. basic_stats_uniform_1(Config) when is_list(Config) -> + ct:timetrap({minutes,6}), %% valgrind needs a lot of time [basic_uniform_1(?LOOP, rand:seed_s(Alg), 0.0, array:new([{default, 0}])) || Alg <- algs()], ok. basic_stats_uniform_2(Config) when is_list(Config) -> + ct:timetrap({minutes,6}), %% valgrind needs a lot of time [basic_uniform_2(?LOOP, rand:seed_s(Alg), 0, array:new([{default, 0}])) || Alg <- algs()], ok. basic_stats_normal(Config) when is_list(Config) -> + ct:timetrap({minutes,6}), %% valgrind needs a lot of time io:format("Testing normal~n",[]), [basic_normal_1(?LOOP, rand:seed_s(Alg), 0, 0) || Alg <- algs()], ok. @@ -395,6 +380,7 @@ crypto_uniform_n(N, State0) -> %% Not a test but measures the time characteristics of the different algorithms measure(Suite) when is_atom(Suite) -> []; measure(_Config) -> + ct:timetrap({minutes,6}), %% valgrind needs a lot of time Algos = [crypto64|algs()], io:format("RNG uniform integer performance~n",[]), _ = measure_1(random, fun(State) -> {int, random:uniform_s(10000, State)} end), diff --git a/lib/stdlib/test/select_SUITE.erl b/lib/stdlib/test/select_SUITE.erl index e999d040c9..22b6d37e5d 100644 --- a/lib/stdlib/test/select_SUITE.erl +++ b/lib/stdlib/test/select_SUITE.erl @@ -59,42 +59,20 @@ config(priv_dir,_) -> ".". -else. %% When run in test server. --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2,select_test/1, - init_per_testcase/2, end_per_testcase/2, - return_values/1]). - -init_per_testcase(_Case, Config) -> - Config. - -end_per_testcase(_Case, _Config) -> - ok. +-export([all/0, suite/0, + select_test/1, return_values/1]). suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{minutes,20}}]. + {timetrap,{minutes,1}}]. all() -> [return_values, select_test]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - %% Test select in numerous ways. select_test(Config) when is_list(Config) -> + ct:timetrap({minutes,40}), %% valgrinds needs a lot of time do_test(Config). %% Test return values in specific situations for select/3 and select/1. diff --git a/lib/stdlib/test/unicode_SUITE.erl b/lib/stdlib/test/unicode_SUITE.erl index 81a591f433..07d63bdf22 100644 --- a/lib/stdlib/test/unicode_SUITE.erl +++ b/lib/stdlib/test/unicode_SUITE.erl @@ -21,10 +21,7 @@ -include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, +-export([all/0, suite/0,groups/0, utf8_illegal_sequences_bif/1, utf16_illegal_sequences_bif/1, random_lists/1, @@ -38,12 +35,6 @@ ex_binaries_errors_utf32_little/1, ex_binaries_errors_utf32_big/1]). -init_per_testcase(_Case, Config) -> - Config. - -end_per_testcase(_Case, _Config) -> - ok. - suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,20}}]. @@ -63,18 +54,6 @@ groups() -> ex_binaries_errors_utf32_little, ex_binaries_errors_utf32_big]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - binaries_errors_limit(Config) when is_list(Config) -> setlimit(10), ex_binaries_errors_utf8(Config), @@ -761,6 +740,7 @@ leading_lo_surrogate_bif(HiSurr, LoSurr, End) when LoSurr =< End -> leading_lo_surrogate_bif(_, _, _) -> ok. utf8_illegal_sequences_bif(Config) when is_list(Config) -> + ct:timetrap({minutes,40}), %% valgrind needs a lot setlimit(10), ex_utf8_illegal_sequences_bif(Config), setlimit(default), diff --git a/lib/wx/api_gen/wx_gen_cpp.erl b/lib/wx/api_gen/wx_gen_cpp.erl index 55c179142d..84d3990786 100644 --- a/lib/wx/api_gen/wx_gen_cpp.erl +++ b/lib/wx/api_gen/wx_gen_cpp.erl @@ -210,7 +210,7 @@ gen_funcs(Defs) -> w(" void *This = getPtr(bp,memenv);~n"), w(" wxeRefData *refd = getRefData(This);~n"), w(" if(This && refd) {~n"), - w(" if(recurse_level > 1 && refd->type != 4) {~n"), + w(" if(recurse_level > 1 && refd->type != 8) {~n"), w(" delayed_delete->Append(Ecmd.Save(op));~n"), w(" } else {~n"), w(" delete_object(This, refd);~n"), @@ -255,7 +255,21 @@ gen_funcs(Defs) -> ], w("bool WxeApp::delete_object(void *ptr, wxeRefData *refd) {~n", []), + w(" if(wxe_debug) {\n" + " wxString msg;\n" + " const wxChar *class_info = wxT(\"unknown\");\n" + " if(refd->type < 10) {\n" + " wxClassInfo *cinfo = ((wxObject *)ptr)->GetClassInfo();\n" + " class_info = cinfo->GetClassName();\n" + " }\n" + " msg.Printf(wxT(\"Deleting {wx_ref, %d, %s} at %p \"), refd->ref, class_info, ptr);\n" + " send_msg(\"debug\", &msg);\n" + " };\n"), + w(" switch(refd->type) {~n", []), + w("#if wxUSE_GRAPHICS_CONTEXT~n", []), + w(" case 4: delete (wxGraphicsObject *) ptr; break;~n", []), + w("#endif~n", []), Case = fun(C=#class{name=Class, id=Id, abstract=IsAbs, parent=P}) when P /= "static" -> UglyWorkaround = lists:member(Class, UglySkipList), HaveVirtual = virtual_dest(C), @@ -761,7 +775,7 @@ call_wx(_N,{constructor,_},#type{base={class,RClass}},Ps) -> end; false -> case is_dc(RClass) of - true -> 4; + true -> 8; false -> case hd(reverse(wx_gen_erl:parents(RClass))) of root -> Id; @@ -819,19 +833,19 @@ return_res1(#type{name=Type,base={class,_},single=list,ref=reference}) -> return_res1(#type{name=Type,base={comp,_,_},single=array,by_val=true}) -> {Type ++ " Result = ", ""}; return_res1(#type{name=Type,single=true,by_val=true, base={class, _}}) -> - %% Temporary memory leak !!!!!! - case {need_copy_constr(Type),Type} of - {true, _} -> ok; - {_, "wxGraphics" ++ _} -> ok; - _ -> - io:format("~s::~s Building return value of temp ~s~n", - [get(current_class),get(current_func),Type]) - end, - case need_copy_constr(Type) of - true -> + case {need_copy_constr(Type), Type} of + {true, _} -> {Type ++ " * Result = new E" ++ Type ++ "(", "); newPtr((void *) Result," ++ "3, memenv);"}; - false -> + {false, "wxGraphics" ++ _} -> + %% {"wxGraphicsObject * Result = new wxGraphicsObject(", "); newPtr((void *) Result," + %% ++ "3, memenv);"}; + {Type ++ " * Result = new " ++ Type ++ "(", "); newPtr((void *) Result," + ++ "4, memenv);"}; + {false, _} -> + %% Temporary memory leak !!!!!! + io:format("~s::~s Building return value of temp ~s~n", + [get(current_class),get(current_func),Type]), {Type ++ " * Result = new " ++ Type ++ "(", "); newPtr((void *) Result," ++ "3, memenv);"} end; diff --git a/lib/wx/api_gen/wx_gen_erl.erl b/lib/wx/api_gen/wx_gen_erl.erl index e15bb0b5ad..794de25002 100644 --- a/lib/wx/api_gen/wx_gen_erl.erl +++ b/lib/wx/api_gen/wx_gen_erl.erl @@ -482,7 +482,7 @@ arg_type_test(#param{name=Name0,in=In,type=#type{base={class,T},single=true},def arg_type_test(#param{name=Name0,in=In,type=#type{base={class,T}}, def=none},EOS,Acc) when In =/= false -> Name = erl_arg_name(Name0), - w(" [?CLASS(~sT,~s) || #wx_ref{type=~sT} <- ~s],~s", [Name,T,Name,Name,EOS]), + w(" _ = [?CLASS(~sT,~s) || #wx_ref{type=~sT} <- ~s],~s", [Name,T,Name,Name,EOS]), Acc; arg_type_test(#param{name=Name0,def=none,in=In, type={merged, diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp index 942baf7c7f..4243d8a35a 100644 --- a/lib/wx/c_src/gen/wxe_funcs.cpp +++ b/lib/wx/c_src/gen/wxe_funcs.cpp @@ -51,7 +51,7 @@ void WxeApp::wxe_dispatch(wxeCommand& Ecmd) void *This = getPtr(bp,memenv); wxeRefData *refd = getRefData(This); if(This && refd) { - if(recurse_level > 1 && refd->type != 4) { + if(recurse_level > 1 && refd->type != 8) { delayed_delete->Append(Ecmd.Save(op)); } else { delete_object(This, refd); @@ -5889,27 +5889,27 @@ case wxMirrorDC_new: { // wxMirrorDC::wxMirrorDC wxDC *dc = (wxDC *) getPtr(bp,memenv); bp += 4; bool * mirror = (bool *) bp; bp += 4; wxMirrorDC * Result = new EwxMirrorDC(*dc,*mirror); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxMirrorDC"); break; } case wxScreenDC_new: { // wxScreenDC::wxScreenDC wxScreenDC * Result = new EwxScreenDC(); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxScreenDC"); break; } #if wxUSE_POSTSCRIPT case wxPostScriptDC_new_0: { // wxPostScriptDC::wxPostScriptDC wxPostScriptDC * Result = new EwxPostScriptDC(); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxPostScriptDC"); break; } case wxPostScriptDC_new_1: { // wxPostScriptDC::wxPostScriptDC wxPrintData *printData = (wxPrintData *) getPtr(bp,memenv); bp += 4; wxPostScriptDC * Result = new EwxPostScriptDC(*printData); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxPostScriptDC"); break; } @@ -5931,7 +5931,7 @@ case wxPostScriptDC_GetResolution: { // wxPostScriptDC::GetResolution #if !wxCHECK_VERSION(2,9,0) case wxWindowDC_new_0: { // wxWindowDC::wxWindowDC wxWindowDC * Result = new EwxWindowDC(); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxWindowDC"); break; } @@ -5939,14 +5939,14 @@ case wxWindowDC_new_0: { // wxWindowDC::wxWindowDC case wxWindowDC_new_1: { // wxWindowDC::wxWindowDC wxWindow *win = (wxWindow *) getPtr(bp,memenv); bp += 4; wxWindowDC * Result = new EwxWindowDC(win); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxWindowDC"); break; } #if !wxCHECK_VERSION(2,9,0) case wxClientDC_new_0: { // wxClientDC::wxClientDC wxClientDC * Result = new EwxClientDC(); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxClientDC"); break; } @@ -5954,14 +5954,14 @@ case wxClientDC_new_0: { // wxClientDC::wxClientDC case wxClientDC_new_1: { // wxClientDC::wxClientDC wxWindow *win = (wxWindow *) getPtr(bp,memenv); bp += 4; wxClientDC * Result = new EwxClientDC(win); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxClientDC"); break; } #if !wxCHECK_VERSION(2,9,0) case wxPaintDC_new_0: { // wxPaintDC::wxPaintDC wxPaintDC * Result = new EwxPaintDC(); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxPaintDC"); break; } @@ -5969,27 +5969,27 @@ case wxPaintDC_new_0: { // wxPaintDC::wxPaintDC case wxPaintDC_new_1: { // wxPaintDC::wxPaintDC wxWindow *win = (wxWindow *) getPtr(bp,memenv); bp += 4; wxPaintDC * Result = new EwxPaintDC(win); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxPaintDC"); break; } case wxMemoryDC_new_1_0: { // wxMemoryDC::wxMemoryDC wxBitmap *bitmap = (wxBitmap *) getPtr(bp,memenv); bp += 4; wxMemoryDC * Result = new EwxMemoryDC(*bitmap); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxMemoryDC"); break; } case wxMemoryDC_new_1_1: { // wxMemoryDC::wxMemoryDC wxDC * dc = (wxDC *) getPtr(bp,memenv); bp += 4; wxMemoryDC * Result = new EwxMemoryDC(dc); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxMemoryDC"); break; } case wxMemoryDC_new_0: { // wxMemoryDC::wxMemoryDC wxMemoryDC * Result = new EwxMemoryDC(); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxMemoryDC"); break; } @@ -6009,7 +6009,7 @@ case wxMemoryDC_SelectObjectAsSource: { // wxMemoryDC::SelectObjectAsSource } case wxBufferedDC_new_0: { // wxBufferedDC::wxBufferedDC wxBufferedDC * Result = new EwxBufferedDC(); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxBufferedDC"); break; } @@ -6027,7 +6027,7 @@ buffer = (wxBitmap *) getPtr(bp,memenv); bp += 4; } break; }}; wxBufferedDC * Result = new EwxBufferedDC(dc,*buffer,style); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxBufferedDC"); break; } @@ -6044,7 +6044,7 @@ case wxBufferedDC_new_3: { // wxBufferedDC::wxBufferedDC } break; }}; wxBufferedDC * Result = new EwxBufferedDC(dc,area,style); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxBufferedDC"); break; } @@ -6091,7 +6091,7 @@ case wxBufferedPaintDC_new_3: { // wxBufferedPaintDC::wxBufferedPaintDC } break; }}; wxBufferedPaintDC * Result = new EwxBufferedPaintDC(window,*buffer,style); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxBufferedPaintDC"); break; } @@ -6105,7 +6105,7 @@ case wxBufferedPaintDC_new_2: { // wxBufferedPaintDC::wxBufferedPaintDC } break; }}; wxBufferedPaintDC * Result = new EwxBufferedPaintDC(window,style); - newPtr((void *) Result, 4, memenv); + newPtr((void *) Result, 8, memenv); rt.addRef(getRef((void *)Result,memenv), "wxBufferedPaintDC"); break; } @@ -6147,7 +6147,7 @@ case wxGraphicsContext_CreatePen: { // wxGraphicsContext::CreatePen wxGraphicsContext *This = (wxGraphicsContext *) getPtr(bp,memenv); bp += 4; wxPen *pen = (wxPen *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); - wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(*pen)); newPtr((void *) Result,3, memenv);; + wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(*pen)); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPen"); break; } @@ -6155,7 +6155,7 @@ case wxGraphicsContext_CreateBrush: { // wxGraphicsContext::CreateBrush wxGraphicsContext *This = (wxGraphicsContext *) getPtr(bp,memenv); bp += 4; wxBrush *brush = (wxBrush *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); - wxGraphicsBrush * Result = new wxGraphicsBrush(This->CreateBrush(*brush)); newPtr((void *) Result,3, memenv);; + wxGraphicsBrush * Result = new wxGraphicsBrush(This->CreateBrush(*brush)); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsBrush"); break; } @@ -6179,7 +6179,7 @@ case wxGraphicsContext_CreateRadialGradientBrush: { // wxGraphicsContext::Create int * cColorA = (int *) bp; bp += 4; wxColour cColor = wxColour(*cColorR,*cColorG,*cColorB,*cColorA); if(!This) throw wxe_badarg(0); - wxGraphicsBrush * Result = new wxGraphicsBrush(This->CreateRadialGradientBrush(*xo,*yo,*xc,*yc,*radius,oColor,cColor)); newPtr((void *) Result,3, memenv);; + wxGraphicsBrush * Result = new wxGraphicsBrush(This->CreateRadialGradientBrush(*xo,*yo,*xc,*yc,*radius,oColor,cColor)); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsBrush"); break; } @@ -6203,7 +6203,7 @@ case wxGraphicsContext_CreateLinearGradientBrush: { // wxGraphicsContext::Create int * c2A = (int *) bp; bp += 4; wxColour c2 = wxColour(*c2R,*c2G,*c2B,*c2A); if(!This) throw wxe_badarg(0); - wxGraphicsBrush * Result = new wxGraphicsBrush(This->CreateLinearGradientBrush(*x1,*y1,*x2,*y2,c1,c2)); newPtr((void *) Result,3, memenv);; + wxGraphicsBrush * Result = new wxGraphicsBrush(This->CreateLinearGradientBrush(*x1,*y1,*x2,*y2,c1,c2)); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsBrush"); break; } @@ -6223,7 +6223,7 @@ case wxGraphicsContext_CreateFont: { // wxGraphicsContext::CreateFont } break; }}; if(!This) throw wxe_badarg(0); - wxGraphicsFont * Result = new wxGraphicsFont(This->CreateFont(*font,col)); newPtr((void *) Result,3, memenv);; + wxGraphicsFont * Result = new wxGraphicsFont(This->CreateFont(*font,col)); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsFont"); break; } @@ -6263,14 +6263,14 @@ case wxGraphicsContext_CreateMatrix: { // wxGraphicsContext::CreateMatrix } break; }}; if(!This) throw wxe_badarg(0); - wxGraphicsMatrix * Result = new wxGraphicsMatrix(This->CreateMatrix(a,b,c,d,tx,ty)); newPtr((void *) Result,3, memenv);; + wxGraphicsMatrix * Result = new wxGraphicsMatrix(This->CreateMatrix(a,b,c,d,tx,ty)); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsMatrix"); break; } case wxGraphicsContext_CreatePath: { // wxGraphicsContext::CreatePath wxGraphicsContext *This = (wxGraphicsContext *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); - wxGraphicsPath * Result = new wxGraphicsPath(This->CreatePath()); newPtr((void *) Result,3, memenv);; + wxGraphicsPath * Result = new wxGraphicsPath(This->CreatePath()); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPath"); break; } @@ -6514,7 +6514,7 @@ case wxGraphicsContext_Translate: { // wxGraphicsContext::Translate case wxGraphicsContext_GetTransform: { // wxGraphicsContext::GetTransform wxGraphicsContext *This = (wxGraphicsContext *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); - wxGraphicsMatrix * Result = new wxGraphicsMatrix(This->GetTransform()); newPtr((void *) Result,3, memenv);; + wxGraphicsMatrix * Result = new wxGraphicsMatrix(This->GetTransform()); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsMatrix"); break; } @@ -7000,7 +7000,7 @@ case wxGraphicsRenderer_CreatePen: { // wxGraphicsRenderer::CreatePen wxGraphicsRenderer *This = (wxGraphicsRenderer *) getPtr(bp,memenv); bp += 4; wxPen *pen = (wxPen *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); - wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(*pen)); newPtr((void *) Result,3, memenv);; + wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(*pen)); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPen"); break; } @@ -7008,7 +7008,7 @@ case wxGraphicsRenderer_CreateBrush: { // wxGraphicsRenderer::CreateBrush wxGraphicsRenderer *This = (wxGraphicsRenderer *) getPtr(bp,memenv); bp += 4; wxBrush *brush = (wxBrush *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); - wxGraphicsBrush * Result = new wxGraphicsBrush(This->CreateBrush(*brush)); newPtr((void *) Result,3, memenv);; + wxGraphicsBrush * Result = new wxGraphicsBrush(This->CreateBrush(*brush)); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsBrush"); break; } @@ -7031,7 +7031,7 @@ case wxGraphicsRenderer_CreateLinearGradientBrush: { // wxGraphicsRenderer::Crea int * c2A = (int *) bp; bp += 4; wxColour c2 = wxColour(*c2R,*c2G,*c2B,*c2A); if(!This) throw wxe_badarg(0); - wxGraphicsBrush * Result = new wxGraphicsBrush(This->CreateLinearGradientBrush(*x1,*y1,*x2,*y2,c1,c2)); newPtr((void *) Result,3, memenv);; + wxGraphicsBrush * Result = new wxGraphicsBrush(This->CreateLinearGradientBrush(*x1,*y1,*x2,*y2,c1,c2)); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsBrush"); break; } @@ -7056,7 +7056,7 @@ case wxGraphicsRenderer_CreateRadialGradientBrush: { // wxGraphicsRenderer::Crea int * cColorA = (int *) bp; bp += 4; wxColour cColor = wxColour(*cColorR,*cColorG,*cColorB,*cColorA); if(!This) throw wxe_badarg(0); - wxGraphicsBrush * Result = new wxGraphicsBrush(This->CreateRadialGradientBrush(*xo,*yo,*xc,*yc,*radius,oColor,cColor)); newPtr((void *) Result,3, memenv);; + wxGraphicsBrush * Result = new wxGraphicsBrush(This->CreateRadialGradientBrush(*xo,*yo,*xc,*yc,*radius,oColor,cColor)); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsBrush"); break; } @@ -7076,7 +7076,7 @@ case wxGraphicsRenderer_CreateFont: { // wxGraphicsRenderer::CreateFont } break; }}; if(!This) throw wxe_badarg(0); - wxGraphicsFont * Result = new wxGraphicsFont(This->CreateFont(*font,col)); newPtr((void *) Result,3, memenv);; + wxGraphicsFont * Result = new wxGraphicsFont(This->CreateFont(*font,col)); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsFont"); break; } @@ -7116,14 +7116,14 @@ case wxGraphicsRenderer_CreateMatrix: { // wxGraphicsRenderer::CreateMatrix } break; }}; if(!This) throw wxe_badarg(0); - wxGraphicsMatrix * Result = new wxGraphicsMatrix(This->CreateMatrix(a,b,c,d,tx,ty)); newPtr((void *) Result,3, memenv);; + wxGraphicsMatrix * Result = new wxGraphicsMatrix(This->CreateMatrix(a,b,c,d,tx,ty)); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsMatrix"); break; } case wxGraphicsRenderer_CreatePath: { // wxGraphicsRenderer::CreatePath wxGraphicsRenderer *This = (wxGraphicsRenderer *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); - wxGraphicsPath * Result = new wxGraphicsPath(This->CreatePath()); newPtr((void *) Result,3, memenv);; + wxGraphicsPath * Result = new wxGraphicsPath(This->CreatePath()); newPtr((void *) Result,4, memenv);; rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPath"); break; } @@ -32071,7 +32071,20 @@ case wxDCOverlay_Clear: { // wxDCOverlay::Clear bool WxeApp::delete_object(void *ptr, wxeRefData *refd) { + if(wxe_debug) { + wxString msg; + const wxChar *class_info = wxT("unknown"); + if(refd->type < 10) { + wxClassInfo *cinfo = ((wxObject *)ptr)->GetClassInfo(); + class_info = cinfo->GetClassName(); + } + msg.Printf(wxT("Deleting {wx_ref, %d, %s} at %p "), refd->ref, class_info, ptr); + send_msg("debug", &msg); + }; switch(refd->type) { +#if wxUSE_GRAPHICS_CONTEXT + case 4: delete (wxGraphicsObject *) ptr; break; +#endif case 24: delete (wxGridCellBoolRenderer *) ptr; break; case 25: delete (wxGridCellBoolEditor *) ptr; break; case 26: delete (wxGridCellFloatRenderer *) ptr; break; diff --git a/lib/wx/c_src/wxe_impl.cpp b/lib/wx/c_src/wxe_impl.cpp index 175bcfce54..0d2da5d4a7 100644 --- a/lib/wx/c_src/wxe_impl.cpp +++ b/lib/wx/c_src/wxe_impl.cpp @@ -490,7 +490,7 @@ void WxeApp::destroyMemEnv(wxeMetaCommand& Ecmd) if(it != ptr2ref.end()) { wxeRefData *refd = it->second; if(refd->alloc_in_erl) { - if((refd->type == 4) && ((wxObject *)ptr)->IsKindOf(CLASSINFO(wxBufferedDC))) { + if((refd->type == 8) && ((wxObject *)ptr)->IsKindOf(CLASSINFO(wxBufferedDC))) { ((wxBufferedDC *)ptr)->m_dc = NULL; // Workaround } wxString msg; @@ -500,7 +500,7 @@ void WxeApp::destroyMemEnv(wxeMetaCommand& Ecmd) msg.Printf(wxT("Memory leak: {wx_ref, %d, %s}"), refd->ref, cinfo->GetClassName()); send_msg("error", &msg); - } else { + } else if(refd->type != 4) { cleanup_ref = delete_object(ptr, refd); } if(cleanup_ref) { @@ -562,7 +562,12 @@ int WxeApp::newPtr(void * ptr, int type, wxeMemEnv *memenv) { if(wxe_debug) { wxString msg; - msg.Printf(wxT("Creating {wx_ref, %d, unknown} at %p "), ref, ptr); + const wxChar *class_info = wxT("unknown"); + if(type < 10) { + wxClassInfo *cinfo = ((wxObject *)ptr)->GetClassInfo(); + class_info = cinfo->GetClassName(); + } + msg.Printf(wxT("Creating {wx_ref, %d, %s} at %p "), ref, class_info, ptr); send_msg("debug", &msg); } @@ -614,12 +619,6 @@ void WxeApp::clearPtr(void * ptr) { refd->memenv->ref2ptr[ref] = NULL; free.Append(ref); - if(wxe_debug) { - wxString msg; - msg.Printf(wxT("Deleting {wx_ref, %d, unknown} at %p "), ref, ptr); - send_msg("debug", &msg); - } - if(((int) refd->pid) != -1) { // Send terminate pid to owner wxeReturn rt = wxeReturn(WXE_DRV_PORT,refd->pid, false); diff --git a/lib/wx/c_src/wxe_memory.h b/lib/wx/c_src/wxe_memory.h index 455e9696d3..66c83e40c3 100644 --- a/lib/wx/c_src/wxe_memory.h +++ b/lib/wx/c_src/wxe_memory.h @@ -48,8 +48,9 @@ class wxeRefData { int type; // 0 = wxWindow subclasses, 1 = wxObject subclasses // 2 = wxDialog subclasses, 3 = allocated wxObjects but not returned from new - // 4 = wxObjects that should always be deleted directly (wxDC derivates) - // > 4 classes which lack virtual destr, or are supposed to be allocated on + // 4 = wxGraphicsObjects or it's subclasses that can no be overloaded + // 8 = wxObjects that should always be deleted directly (wxDC derivates) + // > 10 classes which lack virtual destr, or are supposed to be allocated on // the stack bool alloc_in_erl; wxeMemEnv *memenv; diff --git a/lib/wx/examples/demo/ex_graphicsContext.erl b/lib/wx/examples/demo/ex_graphicsContext.erl index d883ddfc5c..1193578037 100644 --- a/lib/wx/examples/demo/ex_graphicsContext.erl +++ b/lib/wx/examples/demo/ex_graphicsContext.erl @@ -135,6 +135,8 @@ draw(Win, Pen, Brush, Font) -> wxGraphicsContext:drawPath(Canvas, Path) end, wx:foreach(F, lists:seq(1,10)), + wxGraphicsObject:destroy(Path), + wxGraphicsObject:destroy(Canvas), ok catch _:{not_supported, _} -> Err = "wxGraphicsContext not available in this build of wxwidgets", diff --git a/lib/wx/src/gen/wxAcceleratorTable.erl b/lib/wx/src/gen/wxAcceleratorTable.erl index 5c83ffced9..4efcaaa7d0 100644 --- a/lib/wx/src/gen/wxAcceleratorTable.erl +++ b/lib/wx/src/gen/wxAcceleratorTable.erl @@ -46,7 +46,7 @@ new() -> N::integer(), Entries::[wxAcceleratorEntry:wxAcceleratorEntry()]. new(N,Entries) when is_integer(N),is_list(Entries) -> - [?CLASS(EntriesT,wxAcceleratorEntry) || #wx_ref{type=EntriesT} <- Entries], + _ = [?CLASS(EntriesT,wxAcceleratorEntry) || #wx_ref{type=EntriesT} <- Entries], wxe_util:construct(?wxAcceleratorTable_new_2, <<N:32/?UI,(length(Entries)):32/?UI, (<< <<(C#wx_ref.ref):32/?UI>> || C <- Entries>>)/binary, 0:(((0+length(Entries)) rem 2)*32)>>). |