diff --git a/ChangeLog b/ChangeLog index c3d503c9f004e..739a3ac80223e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2017-10-16 Igor Tsimbalist + + * MAINTAINERS (write after approval): Add myself. + 2017-10-01 Gerald Pfeifer * MAINTAINERS: Add a note that maintainership also includes web diff --git a/MAINTAINERS b/MAINTAINERS index 0d33f0b14acc1..9c3a56ea09410 100644 --- a/MAINTAINERS +++ b/MAINTAINERS @@ -603,6 +603,7 @@ Ilya Tocar Philipp Tomsich Konrad Trifunovic Markus Trippelsdorf +Igor Tsimbalist Martin Uecker David Ung Neil Vachharajani diff --git a/fixincludes/ChangeLog b/fixincludes/ChangeLog index ffd171843e15c..1f29148e8e3ab 100644 --- a/fixincludes/ChangeLog +++ b/fixincludes/ChangeLog @@ -1,3 +1,8 @@ +2017-10-13 Mike Frysinger + + * fixinc.in (dirname): Change sed from 's|[^/]*/||' to + 's|[^/]*//*||'. + 2017-06-12 Doug Rupp * inclhack.def (AAB_vxworks_stdint): Remove hack. diff --git a/fixincludes/fixinc.in b/fixincludes/fixinc.in index 15cbaa235445f..cd0b458b8f8b4 100755 --- a/fixincludes/fixinc.in +++ b/fixincludes/fixinc.in @@ -344,7 +344,7 @@ if $LINKS; then mkdir $component >/dev/null 2>&1 cd $component dirmade=$dirmade/$component - dirname=`echo $dirname | sed -e 's|[^/]*/||'` + dirname=`echo $dirname | sed -e 's|[^/]*//*||'` done fi diff --git a/gcc/ChangeLog b/gcc/ChangeLog index b56f7e637e08f..1274635d19d96 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,2039 @@ +2017-10-20 Jakub Jelinek + + * config/i386/i386.md (isa): Remove fma_avx512f. + * config/i386/sse.md (_fmadd__mask, + _fmadd__mask3, + _fmsub__mask, + _fmsub__mask3, + _fnmadd__mask, + _fnmadd__mask3, + _fnmsub__mask, + _fnmsub__mask3, + _fmaddsub__mask, + _fmaddsub__mask3, + _fmsubadd__mask, + _fmsubadd__mask3): Remove isa attribute. + (*vec_widen_umult_even_v16si, + *vec_widen_smult_even_v16si): Likewise. + (avx512bw_dbpsadbw): Likewise. + +2017-10-20 Igor Tsimbalist + + * extend.texi: Add 'nocf_check' documentation. + * gimple.texi: Add second parameter to + gimple_build_call_from_tree. + * invoke.texi: Add -fcf-protection documentation. + * rtl.texi: Add REG_CALL_NOTRACK documenation. + +2017-10-20 Richard Biener + + PR tree-optimization/82473 + * tree-vect-loop.c (vectorizable_reduction): Properly get at + the largest input type. + +2017-10-20 Igor Tsimbalist + + * c-attribs.c (handle_nocf_check_attribute): New function. + (c_common_attribute_table): Add 'nocf_check' handling. + * gimple-parser.c: Add second argument NULL to + gimple_build_call_from_tree. + * attrib.c (comp_type_attributes): Check nocf_check attribute. + * cfgexpand.c (expand_call_stmt): Set REG_CALL_NOCF_CHECK for + call insn. + * combine.c (distribute_notes): Add REG_CALL_NOCF_CHECK handling. + * common.opt: Add fcf-protection flag. + * emit-rtl.c (try_split): Add REG_CALL_NOCF_CHECK handling. + * flag-types.h: Add enum cf_protection_level. + * gimple.c (gimple_build_call_from_tree): Add second parameter. + Add 'nocf_check' attribute propagation to gimple call. + * gimple.h (gf_mask): Add GF_CALL_NOCF_CHECK. + (gimple_build_call_from_tree): Update prototype. + (gimple_call_nocf_check_p): New function. + (gimple_call_set_nocf_check): Likewise. + * gimplify.c: Add second argument to gimple_build_call_from_tree. + * ipa-icf.c: Add nocf_check attribute in statement hash. + * recog.c (peep2_attempt): Add REG_CALL_NOCF_CHECK handling. + * reg-notes.def: Add REG_NOTE (CALL_NOCF_CHECK). + * toplev.c (process_options): Add flag_cf_protection handling. + +2017-10-19 Jan Hubicka + + * x86-tune-costs.h (core_cost): Fix div, move and sqrt latencies. + +2017-10-20 Richard Biener + + PR tree-optimization/82603 + * tree-if-conv.c (predicate_mem_writes): Make sure to only + remove false predicated stores. + +2017-10-20 Richard Biener + + * graphite-isl-ast-to-gimple.c + (translate_isl_ast_to_gimple::graphite_copy_stmts_from_block): + Remove return value and simplify, dump copied stmt after lhs + adjustment. + (translate_isl_ast_to_gimple::translate_isl_ast_node_user): + Reduce dump verbosity. + (gsi_insert_earliest): Likewise. + (translate_isl_ast_to_gimple::copy_bb_and_scalar_dependences): Adjust. + * graphite.c (print_global_statistics): Adjust dumping. + (print_graphite_scop_statistics): Likewise. + (print_graphite_statistics): Do not dump loops here. + (graphite_transform_loops): But here. + +2017-10-20 Nicolas Roche + + * configure.ac (ACX_PROG_GNAT): Append "libgnat" to the include dir. + * configure: Regenerate. + +2017-10-20 Jakub Jelinek + + PR target/82158 + * tree-cfg.c (pass_warn_function_return::execute): In noreturn + functions when optimizing replace GIMPLE_RETURN stmts with + calls to __builtin_unreachable (). + + PR sanitizer/82595 + * config/gnu-user.h (LIBTSAN_EARLY_SPEC): Add libtsan_preinit.o + for -fsanitize=thread link of executables. + (LIBLSAN_EARLY_SPEC): Add liblsan_preinit.o for -fsanitize=leak + link of executables. + + PR target/82370 + * config/i386/sse.md (VI248_AVX2, VI248_AVX512BW, VI248_AVX512BW_2): + New mode iterators. + (3): Change the last of the 3 + define_insns for logical vector shifts to use VI248_AVX512BW + iterator instead of VI48_AVX512, remove + condition, useless isa and prefix attributes. Change the first + 2 of these define_insns to ... + (3): ... this, new + define_insn for avx512vl. + (3): ... and this, new define_insn without + masking for non-avx512vl. + + PR target/82370 + * config/i386/sse.md (*andnot3, + 3, *3): Split + (=v,v,vm) alternative into (=x,x,xm) and (=v,v,vm), for 128-bit + and 256-bit vectors, the (=x,x,xm) alternative and when mask is + not applied use empty suffix even for TARGET_AVX512VL. + * config/i386/subst.md (mask_prefix3, mask_prefix4): When mask + is applied, supply evex,evex or evex,evex,evex instead of just + evex. + +2017-10-20 Julia Koval + + * common/config/i386/i386-common.c (OPTION_MASK_ISA_GFNI_SET, + (OPTION_MASK_ISA_GFNI_UNSET): New. + (ix86_handle_option): Handle OPT_mgfni. + * config/i386/cpuid.h (bit_GFNI): New. + * config/i386/driver-i386.c (host_detect_local_cpu): Detect gfni. + * config/i386/i386-c.c (ix86_target_macros_internal): Define __GFNI__. + * config/i386/i386.c (ix86_target_string): Add -mgfni. + (ix86_valid_target_attribute_inner_p): Add OPT_mgfni. + * config/i386/i386.h (TARGET_GFNI, TARGET_GFNI_P): New. + * config/i386/i386.opt: Add mgfni. + +2017-10-20 Orlando Arias + + * config/msp430/msp430.c (msp430_option_override): Disable + -fdelete-null-pointer-checks. + * doc/invoke.text (-fdelete-null-pointer-checks): Document that. + +2017-10-19 Jan Hubicka + + * x86-tune-costs.h (generic_cost, core_cost): Correct costs + of x87 and SSE instructions. + +2017-10-19 Jan Hubicka + + * asan.c (create_cond_insert_point): Do not update edge count. + * auto-profile.c (afdo_propagate_edge): Update for edge count removal. + (afdo_propagate_circuit): Likewise. + (afdo_calculate_branch_prob): Likewise. + (afdo_annotate_cfg): Likewise. + * basic-block.h (struct edge_def): Remove count. + (edge_def::count): New accessor. + * bb-reorder.c (rotate_loop): Update. + (find_traces_1_round): Update. + (connect_traces): Update. + (sanitize_hot_paths): Update. + * cfg.c (unchecked_make_edge): Update. + (make_single_succ_edge): Update. + (check_bb_profile): Update. + (dump_edge_info): Update. + (update_bb_profile_for_threading): Update. + (scale_bbs_frequencies_int): Update. + (scale_bbs_frequencies_gcov_type): Update. + (scale_bbs_frequencies_profile_count): Update. + (scale_bbs_frequencies): Update. + * cfganal.c (connect_infinite_loops_to_exit): Update. + * cfgbuild.c (compute_outgoing_frequencies): Update. + (find_many_sub_basic_blocks): Update. + * cfgcleanup.c (try_forward_edges): Update. + (try_crossjump_to_edge): Update + * cfgexpand.c (expand_gimple_cond): Update + (expand_gimple_tailcall): Update + (construct_exit_block): Update + * cfghooks.c (verify_flow_info): Update + (redirect_edge_succ_nodup): Update + (split_edge): Update + (make_forwarder_block): Update + (duplicate_block): Update + (account_profile_record): Update + * cfgloop.c (find_subloop_latch_edge_by_profile): Update. + * cfgloopanal.c (expected_loop_iterations_unbounded): Update. + * cfgloopmanip.c (scale_loop_profile): Update. + (loopify): Update. + (lv_adjust_loop_entry_edge): Update. + * cfgrtl.c (try_redirect_by_replacing_jump): Update. + (force_nonfallthru_and_redirect): Update. + (purge_dead_edges): Update. + (rtl_flow_call_edges_add): Update. + * cgraphunit.c (init_lowered_empty_function): Update. + (cgraph_node::expand_thunk): Update. + * gimple-pretty-print.c (dump_probability): Update. + (dump_edge_probability): Update. + * gimple-ssa-isolate-paths.c (isolate_path): Update. + * haifa-sched.c (sched_create_recovery_edges): Update. + * hsa-gen.c (convert_switch_statements): Update. + * ifcvt.c (dead_or_predicable): Update. + * ipa-inline-transform.c (inline_transform): Update. + * ipa-split.c (split_function): Update. + * ipa-utils.c (ipa_merge_profiles): Update. + * loop-doloop.c (add_test): Update. + * loop-unroll.c (unroll_loop_runtime_iterations): Update. + * lto-streamer-in.c (input_cfg): Update. + (input_function): Update. + * lto-streamer-out.c (output_cfg): Update. + * modulo-sched.c (sms_schedule): Update. + * postreload-gcse.c (eliminate_partially_redundant_load): Update. + * predict.c (maybe_hot_edge_p): Update. + (unlikely_executed_edge_p): Update. + (probably_never_executed_edge_p): Update. + (dump_prediction): Update. + (drop_profile): Update. + (propagate_unlikely_bbs_forward): Update. + (determine_unlikely_bbs): Update. + (force_edge_cold): Update. + * profile.c (compute_branch_probabilities): Update. + * reg-stack.c (better_edge): Update. + * shrink-wrap.c (handle_simple_exit): Update. + * tracer.c (better_p): Update. + * trans-mem.c (expand_transaction): Update. + (split_bb_make_tm_edge): Update. + * tree-call-cdce.c: Update. + * tree-cfg.c (gimple_find_sub_bbs): Update. + (gimple_split_edge): Update. + (gimple_duplicate_sese_region): Update. + (gimple_duplicate_sese_tail): Update. + (gimple_flow_call_edges_add): Update. + (insert_cond_bb): Update. + (execute_fixup_cfg): Update. + * tree-cfgcleanup.c (cleanup_control_expr_graph): Update. + * tree-complex.c (expand_complex_div_wide): Update. + * tree-eh.c (lower_resx): Update. + (unsplit_eh): Update. + (cleanup_empty_eh_move_lp): Update. + * tree-inline.c (copy_edges_for_bb): Update. + (freqs_to_counts): Update. + (copy_cfg_body): Update. + * tree-ssa-dce.c (remove_dead_stmt): Update. + * tree-ssa-ifcombine.c (update_profile_after_ifcombine): Update. + * tree-ssa-loop-im.c (execute_sm_if_changed): Update. + * tree-ssa-loop-ivcanon.c (remove_exits_and_undefined_stmts): Update. + (unloop_loops): Update. + * tree-ssa-loop-manip.c (tree_transform_and_unroll_loop): Update. + * tree-ssa-loop-split.c (connect_loops): Update. + (split_loop): Update. + * tree-ssa-loop-unswitch.c (hoist_guard): Update. + * tree-ssa-phionlycprop.c (propagate_rhs_into_lhs): Update. + * tree-ssa-phiopt.c (replace_phi_edge_with_variable): Update. + * tree-ssa-reassoc.c (branch_fixup): Update. + * tree-ssa-tail-merge.c (replace_block_by): Update. + * tree-ssa-threadupdate.c (remove_ctrl_stmt_and_useless_edges): Update. + (compute_path_counts): Update. + (update_profile): Update. + (recompute_probabilities): Update. + (update_joiner_offpath_counts): Update. + (estimated_freqs_path): Update. + (freqs_to_counts_path): Update. + (clear_counts_path): Update. + (ssa_fix_duplicate_block_edges): Update. + (duplicate_thread_path): Update. + * tree-switch-conversion.c (hoist_edge_and_branch_if_true): Update. + (case_bit_test_cmp): Update. + (collect_switch_conv_info): Update. + (gen_inbound_check): Update. + (do_jump_if_equal): Update. + (emit_cmp_and_jump_insns): Update. + * tree-tailcall.c (decrease_profile): Update. + (eliminate_tail_call): Update. + * tree-vect-loop-manip.c (slpeel_add_loop_guard): Update. + (vect_do_peeling): Update. + * tree-vect-loop.c (scale_profile_for_vect_loop): Update. + * ubsan.c (ubsan_expand_null_ifn): Update. + (ubsan_expand_ptr_ifn): Update. + * value-prof.c (gimple_divmod_fixed_value): Update. + (gimple_mod_pow2): Update. + (gimple_mod_subtract): Update. + (gimple_ic): Update. + (gimple_stringop_fixed_value): Update. + +2017-10-19 Uros Bizjak + + PR target/82618 + * config/i386/i386.md (sub to cmp): New peephole2 pattern. + +2017-10-19 Alexander Monakov + + PR rtl-optimization/82395 + * ira-color.c (allocno_priority_compare_func): Fix comparison step + based on non_spilled_static_chain_regno_p. + +2017-10-19 Uros Bizjak + + * config/i386/i386.c (output_387_binary_op): Rewrite SSE part. + (ix86_emit_mode_set): Rewrite insn mnemonic construction. + (ix86_prepare_fp_compare_args): Redefine is_sse as bool. + +2017-10-19 Martin Sebor + + PR tree-optimization/82596 + * tree.c (array_at_struct_end_p): Handle STRING_CST. + +2017-10-19 Eric Botcazou + + * asan.c (handle_builtin_alloca): Deal with all alloca variants. + (get_mem_refs_of_builtin_call): Likewise. + * builtins.c (expand_builtin_apply): Adjust call to + allocate_dynamic_stack_space. + (expand_builtin_alloca): For __builtin_alloca_with_align_and_max, pass + the third argument to allocate_dynamic_stack_space, otherwise -1. + (expand_builtin): Deal with all alloca variants. + (is_inexpensive_builtin): Likewise. + * builtins.def (BUILT_IN_ALLOCA_WITH_ALIGN_AND_MAX): New. + * calls.c (special_function_p): Deal with all alloca variants. + (initialize_argument_information): Adjust call to + allocate_dynamic_stack_space. + (expand_call): Likewise. + * cfgexpand.c (expand_call_stmt): Deal with all alloca variants. + * doc/extend.texi (Built-ins): Add __builtin_alloca_with_align_and_max + * explow.c (allocate_dynamic_stack_space): Add MAX_SIZE parameter and + use it for the stack usage computation. + * explow.h (allocate_dynamic_stack_space): Adjust prototype. + * function.c (gimplify_parameters): Call build_alloca_call_expr. + * gimple-ssa-warn-alloca.c (alloca_call_type): Simplify control flow. + Take into account 3rd argument of __builtin_alloca_with_align_and_max. + (in_loop_p): Remove first argument and useless check. + (pass_walloca::execute): Remove useless test and adjust call to above. + * gimple.c (gimple_build_call_from_tree): Deal with all alloc variants + * gimplify.c (gimplify_vla_decl): Call build_alloca_call_expr. + (gimplify_call_expr): Deal with all alloca variants. + * hsa-gen.c (gen_hsa_alloca): Likewise. + (gen_hsa_insns_for_call): Likewise. + * ipa-pure-const.c (special_builtin_state): Likewise. + * tree-chkp.c (chkp_build_returned_bound): Likewise. + * tree-object-size.c (alloc_object_size): Likewise. + * tree-ssa-alias.c (ref_maybe_used_by_call_p_1): Likewise. + (call_may_clobber_ref_p_1): Likewise. + * tree-ssa-ccp.c (evaluate_stmt): Likewise. + (ccp_fold_stmt): Likewise. + (optimize_stack_restore): Likewise. + * tree-ssa-dce.c (mark_stmt_if_obviously_necessary): Likewise. + (mark_all_reaching_defs_necessary_1): Likewise. + (propagate_necessity): Likewise. + (eliminate_unnecessary_stmts): Likewise. + * tree.c (build_common_builtin_nodes): Build + BUILT_IN_ALLOCA_WITH_ALIGN_AND_MAX. + (build_alloca_call_expr): New function. + * tree.h (ALLOCA_FUNCTION_CODE_P): New macro. + (CASE_BUILT_IN_ALLOCA): Likewise. + (build_alloca_call_expr): Declare. + * varasm.c (incorporeal_function_p): Deal with all alloca variants. + +2017-10-19 Eric Botcazou + + PR debug/82509 + * dwarf2out.c (new_die_raw): New static inline function. + (new_die): Use it to create the DIE. + (add_AT_external_die_ref): Likewise. + (clone_die): Likewise. + (clone_as_declaration): Likewise. + (dwarf2out_vms_debug_main_pointer): Likewise. + (base_type_die): Likewise. Remove early return for corner cases. + Do not call add_pubtype on the DIE here. + (is_base_type): Remove ERROR_MARK and return 0 for VOID_TYPE. + (modified_type_die): Adjust the lookup for reverse order DIEs. Skip + typedefs for base types with DW_AT_endianity. Make sure a DIE with + native order exists for base types, attach the DIE manually and call + add_pubtype on it. Do not equate a reverse order DIE to the type. + +2017-10-19 Richard Earnshaw + + * config/arm/arm.c (align_ok_ldrd_strd): New function. + (mem_ok_for_ldrd_strd): New parameter align. Extract the alignment of + the mem into it. + (gen_operands_ldrd_strd): Validate the alignment of the accesses. + +2017-10-19 Jakub Jelinek + + * flag-types.h (enum sanitize_code): Add SANITIZE_BUILTIN. Or + SANITIZE_BUILTIN into SANITIZE_UNDEFINED. + * sanitizer.def (BUILT_IN_UBSAN_HANDLE_INVALID_BUILTIN, + BUILT_IN_UBSAN_HANDLE_INVALID_BUILTIN_ABORT): New builtins. + * opts.c (sanitizer_opts): Add builtin. + * ubsan.c (instrument_builtin): New function. + (pass_ubsan::execute): Call it. + (pass_ubsan::gate): Enable even for SANITIZE_BUILTIN. + * doc/invoke.texi: Document -fsanitize=builtin. + + * ubsan.c (ubsan_expand_null_ifn): Use _v1 suffixed type mismatch + builtins, store max (log2 (align), 0) into uchar field instead of + align into uptr field. + (ubsan_expand_objsize_ifn): Use _v1 suffixed type mismatch builtins, + store uchar 0 field instead of uptr 0 field. + (instrument_nonnull_return): Use _v1 suffixed nonnull return builtin, + instead of passing one address of struct with 2 locations pass + two addresses of structs with 1 location each. + * sanitizer.def (BUILT_IN_UBSAN_HANDLE_TYPE_MISMATCH, + BUILT_IN_UBSAN_HANDLE_TYPE_MISMATCH_ABORT, + BUILT_IN_UBSAN_HANDLE_NONNULL_RETURN, + BUILT_IN_UBSAN_HANDLE_NONNULL_RETURN_ABORT): Removed. + (BUILT_IN_UBSAN_HANDLE_TYPE_MISMATCH_V1, + BUILT_IN_UBSAN_HANDLE_TYPE_MISMATCH_V1_ABORT, + BUILT_IN_UBSAN_HANDLE_NONNULL_RETURN_V1, + BUILT_IN_UBSAN_HANDLE_NONNULL_RETURN_V1_ABORT): New builtins. + +2017-10-19 Martin Liska + + PR driver/81829 + * file-find.c (remove_prefix): Remove. + * file-find.h (remove_prefix): Likewise. + * gcc-ar.c: Remove smartness of lookup. + +2017-10-19 Segher Boessenkool + + * config/rs6000/rs6000.md (*call_indirect_aix, + *call_value_indirect_aix, *call_indirect_elfv2, + *call_value_indirect_elfv2): Add correct mode to the unspec. + +2017-10-19 Jakub Jelinek + + PR target/82580 + * config/i386/i386.md (setcc + movzbl to xor + setcc): New peephole2. + (setcc + and to xor + setcc): New peephole2. + +2017-10-19 Tom de Vries + + * doc/sourcebuild.texi (Test Directives, Variants of + dg-require-support): Add dg-require-stack-size. + +2017-10-19 Martin Liska + + PR sanitizer/82517 + * gimplify.c (gimplify_decl_expr): Do not instrument variables + that have a large alignment. + (gimplify_target_expr): Likewise. + +2017-10-18 Segher Boessenkool + + PR rtl-optimization/82602 + * ira.c (rtx_moveable_p): Return false for volatile asm. + +2017-10-18 Uros Bizjak + + PR target/82580 + * config/i386/i386-modes.def (CCGZ): New CC mode. + * config/i386/i386.md (sub3_carry_ccgz): New insn pattern. + * config/i386/predicates.md (ix86_comparison_operator): + Handle CCGZmode. + * config/i386/i386.c (ix86_expand_branch) : + Emulate LE, LEU, GT, GTU, LT, LTU, GE and GEU double-word comparisons + with double-word subtraction. + (put_condition_code): Handle CCGZmode. + +2017-10-18 Aldy Hernandez + + * wide-int.cc (debug (const wide_int &)): New. + (debug (const wide_int *)): New. + (debug (const widest_int &)): New. + (debug (const widest_int *)): New. + +2017-10-18 Vladimir Makarov + + PR middle-end/82556 + * lra-constraints.c (curr_insn_transform): Use non-input operand + instead of output one for matched reload. + +2017-10-18 Bin Cheng + + * tree-loop-distribution.c (INCLUDE_ALGORITHM): New header file. + (tree-ssa-loop-ivopts.h): New header file. + (struct builtin_info): New fields. + (classify_builtin_1): Compute and record base and offset parts for + memset builtin partition by calling strip_offset. + (offset_cmp, fuse_memset_builtins): New functions. + (finalize_partitions): Fuse adjacent memset partitions by calling + above function. + * tree-ssa-loop-ivopts.c (strip_offset): Delete static declaration. + Expose the interface. + * tree-ssa-loop-ivopts.h (strip_offset): New declaration. + +2017-10-18 Bin Cheng + + PR tree-optimization/82574 + * tree-loop-distribution.c (find_single_drs): New parameter. Check + that data reference must be executed exactly once per iteration + against the outermost loop in nest. + (classify_partition): Update call to above function. + +2017-10-18 Richard Biener + + PR tree-optimization/82591 + * graphite.c (graphite_transform_loops): Move code gen message + printing ... + * graphite-isl-ast-to-gimple.c (graphite_regenerate_ast_isl): + Here. Handle scop_to_isl_ast failing. + (scop_to_isl_ast): Limit the number of ISL operations. + +2017-10-18 Richard Biener + + * graphite-isl-ast-to-gimple.c + (translate_isl_ast_to_gimple::set_rename): Simplify. + (translate_isl_ast_to_gimple::set_rename_for_each_def): Inline... + (graphite_copy_stmts_from_block): ... here. + (copy_bb_and_scalar_dependences): Simplify. + (add_parameters_to_ivs_params): Canonicalize. + (generate_entry_out_of_ssa_copies): Simplify. + * graphite-sese-to-poly.c (extract_affine_name): Simplify + by passing in ISL dimension. + (parameter_index_in_region_1): Rename to ... + (parameter_index_in_region): ... this. + (extract_affine): Adjust assert, pass down parameter index. + (add_param_constraints): Use range-info when available. + (build_scop_context): Adjust. + * sese.c (new_sese_info): Adjust. + (free_sese_info): Likewise. + * sese.h (bb_map_t, rename_map_t, phi_rename, init_back_edge_pair_t): + Remove unused typedefs. + (struct sese_info_t): Simplify rename_map, remove incomplete_phis. + +2017-10-18 Martin Liska + + * combine.c (simplify_compare_const): Add gcc_fallthrough. + +2017-10-18 Robin Dapp + + * config/s390/s390.c (s390_bb_fallthru_entry_likely): New function. + (s390_sched_init): Do not reset s390_sched_state if we entered the + current basic block via a fallthru edge and all others are unlikely. + +2017-10-18 Robin Dapp + + * config/s390/s390.c (NUM_SIDES): New variable. + (LONGRUNNING_THRESHOLD): New variable. + (LATENCY_FACTOR): New variable. + (s390_sched_score): Decrease score for long-running instructions on + wrong side. + (s390_sched_variable_issue): Perform bookkeeping for long-running + instructions. + +2017-10-18 Richard Biener + + * graphite-isl-ast-to-gimple.c (gcc_expression_from_isl_ast_expr_id): + Simplify with removal of the parameter rename map. + (set_rename): Likewise. + (should_copy_to_new_region): Likewise. + (graphite_copy_stmts_from_block): Likewise. + (copy_bb_and_scalar_dependences): Remove initialization of + unused copied_bb_map. + (copy_def): Remove. + (copy_internal_parameters): Likewise. + (graphite_regenerate_ast_isl): Do not call copy_internal_parameters. + * graphite-scop-detection.c (scop_detection::stmt_simple_for_scop_p): + Use INTEGRAL_TYPE_P. + (parameter_index_in_region_1): Rename to ... + (assign_parameter_index_in_region): ... this. Assert we have + a parameter we handle. + (scan_tree_for_params): Adjust. + * sese.h (parameter_rename_map_t): Remove. + (struct sese_info_t): Remove unused parameter_rename_map and + copied_bb_map members. + * sese.c (new_sese_info): Adjust. + (free_sese_info): Likewise. + +2017-10-18 Martin Liska + + PR sanitizer/82545 + * asan.c (asan_expand_poison_ifn): Do not put gimple stmt + on an abnormal edge. + +2017-10-18 Sebastian Huber + + * doc/invoke.texi (ffunction-sections and fdata-sections): + Update. + +2017-10-17 Eric Botcazou + + * tree-ssa-loop-ivopts.c (add_autoinc_candidates): Bail out only if + the use statement can throw internally. + +2017-10-17 Eric Botcazou + + * config/visium/visium.c (visium_select_cc_mode): Return CCmode for + any RTX present on the RHS of a SET. + * compare-elim.c (try_eliminate_compare): Restore comment. + +2017-10-17 Jakub Jelinek + + * langhooks.h (struct lang_hooks): Document that tree_size langhook + may be also called on tcc_type nodes. + * langhooks.c (lhd_tree_size): Likewise. + +2017-10-17 David Malcolm + + * gimple-ssa-sprintf.c (fmtwarn): Update for changed signature of + format_warning_at_substring. + (maybe_warn): Convert source_range * param to a location_t. Pass + UNKNOWN_LOCATION rather than NULL to fmtwarn. + (format_directive): Remove code to extract source_ranges and + source_range * in favor of just a location_t. + (parse_directive): Pass UNKNOWN_LOCATION rather than NULL to + fmtwarn. + * substring-locations.c (format_warning_va): Convert + source_range * param to a location_t. + (format_warning_at_substring): Likewise. + * substring-locations.h (format_warning_va): Likewise. + (format_warning_at_substring): Likewise. + +2017-10-17 Jan Hubicka + + * target.h (enum vect_cost_for_stmt): Add vec_gather_load and + vec_scatter_store + * tree-vect-stmts.c (record_stmt_cost): Make difference between normal + and scatter/gather ops. + + * aarch64/aarch64.c (aarch64_builtin_vectorization_cost): Add + vec_gather_load and vec_scatter_store. + * arm/arm.c (arm_builtin_vectorization_cost): Likewise. + * powerpcspe/powerpcspe.c (rs6000_builtin_vectorization_cost): Likewise. + * rs6000/rs6000.c (rs6000_builtin_vectorization_cost): Likewise. + * s390/s390.c (s390_builtin_vectorization_cost): Likewise. + * spu/spu.c (spu_builtin_vectorization_cost): Likewise. + * i386/i386.c (x86_builtin_vectorization_cost): Likewise. + +2017-10-17 Uros Bizjak + + * reg-stack.c (compare_for_stack_reg): Add bool argument. + Detect FTST instruction and handle its register pops. Only pop + second operand if can_pop_second_op is true. + (subst_stack_regs_pat) : Detect FCOMI instruction to + set can_pop_second_op to false in the compare_for_stack_reg call. + + * config/i386/i386.md (*cmpi): Only call + output_fp_compare for stack register operands. + * config/i386/i386.c (output_fp_compare): Do not output SSE compare + instructions here. Do not emit stack register pops here. Assert + that FCOMPP pops next to top stack register. Rewrite function. + +2017-10-17 Nathan Sidwell + + PR middle-end/82577 + * alias.c (compare_base_decls): Check HAS_DECL_ASSEMBLER_NAME_P, + use DECL_ASSEMBLER_NAME_RAW. + + PR middle-end/82546 + * tree.c (tree_code_size): Reformat. Punt to lang hook for unknown + TYPE nodes. + +2017-10-17 Qing Zhao + Wilco Dijkstra + + * builtins.c (expand_builtin_update_setjmp_buf): Add a + converstion to Pmode from the buf_addr. + +2017-10-17 Richard Biener + + * graphite-dependences.c (scop_get_reads_and_writes): Change + output parameters to references. + +2017-10-17 Jackson Woodruff + + PR 71026/tree-optimization + * fold-const.c (distribute_real_division): Removed. + (fold_binary_loc): Remove calls to distribute_real_divison. + +2017-10-17 Richard Biener + + * graphite-scop-detection.c + (scop_detection::stmt_has_simple_data_refs_p): Always use + the full nest as region. + (try_generate_gimple_bb): Likewise. + * sese.c (scalar_evolution_in_region): Simplify now that + SCEV can handle instantiation in regions. + * tree-scalar-evolution.c (instantiate_scev_name): Also instantiate + in the non-loop part of a function if requested. + +2017-10-17 Richard Biener + + PR tree-optimization/82563 + * graphite-isl-ast-to-gimple.c (generate_entry_out_of_ssa_copies): + New function. + (graphite_regenerate_ast_isl): Call it. + * graphite-scop-detection.c (build_scops): Remove entry edge split. + +2017-10-17 Jakub Jelinek + + PR tree-optimization/82549 + * fold-const.c (optimize_bit_field_compare, fold_truth_andor_1): + Formatting fixes. Instead of calling make_bit_field_ref with negative + bitpos return 0. + +2017-10-17 Olga Makhotina + + * config/i386/avx512dqintrin.h (_mm_mask_reduce_sd, + _mm_maskz_reduce_sd, _mm_mask_reduce_ss,=20 + _mm_maskz_reduce_ss): New. + * config/i386/i386-builtin.def (__builtin_ia32_reducesd_mask, + __builtin_ia32_reducess_mask): Ditto.. + (__builtin_ia32_reducesd, __builtin_ia32_reducess): Remove. + * config/i386/sse.md (reduces): Renamed to ... + (reduces): ... this. + (vreduce\t{%3, %2, %1, %0|%0, %1, %2, %3}): Changed + to ... + (vreduce\t{%3, %2, %1, %0| + %0, %1, %2, %3}): ... this. + +2017-10-16 David Malcolm + + * Makefile.in (OBJS): Add unique-ptr-tests.o. + * selftest-run-tests.c (selftest::run_tests): Call + selftest::unique_ptr_tests_cc_tests. + * selftest.h (selftest::unique_ptr_tests_cc_tests): New decl. + * unique-ptr-tests.cc: New file. + +2017-10-16 Vladimir Makarov + + PR sanitizer/82353 + * lra.c (collect_non_operand_hard_regs): Don't ignore operator + locations. + * lra-lives.c (bb_killed_pseudos, bb_gen_pseudos): Move up. + (make_hard_regno_born, make_hard_regno_dead): Update + bb_killed_pseudos and bb_gen_pseudos for fixed regs. + +2017-10-16 Jeff Law + + * tree-ssa-dse.c (live_bytes_read): Fix thinko. + +2017-10-16 Jan Hubicka + + * x86-tune-costs.h (znver1_cost): Fix move cost tables. + +2017-10-16 Olivier Hainque + + * gcc/config.gcc (powerpc*-*-*spe*): Pick 8548 as the default + with_cpu if we were configured for an e500v2 target cpu name. + +2017-10-16 Thomas Preud'homme + + * config/arm/arm-cpus.in (cortex-m33): Add nodsp option. + * doc/invoke.texi: Document +nodsp as a valid extension for + -mcpu=cortex-m33. + +2017-10-16 Martin Liska + + * sbitmap.c (bitmap_bit_in_range_p_checking): New function. + (test_set_range): Likewise. + (test_range_functions): Rename to ... + (test_bit_in_range): ... this. + (sbitmap_c_tests): Add new test. + +2017-10-16 Tamar Christina + + * config/aarch64/arm_neon.h (vdot_u32, vdotq_u32, vdot_s32, vdotq_s32): New. + (vdot_lane_u32, vdot_laneq_u32, vdotq_lane_u32, vdotq_laneq_u32): New. + (vdot_lane_s32, vdot_laneq_s32, vdotq_lane_s32, vdotq_laneq_s32): New. + +2017-10-16 Tamar Christina + + * config/aarch64/aarch64-builtins.c + (aarch64_types_quadopu_lane_qualifiers): New. + (TYPES_QUADOPU_LANE): New. + * config/aarch64/aarch64-simd.md (aarch64_dot): New. + (dot_prod, aarch64_dot_lane): New. + (aarch64_dot_laneq): New. + * config/aarch64/aarch64-simd-builtins.def (sdot, udot): New. + (sdot_lane, udot_lane, sdot_laneq, udot_laneq): New. + * config/aarch64/iterators.md (sur): Add UNSPEC_SDOT, UNSPEC_UDOT. + (Vdottype, DOTPROD): New. + (sur): Add SDOT and UDOT. + +2017-10-16 Tamar Christina + + * config/aarch64/aarch64.h (AARCH64_FL_DOTPROD): New. + (AARCH64_ISA_DOTPROD, TARGET_DOTPROD): New. + * config/aarch64/aarch64-c.c (aarch64_update_cpp_builtins): Add TARGET_DOTPROD. + * config/aarch64/aarch64-option-extensions.def (dotprod): New. + * config/aarch64/aarch64-cores.def (cortex-a55, cortex-a75): Enable TARGET_DOTPROD. + (cortex-a75.cortex-a55): Likewise. + * doc/invoke.texi (aarch64-feature-modifiers): Document dotprod. + +2017-10-16 Tamar Christina + + * config/arm/arm-builtins.c (arm_unsigned_uternop_qualifiers): New. + (UTERNOP_QUALIFIERS, arm_umac_lane_qualifiers, UMAC_LANE_QUALIFIERS): New. + * config/arm/arm_neon_builtins.def (sdot, udot, sdot_lane, udot_lane): new. + * config/arm/iterators.md (DOTPROD, VSI2QI, vsi2qi): New. + (UNSPEC_DOT_S, UNSPEC_DOT_U, opsuffix): New. + * config/arm/neon.md (neon_dot): New. + (neon_dot_lane, dot_prod): New. + * config/arm/types.md (neon_dot, neon_dot_q): New. + * config/arm/unspecs.md (sup): Add UNSPEC_DOT_S, UNSPEC_DOT_U. + +2017-10-16 Tamar Christina + + * config/arm/arm.h (TARGET_DOTPROD): New. + * config/arm/arm.c (arm_arch_dotprod): New. + (arm_option_reconfigure_globals): Add arm_arch_dotprod. + * config/arm/arm-c.c (__ARM_FEATURE_DOTPROD): New. + * config/arm/arm-cpus.in (armv8.2-a): Enabled +dotprod. + (feature dotprod, group dotprod, ALL_SIMD_INTERNAL): New. + (ALL_FPU_INTERNAL): Use ALL_SIMD_INTERNAL. + * config/arm/t-multilib (v8_2_a_simd_variants): Add dotprod. + * doc/invoke.texi (armv8.2-a): Document dotprod + +2017-10-14 Jan Hubicka + + * i386.c (ix86_vec_cost): New function. + (ix86_rtx_costs): Handle vector operations better. + * i386.h (struct processor_costs): Add sse_op, fmasd, fmass. + * x86-tune-costs.h: Add new costs to all tables. + +2017-10-14 Jan Hubicka + + * i386.c (ix86_rtx_costs): Make difference between x87 and SSE + operations. + * i386.h (struct processor_costs): Add addss, mulss, mulsd, divss, + divsd, sqrtss and sqrtsd + * x86-tune-costs.h: Add new entries to all costs. + (znver1_cost): Fix to match real instruction latencies. + +2017-10-14 Kyrylo Tkachov + Michael Collison + + * compare-elim.c: Include emit-rtl.h. + (can_merge_compare_into_arith): New function. + (try_validate_parallel): Likewise. + (try_merge_compare): Likewise. + (try_eliminate_compare): Call the above when no previous clobber + is available. + (execute_compare_elim_after_reload): Add DF_UD_CHAIN and DF_DU_CHAIN + dataflow problems. + +2017-10-14 Jakub Jelinek + + PR middle-end/62263 + PR middle-end/82498 + * tree-ssa-phiopt.c (value_replacement): Comment fix. Handle + up to 2 preparation statements for ASSIGN in MIDDLE_BB. + + PR middle-end/62263 + PR middle-end/82498 + * tree-ssa-forwprop.c (simplify_rotate): Allow def_arg1[N] + to be any operand_equal_p operands. For & (B - 1) require + B to be power of 2. Recognize + (X << (Y & (B - 1))) | (X >> ((-Y) & (B - 1))) and similar patterns. + +2017-10-14 Uros Bizjak + + PR bootstrap/82553 + * optabs.c (expand_memory_blockage): Fix call of + targetm.have_memory_blockage. + +2017-10-14 Jakub Jelinek + + PR bootstrap/82548 + * config.gcc (*-*-solaris2*, i[34567]86-*-cygwin*, + x86_64-*-cygwin*, i[34567]86-*-mingw* | x86_64-*-mingw*): Append + objects to extra_objs instead of overwriting it. + +2017-10-14 Uros Bizjak + + * config/i386/sync.md (FILD_ATOMIC/FIST_ATOMIC FP load peephole2): + Use any_fp_register_operand as operand[3] predicate. Simplify + equality test for operands[2] and operands[4] memory location. + (LDX_ATOMIC/STX_ATOMIC FP load peephole2): Ditto. + (FILD_ATOMIC/FIST_ATOMIC FP load peephole2 with mem blockage): New. + (LDX_ATOMIC/LDX_ATOMIC FP load peephole2 with mem blockage): Ditto. + (FILD_ATOMIC/FIST_ATOMIC FP store peephole2): Use + any_fp_register_operand as operand[1] predicate. Simplify + equality test for operands[0] and operands[3] memory location. + (LDX_ATOMIC/STX_ATOMIC FP store peephole2): Ditto. + (FILD_ATOMIC/FIST_ATOMIC FP store peephole2 with mem blockage): New. + (LDX_ATOMIC/LDX_ATOMIC FP storepeephole2 with mem blockage): Ditto. + +2017-10-14 Uros Bizjak + + * target-insns.def: Add memory_blockage. + * optabs.c (expand_memory_blockage): New function. + (expand_asm_memory_barrier): Rename ... + (expand_asm_memory_blockage): ... to this. + (expand_mem_thread_fence): Call expand_memory_blockage + instead of expand_asm_memory_barrier. + (expand_mem_singnal_fence): Ditto. + (expand_atomic_load): Ditto. + (expand_atomic_store): Ditto. + * doc/md.texi (Standard Pattern Names For Generation): + Document memory_blockage instruction pattern. + +2017-10-13 Sebastian Perta + + * config/rl78/rl78.c (rl78_emit_libcall): New function. + * config/rl78/rl78-protos.h (rl78_emit_libcall): New function. + * config/rl78/rl78.md: New define_expand "adddi3". + +2017-10-13 Jan Hubicka + + * cfghooks.c (verify_flow_info): Disable check that all probabilities + are set correctly. + +2017-10-13 Jeff Law + + * tree-ssa-reassoc.c (reassociate_bb): Clarify code slighly. + +2017-10-13 Jakub Jelinek + + PR target/82274 + * internal-fn.c (expand_mul_overflow): If both operands have + the same highpart of -1 or 0 and the topmost bit of lowpart + is different, overflow is if res <= 0 rather than res < 0. + +2017-10-13 Pat Haugen + + * config/rs6000/rs6000.c (rs6000_builtin_vectorization_cost): Remove + TARGET_P9_VECTOR code for unaligned_load case. + +2017-10-13 Jan Hubicka + + * cfghooks.c (verify_flow_info): Check that edge probabilities are set. + +2017-10-13 Nathan Sidwell + + * tree-core.h (tree_contains_struct): Make bool. + * tree.c (tree_contains_struct): Likewise. + * tree.h (MARK_TS_BASE): Remove do ... while (0) idiom. + (MARK_TS_TYPED, MARK_TS_COMMON, MARK_TS_TYPE_COMMON, + MARK_TS_TYPE_WITH_LANG_SPECIFIC, MARK_TS_DECL_MINIMAL, + MARK_TS_DECL_COMMON, MARK_TS_DECL_WRTL, MARK_TS_DECL_WITH_VIS, + MARK_TS_DECL_NON_COMMON): Likewise, use comma operator. + +2017-10-13 Richard Biener + + * graphite-isl-ast-to-gimple.c + (translate_isl_ast_to_gimple::get_rename_from_scev): Remove unused + parameters and dominance check. + (translate_isl_ast_to_gimple::graphite_copy_stmts_from_block): Adjust. + (translate_isl_ast_to_gimple::copy_bb_and_scalar_dependences): Likewise. + (translate_isl_ast_to_gimple::graphite_regenerate_ast_isl): + Do not update SSA form here or do intermediate IL verification. + * graphite.c: Include tree-ssa.h and tree-into-ssa.h. + (graphite_initialize): Remove check on the number of loops in + the function and inline into graphite_transform_loops. + (graphite_finalize): Inline into graphite_transform_loops. + (graphite_transform_loops): Perform SSA update and IL verification + here. + * params.def (PARAM_GRAPHITE_MIN_LOOPS_PER_FUNCTION): Remove. + +2017-10-13 Richard Biener + + * graphite-isl-ast-to-gimple.c (max_mode_int_precision, + graphite_expression_type_precision): Avoid global constructor + by moving ... + (translate_isl_ast_to_gimple::translate_isl_ast_to_gimple): Here. + (translate_isl_ast_to_gimple::graphite_expr_type): Add type member. + (translate_isl_ast_to_gimple::translate_isl_ast_node_for): Use it. + (translate_isl_ast_to_gimple::build_iv_mapping): Likewise. + (translate_isl_ast_to_gimple::graphite_create_new_guard): Likewise. + * graphite-sese-to-poly.c (build_original_schedule): Return nothing. + +2017-10-13 H.J. Lu + + PR target/82499 + * config/i386/i386.h (ix86_red_zone_size): New. + * config/i386/i386.md (push peephole2s): Replace + "!ix86_using_red_zone ()" with "ix86_red_zone_size == 0". + +2017-10-13 Richard Sandiford + Alan Hayward + David Sherwood + + * combine.c (can_change_dest_mode): Reject changes in + REGMODE_NATURAL_SIZE. + +2017-10-13 Richard Sandiford + Alan Hayward + David Sherwood + + * cfgexpand.c (expand_debug_expr): Use GET_MODE_UNIT_BITSIZE. + (expand_debug_source_expr): Likewise. + * combine.c (combine_simplify_rtx): Likewise. + * cse.c (fold_rtx): Likewise. + * fwprop.c (canonicalize_address): Likewise. + * targhooks.c (default_shift_truncation_mask): Likewise. + +2017-10-13 Richard Sandiford + Alan Hayward + David Sherwood + + * optabs.c (add_equal_note): Use GET_MODE_UNIT_SIZE. + (widened_mode): Likewise. + (expand_unop): Likewise. + * ree.c (transform_ifelse): Likewise. + (merge_def_and_ext): Likewise. + (combine_reaching_defs): Likewise. + * simplify-rtx.c (simplify_unary_operation_1): Likewise. + +2017-10-13 Richard Sandiford + Alan Hayward + David Sherwood + + * caller-save.c (replace_reg_with_saved_mem): Use byte_lowpart_offset. + * combine.c (gen_lowpart_for_combine): Likewise. + * dwarf2out.c (rtl_for_decl_location): Likewise. + * final.c (alter_subreg): Likewise. + * rtlhooks.c (gen_lowpart_general): Likewise. + (gen_lowpart_if_possible): Likewise. + +2017-10-13 Richard Sandiford + Alan Hayward + David Sherwood + + * calls.c (expand_call): Use subreg_lowpart_offset. + * cse.c (cse_insn): Likewise. + * regcprop.c (copy_value): Likewise. + (copyprop_hardreg_forward_1): Likewise. + +2017-10-13 Jakub Jelinek + + PR target/82524 + * config/i386/i386.md (addqi_ext_1, andqi_ext_1, + *andqi_ext_1_cc, *qi_ext_1, *xorqi_ext_1_cc): Change + =Q constraints to +Q and into insn condition add check + that operands[0] and operands[1] are equal. + (*addqi_ext_2, *andqi_ext_2, *qi_ext_2): Change + =Q constraints to +Q and into insn condition add check + that operands[0] is equal to either operands[1] or operands[2]. + + PR target/82498 + * fold-const.c (fold_binary_loc) : Code cleanups, + instead of handling MINUS_EXPR twice (once for each argument), + canonicalize operand order and handle just once, use rtype where + possible. Handle (A << B) | (A >> (-B & (Z - 1))). + + PR target/82498 + * config/i386/ia32intrin.h (__rold, __rord, __rolq, __rorq): Allow + any values of __C while still being pattern recognizable as a simple + rotate instruction. + +2017-10-13 Richard Biener + + PR tree-optimization/82451 + Revert + 2017-10-02 Richard Biener + + PR tree-optimization/82355 + * graphite-isl-ast-to-gimple.c (build_iv_mapping): Also build + a mapping for the enclosing loop but avoid generating one for + the loop tree root. + (copy_bb_and_scalar_dependences): Remove premature codegen + error on PHIs in blocks duplicated into multiple places. + * graphite-scop-detection.c + (scop_detection::stmt_has_simple_data_refs_p): For a loop not + in the region use it as loop and nest to analyze the DR in. + (try_generate_gimple_bb): Likewise. + * graphite-sese-to-poly.c (extract_affine_chrec): Adjust. + (add_loop_constraints): For blocks in a loop not in the region + create a dimension with a single iteration. + * sese.h (gbb_loop_at_index): Remove assert. + + * cfgloop.c (loop_preheader_edge): For the loop tree root + return the single successor of the entry block. + * graphite-isl-ast-to-gimple.c (graphite_regenerate_ast_isl): + Reset the SCEV hashtable and niters. + * graphite-scop-detection.c + (scop_detection::graphite_can_represent_scev): Add SCOP parameter, + assert that we only have POLYNOMIAL_CHREC that vary in loops + contained in the region. + (scop_detection::graphite_can_represent_expr): Adjust. + (scop_detection::stmt_has_simple_data_refs_p): For loops + not in the region set loop to NULL. The nest is now the + entry edge to the region. + (try_generate_gimple_bb): Likewise. + * sese.c (scalar_evolution_in_region): Adjust for + instantiate_scev change. + * tree-data-ref.h (graphite_find_data_references_in_stmt): + Make nest parameter the edge into the region. + (create_data_ref): Likewise. + * tree-data-ref.c (dr_analyze_indices): Make nest parameter an + entry edge into a region and adjust instantiate_scev calls. + (create_data_ref): Likewise. + (graphite_find_data_references_in_stmt): Likewise. + (find_data_references_in_stmt): Pass the loop preheader edge + from the nest argument. + * tree-scalar-evolution.h (instantiate_scev): Make instantiate_below + parameter the edge into the region. + (instantiate_parameters): Use the loop preheader edge as entry. + * tree-scalar-evolution.c (analyze_scalar_evolution): Handle + NULL loop. + (get_instantiated_value_entry): Make instantiate_below parameter + the edge into the region. + (instantiate_scev_name): Likewise. Adjust dominance checks, + when we cannot use loop-based instantiation instantiate by + walking use-def chains. + (instantiate_scev_poly): Adjust. + (instantiate_scev_binary): Likewise. + (instantiate_scev_convert): Likewise. + (instantiate_scev_not): Likewise. + (instantiate_array_ref): Remove. + (instantiate_scev_3): Likewise. + (instantiate_scev_2): Likewise. + (instantiate_scev_1): Likewise. + (instantiate_scev_r): Do not blindly handle N-operand trees. + Do not instantiate array-refs. Handle all constants and invariants. + (instantiate_scev): Make instantiate_below parameter + the edge into the region. + (resolve_mixers): Use the loop preheader edge for the region + parameter to instantiate_scev_r. + * tree-ssa-loop-prefetch.c (determine_loop_nest_reuse): Adjust. + +2017-10-13 Richard Biener + + PR tree-optimization/82525 + * graphite-isl-ast-to-gimple.c + (translate_isl_ast_to_gimple::widest_int_from_isl_expr_int): Split + out from ... + (translate_isl_ast_to_gimple::gcc_expression_from_isl_expr_int): Here. + Fail code generation when we cannot represent the isl integer. + (binary_op_to_tree): Elide modulo operations that are no-ops + in the type we code generate. Remove now superfluous code + generation errors. + +2017-10-13 Richard Biener + + * graphite-scop-detection.c (loop_ivs_can_be_represented): Remove. + (scop_detection::harmful_loop_in_region): Remove premature + IV type restriction. + (scop_detection::graphite_can_represent_scev): We can handle + pointer IVs just fine. + +2017-10-13 Alan Modra + + * doc/extend.texi (Extended Asm ): Rename to + "Clobbers and Scratch Registers". Add paragraph on + alternative to clobbers for scratch registers and OpenBLAS + example. + +2017-10-13 Alan Modra + + * doc/extend.texi (Clobbers): Correct vax example. Delete old + example of a memory input for a string of known length. Move + commentary out of table. Add a number of new examples + covering array memory inputs. + +2017-10-12 Martin Liska + + PR tree-optimization/82493 + * sbitmap.c (bitmap_bit_in_range_p): Fix the implementation. + (test_range_functions): New function. + (sbitmap_c_tests): Likewise. + * selftest-run-tests.c (selftest::run_tests): Run new tests. + * selftest.h (sbitmap_c_tests): New function. + + * tree-ssa-dse.c (live_bytes_read): Fix thinko. + +2017-10-12 Michael Meissner + + * config/rs6000/amo.h: Fix spacing issue. + +2017-10-12 Jakub Jelinek + + PR target/82498 + * config/i386/i386.md (*ashl3_mask_1, + *3_mask_1, *3_mask_1, + *_mask_1, *btr_mask_1): New define_insn_and_split + patterns. + +2017-10-12 Jan Hubicka + + * profile-count.h (safe_scale_64bit): Fix GCC4.x path. + (profile_probability): Set max_probability + to (uint32_t) 1 << (n_bits - 2) and update accessors to avoid overlfows + in temporaries. + * profile-count.c (profile_probability::differs_from_p): Do not + rely on max_probaiblity == 10000 + +2017-10-12 Jeff Law + + * tree-ssa-dse.c (valid_ao_ref_for_dse): Reject ao_refs with + negative offsets. + +2017-10-12 Martin Sebor + + PR other/82301 + PR c/82435 + * cgraphunit.c (maybe_diag_incompatible_alias): New function. + (handle_alias_pairs): Call it. + * common.opt (-Wattribute-alias): New option. + * doc/extend.texi (ifunc attribute): Discuss C++ specifics. + * doc/invoke.texi (-Wattribute-alias): Document. + +2017-10-12 Vladimir Makarov + + Revert + 2017-10-11 Vladimir Makarov + PR sanitizer/82353 + * lra.c (collect_non_operand_hard_regs): Don't ignore operator + locations. + * lra-lives.c (bb_killed_pseudos, bb_gen_pseudos): Move up. + (make_hard_regno_born, make_hard_regno_dead): Update + bb_killed_pseudos and bb_gen_pseudos. + +2017-10-12 Jan Hubicka + + * config/i386/x86-tune-sched.c (ix86_adjust_cost): Fix Zen support. + +2017-10-12 Uros Bizjak + + * config/alpha/alpha.c (alpha_split_conditional_move): + Use std::swap instead of manually swapping. + (alpha_stdarg_optimize_hook): Ditto. + (alpha_canonicalize_comparison): Ditto. + +2017-10-12 Bin Cheng + + * tree-loop-distribution.c (struct builtin_info): New struct. + (struct partition): Refactor fields into struct builtin_info. + (partition_free): Free struct builtin_info. + (build_size_arg_loc, build_addr_arg_loc): Delete. + (generate_memset_builtin, generate_memcpy_builtin): Get memory range + information from struct builtin_info. + (find_single_drs): New function refactored from classify_partition. + Also moved builtin validity checks to this function. + (compute_access_range, alloc_builtin): New functions. + (classify_builtin_st, classify_builtin_ldst): New functions. + (classify_partition): Refactor code into functions find_single_drs, + classify_builtin_st and classify_builtin_ldst. + (distribute_loop): Don't do runtime alias check when distributing + loop nest. + (find_seed_stmts_for_distribution): New function. + (pass_loop_distribution::execute): Refactor code finding seed + stmts into above function. Support distribution for the innermost + two-level loop nest. Adjust dump information. + +2017-10-12 Bin Cheng + + * tree-loop-distribution.c: Adjust the general comment. + (NUM_PARTITION_THRESHOLD): New macro. + (ssa_name_has_uses_outside_loop_p): Support loop nest distribution. + (classify_partition): Skip builtin pattern of loop nest's inner loop. + (merge_dep_scc_partitions): New parameter ignore_alias_p and use it + in call to build_partition_graph. + (finalize_partitions): New parameter. Make loop distribution more + conservative by fusing more partitions. + (distribute_loop): Don't do runtime alias check in case of loop nest + distribution. + (find_seed_stmts_for_distribution): New function. + (prepare_perfect_loop_nest): New function. + (pass_loop_distribution::execute): Refactor code finding seed stmts + and loop nest into above functions. Support loop nest distribution. + Adjust dump information accordingly. + +2017-10-12 Bin Cheng + + * tree-loop-distribution.c (break_alias_scc_partitions): Add comment + and set PTYPE_SEQUENTIAL for merged partition. + +2017-10-12 Richard Biener + + PR tree-optimization/69728 + Revert + 2017-09-19 Richard Biener + + PR tree-optimization/69728 + * graphite-sese-to-poly.c (schedule_error): New global. + (add_loop_schedule): Handle empty domain by failing the + schedule. + (build_original_schedule): Handle schedule_error. + + * graphite-sese-to-poly.c (add_loop_schedule): Handle empty + domain by returning an unchanged schedule. + +2017-10-12 Jakub Jelinek + + * genrecog.c (validate_pattern): For VEC_SELECT verify that + CONST_INT selectors are 0 to GET_MODE_NUNITS (imode) - 1. + +2017-10-12 Aldy Hernandez + + * Makefile.in (TAGS): Merge all the *.def files into one pattern. + Handle params.def. + +2017-10-12 Jakub Jelinek + + PR c++/82159 + * expr.c (store_field): Don't optimize away bitsize == 0 store + from CALL_EXPR with addressable return type. + +2017-10-11 Segher Boessenkool + + * config/rs6000/rs6000.h (TARGET_ISEL64): Delete. + * config/rs6000/rs6000.md (sel): Delete mode attribute. + (movcc, isel_signed_, isel_unsigned_, + *isel_reversed_signed_, *isel_reversed_unsigned_): Use + TARGET_ISEL instead of TARGET_ISEL. + +2017-10-11 David Edelsohn + + * config/rs6000/rs6000.c + (rs6000_xcoff_asm_output_aligned_decl_common): Test for NULL decl. + +2017-10-11 Segher Boessenkool + + * config/rs6000/predicates.md (zero_constant, all_ones_constant): + Move up in file. + (reg_or_cint_operand): Fix comment. + (reg_or_zero_operand): New predicate. + * config/rs6000/rs6000-protos.h (output_isel): Delete. + * config/rs6000/rs6000.c (output_isel): Delete. + * config/rs6000/rs6000.md (isel_signed_): Use reg_or_zero_operand + instead of reg_or_cint_operand. Output instruction directly (not via + output_isel). + (isel_unsigned_): Ditto. + (*isel_reversed_signed_): Use reg_or_zero_operand instead of + gpc_reg_operand. Add an instruction alternative for this. Output + instruction directly. + (*isel_reversed_unsigned_): Ditto. + +2017-10-11 Uros Bizjak + + * config/i386/i386.c (ix86_canonicalize_comparison): New function. + (TARGET_CANONICALIZE_COMPARISON): Define. + +2017-10-11 Qing Zhao + + PR target/81422 + * config/aarch64/aarch64.c (aarch64_load_symref_appropriately): + Check whether the dest is REG before adding REG_EQUIV note. + +2017-10-11 Vladimir Makarov + + PR sanitizer/82353 + * lra.c (collect_non_operand_hard_regs): Don't ignore operator + locations. + * lra-lives.c (bb_killed_pseudos, bb_gen_pseudos): Move up. + (make_hard_regno_born, make_hard_regno_dead): Update + bb_killed_pseudos and bb_gen_pseudos. + +2017-10-11 Nathan Sidwell + + * incpath.h (enum incpath_kind): Name enum, prefix values. + (add_path, add_cpp_dir_path, get_added_cpp_dirs): Use incpath_kind. + * incpath.c (heads, tails): Use INC_MAX. + (add_env_var_paths, add_standard_paths): Use incpath_kind. + (merge_include_chains, split_quote_chain, + register_include_chains): Update incpath_kind names. + (add_cpp_dir_path, add_path, get_added_cpp_dirs): Use incpath_kind. + * config/darwin-c.c (add_system_framework_path): Update incpath_kind + names. + (add_framework_path, darwin_register_objc_includes): Likewise. + * config/vms/vms-c.c (vms_c_register_includes): Likewise. + +2017-10-11 Uros Bizjak + + * config/i386/i386.md (*cmp__i387): + Do not use float_operator operator predicate. + (*cmp__cc_i387): Ditto. + * config/i386/predicates.md (float_operator): Remove predicate. + +2017-10-11 Uros Bizjak + + * config/i386/i386.md (*jcc_0_i387): Remove insn pattern. + (*jccxf_i387): Ditto. + (*jcc_i387): Ditto. + (*jccu_i387): Ditto. + (*jcc__i387): Ditto. + (*jcc_*_i387 splitters): Remove. + * config/i386/i386-protos.h (ix86_split_fp_branch): Remove prototype. + * config/i386/i386.c (ix86_split_fp_branch): Remove. + * config/i386/predicates.md (ix86_swapped_fp_comparison_operator): + Remove predicate. + +2017-10-11 Jan Hubicka + + * profile-count.h (slow_safe_scale_64bit): New function. + (safe_scale_64bit): New inline. + (profile_count::max_safe_multiplier): Remove; use safe_scale_64bit. + * profile-count.c: Include wide-int.h + (slow_safe_scale_64bit): New. + +2017-10-11 Nathan Sidwell + + * tree.h (DECL_ASSEMBLER_NAME_SET_P): Don't check + HAS_DECL_ASSEMBLER_NAME_P. + * gimple-expr.c (gimple_decl_printable_name: Check + HAS_DECL_ASSEMBLER_NAME_P too. + * ipa-utils.h (type_in_anonymous_namespace_p): Check + DECL_ASSEMBLER_NAME_SET_P of TYPE_NAME. + (odr_type_p): No need to assert TYPE_NAME is a TYPE_DECL. + * passes.c (rest_of_decl_compilation): Check + HAS_DECL_ASSEMBLER_NAME_P too. + * recog.c (verify_changes): Likewise. + * tree-pretty-print.c (dump_decl_name): Likewise. + * tree-ssa-structalias.c (alias_get_name): Likewise. Reimplement. + + * tree.h (DECL_ASSEMBLER_NAME_RAW): New. + (SET_DECL_ASSEMBLER_NAME): Use it. + (DECL_ASSEMBLER_NAME_SET_P): Likewise. + (COPY_DECL_ASSEMBLER_NAME): Likewise. + * tree.c (decl_assembler_name): Use DECL_ASSEMBLER_NAME_RAW. + +2017-10-11 Jan Hubicka + + * config.gcc (i386, x86_64): Add extra objects. + * config/i386/i386-protos.h (ix86_rip_relative_addr_p): Declare. + (ix86_min_insn_size): Declare. + (ix86_issue_rate): Declare. + (ix86_adjust_cost): Declare. + (ia32_multipass_dfa_lookahead): Declare. + (ix86_macro_fusion_p): Declare. + (ix86_macro_fusion_pair_p): Declare. + (ix86_bd_has_dispatch): Declare. + (ix86_bd_do_dispatch): Declare. + (ix86_core2i7_init_hooks): Declare. + (ix86_atom_sched_reorder): Declare. + * config/i386/i386.c Move all CPU cost tables to x86-tune-costs.h. + (COSTS_N_BYTES): Move to x86-tune-costs.h. + (DUMMY_STRINGOP_ALGS):Move to x86-tune-costs.h. + (rip_relative_addr_p): Rename to ... + (ix86_rip_relative_addr_p): ... this one; export. + (memory_address_length): Update. + (ix86_issue_rate): Move to x86-tune-sched.c. + (ix86_flags_dependent): Move to x86-tune-sched.c. + (ix86_agi_dependent): Move to x86-tune-sched.c. + (exact_dependency_1): Move to x86-tune-sched.c. + (exact_store_load_dependency): Move to x86-tune-sched.c. + (ix86_adjust_cost): Move to x86-tune-sched.c. + (ia32_multipass_dfa_lookahead): Move to x86-tune-sched.c. + (ix86_macro_fusion_p): Move to x86-tune-sched.c. + (ix86_macro_fusion_pair_p): Move to x86-tune-sched.c. + (do_reorder_for_imul): Move to x86-tune-sched-atom.c. + (swap_top_of_ready_list): Move to x86-tune-sched-atom.c. + (ix86_sched_reorder): Move to x86-tune-sched-atom.c. + (core2i7_first_cycle_multipass_init): Move to x86-tune-sched-core.c. + (core2i7_dfa_post_advance_cycle): Move to x86-tune-sched-core.c. + (min_insn_size): Rename to ... + (ix86_min_insn_size): ... this one; export. + (core2i7_first_cycle_multipass_begin): Move to x86-tune-sched-core.c. + (core2i7_first_cycle_multipass_issue): Move to x86-tune-sched-core.c. + (core2i7_first_cycle_multipass_backtrack): Move to + x86-tune-sched-core.c. + (core2i7_first_cycle_multipass_end): Move to x86-tune-sched-core.c. + (core2i7_first_cycle_multipass_fini): Move to x86-tune-sched-core.c. + (ix86_sched_init_global): Break up logic to ix86_core2i7_init_hooks. + (ix86_avoid_jump_mispredicts): Update. + (TARGET_SCHED_DISPATCH): Move to ix86-tune-sched-bd.c. + (TARGET_SCHED_DISPATCH_DO): Move to ix86-tune-sched-bd.c. + (TARGET_SCHED_REORDER): Move to ix86-tune-sched-bd.c. + (DISPATCH_WINDOW_SIZE): Move to ix86-tune-sched-bd.c. + (MAX_DISPATCH_WINDOWS): Move to ix86-tune-sched-bd.c. + (MAX_INSN): Move to ix86-tune-sched-bd.c. + (MAX_IMM): Move to ix86-tune-sched-bd.c. + (MAX_IMM_SIZE): Move to ix86-tune-sched-bd.c. + (MAX_IMM_32): Move to ix86-tune-sched-bd.c. + (MAX_IMM_64): Move to ix86-tune-sched-bd.c. + (MAX_LOAD): Move to ix86-tune-sched-bd.c. + (MAX_STORE): Move to ix86-tune-sched-bd.c. + (BIG): Move to ix86-tune-sched-bd.c. + (enum dispatch_group): Move to ix86-tune-sched-bd.c. + (enum insn_path): Move to ix86-tune-sched-bd.c. + (get_mem_group): Move to ix86-tune-sched-bd.c. + (is_cmp): Move to ix86-tune-sched-bd.c. + (dispatch_violation): Move to ix86-tune-sched-bd.c. + (is_branch): Move to ix86-tune-sched-bd.c. + (is_prefetch): Move to ix86-tune-sched-bd.c. + (init_window): Move to ix86-tune-sched-bd.c. + (allocate_window): Move to ix86-tune-sched-bd.c. + (init_dispatch_sched): Move to ix86-tune-sched-bd.c. + (is_end_basic_block): Move to ix86-tune-sched-bd.c. + (process_end_window): Move to ix86-tune-sched-bd.c. + (allocate_next_window): Move to ix86-tune-sched-bd.c. + (find_constant): Move to ix86-tune-sched-bd.c. + (get_num_immediates): Move to ix86-tune-sched-bd.c. + (has_immediate): Move to ix86-tune-sched-bd.c. + (get_insn_path): Move to ix86-tune-sched-bd.c. + (get_insn_group): Move to ix86-tune-sched-bd.c. + (count_num_restricted): Move to ix86-tune-sched-bd.c. + (fits_dispatch_window): Move to ix86-tune-sched-bd.c. + (add_insn_window): Move to ix86-tune-sched-bd.c. + (add_to_dispatch_window): Move to ix86-tune-sched-bd.c. + (debug_dispatch_window_file): Move to ix86-tune-sched-bd.c. + (debug_dispatch_window): Move to ix86-tune-sched-bd.c. + (debug_insn_dispatch_info_file): Move to ix86-tune-sched-bd.c. + (debug_ready_dispatch): Move to ix86-tune-sched-bd.c. + (do_dispatch): Move to ix86-tune-sched-bd.c. + (has_dispatch): Move to ix86-tune-sched-bd.c. + * config/i386/t-i386: Add new object files. + * config/i386/x86-tune-costs.h: New file. + * config/i386/x86-tune-sched-atom.c: New file. + * config/i386/x86-tune-sched-bd.c: New file. + * config/i386/x86-tune-sched-core.c: New file. + * config/i386/x86-tune-sched.c: New file. + +2017-10-11 Liu Hao + + * pretty-print.c [_WIN32] (colorize_init): Remove. Use + the generic version below instead. + (should_colorize): Recognize Windows consoles as terminals + for MinGW targets. + * pretty-print.c [__MINGW32__] (write_all): New function. + [__MINGW32__] (find_esc_head): Likewise. + [__MINGW32__] (find_esc_terminator): Likewise. + [__MINGW32__] (eat_esc_sequence): Likewise. + [__MINGW32__] (mingw_ansi_fputs): New function that handles + ANSI escape codes. + (pp_write_text_to_stream): Use mingw_ansi_fputs instead of fputs + for MinGW targets. + +2017-10-11 Richard Biener + + * tree-ssa-loop-niter.c (infer_loop_bounds_from_pointer_arith): + Properly call analyze_scalar_evolution with the loop of the stmt. + +2017-10-11 Richard Biener + + * tree.def (POLYNOMIAL_CHREC): Remove CHREC_VARIABLE tree operand. + * tree-core.h (tree_base): Add chrec_var union member. + * tree.h (CHREC_VAR): Remove. + (CHREC_LEFT, CHREC_RIGHT, CHREC_VARIABLE): Adjust. + * tree-chrec.h (build_polynomial_chrec): Adjust. + * tree-chrec.c (reset_evolution_in_loop): Use build_polynomial_chrec. + * tree-pretty-print.c (dump_generic_node): Use CHREC_VARIABLE. + +2017-10-11 Marc Glisse + + * fold-const.c (fold_binary_loc) [X +- Y CMP X]: Move ... + * match.pd: ... here. + ((T) X == (T) Y): Relax condition. + +2017-10-11 Bin Cheng + + PR tree-optimization/82472 + * tree-loop-distribution.c (sort_partitions_by_post_order): Refine + comment. + (break_alias_scc_partitions): Update postorder number. + +2017-10-11 Martin Liska + + PR sanitizer/82490 + * opts.c (parse_no_sanitize_attribute): Do not use error_value + variable. + * opts.h (parse_no_sanitize_attribute): Remove last argument. + +2017-10-11 Martin Liska + + * print-rtl.c (print_insn): Move declaration of idbuf + to same scope as name. + +2017-10-11 Martin Liska + + Revert r253637: + + PR sanitizer/82484 + * sanopt.c (sanitize_rewrite_addressable_params): Do not handle + volatile arguments. + +2017-10-11 Martin Liska + + PR sanitizer/82484 + * sanopt.c (sanitize_rewrite_addressable_params): Do not handle + volatile arguments. + +2017-10-11 Adhemerval Zanella + + * config.gcc (default_gnu_indirect_function): Default to yes for + arm*-*-linux* with glibc. + +2017-10-11 Richard Biener + + * tree-scalar-evolution.c (get_scalar_evolution): Handle + default-defs and types we do not want to analyze. + (interpret_loop_phi): Replace unreachable code with an assert. + (compute_scalar_evolution_in_loop): Remove and inline ... + (analyze_scalar_evolution_1): ... here, replacing condition with + what makes the intent clearer. Remove handling of cases + get_scalar_evolution now handles. + +2017-10-10 Jim Wilson + + PR rtl-optimization/81434 + * haifa-sched.c (prune_ready_list): Init min_cost_group to 0. Update + comment for main loop. In sched_group_found if, also add checks for + pass and min_cost_group. + +2017-10-10 Segher Boessenkool + + * config/rs6000/rs6000.c (TARGET_INSN_COST): New. + (rs6000_insn_cost): New function. + * config/rs6000/rs6000.md (cost): New attribute. + +2017-10-10 Jakub Jelinek + H.J. Lu + + PR target/79565 + PR target/82483 + * config/i386/i386.c (ix86_init_mmx_sse_builtins): Add + OPTION_MASK_ISA_MMX for __builtin_ia32_maskmovq, + __builtin_ia32_vec_ext_v4hi and __builtin_ia32_vec_set_v4hi. + (ix86_expand_builtin): Treat OPTION_MASK_ISA_MMX similarly + to OPTION_MASK_ISA_AVX512VL - builtins that have both + OPTION_MASK_ISA_MMX and some other bit set require both + mmx and the ISAs without the mmx bit. + * config/i386/i386-builtin.def (__builtin_ia32_cvtps2pi, + __builtin_ia32_cvttps2pi, __builtin_ia32_cvtpi2ps, + __builtin_ia32_pavgb, __builtin_ia32_pavgw, __builtin_ia32_pmulhuw, + __builtin_ia32_pmaxub, __builtin_ia32_pmaxsw, __builtin_ia32_pminub, + __builtin_ia32_pminsw, __builtin_ia32_psadbw, __builtin_ia32_pmovmskb, + __builtin_ia32_pshufw, __builtin_ia32_cvtpd2pi, + __builtin_ia32_cvttpd2pi, __builtin_ia32_cvtpi2pd, + __builtin_ia32_pmuludq, __builtin_ia32_pabsb, __builtin_ia32_pabsw, + __builtin_ia32_pabsd, __builtin_ia32_phaddw, __builtin_ia32_phaddd, + __builtin_ia32_phaddsw, __builtin_ia32_phsubw, __builtin_ia32_phsubd, + __builtin_ia32_phsubsw, __builtin_ia32_pmaddubsw, + __builtin_ia32_pmulhrsw, __builtin_ia32_pshufb, __builtin_ia32_psignb, + __builtin_ia32_psignw, __builtin_ia32_psignd, __builtin_ia32_movntq, + __builtin_ia32_paddq, __builtin_ia32_psubq, __builtin_ia32_palignr): + Add OPTION_MASK_ISA_MMX. + +2017-10-10 Andreas Tobler + + * config.gcc (armv7*-*-freebsd*): New target. + (armv6*-*-freebsd*): Remove obsolete TARGET_FREEBSD_ARMv6 define. + +2017-10-10 Jan Hubicka + + * x86-tune.def (X86_TUNE_AVOID_FALSE_DEP_FOR_BMI, + X86_TUNE_ADJUST_UNROLL, X86_TUNE_ONE_IF_CONV_INSN): Move to right + spot in the file. + +2017-10-10 Richard Sandiford + + * wide-int.h (wide_int_ref_storage): Make host_dependent_precision + a template parameter. + (WIDE_INT_REF_FOR): Update accordingly. + * tree.h (wi::int_traits ): Delete. + (wi::tree_to_widest_ref, wi::tree_to_offset_ref): New typedefs. + (wi::to_widest, wi::to_offset): Use them. Expand commentary. + (wi::tree_to_wide_ref): New typedef. + (wi::to_wide): New function. + * calls.c (get_size_range): Use wi::to_wide when operating on + trees as wide_ints. + * cgraph.c (cgraph_node::create_thunk): Likewise. + * config/i386/i386.c (ix86_data_alignment): Likewise. + (ix86_local_alignment): Likewise. + * dbxout.c (stabstr_O): Likewise. + * dwarf2out.c (add_scalar_info, gen_enumeration_type_die): Likewise. + * expr.c (const_vector_from_tree): Likewise. + * fold-const-call.c (host_size_t_cst_p, fold_const_call_1): Likewise. + * fold-const.c (may_negate_without_overflow_p, negate_expr_p) + (fold_negate_expr_1, int_const_binop_1, const_binop) + (fold_convert_const_int_from_real, optimize_bit_field_compare) + (all_ones_mask_p, sign_bit_p, unextend, extract_muldiv_1) + (fold_div_compare, fold_single_bit_test, fold_plusminus_mult_expr) + (pointer_may_wrap_p, expr_not_equal_to, fold_binary_loc) + (fold_ternary_loc, multiple_of_p, fold_negate_const, fold_abs_const) + (fold_not_const, round_up_loc): Likewise. + * gimple-fold.c (gimple_fold_indirect_ref): Likewise. + * gimple-ssa-warn-alloca.c (alloca_call_type_by_arg): Likewise. + (alloca_call_type): Likewise. + * gimple.c (preprocess_case_label_vec_for_gimple): Likewise. + * godump.c (go_output_typedef): Likewise. + * graphite-sese-to-poly.c (tree_int_to_gmp): Likewise. + * internal-fn.c (get_min_precision): Likewise. + * ipa-cp.c (ipcp_store_vr_results): Likewise. + * ipa-polymorphic-call.c + (ipa_polymorphic_call_context::ipa_polymorphic_call_context): Likewise. + * ipa-prop.c (ipa_print_node_jump_functions_for_edge): Likewise. + (ipa_modify_call_arguments): Likewise. + * match.pd: Likewise. + * omp-low.c (scan_omp_1_op, lower_omp_ordered_clauses): Likewise. + * print-tree.c (print_node_brief, print_node): Likewise. + * stmt.c (expand_case): Likewise. + * stor-layout.c (layout_type): Likewise. + * tree-affine.c (tree_to_aff_combination): Likewise. + * tree-cfg.c (group_case_labels_stmt): Likewise. + * tree-data-ref.c (dr_analyze_indices): Likewise. + (prune_runtime_alias_test_list): Likewise. + * tree-dump.c (dequeue_and_dump): Likewise. + * tree-inline.c (remap_gimple_op_r, copy_tree_body_r): Likewise. + * tree-predcom.c (is_inv_store_elimination_chain): Likewise. + * tree-pretty-print.c (dump_generic_node): Likewise. + * tree-scalar-evolution.c (iv_can_overflow_p): Likewise. + (simple_iv_with_niters): Likewise. + * tree-ssa-address.c (addr_for_mem_ref): Likewise. + * tree-ssa-ccp.c (ccp_finalize, evaluate_stmt): Likewise. + * tree-ssa-loop-ivopts.c (constant_multiple_of): Likewise. + * tree-ssa-loop-niter.c (split_to_var_and_offset) + (refine_value_range_using_guard, number_of_iterations_ne_max) + (number_of_iterations_lt_to_ne, number_of_iterations_lt) + (get_cst_init_from_scev, record_nonwrapping_iv) + (scev_var_range_cant_overflow): Likewise. + * tree-ssa-phiopt.c (minmax_replacement): Likewise. + * tree-ssa-pre.c (compute_avail): Likewise. + * tree-ssa-sccvn.c (vn_reference_fold_indirect): Likewise. + (vn_reference_maybe_forwprop_address, valueized_wider_op): Likewise. + * tree-ssa-structalias.c (get_constraint_for_ptr_offset): Likewise. + * tree-ssa-uninit.c (is_pred_expr_subset_of): Likewise. + * tree-ssanames.c (set_nonzero_bits, get_nonzero_bits): Likewise. + * tree-switch-conversion.c (collect_switch_conv_info, array_value_type) + (dump_case_nodes, try_switch_expansion): Likewise. + * tree-vect-loop-manip.c (vect_gen_vector_loop_niters): Likewise. + (vect_do_peeling): Likewise. + * tree-vect-patterns.c (vect_recog_bool_pattern): Likewise. + * tree-vect-stmts.c (vectorizable_load): Likewise. + * tree-vrp.c (compare_values_warnv, vrp_int_const_binop): Likewise. + (zero_nonzero_bits_from_vr, ranges_from_anti_range): Likewise. + (extract_range_from_binary_expr_1, adjust_range_with_scev): Likewise. + (overflow_comparison_p_1, register_edge_assert_for_2): Likewise. + (is_masked_range_test, find_switch_asserts, maybe_set_nonzero_bits) + (vrp_evaluate_conditional_warnv_with_ops, intersect_ranges): Likewise. + (range_fits_type_p, two_valued_val_range_p, vrp_finalize): Likewise. + (evrp_dom_walker::before_dom_children): Likewise. + * tree.c (cache_integer_cst, real_value_from_int_cst, integer_zerop) + (integer_all_onesp, integer_pow2p, integer_nonzerop, tree_log2) + (tree_floor_log2, tree_ctz, mem_ref_offset, tree_int_cst_sign_bit) + (tree_int_cst_sgn, get_unwidened, int_fits_type_p): Likewise. + (get_type_static_bounds, num_ending_zeros, drop_tree_overflow) + (get_range_pos_neg): Likewise. + * ubsan.c (ubsan_expand_ptr_ifn): Likewise. + * config/darwin.c (darwin_mergeable_constant_section): Likewise. + * config/aarch64/aarch64.c (aapcs_vfp_sub_candidate): Likewise. + * config/arm/arm.c (aapcs_vfp_sub_candidate): Likewise. + * config/avr/avr.c (avr_fold_builtin): Likewise. + * config/bfin/bfin.c (bfin_local_alignment): Likewise. + * config/msp430/msp430.c (msp430_attr): Likewise. + * config/nds32/nds32.c (nds32_insert_attributes): Likewise. + * config/powerpcspe/powerpcspe-c.c + (altivec_resolve_overloaded_builtin): Likewise. + * config/powerpcspe/powerpcspe.c (rs6000_aggregate_candidate) + (rs6000_expand_ternop_builtin): Likewise. + * config/rs6000/rs6000-c.c + (altivec_resolve_overloaded_builtin): Likewise. + * config/rs6000/rs6000.c (rs6000_aggregate_candidate): Likewise. + (rs6000_expand_ternop_builtin): Likewise. + * config/s390/s390.c (s390_handle_hotpatch_attribute): Likewise. + +2017-10-10 Bin Cheng + + * tree-vect-loop-manip.c (rename_variables_in_bb): Rename PHI nodes + when copying loop nest with only one inner loop. + +2017-10-10 Richard Biener + + * tree-cfgcleanup.c (cleanup_tree_cfg_noloop): Avoid compacting + blocks if SCEV is active. + * tree-scalar-evolution.c (analyze_scalar_evolution_1): Remove + dead code. + (analyze_scalar_evolution): Handle cached evolutions the obvious way. + (scev_initialize): Assert we are not yet initialized. + +2017-10-10 Bin Cheng + + * tree-loop-distribution.c (generate_loops_for_partition): Remove + inner loop's exit stmt by making it always exit the loop, otherwise + we would generate an infinite empty loop. + +2017-10-10 Bin Cheng + + * tree-vect-loop-manip.c (slpeel_tree_duplicate_loop_to_edge_cfg): Skip + renaming variables in new preheader if it's deleted. + +2017-10-10 Bin Cheng + + * tree-loop-distribution.c (struct partition): Remove unused field + loops of the structure. + (partition_alloc, partition_free): Ditto. + (build_rdg_partition_for_vertex): Ditto. + +2017-10-09 Jeff Law + + * targhooks.c (default_stack_clash_protection_final_dynamic_probe): Fix + return type to match prototype and documentation. + +2010-10-09 Segher Boessenkool + + * config/rs6000/rs6000.c (processor_costs): Move to ... + * config/rs6000/rs6000.h: ... here. + (rs6000_cost): Declare. + +2017-10-09 Eric Botcazou + + * except.c (setjmp_fn): New global variable. + (init_eh): Initialize it if DONT_USE_BUILTIN_SETJMP is defined. + (sjlj_emit_function_enter): Call it instead of BUILTIN_SETJMP + if DONT_USE_BUILTIN_SETJMP is defined. + +2017-10-09 Segher Boessenkool + + * target.def (insn_cost): New hook. + * doc/tm.texi.in (TARGET_INSN_COST): New hook. + * doc/tm.texi: Regenerate. + * rtlanal.c (insn_cost): Use the new hook. + +2017-10-09 Segher Boessenkool + + * combine.c (combine_validate_cost): Compute the new insn_cost, + not just pattern_cost. + (try_combine): Adjust comment. + +2017-10-09 Segher Boessenkool + + * cfgrtl.c (rtl_account_profile_record): Replace insn_rtx_cost with + insn_cost. + * combine.c (uid_insn_cost): Adjust comment. + (combine_validate_cost): Adjust comment. Use pattern_cost instead + of insn_rtx_cost + (combine_instructions): Use insn_cost instead of insn_rtx_cost. + * dse.c (find_shift_sequence): Ditto. + * ifcvt.c (cheap_bb_rtx_cost_p): Ditto. + (bb_valid_for_noce_process_p): Use pattern_cost. + * rtl.h (insn_rtx_cost): Delete. + (pattern_cost): New prototype. + (insn_cost): New prototype. + * rtlanal.c (insn_rtx_cost): Rename to... + (pattern_cost): ... this. + (insn_cost): New. + +2017-10-09 Uros Bizjak + + * config/i386/i386.md (*jcc_2): Remove insn pattern. + (*jcc_0_r_i387): Ditto. + (*jccxf_r_i387): Ditto. + (*jcc_r_i387): Ditto. + (*jccu_r_i387): Ditto. + (*jcc__r_i387): Ditto. + (*jcc): Rename from *jcc_1. + +2017-10-09 Bill Schmidt + + * config/rs6000/rs6000-p8swap.c (rs6000_analyze_swaps): Process + deferred rescans after the lvx/stvx recombination pre-pass. + +2017-10-09 Michael Meissner + + * config/rs6000/amo.h: New include file to provide ISA 3.0 atomic + memory operation instruction support. + * config.gcc (powerpc*-*-*): Include amo.h as an extra header. + (rs6000-ibm-aix[789]*): Likewise. + * doc/extend.texi (PowerPC Atomic Memory Operation Functions): + Document new functions. + +2017-10-09 Richard Biener + + PR tree-optimization/82397 + * tree-data-ref.c (data_ref_compare_tree): Make sure to return + equality only for semantically equal trees. + +2017-10-09 Richard Biener + + PR tree-optimization/82449 + * sese.c (scev_analyzable_p): Check whether the SCEV is linear. + * tree-chrec.h (evolution_function_is_constant_p): Adjust to + allow constant addresses. + * tree-chrec.c (scev_is_linear_expression): Constant evolutions + are linear. + +2017-10-09 Andreas Krebbel + + * config/s390/s390-builtins.def (vec_nabs, vec_vfi): Fix builtin + flags. + +2017-10-09 Andreas Krebbel + + PR target/82463 + * config/s390/vecintrin.h (vec_madd, vec_msub): Fix macro + definitions. + +2017-10-09 Andreas Krebbel + + PR target/82465 + * config/s390/s390-builtins.def (vec_sqrt): Fix builtin flags. + +2017-10-09 Jakub Jelinek + + PR target/82464 + * config/s390/s390-builtins.def (s390_vec_xor_flt_a, + s390_vec_xor_flt_b, s390_vec_xor_flt_c): New. + +2017-10-09 Richard Sandiford + + * wide-int.h (WI_BINARY_OPERATOR_RESULT): New macro. + (WI_BINARY_PREDICATE_RESULT): Likewise. + (wi::binary_traits::operator_result): New type. + (wi::binary_traits::predicate_result): Likewise. + (generic_wide_int::operator~, unary generic_wide_int::operator-) + (generic_wide_int::operator==, generic_wide_int::operator!=) + (generic_wide_int::operator&, generic_wide_int::and_not) + (generic_wide_int::operator|, generic_wide_int::or_not) + (generic_wide_int::operator^, generic_wide_int::operator+ + (binary generic_wide_int::operator-, generic_wide_int::operator*): + Delete. + (operator~, unary operator-, operator==, operator!=, operator&) + (operator|, operator^, operator+, binary operator-, operator*): New + functions. + * expr.c (get_inner_reference): Use wi::bit_and_not. + * fold-const.c (fold_binary_loc): Likewise. + * ipa-prop.c (ipa_compute_jump_functions_for_edge): Likewise. + * tree-ssa-ccp.c (get_value_from_alignment): Likewise. + (bit_value_binop): Likewise. + * tree-ssa-math-opts.c (find_bswap_or_nop_load): Likewise. + * tree-vrp.c (zero_nonzero_bits_from_vr): Likewise. + (extract_range_from_binary_expr_1): Likewise. + (masked_increment): Likewise. + (simplify_bit_ops_using_ranges): Likewise. + +2017-10-09 Martin Jambor + + PR hsa/82416 + * hsa-common.h (hsa_op_with_type): New method extend_int_to_32bit. + * hsa-gen.c (hsa_extend_inttype_to_32bit): New function. + (hsa_type_for_scalar_tree_type): Use it. Always force min32int for + COMPLEX types. + (hsa_fixup_mov_insn_type): New function. + (hsa_op_with_type::get_in_type): Use it. + (hsa_build_append_simple_mov): Likewise. Allow sub-32bit + immediates in an assert. + (hsa_op_with_type::extend_int_to_32bit): New method. + (gen_hsa_insns_for_bitfield): Fixup instruction and intermediary + types. Convert to dest type if necessary. + (gen_hsa_insns_for_bitfield_load): Fixup load type if necessary. + (reg_for_gimple_ssa): Pass false as min32int to + hsa_type_for_scalar_tree_type. + (gen_hsa_addr): Fixup type when creating addresable temporary. + (gen_hsa_cmp_insn_from_gimple): Extend operands if necessary. + (gen_hsa_unary_operation): Extend operands and convert to dest type if + necessary. Call hsa_fixup_mov_insn_type. + (gen_hsa_binary_operation): Changed operand types to hsa_op_with_type, + extend operands and convert to dest type if necessary. + (gen_hsa_insns_for_operation_assignment): Extend operands and convert + to dest type if necessary. + (set_output_in_type): Call hsa_fixup_mov_insn_type. Just ude dest + if conversion nt necessary and size matches. + (gen_hsa_insns_for_load): Call hsa_fixup_mov_insn_type, convert + to dest type if necessary. + (gen_hsa_insns_for_store): Call hsa_fixup_mov_insn_type. + (gen_hsa_insns_for_switch_stmt): Likewise. Also extend operands if + necessary. + (gen_hsa_clrsb): Likewise. + (gen_hsa_ffs): Likewise. + (gen_hsa_divmod): Extend operands and convert to dest type if + necessary. + (gen_hsa_atomic_for_builtin): Change type of op to hsa_op_with_type. + +2017-10-08 Segher Boessenkool + + * config/rs6000/rs6000.md (conditional branch): Clean up formatting. + Remove empty default arguments. Use a brace block as output + statement. + (conditional return): Ditto. + (jump): Ditto. + (indirect_jump): Ditto. Use b%T0 instead of bctr/blr. + (tablejump, tablejumpsi, tablejumpdi, *tablejump_internal1): + Ditto. + (group_ending_nop): Ditto. + (doloop_end): Ditto. + (ctr, ctr_internal1, ctr_internal2): Ditto. + (splitters for those): Ditto. + +2017-10-08 Segher Boessenkool + + * config/rs6000/rs6000-string.c (expand_strncmp_align_check): Invert + a conditional jump (and the compare for it) so that pc_rtx is the + last operand. + * config/rs6000/rs6000.c (rs6000_legitimate_combined_insn): Adjust + for the deleted and renamed ctr_internal[234] patterns. + * config/rs6000/rs6000.md: Delete second conditional branch pattern. + Delete second conditional return pattern. + (ctr_internal2): Delete this second bdnz pattern. + (ctr_internal3): Rename to ctr_internal2. + (ctr_internal4): Delete this second bdz pattern. + +2017-10-08 Eric Botcazou + + * tree-outof-ssa.h (ssaexpand): Add partitions_for_undefined_values. + (always_initialized_rtx_for_ssa_name_p): New predicate. + * tree-outof-ssa.c (remove_ssa_form): Initialize new field of SA. + (finish_out_of_ssa): Free new field of SA. + * tree-ssa-coalesce.h (get_undefined_value_partitions): Declare. + * tree-ssa-coalesce.c: Include tree-ssa.h. + (get_parm_default_def_partitions): Remove extern keyword. + (get_undefined_value_partitions): New function. + * expr.c (expand_expr_real_1) : For a SSA_NAME, do + not set SUBREG_PROMOTED_VAR_P on the sub-register if it may contain + uninitialized bits. + * loop-iv.c (iv_get_reaching_def): Disqualify all subregs. + +2017-10-08 Eric Botcazou + + * builtins.def (BUILT_IN_SETJMP): Revert latest change. + +2017-10-08 Jan Hubicka + + * config/i386/i386.c (ix86_expand_set_or_movmem): Disable 512bit loops + for targets that preffer 128bit. + +2017-10-08 Jan Hubicka + + * config/i386/i386.c (has_dispatch): Disable for Ryzen. + +2017-10-08 Olivier Hainque + + * config/arm/arm.c (arm_set_return_address): Use MEM_VOLATILE_P + on the target mem instead of RTX_FRAME_RELATED_P on the insn to + prevent DSE. + (thumb_set_return_address): Likewise. + +2017-10-08 Olivier Hainque + + * common/config/arm/arm-common.c (arm_except_unwind_info): + Handle DWARF2_UNWIND_INFO. + +2017-10-07 Michael Collison + + * config/aarch64/aarch64.md (*aarch64_reg__minus3): + New pattern. + +2017-10-07 Eric Botcazou + + * builtins.def (BUILT_IN_SETJMP): Declare as library builtin instead + of GCC builtin if DONT_USE_BUILTIN_SETJMP is defined. + * except.c (sjlj_emit_function_enter): If DONT_USE_BUILTIN_SETJMP is + defined, force the creation of a new block for a dispatch label. + +2017-10-07 Jan Hubicka + + * invoke.texi (Wsuggest-attribute=cold): Document. + * common.opt (Wsuggest-attribute=cold): New + * ipa-pure-const.c (warn_function_cold): New function. + * predict.c (compute_function_frequency): Use it. + * predict.h (warn_function_cold): Declare. + +2017-10-06 Jan Hubicka + + * tree-switch-conversion.c (do_jump_if_equal, emit_cmp_and_jump_insns): + Update profile. + 2017-10-06 Martin Liska * sanopt.c (struct sanopt_tree_triplet_hash): Remove inline @@ -156,8 +2192,8 @@ 2017-10-05 Jan Hubicka - * i386.c (ia32_multipass_dfa_lookahead): Default to issue rate - for post-reload scheduling. + * config/i386/i386.c (ia32_multipass_dfa_lookahead): Default to issue + rate for post-reload scheduling. 2017-10-05 Tamar Christina @@ -165,13 +2201,13 @@ 2017-10-05 Jan Hubicka - * i386.c (znver1_cost): Set branch_cost to 3 (instead of 2) + * config/i386/i386.c (znver1_cost): Set branch_cost to 3 (instead of 2) to improve monte carlo in scimark. 2017-10-05 Jan Hubicka - * i386.c (ix86_size_cost, i386_cost, i486_cost, pentium_cost, - lakemont_cost, pentiumpro_cost, geode_cost, k6_cost, + * config/i386/i386.c (ix86_size_cost, i386_cost, i486_cost, + pentium_cost, lakemont_cost, pentiumpro_cost, geode_cost, k6_cost, athlon_cost, k8_cost, amdfam10_cost, btver1_cost, btver2_cost, pentium4_cost, nocona_cost): Set reassociation width to 1. (bdver1_cost, bdver2_cost, bdver3_cost, bdver4_cost): Set reassociation @@ -179,13 +2215,14 @@ (znver1_cost): Set scalar reassoc width to 4 and vector to 3 and 6 for int and fp. (atom_cost): Set reassociation width to 2. - (slm_cost, generic_cost): Set fp reassociation width to 2 and 1 otherwise. + (slm_cost, generic_cost): Set fp reassociation width + to 2 and 1 otherwise. (intel_cost): Set fp reassociation width to 4 and 1 otherwise. (core_cost): Set fp reassociation width to 4 and vector to 2. (ix86_reassociation_width): Rewrite using cost table; special case plus/minus on Zen; honor X86_TUNE_SSE_SPLIT_REGS and TARGET_AVX128_OPTIMAL. - * i386.h (processor_costs): Add + * config/i386/i386.h (processor_costs): Add reassoc_int, reassoc_fp, reassoc_vec_int, reassoc_vec_fp. (TARGET_VECTOR_PARALLEL_EXECUTION, TARGET_REASSOC_INT_TO_PARALLEL, TARGET_REASSOC_FP_TO_PARALLEL): Remove. @@ -445,7 +2482,7 @@ (class dom_opt_dom_walker): Initialize m_dummy_cond member in the class ctor. (pass_dominator:execute): Build the dummy_cond here and pass it - to the dom_opt_dom_walker ctor. + to the dom_opt_dom_walker ctor. (test_for_singularity): New function. 2017-09-30 Krister Walfridsson @@ -890,7 +2927,7 @@ * rs6000.md (allocate_stack): Handle -fstack-clash-protection. (probe_stack_range): Operand 0 is now early-clobbered. Add additional operand and pass it to output_probe_stack_range. - + 2017-09-25 Bin Cheng PR tree-optimization/82163 @@ -1322,7 +3359,7 @@ 2017-09-22 Sergey Shalnov - * config/i386/sse.md ("mov_internal"): Use + * config/i386/sse.md ("mov_internal"): Use mode attribute for TARGET_AVX512VL. 2017-09-21 Sergey Shalnov @@ -1601,9 +3638,9 @@ (ix86_expand_prologue): Dump stack clash info as needed. Call ix86_adjust_stack_and_probe_stack_clash as needed. - * function.c (dump_stack_clash_frame_info): New function. - * function.h (dump_stack_clash_frame_info): Prototype. - (enum stack_clash_probes): New enum. + * function.c (dump_stack_clash_frame_info): New function. + * function.h (dump_stack_clash_frame_info): Prototype. + (enum stack_clash_probes): New enum. * config/alpha/alpha.c (alpha_expand_prologue): Also check flag_stack_clash_protection. diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 10c5712704c66..fedf1ea3d6714 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20171006 +20171020 diff --git a/gcc/Makefile.in b/gcc/Makefile.in index 0bde7acf91415..2809619031b7d 100644 --- a/gcc/Makefile.in +++ b/gcc/Makefile.in @@ -1568,6 +1568,7 @@ OBJS = \ tree-vrp.o \ tree.o \ typed-splay-tree.o \ + unique-ptr-tests.o \ valtrack.o \ value-prof.o \ var-tracking.o \ @@ -4135,8 +4136,7 @@ TAGS: lang.tags ../include/*.h ../libiberty/*.c \ ../libcpp/*.c ../libcpp/include/*.h \ --language=none --regex="/\(char\|unsigned int\|int\|bool\|void\|HOST_WIDE_INT\|enum [A-Za-z_0-9]+\) [*]?\([A-Za-z_0-9]+\)/\2/" common.opt \ - --language=none --regex="/\(DEF_RTL_EXPR\|DEFTREECODE\|DEFGSCODE\).*(\([A-Za-z_0-9]+\)/\2/" rtl.def tree.def gimple.def \ - --language=none --regex="/DEFTIMEVAR (\([A-Za-z_0-9]+\)/\1/" timevar.def \ + --language=none --regex="/\(DEF_RTL_EXPR\|DEFTREECODE\|DEFGSCODE\|DEFTIMEVAR\|DEFPARAM\|DEFPARAMENUM5\)[ ]?(\([A-Za-z_0-9]+\)/\2/" rtl.def tree.def gimple.def timevar.def params.def \ ; \ etags --include TAGS.sub $$incs) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f4588406422f0..dac7791a8e64b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,1018 @@ +2017-10-20 Doug Rupp + + * libgnarl/s-osinte__linux.ads (Relative_Timed_Wait): Add variable + needed for using monotonic clock. + * libgnarl/s-taprop__linux.adb: Revert previous monotonic clock + changes. + * libgnarl/s-taprop__linux.adb, s-taprop__posix.adb: Unify and factor + out monotonic clock related functions body. + (Timed_Sleep, Timed_Delay, Montonic_Clock, RT_Resolution, + Compute_Deadline): Move to... + * libgnarl/s-tpopmo.adb: ... here. New separate package body. + +2017-10-20 Ed Schonberg + + * sem_util.adb (Is_Controlling_Limited_Procedure): Handle properly the + case where the controlling formal is an anonymous access to interface + type. + * exp_ch9.adb (Extract_Dispatching_Call): If controlling actual is an + access type, handle properly the the constructed dereference that + designates the object used in the rewritten synchronized call. + (Parameter_Block_Pack): If the type of the actual is by-copy, its + generated declaration in the parameter block does not need an + initialization even if the type is a null-excluding access type, + because it will be initialized with the value of the actual later on. + (Parameter_Block_Pack): Do not add controlling actual to parameter + block when its type is by-copy. + +2017-10-20 Justin Squirek + + * sem_ch8.adb (Update_Use_Clause_Chain): Add sanity check to verify + scope stack traversal into the context clause. + +2017-10-20 Bob Duff + + * sinfo.ads: Fix a comment typo. + +2017-10-20 Eric Botcazou + + * doc/gnat_ugn/building_executable_programs_with_gnat.rst (-flto): Add + warning against usage in conjunction with -gnatn. + (-fdump-xref): Delete entry. + * doc/gnat_ugn/gnat_utility_programs.rst (--ext): Remove mention of + -fdump-xref switch. + * gnat_ugn.texi: Regenerate. + +2017-10-20 Hristian Kirtchev + + * sem_type.adb, exp_util.adb, sem_util.adb, sem_dim.adb, sem_elab.adb: + Minor reformatting. + +2017-10-20 Yannick Moy + + * sem_dim.adb (Analyze_Dimension_Binary_Op): Accept with a warning to + compare a dimensioned expression with a literal. + (Dim_Warning_For_Numeric_Literal): Do not issue a warning for the + special value zero. + * doc/gnat_ugn/gnat_and_program_execution.rst: Update description of + dimensionality system in GNAT. + * gnat_ugn.texi: Regenerate. + +2017-10-20 Yannick Moy + + * sem_ch6.adb (Analyze_Expression_Function.Freeze_Expr_Types): Remove + inadequate silencing of errors. + * sem_util.adb (Check_Part_Of_Reference): Do not issue an error when + checking the subprogram body generated from an expression function, + when this is done as part of the preanalysis done on expression + functions, as the subprogram body may not yet be attached in the AST. + The error if any will be issued later during the analysis of the body. + (Is_Aliased_View): Trivial rewrite with Is_Formal_Object. + +2017-10-20 Arnaud Charlet + + * sem_ch8.adb (Update_Chain_In_Scope): Add missing [-gnatwu] marker for + warning on ineffective use clause. + +2017-10-20 Eric Botcazou + + * exp_ch11.ads (Warn_If_No_Local_Raise): Declare. + * exp_ch11.adb (Expand_Exception_Handlers): Use Warn_If_No_Local_Raise + to issue the warning on the absence of local raise. + (Possible_Local_Raise): Do not issue the warning for Call_Markers. + (Warn_If_No_Local_Raise): New procedure to issue the warning on the + absence of local raise. + * sem_elab.adb: Add with and use clauses for Exp_Ch11. + (Record_Elaboration_Scenario): Call Possible_Local_Raise in the cases + where a scenario could give rise to raising Program_Error. + * sem_elab.adb: Typo fixes. + * fe.h (Warn_If_No_Local_Raise): Declare. + * gcc-interface/gigi.h (get_exception_label): Change return type. + * gcc-interface/trans.c (gnu_constraint_error_label_stack): Change to + simple vector of Entity_Id. + (gnu_storage_error_label_stack): Likewise. + (gnu_program_error_label_stack): Likewise. + (gigi): Adjust to above changes. + (Raise_Error_to_gnu): Likewise. + (gnat_to_gnu) : Set TREE_USED on the label. + (N_Push_Constraint_Error_Label): Push the label onto the stack. + (N_Push_Storage_Error_Label): Likewise. + (N_Push_Program_Error_Label): Likewise. + (N_Pop_Constraint_Error_Label): Pop the label from the stack and issue + a warning on the absence of local raise. + (N_Pop_Storage_Error_Label): Likewise. + (N_Pop_Program_Error_Label): Likewise. + (push_exception_label_stack): Delete. + (get_exception_label): Change return type to Entity_Id and adjust. + * gcc-interface/utils2.c (build_goto_raise): Change type of first + parameter to Entity_Id and adjust. Set TREE_USED on the label. + (build_call_raise): Adjust calls to get_exception_label and also + build_goto_raise. + (build_call_raise_column): Likewise. + (build_call_raise_range): Likewise. + * doc/gnat_ugn/building_executable_programs_with_gnat.rst (-gnatw.x): + Document actual default behavior. + +2017-10-20 Piotr Trojanek + + * einfo.ads: Minor consistent punctuation in comment. All numbered + items in the comment of Is_Internal are now terminated with a period. + +2017-10-20 Piotr Trojanek + + * exp_util.adb (Build_Temporary): Mark created temporary entity as + internal. + +2017-10-20 Piotr Trojanek + + * sem_type.adb (In_Generic_Actual): Simplified. + +2017-10-20 Justin Squirek + + * sem_ch12.adb (Check_Formal_Package_Instance): Add sanity check to + verify a renaming exists for a generic formal before comparing it to + the actual as defaulted formals will not have a renamed_object. + +2017-10-20 Javier Miranda + + * exp_ch6.adb (Replace_Returns): Fix wrong management of + N_Block_Statement nodes. + +2017-10-20 Bob Duff + + * exp_aggr.adb (Initialize_Array_Component): Avoid adjusting a + component of an array aggregate if it is initialized by a + build-in-place function call. + * exp_ch6.adb (Is_Build_In_Place_Result_Type): Use -gnatd.9 to disable + bip for nonlimited types. + * debug.adb: Document -gnatd.9. + +2017-10-20 Bob Duff + + * sem_ch12.adb: Remove redundant setting of Parent. + +2017-10-20 Eric Botcazou + + * sem_ch4.adb (Find_Concatenation_Types): Filter out operators if one + of the operands is a string literal. + +2017-10-20 Bob Duff + + * einfo.ads: Comment fix. + +2017-10-20 Clement Fumex + + * switch-c.adb: Remove -gnatwm from the switches triggered by -gnateC. + +2017-10-20 Ed Schonberg + + * sem_dim.adb (Extract_Power): Accept dimension values that are not + non-negative integers when the dimensioned base type is an Integer + type. + +2017-10-20 Bob Duff + + * sinfo.ads, sinfo.adb (Alloc_For_BIP_Return): New flag to indicate + that an allocator came from a b-i-p return statement. + * exp_ch4.adb (Expand_Allocator_Expression): Avoid adjusting the return + object of a nonlimited build-in-place function call. + * exp_ch6.adb (Expand_N_Extended_Return_Statement): Set the + Alloc_For_BIP_Return flag on generated allocators. + * sem_ch5.adb (Analyze_Assignment): Move Assert to where it can't fail. + If the N_Assignment_Statement has been transformed into something else, + then Should_Transform_BIP_Assignment won't work. + * exp_ch3.adb (Expand_N_Object_Declaration): A previous revision said, + "Remove Adjust if we're building the return object of an extended + return statement in place." Back out that part of the change, because + the Alloc_For_BIP_Return flag is now used for that. + +2017-10-19 Bob Duff + + * exp_ch6.adb (Is_Build_In_Place_Result_Type): Fix silly bug -- "Typ" + should be "T". Handle case of a subtype of a class-wide type. + +2017-10-19 Bob Duff + + * exp_util.adb: (Process_Statements_For_Controlled_Objects): Clarify + which node kinds can legitimately be ignored, and raise Program_Error + for others. + +2017-10-19 Hristian Kirtchev + + * sem_elab.adb (Compilation_Unit): Handle the case of a subprogram + instantiation that acts as a compilation unit. + (Find_Code_Unit): Reimplemented. + (Find_Top_Unit): Reimplemented. + (Find_Unit_Entity): New routine. + (Process_Instantiation_SPARK): Correct the elaboration requirement a + package instantiation imposes on a unit. + +2017-10-19 Bob Duff + + * exp_ch6.adb (Is_Build_In_Place_Result_Type): Enable build-in-place + for a narrow set of controlled types. + +2017-10-19 Eric Botcazou + + * sinput.ads (Line_Start): Add pragma Inline. + * widechar.ads (Is_Start_Of_Wide_Char): Likewise. + +2017-10-19 Bob Duff + + * exp_attr.adb (Expand_N_Attribute_Reference): Disable + Make_Build_In_Place_Call_... for F(...)'Old, where F(...) is a + build-in-place function call so that the temp is declared in the right + place. + +2017-10-18 Eric Botcazou + + * gcc-interface/misc.c (gnat_tree_size): Move around. + + * gcc-interface/utils.c (max_size): Deal with SSA names. + +2017-10-17 Jakub Jelinek + + * gcc-interface/misc.c (gnat_tree_size): New function. + (LANG_HOOKS_TREE_SIZE): Redefine. + +2017-10-14 Hristian Kirtchev + + * sem_elab.adb (In_Preelaborated_Context): A generic package subject to + Remote_Call_Interface is not a suitable preelaboratd context when the + call appears in the package body. + +2017-10-14 Eric Botcazou + + * layout.ads (Set_Elem_Alignment): Add Align parameter defaulted to 0. + * layout.adb (Set_Elem_Alignment): Likewise. Use M name as maximum + alignment for consistency. If Align is non-zero, use the minimum of + Align and M for the alignment. + * cstand.adb (Build_Float_Type): Use Set_Elem_Alignment instead of + setting the alignment directly. + +2017-10-14 Ed Schonberg + + * sem_prag.adb (Analyze_Pragma, case Check): Defer evaluation of the + optional string in an Assert pragma until the expansion of the pragma + has rewritten it as a conditional statement, so that the string + argument is only evaluaed if the assertion fails. This is mandated by + RM 11.4.2. + +2017-10-14 Hristian Kirtchev + + * debug.adb: Switch -gnatd.v and associated flag are now used to + enforce the SPARK rules for elaboration in SPARK code. + * sem_elab.adb: Describe switch -gnatd.v. + (Process_Call): Verify the SPARK rules only when -gnatd.v is in effect. + (Process_Instantiation): Verify the SPARK rules only when -gnatd.v is + in effect. + (Process_Variable_Assignment): Clarify why variable assignments are + processed reglardless of whether -gnatd.v is in effect. + * doc/gnat_ugn/elaboration_order_handling_in_gnat.rst: Update the + sections on elaboration code and compilation switches. + * gnat_ugn.texi: Regenerate. + +2017-10-14 Gary Dismukes + + * exp_util.adb, freeze.adb, sem_aggr.adb, sem_util.ads, sem_util.adb, + sem_warn.adb: Minor reformattings. + +2017-10-14 Ed Schonberg + + * doc/gnat_rm/implementation_defined_aspects.rst: Add documentation + for reverse iteration over formal containers. + * gnat_rm.texi: Regenerate. + +2017-10-14 Hristian Kirtchev + + * sem_elab.adb (Ensure_Dynamic_Prior_Elaboration): Renamed to + Ensure_Prior_Elaboration_Dynamic for consistency reasons. + (Ensure_Static_Prior_Elaboration): Renamed to + Ensure_Prior_Elaboration_Static for consistency reasons. + (Info_Variable_Reference): Renamed to Info_Variable_Read in order to + reflect its new purpose. + (Is_Initialized): New routine. + (Is_Suitable_Variable_Reference): Renamed to Is_Suitable_Variable_Read + in order to reflect its new purpose. + (Is_Variable_Read): New routine. + (Output_Variable_Reference): Renamed to Output_Variable_Read in order + to reflect its new purpose. + (Process_Variable_Assignment): This routine now acts as a top level + dispatcher for variable assignments. + (Process_Variable_Assignment_Ada): New routine. + (Process_Variable_Assignment_SPARK): New routine. + (Process_Variable_Reference): Renamed to Process_Variable_Read in order + to reflects its new purpose. A reference to a variable is now suitable + for ABE processing only when it is a read. The logic in the routine now + reflects the latest SPARK elaboration rules. + +2017-10-14 Justin Squirek + + * sem_ch8.adb (Analyze_Subprogram_Renaming): Modify condition that + triggers marking on formal subprograms. + +2017-10-14 Javier Miranda + + * checks.adb (Ensure_Valid): Do not skip adding the validity check on + renamings of objects that come from the sources. + +2017-10-14 Eric Botcazou + + * cstand.adb (Build_Float_Type): Move down Siz parameter, add Align + parameter and set the alignment of the type to Align. + (Copy_Float_Type): Adjust call to Build_Float_Type. + (Register_Float_Type): Add pragma Unreferenced for Precision. Adjust + call to Build_Float_Type and do not set RM_Size and Alignment. + +2017-10-14 Patrick Bernardi + + * Makefile.rtl (GNATRTL_NONTASKING_OBJ): Add s-soliin to + GNATRTL_NONTASKING_OBJ. + +2017-10-14 Bob Duff + + * exp_ch6.adb (Is_Build_In_Place_Result_Type): Include code for + enabling b-i-p for nonlimited controlled types (but disabled). + +2017-10-14 Justin Squirek + + * sem_elab.adb (Is_Suitable_Variable_Assignment): Replace call to + Has_Warnings_Off with Warnings_Off. + +2017-10-14 Piotr Trojanek + + * sinfo.ads (Generic_Parent): Remove wrong (possibly obsolete) comment. + +2017-10-14 Hristian Kirtchev + + * sem_ch3.adb (Analyze_Declarations): Analyze the contract of an + enclosing package at the end of the visible declarations. + * sem_prag.adb (Analyze_Initialization_Item): Suppress the analysis of + an initialization item which is undefined due to some illegality. + +2017-10-14 Patrick Bernardi + + * ali.adb: Add new ALI line 'T' to read the number of tasks contain + within each unit that require a default-sized primary and secondary + stack to be generated by the binder. + (Scan_ALI): Scan new 'T' lines. + * ali.ads: Add Primary_Stack_Count and Sec_Stack_Count to Unit_Record. + * bindgen.adb (Gen_Output_File): Count the number of default-sized + stacks within the closure that are to be created by the binder. + (Gen_Adainit, Gen_Output_File_Ada): Generate default-sized secondary + stacks and record these in System.Secodnary_Stack. + (Resolve_Binder_Options): Check if System.Secondary_Stack is in the + closure of the program being bound. + * bindusg.adb (Display): Add "-Q" switch. Remove rouge "--RTS" comment. + * exp_ch3.adb (Count_Default_Sized_Task_Stacks): New routine. + (Expand_N_Object_Declaration): Count the number of default-sized stacks + used by task objects contained within the object whose declaration is + being expanded. Only performed when either the restrictions + No_Implicit_Heap_Allocations or No_Implicit_Task_Allocations are in + effect. + * exp_ch9.adb (Create_Secondary_Stack_For_Task): New routine. + (Expand_N_Task_Type_Declaration): Create a secondary stack as part of + the expansion of a task type if the size of the stack is known at + run-time and the restrictions No_Implicit_Heap_Allocations or + No_Implicit_Task_Allocations are in effect. + (Make_Task_Create_Call): If using a restricted profile provide + secondary stack parameter: either the statically created stack or null. + * lib-load.adb (Create_Dummy_Package_Unit, Load_Unit, + Load_Main_Source): Include Primary_Stack_Count and Sec_Stack_Count in + Unit_Record initialization expressions. + * lib-writ.adb (Add_Preprocessing_Dependency, + Ensure_System_Dependency): Include Primary_Stack_Count and + Sec_Stack_Count in Unit_Record initialization expression. + (Write_ALI): Write T lines. + (Write_Unit_Information): Do not output 'T' lines if there are no + stacks for the binder to generate. + * lib-writ.ads: Updated library information documentation to include + new T line entry. + * lib.adb (Increment_Primary_Stack_Count): New routine. + (Increment_Sec_Stack_Count): New routine. + (Primary_Stack_Count): New routine. + (Sec_Stack_Count): New routine. + * lib.ads: Add Primary_Stack_Count and Sec_Stack_Count components to + Unit_Record and updated documentation. + (Increment_Primary_Stack_Count): New routine along with pragma Inline. + (Increment_Sec_Stack_Count): New routine along with pragma Inline. + (Primary_Stack_Count): New routine along with pragma Inline. + (Sec_Stack_Count): New routine along with pragma Inline. + * opt.ads: New constant No_Stack_Size. Flag Default_Stack_Size + redefined. New flag Default_Sec_Stack_Size and + Quantity_Of_Default_Size_Sec_Stacks. + * rtfinal.c Fixed erroneous comment. + * rtsfind.ads: Moved RE_Default_Secondary_Stack_Size from + System.Secondary_Stack to System.Parameters. Add RE_SS_Stack. + * sem_util.adb (Number_Of_Elements_In_Array): New routine. + * sem_util.ads (Number_Of_Elements_In_Array): New routine. + * switch-b.adb (Scan_Binder_Switches): Scan "-Q" switch. + * libgnarl/s-solita.adb (Get_Sec_Stack_Addr): Removed routine. + (Set_Sec_Stack_Addr): Removed routine. + (Get_Sec_Stack): New routine. + (Set_Sec_Stack): New routine. + (Init_Tasking_Soft_Links): Update System.Soft_Links reference to + reflect new procedure and global names. + * libgnarl/s-taprop__linux.adb, libgnarl/s-taprop__mingw.adb, + libgnarl/s-taprop__posix.adb, libgnarl/s-taprop__solaris.adb, + libgnarl/s-taprop__vxworks.adb (Register_Foreign_Thread): Update + parameter profile to allow the secondary stack size to be specified. + * libgnarl/s-tarest.adb (Create_Restricted_Task): Update the parameter + profile to include Sec_Stack_Address. Update Tasking.Initialize_ATCB + call to remove Secondary_Stack_Size reference. Add secondary stack + address and size to SSL.Create_TSD call. + (Task_Wrapper): Remove secondary stack creation. + * libgnarl/s-tarest.ads (Create_Restricted_Task, + Create_Restricted_Task_Sequential): Update parameter profile to include + Sec_Stack_Address and clarify the Size parameter. + * libgnarl/s-taskin.adb (Initialize_ATCB): Remove Secondary_Stack_Size + from profile and body. + (Initialize): Remove Secondary_Stack_Size from Initialize_ATCB call. + * libgnarl/s-taskin.ads: Removed component Secondary_Stack_Size from + Common_ATCB. + (Initialize_ATCB): Update the parameter profile to remove + Secondary_Stack_Size. + * libgnarl/s-tassta.adb (Create_Task): Updated parameter profile and + call to Initialize_ATCB. Add secondary stack address and size to + SSL.Create_TSD call, and catch any storage exception from the call. + (Finalize_Global_Tasks): Update System.Soft_Links references to reflect + new subprogram and component names. + (Task_Wrapper): Remove secondary stack creation. + (Vulnerable_Complete_Master): Update to reflect TSD changes. + * libgnarl/s-tassta.ads: Reformat comments. + (Create_Task): Update parameter profile. + * libgnarl/s-tporft.adb (Register_Foreign_Thread): Update parameter + profile to include secondary stack size. Remove secondary size + parameter from Initialize_ATCB call and add it to Create_TSD call. + * libgnat/s-parame.adb, libgnat/s-parame__rtems.adb, + libgnat/s-parame__vxworks.adb (Default_Sec_Stack_Size): New routine. + * libgnat/s-parame.ads, libgnat/s-parame__ae653.ads, + libgnat/s-parame__hpux.ads, libgnat/s-parame__vxworks.ads: Remove type + Percentage. Remove constants Dynamic, Sec_Stack_Percentage and + Sec_Stack_Dynamic. Add constant Runtime_Default_Sec_Stack_Size and + Sec_Stack_Dynamic. + (Default_Sec_Stack_Size): New routine. + * libgnat/s-secsta.adb, libgnat/s-secsta.ads: New implementation. Is + now Preelaborate. + * libgnat/s-soflin.adb: Removed unused with-clauses. With + System.Soft_Links.Initialize to initialize non-tasking TSD. + (Create_TSD): Update parameter profile. Initialize the TSD and + unconditionally call SS_Init. + (Destroy_TSD): Update SST.SS_Free call. + (Get_Sec_Stack_Addr_NT, Get_Sec_Stack_Addr_Soft, Set_Sec_Stack_Addr_NT, + Set_Sec_Stack_Addr_Soft): Remove routines. + (Get_Sec_Stack_NT, Get_Sec_Stack_Soft, Set_Sec_Stack_NT, + Set_Sec_Stack_Soft): Add routines. + (NT_TSD): Move to private part of package specification. + * libgnat/s-soflin.ads: New types Get_Stack_Call and Set_Stack_Call + with suppressed access checks. Renamed *_Sec_Stack_Addr_* routines and + objects to *_Sec_Stack_*. TSD: removed warning suppression and + component intialization. Changed Sec_Stack_Addr to Sec_Stack_Ptr. + (Create_TSD): Update parameter profile. + (NT_TSD): Move to private section from body. + * libgnat/s-soliin.adb, libgnat/s-soliin.ads: New files. + * libgnat/s-thread.ads (Thread_Body_Enter): Update parameter profile. + * libgnat/s-thread__ae653.adb (Get_Sec_Stack_Addr, Set_Sec_Stack_Addr): + Remove routine. + (Get_Sec_Stack, Set_Sec_Stack): Add routine. + (Thread_Body_Enter): Update parameter profile and body to adapt to new + System.Secondary_Stack. + (Init_RTS): Update body for new System.Soft_Links names. + * gcc-interface/Make-lang.in (GNAT_ADA_OBJS, GNATBIND_OBJS): Add + s-soliin.o. + +2017-10-10 Richard Sandiford + + * gcc-interface/decl.c (annotate_value): Use wi::to_wide when + operating on trees as wide_ints. + +2017-10-09 Hristian Kirtchev + + * sem_unit.adb (Find_Enclosing_Scope): Do not treat a block statement + as a scoping construct when it is byproduct of exception handling. + +2017-10-09 Hristian Kirtchev + + * sinfo.ads: Update table Is_Syntactic_Field to reflect the nature of + semantic field Target of node N_Call_Marker. + +2017-10-09 Ed Schonberg + + * sem_res.adb (Resolve_Allocator): Reject properly an allocator that + attempts to copy a limited value, when the allocator is the expression + in an expression function. + +2017-10-09 Joel Brobecker + + * doc/share/conf.py: Tell the style checker that this is a Python + fragment, and therefore that pyflakes should not be run to validate + this file. + +2017-10-09 Eric Botcazou + + * einfo.ads (Is_Boolean_Type): Add pragma Inline. + (Is_Entity_Name): Likewise. + (Is_String_Type): Likewise. + * sem_type.adb (Full_View_Covers): Do not test Is_Private_Type here + and remove useless comparisons on the base types. + (Covers): Use simple tests for Standard_Void_Type. Move up cheap tests + on T2. Always test Is_Private_Type before Full_View_Covers. + +2017-10-09 Bob Duff + + * exp_ch4.adb: Minor refactoring. + +2017-10-09 Javier Miranda + + * sem_ch3.adb (Replace_Components): Browse the list of discriminants, + not components. + +2017-10-09 Hristian Kirtchev + + * sem_elab.adb (Static_Elaboration_Checks): Elaboration requirements + are verified only in the static model. + +2017-10-09 Ed Schonberg + + * sem_ch5.adb (Analyze_Iterator_Specification, + Check_Reverse_Iteration): Check that the domain of iteration supports + reverse iteration when it is a formal container. This requires the + presence of a Previous primitive in the Iterable aspect. + * sem_ch13.adb (Resolve_Iterable_Operation): Verify legality of + primitives Last and Previous to support reverse iteration over formal + containers. + (Validate_Iterable_Aspect): Add check for reverse iteration operations. + * exp_ch5.adb (Build_Formal_Container_Iteration): Add proper expansion + for reverse iteration using primitives Last and Previous in generated + loop. + +2017-10-09 Ed Schonberg + + * sem_util.adb (Subprogram_Name): If this is a child unit, use the name + of the Defining_Program_Unit_Name, which is an identifier, in order to + construct the string for the fully qualified name. + +2017-10-09 Justin Squirek + + * sem_ch3.adb: Rename Uses_Unseen_Priv into + Contains_Lib_Incomplete_Type. + +2017-10-09 Hristian Kirtchev + + * sem_aggr.adb, sem_spark.adb, adabkend.adb, exp_ch5.adb, frontend.adb, + sem_ch12.adb, fmap.adb, exp_ch6.adb, exp_spark.adb, lib-load.adb, + exp_ch9.adb, osint.adb, exp_disp.adb, sem_ch8.adb, sem_ch8.ads, + prepcomp.adb, gnat1drv.adb, atree.adb, sinput-l.adb, targparm.adb, + sem_ch10.adb, par-ch8.adb: Minor reformatting. + +2017-10-09 Hristian Kirtchev + + * sem_elab.adb (Is_Suitable_Access): This scenario is now only relevant + in the static model. + (Is_Suitable_Variable_Assignment): This scenario is now only relevant + in the static model. + (Is_Suitable_Variable_Reference): This scenario is now only relevant in + the static model. + +2017-10-09 Ed Schonberg + + * sem_ch3.adb (Analyze_Declarations): In ASIS mode, resolve aspect + expressions when the enclosing scope is a subprogram body and the next + declaration is a body that freezes entities previously declared in the + scope. + +2017-10-09 Justin Squirek + + * sem_ch8.adb (Analyze_Use_Package): Remove checking of mixture between + ghost packages and living packages in use clauses. + (Use_One_Type, Note_Redundant_Use): Correct warning messages + +2017-10-09 Justin Squirek + + * osint.ads: Document new parameter FD for Read_Source_File. + +2017-10-09 Ed Schonberg + + * exp_util.adb (Make_Predicate_Call): If the type of the expression to + which the predicate check applies is tagged, convert the expression to + that type. This is in most cases a no-op, but is relevant if the + expression is clas-swide, because the predicate function being invoked + is not a primitive of the type and cannot take a class-wide actual. + +2017-10-09 Gary Dismukes + + * exp_disp.adb: Minor reformatting. + +2017-10-09 Arnaud Charlet + + * sem_warn.adb (Warn_On_Unreferenced_Entity): Fix typo. + +2017-10-09 Hristian Kirtchev + + * sem_elab.adb (Install_ABE_Check): Do not generate an ABE check for + GNATprove. + (Install_ABE_Failure): Do not generate an ABE failure for GNATprove. + +2017-10-09 Bob Duff + + * exp_ch6.adb: (Make_Build_In_Place_Call_In_Object_Declaration): Return + immediately if the call has already been processed (by a previous call + to Make_Build_In_Place_Call_In_Anonymous_Context). + * sem_elab.adb: Minor typo fixes. + +2017-10-09 Ed Schonberg + + * sem_ch13.adb (Replace_Type_Ref): In the expression for a dynamic + predicate, do not replace an identifier that matches the type if the + identifier is a selector in a selected component, because this + indicates a reference to some homograph of the type itself, and not to + the current occurence in the predicate. + +2017-10-09 Eric Botcazou + + * repinfo.adb (List_Record_Layout): Tweak formatting. + (Write_Val): Remove superfluous spaces in back-end layout mode. + +2017-10-09 Piotr Trojanek + + * sem_res.adb (Property_Error): Remove. + (Resolve_Actuals): check for SPARK RM 7.1.3(10) rewritten to match the + current wording of the rule. + +2017-10-09 Justin Squirek + + * sem_ch3.adb (Analyze_Declarations): Add check for ghost packages + before analyzing a given scope due to an expression function. + (Uses_Unseen_Lib_Unit_Priv): Rename to Uses_Unseen_Priv. + +2017-10-09 Bob Duff + + * exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): Use + Defining_Identifier (Obj_Decl) in two places, because it might have + changed. + * exp_ch6.adb (Make_Build_In_Place_Call_In_Allocator): Deal with cases + involving 'Input on (not visibly) derived types. + +2017-10-09 Hristian Kirtchev + + * atree.adb: Add new soft link Rewriting_Proc. + (Rewrite): Invoke the subprogram attached to the rewriting soft link. + (Set_Rewriting_Proc): New routine. + * attree.ads: Add new access-to-subprogram type Rewrite_Proc. + (Set_Rewriting_Proc): New routine. + * checks.adb (Install_Primitive_Elaboration_Check): Use 'E' character + for *E*laboration flag to maintain consistency with other elaboration + flag generating subprograms. + * debug.adb: Document the new usage of flag -gnatdL. + * einfo.adb: Node19 is now used as Receiving_Entry. Node39 is now used + as Protected_Subprogram. Flag148 is now used as + Is_Elaboration_Checks_OK_Id. Flag302 is now used as + Is_Initial_Condition_Procedure. + (Is_Elaboration_Checks_OK_Id): New routine. + (Is_Initial_Condition_Procedure): New routine. + (Protected_Subprogram): New routine. + (Receiving_Entry): New routine. + (SPARK_Pragma): Update assertion. + (SPARK_Pragma_Inherited): Update assertion. + (Suppress_Elaboration_Warnings): Removed. + (Set_Is_Elaboration_Checks_OK_Id): New routine. + (Set_Is_Initial_Condition_Procedure): New routine. + (Set_Protected_Subprogram): New routine. + (Set_Receiving_Entry): New routine. + (Set_SPARK_Pragma): Update assertion. + (Set_SPARK_Pragma_Inherited): Update assertion. + (Write_Entity_Flags): Update the output for Flag148 and Flag302. + (Write_Field19_Name): Add output for Receiving_Entry. + (Write_Field39_Name): Add output for Protected_Subprogram. + (Write_Field40_Name): Update the output for SPARK_Pragma. + * einfo.ads: New attributes Is_Elaboration_Checks_OK_Id, + Is_Initial_Condition_Procedure, Protected_Subprogram, Receiving_Entry. + Remove attribute Suppress_Elaboration_Warnings. Update the stricture + of various entities. + (Is_Elaboration_Checks_OK_Id): New routine along with pragma Inline. + (Is_Initial_Condition_Procedure): New routine along with pragma Inline. + (Protected_Subprogram): New routine along with pragma Inline. + (Receiving_Entry): New routine along with pragma Inline. + (Suppress_Elaboration_Warnings): Removed. + (Set_Is_Elaboration_Checks_OK_Id): New routine along with pragma + Inline. + (Set_Is_Initial_Condition_Procedure): New routine along with pragma + Inline. + (Set_Protected_Subprogram): New routine along with pragma Inline. + (Set_Receiving_Entry): New routine along with pragma Inline. + (Set_Suppress_Elaboration_Warnings): Removed. + * exp_ch3.adb (Build_Init_Procedure): Use name _Finalizer to maintain + consistency with other finalizer generating subprograms. + (Default_Initialize_Object): Mark the block which wraps the call to + finalize as being part of initialization. + * exp_ch7.adb (Expand_N_Package_Declaration): Directly expand pragma + Initial_Condition. + (Expand_N_Package_Body): Directly expand pragma Initial_Condition. + (Next_Suitable_Statement): Update the comment on usage. Skip over call + markers generated by the ABE mechanism. + * exp_ch9.adb (Activation_Call_Loc): New routine. + (Add_Accept): Link the accept procedure to the original entry. + (Build_Protected_Sub_Specification): Link the protected or unprotected + version to the original subprogram. + (Build_Task_Activation_Call): Code cleanup. Use a source location which + is very close to the "begin" or "end" keywords when generating the + activation call. + * exp_prag.adb (Expand_Pragma_Initial_Condition): Reimplemented. + * exp_spark.adb (Expand_SPARK): Use Expand_SPARK_N_Loop_Statement to + process loops. + (Expand_SPARK_N_Loop_Statement): New routine. + (Expand_SPARK_N_Object_Declaration): Code cleanup. Partially insert the + call to the Default_Initial_Condition procedure. + (Expand_SPARK_Op_Ne): Renamed to Expand_SPARK_N_Op_Ne. + * exp_util.adb (Build_DIC_Procedure_Body): Capture the SPARK_Mode in + effect. + (Build_DIC_Procedure_Declaration): Capture the SPARK_Mode in effect. + (Insert_Actions): Add processing for N_Call_Marker. + (Kill_Dead_Code): Explicitly kill an elaboration scenario. + * exp_util.ads (Make_Invariant_Call): Update the comment on usage. + * frontend.adb: Initialize Sem_Elab. Process all saved top level + elaboration scenarios for ABE issues. + * gcc-interface/trans.c (gnat_to_gnu): Add processing for N_Call_Marker + nodes. + * lib.adb (Earlier_In_Extended_Unit): New variant. + * sem.adb (Analyze): Ignore N_Call_Marker nodes. + (Preanalysis_Active): New routine. + * sem.ads (Preanalysis_Active): New routine. + * sem_attr.adb (Analyze_Access_Attribute): Save certain + elaboration-related attributes. Save the scenario for ABE processing. + * sem_ch3.adb (Analyze_Object_Declaration): Save the SPARK mode in + effect. Save certain elaboration-related attributes. + * sem_ch5.adb (Analyze_Assignment): Save certain elaboration-related + attributes. Save the scenario for ABE processing. + * sem_ch6.adb (Analyze_Abstract_Subprogram_Declaration): Save the SPARK + mode in effect. Save certain elaboration-related attributes. + (Analyze_Subprogram_Body_Helper): Skip N_Call_Marker nodes when + locating the first real statement. + (Analyze_Subprogram_Declaration): Save the SPARK mode in effect. Save + certain elaboration-related attributes. + * sem_ch7.adb (Analyze_Package_Declaration): Do not suppress + elaboration warnings. + * sem_ch8.adb (Attribute_Renaming): Mark a subprogram body which was + generated for purposes of wrapping an attribute used as a generic + actual. + (Find_Direct_Name): Save certain elaboration-related attributes. Save + the scenario for ABE processing. + (Find_Expanded_Name): Save certain elaboration-related attributes. Save + the scenario for ABE processing. + * sem_ch9.adb (Analyze_Entry_Declaration): Save certain + elaboration-related attributes. + (Analyze_Requeue): Save certain elaboration-related attributes. Save + the scenario for ABE processing. + (Analyze_Single_Task_Declaration): Save certain elaboration-related + attributes. + (Analyze_Task_Type_Declaration): Save certain elaboration-related + attributes. + * sem_ch12.adb (Analyze_Generic_Package_Declaration): Save certain + elaboration-related attributes. + (Analyze_Generic_Subprogram_Declaration): Save the SPARK mode in + effect. Save certain elaboration-related attributes. + (Analyze_Package_Instantiation): Save certain elaboration-related + attributes. Save the scenario for ABE processing. Create completing + bodies in case the instantiation results in a guaranteed ABE. + (Analyze_Subprogram_Instantiation): Save certain elaboration-related + attributes Save the scenario for ABE processing. Create a completing + body in case the instantiation results in a guaranteed ABE. + (Provide_Completing_Bodies): New routine. + * sem_elab.ads: Brand new implementation. + * sem_prag.adb (Analyze_Pragma, cases Elaborate, Elaborate_All, + Elaborate_Body): Do not suppress elaboration warnings. + * sem_res.adb (Make_Call_Into_Operator): Set the parent field of the + operator. + (Resolve_Call): Save certain elaboration-related attributes. Save the + scenario for ABE processing. + (Resolve_Entity_Name): Do not perform any ABE processing here. + (Resolve_Entry_Call): Inherit certain attributes from the original call. + * sem_util.adb (Begin_Keyword_Location): New routine. + (Defining_Entity): Update the parameter profile. Add processing for + concurrent subunits that are rewritten as null statements. + (End_Keyword_Location): New routine. + (Find_Enclosing_Scope): New routine. + (In_Instance_Visible_Part): Code cleanup. + (In_Subtree): Update the parameter profile. Add new version. + (Is_Preelaborable_Aggregate): New routine. + (Is_Preelaborable_Construct): New routine. + (Mark_Elaboration_Attributes): New routine. + (Scope_Within): Update the parameter profile. + (Scope_Within_Or_Same): Update the parameter profile. + * sem_util.ads (Begin_Keyword_Location): New routine. + (Defining_Entity): Update the parameter profile and the comment on + usage. + (End_Keyword_Location): New routine. + (Find_Enclosing_Scope): New routine. + (In_Instance_Visible_Part): Update the parameter profile. + (In_Subtree): Update the parameter profile. Add new version. + (Is_Preelaborable_Aggregate): New routine. + (Is_Preelaborable_Construct): New routine. + (Mark_Elaboration_Attributes): New routine. + (Scope_Within): Update the parameter profile and the comment on usage. + (Scope_Within_Or_Same): Update the parameter profile and the comment on + usage. + * sem_warn.adb (Check_Infinite_Loop_Warning): Use Has_Condition_Actions + to determine whether a loop has meaningful condition actions. + (Has_Condition_Actions): New routine. + * sinfo.adb (ABE_Is_Certain): Removed. + (Is_Declaration_Level_Node): New routine. + (Is_Dispatching_Call): New routine. + (Is_Elaboration_Checks_OK_Node): New routine. + (Is_Initialization_Block): New routine. + (Is_Known_Guaranteed_ABE): New routine. + (Is_Recorded_Scenario): New routine. + (Is_Source_Call): New routine. + (Is_SPARK_Mode_On_Node): New routine. + (No_Elaboration_Check): Removed. + (Target): New routine. + (Was_Attribute_Reference): New routine. + (Set_ABE_Is_Certain): Removed. + (Set_Is_Declaration_Level_Node): New routine. + (Set_Is_Dispatching_Call): New routine. + (Set_Is_Elaboration_Checks_OK_Node): New routine. + (Set_Is_Initialization_Block): New routine. + (Set_Is_Known_Guaranteed_ABE): New routine. + (Set_Is_Recorded_Scenario): New routine. + (Set_Is_Source_Call): New routine. + (Set_Is_SPARK_Mode_On_Node): New routine. + (Set_No_Elaboration_Check): Removed. + (Set_Target): New routine. + (Set_Was_Attribute_Reference): New routine. + * sinfo.ads: Remove attribute ABE_Is_Certain. Attribute + Do_Discriminant_Check now utilizes Flag3. Attribute + No_Side_Effect_Removal now utilizes Flag17. Add new node + N_Call_Marker. Update the structure of various nodes. + (ABE_Is_Certain): Removed along with pragma Inline. + (Is_Declaration_Level_Node): New routine along with pragma Inline. + (Is_Dispatching_Call): New routine along with pragma Inline. + (Is_Elaboration_Checks_OK_Node): New routine along with pragma Inline. + (Is_Initialization_Block): New routine along with pragma Inline. + (Is_Known_Guaranteed_ABE): New routine along with pragma Inline. + (Is_Recorded_Scenario): New routine along with pragma Inline. + (Is_Source_Call): New routine along with pragma Inline. + (Is_SPARK_Mode_On_Node): New routine along with pragma Inline. + (No_Elaboration_Check): Removed along with pragma Inline. + (Target): New routine along with pragma Inline. + (Was_Attribute_Reference): New routine along with pragma Inline. + (Set_ABE_Is_Certain): Removed along with pragma Inline. + (Set_Is_Declaration_Level_Node): New routine along with pragma Inline. + (Set_Is_Dispatching_Call): New routine along with pragma Inline. + (Set_Is_Elaboration_Checks_OK_Node): New routine along with pragma + Inline. + (Set_Is_Initialization_Block): New routine along with pragma Inline. + (Set_Is_Known_Guaranteed_ABE): New routine along with pragma Inline. + (Set_Is_Recorded_Scenario): New routine along with pragma Inline. + (Set_Is_Source_Call): New routine along with pragma Inline. + (Set_Is_SPARK_Mode_On_Node): New routine along with pragma Inline. + (Set_No_Elaboration_Check): Removed along with pragma Inline. + (Set_Target): New routine along with pragma Inline. + (Set_Was_Attribute_Reference): New routine along with pragma Inline. + * sprint.adb (Sprint_Node_Actual): Add an entry for N_Call_Marker. + +2017-10-09 Bob Duff + + * exp_ch7.adb (Create_Finalizer): Suppress checks within the finalizer. + +2017-10-09 Bob Duff + + * freeze.ads: Minor comment fixed. + +2017-10-09 Bob Duff + + * exp_ch6.adb: (Make_Build_In_Place_Call_In_Object_Declaration): Take + care of unchecked conversions in addition to regular conversions. This + takes care of a case where a type is derived from a private untagged + type that is completed by a tagged controlled type. + +2017-10-09 Ed Schonberg + + * exp_disp.adb (Build_Class_Wide_Check, Replace_Formals): When + rewriting a class-wide condition, handle properly the case where the + controlling argument of the operation to which the condition applies is + an access to a tagged type, and the condition includes a dispatching + call with an implicit dereference. + +2017-10-09 Bob Duff + + * exp_ch6.adb: (Make_Build_In_Place_Call_In_Object_Declaration): Remove + the code at the end of this procedure that was setting the type of a + class-wide object to the specific type returned by a function call. + Treat this case as indefinite instead. + +2017-10-09 Ed Schonberg + + * sem_ch4.adb (Try_Class_Wide_Operation, Traverse_Homonyms): + Suppress spurious ambiguity error when two traversals of the homonym + chain (first directly, and then through an examination of relevant + interfaces) retrieve the same operation, when other irrelevant homonyms + of the operatioh are also present. + +2017-10-09 Ed Schonberg + + * sem_util.adb (Object_Access_Level): If the object is the return + statement of an expression function, return the level of the function. + This is relevant when the object involves an implicit conversion + between access types and the expression function is a completion, which + forces the analysis of the expression before rewriting it as a body, so + that freeze nodes can appear in the proper scope. + +2017-10-09 Bob Duff + + * atree.adb: Make nnd apply to everything "interesting", including + Rewrite. Remove rrd. + +2017-10-09 Javier Miranda + + * exp_ch3.adb (Expand_N_Object_Declaration): Avoid never-ending loop + processing the declaration of the dummy object internally created by + Make_DT to compute the offset to the top of components referencing + secondary dispatch tables. + (Initialize_Tag): Do not initialize the offset-to-top field if it has + been initialized initialized. + * exp_disp.ads (Building_Static_Secondary_DT): New subprogram. + * exp_disp.adb (Building_Static_Secondary_DT): New subprogram. + (Make_DT): Create a dummy constant object if we can statically build + secondary dispatch tables. + (Make_Secondary_DT): For statically allocated secondary dispatch tables + use the dummy object to compute the offset-to-top field value by means + of the attribute 'Position. + +2017-10-09 Bob Duff + + * exp_ch6.adb (Expand_N_Extended_Return_Statement): Add self-checking + code so if BIPAlloc is not passed in, it will likely raise + Program_Error instead of cause miscellaneous chaos. + (Is_Build_In_Place_Result_Type): Return False if not Expander_Active, + as for the other Is_B-I-P... functions. + * sem_aggr.adb (Resolve_Extension_Aggregate): For an extension + aggregate whose ancestor part is a build-in-place call returning a + nonlimited type, transform the assignment to the ancestor part to use a + temp. + * sem_ch3.adb (Build_Itype_Reference): Handle the case where we're + creating an Itype for a library unit entity. + (Check_Initialization): Avoid spurious error message on + internally-generated call. + * sem_ch5.adb (Analyze_Assignment): Handle the case where the + right-hand side is a build-in-place call. This didn't happen when b-i-p + was only for limited types. + * sem_ch6.adb (Create_Extra_Formals): Remove assumption that b-i-p + implies >= Ada 2005. + * sem_ch7.adb (Scan_Subprogram_Refs): Avoid traversing the same nodes + repeatedly. + * sem_util.adb (Next_Actual): Handle case of build-in-place call. + +2017-10-09 Arnaud Charlet + + * doc/gnat_ugn/gnat_and_program_execution.rst: Minor edit. + +2017-10-09 Piotr Trojanek + + * libgnarl/s-taprob.adb: Minor whitespace fix. + +2017-10-09 Bob Duff + + * namet.ads: Minor comment fix. + +2017-10-09 Piotr Trojanek + + * sem_aux.adb (Unit_Declaration_Node): Detect protected declarations, + just like other program units listed in Ada RM 10.1(1). + +2017-10-09 Justin Squirek + + * sem_ch8.adb (Update_Chain_In_Scope): Modify warning messages. + +2017-10-09 Ed Schonberg + + * sem_ch12.adb (Analyze_Associations, Check_Generic_Parent): If an + actual for a formal package is an instantiation of a child unit, create + a freeze node for the instance of the parent if it appears in the same + scope and is not frozen yet. + +2017-10-09 Pierre-Marie de Rodat + + * exp_atag.ads, libgnat/a-tags.adb, libgnat/a-tags.ads: Enhance + in-source documentation for tagged types's Offset_To_Top. + +2017-10-09 Bob Duff + + * exp_ch3.adb (Build_Assignment): Parameter name N was somewhat + confusing. Same for N_Loc. Remove assumption that b-i-p implies + limited. This is for the case of a function call that occurs as the + default for a record component. + (Expand_N_Object_Declaration): Deal with the case where expansion has + created an object declaration initialized with something like + F(...)'Reference. + * exp_ch3.adb: Minor reformatting. + +2017-10-09 Ed Schonberg + + * exp_attr.adb (Expand_Attribute_Reference, case 'Valid): The prefix of + the attribute is an object, but it may appear within a conversion. The + object itself must be retrieved when generating the range test that + implements the validity check on a scalar type. + 2017-10-05 Eric Botcazou PR ada/82393 diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 021da824c0de1..ed43ae5273c2c 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -659,6 +659,7 @@ GNATRTL_NONTASKING_OBJS= \ s-sequio$(objext) \ s-shasto$(objext) \ s-soflin$(objext) \ + s-soliin$(objext) \ s-spsufi$(objext) \ s-stache$(objext) \ s-stalib$(objext) \ diff --git a/gcc/ada/adabkend.adb b/gcc/ada/adabkend.adb index 2ab4b19a1d8d5..ae0218e04ded6 100644 --- a/gcc/ada/adabkend.adb +++ b/gcc/ada/adabkend.adb @@ -59,8 +59,8 @@ package body Adabkend is -- The front end leaves the Current_Error_Node at a location that is -- meaningless and confusing when emitting bug boxes from the back end. - -- By resetting it here we default to "No source file position - -- information available" message on back end crashes. + -- Reset the global variable in order to emit "No source file position + -- information available" messages on back end crashes. Current_Error_Node := Empty; diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 2b1d472baba8a..959b30587280b 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -58,6 +58,7 @@ package body ALI is 'Z' => True, -- implicit with from instantiation 'C' => True, -- SCO information 'F' => True, -- SPARK cross-reference information + 'T' => True, -- task stack information others => False); -------------------- @@ -842,7 +843,7 @@ package body ALI is if Read_Xref then Ignore := - ('U' | 'W' | 'Y' | 'Z' | 'D' | 'X' => False, others => True); + ('T' | 'U' | 'W' | 'Y' | 'Z' | 'D' | 'X' => False, others => True); -- Read_Lines parameter given @@ -1744,6 +1745,8 @@ package body ALI is UL.Elaborate_Body_Desirable := False; UL.Optimize_Alignment := 'O'; UL.Has_Finalizer := False; + UL.Primary_Stack_Count := 0; + UL.Sec_Stack_Count := 0; if Debug_Flag_U then Write_Str (" ----> reading unit "); @@ -2096,6 +2099,28 @@ package body ALI is Units.Table (Units.Last).Last_With := Withs.Last; Units.Table (Units.Last).Last_Arg := Args.Last; + -- Scan out task stack information for the unit if present + + Check_Unknown_Line; + + if C = 'T' then + if Ignore ('T') then + Skip_Line; + + else + Checkc (' '); + Skip_Space; + + Units.Table (Units.Last).Primary_Stack_Count := Get_Nat; + Skip_Space; + Units.Table (Units.Last).Sec_Stack_Count := Get_Nat; + Skip_Space; + Skip_Eol; + end if; + + C := Getc; + end if; + -- If there are linker options lines present, scan them Name_Len := 0; diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index e15a1c455bdf8..3fa4d99fb09c3 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -388,11 +388,19 @@ package ALI is -- together as possible. Optimize_Alignment : Character; - -- Optimize_Alignment setting. Set to L/S/T/O for OL/OS/OT/OO present + -- Optimize_Alignment setting. Set to L/S/T/O for OL/OS/OT/OO present. Has_Finalizer : Boolean; -- Indicates whether a package body or a spec has a library-level -- finalization routine. + + Primary_Stack_Count : Int; + -- Indicates the number of task objects declared in this unit that have + -- default sized primary stacks. + + Sec_Stack_Count : Int; + -- Indicates the number of task objects declared in this unit that have + -- default sized secondary stacks. end record; package Units is new Table.Table ( diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 16feee0670b2d..1a7e36ca70dd2 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -56,6 +56,9 @@ package body Atree is Reporting_Proc : Report_Proc := null; -- Record argument to last call to Set_Reporting_Proc + Rewriting_Proc : Rewrite_Proc := null; + -- This soft link captures the procedure invoked during a node rewrite + --------------- -- Debugging -- --------------- @@ -73,11 +76,12 @@ package body Atree is -- ww := 12345 -- and set a breakpoint on New_Node_Breakpoint (nickname "nn"). Continue. - -- Either way, gnat1 will stop when node 12345 is created - - -- The second method is much faster + -- Either way, gnat1 will stop when node 12345 is created, or certain other + -- interesting operations are performed, such as Rewrite. To see exactly + -- which operations, search for "pragma Debug" below. - -- Similarly, rr and rrd allow breaking on rewriting of a given node + -- The second method is much faster if the amount of Ada code being + -- compiled is large. ww : Node_Id'Base := Node_Id'First - 1; pragma Export (Ada, ww); -- trick the optimizer @@ -103,24 +107,8 @@ package body Atree is -- If Node = Watch_Node, this prints out the new node and calls -- New_Node_Breakpoint. Otherwise, does nothing. - procedure rr; - pragma Export (Ada, rr); - procedure Rewrite_Breakpoint renames rr; - -- This doesn't do anything interesting; it's just for setting breakpoint - -- on as explained above. - - procedure rrd (Old_Node, New_Node : Node_Id); - pragma Export (Ada, rrd); - procedure Rewrite_Debugging_Output - (Old_Node, New_Node : Node_Id) renames rrd; - -- For debugging. If debugging is turned on, Rewrite calls this. If debug - -- flag N is turned on, this prints out the new node. - -- - -- If Old_Node = Watch_Node, this prints out the old and new nodes and - -- calls Rewrite_Breakpoint. Otherwise, does nothing. - procedure Node_Debug_Output (Op : String; N : Node_Id); - -- Common code for nnd and rrd, writes Op followed by information about N + -- Called by nnd; writes Op followed by information about N procedure Print_Statistics; pragma Export (Ada, Print_Statistics); @@ -751,6 +739,9 @@ package body Atree is Save_Link : constant Union_Id := Nodes.Table (Destination).Link; begin + pragma Debug (New_Node_Debugging_Output (Source)); + pragma Debug (New_Node_Debugging_Output (Destination)); + Nodes.Table (Destination) := Nodes.Table (Source); Nodes.Table (Destination).In_List := Save_In_List; Nodes.Table (Destination).Link := Save_Link; @@ -1319,16 +1310,6 @@ package body Atree is Ekind_In (Ekind (E), V1, V2, V3, V4, V5, V6, V7, V8, V9, V10, V11); end Ekind_In; - ------------------------ - -- Set_Reporting_Proc -- - ------------------------ - - procedure Set_Reporting_Proc (P : Report_Proc) is - begin - pragma Assert (Reporting_Proc = null); - Reporting_Proc := P; - end Set_Reporting_Proc; - ------------------ -- Error_Posted -- ------------------ @@ -1348,6 +1329,9 @@ package body Atree is Temp_Flg : Flags_Byte; begin + pragma Debug (New_Node_Debugging_Output (E1)); + pragma Debug (New_Node_Debugging_Output (E2)); + pragma Assert (True and then Has_Extension (E1) and then Has_Extension (E2) @@ -1420,8 +1404,10 @@ package body Atree is begin pragma Assert (not (Has_Extension (Node))); + Result := Allocate_Initialize_Node (Node, With_Extension => True); pragma Debug (Debug_Extend_Node); + return Result; end Extend_Node; @@ -1695,8 +1681,8 @@ package body Atree is Current_Error_Node := Ent; end if; - Nodes.Table (Ent).Nkind := New_Node_Kind; - Nodes.Table (Ent).Sloc := New_Sloc; + Nodes.Table (Ent).Nkind := New_Node_Kind; + Nodes.Table (Ent).Sloc := New_Sloc; pragma Debug (New_Node_Debugging_Output (Ent)); -- Mark the new entity as Ghost depending on the current Ghost region @@ -1718,6 +1704,7 @@ package body Atree is begin pragma Assert (New_Node_Kind not in N_Entity); + Nod := Allocate_Initialize_Node (Empty, With_Extension => False); Nodes.Table (Nod).Nkind := New_Node_Kind; Nodes.Table (Nod).Sloc := New_Sloc; @@ -1746,7 +1733,6 @@ package body Atree is begin Write_Str ("Watched node "); Write_Int (Int (Watch_Node)); - Write_Str (" created"); Write_Eol; end nn; @@ -1759,7 +1745,7 @@ package body Atree is begin if Debug_Flag_N or else Node_Is_Watched then - Node_Debug_Output ("Allocate", N); + Node_Debug_Output ("Node", N); if Node_Is_Watched then New_Node_Breakpoint; @@ -2164,6 +2150,9 @@ package body Atree is and not Has_Extension (New_Node) and not Nodes.Table (New_Node).In_List); + pragma Debug (New_Node_Debugging_Output (Old_Node)); + pragma Debug (New_Node_Debugging_Output (New_Node)); + -- Do copy, preserving link and in list status and required flags Copy_Node (Source => New_Node, Destination => Old_Node); @@ -2214,7 +2203,9 @@ package body Atree is (not Has_Extension (Old_Node) and not Has_Extension (New_Node) and not Nodes.Table (New_Node).In_List); - pragma Debug (Rewrite_Debugging_Output (Old_Node, New_Node)); + + pragma Debug (New_Node_Debugging_Output (Old_Node)); + pragma Debug (New_Node_Debugging_Output (New_Node)); if Nkind (Old_Node) in N_Subexpr then Old_Paren_Count := Paren_Count (Old_Node); @@ -2262,37 +2253,13 @@ package body Atree is if Reporting_Proc /= null then Reporting_Proc.all (Target => Old_Node, Source => New_Node); end if; - end Rewrite; - ------------------------- - -- Rewrite_Breakpoint -- - ------------------------- + -- Invoke the rewriting procedure (if available) - procedure rr is - begin - Write_Str ("Watched node "); - Write_Int (Int (Watch_Node)); - Write_Str (" rewritten"); - Write_Eol; - end rr; - - ------------------------------ - -- Rewrite_Debugging_Output -- - ------------------------------ - - procedure rrd (Old_Node, New_Node : Node_Id) is - Node_Is_Watched : constant Boolean := Old_Node = Watch_Node; - - begin - if Debug_Flag_N or else Node_Is_Watched then - Node_Debug_Output ("Rewrite", Old_Node); - Node_Debug_Output ("into", New_Node); - - if Node_Is_Watched then - Rewrite_Breakpoint; - end if; + if Rewriting_Proc /= null then + Rewriting_Proc.all (Target => Old_Node, Source => New_Node); end if; - end rrd; + end Rewrite; ------------------ -- Set_Analyzed -- @@ -2429,6 +2396,16 @@ package body Atree is Nodes.Table (N).Link := Union_Id (Val); end Set_Parent; + ------------------------ + -- Set_Reporting_Proc -- + ------------------------ + + procedure Set_Reporting_Proc (Proc : Report_Proc) is + begin + pragma Assert (Reporting_Proc = null); + Reporting_Proc := Proc; + end Set_Reporting_Proc; + -------------- -- Set_Sloc -- -------------- @@ -2439,6 +2416,16 @@ package body Atree is Nodes.Table (N).Sloc := Val; end Set_Sloc; + ------------------------ + -- Set_Rewriting_Proc -- + ------------------------ + + procedure Set_Rewriting_Proc (Proc : Rewrite_Proc) is + begin + pragma Assert (Rewriting_Proc = null); + Rewriting_Proc := Proc; + end Set_Rewriting_Proc; + ---------- -- Sloc -- ---------- diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 5ed81e6853134..bf0da1604eaea 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -572,10 +572,15 @@ package Atree is type Report_Proc is access procedure (Target : Node_Id; Source : Node_Id); - procedure Set_Reporting_Proc (P : Report_Proc); + procedure Set_Reporting_Proc (Proc : Report_Proc); -- Register a procedure that is invoked when a node is allocated, replaced -- or rewritten. + type Rewrite_Proc is access procedure (Target : Node_Id; Source : Node_Id); + + procedure Set_Rewriting_Proc (Proc : Rewrite_Proc); + -- Register a procedure that is invoked when a node is rewritten + type Traverse_Result is (Abandon, OK, OK_Orig, Skip); -- This is the type of the result returned by the Process function passed -- to Traverse_Func and Traverse_Proc. See below for details. @@ -4231,25 +4236,26 @@ package Atree is -- for extending components are completely unused. type Flags_Byte is record - Flag0 : Boolean; + Flag0 : Boolean; -- Note: we don't use Flag0 at the moment. To put Flag0 into use -- requires some awkward work in Treeprs (treeprs.adt), so for the -- moment we don't use it. - Flag1 : Boolean; - Flag2 : Boolean; - Flag3 : Boolean; + Flag1 : Boolean; + Flag2 : Boolean; + Flag3 : Boolean; -- These flags are used in the usual manner in Sinfo and Einfo - Is_Ignored_Ghost_Node : Boolean; - -- Flag denoting whether the node is subject to pragma Ghost with - -- policy Ignore. The name of the flag should be Flag4, however this - -- requires changing the names of all remaining 300+ flags. + -- The flags listed below use explicit names because following the + -- FlagXXX convention would mean reshuffling of over 300+ flags. Check_Actuals : Boolean; -- Flag set to indicate that the marked node is subject to the check - -- for writable actuals. See xxx for more details. Again it would be - -- more uniform to use some Flagx here, but that would be disruptive. + -- for writable actuals. + + Is_Ignored_Ghost_Node : Boolean; + -- Flag denoting whether the node is subject to pragma Ghost with + -- policy Ignore. Spare2 : Boolean; Spare3 : Boolean; diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index a9ea20ebd9bd0..e3d875bc8cc5d 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -59,6 +59,14 @@ package body Bindgen is Num_Elab_Calls : Nat := 0; -- Number of generated calls to elaboration routines + Num_Primary_Stacks : Int := 0; + -- Number of default-sized primary stacks the binder needs to allocate for + -- task objects declared in the program. + + Num_Sec_Stacks : Int := 0; + -- Number of default-sized primary stacks the binder needs to allocate for + -- task objects declared in the program. + System_Restrictions_Used : Boolean := False; -- Flag indicating whether the unit System.Restrictions is in the closure -- of the partition. This is set by Resolve_Binder_Options, and is used @@ -74,6 +82,12 @@ package body Bindgen is -- domains just before calling the main procedure from the environment -- task. + System_Secondary_Stack_Used : Boolean := False; + -- Flag indicating whether the unit System.Secondary_Stack is in the + -- closure of the partition. This is set by Resolve_Binder_Options, and + -- is used to initialize the package in cases where the run-time brings + -- in package but the secondary stack is not used. + System_Tasking_Restricted_Stages_Used : Boolean := False; -- Flag indicating whether the unit System.Tasking.Restricted.Stages is in -- the closure of the partition. This is set by Resolve_Binder_Options, @@ -179,8 +193,11 @@ package body Bindgen is -- Exception_Tracebacks_Symbolic : Integer; -- Detect_Blocking : Integer; -- Default_Stack_Size : Integer; + -- Default_Secondary_Stack_Size : System.Parameters.Size_Type; -- Leap_Seconds_Support : Integer; -- Main_CPU : Integer; + -- Default_Sized_SS_Pool : System.Address; + -- Binder_Sec_Stacks_Count : Natural; -- Main_Priority is the priority value set by pragma Priority in the main -- program. If no such pragma is present, the value is -1. @@ -261,6 +278,9 @@ package body Bindgen is -- Default_Stack_Size is the default stack size used when creating an Ada -- task with no explicit Storage_Size clause. + -- Default_Secondary_Stack_Size is the default secondary stack size used + -- when creating an Ada task with no explicit Secondary_Stack_Size clause. + -- Leap_Seconds_Support denotes whether leap seconds have been enabled or -- disabled. A value of zero indicates that leap seconds are turned "off", -- while a value of one signifies "on" status. @@ -268,6 +288,14 @@ package body Bindgen is -- Main_CPU is the processor set by pragma CPU in the main program. If no -- such pragma is present, the value is -1. + -- Default_Sized_SS_Pool is set to the address of the default-sized + -- secondary stacks array generated by the binder. This pool of stacks is + -- generated when either the restriction No_Implicit_Heap_Allocations + -- or No_Implicit_Task_Allocations is active. + + -- Binder_Sec_Stacks_Count is the number of generated secondary stacks in + -- the Default_Sized_SS_Pool. + procedure WBI (Info : String) renames Osint.B.Write_Binder_Info; -- Convenient shorthand used throughout @@ -554,6 +582,32 @@ package body Bindgen is WBI (" procedure Start_Slave_CPUs;"); WBI (" pragma Import (C, Start_Slave_CPUs," & " ""__gnat_start_slave_cpus"");"); + WBI (""); + end if; + + -- A restricted run-time may attempt to initialize the main task's + -- secondary stack even if the stack is not used. Consequently, + -- the binder needs to initialize Binder_Sec_Stacks_Count anytime + -- System.Secondary_Stack is in the enclosure of the partition. + + if System_Secondary_Stack_Used then + WBI (" Binder_Sec_Stacks_Count : Natural;"); + WBI (" pragma Import (Ada, Binder_Sec_Stacks_Count, " & + """__gnat_binder_ss_count"");"); + WBI (""); + end if; + + if Sec_Stack_Used then + WBI (" Default_Secondary_Stack_Size : " & + "System.Parameters.Size_Type;"); + WBI (" pragma Import (C, Default_Secondary_Stack_Size, " & + """__gnat_default_ss_size"");"); + + WBI (" Default_Sized_SS_Pool : System.Address;"); + WBI (" pragma Import (Ada, Default_Sized_SS_Pool, " & + """__gnat_default_ss_pool"");"); + + WBI (""); end if; WBI (" begin"); @@ -588,6 +642,50 @@ package body Bindgen is WBI (" null;"); end if; + -- Generate default-sized secondary stack pool and set secondary + -- stack globals. + + if Sec_Stack_Used then + + -- Elaborate the body of the binder to initialize the default- + -- sized secondary stack pool. + + WBI (""); + WBI (" " & Get_Ada_Main_Name & "'Elab_Body;"); + + -- Generate the default-sized secondary stack pool and set the + -- related secondary stack globals. + + Set_String (" Default_Secondary_Stack_Size := "); + + if Opt.Default_Sec_Stack_Size /= Opt.No_Stack_Size then + Set_Int (Opt.Default_Sec_Stack_Size); + else + Set_String ("System.Parameters.Runtime_Default_Sec_Stack_Size"); + end if; + + Set_Char (';'); + Write_Statement_Buffer; + + Set_String (" Binder_Sec_Stacks_Count := "); + Set_Int (Num_Sec_Stacks); + Set_Char (';'); + Write_Statement_Buffer; + + WBI (" Default_Sized_SS_Pool := " & + "Sec_Default_Sized_Stacks'Address;"); + WBI (""); + + -- When a restricted run-time initializes the main task's secondary + -- stack but the program does not use it, no secondary stack is + -- generated. Binder_Sec_Stacks_Count is set to zero so the run-time + -- is aware that the lack of pre-allocated secondary stack is + -- expected. + + elsif System_Secondary_Stack_Used then + WBI (" Binder_Sec_Stacks_Count := 0;"); + end if; + -- Normal case (standard library not suppressed). Set all global values -- used by the run time. @@ -647,6 +745,10 @@ package body Bindgen is WBI (" Default_Stack_Size : Integer;"); WBI (" pragma Import (C, Default_Stack_Size, " & """__gl_default_stack_size"");"); + WBI (" Default_Secondary_Stack_Size : " & + "System.Parameters.Size_Type;"); + WBI (" pragma Import (C, Default_Secondary_Stack_Size, " & + """__gnat_default_ss_size"");"); WBI (" Leap_Seconds_Support : Integer;"); WBI (" pragma Import (C, Leap_Seconds_Support, " & """__gl_leap_seconds_support"");"); @@ -730,6 +832,18 @@ package body Bindgen is & """__gnat_freeze_dispatching_domains"");"); end if; + -- Secondary stack global variables + + WBI (" Binder_Sec_Stacks_Count : Natural;"); + WBI (" pragma Import (Ada, Binder_Sec_Stacks_Count, " & + """__gnat_binder_ss_count"");"); + + WBI (" Default_Sized_SS_Pool : System.Address;"); + WBI (" pragma Import (Ada, Default_Sized_SS_Pool, " & + """__gnat_default_ss_pool"");"); + + WBI (""); + -- Start of processing for Adainit WBI (" begin"); @@ -870,9 +984,51 @@ package body Bindgen is WBI (" Bind_Env_Addr := Bind_Env'Address;"); end if; - -- Generate call to Install_Handler - WBI (""); + + -- Generate default-sized secondary stack pool and set secondary + -- stack globals. + + if Sec_Stack_Used then + + -- Elaborate the body of the binder to initialize the default- + -- sized secondary stack pool. + + WBI (" " & Get_Ada_Main_Name & "'Elab_Body;"); + + -- Generate the default-sized secondary stack pool and set the + -- related secondary stack globals. + + Set_String (" Default_Secondary_Stack_Size := "); + + if Opt.Default_Sec_Stack_Size /= Opt.No_Stack_Size then + Set_Int (Opt.Default_Sec_Stack_Size); + else + Set_String ("System.Parameters.Runtime_Default_Sec_Stack_Size"); + end if; + + Set_Char (';'); + Write_Statement_Buffer; + + Set_String (" Binder_Sec_Stacks_Count := "); + Set_Int (Num_Sec_Stacks); + Set_Char (';'); + Write_Statement_Buffer; + + Set_String (" Default_Sized_SS_Pool := "); + + if Num_Sec_Stacks > 0 then + Set_String ("Sec_Default_Sized_Stacks'Address;"); + else + Set_String ("System.Null_Address;"); + end if; + + Write_Statement_Buffer; + WBI (""); + end if; + + -- Generate call to Runtime_Initialize + WBI (" Runtime_Initialize (1);"); end if; @@ -888,17 +1044,6 @@ package body Bindgen is Write_Statement_Buffer; end if; - -- Generate assignment of default secondary stack size if set - - if Sec_Stack_Used and then Default_Sec_Stack_Size /= -1 then - WBI (""); - Set_String (" System.Secondary_Stack."); - Set_String ("Default_Secondary_Stack_Size := "); - Set_Int (Opt.Default_Sec_Stack_Size); - Set_Char (';'); - Write_Statement_Buffer; - end if; - -- Initialize stack limit variable of the environment task if the stack -- check method is stack limit and stack check is enabled. @@ -2044,6 +2189,26 @@ package body Bindgen is end if; end loop; + -- Count the number of statically allocated stacks to be generated by + -- the binder. If the user has specified the number of default-sized + -- secondary stacks, use that number. Otherwise start the count at one + -- as the binder is responsible for creating a secondary stack for the + -- main task. + + if Opt.Quantity_Of_Default_Size_Sec_Stacks /= -1 then + Num_Sec_Stacks := Quantity_Of_Default_Size_Sec_Stacks; + elsif Sec_Stack_Used then + Num_Sec_Stacks := 1; + end if; + + for J in Units.First .. Units.Last loop + Num_Primary_Stacks := + Num_Primary_Stacks + Units.Table (J).Primary_Stack_Count; + + Num_Sec_Stacks := + Num_Sec_Stacks + Units.Table (J).Sec_Stack_Count; + end loop; + -- Generate output file in appropriate language Gen_Output_File_Ada (Filename, Elab_Order); @@ -2114,9 +2279,11 @@ package body Bindgen is WBI ("with System.Scalar_Values;"); end if; - -- Generate with of System.Secondary_Stack if active + -- Generate withs of System.Secondary_Stack and System.Parameters to + -- allow the generation of the default-sized secondary stack pool. - if Sec_Stack_Used and then Default_Sec_Stack_Size /= -1 then + if Sec_Stack_Used then + WBI ("with System.Parameters;"); WBI ("with System.Secondary_Stack;"); end if; @@ -2156,10 +2323,10 @@ package body Bindgen is end if; end if; - -- Define exit status. Again in normal mode, this is in the - -- run-time library, and is initialized there, but in the - -- configurable runtime case, the variable is declared and - -- initialized in this file. + -- Define exit status. Again in normal mode, this is in the run-time + -- library, and is initialized there, but in the configurable + -- run-time case, the variable is declared and initialized in this + -- file. WBI (""); @@ -2358,6 +2525,29 @@ package body Bindgen is Gen_Elab_Externals (Elab_Order); + -- Generate default-sized secondary stacks pool. At least one stack is + -- created and assigned to the environment task if secondary stacks are + -- used by the program. + + if Sec_Stack_Used then + Set_String (" Sec_Default_Sized_Stacks"); + Set_String (" : array (1 .. "); + Set_Int (Num_Sec_Stacks); + Set_String (") of aliased System.Secondary_Stack.SS_Stack ("); + + if Opt.Default_Sec_Stack_Size /= No_Stack_Size then + Set_Int (Opt.Default_Sec_Stack_Size); + else + Set_String ("System.Parameters.Runtime_Default_Sec_Stack_Size"); + end if; + + Set_String (");"); + Write_Statement_Buffer; + WBI (""); + end if; + + -- Generate reference + if not CodePeer_Mode then if not Suppress_Standard_Library_On_Target then @@ -2389,8 +2579,8 @@ package body Bindgen is if not Suppress_Standard_Library_On_Target then - -- The B.1(39) implementation advice says that the adainit - -- and adafinal routines should be idempotent. Generate a flag to + -- The B.1(39) implementation advice says that the adainit and + -- adafinal routines should be idempotent. Generate a flag to -- ensure that. This is not needed if we are suppressing the -- standard library since it would never be referenced. @@ -2873,6 +3063,11 @@ package body Bindgen is Check_Package (System_Restrictions_Used, "system.restrictions%s"); + -- Ditto for the use of System.Secondary_Stack + + Check_Package + (System_Secondary_Stack_Used, "system.secondary_stack%s"); + -- Ditto for use of an SMP bareboard runtime Check_Package (System_BB_CPU_Primitives_Multiprocessors_Used, diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb index 6cf7710219eb8..7c17f93951492 100644 --- a/gcc/ada/bindusg.adb +++ b/gcc/ada/bindusg.adb @@ -210,6 +210,11 @@ package body Bindusg is Write_Line (" -P Generate binder file suitable for CodePeer"); + -- Line for Q switch + + Write_Line + (" -Qnnn Generate nnn default-sized secondary stacks"); + -- Line for -r switch Write_Line @@ -309,8 +314,6 @@ package body Bindusg is Write_Line (" -z No main subprogram (zero main)"); - -- Line for --RTS - -- Line for -Z switch Write_Line diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 8a542ad34dd4d..b2c26ca4981fd 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -5398,8 +5398,10 @@ package body Checks is elsif Checks_May_Be_Suppressed (E) then if Is_Check_Suppressed (E, Elaboration_Check) then return True; + elsif Dynamic_Elaboration_Checks then return Is_Check_Suppressed (E, All_Checks); + else return False; end if; @@ -5408,8 +5410,10 @@ package body Checks is if Scope_Suppress.Suppress (Elaboration_Check) then return True; + elsif Dynamic_Elaboration_Checks then return Scope_Suppress.Suppress (All_Checks); + else return False; end if; @@ -5936,6 +5940,10 @@ package body Checks is -- In addition, we force a check if Force_Validity_Checks is set elsif not Comes_From_Source (Expr) + and then not + (Nkind (Expr) = N_Identifier + and then Present (Renamed_Object (Entity (Expr))) + and then Comes_From_Source (Renamed_Object (Entity (Expr)))) and then not Force_Validity_Checks and then (Nkind (Expr) /= N_Unchecked_Type_Conversion or else Kill_Range_Check (Expr)) @@ -7927,7 +7935,7 @@ package body Checks is Flag_Id := Make_Defining_Identifier (Loc, - Chars => New_External_Name (Chars (Subp_Id), 'F', -1)); + Chars => New_External_Name (Chars (Subp_Id), 'E', -1)); Set_Is_Frozen (Flag_Id); -- Insert the declaration of the elaboration flag in front of the @@ -7936,7 +7944,7 @@ package body Checks is Push_Scope (Scope (Subp_Id)); -- Generate: - -- F : Boolean := False; + -- E : Boolean := False; Insert_Action (Subp_Decl, Make_Object_Declaration (Loc, @@ -7986,7 +7994,7 @@ package body Checks is end if; -- Generate: - -- F := True; + -- E := True; Insert_After_And_Analyze (Set_Ins, Make_Assignment_Statement (Loc, @@ -8060,12 +8068,14 @@ package body Checks is -- since it clearly was not overridden at any point). For a predefined -- check, we test the specific flag. For a user defined check, we check -- the All_Checks flag. The Overflow flag requires special handling to - -- deal with the General vs Assertion case + -- deal with the General vs Assertion case. if C = Overflow_Check then return Overflow_Checks_Suppressed (Empty); + elsif C in Predefined_Check_Id then return Scope_Suppress.Suppress (C); + else return Scope_Suppress.Suppress (All_Checks); end if; diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index fe480beb426b8..e45c0542f2678 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -62,15 +62,22 @@ package body CStand is ----------------------- procedure Build_Float_Type - (E : Entity_Id; - Siz : Int; - Rep : Float_Rep_Kind; - Digs : Int); + (E : Entity_Id; + Digs : Int; + Rep : Float_Rep_Kind; + Siz : Int; + Align : Int); -- Procedure to build standard predefined float base type. The first - -- parameter is the entity for the type, and the second parameter is the - -- size in bits. The third parameter indicates the kind of representation - -- to be used. The fourth parameter is the digits value. Each type + -- parameter is the entity for the type. The second parameter is the + -- digits value. The third parameter indicates the representation to + -- be used for the type. The fourth parameter is the size in bits. + -- The fifth parameter is the alignment in storage units. Each type -- is added to the list of predefined floating point types. + -- + -- Note that both RM_Size and Esize are set to the specified size, i.e. + -- we do not set the RM_Size to the precision passed by the back end. + -- This is consistent with the semantics of 'Size specified in the RM + -- because we cannot pack components of the type tighter than this size. procedure Build_Signed_Integer_Type (E : Entity_Id; Siz : Nat); -- Procedure to build standard predefined signed integer subtype. The @@ -189,10 +196,11 @@ package body CStand is ---------------------- procedure Build_Float_Type - (E : Entity_Id; - Siz : Int; - Rep : Float_Rep_Kind; - Digs : Int) + (E : Entity_Id; + Digs : Int; + Rep : Float_Rep_Kind; + Siz : Int; + Align : Int) is begin Set_Type_Definition (Parent (E), @@ -201,10 +209,10 @@ package body CStand is Set_Ekind (E, E_Floating_Point_Type); Set_Etype (E, E); - Set_Float_Rep (E, Rep); - Init_Size (E, Siz); - Set_Elem_Alignment (E); Init_Digits_Value (E, Digs); + Set_Float_Rep (E, Rep); + Init_Size (E, Siz); + Set_Elem_Alignment (E, Align); Set_Float_Bounds (E); Set_Is_Frozen (E); Set_Is_Public (E); @@ -295,8 +303,9 @@ package body CStand is procedure Copy_Float_Type (To : Entity_Id; From : Entity_Id) is begin - Build_Float_Type (To, UI_To_Int (Esize (From)), Float_Rep (From), - UI_To_Int (Digits_Value (From))); + Build_Float_Type + (To, UI_To_Int (Digits_Value (From)), Float_Rep (From), + UI_To_Int (Esize (From)), UI_To_Int (Alignment (From))); end Copy_Float_Type; ---------------------- @@ -2065,15 +2074,17 @@ package body CStand is Size : Positive; Alignment : Natural) is + pragma Unreferenced (Precision); + -- See Build_Float_Type for the rationale + Ent : constant Entity_Id := New_Standard_Entity; begin Set_Defining_Identifier (New_Node (N_Full_Type_Declaration, Stloc), Ent); Make_Name (Ent, Name); Set_Scope (Ent, Standard_Standard); - Build_Float_Type (Ent, Int (Size), Float_Rep, Pos (Digs)); - Set_RM_Size (Ent, UI_From_Int (Int (Precision))); - Set_Alignment (Ent, UI_From_Int (Int (Alignment / 8))); + Build_Float_Type + (Ent, Pos (Digs), Float_Rep, Int (Size), Int (Alignment / 8)); if No (Back_End_Float_Types) then Back_End_Float_Types := New_Elmt_List; diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 25d083992205f..442ce0873e529 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -75,7 +75,7 @@ package body Debug is -- dI Inhibit internal name numbering in gnatG listing -- dJ Prepend subprogram name in messages -- dK Kill all error messages - -- dL Output trace information on elaboration checking + -- dL Ignore external calls from instances for elaboration -- dM Assume all variables are modified (no current values) -- dN No file name information in exception messages -- dO Output immediate error messages @@ -112,7 +112,7 @@ package body Debug is -- d.s Strict secondary stack management -- d.t Disable static allocation of library level dispatch tables -- d.u Enable Modify_Tree_For_C (update tree for c) - -- d.v + -- d.v Enforce SPARK elaboration rules in SPARK code -- d.w Do not check for infinite loops -- d.x No exception handlers -- d.y Disable implicit pragma Elaborate_All on task bodies @@ -163,7 +163,7 @@ package body Debug is -- d.6 Do not avoid declaring unreferenced types in C code -- d.7 -- d.8 - -- d.9 Enable build-in-place for nonlimited types + -- d.9 Disable build-in-place for nonlimited types -- Debug flags for binder (GNATBIND) @@ -414,10 +414,9 @@ package body Debug is -- of all error messages. It is used in regression tests where the -- error messages are target dependent and irrelevant. - -- dL Output trace information on elaboration checking. This debug - -- switch causes output to be generated showing each call or - -- instantiation as it is checked, and the progress of the recursive - -- trace through elaboration calls at compile time. + -- dL The compiler ignores calls in instances and invoke subprograms + -- which are external to the instance for the static elaboration + -- model. This switch is orthogonal to d.G. -- dM Assume all variables have been modified, and ignore current value -- indications. This debug flag disconnects the tracking of constant @@ -601,6 +600,13 @@ package body Debug is -- d.u Sets Modify_Tree_For_C mode in which tree is modified to make it -- easier to generate code using a C compiler. + -- d.v This flag enforces the elaboration rules defined in the SPARK + -- Reference Manual, chapter 7.7, to all SPARK code within a unit. As + -- a result, constructs which violate the rules in chapter 7.7 are no + -- longer accepted, even if the implementation is able to statically + -- ensure that accepting these constructs does not introduce the + -- possibility of failing an elaboration check. + -- d.w This flag turns off the scanning of loops to detect possible -- infinite loops. @@ -664,7 +670,8 @@ package body Debug is -- d.G Previously the compiler ignored calls via generic formal parameters -- when doing the analysis for the static elaboration model. This is -- now fixed, but we provide this debug flag to revert to the previous - -- situation of ignoring such calls to aid in transition. + -- situation of ignoring such calls to aid in transition. This switch + -- is orthogonal to dL. -- d.H Sets ASIS_GNSA_Mode to True. This signals the front end to suppress -- the call to gigi in ASIS_Mode. diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst b/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst index be7338f743627..c6018227b06ee 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst @@ -302,11 +302,15 @@ Aspect Iterable This aspect provides a light-weight mechanism for loops and quantified expressions over container types, without the overhead imposed by the tampering checks of standard Ada 2012 iterators. The value of the aspect is an aggregate -with four named components: ``First``, ``Next``, ``Has_Element``, and ``Element`` (the -last one being optional). When only 3 components are specified, only the -``for .. in`` form of iteration over cursors is available. When all 4 components -are specified, both this form and the ``for .. of`` form of iteration over -elements are available. The following is a typical example of use: +with six named components, or which the last three are optional: ``First``, + ``Next``, ``Has_Element``,``Element``, ``Last``, and ``Previous``. +When only the first three components are specified, only the +``for .. in`` form of iteration over cursors is available. When ``Element`` +is specified, both this form and the ``for .. of`` form of iteration over +elements are available. If the last two components are specified, reverse +iterations over the container can be specified (analogous to what can be done +over predefined containers that support the Reverse_Iterator interface). +The following is a typical example of use: .. code-block:: ada diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst index 046fe35a825bd..b6447d05dd67b 100644 --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst @@ -1243,21 +1243,13 @@ Alphabetical List of All Switches :file:`scos.adb`. -.. index:: -fdump-xref (gcc) - -:switch:`-fdump-xref` - Generates cross reference information in GLI files for C and C++ sources. - The GLI files have the same syntax as the ALI files for Ada, and can be used - for source navigation in IDEs and on the command line using e.g. gnatxref - and the :switch:`--ext=gli` switch. - - .. index:: -flto (gcc) :switch:`-flto[={n}]` Enables Link Time Optimization. This switch must be used in conjunction - with the traditional :switch:`-Ox` switches and instructs the compiler to - defer most optimizations until the link stage. The advantage of this + with the :switch:`-Ox` switches (but not with the :switch:`-gnatn` switch + since it is a full replacement for the latter) and instructs the compiler + to defer most optimizations until the link stage. The advantage of this approach is that the compiler can do a whole-program analysis and choose the best interprocedural optimization strategy based on a complete view of the program, instead of a fragmentary view with the usual approach. @@ -3898,8 +3890,8 @@ of the pragma in the :title:`GNAT_Reference_manual`). This switch activates warnings for exception usage when pragma Restrictions (No_Exception_Propagation) is in effect. Warnings are given for implicit or explicit exception raises which are not covered by a local handler, and for - exception handlers which do not cover a local raise. The default is that these - warnings are not given. + exception handlers which do not cover a local raise. The default is that + these warnings are given for units that contain exception handlers. :switch:`-gnatw.X` diff --git a/gcc/ada/doc/gnat_ugn/elaboration_order_handling_in_gnat.rst b/gcc/ada/doc/gnat_ugn/elaboration_order_handling_in_gnat.rst index 688dd9961bc81..c45d3fcdbee8c 100644 --- a/gcc/ada/doc/gnat_ugn/elaboration_order_handling_in_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/elaboration_order_handling_in_gnat.rst @@ -17,1855 +17,1806 @@ Elaboration Order Handling in GNAT .. index:: Order of elaboration .. index:: Elaboration control -This appendix describes the handling of elaboration code in Ada and -in GNAT, and discusses how the order of elaboration of program units can -be controlled in GNAT, either automatically or with explicit programming -features. +This appendix describes the handling of elaboration code in Ada and GNAT, and +discusses how the order of elaboration of program units can be controlled in +GNAT, either automatically or with explicit programming features. .. _Elaboration_Code: Elaboration Code ================ -Ada provides rather general mechanisms for executing code at elaboration -time, that is to say before the main program starts executing. Such code arises -in three contexts: +Ada defines the term *execution* as the process by which a construct achieves +its run-time effect. This process is also referred to as **elaboration** for +declarations and *evaluation* for expressions. -* *Initializers for variables* +The execution model in Ada allows for certain sections of an Ada program to be +executed prior to execution of the program itself, primarily with the intent of +initializing data. These sections are referred to as **elaboration code**. +Elaboration code is executed as follows: - Variables declared at the library level, in package specs or bodies, can - require initialization that is performed at elaboration time, as in: +* All partitions of an Ada program are executed in parallel with one another, + possibly in a separate address space, and possibly on a separate computer. - .. code-block:: ada +* The execution of a partition involves running the environment task for that + partition. - Sqrt_Half : Float := Sqrt (0.5); +* The environment task executes all elaboration code (if available) for all + units within that partition. This code is said to be executed at + **elaboration time**. -* *Package initialization code* +* The environment task executes the Ada program (if available) for that + partition. - Code in a ``begin`` ... `` end`` section at the outer level of a package body is - executed as part of the package body elaboration code. +In addition to the Ada terminology, this appendix defines the following terms: -* *Library level task allocators* +* *Scenario* - Tasks that are declared using task allocators at the library level - start executing immediately and hence can execute at elaboration time. + A construct that is elaborated or executed by elaboration code is referred to + as an *elaboration scenario* or simply a **scenario**. GNAT recognizes the + following scenarios: -Subprogram calls are possible in any of these contexts, which means that -any arbitrary part of the program may be executed as part of the elaboration -code. It is even possible to write a program which does all its work at -elaboration time, with a null main program, although stylistically this -would usually be considered an inappropriate way to structure -a program. + - ``'Access`` of entries, operators, and subprograms -An important concern arises in the context of elaboration code: -we have to be sure that it is executed in an appropriate order. What we -have is a series of elaboration code sections, potentially one section -for each unit in the program. It is important that these execute -in the correct order. Correctness here means that, taking the above -example of the declaration of ``Sqrt_Half``, -if some other piece of -elaboration code references ``Sqrt_Half``, -then it must run after the -section of elaboration code that contains the declaration of -``Sqrt_Half``. + - Activation of tasks -There would never be any order of elaboration problem if we made a rule -that whenever you |with| a unit, you must elaborate both the spec and body -of that unit before elaborating the unit doing the |withing|: + - Calls to entries, operators, and subprograms -.. code-block:: ada + - Instantiations of generic templates - with Unit_1; - package Unit_2 is ... +* *Target* -would require that both the body and spec of ``Unit_1`` be elaborated -before the spec of ``Unit_2``. However, a rule like that would be far too -restrictive. In particular, it would make it impossible to have routines -in separate packages that were mutually recursive. + A construct elaborated by a scenario is referred to as *elaboration target* + or simply **target**. GNAT recognizes the following targets: -You might think that a clever enough compiler could look at the actual -elaboration code and determine an appropriate correct order of elaboration, -but in the general case, this is not possible. Consider the following -example. + - For ``'Access`` of entries, operators, and subprograms, the target is the + entry, operator, or subprogram being aliased. -In the body of ``Unit_1``, we have a procedure ``Func_1`` -that references -the variable ``Sqrt_1``, which is declared in the elaboration code -of the body of ``Unit_1``: + - For activation of tasks, the target is the task body -.. code-block:: ada + - For calls to entries, operators, and subprograms, the target is the entry, + operator, or subprogram being invoked. - Sqrt_1 : Float := Sqrt (0.1); + - For instantiations of generic templates, the target is the generic template + being instantiated. -The elaboration code of the body of ``Unit_1`` also contains: +Elaboration code may appear in two distinct contexts: -.. code-block:: ada +* *Library level* - if expression_1 = 1 then - Q := Unit_2.Func_2; - end if; + A scenario appears at the library level when it is encapsulated by a package + [body] compilation unit, ignoring any other package [body] declarations in + between. -``Unit_2`` is exactly parallel, -it has a procedure ``Func_2`` that references -the variable ``Sqrt_2``, which is declared in the elaboration code of -the body ``Unit_2``: + :: -.. code-block:: ada + with Server; + package Client is + procedure Proc; - Sqrt_2 : Float := Sqrt (0.1); + package Nested is + Val : ... := Server.Func; + end Nested; + end Client; -The elaboration code of the body of ``Unit_2`` also contains: + In the example above, the call to ``Server.Func`` is an elaboration scenario + because it appears at the library level of package ``Client``. Note that the + declaration of package ``Nested`` is ignored according to the definition + given above. As a result, the call to ``Server.Func`` will be executed when + the spec of unit ``Client`` is elaborated. -.. code-block:: ada +* *Package body statements* - if expression_2 = 2 then - Q := Unit_1.Func_1; - end if; + A scenario appears within the statement sequence of a package body when it is + bounded by the region starting from the ``begin`` keyword of the package body + and ending at the ``end`` keyword of the package body. -Now the question is, which of the following orders of elaboration is -acceptable: + :: + + package body Client is + procedure Proc is + begin + ... + end Proc; + begin + Proc; + end Client; + + In the example above, the call to ``Proc`` is an elaboration scenario because + it appears within the statement sequence of package body ``Client``. As a + result, the call to ``Proc`` will be executed when the body of ``Client`` is + elaborated. + +.. _Elaboration_Order: + +Elaboration Order +================= + +The sequence by which the elaboration code of all units within a partition is +executed is referred to as **elaboration order**. + +Within a single unit, elaboration code is executed in sequential order. + +:: + + package body Client is + Result : ... := Server.Func; + + procedure Proc is + package Inst is new Server.Gen; + begin + Inst.Eval (Result); + end Proc; + begin + Proc; + end Client; + +In the example above, the elaboration order within package body ``Client`` is +as follows: + +1. The object declaration of ``Result`` is elaborated. + + * Function ``Server.Func`` is invoked. + +2. The subprogram body of ``Proc`` is elaborated. + +3. Procedure ``Proc`` is invoked. + + * Generic unit ``Server.Gen`` is instantiated as ``Inst``. + + * Instance ``Inst`` is elaborated. + + * Procedure ``Inst.Eval`` is invoked. + +The elaboration order of all units within a partition depends on the following +factors: + +* |withed| units + +* purity of units + +* preelaborability of units + +* presence of elaboration control pragmas + +A program may have several elaboration orders depending on its structure. + +:: + + package Server is + function Func (Index : Integer) return Integer; + end Server; :: - Spec of Unit_1 - Spec of Unit_2 - Body of Unit_1 - Body of Unit_2 + package body Server is + Results : array (1 .. 5) of Integer := (1, 2, 3, 4, 5); + + function Func (Index : Integer) return Integer is + begin + return Results (Index); + end Func; + end Server; + +:: -or + with Server; + package Client is + Val : constant Integer := Server.Func (3); + end Client; :: - Spec of Unit_2 - Spec of Unit_1 - Body of Unit_2 - Body of Unit_1 - -If you carefully analyze the flow here, you will see that you cannot tell -at compile time the answer to this question. -If ``expression_1`` is not equal to 1, -and ``expression_2`` is not equal to 2, -then either order is acceptable, because neither of the function calls is -executed. If both tests evaluate to true, then neither order is acceptable -and in fact there is no correct order. - -If one of the two expressions is true, and the other is false, then one -of the above orders is correct, and the other is incorrect. For example, -if ``expression_1`` /= 1 and ``expression_2`` = 2, -then the call to ``Func_1`` -will occur, but not the call to ``Func_2.`` -This means that it is essential -to elaborate the body of ``Unit_1`` before -the body of ``Unit_2``, so the first -order of elaboration is correct and the second is wrong. - -By making ``expression_1`` and ``expression_2`` -depend on input data, or perhaps -the time of day, we can make it impossible for the compiler or binder -to figure out which of these expressions will be true, and hence it -is impossible to guarantee a safe order of elaboration at run time. + with Client; + procedure Main is begin null; end Main; + +The following elaboration order exhibits a fundamental problem referred to as +*access-before-elaboration* or simply **ABE**. + +:: + + spec of Server + spec of Client + body of Server + body of Main + +The elaboration of ``Server``'s spec materializes function ``Func``, making it +callable. The elaboration of ``Client``'s spec elaborates the declaration of +``Val``. This invokes function ``Server.Func``, however the body of +``Server.Func`` has not been elaborated yet because ``Server``'s body comes +after ``Client``'s spec in the elaboration order. As a result, the value of +constant ``Val`` is now undefined. + +Without any guarantees from the language, an undetected ABE problem may hinder +proper initialization of data, which in turn may lead to undefined behavior at +run time. To prevent such ABE problems, Ada employs dynamic checks in the same +vein as index or null exclusion checks. A failed ABE check raises exception +``Program_Error``. + +The following elaboration order avoids the ABE problem and the program can be +successfully elaborated. + +:: + + spec of Server + body of Server + spec of Client + body of Main + +Ada states that a total elaboration order must exist, but it does not define +what this order is. A compiler is thus tasked with choosing a suitable +elaboration order which satisfies the dependencies imposed by |with| clauses, +unit categorization, and elaboration control pragmas. Ideally an order which +avoids ABE problems should be chosen, however a compiler may not always find +such an order due to complications with respect to control and data flow. .. _Checking_the_Elaboration_Order: Checking the Elaboration Order ============================== -In some languages that involve the same kind of elaboration problems, -e.g., Java and C++, the programmer needs to take these -ordering problems into account, and it is common to -write a program in which an incorrect elaboration order gives -surprising results, because it references variables before they -are initialized. -Ada is designed to be a safe language, and a programmer-beware approach is -clearly not sufficient. Consequently, the language provides three lines -of defense: +To avoid placing the entire elaboration order burden on the programmer, Ada +provides three lines of defense: + +* *Static semantics* -* *Standard rules* + Static semantic rules restrict the possible choice of elaboration order. For + instance, if unit Client |withs| unit Server, then the spec of Server is + always elaborated prior to Client. The same principle applies to child units + - the spec of a parent unit is always elaborated prior to the child unit. - Some standard rules restrict the possible choice of elaboration - order. In particular, if you |with| a unit, then its spec is always - elaborated before the unit doing the |with|. Similarly, a parent - spec is always elaborated before the child spec, and finally - a spec is always elaborated before its corresponding body. +* *Dynamic semantics* -.. index:: Elaboration checks -.. index:: Checks, elaboration + Dynamic checks are performed at run time, to ensure that a target is + elaborated prior to a scenario that executes it, thus avoiding ABE problems. + A failed run-time check raises exception ``Program_Error``. The following + restrictions apply: -* *Dynamic elaboration checks* + - *Restrictions on calls* - Dynamic checks are made at run time, so that if some entity is accessed - before it is elaborated (typically by means of a subprogram call) - then the exception (``Program_Error``) is raised. + An entry, operator, or subprogram can be called from elaboration code only + when the corresponding body has been elaborated. + + - *Restrictions on instantiations* + + A generic unit can be instantiated by elaboration code only when the + corresponding body has been elaborated. + + - *Restrictions on task activation* + + A task can be activated by elaboration code only when the body of the + associated task type has been elaborated. + + The restrictions above can be summarized by the following rule: + + *If a target has a body, then this body must be elaborated prior to the + execution of the scenario that invokes, instantiates, or activates the + target.* * *Elaboration control* - Facilities are provided for the programmer to specify the desired order - of elaboration. - -Let's look at these facilities in more detail. First, the rules for -dynamic checking. One possible rule would be simply to say that the -exception is raised if you access a variable which has not yet been -elaborated. The trouble with this approach is that it could require -expensive checks on every variable reference. Instead Ada has two -rules which are a little more restrictive, but easier to check, and -easier to state: - -* *Restrictions on calls* - - A subprogram can only be called at elaboration time if its body - has been elaborated. The rules for elaboration given above guarantee - that the spec of the subprogram has been elaborated before the - call, but not the body. If this rule is violated, then the - exception ``Program_Error`` is raised. - -* *Restrictions on instantiations* - - A generic unit can only be instantiated if the body of the generic - unit has been elaborated. Again, the rules for elaboration given above - guarantee that the spec of the generic unit has been elaborated - before the instantiation, but not the body. If this rule is - violated, then the exception ``Program_Error`` is raised. - -The idea is that if the body has been elaborated, then any variables -it references must have been elaborated; by checking for the body being -elaborated we guarantee that none of its references causes any -trouble. As we noted above, this is a little too restrictive, because a -subprogram that has no non-local references in its body may in fact be safe -to call. However, it really would be unsafe to rely on this, because -it would mean that the caller was aware of details of the implementation -in the body. This goes against the basic tenets of Ada. - -A plausible implementation can be described as follows. -A Boolean variable is associated with each subprogram -and each generic unit. This variable is initialized to False, and is set to -True at the point body is elaborated. Every call or instantiation checks the -variable, and raises ``Program_Error`` if the variable is False. - -Note that one might think that it would be good enough to have one Boolean -variable for each package, but that would not deal with cases of trying -to call a body in the same package as the call -that has not been elaborated yet. -Of course a compiler may be able to do enough analysis to optimize away -some of the Boolean variables as unnecessary, and GNAT indeed -does such optimizations, but still the easiest conceptual model is to -think of there being one variable per subprogram. - -.. _Controlling_the_Elaboration_Order: - -Controlling the Elaboration Order -================================= + Pragmas are provided for the programmer to specify the desired elaboration + order. -In the previous section we discussed the rules in Ada which ensure -that ``Program_Error`` is raised if an incorrect elaboration order is -chosen. This prevents erroneous executions, but we need mechanisms to -specify a correct execution and avoid the exception altogether. -To achieve this, Ada provides a number of features for controlling -the order of elaboration. We discuss these features in this section. +.. _Controlling_the_Elaboration_Order_in_Ada: -First, there are several ways of indicating to the compiler that a given -unit has no elaboration problems: +Controlling the Elaboration Order in Ada +======================================== -* *packages that do not require a body* +Ada provides several idioms and pragmas to aid the programmer with specifying +the desired elaboration order and avoiding ABE problems altogether. - A library package that does not require a body does not permit - a body (this rule was introduced in Ada 95). - Thus if we have a such a package, as in: +* *Packages without a body* - .. code-block:: ada + A library package which does not require a completing body does not suffer + from ABE problems. - package Definitions is - generic - type m is new integer; - package Subp is - type a is array (1 .. 10) of m; - type b is array (1 .. 20) of m; - end Subp; - end Definitions; + :: - A package that |withs| ``Definitions`` may safely instantiate - ``Definitions.Subp`` because the compiler can determine that there - definitely is no package body to worry about in this case + package Pack is + generic + type Element is private; + package Containers is + type Element_Array is array (1 .. 10) of Element; + end Containers; + end Pack; + + In the example above, package ``Pack`` does not require a body because it + does not contain any constructs which require completion in a body. As a + result, generic ``Pack.Containers`` can be instantiated without encountering + any ABE problems. .. index:: pragma Pure * *pragma Pure* - This pragma places sufficient restrictions on a unit to guarantee that - no call to any subprogram in the unit can result in an - elaboration problem. This means that the compiler does not need - to worry about the point of elaboration of such units, and in - particular, does not need to check any calls to any subprograms - in this unit. + Pragma ``Pure`` places sufficient restrictions on a unit to guarantee that no + scenario within the unit can result in an ABE problem. .. index:: pragma Preelaborate * *pragma Preelaborate* - This pragma places slightly less stringent restrictions on a unit than - does pragma Pure, - but these restrictions are still sufficient to ensure that there - are no elaboration problems with any calls to the unit. + Pragma ``Preelaborate`` is slightly less restrictive than pragma ``Pure``, + but still strong enough to prevent ABE problems within a unit. .. index:: pragma Elaborate_Body * *pragma Elaborate_Body* - This pragma requires that the body of a unit be elaborated immediately - after its spec. Suppose a unit ``A`` has such a pragma, - and unit ``B`` does - a |with| of unit ``A``. Recall that the standard rules require - the spec of unit ``A`` - to be elaborated before the |withing| unit; given the pragma in - ``A``, we also know that the body of ``A`` - will be elaborated before ``B``, so - that calls to ``A`` are safe and do not need a check. - - Note that, unlike pragma ``Pure`` and pragma ``Preelaborate``, - the use of ``Elaborate_Body`` does not guarantee that the program is - free of elaboration problems, because it may not be possible - to satisfy the requested elaboration order. - Let's go back to the example with ``Unit_1`` and ``Unit_2``. - If a programmer marks ``Unit_1`` as ``Elaborate_Body``, - and not ``Unit_2,`` then the order of - elaboration will be:: - - Spec of Unit_2 - Spec of Unit_1 - Body of Unit_1 - Body of Unit_2 - - Now that means that the call to ``Func_1`` in ``Unit_2`` - need not be checked, - it must be safe. But the call to ``Func_2`` in - ``Unit_1`` may still fail if - ``Expression_1`` is equal to 1, - and the programmer must still take - responsibility for this not being the case. - - If all units carry a pragma ``Elaborate_Body``, then all problems are - eliminated, except for calls entirely within a body, which are - in any case fully under programmer control. However, using the pragma - everywhere is not always possible. - In particular, for our ``Unit_1``/`Unit_2` example, if - we marked both of them as having pragma ``Elaborate_Body``, then - clearly there would be no possible elaboration order. - -The above pragmas allow a server to guarantee safe use by clients, and -clearly this is the preferable approach. Consequently a good rule -is to mark units as ``Pure`` or ``Preelaborate`` if possible, -and if this is not possible, -mark them as ``Elaborate_Body`` if possible. -As we have seen, there are situations where neither of these -three pragmas can be used. -So we also provide methods for clients to control the -order of elaboration of the servers on which they depend: - -.. index:: pragma Elaborate - -* *pragma Elaborate (unit)* - - This pragma is placed in the context clause, after a |with| clause, - and it requires that the body of the named unit be elaborated before - the unit in which the pragma occurs. The idea is to use this pragma - if the current unit calls at elaboration time, directly or indirectly, - some subprogram in the named unit. - - -.. index:: pragma Elaborate_All - -* *pragma Elaborate_All (unit)* - - This is a stronger version of the Elaborate pragma. Consider the - following example:: - - Unit A |withs| unit B and calls B.Func in elab code - Unit B |withs| unit C, and B.Func calls C.Func - - - Now if we put a pragma ``Elaborate (B)`` - in unit ``A``, this ensures that the - body of ``B`` is elaborated before the call, but not the - body of ``C``, so - the call to ``C.Func`` could still cause ``Program_Error`` to - be raised. - - The effect of a pragma ``Elaborate_All`` is stronger, it requires - not only that the body of the named unit be elaborated before the - unit doing the |with|, but also the bodies of all units that the - named unit uses, following |with| links transitively. For example, - if we put a pragma ``Elaborate_All (B)`` in unit ``A``, - then it requires not only that the body of ``B`` be elaborated before ``A``, - but also the body of ``C``, because ``B`` |withs| ``C``. - -We are now in a position to give a usage rule in Ada for avoiding -elaboration problems, at least if dynamic dispatching and access to -subprogram values are not used. We will handle these cases separately -later. - -The rule is simple: - -*If a unit has elaboration code that can directly or -indirectly make a call to a subprogram in a |withed| unit, or instantiate -a generic package in a |withed| unit, -then if the |withed| unit does not have -pragma ``Pure`` or ``Preelaborate``, then the client should have -a pragma ``Elaborate_All``for the |withed| unit.** - -By following this rule a client is -assured that calls can be made without risk of an exception. - -For generic subprogram instantiations, the rule can be relaxed to -require only a pragma ``Elaborate`` since elaborating the body -of a subprogram cannot cause any transitive elaboration (we are -not calling the subprogram in this case, just elaborating its -declaration). - -If this rule is not followed, then a program may be in one of four -states: - -* *No order exists* - - No order of elaboration exists which follows the rules, taking into - account any ``Elaborate``, ``Elaborate_All``, - or ``Elaborate_Body`` pragmas. In - this case, an Ada compiler must diagnose the situation at bind - time, and refuse to build an executable program. - -* *One or more orders exist, all incorrect* + Pragma ``Elaborate_Body`` requires that the body of a unit is elaborated + immediately after its spec. This restriction guarantees that no client + scenario can execute a server target before the target body has been + elaborated because the spec and body are effectively "glued" together. - One or more acceptable elaboration orders exist, and all of them - generate an elaboration order problem. In this case, the binder - can build an executable program, but ``Program_Error`` will be raised - when the program is run. + :: -* *Several orders exist, some right, some incorrect* + package Server is + pragma Elaborate_Body; - One or more acceptable elaboration orders exists, and some of them - work, and some do not. The programmer has not controlled - the order of elaboration, so the binder may or may not pick one of - the correct orders, and the program may or may not raise an - exception when it is run. This is the worst case, because it means - that the program may fail when moved to another compiler, or even - another version of the same compiler. + function Func return Integer; + end Server; -* *One or more orders exists, all correct* + :: - One ore more acceptable elaboration orders exist, and all of them - work. In this case the program runs successfully. This state of - affairs can be guaranteed by following the rule we gave above, but - may be true even if the rule is not followed. + package body Server is + function Func return Integer is + begin + ... + end Func; + end Server; -Note that one additional advantage of following our rules on the use -of ``Elaborate`` and ``Elaborate_All`` -is that the program continues to stay in the ideal (all orders OK) state -even if maintenance -changes some bodies of some units. Conversely, if a program that does -not follow this rule happens to be safe at some point, this state of affairs -may deteriorate silently as a result of maintenance changes. + :: -You may have noticed that the above discussion did not mention -the use of ``Elaborate_Body``. This was a deliberate omission. If you -|with| an ``Elaborate_Body`` unit, it still may be the case that -code in the body makes calls to some other unit, so it is still necessary -to use ``Elaborate_All`` on such units. + with Server; + package Client is + Val : constant Integer := Server.Func; + end Client; + In the example above, pragma ``Elaborate_Body`` guarantees the following + elaboration order: -.. _Controlling_Elaboration_in_GNAT_-_Internal_Calls: + :: -Controlling Elaboration in GNAT - Internal Calls -================================================ + spec of Server + body of Server + spec of Client -In the case of internal calls, i.e., calls within a single package, the -programmer has full control over the order of elaboration, and it is up -to the programmer to elaborate declarations in an appropriate order. For -example writing: + because the spec of ``Server`` must be elaborated prior to ``Client`` by + virtue of the |with| clause, and in addition the body of ``Server`` must be + elaborated immediately after the spec of ``Server``. -.. code-block:: ada + Removing pragma ``Elaborate_Body`` could result in the following incorrect + elaboration order: - function One return Float; - - Q : Float := One; + :: - function One return Float is - begin - return 1.0; - end One; - -will obviously raise ``Program_Error`` at run time, because function -One will be called before its body is elaborated. In this case GNAT will -generate a warning that the call will raise ``Program_Error``:: - - 1. procedure y is - 2. function One return Float; - 3. - 4. Q : Float := One; - | - >>> warning: cannot call "One" before body is elaborated - >>> warning: Program_Error will be raised at run time - - 5. - 6. function One return Float is - 7. begin - 8. return 1.0; - 9. end One; - 10. - 11. begin - 12. null; - 13. end; - - -Note that in this particular case, it is likely that the call is safe, because -the function ``One`` does not access any global variables. -Nevertheless in Ada, we do not want the validity of the check to depend on -the contents of the body (think about the separate compilation case), so this -is still wrong, as we discussed in the previous sections. - -The error is easily corrected by rearranging the declarations so that the -body of ``One`` appears before the declaration containing the call -(note that in Ada 95 as well as later versions of the Ada standard, -declarations can appear in any order, so there is no restriction that -would prevent this reordering, and if we write: - -.. code-block:: ada - - function One return Float; - - function One return Float is - begin - return 1.0; - end One; - - Q : Float := One; - -then all is well, no warning is generated, and no -``Program_Error`` exception -will be raised. -Things are more complicated when a chain of subprograms is executed: - -.. code-block:: ada - - function A return Integer; - function B return Integer; - function C return Integer; - - function B return Integer is begin return A; end; - function C return Integer is begin return B; end; - - X : Integer := C; - - function A return Integer is begin return 1; end; - -Now the call to ``C`` -at elaboration time in the declaration of ``X`` is correct, because -the body of ``C`` is already elaborated, -and the call to ``B`` within the body of -``C`` is correct, but the call -to ``A`` within the body of ``B`` is incorrect, because the body -of ``A`` has not been elaborated, so ``Program_Error`` -will be raised on the call to ``A``. -In this case GNAT will generate a -warning that ``Program_Error`` may be -raised at the point of the call. Let's look at the warning:: - - 1. procedure x is - 2. function A return Integer; - 3. function B return Integer; - 4. function C return Integer; - 5. - 6. function B return Integer is begin return A; end; - | - >>> warning: call to "A" before body is elaborated may - raise Program_Error - >>> warning: "B" called at line 7 - >>> warning: "C" called at line 9 - - 7. function C return Integer is begin return B; end; - 8. - 9. X : Integer := C; - 10. - 11. function A return Integer is begin return 1; end; - 12. - 13. begin - 14. null; - 15. end; - - -Note that the message here says 'may raise', instead of the direct case, -where the message says 'will be raised'. That's because whether -``A`` is -actually called depends in general on run-time flow of control. -For example, if the body of ``B`` said - -.. code-block:: ada - - function B return Integer is - begin - if some-condition-depending-on-input-data then - return A; - else - return 1; - end if; - end B; - -then we could not know until run time whether the incorrect call to A would -actually occur, so ``Program_Error`` might -or might not be raised. It is possible for a compiler to -do a better job of analyzing bodies, to -determine whether or not ``Program_Error`` -might be raised, but it certainly -couldn't do a perfect job (that would require solving the halting problem -and is provably impossible), and because this is a warning anyway, it does -not seem worth the effort to do the analysis. Cases in which it -would be relevant are rare. - -In practice, warnings of either of the forms given -above will usually correspond to -real errors, and should be examined carefully and eliminated. -In the rare case where a warning is bogus, it can be suppressed by any of -the following methods: - -* Compile with the :switch:`-gnatws` switch set - -* Suppress ``Elaboration_Check`` for the called subprogram - -* Use pragma ``Warnings_Off`` to turn warnings off for the call - -For the internal elaboration check case, -GNAT by default generates the -necessary run-time checks to ensure -that ``Program_Error`` is raised if any -call fails an elaboration check. Of course this can only happen if a -warning has been issued as described above. The use of pragma -``Suppress (Elaboration_Check)`` may (but is not guaranteed to) suppress -some of these checks, meaning that it may be possible (but is not -guaranteed) for a program to be able to call a subprogram whose body -is not yet elaborated, without raising a ``Program_Error`` exception. - - -.. _Controlling_Elaboration_in_GNAT_-_External_Calls: - -Controlling Elaboration in GNAT - External Calls -================================================ - -The previous section discussed the case in which the execution of a -particular thread of elaboration code occurred entirely within a -single unit. This is the easy case to handle, because a programmer -has direct and total control over the order of elaboration, and -furthermore, checks need only be generated in cases which are rare -and which the compiler can easily detect. -The situation is more complex when separate compilation is taken into account. -Consider the following: - -.. code-block:: ada - - package Math is - function Sqrt (Arg : Float) return Float; - end Math; - - package body Math is - function Sqrt (Arg : Float) return Float is - begin - ... - end Sqrt; - end Math; - - with Math; - package Stuff is - X : Float := Math.Sqrt (0.5); - end Stuff; - - with Stuff; - procedure Main is - begin - ... - end Main; - -where ``Main`` is the main program. When this program is executed, the -elaboration code must first be executed, and one of the jobs of the -binder is to determine the order in which the units of a program are -to be elaborated. In this case we have four units: the spec and body -of ``Math``, -the spec of ``Stuff`` and the body of ``Main``). -In what order should the four separate sections of elaboration code -be executed? - -There are some restrictions in the order of elaboration that the binder -can choose. In particular, if unit U has a |with| -for a package ``X``, then you -are assured that the spec of ``X`` -is elaborated before U , but you are -not assured that the body of ``X`` -is elaborated before U. -This means that in the above case, the binder is allowed to choose the -order:: + spec of Server + spec of Client + body of Server + + where ``Client`` invokes ``Server.Func``, but the body of ``Server.Func`` has + not been elaborated yet. + +The pragmas outlined above allow a server unit to guarantee safe elaboration +use by client units. Thus it is a good rule to mark units as ``Pure`` or +``Preelaborate``, and if this is not possible, mark them as ``Elaborate_Body``. + +There are however situations where ``Pure``, ``Preelaborate``, and +``Elaborate_Body`` are not applicable. Ada provides another set of pragmas for +use by client units to help ensure the elaboration safety of server units they +depend on. + +.. index:: pragma Elaborate (Unit) + +* *pragma Elaborate (Unit)* + + Pragma ``Elaborate`` can be placed in the context clauses of a unit, after a + |with| clause. It guarantees that both the spec and body of its argument will + be elaborated prior to the unit with the pragma. Note that other unrelated + units may be elaborated in between the spec and the body. + + :: + + package Server is + function Func return Integer; + end Server; + + :: + + package body Server is + function Func return Integer is + begin + ... + end Func; + end Server; + + :: + + with Server; + pragma Elaborate (Server); + package Client is + Val : constant Integer := Server.Func; + end Client; + + In the example above, pragma ``Elaborate`` guarantees the following + elaboration order: + + :: + + spec of Server + body of Server + spec of Client + + Removing pragma ``Elaborate`` could result in the following incorrect + elaboration order: + + :: + + spec of Server + spec of Client + body of Server + + where ``Client`` invokes ``Server.Func``, but the body of ``Server.Func`` + has not been elaborated yet. + +.. index:: pragma Elaborate_All (Unit) + +* *pragma Elaborate_All (Unit)* + + Pragma ``Elaborate_All`` is placed in the context clauses of a unit, after + a |with| clause. It guarantees that both the spec and body of its argument + will be elaborated prior to the unit with the pragma, as well as all units + |withed| by the spec and body of the argument, recursively. Note that other + unrelated units may be elaborated in between the spec and the body. + + :: + + package Math is + function Factorial (Val : Natural) return Natural; + end Math; + + :: + + package body Math is + function Factorial (Val : Natural) return Natural is + begin + ...; + end Factorial; + end Math; + + :: + + package Computer is + type Operation_Kind is (None, Op_Factorial); + + function Compute + (Val : Natural; + Op : Operation_Kind) return Natural; + end Computer; + + :: + + with Math; + package body Computer is + function Compute + (Val : Natural; + Op : Operation_Kind) return Natural + is + if Op = Op_Factorial then + return Math.Factorial (Val); + end if; + + return 0; + end Compute; + end Computer; + + :: + + with Computer; + pragma Elaborate_All (Computer); + package Client is + Val : constant Natural := + Computer.Compute (123, Computer.Op_Factorial); + end Client; + + In the example above, pragma ``Elaborate_All`` can result in the following + elaboration order: + + :: spec of Math - spec of Stuff body of Math - body of Main - -but that's not good, because now the call to ``Math.Sqrt`` -that happens during -the elaboration of the ``Stuff`` -spec happens before the body of ``Math.Sqrt`` is -elaborated, and hence causes ``Program_Error`` exception to be raised. -At first glance, one might say that the binder is misbehaving, because -obviously you want to elaborate the body of something you |with| first, but -that is not a general rule that can be followed in all cases. Consider - -.. code-block:: ada - - package X is ... - - package Y is ... - - with X; - package body Y is ... - - with Y; - package body X is ... - -This is a common arrangement, and, apart from the order of elaboration -problems that might arise in connection with elaboration code, this works fine. -A rule that says that you must first elaborate the body of anything you -|with| cannot work in this case: -the body of ``X`` |withs| ``Y``, -which means you would have to -elaborate the body of ``Y`` first, but that |withs| ``X``, -which means -you have to elaborate the body of ``X`` first, but ... and we have a -loop that cannot be broken. - -It is true that the binder can in many cases guess an order of elaboration -that is unlikely to cause a ``Program_Error`` -exception to be raised, and it tries to do so (in the -above example of ``Math/Stuff/Spec``, the GNAT binder will -by default -elaborate the body of ``Math`` right after its spec, so all will be well). - -However, a program that blindly relies on the binder to be helpful can -get into trouble, as we discussed in the previous sections, so GNAT -provides a number of facilities for assisting the programmer in -developing programs that are robust with respect to elaboration order. - - -.. _Default_Behavior_in_GNAT_-_Ensuring_Safety: - -Default Behavior in GNAT - Ensuring Safety -========================================== - -The default behavior in GNAT ensures elaboration safety. In its -default mode GNAT implements the -rule we previously described as the right approach. Let's restate it: - -*If a unit has elaboration code that can directly or indirectly make a -call to a subprogram in a |withed| unit, or instantiate a generic -package in a |withed| unit, then if the |withed| unit -does not have pragma ``Pure`` or ``Preelaborate``, then the client should have an -``Elaborate_All`` pragma for the |withed| unit.* - -*In the case of instantiating a generic subprogram, it is always -sufficient to have only an ``Elaborate`` pragma for the -|withed| unit.* - -By following this rule a client is assured that calls and instantiations -can be made without risk of an exception. - -In this mode GNAT traces all calls that are potentially made from -elaboration code, and puts in any missing implicit ``Elaborate`` -and ``Elaborate_All`` pragmas. -The advantage of this approach is that no elaboration problems -are possible if the binder can find an elaboration order that is -consistent with these implicit ``Elaborate`` and -``Elaborate_All`` pragmas. The -disadvantage of this approach is that no such order may exist. - -If the binder does not generate any diagnostics, then it means that it has -found an elaboration order that is guaranteed to be safe. However, the binder -may still be relying on implicitly generated ``Elaborate`` and -``Elaborate_All`` pragmas so portability to other compilers than GNAT is not -guaranteed. - -If it is important to guarantee portability, then the compilations should -use the :switch:`-gnatel` -(info messages for elaboration pragmas) switch. This will cause info messages -to be generated indicating the missing ``Elaborate`` and -``Elaborate_All`` pragmas. -Consider the following source program: - -.. code-block:: ada - - with k; - package j is - m : integer := k.r; - end; - -where it is clear that there -should be a pragma ``Elaborate_All`` -for unit ``k``. An implicit pragma will be generated, and it is -likely that the binder will be able to honor it. However, if you want -to port this program to some other Ada compiler than GNAT. -it is safer to include the pragma explicitly in the source. If this -unit is compiled with the :switch:`-gnatel` -switch, then the compiler outputs an information message:: - - 1. with k; - 2. package j is - 3. m : integer := k.r; - | - >>> info: call to "r" may raise Program_Error - >>> info: missing pragma Elaborate_All for "k" - - 4. end; - -and these messages can be used as a guide for supplying manually -the missing pragmas. It is usually a bad idea to use this -option during development. That's because it will tell you when -you need to put in a pragma, but cannot tell you when it is time -to take it out. So the use of pragma ``Elaborate_All`` may lead to -unnecessary dependencies and even false circularities. - -This default mode is more restrictive than the Ada Reference -Manual, and it is possible to construct programs which will compile -using the dynamic model described there, but will run into a -circularity using the safer static model we have described. - -Of course any Ada compiler must be able to operate in a mode -consistent with the requirements of the Ada Reference Manual, -and in particular must have the capability of implementing the -standard dynamic model of elaboration with run-time checks. - -In GNAT, this standard mode can be achieved either by the use of -the :switch:`-gnatE` switch on the compiler (``gcc`` or -``gnatmake``) command, or by the use of the configuration pragma: - -.. code-block:: ada - - pragma Elaboration_Checks (DYNAMIC); - -Either approach will cause the unit affected to be compiled using the -standard dynamic run-time elaboration checks described in the Ada -Reference Manual. The static model is generally preferable, since it -is clearly safer to rely on compile and link time checks rather than -run-time checks. However, in the case of legacy code, it may be -difficult to meet the requirements of the static model. This -issue is further discussed in -:ref:`What_to_Do_If_the_Default_Elaboration_Behavior_Fails`. - -Note that the static model provides a strict subset of the allowed -behavior and programs of the Ada Reference Manual, so if you do -adhere to the static model and no circularities exist, -then you are assured that your program will -work using the dynamic model, providing that you remove any -pragma Elaborate statements from the source. - - -.. _Treatment_of_Pragma_Elaborate: - -Treatment of Pragma Elaborate -============================= - -.. index:: Pragma Elaborate - -The use of ``pragma Elaborate`` -should generally be avoided in Ada 95 and Ada 2005 programs, -since there is no guarantee that transitive calls -will be properly handled. Indeed at one point, this pragma was placed -in Annex J (Obsolescent Features), on the grounds that it is never useful. - -Now that's a bit restrictive. In practice, the case in which -``pragma Elaborate`` is useful is when the caller knows that there -are no transitive calls, or that the called unit contains all necessary -transitive ``pragma Elaborate`` statements, and legacy code often -contains such uses. - -Strictly speaking the static mode in GNAT should ignore such pragmas, -since there is no assurance at compile time that the necessary safety -conditions are met. In practice, this would cause GNAT to be incompatible -with correctly written Ada 83 code that had all necessary -``pragma Elaborate`` statements in place. Consequently, we made the -decision that GNAT in its default mode will believe that if it encounters -a ``pragma Elaborate`` then the programmer knows what they are doing, -and it will trust that no elaboration errors can occur. - -The result of this decision is two-fold. First to be safe using the -static mode, you should remove all ``pragma Elaborate`` statements. -Second, when fixing circularities in existing code, you can selectively -use ``pragma Elaborate`` statements to convince the static mode of -GNAT that it need not generate an implicit ``pragma Elaborate_All`` -statement. - -When using the static mode with :switch:`-gnatwl`, any use of -``pragma Elaborate`` will generate a warning about possible -problems. - - -.. _Elaboration_Issues_for_Library_Tasks: - -Elaboration Issues for Library Tasks -==================================== - -.. index:: Library tasks, elaboration issues - -.. index:: Elaboration of library tasks - -In this section we examine special elaboration issues that arise for -programs that declare library level tasks. - -Generally the model of execution of an Ada program is that all units are -elaborated, and then execution of the program starts. However, the -declaration of library tasks definitely does not fit this model. The -reason for this is that library tasks start as soon as they are declared -(more precisely, as soon as the statement part of the enclosing package -body is reached), that is to say before elaboration -of the program is complete. This means that if such a task calls a -subprogram, or an entry in another task, the callee may or may not be -elaborated yet, and in the standard -Reference Manual model of dynamic elaboration checks, you can even -get timing dependent Program_Error exceptions, since there can be -a race between the elaboration code and the task code. - -The static model of elaboration in GNAT seeks to avoid all such -dynamic behavior, by being conservative, and the conservative -approach in this particular case is to assume that all the code -in a task body is potentially executed at elaboration time if -a task is declared at the library level. - -This can definitely result in unexpected circularities. Consider -the following example - -.. code-block:: ada - - package Decls is - task Lib_Task is - entry Start; - end Lib_Task; + spec of Computer + body of Computer + spec of Client - type My_Int is new Integer; + Note that there are several allowable suborders for the specs and bodies of + ``Math`` and ``Computer``, but the point is that these specs and bodies will + be elaborated prior to ``Client``. - function Ident (M : My_Int) return My_Int; - end Decls; + Removing pragma ``Elaborate_All`` could result in the following incorrect + elaboration order - with Utils; - package body Decls is - task body Lib_Task is - begin - accept Start; - Utils.Put_Val (2); - end Lib_Task; + :: - function Ident (M : My_Int) return My_Int is + spec of Math + spec of Computer + body of Computer + spec of Client + body of Math + + where ``Client`` invokes ``Computer.Compute``, which in turn invokes + ``Math.Factorial``, but the body of ``Math.Factorial`` has not been + elaborated yet. + +All pragmas shown above can be summarized by the following rule: + +*If a client unit elaborates a server target directly or indirectly, then if +the server unit requires a body and does not have pragma Pure, Preelaborate, +or Elaborate_Body, then the client unit should have pragma Elaborate or +Elaborate_All for the server unit.* + +If the rule outlined above is not followed, then a program may fall in one of +the following states: + +* *No elaboration order exists* + + In this case a compiler must diagnose the situation, and refuse to build an + executable program. + +* *One or more incorrect elaboration orders exist* + + In this case a compiler can build an executable program, but + ``Program_Error`` will be raised when the program is run. + +* *Several elaboration orders exist, some correct, some incorrect* + + In this case the programmer has not controlled the elaboration order. As a + result, a compiler may or may not pick one of the correct orders, and the + program may or may not raise ``Program_Error`` when it is run. This is the + worst possible state because the program may fail on another compiler, or + even another version of the same compiler. + +* *One or more correct orders exist* + + In this case a compiler can build an executable program, and the program is + run successfully. This state may be guaranteed by following the outlined + rules, or may be the result of good program architecture. + +Note that one additional advantage of using ``Elaborate`` and ``Elaborate_All`` +is that the program continues to stay in the last state (one or more correct +orders exist) even if maintenance changes the bodies of targets. + +.. _Controlling_the_Elaboration_Order_in_GNAT: + +Controlling the Elaboration Order in GNAT +========================================= + +In addition to Ada semantics and rules synthesized from them, GNAT offers +three elaboration models to aid the programmer with specifying the correct +elaboration order and to diagnose elaboration problems. + +.. index:: Dynamic elaboration model + +* *Dynamic elaboration model* + + This is the most permissive of the three elaboration models. When the + dynamic model is in effect, GNAT assumes that all code within all units in + a partition is elaboration code. GNAT performs very few diagnostics and + generates run-time checks to verify the elaboration order of a program. This + behavior is identical to that specified by the Ada Reference Manual. The + dynamic model is enabled with compiler switch :switch:`-gnatE`. + +.. index:: Static elaboration model + +* *Static elaboration model* + + This is the middle ground of the three models. When the static model is in + effect, GNAT performs extensive diagnostics on a unit-by-unit basis for all + scenarios that elaborate or execute internal targets. GNAT also generates + run-time checks for all external targets and for all scenarios that may + exhibit ABE problems. Finally, GNAT installs implicit ``Elaborate`` and + ``Elaborate_All`` pragmas for server units based on the dependencies of + client units. The static model is the default model in GNAT. + +.. index:: SPARK elaboration model + +* *SPARK elaboration model* + + This is the most conservative of the three models and enforces the SPARK + rules of elaboration as defined in the SPARK Reference Manual, section 7.7. + The SPARK model is in effect only when a scenario and a target reside in a + region subject to SPARK_Mode On, otherwise the dynamic or static model is in + effect. + +.. _Common_Elaboration_Model_Traits": + +Common Elaboration-model Traits +=============================== + +All three GNAT models are able to detect elaboration problems related to +dispatching calls and a particular kind of ABE referred to as *guaranteed ABE*. + +* *Dispatching calls* + + GNAT installs run-time checks for each primitive subprogram of each tagged + type defined in a partition on the assumption that a dispatching call + invoked at elaboration time will execute one of these primitives. As a + result, a dispatching call that executes a primitive whose body has not + been elaborated yet will raise exception ``Program_Error`` at run time. The + checks can be suppressed using pragma ``Suppress (Elaboration_Check)``. + +* *Guaranteed ABE* + + A guaranteed ABE arises when the body of a target is not elaborated early + enough, and causes all scenarios that directly execute the target to fail. + + :: + + package body Guaranteed_ABE is + function ABE return Integer; + + Val : constant Integer := ABE; + + function ABE return Integer is begin - return M; - end Ident; - end Decls; + ... + end ABE; + end Guaranteed_ABE; + + In the example above, the elaboration of ``Guaranteed_ABE``'s body elaborates + the declaration of ``Val``. This invokes function ``ABE``, however the body + of ``ABE`` has not been elaborated yet. GNAT emits similar diagnostics in all + three models: + + :: + + 1. package body Guaranteed_ABE is + 2. function ABE return Integer; + 3. + 4. Val : constant Integer := ABE; + | + >>> warning: cannot call "ABE" before body seen + >>> warning: Program_Error will be raised at run time + + 5. + 6. function ABE return Integer is + 7. begin + 8. ... + 9. end ABE; + 10. end Guaranteed_ABE; + +Note that GNAT emits warnings rather than hard errors whenever it encounters an +elaboration problem. This is because the elaboration model in effect may be too +conservative, or a particular scenario may not be elaborated or executed due to +data and control flow. The warnings can be suppressed with compiler switch +:switch:`-gnatws`. + +.. _Dynamic_Elaboration_Model_in_GNAT: + +Dynamic Elaboration Model in GNAT +================================= - with Decls; - package Utils is - procedure Put_Val (Arg : Decls.My_Int); - end Utils; +The dynamic model assumes that all code within all units in a partition is +elaboration code. As a result, run-time checks are installed for each scenario +regardless of whether the target is internal or external. The checks can be +suppressed using pragma ``Suppress (Elaboration_Check)``. This behavior is +identical to that specified by the Ada Reference Manual. The following example +showcases run-time checks installed by GNAT to verify the elaboration state of +package ``Dynamic_Model``. - with Text_IO; - package body Utils is - procedure Put_Val (Arg : Decls.My_Int) is +:: + + with Server; + package body Dynamic_Model is + procedure API is + begin + ... + end API; + + + package Inst is new Server.Gen; + + T : Server.Task_Type; + + begin + + + + Server.Proc; + end Dynamic_Model; + +The checks verify that the body of a target has been successfully elaborated +before a scenario activates, calls, or instantiates a target. + +Note that no scenario within package ``Dynamic_Model`` calls procedure ``API``. +In fact, procedure ``API`` may not be invoked by elaboration code within the +partition, however the dynamic model assumes that this can happen. + +The dynamic model emits very few diagnostics, but can make suggestions on +missing ``Elaborate`` and ``Elaborate_All`` pragmas for library-level +scenarios. This information is available when compiler switch :switch:`-gnatel` +is in effect. + +:: + + 1. with Server; + 2. package body Dynamic_Model is + 3. Val : constant Integer := Server.Func; + | + >>> info: call to "Func" during elaboration + >>> info: missing pragma "Elaborate_All" for unit "Server" + + 4. end Dynamic_Model; + +.. _Static_Elaboration_Model_in_GNAT: + +Static Elaboration Model in GNAT +================================ + +In contrast to the dynamic model, the static model is more precise in its +analysis of elaboration code. The model makes a clear distinction between +internal and external targets, and resorts to different diagnostics and +run-time checks based on the nature of the target. + +* *Internal targets* + + The static model performs extensive diagnostics on scenarios which elaborate + or execute internal targets. The warnings resulting from these diagnostics + are enabled by default, but can be suppressed using compiler switch + :switch:`-gnatws`. + + :: + + 1. package body Static_Model is + 2. generic + 3. with function Func return Integer; + 4. package Gen is + 5. Val : constant Integer := Func; + 6. end Gen; + 7. + 8. function ABE return Integer; + 9. + 10. function Cause_ABE return Boolean is + 11. package Inst is new Gen (ABE); + | + >>> warning: in instantiation at line 5 + >>> warning: cannot call "ABE" before body seen + >>> warning: Program_Error may be raised at run time + >>> warning: body of unit "Static_Model" elaborated + >>> warning: function "Cause_ABE" called at line 16 + >>> warning: function "ABE" called at line 5, instance at line 11 + + 12. begin + 13. ... + 14. end Cause_ABE; + 15. + 16. Val : constant Boolean := Cause_ABE; + 17. + 18. function ABE return Integer is + 19. begin + 20. ... + 21. end ABE; + 22. end Static_Model; + + The example above illustrates an ABE problem within package ``Static_Model``, + which is hidden by several layers of indirection. The elaboration of package + body ``Static_Model`` elaborates the declaration of ``Val``. This invokes + function ``Cause_ABE``, which instantiates generic unit ``Gen`` as ``Inst``. + The elaboration of ``Inst`` invokes function ``ABE``, however the body of + ``ABE`` has not been elaborated yet. + +* *External targets* + + The static model installs run-time checks to verify the elaboration status + of server targets only when the scenario that elaborates or executes that + target is part of the elaboration code of the client unit. The checks can be + suppressed using pragma ``Suppress (Elaboration_Check)``. + + :: + + with Server; + package body Static_Model is + generic + with function Func return Integer; + package Gen is + Val : constant Integer := Func; + end Gen; + + function Call_Func return Boolean is + + package Inst is new Gen (Server.Func); begin - Text_IO.Put_Line (Decls.My_Int'Image (Decls.Ident (Arg))); - end Put_Val; - end Utils; + ... + end Call_Func; + + Val : constant Boolean := Call_Func; + end Static_Model; + + In the example above, the elaboration of package body ``Static_Model`` + elaborates the declaration of ``Val``. This invokes function ``Call_Func``, + which instantiates generic unit ``Gen`` as ``Inst``. The elaboration of + ``Inst`` invokes function ``Server.Func``. Since ``Server.Func`` is an + external target, GNAT installs a run-time check to verify that its body has + been elaborated. + + In addition to checks, the static model installs implicit ``Elaborate`` and + ``Elaborate_All`` pragmas to guarantee safe elaboration use of server units. + This information is available when compiler switch :switch:`-gnatel` is in + effect. + + :: + + 1. with Server; + 2. package body Static_Model is + 3. generic + 4. with function Func return Integer; + 5. package Gen is + 6. Val : constant Integer := Func; + 7. end Gen; + 8. + 9. function Call_Func return Boolean is + 10. package Inst is new Gen (Server.Func); + | + >>> info: instantiation of "Gen" during elaboration + >>> info: in instantiation at line 6 + >>> info: call to "Func" during elaboration + >>> info: in instantiation at line 6 + >>> info: implicit pragma "Elaborate_All" generated for unit "Server" + >>> info: body of unit "Static_Model" elaborated + >>> info: function "Call_Func" called at line 15 + >>> info: function "Func" called at line 6, instance at line 10 + + 11. begin + 12. ... + 13. end Call_Func; + 14. + 15. Val : constant Boolean := Call_Func; + | + >>> info: call to "Call_Func" during elaboration + + 16. end Static_Model; + + In the example above, the elaboration of package body ``Static_Model`` + elaborates the declaration of ``Val``. This invokes function ``Call_Func``, + which instantiates generic unit ``Gen`` as ``Inst``. The elaboration of + ``Inst`` invokes function ``Server.Func``. Since ``Server.Func`` is an + external target, GNAT installs an implicit ``Elaborate_All`` pragma for unit + ``Server``. The pragma guarantees that both the spec and body of ``Server``, + along with any additional dependencies that ``Server`` may require, are + elaborated prior to the body of ``Static_Model``. + +.. _SPARK_Elaboration_Model_in_GNAT: + +SPARK Elaboration Model in GNAT +=============================== + +The SPARK model is identical to the static model in its handling of internal +targets. The SPARK model, however, requires explicit ``Elaborate`` or +``Elaborate_All`` pragmas to be present in the program when a target is +external, and compiler switch :switch:`-gnatd.v` is in effect. + +:: + + 1. with Server; + 2. package body SPARK_Model with SPARK_Mode is + 3. Val : constant Integer := Server.Func; + | + >>> call to "Func" during elaboration in SPARK + >>> unit "SPARK_Model" requires pragma "Elaborate_All" for "Server" + >>> body of unit "SPARK_Model" elaborated + >>> function "Func" called at line 3 + + 4. end SPARK_Model; + +.. _Mixing_Elaboration_Models: + +Mixing Elaboration Models +========================= + +It is possible to mix units compiled with a different elaboration model, +however the following rules must be observed: + +* A client unit compiled with the dynamic model can only |with| a server unit + that meets at least one of the following criteria: + + - The server unit is compiled with the dynamic model. + + - The server unit is a GNAT implementation unit from the Ada, GNAT, + Interfaces, or System hierarchies. + + - The server unit has pragma ``Pure`` or ``Preelaborate``. - with Decls; - procedure Main is + - The client unit has an explicit ``Elaborate_All`` pragma for the server + unit. + +These rules ensure that elaboration checks are not omitted. If the rules are +violated, the binder emits a warning: + +:: + + warning: "x.ads" has dynamic elaboration checks and with's + warning: "y.ads" which has static elaboration checks + +The warnings can be suppressed by binder switch :switch:`-ws`. + +.. _Elaboration_Circularities: + +Elaboration Circularities +========================= + +If the binder cannot find an acceptable elaboration order, it outputs detailed +diagnostics describing an **elaboration circularity**. + +:: + + package Server is + function Func return Integer; + end Server; + +:: + + with Client; + package body Server is + function Func return Integer is + begin + ... + end Func; + end Server; + +:: + + with Server; + package Client is + Val : constant Integer := Server.Func; + end Client; + +:: + + with Client; + procedure Main is begin null; end Main; + +:: + + error: elaboration circularity detected + info: "server (body)" must be elaborated before "client (spec)" + info: reason: implicit Elaborate_All in unit "client (spec)" + info: recompile "client (spec)" with -gnatel for full details + info: "server (body)" + info: must be elaborated along with its spec: + info: "server (spec)" + info: which is withed by: + info: "client (spec)" + info: "client (spec)" must be elaborated before "server (body)" + info: reason: with clause + +In the example above, ``Client`` must be elaborated prior to ``Main`` by virtue +of a |with| clause. The elaboration of ``Client`` invokes ``Server.Func``, and +static model generates an implicit ``Elaborate_All`` pragma for ``Server``. The +pragma implies that both the spec and body of ``Server``, along with any units +they |with|, must be elaborated prior to ``Client``. However, ``Server``'s body +|withs| ``Client``, implying that ``Client`` must be elaborated prior to +``Server``. The end result is that ``Client`` must be elaborated prior to +``Client``, and this leads to a circularity. + +.. _Resolving_Elaboration_Circularities: + +Resolving Elaboration Circularities +=================================== + +When faced with an elaboration circularity, a programmer has several options +available. + +* *Fix the program* + + The most desirable option from the point of view of long-term maintenance + is to rearrange the program so that the elaboration problems are avoided. + One useful technique is to place the elaboration code into separate child + packages. Another is to move some of the initialization code to explicitly + invoked subprograms, where the program controls the order of initialization + explicitly. Although this is the most desirable option, it may be impractical + and involve too much modification, especially in the case of complex legacy + code. + +* *Switch to more permissive elaboration model* + + If the compilation was performed using the static model, enable the dynamic + model with compiler switch :switch:`-gnatE`. GNAT will no longer generate + implicit ``Elaborate`` and ``Elaborate_All`` pragmas, resulting in a behavior + identical to that specified by the Ada Reference Manual. The binder will + generate an executable program that may or may not raise ``Program_Error``, + and it is the programmer's responsibility to ensure that it does not raise + ``Program_Error``. + +* *Suppress all elaboration checks* + + The drawback of run-time checks is that they generate overhead at run time, + both in space and time. If the programmer is absolutely sure that a program + will not raise an elaboration-related ``Program_Error``, then using the + pragma ``Suppress (Elaboration_Check)`` globally (as a configuration pragma) + will eliminate all run-time checks. + +* *Suppress elaboration checks selectively* + + If a scenario cannot possibly lead to an elaboration ``Program_Error``, + and the binder nevertheless complains about implicit ``Elaborate`` and + ``Elaborate_All`` pragmas that lead to elaboration circularities, it + is possible to suppress the generation of implicit ``Elaborate`` and + ``Elaborate_All`` pragmas, as well as run-time checks. Clearly this can + be unsafe, and it is the responsibility of the programmer to make sure + that the resulting program has no elaboration anomalies. Pragma + ``Suppress (Elaboration_Check)`` can be used with different levels of + granularity to achieve these effects. + + - *Target suppression* + + When the pragma is placed in a declarative part, without a second argument + naming an entity, it will suppress implicit ``Elaborate`` and + ``Elaborate_All`` pragma generation, as well as run-time checks, on all + targets within the region. + + :: + + package Range_Suppress is + pragma Suppress (Elaboration_Check); + + function Func return Integer; + + generic + procedure Gen; + + pragma Unsuppress (Elaboration_Check); + + task type Tsk; + end Range_Suppress; + + In the example above, a pair of Suppress/Unsuppress pragmas define a region + of suppression within package ``Range_Suppress``. As a result, no implicit + ``Elaborate`` and ``Elaborate_All`` pragmas, nor any run-time checks, will + be generated by callers of ``Func`` and instantiators of ``Gen``. Note that + task type ``Tsk`` is not within this region. + + An alternative to the region-based suppression is to use multiple + ``Suppress`` pragmas with arguments naming specific entities for which + elaboration checks should be suppressed: + + :: + + package Range_Suppress is + function Func return Integer; + pragma Suppress (Elaboration_Check, Func); + + generic + procedure Gen; + pragma Suppress (Elaboration_Check, Gen); + + task type Tsk; + end Range_Suppress; + + - *Scenario suppression* + + When the pragma ``Suppress`` is placed in a declarative or statement + part, without an entity argument, it will suppress implicit ``Elaborate`` + and ``Elaborate_All`` pragma generation, as well as run-time checks, on + all scenarios within the region. + + :: + + with Server; + package body Range_Suppress is + pragma Suppress (Elaboration_Check); + + function Func return Integer is + begin + return Server.Func; + end Func; + + procedure Gen is + begin + Server.Proc; + end Gen; + + pragma Unsuppress (Elaboration_Check); + + task body Tsk is + begin + Server.Proc; + end Tsk; + end Range_Suppress; + + In the example above, a pair of Suppress/Unsuppress pragmas define a region + of suppression within package body ``Range_Suppress``. As a result, the + calls to ``Server.Func`` in ``Func`` and ``Server.Proc`` in ``Gen`` will + not generate any implicit ``Elaborate`` and ``Elaborate_All`` pragmas or + run-time checks. + +.. _Resolving_Task_Issues: + +Resolving Task Issues +===================== + +The model of execution in Ada dictates that elaboration must first take place, +and only then can the main program be started. Tasks which are activated during +elaboration violate this model and may lead to serious concurrent problems at +elaboration time. + +A task can be activated in two different ways: + +* The task is created by an allocator in which case it is activated immediately + after the allocator is evaluated. + +* The task is declared at the library level or within some nested master in + which case it is activated before starting execution of the statement + sequence of the master defining the task. + +Since the elaboration of a partition is performed by the environment task +servicing that partition, any tasks activated during elaboration may be in +a race with the environment task, and lead to unpredictable state and behavior. +The static model seeks to avoid such interactions by assuming that all code in +the task body is executed at elaboration time, if the task was activated by +elaboration code. + +:: + + package Decls is + task Lib_Task is + entry Start; + end Lib_Task; + + type My_Int is new Integer; + + function Ident (M : My_Int) return My_Int; + end Decls; + +:: + + with Utils; + package body Decls is + task body Lib_Task is begin - Decls.Lib_Task.Start; - end; - -If the above example is compiled in the default static elaboration -mode, then a circularity occurs. The circularity comes from the call -``Utils.Put_Val`` in the task body of ``Decls.Lib_Task``. Since -this call occurs in elaboration code, we need an implicit pragma -``Elaborate_All`` for ``Utils``. This means that not only must -the spec and body of ``Utils`` be elaborated before the body -of ``Decls``, but also the spec and body of any unit that is -|withed| by the body of ``Utils`` must also be elaborated before -the body of ``Decls``. This is the transitive implication of -pragma ``Elaborate_All`` and it makes sense, because in general -the body of ``Put_Val`` might have a call to something in a -|withed| unit. - -In this case, the body of Utils (actually its spec) |withs| -``Decls``. Unfortunately this means that the body of ``Decls`` -must be elaborated before itself, in case there is a call from the -body of ``Utils``. - -Here is the exact chain of events we are worrying about: - -* In the body of ``Decls`` a call is made from within the body of a library - task to a subprogram in the package ``Utils``. Since this call may - occur at elaboration time (given that the task is activated at elaboration - time), we have to assume the worst, i.e., that the - call does happen at elaboration time. - -* This means that the body and spec of ``Util`` must be elaborated before - the body of ``Decls`` so that this call does not cause an access before - elaboration. - -* Within the body of ``Util``, specifically within the body of - ``Util.Put_Val`` there may be calls to any unit |withed| - by this package. - -* One such |withed| package is package ``Decls``, so there - might be a call to a subprogram in ``Decls`` in ``Put_Val``. - In fact there is such a call in this example, but we would have to - assume that there was such a call even if it were not there, since - we are not supposed to write the body of ``Decls`` knowing what - is in the body of ``Utils``; certainly in the case of the - static elaboration model, the compiler does not know what is in - other bodies and must assume the worst. - -* This means that the spec and body of ``Decls`` must also be - elaborated before we elaborate the unit containing the call, but - that unit is ``Decls``! This means that the body of ``Decls`` - must be elaborated before itself, and that's a circularity. - -Indeed, if you add an explicit pragma ``Elaborate_All`` for ``Utils`` in -the body of ``Decls`` you will get a true Ada Reference Manual -circularity that makes the program illegal. - -In practice, we have found that problems with the static model of -elaboration in existing code often arise from library tasks, so -we must address this particular situation. - -Note that if we compile and run the program above, using the dynamic model of -elaboration (that is to say use the :switch:`-gnatE` switch), -then it compiles, binds, -links, and runs, printing the expected result of 2. Therefore in some sense -the circularity here is only apparent, and we need to capture -the properties of this program that distinguish it from other library-level -tasks that have real elaboration problems. - -We have four possible answers to this question: - - -* Use the dynamic model of elaboration. - - If we use the :switch:`-gnatE` switch, then as noted above, the program works. - Why is this? If we examine the task body, it is apparent that the task cannot - proceed past the - ``accept`` statement until after elaboration has been completed, because - the corresponding entry call comes from the main program, not earlier. - This is why the dynamic model works here. But that's really giving - up on a precise analysis, and we prefer to take this approach only if we cannot - solve the - problem in any other manner. So let us examine two ways to reorganize - the program to avoid the potential elaboration problem. - -* Split library tasks into separate packages. - - Write separate packages, so that library tasks are isolated from - other declarations as much as possible. Let us look at a variation on - the above program. - - - .. code-block:: ada - - package Decls1 is + accept Start; + Utils.Put_Val (2); + end Lib_Task; + + function Ident (M : My_Int) return My_Int is + begin + return M; + end Ident; + end Decls; + +:: + + with Decls; + package Utils is + procedure Put_Val (Arg : Decls.My_Int); + end Utils; + +:: + + with Ada.Text_IO; use Ada.Text_IO; + package body Utils is + procedure Put_Val (Arg : Decls.My_Int) is + begin + Put_Line (Arg'Img); + end Put_Val; + end Utils; + +:: + + with Decls; + procedure Main is + begin + Decls.Lib_Task.Start; + end Main; + +When the above example is compiled with the static model, an elaboration +circularity arises: + +:: + + error: elaboration circularity detected + info: "decls (body)" must be elaborated before "decls (body)" + info: reason: implicit Elaborate_All in unit "decls (body)" + info: recompile "decls (body)" with -gnatel for full details + info: "decls (body)" + info: must be elaborated along with its spec: + info: "decls (spec)" + info: which is withed by: + info: "utils (spec)" + info: which is withed by: + info: "decls (body)" + +In the above example, ``Decls`` must be elaborated prior to ``Main`` by virtue +of a with clause. The elaboration of ``Decls`` activates task ``Lib_Task``. The +static model conservatibely assumes that all code within the body of +``Lib_Task`` is executed, and generates an implicit ``Elaborate_All`` pragma +for ``Units`` due to the call to ``Utils.Put_Val``. The pragma implies that +both the spec and body of ``Utils``, along with any units they |with|, +must be elaborated prior to ``Decls``. However, ``Utils``'s spec |withs| +``Decls``, implying that ``Decls`` must be elaborated before ``Utils``. The end +result is that ``Utils`` must be elaborated prior to ``Utils``, and this +leads to a circularity. + +In reality, the example above will not exhibit an ABE problem at run time. +When the body of task ``Lib_Task`` is activated, execution will wait for entry +``Start`` to be accepted, and the call to ``Utils.Put_Val`` will not take place +at elaboration time. Task ``Lib_Task`` will resume its execution after the main +program is executed because ``Main`` performs a rendezvous with +``Lib_Task.Start``, and at that point all units have already been elaborated. +As a result, the static model may seem overly conservative, partly because it +does not take control and data flow into account. + +When faced with a task elaboration circularity, a programmer has several +options available: + +* *Use the dynamic model* + + The dynamic model does not generate implicit ``Elaborate`` and + ``Elaborate_All`` pragmas. Instead, it will install checks prior to every + call in the example above, thus verifying the successful elaboration of + ``Utils.Put_Val`` in case the call to it takes place at elaboration time. + The dynamic model is enabled with compiler switch :switch:`-gnatE`. + +* *Isolate the tasks* + + Relocating tasks in their own separate package could decouple them from + dependencies that would otherwise cause an elaboration circularity. The + example above can be rewritten as follows: + + :: + + package Decls1 is -- new task Lib_Task is entry Start; end Lib_Task; - end Decls1; + end Decls1; + + :: - with Utils; - package body Decls1 is + with Utils; + package body Decls1 is -- new task body Lib_Task is begin accept Start; Utils.Put_Val (2); end Lib_Task; - end Decls1; + end Decls1; + + :: - package Decls2 is + package Decls2 is -- new type My_Int is new Integer; function Ident (M : My_Int) return My_Int; - end Decls2; + end Decls2; - with Utils; - package body Decls2 is + :: + + with Utils; + package body Decls2 is -- new function Ident (M : My_Int) return My_Int is begin return M; end Ident; - end Decls2; + end Decls2; + + :: - with Decls2; - package Utils is + with Decls2; + package Utils is procedure Put_Val (Arg : Decls2.My_Int); - end Utils; + end Utils; + + :: - with Text_IO; - package body Utils is + with Ada.Text_IO; use Ada.Text_IO; + package body Utils is procedure Put_Val (Arg : Decls2.My_Int) is begin - Text_IO.Put_Line (Decls2.My_Int'Image (Decls2.Ident (Arg))); + Put_Line (Arg'Img); end Put_Val; - end Utils; - - with Decls1; - procedure Main is - begin - Decls1.Lib_Task.Start; - end; - + end Utils; - All we have done is to split ``Decls`` into two packages, one - containing the library task, and one containing everything else. Now - there is no cycle, and the program compiles, binds, links and executes - using the default static model of elaboration. + :: -* Declare separate task types. + with Decls1; + procedure Main is + begin + Decls1.Lib_Task.Start; + end Main; + +* *Declare the tasks* - A significant part of the problem arises because of the use of the - single task declaration form. This means that the elaboration of - the task type, and the elaboration of the task itself (i.e., the - creation of the task) happen at the same time. A good rule - of style in Ada is to always create explicit task types. By - following the additional step of placing task objects in separate - packages from the task type declaration, many elaboration problems - are avoided. Here is another modified example of the example program: + The original example uses a single task declaration for ``Lib_Task``. An + explicit task type declaration and a properly placed task object could avoid + the dependencies that would otherwise cause an elaboration circularity. The + example can be rewritten as follows: - .. code-block:: ada + :: - package Decls is - task type Lib_Task_Type is + package Decls is + task type Lib_Task is -- new entry Start; - end Lib_Task_Type; + end Lib_Task; type My_Int is new Integer; function Ident (M : My_Int) return My_Int; - end Decls; + end Decls; + + :: - with Utils; - package body Decls is - task body Lib_Task_Type is + with Utils; + package body Decls is + task body Lib_Task is begin accept Start; Utils.Put_Val (2); - end Lib_Task_Type; + end Lib_Task; function Ident (M : My_Int) return My_Int is begin return M; end Ident; - end Decls; + end Decls; + + :: - with Decls; - package Utils is + with Decls; + package Utils is procedure Put_Val (Arg : Decls.My_Int); - end Utils; + end Utils; + + :: - with Text_IO; - package body Utils is + with Ada.Text_IO; use Ada.Text_IO; + package body Utils is procedure Put_Val (Arg : Decls.My_Int) is begin - Text_IO.Put_Line (Decls.My_Int'Image (Decls.Ident (Arg))); + Put_Line (Arg'Img); end Put_Val; - end Utils; + end Utils; - with Decls; - package Declst is - Lib_Task : Decls.Lib_Task_Type; - end Declst; + :: - with Declst; - procedure Main is - begin - Declst.Lib_Task.Start; - end; - - - What we have done here is to replace the ``task`` declaration in - package ``Decls`` with a ``task type`` declaration. Then we - introduce a separate package ``Declst`` to contain the actual - task object. This separates the elaboration issues for - the ``task type`` - declaration, which causes no trouble, from the elaboration issues - of the task object, which is also unproblematic, since it is now independent - of the elaboration of ``Utils``. - This separation of concerns also corresponds to - a generally sound engineering principle of separating declarations - from instances. This version of the program also compiles, binds, links, - and executes, generating the expected output. - -.. index:: No_Entry_Calls_In_Elaboration_Code restriction - -* Use No_Entry_Calls_In_Elaboration_Code restriction. - - The previous two approaches described how a program can be restructured - to avoid the special problems caused by library task bodies. in practice, - however, such restructuring may be difficult to apply to existing legacy code, - so we must consider solutions that do not require massive rewriting. - - Let us consider more carefully why our original sample program works - under the dynamic model of elaboration. The reason is that the code - in the task body blocks immediately on the ``accept`` - statement. Now of course there is nothing to prohibit elaboration - code from making entry calls (for example from another library level task), - so we cannot tell in isolation that - the task will not execute the accept statement during elaboration. - - However, in practice it is very unusual to see elaboration code - make any entry calls, and the pattern of tasks starting - at elaboration time and then immediately blocking on ``accept`` or - ``select`` statements is very common. What this means is that - the compiler is being too pessimistic when it analyzes the - whole package body as though it might be executed at elaboration - time. - - If we know that the elaboration code contains no entry calls, (a very safe - assumption most of the time, that could almost be made the default - behavior), then we can compile all units of the program under control - of the following configuration pragma: - - .. code-block:: ada - - pragma Restrictions (No_Entry_Calls_In_Elaboration_Code); - - This pragma can be placed in the :file:`gnat.adc` file in the usual - manner. If we take our original unmodified program and compile it - in the presence of a :file:`gnat.adc` containing the above pragma, - then once again, we can compile, bind, link, and execute, obtaining - the expected result. In the presence of this pragma, the compiler does - not trace calls in a task body, that appear after the first ``accept`` - or ``select`` statement, and therefore does not report a potential - circularity in the original program. - - The compiler will check to the extent it can that the above - restriction is not violated, but it is not always possible to do a - complete check at compile time, so it is important to use this - pragma only if the stated restriction is in fact met, that is to say - no task receives an entry call before elaboration of all units is completed. + with Decls; + package Obj_Decls is -- new + Task_Obj : Decls.Lib_Task; + end Obj_Decls; + :: -.. _Mixing_Elaboration_Models: + with Obj_Decls; + procedure Main is + begin + Obj_Decls.Task_Obj.Start; -- new + end Main; -Mixing Elaboration Models -========================= +* *Use restriction No_Entry_Calls_In_Elaboration_Code* + + The issue exhibited in the original example under this section revolves + around the body of ``Lib_Task`` blocking on an accept statement. There is + no rule to prevent elaboration code from performing entry calls, however in + practice this is highly unusual. In addition, the pattern of starting tasks + at elaboration time and then immediately blocking on accept or select + statements is quite common. -So far, we have assumed that the entire program is either compiled -using the dynamic model or static model, ensuring consistency. It -is possible to mix the two models, but rules have to be followed -if this mixing is done to ensure that elaboration checks are not -omitted. + If a programmer knows that elaboration code will not perform any entry + calls, then the programmer can indicate that the static model should not + process the remainder of a task body once an accept or select statement has + been encountered. This behavior can be specified by a configuration pragma: -The basic rule is that -**a unit compiled with the static model cannot -be |withed| by a unit compiled with the dynamic model**. -The reason for this is that in the static model, a unit assumes that -its clients guarantee to use (the equivalent of) pragma -``Elaborate_All`` so that no elaboration checks are required -in inner subprograms, and this assumption is violated if the -client is compiled with dynamic checks. + :: -The precise rule is as follows. A unit that is compiled with dynamic -checks can only |with| a unit that meets at least one of the -following criteria: + pragma Restrictions (No_Entry_Calls_In_Elaboration_Code); + In addition to the change in behavior with respect to task bodies, the + static model will verify that no entry calls take place at elaboration time. -* The |withed| unit is itself compiled with dynamic elaboration - checks (that is with the :switch:`-gnatE` switch. +.. _Elaboration_Related_Compiler_Switches: -* The |withed| unit is an internal GNAT implementation unit from - the System, Interfaces, Ada, or GNAT hierarchies. +Elaboration-related Compiler Switches +===================================== -* The |withed| unit has pragma Preelaborate or pragma Pure. +GNAT has several switches that affect the elaboration model and consequently +the elaboration order chosen by the binder. -* The |withing| unit (that is the client) has an explicit pragma - ``Elaborate_All`` for the |withed| unit. +.. index:: -gnatdE (gnat) +:switch:`-gnatdE` + Elaboration checks on predefined units -If this rule is violated, that is if a unit with dynamic elaboration -checks |withs| a unit that does not meet one of the above four -criteria, then the binder (``gnatbind``) will issue a warning -similar to that in the following example:: + When this switch is in effect, GNAT will consider scenarios and targets that + come from the Ada, GNAT, Interfaces, and System hierarchies. This switch is + useful when a programmer has defined a custom grandchild of those packages. - warning: "x.ads" has dynamic elaboration checks and with's - warning: "y.ads" which has static elaboration checks +.. index:: -gnatd.G (gnat) -These warnings indicate that the rule has been violated, and that as a result -elaboration checks may be missed in the resulting executable file. -This warning may be suppressed using the :switch:`-ws` binder switch -in the usual manner. +:switch:`-gnatd.G` + Ignore calls through generic formal parameters for elaboration -One useful application of this mixing rule is in the case of a subsystem -which does not itself |with| units from the remainder of the -application. In this case, the entire subsystem can be compiled with -dynamic checks to resolve a circularity in the subsystem, while -allowing the main application that uses this subsystem to be compiled -using the more reliable default static model. + When this switch is in effect, GNAT will ignore calls that invoke generic + actual entries, operators, or subprograms via generic formal subprograms. As + a result, GNAT will not generate implicit ``Elaborate`` and ``Elaborate_All`` + pragmas, and run-time checks for such calls. Note that this switch does not + overlap with :switch:`-gnatdL`. + :: -.. _What_to_Do_If_the_Default_Elaboration_Behavior_Fails: + package body Ignore_Calls is + function ABE return Integer; -What to Do If the Default Elaboration Behavior Fails -==================================================== + generic + with function Gen_Formal return Integer; + package Gen is + Val : constant Integer := Gen_Formal; + end Gen; -If the binder cannot find an acceptable order, it outputs detailed -diagnostics. For example:: + package Inst is new Gen (ABE); - error: elaboration circularity detected - info: "proc (body)" must be elaborated before "pack (body)" - info: reason: Elaborate_All probably needed in unit "pack (body)" - info: recompile "pack (body)" with -gnatel - info: for full details - info: "proc (body)" - info: is needed by its spec: - info: "proc (spec)" - info: which is withed by: - info: "pack (body)" - info: "pack (body)" must be elaborated before "proc (body)" - info: reason: pragma Elaborate in unit "proc (body)" + function ABE return Integer is + begin + ... + end ABE; + end Ignore_Calls; -In this case we have a cycle that the binder cannot break. On the one -hand, there is an explicit pragma Elaborate in ``proc`` for -``pack``. This means that the body of ``pack`` must be elaborated -before the body of ``proc``. On the other hand, there is elaboration -code in ``pack`` that calls a subprogram in ``proc``. This means -that for maximum safety, there should really be a pragma -Elaborate_All in ``pack`` for ``proc`` which would require that -the body of ``proc`` be elaborated before the body of -``pack``. Clearly both requirements cannot be satisfied. -Faced with a circularity of this kind, you have three different options. + In the example above, the call to function ``ABE`` will be ignored because it + occurs during the elaboration of instance ``Inst``, through a call to generic + formal subprogram ``Gen_Formal``. +.. index:: -gnatdL (gnat) -* *Fix the program* +:switch:`-gnatdL` + Ignore external calls from instances for elaboration - The most desirable option from the point of view of long-term maintenance - is to rearrange the program so that the elaboration problems are avoided. - One useful technique is to place the elaboration code into separate - child packages. Another is to move some of the initialization code to - explicitly called subprograms, where the program controls the order - of initialization explicitly. Although this is the most desirable option, - it may be impractical and involve too much modification, especially in - the case of complex legacy code. - -* *Perform dynamic checks* - - If the compilations are done using the :switch:`-gnatE` - (dynamic elaboration check) switch, then GNAT behaves in a quite different - manner. Dynamic checks are generated for all calls that could possibly result - in raising an exception. With this switch, the compiler does not generate - implicit ``Elaborate`` or ``Elaborate_All`` pragmas. The behavior then is - exactly as specified in the :title:`Ada Reference Manual`. - The binder will generate - an executable program that may or may not raise ``Program_Error``, and then - it is the programmer's job to ensure that it does not raise an exception. Note - that it is important to compile all units with the switch, it cannot be used - selectively. - -* *Suppress checks* - - The drawback of dynamic checks is that they generate a - significant overhead at run time, both in space and time. If you - are absolutely sure that your program cannot raise any elaboration - exceptions, and you still want to use the dynamic elaboration model, - then you can use the configuration pragma - ``Suppress (Elaboration_Check)`` to suppress all such checks. For - example this pragma could be placed in the :file:`gnat.adc` file. - -* *Suppress checks selectively* - - When you know that certain calls or instantiations in elaboration code cannot - possibly lead to an elaboration error, and the binder nevertheless complains - about implicit ``Elaborate`` and ``Elaborate_All`` pragmas that lead to - elaboration circularities, it is possible to remove those warnings locally and - obtain a program that will bind. Clearly this can be unsafe, and it is the - responsibility of the programmer to make sure that the resulting program has no - elaboration anomalies. The pragma ``Suppress (Elaboration_Check)`` can be - used with different granularity to suppress warnings and break elaboration - circularities: - - * Place the pragma that names the called subprogram in the declarative part - that contains the call. - - * Place the pragma in the declarative part, without naming an entity. This - disables warnings on all calls in the corresponding declarative region. - - * Place the pragma in the package spec that declares the called subprogram, - and name the subprogram. This disables warnings on all elaboration calls to - that subprogram. - - * Place the pragma in the package spec that declares the called subprogram, - without naming any entity. This disables warnings on all elaboration calls to - all subprograms declared in this spec. - - * Use Pragma Elaborate. - - As previously described in section :ref:`Treatment_of_Pragma_Elaborate`, - GNAT in static mode assumes that a ``pragma`` Elaborate indicates correctly - that no elaboration checks are required on calls to the designated unit. - There may be cases in which the caller knows that no transitive calls - can occur, so that a ``pragma Elaborate`` will be sufficient in a - case where ``pragma Elaborate_All`` would cause a circularity. - - These five cases are listed in order of decreasing safety, and therefore - require increasing programmer care in their application. Consider the - following program: - - .. code-block:: ada - - package Pack1 is - function F1 return Integer; - X1 : Integer; - end Pack1; - - package Pack2 is - function F2 return Integer; - function Pure (x : integer) return integer; - -- pragma Suppress (Elaboration_Check, On => Pure); -- (3) - -- pragma Suppress (Elaboration_Check); -- (4) - end Pack2; - - with Pack2; - package body Pack1 is - function F1 return Integer is - begin - return 100; - end F1; - Val : integer := Pack2.Pure (11); -- Elab. call (1) + When this switch is in effect, GNAT will ignore calls that originate from + within an instance and directly target an entry, operator, or subprogram + defined outside the instance. As a result, GNAT will not generate implicit + ``Elaborate`` and ``Elaborate_All`` pragmas, and run-time checks for such + calls. Note that this switch does not overlap with :switch:`-gnatd.G`. + + :: + + package body Ignore_Calls is + function ABE return Integer; + + generic + package Gen is + Val : constant Integer := ABE; + end Gen; + + package Inst is new Gen; + + function ABE return Integer is begin - declare - -- pragma Suppress(Elaboration_Check, Pack2.F2); -- (1) - -- pragma Suppress(Elaboration_Check); -- (2) - begin - X1 := Pack2.F2 + 1; -- Elab. call (2) - end; - end Pack1; + ... + end ABE; + end Ignore_Calls; - with Pack1; - package body Pack2 is - function F2 return Integer is - begin - return Pack1.F1; - end F2; - function Pure (x : integer) return integer is - begin - return x ** 3 - 3 * x; - end; - end Pack2; + In the example above, the call to function ``ABE`` will be ignored because it + originates from within an instance and targets a subprogram defined outside + the instance. + +.. index:: -gnatd.o (gnat) + +:switch:`-gnatd.o` + Conservative elaboration order for indirect calls + + When this switch is in effect, GNAT will treat ``'Access`` of an entry, + operator, or subprogram as an immediate call to that target. As a result, + GNAT will generate implicit ``Elaborate`` and ``Elaborate_All`` pragmas as + well as run-time checks for such attribute references. + + :: - with Pack1, Ada.Text_IO; - procedure Proc3 is + 1. package body Attribute_Call is + 2. function Func return Integer; + 3. type Func_Ptr is access function return Integer; + 4. + 5. Ptr : constant Func_Ptr := Func'Access; + | + >>> warning: cannot call "Func" before body seen + >>> warning: Program_Error may be raised at run time + >>> warning: body of unit "Attribute_Call" elaborated + >>> warning: "Access" of "Func" taken at line 5 + >>> warning: function "Func" called at line 5 + + 6. + 7. function Func return Integer is + 8. begin + 9. ... + 10. end Func; + 11. end Attribute_Call; + + In the example above, the elaboration of declaration ``Ptr`` is assigned + ``Func'Access`` before the body of ``Func`` has been elaborated. + +.. index:: -gnatd.U (gnat) + +:switch:`-gnatd.U` + Ignore indirect calls for static elaboration + + When this switch is in effect, GNAT will ignore ``'Access`` of an entry, + operator, or subprogram when the static model is in effect. + +.. index:: -gnatd.v (gnat) + +:switch:`-gnatd.v` + Enforce SPARK elaboration rules in SPARK code + + When this switch is in effect, GNAT will enforce the SPARK rules of + elaboration as defined in the SPARK Reference Manual, section 7.7. As a + result, constructs which violate the SPARK elaboration rules are no longer + accepted, even if GNAT is able to statically ensure that these constructs + will not lead to ABE problems. + +.. index:: -gnatd.y (gnat) + +:switch:`-gnatd.y` + Disable implicit pragma Elaborate[_All] on task bodies + + When this switch is in effect, GNAT will not generate ``Elaborate`` and + ``Elaborate_All`` pragmas if the need for the pragma came directly or + indirectly from a task body. + + :: + + with Server; + package body Disable_Task is + task T; + + task body T is begin - Ada.Text_IO.Put_Line(Pack1.X1'Img); -- 101 - end Proc3; - - In the absence of any pragmas, an attempt to bind this program produces - the following diagnostics:: - - error: elaboration circularity detected - info: "pack1 (body)" must be elaborated before "pack1 (body)" - info: reason: Elaborate_All probably needed in unit "pack1 (body)" - info: recompile "pack1 (body)" with -gnatel for full details - info: "pack1 (body)" - info: must be elaborated along with its spec: - info: "pack1 (spec)" - info: which is withed by: - info: "pack2 (body)" - info: which must be elaborated along with its spec: - info: "pack2 (spec)" - info: which is withed by: - info: "pack1 (body)" - - The sources of the circularity are the two calls to ``Pack2.Pure`` and - ``Pack2.F2`` in the body of ``Pack1``. We can see that the call to - F2 is safe, even though F2 calls F1, because the call appears after the - elaboration of the body of F1. Therefore the pragma (1) is safe, and will - remove the warning on the call. It is also possible to use pragma (2) - because there are no other potentially unsafe calls in the block. - - The call to ``Pure`` is safe because this function does not depend on the - state of ``Pack2``. Therefore any call to this function is safe, and it - is correct to place pragma (3) in the corresponding package spec. - - Finally, we could place pragma (4) in the spec of ``Pack2`` to disable - warnings on all calls to functions declared therein. Note that this is not - necessarily safe, and requires more detailed examination of the subprogram - bodies involved. In particular, a call to ``F2`` requires that ``F1`` - be already elaborated. - -It is hard to generalize on which of these four approaches should be -taken. Obviously if it is possible to fix the program so that the default -treatment works, this is preferable, but this may not always be practical. -It is certainly simple enough to use :switch:`-gnatE` -but the danger in this case is that, even if the GNAT binder -finds a correct elaboration order, it may not always do so, -and certainly a binder from another Ada compiler might not. A -combination of testing and analysis (for which the -information messages generated with the :switch:`-gnatel` -switch can be useful) must be used to ensure that the program is free -of errors. One switch that is useful in this testing is the -:switch:`-p` (pessimistic elaboration order) switch for ``gnatbind``. -Normally the binder tries to find an order that has the best chance -of avoiding elaboration problems. However, if this switch is used, the binder -plays a devil's advocate role, and tries to choose the order that -has the best chance of failing. If your program works even with this -switch, then it has a better chance of being error free, but this is still -not a guarantee. - -For an example of this approach in action, consider the C-tests (executable -tests) from the ACATS suite. If these are compiled and run with the default -treatment, then all but one of them succeed without generating any error -diagnostics from the binder. However, there is one test that fails, and -this is not surprising, because the whole point of this test is to ensure -that the compiler can handle cases where it is impossible to determine -a correct order statically, and it checks that an exception is indeed -raised at run time. - -This one test must be compiled and run using the :switch:`-gnatE` -switch, and then it passes. Alternatively, the entire suite can -be run using this switch. It is never wrong to run with the dynamic -elaboration switch if your code is correct, and we assume that the -C-tests are indeed correct (it is less efficient, but efficiency is -not a factor in running the ACATS tests.) - - -.. _Elaboration_for_Indirect_Calls: - -Elaboration for Indirect Calls -============================== + Server.Proc; + end T; + end Disable_Task; + + In the example above, the activation of single task ``T`` invokes + ``Server.Proc``, which implies that ``Server`` requires ``Elaborate_All``, + however GNAT will not generate the pragma. + +.. index:: -gnatE (gnat) + +:switch:`-gnatE` + Dynamic elaboration checking mode enabled + + When this switch is in effect, GNAT activates the dynamic elaboration model. + +.. index:: -gnatel (gnat) + +:switch:`-gnatel` + Turn on info messages on generated Elaborate[_All] pragmas + + When this switch is in effect, GNAT will emit the following supplementary + information depending on the elaboration model in effect. -.. index:: Dispatching calls -.. index:: Indirect calls + - *Dynamic model* -In rare cases, the static elaboration model fails to prevent -dispatching calls to not-yet-elaborated subprograms. In such cases, we -fall back to run-time checks; premature calls to any primitive -operation of a tagged type before the body of the operation has been -elaborated will raise ``Program_Error``. + GNAT will indicate missing ``Elaborate`` and ``Elaborate_All`` pragmas for + all library-level scenarios within the partition. -Access-to-subprogram types, however, are handled conservatively in many -cases. This was not true in earlier versions of the compiler; you can use -the :switch:`-gnatd.U` debug switch to revert to the old behavior if the new -conservative behavior causes elaboration cycles. Here, 'conservative' means -that if you do ``P'Access`` during elaboration, the compiler will normally -assume that you might call ``P`` indirectly during elaboration, so it adds an -implicit ``pragma Elaborate_All`` on the library unit containing ``P``. The -:switch:`-gnatd.U` switch is safe if you know there are no such calls. If the -program worked before, it will continue to work with :switch:`-gnatd.U`. But beware -that code modifications such as adding an indirect call can cause erroneous -behavior in the presence of :switch:`-gnatd.U`. + - *Static model* -These implicit Elaborate_All pragmas are not added in all cases, because -they cause elaboration cycles in certain common code patterns. If you want -even more conservative handling of P'Access, you can use the :switch:`-gnatd.o` -switch. + GNAT will indicate all scenarios executed during elaboration. In addition, + it will provide detailed traceback when an implicit ``Elaborate`` or + ``Elaborate_All`` pragma is generated. -See :file:`debug.adb` for documentation on the :switch:`-gnatd...` debug switches. + - *SPARK model* + GNAT will indicate how an elaboration requirement is met by the context of + a unit. This diagnostic requires compiler switch :switch:`-gnatd.v`. + + :: + + 1. with Server; pragma Elaborate_All (Server); + 2. package Client with SPARK_Mode is + 3. Val : constant Integer := Server.Func; + | + >>> info: call to "Func" during elaboration in SPARK + >>> info: "Elaborate_All" requirement for unit "Server" met by pragma at line 1 + + 4. end Client; + +.. index:: -gnatw.f (gnat) + +:switch:`-gnatw.f` + Turn on warnings for suspicious Subp'Access + + When this switch is in effect, GNAT will treat ``'Access`` of an entry, + operator, or subprogram as a potential call to the target and issue warnings: + + :: + + 1. package body Attribute_Call is + 2. function Func return Integer; + 3. type Func_Ptr is access function return Integer; + 4. + 5. Ptr : constant Func_Ptr := Func'Access; + | + >>> warning: "Access" attribute of "Func" before body seen + >>> warning: possible Program_Error on later references + >>> warning: body of unit "Attribute_Call" elaborated + >>> warning: "Access" of "Func" taken at line 5 + + 6. + 7. function Func return Integer is + 8. begin + 9. ... + 10. end Func; + 11. end Attribute_Call; + + In the example above, the elaboration of declaration ``Ptr`` is assigned + ``Func'Access`` before the body of ``Func`` has been elaborated. .. _Summary_of_Procedures_for_Elaboration_Control: Summary of Procedures for Elaboration Control ============================================= -.. index:: Elaboration control +A programmer should first compile the program with the default options, using +none of the binder or compiler switches. If the binder succeeds in finding an +elaboration order, then apart from possible cases involing dispatching calls +and access-to-subprogram types, the program is free of elaboration errors. +If it is important for the program to be portable to compilers other than GNAT, +then the programmer should use compiler switch :switch:`-gnatel` and consider +the messages about missing or implicitly created ``Elaborate`` and +``Elaborate_All`` pragmas. -First, compile your program with the default options, using none of -the special elaboration-control switches. If the binder successfully -binds your program, then you can be confident that, apart from issues -raised by the use of access-to-subprogram types and dynamic dispatching, -the program is free of elaboration errors. If it is important that the -program be portable to other compilers than GNAT, then use the -:switch:`-gnatel` -switch to generate messages about missing ``Elaborate`` or -``Elaborate_All`` pragmas, and supply the missing pragmas. - -If the program fails to bind using the default static elaboration -handling, then you can fix the program to eliminate the binder -message, or recompile the entire program with the -:switch:`-gnatE` switch to generate dynamic elaboration checks, -and, if you are sure there really are no elaboration problems, -use a global pragma ``Suppress (Elaboration_Check)``. - - -.. _Other_Elaboration_Order_Considerations: - -Other Elaboration Order Considerations -====================================== - -This section has been entirely concerned with the issue of finding a valid -elaboration order, as defined by the Ada Reference Manual. In a case -where several elaboration orders are valid, the task is to find one -of the possible valid elaboration orders (and the static model in GNAT -will ensure that this is achieved). - -The purpose of the elaboration rules in the Ada Reference Manual is to -make sure that no entity is accessed before it has been elaborated. For -a subprogram, this means that the spec and body must have been elaborated -before the subprogram is called. For an object, this means that the object -must have been elaborated before its value is read or written. A violation -of either of these two requirements is an access before elaboration order, -and this section has been all about avoiding such errors. - -In the case where more than one order of elaboration is possible, in the -sense that access before elaboration errors are avoided, then any one of -the orders is 'correct' in the sense that it meets the requirements of -the Ada Reference Manual, and no such error occurs. - -However, it may be the case for a given program, that there are -constraints on the order of elaboration that come not from consideration -of avoiding elaboration errors, but rather from extra-lingual logic -requirements. Consider this example: - -.. code-block:: ada - - with Init_Constants; - package Constants is - X : Integer := 0; - Y : Integer := 0; - end Constants; - - package Init_Constants is - procedure P; --* require a body* - end Init_Constants; - - with Constants; - package body Init_Constants is - procedure P is begin null; end; - begin - Constants.X := 3; - Constants.Y := 4; - end Init_Constants; +If the binder reports an elaboration circularity, the programmer has several +options: - with Constants; - package Calc is - Z : Integer := Constants.X + Constants.Y; - end Calc; +* Ensure that warnings are enabled. This will allow the static model to output + trace information of elaboration issues. The trace information could shed + light on previously unforeseen dependencies, as well as their origins. - with Calc; - with Text_IO; use Text_IO; - procedure Main is - begin - Put_Line (Calc.Z'Img); - end Main; +* Use switch :switch:`-gnatel` to obtain messages on generated implicit + ``Elaborate`` and ``Elaborate_All`` pragmas. The trace information could + indicate why a server unit must be elaborated prior to a client unit. + +* If the warnings produced by the static model indicate that a task is + involved, consider the options in the section on resolving task issues as + well as compiler switch :switch:`-gnatd.y`. -In this example, there is more than one valid order of elaboration. For -example both the following are correct orders:: +* If the warnings produced by the static model indicate that an generic + instantiations are involved, consider using compiler switches + :switch:`-gnatd.G` and :switch:`-gnatdL`. - Init_Constants spec - Constants spec - Calc spec - Init_Constants body - Main body +* If none of the steps outlined above resolve the circularity, recompile the + program using the dynamic model by using compiler switch :switch:`-gnatE`. -and +.. _Inspecting_the_Chosen_Elaboration_Order: + +Inspecting the Chosen Elaboration Order +======================================= + +To see the elaboration order chosen by the binder, inspect the contents of file +`b~xxx.adb`. On certain targets, this file appears as `b_xxx.adb`. The +elaboration order appears as a sequence of calls to ``Elab_Body`` and +``Elab_Spec``, interspersed with assignments to `Exxx` which indicates that a +particular unit is elaborated. For example: :: - Init_Constants spec - Constants spec - Init_Constants body - Calc spec - Main body - -There is no language rule to prefer one or the other, both are correct -from an order of elaboration point of view. But the programmatic effects -of the two orders are very different. In the first, the elaboration routine -of ``Calc`` initializes ``Z`` to zero, and then the main program -runs with this value of zero. But in the second order, the elaboration -routine of ``Calc`` runs after the body of Init_Constants has set -``X`` and ``Y`` and thus ``Z`` is set to 7 before ``Main`` runs. - -One could perhaps by applying pretty clever non-artificial intelligence -to the situation guess that it is more likely that the second order of -elaboration is the one desired, but there is no formal linguistic reason -to prefer one over the other. In fact in this particular case, GNAT will -prefer the second order, because of the rule that bodies are elaborated -as soon as possible, but it's just luck that this is what was wanted -(if indeed the second order was preferred). - -If the program cares about the order of elaboration routines in a case like -this, it is important to specify the order required. In this particular -case, that could have been achieved by adding to the spec of Calc: - -.. code-block:: ada - - pragma Elaborate_All (Constants); - -which requires that the body (if any) and spec of ``Constants``, -as well as the body and spec of any unit |withed| by -``Constants`` be elaborated before ``Calc`` is elaborated. - -Clearly no automatic method can always guess which alternative you require, -and if you are working with legacy code that had constraints of this kind -which were not properly specified by adding ``Elaborate`` or -``Elaborate_All`` pragmas, then indeed it is possible that two different -compilers can choose different orders. - -However, GNAT does attempt to diagnose the common situation where there -are uninitialized variables in the visible part of a package spec, and the -corresponding package body has an elaboration block that directly or -indirectly initializes one or more of these variables. This is the situation -in which a pragma Elaborate_Body is usually desirable, and GNAT will generate -a warning that suggests this addition if it detects this situation. - -The ``gnatbind` :switch:`-p` switch may be useful in smoking -out problems. This switch causes bodies to be elaborated as late as possible -instead of as early as possible. In the example above, it would have forced -the choice of the first elaboration order. If you get different results -when using this switch, and particularly if one set of results is right, -and one is wrong as far as you are concerned, it shows that you have some -missing ``Elaborate`` pragmas. For the example above, we have the -following output: - -.. code-block:: sh - - $ gnatmake -f -q main - $ main - 7 - $ gnatmake -f -q main -bargs -p - $ main - 0 - -It is of course quite unlikely that both these results are correct, so -it is up to you in a case like this to investigate the source of the -difference, by looking at the two elaboration orders that are chosen, -and figuring out which is correct, and then adding the necessary -``Elaborate`` or ``Elaborate_All`` pragmas to ensure the desired order. - - -.. _Determining_the_Chosen_Elaboration_Order: - -Determining the Chosen Elaboration Order -======================================== + System.Soft_Links'Elab_Body; + E14 := True; + System.Secondary_Stack'Elab_Body; + E18 := True; + System.Exception_Table'Elab_Body; + E24 := True; + Ada.Io_Exceptions'Elab_Spec; + E67 := True; + Ada.Tags'Elab_Spec; + Ada.Streams'Elab_Spec; + E43 := True; + Interfaces.C'Elab_Spec; + E69 := True; + System.Finalization_Root'Elab_Spec; + E60 := True; + System.Os_Lib'Elab_Body; + E71 := True; + System.Finalization_Implementation'Elab_Spec; + System.Finalization_Implementation'Elab_Body; + E62 := True; + Ada.Finalization'Elab_Spec; + E58 := True; + Ada.Finalization.List_Controller'Elab_Spec; + E76 := True; + System.File_Control_Block'Elab_Spec; + E74 := True; + System.File_Io'Elab_Body; + E56 := True; + Ada.Tags'Elab_Body; + E45 := True; + Ada.Text_Io'Elab_Spec; + Ada.Text_Io'Elab_Body; + E07 := True; + +Note also binder switch :switch:`-l`, which outputs the chosen elaboration +order and provides a more readable form of the above: + +:: -To see the elaboration order that the binder chooses, you can look at -the last part of the file:`b~xxx.adb` binder output file. Here is an example:: - - System.Soft_Links'Elab_Body; - E14 := True; - System.Secondary_Stack'Elab_Body; - E18 := True; - System.Exception_Table'Elab_Body; - E24 := True; - Ada.Io_Exceptions'Elab_Spec; - E67 := True; - Ada.Tags'Elab_Spec; - Ada.Streams'Elab_Spec; - E43 := True; - Interfaces.C'Elab_Spec; - E69 := True; - System.Finalization_Root'Elab_Spec; - E60 := True; - System.Os_Lib'Elab_Body; - E71 := True; - System.Finalization_Implementation'Elab_Spec; - System.Finalization_Implementation'Elab_Body; - E62 := True; - Ada.Finalization'Elab_Spec; - E58 := True; - Ada.Finalization.List_Controller'Elab_Spec; - E76 := True; - System.File_Control_Block'Elab_Spec; - E74 := True; - System.File_Io'Elab_Body; - E56 := True; - Ada.Tags'Elab_Body; - E45 := True; - Ada.Text_Io'Elab_Spec; - Ada.Text_Io'Elab_Body; - E07 := True; - -Here Elab_Spec elaborates the spec -and Elab_Body elaborates the body. The assignments to the :samp:`E{xx}` flags -flag that the corresponding body is now elaborated. - -You can also ask the binder to generate a more -readable list of the elaboration order using the -:switch:`-l` switch when invoking the binder. Here is -an example of the output generated by this switch:: - - ada (spec) - interfaces (spec) - system (spec) - system.case_util (spec) - system.case_util (body) - system.concat_2 (spec) - system.concat_2 (body) - system.concat_3 (spec) - system.concat_3 (body) - system.htable (spec) - system.parameters (spec) - system.parameters (body) - system.crtl (spec) - interfaces.c_streams (spec) - interfaces.c_streams (body) - system.restrictions (spec) - system.restrictions (body) - system.standard_library (spec) - system.exceptions (spec) - system.exceptions (body) - system.storage_elements (spec) - system.storage_elements (body) - system.secondary_stack (spec) - system.stack_checking (spec) - system.stack_checking (body) - system.string_hash (spec) - system.string_hash (body) - system.htable (body) - system.strings (spec) - system.strings (body) - system.traceback (spec) - system.traceback (body) - system.traceback_entries (spec) - system.traceback_entries (body) - ada.exceptions (spec) - ada.exceptions.last_chance_handler (spec) - system.soft_links (spec) - system.soft_links (body) - ada.exceptions.last_chance_handler (body) - system.secondary_stack (body) - system.exception_table (spec) - system.exception_table (body) - ada.io_exceptions (spec) - ada.tags (spec) - ada.streams (spec) - interfaces.c (spec) - interfaces.c (body) - system.finalization_root (spec) - system.finalization_root (body) - system.memory (spec) - system.memory (body) - system.standard_library (body) - system.os_lib (spec) - system.os_lib (body) - system.unsigned_types (spec) - system.stream_attributes (spec) - system.stream_attributes (body) - system.finalization_implementation (spec) - system.finalization_implementation (body) - ada.finalization (spec) - ada.finalization (body) - ada.finalization.list_controller (spec) - ada.finalization.list_controller (body) - system.file_control_block (spec) - system.file_io (spec) - system.file_io (body) - system.val_uns (spec) - system.val_util (spec) - system.val_util (body) - system.val_uns (body) - system.wch_con (spec) - system.wch_con (body) - system.wch_cnv (spec) - system.wch_jis (spec) - system.wch_jis (body) - system.wch_cnv (body) - system.wch_stw (spec) - system.wch_stw (body) - ada.tags (body) - ada.exceptions (body) - ada.text_io (spec) - ada.text_io (body) - text_io (spec) - gdbstr (body) + ada (spec) + interfaces (spec) + system (spec) + system.case_util (spec) + system.case_util (body) + system.concat_2 (spec) + system.concat_2 (body) + system.concat_3 (spec) + system.concat_3 (body) + system.htable (spec) + system.parameters (spec) + system.parameters (body) + system.crtl (spec) + interfaces.c_streams (spec) + interfaces.c_streams (body) + system.restrictions (spec) + system.restrictions (body) + system.standard_library (spec) + system.exceptions (spec) + system.exceptions (body) + system.storage_elements (spec) + system.storage_elements (body) + system.secondary_stack (spec) + system.stack_checking (spec) + system.stack_checking (body) + system.string_hash (spec) + system.string_hash (body) + system.htable (body) + system.strings (spec) + system.strings (body) + system.traceback (spec) + system.traceback (body) + system.traceback_entries (spec) + system.traceback_entries (body) + ada.exceptions (spec) + ada.exceptions.last_chance_handler (spec) + system.soft_links (spec) + system.soft_links (body) + ada.exceptions.last_chance_handler (body) + system.secondary_stack (body) + system.exception_table (spec) + system.exception_table (body) + ada.io_exceptions (spec) + ada.tags (spec) + ada.streams (spec) + interfaces.c (spec) + interfaces.c (body) + system.finalization_root (spec) + system.finalization_root (body) + system.memory (spec) + system.memory (body) + system.standard_library (body) + system.os_lib (spec) + system.os_lib (body) + system.unsigned_types (spec) + system.stream_attributes (spec) + system.stream_attributes (body) + system.finalization_implementation (spec) + system.finalization_implementation (body) + ada.finalization (spec) + ada.finalization (body) + ada.finalization.list_controller (spec) + ada.finalization.list_controller (body) + system.file_control_block (spec) + system.file_io (spec) + system.file_io (body) + system.val_uns (spec) + system.val_util (spec) + system.val_util (body) + system.val_uns (body) + system.wch_con (spec) + system.wch_con (body) + system.wch_cnv (spec) + system.wch_jis (spec) + system.wch_jis (body) + system.wch_cnv (body) + system.wch_stw (spec) + system.wch_stw (body) + ada.tags (body) + ada.exceptions (body) + ada.text_io (spec) + ada.text_io (body) + text_io (spec) + gdbstr (body) diff --git a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst index 68117ae2c4949..8f9f37cc0d8c1 100644 --- a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst +++ b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst @@ -3611,20 +3611,26 @@ combine a dimensioned and dimensionless value. Thus an expression such as ``Acceleration``. The dimensionality checks for relationals use the same rules as -for "+" and "-"; thus +for "+" and "-", except when comparing to a literal; thus .. code-block:: ada - acc > 10.0 + acc > len is equivalent to .. code-block:: ada - acc-10.0 > 0.0 + acc-len > 0.0 + +and is thus illegal, but + + .. code-block:: ada + + acc > 10.0 -and is thus illegal. Analogously a conditional expression -requires the same dimension vector for each branch. +is accepted with a warning. Analogously a conditional expression requires the +same dimension vector for each branch (with no exception for literals). The dimension vector of a type conversion :samp:`T({expr})` is defined as follows, based on the nature of ``T``: @@ -4093,9 +4099,8 @@ execution of this erroneous program: ``gnatmem`` makes use of the output created by the special version of allocation and deallocation routines that record call information. This allows it to obtain accurate dynamic memory usage history at a minimal cost to the - execution speed. Note however, that ``gnatmem`` is not supported on all - platforms (currently, it is supported on AIX, HP-UX, GNU/Linux, Solaris and - Windows). + execution speed. Note however, that ``gnatmem`` is only supported on + GNU/Linux and Windows. The ``gnatmem`` command has the form diff --git a/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst b/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst index 3f5f2d64c6b62..855bb8f3d4d64 100644 --- a/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst +++ b/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst @@ -586,9 +586,9 @@ The following switches are available for ``gnatxref``: :switch:`--ext={extension}` Specify an alternate ali file extension. The default is ``ali`` and other - extensions (e.g. ``gli`` for C/C++ sources when using :switch:`-fdump-xref`) - may be specified via this switch. Note that if this switch overrides the - default, which means that only the new extension will be considered. + extensions (e.g. ``gli`` for C/C++ sources) may be specified via this switch. + Note that if this switch overrides the default, which means that only the + new extension will be considered. .. index:: --RTS (gnatxref) diff --git a/gcc/ada/doc/share/conf.py b/gcc/ada/doc/share/conf.py index 173648b26ea1c..e6fafcfaec071 100644 --- a/gcc/ada/doc/share/conf.py +++ b/gcc/ada/doc/share/conf.py @@ -1,4 +1,5 @@ # -*- coding: utf-8 -*- +# Style_Check:Python_Fragment (meaning no pyflakes check) # # GNAT build configuration file diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index e947cba2088fa..01d64f3aff5b5 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -170,6 +170,7 @@ package body Einfo is -- Extra_Accessibility_Of_Result Node19 -- Non_Limited_View Node19 -- Parent_Subtype Node19 + -- Receiving_Entry Node19 -- Size_Check_Code Node19 -- Spec_Entity Node19 -- Underlying_Full_View Node19 @@ -275,6 +276,9 @@ package body Einfo is -- Validated_Object Node36 -- Class_Wide_Clone Node38 + + -- Protected_Subprogram Node39 + -- SPARK_Pragma Node40 -- Original_Protected_Subprogram Node41 @@ -449,7 +453,7 @@ package body Einfo is -- Strict_Alignment Flag145 -- Is_Abstract_Type Flag146 -- Needs_Debug_Info Flag147 - -- Suppress_Elaboration_Warnings Flag148 + -- Is_Elaboration_Checks_OK_Id Flag148 -- Is_Compilation_Unit Flag149 -- Has_Pragma_Elaborate_Body Flag150 @@ -619,7 +623,8 @@ package body Einfo is -- Has_Private_Extension Flag300 -- Ignore_SPARK_Mode_Pragmas Flag301 - -- (unused) Flag302 + -- Is_Initial_Condition_Procedure Flag302 + -- (unused) Flag303 -- (unused) Flag304 -- (unused) Flag305 @@ -2237,6 +2242,17 @@ package body Einfo is return Flag6 (Id); end Is_Dispatching_Operation; + function Is_Elaboration_Checks_OK_Id (Id : E) return B is + begin + pragma Assert + (Ekind_In (Id, E_Constant, E_Variable) + or else Is_Entry (Id) + or else Is_Generic_Unit (Id) + or else Is_Subprogram (Id) + or else Is_Task_Type (Id)); + return Flag148 (Id); + end Is_Elaboration_Checks_OK_Id; + function Is_Eliminated (Id : E) return B is begin return Flag124 (Id); @@ -2364,6 +2380,12 @@ package body Einfo is return Flag268 (Id); end Is_Independent; + function Is_Initial_Condition_Procedure (Id : E) return B is + begin + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); + return Flag302 (Id); + end Is_Initial_Condition_Procedure; + function Is_Inlined (Id : E) return B is begin return Flag11 (Id); @@ -2371,7 +2393,7 @@ package body Einfo is function Is_Inlined_Always (Id : E) return B is begin - pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); return Flag1 (Id); end Is_Inlined_Always; @@ -3084,10 +3106,18 @@ package body Einfo is return Node22 (Id); end Protected_Formal; + function Protected_Subprogram (Id : E) return N is + begin + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); + return Node39 (Id); + end Protected_Subprogram; + function Protection_Object (Id : E) return E is begin - pragma Assert - (Ekind_In (Id, E_Entry, E_Entry_Family, E_Function, E_Procedure)); + pragma Assert (Ekind_In (Id, E_Entry, + E_Entry_Family, + E_Function, + E_Procedure)); return Node23 (Id); end Protection_Object; @@ -3096,6 +3126,12 @@ package body Einfo is return Flag49 (Id); end Reachable; + function Receiving_Entry (Id : E) return E is + begin + pragma Assert (Ekind (Id) = E_Procedure); + return Node19 (Id); + end Receiving_Entry; + function Referenced (Id : E) return B is begin return Flag156 (Id); @@ -3306,6 +3342,9 @@ package body Einfo is E_Task_Body, E_Task_Type) or else + Ekind_In (Id, E_Constant, -- object variants + E_Variable) + or else Ekind_In (Id, E_Entry, -- overloadable variants E_Entry_Family, E_Function, @@ -3319,7 +3358,7 @@ package body Einfo is E_Package, E_Package_Body) or else - Ekind (Id) = E_Variable); -- variable + Ekind (Id) = E_Void); -- special purpose return Node40 (Id); end SPARK_Pragma; @@ -3330,7 +3369,10 @@ package body Einfo is E_Protected_Type, E_Task_Body, E_Task_Type) - or else + or else + Ekind_In (Id, E_Constant, -- object variants + E_Variable) + or else Ekind_In (Id, E_Entry, -- overloadable variants E_Entry_Family, E_Function, @@ -3344,7 +3386,7 @@ package body Einfo is E_Package, E_Package_Body) or else - Ekind (Id) = E_Variable); -- variable + Ekind (Id) = E_Void); -- special purpose return Flag265 (Id); end SPARK_Pragma_Inherited; @@ -3444,11 +3486,6 @@ package body Einfo is return Uint24 (Id); end Subps_Index; - function Suppress_Elaboration_Warnings (Id : E) return B is - begin - return Flag148 (Id); - end Suppress_Elaboration_Warnings; - function Suppress_Initialization (Id : E) return B is begin pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable); @@ -5397,6 +5434,17 @@ package body Einfo is Set_Flag6 (Id, V); end Set_Is_Dispatching_Operation; + procedure Set_Is_Elaboration_Checks_OK_Id (Id : E; V : B := True) is + begin + pragma Assert + (Ekind_In (Id, E_Constant, E_Variable) + or else Is_Entry (Id) + or else Is_Generic_Unit (Id) + or else Is_Subprogram (Id) + or else Is_Task_Type (Id)); + Set_Flag148 (Id, V); + end Set_Is_Elaboration_Checks_OK_Id; + procedure Set_Is_Eliminated (Id : E; V : B := True) is begin Set_Flag124 (Id, V); @@ -5526,6 +5574,12 @@ package body Einfo is Set_Flag268 (Id, V); end Set_Is_Independent; + procedure Set_Is_Initial_Condition_Procedure (Id : E; V : B := True) is + begin + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); + Set_Flag302 (Id, V); + end Set_Is_Initial_Condition_Procedure; + procedure Set_Is_Inlined (Id : E; V : B := True) is begin Set_Flag11 (Id, V); @@ -5533,7 +5587,7 @@ package body Einfo is procedure Set_Is_Inlined_Always (Id : E; V : B := True) is begin - pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); Set_Flag1 (Id, V); end Set_Is_Inlined_Always; @@ -6264,6 +6318,12 @@ package body Einfo is Set_Node22 (Id, V); end Set_Protected_Formal; + procedure Set_Protected_Subprogram (Id : E; V : E) is + begin + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); + Set_Node39 (Id, V); + end Set_Protected_Subprogram; + procedure Set_Protection_Object (Id : E; V : E) is begin pragma Assert (Ekind_In (Id, E_Entry, @@ -6278,6 +6338,12 @@ package body Einfo is Set_Flag49 (Id, V); end Set_Reachable; + procedure Set_Receiving_Entry (Id : E; V : E) is + begin + pragma Assert (Ekind (Id) = E_Procedure); + Set_Node19 (Id, V); + end Set_Receiving_Entry; + procedure Set_Referenced (Id : E; V : B := True) is begin Set_Flag156 (Id, V); @@ -6491,7 +6557,10 @@ package body Einfo is E_Protected_Type, E_Task_Body, E_Task_Type) - or else + or else + Ekind_In (Id, E_Constant, -- object variants + E_Variable) + or else Ekind_In (Id, E_Entry, -- overloadable variants E_Entry_Family, E_Function, @@ -6505,7 +6574,7 @@ package body Einfo is E_Package, E_Package_Body) or else - Ekind (Id) = E_Variable); -- variable + Ekind (Id) = E_Void); -- special purpose Set_Node40 (Id, V); end Set_SPARK_Pragma; @@ -6516,7 +6585,10 @@ package body Einfo is E_Protected_Type, E_Task_Body, E_Task_Type) - or else + or else + Ekind_In (Id, E_Constant, -- object variants + E_Variable) + or else Ekind_In (Id, E_Entry, -- overloadable variants E_Entry_Family, E_Function, @@ -6530,7 +6602,7 @@ package body Einfo is E_Package, E_Package_Body) or else - Ekind (Id) = E_Variable); -- variable + Ekind (Id) = E_Void); -- special purpose Set_Flag265 (Id, V); end Set_SPARK_Pragma_Inherited; @@ -6639,11 +6711,6 @@ package body Einfo is Set_Uint24 (Id, V); end Set_Subps_Index; - procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True) is - begin - Set_Flag148 (Id, V); - end Set_Suppress_Elaboration_Warnings; - procedure Set_Suppress_Initialization (Id : E; V : B := True) is begin pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable); @@ -9562,6 +9629,7 @@ package body Einfo is W ("Is_Discriminant_Check_Function", Flag264 (Id)); W ("Is_Dispatch_Table_Entity", Flag234 (Id)); W ("Is_Dispatching_Operation", Flag6 (Id)); + W ("Is_Elaboration_Checks_OK_Id", Flag148 (Id)); W ("Is_Eliminated", Flag124 (Id)); W ("Is_Entry_Formal", Flag52 (Id)); W ("Is_Exception_Handler", Flag286 (Id)); @@ -9584,6 +9652,7 @@ package body Einfo is W ("Is_Implementation_Defined", Flag254 (Id)); W ("Is_Imported", Flag24 (Id)); W ("Is_Independent", Flag268 (Id)); + W ("Is_Initial_Condition_Procedure", Flag302 (Id)); W ("Is_Inlined", Flag11 (Id)); W ("Is_Inlined_Always", Flag1 (Id)); W ("Is_Instantiated", Flag126 (Id)); @@ -9696,7 +9765,6 @@ package body Einfo is W ("Static_Elaboration_Desired", Flag77 (Id)); W ("Stores_Attribute_Old_Prefix", Flag270 (Id)); W ("Strict_Alignment", Flag145 (Id)); - W ("Suppress_Elaboration_Warnings", Flag148 (Id)); W ("Suppress_Initialization", Flag105 (Id)); W ("Suppress_Style_Checks", Flag165 (Id)); W ("Suppress_Value_Tracking_On_Call", Flag217 (Id)); @@ -10399,6 +10467,9 @@ package body Einfo is when E_Record_Type => Write_Str ("Parent_Subtype"); + when E_Procedure => + Write_Str ("Receiving_Entry"); + when E_Constant | E_Variable => @@ -11089,6 +11160,11 @@ package body Einfo is procedure Write_Field39_Name (Id : Entity_Id) is begin case Ekind (Id) is + when E_Function + | E_Procedure + => + Write_Str ("Protected_Subprogram"); + when others => Write_Str ("Field39??"); end case; @@ -11101,7 +11177,8 @@ package body Einfo is procedure Write_Field40_Name (Id : Entity_Id) is begin case Ekind (Id) is - when E_Entry + when E_Constant + | E_Entry | E_Entry_Family | E_Function | E_Generic_Function @@ -11117,6 +11194,7 @@ package body Einfo is | E_Task_Body | E_Task_Type | E_Variable + | E_Void => Write_Str ("SPARK_Pragma"); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 13bf62019d7a2..bfe14fcae7c5a 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1312,9 +1312,9 @@ package Einfo is -- that represents an activation record pointer is an extra formal. -- Extra_Formals (Node28) --- Applies to subprograms and subprogram types, and also to entries --- and entry families. Returns first extra formal of the subprogram --- or entry. Returns Empty if there are no extra formals. +-- Applies to subprograms, subprogram types, entries, and entry +-- families. Returns first extra formal of the subprogram or entry. +-- Returns Empty if there are no extra formals. -- Finalization_Master (Node23) [root type only] -- Defined in access-to-controlled or access-to-class-wide types. The @@ -2198,13 +2198,6 @@ package Einfo is -- Rep_Item chain mechanism, because a single pragma Import can apply -- to multiple subprogram entities). --- Incomplete_Actuals (Elist24) --- Defined on package entities that are instances. Indicates the actuals --- types in the instantiation that are limited views. If this list is --- not empty, the instantiation, which appears in a package declaration, --- is relocated to the corresponding package body, which must have a --- corresponding nonlimited with_clause. - -- In_Package_Body (Flag48) -- Defined in package entities. Set on the entity that denotes the -- package (the defining occurrence of the package declaration) while @@ -2218,6 +2211,13 @@ package Einfo is -- the end of the package declaration. For objects it indicates that the -- declaration of the object occurs in the private part of a package. +-- Incomplete_Actuals (Elist24) +-- Defined on package entities that are instances. Indicates the actuals +-- types in the instantiation that are limited views. If this list is +-- not empty, the instantiation, which appears in a package declaration, +-- is relocated to the corresponding package body, which must have a +-- corresponding nonlimited with_clause. + -- Initialization_Statements (Node28) -- Defined in constants and variables. For a composite object initialized -- initialized with an aggregate that has been converted to a sequence @@ -2504,13 +2504,19 @@ package Einfo is -- Is_Dynamic_Scope (synthesized) -- Applies to all Entities. Returns True if the entity is a dynamic --- scope (i.e. a block, subprogram, task_type, entry --- or extended return statement). +-- scope (i.e. a block, subprogram, task_type, entry or extended return +-- statement). + +-- Is_Elaboration_Checks_OK_Id (Flag148) +-- Defined in elaboration targets (see terminology in Sem_Elab). Set when +-- the target appears in a region which is subject to elabled elaboration +-- checks. Such targets are allowed to generate run-time conditional ABE +-- checks or guaranteed ABE failures. -- Is_Elementary_Type (synthesized) --- Applies to all entities, true for all elementary types and --- subtypes. Either Is_Composite_Type or Is_Elementary_Type (but --- not both) is true of any type. +-- Applies to all entities, true for all elementary types and subtypes. +-- Either Is_Composite_Type or Is_Elementary_Type (but not both) is true +-- of any type. -- Is_Eliminated (Flag124) -- Defined in type entities, subprogram entities, and object entities. @@ -2703,6 +2709,10 @@ package Einfo is -- and incomplete types, this flag is set in both the partial view and -- the full view. +-- Is_Initial_Condition_Procedure (Flag302) +-- Defined in functions and procedures. Set for a generated procedure +-- which verifies the assumption of pragma Initial_Condition at run time. + -- Is_Inlined (Flag11) -- Defined in all entities. Set for functions and procedures which are -- to be inlined. For subprograms created during expansion, this flag @@ -2746,7 +2756,7 @@ package Einfo is -- 1) Internal entities (such as temporaries generated for the result -- of an inlined function call or dummy variables generated for the -- debugger). Set to indicate that they need not be initialized, even --- when scalars are initialized or normalized; +-- when scalars are initialized or normalized. -- -- 2) Predefined primitives of tagged types. Set to mark that they -- have specific properties: first they are primitives even if they @@ -3958,6 +3968,11 @@ package Einfo is -- formal parameter in the unprotected version of the operation that -- is created during expansion. +-- Protected_Subprogram (Node39) +-- Defined in functions and procedures. Set for the pair of subprograms +-- which emulate the runtime semantics of a protected subprogram. Denotes +-- the entity of the origial protected subprogram. + -- Protection_Object (Node23) -- Applies to protected entries, entry families and subprograms. Denotes -- the entity which is used to rename the _object component of protected @@ -3967,6 +3982,11 @@ package Einfo is -- Defined in labels. The flag is set over the range of statements in -- which a goto to that label is legal. +-- Receiving_Entry (Node19) +-- Defined in procedures. Set for an internally generated procedure which +-- wraps the original statements of an accept alternative. Designates the +-- entity of the task entry being accepted. + -- Referenced (Flag156) -- Defined in all entities. Set if the entity is referenced, except for -- the case of an appearance of a simple variable that is not a renaming @@ -4038,10 +4058,10 @@ package Einfo is -- in a Relative_Deadline pragma for a task type. -- Renamed_Entity (Node18) --- Defined in exceptions, packages, subprograms, and generic units. Set --- for entities that are defined by a renaming declaration. Denotes the --- renamed entity, or transitively the ultimate renamed entity if --- there is a chain of renaming declarations. Empty if no renaming. +-- Defined in exception, generic unit, package, and subprogram entities. +-- Set when the entity is defined by a renaming declaration. Denotes the +-- renamed entity, or transitively the ultimate renamed entity if there +-- is a chain of renaming declarations. Empty if no renaming. -- Renamed_In_Spec (Flag231) -- Defined in package entities. If a package renaming occurs within @@ -4256,20 +4276,20 @@ package Einfo is -- inherited, rather than a local one. -- SPARK_Pragma (Node40) --- Present in concurrent type, entry, operator, [generic] package, --- package body, [generic] subprogram, subprogram body and variable --- entities. Points to the N_Pragma node that applies to the initial --- declaration or body. This is either set by a local SPARK_Mode pragma --- or is inherited from the context (from an outer scope for the spec --- case or from the spec for the body case). In the case where it is --- inherited the flag SPARK_Pragma_Inherited is set. Empty if no +-- Present in concurrent type, constant, entry, operator, [generic] +-- package, package body, [generic] subprogram, subprogram body and +-- variable entities. Points to the N_Pragma node that applies to the +-- initial declaration or body. This is either set by a local SPARK_Mode +-- pragma or is inherited from the context (from an outer scope for the +-- spec case or from the spec for the body case). In the case where it +-- is inherited the flag SPARK_Pragma_Inherited is set. Empty if no -- SPARK_Mode pragma is applicable. -- SPARK_Pragma_Inherited (Flag265) --- Present in concurrent type, entry, operator, [generic] package, --- package body, [generic] subprogram, subprogram body and variable --- entities. Set if the SPARK_Pragma attribute points to a pragma that is --- inherited, rather than a local one. +-- Present in concurrent type, constant, entry, operator, [generic] +-- package, package body, [generic] subprogram, subprogram body and +-- variable entities. Set if the SPARK_Pragma attribute points to a +-- pragma that is inherited, rather than a local one. -- Spec_Entity (Node19) -- Defined in package body entities. Points to corresponding package @@ -4395,17 +4415,6 @@ package Einfo is -- for the outer level subprogram, this is the starting index in the Subp -- table for the entries for this subprogram. --- Suppress_Elaboration_Warnings (Flag148) --- Defined in all entities, can be set only for subprogram entities and --- for variables. If this flag is set then Sem_Elab will not generate --- elaboration warnings for the subprogram or variable. Suppression of --- such warnings is automatic for subprograms for which elaboration --- checks are suppressed (without the need to set this flag), but the --- flag is also set for various internal entities (such as init procs) --- which are known not to generate any possible access before --- elaboration, and it is set on variables when a warning is given to --- avoid multiple elaboration warnings for the same variable. - -- Suppress_Initialization (Flag105) -- Defined in all variable, type and subtype entities. If set for a base -- type, then the generation of initialization procedures is suppressed @@ -5565,7 +5574,6 @@ package Einfo is -- Referenced (Flag156) -- Referenced_As_LHS (Flag36) -- Referenced_As_Out_Parameter (Flag227) - -- Suppress_Elaboration_Warnings (Flag148) -- Suppress_Style_Checks (Flag165) -- Suppress_Value_Tracking_On_Call (Flag217) -- Used_As_Generic_Actual (Flag222) @@ -5869,6 +5877,7 @@ package Einfo is -- Encapsulating_State (Node32) (constants only) -- Linker_Section_Pragma (Node33) -- Contract (Node34) (constants only) + -- SPARK_Pragma (Node40) (constants only) -- Has_Alignment_Clause (Flag46) -- Has_Atomic_Components (Flag86) -- Has_Biased_Representation (Flag139) @@ -5878,6 +5887,7 @@ package Einfo is -- Has_Thunks (Flag228) (constants only) -- Has_Volatile_Components (Flag87) -- Is_Atomic (Flag85) + -- Is_Elaboration_Checks_OK_Id (Flag148) (constants only) -- Is_Eliminated (Flag124) -- Is_Finalized_Transient (Flag252) -- Is_Ignored_Transient (Flag295) @@ -5889,6 +5899,7 @@ package Einfo is -- Is_Volatile_Full_Access (Flag285) -- Optimize_Alignment_Space (Flag241) (constants only) -- Optimize_Alignment_Time (Flag242) (constants only) + -- SPARK_Pragma_Inherited (Flag265) (constants only) -- Stores_Attribute_Old_Prefix (Flag270) (constants only) -- Treat_As_Volatile (Flag41) -- Address_Clause (synth) @@ -5953,6 +5964,7 @@ package Einfo is -- Entry_Accepted (Flag152) -- Has_Expanded_Contract (Flag240) -- Ignore_SPARK_Mode_Pragmas (Flag301) + -- Is_Elaboration_Checks_OK_Id (Flag148) -- Is_Entry_Wrapper (Flag297) -- Needs_No_Actuals (Flag22) -- Sec_Stack_Needed_For_Return (Flag167) @@ -6065,6 +6077,7 @@ package Einfo is -- Contract (Node34) -- Import_Pragma (Node35) (non-generic case only) -- Class_Wide_Clone (Node38) + -- Protected_Subprogram (Node39) (non-generic case only) -- SPARK_Pragma (Node40) -- Original_Protected_Subprogram (Node41) -- Body_Needed_For_SAL (Flag40) @@ -6090,9 +6103,11 @@ package Einfo is -- Is_DIC_Procedure (Flag132) (non-generic case only) -- Is_Discrim_SO_Function (Flag176) -- Is_Discriminant_Check_Function (Flag264) + -- Is_Elaboration_Checks_OK_Id (Flag148) -- Is_Eliminated (Flag124) -- Is_Generic_Actual_Subprogram (Flag274) (non-generic case only) -- Is_Hidden_Non_Overridden_Subpgm (Flag2) (non-generic case only) + -- Is_Initial_Condition_Procedure (Flag302) (non-generic case only) -- Is_Inlined_Always (Flag1) (non-generic case only) -- Is_Instantiated (Flag126) (generic case only) -- Is_Intrinsic_Subprogram (Flag64) @@ -6238,6 +6253,7 @@ package Einfo is -- Default_Expressions_Processed (Flag108) -- Has_Nested_Subprogram (Flag282) -- Ignore_SPARK_Mode_Pragmas (Flag301) + -- Is_Elaboration_Checks_OK_Id (Flag148) -- Is_Intrinsic_Subprogram (Flag64) -- Is_Machine_Code_Subprogram (Flag137) -- Is_Primitive (Flag218) @@ -6304,6 +6320,7 @@ package Einfo is -- Ignore_SPARK_Mode_Pragmas (Flag301) -- In_Package_Body (Flag48) -- In_Use (Flag8) + -- Is_Elaboration_Checks_OK_Id (Flag148) -- Is_Instantiated (Flag126) -- Is_Private_Descendant (Flag53) -- Is_Visible_Lib_Unit (Flag116) @@ -6362,6 +6379,7 @@ package Einfo is -- First_Entity (Node17) -- Alias (Node18) (non-generic case only) -- Renamed_Entity (Node18) (generic case only) + -- Receiving_Entry (Node19) (non-generic case only) -- Last_Entity (Node20) -- Interface_Name (Node21) -- Scope_Depth_Value (Uint22) @@ -6381,6 +6399,7 @@ package Einfo is -- Contract (Node34) -- Import_Pragma (Node35) (non-generic case only) -- Class_Wide_Clone (Node38) + -- Protected_Subprogram (Node39) (non-generic case only) -- SPARK_Pragma (Node40) -- Original_Protected_Subprogram (Node41) -- Body_Needed_For_SAL (Flag40) @@ -6403,9 +6422,11 @@ package Einfo is -- Is_Called (Flag102) (non-generic case only) -- Is_Constructor (Flag76) -- Is_DIC_Procedure (Flag132) (non-generic case only) + -- Is_Elaboration_Checks_OK_Id (Flag148) -- Is_Eliminated (Flag124) -- Is_Generic_Actual_Subprogram (Flag274) (non-generic case only) -- Is_Hidden_Non_Overridden_Subpgm (Flag2) (non-generic case only) + -- Is_Initial_Condition_Procedure (Flag302) (non-generic case only) -- Is_Inlined_Always (Flag1) (non-generic case only) -- Is_Instantiated (Flag126) (generic case only) -- Is_Interrupt_Handler (Flag89) @@ -6614,6 +6635,7 @@ package Einfo is -- Has_Master_Entity (Flag21) -- Has_Storage_Size_Clause (Flag23) (base type only) -- Ignore_SPARK_Mode_Pragmas (Flag301) + -- Is_Elaboration_Checks_OK_Id (Flag148) -- SPARK_Aux_Pragma_Inherited (Flag266) -- SPARK_Pragma_Inherited (Flag265) -- First_Component (synth) @@ -6662,6 +6684,7 @@ package Einfo is -- Has_Size_Clause (Flag29) -- Has_Volatile_Components (Flag87) -- Is_Atomic (Flag85) + -- Is_Elaboration_Checks_OK_Id (Flag148) -- Is_Eliminated (Flag124) -- Is_Finalized_Transient (Flag252) -- Is_Ignored_Transient (Flag295) @@ -7179,6 +7202,7 @@ package Einfo is function Is_Discriminant_Check_Function (Id : E) return B; function Is_Dispatch_Table_Entity (Id : E) return B; function Is_Dispatching_Operation (Id : E) return B; + function Is_Elaboration_Checks_OK_Id (Id : E) return B; function Is_Eliminated (Id : E) return B; function Is_Entry_Formal (Id : E) return B; function Is_Entry_Wrapper (Id : E) return B; @@ -7198,6 +7222,7 @@ package Einfo is function Is_Implementation_Defined (Id : E) return B; function Is_Imported (Id : E) return B; function Is_Independent (Id : E) return B; + function Is_Initial_Condition_Procedure (Id : E) return B; function Is_Inlined (Id : E) return B; function Is_Inlined_Always (Id : E) return B; function Is_Instantiated (Id : E) return B; @@ -7322,8 +7347,10 @@ package Einfo is function Private_View (Id : E) return N; function Protected_Body_Subprogram (Id : E) return E; function Protected_Formal (Id : E) return E; + function Protected_Subprogram (Id : E) return N; function Protection_Object (Id : E) return E; function Reachable (Id : E) return B; + function Receiving_Entry (Id : E) return E; function Referenced (Id : E) return B; function Referenced_As_LHS (Id : E) return B; function Referenced_As_Out_Parameter (Id : E) return B; @@ -7376,7 +7403,6 @@ package Einfo is function String_Literal_Low_Bound (Id : E) return N; function Subprograms_For_Type (Id : E) return L; function Subps_Index (Id : E) return U; - function Suppress_Elaboration_Warnings (Id : E) return B; function Suppress_Initialization (Id : E) return B; function Suppress_Style_Checks (Id : E) return B; function Suppress_Value_Tracking_On_Call (Id : E) return B; @@ -7868,6 +7894,7 @@ package Einfo is procedure Set_Is_Discriminant_Check_Function (Id : E; V : B := True); procedure Set_Is_Dispatch_Table_Entity (Id : E; V : B := True); procedure Set_Is_Dispatching_Operation (Id : E; V : B := True); + procedure Set_Is_Elaboration_Checks_OK_Id (Id : E; V : B := True); procedure Set_Is_Eliminated (Id : E; V : B := True); procedure Set_Is_Entry_Formal (Id : E; V : B := True); procedure Set_Is_Entry_Wrapper (Id : E; V : B := True); @@ -7891,6 +7918,7 @@ package Einfo is procedure Set_Is_Implementation_Defined (Id : E; V : B := True); procedure Set_Is_Imported (Id : E; V : B := True); procedure Set_Is_Independent (Id : E; V : B := True); + procedure Set_Is_Initial_Condition_Procedure (Id : E; V : B := True); procedure Set_Is_Inlined (Id : E; V : B := True); procedure Set_Is_Inlined_Always (Id : E; V : B := True); procedure Set_Is_Instantiated (Id : E; V : B := True); @@ -8015,8 +8043,10 @@ package Einfo is procedure Set_Private_View (Id : E; V : N); procedure Set_Protected_Body_Subprogram (Id : E; V : E); procedure Set_Protected_Formal (Id : E; V : E); + procedure Set_Protected_Subprogram (Id : E; V : N); procedure Set_Protection_Object (Id : E; V : E); procedure Set_Reachable (Id : E; V : B := True); + procedure Set_Receiving_Entry (Id : E; V : E); procedure Set_Referenced (Id : E; V : B := True); procedure Set_Referenced_As_LHS (Id : E; V : B := True); procedure Set_Referenced_As_Out_Parameter (Id : E; V : B := True); @@ -8069,7 +8099,6 @@ package Einfo is procedure Set_String_Literal_Low_Bound (Id : E; V : N); procedure Set_Subprograms_For_Type (Id : E; V : L); procedure Set_Subps_Index (Id : E; V : U); - procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True); procedure Set_Suppress_Initialization (Id : E; V : B := True); procedure Set_Suppress_Style_Checks (Id : E; V : B := True); procedure Set_Suppress_Value_Tracking_On_Call (Id : E; V : B := True); @@ -8690,6 +8719,7 @@ package Einfo is pragma Inline (Is_Discriminant_Check_Function); pragma Inline (Is_Dispatch_Table_Entity); pragma Inline (Is_Dispatching_Operation); + pragma Inline (Is_Elaboration_Checks_OK_Id); pragma Inline (Is_Elementary_Type); pragma Inline (Is_Eliminated); pragma Inline (Is_Entry); @@ -8725,6 +8755,7 @@ package Einfo is pragma Inline (Is_Incomplete_Or_Private_Type); pragma Inline (Is_Incomplete_Type); pragma Inline (Is_Independent); + pragma Inline (Is_Initial_Condition_Procedure); pragma Inline (Is_Inlined); pragma Inline (Is_Inlined_Always); pragma Inline (Is_Instantiated); @@ -8868,8 +8899,10 @@ package Einfo is pragma Inline (Private_View); pragma Inline (Protected_Body_Subprogram); pragma Inline (Protected_Formal); + pragma Inline (Protected_Subprogram); pragma Inline (Protection_Object); pragma Inline (Reachable); + pragma Inline (Receiving_Entry); pragma Inline (Referenced); pragma Inline (Referenced_As_LHS); pragma Inline (Referenced_As_Out_Parameter); @@ -8922,7 +8955,6 @@ package Einfo is pragma Inline (String_Literal_Low_Bound); pragma Inline (Subprograms_For_Type); pragma Inline (Subps_Index); - pragma Inline (Suppress_Elaboration_Warnings); pragma Inline (Suppress_Initialization); pragma Inline (Suppress_Style_Checks); pragma Inline (Suppress_Value_Tracking_On_Call); @@ -9200,6 +9232,7 @@ package Einfo is pragma Inline (Set_Is_Discriminant_Check_Function); pragma Inline (Set_Is_Dispatch_Table_Entity); pragma Inline (Set_Is_Dispatching_Operation); + pragma Inline (Set_Is_Elaboration_Checks_OK_Id); pragma Inline (Set_Is_Eliminated); pragma Inline (Set_Is_Entry_Formal); pragma Inline (Set_Is_Entry_Wrapper); @@ -9223,6 +9256,7 @@ package Einfo is pragma Inline (Set_Is_Implementation_Defined); pragma Inline (Set_Is_Imported); pragma Inline (Set_Is_Independent); + pragma Inline (Set_Is_Initial_Condition_Procedure); pragma Inline (Set_Is_Inlined); pragma Inline (Set_Is_Inlined_Always); pragma Inline (Set_Is_Instantiated); @@ -9348,8 +9382,10 @@ package Einfo is pragma Inline (Set_Private_View); pragma Inline (Set_Protected_Body_Subprogram); pragma Inline (Set_Protected_Formal); + pragma Inline (Set_Protected_Subprogram); pragma Inline (Set_Protection_Object); pragma Inline (Set_Reachable); + pragma Inline (Set_Receiving_Entry); pragma Inline (Set_Referenced); pragma Inline (Set_Referenced_As_LHS); pragma Inline (Set_Referenced_As_Out_Parameter); @@ -9402,7 +9438,6 @@ package Einfo is pragma Inline (Set_String_Literal_Low_Bound); pragma Inline (Set_Subprograms_For_Type); pragma Inline (Set_Subps_Index); - pragma Inline (Set_Suppress_Elaboration_Warnings); pragma Inline (Set_Suppress_Initialization); pragma Inline (Set_Suppress_Style_Checks); pragma Inline (Set_Suppress_Value_Tracking_On_Call); @@ -9435,9 +9470,12 @@ package Einfo is pragma Inline (Base_Type); pragma Inline (Is_Base_Type); + pragma Inline (Is_Boolean_Type); pragma Inline (Is_Controlled); + pragma Inline (Is_Entity_Name); pragma Inline (Is_Package_Or_Generic_Package); pragma Inline (Is_Packed_Array); + pragma Inline (Is_String_Type); pragma Inline (Is_Subprogram_Or_Generic_Subprogram); pragma Inline (Is_Volatile); pragma Inline (Is_Wrapper_Package); diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 972f6d58c4c2a..86621a4a06a7e 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -1251,6 +1251,7 @@ package body Exp_Aggr is if Finalization_OK and then not Is_Limited_Type (Comp_Typ) + and then not Is_Build_In_Place_Function_Call (Init_Expr) and then not (Is_Array_Type (Comp_Typ) and then Is_Controlled (Component_Type (Comp_Typ)) @@ -4125,25 +4126,6 @@ package body Exp_Aggr is -- Convert_To_Assignments -- ---------------------------- - function Is_Build_In_Place_Aggregate_Return (N : Node_Id) return Boolean is - P : Node_Id := Parent (N); - begin - while Nkind (P) = N_Qualified_Expression loop - P := Parent (P); - end loop; - - if Nkind (P) = N_Simple_Return_Statement then - null; - elsif Nkind (Parent (P)) = N_Extended_Return_Statement then - P := Parent (P); - else - return False; - end if; - - return Is_Build_In_Place_Function - (Return_Applies_To (Return_Statement_Entity (P))); - end Is_Build_In_Place_Aggregate_Return; - procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id) is Loc : constant Source_Ptr := Sloc (N); T : Entity_Id; @@ -4176,8 +4158,9 @@ package body Exp_Aggr is Unc_Decl := not Is_Entity_Name (Object_Definition (Parent_Node)) or else (Nkind (N) = N_Aggregate - and then Has_Discriminants - (Entity (Object_Definition (Parent_Node)))) + and then + Has_Discriminants + (Entity (Object_Definition (Parent_Node)))) or else Is_Class_Wide_Type (Entity (Object_Definition (Parent_Node))); end if; @@ -6671,8 +6654,8 @@ package body Exp_Aggr is -- individual assignments to the given components. procedure Expand_N_Extension_Aggregate (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); A : constant Node_Id := Ancestor_Part (N); + Loc : constant Source_Ptr := Sloc (N); Typ : constant Entity_Id := Etype (N); begin @@ -7476,6 +7459,33 @@ package body Exp_Aggr is return False; end Has_Default_Init_Comps; + ---------------------------------------- + -- Is_Build_In_Place_Aggregate_Return -- + ---------------------------------------- + + function Is_Build_In_Place_Aggregate_Return (N : Node_Id) return Boolean is + P : Node_Id := Parent (N); + + begin + while Nkind (P) = N_Qualified_Expression loop + P := Parent (P); + end loop; + + if Nkind (P) = N_Simple_Return_Statement then + null; + + elsif Nkind (Parent (P)) = N_Extended_Return_Statement then + P := Parent (P); + + else + return False; + end if; + + return + Is_Build_In_Place_Function + (Return_Applies_To (Return_Statement_Entity (P))); + end Is_Build_In_Place_Aggregate_Return; + -------------------------- -- Is_Delayed_Aggregate -- -------------------------- diff --git a/gcc/ada/exp_atag.ads b/gcc/ada/exp_atag.ads index d53466fc39c6a..73af9a0505984 100644 --- a/gcc/ada/exp_atag.ads +++ b/gcc/ada/exp_atag.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2006-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 2006-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -147,7 +147,7 @@ package Exp_Atag is -- -- Generates: -- Offset_To_Top_Ptr - -- (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset) + -- (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset).all function Build_Set_Predefined_Prim_Op_Address (Loc : Source_Ptr; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 552cd0295b588..70d39b7a91675 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1756,7 +1756,18 @@ package body Exp_Attr is -- and access to it must be passed to the function. if Is_Build_In_Place_Function_Call (Pref) then - Make_Build_In_Place_Call_In_Anonymous_Context (Pref); + + -- If attribute is 'Old, the context is a postcondition, and + -- the temporary must go in the corresponding subprogram, not + -- the postcondition function or any created blocks, as when + -- the attribute appears in a quantified expression. This is + -- handled below in the expansion of the attribute. + + if Attribute_Name (Parent (Pref)) = Name_Old then + null; + else + Make_Build_In_Place_Call_In_Anonymous_Context (Pref); + end if; -- Ada 2005 (AI-318-02): Specialization of the previous case for prefix -- containing build-in-place function calls whose returned object covers @@ -6512,7 +6523,9 @@ package body Exp_Attr is begin -- The prefix of attribute 'Valid should always denote an object -- reference. The reference is either coming directly from source - -- or is produced by validity check expansion. + -- or is produced by validity check expansion. The object may be + -- wrapped in a conversion in which case the call to Unqual_Conv + -- will yield it. -- If the prefix denotes a variable which captures the value of -- an object for validation purposes, use the variable in the @@ -6523,7 +6536,7 @@ package body Exp_Attr is -- if not Temp in ... then if Is_Validation_Variable_Reference (Pref) then - Temp := New_Occurrence_Of (Entity (Pref), Loc); + Temp := New_Occurrence_Of (Entity (Unqual_Conv (Pref)), Loc); -- Otherwise the prefix is either a source object or a constant -- produced by validity check expansion. Generate: diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 8711c89d0eb48..7941cbd2ca620 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -64,7 +64,7 @@ package body Exp_Ch11 is procedure Warn_If_No_Propagation (N : Node_Id); -- Called for an exception raise that is not a local raise (and thus can - -- not be optimized to a goto. Issues warning if No_Exception_Propagation + -- not be optimized to a goto). Issues warning if No_Exception_Propagation -- restriction is set. N is the node for the raise or equivalent call. --------------------------- @@ -998,15 +998,10 @@ package body Exp_Ch11 is -- if a source generated handler was not the target of a local raise. else - if Restriction_Active (No_Exception_Propagation) - and then not Has_Local_Raise (Handler) + if not Has_Local_Raise (Handler) and then Comes_From_Source (Handler) - and then Warn_On_Non_Local_Exception then - Warn_No_Exception_Propagation_Active (Handler); - Error_Msg_N - ("\?X?this handler can never be entered, " - & "and has been removed", Handler); + Warn_If_No_Local_Raise (Handler); end if; if No_Exception_Propagation_Active then @@ -1859,8 +1854,12 @@ package body Exp_Ch11 is -- Otherwise, if the No_Exception_Propagation restriction is active -- and the warning is enabled, generate the appropriate warnings. + -- ??? Do not do it for the Call_Marker nodes inserted by the ABE + -- mechanism because this generates too many false positives. + elsif Warn_On_Non_Local_Exception and then Restriction_Active (No_Exception_Propagation) + and then Nkind (N) /= N_Call_Marker then Warn_No_Exception_Propagation_Active (N); @@ -2154,6 +2153,22 @@ package body Exp_Ch11 is end case; end Get_RT_Exception_Name; + ---------------------------- + -- Warn_If_No_Local_Raise -- + ---------------------------- + + procedure Warn_If_No_Local_Raise (N : Node_Id) is + begin + if Restriction_Active (No_Exception_Propagation) + and then Warn_On_Non_Local_Exception + then + Warn_No_Exception_Propagation_Active (N); + + Error_Msg_N + ("\?X?this handler can never be entered, and has been removed", N); + end if; + end Warn_If_No_Local_Raise; + ---------------------------- -- Warn_If_No_Propagation -- ---------------------------- diff --git a/gcc/ada/exp_ch11.ads b/gcc/ada/exp_ch11.ads index cdd53de626eed..99efdeb23053d 100644 --- a/gcc/ada/exp_ch11.ads +++ b/gcc/ada/exp_ch11.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -90,4 +90,9 @@ package Exp_Ch11 is -- is a local handler marking that it has a local raise. E is the entity -- of the corresponding exception. + procedure Warn_If_No_Local_Raise (N : Node_Id); + -- Called for an exception handler that is not the target of a local raise. + -- Issues warning if No_Exception_Propagation restriction is set. N is the + -- node for the handler. + end Exp_Ch11; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 0198e3e5f7eb2..043a02c64bab1 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -43,6 +43,7 @@ with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; with Freeze; use Freeze; with Ghost; use Ghost; +with Lib; use Lib; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; @@ -1711,10 +1712,12 @@ package body Exp_Ch3 is Rec_Type : Entity_Id; Set_Tag : Entity_Id := Empty; - function Build_Assignment (Id : Entity_Id; N : Node_Id) return List_Id; - -- Build an assignment statement which assigns the default expression - -- to its corresponding record component if defined. The left hand side - -- of the assignment is marked Assignment_OK so that initialization of + function Build_Assignment + (Id : Entity_Id; + Default : Node_Id) return List_Id; + -- Build an assignment statement that assigns the default expression to + -- its corresponding record component if defined. The left-hand side of + -- the assignment is marked Assignment_OK so that initialization of -- limited private records works correctly. This routine may also build -- an adjustment call if the component is controlled. @@ -1783,13 +1786,16 @@ package body Exp_Ch3 is -- Build_Assignment -- ---------------------- - function Build_Assignment (Id : Entity_Id; N : Node_Id) return List_Id is - N_Loc : constant Source_Ptr := Sloc (N); - Typ : constant Entity_Id := Underlying_Type (Etype (Id)); + function Build_Assignment + (Id : Entity_Id; + Default : Node_Id) return List_Id + is + Default_Loc : constant Source_Ptr := Sloc (Default); + Typ : constant Entity_Id := Underlying_Type (Etype (Id)); Adj_Call : Node_Id; - Exp : Node_Id := N; - Kind : Node_Kind := Nkind (N); + Exp : Node_Id := Default; + Kind : Node_Kind := Nkind (Default); Lhs : Node_Id; Res : List_Id; @@ -1815,10 +1821,11 @@ package body Exp_Ch3 is and then Present (Discriminal_Link (Entity (N))) then Val := - Make_Selected_Component (N_Loc, + Make_Selected_Component (Default_Loc, Prefix => New_Copy_Tree (Lhs), Selector_Name => - New_Occurrence_Of (Discriminal_Link (Entity (N)), N_Loc)); + New_Occurrence_Of + (Discriminal_Link (Entity (N)), Default_Loc)); if Present (Val) then Rewrite (N, New_Copy_Tree (Val)); @@ -1835,9 +1842,9 @@ package body Exp_Ch3 is begin Lhs := - Make_Selected_Component (N_Loc, + Make_Selected_Component (Default_Loc, Prefix => Make_Identifier (Loc, Name_uInit), - Selector_Name => New_Occurrence_Of (Id, N_Loc)); + Selector_Name => New_Occurrence_Of (Id, Default_Loc)); Set_Assignment_OK (Lhs); if Nkind (Exp) = N_Aggregate @@ -1866,16 +1873,16 @@ package body Exp_Ch3 is -- traversing the expression. ??? if Kind = N_Attribute_Reference - and then Nam_In (Attribute_Name (N), Name_Unchecked_Access, - Name_Unrestricted_Access) - and then Is_Entity_Name (Prefix (N)) - and then Is_Type (Entity (Prefix (N))) - and then Entity (Prefix (N)) = Rec_Type + and then Nam_In (Attribute_Name (Default), Name_Unchecked_Access, + Name_Unrestricted_Access) + and then Is_Entity_Name (Prefix (Default)) + and then Is_Type (Entity (Prefix (Default))) + and then Entity (Prefix (Default)) = Rec_Type then Exp := - Make_Attribute_Reference (N_Loc, + Make_Attribute_Reference (Default_Loc, Prefix => - Make_Identifier (N_Loc, Name_uInit), + Make_Identifier (Default_Loc, Name_uInit), Attribute_Name => Name_Unrestricted_Access); end if; @@ -1899,33 +1906,33 @@ package body Exp_Ch3 is if Is_Tagged_Type (Typ) and then Tagged_Type_Expansion then Append_To (Res, - Make_Assignment_Statement (N_Loc, + Make_Assignment_Statement (Default_Loc, Name => - Make_Selected_Component (N_Loc, + Make_Selected_Component (Default_Loc, Prefix => New_Copy_Tree (Lhs, New_Scope => Proc_Id), Selector_Name => - New_Occurrence_Of (First_Tag_Component (Typ), N_Loc)), + New_Occurrence_Of + (First_Tag_Component (Typ), Default_Loc)), Expression => Unchecked_Convert_To (RTE (RE_Tag), New_Occurrence_Of - (Node - (First_Elmt - (Access_Disp_Table (Underlying_Type (Typ)))), - N_Loc)))); + (Node (First_Elmt (Access_Disp_Table (Underlying_Type + (Typ)))), + Default_Loc)))); end if; -- Adjust the component if controlled except if it is an aggregate -- that will be expanded inline. if Kind = N_Qualified_Expression then - Kind := Nkind (Expression (N)); + Kind := Nkind (Expression (Default)); end if; if Needs_Finalization (Typ) and then not (Nkind_In (Kind, N_Aggregate, N_Extension_Aggregate)) - and then not Is_Limited_View (Typ) + and then not Is_Build_In_Place_Function_Call (Exp) then Adj_Call := Make_Adjust_Call @@ -2716,36 +2723,30 @@ package body Exp_Ch3 is and then not Restriction_Active (No_Exception_Propagation) then declare - DF_Call : Node_Id; - DF_Id : Entity_Id; + DF_Id : Entity_Id; begin -- Create a local version of Deep_Finalize which has indication -- of partial initialization state. - DF_Id := Make_Temporary (Loc, 'F'); + DF_Id := + Make_Defining_Identifier (Loc, + Chars => New_External_Name (Name_uFinalizer)); Append_To (Decls, Make_Local_Deep_Finalize (Rec_Type, DF_Id)); - DF_Call := - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (DF_Id, Loc), - Parameter_Associations => New_List ( - Make_Identifier (Loc, Name_uInit), - New_Occurrence_Of (Standard_False, Loc))); - - -- Do not emit warnings related to the elaboration order when a - -- controlled object is declared before the body of Finalize is - -- seen. - - Set_No_Elaboration_Check (DF_Call); - Set_Exception_Handlers (Handled_Stmt_Node, New_List ( Make_Exception_Handler (Loc, Exception_Choices => New_List ( Make_Others_Choice (Loc)), Statements => New_List ( - DF_Call, + Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of (DF_Id, Loc), + Parameter_Associations => New_List ( + Make_Identifier (Loc, Name_uInit), + New_Occurrence_Of (Standard_False, Loc))), + Make_Raise_Statement (Loc))))); end; else @@ -5580,6 +5581,15 @@ package body Exp_Ch3 is -- arithmetic might yield a meaningless value for the length of the -- array, or its corresponding attribute. + procedure Count_Default_Sized_Task_Stacks + (Typ : Entity_Id; + Pri_Stacks : out Int; + Sec_Stacks : out Int); + -- Count the number of default-sized primary and secondary task stacks + -- required for task objects contained within type Typ. If the number of + -- task objects contained within the type is not known at compile time + -- the procedure will return the stack counts of zero. + procedure Default_Initialize_Object (After : Node_Id); -- Generate all default initialization actions for object Def_Id. Any -- new code is inserted after node After. @@ -5772,6 +5782,119 @@ package body Exp_Ch3 is end if; end Check_Large_Modular_Array; + ------------------------------------- + -- Count_Default_Sized_Task_Stacks -- + ------------------------------------- + + procedure Count_Default_Sized_Task_Stacks + (Typ : Entity_Id; + Pri_Stacks : out Int; + Sec_Stacks : out Int) + is + Component : Entity_Id; + + begin + -- To calculate the number of default-sized task stacks required for + -- an object of Typ, a depth-first recursive traversal of the AST + -- from the Typ entity node is undertaken. Only type nodes containing + -- task objects are visited. + + Pri_Stacks := 0; + Sec_Stacks := 0; + + if not Has_Task (Typ) then + return; + end if; + + case Ekind (Typ) is + when E_Task_Subtype + | E_Task_Type + => + -- A task type is found marking the bottom of the descent. If + -- the type has no representation aspect for the corresponding + -- stack then that stack is using the default size. + + if Present (Get_Rep_Item (Typ, Name_Storage_Size)) then + Pri_Stacks := 0; + else + Pri_Stacks := 1; + end if; + + if Present (Get_Rep_Item (Typ, Name_Secondary_Stack_Size)) then + Sec_Stacks := 0; + else + Sec_Stacks := 1; + end if; + + when E_Array_Subtype + | E_Array_Type + => + -- First find the number of default stacks contained within an + -- array component. + + Count_Default_Sized_Task_Stacks + (Component_Type (Typ), + Pri_Stacks, + Sec_Stacks); + + -- Then multiply the result by the size of the array + + declare + Quantity : constant Int := Number_Of_Elements_In_Array (Typ); + -- Number_Of_Elements_In_Array is non-trival, consequently + -- its result is captured as an optimization. + + begin + Pri_Stacks := Pri_Stacks * Quantity; + Sec_Stacks := Sec_Stacks * Quantity; + end; + + when E_Protected_Subtype + | E_Protected_Type + | E_Record_Subtype + | E_Record_Type + => + Component := First_Component_Or_Discriminant (Typ); + + -- Recursively descend each component of the composite type + -- looking for tasks, but only if the component is marked as + -- having a task. + + while Present (Component) loop + if Has_Task (Etype (Component)) then + declare + P : Int; + S : Int; + + begin + Count_Default_Sized_Task_Stacks + (Etype (Component), P, S); + Pri_Stacks := Pri_Stacks + P; + Sec_Stacks := Sec_Stacks + S; + end; + end if; + + Next_Component_Or_Discriminant (Component); + end loop; + + when E_Limited_Private_Subtype + | E_Limited_Private_Type + | E_Record_Subtype_With_Private + | E_Record_Type_With_Private + => + -- Switch to the full view of the private type to continue + -- search. + + Count_Default_Sized_Task_Stacks + (Full_View (Typ), Pri_Stacks, Sec_Stacks); + + -- Other types should not contain tasks + + when others => + raise Program_Error; + end case; + end Count_Default_Sized_Task_Stacks; + ------------------------------- -- Default_Initialize_Object -- ------------------------------- @@ -5809,6 +5932,7 @@ package body Exp_Ch3 is Aggr_Init : Node_Id; Comp_Init : List_Id := No_List; + Fin_Block : Node_Id; Fin_Call : Node_Id; Init_Stmts : List_Id := No_List; Obj_Init : Node_Id := Empty; @@ -5951,14 +6075,7 @@ package body Exp_Ch3 is Skip_Self => True); if Present (Fin_Call) then - - -- Do not emit warnings related to the elaboration order when a - -- controlled object is declared before the body of Finalize is - -- seen. - - Set_No_Elaboration_Check (Fin_Call); - - Append_To (Init_Stmts, + Fin_Block := Make_Block_Statement (Loc, Declarations => No_List, @@ -5973,7 +6090,14 @@ package body Exp_Ch3 is Statements => New_List ( Fin_Call, - Make_Raise_Statement (Loc))))))); + Make_Raise_Statement (Loc)))))); + + -- Signal the ABE mechanism that the block carries out + -- initialization actions. + + Set_Is_Initialization_Block (Fin_Block); + + Append_To (Init_Stmts, Fin_Block); end if; -- Otherwise finalization is not required, the initialization calls @@ -6133,6 +6257,19 @@ package body Exp_Ch3 is return; end if; + -- No action needed for the internal imported dummy object added by + -- Make_DT to compute the offset of the components that reference + -- secondary dispatch tables; required to avoid never-ending loop + -- processing this internal object declaration. + + if Tagged_Type_Expansion + and then Is_Internal (Def_Id) + and then Is_Imported (Def_Id) + and then Related_Type (Def_Id) = Implementation_Base_Type (Typ) + then + return; + end if; + -- First we do special processing for objects of a tagged type where -- this is the point at which the type is frozen. The creation of the -- dispatch table and the initialization procedure have to be deferred @@ -6184,6 +6321,37 @@ package body Exp_Ch3 is Check_Large_Modular_Array; + -- If No_Implicit_Heap_Allocations or No_Implicit_Task_Allocations + -- restrictions are active then default-sized secondary stacks are + -- generated by the binder and allocated by SS_Init. To provide the + -- binder the number of stacks to generate, the number of default-sized + -- stacks required for task objects contained within the object + -- declaration N is calculated here as it is at this point where + -- unconstrained types become constrained. The result is stored in the + -- enclosing unit's Unit_Record. + + -- Note if N is an array object declaration that has an initialization + -- expression, a second object declaration for the initialization + -- expression is created by the compiler. To prevent double counting + -- of the stacks in this scenario, the stacks of the first array are + -- not counted. + + if Has_Task (Typ) + and then not Restriction_Active (No_Secondary_Stack) + and then (Restriction_Active (No_Implicit_Heap_Allocations) + or else Restriction_Active (No_Implicit_Task_Allocations)) + and then not (Ekind_In (Ekind (Typ), E_Array_Type, E_Array_Subtype) + and then (Has_Init_Expression (N))) + then + declare + PS_Count, SS_Count : Int := 0; + begin + Count_Default_Sized_Task_Stacks (Typ, PS_Count, SS_Count); + Increment_Primary_Stack_Count (PS_Count); + Increment_Sec_Stack_Count (SS_Count); + end; + end if; + -- Default initialization required, and no expression present if No (Expr) then @@ -6308,6 +6476,23 @@ package body Exp_Ch3 is return; + -- This is the same as the previous 'elsif', except that the call has + -- been transformed by other expansion activities into something like + -- F(...)'Reference. + + elsif Nkind (Expr_Q) = N_Reference + and then Is_Build_In_Place_Function_Call (Prefix (Expr_Q)) + and then not Is_Expanded_Build_In_Place_Call + (Unqual_Conv (Prefix (Expr_Q))) + then + Make_Build_In_Place_Call_In_Anonymous_Context (Prefix (Expr_Q)); + + -- The previous call expands the expression initializing the + -- built-in-place object into further code that will be analyzed + -- later. No further expansion needed here. + + return; + -- Ada 2005 (AI-318-02): Specialization of the previous case for -- expressions containing a build-in-place function call whose -- returned object covers interface types, and Expr_Q has calls to @@ -6581,7 +6766,8 @@ package body Exp_Ch3 is -- allocated in place, delay checks until assignments are -- made, because the discriminants are not initialized. - if Nkind (Expr) = N_Allocator and then No_Initialization (Expr) + if Nkind (Expr) = N_Allocator + and then No_Initialization (Expr) then null; @@ -6617,15 +6803,7 @@ package body Exp_Ch3 is -- adjustment is required if we are going to rewrite the object -- declaration into a renaming declaration. - if Is_Build_In_Place_Result_Type (Typ) - and then Nkind (Parent (N)) = N_Extended_Return_Statement - and then not Is_Definite_Subtype - (Etype (Return_Applies_To - (Return_Statement_Entity (Parent (N))))) - then - null; - - elsif Needs_Finalization (Typ) + if Needs_Finalization (Typ) and then not Is_Limited_View (Typ) and then not Rewrite_As_Renaming then @@ -8362,10 +8540,13 @@ package body Exp_Ch3 is -- Normal case: No discriminants in the parent type else - -- Don't need to set any value if this interface shares the - -- primary dispatch table. + -- Don't need to set any value if the offset-to-top field is + -- statically set or if this interface shares the primary + -- dispatch table. - if not Is_Ancestor (Iface, Typ, Use_Full_View => True) then + if not Building_Static_Secondary_DT (Typ) + and then not Is_Ancestor (Iface, Typ, Use_Full_View => True) + then Append_To (Stmts_List, Build_Set_Static_Offset_To_Top (Loc, Iface_Tag => New_Occurrence_Of (Iface_Tag, Loc), diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 0fe189b8a4051..abf6d635451e7 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -1069,12 +1069,15 @@ package body Exp_Ch4 is -- object can be limited but not inherently limited if this allocator -- came from a return statement (we're allocating the result on the -- secondary stack). In that case, the object will be moved, so we do - -- want to Adjust. + -- want to Adjust. However, if it's a nonlimited build-in-place + -- function call, Adjust is not wanted. if Needs_Finalization (DesigT) and then Needs_Finalization (T) and then not Aggr_In_Place and then not Is_Limited_View (T) + and then not Alloc_For_BIP_Return (N) + and then not Is_Build_In_Place_Function_Call (Expression (N)) then -- An unchecked conversion is needed in the classwide case because -- the designated type can be an ancestor of the subtype mark of @@ -5451,12 +5454,10 @@ package body Exp_Ch4 is Typ : constant Entity_Id := Etype (N); Actions : List_Id; - Cnn : Entity_Id; Decl : Node_Id; Expr : Node_Id; New_If : Node_Id; New_N : Node_Id; - Ptr_Typ : Entity_Id; begin -- Check for MINIMIZED/ELIMINATED overflow mode @@ -5560,65 +5561,67 @@ package body Exp_Ch4 is Process_If_Case_Statements (N, Then_Actions (N)); Process_If_Case_Statements (N, Else_Actions (N)); - -- Generate: - -- type Ann is access all Typ; - - Ptr_Typ := Make_Temporary (Loc, 'A'); + declare + Cnn : constant Entity_Id := Make_Temporary (Loc, 'C', N); + Ptr_Typ : constant Entity_Id := Make_Temporary (Loc, 'A'); - Insert_Action (N, - Make_Full_Type_Declaration (Loc, - Defining_Identifier => Ptr_Typ, - Type_Definition => - Make_Access_To_Object_Definition (Loc, - All_Present => True, - Subtype_Indication => New_Occurrence_Of (Typ, Loc)))); + begin + -- Generate: + -- type Ann is access all Typ; - -- Generate: - -- Cnn : Ann; + Insert_Action (N, + Make_Full_Type_Declaration (Loc, + Defining_Identifier => Ptr_Typ, + Type_Definition => + Make_Access_To_Object_Definition (Loc, + All_Present => True, + Subtype_Indication => New_Occurrence_Of (Typ, Loc)))); - Cnn := Make_Temporary (Loc, 'C', N); + -- Generate: + -- Cnn : Ann; - Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Cnn, - Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc)); + Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => Cnn, + Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc)); - -- Generate: - -- if Cond then - -- Cnn := 'Unrestricted_Access; - -- else - -- Cnn := 'Unrestricted_Access; - -- end if; + -- Generate: + -- if Cond then + -- Cnn := 'Unrestricted_Access; + -- else + -- Cnn := 'Unrestricted_Access; + -- end if; - New_If := - Make_Implicit_If_Statement (N, - Condition => Relocate_Node (Cond), - Then_Statements => New_List ( - Make_Assignment_Statement (Sloc (Thenx), - Name => New_Occurrence_Of (Cnn, Sloc (Thenx)), - Expression => - Make_Attribute_Reference (Loc, - Prefix => Relocate_Node (Thenx), - Attribute_Name => Name_Unrestricted_Access))), + New_If := + Make_Implicit_If_Statement (N, + Condition => Relocate_Node (Cond), + Then_Statements => New_List ( + Make_Assignment_Statement (Sloc (Thenx), + Name => New_Occurrence_Of (Cnn, Sloc (Thenx)), + Expression => + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (Thenx), + Attribute_Name => Name_Unrestricted_Access))), - Else_Statements => New_List ( - Make_Assignment_Statement (Sloc (Elsex), - Name => New_Occurrence_Of (Cnn, Sloc (Elsex)), - Expression => - Make_Attribute_Reference (Loc, - Prefix => Relocate_Node (Elsex), - Attribute_Name => Name_Unrestricted_Access)))); + Else_Statements => New_List ( + Make_Assignment_Statement (Sloc (Elsex), + Name => New_Occurrence_Of (Cnn, Sloc (Elsex)), + Expression => + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (Elsex), + Attribute_Name => Name_Unrestricted_Access)))); - -- Preserve the original context for which the if statement is being - -- generated. This is needed by the finalization machinery to prevent - -- the premature finalization of controlled objects found within the - -- if statement. + -- Preserve the original context for which the if statement is + -- being generated. This is needed by the finalization machinery + -- to prevent the premature finalization of controlled objects + -- found within the if statement. - Set_From_Conditional_Expression (New_If); + Set_From_Conditional_Expression (New_If); - New_N := - Make_Explicit_Dereference (Loc, - Prefix => New_Occurrence_Of (Cnn, Loc)); + New_N := + Make_Explicit_Dereference (Loc, + Prefix => New_Occurrence_Of (Cnn, Loc)); + end; -- If the result is an unconstrained array and the if expression is in a -- context other than the initializing expression of the declaration of @@ -5639,6 +5642,7 @@ package body Exp_Ch4 is then declare Cnn : constant Node_Id := Make_Temporary (Loc, 'C', N); + begin Insert_Action (N, Make_Object_Declaration (Loc, @@ -5677,31 +5681,34 @@ package body Exp_Ch4 is -- and replace the if expression by a reference to Cnn - Cnn := Make_Temporary (Loc, 'C', N); + declare + Cnn : constant Node_Id := Make_Temporary (Loc, 'C', N); - Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Cnn, - Object_Definition => New_Occurrence_Of (Typ, Loc)); + begin + Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => Cnn, + Object_Definition => New_Occurrence_Of (Typ, Loc)); - New_If := - Make_Implicit_If_Statement (N, - Condition => Relocate_Node (Cond), + New_If := + Make_Implicit_If_Statement (N, + Condition => Relocate_Node (Cond), - Then_Statements => New_List ( - Make_Assignment_Statement (Sloc (Thenx), - Name => New_Occurrence_Of (Cnn, Sloc (Thenx)), - Expression => Relocate_Node (Thenx))), + Then_Statements => New_List ( + Make_Assignment_Statement (Sloc (Thenx), + Name => New_Occurrence_Of (Cnn, Sloc (Thenx)), + Expression => Relocate_Node (Thenx))), - Else_Statements => New_List ( - Make_Assignment_Statement (Sloc (Elsex), - Name => New_Occurrence_Of (Cnn, Sloc (Elsex)), - Expression => Relocate_Node (Elsex)))); + Else_Statements => New_List ( + Make_Assignment_Statement (Sloc (Elsex), + Name => New_Occurrence_Of (Cnn, Sloc (Elsex)), + Expression => Relocate_Node (Elsex)))); - Set_Assignment_OK (Name (First (Then_Statements (New_If)))); - Set_Assignment_OK (Name (First (Else_Statements (New_If)))); + Set_Assignment_OK (Name (First (Then_Statements (New_If)))); + Set_Assignment_OK (Name (First (Else_Statements (New_If)))); - New_N := New_Occurrence_Of (Cnn, Loc); + New_N := New_Occurrence_Of (Cnn, Loc); + end; -- Regular path using Expression_With_Actions diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 5846874fc30ca..9d2f652f11983 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -175,17 +175,30 @@ package body Exp_Ch5 is Advance : out Node_Id; New_Loop : out Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Stats : constant List_Id := Statements (N); - Typ : constant Entity_Id := Base_Type (Etype (Container)); - First_Op : constant Entity_Id := - Get_Iterable_Type_Primitive (Typ, Name_First); - Next_Op : constant Entity_Id := - Get_Iterable_Type_Primitive (Typ, Name_Next); + Loc : constant Source_Ptr := Sloc (N); + Stats : constant List_Id := Statements (N); + Typ : constant Entity_Id := Base_Type (Etype (Container)); Has_Element_Op : constant Entity_Id := - Get_Iterable_Type_Primitive (Typ, Name_Has_Element); + Get_Iterable_Type_Primitive (Typ, Name_Has_Element); + + First_Op : Entity_Id; + Next_Op : Entity_Id; + begin + -- Use the proper set of primitives depending on the direction of + -- iteration. The legality of a reverse iteration has been checked + -- during analysis. + + if Reverse_Present (Iterator_Specification (Iteration_Scheme (N))) then + First_Op := Get_Iterable_Type_Primitive (Typ, Name_Last); + Next_Op := Get_Iterable_Type_Primitive (Typ, Name_Previous); + + else + First_Op := Get_Iterable_Type_Primitive (Typ, Name_First); + Next_Op := Get_Iterable_Type_Primitive (Typ, Name_Next); + end if; + -- Declaration for Cursor Init := @@ -198,7 +211,7 @@ package body Exp_Ch5 is Parameter_Associations => New_List ( Convert_To_Iterable_Type (Container, Loc)))); - -- Statement that advances cursor in loop + -- Statement that advances (in the right direction) cursor in loop Advance := Make_Assignment_Statement (Loc, @@ -1577,7 +1590,7 @@ package body Exp_Ch5 is -- suppressed in this case). It is unnecessary but harmless in -- other cases. - -- Special case: no copy if the target has no discriminants. + -- Special case: no copy if the target has no discriminants if Has_Discriminants (L_Typ) and then Is_Unchecked_Union (Base_Type (L_Typ)) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 715e74cfebeda..bca7e5deae478 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -712,7 +712,8 @@ package body Exp_Ch6 is Stmt := First (Stmts); while Present (Stmt) loop if Nkind (Stmt) = N_Block_Statement then - Replace_Returns (Param_Id, Statements (Stmt)); + Replace_Returns (Param_Id, + Statements (Handled_Statement_Sequence (Stmt))); elsif Nkind (Stmt) = N_Case_Statement then declare @@ -2251,10 +2252,12 @@ package body Exp_Ch6 is procedure Expand_Call (N : Node_Id) is Post_Call : List_Id; + begin - pragma Assert - (Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement, - N_Entry_Call_Statement)); + pragma Assert (Nkind_In (N, N_Entry_Call_Statement, + N_Function_Call, + N_Procedure_Call_Statement)); + Expand_Call_Helper (N, Post_Call); Insert_Post_Call_Actions (N, Post_Call); end Expand_Call; @@ -3001,8 +3004,8 @@ package body Exp_Ch6 is if Prev_Orig /= Prev and then Nkind (Prev) = N_Attribute_Reference - and then - Get_Attribute_Id (Attribute_Name (Prev)) = Attribute_Access + and then Get_Attribute_Id (Attribute_Name (Prev)) = + Attribute_Access and then Is_Aliased_View (Prev_Orig) then Prev_Orig := Prev; @@ -4333,8 +4336,8 @@ package body Exp_Ch6 is if not Is_Build_In_Place_Function_Call (Call_Node) and then (No (First_Formal (Subp)) - or else - not Is_Concurrent_Record_Type (Etype (First_Formal (Subp)))) + or else + not Is_Concurrent_Record_Type (Etype (First_Formal (Subp)))) then Expand_Ctrl_Function_Call (Call_Node); @@ -4343,15 +4346,14 @@ package body Exp_Ch6 is -- intermediate result after its use. elsif Is_Build_In_Place_Function_Call (Call_Node) - and then - Nkind_In (Parent (Unqual_Conv (Call_Node)), - N_Attribute_Reference, - N_Function_Call, - N_Indexed_Component, - N_Object_Renaming_Declaration, - N_Procedure_Call_Statement, - N_Selected_Component, - N_Slice) + and then Nkind_In (Parent (Unqual_Conv (Call_Node)), + N_Attribute_Reference, + N_Function_Call, + N_Indexed_Component, + N_Object_Renaming_Declaration, + N_Procedure_Call_Statement, + N_Selected_Component, + N_Slice) then Establish_Transient_Scope (Call_Node, Sec_Stack => True); end if; @@ -5024,16 +5026,15 @@ package body Exp_Ch6 is -- existing object for use as the return object. If the value -- is two, then the return object must be allocated on the -- secondary stack. Otherwise, the object must be allocated in - -- a storage pool (currently only supported for the global - -- heap, user-defined storage pools TBD ???). We generate an - -- if statement to test the implicit allocation formal and - -- initialize a local access value appropriately, creating - -- allocators in the secondary stack and global heap cases. - -- The special formal also exists and must be tested when the - -- function has a tagged result, even when the result subtype - -- is constrained, because in general such functions can be - -- called in dispatching contexts and must be handled similarly - -- to functions with a class-wide result. + -- a storage pool. We generate an if statement to test the + -- implicit allocation formal and initialize a local access + -- value appropriately, creating allocators in the secondary + -- stack and global heap cases. The special formal also exists + -- and must be tested when the function has a tagged result, + -- even when the result subtype is constrained, because in + -- general such functions can be called in dispatching contexts + -- and must be handled similarly to functions with a class-wide + -- result. if not Is_Constrained (Ret_Typ) or else Is_Tagged_Type (Underlying_Type (Ret_Typ)) @@ -5145,11 +5146,19 @@ package body Exp_Ch6 is Set_No_Initialization (Heap_Allocator); end if; + -- Set the flag indicating that the allocator came from + -- a build-in-place return statement, so we can avoid + -- adjusting the allocated object. Note that this flag + -- will be inherited by the copies made below. + + Set_Alloc_For_BIP_Return (Heap_Allocator); + -- The Pool_Allocator is just like the Heap_Allocator, -- except we set Storage_Pool and Procedure_To_Call so -- it will use the user-defined storage pool. Pool_Allocator := New_Copy_Tree (Heap_Allocator); + pragma Assert (Alloc_For_BIP_Return (Pool_Allocator)); -- Do not generate the renaming of the build-in-place -- pool parameter on ZFP because the parameter is not @@ -5191,6 +5200,7 @@ package body Exp_Ch6 is else SS_Allocator := New_Copy_Tree (Heap_Allocator); + pragma Assert (Alloc_For_BIP_Return (SS_Allocator)); -- The heap and pool allocators are marked as -- Comes_From_Source since they correspond to an @@ -5298,16 +5308,39 @@ package body Exp_Ch6 is Temp_Typ => Ref_Type, Func_Id => Func_Id, Ret_Typ => Ret_Obj_Typ, - Alloc_Expr => Heap_Allocator)))), + Alloc_Expr => Heap_Allocator))), + + -- ???If all is well, we can put the following + -- 'elsif' in the 'else', but this is a useful + -- self-check in case caller and callee don't agree + -- on whether BIPAlloc and so on should be passed. + + Make_Elsif_Part (Loc, + Condition => + Make_Op_Eq (Loc, + Left_Opnd => + New_Occurrence_Of (Obj_Alloc_Formal, Loc), + Right_Opnd => + Make_Integer_Literal (Loc, + UI_From_Int (BIP_Allocation_Form'Pos + (User_Storage_Pool)))), + + Then_Statements => New_List ( + Pool_Decl, + Build_Heap_Allocator + (Temp_Id => Alloc_Obj_Id, + Temp_Typ => Ref_Type, + Func_Id => Func_Id, + Ret_Typ => Ret_Obj_Typ, + Alloc_Expr => Pool_Allocator)))), + + -- Raise Program_Error if it's none of the above; + -- this is a compiler bug. ???PE_All_Guards_Closed + -- is bogus; we should have a new code. Else_Statements => New_List ( - Pool_Decl, - Build_Heap_Allocator - (Temp_Id => Alloc_Obj_Id, - Temp_Typ => Ref_Type, - Func_Id => Func_Id, - Ret_Typ => Ret_Obj_Typ, - Alloc_Expr => Pool_Allocator))); + Make_Raise_Program_Error (Loc, + Reason => PE_All_Guards_Closed))); -- If a separate initialization assignment was created -- earlier, append that following the assignment of the @@ -6425,8 +6458,8 @@ package body Exp_Ch6 is pragma Assert (Comes_From_Extended_Return_Statement (N) - or else not Is_Build_In_Place_Function_Call (Exp) - or else Is_Build_In_Place_Function (Scope_Id)); + or else not Is_Build_In_Place_Function_Call (Exp) + or else Is_Build_In_Place_Function (Scope_Id)); if not Comes_From_Extended_Return_Statement (N) and then Is_Build_In_Place_Function (Scope_Id) @@ -7205,6 +7238,10 @@ package body Exp_Ch6 is function Is_Build_In_Place_Result_Type (Typ : Entity_Id) return Boolean is begin + if not Expander_Active then + return False; + end if; + -- In Ada 2005 all functions with an inherently limited return type -- must be handled using a build-in-place profile, including the case -- of a function with a limited interface result, where the function @@ -7212,8 +7249,68 @@ package body Exp_Ch6 is if Is_Limited_View (Typ) then return Ada_Version >= Ada_2005 and then not Debug_Flag_Dot_L; + else - return Debug_Flag_Dot_9; + if Debug_Flag_Dot_9 then + return False; + end if; + + if Has_Interfaces (Typ) then + return False; + end if; + + declare + T : Entity_Id := Typ; + begin + -- For T'Class, return True if it's True for T. This is necessary + -- because a class-wide function might say "return F (...)", where + -- F returns the corresponding specific type. We need a loop in + -- case T is a subtype of a class-wide type. + + while Is_Class_Wide_Type (T) loop + T := Etype (T); + end loop; + + -- If this is a generic formal type in an instance, return True if + -- it's True for the generic actual type. + + if Nkind (Parent (T)) = N_Subtype_Declaration + and then Present (Generic_Parent_Type (Parent (T))) + then + T := Entity (Subtype_Indication (Parent (T))); + + if Present (Full_View (T)) then + T := Full_View (T); + end if; + end if; + + if Present (Underlying_Type (T)) then + T := Underlying_Type (T); + end if; + + declare + Result : Boolean; + -- So we can stop here in the debugger + begin + -- ???For now, enable build-in-place for a very narrow set of + -- controlled types. Change "if True" to "if False" to + -- experiment more controlled types. Eventually, we would + -- like to enable build-in-place for all tagged types, all + -- types that need finalization, and all caller-unknown-size + -- types. + + if True then + Result := Is_Controlled (T) + and then Present (Enclosing_Subprogram (T)) + and then not Is_Compilation_Unit (Enclosing_Subprogram (T)) + and then Ekind (Enclosing_Subprogram (T)) = E_Procedure; + else + Result := Is_Controlled (T); + end if; + + return Result; + end; + end; end if; end Is_Build_In_Place_Result_Type; @@ -7301,6 +7398,7 @@ package body Exp_Ch6 is declare Result : constant Boolean := Is_Build_In_Place_Function (Function_Id); + -- So we can stop here in the debugger begin return Result; end; @@ -7688,7 +7786,7 @@ package body Exp_Ch6 is Function_Call : Node_Id) is Acc_Type : constant Entity_Id := Etype (Allocator); - Loc : Source_Ptr; + Loc : constant Source_Ptr := Sloc (Function_Call); Func_Call : Node_Id := Function_Call; Ref_Func_Call : Node_Id; Function_Id : Entity_Id; @@ -7718,8 +7816,6 @@ package body Exp_Ch6 is pragma Assert (not Is_Expanded_Build_In_Place_Call (Func_Call)); Set_Is_Expanded_Build_In_Place_Call (Func_Call); - Loc := Sloc (Function_Call); - if Is_Entity_Name (Name (Func_Call)) then Function_Id := Entity (Name (Func_Call)); @@ -7741,7 +7837,7 @@ package body Exp_Ch6 is Return_Obj_Access := Make_Temporary (Loc, 'R'); Set_Etype (Return_Obj_Access, Acc_Type); Set_Can_Never_Be_Null (Acc_Type, False); - -- It gets initialized to null, so we can't have that. + -- It gets initialized to null, so we can't have that -- When the result subtype is constrained, the return object is -- allocated on the caller side, and access to it is passed to the @@ -7775,10 +7871,17 @@ package body Exp_Ch6 is Rewrite (Allocator, New_Allocator); -- Initial value of the temp is the result of the uninitialized - -- allocator + -- allocator. Unchecked_Convert is needed for T'Input where T is + -- derived from a controlled type. Temp_Init := Relocate_Node (Allocator); + if Nkind_In + (Function_Call, N_Type_Conversion, N_Unchecked_Type_Conversion) + then + Temp_Init := Unchecked_Convert_To (Acc_Type, Temp_Init); + end if; + -- Indicate that caller allocates, and pass in the return object Alloc_Form := Caller_Allocation; @@ -7843,6 +7946,15 @@ package body Exp_Ch6 is Rewrite (Ref_Func_Call, OK_Convert_To (Acc_Type, Ref_Func_Call)); + + -- If the types are incompatible, we need an unchecked conversion. Note + -- that the full types will be compatible, but the types not visibly + -- compatible. + + elsif Nkind_In + (Function_Call, N_Type_Conversion, N_Unchecked_Type_Conversion) + then + Ref_Func_Call := Unchecked_Convert_To (Acc_Type, Ref_Func_Call); end if; declare @@ -7854,7 +7966,8 @@ package body Exp_Ch6 is -- caller-allocates case, this is overwriting the temp with its -- initial value, which has no effect. In the callee-allocates case, -- this is setting the temp to point to the object allocated by the - -- callee. + -- callee. Unchecked_Convert is needed for T'Input where T is derived + -- from a controlled type. Actions : List_Id; -- Actions to be inserted. If there are no tasks, this is just the @@ -7914,7 +8027,7 @@ package body Exp_Ch6 is procedure Make_Build_In_Place_Call_In_Anonymous_Context (Function_Call : Node_Id) is - Loc : Source_Ptr; + Loc : constant Source_Ptr := Sloc (Function_Call); Func_Call : constant Node_Id := Unqual_Conv (Function_Call); Function_Id : Entity_Id; Result_Subt : Entity_Id; @@ -7936,8 +8049,6 @@ package body Exp_Ch6 is Set_Is_Expanded_Build_In_Place_Call (Func_Call); - Loc := Sloc (Function_Call); - if Is_Entity_Name (Name (Func_Call)) then Function_Id := Entity (Name (Func_Call)); @@ -8062,10 +8173,10 @@ package body Exp_Ch6 is (Assign : Node_Id; Function_Call : Node_Id) is - Lhs : constant Node_Id := Name (Assign); - Func_Call : constant Node_Id := Unqual_Conv (Function_Call); - Func_Id : Entity_Id; + Func_Call : constant Node_Id := Unqual_Conv (Function_Call); + Lhs : constant Node_Id := Name (Assign); Loc : constant Source_Ptr := Sloc (Function_Call); + Func_Id : Entity_Id; Obj_Decl : Node_Id; Obj_Id : Entity_Id; Ptr_Typ : Entity_Id; @@ -8139,8 +8250,9 @@ package body Exp_Ch6 is -- Add a conversion if it's the wrong type if Etype (New_Expr) /= Ptr_Typ then - New_Expr := Make_Unchecked_Type_Conversion (Loc, - New_Occurrence_Of (Ptr_Typ, Loc), New_Expr); + New_Expr := + Make_Unchecked_Type_Conversion (Loc, + New_Occurrence_Of (Ptr_Typ, Loc), New_Expr); end if; Obj_Id := Make_Temporary (Loc, 'R', New_Expr); @@ -8165,370 +8277,377 @@ package body Exp_Ch6 is (Obj_Decl : Node_Id; Function_Call : Node_Id) is - Obj_Def_Id : constant Entity_Id := Defining_Identifier (Obj_Decl); - Encl_Func : constant Entity_Id := Enclosing_Subprogram (Obj_Def_Id); - Loc : constant Source_Ptr := Sloc (Function_Call); - Obj_Loc : constant Source_Ptr := Sloc (Obj_Decl); + function Get_Function_Id (Func_Call : Node_Id) return Entity_Id; + -- Get the value of Function_Id, below + + --------------------- + -- Get_Function_Id -- + --------------------- + + function Get_Function_Id (Func_Call : Node_Id) return Entity_Id is + begin + if Is_Entity_Name (Name (Func_Call)) then + return Entity (Name (Func_Call)); + + elsif Nkind (Name (Func_Call)) = N_Explicit_Dereference then + return Etype (Name (Func_Call)); + + else + raise Program_Error; + end if; + end Get_Function_Id; + + -- Local variables + + Func_Call : constant Node_Id := Unqual_Conv (Function_Call); + Function_Id : constant Entity_Id := Get_Function_Id (Func_Call); + Loc : constant Source_Ptr := Sloc (Function_Call); + Obj_Loc : constant Source_Ptr := Sloc (Obj_Decl); + Obj_Def_Id : constant Entity_Id := Defining_Identifier (Obj_Decl); + Obj_Typ : constant Entity_Id := Etype (Obj_Def_Id); + Encl_Func : constant Entity_Id := Enclosing_Subprogram (Obj_Def_Id); + Result_Subt : constant Entity_Id := Etype (Function_Id); Call_Deref : Node_Id; Caller_Object : Node_Id; Def_Id : Entity_Id; + Designated_Type : Entity_Id; Fmaster_Actual : Node_Id := Empty; - Func_Call : constant Node_Id := Unqual_Conv (Function_Call); - Function_Id : Entity_Id; Pool_Actual : Node_Id; - Designated_Type : Entity_Id; Ptr_Typ : Entity_Id; Ptr_Typ_Decl : Node_Id; Pass_Caller_Acc : Boolean := False; Res_Decl : Node_Id; - Result_Subt : Entity_Id; - - begin - -- Mark the call as processed as a build-in-place call - pragma Assert (not Is_Expanded_Build_In_Place_Call (Func_Call)); - Set_Is_Expanded_Build_In_Place_Call (Func_Call); + Definite : constant Boolean := + Caller_Known_Size (Func_Call, Result_Subt) + and then not Is_Class_Wide_Type (Obj_Typ); + -- In the case of "X : T'Class := F(...);", where F returns a + -- Caller_Known_Size (specific) tagged type, we treat it as + -- indefinite, because the code for the Definite case below sets the + -- initialization expression of the object to Empty, which would be + -- illegal Ada, and would cause gigi to misallocate X. - if Is_Entity_Name (Name (Func_Call)) then - Function_Id := Entity (Name (Func_Call)); + -- Start of processing for Make_Build_In_Place_Call_In_Object_Declaration - elsif Nkind (Name (Func_Call)) = N_Explicit_Dereference then - Function_Id := Etype (Name (Func_Call)); + begin + -- If the call has already been processed to add build-in-place actuals + -- then return. - else - raise Program_Error; + if Is_Expanded_Build_In_Place_Call (Func_Call) then + return; end if; - Result_Subt := Etype (Function_Id); - - declare - Definite : constant Boolean := - Caller_Known_Size (Func_Call, Result_Subt); - - begin - -- Create an access type designating the function's result subtype. - -- We use the type of the original call because it may be a call to - -- an inherited operation, which the expansion has replaced with the - -- parent operation that yields the parent type. Note that this - -- access type must be declared before we establish a transient - -- scope, so that it receives the proper accessibility level. - - if Is_Class_Wide_Type (Etype (Defining_Identifier (Obj_Decl))) - and then not Is_Interface (Etype (Defining_Identifier (Obj_Decl))) - and then not Is_Class_Wide_Type (Etype (Function_Call)) - then - Designated_Type := Etype (Defining_Identifier (Obj_Decl)); - else - Designated_Type := Etype (Function_Call); - end if; - - Ptr_Typ := Make_Temporary (Loc, 'A'); - Ptr_Typ_Decl := - Make_Full_Type_Declaration (Loc, - Defining_Identifier => Ptr_Typ, - Type_Definition => - Make_Access_To_Object_Definition (Loc, - All_Present => True, - Subtype_Indication => - New_Occurrence_Of (Designated_Type, Loc))); - - -- The access type and its accompanying object must be inserted after - -- the object declaration in the constrained case, so that the - -- function call can be passed access to the object. In the - -- indefinite case, or if the object declaration is for a return - -- object, the access type and object must be inserted before the - -- object, since the object declaration is rewritten to be a renaming - -- of a dereference of the access object. Note: we need to freeze - -- Ptr_Typ explicitly, because the result object is in a different - -- (transient) scope, so won't cause freezing. - - if Definite - and then not Is_Return_Object (Defining_Identifier (Obj_Decl)) - then - Insert_After_And_Analyze (Obj_Decl, Ptr_Typ_Decl); - else - Insert_Action (Obj_Decl, Ptr_Typ_Decl); - end if; - - -- Force immediate freezing of Ptr_Typ because Res_Decl will be - -- elaborated in an inner (transient) scope and thus won't cause - -- freezing by itself. It's not an itype, but it needs to be frozen - -- inside the current subprogram (see Freeze_Outside in freeze.adb). - - Freeze_Itype (Ptr_Typ, Ptr_Typ_Decl); - - -- If the object is a return object of an enclosing build-in-place - -- function, then the implicit build-in-place parameters of the - -- enclosing function are simply passed along to the called function. - -- (Unfortunately, this won't cover the case of extension aggregates - -- where the ancestor part is a build-in-place indefinite function - -- call that should be passed along the caller's parameters. - -- Currently those get mishandled by reassigning the result of the - -- call to the aggregate return object, when the call result should - -- really be directly built in place in the aggregate and not in a - -- temporary. ???) - - if Is_Return_Object (Defining_Identifier (Obj_Decl)) then - Pass_Caller_Acc := True; + -- Mark the call as processed as a build-in-place call - -- When the enclosing function has a BIP_Alloc_Form formal then we - -- pass it along to the callee (such as when the enclosing - -- function has an unconstrained or tagged result type). + Set_Is_Expanded_Build_In_Place_Call (Func_Call); - if Needs_BIP_Alloc_Form (Encl_Func) then - if RTE_Available (RE_Root_Storage_Pool_Ptr) then - Pool_Actual := - New_Occurrence_Of - (Build_In_Place_Formal - (Encl_Func, BIP_Storage_Pool), Loc); + -- Create an access type designating the function's result subtype. + -- We use the type of the original call because it may be a call to an + -- inherited operation, which the expansion has replaced with the parent + -- operation that yields the parent type. Note that this access type + -- must be declared before we establish a transient scope, so that it + -- receives the proper accessibility level. - -- The build-in-place pool formal is not built on e.g. ZFP + if Is_Class_Wide_Type (Obj_Typ) + and then not Is_Interface (Obj_Typ) + and then not Is_Class_Wide_Type (Etype (Function_Call)) + then + Designated_Type := Obj_Typ; + else + Designated_Type := Etype (Function_Call); + end if; - else - Pool_Actual := Empty; - end if; + Ptr_Typ := Make_Temporary (Loc, 'A'); + Ptr_Typ_Decl := + Make_Full_Type_Declaration (Loc, + Defining_Identifier => Ptr_Typ, + Type_Definition => + Make_Access_To_Object_Definition (Loc, + All_Present => True, + Subtype_Indication => + New_Occurrence_Of (Designated_Type, Loc))); + + -- The access type and its accompanying object must be inserted after + -- the object declaration in the constrained case, so that the function + -- call can be passed access to the object. In the indefinite case, or + -- if the object declaration is for a return object, the access type and + -- object must be inserted before the object, since the object + -- declaration is rewritten to be a renaming of a dereference of the + -- access object. Note: we need to freeze Ptr_Typ explicitly, because + -- the result object is in a different (transient) scope, so won't cause + -- freezing. + + if Definite and then not Is_Return_Object (Obj_Def_Id) then + Insert_After_And_Analyze (Obj_Decl, Ptr_Typ_Decl); + else + Insert_Action (Obj_Decl, Ptr_Typ_Decl); + end if; - Add_Unconstrained_Actuals_To_Build_In_Place_Call - (Function_Call => Func_Call, - Function_Id => Function_Id, - Alloc_Form_Exp => - New_Occurrence_Of - (Build_In_Place_Formal (Encl_Func, BIP_Alloc_Form), Loc), - Pool_Actual => Pool_Actual); + -- Force immediate freezing of Ptr_Typ because Res_Decl will be + -- elaborated in an inner (transient) scope and thus won't cause + -- freezing by itself. It's not an itype, but it needs to be frozen + -- inside the current subprogram (see Freeze_Outside in freeze.adb). + + Freeze_Itype (Ptr_Typ, Ptr_Typ_Decl); + + -- If the object is a return object of an enclosing build-in-place + -- function, then the implicit build-in-place parameters of the + -- enclosing function are simply passed along to the called function. + -- (Unfortunately, this won't cover the case of extension aggregates + -- where the ancestor part is a build-in-place indefinite function + -- call that should be passed along the caller's parameters. + -- Currently those get mishandled by reassigning the result of the + -- call to the aggregate return object, when the call result should + -- really be directly built in place in the aggregate and not in a + -- temporary. ???) + + if Is_Return_Object (Obj_Def_Id) then + Pass_Caller_Acc := True; + + -- When the enclosing function has a BIP_Alloc_Form formal then we + -- pass it along to the callee (such as when the enclosing function + -- has an unconstrained or tagged result type). + + if Needs_BIP_Alloc_Form (Encl_Func) then + if RTE_Available (RE_Root_Storage_Pool_Ptr) then + Pool_Actual := + New_Occurrence_Of + (Build_In_Place_Formal + (Encl_Func, BIP_Storage_Pool), Loc); - -- Otherwise, if enclosing function has a definite result subtype, - -- then caller allocation will be used. + -- The build-in-place pool formal is not built on e.g. ZFP else - Add_Unconstrained_Actuals_To_Build_In_Place_Call - (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); + Pool_Actual := Empty; end if; - if Needs_BIP_Finalization_Master (Encl_Func) then - Fmaster_Actual := + Add_Unconstrained_Actuals_To_Build_In_Place_Call + (Function_Call => Func_Call, + Function_Id => Function_Id, + Alloc_Form_Exp => New_Occurrence_Of - (Build_In_Place_Formal - (Encl_Func, BIP_Finalization_Master), Loc); - end if; + (Build_In_Place_Formal (Encl_Func, BIP_Alloc_Form), Loc), + Pool_Actual => Pool_Actual); - -- Retrieve the BIPacc formal from the enclosing function and - -- convert it to the access type of the callee's BIP_Object_Access - -- formal. + -- Otherwise, if enclosing function has a definite result subtype, + -- then caller allocation will be used. - Caller_Object := - Make_Unchecked_Type_Conversion (Loc, - Subtype_Mark => - New_Occurrence_Of - (Etype - (Build_In_Place_Formal - (Function_Id, BIP_Object_Access)), - Loc), - Expression => - New_Occurrence_Of - (Build_In_Place_Formal (Encl_Func, BIP_Object_Access), - Loc)); + else + Add_Unconstrained_Actuals_To_Build_In_Place_Call + (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); + end if; - -- In the definite case, add an implicit actual to the function call - -- that provides access to the declared object. An unchecked - -- conversion to the (specific) result type of the function is - -- inserted to handle the case where the object is declared with a - -- class-wide type. + if Needs_BIP_Finalization_Master (Encl_Func) then + Fmaster_Actual := + New_Occurrence_Of + (Build_In_Place_Formal + (Encl_Func, BIP_Finalization_Master), Loc); + end if; - elsif Definite then - Caller_Object := - Make_Unchecked_Type_Conversion (Loc, - Subtype_Mark => New_Occurrence_Of (Result_Subt, Loc), - Expression => New_Occurrence_Of (Obj_Def_Id, Loc)); + -- Retrieve the BIPacc formal from the enclosing function and convert + -- it to the access type of the callee's BIP_Object_Access formal. - -- When the function has a controlling result, an allocation-form - -- parameter must be passed indicating that the caller is - -- allocating the result object. This is needed because such a - -- function can be called as a dispatching operation and must be - -- treated similarly to functions with indefinite result subtypes. + Caller_Object := + Make_Unchecked_Type_Conversion (Loc, + Subtype_Mark => + New_Occurrence_Of + (Etype (Build_In_Place_Formal + (Function_Id, BIP_Object_Access)), + Loc), + Expression => + New_Occurrence_Of + (Build_In_Place_Formal (Encl_Func, BIP_Object_Access), + Loc)); - Add_Unconstrained_Actuals_To_Build_In_Place_Call - (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); + -- In the definite case, add an implicit actual to the function call + -- that provides access to the declared object. An unchecked conversion + -- to the (specific) result type of the function is inserted to handle + -- the case where the object is declared with a class-wide type. - -- The allocation for indefinite library-level objects occurs on the - -- heap as opposed to the secondary stack. This accommodates DLLs - -- where the secondary stack is destroyed after each library - -- unload. This is a hybrid mechanism where a stack-allocated object - -- lives on the heap. + elsif Definite then + Caller_Object := + Make_Unchecked_Type_Conversion (Loc, + Subtype_Mark => New_Occurrence_Of (Result_Subt, Loc), + Expression => New_Occurrence_Of (Obj_Def_Id, Loc)); - elsif Is_Library_Level_Entity (Defining_Identifier (Obj_Decl)) - and then not Restriction_Active (No_Implicit_Heap_Allocations) - then - Add_Unconstrained_Actuals_To_Build_In_Place_Call - (Func_Call, Function_Id, Alloc_Form => Global_Heap); - Caller_Object := Empty; + -- When the function has a controlling result, an allocation-form + -- parameter must be passed indicating that the caller is allocating + -- the result object. This is needed because such a function can be + -- called as a dispatching operation and must be treated similarly to + -- functions with indefinite result subtypes. - -- Create a finalization master for the access result type to - -- ensure that the heap allocation can properly chain the object - -- and later finalize it when the library unit goes out of scope. + Add_Unconstrained_Actuals_To_Build_In_Place_Call + (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); - if Needs_Finalization (Etype (Func_Call)) then - Build_Finalization_Master - (Typ => Ptr_Typ, - For_Lib_Level => True, - Insertion_Node => Ptr_Typ_Decl); + -- The allocation for indefinite library-level objects occurs on the + -- heap as opposed to the secondary stack. This accommodates DLLs where + -- the secondary stack is destroyed after each library unload. This is a + -- hybrid mechanism where a stack-allocated object lives on the heap. - Fmaster_Actual := - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Finalization_Master (Ptr_Typ), Loc), - Attribute_Name => Name_Unrestricted_Access); - end if; + elsif Is_Library_Level_Entity (Obj_Def_Id) + and then not Restriction_Active (No_Implicit_Heap_Allocations) + then + Add_Unconstrained_Actuals_To_Build_In_Place_Call + (Func_Call, Function_Id, Alloc_Form => Global_Heap); + Caller_Object := Empty; - -- In other indefinite cases, pass an indication to do the allocation - -- on the secondary stack and set Caller_Object to Empty so that a - -- null value will be passed for the caller's object address. A - -- transient scope is established to ensure eventual cleanup of the - -- result. + -- Create a finalization master for the access result type to ensure + -- that the heap allocation can properly chain the object and later + -- finalize it when the library unit goes out of scope. - else - Add_Unconstrained_Actuals_To_Build_In_Place_Call - (Func_Call, Function_Id, Alloc_Form => Secondary_Stack); - Caller_Object := Empty; + if Needs_Finalization (Etype (Func_Call)) then + Build_Finalization_Master + (Typ => Ptr_Typ, + For_Lib_Level => True, + Insertion_Node => Ptr_Typ_Decl); - Establish_Transient_Scope (Obj_Decl, Sec_Stack => True); + Fmaster_Actual := + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (Finalization_Master (Ptr_Typ), Loc), + Attribute_Name => Name_Unrestricted_Access); end if; - -- Pass along any finalization master actual, which is needed in the - -- case where the called function initializes a return object of an - -- enclosing build-in-place function. + -- In other indefinite cases, pass an indication to do the allocation on + -- the secondary stack and set Caller_Object to Empty so that a null + -- value will be passed for the caller's object address. A transient + -- scope is established to ensure eventual cleanup of the result. - Add_Finalization_Master_Actual_To_Build_In_Place_Call - (Func_Call => Func_Call, - Func_Id => Function_Id, - Master_Exp => Fmaster_Actual); + else + Add_Unconstrained_Actuals_To_Build_In_Place_Call + (Func_Call, Function_Id, Alloc_Form => Secondary_Stack); + Caller_Object := Empty; - if Nkind (Parent (Obj_Decl)) = N_Extended_Return_Statement - and then Has_Task (Result_Subt) - then - -- Here we're passing along the master that was passed in to this - -- function. + Establish_Transient_Scope (Obj_Decl, Sec_Stack => True); + end if; - Add_Task_Actuals_To_Build_In_Place_Call - (Func_Call, Function_Id, - Master_Actual => - New_Occurrence_Of - (Build_In_Place_Formal (Encl_Func, BIP_Task_Master), Loc)); + -- Pass along any finalization master actual, which is needed in the + -- case where the called function initializes a return object of an + -- enclosing build-in-place function. - else - Add_Task_Actuals_To_Build_In_Place_Call - (Func_Call, Function_Id, Make_Identifier (Loc, Name_uMaster)); - end if; + Add_Finalization_Master_Actual_To_Build_In_Place_Call + (Func_Call => Func_Call, + Func_Id => Function_Id, + Master_Exp => Fmaster_Actual); - Add_Access_Actual_To_Build_In_Place_Call - (Func_Call, - Function_Id, - Caller_Object, - Is_Access => Pass_Caller_Acc); + if Nkind (Parent (Obj_Decl)) = N_Extended_Return_Statement + and then Has_Task (Result_Subt) + then + -- Here we're passing along the master that was passed in to this + -- function. - -- Finally, create an access object initialized to a reference to the - -- function call. We know this access value cannot be null, so mark - -- the entity accordingly to suppress the access check. + Add_Task_Actuals_To_Build_In_Place_Call + (Func_Call, Function_Id, + Master_Actual => + New_Occurrence_Of + (Build_In_Place_Formal (Encl_Func, BIP_Task_Master), Loc)); - Def_Id := Make_Temporary (Loc, 'R', Func_Call); - Set_Etype (Def_Id, Ptr_Typ); - Set_Is_Known_Non_Null (Def_Id); + else + Add_Task_Actuals_To_Build_In_Place_Call + (Func_Call, Function_Id, Make_Identifier (Loc, Name_uMaster)); + end if; - if Nkind (Function_Call) = N_Type_Conversion then - Res_Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Def_Id, - Constant_Present => True, - Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc), - Expression => - Make_Unchecked_Type_Conversion (Loc, - New_Occurrence_Of (Ptr_Typ, Loc), - Make_Reference (Loc, Relocate_Node (Func_Call)))); - else - Res_Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Def_Id, - Constant_Present => True, - Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc), - Expression => - Make_Reference (Loc, Relocate_Node (Func_Call))); - end if; + Add_Access_Actual_To_Build_In_Place_Call + (Func_Call, + Function_Id, + Caller_Object, + Is_Access => Pass_Caller_Acc); - Insert_After_And_Analyze (Ptr_Typ_Decl, Res_Decl); + -- Finally, create an access object initialized to a reference to the + -- function call. We know this access value cannot be null, so mark the + -- entity accordingly to suppress the access check. - -- If the result subtype of the called function is definite and is - -- not itself the return expression of an enclosing BIP function, - -- then mark the object as having no initialization. + Def_Id := Make_Temporary (Loc, 'R', Func_Call); + Set_Etype (Def_Id, Ptr_Typ); + Set_Is_Known_Non_Null (Def_Id); - if Definite - and then not Is_Return_Object (Defining_Identifier (Obj_Decl)) - then - -- The related object declaration is encased in a transient block - -- because the build-in-place function call contains at least one - -- nested function call that produces a controlled transient - -- temporary: + if Nkind_In (Function_Call, N_Type_Conversion, + N_Unchecked_Type_Conversion) + then + Res_Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => Def_Id, + Constant_Present => True, + Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc), + Expression => + Make_Unchecked_Type_Conversion (Loc, + New_Occurrence_Of (Ptr_Typ, Loc), + Make_Reference (Loc, Relocate_Node (Func_Call)))); + else + Res_Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => Def_Id, + Constant_Present => True, + Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc), + Expression => + Make_Reference (Loc, Relocate_Node (Func_Call))); + end if; - -- Obj : ... := BIP_Func_Call (Ctrl_Func_Call); + Insert_After_And_Analyze (Ptr_Typ_Decl, Res_Decl); - -- Since the build-in-place expansion decouples the call from the - -- object declaration, the finalization machinery lacks the - -- context which prompted the generation of the transient - -- block. To resolve this scenario, store the build-in-place call. + -- If the result subtype of the called function is definite and is not + -- itself the return expression of an enclosing BIP function, then mark + -- the object as having no initialization. - if Scope_Is_Transient and then Node_To_Be_Wrapped = Obj_Decl then - Set_BIP_Initialization_Call (Obj_Def_Id, Res_Decl); - end if; + if Definite and then not Is_Return_Object (Obj_Def_Id) then - Set_Expression (Obj_Decl, Empty); - Set_No_Initialization (Obj_Decl); + -- The related object declaration is encased in a transient block + -- because the build-in-place function call contains at least one + -- nested function call that produces a controlled transient + -- temporary: - -- In case of an indefinite result subtype, or if the call is the - -- return expression of an enclosing BIP function, rewrite the object - -- declaration as an object renaming where the renamed object is a - -- dereference of 'reference: - -- - -- Obj : Subt renames 'Ref.all; + -- Obj : ... := BIP_Func_Call (Ctrl_Func_Call); - else - Call_Deref := - Make_Explicit_Dereference (Obj_Loc, - Prefix => New_Occurrence_Of (Def_Id, Obj_Loc)); - - Rewrite (Obj_Decl, - Make_Object_Renaming_Declaration (Obj_Loc, - Defining_Identifier => Make_Temporary (Obj_Loc, 'D'), - Subtype_Mark => - New_Occurrence_Of (Designated_Type, Obj_Loc), - Name => Call_Deref)); - - Set_Renamed_Object (Defining_Identifier (Obj_Decl), Call_Deref); - - -- If the original entity comes from source, then mark the new - -- entity as needing debug information, even though it's defined - -- by a generated renaming that does not come from source, so that - -- the Materialize_Entity flag will be set on the entity when - -- Debug_Renaming_Declaration is called during analysis. - - if Comes_From_Source (Obj_Def_Id) then - Set_Debug_Info_Needed (Defining_Identifier (Obj_Decl)); - end if; + -- Since the build-in-place expansion decouples the call from the + -- object declaration, the finalization machinery lacks the context + -- which prompted the generation of the transient block. To resolve + -- this scenario, store the build-in-place call. - Analyze (Obj_Decl); - Replace_Renaming_Declaration_Id - (Obj_Decl, Original_Node (Obj_Decl)); + if Scope_Is_Transient and then Node_To_Be_Wrapped = Obj_Decl then + Set_BIP_Initialization_Call (Obj_Def_Id, Res_Decl); end if; - end; - -- If the object entity has a class-wide Etype, then we need to change - -- it to the result subtype of the function call, because otherwise the - -- object will be class-wide without an explicit initialization and - -- won't be allocated properly by the back end. It seems unclean to make - -- such a revision to the type at this point, and we should try to - -- improve this treatment when build-in-place functions with class-wide - -- results are implemented. ??? + Set_Expression (Obj_Decl, Empty); + Set_No_Initialization (Obj_Decl); - if Is_Class_Wide_Type (Etype (Defining_Identifier (Obj_Decl))) then - Set_Etype (Defining_Identifier (Obj_Decl), Result_Subt); + -- In case of an indefinite result subtype, or if the call is the + -- return expression of an enclosing BIP function, rewrite the object + -- declaration as an object renaming where the renamed object is a + -- dereference of 'reference: + -- + -- Obj : Subt renames 'Ref.all; + + else + Call_Deref := + Make_Explicit_Dereference (Obj_Loc, + Prefix => New_Occurrence_Of (Def_Id, Obj_Loc)); + + Rewrite (Obj_Decl, + Make_Object_Renaming_Declaration (Obj_Loc, + Defining_Identifier => Make_Temporary (Obj_Loc, 'D'), + Subtype_Mark => + New_Occurrence_Of (Designated_Type, Obj_Loc), + Name => Call_Deref)); + + -- At this point, Defining_Identifier (Obj_Decl) is no longer equal + -- to Obj_Def_Id. + + Set_Renamed_Object (Defining_Identifier (Obj_Decl), Call_Deref); + + -- If the original entity comes from source, then mark the new + -- entity as needing debug information, even though it's defined + -- by a generated renaming that does not come from source, so that + -- the Materialize_Entity flag will be set on the entity when + -- Debug_Renaming_Declaration is called during analysis. + + if Comes_From_Source (Obj_Def_Id) then + Set_Debug_Info_Needed (Defining_Identifier (Obj_Decl)); + end if; + + Analyze (Obj_Decl); + Replace_Renaming_Declaration_Id + (Obj_Decl, Original_Node (Obj_Decl)); end if; end Make_Build_In_Place_Call_In_Object_Declaration; @@ -9216,7 +9335,7 @@ package body Exp_Ch6 is then On_Object_Declaration := True; return - Unqual_BIP_Function_Call (Expression (Parent (Entity (Expr)))); + Unqual_BIP_Function_Call (Expression (Parent (Entity (Expr)))); -- Recurse to handle calls to displace the pointer to the object to -- reference a secondary dispatch table. @@ -9249,7 +9368,9 @@ package body Exp_Ch6 is begin if Nkind (Expr) = N_Identifier and then No (Entity (Expr)) then - -- Can happen for X'Elab_Spec in the binder-generated file. + + -- Can happen for X'Elab_Spec in the binder-generated file + return Empty; end if; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 07fd33ce465b3..713ba58b72b5d 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -1955,7 +1955,7 @@ package body Exp_Ch7 is Insert_After (Finalizer_Insert_Nod, Fin_Body); end if; - Analyze (Fin_Body); + Analyze (Fin_Body, Suppress => All_Checks); end if; end Create_Finalizer; @@ -2605,8 +2605,8 @@ package body Exp_Ch7 is -- procedures of types Init_Typ or Obj_Typ. function Next_Suitable_Statement (Stmt : Node_Id) return Node_Id; - -- Given a statement which is part of a list, return the next - -- statement while skipping over dynamic elab checks. + -- Obtain the next statement which follows list member Stmt while + -- ignoring artifacts related to access-before-elaboration checks. ----------------------------- -- Find_Last_Init_In_Block -- @@ -2725,16 +2725,22 @@ package body Exp_Ch7 is ----------------------------- function Next_Suitable_Statement (Stmt : Node_Id) return Node_Id is - Result : Node_Id := Next (Stmt); + Result : Node_Id; begin - -- Skip over access-before-elaboration checks + -- Skip call markers and Program_Error raises installed by the + -- ABE mechanism. + + Result := Next (Stmt); + while Present (Result) loop + if not Nkind_In (Result, N_Call_Marker, + N_Raise_Program_Error) + then + exit; + end if; - if Dynamic_Elaboration_Checks - and then Nkind (Result) = N_Raise_Program_Error - then Result := Next (Result); - end if; + end loop; return Result; end Next_Suitable_Statement; @@ -4463,7 +4469,7 @@ package body Exp_Ch7 is -- This is done only for non-generic packages if Ekind (Spec_Id) = E_Package then - Push_Scope (Corresponding_Spec (N)); + Push_Scope (Spec_Id); -- Build dispatch tables of library level tagged types @@ -4475,18 +4481,15 @@ package body Exp_Ch7 is Build_Task_Activation_Call (N); - -- When the package is subject to pragma Initial_Condition, the - -- assertion expression must be verified at the end of the body - -- statements. + -- Verify the run-time semantics of pragma Initial_Condition at the + -- end of the body statements. - if Present (Get_Pragma (Spec_Id, Pragma_Initial_Condition)) then - Expand_Pragma_Initial_Condition (N); - end if; + Expand_Pragma_Initial_Condition (Spec_Id, N); Pop_Scope; end if; - Set_Elaboration_Flag (N, Corresponding_Spec (N)); + Set_Elaboration_Flag (N, Spec_Id); Set_In_Package_Body (Spec_Id, False); -- Set to encode entity names in package body before gigi is called @@ -4601,14 +4604,10 @@ package body Exp_Ch7 is Build_Task_Activation_Call (N); end if; - -- When the package is subject to pragma Initial_Condition and lacks - -- a body, the assertion expression must be verified at the end of - -- the visible declarations. Otherwise the check is performed at the - -- end of the body statements (see Expand_N_Package_Body). + -- Verify the run-time semantics of pragma Initial_Condition at the + -- end of the private declarations when the package lacks a body. - if Present (Get_Pragma (Id, Pragma_Initial_Condition)) then - Expand_Pragma_Initial_Condition (N); - end if; + Expand_Pragma_Initial_Condition (Id, N); Pop_Scope; end if; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 37399adf98b94..063b812f9bcd0 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -52,7 +52,6 @@ with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; with Sem_Ch9; use Sem_Ch9; with Sem_Ch11; use Sem_Ch11; -with Sem_Elab; use Sem_Elab; with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; @@ -340,6 +339,14 @@ package body Exp_Ch9 is -- same parameter names and the same resolved types, but with new entities -- for the formals. + function Create_Secondary_Stack_For_Task (T : Node_Id) return Boolean; + -- Return whether a secondary stack for the task T should be created by the + -- expander. The secondary stack for a task will be created by the expander + -- if the size of the stack has been specified by the Secondary_Stack_Size + -- representation aspect and either the No_Implicit_Heap_Allocations or + -- No_Implicit_Task_Allocations restrictions are in effect and the + -- No_Secondary_Stack restriction is not. + procedure Debug_Private_Data_Declarations (Decls : List_Id); -- Decls is a list which may contain the declarations created by Install_ -- Private_Data_Declarations. All generated entities are marked as needing @@ -3841,6 +3848,12 @@ package body Exp_Ch9 is Set_Original_Protected_Subprogram (New_Id, Def_Id); end if; + -- Link the protected or unprotected version to the original subprogram + -- it emulates. + + Set_Ekind (New_Id, Ekind (Def_Id)); + Set_Protected_Subprogram (New_Id, Def_Id); + -- The unprotected operation carries the user code, and debugging -- information must be generated for it, even though this spec does -- not come from source. It is also convenient to allow gdb to step @@ -4751,11 +4764,39 @@ package body Exp_Ch9 is -------------------------------- procedure Build_Task_Activation_Call (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); + function Activation_Call_Loc return Source_Ptr; + -- Find a suitable source location for the activation call + + ------------------------- + -- Activation_Call_Loc -- + ------------------------- + + function Activation_Call_Loc return Source_Ptr is + begin + -- The activation call must carry the location of the "end" keyword + -- when the context is a package declaration. + + if Nkind (N) = N_Package_Declaration then + return End_Keyword_Location (N); + + -- Otherwise the activation call must carry the location of the + -- "begin" keyword. + + else + return Begin_Keyword_Location (N); + end if; + end Activation_Call_Loc; + + -- Local variables + Chain : Entity_Id; Call : Node_Id; + Loc : Source_Ptr; Name : Node_Id; - P : Node_Id; + Owner : Node_Id; + Stmt : Node_Id; + + -- Start of processing for Build_Task_Activation_Call begin -- For sequential elaboration policy, all the tasks will be activated at @@ -4763,105 +4804,107 @@ package body Exp_Ch9 is if Partition_Elaboration_Policy = 'S' then return; - end if; - -- Get the activation chain entity. Except in the case of a package - -- body, this is in the node that was passed. For a package body, we - -- have to find the corresponding package declaration node. + -- Do not create an activation call for a package spec if the package + -- has a completing body. The activation call will be inserted after + -- the "begin" of the body. - if Nkind (N) = N_Package_Body then - P := Corresponding_Spec (N); - loop - P := Parent (P); - exit when Nkind (P) = N_Package_Declaration; - end loop; + elsif Nkind (N) = N_Package_Declaration + and then Present (Corresponding_Body (N)) + then + return; + end if; - Chain := Activation_Chain_Entity (P); + -- Obtain the activation chain entity. Block statements, entry bodies, + -- subprogram bodies, and task bodies keep the entity in their nodes. + -- Package bodies on the other hand store it in the declaration of the + -- corresponding package spec. - else - Chain := Activation_Chain_Entity (N); + Owner := N; + + if Nkind (Owner) = N_Package_Body then + Owner := Unit_Declaration_Node (Corresponding_Spec (Owner)); end if; - if Present (Chain) then - if Restricted_Profile then - Name := New_Occurrence_Of - (RTE (RE_Activate_Restricted_Tasks), Loc); - else - Name := New_Occurrence_Of - (RTE (RE_Activate_Tasks), Loc); - end if; + Chain := Activation_Chain_Entity (Owner); - Call := - Make_Procedure_Call_Statement (Loc, - Name => Name, - Parameter_Associations => - New_List (Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Chain, Loc), - Attribute_Name => Name_Unchecked_Access))); + -- Nothing to do when there are no tasks to activate. This is indicated + -- by a missing activation chain entity. - if Nkind (N) = N_Package_Declaration then - if Present (Corresponding_Body (N)) then - null; + if No (Chain) then + return; + end if; - elsif Present (Private_Declarations (Specification (N))) then - Append (Call, Private_Declarations (Specification (N))); + -- The location of the activation call must be as close as possible to + -- the intended semantic location of the activation because the ABE + -- mechanism relies heavily on accurate locations. - else - Append (Call, Visible_Declarations (Specification (N))); - end if; + Loc := Activation_Call_Loc; - else - if Present (Handled_Statement_Sequence (N)) then + if Restricted_Profile then + Name := New_Occurrence_Of (RTE (RE_Activate_Restricted_Tasks), Loc); + else + Name := New_Occurrence_Of (RTE (RE_Activate_Tasks), Loc); + end if; - -- The call goes at the start of the statement sequence after - -- the start of exception range label if one is present. + Call := + Make_Procedure_Call_Statement (Loc, + Name => Name, + Parameter_Associations => + New_List (Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Chain, Loc), + Attribute_Name => Name_Unchecked_Access))); - declare - Stm : Node_Id; + if Nkind (N) = N_Package_Declaration then + if Present (Private_Declarations (Specification (N))) then + Append (Call, Private_Declarations (Specification (N))); + else + Append (Call, Visible_Declarations (Specification (N))); + end if; - begin - Stm := First (Statements (Handled_Statement_Sequence (N))); + else + -- The call goes at the start of the statement sequence after the + -- start of exception range label if one is present. - -- A special case, skip exception range label if one is - -- present (from front end zcx processing). + if Present (Handled_Statement_Sequence (N)) then + Stmt := First (Statements (Handled_Statement_Sequence (N))); - if Nkind (Stm) = N_Label and then Exception_Junk (Stm) then - Next (Stm); - end if; + -- A special case, skip exception range label if one is present + -- (from front end zcx processing). - -- Another special case, if the first statement is a block - -- from optimization of a local raise to a goto, then the - -- call goes inside this block. + if Nkind (Stmt) = N_Label and then Exception_Junk (Stmt) then + Next (Stmt); + end if; - if Nkind (Stm) = N_Block_Statement - and then Exception_Junk (Stm) - then - Stm := - First (Statements (Handled_Statement_Sequence (Stm))); - end if; + -- Another special case, if the first statement is a block from + -- optimization of a local raise to a goto, then the call goes + -- inside this block. - -- Insertion point is after any exception label pushes, - -- since we want it covered by any local handlers. + if Nkind (Stmt) = N_Block_Statement + and then Exception_Junk (Stmt) + then + Stmt := First (Statements (Handled_Statement_Sequence (Stmt))); + end if; - while Nkind (Stm) in N_Push_xxx_Label loop - Next (Stm); - end loop; + -- Insertion point is after any exception label pushes, since we + -- want it covered by any local handlers. - -- Now we have the proper insertion point + while Nkind (Stmt) in N_Push_xxx_Label loop + Next (Stmt); + end loop; - Insert_Before (Stm, Call); - end; + -- Now we have the proper insertion point - else - Set_Handled_Statement_Sequence (N, - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Call))); - end if; - end if; + Insert_Before (Stmt, Call); - Analyze (Call); - Check_Task_Activation (N); + else + Set_Handled_Statement_Sequence (N, + Make_Handled_Sequence_Of_Statements (Loc, + Statements => New_List (Call))); + end if; end if; + + Analyze (Call); end Build_Task_Activation_Call; ------------------------------- @@ -5379,6 +5422,20 @@ package body Exp_Ch9 is end if; end Convert_Concurrent; + ------------------------------------- + -- Create_Secondary_Stack_For_Task -- + ------------------------------------- + + function Create_Secondary_Stack_For_Task (T : Node_Id) return Boolean is + begin + return + (Restriction_Active (No_Implicit_Heap_Allocations) + or else Restriction_Active (No_Implicit_Task_Allocations)) + and then not Restriction_Active (No_Secondary_Stack) + and then Has_Rep_Item + (T, Name_Secondary_Stack_Size, Check_Parents => False); + end Create_Secondary_Stack_For_Task; + ------------------------------------- -- Debug_Private_Data_Declarations -- ------------------------------------- @@ -6006,6 +6063,7 @@ package body Exp_Ch9 is -- reference will have been rewritten. if Expander_Active then + -- The expanded name may have been constant folded in which case -- the original node is not necessarily an entity name (e.g. an -- indexed component). @@ -10527,6 +10585,11 @@ package body Exp_Ch9 is Make_Defining_Identifier (Eloc, New_External_Name (Chars (Ename), 'A', Num_Accept)); + -- Link the acceptor to the original receiving entry + + Set_Ekind (PB_Ent, E_Procedure); + Set_Receiving_Entry (PB_Ent, Eent); + if Comes_From_Source (Alt) then Set_Debug_Info_Needed (PB_Ent); end if; @@ -11671,6 +11734,7 @@ package body Exp_Ch9 is Body_Decl : Node_Id; Cdecls : List_Id; Decl_Stack : Node_Id; + Decl_SS : Node_Id; Elab_Decl : Node_Id; Ent_Stack : Entity_Id; Proc_Spec : Node_Id; @@ -11898,6 +11962,57 @@ package body Exp_Ch9 is end if; + -- Declare a static secondary stack if the conditions for a statically + -- generated stack are met. + + if Create_Secondary_Stack_For_Task (TaskId) then + declare + Ritem : Node_Id; + Size_Expr : Node_Id; + + begin + -- First extract the secondary stack size from the task type's + -- representation aspect. + + Ritem := + Get_Rep_Item + (TaskId, Name_Secondary_Stack_Size, Check_Parents => False); + + -- Get Secondary_Stack_Size expression. Can be a pragma or aspect. + + if Nkind (Ritem) = N_Pragma then + Size_Expr := + Expression + (First (Pragma_Argument_Associations (Ritem))); + else + Size_Expr := Expression (Ritem); + end if; + + pragma Assert (Compile_Time_Known_Value (Size_Expr)); + + -- Create the secondary stack for the task + + Decl_SS := + Make_Component_Declaration (Loc, + Defining_Identifier => + Make_Defining_Identifier (Loc, Name_uSecondary_Stack), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => True, + Subtype_Indication => + Make_Subtype_Indication (Loc, + Subtype_Mark => + New_Occurrence_Of (RTE (RE_SS_Stack), Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, + Constraints => New_List ( + Make_Integer_Literal (Loc, + Expr_Value (Size_Expr))))))); + + Append_To (Cdecls, Decl_SS); + end; + end if; + -- Add components for entry families Collect_Entry_Families (Loc, Cdecls, Size_Decl, Tasktyp); @@ -12794,11 +12909,14 @@ package body Exp_Ch9 is end if; -- If the type of the dispatching object is an access type then return - -- an explicit dereference. + -- an explicit dereference of a copy of the object, and note that + -- this is the controlling actual of the call. if Is_Access_Type (Etype (Object)) then - Object := Make_Explicit_Dereference (Sloc (N), Object); + Object := + Make_Explicit_Dereference (Sloc (N), New_Copy_Tree (Object)); Analyze (Object); + Set_Is_Controlling_Actual (Object); end if; end Extract_Dispatching_Call; @@ -14095,11 +14213,33 @@ package body Exp_Ch9 is New_Occurrence_Of (Storage_Size_Variable (Ttyp), Loc)); end if; - -- Secondary_Stack_Size parameter. Set Default_Secondary_Stack_Size - -- unless there is a Secondary_Stack_Size rep item, in which case we - -- take the value from the rep item. If the restriction - -- No_Secondary_Stack is active then a size of 0 is passed regardless - -- to prevent the allocation of the unused stack. + -- Secondary_Stack parameter used for restricted profiles + + if Restricted_Profile then + + -- If the secondary stack has been allocated by the expander then + -- pass its access pointer. Otherwise, pass null. + + if Create_Secondary_Stack_For_Task (Ttyp) then + Append_To (Args, + Make_Attribute_Reference (Loc, + Prefix => + Make_Selected_Component (Loc, + Prefix => Make_Identifier (Loc, Name_uInit), + Selector_Name => + Make_Identifier (Loc, Name_uSecondary_Stack)), + Attribute_Name => Name_Unrestricted_Access)); + + else + Append_To (Args, Make_Null (Loc)); + end if; + end if; + + -- Secondary_Stack_Size parameter. Set RE_Unspecified_Size unless there + -- is a Secondary_Stack_Size rep item, in which case take the value from + -- the rep item. If the restriction No_Secondary_Stack is active then a + -- size of 0 is passed regardless to prevent the allocation of the + -- unused stack. if Restriction_Active (No_Secondary_Stack) then Append_To (Args, Make_Integer_Literal (Loc, 0)); @@ -14424,6 +14564,12 @@ package body Exp_Ch9 is Object_Definition => New_Occurrence_Of (Etype (Formal), Loc))); + -- The object is initialized with an explicit assignment + -- later. Indicate that it does not need an initialization + -- to prevent spurious warnings if the type excludes null. + + Set_No_Initialization (Last (Decls)); + if Ekind (Formal) /= E_Out_Parameter then -- Generate: @@ -14440,15 +14586,22 @@ package body Exp_Ch9 is Expression => New_Copy_Tree (Actual))); end if; - -- Generate: + -- If the actual is not controlling, generate: + -- Jnn'unchecked_access - Append_To (Params, - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Unchecked_Access, - Prefix => New_Occurrence_Of (Temp_Nam, Loc))); + -- and add it to aggegate for access to formals. Note that + -- the actual may be by-copy but still be a controlling actual + -- if it is an access to class-wide interface. + + if not Is_Controlling_Actual (Actual) then + Append_To (Params, + Make_Attribute_Reference (Loc, + Attribute_Name => Name_Unchecked_Access, + Prefix => New_Occurrence_Of (Temp_Nam, Loc))); - Has_Param := True; + Has_Param := True; + end if; -- The controlling parameter is omitted diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 97ac138e8982d..f3728f655d4da 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -29,6 +29,7 @@ with Debug; use Debug; with Einfo; use Einfo; with Elists; use Elists; with Errout; use Errout; +with Expander; use Expander; with Exp_Atag; use Exp_Atag; with Exp_Ch6; use Exp_Ch6; with Exp_CG; use Exp_CG; @@ -299,6 +300,32 @@ package body Exp_Disp is and then not Is_CPP_Class (Root_Typ); end Building_Static_DT; + ---------------------------------- + -- Building_Static_Secondary_DT -- + ---------------------------------- + + function Building_Static_Secondary_DT (Typ : Entity_Id) return Boolean is + Full_Typ : Entity_Id := Typ; + Root_Typ : Entity_Id := Root_Type (Typ); + + begin + -- Handle private types + + if Present (Full_View (Typ)) then + Full_Typ := Full_View (Typ); + end if; + + if Present (Full_View (Root_Typ)) then + Root_Typ := Full_View (Root_Typ); + end if; + + return Building_Static_DT (Full_Typ) + and then not Is_Interface (Full_Typ) + and then Has_Interfaces (Full_Typ) + and then (Full_Typ = Root_Typ + or else not Is_Variable_Size_Record (Etype (Full_Typ))); + end Building_Static_Secondary_DT; + ---------------------------------- -- Build_Static_Dispatch_Tables -- ---------------------------------- @@ -709,6 +736,18 @@ package body Exp_Disp is if Is_Class_Wide_Type (Etype (F)) then Set_Etype (N, Etype (F)); + + -- Conversely, if this is a controlling argument + -- (in a dispatching call in the condition) that is a + -- dereference, the source is an access-to-class-wide + -- type, so preserve the dispatching nature of the + -- call in the rewritten condition. + + elsif Nkind (Parent (N)) = N_Explicit_Dereference + and then Is_Controlling_Actual (Parent (N)) + then + Set_Controlling_Argument (Parent (Parent (N)), + Parent (N)); end if; exit; @@ -1693,11 +1732,10 @@ package body Exp_Disp is if From_Limited_With (Actual_Typ) then - -- If the type of the actual parameter comes from a - -- limited with-clause and the non-limited view is already - -- available, we replace the anonymous access type by - -- a duplicate declaration whose designated type is the - -- non-limited view. + -- If the type of the actual parameter comes from a limited + -- with_clause and the nonlimited view is already available, + -- we replace the anonymous access type by a duplicate + -- declaration whose designated type is the nonlimited view. if Has_Non_Limited_View (Actual_DDT) then Anon := New_Copy (Actual_Typ); @@ -3755,6 +3793,11 @@ package body Exp_Disp is DT_Aggr : constant Elist_Id := New_Elmt_List; -- Entities marked with attribute Is_Dispatch_Table_Entity + Dummy_Object : Entity_Id := Empty; + -- Extra nonexistent object of type Typ internally used to compute the + -- offset to the components that reference secondary dispatch tables. + -- Used to statically allocate secondary dispatch tables. + procedure Check_Premature_Freezing (Subp : Entity_Id; Tagged_Type : Entity_Id; @@ -3783,6 +3826,7 @@ package body Exp_Disp is procedure Make_Secondary_DT (Typ : Entity_Id; Iface : Entity_Id; + Iface_Comp : Node_Id; Suffix_Index : Int; Num_Iface_Prims : Nat; Iface_DT_Ptr : Entity_Id; @@ -3941,6 +3985,7 @@ package body Exp_Disp is procedure Make_Secondary_DT (Typ : Entity_Id; Iface : Entity_Id; + Iface_Comp : Node_Id; Suffix_Index : Int; Num_Iface_Prims : Nat; Iface_DT_Ptr : Entity_Id; @@ -4179,10 +4224,25 @@ package body Exp_Disp is Prefix => New_Occurrence_Of (Predef_Prims, Loc), Attribute_Name => Name_Address)); - -- Note: The correct value of Offset_To_Top will be set by the init - -- subprogram + -- If the location of the component that references this secondary + -- dispatch table is variable then we have not declared the internal + -- dummy object; the value of Offset_To_Top will be set by the init + -- subprogram. - Append_To (DT_Aggr_List, Make_Integer_Literal (Loc, 0)); + if No (Dummy_Object) then + Append_To (DT_Aggr_List, Make_Integer_Literal (Loc, 0)); + + else + Append_To (DT_Aggr_List, + Make_Attribute_Reference (Loc, + Prefix => + Make_Selected_Component (Loc, + Prefix => + New_Occurrence_Of (Dummy_Object, Loc), + Selector_Name => + New_Occurrence_Of (Iface_Comp, Loc)), + Attribute_Name => Name_Position)); + end if; -- Generate the Object Specific Data table required to dispatch calls -- through synchronized interfaces. @@ -4407,15 +4467,16 @@ package body Exp_Disp is Append_Elmt (New_Node, DT_Aggr); - -- Note: Secondary dispatch tables cannot be declared constant - -- because the component Offset_To_Top is currently initialized - -- by the IP routine. + -- Note: Secondary dispatch tables are declared constant only if + -- we can compute their offset field by means of the extra dummy + -- object; otherwise they cannot be declared constant and the + -- Offset_To_Top component is initialized by the IP routine. Append_To (Result, Make_Object_Declaration (Loc, Defining_Identifier => Iface_DT, Aliased_Present => True, - Constant_Present => False, + Constant_Present => Present (Dummy_Object), Object_Definition => Make_Subtype_Indication (Loc, @@ -4678,6 +4739,94 @@ package body Exp_Disp is end; end if; + if Building_Static_Secondary_DT (Typ) then + declare + Cannot_Have_Null_Disc : Boolean := False; + Name_Dummy_Object : constant Name_Id := + New_External_Name (Tname, + 'P', Suffix_Index => -1); + begin + Dummy_Object := Make_Defining_Identifier (Loc, Name_Dummy_Object); + + -- Define the extra object imported and constant to avoid linker + -- errors (since this object is never declared). Required because + -- we implement RM 13.3(19) for exported and imported (variable) + -- objects by making them volatile. + + Set_Is_Imported (Dummy_Object); + Set_Ekind (Dummy_Object, E_Constant); + Set_Is_True_Constant (Dummy_Object); + Set_Related_Type (Dummy_Object, Typ); + + -- The scope must be set now to call Get_External_Name + + Set_Scope (Dummy_Object, Current_Scope); + + Get_External_Name (Dummy_Object); + Set_Interface_Name (Dummy_Object, + Make_String_Literal (Loc, Strval => String_From_Name_Buffer)); + + -- Ensure proper Sprint output of this implicit importation + + Set_Is_Internal (Dummy_Object); + + if not Has_Discriminants (Typ) then + Append_To (Result, + Make_Object_Declaration (Loc, + Defining_Identifier => Dummy_Object, + Constant_Present => True, + Object_Definition => New_Occurrence_Of (Typ, Loc))); + else + declare + Constr_List : constant List_Id := New_List; + Discrim : Node_Id; + + begin + Discrim := First_Discriminant (Typ); + while Present (Discrim) loop + if Is_Discrete_Type (Etype (Discrim)) then + Append_To (Constr_List, + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (Etype (Discrim), Loc), + Attribute_Name => Name_First)); + + else + pragma Assert (Is_Access_Type (Etype (Discrim))); + Cannot_Have_Null_Disc := + Cannot_Have_Null_Disc + or else Can_Never_Be_Null (Etype (Discrim)); + Append_To (Constr_List, Make_Null (Loc)); + end if; + + Next_Discriminant (Discrim); + end loop; + + Append_To (Result, + Make_Object_Declaration (Loc, + Defining_Identifier => Dummy_Object, + Constant_Present => True, + Object_Definition => + Make_Subtype_Indication (Loc, + Subtype_Mark => New_Occurrence_Of (Typ, Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, + Constraints => Constr_List)))); + end; + end if; + + -- Given that the dummy object will not be declared at run time, + -- analyze its declaration with expansion disabled and warnings + -- and error messages ignored. + + Expander_Mode_Save_And_Set (False); + Ignore_Errors_Enable := Ignore_Errors_Enable + 1; + Analyze (Last (Result), Suppress => All_Checks); + Ignore_Errors_Enable := Ignore_Errors_Enable - 1; + Expander_Mode_Restore; + end; + end if; + -- Ada 2005 (AI-251): Build the secondary dispatch tables if Has_Interfaces (Typ) then @@ -4702,11 +4851,12 @@ package body Exp_Disp is Make_Secondary_DT (Typ => Typ, - Iface => Base_Type - (Related_Type (Node (AI_Tag_Comp))), + Iface => + Base_Type (Related_Type (Node (AI_Tag_Comp))), + Iface_Comp => Node (AI_Tag_Comp), Suffix_Index => Suffix_Index, - Num_Iface_Prims => UI_To_Int - (DT_Entry_Count (Node (AI_Tag_Comp))), + Num_Iface_Prims => + UI_To_Int (DT_Entry_Count (Node (AI_Tag_Comp))), Iface_DT_Ptr => Node (AI_Tag_Elmt), Predef_Prims_Ptr => Node (Next_Elmt (AI_Tag_Elmt)), Build_Thunks => True, @@ -4731,6 +4881,7 @@ package body Exp_Disp is (Typ => Typ, Iface => Base_Type (Related_Type (Node (AI_Tag_Comp))), + Iface_Comp => Node (AI_Tag_Comp), Suffix_Index => -1, Num_Iface_Prims => UI_To_Int (DT_Entry_Count (Node (AI_Tag_Comp))), diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads index cfd4b7821c9ce..cba4cac4145f5 100644 --- a/gcc/ada/exp_disp.ads +++ b/gcc/ada/exp_disp.ads @@ -174,6 +174,11 @@ package Exp_Disp is pragma Inline (Building_Static_DT); -- Returns true when building statically allocated dispatch tables + function Building_Static_Secondary_DT (Typ : Entity_Id) return Boolean; + pragma Inline (Building_Static_Secondary_DT); + -- Returns true when building statically allocated secondary dispatch + -- tables + procedure Build_Static_Dispatch_Tables (N : Node_Id); -- N is a library level package declaration or package body. Build the -- static dispatch table of the tagged types defined at library level. In diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 57f60cd90ebc2..dfed6af66a731 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -42,6 +42,7 @@ with Restrict; use Restrict; with Rident; use Rident; with Rtsfind; use Rtsfind; with Sem; use Sem; +with Sem_Aux; use Sem_Aux; with Sem_Ch8; use Sem_Ch8; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; @@ -1447,82 +1448,287 @@ package body Exp_Prag is -- Expand_Pragma_Initial_Condition -- ------------------------------------- - procedure Expand_Pragma_Initial_Condition (Spec_Or_Body : Node_Id) is - Loc : constant Source_Ptr := Sloc (Spec_Or_Body); + procedure Expand_Pragma_Initial_Condition + (Pack_Id : Entity_Id; + N : Node_Id) + is + procedure Extract_Package_Body_Lists + (Pack_Body : Node_Id; + Body_List : out List_Id; + Call_List : out List_Id; + Spec_List : out List_Id); + -- Obtain the various declarative and statement lists of package body + -- Pack_Body needed to insert the initial condition procedure and the + -- call to it. The lists are as follows: + -- + -- * Body_List - used to insert the initial condition procedure body + -- + -- * Call_List - used to insert the call to the initial condition + -- procedure. + -- + -- * Spec_List - used to insert the initial condition procedure spec + + procedure Extract_Package_Declaration_Lists + (Pack_Decl : Node_Id; + Body_List : out List_Id; + Call_List : out List_Id; + Spec_List : out List_Id); + -- Obtain the various declarative lists of package declaration Pack_Decl + -- needed to insert the initial condition procedure and the call to it. + -- The lists are as follows: + -- + -- * Body_List - used to insert the initial condition procedure body + -- + -- * Call_List - used to insert the call to the initial condition + -- procedure. + -- + -- * Spec_List - used to insert the initial condition procedure spec + + -------------------------------- + -- Extract_Package_Body_Lists -- + -------------------------------- + + procedure Extract_Package_Body_Lists + (Pack_Body : Node_Id; + Body_List : out List_Id; + Call_List : out List_Id; + Spec_List : out List_Id) + is + Pack_Spec : constant Entity_Id := Corresponding_Spec (Pack_Body); - Check : Node_Id; - Expr : Node_Id; - Init_Cond : Node_Id; - List : List_Id; - Pack_Id : Entity_Id; + Dummy_1 : List_Id; + Dummy_2 : List_Id; + HSS : Node_Id; - begin - if Nkind (Spec_Or_Body) = N_Package_Body then - Pack_Id := Corresponding_Spec (Spec_Or_Body); + begin + pragma Assert (Present (Pack_Spec)); - if Present (Handled_Statement_Sequence (Spec_Or_Body)) then - List := Statements (Handled_Statement_Sequence (Spec_Or_Body)); + -- The different parts of the invariant procedure are inserted as + -- follows: - -- The package body lacks statements, create an empty list + -- package Pack is package body Pack is + -- + -- private begin + -- ... + -- end Pack; end Pack; - else - List := New_List; + -- The initial condition procedure spec is inserted in the visible + -- declaration of the corresponding package spec. + + Extract_Package_Declaration_Lists + (Pack_Decl => Unit_Declaration_Node (Pack_Spec), + Body_List => Dummy_1, + Call_List => Dummy_2, + Spec_List => Spec_List); + + -- The initial condition procedure body is added to the declarations + -- of the package body. + + Body_List := Declarations (Pack_Body); - Set_Handled_Statement_Sequence (Spec_Or_Body, - Make_Handled_Sequence_Of_Statements (Loc, Statements => List)); + if No (Body_List) then + Body_List := New_List; + Set_Declarations (Pack_Body, Body_List); end if; - elsif Nkind (Spec_Or_Body) = N_Package_Declaration then - Pack_Id := Defining_Entity (Spec_Or_Body); + -- The call to the initial condition procedure is inserted in the + -- statements of the package body. - if Present (Visible_Declarations (Specification (Spec_Or_Body))) then - List := Visible_Declarations (Specification (Spec_Or_Body)); + HSS := Handled_Statement_Sequence (Pack_Body); - -- The package lacks visible declarations, create an empty list + if No (HSS) then + HSS := + Make_Handled_Sequence_Of_Statements (Sloc (Pack_Body), + Statements => New_List); + Set_Handled_Statement_Sequence (Pack_Body, HSS); + end if; - else - List := New_List; + Call_List := Statements (HSS); + end Extract_Package_Body_Lists; + + --------------------------------------- + -- Extract_Package_Declaration_Lists -- + --------------------------------------- + + procedure Extract_Package_Declaration_Lists + (Pack_Decl : Node_Id; + Body_List : out List_Id; + Call_List : out List_Id; + Spec_List : out List_Id) + is + Pack_Spec : constant Node_Id := Specification (Pack_Decl); + + begin + -- The different parts of the invariant procedure are inserted as + -- follows: - Set_Visible_Declarations (Specification (Spec_Or_Body), List); + -- package Pack is + -- + -- + -- private + -- + -- end Pack; + + -- The initial condition procedure spec and body are inserted in the + -- visible declarations of the package spec. + + Body_List := Visible_Declarations (Pack_Spec); + + if No (Body_List) then + Body_List := New_List; + Set_Visible_Declarations (Pack_Spec, Body_List); + end if; + + Spec_List := Body_List; + + -- The call to the initial procedure is inserted in the private + -- declarations of the package spec. + + Call_List := Private_Declarations (Pack_Spec); + + if No (Call_List) then + Call_List := New_List; + Set_Private_Declarations (Pack_Spec, Call_List); end if; + end Extract_Package_Declaration_Lists; + + -- Local variables + + IC_Prag : constant Node_Id := + Get_Pragma (Pack_Id, Pragma_Initial_Condition); + + Body_List : List_Id; + Call : Node_Id; + Call_List : List_Id; + Call_Loc : Source_Ptr; + Expr : Node_Id; + Loc : Source_Ptr; + Proc_Body : Node_Id; + Proc_Body_Id : Entity_Id; + Proc_Decl : Node_Id; + Proc_Id : Entity_Id; + Spec_List : List_Id; + + -- Start of processing for Expand_Pragma_Initial_Condition + + begin + -- Nothing to do when the package is not subject to an Initial_Condition + -- pragma. + + if No (IC_Prag) then + return; + end if; + + Expr := Get_Pragma_Arg (First (Pragma_Argument_Associations (IC_Prag))); + Loc := Sloc (IC_Prag); + + -- Nothing to do when the pragma or its argument are illegal because + -- there is no valid expression to check. + + if Error_Posted (IC_Prag) or else Error_Posted (Expr) then + return; + end if; + + -- Obtain the various lists of the context where the individual pieces + -- of the initial condition procedure are to be inserted. + + if Nkind (N) = N_Package_Body then + Extract_Package_Body_Lists + (Pack_Body => N, + Body_List => Body_List, + Call_List => Call_List, + Spec_List => Spec_List); + + elsif Nkind (N) = N_Package_Declaration then + Extract_Package_Declaration_Lists + (Pack_Decl => N, + Body_List => Body_List, + Call_List => Call_List, + Spec_List => Spec_List); -- This routine should not be used on anything other than packages else - raise Program_Error; + pragma Assert (False); + return; end if; - Init_Cond := Get_Pragma (Pack_Id, Pragma_Initial_Condition); + Proc_Id := + Make_Defining_Identifier (Loc, + Chars => New_External_Name (Chars (Pack_Id), "Initial_Condition")); - -- The caller should check whether the package is subject to pragma - -- Initial_Condition. + Set_Ekind (Proc_Id, E_Procedure); + Set_Is_Initial_Condition_Procedure (Proc_Id); - pragma Assert (Present (Init_Cond)); + -- Generate: + -- procedure Initial_Condition; - Expr := - Get_Pragma_Arg (First (Pragma_Argument_Associations (Init_Cond))); + Proc_Decl := + Make_Subprogram_Declaration (Loc, + Make_Procedure_Specification (Loc, + Defining_Unit_Name => Proc_Id)); - -- The assertion expression was found to be illegal, do not generate the - -- runtime check as it will repeat the illegality. + Append_To (Spec_List, Proc_Decl); - if Error_Posted (Init_Cond) or else Error_Posted (Expr) then - return; + -- The initial condition procedure requires debug info when initial + -- condition is subject to Source Coverage Obligations. + + if Generate_SCO then + Set_Needs_Debug_Info (Proc_Id); end if; -- Generate: - -- pragma Check (Initial_Condition, ); + -- procedure Initial_Condition is + -- begin + -- pragma Check (Initial_Condition, ); + -- end Initial_Condition; + + Proc_Body := + Make_Subprogram_Body (Loc, + Specification => + Copy_Subprogram_Spec (Specification (Proc_Decl)), + Declarations => Empty_List, + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => New_List ( + Make_Pragma (Loc, + Chars => Name_Check, + Pragma_Argument_Associations => New_List ( + Make_Pragma_Argument_Association (Loc, + Expression => + Make_Identifier (Loc, Name_Initial_Condition)), + Make_Pragma_Argument_Association (Loc, + Expression => New_Copy_Tree (Expr))))))); - Check := - Make_Pragma (Loc, - Chars => Name_Check, - Pragma_Argument_Associations => New_List ( - Make_Pragma_Argument_Association (Loc, - Expression => Make_Identifier (Loc, Name_Initial_Condition)), - Make_Pragma_Argument_Association (Loc, - Expression => New_Copy_Tree (Expr)))); + Append_To (Body_List, Proc_Body); + + -- The initial condition procedure requires debug info when initial + -- condition is subject to Source Coverage Obligations. + + Proc_Body_Id := Defining_Entity (Proc_Body); + + if Generate_SCO then + Set_Needs_Debug_Info (Proc_Body_Id); + end if; + + -- The location of the initial condition procedure call must be as close + -- as possible to the intended semantic location of the check because + -- the ABE mechanism relies heavily on accurate locations. + + Call_Loc := End_Keyword_Location (N); + + -- Generate: + -- Initial_Condition; + + Call := + Make_Procedure_Call_Statement (Call_Loc, + Name => New_Occurrence_Of (Proc_Id, Call_Loc)); + + Append_To (Call_List, Call); - Append_To (List, Check); - Analyze (Check); + Analyze (Proc_Decl); + Analyze (Proc_Body); + Analyze (Call); end Expand_Pragma_Initial_Condition; ------------------------------------ diff --git a/gcc/ada/exp_prag.ads b/gcc/ada/exp_prag.ads index 48d1c2f6b5462..9e5f042c1810b 100644 --- a/gcc/ada/exp_prag.ads +++ b/gcc/ada/exp_prag.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -42,15 +42,11 @@ package Exp_Prag is -- Subp_Id's body. All generated code is added to list Stmts. If Stmts is -- No_List on entry, a new list is created. - procedure Expand_Pragma_Initial_Condition (Spec_Or_Body : Node_Id); - -- Generate a runtime check needed to verify the assumption of introduced - -- by pragma Initial_Condition. Spec_Or_Body denotes the spec or body of - -- the package where the pragma appears. The check is inserted according - -- to the following precedence rules: - -- 1) If the package has a body with a statement sequence, the check is - -- inserted at the end of the statments. - -- 2) If the package has a body, the check is inserted at the end of the - -- body declarations. - -- 3) The check is inserted at the end of the visible declarations. + procedure Expand_Pragma_Initial_Condition + (Pack_Id : Entity_Id; + N : Node_Id); + -- Verify the run-time semantics of pragma Initial_Condition when it + -- applies to package Pack_Id. N denotes the related package spec or + -- body. end Exp_Prag; diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb index 811033e9d5bb9..5386fa6578b1d 100644 --- a/gcc/ada/exp_spark.adb +++ b/gcc/ada/exp_spark.adb @@ -55,22 +55,25 @@ package body Exp_SPARK is -- Replace occurrences of System'To_Address by calls to -- System.Storage_Elements.To_Address - procedure Expand_SPARK_Freeze_Type (E : Entity_Id); + procedure Expand_SPARK_N_Freeze_Type (E : Entity_Id); -- Build the DIC procedure of a type when needed, if not already done - procedure Expand_SPARK_Indexed_Component (N : Node_Id); + procedure Expand_SPARK_N_Indexed_Component (N : Node_Id); -- Insert explicit dereference if required + procedure Expand_SPARK_N_Loop_Statement (N : Node_Id); + -- Perform loop statement-specific expansion + procedure Expand_SPARK_N_Object_Declaration (N : Node_Id); -- Perform object-declaration-specific expansion procedure Expand_SPARK_N_Object_Renaming_Declaration (N : Node_Id); -- Perform name evaluation for a renamed object - procedure Expand_SPARK_Op_Ne (N : Node_Id); + procedure Expand_SPARK_N_Op_Ne (N : Node_Id); -- Rewrite operator /= based on operator = when defined explicitly - procedure Expand_SPARK_Selected_Component (N : Node_Id); + procedure Expand_SPARK_N_Selected_Component (N : Node_Id); -- Insert explicit dereference if required ------------------ @@ -118,17 +121,7 @@ package body Exp_SPARK is -- dealt with specially in GNATprove. when N_Loop_Statement => - declare - Scheme : constant Node_Id := Iteration_Scheme (N); - begin - if Present (Scheme) - and then Present (Iterator_Specification (Scheme)) - and then - Is_Iterator_Over_Array (Iterator_Specification (Scheme)) - then - Expand_Iterator_Loop_Over_Array (N); - end if; - end; + Expand_SPARK_N_Loop_Statement (N); when N_Object_Declaration => Expand_SPARK_N_Object_Declaration (N); @@ -137,18 +130,18 @@ package body Exp_SPARK is Expand_SPARK_N_Object_Renaming_Declaration (N); when N_Op_Ne => - Expand_SPARK_Op_Ne (N); + Expand_SPARK_N_Op_Ne (N); when N_Freeze_Entity => if Is_Type (Entity (N)) then - Expand_SPARK_Freeze_Type (Entity (N)); + Expand_SPARK_N_Freeze_Type (Entity (N)); end if; when N_Indexed_Component => - Expand_SPARK_Indexed_Component (N); + Expand_SPARK_N_Indexed_Component (N); when N_Selected_Component => - Expand_SPARK_Selected_Component (N); + Expand_SPARK_N_Selected_Component (N); -- In SPARK mode, no other constructs require expansion @@ -157,6 +150,21 @@ package body Exp_SPARK is end case; end Expand_SPARK; + -------------------------------- + -- Expand_SPARK_N_Freeze_Type -- + -------------------------------- + + procedure Expand_SPARK_N_Freeze_Type (E : Entity_Id) is + begin + -- When a DIC is inherited by a tagged type, it may need to be + -- specialized to the descendant type, hence build a separate DIC + -- procedure for it as done during regular expansion for compilation. + + if Has_DIC (E) and then Is_Tagged_Type (E) then + Build_DIC_Procedure_Body (E, For_Freeze => True); + end if; + end Expand_SPARK_N_Freeze_Type; + ---------------------------------------- -- Expand_SPARK_N_Attribute_Reference -- ---------------------------------------- @@ -261,43 +269,54 @@ package body Exp_SPARK is end if; end Expand_SPARK_N_Attribute_Reference; - ------------------------------ - -- Expand_SPARK_Freeze_Type -- - ------------------------------ + ----------------------------------- + -- Expand_SPARK_N_Loop_Statement -- + ----------------------------------- - procedure Expand_SPARK_Freeze_Type (E : Entity_Id) is - begin - -- When a DIC is inherited by a tagged type, it may need to be - -- specialized to the descendant type, hence build a separate DIC - -- procedure for it as done during regular expansion for compilation. + procedure Expand_SPARK_N_Loop_Statement (N : Node_Id) is + Scheme : constant Node_Id := Iteration_Scheme (N); - if Has_DIC (E) and then Is_Tagged_Type (E) then - Build_DIC_Procedure_Body (E, For_Freeze => True); + begin + -- Loop iterations over arrays need to be expanded, to avoid getting + -- two names referring to the same object in memory (the array and the + -- iterator) in GNATprove, especially since both can be written (thus + -- possibly leading to interferences due to aliasing). No such problem + -- arises with quantified expressions over arrays, which are dealt with + -- specially in GNATprove. + + if Present (Scheme) + and then Present (Iterator_Specification (Scheme)) + and then Is_Iterator_Over_Array (Iterator_Specification (Scheme)) + then + Expand_Iterator_Loop_Over_Array (N); end if; - end Expand_SPARK_Freeze_Type; + end Expand_SPARK_N_Loop_Statement; - ------------------------------------ - -- Expand_SPARK_Indexed_Component -- - ------------------------------------ + -------------------------------------- + -- Expand_SPARK_N_Indexed_Component -- + -------------------------------------- + + procedure Expand_SPARK_N_Indexed_Component (N : Node_Id) is + Pref : constant Node_Id := Prefix (N); + Typ : constant Entity_Id := Etype (Pref); - procedure Expand_SPARK_Indexed_Component (N : Node_Id) is - P : constant Node_Id := Prefix (N); - T : constant Entity_Id := Etype (P); begin - if Is_Access_Type (T) then - Insert_Explicit_Dereference (P); - Analyze_And_Resolve (P, Designated_Type (T)); + if Is_Access_Type (Typ) then + Insert_Explicit_Dereference (Pref); + Analyze_And_Resolve (Pref, Designated_Type (Typ)); end if; - end Expand_SPARK_Indexed_Component; + end Expand_SPARK_N_Indexed_Component; --------------------------------------- -- Expand_SPARK_N_Object_Declaration -- --------------------------------------- procedure Expand_SPARK_N_Object_Declaration (N : Node_Id) is - Def_Id : constant Entity_Id := Defining_Identifier (N); Loc : constant Source_Ptr := Sloc (N); - Typ : constant Entity_Id := Etype (Def_Id); + Obj_Id : constant Entity_Id := Defining_Identifier (N); + Typ : constant Entity_Id := Etype (Obj_Id); + + Call : Node_Id; begin -- If the object declaration denotes a variable without initialization @@ -305,12 +324,19 @@ package body Exp_SPARK is -- and analyze a dummy call to the DIC procedure of the type in order -- to detect potential elaboration issues. - if Comes_From_Source (Def_Id) + if Comes_From_Source (Obj_Id) + and then Ekind (Obj_Id) = E_Variable and then Has_DIC (Typ) and then Present (DIC_Procedure (Typ)) and then not Has_Init_Expression (N) then - Analyze (Build_DIC_Call (Loc, Def_Id, Typ)); + Call := Build_DIC_Call (Loc, Obj_Id, Typ); + + -- Partially insert the call into the tree by setting its parent + -- pointer. + + Set_Parent (Call, N); + Analyze (Call); end if; end Expand_SPARK_N_Object_Declaration; @@ -370,11 +396,11 @@ package body Exp_SPARK is end if; end Expand_SPARK_N_Object_Renaming_Declaration; - ------------------------ - -- Expand_SPARK_Op_Ne -- - ------------------------ + -------------------------- + -- Expand_SPARK_N_Op_Ne -- + -------------------------- - procedure Expand_SPARK_Op_Ne (N : Node_Id) is + procedure Expand_SPARK_N_Op_Ne (N : Node_Id) is Typ : constant Entity_Id := Etype (Left_Opnd (N)); begin @@ -388,7 +414,7 @@ package body Exp_SPARK is else Exp_Ch4.Expand_N_Op_Ne (N); end if; - end Expand_SPARK_Op_Ne; + end Expand_SPARK_N_Op_Ne; ------------------------------------- -- Expand_SPARK_Potential_Renaming -- @@ -471,31 +497,31 @@ package body Exp_SPARK is end if; end Expand_SPARK_Potential_Renaming; - ------------------------------------- - -- Expand_SPARK_Selected_Component -- - ------------------------------------- + --------------------------------------- + -- Expand_SPARK_N_Selected_Component -- + --------------------------------------- + + procedure Expand_SPARK_N_Selected_Component (N : Node_Id) is + Pref : constant Node_Id := Prefix (N); + Typ : constant Entity_Id := Underlying_Type (Etype (Pref)); - procedure Expand_SPARK_Selected_Component (N : Node_Id) is - P : constant Node_Id := Prefix (N); - Ptyp : constant Entity_Id := Underlying_Type (Etype (P)); begin - if Present (Ptyp) - and then Is_Access_Type (Ptyp) - then + if Present (Typ) and then Is_Access_Type (Typ) then + -- First set prefix type to proper access type, in case it currently -- has a private (non-access) view of this type. - Set_Etype (P, Ptyp); + Set_Etype (Pref, Typ); - Insert_Explicit_Dereference (P); - Analyze_And_Resolve (P, Designated_Type (Ptyp)); + Insert_Explicit_Dereference (Pref); + Analyze_And_Resolve (Pref, Designated_Type (Typ)); - if Ekind (Etype (P)) = E_Private_Subtype - and then Is_For_Access_Subtype (Etype (P)) + if Ekind (Etype (Pref)) = E_Private_Subtype + and then Is_For_Access_Subtype (Etype (Pref)) then - Set_Etype (P, Base_Type (Etype (P))); + Set_Etype (Pref, Base_Type (Etype (Pref))); end if; end if; - end Expand_SPARK_Selected_Component; + end Expand_SPARK_N_Selected_Component; end Exp_SPARK; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 1d64a3add3453..8fdd8aa82006d 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -52,6 +52,7 @@ with Sem_Ch8; use Sem_Ch8; with Sem_Ch12; use Sem_Ch12; with Sem_Ch13; use Sem_Ch13; with Sem_Disp; use Sem_Disp; +with Sem_Elab; use Sem_Elab; with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Type; use Sem_Type; @@ -650,9 +651,8 @@ package body Exp_Util is -- stack. elsif Is_RTE (Pool_Id, RE_SS_Pool) - or else - (Nkind (Expr) = N_Allocator - and then Is_RTE (Storage_Pool (Expr), RE_SS_Pool)) + or else (Nkind (Expr) = N_Allocator + and then Is_RTE (Storage_Pool (Expr), RE_SS_Pool)) then return; @@ -1763,9 +1763,12 @@ package body Exp_Util is -- Perform minor decoration in case the body is not analyzed - Set_Ekind (Proc_Body_Id, E_Subprogram_Body); - Set_Etype (Proc_Body_Id, Standard_Void_Type); - Set_Scope (Proc_Body_Id, Current_Scope); + Set_Ekind (Proc_Body_Id, E_Subprogram_Body); + Set_Etype (Proc_Body_Id, Standard_Void_Type); + Set_Scope (Proc_Body_Id, Current_Scope); + Set_SPARK_Pragma (Proc_Body_Id, SPARK_Pragma (Proc_Id)); + Set_SPARK_Pragma_Inherited + (Proc_Body_Id, SPARK_Pragma_Inherited (Proc_Id)); -- Link both spec and body to avoid generating duplicates @@ -1905,17 +1908,19 @@ package body Exp_Util is -- Perform minor decoration in case the declaration is not analyzed - Set_Ekind (Proc_Id, E_Procedure); - Set_Etype (Proc_Id, Standard_Void_Type); - Set_Scope (Proc_Id, Current_Scope); + Set_Ekind (Proc_Id, E_Procedure); + Set_Etype (Proc_Id, Standard_Void_Type); + Set_Is_DIC_Procedure (Proc_Id); + Set_Scope (Proc_Id, Current_Scope); + Set_SPARK_Pragma (Proc_Id, SPARK_Mode_Pragma); + Set_SPARK_Pragma_Inherited (Proc_Id); - Set_Is_DIC_Procedure (Proc_Id); Set_DIC_Procedure (Work_Typ, Proc_Id); -- The DIC procedure requires debug info when the assertion expression -- is subject to Source Coverage Obligations. - if Opt.Generate_SCO then + if Generate_SCO then Set_Needs_Debug_Info (Proc_Id); end if; @@ -3387,7 +3392,7 @@ package body Exp_Util is -- The invariant procedure requires debug info when the invariants are -- subject to Source Coverage Obligations. - if Opt.Generate_SCO then + if Generate_SCO then Set_Needs_Debug_Info (Proc_Id); end if; @@ -7232,7 +7237,7 @@ package body Exp_Util is null; end if; - -- Another special case, an attribute denoting a procedure call + -- Special case: an attribute denoting a procedure call when N_Attribute_Reference => if Is_Procedure_Attribute_Name (Attribute_Name (P)) then @@ -7250,6 +7255,14 @@ package body Exp_Util is null; end if; + -- Special case: a call marker + + when N_Call_Marker => + if Is_List_Member (P) then + Insert_List_Before_And_Analyze (P, Ins_Actions); + return; + end if; + -- A contract node should not belong to the tree when N_Contract => @@ -8834,6 +8847,11 @@ package body Exp_Util is if Present (N) then Remove_Warning_Messages (N); + -- Update the internal structures of the ABE mechanism in case the + -- dead node is an elaboration scenario. + + Kill_Elaboration_Scenario (N); + -- Generate warning if appropriate if W then @@ -9190,43 +9208,42 @@ package body Exp_Util is Lo : constant Node_Id := New_Copy_Tree (String_Literal_Low_Bound (Literal_Typ)); Index : constant Entity_Id := Etype (Lo); - - Hi : Node_Id; Length_Expr : constant Node_Id := Make_Op_Subtract (Loc, - Left_Opnd => + Left_Opnd => Make_Integer_Literal (Loc, Intval => String_Literal_Length (Literal_Typ)), - Right_Opnd => - Make_Integer_Literal (Loc, 1)); + Right_Opnd => Make_Integer_Literal (Loc, 1)); + + Hi : Node_Id; begin Set_Analyzed (Lo, False); - if Is_Integer_Type (Index) then - Hi := - Make_Op_Add (Loc, - Left_Opnd => New_Copy_Tree (Lo), - Right_Opnd => Length_Expr); - else - Hi := - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Val, - Prefix => New_Occurrence_Of (Index, Loc), - Expressions => New_List ( - Make_Op_Add (Loc, - Left_Opnd => - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Pos, - Prefix => New_Occurrence_Of (Index, Loc), - Expressions => New_List (New_Copy_Tree (Lo))), - Right_Opnd => Length_Expr))); - end if; + if Is_Integer_Type (Index) then + Hi := + Make_Op_Add (Loc, + Left_Opnd => New_Copy_Tree (Lo), + Right_Opnd => Length_Expr); + else + Hi := + Make_Attribute_Reference (Loc, + Attribute_Name => Name_Val, + Prefix => New_Occurrence_Of (Index, Loc), + Expressions => New_List ( + Make_Op_Add (Loc, + Left_Opnd => + Make_Attribute_Reference (Loc, + Attribute_Name => Name_Pos, + Prefix => New_Occurrence_Of (Index, Loc), + Expressions => New_List (New_Copy_Tree (Lo))), + Right_Opnd => Length_Expr))); + end if; - return - Make_Range (Loc, - Low_Bound => Lo, - High_Bound => Hi); + return + Make_Range (Loc, + Low_Bound => Lo, + High_Bound => Hi); end Make_Literal_Range; -------------------------- @@ -9287,10 +9304,22 @@ package body Exp_Util is -- Case of calling normal predicate function - Call := - Make_Function_Call (Loc, - Name => New_Occurrence_Of (Func_Id, Loc), - Parameter_Associations => New_List (Relocate_Node (Expr))); + -- If the type is tagged, the expression may be class-wide, in which + -- case it has to be converted to its root type, given that the + -- generated predicate function is not dispatching. + + if Is_Tagged_Type (Typ) then + Call := + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Func_Id, Loc), + Parameter_Associations => + New_List (Convert_To (Typ, Relocate_Node (Expr)))); + else + Call := + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Func_Id, Loc), + Parameter_Associations => New_List (Relocate_Node (Expr))); + end if; Restore_Ghost_Mode (Saved_GM); @@ -10788,8 +10817,17 @@ package body Exp_Util is Analyze (Block); end if; - when others => + -- Could be e.g. a loop that was transformed into a block or null + -- statement. Do nothing for terminate alternatives. + + when N_Block_Statement + | N_Null_Statement + | N_Terminate_Alternative + => null; + + when others => + raise Program_Error; end case; end Process_Statements_For_Controlled_Objects; @@ -10940,7 +10978,8 @@ package body Exp_Util is Related_Nod : Node_Id := Empty) return Entity_Id; -- Create an external symbol of the form xxx_FIRST/_LAST if Related_Nod -- is present (xxx is taken from the Chars field of Related_Nod), - -- otherwise it generates an internal temporary. + -- otherwise it generates an internal temporary. The created temporary + -- entity is marked as internal. --------------------- -- Build_Temporary -- @@ -10951,6 +10990,7 @@ package body Exp_Util is Id : Character; Related_Nod : Node_Id := Empty) return Entity_Id is + Temp_Id : Entity_Id; Temp_Nam : Name_Id; begin @@ -10963,13 +11003,17 @@ package body Exp_Util is Temp_Nam := New_External_Name (Chars (Related_Id), "_LAST"); end if; - return Make_Defining_Identifier (Loc, Temp_Nam); + Temp_Id := Make_Defining_Identifier (Loc, Temp_Nam); -- Otherwise generate an internal temporary else - return Make_Temporary (Loc, Id, Related_Nod); + Temp_Id := Make_Temporary (Loc, Id, Related_Nod); end if; + + Set_Is_Internal (Temp_Id); + + return Temp_Id; end Build_Temporary; -- Local variables @@ -11220,7 +11264,7 @@ package body Exp_Util is -- Exp_Ch2.Expand_Renaming). Otherwise the temporary must be -- elaborated by gigi, and is of course not to be replaced in-line -- by the expression it renames, which would defeat the purpose of - -- removing the side-effect. + -- removing the side effect. if Nkind_In (Exp, N_Selected_Component, N_Indexed_Component) and then Has_Non_Standard_Rep (Etype (Prefix (Exp))) @@ -12621,7 +12665,7 @@ package body Exp_Util is and then Variable_Ref then -- Exception is a prefix that is the result of a previous removal - -- of side-effects. + -- of side effects. return Is_Entity_Name (Prefix (N)) and then not Comes_From_Source (Prefix (N)) diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 99500584dd88b..3fab6dd7b6958 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -856,11 +856,8 @@ package Exp_Util is -- False means that it is not known if the value is positive or negative. function Make_Invariant_Call (Expr : Node_Id) return Node_Id; - -- Expr is an object of a type which Has_Invariants set (and which thus - -- also has an Invariant_Procedure set). If invariants are enabled, this - -- function returns a call to the Invariant procedure passing Expr as the - -- argument, and returns it unanalyzed. If invariants are not enabled, - -- returns a null statement. + -- Generate a call to the Invariant_Procedure associated with the type of + -- expression Expr. Expr is passed as an actual parameter in the call. function Make_Predicate_Call (Typ : Entity_Id; diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index 513cfa97daa18..6b6d524bcd7fd 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -109,10 +109,12 @@ extern Nat Serious_Errors_Detected; #define Get_Local_Raise_Call_Entity exp_ch11__get_local_raise_call_entity #define Get_RT_Exception_Entity exp_ch11__get_rt_exception_entity #define Get_RT_Exception_Name exp_ch11__get_rt_exception_name +#define Warn_If_No_Local_Raise exp_ch11__warn_if_no_local_raise extern Entity_Id Get_Local_Raise_Call_Entity (void); extern Entity_Id Get_RT_Exception_Entity (int); extern void Get_RT_Exception_Name (int); +extern void Warn_If_No_Local_Raise (int); /* exp_code: */ diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb index 4345dfa800537..2b95dc7be7d30 100644 --- a/gcc/ada/fmap.adb +++ b/gcc/ada/fmap.adb @@ -306,6 +306,7 @@ package body Fmap is else Write_Str ("warning: no read access for mapping file """); end if; + Write_Str (File_Name); Write_Line (""""); No_Mapping_File := True; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 794fdf3d09555..a106d68ae8627 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -8450,7 +8450,7 @@ package body Freeze is -- The analysis of the expression may generate insert actions, -- which of course must not be executed. We wrap those actions -- in a procedure that is not called, and later on eliminated. - -- The following cases have no side-effects, and are analyzed + -- The following cases have no side effects, and are analyzed -- directly. if Nkind (Dcopy) = N_Identifier diff --git a/gcc/ada/freeze.ads b/gcc/ada/freeze.ads index 079d7132abe9b..6ec74b466a6e3 100644 --- a/gcc/ada/freeze.ads +++ b/gcc/ada/freeze.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -114,15 +114,15 @@ package Freeze is -- Are always frozen at the point of declaration - -- The flag Has_Delayed_Freeze is used for to indicate that delayed - -- freezing is required. Usually the associated freeze node is allocated - -- at the freezing point. One special exception occurs with anonymous - -- base types, where the freeze node is preallocated at the point of - -- declaration, so that the First_Subtype_Link field can be set. + -- The flag Has_Delayed_Freeze is used to indicate that delayed freezing + -- is required. Usually the associated freeze node is allocated at the + -- freezing point. One special exception occurs with anonymous base types, + -- where the freeze node is preallocated at the point of declaration, so + -- that the First_Subtype_Link field can be set. Freezing_Library_Level_Tagged_Type : Boolean := False; -- Flag used to indicate that we are freezing the primitives of a library - -- level tagged types. Used to disable checks on premature freezing. + -- level tagged type. Used to disable checks on premature freezing. -- More documentation needed??? why is this flag needed? what are these -- checks? why do they need disabling in some cases? diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index bb28eae1192e0..828f6ff2999db 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -87,6 +87,7 @@ begin Checks.Initialize; Sem_Warn.Initialize; Prep.Initialize; + Sem_Elab.Initialize; if Generate_SCIL then SCIL_LL.Initialize; @@ -168,6 +169,7 @@ begin -- Case of gnat.adc file present if Source_gnat_adc > No_Source_File then + -- Parse the gnat.adc file for configuration pragmas Initialize_Scanner (No_Unit, Source_gnat_adc); @@ -422,8 +424,9 @@ begin Instantiate_Bodies; end if; - -- Analyze inlined bodies and check elaboration rules in GNATprove - -- mode as well as during compilation. + -- Analyze all inlined bodies, check access-before-elaboration + -- rules, and remove ignored Ghost code when generating code or + -- compiling for GNATprove. if Operating_Mode = Generate_Code or else GNATprove_Mode then if Inline_Processing_Required then @@ -437,12 +440,24 @@ begin Collect_Garbage_Entities; end if; - Check_Elab_Calls; + -- Examine all top level scenarios collected during analysis + -- and resolution. Diagnose conditional and guaranteed ABEs, + -- install run-time checks to catch ABEs, and guarantee the + -- prior elaboration of external units. + + Check_Elaboration_Scenarios; -- Remove any ignored Ghost code as it must not appear in the -- executable. Remove_Ignored_Ghost_Code; + + -- Otherwise check the access-before-elaboration rules even when + -- previous errors were detected or the compilation is verifying + -- semantics. + + else + Check_Elaboration_Scenarios; end if; -- At this stage we can unnest subprogram bodies if required diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 113c84f390bd9..9c7b6e1496fa3 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -390,6 +390,7 @@ GNAT_ADA_OBJS = \ ada/libgnat/s-restri.o \ ada/libgnat/s-secsta.o \ ada/libgnat/s-soflin.o \ + ada/libgnat/s-soliin.o \ ada/libgnat/s-sopco3.o \ ada/libgnat/s-sopco4.o \ ada/libgnat/s-sopco5.o \ @@ -579,6 +580,7 @@ GNATBIND_OBJS = \ ada/libgnat/s-restri.o \ ada/libgnat/s-secsta.o \ ada/libgnat/s-soflin.o \ + ada/libgnat/s-soliin.o \ ada/libgnat/s-sopco3.o \ ada/libgnat/s-sopco4.o \ ada/libgnat/s-sopco5.o \ diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index e6cd8d6ba50eb..e0d7a5f55685a 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -8070,7 +8070,7 @@ annotate_value (tree gnu_size) can appear for discriminants in expressions for variants. */ if (tree_int_cst_sgn (gnu_size) < 0) { - tree t = wide_int_to_tree (sizetype, wi::neg (gnu_size)); + tree t = wide_int_to_tree (sizetype, -wi::to_wide (gnu_size)); tcode = Negate_Expr; ops[0] = UI_From_gnu (t); } @@ -8174,7 +8174,8 @@ annotate_value (tree gnu_size) if (TREE_CODE (TREE_OPERAND (gnu_size, 1)) == INTEGER_CST) { tree op1 = TREE_OPERAND (gnu_size, 1); - wide_int signed_op1 = wi::sext (op1, TYPE_PRECISION (sizetype)); + wide_int signed_op1 = wi::sext (wi::to_wide (op1), + TYPE_PRECISION (sizetype)); if (wi::neg_p (signed_op1)) { op1 = wide_int_to_tree (sizetype, wi::neg (signed_op1)); diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 4ddd0f0a8d2e4..a957de5e58970 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -312,9 +312,9 @@ extern void post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent, extern void post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent, tree t, int num); -/* Return a label to branch to for the exception type in KIND or NULL_TREE +/* Return a label to branch to for the exception type in KIND or Empty if none. */ -extern tree get_exception_label (char kind); +extern Entity_Id get_exception_label (char kind); /* If nonzero, pretend we are allocating at global level. */ extern int force_global; diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 081a63ab0d082..7bdb3803c13dc 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -1370,6 +1370,23 @@ gnat_init_ts (void) MARK_TS_TYPED (EXIT_STMT); } +/* Return the size of a tree with CODE, which is a language-specific tree code + in category tcc_constant, tcc_exceptional or tcc_type. The default expects + never to be called. */ + +static size_t +gnat_tree_size (enum tree_code code) +{ + gcc_checking_assert (code >= NUM_TREE_CODES); + switch (code) + { + case UNCONSTRAINED_ARRAY_TYPE: + return sizeof (tree_type_non_common); + default: + gcc_unreachable (); + } +} + /* Return the lang specific structure attached to NODE. Allocate it (cleared) if needed. */ @@ -1387,6 +1404,8 @@ get_lang_specific (tree node) #define LANG_HOOKS_NAME "GNU Ada" #undef LANG_HOOKS_IDENTIFIER_SIZE #define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier) +#undef LANG_HOOKS_TREE_SIZE +#define LANG_HOOKS_TREE_SIZE gnat_tree_size #undef LANG_HOOKS_INIT #define LANG_HOOKS_INIT gnat_init #undef LANG_HOOKS_OPTION_LANG_MASK diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 18bf0713b2b78..0e46e5a921ce7 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -211,9 +211,9 @@ typedef struct loop_info_d *loop_info; static GTY(()) vec *gnu_loop_stack; /* The stacks for N_{Push,Pop}_*_Label. */ -static GTY(()) vec *gnu_constraint_error_label_stack; -static GTY(()) vec *gnu_storage_error_label_stack; -static GTY(()) vec *gnu_program_error_label_stack; +static vec gnu_constraint_error_label_stack; +static vec gnu_storage_error_label_stack; +static vec gnu_program_error_label_stack; /* Map GNAT tree codes to GCC tree codes for simple expressions. */ static enum tree_code gnu_codes[Number_Node_Kinds]; @@ -226,7 +226,6 @@ static void record_code_position (Node_Id); static void insert_code_for (Node_Id); static void add_cleanup (tree, Node_Id); static void add_stmt_list (List_Id); -static void push_exception_label_stack (vec **, Entity_Id); static tree build_stmt_group (List_Id, bool); static inline bool stmt_group_may_fallthru (void); static enum gimplify_status gnat_gimplify_stmt (tree *); @@ -647,9 +646,10 @@ gigi (Node_Id gnat_root, gnat_install_builtins (); vec_safe_push (gnu_except_ptr_stack, NULL_TREE); - vec_safe_push (gnu_constraint_error_label_stack, NULL_TREE); - vec_safe_push (gnu_storage_error_label_stack, NULL_TREE); - vec_safe_push (gnu_program_error_label_stack, NULL_TREE); + + gnu_constraint_error_label_stack.safe_push (Empty); + gnu_storage_error_label_stack.safe_push (Empty); + gnu_program_error_label_stack.safe_push (Empty); /* Process any Pragma Ident for the main unit. */ if (Present (Ident_String (Main_Unit))) @@ -5614,7 +5614,7 @@ Raise_Error_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) const bool with_extra_info = Exception_Extra_Info && !No_Exception_Handlers_Set () - && !get_exception_label (kind); + && No (get_exception_label (kind)); tree gnu_result = NULL_TREE, gnu_cond = NULL_TREE; /* The following processing is not required for correctness. Its purpose is @@ -7271,8 +7271,9 @@ gnat_to_gnu (Node_Id gnat_node) break; case N_Goto_Statement: - gnu_result - = build1 (GOTO_EXPR, void_type_node, gnat_to_gnu (Name (gnat_node))); + gnu_expr = gnat_to_gnu (Name (gnat_node)); + gnu_result = build1 (GOTO_EXPR, void_type_node, gnu_expr); + TREE_USED (gnu_expr) = 1; break; /***************************/ @@ -7492,30 +7493,36 @@ gnat_to_gnu (Node_Id gnat_node) break; case N_Push_Constraint_Error_Label: - push_exception_label_stack (&gnu_constraint_error_label_stack, - Exception_Label (gnat_node)); + gnu_constraint_error_label_stack.safe_push (Exception_Label (gnat_node)); break; case N_Push_Storage_Error_Label: - push_exception_label_stack (&gnu_storage_error_label_stack, - Exception_Label (gnat_node)); + gnu_storage_error_label_stack.safe_push (Exception_Label (gnat_node)); break; case N_Push_Program_Error_Label: - push_exception_label_stack (&gnu_program_error_label_stack, - Exception_Label (gnat_node)); + gnu_program_error_label_stack.safe_push (Exception_Label (gnat_node)); break; case N_Pop_Constraint_Error_Label: - gnu_constraint_error_label_stack->pop (); + gnat_temp = gnu_constraint_error_label_stack.pop (); + if (Present (gnat_temp) + && !TREE_USED (gnat_to_gnu_entity (gnat_temp, NULL_TREE, false))) + Warn_If_No_Local_Raise (gnat_temp); break; case N_Pop_Storage_Error_Label: - gnu_storage_error_label_stack->pop (); + gnat_temp = gnu_storage_error_label_stack.pop (); + if (Present (gnat_temp) + && !TREE_USED (gnat_to_gnu_entity (gnat_temp, NULL_TREE, false))) + Warn_If_No_Local_Raise (gnat_temp); break; case N_Pop_Program_Error_Label: - gnu_program_error_label_stack->pop (); + gnat_temp = gnu_program_error_label_stack.pop (); + if (Present (gnat_temp) + && !TREE_USED (gnat_to_gnu_entity (gnat_temp, NULL_TREE, false))) + Warn_If_No_Local_Raise (gnat_temp); break; /******************************/ @@ -7688,6 +7695,15 @@ gnat_to_gnu (Node_Id gnat_node) /* Added Nodes */ /****************/ + /* Call markers are created by the ABE mechanism to capture the target of + a call along with other elaboration-related attributes which are either + unavailable of expensive to recompute. Call markers do not have static + and runtime semantics, and should be ignored. */ + + case N_Call_Marker: + gnu_result = alloc_stmt_list (); + break; + case N_Expression_With_Actions: /* This construct doesn't define a scope so we don't push a binding level around the statement list, but we wrap it in a SAVE_EXPR to @@ -8020,20 +8036,6 @@ gnat_to_gnu_external (Node_Id gnat_node) return gnu_result; } -/* Subroutine of above to push the exception label stack. GNU_STACK is - a pointer to the stack to update and GNAT_LABEL, if present, is the - label to push onto the stack. */ - -static void -push_exception_label_stack (vec **gnu_stack, Entity_Id gnat_label) -{ - tree gnu_label = (Present (gnat_label) - ? gnat_to_gnu_entity (gnat_label, NULL_TREE, false) - : NULL_TREE); - - vec_safe_push (*gnu_stack, gnu_label); -} - /* Return true if the statement list STMT_LIST is empty. */ static bool @@ -10217,28 +10219,28 @@ post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent, tree t, post_error_ne_tree (msg, node, ent, t); } -/* Return a label to branch to for the exception type in KIND or NULL_TREE +/* Return a label to branch to for the exception type in KIND or Empty if none. */ -tree +Entity_Id get_exception_label (char kind) { switch (kind) { case N_Raise_Constraint_Error: - return gnu_constraint_error_label_stack->last (); + return gnu_constraint_error_label_stack.last (); case N_Raise_Storage_Error: - return gnu_storage_error_label_stack->last (); + return gnu_storage_error_label_stack.last (); case N_Raise_Program_Error: - return gnu_program_error_label_stack->last (); + return gnu_program_error_label_stack.last (); default: - break; + return Empty; } - return NULL_TREE; + gcc_unreachable (); } /* Return the decl for the current elaboration procedure. */ diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 04199769ea34d..99453821e419e 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -3595,6 +3595,10 @@ max_size (tree exp, bool max_p) case tcc_constant: return exp; + case tcc_exceptional: + gcc_assert (code == SSA_NAME); + return exp; + case tcc_vl_exp: if (code == CALL_EXPR) { diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index 6f109c731469c..dcd4134a434a2 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -1787,9 +1787,10 @@ build_call_n_expr (tree fndecl, int n, ...) MSG gives the exception's identity for the call to Local_Raise, if any. */ static tree -build_goto_raise (tree label, int msg) +build_goto_raise (Entity_Id gnat_label, int msg) { - tree gnu_result = build1 (GOTO_EXPR, void_type_node, label); + tree gnu_label = gnat_to_gnu_entity (gnat_label, NULL_TREE, false); + tree gnu_result = build1 (GOTO_EXPR, void_type_node, gnu_label); Entity_Id local_raise = Get_Local_Raise_Call_Entity (); /* If Local_Raise is present, build Local_Raise (Exception'Identity). */ @@ -1807,6 +1808,7 @@ build_goto_raise (tree label, int msg) = build2 (COMPOUND_EXPR, void_type_node, gnu_call, gnu_result); } + TREE_USED (gnu_label) = 1; return gnu_result; } @@ -1859,13 +1861,13 @@ expand_sloc (Node_Id gnat_node, tree *filename, tree *line, tree *col) tree build_call_raise (int msg, Node_Id gnat_node, char kind) { + Entity_Id gnat_label = get_exception_label (kind); tree fndecl = gnat_raise_decls[msg]; - tree label = get_exception_label (kind); tree filename, line; /* If this is to be done as a goto, handle that case. */ - if (label) - return build_goto_raise (label, msg); + if (Present (gnat_label)) + return build_goto_raise (gnat_label, msg); expand_sloc (gnat_node, &filename, &line, NULL); @@ -1883,13 +1885,13 @@ build_call_raise (int msg, Node_Id gnat_node, char kind) tree build_call_raise_column (int msg, Node_Id gnat_node, char kind) { + Entity_Id gnat_label = get_exception_label (kind); tree fndecl = gnat_raise_decls_ext[msg]; - tree label = get_exception_label (kind); tree filename, line, col; /* If this is to be done as a goto, handle that case. */ - if (label) - return build_goto_raise (label, msg); + if (Present (gnat_label)) + return build_goto_raise (gnat_label, msg); expand_sloc (gnat_node, &filename, &line, &col); @@ -1908,13 +1910,13 @@ tree build_call_raise_range (int msg, Node_Id gnat_node, char kind, tree index, tree first, tree last) { + Entity_Id gnat_label = get_exception_label (kind); tree fndecl = gnat_raise_decls_ext[msg]; - tree label = get_exception_label (kind); tree filename, line, col; /* If this is to be done as a goto, handle that case. */ - if (label) - return build_goto_raise (label, msg); + if (Present (gnat_label)) + return build_goto_raise (gnat_label, msg); expand_sloc (gnat_node, &filename, &line, &col); diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 882631f9beee9..4bf910bca3e53 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -1065,6 +1065,7 @@ begin ("fatal error, run-time library not installed correctly"); Write_Line ("cannot locate file system.ads"); raise Unrecoverable_Error; + elsif S = No_Access_To_Source_File then Write_Line ("fatal error, run-time library not installed correctly"); diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 8ed58c4fc7fa8..b042e2be3e14f 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT Reference Manual , Sep 29, 2017 +GNAT Reference Manual , Oct 14, 2017 AdaCore @@ -9413,11 +9413,20 @@ that it is separately controllable using pragma @code{Assertion_Policy}. This aspect provides a light-weight mechanism for loops and quantified expressions over container types, without the overhead imposed by the tampering checks of standard Ada 2012 iterators. The value of the aspect is an aggregate -with four named components: @code{First}, @code{Next}, @code{Has_Element}, and @code{Element} (the -last one being optional). When only 3 components are specified, only the -@code{for .. in} form of iteration over cursors is available. When all 4 components -are specified, both this form and the @code{for .. of} form of iteration over -elements are available. The following is a typical example of use: +with six named components, or which the last three are optional: @code{First}, + +@quotation + +@code{Next}, @code{Has_Element},`@w{`}Element`@w{`}, @code{Last}, and @code{Previous}. +@end quotation + +When only the first three components are specified, only the +@code{for .. in} form of iteration over cursors is available. When @code{Element} +is specified, both this form and the @code{for .. of} form of iteration over +elements are available. If the last two components are specified, reverse +iterations over the container can be specified (analogous to what can be done +over predefined containers that support the Reverse_Iterator interface). +The following is a typical example of use: @example type List is private with diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 49abd462265c0..947506799a5f9 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT User's Guide for Native Platforms , Sep 29, 2017 +GNAT User's Guide for Native Platforms , Oct 20, 2017 AdaCore @@ -529,19 +529,21 @@ Mac OS Topics Elaboration Order Handling in GNAT * Elaboration Code:: +* Elaboration Order:: * Checking the Elaboration Order:: -* Controlling the Elaboration Order:: -* Controlling Elaboration in GNAT - Internal Calls:: -* Controlling Elaboration in GNAT - External Calls:: -* Default Behavior in GNAT - Ensuring Safety:: -* Treatment of Pragma Elaborate:: -* Elaboration Issues for Library Tasks:: +* Controlling the Elaboration Order in Ada:: +* Controlling the Elaboration Order in GNAT:: +* Common Elaboration-model Traits:: +* Dynamic Elaboration Model in GNAT:: +* Static Elaboration Model in GNAT:: +* SPARK Elaboration Model in GNAT:: * Mixing Elaboration Models:: -* What to Do If the Default Elaboration Behavior Fails:: -* Elaboration for Indirect Calls:: +* Elaboration Circularities:: +* Resolving Elaboration Circularities:: +* Resolving Task Issues:: +* Elaboration-related Compiler Switches:: * Summary of Procedures for Elaboration Control:: -* Other Elaboration Order Considerations:: -* Determining the Chosen Elaboration Order:: +* Inspecting the Chosen Elaboration Order:: Inline Assembler @@ -8807,19 +8809,6 @@ in the compiler sources for details in files @code{scos.ads} and @code{scos.adb}. @end table -@geindex -fdump-xref (gcc) - - -@table @asis - -@item @code{-fdump-xref} - -Generates cross reference information in GLI files for C and C++ sources. -The GLI files have the same syntax as the ALI files for Ada, and can be used -for source navigation in IDEs and on the command line using e.g. gnatxref -and the @code{--ext=gli} switch. -@end table - @geindex -flto (gcc) @@ -8828,8 +8817,9 @@ and the @code{--ext=gli} switch. @item @code{-flto[=@emph{n}]} Enables Link Time Optimization. This switch must be used in conjunction -with the traditional @code{-Ox} switches and instructs the compiler to -defer most optimizations until the link stage. The advantage of this +with the @code{-Ox} switches (but not with the @code{-gnatn} switch +since it is a full replacement for the latter) and instructs the compiler +to defer most optimizations until the link stage. The advantage of this approach is that the compiler can do a whole-program analysis and choose the best interprocedural optimization strategy based on a complete view of the program, instead of a fragmentary view with the usual approach. @@ -12472,8 +12462,8 @@ should not complain at you. This switch activates warnings for exception usage when pragma Restrictions (No_Exception_Propagation) is in effect. Warnings are given for implicit or explicit exception raises which are not covered by a local handler, and for -exception handlers which do not cover a local raise. The default is that these -warnings are not given. +exception handlers which do not cover a local raise. The default is that +these warnings are given for units that contain exception handlers. @item @code{-gnatw.X} @@ -17947,9 +17937,9 @@ Do not look for library files in the system default directory. @item @code{--ext=@emph{extension}} Specify an alternate ali file extension. The default is @code{ali} and other -extensions (e.g. @code{gli} for C/C++ sources when using @code{-fdump-xref}) -may be specified via this switch. Note that if this switch overrides the -default, which means that only the new extension will be considered. +extensions (e.g. @code{gli} for C/C++ sources) may be specified via this switch. +Note that if this switch overrides the default, which means that only the +new extension will be considered. @end table @geindex --RTS (gnatxref) @@ -22899,12 +22889,12 @@ combine a dimensioned and dimensionless value. Thus an expression such as @code{Acceleration}. The dimensionality checks for relationals use the same rules as -for "+" and "-"; thus +for "+" and "-", except when comparing to a literal; thus @quotation @example -acc > 10.0 +acc > len @end example @end quotation @@ -22913,12 +22903,21 @@ is equivalent to @quotation @example -acc-10.0 > 0.0 +acc-len > 0.0 +@end example +@end quotation + +and is thus illegal, but + +@quotation + +@example +acc > 10.0 @end example @end quotation -and is thus illegal. Analogously a conditional expression -requires the same dimension vector for each branch. +is accepted with a warning. Analogously a conditional expression requires the +same dimension vector for each branch (with no exception for literals). The dimension vector of a type conversion @code{T(@emph{expr})} is defined as follows, based on the nature of @code{T}: @@ -27013,1442 +27012,1171 @@ elaboration code in your own application). @geindex Elaboration control -This appendix describes the handling of elaboration code in Ada and -in GNAT, and discusses how the order of elaboration of program units can -be controlled in GNAT, either automatically or with explicit programming -features. +This appendix describes the handling of elaboration code in Ada and GNAT, and +discusses how the order of elaboration of program units can be controlled in +GNAT, either automatically or with explicit programming features. @menu * Elaboration Code:: +* Elaboration Order:: * Checking the Elaboration Order:: -* Controlling the Elaboration Order:: -* Controlling Elaboration in GNAT - Internal Calls:: -* Controlling Elaboration in GNAT - External Calls:: -* Default Behavior in GNAT - Ensuring Safety:: -* Treatment of Pragma Elaborate:: -* Elaboration Issues for Library Tasks:: +* Controlling the Elaboration Order in Ada:: +* Controlling the Elaboration Order in GNAT:: +* Common Elaboration-model Traits:: +* Dynamic Elaboration Model in GNAT:: +* Static Elaboration Model in GNAT:: +* SPARK Elaboration Model in GNAT:: * Mixing Elaboration Models:: -* What to Do If the Default Elaboration Behavior Fails:: -* Elaboration for Indirect Calls:: +* Elaboration Circularities:: +* Resolving Elaboration Circularities:: +* Resolving Task Issues:: +* Elaboration-related Compiler Switches:: * Summary of Procedures for Elaboration Control:: -* Other Elaboration Order Considerations:: -* Determining the Chosen Elaboration Order:: +* Inspecting the Chosen Elaboration Order:: @end menu -@node Elaboration Code,Checking the Elaboration Order,,Elaboration Order Handling in GNAT +@node Elaboration Code,Elaboration Order,,Elaboration Order Handling in GNAT @anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-code}@anchor{22e}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id2}@anchor{22f} @section Elaboration Code -Ada provides rather general mechanisms for executing code at elaboration -time, that is to say before the main program starts executing. Such code arises -in three contexts: +Ada defines the term @emph{execution} as the process by which a construct achieves +its run-time effect. This process is also referred to as @strong{elaboration} for +declarations and @emph{evaluation} for expressions. + +The execution model in Ada allows for certain sections of an Ada program to be +executed prior to execution of the program itself, primarily with the intent of +initializing data. These sections are referred to as @strong{elaboration code}. +Elaboration code is executed as follows: @itemize * @item -@emph{Initializers for variables} +All partitions of an Ada program are executed in parallel with one another, +possibly in a separate address space, and possibly on a separate computer. -Variables declared at the library level, in package specs or bodies, can -require initialization that is performed at elaboration time, as in: +@item +The execution of a partition involves running the environment task for that +partition. -@example -Sqrt_Half : Float := Sqrt (0.5); -@end example +@item +The environment task executes all elaboration code (if available) for all +units within that partition. This code is said to be executed at +@strong{elaboration time}. + +@item +The environment task executes the Ada program (if available) for that +partition. +@end itemize + +In addition to the Ada terminology, this appendix defines the following terms: + + +@itemize * + +@item +@emph{Scenario} + +A construct that is elaborated or executed by elaboration code is referred to +as an @emph{elaboration scenario} or simply a @strong{scenario}. GNAT recognizes the +following scenarios: + + +@itemize - @item -@emph{Package initialization code} +@code{'Access} of entries, operators, and subprograms -Code in a @code{begin} ... `@w{`} end`@w{`} section at the outer level of a package body is -executed as part of the package body elaboration code. +@item +Activation of tasks @item -@emph{Library level task allocators} +Calls to entries, operators, and subprograms -Tasks that are declared using task allocators at the library level -start executing immediately and hence can execute at elaboration time. +@item +Instantiations of generic templates @end itemize -Subprogram calls are possible in any of these contexts, which means that -any arbitrary part of the program may be executed as part of the elaboration -code. It is even possible to write a program which does all its work at -elaboration time, with a null main program, although stylistically this -would usually be considered an inappropriate way to structure -a program. +@item +@emph{Target} -An important concern arises in the context of elaboration code: -we have to be sure that it is executed in an appropriate order. What we -have is a series of elaboration code sections, potentially one section -for each unit in the program. It is important that these execute -in the correct order. Correctness here means that, taking the above -example of the declaration of @code{Sqrt_Half}, -if some other piece of -elaboration code references @code{Sqrt_Half}, -then it must run after the -section of elaboration code that contains the declaration of -@code{Sqrt_Half}. +A construct elaborated by a scenario is referred to as @emph{elaboration target} +or simply @strong{target}. GNAT recognizes the following targets: -There would never be any order of elaboration problem if we made a rule -that whenever you @emph{with} a unit, you must elaborate both the spec and body -of that unit before elaborating the unit doing the @emph{with}ing: -@example -with Unit_1; -package Unit_2 is ... -@end example +@itemize - -would require that both the body and spec of @code{Unit_1} be elaborated -before the spec of @code{Unit_2}. However, a rule like that would be far too -restrictive. In particular, it would make it impossible to have routines -in separate packages that were mutually recursive. +@item +For @code{'Access} of entries, operators, and subprograms, the target is the +entry, operator, or subprogram being aliased. -You might think that a clever enough compiler could look at the actual -elaboration code and determine an appropriate correct order of elaboration, -but in the general case, this is not possible. Consider the following -example. +@item +For activation of tasks, the target is the task body -In the body of @code{Unit_1}, we have a procedure @code{Func_1} -that references -the variable @code{Sqrt_1}, which is declared in the elaboration code -of the body of @code{Unit_1}: +@item +For calls to entries, operators, and subprograms, the target is the entry, +operator, or subprogram being invoked. -@example -Sqrt_1 : Float := Sqrt (0.1); -@end example +@item +For instantiations of generic templates, the target is the generic template +being instantiated. +@end itemize +@end itemize -The elaboration code of the body of @code{Unit_1} also contains: +Elaboration code may appear in two distinct contexts: -@example -if expression_1 = 1 then - Q := Unit_2.Func_2; -end if; -@end example -@code{Unit_2} is exactly parallel, -it has a procedure @code{Func_2} that references -the variable @code{Sqrt_2}, which is declared in the elaboration code of -the body @code{Unit_2}: +@itemize * + +@item +@emph{Library level} + +A scenario appears at the library level when it is encapsulated by a package +[body] compilation unit, ignoring any other package [body] declarations in +between. @example -Sqrt_2 : Float := Sqrt (0.1); +with Server; +package Client is + procedure Proc; + + package Nested is + Val : ... := Server.Func; + end Nested; +end Client; @end example -The elaboration code of the body of @code{Unit_2} also contains: +In the example above, the call to @code{Server.Func} is an elaboration scenario +because it appears at the library level of package @code{Client}. Note that the +declaration of package @code{Nested} is ignored according to the definition +given above. As a result, the call to @code{Server.Func} will be executed when +the spec of unit @code{Client} is elaborated. + +@item +@emph{Package body statements} + +A scenario appears within the statement sequence of a package body when it is +bounded by the region starting from the @code{begin} keyword of the package body +and ending at the @code{end} keyword of the package body. @example -if expression_2 = 2 then - Q := Unit_1.Func_1; -end if; +package body Client is + procedure Proc is + begin + ... + end Proc; +begin + Proc; +end Client; @end example -Now the question is, which of the following orders of elaboration is -acceptable: +In the example above, the call to @code{Proc} is an elaboration scenario because +it appears within the statement sequence of package body @code{Client}. As a +result, the call to @code{Proc} will be executed when the body of @code{Client} is +elaborated. +@end itemize + +@node Elaboration Order,Checking the Elaboration Order,Elaboration Code,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-order}@anchor{230}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id3}@anchor{231} +@section Elaboration Order + + +The sequence by which the elaboration code of all units within a partition is +executed is referred to as @strong{elaboration order}. + +Within a single unit, elaboration code is executed in sequential order. @example -Spec of Unit_1 -Spec of Unit_2 -Body of Unit_1 -Body of Unit_2 +package body Client is + Result : ... := Server.Func; + + procedure Proc is + package Inst is new Server.Gen; + begin + Inst.Eval (Result); + end Proc; +begin + Proc; +end Client; @end example -or +In the example above, the elaboration order within package body @code{Client} is +as follows: -@example -Spec of Unit_2 -Spec of Unit_1 -Body of Unit_2 -Body of Unit_1 -@end example - -If you carefully analyze the flow here, you will see that you cannot tell -at compile time the answer to this question. -If @code{expression_1} is not equal to 1, -and @code{expression_2} is not equal to 2, -then either order is acceptable, because neither of the function calls is -executed. If both tests evaluate to true, then neither order is acceptable -and in fact there is no correct order. - -If one of the two expressions is true, and the other is false, then one -of the above orders is correct, and the other is incorrect. For example, -if @code{expression_1} /= 1 and @code{expression_2} = 2, -then the call to @code{Func_1} -will occur, but not the call to @code{Func_2.} -This means that it is essential -to elaborate the body of @code{Unit_1} before -the body of @code{Unit_2}, so the first -order of elaboration is correct and the second is wrong. - -By making @code{expression_1} and @code{expression_2} -depend on input data, or perhaps -the time of day, we can make it impossible for the compiler or binder -to figure out which of these expressions will be true, and hence it -is impossible to guarantee a safe order of elaboration at run time. - -@node Checking the Elaboration Order,Controlling the Elaboration Order,Elaboration Code,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat checking-the-elaboration-order}@anchor{230}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id3}@anchor{231} -@section Checking the Elaboration Order +@enumerate -In some languages that involve the same kind of elaboration problems, -e.g., Java and C++, the programmer needs to take these -ordering problems into account, and it is common to -write a program in which an incorrect elaboration order gives -surprising results, because it references variables before they -are initialized. -Ada is designed to be a safe language, and a programmer-beware approach is -clearly not sufficient. Consequently, the language provides three lines -of defense: +@item +The object declaration of @code{Result} is elaborated. @itemize * @item -@emph{Standard rules} - -Some standard rules restrict the possible choice of elaboration -order. In particular, if you @emph{with} a unit, then its spec is always -elaborated before the unit doing the @emph{with}. Similarly, a parent -spec is always elaborated before the child spec, and finally -a spec is always elaborated before its corresponding body. +Function @code{Server.Func} is invoked. @end itemize -@geindex Elaboration checks +@item +The subprogram body of @code{Proc} is elaborated. -@geindex Checks -@geindex elaboration +@item +Procedure @code{Proc} is invoked. @itemize * @item -@emph{Dynamic elaboration checks} - -Dynamic checks are made at run time, so that if some entity is accessed -before it is elaborated (typically by means of a subprogram call) -then the exception (@code{Program_Error}) is raised. +Generic unit @code{Server.Gen} is instantiated as @code{Inst}. @item -@emph{Elaboration control} +Instance @code{Inst} is elaborated. -Facilities are provided for the programmer to specify the desired order -of elaboration. +@item +Procedure @code{Inst.Eval} is invoked. @end itemize +@end enumerate -Let's look at these facilities in more detail. First, the rules for -dynamic checking. One possible rule would be simply to say that the -exception is raised if you access a variable which has not yet been -elaborated. The trouble with this approach is that it could require -expensive checks on every variable reference. Instead Ada has two -rules which are a little more restrictive, but easier to check, and -easier to state: +The elaboration order of all units within a partition depends on the following +factors: @itemize * @item -@emph{Restrictions on calls} +@emph{with}ed units -A subprogram can only be called at elaboration time if its body -has been elaborated. The rules for elaboration given above guarantee -that the spec of the subprogram has been elaborated before the -call, but not the body. If this rule is violated, then the -exception @code{Program_Error} is raised. +@item +purity of units @item -@emph{Restrictions on instantiations} +preelaborability of units -A generic unit can only be instantiated if the body of the generic -unit has been elaborated. Again, the rules for elaboration given above -guarantee that the spec of the generic unit has been elaborated -before the instantiation, but not the body. If this rule is -violated, then the exception @code{Program_Error} is raised. +@item +presence of elaboration control pragmas @end itemize -The idea is that if the body has been elaborated, then any variables -it references must have been elaborated; by checking for the body being -elaborated we guarantee that none of its references causes any -trouble. As we noted above, this is a little too restrictive, because a -subprogram that has no non-local references in its body may in fact be safe -to call. However, it really would be unsafe to rely on this, because -it would mean that the caller was aware of details of the implementation -in the body. This goes against the basic tenets of Ada. - -A plausible implementation can be described as follows. -A Boolean variable is associated with each subprogram -and each generic unit. This variable is initialized to False, and is set to -True at the point body is elaborated. Every call or instantiation checks the -variable, and raises @code{Program_Error} if the variable is False. - -Note that one might think that it would be good enough to have one Boolean -variable for each package, but that would not deal with cases of trying -to call a body in the same package as the call -that has not been elaborated yet. -Of course a compiler may be able to do enough analysis to optimize away -some of the Boolean variables as unnecessary, and GNAT indeed -does such optimizations, but still the easiest conceptual model is to -think of there being one variable per subprogram. - -@node Controlling the Elaboration Order,Controlling Elaboration in GNAT - Internal Calls,Checking the Elaboration Order,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id4}@anchor{232}@anchor{gnat_ugn/elaboration_order_handling_in_gnat controlling-the-elaboration-order}@anchor{233} -@section Controlling the Elaboration Order - - -In the previous section we discussed the rules in Ada which ensure -that @code{Program_Error} is raised if an incorrect elaboration order is -chosen. This prevents erroneous executions, but we need mechanisms to -specify a correct execution and avoid the exception altogether. -To achieve this, Ada provides a number of features for controlling -the order of elaboration. We discuss these features in this section. - -First, there are several ways of indicating to the compiler that a given -unit has no elaboration problems: +A program may have several elaboration orders depending on its structure. +@example +package Server is + function Func (Index : Integer) return Integer; +end Server; +@end example -@itemize * +@example +package body Server is + Results : array (1 .. 5) of Integer := (1, 2, 3, 4, 5); -@item -@emph{packages that do not require a body} + function Func (Index : Integer) return Integer is + begin + return Results (Index); + end Func; +end Server; +@end example -A library package that does not require a body does not permit -a body (this rule was introduced in Ada 95). -Thus if we have a such a package, as in: +@example +with Server; +package Client is + Val : constant Integer := Server.Func (3); +end Client; +@end example @example -package Definitions is - generic - type m is new integer; - package Subp is - type a is array (1 .. 10) of m; - type b is array (1 .. 20) of m; - end Subp; -end Definitions; +with Client; +procedure Main is begin null; end Main; @end example -A package that @emph{with}s @code{Definitions} may safely instantiate -@code{Definitions.Subp} because the compiler can determine that there -definitely is no package body to worry about in this case -@end itemize +The following elaboration order exhibits a fundamental problem referred to as +@emph{access-before-elaboration} or simply @strong{ABE}. -@geindex pragma Pure +@example +spec of Server +spec of Client +body of Server +body of Main +@end example +The elaboration of @code{Server}'s spec materializes function @code{Func}, making it +callable. The elaboration of @code{Client}'s spec elaborates the declaration of +@code{Val}. This invokes function @code{Server.Func}, however the body of +@code{Server.Func} has not been elaborated yet because @code{Server}'s body comes +after @code{Client}'s spec in the elaboration order. As a result, the value of +constant @code{Val} is now undefined. -@itemize * +Without any guarantees from the language, an undetected ABE problem may hinder +proper initialization of data, which in turn may lead to undefined behavior at +run time. To prevent such ABE problems, Ada employs dynamic checks in the same +vein as index or null exclusion checks. A failed ABE check raises exception +@code{Program_Error}. -@item -@emph{pragma Pure} +The following elaboration order avoids the ABE problem and the program can be +successfully elaborated. -This pragma places sufficient restrictions on a unit to guarantee that -no call to any subprogram in the unit can result in an -elaboration problem. This means that the compiler does not need -to worry about the point of elaboration of such units, and in -particular, does not need to check any calls to any subprograms -in this unit. -@end itemize +@example +spec of Server +body of Server +spec of Client +body of Main +@end example -@geindex pragma Preelaborate +Ada states that a total elaboration order must exist, but it does not define +what this order is. A compiler is thus tasked with choosing a suitable +elaboration order which satisfies the dependencies imposed by @emph{with} clauses, +unit categorization, and elaboration control pragmas. Ideally an order which +avoids ABE problems should be chosen, however a compiler may not always find +such an order due to complications with respect to control and data flow. + +@node Checking the Elaboration Order,Controlling the Elaboration Order in Ada,Elaboration Order,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat id4}@anchor{232}@anchor{gnat_ugn/elaboration_order_handling_in_gnat checking-the-elaboration-order}@anchor{233} +@section Checking the Elaboration Order + + +To avoid placing the entire elaboration order burden on the programmer, Ada +provides three lines of defense: @itemize * @item -@emph{pragma Preelaborate} +@emph{Static semantics} -This pragma places slightly less stringent restrictions on a unit than -does pragma Pure, -but these restrictions are still sufficient to ensure that there -are no elaboration problems with any calls to the unit. -@end itemize +Static semantic rules restrict the possible choice of elaboration order. For +instance, if unit Client @emph{with}s unit Server, then the spec of Server is +always elaborated prior to Client. The same principle applies to child units +- the spec of a parent unit is always elaborated prior to the child unit. -@geindex pragma Elaborate_Body +@item +@emph{Dynamic semantics} +Dynamic checks are performed at run time, to ensure that a target is +elaborated prior to a scenario that executes it, thus avoiding ABE problems. +A failed run-time check raises exception @code{Program_Error}. The following +restrictions apply: -@itemize * + +@itemize - @item -@emph{pragma Elaborate_Body} +@emph{Restrictions on calls} -This pragma requires that the body of a unit be elaborated immediately -after its spec. Suppose a unit @code{A} has such a pragma, -and unit @code{B} does -a @emph{with} of unit @code{A}. Recall that the standard rules require -the spec of unit @code{A} -to be elaborated before the @emph{with}ing unit; given the pragma in -@code{A}, we also know that the body of @code{A} -will be elaborated before @code{B}, so -that calls to @code{A} are safe and do not need a check. - -Note that, unlike pragma @code{Pure} and pragma @code{Preelaborate}, -the use of @code{Elaborate_Body} does not guarantee that the program is -free of elaboration problems, because it may not be possible -to satisfy the requested elaboration order. -Let's go back to the example with @code{Unit_1} and @code{Unit_2}. -If a programmer marks @code{Unit_1} as @code{Elaborate_Body}, -and not @code{Unit_2,} then the order of -elaboration will be: - -@example -Spec of Unit_2 -Spec of Unit_1 -Body of Unit_1 -Body of Unit_2 -@end example - -Now that means that the call to @code{Func_1} in @code{Unit_2} -need not be checked, -it must be safe. But the call to @code{Func_2} in -@code{Unit_1} may still fail if -@code{Expression_1} is equal to 1, -and the programmer must still take -responsibility for this not being the case. - -If all units carry a pragma @code{Elaborate_Body}, then all problems are -eliminated, except for calls entirely within a body, which are -in any case fully under programmer control. However, using the pragma -everywhere is not always possible. -In particular, for our @code{Unit_1}/@cite{Unit_2} example, if -we marked both of them as having pragma @code{Elaborate_Body}, then -clearly there would be no possible elaboration order. -@end itemize +An entry, operator, or subprogram can be called from elaboration code only +when the corresponding body has been elaborated. + +@item +@emph{Restrictions on instantiations} -The above pragmas allow a server to guarantee safe use by clients, and -clearly this is the preferable approach. Consequently a good rule -is to mark units as @code{Pure} or @code{Preelaborate} if possible, -and if this is not possible, -mark them as @code{Elaborate_Body} if possible. -As we have seen, there are situations where neither of these -three pragmas can be used. -So we also provide methods for clients to control the -order of elaboration of the servers on which they depend: +A generic unit can be instantiated by elaboration code only when the +corresponding body has been elaborated. -@geindex pragma Elaborate +@item +@emph{Restrictions on task activation} +A task can be activated by elaboration code only when the body of the +associated task type has been elaborated. +@end itemize -@itemize * +The restrictions above can be summarized by the following rule: + +@emph{If a target has a body, then this body must be elaborated prior to the +execution of the scenario that invokes, instantiates, or activates the +target.} @item -@emph{pragma Elaborate (unit)} +@emph{Elaboration control} -This pragma is placed in the context clause, after a @emph{with} clause, -and it requires that the body of the named unit be elaborated before -the unit in which the pragma occurs. The idea is to use this pragma -if the current unit calls at elaboration time, directly or indirectly, -some subprogram in the named unit. +Pragmas are provided for the programmer to specify the desired elaboration +order. @end itemize -@geindex pragma Elaborate_All +@node Controlling the Elaboration Order in Ada,Controlling the Elaboration Order in GNAT,Checking the Elaboration Order,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat controlling-the-elaboration-order-in-ada}@anchor{234}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id5}@anchor{235} +@section Controlling the Elaboration Order in Ada + + +Ada provides several idioms and pragmas to aid the programmer with specifying +the desired elaboration order and avoiding ABE problems altogether. @itemize * @item -@emph{pragma Elaborate_All (unit)} +@emph{Packages without a body} -This is a stronger version of the Elaborate pragma. Consider the -following example: +A library package which does not require a completing body does not suffer +from ABE problems. @example -Unit A |withs| unit B and calls B.Func in elab code -Unit B |withs| unit C, and B.Func calls C.Func +package Pack is + generic + type Element is private; + package Containers is + type Element_Array is array (1 .. 10) of Element; + end Containers; +end Pack; @end example -Now if we put a pragma @code{Elaborate (B)} -in unit @code{A}, this ensures that the -body of @code{B} is elaborated before the call, but not the -body of @code{C}, so -the call to @code{C.Func} could still cause @code{Program_Error} to -be raised. - -The effect of a pragma @code{Elaborate_All} is stronger, it requires -not only that the body of the named unit be elaborated before the -unit doing the @emph{with}, but also the bodies of all units that the -named unit uses, following @emph{with} links transitively. For example, -if we put a pragma @code{Elaborate_All (B)} in unit @code{A}, -then it requires not only that the body of @code{B} be elaborated before @code{A}, -but also the body of @code{C}, because @code{B} @emph{with}s @code{C}. +In the example above, package @code{Pack} does not require a body because it +does not contain any constructs which require completion in a body. As a +result, generic @code{Pack.Containers} can be instantiated without encountering +any ABE problems. @end itemize -We are now in a position to give a usage rule in Ada for avoiding -elaboration problems, at least if dynamic dispatching and access to -subprogram values are not used. We will handle these cases separately -later. - -The rule is simple: - -@emph{If a unit has elaboration code that can directly or -indirectly make a call to a subprogram in a |withed| unit, or instantiate -a generic package in a |withed| unit, -then if the |withed| unit does not have -pragma `@w{`}Pure`@w{`} or `@w{`}Preelaborate`@w{`}, then the client should have -a pragma `@w{`}Elaborate_All`@w{`}for the |withed| unit.*} - -By following this rule a client is -assured that calls can be made without risk of an exception. - -For generic subprogram instantiations, the rule can be relaxed to -require only a pragma @code{Elaborate} since elaborating the body -of a subprogram cannot cause any transitive elaboration (we are -not calling the subprogram in this case, just elaborating its -declaration). - -If this rule is not followed, then a program may be in one of four -states: +@geindex pragma Pure @itemize * @item -@emph{No order exists} - -No order of elaboration exists which follows the rules, taking into -account any @code{Elaborate}, @code{Elaborate_All}, -or @code{Elaborate_Body} pragmas. In -this case, an Ada compiler must diagnose the situation at bind -time, and refuse to build an executable program. +@emph{pragma Pure} -@item -@emph{One or more orders exist, all incorrect} +Pragma @code{Pure} places sufficient restrictions on a unit to guarantee that no +scenario within the unit can result in an ABE problem. +@end itemize -One or more acceptable elaboration orders exist, and all of them -generate an elaboration order problem. In this case, the binder -can build an executable program, but @code{Program_Error} will be raised -when the program is run. +@geindex pragma Preelaborate -@item -@emph{Several orders exist, some right, some incorrect} -One or more acceptable elaboration orders exists, and some of them -work, and some do not. The programmer has not controlled -the order of elaboration, so the binder may or may not pick one of -the correct orders, and the program may or may not raise an -exception when it is run. This is the worst case, because it means -that the program may fail when moved to another compiler, or even -another version of the same compiler. +@itemize * @item -@emph{One or more orders exists, all correct} +@emph{pragma Preelaborate} -One ore more acceptable elaboration orders exist, and all of them -work. In this case the program runs successfully. This state of -affairs can be guaranteed by following the rule we gave above, but -may be true even if the rule is not followed. +Pragma @code{Preelaborate} is slightly less restrictive than pragma @code{Pure}, +but still strong enough to prevent ABE problems within a unit. @end itemize -Note that one additional advantage of following our rules on the use -of @code{Elaborate} and @code{Elaborate_All} -is that the program continues to stay in the ideal (all orders OK) state -even if maintenance -changes some bodies of some units. Conversely, if a program that does -not follow this rule happens to be safe at some point, this state of affairs -may deteriorate silently as a result of maintenance changes. +@geindex pragma Elaborate_Body -You may have noticed that the above discussion did not mention -the use of @code{Elaborate_Body}. This was a deliberate omission. If you -@emph{with} an @code{Elaborate_Body} unit, it still may be the case that -code in the body makes calls to some other unit, so it is still necessary -to use @code{Elaborate_All} on such units. -@node Controlling Elaboration in GNAT - Internal Calls,Controlling Elaboration in GNAT - External Calls,Controlling the Elaboration Order,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id5}@anchor{234}@anchor{gnat_ugn/elaboration_order_handling_in_gnat controlling-elaboration-in-gnat-internal-calls}@anchor{235} -@section Controlling Elaboration in GNAT - Internal Calls +@itemize * +@item +@emph{pragma Elaborate_Body} -In the case of internal calls, i.e., calls within a single package, the -programmer has full control over the order of elaboration, and it is up -to the programmer to elaborate declarations in an appropriate order. For -example writing: +Pragma @code{Elaborate_Body} requires that the body of a unit is elaborated +immediately after its spec. This restriction guarantees that no client +scenario can execute a server target before the target body has been +elaborated because the spec and body are effectively "glued" together. @example -function One return Float; +package Server is + pragma Elaborate_Body; -Q : Float := One; - -function One return Float is -begin - return 1.0; -end One; + function Func return Integer; +end Server; @end example -will obviously raise @code{Program_Error} at run time, because function -One will be called before its body is elaborated. In this case GNAT will -generate a warning that the call will raise @code{Program_Error}: +@example +package body Server is + function Func return Integer is + begin + ... + end Func; +end Server; +@end example @example - 1. procedure y is - 2. function One return Float; - 3. - 4. Q : Float := One; - | - >>> warning: cannot call "One" before body is elaborated - >>> warning: Program_Error will be raised at run time +with Server; +package Client is + Val : constant Integer := Server.Func; +end Client; +@end example + +In the example above, pragma @code{Elaborate_Body} guarantees the following +elaboration order: - 5. - 6. function One return Float is - 7. begin - 8. return 1.0; - 9. end One; -10. -11. begin -12. null; -13. end; +@example +spec of Server +body of Server +spec of Client @end example -Note that in this particular case, it is likely that the call is safe, because -the function @code{One} does not access any global variables. -Nevertheless in Ada, we do not want the validity of the check to depend on -the contents of the body (think about the separate compilation case), so this -is still wrong, as we discussed in the previous sections. +because the spec of @code{Server} must be elaborated prior to @code{Client} by +virtue of the @emph{with} clause, and in addition the body of @code{Server} must be +elaborated immediately after the spec of @code{Server}. -The error is easily corrected by rearranging the declarations so that the -body of @code{One} appears before the declaration containing the call -(note that in Ada 95 as well as later versions of the Ada standard, -declarations can appear in any order, so there is no restriction that -would prevent this reordering, and if we write: +Removing pragma @code{Elaborate_Body} could result in the following incorrect +elaboration order: @example -function One return Float; +spec of Server +spec of Client +body of Server +@end example -function One return Float is -begin - return 1.0; -end One; +where @code{Client} invokes @code{Server.Func}, but the body of @code{Server.Func} has +not been elaborated yet. +@end itemize -Q : Float := One; -@end example +The pragmas outlined above allow a server unit to guarantee safe elaboration +use by client units. Thus it is a good rule to mark units as @code{Pure} or +@code{Preelaborate}, and if this is not possible, mark them as @code{Elaborate_Body}. -then all is well, no warning is generated, and no -@code{Program_Error} exception -will be raised. -Things are more complicated when a chain of subprograms is executed: +There are however situations where @code{Pure}, @code{Preelaborate}, and +@code{Elaborate_Body} are not applicable. Ada provides another set of pragmas for +use by client units to help ensure the elaboration safety of server units they +depend on. -@example -function A return Integer; -function B return Integer; -function C return Integer; +@geindex pragma Elaborate (Unit) -function B return Integer is begin return A; end; -function C return Integer is begin return B; end; -X : Integer := C; +@itemize * -function A return Integer is begin return 1; end; -@end example +@item +@emph{pragma Elaborate (Unit)} -Now the call to @code{C} -at elaboration time in the declaration of @code{X} is correct, because -the body of @code{C} is already elaborated, -and the call to @code{B} within the body of -@code{C} is correct, but the call -to @code{A} within the body of @code{B} is incorrect, because the body -of @code{A} has not been elaborated, so @code{Program_Error} -will be raised on the call to @code{A}. -In this case GNAT will generate a -warning that @code{Program_Error} may be -raised at the point of the call. Let's look at the warning: +Pragma @code{Elaborate} can be placed in the context clauses of a unit, after a +@emph{with} clause. It guarantees that both the spec and body of its argument will +be elaborated prior to the unit with the pragma. Note that other unrelated +units may be elaborated in between the spec and the body. @example - 1. procedure x is - 2. function A return Integer; - 3. function B return Integer; - 4. function C return Integer; - 5. - 6. function B return Integer is begin return A; end; - | - >>> warning: call to "A" before body is elaborated may - raise Program_Error - >>> warning: "B" called at line 7 - >>> warning: "C" called at line 9 - - 7. function C return Integer is begin return B; end; - 8. - 9. X : Integer := C; -10. -11. function A return Integer is begin return 1; end; -12. -13. begin -14. null; -15. end; +package Server is + function Func return Integer; +end Server; @end example -Note that the message here says 'may raise', instead of the direct case, -where the message says 'will be raised'. That's because whether -@code{A} is -actually called depends in general on run-time flow of control. -For example, if the body of @code{B} said +@example +package body Server is + function Func return Integer is + begin + ... + end Func; +end Server; +@end example @example -function B return Integer is -begin - if some-condition-depending-on-input-data then - return A; - else - return 1; - end if; -end B; -@end example - -then we could not know until run time whether the incorrect call to A would -actually occur, so @code{Program_Error} might -or might not be raised. It is possible for a compiler to -do a better job of analyzing bodies, to -determine whether or not @code{Program_Error} -might be raised, but it certainly -couldn't do a perfect job (that would require solving the halting problem -and is provably impossible), and because this is a warning anyway, it does -not seem worth the effort to do the analysis. Cases in which it -would be relevant are rare. - -In practice, warnings of either of the forms given -above will usually correspond to -real errors, and should be examined carefully and eliminated. -In the rare case where a warning is bogus, it can be suppressed by any of -the following methods: +with Server; +pragma Elaborate (Server); +package Client is + Val : constant Integer := Server.Func; +end Client; +@end example +In the example above, pragma @code{Elaborate} guarantees the following +elaboration order: -@itemize * +@example +spec of Server +body of Server +spec of Client +@end example -@item -Compile with the @code{-gnatws} switch set +Removing pragma @code{Elaborate} could result in the following incorrect +elaboration order: -@item -Suppress @code{Elaboration_Check} for the called subprogram +@example +spec of Server +spec of Client +body of Server +@end example -@item -Use pragma @code{Warnings_Off} to turn warnings off for the call +where @code{Client} invokes @code{Server.Func}, but the body of @code{Server.Func} +has not been elaborated yet. @end itemize -For the internal elaboration check case, -GNAT by default generates the -necessary run-time checks to ensure -that @code{Program_Error} is raised if any -call fails an elaboration check. Of course this can only happen if a -warning has been issued as described above. The use of pragma -@code{Suppress (Elaboration_Check)} may (but is not guaranteed to) suppress -some of these checks, meaning that it may be possible (but is not -guaranteed) for a program to be able to call a subprogram whose body -is not yet elaborated, without raising a @code{Program_Error} exception. +@geindex pragma Elaborate_All (Unit) + -@node Controlling Elaboration in GNAT - External Calls,Default Behavior in GNAT - Ensuring Safety,Controlling Elaboration in GNAT - Internal Calls,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id6}@anchor{236}@anchor{gnat_ugn/elaboration_order_handling_in_gnat controlling-elaboration-in-gnat-external-calls}@anchor{237} -@section Controlling Elaboration in GNAT - External Calls +@itemize * +@item +@emph{pragma Elaborate_All (Unit)} -The previous section discussed the case in which the execution of a -particular thread of elaboration code occurred entirely within a -single unit. This is the easy case to handle, because a programmer -has direct and total control over the order of elaboration, and -furthermore, checks need only be generated in cases which are rare -and which the compiler can easily detect. -The situation is more complex when separate compilation is taken into account. -Consider the following: +Pragma @code{Elaborate_All} is placed in the context clauses of a unit, after +a @emph{with} clause. It guarantees that both the spec and body of its argument +will be elaborated prior to the unit with the pragma, as well as all units +@emph{with}ed by the spec and body of the argument, recursively. Note that other +unrelated units may be elaborated in between the spec and the body. @example package Math is - function Sqrt (Arg : Float) return Float; + function Factorial (Val : Natural) return Natural; end Math; +@end example +@example package body Math is - function Sqrt (Arg : Float) return Float is + function Factorial (Val : Natural) return Natural is begin - ... - end Sqrt; + ...; + end Factorial; end Math; +@end example +@example +package Computer is + type Operation_Kind is (None, Op_Factorial); + + function Compute + (Val : Natural; + Op : Operation_Kind) return Natural; +end Computer; +@end example + +@example with Math; -package Stuff is - X : Float := Math.Sqrt (0.5); -end Stuff; +package body Computer is + function Compute + (Val : Natural; + Op : Operation_Kind) return Natural + is + if Op = Op_Factorial then + return Math.Factorial (Val); + end if; -with Stuff; -procedure Main is -begin - ... -end Main; + return 0; + end Compute; +end Computer; @end example -where @code{Main} is the main program. When this program is executed, the -elaboration code must first be executed, and one of the jobs of the -binder is to determine the order in which the units of a program are -to be elaborated. In this case we have four units: the spec and body -of @code{Math}, -the spec of @code{Stuff} and the body of @code{Main}). -In what order should the four separate sections of elaboration code -be executed? +@example +with Computer; +pragma Elaborate_All (Computer); +package Client is + Val : constant Natural := + Computer.Compute (123, Computer.Op_Factorial); +end Client; +@end example -There are some restrictions in the order of elaboration that the binder -can choose. In particular, if unit U has a @emph{with} -for a package @code{X}, then you -are assured that the spec of @code{X} -is elaborated before U , but you are -not assured that the body of @code{X} -is elaborated before U. -This means that in the above case, the binder is allowed to choose the -order: +In the example above, pragma @code{Elaborate_All} can result in the following +elaboration order: @example spec of Math -spec of Stuff body of Math -body of Main +spec of Computer +body of Computer +spec of Client @end example -but that's not good, because now the call to @code{Math.Sqrt} -that happens during -the elaboration of the @code{Stuff} -spec happens before the body of @code{Math.Sqrt} is -elaborated, and hence causes @code{Program_Error} exception to be raised. -At first glance, one might say that the binder is misbehaving, because -obviously you want to elaborate the body of something you @emph{with} first, but -that is not a general rule that can be followed in all cases. Consider - -@example -package X is ... - -package Y is ... - -with X; -package body Y is ... - -with Y; -package body X is ... -@end example - -This is a common arrangement, and, apart from the order of elaboration -problems that might arise in connection with elaboration code, this works fine. -A rule that says that you must first elaborate the body of anything you -@emph{with} cannot work in this case: -the body of @code{X} @emph{with}s @code{Y}, -which means you would have to -elaborate the body of @code{Y} first, but that @emph{with}s @code{X}, -which means -you have to elaborate the body of @code{X} first, but ... and we have a -loop that cannot be broken. - -It is true that the binder can in many cases guess an order of elaboration -that is unlikely to cause a @code{Program_Error} -exception to be raised, and it tries to do so (in the -above example of @code{Math/Stuff/Spec}, the GNAT binder will -by default -elaborate the body of @code{Math} right after its spec, so all will be well). - -However, a program that blindly relies on the binder to be helpful can -get into trouble, as we discussed in the previous sections, so GNAT -provides a number of facilities for assisting the programmer in -developing programs that are robust with respect to elaboration order. - -@node Default Behavior in GNAT - Ensuring Safety,Treatment of Pragma Elaborate,Controlling Elaboration in GNAT - External Calls,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id7}@anchor{238}@anchor{gnat_ugn/elaboration_order_handling_in_gnat default-behavior-in-gnat-ensuring-safety}@anchor{239} -@section Default Behavior in GNAT - Ensuring Safety - - -The default behavior in GNAT ensures elaboration safety. In its -default mode GNAT implements the -rule we previously described as the right approach. Let's restate it: - -@emph{If a unit has elaboration code that can directly or indirectly make a -call to a subprogram in a |withed| unit, or instantiate a generic -package in a |withed| unit, then if the |withed| unit -does not have pragma `@w{`}Pure`@w{`} or `@w{`}Preelaborate`@w{`}, then the client should have an -`@w{`}Elaborate_All`@w{`} pragma for the |withed| unit.} - -@emph{In the case of instantiating a generic subprogram, it is always -sufficient to have only an `@w{`}Elaborate`@w{`} pragma for the -|withed| unit.} - -By following this rule a client is assured that calls and instantiations -can be made without risk of an exception. - -In this mode GNAT traces all calls that are potentially made from -elaboration code, and puts in any missing implicit @code{Elaborate} -and @code{Elaborate_All} pragmas. -The advantage of this approach is that no elaboration problems -are possible if the binder can find an elaboration order that is -consistent with these implicit @code{Elaborate} and -@code{Elaborate_All} pragmas. The -disadvantage of this approach is that no such order may exist. - -If the binder does not generate any diagnostics, then it means that it has -found an elaboration order that is guaranteed to be safe. However, the binder -may still be relying on implicitly generated @code{Elaborate} and -@code{Elaborate_All} pragmas so portability to other compilers than GNAT is not -guaranteed. - -If it is important to guarantee portability, then the compilations should -use the @code{-gnatel} -(info messages for elaboration pragmas) switch. This will cause info messages -to be generated indicating the missing @code{Elaborate} and -@code{Elaborate_All} pragmas. -Consider the following source program: +Note that there are several allowable suborders for the specs and bodies of +@code{Math} and @code{Computer}, but the point is that these specs and bodies will +be elaborated prior to @code{Client}. + +Removing pragma @code{Elaborate_All} could result in the following incorrect +elaboration order @example -with k; -package j is - m : integer := k.r; -end; +spec of Math +spec of Computer +body of Computer +spec of Client +body of Math @end example -where it is clear that there -should be a pragma @code{Elaborate_All} -for unit @code{k}. An implicit pragma will be generated, and it is -likely that the binder will be able to honor it. However, if you want -to port this program to some other Ada compiler than GNAT. -it is safer to include the pragma explicitly in the source. If this -unit is compiled with the @code{-gnatel} -switch, then the compiler outputs an information message: - -@example -1. with k; -2. package j is -3. m : integer := k.r; - | - >>> info: call to "r" may raise Program_Error - >>> info: missing pragma Elaborate_All for "k" - -4. end; -@end example - -and these messages can be used as a guide for supplying manually -the missing pragmas. It is usually a bad idea to use this -option during development. That's because it will tell you when -you need to put in a pragma, but cannot tell you when it is time -to take it out. So the use of pragma @code{Elaborate_All} may lead to -unnecessary dependencies and even false circularities. - -This default mode is more restrictive than the Ada Reference -Manual, and it is possible to construct programs which will compile -using the dynamic model described there, but will run into a -circularity using the safer static model we have described. - -Of course any Ada compiler must be able to operate in a mode -consistent with the requirements of the Ada Reference Manual, -and in particular must have the capability of implementing the -standard dynamic model of elaboration with run-time checks. - -In GNAT, this standard mode can be achieved either by the use of -the @code{-gnatE} switch on the compiler (@code{gcc} or -@code{gnatmake}) command, or by the use of the configuration pragma: - -@example -pragma Elaboration_Checks (DYNAMIC); -@end example - -Either approach will cause the unit affected to be compiled using the -standard dynamic run-time elaboration checks described in the Ada -Reference Manual. The static model is generally preferable, since it -is clearly safer to rely on compile and link time checks rather than -run-time checks. However, in the case of legacy code, it may be -difficult to meet the requirements of the static model. This -issue is further discussed in -@ref{23a,,What to Do If the Default Elaboration Behavior Fails}. - -Note that the static model provides a strict subset of the allowed -behavior and programs of the Ada Reference Manual, so if you do -adhere to the static model and no circularities exist, -then you are assured that your program will -work using the dynamic model, providing that you remove any -pragma Elaborate statements from the source. - -@node Treatment of Pragma Elaborate,Elaboration Issues for Library Tasks,Default Behavior in GNAT - Ensuring Safety,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat treatment-of-pragma-elaborate}@anchor{23b}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id8}@anchor{23c} -@section Treatment of Pragma Elaborate - - -@geindex Pragma Elaborate - -The use of @code{pragma Elaborate} -should generally be avoided in Ada 95 and Ada 2005 programs, -since there is no guarantee that transitive calls -will be properly handled. Indeed at one point, this pragma was placed -in Annex J (Obsolescent Features), on the grounds that it is never useful. - -Now that's a bit restrictive. In practice, the case in which -@code{pragma Elaborate} is useful is when the caller knows that there -are no transitive calls, or that the called unit contains all necessary -transitive @code{pragma Elaborate} statements, and legacy code often -contains such uses. - -Strictly speaking the static mode in GNAT should ignore such pragmas, -since there is no assurance at compile time that the necessary safety -conditions are met. In practice, this would cause GNAT to be incompatible -with correctly written Ada 83 code that had all necessary -@code{pragma Elaborate} statements in place. Consequently, we made the -decision that GNAT in its default mode will believe that if it encounters -a @code{pragma Elaborate} then the programmer knows what they are doing, -and it will trust that no elaboration errors can occur. - -The result of this decision is two-fold. First to be safe using the -static mode, you should remove all @code{pragma Elaborate} statements. -Second, when fixing circularities in existing code, you can selectively -use @code{pragma Elaborate} statements to convince the static mode of -GNAT that it need not generate an implicit @code{pragma Elaborate_All} -statement. - -When using the static mode with @code{-gnatwl}, any use of -@code{pragma Elaborate} will generate a warning about possible -problems. +where @code{Client} invokes @code{Computer.Compute}, which in turn invokes +@code{Math.Factorial}, but the body of @code{Math.Factorial} has not been +elaborated yet. +@end itemize -@node Elaboration Issues for Library Tasks,Mixing Elaboration Models,Treatment of Pragma Elaborate,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-issues-for-library-tasks}@anchor{23d}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id9}@anchor{23e} -@section Elaboration Issues for Library Tasks +All pragmas shown above can be summarized by the following rule: +@emph{If a client unit elaborates a server target directly or indirectly, then if +the server unit requires a body and does not have pragma Pure, Preelaborate, +or Elaborate_Body, then the client unit should have pragma Elaborate or +Elaborate_All for the server unit.} -@geindex Library tasks -@geindex elaboration issues +If the rule outlined above is not followed, then a program may fall in one of +the following states: -@geindex Elaboration of library tasks -In this section we examine special elaboration issues that arise for -programs that declare library level tasks. +@itemize * -Generally the model of execution of an Ada program is that all units are -elaborated, and then execution of the program starts. However, the -declaration of library tasks definitely does not fit this model. The -reason for this is that library tasks start as soon as they are declared -(more precisely, as soon as the statement part of the enclosing package -body is reached), that is to say before elaboration -of the program is complete. This means that if such a task calls a -subprogram, or an entry in another task, the callee may or may not be -elaborated yet, and in the standard -Reference Manual model of dynamic elaboration checks, you can even -get timing dependent Program_Error exceptions, since there can be -a race between the elaboration code and the task code. +@item +@emph{No elaboration order exists} -The static model of elaboration in GNAT seeks to avoid all such -dynamic behavior, by being conservative, and the conservative -approach in this particular case is to assume that all the code -in a task body is potentially executed at elaboration time if -a task is declared at the library level. +In this case a compiler must diagnose the situation, and refuse to build an +executable program. -This can definitely result in unexpected circularities. Consider -the following example +@item +@emph{One or more incorrect elaboration orders exist} -@example -package Decls is - task Lib_Task is - entry Start; - end Lib_Task; +In this case a compiler can build an executable program, but +@code{Program_Error} will be raised when the program is run. - type My_Int is new Integer; +@item +@emph{Several elaboration orders exist, some correct, some incorrect} - function Ident (M : My_Int) return My_Int; -end Decls; +In this case the programmer has not controlled the elaboration order. As a +result, a compiler may or may not pick one of the correct orders, and the +program may or may not raise @code{Program_Error} when it is run. This is the +worst possible state because the program may fail on another compiler, or +even another version of the same compiler. -with Utils; -package body Decls is - task body Lib_Task is - begin - accept Start; - Utils.Put_Val (2); - end Lib_Task; - - function Ident (M : My_Int) return My_Int is - begin - return M; - end Ident; -end Decls; +@item +@emph{One or more correct orders exist} -with Decls; -package Utils is - procedure Put_Val (Arg : Decls.My_Int); -end Utils; +In this case a compiler can build an executable program, and the program is +run successfully. This state may be guaranteed by following the outlined +rules, or may be the result of good program architecture. +@end itemize -with Text_IO; -package body Utils is - procedure Put_Val (Arg : Decls.My_Int) is - begin - Text_IO.Put_Line (Decls.My_Int'Image (Decls.Ident (Arg))); - end Put_Val; -end Utils; +Note that one additional advantage of using @code{Elaborate} and @code{Elaborate_All} +is that the program continues to stay in the last state (one or more correct +orders exist) even if maintenance changes the bodies of targets. -with Decls; -procedure Main is -begin - Decls.Lib_Task.Start; -end; -@end example +@node Controlling the Elaboration Order in GNAT,Common Elaboration-model Traits,Controlling the Elaboration Order in Ada,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat id6}@anchor{236}@anchor{gnat_ugn/elaboration_order_handling_in_gnat controlling-the-elaboration-order-in-gnat}@anchor{237} +@section Controlling the Elaboration Order in GNAT -If the above example is compiled in the default static elaboration -mode, then a circularity occurs. The circularity comes from the call -@code{Utils.Put_Val} in the task body of @code{Decls.Lib_Task}. Since -this call occurs in elaboration code, we need an implicit pragma -@code{Elaborate_All} for @code{Utils}. This means that not only must -the spec and body of @code{Utils} be elaborated before the body -of @code{Decls}, but also the spec and body of any unit that is -@emph{with}ed by the body of @code{Utils} must also be elaborated before -the body of @code{Decls}. This is the transitive implication of -pragma @code{Elaborate_All} and it makes sense, because in general -the body of @code{Put_Val} might have a call to something in a -@emph{with}ed unit. -In this case, the body of Utils (actually its spec) @emph{with}s -@code{Decls}. Unfortunately this means that the body of @code{Decls} -must be elaborated before itself, in case there is a call from the -body of @code{Utils}. +In addition to Ada semantics and rules synthesized from them, GNAT offers +three elaboration models to aid the programmer with specifying the correct +elaboration order and to diagnose elaboration problems. -Here is the exact chain of events we are worrying about: +@geindex Dynamic elaboration model @itemize * @item -In the body of @code{Decls} a call is made from within the body of a library -task to a subprogram in the package @code{Utils}. Since this call may -occur at elaboration time (given that the task is activated at elaboration -time), we have to assume the worst, i.e., that the -call does happen at elaboration time. +@emph{Dynamic elaboration model} -@item -This means that the body and spec of @code{Util} must be elaborated before -the body of @code{Decls} so that this call does not cause an access before -elaboration. - -@item -Within the body of @code{Util}, specifically within the body of -@code{Util.Put_Val} there may be calls to any unit @emph{with}ed -by this package. +This is the most permissive of the three elaboration models. When the +dynamic model is in effect, GNAT assumes that all code within all units in +a partition is elaboration code. GNAT performs very few diagnostics and +generates run-time checks to verify the elaboration order of a program. This +behavior is identical to that specified by the Ada Reference Manual. The +dynamic model is enabled with compiler switch @code{-gnatE}. +@end itemize -@item -One such @emph{with}ed package is package @code{Decls}, so there -might be a call to a subprogram in @code{Decls} in @code{Put_Val}. -In fact there is such a call in this example, but we would have to -assume that there was such a call even if it were not there, since -we are not supposed to write the body of @code{Decls} knowing what -is in the body of @code{Utils}; certainly in the case of the -static elaboration model, the compiler does not know what is in -other bodies and must assume the worst. +@geindex Static elaboration model -@item -This means that the spec and body of @code{Decls} must also be -elaborated before we elaborate the unit containing the call, but -that unit is @code{Decls}! This means that the body of @code{Decls} -must be elaborated before itself, and that's a circularity. -@end itemize -Indeed, if you add an explicit pragma @code{Elaborate_All} for @code{Utils} in -the body of @code{Decls} you will get a true Ada Reference Manual -circularity that makes the program illegal. +@itemize * -In practice, we have found that problems with the static model of -elaboration in existing code often arise from library tasks, so -we must address this particular situation. +@item +@emph{Static elaboration model} -Note that if we compile and run the program above, using the dynamic model of -elaboration (that is to say use the @code{-gnatE} switch), -then it compiles, binds, -links, and runs, printing the expected result of 2. Therefore in some sense -the circularity here is only apparent, and we need to capture -the properties of this program that distinguish it from other library-level -tasks that have real elaboration problems. +This is the middle ground of the three models. When the static model is in +effect, GNAT performs extensive diagnostics on a unit-by-unit basis for all +scenarios that elaborate or execute internal targets. GNAT also generates +run-time checks for all external targets and for all scenarios that may +exhibit ABE problems. Finally, GNAT installs implicit @code{Elaborate} and +@code{Elaborate_All} pragmas for server units based on the dependencies of +client units. The static model is the default model in GNAT. +@end itemize -We have four possible answers to this question: +@geindex SPARK elaboration model @itemize * @item -Use the dynamic model of elaboration. +@emph{SPARK elaboration model} -If we use the @code{-gnatE} switch, then as noted above, the program works. -Why is this? If we examine the task body, it is apparent that the task cannot -proceed past the -@code{accept} statement until after elaboration has been completed, because -the corresponding entry call comes from the main program, not earlier. -This is why the dynamic model works here. But that's really giving -up on a precise analysis, and we prefer to take this approach only if we cannot -solve the -problem in any other manner. So let us examine two ways to reorganize -the program to avoid the potential elaboration problem. +This is the most conservative of the three models and enforces the SPARK +rules of elaboration as defined in the SPARK Reference Manual, section 7.7. +The SPARK model is in effect only when a scenario and a target reside in a +region subject to SPARK_Mode On, otherwise the dynamic or static model is in +effect. +@end itemize -@item -Split library tasks into separate packages. +@node Common Elaboration-model Traits,Dynamic Elaboration Model in GNAT,Controlling the Elaboration Order in GNAT,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat common-elaboration-model-traits}@anchor{238}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id7}@anchor{239} +@section Common Elaboration-model Traits -Write separate packages, so that library tasks are isolated from -other declarations as much as possible. Let us look at a variation on -the above program. -@example -package Decls1 is - task Lib_Task is - entry Start; - end Lib_Task; -end Decls1; +All three GNAT models are able to detect elaboration problems related to +dispatching calls and a particular kind of ABE referred to as @emph{guaranteed ABE}. -with Utils; -package body Decls1 is - task body Lib_Task is - begin - accept Start; - Utils.Put_Val (2); - end Lib_Task; -end Decls1; -package Decls2 is - type My_Int is new Integer; - function Ident (M : My_Int) return My_Int; -end Decls2; +@itemize * -with Utils; -package body Decls2 is - function Ident (M : My_Int) return My_Int is - begin - return M; - end Ident; -end Decls2; +@item +@emph{Dispatching calls} -with Decls2; -package Utils is - procedure Put_Val (Arg : Decls2.My_Int); -end Utils; +GNAT installs run-time checks for each primitive subprogram of each tagged +type defined in a partition on the assumption that a dispatching call +invoked at elaboration time will execute one of these primitives. As a +result, a dispatching call that executes a primitive whose body has not +been elaborated yet will raise exception @code{Program_Error} at run time. The +checks can be suppressed using pragma @code{Suppress (Elaboration_Check)}. -with Text_IO; -package body Utils is - procedure Put_Val (Arg : Decls2.My_Int) is - begin - Text_IO.Put_Line (Decls2.My_Int'Image (Decls2.Ident (Arg))); - end Put_Val; -end Utils; +@item +@emph{Guaranteed ABE} -with Decls1; -procedure Main is -begin - Decls1.Lib_Task.Start; -end; -@end example +A guaranteed ABE arises when the body of a target is not elaborated early +enough, and causes all scenarios that directly execute the target to fail. -All we have done is to split @code{Decls} into two packages, one -containing the library task, and one containing everything else. Now -there is no cycle, and the program compiles, binds, links and executes -using the default static model of elaboration. +@example +package body Guaranteed_ABE is + function ABE return Integer; -@item -Declare separate task types. + Val : constant Integer := ABE; + + function ABE return Integer is + begin + ... + end ABE; +end Guaranteed_ABE; +@end example -A significant part of the problem arises because of the use of the -single task declaration form. This means that the elaboration of -the task type, and the elaboration of the task itself (i.e., the -creation of the task) happen at the same time. A good rule -of style in Ada is to always create explicit task types. By -following the additional step of placing task objects in separate -packages from the task type declaration, many elaboration problems -are avoided. Here is another modified example of the example program: +In the example above, the elaboration of @code{Guaranteed_ABE}'s body elaborates +the declaration of @code{Val}. This invokes function @code{ABE}, however the body +of @code{ABE} has not been elaborated yet. GNAT emits similar diagnostics in all +three models: @example -package Decls is - task type Lib_Task_Type is - entry Start; - end Lib_Task_Type; +1. package body Guaranteed_ABE is +2. function ABE return Integer; +3. +4. Val : constant Integer := ABE; + | + >>> warning: cannot call "ABE" before body seen + >>> warning: Program_Error will be raised at run time - type My_Int is new Integer; +5. +6. function ABE return Integer is +7. begin +8. ... +9. end ABE; +10. end Guaranteed_ABE; +@end example +@end itemize - function Ident (M : My_Int) return My_Int; -end Decls; +Note that GNAT emits warnings rather than hard errors whenever it encounters an +elaboration problem. This is because the elaboration model in effect may be too +conservative, or a particular scenario may not be elaborated or executed due to +data and control flow. The warnings can be suppressed with compiler switch +@code{-gnatws}. -with Utils; -package body Decls is - task body Lib_Task_Type is - begin - accept Start; - Utils.Put_Val (2); - end Lib_Task_Type; - - function Ident (M : My_Int) return My_Int is - begin - return M; - end Ident; -end Decls; +@node Dynamic Elaboration Model in GNAT,Static Elaboration Model in GNAT,Common Elaboration-model Traits,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat dynamic-elaboration-model-in-gnat}@anchor{23a}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id8}@anchor{23b} +@section Dynamic Elaboration Model in GNAT -with Decls; -package Utils is - procedure Put_Val (Arg : Decls.My_Int); -end Utils; -with Text_IO; -package body Utils is - procedure Put_Val (Arg : Decls.My_Int) is - begin - Text_IO.Put_Line (Decls.My_Int'Image (Decls.Ident (Arg))); - end Put_Val; -end Utils; +The dynamic model assumes that all code within all units in a partition is +elaboration code. As a result, run-time checks are installed for each scenario +regardless of whether the target is internal or external. The checks can be +suppressed using pragma @code{Suppress (Elaboration_Check)}. This behavior is +identical to that specified by the Ada Reference Manual. The following example +showcases run-time checks installed by GNAT to verify the elaboration state of +package @code{Dynamic_Model}. -with Decls; -package Declst is - Lib_Task : Decls.Lib_Task_Type; -end Declst; +@example +with Server; +package body Dynamic_Model is + procedure API is + begin + ... + end API; + + + package Inst is new Server.Gen; + + T : Server.Task_Type; -with Declst; -procedure Main is begin - Declst.Lib_Task.Start; -end; + + + + Server.Proc; +end Dynamic_Model; @end example -What we have done here is to replace the @code{task} declaration in -package @code{Decls} with a @code{task type} declaration. Then we -introduce a separate package @code{Declst} to contain the actual -task object. This separates the elaboration issues for -the @code{task type} -declaration, which causes no trouble, from the elaboration issues -of the task object, which is also unproblematic, since it is now independent -of the elaboration of @code{Utils}. -This separation of concerns also corresponds to -a generally sound engineering principle of separating declarations -from instances. This version of the program also compiles, binds, links, -and executes, generating the expected output. -@end itemize +The checks verify that the body of a target has been successfully elaborated +before a scenario activates, calls, or instantiates a target. + +Note that no scenario within package @code{Dynamic_Model} calls procedure @code{API}. +In fact, procedure @code{API} may not be invoked by elaboration code within the +partition, however the dynamic model assumes that this can happen. + +The dynamic model emits very few diagnostics, but can make suggestions on +missing @code{Elaborate} and @code{Elaborate_All} pragmas for library-level +scenarios. This information is available when compiler switch @code{-gnatel} +is in effect. -@geindex No_Entry_Calls_In_Elaboration_Code restriction +@example +1. with Server; +2. package body Dynamic_Model is +3. Val : constant Integer := Server.Func; + | + >>> info: call to "Func" during elaboration + >>> info: missing pragma "Elaborate_All" for unit "Server" + +4. end Dynamic_Model; +@end example + +@node Static Elaboration Model in GNAT,SPARK Elaboration Model in GNAT,Dynamic Elaboration Model in GNAT,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat static-elaboration-model-in-gnat}@anchor{23c}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id9}@anchor{23d} +@section Static Elaboration Model in GNAT + + +In contrast to the dynamic model, the static model is more precise in its +analysis of elaboration code. The model makes a clear distinction between +internal and external targets, and resorts to different diagnostics and +run-time checks based on the nature of the target. @itemize * @item -Use No_Entry_Calls_In_Elaboration_Code restriction. +@emph{Internal targets} + +The static model performs extensive diagnostics on scenarios which elaborate +or execute internal targets. The warnings resulting from these diagnostics +are enabled by default, but can be suppressed using compiler switch +@code{-gnatws}. + +@example + 1. package body Static_Model is + 2. generic + 3. with function Func return Integer; + 4. package Gen is + 5. Val : constant Integer := Func; + 6. end Gen; + 7. + 8. function ABE return Integer; + 9. +10. function Cause_ABE return Boolean is +11. package Inst is new Gen (ABE); + | + >>> warning: in instantiation at line 5 + >>> warning: cannot call "ABE" before body seen + >>> warning: Program_Error may be raised at run time + >>> warning: body of unit "Static_Model" elaborated + >>> warning: function "Cause_ABE" called at line 16 + >>> warning: function "ABE" called at line 5, instance at line 11 + +12. begin +13. ... +14. end Cause_ABE; +15. +16. Val : constant Boolean := Cause_ABE; +17. +18. function ABE return Integer is +19. begin +20. ... +21. end ABE; +22. end Static_Model; +@end example + +The example above illustrates an ABE problem within package @code{Static_Model}, +which is hidden by several layers of indirection. The elaboration of package +body @code{Static_Model} elaborates the declaration of @code{Val}. This invokes +function @code{Cause_ABE}, which instantiates generic unit @code{Gen} as @code{Inst}. +The elaboration of @code{Inst} invokes function @code{ABE}, however the body of +@code{ABE} has not been elaborated yet. + +@item +@emph{External targets} + +The static model installs run-time checks to verify the elaboration status +of server targets only when the scenario that elaborates or executes that +target is part of the elaboration code of the client unit. The checks can be +suppressed using pragma @code{Suppress (Elaboration_Check)}. + +@example +with Server; +package body Static_Model is + generic + with function Func return Integer; + package Gen is + Val : constant Integer := Func; + end Gen; + + function Call_Func return Boolean is + + package Inst is new Gen (Server.Func); + begin + ... + end Call_Func; + + Val : constant Boolean := Call_Func; +end Static_Model; +@end example -The previous two approaches described how a program can be restructured -to avoid the special problems caused by library task bodies. in practice, -however, such restructuring may be difficult to apply to existing legacy code, -so we must consider solutions that do not require massive rewriting. +In the example above, the elaboration of package body @code{Static_Model} +elaborates the declaration of @code{Val}. This invokes function @code{Call_Func}, +which instantiates generic unit @code{Gen} as @code{Inst}. The elaboration of +@code{Inst} invokes function @code{Server.Func}. Since @code{Server.Func} is an +external target, GNAT installs a run-time check to verify that its body has +been elaborated. -Let us consider more carefully why our original sample program works -under the dynamic model of elaboration. The reason is that the code -in the task body blocks immediately on the @code{accept} -statement. Now of course there is nothing to prohibit elaboration -code from making entry calls (for example from another library level task), -so we cannot tell in isolation that -the task will not execute the accept statement during elaboration. +In addition to checks, the static model installs implicit @code{Elaborate} and +@code{Elaborate_All} pragmas to guarantee safe elaboration use of server units. +This information is available when compiler switch @code{-gnatel} is in +effect. -However, in practice it is very unusual to see elaboration code -make any entry calls, and the pattern of tasks starting -at elaboration time and then immediately blocking on @code{accept} or -@code{select} statements is very common. What this means is that -the compiler is being too pessimistic when it analyzes the -whole package body as though it might be executed at elaboration -time. +@example + 1. with Server; + 2. package body Static_Model is + 3. generic + 4. with function Func return Integer; + 5. package Gen is + 6. Val : constant Integer := Func; + 7. end Gen; + 8. + 9. function Call_Func return Boolean is +10. package Inst is new Gen (Server.Func); + | + >>> info: instantiation of "Gen" during elaboration + >>> info: in instantiation at line 6 + >>> info: call to "Func" during elaboration + >>> info: in instantiation at line 6 + >>> info: implicit pragma "Elaborate_All" generated for unit "Server" + >>> info: body of unit "Static_Model" elaborated + >>> info: function "Call_Func" called at line 15 + >>> info: function "Func" called at line 6, instance at line 10 + +11. begin +12. ... +13. end Call_Func; +14. +15. Val : constant Boolean := Call_Func; + | + >>> info: call to "Call_Func" during elaboration + +16. end Static_Model; +@end example + +In the example above, the elaboration of package body @code{Static_Model} +elaborates the declaration of @code{Val}. This invokes function @code{Call_Func}, +which instantiates generic unit @code{Gen} as @code{Inst}. The elaboration of +@code{Inst} invokes function @code{Server.Func}. Since @code{Server.Func} is an +external target, GNAT installs an implicit @code{Elaborate_All} pragma for unit +@code{Server}. The pragma guarantees that both the spec and body of @code{Server}, +along with any additional dependencies that @code{Server} may require, are +elaborated prior to the body of @code{Static_Model}. +@end itemize + +@node SPARK Elaboration Model in GNAT,Mixing Elaboration Models,Static Elaboration Model in GNAT,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat id10}@anchor{23e}@anchor{gnat_ugn/elaboration_order_handling_in_gnat spark-elaboration-model-in-gnat}@anchor{23f} +@section SPARK Elaboration Model in GNAT -If we know that the elaboration code contains no entry calls, (a very safe -assumption most of the time, that could almost be made the default -behavior), then we can compile all units of the program under control -of the following configuration pragma: + +The SPARK model is identical to the static model in its handling of internal +targets. The SPARK model, however, requires explicit @code{Elaborate} or +@code{Elaborate_All} pragmas to be present in the program when a target is +external, and compiler switch @code{-gnatd.v} is in effect. @example -pragma Restrictions (No_Entry_Calls_In_Elaboration_Code); -@end example +1. with Server; +2. package body SPARK_Model with SPARK_Mode is +3. Val : constant Integer := Server.Func; + | + >>> call to "Func" during elaboration in SPARK + >>> unit "SPARK_Model" requires pragma "Elaborate_All" for "Server" + >>> body of unit "SPARK_Model" elaborated + >>> function "Func" called at line 3 -This pragma can be placed in the @code{gnat.adc} file in the usual -manner. If we take our original unmodified program and compile it -in the presence of a @code{gnat.adc} containing the above pragma, -then once again, we can compile, bind, link, and execute, obtaining -the expected result. In the presence of this pragma, the compiler does -not trace calls in a task body, that appear after the first @code{accept} -or @code{select} statement, and therefore does not report a potential -circularity in the original program. - -The compiler will check to the extent it can that the above -restriction is not violated, but it is not always possible to do a -complete check at compile time, so it is important to use this -pragma only if the stated restriction is in fact met, that is to say -no task receives an entry call before elaboration of all units is completed. -@end itemize +4. end SPARK_Model; +@end example -@node Mixing Elaboration Models,What to Do If the Default Elaboration Behavior Fails,Elaboration Issues for Library Tasks,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id10}@anchor{23f}@anchor{gnat_ugn/elaboration_order_handling_in_gnat mixing-elaboration-models}@anchor{240} +@node Mixing Elaboration Models,Elaboration Circularities,SPARK Elaboration Model in GNAT,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat mixing-elaboration-models}@anchor{240}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id11}@anchor{241} @section Mixing Elaboration Models -So far, we have assumed that the entire program is either compiled -using the dynamic model or static model, ensuring consistency. It -is possible to mix the two models, but rules have to be followed -if this mixing is done to ensure that elaboration checks are not -omitted. +It is possible to mix units compiled with a different elaboration model, +however the following rules must be observed: + -The basic rule is that -@strong{a unit compiled with the static model cannot -be |withed| by a unit compiled with the dynamic model}. -The reason for this is that in the static model, a unit assumes that -its clients guarantee to use (the equivalent of) pragma -@code{Elaborate_All} so that no elaboration checks are required -in inner subprograms, and this assumption is violated if the -client is compiled with dynamic checks. +@itemize * -The precise rule is as follows. A unit that is compiled with dynamic -checks can only @emph{with} a unit that meets at least one of the -following criteria: +@item +A client unit compiled with the dynamic model can only @emph{with} a server unit +that meets at least one of the following criteria: -@itemize * +@itemize - @item -The @emph{with}ed unit is itself compiled with dynamic elaboration -checks (that is with the @code{-gnatE} switch. +The server unit is compiled with the dynamic model. @item -The @emph{with}ed unit is an internal GNAT implementation unit from -the System, Interfaces, Ada, or GNAT hierarchies. +The server unit is a GNAT implementation unit from the Ada, GNAT, +Interfaces, or System hierarchies. @item -The @emph{with}ed unit has pragma Preelaborate or pragma Pure. +The server unit has pragma @code{Pure} or @code{Preelaborate}. @item -The @emph{with}ing unit (that is the client) has an explicit pragma -@code{Elaborate_All} for the @emph{with}ed unit. +The client unit has an explicit @code{Elaborate_All} pragma for the server +unit. +@end itemize @end itemize -If this rule is violated, that is if a unit with dynamic elaboration -checks @emph{with}s a unit that does not meet one of the above four -criteria, then the binder (@code{gnatbind}) will issue a warning -similar to that in the following example: +These rules ensure that elaboration checks are not omitted. If the rules are +violated, the binder emits a warning: @example warning: "x.ads" has dynamic elaboration checks and with's warning: "y.ads" which has static elaboration checks @end example -These warnings indicate that the rule has been violated, and that as a result -elaboration checks may be missed in the resulting executable file. -This warning may be suppressed using the @code{-ws} binder switch -in the usual manner. +The warnings can be suppressed by binder switch @code{-ws}. + +@node Elaboration Circularities,Resolving Elaboration Circularities,Mixing Elaboration Models,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat id12}@anchor{242}@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-circularities}@anchor{243} +@section Elaboration Circularities -One useful application of this mixing rule is in the case of a subsystem -which does not itself @emph{with} units from the remainder of the -application. In this case, the entire subsystem can be compiled with -dynamic checks to resolve a circularity in the subsystem, while -allowing the main application that uses this subsystem to be compiled -using the more reliable default static model. -@node What to Do If the Default Elaboration Behavior Fails,Elaboration for Indirect Calls,Mixing Elaboration Models,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id11}@anchor{241}@anchor{gnat_ugn/elaboration_order_handling_in_gnat what-to-do-if-the-default-elaboration-behavior-fails}@anchor{23a} -@section What to Do If the Default Elaboration Behavior Fails +If the binder cannot find an acceptable elaboration order, it outputs detailed +diagnostics describing an @strong{elaboration circularity}. + +@example +package Server is + function Func return Integer; +end Server; +@end example +@example +with Client; +package body Server is + function Func return Integer is + begin + ... + end Func; +end Server; +@end example + +@example +with Server; +package Client is + Val : constant Integer := Server.Func; +end Client; +@end example -If the binder cannot find an acceptable order, it outputs detailed -diagnostics. For example: +@example +with Client; +procedure Main is begin null; end Main; +@end example @example error: elaboration circularity detected -info: "proc (body)" must be elaborated before "pack (body)" -info: reason: Elaborate_All probably needed in unit "pack (body)" -info: recompile "pack (body)" with -gnatel -info: for full details -info: "proc (body)" -info: is needed by its spec: -info: "proc (spec)" -info: which is withed by: -info: "pack (body)" -info: "pack (body)" must be elaborated before "proc (body)" -info: reason: pragma Elaborate in unit "proc (body)" -@end example - -In this case we have a cycle that the binder cannot break. On the one -hand, there is an explicit pragma Elaborate in @code{proc} for -@code{pack}. This means that the body of @code{pack} must be elaborated -before the body of @code{proc}. On the other hand, there is elaboration -code in @code{pack} that calls a subprogram in @code{proc}. This means -that for maximum safety, there should really be a pragma -Elaborate_All in @code{pack} for @code{proc} which would require that -the body of @code{proc} be elaborated before the body of -@code{pack}. Clearly both requirements cannot be satisfied. -Faced with a circularity of this kind, you have three different options. +info: "server (body)" must be elaborated before "client (spec)" +info: reason: implicit Elaborate_All in unit "client (spec)" +info: recompile "client (spec)" with -gnatel for full details +info: "server (body)" +info: must be elaborated along with its spec: +info: "server (spec)" +info: which is withed by: +info: "client (spec)" +info: "client (spec)" must be elaborated before "server (body)" +info: reason: with clause +@end example + +In the example above, @code{Client} must be elaborated prior to @code{Main} by virtue +of a @emph{with} clause. The elaboration of @code{Client} invokes @code{Server.Func}, and +static model generates an implicit @code{Elaborate_All} pragma for @code{Server}. The +pragma implies that both the spec and body of @code{Server}, along with any units +they @emph{with}, must be elaborated prior to @code{Client}. However, @code{Server}'s body +@emph{with}s @code{Client}, implying that @code{Client} must be elaborated prior to +@code{Server}. The end result is that @code{Client} must be elaborated prior to +@code{Client}, and this leads to a circularity. + +@node Resolving Elaboration Circularities,Resolving Task Issues,Elaboration Circularities,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat id13}@anchor{244}@anchor{gnat_ugn/elaboration_order_handling_in_gnat resolving-elaboration-circularities}@anchor{245} +@section Resolving Elaboration Circularities + + +When faced with an elaboration circularity, a programmer has several options +available. @itemize * @@ -28458,420 +28186,778 @@ Faced with a circularity of this kind, you have three different options. The most desirable option from the point of view of long-term maintenance is to rearrange the program so that the elaboration problems are avoided. -One useful technique is to place the elaboration code into separate -child packages. Another is to move some of the initialization code to -explicitly called subprograms, where the program controls the order -of initialization explicitly. Although this is the most desirable option, -it may be impractical and involve too much modification, especially in -the case of complex legacy code. +One useful technique is to place the elaboration code into separate child +packages. Another is to move some of the initialization code to explicitly +invoked subprograms, where the program controls the order of initialization +explicitly. Although this is the most desirable option, it may be impractical +and involve too much modification, especially in the case of complex legacy +code. @item -@emph{Perform dynamic checks} +@emph{Switch to more permissive elaboration model} -If the compilations are done using the @code{-gnatE} -(dynamic elaboration check) switch, then GNAT behaves in a quite different -manner. Dynamic checks are generated for all calls that could possibly result -in raising an exception. With this switch, the compiler does not generate -implicit @code{Elaborate} or @code{Elaborate_All} pragmas. The behavior then is -exactly as specified in the @cite{Ada Reference Manual}. -The binder will generate -an executable program that may or may not raise @code{Program_Error}, and then -it is the programmer's job to ensure that it does not raise an exception. Note -that it is important to compile all units with the switch, it cannot be used -selectively. +If the compilation was performed using the static model, enable the dynamic +model with compiler switch @code{-gnatE}. GNAT will no longer generate +implicit @code{Elaborate} and @code{Elaborate_All} pragmas, resulting in a behavior +identical to that specified by the Ada Reference Manual. The binder will +generate an executable program that may or may not raise @code{Program_Error}, +and it is the programmer's responsibility to ensure that it does not raise +@code{Program_Error}. @item -@emph{Suppress checks} +@emph{Suppress all elaboration checks} -The drawback of dynamic checks is that they generate a -significant overhead at run time, both in space and time. If you -are absolutely sure that your program cannot raise any elaboration -exceptions, and you still want to use the dynamic elaboration model, -then you can use the configuration pragma -@code{Suppress (Elaboration_Check)} to suppress all such checks. For -example this pragma could be placed in the @code{gnat.adc} file. +The drawback of run-time checks is that they generate overhead at run time, +both in space and time. If the programmer is absolutely sure that a program +will not raise an elaboration-related @code{Program_Error}, then using the +pragma @code{Suppress (Elaboration_Check)} globally (as a configuration pragma) +will eliminate all run-time checks. @item -@emph{Suppress checks selectively} +@emph{Suppress elaboration checks selectively} -When you know that certain calls or instantiations in elaboration code cannot -possibly lead to an elaboration error, and the binder nevertheless complains -about implicit @code{Elaborate} and @code{Elaborate_All} pragmas that lead to -elaboration circularities, it is possible to remove those warnings locally and -obtain a program that will bind. Clearly this can be unsafe, and it is the -responsibility of the programmer to make sure that the resulting program has no -elaboration anomalies. The pragma @code{Suppress (Elaboration_Check)} can be -used with different granularity to suppress warnings and break elaboration -circularities: +If a scenario cannot possibly lead to an elaboration @code{Program_Error}, +and the binder nevertheless complains about implicit @code{Elaborate} and +@code{Elaborate_All} pragmas that lead to elaboration circularities, it +is possible to suppress the generation of implicit @code{Elaborate} and +@code{Elaborate_All} pragmas, as well as run-time checks. Clearly this can +be unsafe, and it is the responsibility of the programmer to make sure +that the resulting program has no elaboration anomalies. Pragma +@code{Suppress (Elaboration_Check)} can be used with different levels of +granularity to achieve these effects. -@itemize * +@itemize - @item -Place the pragma that names the called subprogram in the declarative part -that contains the call. +@emph{Target suppression} -@item -Place the pragma in the declarative part, without naming an entity. This -disables warnings on all calls in the corresponding declarative region. +When the pragma is placed in a declarative part, without a second argument +naming an entity, it will suppress implicit @code{Elaborate} and +@code{Elaborate_All} pragma generation, as well as run-time checks, on all +targets within the region. -@item -Place the pragma in the package spec that declares the called subprogram, -and name the subprogram. This disables warnings on all elaboration calls to -that subprogram. +@example +package Range_Suppress is + pragma Suppress (Elaboration_Check); + + function Func return Integer; + + generic + procedure Gen; + + pragma Unsuppress (Elaboration_Check); + + task type Tsk; +end Range_Suppress; +@end example + +In the example above, a pair of Suppress/Unsuppress pragmas define a region +of suppression within package @code{Range_Suppress}. As a result, no implicit +@code{Elaborate} and @code{Elaborate_All} pragmas, nor any run-time checks, will +be generated by callers of @code{Func} and instantiators of @code{Gen}. Note that +task type @code{Tsk} is not within this region. + +An alternative to the region-based suppression is to use multiple +@code{Suppress} pragmas with arguments naming specific entities for which +elaboration checks should be suppressed: + +@example +package Range_Suppress is + function Func return Integer; + pragma Suppress (Elaboration_Check, Func); + + generic + procedure Gen; + pragma Suppress (Elaboration_Check, Gen); + + task type Tsk; +end Range_Suppress; +@end example @item -Place the pragma in the package spec that declares the called subprogram, -without naming any entity. This disables warnings on all elaboration calls to -all subprograms declared in this spec. +@emph{Scenario suppression} + +When the pragma @code{Suppress} is placed in a declarative or statement +part, without an entity argument, it will suppress implicit @code{Elaborate} +and @code{Elaborate_All} pragma generation, as well as run-time checks, on +all scenarios within the region. + +@example +with Server; +package body Range_Suppress is + pragma Suppress (Elaboration_Check); + + function Func return Integer is + begin + return Server.Func; + end Func; + + procedure Gen is + begin + Server.Proc; + end Gen; + + pragma Unsuppress (Elaboration_Check); + + task body Tsk is + begin + Server.Proc; + end Tsk; +end Range_Suppress; +@end example + +In the example above, a pair of Suppress/Unsuppress pragmas define a region +of suppression within package body @code{Range_Suppress}. As a result, the +calls to @code{Server.Func} in @code{Func} and @code{Server.Proc} in @code{Gen} will +not generate any implicit @code{Elaborate} and @code{Elaborate_All} pragmas or +run-time checks. +@end itemize +@end itemize + +@node Resolving Task Issues,Elaboration-related Compiler Switches,Resolving Elaboration Circularities,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat id14}@anchor{246}@anchor{gnat_ugn/elaboration_order_handling_in_gnat resolving-task-issues}@anchor{247} +@section Resolving Task Issues + + +The model of execution in Ada dictates that elaboration must first take place, +and only then can the main program be started. Tasks which are activated during +elaboration violate this model and may lead to serious concurrent problems at +elaboration time. + +A task can be activated in two different ways: + + +@itemize * @item -Use Pragma Elaborate. +The task is created by an allocator in which case it is activated immediately +after the allocator is evaluated. -As previously described in section @ref{23b,,Treatment of Pragma Elaborate}, -GNAT in static mode assumes that a @code{pragma} Elaborate indicates correctly -that no elaboration checks are required on calls to the designated unit. -There may be cases in which the caller knows that no transitive calls -can occur, so that a @code{pragma Elaborate} will be sufficient in a -case where @code{pragma Elaborate_All} would cause a circularity. +@item +The task is declared at the library level or within some nested master in +which case it is activated before starting execution of the statement +sequence of the master defining the task. @end itemize -These five cases are listed in order of decreasing safety, and therefore -require increasing programmer care in their application. Consider the -following program: +Since the elaboration of a partition is performed by the environment task +servicing that partition, any tasks activated during elaboration may be in +a race with the environment task, and lead to unpredictable state and behavior. +The static model seeks to avoid such interactions by assuming that all code in +the task body is executed at elaboration time, if the task was activated by +elaboration code. @example -package Pack1 is - function F1 return Integer; - X1 : Integer; -end Pack1; +package Decls is + task Lib_Task is + entry Start; + end Lib_Task; -package Pack2 is - function F2 return Integer; - function Pure (x : integer) return integer; - -- pragma Suppress (Elaboration_Check, On => Pure); -- (3) - -- pragma Suppress (Elaboration_Check); -- (4) -end Pack2; + type My_Int is new Integer; -with Pack2; -package body Pack1 is - function F1 return Integer is - begin - return 100; - end F1; - Val : integer := Pack2.Pure (11); -- Elab. call (1) -begin - declare - -- pragma Suppress(Elaboration_Check, Pack2.F2); -- (1) - -- pragma Suppress(Elaboration_Check); -- (2) - begin - X1 := Pack2.F2 + 1; -- Elab. call (2) - end; -end Pack1; + function Ident (M : My_Int) return My_Int; +end Decls; +@end example -with Pack1; -package body Pack2 is - function F2 return Integer is - begin - return Pack1.F1; - end F2; - function Pure (x : integer) return integer is - begin - return x ** 3 - 3 * x; - end; -end Pack2; +@example +with Utils; +package body Decls is + task body Lib_Task is + begin + accept Start; + Utils.Put_Val (2); + end Lib_Task; + + function Ident (M : My_Int) return My_Int is + begin + return M; + end Ident; +end Decls; +@end example + +@example +with Decls; +package Utils is + procedure Put_Val (Arg : Decls.My_Int); +end Utils; +@end example + +@example +with Ada.Text_IO; use Ada.Text_IO; +package body Utils is + procedure Put_Val (Arg : Decls.My_Int) is + begin + Put_Line (Arg'Img); + end Put_Val; +end Utils; +@end example -with Pack1, Ada.Text_IO; -procedure Proc3 is +@example +with Decls; +procedure Main is begin - Ada.Text_IO.Put_Line(Pack1.X1'Img); -- 101 -end Proc3; + Decls.Lib_Task.Start; +end Main; @end example -In the absence of any pragmas, an attempt to bind this program produces -the following diagnostics: +When the above example is compiled with the static model, an elaboration +circularity arises: @example error: elaboration circularity detected -info: "pack1 (body)" must be elaborated before "pack1 (body)" -info: reason: Elaborate_All probably needed in unit "pack1 (body)" -info: recompile "pack1 (body)" with -gnatel for full details -info: "pack1 (body)" +info: "decls (body)" must be elaborated before "decls (body)" +info: reason: implicit Elaborate_All in unit "decls (body)" +info: recompile "decls (body)" with -gnatel for full details +info: "decls (body)" info: must be elaborated along with its spec: -info: "pack1 (spec)" +info: "decls (spec)" info: which is withed by: -info: "pack2 (body)" -info: which must be elaborated along with its spec: -info: "pack2 (spec)" +info: "utils (spec)" info: which is withed by: -info: "pack1 (body)" +info: "decls (body)" @end example -The sources of the circularity are the two calls to @code{Pack2.Pure} and -@code{Pack2.F2} in the body of @code{Pack1}. We can see that the call to -F2 is safe, even though F2 calls F1, because the call appears after the -elaboration of the body of F1. Therefore the pragma (1) is safe, and will -remove the warning on the call. It is also possible to use pragma (2) -because there are no other potentially unsafe calls in the block. +In the above example, @code{Decls} must be elaborated prior to @code{Main} by virtue +of a with clause. The elaboration of @code{Decls} activates task @code{Lib_Task}. The +static model conservatibely assumes that all code within the body of +@code{Lib_Task} is executed, and generates an implicit @code{Elaborate_All} pragma +for @code{Units} due to the call to @code{Utils.Put_Val}. The pragma implies that +both the spec and body of @code{Utils}, along with any units they @emph{with}, +must be elaborated prior to @code{Decls}. However, @code{Utils}'s spec @emph{with}s +@code{Decls}, implying that @code{Decls} must be elaborated before @code{Utils}. The end +result is that @code{Utils} must be elaborated prior to @code{Utils}, and this +leads to a circularity. -The call to @code{Pure} is safe because this function does not depend on the -state of @code{Pack2}. Therefore any call to this function is safe, and it -is correct to place pragma (3) in the corresponding package spec. +In reality, the example above will not exhibit an ABE problem at run time. +When the body of task @code{Lib_Task} is activated, execution will wait for entry +@code{Start} to be accepted, and the call to @code{Utils.Put_Val} will not take place +at elaboration time. Task @code{Lib_Task} will resume its execution after the main +program is executed because @code{Main} performs a rendezvous with +@code{Lib_Task.Start}, and at that point all units have already been elaborated. +As a result, the static model may seem overly conservative, partly because it +does not take control and data flow into account. -Finally, we could place pragma (4) in the spec of @code{Pack2} to disable -warnings on all calls to functions declared therein. Note that this is not -necessarily safe, and requires more detailed examination of the subprogram -bodies involved. In particular, a call to @code{F2} requires that @code{F1} -be already elaborated. -@end itemize +When faced with a task elaboration circularity, a programmer has several +options available: -It is hard to generalize on which of these four approaches should be -taken. Obviously if it is possible to fix the program so that the default -treatment works, this is preferable, but this may not always be practical. -It is certainly simple enough to use @code{-gnatE} -but the danger in this case is that, even if the GNAT binder -finds a correct elaboration order, it may not always do so, -and certainly a binder from another Ada compiler might not. A -combination of testing and analysis (for which the -information messages generated with the @code{-gnatel} -switch can be useful) must be used to ensure that the program is free -of errors. One switch that is useful in this testing is the -@code{-p} (pessimistic elaboration order) switch for @code{gnatbind}. -Normally the binder tries to find an order that has the best chance -of avoiding elaboration problems. However, if this switch is used, the binder -plays a devil's advocate role, and tries to choose the order that -has the best chance of failing. If your program works even with this -switch, then it has a better chance of being error free, but this is still -not a guarantee. - -For an example of this approach in action, consider the C-tests (executable -tests) from the ACATS suite. If these are compiled and run with the default -treatment, then all but one of them succeed without generating any error -diagnostics from the binder. However, there is one test that fails, and -this is not surprising, because the whole point of this test is to ensure -that the compiler can handle cases where it is impossible to determine -a correct order statically, and it checks that an exception is indeed -raised at run time. - -This one test must be compiled and run using the @code{-gnatE} -switch, and then it passes. Alternatively, the entire suite can -be run using this switch. It is never wrong to run with the dynamic -elaboration switch if your code is correct, and we assume that the -C-tests are indeed correct (it is less efficient, but efficiency is -not a factor in running the ACATS tests.) - -@node Elaboration for Indirect Calls,Summary of Procedures for Elaboration Control,What to Do If the Default Elaboration Behavior Fails,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id12}@anchor{242}@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-for-indirect-calls}@anchor{243} -@section Elaboration for Indirect Calls - - -@geindex Dispatching calls - -@geindex Indirect calls - -In rare cases, the static elaboration model fails to prevent -dispatching calls to not-yet-elaborated subprograms. In such cases, we -fall back to run-time checks; premature calls to any primitive -operation of a tagged type before the body of the operation has been -elaborated will raise @code{Program_Error}. - -Access-to-subprogram types, however, are handled conservatively in many -cases. This was not true in earlier versions of the compiler; you can use -the @code{-gnatd.U} debug switch to revert to the old behavior if the new -conservative behavior causes elaboration cycles. Here, 'conservative' means -that if you do @code{P'Access} during elaboration, the compiler will normally -assume that you might call @code{P} indirectly during elaboration, so it adds an -implicit @code{pragma Elaborate_All} on the library unit containing @code{P}. The -@code{-gnatd.U} switch is safe if you know there are no such calls. If the -program worked before, it will continue to work with @code{-gnatd.U}. But beware -that code modifications such as adding an indirect call can cause erroneous -behavior in the presence of @code{-gnatd.U}. - -These implicit Elaborate_All pragmas are not added in all cases, because -they cause elaboration cycles in certain common code patterns. If you want -even more conservative handling of P'Access, you can use the @code{-gnatd.o} -switch. -See @code{debug.adb} for documentation on the @code{-gnatd...} debug switches. +@itemize * -@node Summary of Procedures for Elaboration Control,Other Elaboration Order Considerations,Elaboration for Indirect Calls,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id13}@anchor{244}@anchor{gnat_ugn/elaboration_order_handling_in_gnat summary-of-procedures-for-elaboration-control}@anchor{245} -@section Summary of Procedures for Elaboration Control +@item +@emph{Use the dynamic model} +The dynamic model does not generate implicit @code{Elaborate} and +@code{Elaborate_All} pragmas. Instead, it will install checks prior to every +call in the example above, thus verifying the successful elaboration of +@code{Utils.Put_Val} in case the call to it takes place at elaboration time. +The dynamic model is enabled with compiler switch @code{-gnatE}. -@geindex Elaboration control +@item +@emph{Isolate the tasks} + +Relocating tasks in their own separate package could decouple them from +dependencies that would otherwise cause an elaboration circularity. The +example above can be rewritten as follows: -First, compile your program with the default options, using none of -the special elaboration-control switches. If the binder successfully -binds your program, then you can be confident that, apart from issues -raised by the use of access-to-subprogram types and dynamic dispatching, -the program is free of elaboration errors. If it is important that the -program be portable to other compilers than GNAT, then use the -@code{-gnatel} -switch to generate messages about missing @code{Elaborate} or -@code{Elaborate_All} pragmas, and supply the missing pragmas. - -If the program fails to bind using the default static elaboration -handling, then you can fix the program to eliminate the binder -message, or recompile the entire program with the -@code{-gnatE} switch to generate dynamic elaboration checks, -and, if you are sure there really are no elaboration problems, -use a global pragma @code{Suppress (Elaboration_Check)}. - -@node Other Elaboration Order Considerations,Determining the Chosen Elaboration Order,Summary of Procedures for Elaboration Control,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat id14}@anchor{246}@anchor{gnat_ugn/elaboration_order_handling_in_gnat other-elaboration-order-considerations}@anchor{247} -@section Other Elaboration Order Considerations - - -This section has been entirely concerned with the issue of finding a valid -elaboration order, as defined by the Ada Reference Manual. In a case -where several elaboration orders are valid, the task is to find one -of the possible valid elaboration orders (and the static model in GNAT -will ensure that this is achieved). - -The purpose of the elaboration rules in the Ada Reference Manual is to -make sure that no entity is accessed before it has been elaborated. For -a subprogram, this means that the spec and body must have been elaborated -before the subprogram is called. For an object, this means that the object -must have been elaborated before its value is read or written. A violation -of either of these two requirements is an access before elaboration order, -and this section has been all about avoiding such errors. - -In the case where more than one order of elaboration is possible, in the -sense that access before elaboration errors are avoided, then any one of -the orders is 'correct' in the sense that it meets the requirements of -the Ada Reference Manual, and no such error occurs. - -However, it may be the case for a given program, that there are -constraints on the order of elaboration that come not from consideration -of avoiding elaboration errors, but rather from extra-lingual logic -requirements. Consider this example: - -@example -with Init_Constants; -package Constants is - X : Integer := 0; - Y : Integer := 0; -end Constants; - -package Init_Constants is - procedure P; --* require a body* -end Init_Constants; - -with Constants; -package body Init_Constants is - procedure P is begin null; end; +@example +package Decls1 is -- new + task Lib_Task is + entry Start; + end Lib_Task; +end Decls1; +@end example + +@example +with Utils; +package body Decls1 is -- new + task body Lib_Task is + begin + accept Start; + Utils.Put_Val (2); + end Lib_Task; +end Decls1; +@end example + +@example +package Decls2 is -- new + type My_Int is new Integer; + function Ident (M : My_Int) return My_Int; +end Decls2; +@end example + +@example +with Utils; +package body Decls2 is -- new + function Ident (M : My_Int) return My_Int is + begin + return M; + end Ident; +end Decls2; +@end example + +@example +with Decls2; +package Utils is + procedure Put_Val (Arg : Decls2.My_Int); +end Utils; +@end example + +@example +with Ada.Text_IO; use Ada.Text_IO; +package body Utils is + procedure Put_Val (Arg : Decls2.My_Int) is + begin + Put_Line (Arg'Img); + end Put_Val; +end Utils; +@end example + +@example +with Decls1; +procedure Main is begin - Constants.X := 3; - Constants.Y := 4; -end Init_Constants; + Decls1.Lib_Task.Start; +end Main; +@end example -with Constants; -package Calc is - Z : Integer := Constants.X + Constants.Y; -end Calc; +@item +@emph{Declare the tasks} -with Calc; -with Text_IO; use Text_IO; +The original example uses a single task declaration for @code{Lib_Task}. An +explicit task type declaration and a properly placed task object could avoid +the dependencies that would otherwise cause an elaboration circularity. The +example can be rewritten as follows: + +@example +package Decls is + task type Lib_Task is -- new + entry Start; + end Lib_Task; + + type My_Int is new Integer; + + function Ident (M : My_Int) return My_Int; +end Decls; +@end example + +@example +with Utils; +package body Decls is + task body Lib_Task is + begin + accept Start; + Utils.Put_Val (2); + end Lib_Task; + + function Ident (M : My_Int) return My_Int is + begin + return M; + end Ident; +end Decls; +@end example + +@example +with Decls; +package Utils is + procedure Put_Val (Arg : Decls.My_Int); +end Utils; +@end example + +@example +with Ada.Text_IO; use Ada.Text_IO; +package body Utils is + procedure Put_Val (Arg : Decls.My_Int) is + begin + Put_Line (Arg'Img); + end Put_Val; +end Utils; +@end example + +@example +with Decls; +package Obj_Decls is -- new + Task_Obj : Decls.Lib_Task; +end Obj_Decls; +@end example + +@example +with Obj_Decls; procedure Main is begin - Put_Line (Calc.Z'Img); + Obj_Decls.Task_Obj.Start; -- new end Main; @end example -In this example, there is more than one valid order of elaboration. For -example both the following are correct orders: +@item +@emph{Use restriction No_Entry_Calls_In_Elaboration_Code} + +The issue exhibited in the original example under this section revolves +around the body of @code{Lib_Task} blocking on an accept statement. There is +no rule to prevent elaboration code from performing entry calls, however in +practice this is highly unusual. In addition, the pattern of starting tasks +at elaboration time and then immediately blocking on accept or select +statements is quite common. + +If a programmer knows that elaboration code will not perform any entry +calls, then the programmer can indicate that the static model should not +process the remainder of a task body once an accept or select statement has +been encountered. This behavior can be specified by a configuration pragma: + +@example +pragma Restrictions (No_Entry_Calls_In_Elaboration_Code); +@end example + +In addition to the change in behavior with respect to task bodies, the +static model will verify that no entry calls take place at elaboration time. +@end itemize + +@node Elaboration-related Compiler Switches,Summary of Procedures for Elaboration Control,Resolving Task Issues,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat elaboration-related-compiler-switches}@anchor{248}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id15}@anchor{249} +@section Elaboration-related Compiler Switches + + +GNAT has several switches that affect the elaboration model and consequently +the elaboration order chosen by the binder. + +@geindex -gnatdE (gnat) + + +@table @asis + +@item @code{-gnatdE} + +Elaboration checks on predefined units + +When this switch is in effect, GNAT will consider scenarios and targets that +come from the Ada, GNAT, Interfaces, and System hierarchies. This switch is +useful when a programmer has defined a custom grandchild of those packages. +@end table + +@geindex -gnatd.G (gnat) + + +@table @asis + +@item @code{-gnatd.G} + +Ignore calls through generic formal parameters for elaboration + +When this switch is in effect, GNAT will ignore calls that invoke generic +actual entries, operators, or subprograms via generic formal subprograms. As +a result, GNAT will not generate implicit @code{Elaborate} and @code{Elaborate_All} +pragmas, and run-time checks for such calls. Note that this switch does not +overlap with @code{-gnatdL}. + +@example +package body Ignore_Calls is + function ABE return Integer; + + generic + with function Gen_Formal return Integer; + package Gen is + Val : constant Integer := Gen_Formal; + end Gen; + + package Inst is new Gen (ABE); + + function ABE return Integer is + begin + ... + end ABE; +end Ignore_Calls; +@end example + +In the example above, the call to function @code{ABE} will be ignored because it +occurs during the elaboration of instance @code{Inst}, through a call to generic +formal subprogram @code{Gen_Formal}. +@end table + +@geindex -gnatdL (gnat) + + +@table @asis + +@item @code{-gnatdL} + +Ignore external calls from instances for elaboration + +When this switch is in effect, GNAT will ignore calls that originate from +within an instance and directly target an entry, operator, or subprogram +defined outside the instance. As a result, GNAT will not generate implicit +@code{Elaborate} and @code{Elaborate_All} pragmas, and run-time checks for such +calls. Note that this switch does not overlap with @code{-gnatd.G}. + +@example +package body Ignore_Calls is + function ABE return Integer; + + generic + package Gen is + Val : constant Integer := ABE; + end Gen; + + package Inst is new Gen; + + function ABE return Integer is + begin + ... + end ABE; +end Ignore_Calls; +@end example + +In the example above, the call to function @code{ABE} will be ignored because it +originates from within an instance and targets a subprogram defined outside +the instance. +@end table + +@geindex -gnatd.o (gnat) + + +@table @asis + +@item @code{-gnatd.o} + +Conservative elaboration order for indirect calls + +When this switch is in effect, GNAT will treat @code{'Access} of an entry, +operator, or subprogram as an immediate call to that target. As a result, +GNAT will generate implicit @code{Elaborate} and @code{Elaborate_All} pragmas as +well as run-time checks for such attribute references. @example -Init_Constants spec -Constants spec -Calc spec -Init_Constants body -Main body + 1. package body Attribute_Call is + 2. function Func return Integer; + 3. type Func_Ptr is access function return Integer; + 4. + 5. Ptr : constant Func_Ptr := Func'Access; + | + >>> warning: cannot call "Func" before body seen + >>> warning: Program_Error may be raised at run time + >>> warning: body of unit "Attribute_Call" elaborated + >>> warning: "Access" of "Func" taken at line 5 + >>> warning: function "Func" called at line 5 + + 6. + 7. function Func return Integer is + 8. begin + 9. ... +10. end Func; +11. end Attribute_Call; @end example -and +In the example above, the elaboration of declaration @code{Ptr} is assigned +@code{Func'Access} before the body of @code{Func} has been elaborated. +@end table + +@geindex -gnatd.U (gnat) + + +@table @asis + +@item @code{-gnatd.U} + +Ignore indirect calls for static elaboration + +When this switch is in effect, GNAT will ignore @code{'Access} of an entry, +operator, or subprogram when the static model is in effect. +@end table + +@geindex -gnatd.v (gnat) + + +@table @asis + +@item @code{-gnatd.v} + +Enforce SPARK elaboration rules in SPARK code + +When this switch is in effect, GNAT will enforce the SPARK rules of +elaboration as defined in the SPARK Reference Manual, section 7.7. As a +result, constructs which violate the SPARK elaboration rules are no longer +accepted, even if GNAT is able to statically ensure that these constructs +will not lead to ABE problems. +@end table + +@geindex -gnatd.y (gnat) + + +@table @asis + +@item @code{-gnatd.y} + +Disable implicit pragma Elaborate[_All] on task bodies + +When this switch is in effect, GNAT will not generate @code{Elaborate} and +@code{Elaborate_All} pragmas if the need for the pragma came directly or +indirectly from a task body. @example -Init_Constants spec -Constants spec -Init_Constants body -Calc spec -Main body +with Server; +package body Disable_Task is + task T; + + task body T is + begin + Server.Proc; + end T; +end Disable_Task; @end example -There is no language rule to prefer one or the other, both are correct -from an order of elaboration point of view. But the programmatic effects -of the two orders are very different. In the first, the elaboration routine -of @code{Calc} initializes @code{Z} to zero, and then the main program -runs with this value of zero. But in the second order, the elaboration -routine of @code{Calc} runs after the body of Init_Constants has set -@code{X} and @code{Y} and thus @code{Z} is set to 7 before @code{Main} runs. +In the example above, the activation of single task @code{T} invokes +@code{Server.Proc}, which implies that @code{Server} requires @code{Elaborate_All}, +however GNAT will not generate the pragma. +@end table + +@geindex -gnatE (gnat) -One could perhaps by applying pretty clever non-artificial intelligence -to the situation guess that it is more likely that the second order of -elaboration is the one desired, but there is no formal linguistic reason -to prefer one over the other. In fact in this particular case, GNAT will -prefer the second order, because of the rule that bodies are elaborated -as soon as possible, but it's just luck that this is what was wanted -(if indeed the second order was preferred). -If the program cares about the order of elaboration routines in a case like -this, it is important to specify the order required. In this particular -case, that could have been achieved by adding to the spec of Calc: +@table @asis + +@item @code{-gnatE} + +Dynamic elaboration checking mode enabled + +When this switch is in effect, GNAT activates the dynamic elaboration model. +@end table + +@geindex -gnatel (gnat) + + +@table @asis + +@item @code{-gnatel} + +Turn on info messages on generated Elaborate[_All] pragmas + +When this switch is in effect, GNAT will emit the following supplementary +information depending on the elaboration model in effect. + + +@itemize - + +@item +@emph{Dynamic model} + +GNAT will indicate missing @code{Elaborate} and @code{Elaborate_All} pragmas for +all library-level scenarios within the partition. + +@item +@emph{Static model} + +GNAT will indicate all scenarios executed during elaboration. In addition, +it will provide detailed traceback when an implicit @code{Elaborate} or +@code{Elaborate_All} pragma is generated. + +@item +@emph{SPARK model} + +GNAT will indicate how an elaboration requirement is met by the context of +a unit. This diagnostic requires compiler switch @code{-gnatd.v}. @example -pragma Elaborate_All (Constants); +1. with Server; pragma Elaborate_All (Server); +2. package Client with SPARK_Mode is +3. Val : constant Integer := Server.Func; + | + >>> info: call to "Func" during elaboration in SPARK + >>> info: "Elaborate_All" requirement for unit "Server" met by pragma at line 1 + +4. end Client; @end example +@end itemize +@end table -which requires that the body (if any) and spec of @code{Constants}, -as well as the body and spec of any unit @emph{with}ed by -@code{Constants} be elaborated before @code{Calc} is elaborated. +@geindex -gnatw.f (gnat) + + +@table @asis -Clearly no automatic method can always guess which alternative you require, -and if you are working with legacy code that had constraints of this kind -which were not properly specified by adding @code{Elaborate} or -@code{Elaborate_All} pragmas, then indeed it is possible that two different -compilers can choose different orders. +@item @code{-gnatw.f} -However, GNAT does attempt to diagnose the common situation where there -are uninitialized variables in the visible part of a package spec, and the -corresponding package body has an elaboration block that directly or -indirectly initializes one or more of these variables. This is the situation -in which a pragma Elaborate_Body is usually desirable, and GNAT will generate -a warning that suggests this addition if it detects this situation. +Turn on warnings for suspicious Subp'Access -The @code{gnatbind` :switch:`-p` switch may be useful in smoking -out problems. This switch causes bodies to be elaborated as late as possible -instead of as early as possible. In the example above, it would have forced -the choice of the first elaboration order. If you get different results -when using this switch, and particularly if one set of results is right, -and one is wrong as far as you are concerned, it shows that you have some -missing `@w{`}Elaborate} pragmas. For the example above, we have the -following output: +When this switch is in effect, GNAT will treat @code{'Access} of an entry, +operator, or subprogram as a potential call to the target and issue warnings: @example -$ gnatmake -f -q main -$ main - 7 -$ gnatmake -f -q main -bargs -p -$ main - 0 + 1. package body Attribute_Call is + 2. function Func return Integer; + 3. type Func_Ptr is access function return Integer; + 4. + 5. Ptr : constant Func_Ptr := Func'Access; + | + >>> warning: "Access" attribute of "Func" before body seen + >>> warning: possible Program_Error on later references + >>> warning: body of unit "Attribute_Call" elaborated + >>> warning: "Access" of "Func" taken at line 5 + + 6. + 7. function Func return Integer is + 8. begin + 9. ... +10. end Func; +11. end Attribute_Call; @end example -It is of course quite unlikely that both these results are correct, so -it is up to you in a case like this to investigate the source of the -difference, by looking at the two elaboration orders that are chosen, -and figuring out which is correct, and then adding the necessary -@code{Elaborate} or @code{Elaborate_All} pragmas to ensure the desired order. +In the example above, the elaboration of declaration @code{Ptr} is assigned +@code{Func'Access} before the body of @code{Func} has been elaborated. +@end table + +@node Summary of Procedures for Elaboration Control,Inspecting the Chosen Elaboration Order,Elaboration-related Compiler Switches,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat summary-of-procedures-for-elaboration-control}@anchor{24a}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id16}@anchor{24b} +@section Summary of Procedures for Elaboration Control -@node Determining the Chosen Elaboration Order,,Other Elaboration Order Considerations,Elaboration Order Handling in GNAT -@anchor{gnat_ugn/elaboration_order_handling_in_gnat determining-the-chosen-elaboration-order}@anchor{248}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id15}@anchor{249} -@section Determining the Chosen Elaboration Order +A programmer should first compile the program with the default options, using +none of the binder or compiler switches. If the binder succeeds in finding an +elaboration order, then apart from possible cases involing dispatching calls +and access-to-subprogram types, the program is free of elaboration errors. +If it is important for the program to be portable to compilers other than GNAT, +then the programmer should use compiler switch @code{-gnatel} and consider +the messages about missing or implicitly created @code{Elaborate} and +@code{Elaborate_All} pragmas. -To see the elaboration order that the binder chooses, you can look at -the last part of the file:@cite{b~xxx.adb} binder output file. Here is an example: +If the binder reports an elaboration circularity, the programmer has several +options: + + +@itemize * + +@item +Ensure that warnings are enabled. This will allow the static model to output +trace information of elaboration issues. The trace information could shed +light on previously unforeseen dependencies, as well as their origins. + +@item +Use switch @code{-gnatel} to obtain messages on generated implicit +@code{Elaborate} and @code{Elaborate_All} pragmas. The trace information could +indicate why a server unit must be elaborated prior to a client unit. + +@item +If the warnings produced by the static model indicate that a task is +involved, consider the options in the section on resolving task issues as +well as compiler switch @code{-gnatd.y}. + +@item +If the warnings produced by the static model indicate that an generic +instantiations are involved, consider using compiler switches +@code{-gnatd.G} and @code{-gnatdL}. + +@item +If none of the steps outlined above resolve the circularity, recompile the +program using the dynamic model by using compiler switch @code{-gnatE}. +@end itemize + +@node Inspecting the Chosen Elaboration Order,,Summary of Procedures for Elaboration Control,Elaboration Order Handling in GNAT +@anchor{gnat_ugn/elaboration_order_handling_in_gnat inspecting-the-chosen-elaboration-order}@anchor{24c}@anchor{gnat_ugn/elaboration_order_handling_in_gnat id17}@anchor{24d} +@section Inspecting the Chosen Elaboration Order + + +To see the elaboration order chosen by the binder, inspect the contents of file +@cite{b~xxx.adb}. On certain targets, this file appears as @cite{b_xxx.adb}. The +elaboration order appears as a sequence of calls to @code{Elab_Body} and +@code{Elab_Spec}, interspersed with assignments to @cite{Exxx} which indicates that a +particular unit is elaborated. For example: @example System.Soft_Links'Elab_Body; @@ -28909,14 +28995,8 @@ Ada.Text_Io'Elab_Body; E07 := True; @end example -Here Elab_Spec elaborates the spec -and Elab_Body elaborates the body. The assignments to the @code{E@emph{xx}} flags -flag that the corresponding body is now elaborated. - -You can also ask the binder to generate a more -readable list of the elaboration order using the -@code{-l} switch when invoking the binder. Here is -an example of the output generated by this switch: +Note also binder switch @code{-l}, which outputs the chosen elaboration +order and provides a more readable form of the above: @example ada (spec) @@ -29006,7 +29086,7 @@ gdbstr (body) @end example @node Inline Assembler,GNU Free Documentation License,Elaboration Order Handling in GNAT,Top -@anchor{gnat_ugn/inline_assembler inline-assembler}@anchor{10}@anchor{gnat_ugn/inline_assembler doc}@anchor{24a}@anchor{gnat_ugn/inline_assembler id1}@anchor{24b} +@anchor{gnat_ugn/inline_assembler inline-assembler}@anchor{10}@anchor{gnat_ugn/inline_assembler doc}@anchor{24e}@anchor{gnat_ugn/inline_assembler id1}@anchor{24f} @chapter Inline Assembler @@ -29065,7 +29145,7 @@ and with assembly language programming. @end menu @node Basic Assembler Syntax,A Simple Example of Inline Assembler,,Inline Assembler -@anchor{gnat_ugn/inline_assembler id2}@anchor{24c}@anchor{gnat_ugn/inline_assembler basic-assembler-syntax}@anchor{24d} +@anchor{gnat_ugn/inline_assembler id2}@anchor{250}@anchor{gnat_ugn/inline_assembler basic-assembler-syntax}@anchor{251} @section Basic Assembler Syntax @@ -29181,7 +29261,7 @@ Intel: Destination first; for example @code{mov eax, 4}@w{ } @node A Simple Example of Inline Assembler,Output Variables in Inline Assembler,Basic Assembler Syntax,Inline Assembler -@anchor{gnat_ugn/inline_assembler a-simple-example-of-inline-assembler}@anchor{24e}@anchor{gnat_ugn/inline_assembler id3}@anchor{24f} +@anchor{gnat_ugn/inline_assembler a-simple-example-of-inline-assembler}@anchor{252}@anchor{gnat_ugn/inline_assembler id3}@anchor{253} @section A Simple Example of Inline Assembler @@ -29330,7 +29410,7 @@ If there are no errors, @code{as} will generate an object file @code{nothing.out}. @node Output Variables in Inline Assembler,Input Variables in Inline Assembler,A Simple Example of Inline Assembler,Inline Assembler -@anchor{gnat_ugn/inline_assembler id4}@anchor{250}@anchor{gnat_ugn/inline_assembler output-variables-in-inline-assembler}@anchor{251} +@anchor{gnat_ugn/inline_assembler id4}@anchor{254}@anchor{gnat_ugn/inline_assembler output-variables-in-inline-assembler}@anchor{255} @section Output Variables in Inline Assembler @@ -29697,7 +29777,7 @@ end Get_Flags_3; @end quotation @node Input Variables in Inline Assembler,Inlining Inline Assembler Code,Output Variables in Inline Assembler,Inline Assembler -@anchor{gnat_ugn/inline_assembler id5}@anchor{252}@anchor{gnat_ugn/inline_assembler input-variables-in-inline-assembler}@anchor{253} +@anchor{gnat_ugn/inline_assembler id5}@anchor{256}@anchor{gnat_ugn/inline_assembler input-variables-in-inline-assembler}@anchor{257} @section Input Variables in Inline Assembler @@ -29786,7 +29866,7 @@ _increment__incr.1: @end quotation @node Inlining Inline Assembler Code,Other Asm Functionality,Input Variables in Inline Assembler,Inline Assembler -@anchor{gnat_ugn/inline_assembler id6}@anchor{254}@anchor{gnat_ugn/inline_assembler inlining-inline-assembler-code}@anchor{255} +@anchor{gnat_ugn/inline_assembler id6}@anchor{258}@anchor{gnat_ugn/inline_assembler inlining-inline-assembler-code}@anchor{259} @section Inlining Inline Assembler Code @@ -29857,7 +29937,7 @@ movl %esi,%eax thus saving the overhead of stack frame setup and an out-of-line call. @node Other Asm Functionality,,Inlining Inline Assembler Code,Inline Assembler -@anchor{gnat_ugn/inline_assembler other-asm-functionality}@anchor{256}@anchor{gnat_ugn/inline_assembler id7}@anchor{257} +@anchor{gnat_ugn/inline_assembler other-asm-functionality}@anchor{25a}@anchor{gnat_ugn/inline_assembler id7}@anchor{25b} @section Other @code{Asm} Functionality @@ -29872,7 +29952,7 @@ and @code{Volatile}, which inhibits unwanted optimizations. @end menu @node The Clobber Parameter,The Volatile Parameter,,Other Asm Functionality -@anchor{gnat_ugn/inline_assembler the-clobber-parameter}@anchor{258}@anchor{gnat_ugn/inline_assembler id8}@anchor{259} +@anchor{gnat_ugn/inline_assembler the-clobber-parameter}@anchor{25c}@anchor{gnat_ugn/inline_assembler id8}@anchor{25d} @subsection The @code{Clobber} Parameter @@ -29936,7 +30016,7 @@ Use 'register' name @code{memory} if you changed a memory location @end itemize @node The Volatile Parameter,,The Clobber Parameter,Other Asm Functionality -@anchor{gnat_ugn/inline_assembler the-volatile-parameter}@anchor{25a}@anchor{gnat_ugn/inline_assembler id9}@anchor{25b} +@anchor{gnat_ugn/inline_assembler the-volatile-parameter}@anchor{25e}@anchor{gnat_ugn/inline_assembler id9}@anchor{25f} @subsection The @code{Volatile} Parameter @@ -29972,7 +30052,7 @@ to @code{True} only if the compiler's optimizations have created problems. @node GNU Free Documentation License,Index,Inline Assembler,Top -@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license doc}@anchor{25c}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{25d} +@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license doc}@anchor{260}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{261} @chapter GNU Free Documentation License diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 34c5b5d0f9a7a..52e84526ca4e8 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -843,7 +843,7 @@ package body Layout is -- Set_Elem_Alignment -- ------------------------ - procedure Set_Elem_Alignment (E : Entity_Id) is + procedure Set_Elem_Alignment (E : Entity_Id; Align : Nat := 0) is begin -- Do not set alignment for packed array types, this is handled in the -- backend. @@ -869,15 +869,12 @@ package body Layout is return; end if; - -- Here we calculate the alignment as the largest power of two multiple - -- of System.Storage_Unit that does not exceed either the object size of - -- the type, or the maximum allowed alignment. + -- We attempt to set the alignment in all the other cases declare S : Int; A : Nat; - - Max_Alignment : Nat; + M : Nat; begin -- The given Esize may be larger that int'last because of a previous @@ -908,7 +905,7 @@ package body Layout is and then S = 8 and then Is_Floating_Point_Type (E) then - Max_Alignment := Ttypes.Target_Double_Float_Alignment; + M := Ttypes.Target_Double_Float_Alignment; -- If the default alignment of "double" or larger scalar types is -- specifically capped, enforce the cap. @@ -917,18 +914,27 @@ package body Layout is and then S >= 8 and then Is_Scalar_Type (E) then - Max_Alignment := Ttypes.Target_Double_Scalar_Alignment; + M := Ttypes.Target_Double_Scalar_Alignment; -- Otherwise enforce the overall alignment cap else - Max_Alignment := Ttypes.Maximum_Alignment; + M := Ttypes.Maximum_Alignment; end if; - A := 1; - while 2 * A <= Max_Alignment and then 2 * A <= S loop - A := 2 * A; - end loop; + -- We calculate the alignment as the largest power-of-two multiple + -- of System.Storage_Unit that does not exceed the object size of + -- the type and the maximum allowed alignment, if none was specified. + -- Otherwise we only cap it to the maximum allowed alignment. + + if Align = 0 then + A := 1; + while 2 * A <= S and then 2 * A <= M loop + A := 2 * A; + end loop; + else + A := Nat'Min (Align, M); + end if; -- If alignment is currently not set, then we can safely set it to -- this new calculated value. diff --git a/gcc/ada/layout.ads b/gcc/ada/layout.ads index 57aa93e4f5ae3..246970fd8fd9b 100644 --- a/gcc/ada/layout.ads +++ b/gcc/ada/layout.ads @@ -74,10 +74,11 @@ package Layout is -- types, the RM_Size is simply set to zero. This routine also sets -- the Is_Constrained flag in Def_Id. - procedure Set_Elem_Alignment (E : Entity_Id); + procedure Set_Elem_Alignment (E : Entity_Id; Align : Nat := 0); -- The front end always sets alignments for elementary types by calling -- this procedure. Note that we have to do this for discrete types (since -- the Alignment attribute is static), so we might as well do it for all - -- elementary types, since the processing is the same. + -- elementary types, as the processing is the same. If Align is nonzero, + -- it is an external alignment setting that we must respect. end Layout; diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index 1419422887f8f..0b0ea7f5057b3 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -214,34 +214,36 @@ package body Lib.Load is Unum := Units.Last; Units.Table (Unum) := - (Cunit => Cunit, - Cunit_Entity => Cunit_Entity, - Dependency_Num => 0, - Dynamic_Elab => False, - Error_Location => Sloc (With_Node), - Expected_Unit => Spec_Name, - Fatal_Error => Error_Detected, - Generate_Code => False, - Has_RACW => False, - Filler => False, - Ident_String => Empty, + (Cunit => Cunit, + Cunit_Entity => Cunit_Entity, + Dependency_Num => 0, + Dynamic_Elab => False, + Error_Location => Sloc (With_Node), + Expected_Unit => Spec_Name, + Fatal_Error => Error_Detected, + Generate_Code => False, + Has_RACW => False, + Filler => False, + Ident_String => Empty, Is_Predefined_Renaming => Ren_Name, Is_Predefined_Unit => Pre_Name or Ren_Name, Is_Internal_Unit => Pre_Name or Ren_Name or GNAT_Name, Filler2 => False, - Loading => False, - Main_Priority => Default_Main_Priority, - Main_CPU => Default_Main_CPU, - Munit_Index => 0, - No_Elab_Code_All => False, - Serial_Number => 0, - Source_Index => No_Source_File, - Unit_File_Name => Fname, - Unit_Name => Spec_Name, - Version => 0, - OA_Setting => 'O'); + Loading => False, + Main_Priority => Default_Main_Priority, + Main_CPU => Default_Main_CPU, + Primary_Stack_Count => 0, + Sec_Stack_Count => 0, + Munit_Index => 0, + No_Elab_Code_All => False, + Serial_Number => 0, + Source_Index => No_Source_File, + Unit_File_Name => Fname, + Unit_Name => Spec_Name, + Version => 0, + OA_Setting => 'O'); Set_Comes_From_Source_Default (Save_CS); Set_Error_Posted (Cunit_Entity); @@ -328,52 +330,59 @@ package body Lib.Load is if Main_Source_File > No_Source_File then Version := Source_Checksum (Main_Source_File); + else -- To avoid emitting a source location (since there is no file), -- we write a custom error message instead of using the machinery -- in errout.adb. Set_Standard_Error; + if Main_Source_File = No_Access_To_Source_File then - Write_Str ("no read access for file """ - & Get_Name_String (Fname) & """"); + Write_Str + ("no read access for file """ & Get_Name_String (Fname) + & """"); else - Write_Str ("file """ - & Get_Name_String (Fname) & """ not found"); + Write_Str + ("file """ & Get_Name_String (Fname) & """ not found"); end if; + Write_Eol; Set_Standard_Output; end if; Units.Table (Main_Unit) := - (Cunit => Empty, - Cunit_Entity => Empty, - Dependency_Num => 0, - Dynamic_Elab => False, - Error_Location => No_Location, - Expected_Unit => No_Unit_Name, - Fatal_Error => None, - Generate_Code => False, - Has_RACW => False, - Filler => False, - Ident_String => Empty, + (Cunit => Empty, + Cunit_Entity => Empty, + Dependency_Num => 0, + Dynamic_Elab => False, + Error_Location => No_Location, + Expected_Unit => No_Unit_Name, + Fatal_Error => None, + Generate_Code => False, + Has_RACW => False, + Filler => False, + Ident_String => Empty, Is_Predefined_Renaming => Ren_Name, Is_Predefined_Unit => Pre_Name or Ren_Name, Is_Internal_Unit => Pre_Name or Ren_Name or GNAT_Name, Filler2 => False, - Loading => True, - Main_Priority => Default_Main_Priority, - Main_CPU => Default_Main_CPU, - Munit_Index => 0, - No_Elab_Code_All => False, - Serial_Number => 0, - Source_Index => Main_Source_File, - Unit_File_Name => Fname, - Unit_Name => No_Unit_Name, - Version => Version, - OA_Setting => 'O'); + Loading => True, + Main_Priority => Default_Main_Priority, + Main_CPU => Default_Main_CPU, + Primary_Stack_Count => 0, + Sec_Stack_Count => 0, + + Munit_Index => 0, + No_Elab_Code_All => False, + Serial_Number => 0, + Source_Index => Main_Source_File, + Unit_File_Name => Fname, + Unit_Name => No_Unit_Name, + Version => Version, + OA_Setting => 'O'); end if; end Load_Main_Source; @@ -724,34 +733,36 @@ package body Lib.Load is if Src_Ind > No_Source_File then Units.Table (Unum) := - (Cunit => Empty, - Cunit_Entity => Empty, - Dependency_Num => 0, - Dynamic_Elab => False, - Error_Location => Sloc (Error_Node), - Expected_Unit => Uname_Actual, - Fatal_Error => None, - Generate_Code => False, - Has_RACW => False, - Filler => False, - Ident_String => Empty, + (Cunit => Empty, + Cunit_Entity => Empty, + Dependency_Num => 0, + Dynamic_Elab => False, + Error_Location => Sloc (Error_Node), + Expected_Unit => Uname_Actual, + Fatal_Error => None, + Generate_Code => False, + Has_RACW => False, + Filler => False, + Ident_String => Empty, Is_Predefined_Renaming => Ren_Name, Is_Predefined_Unit => Pre_Name or Ren_Name, Is_Internal_Unit => Pre_Name or Ren_Name or GNAT_Name, Filler2 => False, - Loading => True, - Main_Priority => Default_Main_Priority, - Main_CPU => Default_Main_CPU, - Munit_Index => 0, - No_Elab_Code_All => False, - Serial_Number => 0, - Source_Index => Src_Ind, - Unit_File_Name => Fname, - Unit_Name => Uname_Actual, - Version => Source_Checksum (Src_Ind), - OA_Setting => 'O'); + Loading => True, + Main_Priority => Default_Main_Priority, + Main_CPU => Default_Main_CPU, + Primary_Stack_Count => 0, + Sec_Stack_Count => 0, + Munit_Index => 0, + No_Elab_Code_All => False, + Serial_Number => 0, + Source_Index => Src_Ind, + Unit_File_Name => Fname, + Unit_Name => Uname_Actual, + Version => Source_Checksum (Src_Ind), + OA_Setting => 'O'); -- Parse the new unit @@ -835,6 +846,7 @@ package body Lib.Load is else Write_Str (" file was not found, load failed"); end if; + Write_Eol; end if; @@ -867,6 +879,7 @@ package body Lib.Load is else Error_Msg_File_1 := Fname; + if Src_Ind = No_Access_To_Source_File then Error_Msg ("no read access to file{", Load_Msg_Sloc); else diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index d263b05dc1c55..47109b4e3f98a 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -96,6 +96,8 @@ package body Lib.Writ is Main_CPU => -1, Munit_Index => 0, No_Elab_Code_All => False, + Primary_Stack_Count => 0, + Sec_Stack_Count => 0, Serial_Number => 0, Version => 0, Error_Location => No_Location, @@ -157,6 +159,8 @@ package body Lib.Writ is Main_CPU => -1, Munit_Index => 0, No_Elab_Code_All => False, + Primary_Stack_Count => 0, + Sec_Stack_Count => 0, Serial_Number => 0, Version => 0, Error_Location => No_Location, @@ -616,6 +620,19 @@ package body Lib.Writ is Write_With_Lines; + -- Generate task stack lines + + if Primary_Stack_Count (Unit_Num) > 0 + or else Sec_Stack_Count (Unit_Num) > 0 + then + Write_Info_Initiate ('T'); + Write_Info_Char (' '); + Write_Info_Int (Primary_Stack_Count (Unit_Num)); + Write_Info_Char (' '); + Write_Info_Int (Sec_Stack_Count (Unit_Num)); + Write_Info_EOL; + end if; + -- Generate the linker option lines for J in 1 .. Linker_Option_Lines.Last loop diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads index f113b0a5993ba..a959e94e2fcca 100644 --- a/gcc/ada/lib-writ.ads +++ b/gcc/ada/lib-writ.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -670,14 +670,33 @@ package Lib.Writ is -- binder do the consistency check, but not include the unit in the -- partition closure (unless it is properly With'ed somewhere). + -- -------------------- + -- -- T Task Stacks -- + -- -------------------- + + -- Following the W lines (if any, or the U line if not), is an optional + -- line that identifies the number of default-sized primary and secondary + -- stacks that the binder needs to create for the tasks declared within the + -- unit. For each compilation unit, a line is present in the form: + + -- T primary-stack-quantity secondary-stack-quantity + + -- The first parameter of T defines the number of task objects declared + -- in the unit that have no Storage_Size specified. The second parameter + -- defines the number of task objects declared in the unit that have no + -- Secondary_Stack_Size specified. These values are non-zero only if + -- the restrictions No_Implicit_Heap_Allocations or + -- No_Implicit_Task_Allocations are active. + -- ----------------------- -- -- L Linker_Options -- -- ----------------------- - -- Following the W lines (if any, or the U line if not), are an optional - -- series of lines that indicates the usage of the pragma Linker_Options in - -- the associated unit. For each appearance of a pragma Linker_Options (or - -- Link_With) in the unit, a line is present with the form: + -- Following the T and W lines (if any, or the U line if not), are + -- an optional series of lines that indicates the usage of the pragma + -- Linker_Options in the associated unit. For each appearance of a pragma + -- Linker_Options (or Link_With) in the unit, a line is present with the + -- form: -- L "string" diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index 9373f9519e73c..02eb1987d8ec2 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -62,7 +62,9 @@ package body Lib is Yes_After, -- S1 is in same extended unit as S2, and appears after it No); -- S2 is not in same extended unit as S2 - function Check_Same_Extended_Unit (S1, S2 : Source_Ptr) return SEU_Result; + function Check_Same_Extended_Unit + (S1 : Source_Ptr; + S2 : Source_Ptr) return SEU_Result; -- Used by In_Same_Extended_Unit and Earlier_In_Extended_Unit. Returns -- value as described above. @@ -176,6 +178,16 @@ package body Lib is return Units.Table (U).OA_Setting; end OA_Setting; + function Primary_Stack_Count (U : Unit_Number_Type) return Int is + begin + return Units.Table (U).Primary_Stack_Count; + end Primary_Stack_Count; + + function Sec_Stack_Count (U : Unit_Number_Type) return Int is + begin + return Units.Table (U).Sec_Stack_Count; + end Sec_Stack_Count; + function Source_Index (U : Unit_Number_Type) return Source_File_Index is begin return Units.Table (U).Source_Index; @@ -273,7 +285,10 @@ package body Lib is -- Check_Same_Extended_Unit -- ------------------------------ - function Check_Same_Extended_Unit (S1, S2 : Source_Ptr) return SEU_Result is + function Check_Same_Extended_Unit + (S1 : Source_Ptr; + S2 : Source_Ptr) return SEU_Result + is Max_Iterations : constant Nat := Maximum_Instantiations * 2; -- Limit to prevent a potential infinite loop @@ -459,6 +474,7 @@ package body Lib is -- Prevent looping forever if Counter > Max_Iterations then + -- ??? Not quite right, but return a value to be able to generate -- SCIL files and hope for the best. @@ -502,11 +518,22 @@ package body Lib is -- Earlier_In_Extended_Unit -- ------------------------------ - function Earlier_In_Extended_Unit (S1, S2 : Source_Ptr) return Boolean is + function Earlier_In_Extended_Unit + (S1 : Source_Ptr; + S2 : Source_Ptr) return Boolean + is begin return Check_Same_Extended_Unit (S1, S2) = Yes_Before; end Earlier_In_Extended_Unit; + function Earlier_In_Extended_Unit + (N1 : Node_Or_Entity_Id; + N2 : Node_Or_Entity_Id) return Boolean + is + begin + return Earlier_In_Extended_Unit (Sloc (N1), Sloc (N2)); + end Earlier_In_Extended_Unit; + ----------------------- -- Exact_Source_Name -- ----------------------- @@ -747,7 +774,9 @@ package body Lib is begin return Get_Code_Or_Source_Unit - (S, Unwind_Instances => True, Unwind_Subunits => False); + (S => S, + Unwind_Instances => True, + Unwind_Subunits => False); end Get_Source_Unit; function Get_Source_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type is @@ -807,8 +836,7 @@ package body Lib is -- Node may be in spec (or subunit etc) of main unit else - return - In_Same_Extended_Unit (N, Cunit (Main_Unit)); + return In_Same_Extended_Unit (N, Cunit (Main_Unit)); end if; end In_Extended_Main_Code_Unit; @@ -828,8 +856,7 @@ package body Lib is -- Location may be in spec (or subunit etc) of main unit else - return - In_Same_Extended_Unit (Loc, Sloc (Cunit (Main_Unit))); + return In_Same_Extended_Unit (Loc, Sloc (Cunit (Main_Unit))); end if; end In_Extended_Main_Code_Unit; @@ -1010,6 +1037,26 @@ package body Lib is return Get_Source_Unit (N1) = Get_Source_Unit (N2); end In_Same_Source_Unit; + ----------------------------------- + -- Increment_Primary_Stack_Count -- + ----------------------------------- + + procedure Increment_Primary_Stack_Count (Increment : Int) is + PSC : Int renames Units.Table (Current_Sem_Unit).Primary_Stack_Count; + begin + PSC := PSC + Increment; + end Increment_Primary_Stack_Count; + + ------------------------------- + -- Increment_Sec_Stack_Count -- + ------------------------------- + + procedure Increment_Sec_Stack_Count (Increment : Int) is + SSC : Int renames Units.Table (Current_Sem_Unit).Sec_Stack_Count; + begin + SSC := SSC + Increment; + end Increment_Sec_Stack_Count; + ----------------------------- -- Increment_Serial_Number -- ----------------------------- diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index a5b9858eaa920..c9686992f5a24 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -370,6 +370,20 @@ package Lib is -- This is a character field containing L if Optimize_Alignment mode -- was set locally, and O/T/S for Off/Time/Space default if not. + -- Primary_Stack_Count + -- The number of primary stacks belonging to tasks defined within the + -- unit that have no Storage_Size specified when the either restriction + -- No_Implicit_Heap_Allocations or No_Implicit_Task_Allocations is + -- active. Only used by the binder to generate stacks for these tasks + -- at bind time. + + -- Sec_Stack_Count + -- The number of secondary stacks belonging to tasks defined within the + -- unit that have no Secondary_Stack_Size specified when the either + -- the No_Implicit_Heap_Allocations or No_Implicit_Task_Allocations + -- restrictions are active. Only used by the binder to generate stacks + -- for these tasks at bind time. + -- Serial_Number -- This field holds a serial number used by New_Internal_Name to -- generate unique temporary numbers on a unit by unit basis. The @@ -441,15 +455,20 @@ package Lib is function Generate_Code (U : Unit_Number_Type) return Boolean; function Ident_String (U : Unit_Number_Type) return Node_Id; function Has_RACW (U : Unit_Number_Type) return Boolean; - function Is_Predefined_Renaming (U : Unit_Number_Type) return Boolean; - function Is_Internal_Unit (U : Unit_Number_Type) return Boolean; - function Is_Predefined_Unit (U : Unit_Number_Type) return Boolean; + function Is_Predefined_Renaming + (U : Unit_Number_Type) return Boolean; + function Is_Internal_Unit (U : Unit_Number_Type) return Boolean; + function Is_Predefined_Unit + (U : Unit_Number_Type) return Boolean; function Loading (U : Unit_Number_Type) return Boolean; function Main_CPU (U : Unit_Number_Type) return Int; function Main_Priority (U : Unit_Number_Type) return Int; function Munit_Index (U : Unit_Number_Type) return Nat; function No_Elab_Code_All (U : Unit_Number_Type) return Boolean; function OA_Setting (U : Unit_Number_Type) return Character; + function Primary_Stack_Count + (U : Unit_Number_Type) return Int; + function Sec_Stack_Count (U : Unit_Number_Type) return Int; function Source_Index (U : Unit_Number_Type) return Source_File_Index; function Unit_File_Name (U : Unit_Number_Type) return File_Name_Type; function Unit_Name (U : Unit_Number_Type) return Unit_Name_Type; @@ -481,13 +500,20 @@ package Lib is -- avoid registering switches added automatically by the gcc driver at the -- end of the command line. - function Earlier_In_Extended_Unit (S1, S2 : Source_Ptr) return Boolean; + function Earlier_In_Extended_Unit + (S1 : Source_Ptr; + S2 : Source_Ptr) return Boolean; -- Given two Sloc values for which In_Same_Extended_Unit is true, determine -- if S1 appears before S2. Returns True if S1 appears before S2, and False -- otherwise. The result is undefined if S1 and S2 are not in the same -- extended unit. Note: this routine will not give reliable results if -- called after Sprint has been called with -gnatD set. + function Earlier_In_Extended_Unit + (N1 : Node_Or_Entity_Id; + N2 : Node_Or_Entity_Id) return Boolean; + -- Same as above, but the inputs denote nodes or entities + procedure Enable_Switch_Storing; -- Enable registration of switches by Store_Compilation_Switch. Used to -- avoid registering switches added automatically by the gcc driver at the @@ -655,6 +681,13 @@ package Lib is -- source unit, the criterion being that Get_Source_Unit yields the -- same value for each argument. + procedure Increment_Primary_Stack_Count (Increment : Int); + -- Increment the Primary_Stack_Count field for the current unit by + -- Increment. + + procedure Increment_Sec_Stack_Count (Increment : Int); + -- Increment the Sec_Stack_Count field for the current unit by Increment + function Increment_Serial_Number return Nat; -- Increment Serial_Number field for current unit, and return the -- incremented value. @@ -787,6 +820,8 @@ private pragma Inline (Fatal_Error); pragma Inline (Generate_Code); pragma Inline (Has_RACW); + pragma Inline (Increment_Primary_Stack_Count); + pragma Inline (Increment_Sec_Stack_Count); pragma Inline (Increment_Serial_Number); pragma Inline (Loading); pragma Inline (Main_CPU); @@ -802,6 +837,8 @@ private pragma Inline (Is_Predefined_Renaming); pragma Inline (Is_Internal_Unit); pragma Inline (Is_Predefined_Unit); + pragma Inline (Primary_Stack_Count); + pragma Inline (Sec_Stack_Count); pragma Inline (Set_Loading); pragma Inline (Set_Main_CPU); pragma Inline (Set_Main_Priority); @@ -815,28 +852,30 @@ private -- The Units Table type Unit_Record is record - Unit_File_Name : File_Name_Type; - Unit_Name : Unit_Name_Type; - Munit_Index : Nat; - Expected_Unit : Unit_Name_Type; - Source_Index : Source_File_Index; - Cunit : Node_Id; - Cunit_Entity : Entity_Id; - Dependency_Num : Int; - Ident_String : Node_Id; - Main_Priority : Int; - Main_CPU : Int; - Serial_Number : Nat; - Version : Word; - Error_Location : Source_Ptr; - Fatal_Error : Fatal_Type; - Generate_Code : Boolean; - Has_RACW : Boolean; - Dynamic_Elab : Boolean; - No_Elab_Code_All : Boolean; - Filler : Boolean; - Loading : Boolean; - OA_Setting : Character; + Unit_File_Name : File_Name_Type; + Unit_Name : Unit_Name_Type; + Munit_Index : Nat; + Expected_Unit : Unit_Name_Type; + Source_Index : Source_File_Index; + Cunit : Node_Id; + Cunit_Entity : Entity_Id; + Dependency_Num : Int; + Ident_String : Node_Id; + Main_Priority : Int; + Main_CPU : Int; + Primary_Stack_Count : Int; + Sec_Stack_Count : Int; + Serial_Number : Nat; + Version : Word; + Error_Location : Source_Ptr; + Fatal_Error : Fatal_Type; + Generate_Code : Boolean; + Has_RACW : Boolean; + Dynamic_Elab : Boolean; + No_Elab_Code_All : Boolean; + Filler : Boolean; + Loading : Boolean; + OA_Setting : Character; Is_Predefined_Renaming : Boolean; Is_Internal_Unit : Boolean; @@ -849,36 +888,38 @@ private -- written by Tree_Gen, we do not write uninitialized values to the file. for Unit_Record use record - Unit_File_Name at 0 range 0 .. 31; - Unit_Name at 4 range 0 .. 31; - Munit_Index at 8 range 0 .. 31; - Expected_Unit at 12 range 0 .. 31; - Source_Index at 16 range 0 .. 31; - Cunit at 20 range 0 .. 31; - Cunit_Entity at 24 range 0 .. 31; - Dependency_Num at 28 range 0 .. 31; - Ident_String at 32 range 0 .. 31; - Main_Priority at 36 range 0 .. 31; - Main_CPU at 40 range 0 .. 31; - Serial_Number at 44 range 0 .. 31; - Version at 48 range 0 .. 31; - Error_Location at 52 range 0 .. 31; - Fatal_Error at 56 range 0 .. 7; - Generate_Code at 57 range 0 .. 7; - Has_RACW at 58 range 0 .. 7; - Dynamic_Elab at 59 range 0 .. 7; - No_Elab_Code_All at 60 range 0 .. 7; - Filler at 61 range 0 .. 7; - OA_Setting at 62 range 0 .. 7; - Loading at 63 range 0 .. 7; - - Is_Predefined_Renaming at 64 range 0 .. 7; - Is_Internal_Unit at 65 range 0 .. 7; - Is_Predefined_Unit at 66 range 0 .. 7; - Filler2 at 67 range 0 .. 7; + Unit_File_Name at 0 range 0 .. 31; + Unit_Name at 4 range 0 .. 31; + Munit_Index at 8 range 0 .. 31; + Expected_Unit at 12 range 0 .. 31; + Source_Index at 16 range 0 .. 31; + Cunit at 20 range 0 .. 31; + Cunit_Entity at 24 range 0 .. 31; + Dependency_Num at 28 range 0 .. 31; + Ident_String at 32 range 0 .. 31; + Main_Priority at 36 range 0 .. 31; + Main_CPU at 40 range 0 .. 31; + Primary_Stack_Count at 44 range 0 .. 31; + Sec_Stack_Count at 48 range 0 .. 31; + Serial_Number at 52 range 0 .. 31; + Version at 56 range 0 .. 31; + Error_Location at 60 range 0 .. 31; + Fatal_Error at 64 range 0 .. 7; + Generate_Code at 65 range 0 .. 7; + Has_RACW at 66 range 0 .. 7; + Dynamic_Elab at 67 range 0 .. 7; + No_Elab_Code_All at 68 range 0 .. 7; + Filler at 69 range 0 .. 7; + OA_Setting at 70 range 0 .. 7; + Loading at 71 range 0 .. 7; + + Is_Predefined_Renaming at 72 range 0 .. 7; + Is_Internal_Unit at 73 range 0 .. 7; + Is_Predefined_Unit at 74 range 0 .. 7; + Filler2 at 75 range 0 .. 7; end record; - for Unit_Record'Size use 68 * 8; + for Unit_Record'Size use 76 * 8; -- This ensures that we did not leave out any fields package Units is new Table.Table ( diff --git a/gcc/ada/libgnarl/s-osinte__linux.ads b/gcc/ada/libgnarl/s-osinte__linux.ads index 87da7ff01a575..a2ba537fb3738 100644 --- a/gcc/ada/libgnarl/s-osinte__linux.ads +++ b/gcc/ada/libgnarl/s-osinte__linux.ads @@ -448,6 +448,9 @@ package System.OS_Interface is abstime : access timespec) return int; pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); + Relative_Timed_Wait : constant Boolean := False; + -- pthread_cond_timedwait requires an absolute delay time + -------------------------- -- POSIX.1c Section 13 -- -------------------------- diff --git a/gcc/ada/libgnarl/s-solita.adb b/gcc/ada/libgnarl/s-solita.adb index bb38578b06f0c..a5485aa268d74 100644 --- a/gcc/ada/libgnarl/s-solita.adb +++ b/gcc/ada/libgnarl/s-solita.adb @@ -44,6 +44,7 @@ with Ada.Exceptions.Is_Null_Occurrence; with System.Task_Primitives.Operations; with System.Tasking; with System.Stack_Checking; +with System.Secondary_Stack; package body System.Soft_Links.Tasking is @@ -52,6 +53,8 @@ package body System.Soft_Links.Tasking is use Ada.Exceptions; + use type System.Secondary_Stack.SS_Stack_Ptr; + use type System.Tasking.Task_Id; use type System.Tasking.Termination_Handler; @@ -71,8 +74,8 @@ package body System.Soft_Links.Tasking is procedure Set_Jmpbuf_Address (Addr : Address); -- Get/Set Jmpbuf_Address for current task - function Get_Sec_Stack_Addr return Address; - procedure Set_Sec_Stack_Addr (Addr : Address); + function Get_Sec_Stack return SST.SS_Stack_Ptr; + procedure Set_Sec_Stack (Stack : SST.SS_Stack_Ptr); -- Get/Set location of current task's secondary stack procedure Timed_Delay_T (Time : Duration; Mode : Integer); @@ -93,14 +96,14 @@ package body System.Soft_Links.Tasking is return STPO.Self.Common.Compiler_Data.Jmpbuf_Address; end Get_Jmpbuf_Address; - function Get_Sec_Stack_Addr return Address is + function Get_Sec_Stack return SST.SS_Stack_Ptr is begin - return Result : constant Address := - STPO.Self.Common.Compiler_Data.Sec_Stack_Addr + return Result : constant SST.SS_Stack_Ptr := + STPO.Self.Common.Compiler_Data.Sec_Stack_Ptr do - pragma Assert (Result /= Null_Address); + pragma Assert (Result /= null); end return; - end Get_Sec_Stack_Addr; + end Get_Sec_Stack; function Get_Stack_Info return Stack_Checking.Stack_Access is begin @@ -116,10 +119,10 @@ package body System.Soft_Links.Tasking is STPO.Self.Common.Compiler_Data.Jmpbuf_Address := Addr; end Set_Jmpbuf_Address; - procedure Set_Sec_Stack_Addr (Addr : Address) is + procedure Set_Sec_Stack (Stack : SST.SS_Stack_Ptr) is begin - STPO.Self.Common.Compiler_Data.Sec_Stack_Addr := Addr; - end Set_Sec_Stack_Addr; + STPO.Self.Common.Compiler_Data.Sec_Stack_Ptr := Stack; + end Set_Sec_Stack; ------------------- -- Timed_Delay_T -- @@ -213,20 +216,20 @@ package body System.Soft_Links.Tasking is SSL.Get_Jmpbuf_Address := Get_Jmpbuf_Address'Access; SSL.Set_Jmpbuf_Address := Set_Jmpbuf_Address'Access; - SSL.Get_Sec_Stack_Addr := Get_Sec_Stack_Addr'Access; + SSL.Get_Sec_Stack := Get_Sec_Stack'Access; SSL.Get_Stack_Info := Get_Stack_Info'Access; - SSL.Set_Sec_Stack_Addr := Set_Sec_Stack_Addr'Access; + SSL.Set_Sec_Stack := Set_Sec_Stack'Access; SSL.Timed_Delay := Timed_Delay_T'Access; SSL.Task_Termination_Handler := Task_Termination_Handler_T'Access; -- No need to create a new secondary stack, since we will use the -- default one created in s-secsta.adb. - SSL.Set_Sec_Stack_Addr (SSL.Get_Sec_Stack_Addr_NT); + SSL.Set_Sec_Stack (SSL.Get_Sec_Stack_NT); SSL.Set_Jmpbuf_Address (SSL.Get_Jmpbuf_Address_NT); end if; - pragma Assert (Get_Sec_Stack_Addr /= Null_Address); + pragma Assert (Get_Sec_Stack /= null); end Init_Tasking_Soft_Links; end System.Soft_Links.Tasking; diff --git a/gcc/ada/libgnarl/s-taprob.adb b/gcc/ada/libgnarl/s-taprob.adb index 517b92d8af280..c4d33c5336554 100644 --- a/gcc/ada/libgnarl/s-taprob.adb +++ b/gcc/ada/libgnarl/s-taprob.adb @@ -75,7 +75,7 @@ package body System.Tasking.Protected_Objects is begin if Init_Priority = Unspecified_Priority then - Init_Priority := System.Priority'Last; + Init_Priority := System.Priority'Last; end if; Initialize_Lock (Init_Priority, Object.L'Access); diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb index 1dfcf39dd81a0..5da10824a157d 100644 --- a/gcc/ada/libgnarl/s-taprop__linux.adb +++ b/gcc/ada/libgnarl/s-taprop__linux.adb @@ -38,9 +38,7 @@ pragma Polling (Off); -- Turn off polling, we do not want ATC polling to take place during tasking -- operations. It causes infinite loops and other problems. -with Interfaces.C; use Interfaces; -use type Interfaces.C.int; -use type Interfaces.C.long; +with Interfaces.C; use Interfaces; use type Interfaces.C.int; with System.Task_Info; with System.Tasking.Debug; @@ -112,8 +110,6 @@ package body System.Task_Primitives.Operations is -- Constant to indicate that the thread identifier has not yet been -- initialized. - Base_Monotonic_Clock : Duration := 0.0; - -------------------- -- Local Packages -- -------------------- @@ -141,6 +137,38 @@ package body System.Task_Primitives.Operations is package body Specific is separate; -- The body of this package is target specific + package Monotonic is + + function Monotonic_Clock return Duration; + pragma Inline (Monotonic_Clock); + -- Returns "absolute" time, represented as an offset relative to "the + -- Epoch", which is Jan 1, 1970. This clock implementation is immune to + -- the system's clock changes. + + function RT_Resolution return Duration; + pragma Inline (RT_Resolution); + -- Returns resolution of the underlying clock used to implement RT_Clock + + procedure Timed_Sleep + (Self_ID : ST.Task_Id; + Time : Duration; + Mode : ST.Delay_Modes; + Reason : System.Tasking.Task_States; + Timedout : out Boolean; + Yielded : out Boolean); + -- Combination of Sleep (above) and Timed_Delay + + procedure Timed_Delay + (Self_ID : ST.Task_Id; + Time : Duration; + Mode : ST.Delay_Modes); + -- Implement the semantics of the delay statement. + -- The caller should be abort-deferred and should not hold any locks. + + end Monotonic; + + package body Monotonic is separate; + ---------------------------------- -- ATCB allocation/deallocation -- ---------------------------------- @@ -152,11 +180,16 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread + function Register_Foreign_Thread + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) return Task_Id; + -- Allocate and initialize a new ATCB for the current Thread. The size of + -- the secondary stack can be optionally specified. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_Id is separate; + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) + return Task_Id is separate; ----------------------- -- Local Subprograms -- @@ -164,11 +197,6 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (signo : Signal); - function Compute_Base_Monotonic_Clock return Duration; - -- The monotonic clock epoch is set to some undetermined time in the past - -- (typically system boot time). In order to use the monotonic clock for - -- absolute time, the offset from a known epoch is needed. - function GNAT_pthread_condattr_setup (attr : access pthread_condattr_t) return C.int; pragma Import @@ -270,100 +298,6 @@ package body System.Task_Primitives.Operations is end if; end Abort_Handler; - ---------------------------------- - -- Compute_Base_Monotonic_Clock -- - ---------------------------------- - - function Compute_Base_Monotonic_Clock return Duration is - Aft : Duration; - Bef : Duration; - Mon : Duration; - Res_A : Interfaces.C.int; - Res_B : Interfaces.C.int; - Res_M : Interfaces.C.int; - TS_Aft : aliased timespec; - TS_Aft0 : aliased timespec; - TS_Bef : aliased timespec; - TS_Bef0 : aliased timespec; - TS_Mon : aliased timespec; - TS_Mon0 : aliased timespec; - - begin - Res_B := - clock_gettime - (clock_id => OSC.CLOCK_REALTIME, - tp => TS_Bef0'Unchecked_Access); - pragma Assert (Res_B = 0); - - Res_M := - clock_gettime - (clock_id => OSC.CLOCK_RT_Ada, - tp => TS_Mon0'Unchecked_Access); - pragma Assert (Res_M = 0); - - Res_A := - clock_gettime - (clock_id => OSC.CLOCK_REALTIME, - tp => TS_Aft0'Unchecked_Access); - pragma Assert (Res_A = 0); - - for I in 1 .. 10 loop - - -- Guard against a leap second that will cause CLOCK_REALTIME to jump - -- backwards. In the extrenmely unlikely event we call clock_gettime - -- before and after the jump the epoch, the result will be off - -- slightly. - -- Use only results where the tv_sec values match, for the sake of - -- convenience. - -- Also try to calculate the most accurate epoch by taking the - -- minimum difference of 10 tries. - - Res_B := - clock_gettime - (clock_id => OSC.CLOCK_REALTIME, - tp => TS_Bef'Unchecked_Access); - pragma Assert (Res_B = 0); - - Res_M := - clock_gettime - (clock_id => OSC.CLOCK_RT_Ada, - tp => TS_Mon'Unchecked_Access); - pragma Assert (Res_M = 0); - - Res_A := - clock_gettime - (clock_id => OSC.CLOCK_REALTIME, - tp => TS_Aft'Unchecked_Access); - pragma Assert (Res_A = 0); - - -- The calls to clock_gettime before the loop were no good - - if (TS_Bef0.tv_sec /= TS_Aft0.tv_sec - and then TS_Bef.tv_sec = TS_Aft.tv_sec) - - -- The most recent calls to clock_gettime were better - - or else - (TS_Bef0.tv_sec = TS_Aft0.tv_sec - and then TS_Bef.tv_sec = TS_Aft.tv_sec - and then (TS_Aft.tv_nsec - TS_Bef.tv_nsec - < TS_Aft0.tv_nsec - TS_Bef0.tv_nsec)) - then - TS_Bef0 := TS_Bef; - TS_Aft0 := TS_Aft; - TS_Mon0 := TS_Mon; - end if; - end loop; - - Bef := To_Duration (TS_Bef0); - Mon := To_Duration (TS_Mon0); - Aft := To_Duration (TS_Aft0); - - -- Distribute the division, to avoid potential type overflow someday - - return Bef / 2 + Aft / 2 - Mon; - end Compute_Base_Monotonic_Clock; - -------------- -- Lock_RTS -- -------------- @@ -685,56 +619,7 @@ package body System.Task_Primitives.Operations is Mode : ST.Delay_Modes; Reason : System.Tasking.Task_States; Timedout : out Boolean; - Yielded : out Boolean) - is - pragma Unreferenced (Reason); - - Base_Time : constant Duration := Monotonic_Clock; - Check_Time : Duration := Base_Time - Base_Monotonic_Clock; - Abs_Time : Duration; - Request : aliased timespec; - Result : C.int; - - begin - Timedout := True; - Yielded := False; - - Abs_Time := - (if Mode = Relative - then Duration'Min (Time, Max_Sensible_Delay) + Check_Time - else Duration'Min (Check_Time + Max_Sensible_Delay, - Time - Base_Monotonic_Clock)); - - if Abs_Time > Check_Time then - Request := To_Timespec (Abs_Time); - - loop - exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; - - Result := - pthread_cond_timedwait - (cond => Self_ID.Common.LL.CV'Access, - mutex => (if Single_Lock - then Single_RTS_Lock'Access - else Self_ID.Common.LL.L'Access), - abstime => Request'Access); - - Check_Time := Monotonic_Clock; - exit when Abs_Time + Base_Monotonic_Clock <= Check_Time - or else Check_Time < Base_Time; - - if Result in 0 | EINTR then - - -- Somebody may have called Wakeup for us - - Timedout := False; - exit; - end if; - - pragma Assert (Result = ETIMEDOUT); - end loop; - end if; - end Timed_Sleep; + Yielded : out Boolean) renames Monotonic.Timed_Sleep; ----------------- -- Timed_Delay -- @@ -746,92 +631,19 @@ package body System.Task_Primitives.Operations is procedure Timed_Delay (Self_ID : Task_Id; Time : Duration; - Mode : ST.Delay_Modes) - is - Base_Time : constant Duration := Monotonic_Clock; - Check_Time : Duration := Base_Time - Base_Monotonic_Clock; - Abs_Time : Duration; - Request : aliased timespec; - - Result : C.int; - pragma Warnings (Off, Result); - - begin - if Single_Lock then - Lock_RTS; - end if; - - Write_Lock (Self_ID); - - Abs_Time := - (if Mode = Relative - then Time + Check_Time - else Duration'Min (Check_Time + Max_Sensible_Delay, - Time - Base_Monotonic_Clock)); - - if Abs_Time > Check_Time then - Request := To_Timespec (Abs_Time); - Self_ID.Common.State := Delay_Sleep; - - loop - exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; - - Result := - pthread_cond_timedwait - (cond => Self_ID.Common.LL.CV'Access, - mutex => (if Single_Lock - then Single_RTS_Lock'Access - else Self_ID.Common.LL.L'Access), - abstime => Request'Access); - - Check_Time := Monotonic_Clock; - exit when Abs_Time + Base_Monotonic_Clock <= Check_Time - or else Check_Time < Base_Time; - - pragma Assert (Result in 0 | ETIMEDOUT | EINTR); - end loop; - - Self_ID.Common.State := Runnable; - end if; - - Unlock (Self_ID); - - if Single_Lock then - Unlock_RTS; - end if; - - Result := sched_yield; - end Timed_Delay; + Mode : ST.Delay_Modes) renames Monotonic.Timed_Delay; --------------------- -- Monotonic_Clock -- --------------------- - function Monotonic_Clock return Duration is - TS : aliased timespec; - Result : Interfaces.C.int; - begin - Result := clock_gettime - (clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access); - pragma Assert (Result = 0); - - return Base_Monotonic_Clock + To_Duration (TS); - end Monotonic_Clock; + function Monotonic_Clock return Duration renames Monotonic.Monotonic_Clock; ------------------- -- RT_Resolution -- ------------------- - function RT_Resolution return Duration is - TS : aliased timespec; - Result : C.int; - - begin - Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access); - pragma Assert (Result = 0); - - return To_Duration (TS); - end RT_Resolution; + function RT_Resolution return Duration renames Monotonic.RT_Resolution; ------------ -- Wakeup -- @@ -1607,8 +1419,6 @@ package body System.Task_Primitives.Operations is Interrupt_Management.Initialize; - Base_Monotonic_Clock := Compute_Base_Monotonic_Clock; - -- Prepare the set of signals that should be unblocked in all tasks Result := sigemptyset (Unblocked_Signal_Mask'Access); diff --git a/gcc/ada/libgnarl/s-taprop__mingw.adb b/gcc/ada/libgnarl/s-taprop__mingw.adb index fa96651456886..b14444ad1850c 100644 --- a/gcc/ada/libgnarl/s-taprop__mingw.adb +++ b/gcc/ada/libgnarl/s-taprop__mingw.adb @@ -190,11 +190,16 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread + function Register_Foreign_Thread + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) return Task_Id; + -- Allocate and initialize a new ATCB for the current Thread. The size of + -- the secondary stack can be optionally specified. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_Id is separate; + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) + return Task_Id is separate; ---------------------------------- -- Condition Variable Functions -- diff --git a/gcc/ada/libgnarl/s-taprop__posix.adb b/gcc/ada/libgnarl/s-taprop__posix.adb index 3efc1e0de1a2c..d9ee078b36490 100644 --- a/gcc/ada/libgnarl/s-taprop__posix.adb +++ b/gcc/ada/libgnarl/s-taprop__posix.adb @@ -145,6 +145,38 @@ package body System.Task_Primitives.Operations is package body Specific is separate; -- The body of this package is target specific + package Monotonic is + + function Monotonic_Clock return Duration; + pragma Inline (Monotonic_Clock); + -- Returns "absolute" time, represented as an offset relative to "the + -- Epoch", which is Jan 1, 1970. This clock implementation is immune to + -- the system's clock changes. + + function RT_Resolution return Duration; + pragma Inline (RT_Resolution); + -- Returns resolution of the underlying clock used to implement RT_Clock + + procedure Timed_Sleep + (Self_ID : ST.Task_Id; + Time : Duration; + Mode : ST.Delay_Modes; + Reason : System.Tasking.Task_States; + Timedout : out Boolean; + Yielded : out Boolean); + -- Combination of Sleep (above) and Timed_Delay + + procedure Timed_Delay + (Self_ID : ST.Task_Id; + Time : Duration; + Mode : ST.Delay_Modes); + -- Implement the semantics of the delay statement. + -- The caller should be abort-deferred and should not hold any locks. + + end Monotonic; + + package body Monotonic is separate; + ---------------------------------- -- ATCB allocation/deallocation -- ---------------------------------- @@ -156,11 +188,16 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread + function Register_Foreign_Thread + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) return Task_Id; + -- Allocate and initialize a new ATCB for the current Thread. The size of + -- the secondary stack can be optionally specified. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_Id is separate; + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) + return Task_Id is separate; ----------------------- -- Local Subprograms -- @@ -178,18 +215,6 @@ package body System.Task_Primitives.Operations is pragma Import (C, GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup"); - procedure Compute_Deadline - (Time : Duration; - Mode : ST.Delay_Modes; - Check_Time : out Duration; - Abs_Time : out Duration; - Rel_Time : out Duration); - -- Helper for Timed_Sleep and Timed_Delay: given a deadline specified by - -- Time and Mode, compute the current clock reading (Check_Time), and the - -- target absolute and relative clock readings (Abs_Time, Rel_Time). The - -- epoch for Time depends on Mode; the epoch for Check_Time and Abs_Time - -- is always that of CLOCK_RT_Ada. - ------------------- -- Abort_Handler -- ------------------- @@ -248,67 +273,6 @@ package body System.Task_Primitives.Operations is end if; end Abort_Handler; - ---------------------- - -- Compute_Deadline -- - ---------------------- - - procedure Compute_Deadline - (Time : Duration; - Mode : ST.Delay_Modes; - Check_Time : out Duration; - Abs_Time : out Duration; - Rel_Time : out Duration) - is - begin - Check_Time := Monotonic_Clock; - - -- Relative deadline - - if Mode = Relative then - Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time; - - if Relative_Timed_Wait then - Rel_Time := Duration'Min (Max_Sensible_Delay, Time); - end if; - - pragma Warnings (Off); - -- Comparison "OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME" is compile - -- time known. - - -- Absolute deadline specified using the tasking clock (CLOCK_RT_Ada) - - elsif Mode = Absolute_RT - or else OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME - then - pragma Warnings (On); - Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time); - - if Relative_Timed_Wait then - Rel_Time := Duration'Min (Max_Sensible_Delay, Time - Check_Time); - end if; - - -- Absolute deadline specified using the calendar clock, in the - -- case where it is not the same as the tasking clock: compensate for - -- difference between clock epochs (Base_Time - Base_Cal_Time). - - else - declare - Cal_Check_Time : constant Duration := OS_Primitives.Clock; - RT_Time : constant Duration := - Time + Check_Time - Cal_Check_Time; - - begin - Abs_Time := - Duration'Min (Check_Time + Max_Sensible_Delay, RT_Time); - - if Relative_Timed_Wait then - Rel_Time := - Duration'Min (Max_Sensible_Delay, RT_Time - Check_Time); - end if; - end; - end if; - end Compute_Deadline; - ----------------- -- Stack_Guard -- ----------------- @@ -595,60 +559,7 @@ package body System.Task_Primitives.Operations is Mode : ST.Delay_Modes; Reason : Task_States; Timedout : out Boolean; - Yielded : out Boolean) - is - pragma Unreferenced (Reason); - - Base_Time : Duration; - Check_Time : Duration; - Abs_Time : Duration; - Rel_Time : Duration; - - Request : aliased timespec; - Result : Interfaces.C.int; - - begin - Timedout := True; - Yielded := False; - - Compute_Deadline - (Time => Time, - Mode => Mode, - Check_Time => Check_Time, - Abs_Time => Abs_Time, - Rel_Time => Rel_Time); - Base_Time := Check_Time; - - if Abs_Time > Check_Time then - Request := - To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time); - - loop - exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; - - Result := - pthread_cond_timedwait - (cond => Self_ID.Common.LL.CV'Access, - mutex => (if Single_Lock - then Single_RTS_Lock'Access - else Self_ID.Common.LL.L'Access), - abstime => Request'Access); - - Check_Time := Monotonic_Clock; - exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; - - if Result = 0 or Result = EINTR then - - -- Somebody may have called Wakeup for us - - Timedout := False; - exit; - end if; - - pragma Assert (Result = ETIMEDOUT); - end loop; - end if; - end Timed_Sleep; + Yielded : out Boolean) renames Monotonic.Timed_Sleep; ----------------- -- Timed_Delay -- @@ -660,95 +571,19 @@ package body System.Task_Primitives.Operations is procedure Timed_Delay (Self_ID : Task_Id; Time : Duration; - Mode : ST.Delay_Modes) - is - Base_Time : Duration; - Check_Time : Duration; - Abs_Time : Duration; - Rel_Time : Duration; - Request : aliased timespec; - - Result : Interfaces.C.int; - pragma Warnings (Off, Result); - - begin - if Single_Lock then - Lock_RTS; - end if; - - Write_Lock (Self_ID); - - Compute_Deadline - (Time => Time, - Mode => Mode, - Check_Time => Check_Time, - Abs_Time => Abs_Time, - Rel_Time => Rel_Time); - Base_Time := Check_Time; - - if Abs_Time > Check_Time then - Request := - To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time); - Self_ID.Common.State := Delay_Sleep; - - loop - exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; - - Result := - pthread_cond_timedwait - (cond => Self_ID.Common.LL.CV'Access, - mutex => (if Single_Lock - then Single_RTS_Lock'Access - else Self_ID.Common.LL.L'Access), - abstime => Request'Access); - - Check_Time := Monotonic_Clock; - exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; - - pragma Assert (Result = 0 - or else Result = ETIMEDOUT - or else Result = EINTR); - end loop; - - Self_ID.Common.State := Runnable; - end if; - - Unlock (Self_ID); - - if Single_Lock then - Unlock_RTS; - end if; - - Result := sched_yield; - end Timed_Delay; + Mode : ST.Delay_Modes) renames Monotonic.Timed_Delay; --------------------- -- Monotonic_Clock -- --------------------- - function Monotonic_Clock return Duration is - TS : aliased timespec; - Result : Interfaces.C.int; - begin - Result := clock_gettime - (clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access); - pragma Assert (Result = 0); - return To_Duration (TS); - end Monotonic_Clock; + function Monotonic_Clock return Duration renames Monotonic.Monotonic_Clock; ------------------- -- RT_Resolution -- ------------------- - function RT_Resolution return Duration is - TS : aliased timespec; - Result : Interfaces.C.int; - begin - Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access); - pragma Assert (Result = 0); - - return To_Duration (TS); - end RT_Resolution; + function RT_Resolution return Duration renames Monotonic.RT_Resolution; ------------ -- Wakeup -- diff --git a/gcc/ada/libgnarl/s-taprop__solaris.adb b/gcc/ada/libgnarl/s-taprop__solaris.adb index e97662c12b11f..26d83e584d6f1 100644 --- a/gcc/ada/libgnarl/s-taprop__solaris.adb +++ b/gcc/ada/libgnarl/s-taprop__solaris.adb @@ -237,11 +237,16 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread + function Register_Foreign_Thread + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) return Task_Id; + -- Allocate and initialize a new ATCB for the current Thread. The size of + -- the secondary stack can be optionally specified. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_Id is separate; + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) + return Task_Id is separate; ------------ -- Checks -- diff --git a/gcc/ada/libgnarl/s-taprop__vxworks.adb b/gcc/ada/libgnarl/s-taprop__vxworks.adb index b77fb106b3744..83ebc22312e0e 100644 --- a/gcc/ada/libgnarl/s-taprop__vxworks.adb +++ b/gcc/ada/libgnarl/s-taprop__vxworks.adb @@ -149,11 +149,16 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread + function Register_Foreign_Thread + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) return Task_Id; + -- Allocate and initialize a new ATCB for the current Thread. The size of + -- the secondary stack can be optionally specified. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_Id is separate; + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) + return Task_Id is separate; ----------------------- -- Local Subprograms -- diff --git a/gcc/ada/libgnarl/s-tarest.adb b/gcc/ada/libgnarl/s-tarest.adb index daff5c1c3ae27..7b9f260927e16 100644 --- a/gcc/ada/libgnarl/s-tarest.adb +++ b/gcc/ada/libgnarl/s-tarest.adb @@ -47,12 +47,6 @@ with Ada.Exceptions; with System.Task_Primitives.Operations; with System.Soft_Links.Tasking; -with System.Storage_Elements; - -with System.Secondary_Stack; -pragma Elaborate_All (System.Secondary_Stack); --- Make sure the body of Secondary_Stack is elaborated before calling --- Init_Tasking_Soft_Links. See comments for this routine for explanation. with System.Soft_Links; -- Used for the non-tasking routines (*_NT) that refer to global data. They @@ -65,8 +59,6 @@ package body System.Tasking.Restricted.Stages is package STPO renames System.Task_Primitives.Operations; package SSL renames System.Soft_Links; - package SSE renames System.Storage_Elements; - package SST renames System.Secondary_Stack; use Ada.Exceptions; @@ -115,17 +107,18 @@ package body System.Tasking.Restricted.Stages is -- This should only be called by the Task_Wrapper procedure. procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id); + (Priority : Integer; + Stack_Address : System.Address; + Stack_Size : System.Parameters.Size_Type; + Sec_Stack_Address : System.Secondary_Stack.SS_Stack_Ptr; + Sec_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id); -- Code shared between Create_Restricted_Task (the concurrent version) and -- Create_Restricted_Task_Sequential. See comment of the former in the -- specification of this package. @@ -205,54 +198,6 @@ package body System.Tasking.Restricted.Stages is -- -- DO NOT delete ID. As noted, it is needed on some targets. - function Secondary_Stack_Size return Storage_Elements.Storage_Offset; - -- Returns the size of the secondary stack for the task. For fixed - -- secondary stacks, the function will return the ATCB field - -- Secondary_Stack_Size if it is not set to Unspecified_Size, - -- otherwise a percentage of the stack is reserved using the - -- System.Parameters.Sec_Stack_Percentage property. - - -- Dynamic secondary stacks are allocated in System.Soft_Links. - -- Create_TSD and thus the function returns 0 to suppress the - -- creation of the fixed secondary stack in the primary stack. - - -------------------------- - -- Secondary_Stack_Size -- - -------------------------- - - function Secondary_Stack_Size return Storage_Elements.Storage_Offset is - use System.Storage_Elements; - use System.Secondary_Stack; - - begin - if Parameters.Sec_Stack_Dynamic then - return 0; - - elsif Self_ID.Common.Secondary_Stack_Size = Unspecified_Size then - return (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size - * SSE.Storage_Offset (Sec_Stack_Percentage) / 100); - else - -- Use the size specified by aspect Secondary_Stack_Size padded - -- by the amount of space used by the stack data structure. - - return Storage_Offset (Self_ID.Common.Secondary_Stack_Size) + - Storage_Offset (Minimum_Secondary_Stack_Size); - end if; - end Secondary_Stack_Size; - - Secondary_Stack : aliased Storage_Elements.Storage_Array - (1 .. Secondary_Stack_Size); - for Secondary_Stack'Alignment use Standard'Maximum_Alignment; - -- This is the secondary stack data. Note that it is critical that this - -- have maximum alignment, since any kind of data can be allocated here. - - pragma Warnings (Off); - Secondary_Stack_Address : System.Address := Secondary_Stack'Address; - pragma Warnings (On); - -- Address of secondary stack. In the fixed secondary stack case, this - -- value is not modified, causing a warning, hence the bracketing with - -- Warnings (Off/On). - Cause : Cause_Of_Termination := Normal; -- Indicates the reason why this task terminates. Normal corresponds to -- a task terminating due to completing the last statement of its body. @@ -266,15 +211,7 @@ package body System.Tasking.Restricted.Stages is -- execution of its task body, then EO will contain the associated -- exception occurrence. Otherwise, it will contain Null_Occurrence. - -- Start of processing for Task_Wrapper - begin - if not Parameters.Sec_Stack_Dynamic then - Self_ID.Common.Compiler_Data.Sec_Stack_Addr := - Secondary_Stack'Address; - SST.SS_Init (Secondary_Stack_Address, Integer (Secondary_Stack'Last)); - end if; - -- Initialize low-level TCB components, that cannot be initialized by -- the creator. @@ -539,17 +476,18 @@ package body System.Tasking.Restricted.Stages is ---------------------------- procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id) + (Priority : Integer; + Stack_Address : System.Address; + Stack_Size : System.Parameters.Size_Type; + Sec_Stack_Address : System.Secondary_Stack.SS_Stack_Ptr; + Sec_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id) is Self_ID : constant Task_Id := STPO.Self; Base_Priority : System.Any_Priority; @@ -608,8 +546,7 @@ package body System.Tasking.Restricted.Stages is Initialize_ATCB (Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority, - Base_CPU, null, Task_Info, Size, Secondary_Stack_Size, - Created_Task, Success); + Base_CPU, null, Task_Info, Stack_Size, Created_Task, Success); -- If we do our job right then there should never be any failures, which -- was probably said about the Titanic; so just to be safe, let's retain @@ -639,25 +576,31 @@ package body System.Tasking.Restricted.Stages is Unlock_RTS; end if; - -- Create TSD as early as possible in the creation of a task, since it - -- may be used by the operation of Ada code within the task. + -- Create TSD as early as possible in the creation of a task, since + -- it may be used by the operation of Ada code within the task. If the + -- compiler has not allocated a secondary stack, a stack will be + -- allocated fromt the binder generated pool. - SSL.Create_TSD (Created_Task.Common.Compiler_Data); + SSL.Create_TSD + (Created_Task.Common.Compiler_Data, + Sec_Stack_Address, + Sec_Stack_Size); end Create_Restricted_Task; procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Chain : in out Activation_Chain; - Task_Image : String; - Created_Task : Task_Id) + (Priority : Integer; + Stack_Address : System.Address; + Stack_Size : System.Parameters.Size_Type; + Sec_Stack_Address : System.Secondary_Stack.SS_Stack_Ptr; + Sec_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Chain : in out Activation_Chain; + Task_Image : String; + Created_Task : Task_Id) is begin if Partition_Elaboration_Policy = 'S' then @@ -668,14 +611,14 @@ package body System.Tasking.Restricted.Stages is -- sequential, activation must be deferred. Create_Restricted_Task_Sequential - (Priority, Stack_Address, Size, Secondary_Stack_Size, - Task_Info, CPU, State, Discriminants, Elaborated, + (Priority, Stack_Address, Stack_Size, Sec_Stack_Address, + Sec_Stack_Size, Task_Info, CPU, State, Discriminants, Elaborated, Task_Image, Created_Task); else Create_Restricted_Task - (Priority, Stack_Address, Size, Secondary_Stack_Size, - Task_Info, CPU, State, Discriminants, Elaborated, + (Priority, Stack_Address, Stack_Size, Sec_Stack_Address, + Sec_Stack_Size, Task_Info, CPU, State, Discriminants, Elaborated, Task_Image, Created_Task); -- Append this task to the activation chain @@ -690,22 +633,24 @@ package body System.Tasking.Restricted.Stages is --------------------------------------- procedure Create_Restricted_Task_Sequential - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id) is + (Priority : Integer; + Stack_Address : System.Address; + Stack_Size : System.Parameters.Size_Type; + Sec_Stack_Address : System.Secondary_Stack.SS_Stack_Ptr; + Sec_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id) + is begin - Create_Restricted_Task (Priority, Stack_Address, Size, - Secondary_Stack_Size, Task_Info, - CPU, State, Discriminants, Elaborated, - Task_Image, Created_Task); + Create_Restricted_Task + (Priority, Stack_Address, Stack_Size, Sec_Stack_Address, + Sec_Stack_Size, Task_Info, CPU, State, Discriminants, Elaborated, + Task_Image, Created_Task); -- Append this task to the activation chain diff --git a/gcc/ada/libgnarl/s-tarest.ads b/gcc/ada/libgnarl/s-tarest.ads index ccc5683bd3153..e51fa58ca61b3 100644 --- a/gcc/ada/libgnarl/s-tarest.ads +++ b/gcc/ada/libgnarl/s-tarest.ads @@ -43,8 +43,9 @@ -- The restricted GNARLI is also composed of System.Protected_Objects and -- System.Protected_Objects.Single_Entry -with System.Task_Info; with System.Parameters; +with System.Secondary_Stack; +with System.Task_Info; package System.Tasking.Restricted.Stages is pragma Elaborate_Body; @@ -128,33 +129,38 @@ package System.Tasking.Restricted.Stages is -- by the binder generated code, before calling elaboration code. procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Chain : in out Activation_Chain; - Task_Image : String; - Created_Task : Task_Id); + (Priority : Integer; + Stack_Address : System.Address; + Stack_Size : System.Parameters.Size_Type; + Sec_Stack_Address : System.Secondary_Stack.SS_Stack_Ptr; + Sec_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Chain : in out Activation_Chain; + Task_Image : String; + Created_Task : Task_Id); -- Compiler interface only. Do not call from within the RTS. -- This must be called to create a new task, when the partition -- elaboration policy is not specified (or is concurrent). -- -- Priority is the task's priority (assumed to be in the - -- System.Any_Priority'Range) + -- System.Any_Priority'Range). -- -- Stack_Address is the start address of the stack associated to the task, -- in case it has been preallocated by the compiler; it is equal to -- Null_Address when the stack needs to be allocated by the underlying -- operating system. -- - -- Size is the stack size of the task to create + -- Stack_Size is the stack size of the task to create. + -- + -- Sec_Stack_Address is the pointer to the secondary stack created by the + -- compiler. If null, the secondary stack is either allocated by the binder + -- or the run-time. -- - -- Secondary_Stack_Size is the secondary stack size of the task to create + -- Secondary_Stack_Size is the secondary stack size of the task to create. -- -- Task_Info is the task info associated with the created task, or -- Unspecified_Task_Info if none. @@ -164,7 +170,7 @@ package System.Tasking.Restricted.Stages is -- checks are performed when analyzing the pragma, and dynamic ones are -- performed before setting the affinity at run time. -- - -- State is the compiler generated task's procedure body + -- State is the compiler generated task's procedure body. -- -- Discriminants is a pointer to a limited record whose discriminants are -- those of the task to create. This parameter should be passed as the @@ -182,20 +188,21 @@ package System.Tasking.Restricted.Stages is -- -- Created_Task is the resulting task. -- - -- This procedure can raise Storage_Error if the task creation fails + -- This procedure can raise Storage_Error if the task creation fails. procedure Create_Restricted_Task_Sequential - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id); + (Priority : Integer; + Stack_Address : System.Address; + Stack_Size : System.Parameters.Size_Type; + Sec_Stack_Address : System.Secondary_Stack.SS_Stack_Ptr; + Sec_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id); -- Compiler interface only. Do not call from within the RTS. -- This must be called to create a new task, when the sequential partition -- elaboration policy is used. diff --git a/gcc/ada/libgnarl/s-taskin.adb b/gcc/ada/libgnarl/s-taskin.adb index 462e229645cfd..d9fc6e3213b97 100644 --- a/gcc/ada/libgnarl/s-taskin.adb +++ b/gcc/ada/libgnarl/s-taskin.adb @@ -96,7 +96,6 @@ package body System.Tasking is Domain : Dispatching_Domain_Access; Task_Info : System.Task_Info.Task_Info_Type; Stack_Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; T : Task_Id; Success : out Boolean) is @@ -147,7 +146,6 @@ package body System.Tasking is T.Common.Specific_Handler := null; T.Common.Debug_Events := (others => False); T.Common.Task_Image_Len := 0; - T.Common.Secondary_Stack_Size := Secondary_Stack_Size; if T.Common.Parent = null then @@ -244,7 +242,6 @@ package body System.Tasking is Domain => System_Domain, Task_Info => Task_Info.Unspecified_Task_Info, Stack_Size => 0, - Secondary_Stack_Size => Parameters.Unspecified_Size, T => T, Success => Success); pragma Assert (Success); diff --git a/gcc/ada/libgnarl/s-taskin.ads b/gcc/ada/libgnarl/s-taskin.ads index cd53cf9347170..7c8b44b952ca7 100644 --- a/gcc/ada/libgnarl/s-taskin.ads +++ b/gcc/ada/libgnarl/s-taskin.ads @@ -37,12 +37,12 @@ with Ada.Exceptions; with Ada.Unchecked_Conversion; +with System.Multiprocessors; with System.Parameters; -with System.Task_Info; with System.Soft_Links; -with System.Task_Primitives; with System.Stack_Usage; -with System.Multiprocessors; +with System.Task_Info; +with System.Task_Primitives; package System.Tasking is pragma Preelaborate; @@ -702,13 +702,6 @@ package System.Tasking is -- need to do different things depending on the situation. -- -- Protection: Self.L - - Secondary_Stack_Size : System.Parameters.Size_Type; - -- Secondary_Stack_Size is the size of the secondary stack for the - -- task. Defined here since it is the responsibility of the task to - -- creates its own secondary stack. - -- - -- Protected: Only accessed by Self end record; --------------------------------------- @@ -1173,7 +1166,6 @@ package System.Tasking is Domain : Dispatching_Domain_Access; Task_Info : System.Task_Info.Task_Info_Type; Stack_Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; T : Task_Id; Success : out Boolean); -- Initialize fields of the TCB for task T, and link into global TCB diff --git a/gcc/ada/libgnarl/s-tassta.adb b/gcc/ada/libgnarl/s-tassta.adb index 44c054fec3ecf..518a02c8b48eb 100644 --- a/gcc/ada/libgnarl/s-tassta.adb +++ b/gcc/ada/libgnarl/s-tassta.adb @@ -71,11 +71,11 @@ package body System.Tasking.Stages is package STPO renames System.Task_Primitives.Operations; package SSL renames System.Soft_Links; package SSE renames System.Storage_Elements; - package SST renames System.Secondary_Stack; use Ada.Exceptions; use Parameters; + use Secondary_Stack; use Task_Primitives; use Task_Primitives.Operations; @@ -465,7 +465,7 @@ package body System.Tasking.Stages is procedure Create_Task (Priority : Integer; - Size : System.Parameters.Size_Type; + Stack_Size : System.Parameters.Size_Type; Secondary_Stack_Size : System.Parameters.Size_Type; Task_Info : System.Task_Info.Task_Info_Type; CPU : Integer; @@ -604,8 +604,7 @@ package body System.Tasking.Stages is end if; Initialize_ATCB (Self_ID, State, Discriminants, P, Elaborated, - Base_Priority, Base_CPU, Domain, Task_Info, Size, - Secondary_Stack_Size, T, Success); + Base_Priority, Base_CPU, Domain, Task_Info, Stack_Size, T, Success); if not Success then Free (T); @@ -692,10 +691,18 @@ package body System.Tasking.Stages is Dispatching_Domain_Tasks (Base_CPU) + 1; end if; - -- Create TSD as early as possible in the creation of a task, since it - -- may be used by the operation of Ada code within the task. + -- Create the secondary stack for the task as early as possible during + -- in the creation of a task, since it may be used by the operation of + -- Ada code within the task. + + begin + SSL.Create_TSD (T.Common.Compiler_Data, null, Secondary_Stack_Size); + exception + when others => + Initialization.Undefer_Abort_Nestable (Self_ID); + raise Storage_Error with "Secondary stack could not be allocated"; + end; - SSL.Create_TSD (T.Common.Compiler_Data); T.Common.Activation_Link := Chain.T_ID; Chain.T_ID := T; Created_Task := T; @@ -914,8 +921,8 @@ package body System.Tasking.Stages is SSL.Unlock_Task := SSL.Task_Unlock_NT'Access; SSL.Get_Jmpbuf_Address := SSL.Get_Jmpbuf_Address_NT'Access; SSL.Set_Jmpbuf_Address := SSL.Set_Jmpbuf_Address_NT'Access; - SSL.Get_Sec_Stack_Addr := SSL.Get_Sec_Stack_Addr_NT'Access; - SSL.Set_Sec_Stack_Addr := SSL.Set_Sec_Stack_Addr_NT'Access; + SSL.Get_Sec_Stack := SSL.Get_Sec_Stack_NT'Access; + SSL.Set_Sec_Stack := SSL.Set_Sec_Stack_NT'Access; SSL.Check_Abort_Status := SSL.Check_Abort_Status_NT'Access; SSL.Get_Stack_Info := SSL.Get_Stack_Info_NT'Access; @@ -1014,7 +1021,6 @@ package body System.Tasking.Stages is -- at-end handler that the compiler generates. procedure Task_Wrapper (Self_ID : Task_Id) is - use type SSE.Storage_Offset; use System.Standard_Library; use System.Stack_Usage; @@ -1027,52 +1033,6 @@ package body System.Tasking.Stages is Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0; -- Whether to use above alternate signal stack for stack overflows - function Secondary_Stack_Size return Storage_Elements.Storage_Offset; - -- Returns the size of the secondary stack for the task. For fixed - -- secondary stacks, the function will return the ATCB field - -- Secondary_Stack_Size if it is not set to Unspecified_Size, - -- otherwise a percentage of the stack is reserved using the - -- System.Parameters.Sec_Stack_Percentage property. - - -- Dynamic secondary stacks are allocated in System.Soft_Links. - -- Create_TSD and thus the function returns 0 to suppress the - -- creation of the fixed secondary stack in the primary stack. - - -------------------------- - -- Secondary_Stack_Size -- - -------------------------- - - function Secondary_Stack_Size return Storage_Elements.Storage_Offset is - use System.Storage_Elements; - - begin - if Parameters.Sec_Stack_Dynamic then - return 0; - - elsif Self_ID.Common.Secondary_Stack_Size = Unspecified_Size then - return (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size - * SSE.Storage_Offset (Sec_Stack_Percentage) / 100); - else - -- Use the size specified by aspect Secondary_Stack_Size padded - -- by the amount of space used by the stack data structure. - - return Storage_Offset (Self_ID.Common.Secondary_Stack_Size) + - Storage_Offset (SST.Minimum_Secondary_Stack_Size); - end if; - end Secondary_Stack_Size; - - Secondary_Stack : aliased Storage_Elements.Storage_Array - (1 .. Secondary_Stack_Size); - for Secondary_Stack'Alignment use Standard'Maximum_Alignment; - -- Actual area allocated for secondary stack. Note that it is critical - -- that this have maximum alignment, since any kind of data can be - -- allocated here. - - Secondary_Stack_Address : System.Address := Secondary_Stack'Address; - -- Address of secondary stack. In the fixed secondary stack case, this - -- value is not modified, causing a warning, hence the bracketing with - -- Warnings (Off/On). But why is so much *more* bracketed??? - SEH_Table : aliased SSE.Storage_Array (1 .. 8); -- Structured Exception Registration table (2 words) @@ -1136,14 +1096,6 @@ package body System.Tasking.Stages is Debug.Master_Hook (Self_ID, Self_ID.Common.Parent, Self_ID.Master_of_Task); - -- Assume a size of the stack taken at this stage - - if not Parameters.Sec_Stack_Dynamic then - Self_ID.Common.Compiler_Data.Sec_Stack_Addr := - Secondary_Stack'Address; - SST.SS_Init (Secondary_Stack_Address, Integer (Secondary_Stack'Last)); - end if; - if Use_Alternate_Stack then Self_ID.Common.Task_Alternate_Stack := Task_Alternate_Stack'Address; end if; @@ -1197,15 +1149,6 @@ package body System.Tasking.Stages is Stack_Base := Bottom_Of_Stack'Address; - -- Also reduce the size of the stack to take into account the - -- secondary stack array declared in this frame. This is for - -- sure very conservative. - - if not Parameters.Sec_Stack_Dynamic then - Pattern_Size := - Pattern_Size - Natural (Secondary_Stack_Size); - end if; - -- Adjustments for inner frames Pattern_Size := Pattern_Size - @@ -1973,10 +1916,10 @@ package body System.Tasking.Stages is then Initialization.Task_Lock (Self_ID); - -- If Sec_Stack_Addr is not null, it means that Destroy_TSD + -- If Sec_Stack_Ptr is not null, it means that Destroy_TSD -- has not been called yet (case of an unactivated task). - if T.Common.Compiler_Data.Sec_Stack_Addr /= Null_Address then + if T.Common.Compiler_Data.Sec_Stack_Ptr /= null then SSL.Destroy_TSD (T.Common.Compiler_Data); end if; diff --git a/gcc/ada/libgnarl/s-tassta.ads b/gcc/ada/libgnarl/s-tassta.ads index bc837fc9af8c8..a1129a1085a83 100644 --- a/gcc/ada/libgnarl/s-tassta.ads +++ b/gcc/ada/libgnarl/s-tassta.ads @@ -70,7 +70,7 @@ package System.Tasking.Stages is -- tE : aliased boolean := false; -- tZ : size_type := unspecified_size; -- type tV (discr : integer) is limited record - -- _task_id : task_id; + -- _task_id : task_id; -- end record; -- procedure tB (_task : access tV); -- freeze tV [ @@ -168,7 +168,7 @@ package System.Tasking.Stages is procedure Create_Task (Priority : Integer; - Size : System.Parameters.Size_Type; + Stack_Size : System.Parameters.Size_Type; Secondary_Stack_Size : System.Parameters.Size_Type; Task_Info : System.Task_Info.Task_Info_Type; CPU : Integer; @@ -187,31 +187,44 @@ package System.Tasking.Stages is -- -- Priority is the task's priority (assumed to be in range of type -- System.Any_Priority) - -- Size is the stack size of the task to create - -- Secondary_Stack_Size is the secondary stack size of the task to create + -- + -- Stack_Size is the stack size of the task to create + -- + -- Secondary_Stack_Size is the size of the secondary stack to be used by + -- the task. + -- -- Task_Info is the task info associated with the created task, or -- Unspecified_Task_Info if none. + -- -- CPU is the task affinity. Passed as an Integer because the undefined -- value is not in the range of CPU_Range. Static range checks are -- performed when analyzing the pragma, and dynamic ones are performed -- before setting the affinity at run time. + -- -- Relative_Deadline is the relative deadline associated with the created -- task by means of a pragma Relative_Deadline, or 0.0 if none. + -- -- Domain is the dispatching domain associated with the created task by -- means of a Dispatching_Domain pragma or aspect, or null if none. + -- -- State is the compiler generated task's procedure body + -- -- Discriminants is a pointer to a limited record whose discriminants -- are those of the task to create. This parameter should be passed as -- the single argument to State. + -- -- Elaborated is a pointer to a Boolean that must be set to true on exit -- if the task could be successfully elaborated. + -- -- Chain is a linked list of task that needs to be created. On exit, -- Created_Task.Activation_Link will be Chain.T_ID, and Chain.T_ID -- will be Created_Task (e.g the created task will be linked at the front -- of Chain). + -- -- Task_Image is a string created by the compiler that the -- run time can store to ease the debugging and the -- Ada.Task_Identification facility. + -- -- Created_Task is the resulting task. -- -- This procedure can raise Storage_Error if the task creation failed. diff --git a/gcc/ada/libgnarl/s-tpopmo.adb b/gcc/ada/libgnarl/s-tpopmo.adb new file mode 100644 index 0000000000000..b6164aa19ed4e --- /dev/null +++ b/gcc/ada/libgnarl/s-tpopmo.adb @@ -0,0 +1,283 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- SYSTEM.TASK_PRIMITIVES.OPERATIONS.MONOTONIC -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the Monotonic version of this package for Posix and Linux targets. + +separate (System.Task_Primitives.Operations) +package body Monotonic is + + ----------------------- + -- Local Subprograms -- + ----------------------- + + procedure Compute_Deadline + (Time : Duration; + Mode : ST.Delay_Modes; + Check_Time : out Duration; + Abs_Time : out Duration; + Rel_Time : out Duration); + -- Helper for Timed_Sleep and Timed_Delay: given a deadline specified by + -- Time and Mode, compute the current clock reading (Check_Time), and the + -- target absolute and relative clock readings (Abs_Time, Rel_Time). The + -- epoch for Time depends on Mode; the epoch for Check_Time and Abs_Time + -- is always that of CLOCK_RT_Ada. + + --------------------- + -- Monotonic_Clock -- + --------------------- + + function Monotonic_Clock return Duration is + TS : aliased timespec; + Result : Interfaces.C.int; + begin + Result := clock_gettime + (clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access); + pragma Assert (Result = 0); + + return To_Duration (TS); + end Monotonic_Clock; + + ------------------- + -- RT_Resolution -- + ------------------- + + function RT_Resolution return Duration is + TS : aliased timespec; + Result : Interfaces.C.int; + + begin + Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access); + pragma Assert (Result = 0); + + return To_Duration (TS); + end RT_Resolution; + + ---------------------- + -- Compute_Deadline -- + ---------------------- + + procedure Compute_Deadline + (Time : Duration; + Mode : ST.Delay_Modes; + Check_Time : out Duration; + Abs_Time : out Duration; + Rel_Time : out Duration) + is + begin + Check_Time := Monotonic_Clock; + + -- Relative deadline + + if Mode = Relative then + Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time; + + if Relative_Timed_Wait then + Rel_Time := Duration'Min (Max_Sensible_Delay, Time); + end if; + + pragma Warnings (Off); + -- Comparison "OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME" is compile + -- time known. + + -- Absolute deadline specified using the tasking clock (CLOCK_RT_Ada) + + elsif Mode = Absolute_RT + or else OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME + then + pragma Warnings (On); + Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time); + + if Relative_Timed_Wait then + Rel_Time := Duration'Min (Max_Sensible_Delay, Time - Check_Time); + end if; + + -- Absolute deadline specified using the calendar clock, in the + -- case where it is not the same as the tasking clock: compensate for + -- difference between clock epochs (Base_Time - Base_Cal_Time). + + else + declare + Cal_Check_Time : constant Duration := OS_Primitives.Clock; + RT_Time : constant Duration := + Time + Check_Time - Cal_Check_Time; + + begin + Abs_Time := + Duration'Min (Check_Time + Max_Sensible_Delay, RT_Time); + + if Relative_Timed_Wait then + Rel_Time := + Duration'Min (Max_Sensible_Delay, RT_Time - Check_Time); + end if; + end; + end if; + end Compute_Deadline; + + ----------------- + -- Timed_Sleep -- + ----------------- + + -- This is for use within the run-time system, so abort is + -- assumed to be already deferred, and the caller should be + -- holding its own ATCB lock. + + procedure Timed_Sleep + (Self_ID : ST.Task_Id; + Time : Duration; + Mode : ST.Delay_Modes; + Reason : System.Tasking.Task_States; + Timedout : out Boolean; + Yielded : out Boolean) + is + pragma Unreferenced (Reason); + + Base_Time : Duration; + Check_Time : Duration; + Abs_Time : Duration; + Rel_Time : Duration; + + Request : aliased timespec; + Result : Interfaces.C.int; + + begin + Timedout := True; + Yielded := False; + + Compute_Deadline + (Time => Time, + Mode => Mode, + Check_Time => Check_Time, + Abs_Time => Abs_Time, + Rel_Time => Rel_Time); + Base_Time := Check_Time; + + if Abs_Time > Check_Time then + Request := + To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time); + + loop + exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; + + Result := + pthread_cond_timedwait + (cond => Self_ID.Common.LL.CV'Access, + mutex => (if Single_Lock + then Single_RTS_Lock'Access + else Self_ID.Common.LL.L'Access), + abstime => Request'Access); + + Check_Time := Monotonic_Clock; + exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; + + if Result in 0 | EINTR then + + -- Somebody may have called Wakeup for us + + Timedout := False; + exit; + end if; + + pragma Assert (Result = ETIMEDOUT); + end loop; + end if; + end Timed_Sleep; + + ----------------- + -- Timed_Delay -- + ----------------- + + -- This is for use in implementing delay statements, so we assume the + -- caller is abort-deferred but is holding no locks. + + procedure Timed_Delay + (Self_ID : ST.Task_Id; + Time : Duration; + Mode : ST.Delay_Modes) + is + Base_Time : Duration; + Check_Time : Duration; + Abs_Time : Duration; + Rel_Time : Duration; + Request : aliased timespec; + + Result : Interfaces.C.int; + pragma Warnings (Off, Result); + + begin + if Single_Lock then + Lock_RTS; + end if; + + Write_Lock (Self_ID); + + Compute_Deadline + (Time => Time, + Mode => Mode, + Check_Time => Check_Time, + Abs_Time => Abs_Time, + Rel_Time => Rel_Time); + Base_Time := Check_Time; + + if Abs_Time > Check_Time then + Request := + To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time); + Self_ID.Common.State := Delay_Sleep; + + loop + exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; + + Result := + pthread_cond_timedwait + (cond => Self_ID.Common.LL.CV'Access, + mutex => (if Single_Lock + then Single_RTS_Lock'Access + else Self_ID.Common.LL.L'Access), + abstime => Request'Access); + + Check_Time := Monotonic_Clock; + exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; + + pragma Assert (Result in 0 | ETIMEDOUT | EINTR); + end loop; + + Self_ID.Common.State := Runnable; + end if; + + Unlock (Self_ID); + + if Single_Lock then + Unlock_RTS; + end if; + + Result := sched_yield; + end Timed_Delay; + +end Monotonic; diff --git a/gcc/ada/libgnarl/s-tporft.adb b/gcc/ada/libgnarl/s-tporft.adb index 7b8a59276f8cc..56eda26e6a101 100644 --- a/gcc/ada/libgnarl/s-tporft.adb +++ b/gcc/ada/libgnarl/s-tporft.adb @@ -29,16 +29,16 @@ -- -- ------------------------------------------------------------------------------ -with System.Task_Info; --- Use for Unspecified_Task_Info - -with System.Soft_Links; --- used to initialize TSD for a C thread, in function Self - with System.Multiprocessors; +with System.Soft_Links; +with System.Task_Info; separate (System.Task_Primitives.Operations) -function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id is +function Register_Foreign_Thread + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) + return Task_Id +is Local_ATCB : aliased Ada_Task_Control_Block (0); Self_Id : Task_Id; Succeeded : Boolean; @@ -66,7 +66,7 @@ begin (Self_Id, null, Null_Address, Null_Task, Foreign_Task_Elaborated'Access, System.Priority'First, System.Multiprocessors.Not_A_Specific_CPU, null, - Task_Info.Unspecified_Task_Info, 0, 0, Self_Id, Succeeded); + Task_Info.Unspecified_Task_Info, 0, Self_Id, Succeeded); Unlock_RTS; pragma Assert (Succeeded); @@ -92,7 +92,10 @@ begin Self_Id.Common.Task_Alternate_Stack := Null_Address; - System.Soft_Links.Create_TSD (Self_Id.Common.Compiler_Data); + -- Create the TSD for the task + + System.Soft_Links.Create_TSD + (Self_Id.Common.Compiler_Data, null, Sec_Stack_Size); Enter_Task (Self_Id); diff --git a/gcc/ada/libgnat/a-tags.adb b/gcc/ada/libgnat/a-tags.adb index 322f9915f6e63..f3c2c0e969c5e 100644 --- a/gcc/ada/libgnat/a-tags.adb +++ b/gcc/ada/libgnat/a-tags.adb @@ -842,9 +842,21 @@ package body Ada.Tags is begin Curr_DT := DT (To_Tag_Ptr (This).all); + -- See the documentation of Dispatch_Table_Wrapper.Offset_To_Top + if Curr_DT.Offset_To_Top = SSE.Storage_Offset'Last then + + -- The parent record type has variable-size components, so the + -- instance-specific offset is stored in the tagged record, right + -- after the reference to Curr_DT (which is a secondary dispatch + -- table). + return To_Storage_Offset_Ptr (This + Tag_Size).all; + else + -- The offset is compile-time known, so it is simply stored in the + -- Offset_To_Top field. + return Curr_DT.Offset_To_Top; end if; end Offset_To_Top; diff --git a/gcc/ada/libgnat/a-tags.ads b/gcc/ada/libgnat/a-tags.ads index 564ce205f4938..a11cdd4a44dad 100644 --- a/gcc/ada/libgnat/a-tags.ads +++ b/gcc/ada/libgnat/a-tags.ads @@ -380,12 +380,21 @@ private -- Prims_Ptr table. Offset_To_Top : SSE.Storage_Offset; - TSD : System.Address; + -- Offset between the _Tag field and the field that contains the + -- reference to this dispatch table. For primary dispatch tables it is + -- zero. For secondary dispatch tables: if the parent record type (if + -- any) has a compile-time-known size, then Offset_To_Top contains the + -- expected value, otherwise it contains SSE.Storage_Offset'Last and the + -- actual offset is to be found in the tagged record, right after the + -- field that contains the reference to this dispatch table. See the + -- implementation of Ada.Tags.Offset_To_Top for the corresponding logic. + + TSD : System.Address; Prims_Ptr : aliased Address_Array (1 .. Num_Prims); -- The size of the Prims_Ptr array actually depends on the tagged type -- to which it applies. For each tagged type, the expander computes the - -- actual array size, allocates the Dispatch_Table record accordingly. + -- actual array size, allocating the Dispatch_Table record accordingly. end record; type Dispatch_Table_Ptr is access all Dispatch_Table_Wrapper; diff --git a/gcc/ada/libgnat/s-parame.adb b/gcc/ada/libgnat/s-parame.adb index 0f4d45f2da8f7..359edacb95ee0 100644 --- a/gcc/ada/libgnat/s-parame.adb +++ b/gcc/ada/libgnat/s-parame.adb @@ -50,6 +50,34 @@ package body System.Parameters is end if; end Adjust_Storage_Size; + ---------------------------- + -- Default_Sec_Stack_Size -- + ---------------------------- + + function Default_Sec_Stack_Size return Size_Type is + Default_SS_Size : Integer; + pragma Import (C, Default_SS_Size, + "__gnat_default_ss_size"); + begin + -- There are two situations where the default secondary stack size is + -- set to zero: + -- + -- * The user sets it to zero erroneously thinking it will disable + -- the secondary stack. + -- + -- * Or more likely, we are building with an old compiler and + -- Default_SS_Size is never set. + -- + -- In both case set the default secondary stack size to the run-time + -- default. + + if Default_SS_Size > 0 then + return Size_Type (Default_SS_Size); + else + return Runtime_Default_Sec_Stack_Size; + end if; + end Default_Sec_Stack_Size; + ------------------------ -- Default_Stack_Size -- ------------------------ diff --git a/gcc/ada/libgnat/s-parame.ads b/gcc/ada/libgnat/s-parame.ads index f48c7e0973f6f..60a5e99702109 100644 --- a/gcc/ada/libgnat/s-parame.ads +++ b/gcc/ada/libgnat/s-parame.ads @@ -64,20 +64,6 @@ package System.Parameters is Unspecified_Size : constant Size_Type := Size_Type'First; -- Value used to indicate that no size type is set - subtype Percentage is Size_Type range -1 .. 100; - Dynamic : constant Size_Type := -1; - -- The secondary stack ratio is a constant between 0 and 100 which - -- determines the percentage of the allocated task stack that is - -- used by the secondary stack (the rest being the primary stack). - -- The special value of minus one indicates that the secondary - -- stack is to be allocated from the heap instead. - - Sec_Stack_Percentage : constant Percentage := Dynamic; - -- This constant defines the handling of the secondary stack - - Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Percentage = Dynamic; - -- Convenient Boolean for testing for dynamic secondary stack - function Default_Stack_Size return Size_Type; -- Default task stack size used if none is specified @@ -94,15 +80,27 @@ package System.Parameters is -- otherwise return given Size Default_Env_Stack_Size : constant Size_Type := 8_192_000; - -- Assumed size of the environment task, if no other information - -- is available. This value is used when stack checking is - -- enabled and no GNAT_STACK_LIMIT environment variable is set. + -- Assumed size of the environment task, if no other information is + -- available. This value is used when stack checking is enabled and + -- no GNAT_STACK_LIMIT environment variable is set. Stack_Grows_Down : constant Boolean := True; -- This constant indicates whether the stack grows up (False) or -- down (True) in memory as functions are called. It is used for -- proper implementation of the stack overflow check. + Runtime_Default_Sec_Stack_Size : constant Size_Type := 10 * 1024; + -- The run-time chosen default size for secondary stacks that may be + -- overriden by the user with the use of binder -D switch. + + function Default_Sec_Stack_Size return Size_Type; + -- The default initial size for secondary stacks that reflects any user + -- specified default via the binder -D switch. + + Sec_Stack_Dynamic : constant Boolean := True; + -- Indicates if secondary stacks can grow and shrink at run-time. If False, + -- the size of a secondary stack is fixed at the point of its creation. + ---------------------------------------------- -- Characteristics of types in Interfaces.C -- ---------------------------------------------- diff --git a/gcc/ada/libgnat/s-parame__ae653.ads b/gcc/ada/libgnat/s-parame__ae653.ads index 8a787f007bc6b..42d438e72ea05 100644 --- a/gcc/ada/libgnat/s-parame__ae653.ads +++ b/gcc/ada/libgnat/s-parame__ae653.ads @@ -62,20 +62,6 @@ package System.Parameters is Unspecified_Size : constant Size_Type := Size_Type'First; -- Value used to indicate that no size type is set - subtype Percentage is Size_Type range -1 .. 100; - Dynamic : constant Size_Type := -1; - -- The secondary stack ratio is a constant between 0 and 100 which - -- determines the percentage of the allocated task stack that is - -- used by the secondary stack (the rest being the primary stack). - -- The special value of minus one indicates that the secondary - -- stack is to be allocated from the heap instead. - - Sec_Stack_Percentage : constant Percentage := 25; - -- This constant defines the handling of the secondary stack - - Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Percentage = Dynamic; - -- Convenient Boolean for testing for dynamic secondary stack - function Default_Stack_Size return Size_Type; -- Default task stack size used if none is specified @@ -103,6 +89,18 @@ package System.Parameters is -- down (True) in memory as functions are called. It is used for -- proper implementation of the stack overflow check. + Runtime_Default_Sec_Stack_Size : constant Size_Type := 10 * 1024; + -- The run-time chosen default size for secondary stacks that may be + -- overriden by the user with the use of binder -D switch. + + function Default_Sec_Stack_Size return Size_Type; + -- The default size for secondary stacks that reflects any user specified + -- default via the binder -D switch. + + Sec_Stack_Dynamic : constant Boolean := False; + -- Indicates if secondary stacks can grow and shrink at run-time. If False, + -- the size of a secondary stack is fixed at the point of its creation. + ---------------------------------------------- -- Characteristics of types in Interfaces.C -- ---------------------------------------------- diff --git a/gcc/ada/libgnat/s-parame__hpux.ads b/gcc/ada/libgnat/s-parame__hpux.ads index f20cfbebe7e2a..846b165561eaa 100644 --- a/gcc/ada/libgnat/s-parame__hpux.ads +++ b/gcc/ada/libgnat/s-parame__hpux.ads @@ -62,20 +62,6 @@ package System.Parameters is Unspecified_Size : constant Size_Type := Size_Type'First; -- Value used to indicate that no size type is set - subtype Percentage is Size_Type range -1 .. 100; - Dynamic : constant Size_Type := -1; - -- The secondary stack ratio is a constant between 0 and 100 which - -- determines the percentage of the allocated task stack that is - -- used by the secondary stack (the rest being the primary stack). - -- The special value of minus one indicates that the secondary - -- stack is to be allocated from the heap instead. - - Sec_Stack_Percentage : constant Percentage := Dynamic; - -- This constant defines the handling of the secondary stack - - Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Percentage = Dynamic; - -- Convenient Boolean for testing for dynamic secondary stack - function Default_Stack_Size return Size_Type; -- Default task stack size used if none is specified @@ -101,6 +87,18 @@ package System.Parameters is -- down (True) in memory as functions are called. It is used for -- proper implementation of the stack overflow check. + Runtime_Default_Sec_Stack_Size : constant Size_Type := 10 * 1024; + -- The run-time chosen default size for secondary stacks that may be + -- overriden by the user with the use of binder -D switch. + + function Default_Sec_Stack_Size return Size_Type; + -- The default initial size for secondary stacks that reflects any user + -- specified default via the binder -D switch. + + Sec_Stack_Dynamic : constant Boolean := True; + -- Indicates if secondary stacks can grow and shrink at run-time. If False, + -- the size of a secondary stack is fixed at the point of its creation. + ---------------------------------------------- -- Characteristics of Types in Interfaces.C -- ---------------------------------------------- diff --git a/gcc/ada/libgnat/s-parame__rtems.adb b/gcc/ada/libgnat/s-parame__rtems.adb index aa131147eb6e5..5a19c4396da76 100644 --- a/gcc/ada/libgnat/s-parame__rtems.adb +++ b/gcc/ada/libgnat/s-parame__rtems.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -39,6 +39,35 @@ package body System.Parameters is pragma Import (C, ada_pthread_minimum_stack_size, "_ada_pthread_minimum_stack_size"); + ------------------------- + -- Adjust_Storage_Size -- + ------------------------- + + function Adjust_Storage_Size (Size : Size_Type) return Size_Type is + begin + if Size = Unspecified_Size then + return Default_Stack_Size; + + elsif Size < Minimum_Stack_Size then + return Minimum_Stack_Size; + + else + return Size; + end if; + end Adjust_Storage_Size; + + ---------------------------- + -- Default_Sec_Stack_Size -- + ---------------------------- + + function Default_Sec_Stack_Size return Size_Type is + Default_SS_Size : Integer; + pragma Import (C, Default_SS_Size, + "__gnat_default_ss_size"); + begin + return Size_Type (Default_SS_Size); + end Default_Sec_Stack_Size; + ------------------------ -- Default_Stack_Size -- ------------------------ @@ -58,21 +87,4 @@ package body System.Parameters is return Size_Type (ada_pthread_minimum_stack_size); end Minimum_Stack_Size; - ------------------------- - -- Adjust_Storage_Size -- - ------------------------- - - function Adjust_Storage_Size (Size : Size_Type) return Size_Type is - begin - if Size = Unspecified_Size then - return Default_Stack_Size; - - elsif Size < Minimum_Stack_Size then - return Minimum_Stack_Size; - - else - return Size; - end if; - end Adjust_Storage_Size; - end System.Parameters; diff --git a/gcc/ada/libgnat/s-parame__vxworks.adb b/gcc/ada/libgnat/s-parame__vxworks.adb index 325aa2e4f08e0..97d74b6932e2c 100644 --- a/gcc/ada/libgnat/s-parame__vxworks.adb +++ b/gcc/ada/libgnat/s-parame__vxworks.adb @@ -48,6 +48,18 @@ package body System.Parameters is end if; end Adjust_Storage_Size; + ---------------------------- + -- Default_Sec_Stack_Size -- + ---------------------------- + + function Default_Sec_Stack_Size return Size_Type is + Default_SS_Size : Integer; + pragma Import (C, Default_SS_Size, + "__gnat_default_ss_size"); + begin + return Size_Type (Default_SS_Size); + end Default_Sec_Stack_Size; + ------------------------ -- Default_Stack_Size -- ------------------------ diff --git a/gcc/ada/libgnat/s-parame__vxworks.ads b/gcc/ada/libgnat/s-parame__vxworks.ads index 919361ad10d63..e395e017b05d1 100644 --- a/gcc/ada/libgnat/s-parame__vxworks.ads +++ b/gcc/ada/libgnat/s-parame__vxworks.ads @@ -62,20 +62,6 @@ package System.Parameters is Unspecified_Size : constant Size_Type := Size_Type'First; -- Value used to indicate that no size type is set - subtype Percentage is Size_Type range -1 .. 100; - Dynamic : constant Size_Type := -1; - -- The secondary stack ratio is a constant between 0 and 100 which - -- determines the percentage of the allocated task stack that is - -- used by the secondary stack (the rest being the primary stack). - -- The special value of minus one indicates that the secondary - -- stack is to be allocated from the heap instead. - - Sec_Stack_Percentage : constant Percentage := Dynamic; - -- This constant defines the handling of the secondary stack - - Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Percentage = Dynamic; - -- Convenient Boolean for testing for dynamic secondary stack - function Default_Stack_Size return Size_Type; -- Default task stack size used if none is specified @@ -103,6 +89,18 @@ package System.Parameters is -- down (True) in memory as functions are called. It is used for -- proper implementation of the stack overflow check. + Runtime_Default_Sec_Stack_Size : constant Size_Type := 10 * 1024; + -- The run-time chosen default size for secondary stacks that may be + -- overriden by the user with the use of binder -D switch. + + function Default_Sec_Stack_Size return Size_Type; + -- The default initial size for secondary stacks that reflects any user + -- specified default via the binder -D switch. + + Sec_Stack_Dynamic : constant Boolean := True; + -- Indicates if secondary stacks can grow and shrink at run-time. If False, + -- the size of a secondary stack is fixed at the point of its creation. + ---------------------------------------------- -- Characteristics of types in Interfaces.C -- ---------------------------------------------- diff --git a/gcc/ada/libgnat/s-secsta.adb b/gcc/ada/libgnat/s-secsta.adb index 0449ee4dbcdf6..b39cf0dc33dec 100644 --- a/gcc/ada/libgnat/s-secsta.adb +++ b/gcc/ada/libgnat/s-secsta.adb @@ -31,203 +31,65 @@ pragma Compiler_Unit_Warning; -with System.Soft_Links; -with System.Parameters; - with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; +with System.Soft_Links; package body System.Secondary_Stack is package SSL renames System.Soft_Links; - use type SSE.Storage_Offset; use type System.Parameters.Size_Type; - SS_Ratio_Dynamic : constant Boolean := - Parameters.Sec_Stack_Percentage = Parameters.Dynamic; - -- There are two entirely different implementations of the secondary - -- stack mechanism in this unit, and this Boolean is used to select - -- between them (at compile time, so the generated code will contain - -- only the code for the desired variant). If SS_Ratio_Dynamic is - -- True, then the secondary stack is dynamically allocated from the - -- heap in a linked list of chunks. If SS_Ration_Dynamic is False, - -- then the secondary stack is allocated statically by grabbing a - -- section of the primary stack and using it for this purpose. - - type Memory is array (SS_Ptr range <>) of SSE.Storage_Element; - for Memory'Alignment use Standard'Maximum_Alignment; - -- This is the type used for actual allocation of secondary stack - -- areas. We require maximum alignment for all such allocations. - - --------------------------------------------------------------- - -- Data Structures for Dynamically Allocated Secondary Stack -- - --------------------------------------------------------------- - - -- The following is a diagram of the data structures used for the - -- case of a dynamically allocated secondary stack, where the stack - -- is allocated as a linked list of chunks allocated from the heap. - - -- +------------------+ - -- | Next | - -- +------------------+ - -- | | Last (200) - -- | | - -- | | - -- | | - -- | | - -- | | - -- | | First (101) - -- +------------------+ - -- +----------> | | | - -- | +--------- | ------+ - -- | ^ | - -- | | | - -- | | V - -- | +------ | ---------+ - -- | | | | - -- | +------------------+ - -- | | | Last (100) - -- | | C | - -- | | H | - -- +-----------------+ | +------->| U | - -- | Current_Chunk ----+ | | N | - -- +-----------------+ | | K | - -- | Top --------+ | | First (1) - -- +-----------------+ +------------------+ - -- | Default_Size | | Prev | - -- +-----------------+ +------------------+ - -- - - type Chunk_Id (First, Last : SS_Ptr); - type Chunk_Ptr is access all Chunk_Id; - - type Chunk_Id (First, Last : SS_Ptr) is record - Prev, Next : Chunk_Ptr; - Mem : Memory (First .. Last); - end record; - - type Stack_Id is record - Top : SS_Ptr; - Default_Size : SSE.Storage_Count; - Current_Chunk : Chunk_Ptr; - end record; - - type Stack_Ptr is access Stack_Id; - -- Pointer to record used to represent a dynamically allocated secondary - -- stack descriptor for a secondary stack chunk. - procedure Free is new Ada.Unchecked_Deallocation (Chunk_Id, Chunk_Ptr); -- Free a dynamically allocated chunk - function To_Stack_Ptr is new - Ada.Unchecked_Conversion (Address, Stack_Ptr); - function To_Addr is new - Ada.Unchecked_Conversion (Stack_Ptr, Address); - -- Convert to and from address stored in task data structures - - -------------------------------------------------------------- - -- Data Structures for Statically Allocated Secondary Stack -- - -------------------------------------------------------------- - - -- For the static case, the secondary stack is a single contiguous - -- chunk of storage, carved out of the primary stack, and represented - -- by the following data structure - - type Fixed_Stack_Id is record - Top : SS_Ptr; - -- Index of next available location in Mem. This is initialized to - -- 0, and then incremented on Allocate, and Decremented on Release. - - Last : SS_Ptr; - -- Length of usable Mem array, which is thus the index past the - -- last available location in Mem. Mem (Last-1) can be used. This - -- is used to check that the stack does not overflow. - - Max : SS_Ptr; - -- Maximum value of Top. Initialized to 0, and then may be incremented - -- on Allocate, but is never Decremented. The last used location will - -- be Mem (Max - 1), so Max is the maximum count of used stack space. - - Mem : Memory (0 .. 0); - -- This is the area that is actually used for the secondary stack. - -- Note that the upper bound is a dummy value properly defined by - -- the value of Last. We never actually allocate objects of type - -- Fixed_Stack_Id, so the bounds declared here do not matter. - end record; - - Dummy_Fixed_Stack : Fixed_Stack_Id; - pragma Warnings (Off, Dummy_Fixed_Stack); - -- Well it is not quite true that we never allocate an object of the - -- type. This dummy object is allocated for the purpose of getting the - -- offset of the Mem field via the 'Position attribute (such a nuisance - -- that we cannot apply this to a field of a type). - - type Fixed_Stack_Ptr is access Fixed_Stack_Id; - -- Pointer to record used to describe statically allocated sec stack - - function To_Fixed_Stack_Ptr is new - Ada.Unchecked_Conversion (Address, Fixed_Stack_Ptr); - -- Convert from address stored in task data structures - - ---------------------------------- - -- Minimum_Secondary_Stack_Size -- - ---------------------------------- - - function Minimum_Secondary_Stack_Size return Natural is - begin - return Dummy_Fixed_Stack.Mem'Position; - end Minimum_Secondary_Stack_Size; - - -------------- - -- Allocate -- - -------------- + ----------------- + -- SS_Allocate -- + ----------------- procedure SS_Allocate (Addr : out Address; Storage_Size : SSE.Storage_Count) is - Max_Align : constant SS_Ptr := SS_Ptr (Standard'Maximum_Alignment); - Max_Size : constant SS_Ptr := - ((SS_Ptr (Storage_Size) + Max_Align - 1) / Max_Align) * - Max_Align; - + Max_Align : constant SS_Ptr := SS_Ptr (Standard'Maximum_Alignment); + Mem_Request : constant SS_Ptr := + ((SS_Ptr (Storage_Size) + Max_Align - 1) / Max_Align) * + Max_Align; + -- Round up Storage_Size to the nearest multiple of the max alignment + -- value for the target. This ensures efficient stack access. + + Stack : constant SS_Stack_Ptr := SSL.Get_Sec_Stack.all; begin - -- Case of fixed allocation secondary stack - - if not SS_Ratio_Dynamic then - declare - Fixed_Stack : constant Fixed_Stack_Ptr := - To_Fixed_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all); + -- Case of fixed secondary stack - begin - -- Check if max stack usage is increasing + if not SP.Sec_Stack_Dynamic then + -- Check if max stack usage is increasing - if Fixed_Stack.Top + Max_Size > Fixed_Stack.Max then + if Stack.Top + Mem_Request > Stack.Max then - -- If so, check if max size is exceeded + -- If so, check if the stack is exceeded, noting Stack.Top points + -- to the first free byte (so the value of Stack.Top on a fully + -- allocated stack will be Stack.Size + 1). - if Fixed_Stack.Top + Max_Size > Fixed_Stack.Last then - raise Storage_Error; - end if; + if Stack.Top + Mem_Request > Stack.Size + 1 then + raise Storage_Error; + end if; - -- Record new max usage + -- Record new max usage - Fixed_Stack.Max := Fixed_Stack.Top + Max_Size; - end if; + Stack.Max := Stack.Top + Mem_Request; + end if; - -- Set resulting address and update top of stack pointer + -- Set resulting address and update top of stack pointer - Addr := Fixed_Stack.Mem (Fixed_Stack.Top)'Address; - Fixed_Stack.Top := Fixed_Stack.Top + Max_Size; - end; + Addr := Stack.Internal_Chunk.Mem (Stack.Top)'Address; + Stack.Top := Stack.Top + Mem_Request; - -- Case of dynamically allocated secondary stack + -- Case of dynamic secondary stack else declare - Stack : constant Stack_Ptr := - To_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all); Chunk : Chunk_Ptr; To_Be_Released_Chunk : Chunk_Ptr; @@ -235,7 +97,7 @@ package body System.Secondary_Stack is begin Chunk := Stack.Current_Chunk; - -- The Current_Chunk may not be the good one if a lot of release + -- The Current_Chunk may not be the best one if a lot of release -- operations have taken place. Go down the stack if necessary. while Chunk.First > Stack.Top loop @@ -246,7 +108,7 @@ package body System.Secondary_Stack is -- sufficient, if not, go to the next one and eventually create -- the necessary room. - while Chunk.Last - Stack.Top + 1 < Max_Size loop + while Chunk.Last - Stack.Top + 1 < Mem_Request loop if Chunk.Next /= null then -- Release unused non-first empty chunk @@ -262,11 +124,11 @@ package body System.Secondary_Stack is -- Create new chunk of default size unless it is not sufficient -- to satisfy the current request. - elsif SSE.Storage_Count (Max_Size) <= Stack.Default_Size then + elsif Mem_Request <= Stack.Size then Chunk.Next := new Chunk_Id (First => Chunk.Last + 1, - Last => Chunk.Last + SS_Ptr (Stack.Default_Size)); + Last => Chunk.Last + SS_Ptr (Stack.Size)); Chunk.Next.Prev := Chunk; @@ -276,7 +138,7 @@ package body System.Secondary_Stack is Chunk.Next := new Chunk_Id (First => Chunk.Last + 1, - Last => Chunk.Last + Max_Size); + Last => Chunk.Last + Mem_Request); Chunk.Next.Prev := Chunk; end if; @@ -288,8 +150,15 @@ package body System.Secondary_Stack is -- Resulting address is the address pointed by Stack.Top Addr := Chunk.Mem (Stack.Top)'Address; - Stack.Top := Stack.Top + Max_Size; + Stack.Top := Stack.Top + Mem_Request; Stack.Current_Chunk := Chunk; + + -- Record new max usage + + if Stack.Top > Stack.Max then + Stack.Max := Stack.Top; + end if; + end; end if; end SS_Allocate; @@ -298,40 +167,39 @@ package body System.Secondary_Stack is -- SS_Free -- ------------- - procedure SS_Free (Stk : in out Address) is + procedure SS_Free (Stack : in out SS_Stack_Ptr) is + procedure Free is + new Ada.Unchecked_Deallocation (SS_Stack, SS_Stack_Ptr); begin - -- Case of statically allocated secondary stack, nothing to free - - if not SS_Ratio_Dynamic then - return; + -- If using dynamic secondary stack, free any external chunks - -- Case of dynamically allocated secondary stack - - else + if SP.Sec_Stack_Dynamic then declare - Stack : Stack_Ptr := To_Stack_Ptr (Stk); Chunk : Chunk_Ptr; procedure Free is - new Ada.Unchecked_Deallocation (Stack_Id, Stack_Ptr); + new Ada.Unchecked_Deallocation (Chunk_Id, Chunk_Ptr); begin Chunk := Stack.Current_Chunk; - while Chunk.Prev /= null loop - Chunk := Chunk.Prev; - end loop; + -- Go to top of linked list and free backwards. Do not free the + -- internal chunk as it is part of SS_Stack. while Chunk.Next /= null loop Chunk := Chunk.Next; - Free (Chunk.Prev); end loop; - Free (Chunk); - Free (Stack); - Stk := Null_Address; + while Chunk.Prev /= null loop + Chunk := Chunk.Prev; + Free (Chunk.Next); + end loop; end; end if; + + if Stack.Freeable then + Free (Stack); + end if; end SS_Free; ---------------- @@ -339,17 +207,13 @@ package body System.Secondary_Stack is ---------------- function SS_Get_Max return Long_Long_Integer is + Stack : constant SS_Stack_Ptr := SSL.Get_Sec_Stack.all; begin - if SS_Ratio_Dynamic then - return -1; - else - declare - Fixed_Stack : constant Fixed_Stack_Ptr := - To_Fixed_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all); - begin - return Long_Long_Integer (Fixed_Stack.Max); - end; - end if; + -- Stack.Max points to the first untouched byte in the stack, thus the + -- maximum number of bytes that have been allocated on the stack is one + -- less the value of Stack.Max. + + return Long_Long_Integer (Stack.Max - 1); end SS_Get_Max; ------------- @@ -357,32 +221,25 @@ package body System.Secondary_Stack is ------------- procedure SS_Info is + Stack : constant SS_Stack_Ptr := SSL.Get_Sec_Stack.all; begin Put_Line ("Secondary Stack information:"); -- Case of fixed secondary stack - if not SS_Ratio_Dynamic then - declare - Fixed_Stack : constant Fixed_Stack_Ptr := - To_Fixed_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all); - - begin - Put_Line (" Total size : " - & SS_Ptr'Image (Fixed_Stack.Last) - & " bytes"); + if not SP.Sec_Stack_Dynamic then + Put_Line (" Total size : " + & SS_Ptr'Image (Stack.Size) + & " bytes"); - Put_Line (" Current allocated space : " - & SS_Ptr'Image (Fixed_Stack.Top) - & " bytes"); - end; + Put_Line (" Current allocated space : " + & SS_Ptr'Image (Stack.Top - 1) + & " bytes"); - -- Case of dynamically allocated secondary stack + -- Case of dynamic secondary stack else declare - Stack : constant Stack_Ptr := - To_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all); Nb_Chunks : Integer := 1; Chunk : Chunk_Ptr := Stack.Current_Chunk; @@ -414,7 +271,7 @@ package body System.Secondary_Stack is & Integer'Image (Nb_Chunks)); Put_Line (" Default size of Chunks : " - & SSE.Storage_Count'Image (Stack.Default_Size)); + & SP.Size_Type'Image (Stack.Size)); end; end if; end SS_Info; @@ -424,42 +281,86 @@ package body System.Secondary_Stack is ------------- procedure SS_Init - (Stk : in out Address; - Size : Natural := Default_Secondary_Stack_Size) + (Stack : in out SS_Stack_Ptr; + Size : SP.Size_Type := SP.Unspecified_Size) is - begin - -- Case of fixed size secondary stack - - if not SS_Ratio_Dynamic then - declare - Fixed_Stack : constant Fixed_Stack_Ptr := - To_Fixed_Stack_Ptr (Stk); - - begin - Fixed_Stack.Top := 0; - Fixed_Stack.Max := 0; - - if Size <= Dummy_Fixed_Stack.Mem'Position then - Fixed_Stack.Last := 0; - else - Fixed_Stack.Last := - SS_Ptr (Size) - Dummy_Fixed_Stack.Mem'Position; - end if; - end; - - -- Case of dynamically allocated secondary stack + use Parameters; - else - declare - Stack : Stack_Ptr; - begin - Stack := new Stack_Id; - Stack.Current_Chunk := new Chunk_Id (1, SS_Ptr (Size)); - Stack.Top := 1; - Stack.Default_Size := SSE.Storage_Count (Size); - Stk := To_Addr (Stack); - end; + Stack_Size : Size_Type; + begin + -- If Stack is not null then the stack has been allocated outside the + -- package (by the compiler or the user) and all that is left to do is + -- initialize the stack. Otherwise, SS_Init will allocate a secondary + -- stack from either the heap or the default-sized secondary stack pool + -- generated by the binder. In the later case, this pool is generated + -- only when the either No_Implicit_Heap_Allocations + -- or No_Implicit_Task_Allocations are active, and SS_Init will allocate + -- all requests for a secondary stack of Unspecified_Size from this + -- pool. + + if Stack = null then + if Size = Unspecified_Size then + Stack_Size := Default_Sec_Stack_Size; + else + Stack_Size := Size; + end if; + + if Size = Unspecified_Size + and then Binder_SS_Count > 0 + and then Num_Of_Assigned_Stacks < Binder_SS_Count + then + -- The default-sized secondary stack pool is passed from the + -- binder to this package as an Address since it is not possible + -- to have a pointer to an array of unconstrained objects. A + -- pointer to the pool is obtainable via an unchecked conversion + -- to a constrained array of SS_Stacks that mirrors the one used + -- by the binder. + + -- However, Ada understandably does not allow a local pointer to + -- a stack in the pool to be stored in a pointer outside of this + -- scope. While the conversion is safe in this case, since a view + -- of a global object is being used, using Unchecked_Access + -- would prevent users from specifying the restriction + -- No_Unchecked_Access whenever the secondary stack is used. As + -- a workaround, the local stack pointer is converted to a global + -- pointer via System.Address. + + declare + type Stk_Pool_Array is array (1 .. Binder_SS_Count) of + aliased SS_Stack (Default_SS_Size); + type Stk_Pool_Access is access Stk_Pool_Array; + + function To_Stack_Pool is new + Ada.Unchecked_Conversion (Address, Stk_Pool_Access); + + pragma Warnings (Off); + function To_Global_Ptr is new + Ada.Unchecked_Conversion (Address, SS_Stack_Ptr); + pragma Warnings (On); + -- Suppress aliasing warning since the pointer we return will + -- be the only access to the stack. + + Local_Stk_Address : System.Address; + + begin + Num_Of_Assigned_Stacks := Num_Of_Assigned_Stacks + 1; + + Local_Stk_Address := + To_Stack_Pool + (Default_Sized_SS_Pool) (Num_Of_Assigned_Stacks)'Address; + Stack := To_Global_Ptr (Local_Stk_Address); + end; + + Stack.Freeable := False; + else + Stack := new SS_Stack (Stack_Size); + Stack.Freeable := True; + end if; end if; + + Stack.Top := 1; + Stack.Max := 1; + Stack.Current_Chunk := Stack.Internal_Chunk'Access; end SS_Init; ------------- @@ -467,13 +368,9 @@ package body System.Secondary_Stack is ------------- function SS_Mark return Mark_Id is - Sstk : constant System.Address := SSL.Get_Sec_Stack_Addr.all; + Stack : constant SS_Stack_Ptr := SSL.Get_Sec_Stack.all; begin - if SS_Ratio_Dynamic then - return (Sstk => Sstk, Sptr => To_Stack_Ptr (Sstk).Top); - else - return (Sstk => Sstk, Sptr => To_Fixed_Stack_Ptr (Sstk).Top); - end if; + return (Sec_Stack => Stack, Sptr => Stack.Top); end SS_Mark; ---------------- @@ -482,66 +379,7 @@ package body System.Secondary_Stack is procedure SS_Release (M : Mark_Id) is begin - if SS_Ratio_Dynamic then - To_Stack_Ptr (M.Sstk).Top := M.Sptr; - else - To_Fixed_Stack_Ptr (M.Sstk).Top := M.Sptr; - end if; + M.Sec_Stack.Top := M.Sptr; end SS_Release; - ------------------------- - -- Package Elaboration -- - ------------------------- - - -- Allocate a secondary stack for the main program to use - - -- We make sure that the stack has maximum alignment. Some systems require - -- this (e.g. Sparc), and in any case it is a good idea for efficiency. - - Stack : aliased Stack_Id; - for Stack'Alignment use Standard'Maximum_Alignment; - - Static_Secondary_Stack_Size : constant := 10 * 1024; - -- Static_Secondary_Stack_Size must be static so that Chunk is allocated - -- statically, and not via dynamic memory allocation. - - Chunk : aliased Chunk_Id (1, Static_Secondary_Stack_Size); - for Chunk'Alignment use Standard'Maximum_Alignment; - -- Default chunk used, unless gnatbind -D is specified with a value greater - -- than Static_Secondary_Stack_Size. - -begin - declare - Chunk_Address : Address; - Chunk_Access : Chunk_Ptr; - - begin - if Default_Secondary_Stack_Size <= Static_Secondary_Stack_Size then - - -- Normally we allocate the secondary stack for the main program - -- statically, using the default secondary stack size. - - Chunk_Access := Chunk'Access; - - else - -- Default_Secondary_Stack_Size was increased via gnatbind -D, so we - -- need to allocate a chunk dynamically. - - Chunk_Access := - new Chunk_Id (1, SS_Ptr (Default_Secondary_Stack_Size)); - end if; - - if SS_Ratio_Dynamic then - Stack.Top := 1; - Stack.Current_Chunk := Chunk_Access; - Stack.Default_Size := - SSE.Storage_Offset (Default_Secondary_Stack_Size); - System.Soft_Links.Set_Sec_Stack_Addr_NT (Stack'Address); - - else - Chunk_Address := Chunk_Access.all'Address; - SS_Init (Chunk_Address, Default_Secondary_Stack_Size); - System.Soft_Links.Set_Sec_Stack_Addr_NT (Chunk_Address); - end if; - end; end System.Secondary_Stack; diff --git a/gcc/ada/libgnat/s-secsta.ads b/gcc/ada/libgnat/s-secsta.ads index 534708d1a6f99..ae5ec888453b3 100644 --- a/gcc/ada/libgnat/s-secsta.ads +++ b/gcc/ada/libgnat/s-secsta.ads @@ -31,41 +31,27 @@ pragma Compiler_Unit_Warning; +with System.Parameters; with System.Storage_Elements; package System.Secondary_Stack is + pragma Preelaborate; + package SP renames System.Parameters; package SSE renames System.Storage_Elements; - Default_Secondary_Stack_Size : Natural := 10 * 1024; - -- Default size of a secondary stack. May be modified by binder -D switch - -- which causes the binder to generate an appropriate assignment in the - -- binder generated file. + type SS_Stack (Size : SP.Size_Type) is private; + -- Data structure for secondary stacks - function Minimum_Secondary_Stack_Size return Natural; - -- The minimum size of the secondary stack so that the internal - -- requirements of the stack are met. + type SS_Stack_Ptr is access all SS_Stack; + -- Pointer to secondary stack objects procedure SS_Init - (Stk : in out Address; - Size : Natural := Default_Secondary_Stack_Size); - -- Initialize the secondary stack with a main stack of the given Size. - -- - -- If System.Parameters.Sec_Stack_Percentage equals Dynamic, Stk is really - -- an OUT parameter that will be allocated on the heap. Then all further - -- allocations which do not overflow the main stack will not generate - -- dynamic (de)allocation calls. If the main Stack overflows, a new - -- chuck of at least the same size will be allocated and linked to the - -- previous chunk. - -- - -- Otherwise (Sec_Stack_Percentage between 0 and 100), Stk is an IN - -- parameter that is already pointing to a Stack_Id. The secondary stack - -- in this case is fixed, and any attempt to allocate more than the initial - -- size will result in a Storage_Error being raised. - -- - -- Note: the reason that Stk is passed is that SS_Init is called before - -- the proper interface is established to obtain the address of the - -- stack using System.Soft_Links.Get_Sec_Stack_Addr. + (Stack : in out SS_Stack_Ptr; + Size : SP.Size_Type := SP.Unspecified_Size); + -- Initialize the secondary stack Stack. If Stack is null allocate a stack + -- from the heap or from the default-sized secondary stack pool if the + -- pool exists and the requested size is Unspecified_Size. procedure SS_Allocate (Addr : out Address; @@ -73,10 +59,9 @@ package System.Secondary_Stack is -- Allocate enough space for a 'Storage_Size' bytes object with Maximum -- alignment. The address of the allocated space is returned in Addr. - procedure SS_Free (Stk : in out Address); - -- Release the memory allocated for the Secondary Stack. That is - -- to say, all the allocated chunks. Upon return, Stk will be set - -- to System.Null_Address. + procedure SS_Free (Stack : in out SS_Stack_Ptr); + -- Release the memory allocated for the Stack. If the stack was statically + -- allocated the SS_Stack record is not freed. type Mark_Id is private; -- Type used to mark the stack for mark/release processing @@ -85,17 +70,11 @@ package System.Secondary_Stack is -- Return the Mark corresponding to the current state of the stack procedure SS_Release (M : Mark_Id); - -- Restore the state of the stack corresponding to the mark M. If an - -- additional chunk have been allocated, it will never be freed during a - -- ??? missing comment here + -- Restore the state of the stack corresponding to the mark M function SS_Get_Max return Long_Long_Integer; - -- Return maximum used space in storage units for the current secondary - -- stack. For a dynamically allocated secondary stack, the returned - -- result is always -1. For a statically allocated secondary stack, - -- the returned value shows the largest amount of space allocated so - -- far during execution of the program to the current secondary stack, - -- i.e. the secondary stack for the current task. + -- Return the high water mark of the secondary stack for the current + -- secondary stack in bytes. generic with procedure Put_Line (S : String); @@ -109,15 +88,142 @@ private -- Unused entity that is just present to ease the sharing of the pool -- mechanism for specific allocation/deallocation in the compiler - type SS_Ptr is new SSE.Integer_Address; - -- Stack pointer value for secondary stack + ------------------------------------- + -- Secondary Stack Data Structures -- + ------------------------------------- + + -- This package provides fixed and dynamically sized secondary stack + -- implementations centered around a common data structure SS_Stack. This + -- record contains an initial secondary stack allocation of the requested + -- size, and markers for the current top of the stack and the high-water + -- mark of the stack. A SS_Stack can be either pre-allocated outside the + -- package or SS_Init can allocate a stack from the heap or the + -- default-sized secondary stack from a pool generated by the binder. + + -- For dynamically allocated secondary stacks, the stack can grow via a + -- linked list of stack chunks allocated from the heap. New chunks are + -- allocated once the initial static allocation and any existing chunks are + -- exhausted. The following diagram illustrated the data structures used + -- for a dynamically allocated secondary stack: + -- + -- +------------------+ + -- | Next | + -- +------------------+ + -- | | Last (300) + -- | | + -- | | + -- | | + -- | | + -- | | + -- | | First (201) + -- +------------------+ + -- +-----------------+ +------> | | | + -- | | (100) | +--------- | ------+ + -- | | | ^ | + -- | | | | | + -- | | | | V + -- | | | +------ | ---------+ + -- | | | | | | + -- | | | +------------------+ + -- | | | | | Last (200) + -- | | | | C | + -- | | (1) | | H | + -- +-----------------+ | +---->| U | + -- | Current_Chunk ---------+ | | N | + -- +-----------------+ | | K | + -- | Top ------------+ | | First (101) + -- +-----------------+ +------------------+ + -- | Size | | Prev | + -- +-----------------+ +------------------+ + -- + -- The implementation used by the runtime is controlled via the constant + -- System.Parameter.Sec_Stack_Dynamic. If True, the implementation is + -- permitted to grow the secondary stack at runtime. The implementation is + -- designed for the compiler to include only code to support the desired + -- secondary stack behavior. + + subtype SS_Ptr is SP.Size_Type; + -- Stack pointer value for the current position within the secondary stack. + -- Size_Type is used as the base type since the Size discriminate of + -- SS_Stack forms the bounds of the internal memory array. + + type Memory is array (SS_Ptr range <>) of SSE.Storage_Element; + for Memory'Alignment use Standard'Maximum_Alignment; + -- The region of memory that holds the stack itself. Requires maximum + -- alignment for efficient stack operations. + + -- Chunk_Id + + -- Chunk_Id is a contiguous block of dynamically allocated stack. First + -- and Last indicate the range of secondary stack addresses present in the + -- chunk. Chunk_Ptr points to a Chunk_Id block. + + type Chunk_Id (First, Last : SS_Ptr); + type Chunk_Ptr is access all Chunk_Id; + + type Chunk_Id (First, Last : SS_Ptr) is record + Prev, Next : Chunk_Ptr; + Mem : Memory (First .. Last); + end record; + + -- Secondary stack data structure + + type SS_Stack (Size : SP.Size_Type) is record + Top : SS_Ptr; + -- Index of next available location in the stack. Initialized to 1 and + -- then incremented on Allocate and decremented on Release. + + Max : SS_Ptr; + -- Contains the high-water mark of Top. Initialized to 1 and then + -- may be incremented on Allocate but never decremented. Since + -- Top = Size + 1 represents a fully used stack, Max - 1 indicates + -- the size of the stack used in bytes. + + Current_Chunk : Chunk_Ptr; + -- A link to the chunk containing the highest range of the stack + + Freeable : Boolean; + -- Indicates if an object of this type can be freed + + Internal_Chunk : aliased Chunk_Id (1, Size); + -- Initial memory allocation of the secondary stack + end record; type Mark_Id is record - Sstk : System.Address; - Sptr : SS_Ptr; + Sec_Stack : SS_Stack_Ptr; + Sptr : SS_Ptr; end record; - -- A mark value contains the address of the secondary stack structure, - -- as returned by System.Soft_Links.Get_Sec_Stack_Addr, and a stack - -- pointer value corresponding to the point of the mark call. + -- Contains the pointer to the secondary stack object and the stack pointer + -- value corresponding to the top of the stack at the time of the mark + -- call. + + ------------------------------------ + -- Binder Allocated Stack Support -- + ------------------------------------ + + -- When the No_Implicit_Heap_Allocations or No_Implicit_Task_Allocations + -- restrictions are in effect the binder statically generates secondary + -- stacks for tasks who are using default-sized secondary stack. Assignment + -- of these stacks to tasks is handled by SS_Init. The following variables + -- assist SS_Init and are defined here so the runtime does not depend on + -- the binder. + + Binder_SS_Count : Natural; + pragma Export (Ada, Binder_SS_Count, "__gnat_binder_ss_count"); + -- The number of default sized secondary stacks allocated by the binder + + Default_SS_Size : SP.Size_Type; + pragma Export (Ada, Default_SS_Size, "__gnat_default_ss_size"); + -- The default size for secondary stacks. Defined here and not in init.c/ + -- System.Init because these locations are not present on ZFP or + -- Ravenscar-SFP run-times. + + Default_Sized_SS_Pool : System.Address; + pragma Export (Ada, Default_Sized_SS_Pool, "__gnat_default_ss_pool"); + -- Address to the secondary stack pool generated by the binder that + -- contains default sized stacks. + + Num_Of_Assigned_Stacks : Natural := 0; + -- The number of currently allocated secondary stacks end System.Secondary_Stack; diff --git a/gcc/ada/libgnat/s-soflin.adb b/gcc/ada/libgnat/s-soflin.adb index f604f4df3be1e..94ead0306faa7 100644 --- a/gcc/ada/libgnat/s-soflin.adb +++ b/gcc/ada/libgnat/s-soflin.adb @@ -35,25 +35,19 @@ pragma Polling (Off); -- We must turn polling off for this unit, because otherwise we get an -- infinite loop from the code within the Poll routine itself. -with System.Parameters; - pragma Warnings (Off); --- Disable warnings since System.Secondary_Stack is currently not Preelaborate -with System.Secondary_Stack; +-- Disable warnings as System.Soft_Links.Initialize is not Preelaborate. It is +-- safe to with this unit as its elaboration routine will only be initializing +-- NT_TSD, which is part of this package spec. +with System.Soft_Links.Initialize; pragma Warnings (On); package body System.Soft_Links is - package SST renames System.Secondary_Stack; - - NT_TSD : TSD; - -- Note: we rely on the default initialization of NT_TSD - - -- Needed for Vx6Cert (Vx653mc) GOS cert and ravenscar-cert runtimes, - -- VxMILS cert, ravenscar-cert and full runtimes, Vx 5 default runtime Stack_Limit : aliased System.Address := System.Null_Address; - pragma Export (C, Stack_Limit, "__gnat_stack_limit"); + -- Needed for Vx6Cert (Vx653mc) GOS cert and ravenscar-cert runtimes, + -- VxMILS cert, ravenscar-cert and full runtimes, Vx 5 default runtime -------------------- -- Abort_Defer_NT -- @@ -125,14 +119,16 @@ package body System.Soft_Links is -- Create_TSD -- ---------------- - procedure Create_TSD (New_TSD : in out TSD) is - use Parameters; - SS_Ratio_Dynamic : constant Boolean := Sec_Stack_Percentage = Dynamic; + procedure Create_TSD + (New_TSD : in out TSD; + Sec_Stack : SST.SS_Stack_Ptr; + Sec_Stack_Size : System.Parameters.Size_Type) + is begin - if SS_Ratio_Dynamic then - SST.SS_Init - (New_TSD.Sec_Stack_Addr, SST.Default_Secondary_Stack_Size); - end if; + New_TSD.Jmpbuf_Address := Null_Address; + + New_TSD.Sec_Stack_Ptr := Sec_Stack; + SST.SS_Init (New_TSD.Sec_Stack_Ptr, Sec_Stack_Size); end Create_TSD; ----------------------- @@ -150,7 +146,7 @@ package body System.Soft_Links is procedure Destroy_TSD (Old_TSD : in out TSD) is begin - SST.SS_Free (Old_TSD.Sec_Stack_Addr); + SST.SS_Free (Old_TSD.Sec_Stack_Ptr); end Destroy_TSD; --------------------- @@ -198,23 +194,23 @@ package body System.Soft_Links is return Get_Jmpbuf_Address.all; end Get_Jmpbuf_Address_Soft; - --------------------------- - -- Get_Sec_Stack_Addr_NT -- - --------------------------- + ---------------------- + -- Get_Sec_Stack_NT -- + ---------------------- - function Get_Sec_Stack_Addr_NT return Address is + function Get_Sec_Stack_NT return SST.SS_Stack_Ptr is begin - return NT_TSD.Sec_Stack_Addr; - end Get_Sec_Stack_Addr_NT; + return NT_TSD.Sec_Stack_Ptr; + end Get_Sec_Stack_NT; ----------------------------- - -- Get_Sec_Stack_Addr_Soft -- + -- Get_Sec_Stack_Soft -- ----------------------------- - function Get_Sec_Stack_Addr_Soft return Address is + function Get_Sec_Stack_Soft return SST.SS_Stack_Ptr is begin - return Get_Sec_Stack_Addr.all; - end Get_Sec_Stack_Addr_Soft; + return Get_Sec_Stack.all; + end Get_Sec_Stack_Soft; ----------------------- -- Get_Stack_Info_NT -- @@ -254,23 +250,23 @@ package body System.Soft_Links is Set_Jmpbuf_Address (Addr); end Set_Jmpbuf_Address_Soft; - --------------------------- - -- Set_Sec_Stack_Addr_NT -- - --------------------------- + ---------------------- + -- Set_Sec_Stack_NT -- + ---------------------- - procedure Set_Sec_Stack_Addr_NT (Addr : Address) is + procedure Set_Sec_Stack_NT (Stack : SST.SS_Stack_Ptr) is begin - NT_TSD.Sec_Stack_Addr := Addr; - end Set_Sec_Stack_Addr_NT; + NT_TSD.Sec_Stack_Ptr := Stack; + end Set_Sec_Stack_NT; - ----------------------------- - -- Set_Sec_Stack_Addr_Soft -- - ----------------------------- + ------------------------ + -- Set_Sec_Stack_Soft -- + ------------------------ - procedure Set_Sec_Stack_Addr_Soft (Addr : Address) is + procedure Set_Sec_Stack_Soft (Stack : SST.SS_Stack_Ptr) is begin - Set_Sec_Stack_Addr (Addr); - end Set_Sec_Stack_Addr_Soft; + Set_Sec_Stack (Stack); + end Set_Sec_Stack_Soft; ------------------ -- Task_Lock_NT -- @@ -308,5 +304,4 @@ package body System.Soft_Links is begin null; end Task_Unlock_NT; - end System.Soft_Links; diff --git a/gcc/ada/libgnat/s-soflin.ads b/gcc/ada/libgnat/s-soflin.ads index 402ea84818b41..4242fcee7ee6c 100644 --- a/gcc/ada/libgnat/s-soflin.ads +++ b/gcc/ada/libgnat/s-soflin.ads @@ -40,11 +40,15 @@ pragma Compiler_Unit_Warning; with Ada.Exceptions; +with System.Parameters; +with System.Secondary_Stack; with System.Stack_Checking; package System.Soft_Links is pragma Preelaborate; + package SST renames System.Secondary_Stack; + subtype EOA is Ada.Exceptions.Exception_Occurrence_Access; subtype EO is Ada.Exceptions.Exception_Occurrence; @@ -89,6 +93,11 @@ package System.Soft_Links is type Set_EO_Call is access procedure (Excep : EO); pragma Favor_Top_Level (Set_EO_Call); + type Get_Stack_Call is access function return SST.SS_Stack_Ptr; + pragma Favor_Top_Level (Get_Stack_Call); + type Set_Stack_Call is access procedure (Stack : SST.SS_Stack_Ptr); + pragma Favor_Top_Level (Set_Stack_Call); + type Special_EO_Call is access procedure (Excep : EO := Current_Target_Exception); pragma Favor_Top_Level (Special_EO_Call); @@ -118,6 +127,8 @@ package System.Soft_Links is pragma Suppress (Access_Check, Set_Integer_Call); pragma Suppress (Access_Check, Get_EOA_Call); pragma Suppress (Access_Check, Set_EOA_Call); + pragma Suppress (Access_Check, Get_Stack_Call); + pragma Suppress (Access_Check, Set_Stack_Call); pragma Suppress (Access_Check, Timed_Delay_Call); pragma Suppress (Access_Check, Get_Stack_Access_Call); pragma Suppress (Access_Check, Task_Name_Call); @@ -228,11 +239,11 @@ package System.Soft_Links is Get_Jmpbuf_Address : Get_Address_Call := Get_Jmpbuf_Address_NT'Access; Set_Jmpbuf_Address : Set_Address_Call := Set_Jmpbuf_Address_NT'Access; - function Get_Sec_Stack_Addr_NT return Address; - procedure Set_Sec_Stack_Addr_NT (Addr : Address); + function Get_Sec_Stack_NT return SST.SS_Stack_Ptr; + procedure Set_Sec_Stack_NT (Stack : SST.SS_Stack_Ptr); - Get_Sec_Stack_Addr : Get_Address_Call := Get_Sec_Stack_Addr_NT'Access; - Set_Sec_Stack_Addr : Set_Address_Call := Set_Sec_Stack_Addr_NT'Access; + Get_Sec_Stack : Get_Stack_Call := Get_Sec_Stack_NT'Access; + Set_Sec_Stack : Set_Stack_Call := Set_Sec_Stack_NT'Access; function Get_Current_Excep_NT return EOA; @@ -320,19 +331,14 @@ package System.Soft_Links is -- must be initialized to the tasks requested stack size before the task -- can do its first stack check. - pragma Warnings (Off); - -- Needed because we are giving a non-static default to an object in - -- a preelaborated unit, which is formally not permitted, but OK here. - - Jmpbuf_Address : System.Address := System.Null_Address; + Jmpbuf_Address : System.Address; -- Address of jump buffer used to store the address of the current -- longjmp/setjmp buffer for exception management. These buffers are -- threaded into a stack, and the address here is the top of the stack. -- A null address means that no exception handler is currently active. - Sec_Stack_Addr : System.Address := System.Null_Address; - pragma Warnings (On); - -- Address of currently allocated secondary stack + Sec_Stack_Ptr : SST.SS_Stack_Ptr; + -- Pointer of the allocated secondary stack Current_Excep : aliased EO; -- Exception occurrence that contains the information for the current @@ -344,7 +350,10 @@ package System.Soft_Links is -- exception mechanism, organized as a stack with the most recent first. end record; - procedure Create_TSD (New_TSD : in out TSD); + procedure Create_TSD + (New_TSD : in out TSD; + Sec_Stack : SST.SS_Stack_Ptr; + Sec_Stack_Size : System.Parameters.Size_Type); pragma Inline (Create_TSD); -- Called from s-tassta when a new thread is created to perform -- any required initialization of the TSD. @@ -370,10 +379,10 @@ package System.Soft_Links is pragma Inline (Get_Jmpbuf_Address_Soft); pragma Inline (Set_Jmpbuf_Address_Soft); - function Get_Sec_Stack_Addr_Soft return Address; - procedure Set_Sec_Stack_Addr_Soft (Addr : Address); - pragma Inline (Get_Sec_Stack_Addr_Soft); - pragma Inline (Set_Sec_Stack_Addr_Soft); + function Get_Sec_Stack_Soft return SST.SS_Stack_Ptr; + procedure Set_Sec_Stack_Soft (Stack : SST.SS_Stack_Ptr); + pragma Inline (Get_Sec_Stack_Soft); + pragma Inline (Set_Sec_Stack_Soft); -- The following is a dummy record designed to mimic Communication_Block as -- defined in s-tpobop.ads: @@ -396,4 +405,11 @@ package System.Soft_Links is Comp_3 : Boolean; end record; +private + NT_TSD : TSD; + -- The task specific data for the main task when the Ada tasking run-time + -- is not used. It relies on the default initialization of NT_TSD. It is + -- placed here and not the body to ensure the default initialization does + -- not clobber the secondary stack initialization that occurs as part of + -- System.Soft_Links.Initialization. end System.Soft_Links; diff --git a/gcc/ada/libgnat/s-soliin.adb b/gcc/ada/libgnat/s-soliin.adb new file mode 100644 index 0000000000000..5364e46f6f4e7 --- /dev/null +++ b/gcc/ada/libgnat/s-soliin.adb @@ -0,0 +1,47 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . S O F T _ L I N K S . I N I T I A L I Z E -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2017, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with System.Secondary_Stack; + +package body System.Soft_Links.Initialize is + + package SSS renames System.Secondary_Stack; + +begin + -- Initialize the TSD of the main task + + NT_TSD.Jmpbuf_Address := System.Null_Address; + + -- Allocate and initialize the secondary stack for the main task + + NT_TSD.Sec_Stack_Ptr := null; + SSS.SS_Init (NT_TSD.Sec_Stack_Ptr); +end System.Soft_Links.Initialize; diff --git a/gcc/ada/libgnat/s-soliin.ads b/gcc/ada/libgnat/s-soliin.ads new file mode 100644 index 0000000000000..ba9cf745f4839 --- /dev/null +++ b/gcc/ada/libgnat/s-soliin.ads @@ -0,0 +1,48 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . S O F T _ L I N K S . I N I T I A L I Z E -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2017, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package exists to initialize the TSD record of the main task and in +-- the process, allocate and initialize the secondary stack for the main task. +-- The initialization routine is contained within its own package because +-- System.Soft_Links and System.Secondary_Stack are both Preelaborate packages +-- that are the parents to other Preelaborate System packages. + +-- Ideally, the secondary stack would be set up via __gnat_runtime_initialize +-- to have the secondary stack active as early as possible and to remove the +-- awkwardness of System.Soft_Links depending on a non-Preelaborate package. +-- However, as this procedure only exists from 2014, for bootstrapping +-- purposes the elaboration mechanism is used instead to perform these +-- functions. + +package System.Soft_Links.Initialize is + pragma Elaborate_Body; + -- Allow this package to have a body +end System.Soft_Links.Initialize; diff --git a/gcc/ada/libgnat/s-thread.ads b/gcc/ada/libgnat/s-thread.ads index cd4faaec1ed49..185141b1f1b6b 100644 --- a/gcc/ada/libgnat/s-thread.ads +++ b/gcc/ada/libgnat/s-thread.ads @@ -42,10 +42,13 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.Secondary_Stack; with System.Soft_Links; package System.Threads is + package SST renames System.Secondary_Stack; + type ATSD is limited private; -- Type of the Ada thread specific data. It contains datas needed -- by the GNAT runtime. @@ -71,8 +74,7 @@ package System.Threads is -- wrapper in the APEX process registration package. procedure Thread_Body_Enter - (Sec_Stack_Address : System.Address; - Sec_Stack_Size : Natural; + (Sec_Stack_Ptr : SST.SS_Stack_Ptr; Process_ATSD_Address : System.Address); -- Enter thread body, see above for details diff --git a/gcc/ada/libgnat/s-thread__ae653.adb b/gcc/ada/libgnat/s-thread__ae653.adb index ca871286fceed..9e8b2abb946aa 100644 --- a/gcc/ada/libgnat/s-thread__ae653.adb +++ b/gcc/ada/libgnat/s-thread__ae653.adb @@ -37,15 +37,11 @@ pragma Restrictions (No_Tasking); -- will be checked by the binder. with System.OS_Versions; use System.OS_Versions; -with System.Secondary_Stack; -pragma Elaborate_All (System.Secondary_Stack); package body System.Threads is use Interfaces.C; - package SSS renames System.Secondary_Stack; - package SSL renames System.Soft_Links; Current_ATSD : aliased System.Address := System.Null_Address; @@ -94,17 +90,16 @@ package body System.Threads is procedure Install_Handler; pragma Import (C, Install_Handler, "__gnat_install_handler"); - function Get_Sec_Stack_Addr return Address; + function Get_Sec_Stack return SST.SS_Stack_Ptr; - procedure Set_Sec_Stack_Addr (Addr : Address); + procedure Set_Sec_Stack (Stack : SST.SS_Stack_Ptr); ----------------------- -- Thread_Body_Enter -- ----------------------- procedure Thread_Body_Enter - (Sec_Stack_Address : System.Address; - Sec_Stack_Size : Natural; + (Sec_Stack_Ptr : SST.SS_Stack_Ptr; Process_ATSD_Address : System.Address) is -- Current_ATSD must already be a taskVar of taskIdSelf. @@ -115,8 +110,8 @@ package body System.Threads is begin - TSD.Sec_Stack_Addr := Sec_Stack_Address; - SSS.SS_Init (TSD.Sec_Stack_Addr, Sec_Stack_Size); + TSD.Sec_Stack_Ptr := Sec_Stack_Ptr; + SST.SS_Init (TSD.Sec_Stack_Ptr); Current_ATSD := Process_ATSD_Address; Install_Handler; @@ -166,23 +161,23 @@ package body System.Threads is pragma Assert (Result /= ERROR); begin - Main_ATSD.Sec_Stack_Addr := SSL.Get_Sec_Stack_Addr_NT; + Main_ATSD.Sec_Stack_Ptr := SSL.Get_Sec_Stack_NT; Current_ATSD := Main_ATSD'Address; Install_Handler; - SSL.Get_Sec_Stack_Addr := Get_Sec_Stack_Addr'Access; - SSL.Set_Sec_Stack_Addr := Set_Sec_Stack_Addr'Access; + SSL.Get_Sec_Stack := Get_Sec_Stack'Access; + SSL.Set_Sec_Stack := Set_Sec_Stack'Access; end Init_RTS; - ------------------------ - -- Get_Sec_Stack_Addr -- - ------------------------ + ------------------- + -- Get_Sec_Stack -- + ------------------- - function Get_Sec_Stack_Addr return Address is + function Get_Sec_Stack return SST.SS_Stack_Ptr is CTSD : constant ATSD_Access := From_Address (Current_ATSD); begin pragma Assert (CTSD /= null); - return CTSD.Sec_Stack_Addr; - end Get_Sec_Stack_Addr; + return CTSD.Sec_Stack_Ptr; + end Get_Sec_Stack; -------------- -- Register -- @@ -229,16 +224,16 @@ package body System.Threads is return Result; end Register; - ------------------------ - -- Set_Sec_Stack_Addr -- - ------------------------ + ------------------- + -- Set_Sec_Stack -- + ------------------- - procedure Set_Sec_Stack_Addr (Addr : Address) is + procedure Set_Sec_Stack (Stack : SST.SS_Stack_Ptr) is CTSD : constant ATSD_Access := From_Address (Current_ATSD); begin pragma Assert (CTSD /= null); - CTSD.Sec_Stack_Addr := Addr; - end Set_Sec_Stack_Addr; + CTSD.Sec_Stack_Ptr := Stack; + end Set_Sec_Stack; begin -- Initialize run-time library diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index 124f7782036f7..72ac8fabf30d2 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -477,7 +477,7 @@ package Namet is -- Sets the Int value associated with the given name function Is_Internal_Name (Id : Name_Id) return Boolean; - -- Returns True if the name is an internal name (i.e. contains a character + -- Returns True if the name is an internal name, i.e. contains a character -- for which Is_OK_Internal_Letter is true, or if the name starts or ends -- with an underscore. -- diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 687d1eb75b969..96e2f3e2f924f 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -462,18 +462,21 @@ package Opt is -- otherwise: "pragma Default_Storage_Pool (X);" applies, and -- this points to the name X. -- Push_Scope and Pop_Scope in Sem_Ch8 save and restore this value. - Default_Stack_Size : Int := -1; + + No_Stack_Size : constant := -1; + + Default_Stack_Size : Int := No_Stack_Size; -- GNATBIND - -- Set to default primary stack size in units of bytes. Set by - -- the -dnnn switch for the binder. A value of -1 indicates that no - -- default was set by the binder. + -- Set to default primary stack size in units of bytes. Set by the -dnnn + -- switch for the binder. A value of No_Stack_Size indicates that + -- no default was set by the binder. - Default_Sec_Stack_Size : Int := -1; + Default_Sec_Stack_Size : Int := No_Stack_Size; -- GNATBIND - -- Set to default secondary stack size in units of bytes. Set by - -- the -Dnnn switch for the binder. A value of -1 indicates that no - -- default was set by the binder, and that the default should be the - -- initial value of System.Secondary_Stack.Default_Secondary_Stack_Size. + -- Set to default secondary stack size in units of bytes. Set by the -Dnnn + -- switch for the binder. A value of No_Stack_Size indicates that no + -- default was set by the binder and the run-time value should be used + -- instead. Default_SSO : Character := ' '; -- GNAT @@ -1313,6 +1316,13 @@ package Opt is -- Indicates if a project file is used or not. Set to In_Use by the first -- SFNP pragma. + Quantity_Of_Default_Size_Sec_Stacks : Int := -1; + -- GNATBIND + -- The number of default sized secondary stacks that the binder should + -- generate. Allows ZFP users to have the binder generate extra stacks if + -- needed to support multithreaded applications. A value of -1 indicates + -- that no size was set by the binder. + Queuing_Policy : Character := ' '; -- GNAT, GNATBIND -- Set to ' ' for the default case (no queuing policy specified). Reset to diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 781db47d0afc9..14fbba51152f8 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -2568,10 +2568,6 @@ package body Osint is FD : out File_Descriptor; T : File_Type := Source) is - -- Source_File_FD : File_Descriptor; - -- The file descriptor for the current source file. A negative value - -- indicates failure to open the specified source file. - Len : Integer; -- Length of file, assume no more than 2 gigabytes of source diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index 4d6a4a4d8cd5c..b8edeec2b589b 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -405,7 +405,8 @@ package Osint is T : File_Type := Source); -- Allocates a Source_Buffer of appropriate length and then reads the -- entire contents of the source file N into the buffer. The address of - -- the allocated buffer is returned in Src. + -- the allocated buffer is returned in Src. FD is used for extended error + -- information in the case the read fails. -- -- Each line of text is terminated by one of the sequences: -- @@ -427,7 +428,11 @@ package Osint is -- failure to find the file is a fatal error, an error message is output, -- and program execution is terminated. Otherwise (for the case of a -- subsidiary source loaded directly or indirectly using with), a file - -- not found condition causes null to be set as the result value. + -- not found condition causes null to be set as the result value and a + -- value of No_Source_File (0) to be set as the FD value. In the related + -- case of a file with no read permissions the result is the same except FD + -- is set to No_Access_To_Source_File (-1). Upon success FD is set to a + -- positive Source_File_Index. -- -- Note that the name passed to this function is the simple file name, -- without any directory information. The implementation is responsible diff --git a/gcc/ada/par-ch8.adb b/gcc/ada/par-ch8.adb index 456c86358be77..4dea281647a95 100644 --- a/gcc/ada/par-ch8.adb +++ b/gcc/ada/par-ch8.adb @@ -65,6 +65,7 @@ package body Ch8 is Append (Use_Node, Item_List); Is_Last := True; + else Set_More_Ids (Use_Node); @@ -152,11 +153,12 @@ package body Ch8 is -- Error recovery: cannot raise Error_Resync procedure P_Use_Type_Clause (Item_List : List_Id) is + Use_Sloc : constant Source_Ptr := Prev_Token_Ptr; + All_Present : Boolean; Is_First : Boolean := True; Is_Last : Boolean := False; Use_Node : Node_Id; - Use_Sloc : constant Source_Ptr := Prev_Token_Ptr; begin if Token = Tok_All then diff --git a/gcc/ada/prepcomp.adb b/gcc/ada/prepcomp.adb index 7c56130c113ab..320d62222d39f 100644 --- a/gcc/ada/prepcomp.adb +++ b/gcc/ada/prepcomp.adb @@ -630,17 +630,16 @@ package body Prepcomp is String_To_Name_Buffer (Current_Data.Deffile); declare - N : constant File_Name_Type := Name_Find; - Deffile : constant Source_File_Index := - Load_Definition_File (N); - Add_Deffile : Boolean := True; - T : constant Nat := Total_Errors_Detected; + N : constant File_Name_Type := Name_Find; + Deffile : constant Source_File_Index := Load_Definition_File (N); + T : constant Nat := Total_Errors_Detected; + + Add_Deffile : Boolean := True; begin if Deffile <= No_Source_File then - Fail ("definition file """ - & Get_Name_String (N) - & """ not found"); + Fail + ("definition file """ & Get_Name_String (N) & """ not found"); end if; -- Initialize the preprocessor and set the characteristics of the diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 630d592f2be88..464b1b234d1f3 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -1051,14 +1051,13 @@ package body Repinfo is and then List_Representation_Info = 3 then Spaces (Max_Spos_Length - 2); - Write_Str ("bit offset"); + Write_Str ("bit offset "); if Starting_Position /= Uint_0 or else Starting_First_Bit /= Uint_0 then - Write_Char (' '); UI_Write (Starting_Position * SSU + Starting_First_Bit); - Write_Str (" +"); + Write_Str (" + "); end if; Write_Val (Bofs, Paren => True); @@ -1686,27 +1685,18 @@ package body Repinfo is Write_Str ("??"); else - if Back_End_Layout then - Write_Char (' '); - - if Paren then - Write_Char ('('); - List_GCC_Expression (Val); - Write_Char (')'); - else - List_GCC_Expression (Val); - end if; - - Write_Char (' '); + if Paren then + Write_Char ('('); + end if; + if Back_End_Layout then + List_GCC_Expression (Val); else - if Paren then - Write_Char ('('); - Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val))); - Write_Char (')'); - else - Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val))); - end if; + Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val))); + end if; + + if Paren then + Write_Char (')'); end if; end if; diff --git a/gcc/ada/rtfinal.c b/gcc/ada/rtfinal.c index 8f7e163cdedbf..9398af393baf0 100644 --- a/gcc/ada/rtfinal.c +++ b/gcc/ada/rtfinal.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 2014, Free Software Foundation, Inc. * + * Copyright (C) 2014-2017, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -40,7 +40,7 @@ extern void __gnat_runtime_finalize (void); at all, the intention is that this be replaced by system specific code where finalization is required. - Note that __gnat_runtime_initialize() is called in adafinal() */ + Note that __gnat_runtime_finalize() is called in adafinal() */ extern int __gnat_rt_init_count; /* see initialize.c */ diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index bdad2520fd4c7..c4d7d3c80c635 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -1249,6 +1249,7 @@ package Rtsfind is RE_Set_63, -- System.Pack_63 RE_Adjust_Storage_Size, -- System.Parameters + RE_Default_Secondary_Stack_Size, -- System.Parameters RE_Default_Stack_Size, -- System.Parameters RE_Garbage_Collected, -- System.Parameters RE_Size_Type, -- System.Parameters @@ -1424,12 +1425,12 @@ package Rtsfind is RE_IS_Ilf, -- System.Scalar_Values RE_IS_Ill, -- System.Scalar_Values - RE_Default_Secondary_Stack_Size, -- System.Secondary_Stack RE_Mark_Id, -- System.Secondary_Stack RE_SS_Allocate, -- System.Secondary_Stack RE_SS_Pool, -- System.Secondary_Stack RE_SS_Mark, -- System.Secondary_Stack RE_SS_Release, -- System.Secondary_Stack + RE_SS_Stack, -- System.Secondary_Stack RE_Shared_Var_Lock, -- System.Shared_Storage RE_Shared_Var_Unlock, -- System.Shared_Storage @@ -2487,6 +2488,7 @@ package Rtsfind is RE_Set_63 => System_Pack_63, RE_Adjust_Storage_Size => System_Parameters, + RE_Default_Secondary_Stack_Size => System_Parameters, RE_Default_Stack_Size => System_Parameters, RE_Garbage_Collected => System_Parameters, RE_Size_Type => System_Parameters, @@ -2662,12 +2664,12 @@ package Rtsfind is RE_IS_Ilf => System_Scalar_Values, RE_IS_Ill => System_Scalar_Values, - RE_Default_Secondary_Stack_Size => System_Secondary_Stack, RE_Mark_Id => System_Secondary_Stack, RE_SS_Allocate => System_Secondary_Stack, RE_SS_Mark => System_Secondary_Stack, RE_SS_Pool => System_Secondary_Stack, RE_SS_Release => System_Secondary_Stack, + RE_SS_Stack => System_Secondary_Stack, RE_Shared_Var_Lock => System_Shared_Storage, RE_Shared_Var_Unlock => System_Shared_Storage, diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index e121e5969130f..aaa3ccb2e4013 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -612,6 +612,12 @@ package body Sem is when N_With_Clause => Analyze_With_Clause (N); + -- A call to analyze a call marker is ignored because the node does + -- not have any static and run-time semantics. + + when N_Call_Marker => + null; + -- A call to analyze the Empty node is an error, but most likely it -- is an error caused by an attempt to analyze a malformed piece of -- tree caused by some other error, so if there have been any other @@ -1242,6 +1248,15 @@ package body Sem is Scope_Stack.Locked := True; end Lock; + ------------------------ + -- Preanalysis_Active -- + ------------------------ + + function Preanalysis_Active return Boolean is + begin + return not Full_Analysis and not Expander_Active; + end Preanalysis_Active; + ---------------- -- Preanalyze -- ---------------- diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index fca920a8a008d..500f9220fd243 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -683,6 +683,10 @@ package Sem is -- This function returns True if an explicit pragma Suppress for check C -- is present in the package defining E. + function Preanalysis_Active return Boolean; + pragma Inline (Preanalysis_Active); + -- Determine whether preanalysis is active at the point of invocation + procedure Preanalyze (N : Node_Id); -- Performs a pre-analysis of node N. During pre-analysis no expansion is -- carried out for N or its children. For more info on pre-analysis read diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index ad6e1ea9a3ea9..6c29b38b93ad2 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -30,6 +30,7 @@ with Einfo; use Einfo; with Elists; use Elists; with Errout; use Errout; with Expander; use Expander; +with Exp_Ch6; use Exp_Ch6; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; with Freeze; use Freeze; @@ -1593,7 +1594,7 @@ package body Sem_Aggr is -- unless the expression covers a single component, or the -- expander is inactive. - -- In SPARK mode, expressions that can perform side-effects will + -- In SPARK mode, expressions that can perform side effects will -- be recognized by the gnat2why back-end, and the whole -- subprogram will be ignored. So semantic analysis can be -- performed safely. @@ -2932,6 +2933,11 @@ package body Sem_Aggr is -- Verify that the type of the ancestor part is a non-private ancestor -- of the expected type, which must be a type extension. + procedure Transform_BIP_Assignment (Typ : Entity_Id); + -- For an extension aggregate whose ancestor part is a build-in-place + -- call returning a nonlimited type, this is used to transform the + -- assignment to the ancestor part to use a temp. + ---------------------------- -- Valid_Limited_Ancestor -- ---------------------------- @@ -3013,6 +3019,26 @@ package body Sem_Aggr is return False; end Valid_Ancestor_Type; + ------------------------------ + -- Transform_BIP_Assignment -- + ------------------------------ + + procedure Transform_BIP_Assignment (Typ : Entity_Id) is + Loc : constant Source_Ptr := Sloc (N); + Def_Id : constant Entity_Id := Make_Temporary (Loc, 'Y', A); + Obj_Decl : constant Node_Id := + Make_Object_Declaration (Loc, + Defining_Identifier => Def_Id, + Constant_Present => True, + Object_Definition => New_Occurrence_Of (Typ, Loc), + Expression => A, + Has_Init_Expression => True); + begin + Set_Etype (Def_Id, Typ); + Set_Ancestor_Part (N, New_Occurrence_Of (Def_Id, Loc)); + Insert_Action (N, Obj_Decl); + end Transform_BIP_Assignment; + -- Start of processing for Resolve_Extension_Aggregate begin @@ -3081,7 +3107,7 @@ package body Sem_Aggr is Get_First_Interp (A, I, It); while Present (It.Typ) loop - -- Only consider limited interpretations in the Ada 2005 case + -- Consider limited interpretations if Ada 2005 or higher if Is_Tagged_Type (It.Typ) and then (Ada_Version >= Ada_2005 @@ -3177,6 +3203,18 @@ package body Sem_Aggr is Error_Msg_N ("ancestor part must be statically tagged", A); else + -- We are using the build-in-place protocol, but we can't build + -- in place, because we need to call the function before + -- allocating the aggregate. Could do better for null + -- extensions, and maybe for nondiscriminated types. + -- This is wrong for limited, but those were wrong already. + + if not Is_Limited_View (A_Type) + and then Is_Build_In_Place_Function_Call (A) + then + Transform_BIP_Assignment (A_Type); + end if; + Resolve_Record_Aggregate (N, Typ); end if; end if; @@ -3567,7 +3605,7 @@ package body Sem_Aggr is -- This is redundant if the others_choice covers only -- one component (small optimization possible???), but -- indispensable otherwise, because each one must be - -- expanded individually to preserve side-effects. + -- expanded individually to preserve side effects. -- Ada 2005 (AI-287): In case of default initialization -- of components, we duplicate the corresponding default @@ -3843,7 +3881,7 @@ package body Sem_Aggr is -- expansion is delayed until the enclosing aggregate is expanded -- into assignments. In that case, do not generate checks on the -- expression, because they will be generated later, and will other- - -- wise force a copy (to remove side-effects) that would leave a + -- wise force a copy (to remove side effects) that would leave a -- dynamic-sized aggregate in the code, something that gigi cannot -- handle. @@ -4109,8 +4147,9 @@ package body Sem_Aggr is Assoc := First (Component_Associations (N)); while Present (Assoc) loop if Nkind (Assoc) = N_Iterated_Component_Association then - Error_Msg_N ("iterated component association can only " - & "appear in an array aggregate", N); + Error_Msg_N + ("iterated component association can only appear in an " + & "array aggregate", N); raise Unrecoverable_Error; else diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 5bedc6c8c128e..5aef17df8ec3b 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -28,7 +28,6 @@ with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; with Atree; use Atree; with Casing; use Casing; with Checks; use Checks; -with Debug; use Debug; with Einfo; use Einfo; with Elists; use Elists; with Errout; use Errout; @@ -806,6 +805,20 @@ package body Sem_Attr is ("prefix of % attribute cannot be enumeration literal"); end if; + -- Preserve relevant elaboration-related attributes of the context + -- which are no longer available or very expensive to recompute once + -- analysis, resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => N, + Checks => True, + Modes => True); + + -- Save the scenario for later examination by the ABE Processing + -- phase. + + Record_Elaboration_Scenario (N); + -- Case of access to subprogram if Is_Entity_Name (P) and then Is_Overloadable (Entity (P)) then @@ -860,14 +873,6 @@ package body Sem_Attr is Kill_Current_Values; end if; - -- In the static elaboration model, treat the attribute reference - -- as a call for elaboration purposes. Suppress this treatment - -- under debug flag. In any case, we are all done. - - if not Dynamic_Elaboration_Checks and not Debug_Flag_Dot_UU then - Check_Elab_Call (N); - end if; - return; -- Component is an operation of a protected type @@ -11133,8 +11138,8 @@ package body Sem_Attr is -- 'Unrestricted_Access or in case of a subprogram. if Is_Entity_Name (P) - and then (Attr_Id = Attribute_Unrestricted_Access - or else Is_Subprogram (Entity (P))) + and then (Attr_Id = Attribute_Unrestricted_Access + or else Is_Subprogram (Entity (P))) then Set_Address_Taken (Entity (P)); end if; diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 4f60f41e12206..d34ed078be738 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -1693,6 +1693,7 @@ package body Sem_Aux is and then Nkind (N) /= N_Package_Renaming_Declaration and then Nkind (N) /= N_Procedure_Instantiation and then Nkind (N) /= N_Protected_Body + and then Nkind (N) /= N_Protected_Type_Declaration and then Nkind (N) /= N_Subprogram_Declaration and then Nkind (N) /= N_Subprogram_Body and then Nkind (N) /= N_Subprogram_Body_Stub diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index b89d8d32008f4..0616a201b79bf 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -163,7 +163,9 @@ package body Sem_Ch10 is -- the private declarations of a parent unit. procedure Install_Parents - (Lib_Unit : Node_Id; Is_Private : Boolean; Chain : Boolean := True); + (Lib_Unit : Node_Id; + Is_Private : Boolean; + Chain : Boolean := True); -- This procedure establishes the context for the compilation of a child -- unit. If Lib_Unit is a child library spec then the context of the parent -- is installed, and the parent itself made immediately visible, so that @@ -3390,7 +3392,9 @@ package body Sem_Ch10 is if Is_Child_Spec (Lib_Unit) then Install_Parents - (Lib_Unit, Private_Present (Parent (Lib_Unit)), Chain); + (Lib_Unit => Lib_Unit, + Is_Private => Private_Present (Parent (Lib_Unit)), + Chain => Chain); end if; Install_Limited_Context_Clauses (N); @@ -4065,7 +4069,10 @@ package body Sem_Ch10 is --------------------- procedure Install_Parents - (Lib_Unit : Node_Id; Is_Private : Boolean; Chain : Boolean := True) is + (Lib_Unit : Node_Id; + Is_Private : Boolean; + Chain : Boolean := True) + is P : Node_Id; E_Name : Entity_Id; P_Name : Entity_Id; @@ -4121,8 +4128,11 @@ package body Sem_Ch10 is -- This is the recursive call that ensures all parents are loaded if Is_Child_Spec (P) then - Install_Parents (P, - Is_Private or else Private_Present (Parent (Lib_Unit)), Chain); + Install_Parents + (Lib_Unit => P, + Is_Private => + Is_Private or else Private_Present (Parent (Lib_Unit)), + Chain => Chain); end if; -- Now we can install the context for this parent diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index ec270f3ad1925..ac5035fd1bc6a 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -839,6 +839,10 @@ package body Sem_Ch12 is -- entity is marked as having a limited_view actual when some actual is -- a limited view. This is used to place the instance body properly. + procedure Provide_Completing_Bodies (N : Node_Id); + -- Generate completing bodies for all subprograms found within package or + -- subprogram declaration N. + procedure Remove_Parent (In_Body : Boolean := False); -- Reverse effect after instantiation of child is complete @@ -1903,7 +1907,8 @@ package body Sem_Ch12 is -- body. Explicit_Freeze_Check : declare - Actual : constant Entity_Id := Entity (Match); + Actual : constant Entity_Id := Entity (Match); + Gen_Par : Entity_Id; Needs_Freezing : Boolean; S : Entity_Id; @@ -1912,7 +1917,11 @@ package body Sem_Ch12 is -- The actual may be an instantiation of a unit -- declared in a previous instantiation. If that -- one is also in the current compilation, it must - -- itself be frozen before the actual. + -- itself be frozen before the actual. The actual + -- may be an instantiation of a generic child unit, + -- in which case the same applies to the instance + -- of the parent which must be frozen before the + -- actual. -- Should this itself be recursive ??? -------------------------- @@ -1920,30 +1929,72 @@ package body Sem_Ch12 is -------------------------- procedure Check_Generic_Parent is - Par : Entity_Id; + Inst : constant Node_Id := + Next (Unit_Declaration_Node (Actual)); + Par : Entity_Id; begin - if Nkind (Parent (Actual)) = - N_Package_Specification + Par := Empty; + + if Nkind (Parent (Actual)) = N_Package_Specification then Par := Scope (Generic_Parent (Parent (Actual))); - if Is_Generic_Instance (Par) - and then Scope (Par) = Current_Scope - and then - (No (Freeze_Node (Par)) - or else - not Is_List_Member (Freeze_Node (Par))) + if Is_Generic_Instance (Par) then + null; + + -- If the actual is a child generic unit, check + -- whether the instantiation of the parent is + -- also local and must also be frozen now. We + -- must retrieve the instance node to locate the + -- parent instance if any. + + elsif Ekind (Par) = E_Generic_Package + and then Is_Child_Unit (Gen_Par) + and then Ekind (Scope (Gen_Par)) = + E_Generic_Package then - Set_Has_Delayed_Freeze (Par); - Append_Elmt (Par, Actuals_To_Freeze); + if Nkind (Inst) = N_Package_Instantiation + and then Nkind (Name (Inst)) = + N_Expanded_Name + then + -- Retrieve entity of parent instance + + Par := Entity (Prefix (Name (Inst))); + end if; + + else + Par := Empty; end if; end if; + + if Present (Par) + and then Is_Generic_Instance (Par) + and then Scope (Par) = Current_Scope + and then + (No (Freeze_Node (Par)) + or else + not Is_List_Member (Freeze_Node (Par))) + then + Set_Has_Delayed_Freeze (Par); + Append_Elmt (Par, Actuals_To_Freeze); + end if; end Check_Generic_Parent; -- Start of processing for Explicit_Freeze_Check begin + if Present (Renamed_Entity (Actual)) then + Gen_Par := + Generic_Parent (Specification + (Unit_Declaration_Node + (Renamed_Entity (Actual)))); + else + Gen_Par := + Generic_Parent (Specification + (Unit_Declaration_Node (Actual))); + end if; + if not Expander_Active or else not Has_Completion (Actual) or else not In_Same_Source_Unit (I_Node, Actual) @@ -1986,12 +2037,13 @@ package body Sem_Ch12 is -- that it is the instance that must be frozen. if Nkind (Parent (Actual)) = - N_Package_Renaming_Declaration + N_Package_Renaming_Declaration then Set_Has_Delayed_Freeze (Renamed_Entity (Actual)); Append_Elmt - (Renamed_Entity (Actual), Actuals_To_Freeze); + (Renamed_Entity (Actual), + Actuals_To_Freeze); else Set_Has_Delayed_Freeze (Actual); Append_Elmt (Actual, Actuals_To_Freeze); @@ -3496,6 +3548,14 @@ package body Sem_Ch12 is Set_SPARK_Pragma_Inherited (Id); Set_SPARK_Aux_Pragma_Inherited (Id); + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => Id, + Checks => True); + -- Analyze aspects now, so that generated pragmas appear in the -- declarations before building and analyzing the generic copy. @@ -3624,7 +3684,7 @@ package body Sem_Ch12 is Create_Generic_Contract (N); Spec := Specification (N); - Id := Defining_Entity (Spec); + Id := Defining_Entity (Spec); Generate_Definition (Id); if Nkind (Id) = N_Defining_Operator_Symbol then @@ -3651,14 +3711,27 @@ package body Sem_Ch12 is Analyze_Generic_Formal_Part (N); - Formals := Parameter_Specifications (Spec); - if Nkind (Spec) = N_Function_Specification then Set_Ekind (Id, E_Generic_Function); else Set_Ekind (Id, E_Generic_Procedure); end if; + -- Set SPARK_Mode from context + + Set_SPARK_Pragma (Id, SPARK_Mode_Pragma); + Set_SPARK_Pragma_Inherited (Id); + + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => Id, + Checks => True); + + Formals := Parameter_Specifications (Spec); + if Present (Formals) then Process_Formals (Formals, Spec); end if; @@ -3854,6 +3927,16 @@ package body Sem_Ch12 is -- Start of processing for Analyze_Package_Instantiation begin + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => N, + Checks => True, + Level => True, + Modes => True); + Check_SPARK_05_Restriction ("generic is not allowed", N); -- Very first thing: check for Text_IO special unit in case we are @@ -4516,19 +4599,26 @@ package body Sem_Ch12 is Analyze (Act_Decl); Set_Unit (Parent (N), N); Set_Body_Required (Parent (N), False); + end if; - -- We never need elaboration checks on instantiations, since by - -- definition, the body instantiation is elaborated at the same - -- time as the spec instantiation. + -- Save the scenario for later examination by the ABE Processing + -- phase. - Set_Suppress_Elaboration_Warnings (Act_Decl_Id); - Set_Kill_Elaboration_Checks (Act_Decl_Id); - end if; + Record_Elaboration_Scenario (N); + + -- The instantiation results in a guaranteed ABE + + if Is_Known_Guaranteed_ABE (N) and then Needs_Body then - Check_Elab_Instantiation (N); + -- Do not instantiate the corresponding body because gigi cannot + -- handle certain types of premature instantiations. - if ABE_Is_Certain (N) and then Needs_Body then Pending_Instantiations.Decrement_Last; + + -- Create completing bodies for all subprogram declarations since + -- their real bodies will not be instantiated. + + Provide_Completing_Bodies (Instance_Spec (N)); end if; Check_Hidden_Child_Unit (N, Gen_Unit, Act_Decl_Id); @@ -5010,7 +5100,7 @@ package body Sem_Ch12 is -- No point in inlining if ABE is inevitable - and then not ABE_Is_Certain (N) + and then not Is_Known_Guaranteed_ABE (N) -- Or if subprogram is eliminated @@ -5196,12 +5286,7 @@ package body Sem_Ch12 is Check_Eliminated (Act_Decl_Id); Set_Is_Eliminated (Anon_Id, Is_Eliminated (Act_Decl_Id)); - -- In compilation unit case, kill elaboration checks on the - -- instantiation, since they are never needed -- the body is - -- instantiated at the same point as the spec. - if Nkind (Parent (N)) = N_Compilation_Unit then - Set_Suppress_Elaboration_Warnings (Act_Decl_Id); Set_Kill_Elaboration_Checks (Act_Decl_Id); Set_Is_Compilation_Unit (Anon_Id); @@ -5220,8 +5305,7 @@ package body Sem_Ch12 is Valid_Operator_Definition (Act_Decl_Id); end if; - Set_Alias (Act_Decl_Id, Anon_Id); - Set_Parent (Act_Decl_Id, Parent (Anon_Id)); + Set_Alias (Act_Decl_Id, Anon_Id); Set_Has_Completion (Act_Decl_Id); Set_Related_Instance (Pack_Id, Act_Decl_Id); @@ -5292,6 +5376,16 @@ package body Sem_Ch12 is -- Start of processing for Analyze_Subprogram_Instantiation begin + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => N, + Checks => True, + Level => True, + Modes => True); + Check_SPARK_05_Restriction ("generic is not allowed", N); -- Very first thing: check for special Text_IO unit in case we are @@ -5544,8 +5638,17 @@ package body Sem_Ch12 is Set_Ignore_SPARK_Mode_Pragmas (Anon_Id); end if; - if not Is_Intrinsic_Subprogram (Gen_Unit) then - Check_Elab_Instantiation (N); + -- Save the scenario for later examination by the ABE Processing + -- phase. + + Record_Elaboration_Scenario (N); + + -- The instantiation results in a guaranteed ABE. Create a completing + -- body for the subprogram declaration because the real body will not + -- be instantiated. + + if Is_Known_Guaranteed_ABE (N) then + Provide_Completing_Bodies (Instance_Spec (N)); end if; if Is_Dispatching_Operation (Act_Decl_Id) @@ -6356,10 +6459,11 @@ package body Sem_Ch12 is elsif Ekind (E1) = E_Package then Check_Mismatch (Ekind (E1) /= Ekind (E2) - or else Renamed_Object (E1) /= Renamed_Object (E2)); + or else (Present (Renamed_Object (E2)) + and then Renamed_Object (E1) /= + Renamed_Object (E2))); elsif Is_Overloadable (E1) then - -- Verify that the actual subprograms match. Note that actuals -- that are attributes are rewritten as subprograms. If the -- subprogram in the formal package is defaulted, no check is @@ -8515,7 +8619,7 @@ package body Sem_Ch12 is -- The parent was a premature instantiation. Insert freeze node at -- the end the current declarative part. - if ABE_Is_Certain (Get_Unit_Instantiation_Node (Par)) then + if Is_Known_Guaranteed_ABE (Get_Unit_Instantiation_Node (Par)) then Insert_Freeze_Node_For_Instance (Inst_Node, F_Node); -- Handle the following case: @@ -13945,6 +14049,102 @@ package body Sem_Ch12 is end if; end Preanalyze_Actuals; + ------------------------------- + -- Provide_Completing_Bodies -- + ------------------------------- + + procedure Provide_Completing_Bodies (N : Node_Id) is + procedure Build_Completing_Body (Subp_Decl : Node_Id); + -- Generate the completing body for subprogram declaration Subp_Decl + + procedure Provide_Completing_Bodies_In (Decls : List_Id); + -- Generating completing bodies for all subprograms found in declarative + -- list Decls. + + --------------------------- + -- Build_Completing_Body -- + --------------------------- + + procedure Build_Completing_Body (Subp_Decl : Node_Id) is + Loc : constant Source_Ptr := Sloc (Subp_Decl); + Subp_Id : constant Entity_Id := Defining_Entity (Subp_Decl); + Spec : Node_Id; + + begin + -- Nothing to do if the subprogram already has a completing body + + if Present (Corresponding_Body (Subp_Decl)) then + return; + + -- Mark the function as having a valid return statement even though + -- the body contains a single raise statement. + + elsif Ekind (Subp_Id) = E_Function then + Set_Return_Present (Subp_Id); + end if; + + -- Clone the specification to obtain new entities and reset the only + -- semantic field. + + Spec := Copy_Subprogram_Spec (Specification (Subp_Decl)); + Set_Generic_Parent (Spec, Empty); + + -- Generate: + -- function Func ... return ... is + -- + -- procedure Proc ... is + -- begin + -- raise Program_Error with "access before elaboration"; + -- edn Proc; + + Insert_After_And_Analyze (Subp_Decl, + Make_Subprogram_Body (Loc, + Specification => Spec, + Declarations => New_List, + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => New_List ( + Make_Raise_Program_Error (Loc, + Reason => PE_Access_Before_Elaboration))))); + end Build_Completing_Body; + + ---------------------------------- + -- Provide_Completing_Bodies_In -- + ---------------------------------- + + procedure Provide_Completing_Bodies_In (Decls : List_Id) is + Decl : Node_Id; + + begin + if Present (Decls) then + Decl := First (Decls); + while Present (Decl) loop + Provide_Completing_Bodies (Decl); + Next (Decl); + end loop; + end if; + end Provide_Completing_Bodies_In; + + -- Local variables + + Spec : Node_Id; + + -- Start of processing for Provide_Completing_Bodies + + begin + if Nkind (N) = N_Package_Declaration then + Spec := Specification (N); + + Push_Scope (Defining_Entity (N)); + Provide_Completing_Bodies_In (Visible_Declarations (Spec)); + Provide_Completing_Bodies_In (Private_Declarations (Spec)); + Pop_Scope; + + elsif Nkind (N) = N_Subprogram_Declaration then + Build_Completing_Body (N); + end if; + end Provide_Completing_Bodies; + ------------------- -- Remove_Parent -- ------------------- diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 79b22cd54b5d0..564ff0dfc0aba 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4415,15 +4415,6 @@ package body Sem_Ch13 is if Present (Default_Element) then Analyze (Default_Element); - - if Is_Entity_Name (Default_Element) - and then not Covers (Entity (Default_Element), Ret_Type) - and then False - then - Illegal_Indexing - ("wrong return type for indexing function"); - return; - end if; end if; -- For variable_indexing the return type must be a reference type @@ -12670,10 +12661,18 @@ package body Sem_Ch13 is return Skip; - -- Otherwise do the replacement and we are done with this node + -- Otherwise do the replacement if this is not a qualified + -- reference to a homograph of the type itself. Note that the + -- current instance could not appear in such a context, e.g. + -- the prefix of a type conversion. else - Replace_Type_Reference (N); + if Nkind (Parent (N)) /= N_Selected_Component + or else N /= Selector_Name (Parent (N)) + then + Replace_Type_Reference (N); + end if; + return Skip; end if; @@ -12682,7 +12681,7 @@ package body Sem_Ch13 is elsif Nkind (N) = N_Selected_Component then - -- If selector name is not our type, keeping going (we might still + -- If selector name is not our type, keep going (we might still -- have an occurrence of the type in the prefix). if Nkind (Selector_Name (N)) /= N_Identifier @@ -13194,16 +13193,18 @@ package body Sem_Ch13 is or else No (First_Formal (Entity (N))) or else Etype (First_Formal (Entity (N))) /= Typ then - Error_Msg_N ("iterable primitive must be local function name " - & "whose first formal is an iterable type", N); + Error_Msg_N + ("iterable primitive must be local function name whose first " + & "formal is an iterable type", N); return; end if; Ent := Entity (N); - F1 := First_Formal (Ent); - if Nam = Name_First then + F1 := First_Formal (Ent); - -- First (Container) => Cursor + if Nam = Name_First or else Nam = Name_Last then + + -- First or Last (Container) => Cursor if Etype (Ent) /= Cursor then Error_Msg_N ("primitive for First must yield a curosr", N); @@ -13222,11 +13223,25 @@ package body Sem_Ch13 is Error_Msg_N ("no match for Next iterable primitive", N); end if; + elsif Nam = Name_Previous then + + -- Previous (Container, Cursor) => Cursor + + F2 := Next_Formal (F1); + + if Etype (F2) /= Cursor + or else Etype (Ent) /= Cursor + or else Present (Next_Formal (F2)) + then + Error_Msg_N ("no match for Previous iterable primitive", N); + end if; + elsif Nam = Name_Has_Element then -- Has_Element (Container, Cursor) => Boolean F2 := Next_Formal (F1); + if Etype (F2) /= Cursor or else Etype (Ent) /= Standard_Boolean or else Present (Next_Formal (F2)) @@ -13243,15 +13258,14 @@ package body Sem_Ch13 is then Error_Msg_N ("no match for Element iterable primitive", N); end if; - null; else raise Program_Error; end if; else - -- Overloaded case: find subprogram with proper signature. - -- Caller will report error if no match is found. + -- Overloaded case: find subprogram with proper signature. Caller + -- will report error if no match is found. declare I : Interp_Index; @@ -14023,6 +14037,7 @@ package body Sem_Ch13 is Cursor : constant Entity_Id := Get_Cursor_Type (ASN, Typ); First_Id : Entity_Id; + Last_Id : Entity_Id; Next_Id : Entity_Id; Has_Element_Id : Entity_Id; Element_Id : Entity_Id; @@ -14035,6 +14050,7 @@ package body Sem_Ch13 is end if; First_Id := Empty; + Last_Id := Empty; Next_Id := Empty; Has_Element_Id := Empty; Element_Id := Empty; @@ -14055,6 +14071,14 @@ package body Sem_Ch13 is Resolve_Iterable_Operation (Expr, Cursor, Typ, Name_First); First_Id := Entity (Expr); + elsif Chars (Prim) = Name_Last then + Resolve_Iterable_Operation (Expr, Cursor, Typ, Name_Last); + Last_Id := Entity (Expr); + + elsif Chars (Prim) = Name_Previous then + Resolve_Iterable_Operation (Expr, Cursor, Typ, Name_Previous); + Last_Id := Entity (Expr); + elsif Chars (Prim) = Name_Next then Resolve_Iterable_Operation (Expr, Cursor, Typ, Name_Next); Next_Id := Entity (Expr); @@ -14083,8 +14107,8 @@ package body Sem_Ch13 is elsif No (Has_Element_Id) then Error_Msg_N ("match for Has_Element primitive not found", ASN); - elsif No (Element_Id) then - null; -- Optional. + elsif No (Element_Id) or else No (Last_Id) then + null; -- optional end if; end Validate_Iterable_Aspect; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index f6705d672327d..1e3b78ccf2f0f 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2211,6 +2211,12 @@ package body Sem_Ch3 is -- contract expression. Full analysis of the expression is done when -- the contract is processed. + function Contains_Lib_Incomplete_Type (Pkg : Entity_Id) return Boolean; + -- Check if a nested package has entities within it that rely on library + -- level private types where the full view has not been completed for + -- the purposes of checking if it is acceptable to freeze an expression + -- function at the point of declaration. + procedure Handle_Late_Controlled_Primitive (Body_Decl : Node_Id); -- Determine whether Body_Decl denotes the body of a late controlled -- primitive (either Initialize, Adjust or Finalize). If this is the @@ -2231,11 +2237,8 @@ package body Sem_Ch3 is procedure Resolve_Aspects; -- Utility to resolve the expressions of aspects at the end of a list of - -- declarations. - - function Uses_Unseen_Lib_Unit_Priv (Pkg : Entity_Id) return Boolean; - -- Check if an inner package has entities within it that rely on library - -- level private types where the full view has not been seen. + -- declarations, or before a declaration that freezes previous entities, + -- such as in a subprogram body. ----------------- -- Adjust_Decl -- @@ -2397,6 +2400,40 @@ package body Sem_Ch3 is end loop; end Check_Entry_Contracts; + ---------------------------------- + -- Contains_Lib_Incomplete_Type -- + ---------------------------------- + + function Contains_Lib_Incomplete_Type (Pkg : Entity_Id) return Boolean is + Curr : Entity_Id; + + begin + -- Avoid looking through scopes that do not meet the precondition of + -- Pkg not being within a library unit spec. + + if not Is_Compilation_Unit (Pkg) + and then not Is_Generic_Instance (Pkg) + and then not In_Package_Body (Enclosing_Lib_Unit_Entity (Pkg)) + then + -- Loop through all entities in the current scope to identify + -- an entity that depends on a private type. + + Curr := First_Entity (Pkg); + loop + if Nkind (Curr) in N_Entity + and then Depends_On_Private (Curr) + then + return True; + end if; + + exit when Last_Entity (Current_Scope) = Curr; + Curr := Next_Entity (Curr); + end loop; + end if; + + return False; + end Contains_Lib_Incomplete_Type; + -------------------------------------- -- Handle_Late_Controlled_Primitive -- -------------------------------------- @@ -2540,40 +2577,6 @@ package body Sem_Ch3 is end loop; end Resolve_Aspects; - ------------------------------- - -- Uses_Unseen_Lib_Unit_Priv -- - ------------------------------- - - function Uses_Unseen_Lib_Unit_Priv (Pkg : Entity_Id) return Boolean is - Curr : Entity_Id; - - begin - -- Avoid looking through scopes that do not meet the precondition of - -- Pkg not being within a library unit spec. - - if not Is_Compilation_Unit (Pkg) - and then not Is_Generic_Instance (Pkg) - and then not In_Package_Body (Enclosing_Lib_Unit_Entity (Pkg)) - then - -- Loop through all entities in the current scope to identify - -- an entity that depends on a private type. - - Curr := First_Entity (Pkg); - loop - if Nkind (Curr) in N_Entity - and then Depends_On_Private (Curr) - then - return True; - end if; - - exit when Last_Entity (Current_Scope) = Curr; - Curr := Next_Entity (Curr); - end loop; - end if; - - return False; - end Uses_Unseen_Lib_Unit_Priv; - -- Local variables Context : Node_Id := Empty; @@ -2747,14 +2750,16 @@ package body Sem_Ch3 is -- not cause unwanted freezing at that point. -- It is also necessary to check for a case where both an expression - -- function is used and the current scope depends on an unseen + -- function is used and the current scope depends on an incomplete -- private type from a library unit, otherwise premature freezing of -- the private type will occur. elsif not Analyzed (Next_Decl) and then Is_Body (Next_Decl) and then ((Nkind (Next_Decl) /= N_Subprogram_Body - or else not Was_Expression_Function (Next_Decl)) - or else not Uses_Unseen_Lib_Unit_Priv (Current_Scope)) + or else not Was_Expression_Function (Next_Decl)) + or else (not Is_Ignored_Ghost_Entity (Current_Scope) + and then not Contains_Lib_Incomplete_Type + (Current_Scope))) then -- When a controlled type is frozen, the expander generates stream -- and controlled-type support routines. If the freeze is caused @@ -2786,6 +2791,12 @@ package body Sem_Ch3 is if Nkind (Next_Decl) = N_Subprogram_Body then Handle_Late_Controlled_Primitive (Next_Decl); end if; + + else + -- In ASIS mode, if the next declaration is a body, complete + -- the analysis of declarations so far. + + Resolve_Aspects; end if; Adjust_Decl; @@ -2809,24 +2820,10 @@ package body Sem_Ch3 is -- Analyze the contracts of packages and their bodies - if Nkind (Context) = N_Package_Specification then - - -- When a package has private declarations, its contract must be - -- analyzed at the end of the said declarations. This way both the - -- analysis and freeze actions are properly synchronized in case - -- of private type use within the contract. - - if L = Private_Declarations (Context) then - Analyze_Package_Contract (Defining_Entity (Context)); - - -- Otherwise the contract is analyzed at the end of the visible - -- declarations. - - elsif L = Visible_Declarations (Context) - and then No (Private_Declarations (Context)) - then - Analyze_Package_Contract (Defining_Entity (Context)); - end if; + if Nkind (Context) = N_Package_Specification + and then L = Visible_Declarations (Context) + then + Analyze_Package_Contract (Defining_Entity (Context)); elsif Nkind (Context) = N_Package_Body then Analyze_Package_Body_Contract (Defining_Entity (Context)); @@ -4709,6 +4706,20 @@ package body Sem_Ch3 is end if; end if; + -- Set the SPARK mode from the current context (may be overwritten later + -- with explicit pragma). + + Set_SPARK_Pragma (Id, SPARK_Mode_Pragma); + Set_SPARK_Pragma_Inherited (Id); + + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => Id, + Checks => True); + -- Initialize alignment and size and capture alignment setting Init_Alignment (Id); @@ -10230,10 +10241,11 @@ package body Sem_Ch3 is Set_Is_Limited_Record (Def_Id, Is_Limited_Record (T)); if Has_Discrs - and then not Is_Empty_Elmt_List (Elist) - and then not For_Access + and then not Is_Empty_Elmt_List (Elist) + and then not For_Access then Create_Constrained_Components (Def_Id, Related_Nod, T, Elist); + elsif not For_Access then Set_Cloned_Subtype (Def_Id, T); end if; @@ -10257,7 +10269,21 @@ package body Sem_Ch3 is return; else Set_Itype (IR, Ityp); - Insert_After (Nod, IR); + + -- If Nod is a library unit entity, then Insert_After won't work, + -- because Nod is not a member of any list. Therefore, we use + -- Add_Global_Declaration in this case. This can happen if we have a + -- build-in-place library function. + + if (Nkind (Nod) in N_Entity and then Is_Compilation_Unit (Nod)) + or else + (Nkind (Nod) = N_Defining_Program_Unit_Name + and then Is_Compilation_Unit (Defining_Identifier (Nod))) + then + Add_Global_Declaration (IR); + else + Insert_After (Nod, IR); + end if; end if; end Build_Itype_Reference; @@ -11777,14 +11803,25 @@ package body Sem_Ch3 is if Nkind (Exp) = N_Type_Conversion and then Nkind (Expression (Exp)) = N_Function_Call then - Error_Msg_N - ("illegal context for call" - & " to function with limited result", Exp); + -- No error for internally-generated object declarations, + -- which can come from build-in-place assignment statements. + + if Nkind (Parent (Exp)) = N_Object_Declaration + and then not Comes_From_Source + (Defining_Identifier (Parent (Exp))) + then + null; + + else + Error_Msg_N + ("illegal context for call to function with limited " + & "result", Exp); + end if; else Error_Msg_N - ("initialization of limited object requires aggregate " - & "or function call", Exp); + ("initialization of limited object requires aggregate or " + & "function call", Exp); end if; end if; end if; @@ -21940,7 +21977,7 @@ package body Sem_Ch3 is exit; end if; - Next_Component (Comp); + Next_Discriminant (Comp); end loop; elsif Nkind (N) = N_Component_Declaration then diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 8801fb750bad1..538023524e343 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6431,10 +6431,24 @@ package body Sem_Ch4 is Op_Id : Entity_Id; N : Node_Id) is - Op_Type : constant Entity_Id := Etype (Op_Id); + Is_String : constant Boolean := Nkind (L) = N_String_Literal + or else + Nkind (R) = N_String_Literal; + Op_Type : constant Entity_Id := Etype (Op_Id); begin if Is_Array_Type (Op_Type) + + -- Small but very effective optimization: if at least one operand is a + -- string literal, then the type of the operator must be either array + -- of characters or array of strings. + + and then (not Is_String + or else + Is_Character_Type (Component_Type (Op_Type)) + or else + Is_String_Type (Component_Type (Op_Type))) + and then not Is_Limited_Type (Op_Type) and then (Has_Compatible_Type (L, Op_Type) @@ -8860,7 +8874,7 @@ package body Sem_Ch4 is while Present (Hom) loop if Ekind_In (Hom, E_Procedure, E_Function) and then (not Is_Hidden (Hom) or else In_Instance) - and then Scope (Hom) = Scope (Anc_Type) + and then Scope (Hom) = Scope (Base_Type (Anc_Type)) and then Present (First_Formal (Hom)) and then (Base_Type (Etype (First_Formal (Hom))) = Cls_Type @@ -8921,8 +8935,13 @@ package body Sem_Ch4 is Success => Success, Skip_First => True); + -- The same operation may be encountered on two homonym + -- traversals, before and after looking at interfaces. + -- Check for this case before reporting a real ambiguity. + if Present (Valid_Candidate (Success, Call_Node, Hom)) and then Nkind (Call_Node) /= N_Function_Call + and then Hom /= Matching_Op then Error_Msg_NE ("ambiguous call to&", N, Hom); Report_Ambiguity (Matching_Op); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index e3aa50b2ddd2f..10002ea08c2a4 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -101,13 +101,7 @@ package body Sem_Ch5 is procedure Analyze_Assignment (N : Node_Id) is Lhs : constant Node_Id := Name (N); - Rhs : constant Node_Id := Expression (N); - - Decl : Node_Id; - T1 : Entity_Id; - T2 : Entity_Id; - - Save_Full_Analysis : Boolean := False; -- initialize to prevent warning + Rhs : Node_Id := Expression (N); procedure Diagnose_Non_Variable_Lhs (N : Node_Id); -- N is the node for the left hand side of an assignment, and it is not @@ -126,6 +120,27 @@ package body Sem_Ch5 is -- nominal subtype. This procedure is used to deal with cases where the -- nominal subtype must be replaced by the actual subtype. + procedure Transform_BIP_Assignment (Typ : Entity_Id); + function Should_Transform_BIP_Assignment + (Typ : Entity_Id) return Boolean; + -- If the right-hand side of an assignment statement is a build-in-place + -- call we cannot build in place, so we insert a temp initialized with + -- the call, and transform the assignment statement to copy the temp. + -- Transform_BIP_Assignment does the tranformation, and + -- Should_Transform_BIP_Assignment determines whether we should. + -- The same goes for qualified expressions and conversions whose + -- operand is such a call. + -- + -- This is only for nonlimited types; assignment statements are illegal + -- for limited types, but are generated internally for aggregates and + -- init procs. These limited-type are not really assignment statements + -- -- conceptually, they are initializations, so should not be + -- transformed. + -- + -- Similarly, for nonlimited types, aggregates and init procs generate + -- assignment statements that are really initializations. These are + -- marked No_Ctrl_Actions. + ------------------------------- -- Diagnose_Non_Variable_Lhs -- ------------------------------- @@ -232,6 +247,8 @@ package body Sem_Ch5 is (Opnd : Node_Id; Opnd_Type : in out Entity_Id) is + Decl : Node_Id; + begin Require_Entity (Opnd); @@ -249,9 +266,9 @@ package body Sem_Ch5 is or else (Ekind (Entity (Opnd)) = E_Variable and then Nkind (Parent (Entity (Opnd))) = - N_Object_Renaming_Declaration + N_Object_Renaming_Declaration and then Nkind (Parent (Parent (Entity (Opnd)))) = - N_Accept_Statement)) + N_Accept_Statement)) then Opnd_Type := Get_Actual_Subtype (Opnd); @@ -282,8 +299,100 @@ package body Sem_Ch5 is end if; end Set_Assignment_Type; + ------------------------------------- + -- Should_Transform_BIP_Assignment -- + ------------------------------------- + + function Should_Transform_BIP_Assignment + (Typ : Entity_Id) return Boolean + is + Result : Boolean; + + begin + if Expander_Active + and then not Is_Limited_View (Typ) + and then Is_Build_In_Place_Result_Type (Typ) + and then not No_Ctrl_Actions (N) + then + -- This function is called early, before name resolution is + -- complete, so we have to deal with things that might turn into + -- function calls later. N_Function_Call and N_Op nodes are the + -- obvious case. An N_Identifier or N_Expanded_Name is a + -- parameterless function call if it denotes a function. + -- Finally, an attribute reference can be a function call. + + case Nkind (Unqual_Conv (Rhs)) is + when N_Function_Call + | N_Op + => + Result := True; + + when N_Expanded_Name + | N_Identifier + => + case Ekind (Entity (Unqual_Conv (Rhs))) is + when E_Function + | E_Operator + => + Result := True; + + when others => + Result := False; + end case; + + when N_Attribute_Reference => + Result := Attribute_Name (Unqual_Conv (Rhs)) = Name_Input; + -- T'Input will turn into a call whose result type is T + + when others => + Result := False; + end case; + else + Result := False; + end if; + + return Result; + end Should_Transform_BIP_Assignment; + + ------------------------------ + -- Transform_BIP_Assignment -- + ------------------------------ + + procedure Transform_BIP_Assignment (Typ : Entity_Id) is + + -- Tranform "X : [constant] T := F (...);" into: + -- + -- Temp : constant T := F (...); + -- X := Temp; + + Loc : constant Source_Ptr := Sloc (N); + Def_Id : constant Entity_Id := Make_Temporary (Loc, 'Y', Rhs); + Obj_Decl : constant Node_Id := + Make_Object_Declaration (Loc, + Defining_Identifier => Def_Id, + Constant_Present => True, + Object_Definition => New_Occurrence_Of (Typ, Loc), + Expression => Rhs, + Has_Init_Expression => True); + + begin + Set_Etype (Def_Id, Typ); + Set_Expression (N, New_Occurrence_Of (Def_Id, Loc)); + + -- At this point, Rhs is no longer equal to Expression (N), so: + + Rhs := Expression (N); + + Insert_Action (N, Obj_Decl); + end Transform_BIP_Assignment; + -- Local variables + T1 : Entity_Id; + T2 : Entity_Id; + + Save_Full_Analysis : Boolean; + Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; -- Save the Ghost mode to restore on exit @@ -292,6 +401,15 @@ package body Sem_Ch5 is begin Mark_Coextensions (N, Rhs); + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => N, + Checks => True, + Modes => True); + -- Analyze the target of the assignment first in case the expression -- contains references to Ghost entities. The checks that verify the -- proper use of a Ghost entity need to know the enclosing context. @@ -360,8 +478,9 @@ package body Sem_Ch5 is null; elsif Has_Compatible_Type (Rhs, It.Typ) then - if T1 /= Any_Type then - + if T1 = Any_Type then + T1 := It.Typ; + else -- An explicit dereference is overloaded if the prefix -- is. Try to remove the ambiguity on the prefix, the -- error will be posted there if the ambiguity is real. @@ -412,8 +531,6 @@ package body Sem_Ch5 is ("ambiguous left-hand side in assignment", Lhs); exit; end if; - else - T1 := It.Typ; end if; end if; @@ -429,13 +546,21 @@ package body Sem_Ch5 is end if; end if; + -- Deal with build-in-place calls for nonlimited types. We don't do this + -- later, because resolving the rhs tranforms it incorrectly for build- + -- in-place. + + if Should_Transform_BIP_Assignment (Typ => T1) then + Transform_BIP_Assignment (Typ => T1); + end if; + + pragma Assert (not Should_Transform_BIP_Assignment (Typ => T1)); + -- The resulting assignment type is T1, so now we will resolve the left -- hand side of the assignment using this determined type. Resolve (Lhs, T1); - -- Cases where Lhs is not a variable - -- Cases where Lhs is not a variable. In an instance or an inlined body -- no need for further check because assignment was legal in template. @@ -822,11 +947,9 @@ package body Sem_Ch5 is Error_Msg_CRT ("composite assignment", N); end if; - -- Check elaboration warning for left side if not in elab code + -- Save the scenario for later examination by the ABE Processing phase - if not In_Subprogram_Or_Concurrent_Unit then - Check_Elab_Assign (Lhs); - end if; + Record_Elaboration_Scenario (N); -- Set Referenced_As_LHS if appropriate. We only set this flag if the -- assignment is a source assignment in the extended main source unit. @@ -967,9 +1090,13 @@ package body Sem_Ch5 is -- the context of the assignment statement. Restore the expander mode -- now so that assignment statement can be properly expanded. - if Nkind (N) = N_Assignment_Statement and then Has_Target_Names (N) then - Expander_Mode_Restore; - Full_Analysis := Save_Full_Analysis; + if Nkind (N) = N_Assignment_Statement then + if Has_Target_Names (N) then + Expander_Mode_Restore; + Full_Analysis := Save_Full_Analysis; + end if; + + pragma Assert (not Should_Transform_BIP_Assignment (Typ => T1)); end if; end Analyze_Assignment; @@ -1833,12 +1960,20 @@ package body Sem_Ch5 is procedure Check_Reverse_Iteration (Typ : Entity_Id) is begin - if Reverse_Present (N) - and then not Is_Array_Type (Typ) - and then not Is_Reversible_Iterator (Typ) - then - Error_Msg_NE - ("container type does not support reverse iteration", N, Typ); + if Reverse_Present (N) then + if Is_Array_Type (Typ) + or else Is_Reversible_Iterator (Typ) + or else + (Present (Find_Aspect (Typ, Aspect_Iterable)) + and then + Present + (Get_Iterable_Type_Primitive (Typ, Name_Previous))) + then + null; + else + Error_Msg_NE + ("container type does not support reverse iteration", N, Typ); + end if; end if; end Check_Reverse_Iteration; @@ -1947,13 +2082,13 @@ package body Sem_Ch5 is begin if No (Iterator) then - null; -- error reported below. + null; -- error reported below elsif not Is_Overloaded (Iterator) then Check_Reverse_Iteration (Etype (Iterator)); - -- If Iterator is overloaded, use reversible iterator if - -- one is available. + -- If Iterator is overloaded, use reversible iterator if one is + -- available. elsif Is_Overloaded (Iterator) then Get_First_Interp (Iterator, I, It); @@ -2199,6 +2334,7 @@ package body Sem_Ch5 is ("missing Element primitive for iteration", N); else Set_Etype (Def_Id, Etype (Elt)); + Check_Reverse_Iteration (Typ); end if; end; @@ -3512,8 +3648,7 @@ package body Sem_Ch5 is end if; else - - -- Pre-Ada2012 for-loops and while loops. + -- Pre-Ada2012 for-loops and while loops Analyze_Statements (Statements (N)); end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index cf1b83f0ade12..4f719e9b81c45 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -226,6 +226,20 @@ package body Sem_Ch6 is Generate_Definition (Subp_Id); + -- Set the SPARK mode from the current context (may be overwritten later + -- with explicit pragma). + + Set_SPARK_Pragma (Subp_Id, SPARK_Mode_Pragma); + Set_SPARK_Pragma_Inherited (Subp_Id); + + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => Subp_Id, + Checks => True); + Set_Is_Abstract_Subprogram (Subp_Id); New_Overloaded_Entity (Subp_Id); Check_Delayed_Subprogram (Subp_Id); @@ -428,18 +442,12 @@ package body Sem_Ch6 is begin -- Preanalyze a duplicate of the expression to have available the -- minimum decoration needed to locate referenced unfrozen types - -- without adding any decoration to the function expression. This - -- preanalysis is performed with errors disabled to avoid reporting - -- spurious errors on Ghost entities (since the expression is not - -- fully analyzed). + -- without adding any decoration to the function expression. Push_Scope (Def_Id); Install_Formals (Def_Id); - Ignore_Errors_Enable := Ignore_Errors_Enable + 1; Preanalyze_Spec_Expression (Dup_Expr, Etype (Def_Id)); - - Ignore_Errors_Enable := Ignore_Errors_Enable - 1; End_Scope; -- Restore certain attributes of Def_Id since the preanalysis may @@ -1468,7 +1476,7 @@ package body Sem_Ch6 is Set_Actual_Subtypes (N, Current_Scope); - Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma); + Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma); Set_SPARK_Pragma_Inherited (Body_Id); -- Analyze any aspect specifications that appear on the generic @@ -1769,13 +1777,12 @@ package body Sem_Ch6 is if Analyzed (N) then return; - end if; -- If there is an error analyzing the name (which may have been -- rewritten if the original call was in prefix notation) then error -- has been emitted already, mark node and return. - if Error_Posted (N) or else Etype (Name (N)) = Any_Type then + elsif Error_Posted (N) or else Etype (Name (N)) = Any_Type then Set_Etype (N, Any_Type); return; end if; @@ -1849,9 +1856,9 @@ package body Sem_Ch6 is New_N := Make_Indexed_Component (Loc, - Prefix => + Prefix => Make_Selected_Component (Loc, - Prefix => New_Occurrence_Of (Scope (Entity (P)), Loc), + Prefix => New_Occurrence_Of (Scope (Entity (P)), Loc), Selector_Name => New_Occurrence_Of (Entity (P), Loc)), Expressions => Actuals); Set_Name (N, New_N); @@ -1957,7 +1964,8 @@ package body Sem_Ch6 is then New_N := Make_Selected_Component (Loc, - Prefix => New_Occurrence_Of (Scope (Entity (Prefix (P))), Loc), + Prefix => + New_Occurrence_Of (Scope (Entity (Prefix (P))), Loc), Selector_Name => New_Occurrence_Of (Entity (Prefix (P)), Loc)); Rewrite (Prefix (P), New_N); Analyze (P); @@ -4026,7 +4034,7 @@ package body Sem_Ch6 is -- between the spec and body. elsif No (SPARK_Pragma (Body_Id)) then - Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma); + Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma); Set_SPARK_Pragma_Inherited (Body_Id); end if; @@ -4471,12 +4479,11 @@ package body Sem_Ch6 is Stm : Node_Id; begin - -- Skip initial labels (for one thing this occurs when we are in - -- front-end ZCX mode, but in any case it is irrelevant), and also - -- initial Push_xxx_Error_Label nodes, which are also irrelevant. + -- Skip call markers installed by the ABE mechanism, labels, and + -- Push_xxx_Error_Label to find the first real statement. Stm := First (Statements (HSS)); - while Nkind (Stm) = N_Label + while Nkind_In (Stm, N_Call_Marker, N_Label) or else Nkind (Stm) in N_Push_xxx_Label loop Next (Stm); @@ -4657,8 +4664,9 @@ package body Sem_Ch6 is and then Is_Entry_Barrier_Function (N) then null; + else - Set_SPARK_Pragma (Designator, SPARK_Mode_Pragma); + Set_SPARK_Pragma (Designator, SPARK_Mode_Pragma); Set_SPARK_Pragma_Inherited (Designator); end if; @@ -4671,6 +4679,14 @@ package body Sem_Ch6 is Set_Ignore_SPARK_Mode_Pragmas (Designator); end if; + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => Designator, + Checks => True); + if Debug_Flag_C then Write_Str ("==> subprogram spec "); Write_Name (Chars (Designator)); @@ -8002,7 +8018,7 @@ package body Sem_Ch6 is -- Ada 2005 (AI-318-02): In the case of build-in-place functions, add -- appropriate extra formals. See type Exp_Ch6.BIP_Formal_Kind. - if Ada_Version >= Ada_2005 and then Is_Build_In_Place_Function (E) then + if Is_Build_In_Place_Function (E) then declare Result_Subt : constant Entity_Id := Etype (E); Full_Subt : constant Entity_Id := Available_View (Result_Subt); diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index ba7ff3c848cd3..dc00cf9f2497d 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -199,7 +199,7 @@ package body Sem_Ch7 is subtype Entity_Header_Num is Integer range 0 .. Entity_Table_Size - 1; -- Range of headers in hash table - function Entity_Hash (Id : Entity_Id) return Entity_Header_Num; + function Node_Hash (Id : Entity_Id) return Entity_Header_Num; -- Simple hash function for Entity_Ids package Subprogram_Table is new GNAT.Htable.Simple_HTable @@ -207,19 +207,29 @@ package body Sem_Ch7 is Element => Boolean, No_Element => False, Key => Entity_Id, - Hash => Entity_Hash, + Hash => Node_Hash, Equal => "="); -- Hash table to record which subprograms are referenced. It is declared -- at library level to avoid elaborating it for every call to Analyze. + package Traversed_Table is new GNAT.Htable.Simple_HTable + (Header_Num => Entity_Header_Num, + Element => Boolean, + No_Element => False, + Key => Node_Id, + Hash => Node_Hash, + Equal => "="); + -- Hash table to record which nodes we have traversed, so we can avoid + -- traversing the same nodes repeatedly. + ----------------- - -- Entity_Hash -- + -- Node_Hash -- ----------------- - function Entity_Hash (Id : Entity_Id) return Entity_Header_Num is + function Node_Hash (Id : Entity_Id) return Entity_Header_Num is begin return Entity_Header_Num (Id mod Entity_Table_Size); - end Entity_Hash; + end Node_Hash; --------------------------------- -- Analyze_Package_Body_Helper -- @@ -260,13 +270,17 @@ package body Sem_Ch7 is function Scan_Subprogram_Ref (N : Node_Id) return Traverse_Result; -- Determine whether a node denotes a reference to a subprogram - procedure Scan_Subprogram_Refs is + procedure Traverse_And_Scan_Subprogram_Refs is new Traverse_Proc (Scan_Subprogram_Ref); -- Subsidiary to routine Has_Referencer. Determine whether a node -- contains references to a subprogram and record them. -- WARNING: this is a very expensive routine as it performs a full -- tree traversal. + procedure Scan_Subprogram_Refs (Node : Node_Id); + -- If we haven't already traversed Node, then mark it and traverse + -- it. + -------------------- -- Has_Referencer -- -------------------- @@ -511,6 +525,18 @@ package body Sem_Ch7 is return OK; end Scan_Subprogram_Ref; + -------------------------- + -- Scan_Subprogram_Refs -- + -------------------------- + + procedure Scan_Subprogram_Refs (Node : Node_Id) is + begin + if not Traversed_Table.Get (Node) then + Traversed_Table.Set (Node, True); + Traverse_And_Scan_Subprogram_Refs (Node); + end if; + end Scan_Subprogram_Refs; + -- Local variables Discard : Boolean; @@ -581,6 +607,7 @@ package body Sem_Ch7 is -- actual parameters of the instantiations matter here, and they are -- present in the declarations list of the instantiated packages. + Traversed_Table.Reset; Subprogram_Table.Reset; Discard := Has_Referencer (Decls, Top_Level => True); end Hide_Public_Entities; @@ -1121,16 +1148,10 @@ package body Sem_Ch7 is end if; end if; - if Is_Comp_Unit then - - -- Set Body_Required indication on the compilation unit node, and - -- determine whether elaboration warnings may be meaningful on it. + -- Set Body_Required indication on the compilation unit node + if Is_Comp_Unit then Set_Body_Required (Parent (N), Body_Required); - - if not Body_Required then - Set_Suppress_Elaboration_Warnings (Id); - end if; end if; End_Package_Scope (Id); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index a51cc636298f4..bdc8aba1e1fd3 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -57,6 +57,7 @@ with Sem_Ch13; use Sem_Ch13; with Sem_Dim; use Sem_Dim; with Sem_Disp; use Sem_Disp; with Sem_Dist; use Sem_Dist; +with Sem_Elab; use Sem_Elab; with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; @@ -478,6 +479,7 @@ package body Sem_Ch8 is -- Find the most previous use clause (that is, the first one to appear in -- the source) by traversing the previous clause chain that exists in both -- N_Use_Package_Clause nodes and N_Use_Type_Clause nodes. + -- ??? a better subprogram name is in order function Find_Renamed_Entity (N : Node_Id; @@ -525,19 +527,24 @@ package body Sem_Ch8 is Clause2 : Entity_Id) return Entity_Id; -- Determine which use clause parameter is the most descendant in terms of -- scope. + -- ??? a better subprogram name is in order procedure Premature_Usage (N : Node_Id); -- Diagnose usage of an entity before it is visible procedure Use_One_Package - (N : Node_Id; Pack_Name : Entity_Id := Empty; Force : Boolean := False); + (N : Node_Id; + Pack_Name : Entity_Id := Empty; + Force : Boolean := False); -- Make visible entities declared in package P potentially use-visible -- in the current context. Also used in the analysis of subunits, when -- re-installing use clauses of parent units. N is the use_clause that -- names P (and possibly other packages). procedure Use_One_Type - (Id : Node_Id; Installed : Boolean := False; Force : Boolean := False); + (Id : Node_Id; + Installed : Boolean := False; + Force : Boolean := False); -- Id is the subtype mark from a use_type_clause. This procedure makes -- the primitive operators of the type potentially use-visible. The -- boolean flag Installed indicates that the clause is being reinstalled @@ -3637,19 +3644,16 @@ package body Sem_Ch8 is -- and mark any use_package_clauses that affect the visibility of the -- implicit generic actual. - if From_Default (N) - and then Is_Generic_Actual_Subprogram (New_S) - and then Present (Alias (New_S)) + if Is_Generic_Actual_Subprogram (New_S) + and then (Is_Intrinsic_Subprogram (New_S) or else From_Default (N)) then - Mark_Use_Clauses (Alias (New_S)); + Mark_Use_Clauses (New_S); - -- Check intrinsic operators used as generic actuals since they may - -- make a use_type_clause effective. + -- Handle overloaded subprograms - elsif Is_Generic_Actual_Subprogram (New_S) - and then Is_Intrinsic_Subprogram (New_S) - then - Mark_Use_Clauses (New_S); + if Present (Alias (New_S)) then + Mark_Use_Clauses (Alias (New_S)); + end if; end if; end Analyze_Subprogram_Renaming; @@ -3665,7 +3669,6 @@ package body Sem_Ch8 is -- within the package itself, ignore it. procedure Analyze_Use_Package (N : Node_Id; Chain : Boolean := True) is - procedure Analyze_Package_Name (Clause : Node_Id); -- Perform analysis on a package name from a use_package_clause @@ -3699,8 +3702,8 @@ package body Sem_Ch8 is if Entity (Pref) = Standard_Standard then Error_Msg_N - ("predefined package Standard cannot appear in a " - & "context clause", Pref); + ("predefined package Standard cannot appear in a context " + & "clause", Pref); end if; end if; end Analyze_Package_Name; @@ -3762,6 +3765,7 @@ package body Sem_Ch8 is if not More_Ids (N) and then not Prev_Ids (N) then Analyze_Package_Name (N); + elsif More_Ids (N) and then not Prev_Ids (N) then Analyze_Package_Name_List (N); end if; @@ -3771,12 +3775,13 @@ package body Sem_Ch8 is return; end if; - Pack := Entity (Name (N)); if Chain then Chain_Use_Clause (N); end if; + Pack := Entity (Name (N)); + -- There are many cases where scopes are manipulated during analysis, so -- check that Pack's current use clause has not already been chained -- before setting its previous use clause. @@ -3795,8 +3800,7 @@ package body Sem_Ch8 is if Ekind (Pack) /= E_Package and then Etype (Pack) /= Any_Type then if Ekind (Pack) = E_Generic_Package then Error_Msg_N -- CODEFIX - ("a generic package is not allowed in a use clause", - Name (N)); + ("a generic package is not allowed in a use clause", Name (N)); elsif Ekind_In (Pack, E_Generic_Function, E_Generic_Package) then @@ -3806,8 +3810,7 @@ package body Sem_Ch8 is elsif Ekind_In (Pack, E_Function, E_Procedure, E_Operator) then Error_Msg_N -- CODEFIX - ("a subprogram is not allowed in a use clause", - Name (N)); + ("a subprogram is not allowed in a use clause", Name (N)); else Error_Msg_N ("& is not allowed in a use clause", Name (N)); @@ -3835,25 +3838,6 @@ package body Sem_Ch8 is end if; end if; end if; - - -- Detect a mixture of Ghost packages and living packages within the - -- same use_package_clause. Ideally one would split a use_package_clause - -- with multiple names into multiple use_package_clauses with a single - -- name, however clients of the front end would have to adapt to this - -- change. - - if Present (Ghost_Id) and then Present (Living_Id) then - Error_Msg_N - ("use clause cannot mention ghost and non-ghost ghost units", N); - - Error_Msg_Sloc := Sloc (Ghost_Id); - Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id); - - Error_Msg_Sloc := Sloc (Living_Id); - Error_Msg_NE ("\& # declared as non-ghost", N, Living_Id); - end if; - - Mark_Ghost_Clause (N); end Analyze_Use_Package; ---------------------- @@ -4133,6 +4117,11 @@ package body Sem_Ch8 is Statements => New_List (Attr_Node))); end if; + -- Signal the ABE mechanism that the generated subprogram body has not + -- ABE ramifications. + + Set_Was_Attribute_Reference (Body_Node); + -- In case of tagged types we add the body of the generated function to -- the freezing actions of the type (because in the general case such -- type is still not frozen). We exclude from this processing generic @@ -4192,15 +4181,6 @@ package body Sem_Ch8 is Error_Msg_N ("a library unit can only rename another library unit", N); end if; - - -- We suppress elaboration warnings for the resulting entity, since - -- clearly they are not needed, and more particularly, in the case - -- of a generic formal subprogram, the resulting entity can appear - -- after the instantiation itself, and thus look like a bogus case - -- of access before elaboration. - - Set_Suppress_Elaboration_Warnings (New_S); - end Attribute_Renaming; ---------------------- @@ -4208,8 +4188,8 @@ package body Sem_Ch8 is ---------------------- procedure Chain_Use_Clause (N : Node_Id) is - Pack : Entity_Id; Level : Int := Scope_Stack.Last; + Pack : Entity_Id; begin -- Common case @@ -4231,6 +4211,7 @@ package body Sem_Ch8 is -- parent unit when compiling a child. Pack := Defining_Entity (Parent (N), Empty_On_Errors => True); + if not In_Open_Scopes (Pack) then null; @@ -4793,9 +4774,7 @@ package body Sem_Ch8 is function Entity_Of_Unit (U : Node_Id) return Entity_Id is begin - if Nkind (U) = N_Package_Instantiation - and then Analyzed (U) - then + if Nkind (U) = N_Package_Instantiation and then Analyzed (U) then return Defining_Entity (Instance_Spec (U)); else return Defining_Entity (U); @@ -5433,6 +5412,16 @@ package body Sem_Ch8 is return; end if; + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + if Nkind (N) = N_Identifier then + Mark_Elaboration_Attributes + (N_Id => N, + Modes => True); + end if; + -- Here if Entity pointer was not set, we need full visibility analysis -- First we generate debugging output if the debug E flag is set. @@ -5897,9 +5886,7 @@ package body Sem_Ch8 is -- path, so ignore the fact that they are overloaded and mark them -- anyway. - if Nkind (N) not in N_Subexpr - or else not Is_Overloaded (N) - then + if Nkind (N) not in N_Subexpr or else not Is_Overloaded (N) then Mark_Use_Clauses (N); end if; @@ -5907,6 +5894,10 @@ package body Sem_Ch8 is <> Check_Restriction_No_Use_Of_Entity (N); + + -- Save the scenario for later examination by the ABE Processing phase + + Record_Elaboration_Scenario (N); end Find_Direct_Name; ------------------------ @@ -6421,6 +6412,14 @@ package body Sem_Ch8 is Change_Selected_Component_To_Expanded_Name (N); + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => N, + Modes => True); + -- Set appropriate type if Is_Type (Id) then @@ -6529,6 +6528,10 @@ package body Sem_Ch8 is end if; Check_Restriction_No_Use_Of_Entity (N); + + -- Save the scenario for later examination by the ABE Processing phase + + Record_Elaboration_Scenario (N); end Find_Expanded_Name; -------------------- @@ -6537,6 +6540,7 @@ package body Sem_Ch8 is function Find_Most_Prev (Use_Clause : Node_Id) return Node_Id is Curr : Node_Id; + begin -- Loop through the Prev_Use_Clause chain @@ -8202,7 +8206,6 @@ package body Sem_Ch8 is ---------------------- procedure Mark_Use_Clauses (Id : Node_Or_Entity_Id) is - procedure Mark_Parameters (Call : Entity_Id); -- Perform use_type_clause marking for all parameters in a subprogram -- or operator call. @@ -8245,8 +8248,8 @@ package body Sem_Ch8 is Curr : Node_Id; begin - -- Ignore cases where the scope of the type is not a package - -- (e.g. Standard_Standard). + -- Ignore cases where the scope of the type is not a package (e.g. + -- Standard_Standard). if Ekind (Pak) /= E_Package then return; @@ -8254,10 +8257,10 @@ package body Sem_Ch8 is Curr := Current_Use_Clause (Pak); while Present (Curr) - and then not Is_Effective_Use_Clause (Curr) + and then not Is_Effective_Use_Clause (Curr) loop - -- We need to mark the previous use clauses as effective, but each - -- use clause may in turn render other use_package_clauses + -- We need to mark the previous use clauses as effective, but + -- each use clause may in turn render other use_package_clauses -- effective. Additionally, it is possible to have a parent -- package renamed as a child of itself so we must check the -- prefix entity is not the same as the package we are marking. @@ -8308,6 +8311,7 @@ package body Sem_Ch8 is -- for ignoring previous errors. Mark_Use_Package (Scope (Base_Type (Etype (E)))); + if Nkind (E) in N_Op and then Present (Entity (E)) and then Present (Scope (Entity (E))) @@ -8342,7 +8346,7 @@ package body Sem_Ch8 is -- Use clauses in and of themselves do not count as a "use" of a -- package. - if Nkind_In (Parent (Id), N_Use_Type_Clause, N_Use_Package_Clause) then + if Nkind_In (Parent (Id), N_Use_Package_Clause, N_Use_Type_Clause) then return; end if; @@ -8364,8 +8368,8 @@ package body Sem_Ch8 is -- Mark primitives elsif (Ekind (Id) in Overloadable_Kind - or else Ekind_In - (Ekind (Id), E_Generic_Function, E_Generic_Procedure)) + or else Ekind_In (Id, E_Generic_Function, + E_Generic_Procedure)) and then (Is_Potentially_Use_Visible (Id) or else Is_Intrinsic_Subprogram (Id)) then @@ -8384,7 +8388,7 @@ package body Sem_Ch8 is -- expression. if Nkind (Id) in N_Binary_Op - and then not (Nkind (Left_Opnd (Id)) in N_Op) + and then not (Nkind (Left_Opnd (Id)) in N_Op) then Mark_Use_Type (Left_Opnd (Id)); end if; @@ -8892,8 +8896,9 @@ package body Sem_Ch8 is and then Scope_Stack.Table (SS_Last).Entity /= Standard_Standard and then Handle_Use then - Install_Use_Clauses (Scope_Stack.Table (SS_Last).First_Use_Clause, - Force_Installation => True); + Install_Use_Clauses + (Scope_Stack.Table (SS_Last).First_Use_Clause, + Force_Installation => True); end if; end Restore_Scope_Stack; @@ -9016,7 +9021,6 @@ package body Sem_Ch8 is ----------------------------- procedure Update_Use_Clause_Chain is - procedure Update_Chain_In_Scope (Level : Int); -- Iterate through one level in the scope stack verifying each use-type -- clause within said level is used then reset the Current_Use_Clause @@ -9054,7 +9058,6 @@ package body Sem_Ch8 is and then not Is_Effective_Use_Clause (Curr) and then not In_Instance then - -- We are dealing with a potentially unused use_package_clause if Nkind (Curr) = N_Use_Package_Clause then @@ -9064,21 +9067,24 @@ package body Sem_Ch8 is if not (Present (Associated_Node (N)) and then Present - (Current_Use_Clause (Associated_Node (N))) + (Current_Use_Clause + (Associated_Node (N))) and then Is_Effective_Use_Clause - (Current_Use_Clause (Associated_Node (N)))) + (Current_Use_Clause + (Associated_Node (N)))) then Error_Msg_Node_1 := Entity (N); - Error_Msg_NE ("ineffective use clause for package &?", - Curr, Entity (N)); + Error_Msg_NE + ("use clause for package & has no effect?u?", + Curr, Entity (N)); end if; -- We are dealing with an unused use_type_clause else Error_Msg_Node_1 := Etype (N); - Error_Msg_NE ("ineffective use clause for }?", - Curr, Etype (N)); + Error_Msg_NE + ("use clause for } has no effect?u?", Curr, Etype (N)); end if; end if; @@ -9102,10 +9108,10 @@ package body Sem_Ch8 is -- Deal with use clauses within the context area if the current -- scope is a compilation unit. - if Is_Compilation_Unit (Current_Scope) then - - pragma Assert (Scope_Stack.Last /= Scope_Stack.First); - + if Is_Compilation_Unit (Current_Scope) + and then Sloc (Scope_Stack.Table + (Scope_Stack.Last - 1).Entity) = Standard_Location + then Update_Chain_In_Scope (Scope_Stack.Last - 1); end if; end Update_Use_Clause_Chain; @@ -9119,7 +9125,6 @@ package body Sem_Ch8 is Pack_Name : Entity_Id := Empty; Force : Boolean := False) is - procedure Note_Redundant_Use (Clause : Node_Id); -- Mark the name in a use clause as redundant if the corresponding -- entity is already use-visible. Emit a warning if the use clause comes @@ -9130,8 +9135,8 @@ package body Sem_Ch8 is ------------------------ procedure Note_Redundant_Use (Clause : Node_Id) is - Pack_Name : constant Entity_Id := Entity (Clause); Decl : constant Node_Id := Parent (Clause); + Pack_Name : constant Entity_Id := Entity (Clause); Cur_Use : Node_Id := Current_Use_Clause (Pack_Name); Prev_Use : Node_Id := Empty; @@ -9187,10 +9192,11 @@ package body Sem_Ch8 is elsif Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body then declare Cur_Unit : constant Unit_Number_Type := - Get_Source_Unit (Cur_Use); + Get_Source_Unit (Cur_Use); New_Unit : constant Unit_Number_Type := - Get_Source_Unit (Clause); - Scop : Entity_Id; + Get_Source_Unit (Clause); + + Scop : Entity_Id; begin if Cur_Unit = New_Unit then @@ -9212,8 +9218,8 @@ package body Sem_Ch8 is Redundant := Clause; Prev_Use := Cur_Use; - -- Most common case: redundant clause in body, - -- original clause in spec. Current scope is spec entity. + -- Most common case: redundant clause in body, original + -- clause in spec. Current scope is spec entity. elsif Current_Scope = Cunit_Entity (Current_Sem_Unit) then Redundant := Cur_Use; @@ -9283,8 +9289,8 @@ package body Sem_Ch8 is -- visible part of the child, and no warning should be emitted. if Nkind (Parent (Decl)) = N_Package_Specification - and then - List_Containing (Decl) = Private_Declarations (Parent (Decl)) + and then List_Containing (Decl) = + Private_Declarations (Parent (Decl)) then declare Par : constant Entity_Id := Defining_Entity (Parent (Decl)); @@ -9295,16 +9301,16 @@ package body Sem_Ch8 is if Is_Compilation_Unit (Par) and then Par /= Cunit_Entity (Current_Sem_Unit) and then Parent (Cur_Use) = Spec - and then - List_Containing (Cur_Use) = Visible_Declarations (Spec) + and then List_Containing (Cur_Use) = + Visible_Declarations (Spec) then return; end if; end; end if; - -- Finally, if the current use clause is in the context then - -- the clause is redundant when it is nested within the unit. + -- Finally, if the current use clause is in the context then the + -- clause is redundant when it is nested within the unit. elsif Nkind (Parent (Cur_Use)) = N_Compilation_Unit and then Nkind (Parent (Parent (Clause))) /= N_Compilation_Unit @@ -9316,6 +9322,7 @@ package body Sem_Ch8 is end if; if Present (Redundant) and then Parent (Redundant) /= Prev_Use then + -- Make sure we are looking at most-descendant use_package_clause -- by traversing the chain with Find_Most_Prev and then verifying -- there is no scope manipulation via Most_Descendant_Use_Clause. @@ -9324,26 +9331,26 @@ package body Sem_Ch8 is and then (Nkind (Parent (Prev_Use)) /= N_Compilation_Unit or else Most_Descendant_Use_Clause - (Prev_Use, Find_Most_Prev (Prev_Use)) /= Prev_Use) + (Prev_Use, Find_Most_Prev (Prev_Use)) /= Prev_Use) then Prev_Use := Find_Most_Prev (Prev_Use); end if; Error_Msg_Sloc := Sloc (Prev_Use); Error_Msg_NE -- CODEFIX - ("& is already use-visible through previous use clause #??", + ("& is already use-visible through previous use_clause #??", Redundant, Pack_Name); end if; end Note_Redundant_Use; -- Local variables + Current_Instance : Entity_Id := Empty; Id : Entity_Id; + P : Entity_Id; Prev : Entity_Id; - Current_Instance : Entity_Id := Empty; - Real_P : Entity_Id; Private_With_OK : Boolean := False; - P : Entity_Id; + Real_P : Entity_Id; -- Start of processing for Use_One_Package @@ -9384,9 +9391,11 @@ package body Sem_Ch8 is if In_Use (P) then Note_Redundant_Use (Pack_Name); + if not Force then Set_Current_Use_Clause (P, N); end if; + return; -- Warn about detected redundant clauses @@ -9397,6 +9406,7 @@ package body Sem_Ch8 is ("& is already use-visible within itself?r?", Pack_Name, P); end if; + return; end if; @@ -9428,10 +9438,9 @@ package body Sem_Ch8 is end if; end if; - -- If unit is a package renaming, indicate that the renamed - -- package is also in use (the flags on both entities must - -- remain consistent, and a subsequent use of either of them - -- should be recognized as redundant). + -- If unit is a package renaming, indicate that the renamed package is + -- also in use (the flags on both entities must remain consistent, and a + -- subsequent use of either of them should be recognized as redundant). if Present (Renamed_Object (P)) then Set_In_Use (Renamed_Object (P)); @@ -9596,13 +9605,10 @@ package body Sem_Ch8 is ------------------ procedure Use_One_Type - (Id : Node_Id; Installed : Boolean := False; Force : Boolean := False) + (Id : Node_Id; + Installed : Boolean := False; + Force : Boolean := False) is - Elmt : Elmt_Id; - Is_Known_Used : Boolean; - Op_List : Elist_Id; - T : Entity_Id; - function Spec_Reloaded_For_Body return Boolean; -- Determine whether the compilation unit is a package body and the use -- type clause is in the spec of the same package. Even though the spec @@ -9631,9 +9637,9 @@ package body Sem_Ch8 is return Nkind (Spec) = N_Package_Specification - and then - In_Same_Source_Unit (Corresponding_Body (Parent (Spec)), - Cunit_Entity (Current_Sem_Unit)); + and then In_Same_Source_Unit + (Corresponding_Body (Parent (Spec)), + Cunit_Entity (Current_Sem_Unit)); end; end if; @@ -9645,9 +9651,6 @@ package body Sem_Ch8 is ------------------------------- procedure Use_Class_Wide_Operations (Typ : Entity_Id) is - Scop : Entity_Id; - Ent : Entity_Id; - function Is_Class_Wide_Operation_Of (Op : Entity_Id; T : Entity_Id) return Boolean; @@ -9659,8 +9662,8 @@ package body Sem_Ch8 is --------------------------------- function Is_Class_Wide_Operation_Of - (Op : Entity_Id; - T : Entity_Id) return Boolean + (Op : Entity_Id; + T : Entity_Id) return Boolean is Formal : Entity_Id; @@ -9670,6 +9673,7 @@ package body Sem_Ch8 is if Etype (Formal) = Class_Wide_Type (T) then return True; end if; + Next_Formal (Formal); end loop; @@ -9680,6 +9684,11 @@ package body Sem_Ch8 is return False; end Is_Class_Wide_Operation_Of; + -- Local variables + + Ent : Entity_Id; + Scop : Entity_Id; + -- Start of processing for Use_Class_Wide_Operations begin @@ -9704,6 +9713,13 @@ package body Sem_Ch8 is end if; end Use_Class_Wide_Operations; + -- Local variables + + Elmt : Elmt_Id; + Is_Known_Used : Boolean; + Op_List : Elist_Id; + T : Entity_Id; + -- Start of processing for Use_One_Type begin @@ -9720,13 +9736,13 @@ package body Sem_Ch8 is -- in use or the entity is declared in the current package, thus -- use-visible. - Is_Known_Used := (In_Use (T) - and then ((Present (Current_Use_Clause (T)) - and then All_Present - (Current_Use_Clause (T))) - or else not All_Present (Parent (Id)))) - or else In_Use (Scope (T)) - or else Scope (T) = Current_Scope; + Is_Known_Used := + (In_Use (T) + and then ((Present (Current_Use_Clause (T)) + and then All_Present (Current_Use_Clause (T))) + or else not All_Present (Parent (Id)))) + or else In_Use (Scope (T)) + or else Scope (T) = Current_Scope; Set_Redundant_Use (Id, Is_Known_Used or else Is_Potentially_Use_Visible (T)); @@ -9780,8 +9796,8 @@ package body Sem_Ch8 is Set_Current_Use_Clause (T, Parent (Id)); Set_In_Use (T); - -- If T is tagged, primitive operators on class-wide operands - -- are also available. + -- If T is tagged, primitive operators on class-wide operands are + -- also available. if Is_Tagged_Type (T) then Set_In_Use (Class_Wide_Type (T)); @@ -9858,8 +9874,8 @@ package body Sem_Ch8 is if Present (Current_Use_Clause (T)) then Use_Clause_Known : declare - Clause1 : constant Node_Id := Find_Most_Prev - (Current_Use_Clause (T)); + Clause1 : constant Node_Id := + Find_Most_Prev (Current_Use_Clause (T)); Clause2 : constant Node_Id := Parent (Id); Ent1 : Entity_Id; Ent2 : Entity_Id; @@ -9934,7 +9950,8 @@ package body Sem_Ch8 is else declare - S1, S2 : Entity_Id; + S1 : Entity_Id; + S2 : Entity_Id; begin S1 := Scope (Ent1); @@ -9978,24 +9995,24 @@ package body Sem_Ch8 is else Error_Msg_NE -- CODEFIX ("& is already use-visible through previous " - & "use type clause??", Id, T); + & "use_type_clause??", Id, T); end if; end Use_Clause_Known; - -- Here if Current_Use_Clause is not set for T, another case - -- where we do not have the location information available. + -- Here if Current_Use_Clause is not set for T, another case where + -- we do not have the location information available. else Error_Msg_NE -- CODEFIX ("& is already use-visible through previous " - & "use type clause??", Id, T); + & "use_type_clause??", Id, T); end if; -- The package where T is declared is already used elsif In_Use (Scope (T)) then - Error_Msg_Sloc := Sloc (Find_Most_Prev - (Current_Use_Clause (Scope (T)))); + Error_Msg_Sloc := + Sloc (Find_Most_Prev (Current_Use_Clause (Scope (T)))); Error_Msg_NE -- CODEFIX ("& is already use-visible through package use clause #??", Id, T); diff --git a/gcc/ada/sem_ch8.ads b/gcc/ada/sem_ch8.ads index e87f5aafd5162..bee5f49e87497 100644 --- a/gcc/ada/sem_ch8.ads +++ b/gcc/ada/sem_ch8.ads @@ -53,17 +53,15 @@ package Sem_Ch8 is procedure Analyze_Package_Renaming (N : Node_Id); procedure Analyze_Subprogram_Renaming (N : Node_Id); - procedure Analyze_Use_Package (N : Node_Id; - Chain : Boolean := True); - -- Analyze a use package clause and control (through the Chain - -- parameter) whether to add N to the use clause chain for the name - -- denoted within use clause N in case we are reanalyzing a use clause - -- because of stack manipulation. - - procedure Analyze_Use_Type (N : Node_Id; - Chain : Boolean := True); - -- Similar to Analyze_Use_Package except the Chain parameter applies - -- to the type within N's subtype mark Current_Use_Clause. + procedure Analyze_Use_Package (N : Node_Id; Chain : Boolean := True); + -- Analyze a use package clause and control (through the Chain parameter) + -- whether to add N to the use clause chain for the name denoted within + -- use clause N in case we are reanalyzing a use clause because of stack + -- manipulation. + + procedure Analyze_Use_Type (N : Node_Id; Chain : Boolean := True); + -- Similar to Analyze_Use_Package except the Chain parameter applies to the + -- type within N's subtype mark Current_Use_Clause. procedure End_Scope; -- Called at end of scope. On exit from blocks and bodies (subprogram, diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index cbebe2601d2bb..199cd8a8c7a65 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -50,6 +50,7 @@ with Sem_Ch5; use Sem_Ch5; with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; with Sem_Ch13; use Sem_Ch13; +with Sem_Elab; use Sem_Elab; with Sem_Eval; use Sem_Eval; with Sem_Prag; use Sem_Prag; with Sem_Res; use Sem_Res; @@ -1656,6 +1657,14 @@ package body Sem_Ch9 is Set_SPARK_Pragma_Inherited (Def_Id); end if; + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => Def_Id, + Checks => True); + -- Process formals if Present (Formals) then @@ -2281,6 +2290,15 @@ package body Sem_Ch9 is Synch_Type : Entity_Id; begin + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => N, + Checks => True, + Modes => True); + Tasking_Used := True; Check_SPARK_05_Restriction ("requeue statement is not allowed", N); Check_Restriction (No_Requeue_Statements, N); @@ -2553,6 +2571,12 @@ package body Sem_Ch9 is Error_Msg_N ("target protected object of requeue must be a variable", N); end if; + + -- A requeue statement is treated as a call for purposes of ABE checks + -- and diagnostics. Annotate the tree by creating a call marker in case + -- the requeue statement is transformed by expansion. + + Build_Call_Marker (N); end Analyze_Requeue; ------------------------------ @@ -2836,6 +2860,14 @@ package body Sem_Ch9 is Set_SPARK_Pragma (Obj_Id, SPARK_Mode_Pragma); Set_SPARK_Pragma_Inherited (Obj_Id); + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => Obj_Id, + Checks => True); + -- Instead of calling Analyze on the new node, call the proper analysis -- procedure directly. Otherwise the node would be expanded twice, with -- disastrous result. @@ -3099,6 +3131,14 @@ package body Sem_Ch9 is Set_SPARK_Pragma_Inherited (T); Set_SPARK_Aux_Pragma_Inherited (T); + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => T, + Checks => True); + Push_Scope (T); if Ada_Version >= Ada_2005 then diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index 6330703e071bc..a271ca559602e 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -518,25 +518,17 @@ package body Sem_Dim is Position : Dimension_Position) is begin - -- Integer case - - if Is_Integer_Type (Def_Id) then - - -- Dimension value must be an integer literal - - if Nkind (Expr) = N_Integer_Literal then - Dimensions (Position) := +Whole (UI_To_Int (Intval (Expr))); - else - Error_Msg_N ("integer literal expected", Expr); - end if; + Dimensions (Position) := Create_Rational_From (Expr, True); + Processed (Position) := True; - -- Float case + -- If the dimensioned root type is an integer type, it is not + -- particularly useful, and fractional dimensions do not make + -- much sense for such types, so previously we used to reject + -- dimensions of integer types that were not integer literals. + -- However, the manipulation of dimensions does not depend on + -- the kind of root type, so we can accept this usage for rare + -- cases where dimensions are specified for integer values. - else - Dimensions (Position) := Create_Rational_From (Expr, True); - end if; - - Processed (Position) := True; end Extract_Power; ------------------------ @@ -1585,6 +1577,20 @@ package body Sem_Dim is then null; + -- Numeric literal case. Issue a warning to indicate the + -- literal is treated as if its dimension matches the type + -- dimension. + + elsif Nkind_In (Original_Node (L), N_Integer_Literal, + N_Real_Literal) + then + Dim_Warning_For_Numeric_Literal (L, Etype (R)); + + elsif Nkind_In (Original_Node (R), N_Integer_Literal, + N_Real_Literal) + then + Dim_Warning_For_Numeric_Literal (R, Etype (L)); + else Error_Dim_Msg_For_Binary_Op (N, L, R); end if; @@ -2732,6 +2738,24 @@ package body Sem_Dim is procedure Dim_Warning_For_Numeric_Literal (N : Node_Id; Typ : Entity_Id) is begin + -- Consider the literal zero (integer 0 or real 0.0) to be of any + -- dimension. + + case Nkind (Original_Node (N)) is + when N_Real_Literal => + if Expr_Value_R (N) = Ureal_0 then + return; + end if; + + when N_Integer_Literal => + if Expr_Value (N) = Uint_0 then + return; + end if; + + when others => + null; + end case; + -- Initialize name buffer Name_Len := 0; diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 7be57cfce9790..8dec4280eb3cb 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -24,31 +24,28 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Checks; use Checks; with Debug; use Debug; with Einfo; use Einfo; -with Elists; use Elists; with Errout; use Errout; +with Exp_Ch11; use Exp_Ch11; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; -with Expander; use Expander; with Lib; use Lib; with Lib.Load; use Lib.Load; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; with Opt; use Opt; -with Output; use Output; with Restrict; use Restrict; with Rident; use Rident; +with Rtsfind; use Rtsfind; with Sem; use Sem; with Sem_Aux; use Sem_Aux; -with Sem_Cat; use Sem_Cat; with Sem_Ch7; use Sem_Ch7; with Sem_Ch8; use Sem_Ch8; +with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; -with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; with Table; @@ -56,2125 +53,6981 @@ with Tbuild; use Tbuild; with Uintp; use Uintp; with Uname; use Uname; +with GNAT.HTable; use GNAT.HTable; + package body Sem_Elab is - -- The following table records the recursive call chain for output in the - -- Output routine. Each entry records the call node and the entity of the - -- called routine. The number of entries in the table (i.e. the value of - -- Elab_Call.Last) indicates the current depth of recursion and is used to - -- identify the outer level. + ----------------------------------------- + -- Access-before-elaboration mechanism -- + ----------------------------------------- + + -- The access-before-elaboration (ABE) mechanism implemented in this unit + -- has the following objectives: + -- + -- * Diagnose at compile-time or install run-time checks to prevent ABE + -- access to data and behaviour. + -- + -- The high level idea is to accurately diagnose ABE issues within a + -- single unit because the ABE mechanism can inspect the whole unit. + -- As soon as the elaboration graph extends to an external unit, the + -- diagnostics stop because the body of the unit may not be available. + -- Due to control and data flow, the ABE mechanism cannot accurately + -- determine whether a particular scenario will be elaborated or not. + -- Conditional ABE checks are therefore used to verify the elaboration + -- status of a local and external target at run time. + -- + -- * Supply elaboration dependencies for a unit to binde + -- + -- The ABE mechanism registers each outgoing elaboration edge for the + -- main unit in its ALI file. GNATbind and binde can then reconstruct + -- the full elaboration graph and determine the proper elaboration + -- order for all units in the compilation. + -- + -- The ABE mechanism supports three models of elaboration: + -- + -- * Dynamic model - This is the most permissive of the three models. + -- When the dynamic model is in effect, the mechanism performs very + -- little diagnostics and generates run-time checks to detect ABE + -- issues. The behaviour of this model is identical to that specified + -- by the Ada RM. This model is enabled with switch -gnatE. + -- + -- * Static model - This is the middle ground of the three models. When + -- the static model is in effect, the mechanism diagnoses and installs + -- run-time checks to detect ABE issues in the main unit. In addition, + -- the mechanism generates implicit Elaborate or Elaborate_All pragmas + -- to ensure the prior elaboration of withed units. The model employs + -- textual order, with clause context, and elaboration-related source + -- pragmas. This is the default model. + -- + -- * SPARK model - This is the most conservative of the three models and + -- impelements the semantics defined in SPARK RM 7.7. The SPARK model + -- is in effect only when a context resides in a SPARK_Mode On region, + -- otherwise the mechanism falls back to one of the previous models. + -- + -- The ABE mechanism consists of a "recording" phase and a "processing" + -- phase. + + ----------------- + -- Terminology -- + ----------------- + + -- * Bridge target - A type of target. A bridge target is a link between + -- scenarios. It is usually a byproduct of expansion and does not have + -- any direct ABE ramifications. + -- + -- * Call marker - A special node used to indicate the presence of a call + -- in the tree in case expansion transforms or eliminates the original + -- call. N_Call_Marker nodes do not have static and run-time semantics. + -- + -- * Conditional ABE - A type of ABE. A conditional ABE occurs when the + -- elaboration or invocation of a target by a scenario within the main + -- unit causes an ABE, but does not cause an ABE for another scenarios + -- within the main unit. + -- + -- * Declaration level - A type of enclosing level. A scenario or target is + -- at the declaration level when it appears within the declarations of a + -- block statement, entry body, subprogram body, or task body, ignoring + -- enclosing packges. + -- + -- * Generic library level - A type of enclosing level. A scenario or + -- target is at the generic library level if it appears in a generic + -- package library unit, ignoring enclosing packages. + -- + -- * Guaranteed ABE - A type of ABE. A guaranteed ABE occurs when the + -- elaboration or invocation of a target by all scenarios within the + -- main unit causes an ABE. + -- + -- * Instantiation library level - A type of enclosing level. A scenario + -- or target is at the instantiation library level if it appears in an + -- instantiation library unit, ignoring enclosing packages. + -- + -- * Library level - A type of enclosing level. A scenario or target is at + -- the library level if it appears in a package library unit, ignoring + -- enclosng packages. + -- + -- * Non-library level encapsulator - A construct that cannot be elaborated + -- on its own and requires elaboration by a top level scenario. + -- + -- * Scenario - A construct or context which may be elaborated or executed + -- by elaboration code. The scenarios recognized by the ABE mechanism are + -- as follows: + -- + -- - '[Unrestricted_]Access of entries, operators, and subprograms + -- + -- - Assignments to variables + -- + -- - Calls to entries, operators, and subprograms + -- + -- - Instantiations + -- + -- - Reads of variables + -- + -- - Task activation + -- + -- * Target - A construct referenced by a scenario. The targets recognized + -- by the ABE mechanism are as follows: + -- + -- - For '[Unrestricted_]Access of entries, operators, and subprograms, + -- the target is the entry, operator, or subprogram. + -- + -- - For assignments to variables, the target is the variable + -- + -- - For calls, the target is the entry, operator, or subprogram + -- + -- - For instantiations, the target is the generic template + -- + -- - For reads of variables, the target is the variable + -- + -- - For task activation, the target is the task body + -- + -- * Top level scenario - A scenario which appears in a non-generic main + -- unit. Depending on the elaboration model is in effect, the following + -- addotional restrictions apply: + -- + -- - Dynamic model - No restrictions + -- + -- - SPARK model - Falls back to either the dynamic or static model + -- + -- - Static model - The scenario must be at the library level + + --------------------- + -- Recording phase -- + --------------------- + + -- The Recording phase coincides with the analysis/resolution phase of the + -- compiler. It has the following objectives: + -- + -- * Record all top level scenarios for examination by the Processing + -- phase. + -- + -- Saving only a certain number of nodes improves the performance of + -- the ABE mechanism. This eliminates the need to examine the whole + -- tree in a separate pass. + -- + -- * Detect and diagnose calls in preelaborable or pure units, including + -- generic bodies. + -- + -- This diagnostic is carried out during the Recording phase because it + -- does not need the heavy recursive traversal done by the Processing + -- phase. + -- + -- * Detect and diagnose guaranteed ABEs caused by instantiations, + -- calls, and task activation. + -- + -- The issues detected by the ABE mechanism are reported as warnings + -- because they do not violate Ada semantics. Forward instantiations + -- may thus reach gigi, however gigi cannot handle certain kinds of + -- premature instantiations and may crash. To avoid this limitation, + -- the ABE mechanism must identify forward instantiations as early as + -- possible and suppress their bodies. Calls and task activations are + -- included in this category for completeness. + + ---------------------- + -- Processing phase -- + ---------------------- + + -- The Processing phase is a separate pass which starts after instantiating + -- and/or inlining of bodies, but before the removal of Ghost code. It has + -- the following objectives: + -- + -- * Examine all top level scenarios saved during the Recording phase + -- + -- The top level scenarios act as roots for depth-first traversal of + -- the call/instantiation/task activation graph. The traversal stops + -- when an outgoing edge leaves the main unit. + -- + -- * Depending on the elaboration model in effect, perform the following + -- actions: + -- + -- - Dynamic model - Diagnose guaranteed ABEs and install run-time + -- conditional ABE checks. + -- + -- - SPARK model - Enforce the SPARK elaboration rules + -- + -- - Static model - Diagnose conditional/guaranteed ABEs, install + -- run-time conditional ABE checks, and guarantee the elaboration + -- of external units. + -- + -- * Examine nested scenarios + -- + -- Nested scenarios discovered during the depth-first traversal are + -- in turn subjected to the same actions outlined above and examined + -- for the next level of nested scenarios. + + ------------------ + -- Architecture -- + ------------------ + + -- +------------------------ Recording phase ---------------------------+ + -- | | + -- | Record_Elaboration_Scenario | + -- | | | + -- | +--> Check_Preelaborated_Call | + -- | | | + -- | +--> Process_Guaranteed_ABE | + -- | | | + -- +------------------------- | --------------------------------------+ + -- | + -- | + -- v + -- Top_Level_Scenarios + -- +-----------+-----------+ .. +-----------+ + -- | Scenario1 | Scenario2 | .. | ScenarioN | + -- +-----------+-----------+ .. +-----------+ + -- | + -- | + -- +------------------------- | --------------------------------------+ + -- | | | + -- | Check_Elaboration_Scenarios | + -- | | | + -- | v | + -- | +----------- Process_Scenario <-----------+ | + -- | | | | + -- | +--> Process_Access Is_Suitable_Scenario | + -- | | ^ | + -- | +--> Process_Activation_Call --+ | | + -- | | +---> Traverse_Body | + -- | +--> Process_Call -------------+ | + -- | | | + -- | +--> Process_Instantiation | + -- | | | + -- | +--> Process_Variable_Assignment | + -- | | | + -- | +--> Process_Variable_Read | + -- | | + -- +------------------------- Processing phase -------------------------+ + + ---------------------- + -- Important points -- + ---------------------- + + -- The Processing phase starts after the analysis, resolution, expansion + -- phase has completed. As a result, no current semantic information is + -- available. The scope stack is empty, global flags such as In_Instance + -- or Inside_A_Generic become useless. To remedy this, the ABE mechanism + -- must either save or recompute semantic information. + + -- Expansion heavily transforms calls and to some extent instantiations. To + -- remedy this, the ABE mechanism generates N_Call_Marker nodes in order to + -- capture the target and relevant attributes of the original call. + + -- The diagnostics of the ABE mechanism depend on accurate source locations + -- to determine the spacial relation of nodes. + + -------------- + -- Switches -- + -------------- + + -- The following switches may be used to control the behavior of the ABE + -- mechanism. + -- + -- -gnatdE elaboration checks on predefined units + -- + -- The ABE mechanism considers scenarios which appear in internal + -- units (Ada, GNAT, Interfaces, System). + -- + -- -gnatd.G ignore calls through generic formal parameters for elaboration + -- + -- The ABE mechanism does not generate N_Call_Marker nodes for + -- calls which occur in expanded instances, and invoke generic + -- actual subprograms through generic formal subprograms. As a + -- result, the calls are not recorded or processed. + -- + -- If switches -gnatd.G and -gnatdL are used together, then the + -- ABE mechanism effectively ignores all calls which cause the + -- elaboration flow to "leave" the instance. + -- + -- -gnatdL ignore external calls from instances for elaboration + -- + -- The ABE mechanism does not generate N_Call_Marker nodes for + -- calls which occur in expanded instances, do not invoke generic + -- actual subprograms through formal subprograms, and the target + -- is external to the instance. As a result, the calls are not + -- recorded or processed. + -- + -- If switches -gnatd.G and -gnatdL are used together, then the + -- ABE mechanism effectively ignores all calls which cause the + -- elaboration flow to "leave" the instance. + -- + -- -gnatd.o conservative elaboration order for indirect calls + -- + -- The ABE mechanism treats '[Unrestricted_]Access of an entry, + -- operator, or subprogram as an immediate invocation of the + -- target. As a result, it performs ABE checks and diagnostics on + -- the immediate call. + -- + -- -gnatd.U ignore indirect calls for static elaboration + -- + -- The ABE mechanism does not consider '[Unrestricted_]Access of + -- entries, operators, and subprograms. As a result, the scenarios + -- are not recorder or processed. + -- + -- -gnatd.v enforce SPARK elaboration rules in SPARK code + -- + -- The ABE mechanism applies some of the SPARK elaboration rules + -- defined in the SPARK reference manual, chapter 7.7. Note that + -- certain rules are always enforced, regardless of whether the + -- switch is active. + -- + -- -gnatd.y disable implicit pragma Elaborate_All on task bodies + -- + -- The ABE mechanism does not generate implicit Elaborate_All when + -- the need for the pragma came from a task body. + -- + -- -gnatE dynamic elaboration checking mode enabled + -- + -- The ABE mechanism assumes that any scenario is elaborated or + -- invoked by elaboration code. The ABE mechanism performs very + -- little diagnostics and generates condintional ABE checks to + -- detect ABE issues at run-time. + -- + -- -gnatel turn on info messages on generated Elaborate[_All] pragmas + -- + -- The ABE mechanism produces information messages on generated + -- implicit Elabote[_All] pragmas along with traceback showing + -- why the pragma was generated. In addition, the ABE mechanism + -- produces information messages for each scenario elaborated or + -- invoked by elaboration code. + -- + -- -gnateL turn off info messages on generated Elaborate[_All] pragmas + -- + -- The complimentary switch for -gnatel. + -- + -- -gnatwl turn on warnings for elaboration problems + -- + -- The ABE mechanism produces warnings on detected ABEs along with + -- traceback showing the graph of the ABE. + -- + -- -gnatwL turn off warnings for elaboration problems + -- + -- The complimentary switch for -gnatwl. + -- + -- -gnatw.f turn on warnings for suspicious Subp'Access + -- + -- The ABE mechanism treats '[Unrestricted_]Access of an entry, + -- operator, or subprogram as a pseudo invocation of the target. + -- As a result, it performs ABE diagnostics on the pseudo call. + -- + -- -gnatw.F turn off warnings for suspicious Subp'Access + -- + -- The complimentary switch for -gnatw.f. + + --------------------------- + -- Adding a new scenario -- + --------------------------- + + -- The following steps describe how to add a new elaboration scenario and + -- preserve the existing architecture. + -- + -- 1) If necessary, update predicates Is_Check_Emitting_Scenario and + -- Is_Scenario. + -- + -- 2) Add predicate Is_Suitable_xxx. Include a call to it in predicate + -- Is_Suitable_Scenario. + -- + -- 3) Update routine Record_Elaboration_Scenario + -- + -- 4) Add routine Process_xxx. Include a call to it in Process_Scenario. + -- + -- 5) Add routine Info_xxx. Include a call to it in Process_xxx. + -- + -- 6) Add routine Output_xxx. Include a call to it in routine + -- Output_Active_Scenarios. + -- + -- 7) If necessary, add a new Extract_xxx_Attributes routine + -- + -- 8) If necessary, update routine Is_Potential_Scenario + + ------------------------- + -- Adding a new target -- + ------------------------- + + -- The following steps describe how to add a new elaboration target and + -- preserve the existing architecture. + -- + -- 1) Add predicate Is_xxx. + -- + -- 2) Update predicates Is_Ada_Semantic_Target, Is_Bridge_Target, or + -- Is_SPARK_Semantic_Target. If necessary, create a new category. + -- + -- 3) Update the appropriate Info_xxx routine. + -- + -- 4) Update the appropriate Output_xxx routine. + -- + -- 5) Update routine Extract_Target_Attributes. If necessary, create a + -- new Extract_xxx routine. + + -------------------------- + -- Debugging ABE issues -- + -------------------------- + + -- * If the issue involves a call, ensure that the call is eligible for ABE + -- processing and receives a corresponding call marker. The routines of + -- interest are + -- + -- Build_Call_Marker + -- Record_Elaboration_Scenario + + -- * If the issue involves an arbitrary scenario, ensure that the scenario + -- is either recorded, or is successfully recognized while traversing a + -- body. The routines of interest are + -- + -- Record_Elaboration_Scenario + -- Process_Scenario + -- Traverse_Body + + -- * If the issue involves a circularity in the elaboration order, examine + -- the ALI files and look for the following encodings next to units: + -- + -- E indicates a source Elaborate + -- + -- EA indicates a source Elaborate_All + -- + -- AD indicates an implicit Elaborate_All + -- + -- ED indicates an implicit Elaborate + -- + -- If possible, compare these encodings with those generated by the old + -- ABE mechanism. The routines of interest are + -- + -- Ensure_Prior_Elaboration + + ---------------- + -- Attributes -- + ---------------- + + -- The following type captures relevant attributes which pertain to a call + + type Call_Attributes is record + Elab_Checks_OK : Boolean; + -- This flag is set when the call has elaboration checks enabled + + From_Source : Boolean; + -- This flag is set when the call comes from source + + Ghost_Mode_Ignore : Boolean; + -- This flag is set when the call appears in a region subject to pragma + -- Ghost with policy Ignore. + + In_Declarations : Boolean; + -- This flag is set when the call appears at the declaration level + + Is_Dispatching : Boolean; + -- This flag is set when the call is dispatching + + SPARK_Mode_On : Boolean; + -- This flag is set when the call appears in a region subject to pragma + -- SPARK_Mode with value On. + end record; + + -- The following type captures relevant attributes which pertain to the + -- prior elaboration of a unit. This type is coupled together with a unit + -- to form a key -> value relationship. + + type Elaboration_Attributes is record + Source_Pragma : Node_Id; + -- This attribute denotes a source Elaborate or Elaborate_All pragma + -- which guarantees the prior elaboration of some unit with respect + -- to the main unit. The pragma may come from the following contexts: + + -- * The main unit + -- * The spec of the main unit (if applicable) + -- * Any parent spec of the main unit (if applicable) + -- * Any parent subunit of the main unit (if applicable) + + -- The attribute remains Empty if no such pragma is available. Source + -- pragmas play a role in satisfying SPARK elaboration requirements. + + With_Clause : Node_Id; + -- This attribute denotes an internally generated or source with clause + -- for some unit withed by the main unit. With clauses carry flags which + -- represent implicit Elaborate or Elaborate_All pragmas. These clauses + -- play a role in supplying the elaboration dependencies to binde. + end record; + + No_Elaboration_Attributes : constant Elaboration_Attributes := + (Source_Pragma => Empty, + With_Clause => Empty); + + -- The following type captures relevant attributes which pertain to an + -- instantiation. + + type Instantiation_Attributes is record + Elab_Checks_OK : Boolean; + -- This flag is set when the instantiation has elaboration checks + -- enabled. + + Ghost_Mode_Ignore : Boolean; + -- This flag is set when the instantiation appears in a region subject + -- to pragma Ghost with policy ignore, or starts one such region. + + In_Declarations : Boolean; + -- This flag is set when the instantiation appears at the declaration + -- level. + + SPARK_Mode_On : Boolean; + -- This flag is set when the instantiation appears in a region subject + -- to pragma SPARK_Mode with value On, or starts one such region. + end record; + + -- The following type captures relevant attributes which pertain to a + -- target. + + type Target_Attributes is record + Elab_Checks_OK : Boolean; + -- This flag is set when the target has elaboration checks enabled + + From_Source : Boolean; + -- This flag is set when the target comes from source + + Ghost_Mode_Ignore : Boolean; + -- This flag is set when the target appears in a region subject to + -- pragma Ghost with policy ignore, or starts one such region. + + SPARK_Mode_On : Boolean; + -- This flag is set when the target appears in a region subject to + -- pragma SPARK_Mode with value On, or starts one such region. + + Spec_Decl : Node_Id; + -- This attribute denotes the declaration of Spec_Id + + Unit_Id : Entity_Id; + -- This attribute denotes the top unit where Spec_Id resides + + -- The semantics of the following attributes depend on the target + + Body_Barf : Node_Id; + Body_Decl : Node_Id; + Spec_Id : Entity_Id; + + -- The target is a generic package or a subprogram + -- + -- * Body_Barf - Empty + -- + -- * Body_Decl - This attribute denotes the generic or subprogram + -- body. + -- + -- * Spec_Id - This attribute denotes the entity of the generic + -- package or subprogram. + + -- The target is a protected entry + -- + -- * Body_Barf - This attribute denotes the body of the barrier + -- function if expansion took place, otherwise it is Empty. + -- + -- * Body_Decl - This attribute denotes the body of the procedure + -- which emulates the entry if expansion took place, otherwise it + -- denotes the body of the protected entry. + -- + -- * Spec_Id - This attribute denotes the entity of the procedure + -- which emulates the entry if expansion took place, otherwise it + -- denotes the protected entry. + + -- The target is a protected subprogram + -- + -- * Body_Barf - Empty + -- + -- * Body_Decl - This attribute denotes the body of the protected or + -- unprotected version of the protected subprogram if expansion took + -- place, otherwise it denotes the body of the protected subprogram. + -- + -- * Spec_Id - This attribute denotes the entity of the protected or + -- unprotected version of the protected subprogram if expansion took + -- place, otherwise it is the entity of the protected subprogram. + + -- The target is a task entry + -- + -- * Body_Barf - Empty + -- + -- * Body_Decl - This attribute denotes the body of the procedure + -- which emulates the task body if expansion took place, otherwise + -- it denotes the body of the task type. + -- + -- * Spec_Id - This attribute denotes the entity of the procedure + -- which emulates the task body if expansion took place, otherwise + -- it denotes the entity of the task type. + end record; + + -- The following type captures relevant attributes which pertain to a task + -- type. + + type Task_Attributes is record + Body_Decl : Node_Id; + -- This attribute denotes the declaration of the procedure body which + -- emulates the behaviour of the task body. + + Elab_Checks_OK : Boolean; + -- This flag is set when the task type has elaboration checks enabled + + Ghost_Mode_Ignore : Boolean; + -- This flag is set when the task type appears in a region subject to + -- pragma Ghost with policy ignore, or starts one such region. + + SPARK_Mode_On : Boolean; + -- This flag is set when the task type appears in a region subject to + -- pragma SPARK_Mode with value On, or starts one such region. + + Spec_Id : Entity_Id; + -- This attribute denotes the entity of the initial declaration of the + -- procedure body which emulates the behaviour of the task body. + + Task_Decl : Node_Id; + -- This attribute denotes the declaration of the task type + + Unit_Id : Entity_Id; + -- This attribute denotes the entity of the compilation unit where the + -- task type resides. + end record; + + -- The following type captures relevant attributes which pertain to a + -- variable. - type Elab_Call_Element is record - Cloc : Source_Ptr; - Ent : Entity_Id; + type Variable_Attributes is record + SPARK_Mode_On : Boolean; + -- This flag is set when the variable appears in a region subject to + -- pragma SPARK_Mode with value On, or starts one such region. + + Unit_Id : Entity_Id; + -- This attribute denotes the entity of the compilation unit where the + -- variable resides. end record; - package Elab_Call is new Table.Table - (Table_Component_Type => Elab_Call_Element, + --------------------- + -- Data structures -- + --------------------- + + -- The following table stores the elaboration status of all units withed by + -- the main unit. + + Elaboration_Context_Max : constant := 1009; + + type Elaboration_Context_Index is range 0 .. Elaboration_Context_Max - 1; + + function Elaboration_Context_Hash + (Key : Entity_Id) return Elaboration_Context_Index; + -- Obtain the hash value of entity Key + + package Elaboration_Context is new Simple_HTable + (Header_Num => Elaboration_Context_Index, + Element => Elaboration_Attributes, + No_Element => No_Elaboration_Attributes, + Key => Entity_Id, + Hash => Elaboration_Context_Hash, + Equal => "="); + + -- The following table stores all active scenarios in a recursive traversal + -- starting from a top level scenario. This table must be maintained in a + -- FIFO fashion. + + package Scenario_Stack is new Table.Table + (Table_Component_Type => Node_Id, Table_Index_Type => Int, Table_Low_Bound => 1, Table_Initial => 50, Table_Increment => 100, - Table_Name => "Elab_Call"); + Table_Name => "Scenario_Stack"); + + -- The following table stores all top level scenario saved during the + -- Recording phase. The contents of this table act as traversal roots + -- later in the Processing phase. This table must be maintained in a + -- LIFO fashion. + + package Top_Level_Scenarios is new Table.Table + (Table_Component_Type => Node_Id, + Table_Index_Type => Int, + Table_Low_Bound => 1, + Table_Initial => 1000, + Table_Increment => 100, + Table_Name => "Top_Level_Scenarios"); - -- The following table records all calls that have been processed starting - -- from an outer level call. The table prevents both infinite recursion and - -- useless reanalysis of calls within the same context. The use of context - -- is important because it allows for proper checks in more complex code: + -- The following table stores the bodies of all eligible scenarios visited + -- during a traversal starting from a top level scenario. The contents of + -- this table must be reset upon each new traversal. - -- if ... then - -- Call; -- requires a check - -- Call; -- does not need a check thanks to the table - -- elsif ... then - -- Call; -- requires a check, different context - -- end if; + Visited_Bodies_Max : constant := 511; - -- Call; -- requires a check, different context + type Visited_Bodies_Index is range 0 .. Visited_Bodies_Max - 1; - type Visited_Element is record - Subp_Id : Entity_Id; - -- The entity of the subprogram being called + function Visited_Bodies_Hash (Key : Node_Id) return Visited_Bodies_Index; + -- Obtain the hash value of node Key + + package Visited_Bodies is new Simple_HTable + (Header_Num => Visited_Bodies_Index, + Element => Boolean, + No_Element => False, + Key => Node_Id, + Hash => Visited_Bodies_Hash, + Equal => "="); + + ----------------------- + -- Local subprograms -- + ----------------------- + + procedure Check_Preelaborated_Call (Call : Node_Id); + -- Determine whether entry, operator, or subprogram call Call appears at + -- the library level of a preelaborated unit. Emit an error if this is the + -- case. + + function Compilation_Unit (Unit_Id : Entity_Id) return Node_Id; + pragma Inline (Compilation_Unit); + -- Return the N_Compilation_Unit node of unit Unit_Id + + procedure Elab_Msg_NE + (Msg : String; + N : Node_Id; + Id : Entity_Id; + Info_Msg : Boolean; + In_SPARK : Boolean); + pragma Inline (Elab_Msg_NE); + -- Wrapper around Error_Msg_NE. Emit message Msg concerning arbitrary node + -- N and entity. If flag Info_Msg is set, the routine emits an information + -- message, otherwise it emits an error. If flag In_SPARK is set, then + -- string " in SPARK" is added to the end of the message. + + procedure Ensure_Prior_Elaboration + (N : Node_Id; + Unit_Id : Entity_Id; + In_Task_Body : Boolean); + -- Guarantee the elaboration of unit Unit_Id with respect to the main unit. + -- N denotes the related scenario. Flag In_Task_Body should be set when the + -- need for elaboration is initiated from a task body. + + procedure Ensure_Prior_Elaboration_Dynamic + (N : Node_Id; + Unit_Id : Entity_Id; + Prag_Nam : Name_Id); + -- Guarantee the elaboration of unit Unit_Id with respect to the main unit + -- by suggesting the use of Elaborate[_All] with name Prag_Nam. N denotes + -- the related scenario. + + procedure Ensure_Prior_Elaboration_Static + (N : Node_Id; + Unit_Id : Entity_Id; + Prag_Nam : Name_Id); + -- Guarantee the elaboration of unit Unit_Id with respect to the main unit + -- by installing an implicit Elaborate[_All] pragma with name Prag_Nam. N + -- denotes the related scenario. + + function Extract_Assignment_Name (Asmt : Node_Id) return Node_Id; + pragma Inline (Extract_Assignment_Name); + -- Obtain the Name attribute of assignment statement Asmt + + procedure Extract_Call_Attributes + (Call : Node_Id; + Target_Id : out Entity_Id; + Attrs : out Call_Attributes); + pragma Inline (Extract_Call_Attributes); + -- Obtain attributes Attrs associated with call Call. Target_Id is the + -- entity of the call target. + + function Extract_Call_Name (Call : Node_Id) return Node_Id; + pragma Inline (Extract_Call_Name); + -- Obtain the Name attribute of entry or subprogram call Call + + procedure Extract_Instance_Attributes + (Exp_Inst : Node_Id; + Inst_Body : out Node_Id; + Inst_Decl : out Node_Id); + pragma Inline (Extract_Instance_Attributes); + -- Obtain body Inst_Body and spec Inst_Decl of expanded instance Exp_Inst + + procedure Extract_Instantiation_Attributes + (Exp_Inst : Node_Id; + Inst : out Node_Id; + Inst_Id : out Entity_Id; + Gen_Id : out Entity_Id; + Attrs : out Instantiation_Attributes); + pragma Inline (Extract_Instantiation_Attributes); + -- Obtain attributes Attrs associated with expanded instantiation Exp_Inst. + -- Inst is the instantiation. Inst_Id is the entity of the instance. Gen_Id + -- is the entity of the generic unit being instantiated. + + procedure Extract_Target_Attributes + (Target_Id : Entity_Id; + Attrs : out Target_Attributes); + -- Obtain attributes Attrs associated with an entry, package, or subprogram + -- denoted by Target_Id. + + procedure Extract_Task_Attributes + (Typ : Entity_Id; + Attrs : out Task_Attributes); + pragma Inline (Extract_Task_Attributes); + -- Obtain attributes Attrs associated with task type Typ + + procedure Extract_Variable_Reference_Attributes + (Ref : Node_Id; + Var_Id : out Entity_Id; + Attrs : out Variable_Attributes); + pragma Inline (Extract_Variable_Reference_Attributes); + -- Obtain attributes Attrs associated with reference Ref that mentions + -- variable Var_Id. + + function Find_Code_Unit (N : Node_Or_Entity_Id) return Entity_Id; + pragma Inline (Find_Code_Unit); + -- Return the code unit which contains arbitrary node or entity N. This + -- is the unit of the file which physically contains the related construct + -- denoted by N except when N is within an instantiation. In that case the + -- unit is that of the top level instantiation. + + procedure Find_Elaborated_Units; + -- Populate table Elaboration_Context with all units which have prior + -- elaboration with respect to the main unit. + + function Find_Enclosing_Instance (N : Node_Id) return Node_Id; + pragma Inline (Find_Enclosing_Instance); + -- Find the declaration or body of the nearest expanded instance which + -- encloses arbitrary node N. Return Empty if no such instance exists. + + function Find_Top_Unit (N : Node_Or_Entity_Id) return Entity_Id; + pragma Inline (Find_Top_Unit); + -- Return the top unit which contains arbitrary node or entity N. The unit + -- is obtained by logically unwinding instantiations and subunits when N + -- resides within one. + + function Find_Unit_Entity (N : Node_Id) return Entity_Id; + pragma Inline (Find_Unit_Entity); + -- Return the entity of unit N + + function First_Formal_Type (Subp_Id : Entity_Id) return Entity_Id; + pragma Inline (First_Formal_Type); + -- Return the type of subprogram Subp_Id's first formal parameter. If the + -- subprogram lacks formal parameters, return Empty. + + function Has_Body (Pack_Decl : Node_Id) return Boolean; + -- Determine whether package declaration Pack_Decl has a corresponding body + -- or would eventually have one. + + function Has_Prior_Elaboration + (Unit_Id : Entity_Id; + Context_OK : Boolean := False; + Elab_Body_OK : Boolean := False; + Same_Unit_OK : Boolean := False) return Boolean; + pragma Inline (Has_Prior_Elaboration); + -- Determine whether unit Unit_Id is elaborated prior to the main unit. + -- If flag Context_OK is set, the routine considers the following case + -- as valid prior elaboration: + -- + -- * Unit_Id is in the elaboration context of the main unit + -- + -- If flag Elab_Body_OK is set, the routine considers the following case + -- as valid prior elaboration: + -- + -- * Unit_Id has pragma Elaborate_Body and is not the main unit + -- + -- If flag Same_Unit_OK is set, the routine considers the following cases + -- as valid prior elaboration: + -- + -- * Unit_Id is the main unit + -- + -- * Unit_Id denotes the spec of the main unit body + + function In_External_Instance + (N : Node_Id; + Target_Decl : Node_Id) return Boolean; + pragma Inline (In_External_Instance); + -- Determine whether a target desctibed by its declaration Target_Decl + -- resides in a package instance which is external to scenario N. + + function In_Main_Context (N : Node_Id) return Boolean; + pragma Inline (In_Main_Context); + -- Determine whether arbitrary node N appears within the main compilation + -- unit. + + function In_Same_Context + (N1 : Node_Id; + N2 : Node_Id; + Nested_OK : Boolean := False) return Boolean; + -- Determine whether two arbitrary nodes N1 and N2 appear within the same + -- context ignoring enclosing library levels. Nested_OK should be set when + -- the context of N1 can enclose that of N2. + + procedure Info_Call + (Call : Node_Id; + Target_Id : Entity_Id; + Info_Msg : Boolean; + In_SPARK : Boolean); + -- Output information concerning call Call which invokes target Target_Id. + -- If flag Info_Msg is set, the routine emits an information message, + -- otherwise it emits an error. If flag In_SPARK is set, then the string + -- " in SPARK" is added to the end of the message. + + procedure Info_Instantiation + (Inst : Node_Id; + Gen_Id : Entity_Id; + Info_Msg : Boolean; + In_SPARK : Boolean); + pragma Inline (Info_Instantiation); + -- Output information concerning instantiation Inst which instantiates + -- generic unit Gen_Id. If flag Info_Msg is set, the routine emits an + -- information message, otherwise it emits an error. If flag In_SPARK + -- is set, then string " in SPARK" is added to the end of the message. + + procedure Info_Variable_Read + (Ref : Node_Id; + Var_Id : Entity_Id; + Info_Msg : Boolean; + In_SPARK : Boolean); + pragma Inline (Info_Variable_Read); + -- Output information concerning reference Ref which reads variable Var_Id. + -- If flag Info_Msg is set, the routine emits an information message, + -- otherwise it emits an error. If flag In_SPARK is set, then string " in + -- SPARK" is added to the end of the message. + + function Insertion_Node (N : Node_Id; Ins_Nod : Node_Id) return Node_Id; + pragma Inline (Insertion_Node); + -- Obtain the proper insertion node of an ABE check or failure for scenario + -- N and candidate insertion node Ins_Nod. + + procedure Install_ABE_Check + (N : Node_Id; + Id : Entity_Id; + Ins_Nod : Node_Id); + -- Insert a run-time ABE check for elaboration scenario N which verifies + -- whether arbitrary entity Id is elaborated. The check in inserted prior + -- to node Ins_Nod. + + procedure Install_ABE_Check + (N : Node_Id; + Target_Id : Entity_Id; + Target_Decl : Node_Id; + Target_Body : Node_Id; + Ins_Nod : Node_Id); + -- Insert a run-time ABE check for elaboration scenario N which verifies + -- whether target Target_Id with initial declaration Target_Decl and body + -- Target_Body is elaborated. The check is inserted prior to node Ins_Nod. + + procedure Install_ABE_Failure (N : Node_Id; Ins_Nod : Node_Id); + -- Insert a Program_Error concerning a guaranteed ABE for elaboration + -- scenario N. The failure is inserted prior to node Node_Id. + + function Is_Accept_Alternative_Proc (Id : Entity_Id) return Boolean; + pragma Inline (Is_Accept_Alternative_Proc); + -- Determine whether arbitrary entity Id denotes an internally generated + -- procedure which encapsulates the statements of an accept alternative. + + function Is_Activation_Proc (Id : Entity_Id) return Boolean; + pragma Inline (Is_Activation_Proc); + -- Determine whether arbitrary entity Id denotes a runtime procedure in + -- charge with activating tasks. + + function Is_Ada_Semantic_Target (Id : Entity_Id) return Boolean; + pragma Inline (Is_Ada_Semantic_Target); + -- Determine whether arbitrary entity Id nodes a source or internally + -- generated subprogram which emulates Ada semantics. + + function Is_Bodiless_Subprogram (Subp_Id : Entity_Id) return Boolean; + pragma Inline (Is_Bodiless_Subprogram); + -- Determine whether subprogram Subp_Id will never have a body + + function Is_Check_Emitting_Scenario (N : Node_Id) return Boolean; + pragma Inline (Is_Check_Emitting_Scenario); + -- Determine whether arbitrary node N denotes a scenario which may emit a + -- conditional ABE check. + + function Is_Controlled_Proc + (Subp_Id : Entity_Id; + Subp_Nam : Name_Id) return Boolean; + pragma Inline (Is_Controlled_Proc); + -- Determine whether subprogram Subp_Id denotes controlled type primitives + -- Adjust, Finalize, or Initialize as denoted by name Subp_Nam. + + function Is_Default_Initial_Condition_Proc (Id : Entity_Id) return Boolean; + pragma Inline (Is_Default_Initial_Condition_Proc); + -- Determine whether arbitrary entity Id denotes internally generated + -- routine Default_Initial_Condition. + + function Is_Finalizer_Proc (Id : Entity_Id) return Boolean; + pragma Inline (Is_Finalizer_Proc); + -- Determine whether arbitrary entity Id denotes internally generated + -- routine _Finalizer. + + function Is_Guaranteed_ABE + (N : Node_Id; + Target_Decl : Node_Id; + Target_Body : Node_Id) return Boolean; + pragma Inline (Is_Guaranteed_ABE); + -- Determine whether scenario N with a target described by its initial + -- declaration Target_Decl and body Target_Decl results in a guaranteed + -- ABE. + + function Is_Initial_Condition_Proc (Id : Entity_Id) return Boolean; + pragma Inline (Is_Initial_Condition_Proc); + -- Determine whether arbitrary entity Id denotes internally generated + -- routine Initial_Condition. + + function Is_Initialized (Obj_Decl : Node_Id) return Boolean; + pragma Inline (Is_Initialized); + -- Determine whether object declaration Obj_Decl is initialized + + function Is_Invariant_Proc (Id : Entity_Id) return Boolean; + pragma Inline (Is_Invariant_Proc); + -- Determine whether arbitrary entity Id denotes an invariant procedure + + function Is_Non_Library_Level_Encapsulator (N : Node_Id) return Boolean; + pragma Inline (Is_Non_Library_Level_Encapsulator); + -- Determine whether arbitrary node N is a non-library encapsulator + + function Is_Partial_Invariant_Proc (Id : Entity_Id) return Boolean; + pragma Inline (Is_Partial_Invariant_Proc); + -- Determine whether arbitrary entity Id denotes a partial invariant + -- procedure. + + function Is_Postconditions_Proc (Id : Entity_Id) return Boolean; + pragma Inline (Is_Postconditions_Proc); + -- Determine whether arbitrary entity Id denotes internally generated + -- routine _Postconditions. + + function Is_Preelaborated_Unit (Id : Entity_Id) return Boolean; + pragma Inline (Is_Preelaborated_Unit); + -- Determine whether arbitrary entity Id denotes a unit which is subject to + -- one of the following pragmas: + -- + -- * Preelaborable + -- * Pure + -- * Remote_Call_Interface + -- * Remote_Types + -- * Shared_Passive + + function Is_Protected_Entry (Id : Entity_Id) return Boolean; + pragma Inline (Is_Protected_Entry); + -- Determine whether arbitrary entity Id denotes a protected entry + + function Is_Protected_Subp (Id : Entity_Id) return Boolean; + pragma Inline (Is_Protected_Subp); + -- Determine whether entity Id denotes a protected subprogram + + function Is_Protected_Body_Subp (Id : Entity_Id) return Boolean; + pragma Inline (Is_Protected_Body_Subp); + -- Determine whether entity Id denotes the protected or unprotected version + -- of a protected subprogram. + + function Is_Safe_Activation + (Call : Node_Id; + Task_Decl : Node_Id) return Boolean; + pragma Inline (Is_Safe_Activation); + -- Determine whether call Call which activates a task object described by + -- declaration Task_Decl is always ABE-safe. + + function Is_Safe_Call + (Call : Node_Id; + Target_Attrs : Target_Attributes) return Boolean; + pragma Inline (Is_Safe_Call); + -- Determine whether call Call which invokes a target described by + -- attributes Target_Attrs is always ABE-safe. + + function Is_Safe_Instantiation + (Inst : Node_Id; + Gen_Attrs : Target_Attributes) return Boolean; + pragma Inline (Is_Safe_Instantiation); + -- Determine whether instance Inst which instantiates a generic unit + -- described by attributes Gen_Attrs is always ABE-safe. + + function Is_Same_Unit + (Unit_1 : Entity_Id; + Unit_2 : Entity_Id) return Boolean; + pragma Inline (Is_Same_Unit); + -- Determine whether entities Unit_1 and Unit_2 denote the same unit + + function Is_Scenario (N : Node_Id) return Boolean; + pragma Inline (Is_Scenario); + -- Determine whether attribute node N denotes a scenario. The scenario may + -- not necessarily be eligible for ABE processing. + + function Is_SPARK_Semantic_Target (Id : Entity_Id) return Boolean; + pragma Inline (Is_SPARK_Semantic_Target); + -- Determine whether arbitrary entity Id nodes a source or internally + -- generated subprogram which emulates SPARK semantics. + + function Is_Suitable_Access (N : Node_Id) return Boolean; + pragma Inline (Is_Suitable_Access); + -- Determine whether arbitrary node N denotes a suitable attribute for ABE + -- processing. + + function Is_Suitable_Call (N : Node_Id) return Boolean; + pragma Inline (Is_Suitable_Call); + -- Determine whether arbitrary node N denotes a suitable call for ABE + -- processing. + + function Is_Suitable_Instantiation (N : Node_Id) return Boolean; + pragma Inline (Is_Suitable_Instantiation); + -- Determine whether arbitrary node N is a suitable instantiation for ABE + -- processing. + + function Is_Suitable_Scenario (N : Node_Id) return Boolean; + pragma Inline (Is_Suitable_Scenario); + -- Determine whether arbitrary node N is a suitable scenario for ABE + -- processing. + + function Is_Suitable_Variable_Assignment (N : Node_Id) return Boolean; + pragma Inline (Is_Suitable_Variable_Assignment); + -- Determine whether arbitrary node N denotes a suitable assignment for ABE + -- processing. + + function Is_Suitable_Variable_Read (N : Node_Id) return Boolean; + pragma Inline (Is_Suitable_Variable_Read); + -- Determine whether arbitrary node N is a suitable variable read for ABE + -- processing. + + function Is_Task_Entry (Id : Entity_Id) return Boolean; + pragma Inline (Is_Task_Entry); + -- Determine whether arbitrary entity Id denotes a task entry + + function Is_Up_Level_Target (Target_Decl : Node_Id) return Boolean; + pragma Inline (Is_Up_Level_Target); + -- Determine whether the current root resides at the declaration level. If + -- this is the case, determine whether a target described by declaration + -- Target_Decl is within a context which encloses the current root or is in + -- a different unit. + + procedure Meet_Elaboration_Requirement + (N : Node_Id; + Target_Id : Entity_Id; + Req_Nam : Name_Id); + -- Determine whether elaboration requirement Req_Nam for scenario N with + -- target Target_Id is met by the context of the main unit using the SPARK + -- rules. Req_Nam must denote either Elaborate or Elaborate_All. Emit an + -- error if this is not the case. + + function Non_Private_View (Typ : Entity_Id) return Entity_Id; + pragma Inline (Non_Private_View); + -- Return the full view of private type Typ if available, otherwise return + -- type Typ. + + procedure Output_Active_Scenarios (Error_Nod : Node_Id); + -- Output the contents of the active scenario stack from earliest to latest + -- to supplement an earlier error emitted for node Error_Nod. + + procedure Pop_Active_Scenario (N : Node_Id); + pragma Inline (Pop_Active_Scenario); + -- Pop the top of the scenario stack. A check is made to ensure that the + -- scenario being removed is the same as N. + + procedure Process_Access (Attr : Node_Id; In_Task_Body : Boolean); + -- Perform ABE checks and diagnostics for 'Access to entry, operator, or + -- subprogram denoted by Attr. Flag In_Task_Body should be set when the + -- processing is initiated from a task body. + + generic + with procedure Process_Single_Activation + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Obj_Id : Entity_Id; + Task_Attrs : Task_Attributes; + In_Task_Body : Boolean); + -- Perform ABE checks and diagnostics for task activation call Call + -- which activates task Obj_Id. Call_Attrs are the attributes of the + -- activation call. Task_Attrs are the attributes of the task type. + -- Flag In_Task_Body should be set when the processing is initiated + -- from a task body. + + procedure Process_Activation_Call + (Call : Node_Id; + Call_Attrs : Call_Attributes; + In_Task_Body : Boolean); + -- Perform ABE checks and diagnostics for activation call Call by invoking + -- routine Process_Single_Activation on each task object being activated. + -- Call_Attrs are the attributes of the activation call. Flag In_Task_Body + -- should be set when the processing is initiated from a task body. + + procedure Process_Activation_Conditional_ABE_Impl + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Obj_Id : Entity_Id; + Task_Attrs : Task_Attributes; + In_Task_Body : Boolean); + -- Perform common conditional ABE checks and diagnostics for call Call + -- which activates task Obj_Id ignoring the Ada or SPARK rules. CAll_Attrs + -- are the attributes of the activation call. Task_Attrs are the attributes + -- of the task type. Flag In_Task_Body should be set when the processing is + -- initiated from a task body. + + procedure Process_Activation_Guaranteed_ABE_Impl + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Obj_Id : Entity_Id; + Task_Attrs : Task_Attributes; + In_Task_Body : Boolean); + -- Perform common guaranteed ABE checks and diagnostics for call Call + -- which activates task Obj_Id ignoring the Ada or SPARK rules. CAll_Attrs + -- are the attributes of the activation call. Task_Attrs are the attributes + -- of the task type. Flag In_Task_Body should be set when the processing is + -- initiated from a task body. + + procedure Process_Call + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + In_Task_Body : Boolean); + -- Top-level dispatcher for processing of calls. Perform ABE checks and + -- diagnostics for call Call which invokes target Target_Id. Call_Attrs + -- are the attributes of the call. Flag In_Task_Body should be set when + -- the processing is initiated from a task body. + + procedure Process_Call_Ada + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + Target_Attrs : Target_Attributes; + In_Task_Body : Boolean); + -- Perform ABE checks and diagnostics for call Call which invokes target + -- Target_Id using the Ada rules. Call_Attrs are the attributes of the + -- call. Target_Attrs are attributes of the target. Flag In_Task_Body + -- should be set when the processing is initiated from a task body. + + procedure Process_Call_Conditional_ABE + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + Target_Attrs : Target_Attributes); + -- Perform common conditional ABE checks and diagnostics for call Call that + -- invokes target Target_Id ignoring the Ada or SPARK rules. Call_Attrs are + -- the attributes of the call. Target_Attrs are attributes of the target. + + procedure Process_Call_Guaranteed_ABE + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id); + -- Perform common guaranteed ABE checks and diagnostics for call Call which + -- invokes target Target_Id ignoring the Ada or SPARK rules. Call_Attrs are + -- the attributes of the call. + + procedure Process_Call_SPARK + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + Target_Attrs : Target_Attributes); + -- Perform ABE checks and diagnostics for call Call which invokes target + -- Target_Id using the SPARK rules. Call_Attrs are the attributes of the + -- call. Target_Attrs are attributes of the target. + + procedure Process_Guaranteed_ABE (N : Node_Id); + -- Top level dispatcher for processing of scenarios which result in a + -- guaranteed ABE. + + procedure Process_Instantiation + (Exp_Inst : Node_Id; + In_Task_Body : Boolean); + -- Top level dispatcher for processing of instantiations. Perform ABE + -- checks and diagnostics for expanded instantiation Exp_Inst. Flag + -- In_Task_Body should be set when the processing is initiated from a + -- task body. + + procedure Process_Instantiation_Ada + (Exp_Inst : Node_Id; + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Gen_Id : Entity_Id; + Gen_Attrs : Target_Attributes; + In_Task_Body : Boolean); + -- Perform ABE checks and diagnostics for expanded instantiation Exp_Inst + -- of generic Gen_Id using the Ada rules. Inst is the instantiation node. + -- Inst_Attrs are the attributes of the instance. Gen_Attrs are the + -- attributes of the generic. Flag In_Task_Body should be set when the + -- processing is initiated from a task body. + + procedure Process_Instantiation_Conditional_ABE + (Exp_Inst : Node_Id; + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Gen_Id : Entity_Id; + Gen_Attrs : Target_Attributes); + -- Perform common conditional ABE checks and diagnostics for expanded + -- instantiation Exp_Inst of generic Gen_Id ignoring the Ada or SPARK + -- rules. Inst is the instantiation node. Inst_Attrs are the attributes + -- of the instance. Gen_Attrs are the attributes of the generic. + + procedure Process_Instantiation_Guaranteed_ABE (Exp_Inst : Node_Id); + -- Perform common guaranteed ABE checks and diagnostics for expanded + -- instantiation Exp_Inst of generic Gen_Id ignoring the Ada or SPARK + -- rules. + + procedure Process_Instantiation_SPARK + (Exp_Inst : Node_Id; + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Gen_Id : Entity_Id; + Gen_Attrs : Target_Attributes); + -- Perform ABE checks and diagnostics for expanded instantiation Exp_Inst + -- of generic Gen_Id using the SPARK rules. Inst is the instantiation node. + -- Inst_Attrs are the attributes of the instance. Gen_Attrs are the + -- attributes of the generic. + + procedure Process_Scenario (N : Node_Id; In_Task_Body : Boolean := False); + -- Top level dispatcher for processing of various elaboration scenarios. + -- Perform ABE checks and diagnostics for scenario N. Flag In_Task_Body + -- should be set when the processing is initiated from a task body. + + procedure Process_Variable_Assignment (Asmt : Node_Id); + -- Top level dispatcher for processing of variable assignments. Perform ABE + -- checks and diagnostics for assignment statement Asmt. + + procedure Process_Variable_Assignment_Ada + (Asmt : Node_Id; + Var_Id : Entity_Id); + -- Perform ABE checks and diagnostics for assignment statement Asmt that + -- updates the value of variable Var_Id using the Ada rules. + + procedure Process_Variable_Assignment_SPARK + (Asmt : Node_Id; + Var_Id : Entity_Id); + -- Perform ABE checks and diagnostics for assignment statement Asmt that + -- updates the value of variable Var_Id using the SPARK rules. + + procedure Process_Variable_Read (Ref : Node_Id); + -- Perform ABE checks and diagnostics for reference Ref that reads a + -- variable. + + procedure Push_Active_Scenario (N : Node_Id); + pragma Inline (Push_Active_Scenario); + -- Push scenario N on top of the scenario stack + + function Root_Scenario return Node_Id; + pragma Inline (Root_Scenario); + -- Return the top level scenario which started a recursive search for other + -- scenarios. It is assumed that there is a valid top level scenario on the + -- active scenario stack. + + function Static_Elaboration_Checks return Boolean; + pragma Inline (Static_Elaboration_Checks); + -- Determine whether the static model is in effect + + procedure Traverse_Body (N : Node_Id; In_Task_Body : Boolean); + -- Inspect the declarations and statements of subprogram body N for + -- suitable elaboration scenarios and process them. Flag In_Task_Body + -- should be set when the traversal is initiated from a task body. + + procedure Update_Elaboration_Scenario (New_N : Node_Id; Old_N : Node_Id); + pragma Inline (Update_Elaboration_Scenario); + -- Update all relevant internal data structures when scenario Old_N is + -- transformed into scenario New_N by Atree.Rewrite. + + ----------------------- + -- Build_Call_Marker -- + ----------------------- + + procedure Build_Call_Marker (N : Node_Id) is + function In_External_Context + (Call : Node_Id; + Target_Id : Entity_Id) return Boolean; + pragma Inline (In_External_Context); + -- Determine whether target Target_Id is external to call N which must + -- reside within an instance. + + function In_Premature_Context (Call : Node_Id) return Boolean; + -- Determine whether call Call appears within a premature context + + function Is_Bridge_Target (Id : Entity_Id) return Boolean; + pragma Inline (Is_Bridge_Target); + -- Determine whether arbitrary entity Id denotes a bridge target + + function Is_Default_Expression (Call : Node_Id) return Boolean; + pragma Inline (Is_Default_Expression); + -- Determine whether call Call acts as the expression of a defaulted + -- parameter within a source call. + + function Is_Generic_Formal_Subp (Subp_Id : Entity_Id) return Boolean; + pragma Inline (Is_Generic_Formal_Subp); + -- Determine whether subprogram Subp_Id denotes a generic formal + -- subprogram which appears in the "prologue" of an instantiation. + + ------------------------- + -- In_External_Context -- + ------------------------- + + function In_External_Context + (Call : Node_Id; + Target_Id : Entity_Id) return Boolean + is + Target_Decl : constant Node_Id := Unit_Declaration_Node (Target_Id); + + Inst : Node_Id; + Inst_Body : Node_Id; + Inst_Decl : Node_Id; + + begin + -- Performance note: parent traversal + + Inst := Find_Enclosing_Instance (Call); + + -- The call appears within an instance + + if Present (Inst) then + + -- The call comes from the main unit and the target does not + + if In_Extended_Main_Code_Unit (Call) + and then not In_Extended_Main_Code_Unit (Target_Decl) + then + return True; + + -- Otherwise the target declaration must not appear within the + -- instance spec or body. + + else + Extract_Instance_Attributes + (Exp_Inst => Inst, + Inst_Decl => Inst_Decl, + Inst_Body => Inst_Body); + + -- Performance note: parent traversal + + return not In_Subtree + (N => Target_Decl, + Root1 => Inst_Decl, + Root2 => Inst_Body); + end if; + end if; + + return False; + end In_External_Context; + + -------------------------- + -- In_Premature_Context -- + -------------------------- + + function In_Premature_Context (Call : Node_Id) return Boolean is + Par : Node_Id; + + begin + -- Climb the parent chain looking for premature contexts + + Par := Parent (Call); + while Present (Par) loop + + -- Aspect specifications and generic associations are premature + -- contexts because nested calls has not been relocated to their + -- final context. + + if Nkind_In (Par, N_Aspect_Specification, + N_Generic_Association) + then + return True; + + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (Par) then + exit; + end if; + + Par := Parent (Par); + end loop; + + return False; + end In_Premature_Context; + + ---------------------- + -- Is_Bridge_Target -- + ---------------------- + + function Is_Bridge_Target (Id : Entity_Id) return Boolean is + begin + return + Is_Accept_Alternative_Proc (Id) + or else Is_Finalizer_Proc (Id) + or else Is_Partial_Invariant_Proc (Id) + or else Is_Postconditions_Proc (Id) + or else Is_TSS (Id, TSS_Deep_Adjust) + or else Is_TSS (Id, TSS_Deep_Finalize) + or else Is_TSS (Id, TSS_Deep_Initialize); + end Is_Bridge_Target; + + --------------------------- + -- Is_Default_Expression -- + --------------------------- + + function Is_Default_Expression (Call : Node_Id) return Boolean is + Outer_Call : constant Node_Id := Parent (Call); + Outer_Nam : Node_Id; + + begin + -- To qualify, the node must appear immediately within a source call + -- which invokes a source target. + + if Nkind_In (Outer_Call, N_Entry_Call_Statement, + N_Function_Call, + N_Procedure_Call_Statement) + and then Comes_From_Source (Outer_Call) + then + Outer_Nam := Extract_Call_Name (Outer_Call); + + return + Is_Entity_Name (Outer_Nam) + and then Present (Entity (Outer_Nam)) + and then Is_Subprogram_Or_Entry (Entity (Outer_Nam)) + and then Comes_From_Source (Entity (Outer_Nam)); + end if; + + return False; + end Is_Default_Expression; + + ---------------------------- + -- Is_Generic_Formal_Subp -- + ---------------------------- + + function Is_Generic_Formal_Subp (Subp_Id : Entity_Id) return Boolean is + Subp_Decl : constant Node_Id := Unit_Declaration_Node (Subp_Id); + Context : constant Node_Id := Parent (Subp_Decl); + + begin + -- To qualify, the subprogram must rename a generic actual subprogram + -- where the enclosing context is an instantiation. + + return + Nkind (Subp_Decl) = N_Subprogram_Renaming_Declaration + and then not Comes_From_Source (Subp_Decl) + and then Nkind_In (Context, N_Function_Specification, + N_Package_Specification, + N_Procedure_Specification) + and then Present (Generic_Parent (Context)); + end Is_Generic_Formal_Subp; + + -- Local variables + + Call_Attrs : Call_Attributes; + Call_Nam : Node_Id; + Marker : Node_Id; + Target_Id : Entity_Id; + + -- Start of processing for Build_Call_Marker + + begin + -- Nothing to do for ASIS. As a result, ABE checks and diagnostics are + -- not performed in this mode. + + if ASIS_Mode then + return; + + -- Nothing to do when the input does not denote a call or a requeue + + elsif not Nkind_In (N, N_Entry_Call_Statement, + N_Function_Call, + N_Procedure_Call_Statement, + N_Requeue_Statement) + then + return; + + -- Nothing to do when the call is being preanalyzed as the marker will + -- be inserted in the wrong place. + + elsif Preanalysis_Active then + return; + + -- Nothing to do when the call is analyzed/resolved too early within an + -- intermediate context. + + -- Performance note: parent traversal + + elsif In_Premature_Context (N) then + return; + end if; + + Call_Nam := Extract_Call_Name (N); + + -- Nothing to do when the call is erroneous or left in a bad state + + if not (Is_Entity_Name (Call_Nam) + and then Present (Entity (Call_Nam)) + and then Is_Subprogram_Or_Entry (Entity (Call_Nam))) + then + return; + + -- Nothing to do when the call invokes a generic formal subprogram and + -- switch -gnatd.G (ignore calls through generic formal parameters for + -- elaboration) is in effect. This check must be performed with the + -- direct target of the call to avoid the side effects of mapping + -- actuals to formals using renamings. + + elsif Debug_Flag_Dot_GG + and then Is_Generic_Formal_Subp (Entity (Call_Nam)) + then + return; + end if; + + Extract_Call_Attributes + (Call => N, + Target_Id => Target_Id, + Attrs => Call_Attrs); + + -- Nothing to do when the call appears within the expanded spec or + -- body of an instantiated generic, the call does not invoke a generic + -- formal subprogram, the target is external to the instance, and switch + -- -gnatdL (ignore external calls from instances for elaboration) is in + -- effect. This behaviour approximates that of the old ABE mechanism. + + if Debug_Flag_LL + and then not Is_Generic_Formal_Subp (Entity (Call_Nam)) + + -- Performance note: parent traversal + + and then In_External_Context + (Call => N, + Target_Id => Target_Id) + then + return; + + -- Source calls to source targets are always considered because they + -- reflect the original call graph. + + elsif Comes_From_Source (Target_Id) and then Call_Attrs.From_Source then + null; + + -- A call to a source function which acts as the default expression in + -- another call requires special detection. + + elsif Comes_From_Source (Target_Id) + and then Nkind (N) = N_Function_Call + and then Is_Default_Expression (N) + then + null; + + -- The target emulates Ada semantics + + elsif Is_Ada_Semantic_Target (Target_Id) then + null; + + -- The target acts as a link between scenarios + + elsif Is_Bridge_Target (Target_Id) then + null; + + -- The target emulates SPARK semantics + + elsif Is_SPARK_Semantic_Target (Target_Id) then + null; + + -- Otherwise the call is not suitable for ABE processing. This prevents + -- the generation of call markers which will never play a role in ABE + -- diagnostics. + + else + return; + end if; + + -- At this point it is known that the call will play some role in ABE + -- checks and diagnostics. Create a corresponding call marker in case + -- the original call is heavily transformed by expansion later on. + + Marker := Make_Call_Marker (Sloc (N)); + + -- Inherit the attributes of the original call + + Set_Target (Marker, Target_Id); + Set_Is_Elaboration_Checks_OK_Node (Marker, Call_Attrs.Elab_Checks_OK); + Set_Is_Declaration_Level_Node (Marker, Call_Attrs.In_Declarations); + Set_Is_Dispatching_Call (Marker, Call_Attrs.Is_Dispatching); + Set_Is_Ignored_Ghost_Node (Marker, Call_Attrs.Ghost_Mode_Ignore); + Set_Is_Source_Call (Marker, Call_Attrs.From_Source); + Set_Is_SPARK_Mode_On_Node (Marker, Call_Attrs.SPARK_Mode_On); + + -- The marker is inserted prior to the original call. This placement has + -- several desirable effects: + + -- 1) The marker appears in the same context, in close proximity to + -- the call. + + -- + -- + + -- 2) Inserting the marker prior to the call ensures that an ABE check + -- will take effect prior to the call. + + -- + -- + -- + + -- 3) The above two properties are preserved even when the call is a + -- function which is subsequently relocated in order to capture its + -- result. Note that if the call is relocated to a new context, the + -- relocated call will receive a marker of its own. + + -- + -- + -- Temp : ... := Func_Call ...; + -- ... Temp ... + + -- The insertion must take place even when the call does not occur in + -- the main unit to keep the tree symmetric. This ensures that internal + -- name serialization is consistent in case the call marker causes the + -- tree to transform in some way. + + Insert_Action (N, Marker); + + -- The marker becomes the "corresponding" scenario for the call. Save + -- the marker for later processing by the ABE phase. + + Record_Elaboration_Scenario (Marker); + end Build_Call_Marker; + + --------------------------------- + -- Check_Elaboration_Scenarios -- + --------------------------------- + + procedure Check_Elaboration_Scenarios is + begin + -- Nothing to do for ASIS. As a result, no ABE checks and diagnostics + -- are performed in this mode. + + if ASIS_Mode then + return; + end if; + + -- Examine the context of the main unit and record all units with prior + -- elaboration with respect to it. + + Find_Elaborated_Units; + + -- Examine each top level scenario saved during the Recording phase and + -- perform various actions depending on the elaboration model in effect. + + for Index in Top_Level_Scenarios.First .. Top_Level_Scenarios.Last loop + + -- Clear the table of visited scenario bodies for each new top level + -- scenario. + + Visited_Bodies.Reset; + + Process_Scenario (Top_Level_Scenarios.Table (Index)); + end loop; + end Check_Elaboration_Scenarios; + + ------------------------------ + -- Check_Preelaborated_Call -- + ------------------------------ + + procedure Check_Preelaborated_Call (Call : Node_Id) is + function In_Preelaborated_Context (N : Node_Id) return Boolean; + -- Determine whether arbitrary node appears in a preelaborated context + + ------------------------------ + -- In_Preelaborated_Context -- + ------------------------------ + + function In_Preelaborated_Context (N : Node_Id) return Boolean is + Body_Id : constant Entity_Id := Find_Code_Unit (N); + Spec_Id : constant Entity_Id := Unique_Entity (Body_Id); + + begin + -- The node appears within a package body whose corresponding spec is + -- subject to pragma Remote_Call_Interface or Remote_Types. This does + -- not result in a preelaborated context because the package body may + -- be on another machine. + + if Ekind (Body_Id) = E_Package_Body + and then Ekind_In (Spec_Id, E_Generic_Package, E_Package) + and then (Is_Remote_Call_Interface (Spec_Id) + or else Is_Remote_Types (Spec_Id)) + then + return False; + + -- Otherwise the node appears within a preelaborated context when the + -- associated unit is preelaborated. + + else + return Is_Preelaborated_Unit (Spec_Id); + end if; + end In_Preelaborated_Context; + + -- Local variables + + Call_Attrs : Call_Attributes; + Level : Enclosing_Level_Kind; + Target_Id : Entity_Id; + + -- Start of processing for Check_Preelaborated_Call + + begin + Extract_Call_Attributes + (Call => Call, + Target_Id => Target_Id, + Attrs => Call_Attrs); + + -- Nothing to do when the call is internally generated because it is + -- assumed that it will never violate preelaboration. + + if not Call_Attrs.From_Source then + return; + end if; + + -- Performance note: parent traversal + + Level := Find_Enclosing_Level (Call); + + -- Library level calls are always considered because they are part of + -- the associated unit's elaboration actions. + + if Level in Library_Level then + null; + + -- Calls at the library level of a generic package body must be checked + -- because they would render an instantiation illegal if the template is + -- marked as preelaborated. Note that this does not apply to calls at + -- the library level of a generic package spec. + + elsif Level = Generic_Package_Body then + null; + + -- Otherwise the call does not appear at the proper level and must not + -- be considered for this check. + + else + return; + end if; + + -- The call appears within a preelaborated unit. Emit a warning only for + -- internal uses, otherwise this is an error. + + if In_Preelaborated_Context (Call) then + Error_Msg_Warn := GNAT_Mode; + Error_Msg_N + ("< Unit_Id, + Same_Unit_OK => True, + Elab_Body_OK => Prag_Nam = Name_Elaborate) + then + return; + + -- Suggest the use of pragma Prag_Nam when the dynamic model is in + -- effect. + + elsif Dynamic_Elaboration_Checks then + Ensure_Prior_Elaboration_Dynamic + (N => N, + Unit_Id => Unit_Id, + Prag_Nam => Prag_Nam); + + -- Install an implicit pragma Prag_Nam when the static model is in + -- effect. + + else + pragma Assert (Static_Elaboration_Checks); + + Ensure_Prior_Elaboration_Static + (N => N, + Unit_Id => Unit_Id, + Prag_Nam => Prag_Nam); + end if; + end Ensure_Prior_Elaboration; + + -------------------------------------- + -- Ensure_Prior_Elaboration_Dynamic -- + -------------------------------------- + + procedure Ensure_Prior_Elaboration_Dynamic + (N : Node_Id; + Unit_Id : Entity_Id; + Prag_Nam : Name_Id) + is + procedure Info_Missing_Pragma; + pragma Inline (Info_Missing_Pragma); + -- Output information concerning missing Elaborate or Elaborate_All + -- pragma with name Prag_Nam for scenario N, which would ensure the + -- prior elaboration of Unit_Id. + + ------------------------- + -- Info_Missing_Pragma -- + ------------------------- + + procedure Info_Missing_Pragma is + begin + -- Internal units are ignored as they cause unnecessary noise + + if not In_Internal_Unit (Unit_Id) then + + -- The name of the unit subjected to the elaboration pragma is + -- fully qualified to improve the clarity of the info message. + + Error_Msg_Name_1 := Prag_Nam; + Error_Msg_Qual_Level := Nat'Last; + + Error_Msg_NE ("info: missing pragma % for unit &", N, Unit_Id); + Error_Msg_Qual_Level := 0; + end if; + end Info_Missing_Pragma; + + -- Local variables + + Elab_Attrs : Elaboration_Attributes; + Level : Enclosing_Level_Kind; + + -- Start of processing for Ensure_Prior_Elaboration_Dynamic + + begin + Elab_Attrs := Elaboration_Context.Get (Unit_Id); + + -- Nothing to do when the unit is guaranteed prior elaboration by means + -- of a source Elaborate[_All] pragma. + + if Present (Elab_Attrs.Source_Pragma) then + return; + end if; + + -- Output extra information on a missing Elaborate[_All] pragma when + -- switch -gnatel (info messages on implicit Elaborate[_All] pragmas + -- is in effect. + + if Elab_Info_Messages then + + -- Performance note: parent traversal + + Level := Find_Enclosing_Level (N); + + -- Declaration-level scenario + + if (Is_Suitable_Call (N) or else Is_Suitable_Instantiation (N)) + and then Level = Declaration_Level + then + null; + + -- Library-level scenario + + elsif Level in Library_Level then + null; + + -- Instantiation library-level scenario + + elsif Level = Instantiation then + null; + + -- Otherwise the scenario does not appear at the proper level and + -- cannot possibly act as a top-level scenario. + + else + return; + end if; + + Info_Missing_Pragma; + end if; + end Ensure_Prior_Elaboration_Dynamic; + + ------------------------------------- + -- Ensure_Prior_Elaboration_Static -- + ------------------------------------- + + procedure Ensure_Prior_Elaboration_Static + (N : Node_Id; + Unit_Id : Entity_Id; + Prag_Nam : Name_Id) + is + function Find_With_Clause + (Items : List_Id; + Withed_Id : Entity_Id) return Node_Id; + pragma Inline (Find_With_Clause); + -- Find a nonlimited with clause in the list of context items Items + -- that withs unit Withed_Id. Return Empty if no such clause is found. + + procedure Info_Implicit_Pragma; + pragma Inline (Info_Implicit_Pragma); + -- Output information concerning an implicitly generated Elaborate or + -- Elaborate_All pragma with name Prag_Nam for scenario N which ensures + -- the prior elaboration of unit Unit_Id. + + ---------------------- + -- Find_With_Clause -- + ---------------------- + + function Find_With_Clause + (Items : List_Id; + Withed_Id : Entity_Id) return Node_Id + is + Item : Node_Id; + + begin + -- Examine the context clauses looking for a suitable with. Note that + -- limited clauses do not affect the elaboration order. + + Item := First (Items); + while Present (Item) loop + if Nkind (Item) = N_With_Clause + and then not Error_Posted (Item) + and then not Limited_Present (Item) + and then Entity (Name (Item)) = Withed_Id + then + return Item; + end if; + + Next (Item); + end loop; + + return Empty; + end Find_With_Clause; + + -------------------------- + -- Info_Implicit_Pragma -- + -------------------------- + + procedure Info_Implicit_Pragma is + begin + -- Internal units are ignored as they cause unnecessary noise + + if not In_Internal_Unit (Unit_Id) then + + -- The name of the unit subjected to the elaboration pragma is + -- fully qualified to improve the clarity of the info message. + + Error_Msg_Name_1 := Prag_Nam; + Error_Msg_Qual_Level := Nat'Last; + + Error_Msg_NE + ("info: implicit pragma % generated for unit &", N, Unit_Id); + + Error_Msg_Qual_Level := 0; + Output_Active_Scenarios (N); + end if; + end Info_Implicit_Pragma; + + -- Local variables + + Main_Cunit : constant Node_Id := Cunit (Main_Unit); + Loc : constant Source_Ptr := Sloc (Main_Cunit); + Unit_Cunit : constant Node_Id := Compilation_Unit (Unit_Id); + + Is_Instantiation : constant Boolean := + Nkind (N) in N_Generic_Instantiation; + + Clause : Node_Id; + Elab_Attrs : Elaboration_Attributes; + Items : List_Id; + + -- Start of processing for Ensure_Prior_Elaboration_Static + + begin + Elab_Attrs := Elaboration_Context.Get (Unit_Id); + + -- Nothing to do when the unit is guaranteed prior elaboration by means + -- of a source Elaborate[_All] pragma. + + if Present (Elab_Attrs.Source_Pragma) then + return; + + -- Nothing to do when the unit has an existing implicit Elaborate[_All] + -- pragma installed by a previous scenario. + + elsif Present (Elab_Attrs.With_Clause) then + + -- The unit is already guaranteed prior elaboration by means of an + -- implicit Elaborate pragma, however the current scenario imposes + -- a stronger requirement of Elaborate_All. "Upgrade" the existing + -- pragma to match this new requirement. + + if Elaborate_Desirable (Elab_Attrs.With_Clause) + and then Prag_Nam = Name_Elaborate_All + then + Set_Elaborate_All_Desirable (Elab_Attrs.With_Clause); + Set_Elaborate_Desirable (Elab_Attrs.With_Clause, False); + end if; + + return; + end if; + + -- At this point it is known that the unit has no prior elaboration + -- according to pragmas and hierarchical relationships. + + Items := Context_Items (Main_Cunit); + + if No (Items) then + Items := New_List; + Set_Context_Items (Main_Cunit, Items); + end if; + + -- Locate the with clause for the unit. Note that there may not be a + -- clause if the unit is visible through a subunit-body, body-spec, or + -- spec-parent relationship. + + Clause := + Find_With_Clause + (Items => Items, + Withed_Id => Unit_Id); + + -- Generate: + -- with Id; + + -- Note that adding implicit with clauses is safe because analysis, + -- resolution, and expansion have already taken place and it is not + -- possible to interfere with visibility. + + if No (Clause) then + Clause := + Make_With_Clause (Loc, + Name => New_Occurrence_Of (Unit_Id, Loc)); + + Set_Implicit_With (Clause); + Set_Library_Unit (Clause, Unit_Cunit); + + Append_To (Items, Clause); + end if; + + -- Instantiations require an implicit Elaborate because Elaborate_All is + -- too conservative and may introduce non-existent elaboration cycles. + + if Is_Instantiation then + Set_Elaborate_Desirable (Clause); + + -- Otherwise generate an implicit Elaborate_All + + else + Set_Elaborate_All_Desirable (Clause); + end if; + + -- The implicit Elaborate[_All] ensures the prior elaboration of the + -- unit. Include the unit in the elaboration context of the main unit. + + Elaboration_Context.Set (Unit_Id, + Elaboration_Attributes'(Source_Pragma => Empty, + With_Clause => Clause)); + + -- Output extra information on an implicit Elaborate[_All] pragma when + -- switch -gnatel (info messages on implicit Elaborate[_All] pragmas is + -- in effect. + + if Elab_Info_Messages then + Info_Implicit_Pragma; + end if; + end Ensure_Prior_Elaboration_Static; + + ----------------------------- + -- Extract_Assignment_Name -- + ----------------------------- + + function Extract_Assignment_Name (Asmt : Node_Id) return Node_Id is + Nam : Node_Id; + + begin + Nam := Name (Asmt); + + -- When the name denotes an array or record component, find the whole + -- object. + + while Nkind_In (Nam, N_Explicit_Dereference, + N_Indexed_Component, + N_Selected_Component, + N_Slice) + loop + Nam := Prefix (Nam); + end loop; + + return Nam; + end Extract_Assignment_Name; + + ----------------------------- + -- Extract_Call_Attributes -- + ----------------------------- + + procedure Extract_Call_Attributes + (Call : Node_Id; + Target_Id : out Entity_Id; + Attrs : out Call_Attributes) + is + From_Source : Boolean; + In_Declarations : Boolean; + Is_Dispatching : Boolean; + + begin + -- Extraction for call markers + + if Nkind (Call) = N_Call_Marker then + Target_Id := Target (Call); + From_Source := Is_Source_Call (Call); + In_Declarations := Is_Declaration_Level_Node (Call); + Is_Dispatching := Is_Dispatching_Call (Call); + + -- Extraction for entry calls, requeue, and subprogram calls + + else + pragma Assert (Nkind_In (Call, N_Entry_Call_Statement, + N_Function_Call, + N_Procedure_Call_Statement, + N_Requeue_Statement)); + + Target_Id := Entity (Extract_Call_Name (Call)); + From_Source := Comes_From_Source (Call); + + -- Performance note: parent traversal + + In_Declarations := Find_Enclosing_Level (Call) = Declaration_Level; + Is_Dispatching := + Nkind_In (Call, N_Function_Call, N_Procedure_Call_Statement) + and then Present (Controlling_Argument (Call)); + end if; + + -- Obtain the original entry or subprogram which the target may rename + -- except when the target is an instantiation. In this case the alias + -- is the internally generated subprogram which appears within the the + -- anonymous package created for the instantiation. Such an alias is not + -- a suitable target. + + if not (Is_Subprogram (Target_Id) + and then Is_Generic_Instance (Target_Id)) + then + Target_Id := Get_Renamed_Entity (Target_Id); + end if; + + -- Set all attributes + + Attrs.Elab_Checks_OK := Is_Elaboration_Checks_OK_Node (Call); + Attrs.From_Source := From_Source; + Attrs.Ghost_Mode_Ignore := Is_Ignored_Ghost_Node (Call); + Attrs.In_Declarations := In_Declarations; + Attrs.Is_Dispatching := Is_Dispatching; + Attrs.SPARK_Mode_On := Is_SPARK_Mode_On_Node (Call); + end Extract_Call_Attributes; + + ----------------------- + -- Extract_Call_Name -- + ----------------------- + + function Extract_Call_Name (Call : Node_Id) return Node_Id is + Nam : Node_Id; + + begin + Nam := Name (Call); + + -- When the call invokes an entry family, the name appears as an indexed + -- component. + + if Nkind (Nam) = N_Indexed_Component then + Nam := Prefix (Nam); + end if; + + -- When the call employs the object.operation form, the name appears as + -- a selected component. + + if Nkind (Nam) = N_Selected_Component then + Nam := Selector_Name (Nam); + end if; + + return Nam; + end Extract_Call_Name; + + --------------------------------- + -- Extract_Instance_Attributes -- + --------------------------------- + + procedure Extract_Instance_Attributes + (Exp_Inst : Node_Id; + Inst_Body : out Node_Id; + Inst_Decl : out Node_Id) + is + Body_Id : Entity_Id; + + begin + -- Assume that the attributes are unavailable + + Inst_Body := Empty; + Inst_Decl := Empty; + + -- Generic package or subprogram spec + + if Nkind_In (Exp_Inst, N_Package_Declaration, + N_Subprogram_Declaration) + then + Inst_Decl := Exp_Inst; + Body_Id := Corresponding_Body (Inst_Decl); + + if Present (Body_Id) then + Inst_Body := Unit_Declaration_Node (Body_Id); + end if; + + -- Generic package or subprogram body + + else + pragma Assert + (Nkind_In (Exp_Inst, N_Package_Body, N_Subprogram_Body)); + + Inst_Body := Exp_Inst; + Inst_Decl := Unit_Declaration_Node (Corresponding_Spec (Inst_Body)); + end if; + end Extract_Instance_Attributes; + + -------------------------------------- + -- Extract_Instantiation_Attributes -- + -------------------------------------- + + procedure Extract_Instantiation_Attributes + (Exp_Inst : Node_Id; + Inst : out Node_Id; + Inst_Id : out Entity_Id; + Gen_Id : out Entity_Id; + Attrs : out Instantiation_Attributes) + is + begin + Inst := Original_Node (Exp_Inst); + Inst_Id := Defining_Entity (Inst); + + -- Traverse a possible chain of renamings to obtain the original generic + -- being instantiatied. + + Gen_Id := Get_Renamed_Entity (Entity (Name (Inst))); + + -- Set all attributes + + Attrs.Elab_Checks_OK := Is_Elaboration_Checks_OK_Node (Inst); + Attrs.Ghost_Mode_Ignore := Is_Ignored_Ghost_Node (Inst); + Attrs.In_Declarations := Is_Declaration_Level_Node (Inst); + Attrs.SPARK_Mode_On := Is_SPARK_Mode_On_Node (Inst); + end Extract_Instantiation_Attributes; + + ------------------------------- + -- Extract_Target_Attributes -- + ------------------------------- + + procedure Extract_Target_Attributes + (Target_Id : Entity_Id; + Attrs : out Target_Attributes) + is + procedure Extract_Package_Or_Subprogram_Attributes + (Spec_Id : out Entity_Id; + Body_Decl : out Node_Id); + -- Obtain the attributes associated with a package or a subprogram. + -- Spec_Id is the package or subprogram. Body_Decl is the declaration + -- of the corresponding package or subprogram body. + + procedure Extract_Protected_Entry_Attributes + (Spec_Id : out Entity_Id; + Body_Decl : out Node_Id; + Body_Barf : out Node_Id); + -- Obtain the attributes associated with a protected entry [family]. + -- Spec_Id is the entity of the protected body subprogram. Body_Decl + -- is the declaration of Spec_Id's corresponding body. Body_Barf is + -- the declaration of the barrier function body. + + procedure Extract_Protected_Subprogram_Attributes + (Spec_Id : out Entity_Id; + Body_Decl : out Node_Id); + -- Obtain the attributes associated with a protected subprogram. Formal + -- Spec_Id is the entity of the protected body subprogram. Body_Decl is + -- the declaration of Spec_Id's corresponding body. + + procedure Extract_Task_Entry_Attributes + (Spec_Id : out Entity_Id; + Body_Decl : out Node_Id); + -- Obtain the attributes associated with a task entry [family]. Formal + -- Spec_Id is the entity of the task body procedure. Body_Decl is the + -- declaration of Spec_Id's corresponding body. + + ---------------------------------------------- + -- Extract_Package_Or_Subprogram_Attributes -- + ---------------------------------------------- + + procedure Extract_Package_Or_Subprogram_Attributes + (Spec_Id : out Entity_Id; + Body_Decl : out Node_Id) + is + Body_Id : Entity_Id; + Init_Id : Entity_Id; + Spec_Decl : Node_Id; + + begin + -- Assume that the body is not available + + Body_Decl := Empty; + Spec_Id := Target_Id; + + -- For body retrieval purposes, the entity of the initial declaration + -- is that of the spec. + + Init_Id := Spec_Id; + + -- The only exception to the above is a function which returns a + -- constrained array type in a SPARK-to-C compilation. In this case + -- the function receives a corresponding procedure which has an out + -- parameter. The proper body for ABE checks and diagnostics is that + -- of the procedure. + + if Ekind (Init_Id) = E_Function + and then Rewritten_For_C (Init_Id) + then + Init_Id := Corresponding_Procedure (Init_Id); + end if; + + -- Extract the attributes of the body + + Spec_Decl := Unit_Declaration_Node (Init_Id); + + -- The initial declaration is a stand alone subprogram body + + if Nkind (Spec_Decl) = N_Subprogram_Body then + Body_Decl := Spec_Decl; + + -- Otherwise the package or subprogram has a spec and a completing + -- body. + + elsif Nkind_In (Spec_Decl, N_Generic_Package_Declaration, + N_Generic_Subprogram_Declaration, + N_Package_Declaration, + N_Subprogram_Body_Stub, + N_Subprogram_Declaration) + then + Body_Id := Corresponding_Body (Spec_Decl); + + if Present (Body_Id) then + Body_Decl := Unit_Declaration_Node (Body_Id); + end if; + end if; + end Extract_Package_Or_Subprogram_Attributes; + + ---------------------------------------- + -- Extract_Protected_Entry_Attributes -- + ---------------------------------------- + + procedure Extract_Protected_Entry_Attributes + (Spec_Id : out Entity_Id; + Body_Decl : out Node_Id; + Body_Barf : out Node_Id) + is + Barf_Id : Entity_Id; + Body_Id : Entity_Id; + + begin + -- Assume that the bodies are not available + + Body_Barf := Empty; + Body_Decl := Empty; + + -- When the entry [family] has already been expanded, it carries both + -- the procedure which emulates the behavior of the entry [family] as + -- well as the barrier function. + + if Present (Protected_Body_Subprogram (Target_Id)) then + Spec_Id := Protected_Body_Subprogram (Target_Id); + + -- Extract the attributes of the barrier function + + Barf_Id := + Corresponding_Body + (Unit_Declaration_Node (Barrier_Function (Target_Id))); + + if Present (Barf_Id) then + Body_Barf := Unit_Declaration_Node (Barf_Id); + end if; + + -- Otherwise no expansion took place + + else + Spec_Id := Target_Id; + end if; + + -- Extract the attributes of the entry body + + Body_Id := Corresponding_Body (Unit_Declaration_Node (Spec_Id)); + + if Present (Body_Id) then + Body_Decl := Unit_Declaration_Node (Body_Id); + end if; + end Extract_Protected_Entry_Attributes; + + --------------------------------------------- + -- Extract_Protected_Subprogram_Attributes -- + --------------------------------------------- + + procedure Extract_Protected_Subprogram_Attributes + (Spec_Id : out Entity_Id; + Body_Decl : out Node_Id) + is + Body_Id : Entity_Id; + + begin + -- Assume that the body is not available + + Body_Decl := Empty; + + -- When the protected subprogram has already been expanded, it + -- carries the subprogram which seizes the lock and invokes the + -- original statements. + + if Present (Protected_Subprogram (Target_Id)) then + Spec_Id := + Protected_Body_Subprogram (Protected_Subprogram (Target_Id)); + + -- Otherwise no expansion took place + + else + Spec_Id := Target_Id; + end if; + + -- Extract the attributes of the body + + Body_Id := Corresponding_Body (Unit_Declaration_Node (Spec_Id)); + + if Present (Body_Id) then + Body_Decl := Unit_Declaration_Node (Body_Id); + end if; + end Extract_Protected_Subprogram_Attributes; + + ----------------------------------- + -- Extract_Task_Entry_Attributes -- + ----------------------------------- + + procedure Extract_Task_Entry_Attributes + (Spec_Id : out Entity_Id; + Body_Decl : out Node_Id) + is + Task_Typ : constant Entity_Id := Non_Private_View (Scope (Target_Id)); + Body_Id : Entity_Id; + + begin + -- Assume that the body is not available + + Body_Decl := Empty; + + -- The the task type has already been expanded, it carries the + -- procedure which emulates the behavior of the task body. + + if Present (Task_Body_Procedure (Task_Typ)) then + Spec_Id := Task_Body_Procedure (Task_Typ); + + -- Otherwise no expansion took place + + else + Spec_Id := Task_Typ; + end if; + + -- Extract the attributes of the body + + Body_Id := Corresponding_Body (Unit_Declaration_Node (Spec_Id)); + + if Present (Body_Id) then + Body_Decl := Unit_Declaration_Node (Body_Id); + end if; + end Extract_Task_Entry_Attributes; + + -- Local variables + + Prag : constant Node_Id := SPARK_Pragma (Target_Id); + Body_Barf : Node_Id; + Body_Decl : Node_Id; + Spec_Id : Entity_Id; + + -- Start of processing for Extract_Target_Attributes + + begin + -- Assume that the body of the barrier function is not available + + Body_Barf := Empty; + + -- The target is a protected entry [family] + + if Is_Protected_Entry (Target_Id) then + Extract_Protected_Entry_Attributes + (Spec_Id => Spec_Id, + Body_Decl => Body_Decl, + Body_Barf => Body_Barf); + + -- The target is a protected subprogram + + elsif Is_Protected_Subp (Target_Id) + or else Is_Protected_Body_Subp (Target_Id) + then + Extract_Protected_Subprogram_Attributes + (Spec_Id => Spec_Id, + Body_Decl => Body_Decl); + + -- The target is a task entry [family] + + elsif Is_Task_Entry (Target_Id) then + Extract_Task_Entry_Attributes + (Spec_Id => Spec_Id, + Body_Decl => Body_Decl); + + -- Otherwise the target is a package or a subprogram + + else + Extract_Package_Or_Subprogram_Attributes + (Spec_Id => Spec_Id, + Body_Decl => Body_Decl); + end if; + + -- Set all attributes + + Attrs.Body_Barf := Body_Barf; + Attrs.Body_Decl := Body_Decl; + Attrs.Elab_Checks_OK := Is_Elaboration_Checks_OK_Id (Target_Id); + Attrs.From_Source := Comes_From_Source (Target_Id); + Attrs.Ghost_Mode_Ignore := Is_Ignored_Ghost_Entity (Target_Id); + Attrs.SPARK_Mode_On := + Present (Prag) and then Get_SPARK_Mode_From_Annotation (Prag) = On; + Attrs.Spec_Decl := Unit_Declaration_Node (Spec_Id); + Attrs.Spec_Id := Spec_Id; + Attrs.Unit_Id := Find_Top_Unit (Target_Id); + + -- At this point certain attributes should always be available + + pragma Assert (Present (Attrs.Spec_Decl)); + pragma Assert (Present (Attrs.Spec_Id)); + pragma Assert (Present (Attrs.Unit_Id)); + end Extract_Target_Attributes; + + ----------------------------- + -- Extract_Task_Attributes -- + ----------------------------- + + procedure Extract_Task_Attributes + (Typ : Entity_Id; + Attrs : out Task_Attributes) + is + Task_Typ : constant Entity_Id := Non_Private_View (Typ); + + Body_Decl : Node_Id; + Body_Id : Entity_Id; + Prag : Node_Id; + Spec_Id : Entity_Id; + + begin + -- Assume that the body of the task procedure is not available + + Body_Decl := Empty; + + -- The initial declaration is that of the task body procedure + + Spec_Id := Get_Task_Body_Procedure (Task_Typ); + Body_Id := Corresponding_Body (Unit_Declaration_Node (Spec_Id)); + + if Present (Body_Id) then + Body_Decl := Unit_Declaration_Node (Body_Id); + end if; + + Prag := SPARK_Pragma (Task_Typ); + + -- Set all attributes + + Attrs.Body_Decl := Body_Decl; + Attrs.Elab_Checks_OK := Is_Elaboration_Checks_OK_Id (Task_Typ); + Attrs.Ghost_Mode_Ignore := Is_Ignored_Ghost_Entity (Task_Typ); + Attrs.SPARK_Mode_On := + Present (Prag) and then Get_SPARK_Mode_From_Annotation (Prag) = On; + Attrs.Spec_Id := Spec_Id; + Attrs.Task_Decl := Declaration_Node (Task_Typ); + Attrs.Unit_Id := Find_Top_Unit (Task_Typ); + + -- At this point certain attributes should always be available + + pragma Assert (Present (Attrs.Spec_Id)); + pragma Assert (Present (Attrs.Task_Decl)); + pragma Assert (Present (Attrs.Unit_Id)); + end Extract_Task_Attributes; + + ------------------------------------------- + -- Extract_Variable_Reference_Attributes -- + ------------------------------------------- + + procedure Extract_Variable_Reference_Attributes + (Ref : Node_Id; + Var_Id : out Entity_Id; + Attrs : out Variable_Attributes) + is + begin + -- Traverse a possible chain of renamings to obtain the original + -- variable being referenced. + + Var_Id := Get_Renamed_Entity (Entity (Ref)); + + Attrs.SPARK_Mode_On := Is_SPARK_Mode_On_Node (Ref); + Attrs.Unit_Id := Find_Top_Unit (Var_Id); + + -- At this point certain attributes should always be available + + pragma Assert (Present (Attrs.Unit_Id)); + end Extract_Variable_Reference_Attributes; + + -------------------- + -- Find_Code_Unit -- + -------------------- + + function Find_Code_Unit (N : Node_Or_Entity_Id) return Entity_Id is + begin + return Find_Unit_Entity (Unit (Cunit (Get_Code_Unit (N)))); + end Find_Code_Unit; + + --------------------------- + -- Find_Elaborated_Units -- + --------------------------- + + procedure Find_Elaborated_Units is + procedure Add_Pragma (Prag : Node_Id); + -- Determine whether pragma Prag denotes a legal Elaborate[_All] pragma. + -- If this is the case, add the related unit to the elaboration context. + -- For pragma Elaborate_All, include recursively all units withed by the + -- related unit. + + procedure Add_Unit + (Unit_Id : Entity_Id; + Prag : Node_Id; + Full_Context : Boolean); + -- Add unit Unit_Id to the elaboration context. Prag denotes the pragma + -- which prompted the inclusion of the unit to the elaboration context. + -- If flag Full_Context is set, examine the nonlimited clauses of unit + -- Unit_Id and add each withed unit to the context. + + procedure Find_Elaboration_Context (Comp_Unit : Node_Id); + -- Examine the context items of compilation unit Comp_Unit for suitable + -- elaboration-related pragmas and add all related units to the context. + + ---------------- + -- Add_Pragma -- + ---------------- + + procedure Add_Pragma (Prag : Node_Id) is + Prag_Args : constant List_Id := Pragma_Argument_Associations (Prag); + Prag_Nam : constant Name_Id := Pragma_Name (Prag); + Unit_Arg : Node_Id; + + begin + -- Nothing to do if the pragma is not related to elaboration + + if not Nam_In (Prag_Nam, Name_Elaborate, Name_Elaborate_All) then + return; + + -- Nothing to do when the pragma is illegal + + elsif Error_Posted (Prag) then + return; + end if; + + Unit_Arg := Get_Pragma_Arg (First (Prag_Args)); + + -- The argument of the pragma may appear in package.package form + + if Nkind (Unit_Arg) = N_Selected_Component then + Unit_Arg := Selector_Name (Unit_Arg); + end if; + + Add_Unit + (Unit_Id => Entity (Unit_Arg), + Prag => Prag, + Full_Context => Prag_Nam = Name_Elaborate_All); + end Add_Pragma; + + -------------- + -- Add_Unit -- + -------------- + + procedure Add_Unit + (Unit_Id : Entity_Id; + Prag : Node_Id; + Full_Context : Boolean) + is + Clause : Node_Id; + Elab_Attrs : Elaboration_Attributes; + + begin + -- Nothing to do when some previous error left a with clause or a + -- pragma in a bad state. + + if No (Unit_Id) then + return; + end if; + + Elab_Attrs := Elaboration_Context.Get (Unit_Id); + + -- The current unit is not part of the context. Prepare a new set of + -- attributes. + + if Elab_Attrs = No_Elaboration_Attributes then + Elab_Attrs := + Elaboration_Attributes'(Source_Pragma => Prag, + With_Clause => Empty); + + -- The unit is already included in the context by means of pragma + -- Elaborate. "Upgrage" the existing attributes when the unit is + -- subject to Elaborate_All because the new pragma covers a larger + -- set of units. All other properties remain the same. + + elsif Pragma_Name (Elab_Attrs.Source_Pragma) = Name_Elaborate + and then Pragma_Name (Prag) = Name_Elaborate_All + then + Elab_Attrs.Source_Pragma := Prag; + + -- Otherwise the unit is already included in the context + + else + return; + end if; + + -- Add or update the attributes of the unit + + Elaboration_Context.Set (Unit_Id, Elab_Attrs); + + -- Includes all units withed by the current one when computing the + -- full context. + + if Full_Context then + + -- Process all nonlimited with clauses found in the context of + -- the current unit. Note that limited clauses do not impose an + -- elaboration order. + + Clause := First (Context_Items (Compilation_Unit (Unit_Id))); + while Present (Clause) loop + if Nkind (Clause) = N_With_Clause + and then not Error_Posted (Clause) + and then not Limited_Present (Clause) + then + Add_Unit + (Unit_Id => Entity (Name (Clause)), + Prag => Prag, + Full_Context => Full_Context); + end if; + + Next (Clause); + end loop; + end if; + end Add_Unit; + + ------------------------------ + -- Find_Elaboration_Context -- + ------------------------------ + + procedure Find_Elaboration_Context (Comp_Unit : Node_Id) is + Prag : Node_Id; + + begin + pragma Assert (Nkind (Comp_Unit) = N_Compilation_Unit); + + -- Process all elaboration-related pragmas found in the context of + -- the compilation unit. + + Prag := First (Context_Items (Comp_Unit)); + while Present (Prag) loop + if Nkind (Prag) = N_Pragma then + Add_Pragma (Prag); + end if; + + Next (Prag); + end loop; + end Find_Elaboration_Context; + + -- Local variables + + Par_Id : Entity_Id; + Unt : Node_Id; + + -- Start of processing for Find_Elaborated_Units + + begin + -- Perform a traversal which examines the context of the main unit and + -- populates the Elaboration_Context table with all units elaborated + -- prior to the main unit. The traversal performs the following jumps: + + -- subunit -> parent subunit + -- parent subunit -> body + -- body -> spec + -- spec -> parent spec + -- parent spec -> grandparent spec and so on + + -- The traversal relies on units rather than scopes because the scope of + -- a subunit is some spec, while this traversal must process the body as + -- well. Given that protected and task bodies can also be subunits, this + -- complicates the scope approach even further. + + Unt := Unit (Cunit (Main_Unit)); + + -- Perform the following traversals when the main unit is a subunit + + -- subunit -> parent subunit + -- parent subunit -> body + + while Present (Unt) and then Nkind (Unt) = N_Subunit loop + Find_Elaboration_Context (Parent (Unt)); + + -- Continue the traversal by going to the unit which contains the + -- corresponding stub. + + if Present (Corresponding_Stub (Unt)) then + Unt := Unit (Cunit (Get_Source_Unit (Corresponding_Stub (Unt)))); + + -- Otherwise the subunit may be erroneous or left in a bad state + + else + exit; + end if; + end loop; + + -- Perform the following traversal now that subunits have been taken + -- care of, or the main unit is a body. + + -- body -> spec + + if Present (Unt) + and then Nkind_In (Unt, N_Package_Body, N_Subprogram_Body) + then + Find_Elaboration_Context (Parent (Unt)); + + -- Continue the traversal by going to the unit which contains the + -- corresponding spec. + + if Present (Corresponding_Spec (Unt)) then + Unt := Unit (Cunit (Get_Source_Unit (Corresponding_Spec (Unt)))); + end if; + end if; + + -- Perform the following traversals now that the body has been taken + -- care of, or the main unit is a spec. + + -- spec -> parent spec + -- parent spec -> grandparent spec and so on + + if Present (Unt) + and then Nkind_In (Unt, N_Generic_Package_Declaration, + N_Generic_Subprogram_Declaration, + N_Package_Declaration, + N_Subprogram_Declaration) + then + Find_Elaboration_Context (Parent (Unt)); + + -- Process a potential chain of parent units which ends with the + -- main unit spec. The traversal can now safely rely on the scope + -- chain. + + Par_Id := Scope (Defining_Entity (Unt)); + while Present (Par_Id) and then Par_Id /= Standard_Standard loop + Find_Elaboration_Context (Compilation_Unit (Par_Id)); + + Par_Id := Scope (Par_Id); + end loop; + end if; + end Find_Elaborated_Units; + + ----------------------------- + -- Find_Enclosing_Instance -- + ----------------------------- + + function Find_Enclosing_Instance (N : Node_Id) return Node_Id is + Par : Node_Id; + Spec_Id : Entity_Id; + + begin + -- Climb the parent chain looking for an enclosing instance spec or body + + Par := N; + while Present (Par) loop + + -- Generic package or subprogram spec + + if Nkind_In (Par, N_Package_Declaration, + N_Subprogram_Declaration) + and then Is_Generic_Instance (Defining_Entity (Par)) + then + return Par; + + -- Generic package or subprogram body + + elsif Nkind_In (Par, N_Package_Body, N_Subprogram_Body) then + Spec_Id := Corresponding_Spec (Par); + + if Present (Spec_Id) and then Is_Generic_Instance (Spec_Id) then + return Par; + end if; + end if; + + Par := Parent (Par); + end loop; + + return Empty; + end Find_Enclosing_Instance; + + -------------------------- + -- Find_Enclosing_Level -- + -------------------------- + + function Find_Enclosing_Level (N : Node_Id) return Enclosing_Level_Kind is + function Level_Of (Unit : Node_Id) return Enclosing_Level_Kind; + -- Obtain the corresponding level of unit Unit + + -------------- + -- Level_Of -- + -------------- + + function Level_Of (Unit : Node_Id) return Enclosing_Level_Kind is + Spec_Id : Entity_Id; + + begin + if Nkind (Unit) in N_Generic_Instantiation then + return Instantiation; + + elsif Nkind (Unit) = N_Generic_Package_Declaration then + return Generic_Package_Spec; + + elsif Nkind (Unit) = N_Package_Declaration then + return Package_Spec; + + elsif Nkind (Unit) = N_Package_Body then + Spec_Id := Corresponding_Spec (Unit); + + -- The body belongs to a generic package + + if Present (Spec_Id) + and then Ekind (Spec_Id) = E_Generic_Package + then + return Generic_Package_Body; + + -- Otherwise the body belongs to a non-generic package. This also + -- treats an illegal package body without a corresponding spec as + -- a non-generic package body. + + else + return Package_Body; + end if; + end if; + + return No_Level; + end Level_Of; + + -- Local variables + + Context : Node_Id; + Curr : Node_Id; + Prev : Node_Id; + + -- Start of processing for Find_Enclosing_Level + + begin + -- Call markers and instantiations which appear at the declaration level + -- but are later relocated in a different context retain their original + -- declaration level. + + if Nkind_In (N, N_Call_Marker, + N_Function_Instantiation, + N_Package_Instantiation, + N_Procedure_Instantiation) + and then Is_Declaration_Level_Node (N) + then + return Declaration_Level; + end if; + + -- Climb the parent chain looking at the enclosing levels + + Prev := N; + Curr := Parent (Prev); + while Present (Curr) loop + + -- A traversal from a subunit continues via the corresponding stub + + if Nkind (Curr) = N_Subunit then + Curr := Corresponding_Stub (Curr); + + -- The current construct is a package. Packages are ignored because + -- they are always elaborated when the enclosing context is invoked + -- or elaborated. + + elsif Nkind_In (Curr, N_Package_Body, N_Package_Declaration) then + null; + + -- The current construct is a block statement + + elsif Nkind (Curr) = N_Block_Statement then + + -- Ignore internally generated blocks created by the expander for + -- various purposes such as abort defer/undefer. + + if not Comes_From_Source (Curr) then + null; + + -- If the traversal came from the handled sequence of statments, + -- then the node appears at the level of the enclosing construct. + -- This is a more reliable test because transients scopes within + -- the declarative region of the encapsulator are hard to detect. + + elsif Nkind (Prev) = N_Handled_Sequence_Of_Statements + and then Handled_Statement_Sequence (Curr) = Prev + then + return Find_Enclosing_Level (Parent (Curr)); + + -- Otherwise the traversal came from the declarations, the node is + -- at the declaration level. + + else + return Declaration_Level; + end if; + + -- The current construct is a declaration level encapsulator + + elsif Nkind_In (Curr, N_Entry_Body, + N_Subprogram_Body, + N_Task_Body) + then + -- If the traversal came from the handled sequence of statments, + -- then the node cannot possibly appear at any level. This is + -- a more reliable test because transients scopes within the + -- declarative region of the encapsulator are hard to detect. + + if Nkind (Prev) = N_Handled_Sequence_Of_Statements + and then Handled_Statement_Sequence (Curr) = Prev + then + return No_Level; + + -- Otherwise the traversal came from the declarations, the node is + -- at the declaration level. + + else + return Declaration_Level; + end if; + + -- The current construct is a non-library level encapsulator which + -- indicates that the node cannot possibly appear at any level. + -- Note that this check must come after the declaration level check + -- because both predicates share certain nodes. + + elsif Is_Non_Library_Level_Encapsulator (Curr) then + Context := Parent (Curr); + + -- The sole exception is when the encapsulator is the compilation + -- utit itself because the compilation unit node requires special + -- processing (see below). + + if Present (Context) + and then Nkind (Context) = N_Compilation_Unit + then + null; + + -- Otherwise the node is not at any level + + else + return No_Level; + end if; + + -- The current construct is a compilation unit. The node appears at + -- the [generic] library level when the unit is a [generic] package. + + elsif Nkind (Curr) = N_Compilation_Unit then + return Level_Of (Unit (Curr)); + end if; + + Prev := Curr; + Curr := Parent (Prev); + end loop; + + return No_Level; + end Find_Enclosing_Level; + + ------------------- + -- Find_Top_Unit -- + ------------------- + + function Find_Top_Unit (N : Node_Or_Entity_Id) return Entity_Id is + begin + return Find_Unit_Entity (Unit (Cunit (Get_Top_Level_Code_Unit (N)))); + end Find_Top_Unit; + + ---------------------- + -- Find_Unit_Entity -- + ---------------------- + + function Find_Unit_Entity (N : Node_Id) return Entity_Id is + Context : constant Node_Id := Parent (N); + Orig_N : constant Node_Id := Original_Node (N); + + begin + -- The unit denotes a package body of an instantiation which acts as + -- a compilation unit. The proper entity is that of the package spec. + + if Nkind (N) = N_Package_Body + and then Nkind (Orig_N) = N_Package_Instantiation + and then Nkind (Context) = N_Compilation_Unit + then + return Corresponding_Spec (N); + + -- The unit denotes an anonymous package created to wrap a subprogram + -- instantiation which acts as a compilation unit. The proper entity is + -- that of the "related instance". + + elsif Nkind (N) = N_Package_Declaration + and then Nkind_In (Orig_N, N_Function_Instantiation, + N_Procedure_Instantiation) + and then Nkind (Context) = N_Compilation_Unit + then + return + Related_Instance (Defining_Entity (N, Concurrent_Subunit => True)); + + -- Otherwise the proper entity is the defining entity + + else + return Defining_Entity (N, Concurrent_Subunit => True); + end if; + end Find_Unit_Entity; + + ----------------------- + -- First_Formal_Type -- + ----------------------- + + function First_Formal_Type (Subp_Id : Entity_Id) return Entity_Id is + Formal_Id : constant Entity_Id := First_Formal (Subp_Id); + Typ : Entity_Id; + + begin + if Present (Formal_Id) then + Typ := Etype (Formal_Id); + + -- Handle various combinations of concurrent and private types + + loop + if Ekind_In (Typ, E_Protected_Type, E_Task_Type) + and then Present (Anonymous_Object (Typ)) + then + Typ := Anonymous_Object (Typ); + + elsif Is_Concurrent_Record_Type (Typ) then + Typ := Corresponding_Concurrent_Type (Typ); + + elsif Is_Private_Type (Typ) and then Present (Full_View (Typ)) then + Typ := Full_View (Typ); + + else + exit; + end if; + end loop; + + return Typ; + end if; + + return Empty; + end First_Formal_Type; + + -------------- + -- Has_Body -- + -------------- + + function Has_Body (Pack_Decl : Node_Id) return Boolean is + function Find_Corresponding_Body (Spec_Id : Entity_Id) return Node_Id; + -- Try to locate the corresponding body of spec Spec_Id. If no body is + -- found, return Empty. + + function Find_Body + (Spec_Id : Entity_Id; + From : Node_Id) return Node_Id; + -- Try to locate the corresponding body of spec Spec_Id in the node list + -- which follows arbitrary node From. If no body is found, return Empty. + + function Load_Package_Body (Unit_Nam : Unit_Name_Type) return Node_Id; + -- Attempt to load the body of unit Unit_Nam. If the load failed, return + -- Empty. If the compilation will not generate code, return Empty. + + ----------------------------- + -- Find_Corresponding_Body -- + ----------------------------- + + function Find_Corresponding_Body (Spec_Id : Entity_Id) return Node_Id is + Context : constant Entity_Id := Scope (Spec_Id); + Spec_Decl : constant Node_Id := Unit_Declaration_Node (Spec_Id); + Body_Decl : Node_Id; + Body_Id : Entity_Id; + + begin + if Is_Compilation_Unit (Spec_Id) then + Body_Id := Corresponding_Body (Spec_Decl); + + if Present (Body_Id) then + return Unit_Declaration_Node (Body_Id); + + -- The package is at the library and requires a body. Load the + -- corresponding body because the optional body may be declared + -- there. + + elsif Unit_Requires_Body (Spec_Id) then + return + Load_Package_Body + (Get_Body_Name (Unit_Name (Get_Source_Unit (Spec_Decl)))); + + -- Otherwise there is no optional body + + else + return Empty; + end if; + + -- The immediate context is a package. The optional body may be + -- within the body of that package. + + -- procedure Proc is + -- package Nested_1 is + -- package Nested_2 is + -- generic + -- package Pack is + -- end Pack; + -- end Nested_2; + -- end Nested_1; + + -- package body Nested_1 is + -- package body Nested_2 is separate; + -- end Nested_1; + + -- separate (Proc.Nested_1.Nested_2) + -- package body Nested_2 is + -- package body Pack is -- optional body + -- ... + -- end Pack; + -- end Nested_2; + + elsif Is_Package_Or_Generic_Package (Context) then + Body_Decl := Find_Corresponding_Body (Context); + + -- The optional body is within the body of the enclosing package + + if Present (Body_Decl) then + return + Find_Body + (Spec_Id => Spec_Id, + From => First (Declarations (Body_Decl))); + + -- Otherwise the enclosing package does not have a body. This may + -- be the result of an error or a genuine lack of a body. + + else + return Empty; + end if; + + -- Otherwise the immediate context is a body. The optional body may + -- be within the same list as the spec. + + -- procedure Proc is + -- generic + -- package Pack is + -- end Pack; + + -- package body Pack is -- optional body + -- ... + -- end Pack; + + else + return + Find_Body + (Spec_Id => Spec_Id, + From => Next (Spec_Decl)); + end if; + end Find_Corresponding_Body; + + --------------- + -- Find_Body -- + --------------- + + function Find_Body + (Spec_Id : Entity_Id; + From : Node_Id) return Node_Id + is + Spec_Nam : constant Name_Id := Chars (Spec_Id); + Item : Node_Id; + Lib_Unit : Node_Id; + + begin + Item := From; + while Present (Item) loop + + -- The current item denotes the optional body + + if Nkind (Item) = N_Package_Body + and then Chars (Defining_Entity (Item)) = Spec_Nam + then + return Item; + + -- The current item denotes a stub, the optional body may be in + -- the subunit. + + elsif Nkind (Item) = N_Package_Body_Stub + and then Chars (Defining_Entity (Item)) = Spec_Nam + then + Lib_Unit := Library_Unit (Item); + + -- The corresponding subunit was previously loaded + + if Present (Lib_Unit) then + return Lib_Unit; + + -- Otherwise attempt to load the corresponding subunit + + else + return Load_Package_Body (Get_Unit_Name (Item)); + end if; + end if; + + Next (Item); + end loop; + + return Empty; + end Find_Body; + + ----------------------- + -- Load_Package_Body -- + ----------------------- + + function Load_Package_Body (Unit_Nam : Unit_Name_Type) return Node_Id is + Body_Decl : Node_Id; + Unit_Num : Unit_Number_Type; + + begin + -- The load is performed only when the compilation will generate code + + if Operating_Mode = Generate_Code then + Unit_Num := + Load_Unit + (Load_Name => Unit_Nam, + Required => False, + Subunit => False, + Error_Node => Pack_Decl); + + -- The load failed most likely because the physical file is + -- missing. + + if Unit_Num = No_Unit then + return Empty; + + -- Otherwise the load was successful, return the body of the unit + + else + Body_Decl := Unit (Cunit (Unit_Num)); + + -- If the unit is a subunit with an available proper body, + -- return the proper body. + + if Nkind (Body_Decl) = N_Subunit + and then Present (Proper_Body (Body_Decl)) + then + Body_Decl := Proper_Body (Body_Decl); + end if; + + return Body_Decl; + end if; + end if; + + return Empty; + end Load_Package_Body; + + -- Local variables + + Pack_Id : constant Entity_Id := Defining_Entity (Pack_Decl); + + -- Start of processing for Has_Body + + begin + -- The body is available + + if Present (Corresponding_Body (Pack_Decl)) then + return True; + + -- The body is required if the package spec contains a construct which + -- requires a completion in a body. + + elsif Unit_Requires_Body (Pack_Id) then + return True; + + -- The body may be optional + + else + return Present (Find_Corresponding_Body (Pack_Id)); + end if; + end Has_Body; + + --------------------------- + -- Has_Prior_Elaboration -- + --------------------------- + + function Has_Prior_Elaboration + (Unit_Id : Entity_Id; + Context_OK : Boolean := False; + Elab_Body_OK : Boolean := False; + Same_Unit_OK : Boolean := False) return Boolean + is + Main_Id : constant Entity_Id := Cunit_Entity (Main_Unit); + + begin + -- A preelaborated unit is always elaborated prior to the main unit + + if Is_Preelaborated_Unit (Unit_Id) then + return True; + + -- An internal unit is always elaborated prior to a non-internal main + -- unit. + + elsif In_Internal_Unit (Unit_Id) + and then not In_Internal_Unit (Main_Id) + then + return True; + + -- A unit has prior elaboration if it appears within the context of the + -- main unit. Consider this case only when requested by the caller. + + elsif Context_OK + and then Elaboration_Context.Get (Unit_Id) /= No_Elaboration_Attributes + then + return True; + + -- A unit whose body is elaborated together with its spec has prior + -- elaboration except with respect to itself. Consider this case only + -- when requested by the caller. + + elsif Elab_Body_OK + and then Has_Pragma_Elaborate_Body (Unit_Id) + and then not Is_Same_Unit (Unit_Id, Main_Id) + then + return True; + + -- A unit has no prior elaboration with respect to itself, but does not + -- require any means of ensuring its own elaboration either. Treat this + -- case as valid prior elaboration only when requested by the caller. + + elsif Same_Unit_OK and then Is_Same_Unit (Unit_Id, Main_Id) then + return True; + end if; + + return False; + end Has_Prior_Elaboration; + + -------------------------- + -- In_External_Instance -- + -------------------------- + + function In_External_Instance + (N : Node_Id; + Target_Decl : Node_Id) return Boolean + is + Dummy : Node_Id; + Inst_Body : Node_Id; + Inst_Decl : Node_Id; + + begin + -- Performance note: parent traversal + + Inst_Decl := Find_Enclosing_Instance (Target_Decl); + + -- The target declaration appears within an instance spec. Visibility is + -- ignored because internally generated primitives for private types may + -- reside in the private declarations and still be invoked from outside. + + if Present (Inst_Decl) + and then Nkind (Inst_Decl) = N_Package_Declaration + then + -- The scenario comes from the main unit and the instance does not + + if In_Extended_Main_Code_Unit (N) + and then not In_Extended_Main_Code_Unit (Inst_Decl) + then + return True; + + -- Otherwise the scenario must not appear within the instance spec or + -- body. + + else + Extract_Instance_Attributes + (Exp_Inst => Inst_Decl, + Inst_Body => Inst_Body, + Inst_Decl => Dummy); + + -- Performance note: parent traversal + + return not In_Subtree + (N => N, + Root1 => Inst_Decl, + Root2 => Inst_Body); + end if; + end if; + + return False; + end In_External_Instance; + + --------------------- + -- In_Main_Context -- + --------------------- + + function In_Main_Context (N : Node_Id) return Boolean is + begin + -- Scenarios outside the main unit are not considered because the ALI + -- information supplied to binde is for the main unit only. + + if not In_Extended_Main_Code_Unit (N) then + return False; + + -- Scenarios within internal units are not considered unless switch + -- -gnatdE (elaboration checks on predefined units) is in effect. + + elsif not Debug_Flag_EE and then In_Internal_Unit (N) then + return False; + end if; + + return True; + end In_Main_Context; + + --------------------- + -- In_Same_Context -- + --------------------- + + function In_Same_Context + (N1 : Node_Id; + N2 : Node_Id; + Nested_OK : Boolean := False) return Boolean + is + function Find_Enclosing_Context (N : Node_Id) return Node_Id; + -- Return the nearest enclosing non-library level or compilation unit + -- node which which encapsulates arbitrary node N. Return Empty is no + -- such context is available. + + function In_Nested_Context + (Outer : Node_Id; + Inner : Node_Id) return Boolean; + -- Determine whether arbitrary node Outer encapsulates arbitrary node + -- Inner. + + ---------------------------- + -- Find_Enclosing_Context -- + ---------------------------- + + function Find_Enclosing_Context (N : Node_Id) return Node_Id is + Context : Node_Id; + Par : Node_Id; + + begin + Par := Parent (N); + while Present (Par) loop + + -- A traversal from a subunit continues via the corresponding stub + + if Nkind (Par) = N_Subunit then + Par := Corresponding_Stub (Par); + + -- Stop the traversal when the nearest enclosing non-library level + -- encapsulator has been reached. + + elsif Is_Non_Library_Level_Encapsulator (Par) then + Context := Parent (Par); + + -- The sole exception is when the encapsulator is the unit of + -- compilation because this case requires special processing + -- (see below). + + if Present (Context) + and then Nkind (Context) = N_Compilation_Unit + then + null; + + else + return Par; + end if; + + -- Reaching a compilation unit node without hitting a non-library + -- level encapsulator indicates that N is at the library level in + -- which case the compilation unit is the context. + + elsif Nkind (Par) = N_Compilation_Unit then + return Par; + end if; + + Par := Parent (Par); + end loop; + + return Empty; + end Find_Enclosing_Context; + + ----------------------- + -- In_Nested_Context -- + ----------------------- + + function In_Nested_Context + (Outer : Node_Id; + Inner : Node_Id) return Boolean + is + Par : Node_Id; + + begin + Par := Inner; + while Present (Par) loop + + -- A traversal from a subunit continues via the corresponding stub + + if Nkind (Par) = N_Subunit then + Par := Corresponding_Stub (Par); + + elsif Par = Outer then + return True; + end if; + + Par := Parent (Par); + end loop; + + return False; + end In_Nested_Context; + + -- Local variables + + Context_1 : constant Node_Id := Find_Enclosing_Context (N1); + Context_2 : constant Node_Id := Find_Enclosing_Context (N2); + + -- Start of processing for In_Same_Context + + begin + -- Both nodes appear within the same context + + if Context_1 = Context_2 then + return True; + + -- Both nodes appear in compilation units. Determine whether one unit + -- is the body of the other. + + elsif Nkind (Context_1) = N_Compilation_Unit + and then Nkind (Context_2) = N_Compilation_Unit + then + return + Is_Same_Unit + (Unit_1 => Defining_Entity (Unit (Context_1)), + Unit_2 => Defining_Entity (Unit (Context_2))); + + -- The context of N1 encloses the context of N2 + + elsif Nested_OK and then In_Nested_Context (Context_1, Context_2) then + return True; + end if; + + return False; + end In_Same_Context; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize is + begin + -- Set the soft link which enables Atree.Rewrite to update a top level + -- scenario each time it is transformed into another node. + + Set_Rewriting_Proc (Update_Elaboration_Scenario'Access); + end Initialize; + + --------------- + -- Info_Call -- + --------------- + + procedure Info_Call + (Call : Node_Id; + Target_Id : Entity_Id; + Info_Msg : Boolean; + In_SPARK : Boolean) + is + procedure Info_Accept_Alternative; + pragma Inline (Info_Accept_Alternative); + -- Output information concerning an accept alternative + + procedure Info_Simple_Call; + pragma Inline (Info_Simple_Call); + -- Output information concerning the call + + procedure Info_Type_Actions (Action : String); + pragma Inline (Info_Type_Actions); + -- Output information concerning action Action of a type + + procedure Info_Verification_Call + (Pred : String; + Id : Entity_Id; + Id_Kind : String); + pragma Inline (Info_Verification_Call); + -- Output information concerning the verification of predicate Pred + -- applied to related entity Id with kind Id_Kind. + + ----------------------------- + -- Info_Accept_Alternative -- + ----------------------------- + + procedure Info_Accept_Alternative is + Entry_Id : constant Entity_Id := Receiving_Entry (Target_Id); + + begin + pragma Assert (Present (Entry_Id)); + + Elab_Msg_NE + (Msg => "accept for entry & during elaboration", + N => Call, + Id => Entry_Id, + Info_Msg => Info_Msg, + In_SPARK => In_SPARK); + end Info_Accept_Alternative; + + ---------------------- + -- Info_Simple_Call -- + ---------------------- + + procedure Info_Simple_Call is + begin + Elab_Msg_NE + (Msg => "call to & during elaboration", + N => Call, + Id => Target_Id, + Info_Msg => Info_Msg, + In_SPARK => In_SPARK); + end Info_Simple_Call; + + ----------------------- + -- Info_Type_Actions -- + ----------------------- + + procedure Info_Type_Actions (Action : String) is + Typ : constant Entity_Id := First_Formal_Type (Target_Id); + + begin + pragma Assert (Present (Typ)); + + Elab_Msg_NE + (Msg => Action & " actions for type & during elaboration", + N => Call, + Id => Typ, + Info_Msg => Info_Msg, + In_SPARK => In_SPARK); + end Info_Type_Actions; + + ---------------------------- + -- Info_Verification_Call -- + ---------------------------- + + procedure Info_Verification_Call + (Pred : String; + Id : Entity_Id; + Id_Kind : String) + is + begin + pragma Assert (Present (Id)); + + Elab_Msg_NE + (Msg => + "verification of " & Pred & " of " & Id_Kind & " & during " + & "elaboration", + N => Call, + Id => Id, + Info_Msg => Info_Msg, + In_SPARK => In_SPARK); + end Info_Verification_Call; + + -- Start of processing for Info_Call + + begin + -- Do not output anything for targets defined in internal units because + -- this creates noise. + + if not In_Internal_Unit (Target_Id) then + + -- Accept alternative + + if Is_Accept_Alternative_Proc (Target_Id) then + Info_Accept_Alternative; + + -- Adjustment + + elsif Is_TSS (Target_Id, TSS_Deep_Adjust) then + Info_Type_Actions ("adjustment"); + + -- Default_Initial_Condition + + elsif Is_Default_Initial_Condition_Proc (Target_Id) then + Info_Verification_Call + (Pred => "Default_Initial_Condition", + Id => First_Formal_Type (Target_Id), + Id_Kind => "type"); + + -- Entries + + elsif Is_Protected_Entry (Target_Id) then + Info_Simple_Call; + + -- Task entry calls are never processed because the entry being + -- invoked does not have a corresponding "body", it has a select. + + elsif Is_Task_Entry (Target_Id) then + null; + + -- Finalization + + elsif Is_TSS (Target_Id, TSS_Deep_Finalize) then + Info_Type_Actions ("finalization"); + + -- Calls to _Finalizer procedures must not appear in the output + -- because this creates confusing noise. + + elsif Is_Finalizer_Proc (Target_Id) then + null; + + -- Initial_Condition + + elsif Is_Initial_Condition_Proc (Target_Id) then + Info_Verification_Call + (Pred => "Initial_Condition", + Id => Find_Enclosing_Scope (Call), + Id_Kind => "package"); + + -- Initialization + + elsif Is_Init_Proc (Target_Id) + or else Is_TSS (Target_Id, TSS_Deep_Initialize) + then + Info_Type_Actions ("initialization"); + + -- Invariant + + elsif Is_Invariant_Proc (Target_Id) then + Info_Verification_Call + (Pred => "invariants", + Id => First_Formal_Type (Target_Id), + Id_Kind => "type"); + + -- Partial invariant calls must not appear in the output because this + -- creates confusing noise. + + elsif Is_Partial_Invariant_Proc (Target_Id) then + null; + + -- _Postconditions + + elsif Is_Postconditions_Proc (Target_Id) then + Info_Verification_Call + (Pred => "postconditions", + Id => Find_Enclosing_Scope (Call), + Id_Kind => "subprogram"); + + -- Subprograms must come last because some of the previous cases fall + -- under this category. + + elsif Ekind (Target_Id) = E_Function then + Info_Simple_Call; + + elsif Ekind (Target_Id) = E_Procedure then + Info_Simple_Call; + + else + pragma Assert (False); + null; + end if; + end if; + end Info_Call; + + ------------------------ + -- Info_Instantiation -- + ------------------------ + + procedure Info_Instantiation + (Inst : Node_Id; + Gen_Id : Entity_Id; + Info_Msg : Boolean; + In_SPARK : Boolean) + is + begin + Elab_Msg_NE + (Msg => "instantiation of & during elaboration", + N => Inst, + Id => Gen_Id, + Info_Msg => Info_Msg, + In_SPARK => In_SPARK); + end Info_Instantiation; + + ------------------------ + -- Info_Variable_Read -- + ------------------------ + + procedure Info_Variable_Read + (Ref : Node_Id; + Var_Id : Entity_Id; + Info_Msg : Boolean; + In_SPARK : Boolean) + is + begin + Elab_Msg_NE + (Msg => "read of variable & during elaboration", + N => Ref, + Id => Var_Id, + Info_Msg => Info_Msg, + In_SPARK => In_SPARK); + end Info_Variable_Read; + + -------------------- + -- Insertion_Node -- + -------------------- + + function Insertion_Node (N : Node_Id; Ins_Nod : Node_Id) return Node_Id is + begin + -- When the scenario denotes an instantiation, the proper insertion node + -- is the instance spec. This ensures that the generic actuals will not + -- be evaluated prior to a potential ABE. + + if Nkind (N) in N_Generic_Instantiation + and then Present (Instance_Spec (N)) + then + return Instance_Spec (N); + + -- Otherwise the proper insertion node is the candidate insertion node + + else + return Ins_Nod; + end if; + end Insertion_Node; + + ----------------------- + -- Install_ABE_Check -- + ----------------------- + + procedure Install_ABE_Check + (N : Node_Id; + Id : Entity_Id; + Ins_Nod : Node_Id) + is + Check_Ins_Nod : constant Node_Id := Insertion_Node (N, Ins_Nod); + -- Insert the check prior to this node + + Loc : constant Source_Ptr := Sloc (N); + Spec_Id : constant Entity_Id := Unique_Entity (Id); + Unit_Id : constant Entity_Id := Find_Top_Unit (Id); + Scop_Id : Entity_Id; + + begin + -- Nothing to do when compiling for GNATprove because raise statements + -- are not supported. + + if GNATprove_Mode then + return; + + -- Nothing to do when the compilation will not produce an executable + + elsif Serious_Errors_Detected > 0 then + return; + + -- Nothing to do for a compilation unit because there is no executable + -- environment at that level. + + elsif Nkind (Parent (Check_Ins_Nod)) = N_Compilation_Unit then + return; + + -- Nothing to do when the unit is elaborated prior to the main unit. + -- This check must also consider the following cases: + + -- * Id's unit appears in the context of the main unit + + -- * Id's unit is subject to pragma Elaborate_Body. An ABE check MUST + -- NOT be generated because Id's unit is always elaborated prior to + -- the main unit. + + -- * Id's unit is the main unit. An ABE check MUST be generated in this + -- case because a conditional ABE may be raised depending on the flow + -- of execution within the main unit (flag Same_Unit_OK is False). + + elsif Has_Prior_Elaboration + (Unit_Id => Unit_Id, + Context_OK => True, + Elab_Body_OK => True) + then + return; + end if; + + -- Prevent multiple scenarios from installing the same ABE check + + Set_Is_Elaboration_Checks_OK_Node (N, False); + + -- Install the nearest enclosing scope of the scenario as there must be + -- something on the scope stack. + + -- Performance note: parent traversal + + Scop_Id := Find_Enclosing_Scope (Check_Ins_Nod); + pragma Assert (Present (Scop_Id)); + + Push_Scope (Scop_Id); + + -- Generate: + -- if not Spec_Id'Elaborated then + -- raise Program_Error with "access before elaboration"; + -- end if; + + Insert_Action (Check_Ins_Nod, + Make_Raise_Program_Error (Loc, + Condition => + Make_Op_Not (Loc, + Right_Opnd => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Spec_Id, Loc), + Attribute_Name => Name_Elaborated)), + Reason => PE_Access_Before_Elaboration)); + + Pop_Scope; + end Install_ABE_Check; + + ----------------------- + -- Install_ABE_Check -- + ----------------------- + + procedure Install_ABE_Check + (N : Node_Id; + Target_Id : Entity_Id; + Target_Decl : Node_Id; + Target_Body : Node_Id; + Ins_Nod : Node_Id) + is + procedure Build_Elaboration_Entity; + pragma Inline (Build_Elaboration_Entity); + -- Create a new elaboration flag for Target_Id, insert it prior to + -- Target_Decl, and set it after Body_Decl. + + ------------------------------ + -- Build_Elaboration_Entity -- + ------------------------------ + + procedure Build_Elaboration_Entity is + Loc : constant Source_Ptr := Sloc (Target_Id); + Flag_Id : Entity_Id; + + begin + -- Create the declaration of the elaboration flag. The name carries a + -- unique counter in case of name overloading. + + Flag_Id := + Make_Defining_Identifier (Loc, + Chars => New_External_Name (Chars (Target_Id), 'E', -1)); + + Set_Elaboration_Entity (Target_Id, Flag_Id); + Set_Elaboration_Entity_Required (Target_Id); + + Push_Scope (Scope (Target_Id)); + + -- Generate: + -- Enn : Short_Integer := 0; + + Insert_Action (Target_Decl, + Make_Object_Declaration (Loc, + Defining_Identifier => Flag_Id, + Object_Definition => + New_Occurrence_Of (Standard_Short_Integer, Loc), + Expression => Make_Integer_Literal (Loc, Uint_0))); + + -- Generate: + -- Enn := 1; + + Set_Elaboration_Flag (Target_Body, Target_Id); + + Pop_Scope; + end Build_Elaboration_Entity; + + -- Local variables + + Target_Unit_Id : constant Entity_Id := Find_Top_Unit (Target_Id); + + -- Start for processing for Install_ABE_Check + + begin + -- Nothing to do when compiling for GNATprove because raise statements + -- are not supported. + + if GNATprove_Mode then + return; + + -- Nothing to do when the compilation will not produce an executable + + elsif Serious_Errors_Detected > 0 then + return; + + -- Nothing to do when the target is a protected subprogram because the + -- check is associated with the protected body subprogram. + + elsif Is_Protected_Subp (Target_Id) then + return; + + -- Nothing to do when the target is elaborated prior to the main unit. + -- This check must also consider the following cases: + + -- * The unit of the target appears in the context of the main unit + + -- * The unit of the target is subject to pragma Elaborate_Body. An ABE + -- check MUST NOT be generated because the unit is always elaborated + -- prior to the main unit. + + -- * The unit of the target is the main unit. An ABE check MUST be added + -- in this case because a conditional ABE may be raised depending on + -- the flow of execution within the main unit (flag Same_Unit_OK is + -- False). + + elsif Has_Prior_Elaboration + (Unit_Id => Target_Unit_Id, + Context_OK => True, + Elab_Body_OK => True) + then + return; + + -- Create an elaboration flag for the target when it does not have one + + elsif No (Elaboration_Entity (Target_Id)) then + Build_Elaboration_Entity; + end if; + + Install_ABE_Check + (N => N, + Ins_Nod => Ins_Nod, + Id => Target_Id); + end Install_ABE_Check; + + ------------------------- + -- Install_ABE_Failure -- + ------------------------- + + procedure Install_ABE_Failure (N : Node_Id; Ins_Nod : Node_Id) is + Fail_Ins_Nod : constant Node_Id := Insertion_Node (N, Ins_Nod); + -- Insert the failure prior to this node + + Loc : constant Source_Ptr := Sloc (N); + Scop_Id : Entity_Id; + + begin + -- Nothing to do when compiling for GNATprove because raise statements + -- are not supported. + + if GNATprove_Mode then + return; + + -- Nothing to do when the compilation will not produce an executable + + elsif Serious_Errors_Detected > 0 then + return; + + -- Do not install an ABE check for a compilation unit because there is + -- no executable environment at that level. + + elsif Nkind (Parent (Fail_Ins_Nod)) = N_Compilation_Unit then + return; + end if; + + -- Prevent multiple scenarios from installing the same ABE failure + + Set_Is_Elaboration_Checks_OK_Node (N, False); + + -- Install the nearest enclosing scope of the scenario as there must be + -- something on the scope stack. + + -- Performance note: parent traversal + + Scop_Id := Find_Enclosing_Scope (Fail_Ins_Nod); + pragma Assert (Present (Scop_Id)); + + Push_Scope (Scop_Id); + + -- Generate: + -- raise Program_Error with "access before elaboration"; + + Insert_Action (Fail_Ins_Nod, + Make_Raise_Program_Error (Loc, + Reason => PE_Access_Before_Elaboration)); + + Pop_Scope; + end Install_ABE_Failure; + + -------------------------------- + -- Is_Accept_Alternative_Proc -- + -------------------------------- + + function Is_Accept_Alternative_Proc (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote a procedure with a receiving entry + + return Ekind (Id) = E_Procedure and then Present (Receiving_Entry (Id)); + end Is_Accept_Alternative_Proc; + + ------------------------ + -- Is_Activation_Proc -- + ------------------------ + + function Is_Activation_Proc (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote one of the runtime procedures in + -- charge of task activation. + + if Ekind (Id) = E_Procedure then + if Restricted_Profile then + return Is_RTE (Id, RE_Activate_Restricted_Tasks); + else + return Is_RTE (Id, RE_Activate_Tasks); + end if; + end if; + + return False; + end Is_Activation_Proc; + + ---------------------------- + -- Is_Ada_Semantic_Target -- + ---------------------------- + + function Is_Ada_Semantic_Target (Id : Entity_Id) return Boolean is + begin + return + Is_Activation_Proc (Id) + or else Is_Controlled_Proc (Id, Name_Adjust) + or else Is_Controlled_Proc (Id, Name_Finalize) + or else Is_Controlled_Proc (Id, Name_Initialize) + or else Is_Init_Proc (Id) + or else Is_Invariant_Proc (Id) + or else Is_Protected_Entry (Id) + or else Is_Protected_Subp (Id) + or else Is_Protected_Body_Subp (Id) + or else Is_Task_Entry (Id); + end Is_Ada_Semantic_Target; + + ---------------------------- + -- Is_Bodiless_Subprogram -- + ---------------------------- + + function Is_Bodiless_Subprogram (Subp_Id : Entity_Id) return Boolean is + begin + -- An abstract subprogram does not have a body + + if Ekind_In (Subp_Id, E_Function, + E_Operator, + E_Procedure) + and then Is_Abstract_Subprogram (Subp_Id) + then + return True; + + -- A formal subprogram does not have a body + + elsif Is_Formal_Subprogram (Subp_Id) then + return True; + + -- An imported subprogram may have a body, however it is not known at + -- compile or bind time where the body resides and whether it will be + -- elaborated on time. + + elsif Is_Imported (Subp_Id) then + return True; + end if; + + return False; + end Is_Bodiless_Subprogram; + + -------------------------------- + -- Is_Check_Emitting_Scenario -- + -------------------------------- + + function Is_Check_Emitting_Scenario (N : Node_Id) return Boolean is + begin + return + Nkind_In (N, N_Call_Marker, + N_Function_Instantiation, + N_Package_Instantiation, + N_Procedure_Instantiation); + end Is_Check_Emitting_Scenario; + + ------------------------ + -- Is_Controlled_Proc -- + ------------------------ + + function Is_Controlled_Proc + (Subp_Id : Entity_Id; + Subp_Nam : Name_Id) return Boolean + is + Formal_Id : Entity_Id; + + begin + pragma Assert (Nam_In (Subp_Nam, Name_Adjust, + Name_Finalize, + Name_Initialize)); + + -- To qualify, the subprogram must denote a source procedure with name + -- Adjust, Finalize, or Initialize where the sole formal is controlled. + + if Comes_From_Source (Subp_Id) + and then Ekind (Subp_Id) = E_Procedure + and then Chars (Subp_Id) = Subp_Nam + then + Formal_Id := First_Formal (Subp_Id); + + return + Present (Formal_Id) + and then Is_Controlled (Etype (Formal_Id)) + and then No (Next_Formal (Formal_Id)); + end if; + + return False; + end Is_Controlled_Proc; + + --------------------------------------- + -- Is_Default_Initial_Condition_Proc -- + --------------------------------------- + + function Is_Default_Initial_Condition_Proc + (Id : Entity_Id) return Boolean + is + begin + -- To qualify, the entity must denote a Default_Initial_Condition + -- procedure. + + return Ekind (Id) = E_Procedure and then Is_DIC_Procedure (Id); + end Is_Default_Initial_Condition_Proc; + + ----------------------- + -- Is_Finalizer_Proc -- + ----------------------- + + function Is_Finalizer_Proc (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote a _Finalizer procedure + + return Ekind (Id) = E_Procedure and then Chars (Id) = Name_uFinalizer; + end Is_Finalizer_Proc; + + ----------------------- + -- Is_Guaranteed_ABE -- + ----------------------- + + function Is_Guaranteed_ABE + (N : Node_Id; + Target_Decl : Node_Id; + Target_Body : Node_Id) return Boolean + is + begin + -- Avoid cascaded errors if there were previous serious infractions. + -- As a result the scenario will not be treated as a guaranteed ABE. + -- This behaviour parallels that of the old ABE mechanism. + + if Serious_Errors_Detected > 0 then + return False; + + -- The scenario and the target appear within the same context ignoring + -- enclosing library levels. + + -- Performance note: parent traversal + + elsif In_Same_Context (N, Target_Decl) then + + -- The target body has already been encountered. The scenario results + -- in a guaranteed ABE if it appears prior to the body. + + if Present (Target_Body) then + return Earlier_In_Extended_Unit (N, Target_Body); + + -- Otherwise the body has not been encountered yet. The scenario is + -- a guaranteed ABE since the body will appear later. It is assumed + -- that the caller has already checked whether the scenario is ABE- + -- safe as optional bodies are not considered here. + + else + return True; + end if; + end if; + + return False; + end Is_Guaranteed_ABE; + + ------------------------------- + -- Is_Initial_Condition_Proc -- + ------------------------------- + + function Is_Initial_Condition_Proc (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote an Initial_Condition procedure + + return + Ekind (Id) = E_Procedure and then Is_Initial_Condition_Procedure (Id); + end Is_Initial_Condition_Proc; + + -------------------- + -- Is_Initialized -- + -------------------- + + function Is_Initialized (Obj_Decl : Node_Id) return Boolean is + begin + -- To qualify, the object declaration must have an expression + + return + Present (Expression (Obj_Decl)) or else Has_Init_Expression (Obj_Decl); + end Is_Initialized; + + ----------------------- + -- Is_Invariant_Proc -- + ----------------------- + + function Is_Invariant_Proc (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote the "full" invariant procedure + + return Ekind (Id) = E_Procedure and then Is_Invariant_Procedure (Id); + end Is_Invariant_Proc; + + --------------------------------------- + -- Is_Non_Library_Level_Encapsulator -- + --------------------------------------- + + function Is_Non_Library_Level_Encapsulator (N : Node_Id) return Boolean is + begin + case Nkind (N) is + when N_Abstract_Subprogram_Declaration + | N_Aspect_Specification + | N_Component_Declaration + | N_Entry_Body + | N_Entry_Declaration + | N_Expression_Function + | N_Formal_Abstract_Subprogram_Declaration + | N_Formal_Concrete_Subprogram_Declaration + | N_Formal_Object_Declaration + | N_Formal_Package_Declaration + | N_Formal_Type_Declaration + | N_Generic_Association + | N_Implicit_Label_Declaration + | N_Incomplete_Type_Declaration + | N_Private_Extension_Declaration + | N_Private_Type_Declaration + | N_Protected_Body + | N_Protected_Type_Declaration + | N_Single_Protected_Declaration + | N_Single_Task_Declaration + | N_Subprogram_Body + | N_Subprogram_Declaration + | N_Task_Body + | N_Task_Type_Declaration + => + return True; + + when others => + return Is_Generic_Declaration_Or_Body (N); + end case; + end Is_Non_Library_Level_Encapsulator; + + ------------------------------- + -- Is_Partial_Invariant_Proc -- + ------------------------------- + + function Is_Partial_Invariant_Proc (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote the "partial" invariant procedure + + return + Ekind (Id) = E_Procedure and then Is_Partial_Invariant_Procedure (Id); + end Is_Partial_Invariant_Proc; + + ---------------------------- + -- Is_Postconditions_Proc -- + ---------------------------- + + function Is_Postconditions_Proc (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote a _Postconditions procedure + + return + Ekind (Id) = E_Procedure and then Chars (Id) = Name_uPostconditions; + end Is_Postconditions_Proc; + + --------------------------- + -- Is_Preelaborated_Unit -- + --------------------------- + + function Is_Preelaborated_Unit (Id : Entity_Id) return Boolean is + begin + return + Is_Preelaborated (Id) + or else Is_Pure (Id) + or else Is_Remote_Call_Interface (Id) + or else Is_Remote_Types (Id) + or else Is_Shared_Passive (Id); + end Is_Preelaborated_Unit; + + ------------------------ + -- Is_Protected_Entry -- + ------------------------ + + function Is_Protected_Entry (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote an entry defined in a protected + -- type. + + return + Is_Entry (Id) + and then Is_Protected_Type (Non_Private_View (Scope (Id))); + end Is_Protected_Entry; + + ----------------------- + -- Is_Protected_Subp -- + ----------------------- + + function Is_Protected_Subp (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote a subprogram defined within a + -- protected type. + + return + Ekind_In (Id, E_Function, E_Procedure) + and then Is_Protected_Type (Non_Private_View (Scope (Id))); + end Is_Protected_Subp; + + ---------------------------- + -- Is_Protected_Body_Subp -- + ---------------------------- + + function Is_Protected_Body_Subp (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote a subprogram with attribute + -- Protected_Subprogram set. + + return + Ekind_In (Id, E_Function, E_Procedure) + and then Present (Protected_Subprogram (Id)); + end Is_Protected_Body_Subp; + + ------------------------ + -- Is_Safe_Activation -- + ------------------------ + + function Is_Safe_Activation + (Call : Node_Id; + Task_Decl : Node_Id) return Boolean + is + begin + -- The activation of a task coming from an external instance cannot + -- cause an ABE because the generic was already instantiated. Note + -- that the instantiation itself may lead to an ABE. + + return + In_External_Instance + (N => Call, + Target_Decl => Task_Decl); + end Is_Safe_Activation; + + ------------------ + -- Is_Safe_Call -- + ------------------ + + function Is_Safe_Call + (Call : Node_Id; + Target_Attrs : Target_Attributes) return Boolean + is + begin + -- The target is either an abstract subprogram, formal subprogram, or + -- imported, in which case it does not have a body at compile or bind + -- time. Assume that the call is ABE-safe. + + if Is_Bodiless_Subprogram (Target_Attrs.Spec_Id) then + return True; + + -- The target is an instantiation of a generic subprogram. The call + -- cannot cause an ABE because the generic was already instantiated. + -- Note that the instantiation itself may lead to an ABE. + + elsif Is_Generic_Instance (Target_Attrs.Spec_Id) then + return True; + + -- The invocation of a target coming from an external instance cannot + -- cause an ABE because the generic was already instantiated. Note that + -- the instantiation itself may lead to an ABE. + + elsif In_External_Instance + (N => Call, + Target_Decl => Target_Attrs.Spec_Decl) + then + return True; + + -- The target is a subprogram body without a previous declaration. The + -- call cannot cause an ABE because the body has already been seen. + + elsif Nkind (Target_Attrs.Spec_Decl) = N_Subprogram_Body + and then No (Corresponding_Spec (Target_Attrs.Spec_Decl)) + then + return True; + + -- The target is a subprogram body stub without a prior declaration. + -- The call cannot cause an ABE because the proper body substitutes + -- the stub. + + elsif Nkind (Target_Attrs.Spec_Decl) = N_Subprogram_Body_Stub + and then No (Corresponding_Spec_Of_Stub (Target_Attrs.Spec_Decl)) + then + return True; + + -- Subprogram bodies which wrap attribute references used as actuals + -- in instantiations are always ABE-safe. These bodies are artifacts + -- of expansion. + + elsif Present (Target_Attrs.Body_Decl) + and then Nkind (Target_Attrs.Body_Decl) = N_Subprogram_Body + and then Was_Attribute_Reference (Target_Attrs.Body_Decl) + then + return True; + end if; + + return False; + end Is_Safe_Call; + + --------------------------- + -- Is_Safe_Instantiation -- + --------------------------- + + function Is_Safe_Instantiation + (Inst : Node_Id; + Gen_Attrs : Target_Attributes) return Boolean + is + begin + -- The generic is an intrinsic subprogram in which case it does not + -- have a body at compile or bind time. Assume that the instantiation + -- is ABE-safe. + + if Is_Bodiless_Subprogram (Gen_Attrs.Spec_Id) then + return True; + + -- The instantiation of an external nested generic cannot cause an ABE + -- if the outer generic was already instantiated. Note that the instance + -- of the outer generic may lead to an ABE. + + elsif In_External_Instance + (N => Inst, + Target_Decl => Gen_Attrs.Spec_Decl) + then + return True; + + -- The generic is a package. The instantiation cannot cause an ABE when + -- the package has no body. + + elsif Ekind (Gen_Attrs.Spec_Id) = E_Generic_Package + and then not Has_Body (Gen_Attrs.Spec_Decl) + then + return True; + end if; + + return False; + end Is_Safe_Instantiation; + + ------------------ + -- Is_Same_Unit -- + ------------------ + + function Is_Same_Unit + (Unit_1 : Entity_Id; + Unit_2 : Entity_Id) return Boolean + is + function Is_Subunit (Unit_Id : Entity_Id) return Boolean; + pragma Inline (Is_Subunit); + -- Determine whether unit Unit_Id is a subunit + + function Normalize_Unit (Unit_Id : Entity_Id) return Entity_Id; + -- Strip a potential subunit chain ending with unit Unit_Id and return + -- the corresponding spec. + + ---------------- + -- Is_Subunit -- + ---------------- + + function Is_Subunit (Unit_Id : Entity_Id) return Boolean is + begin + return Nkind (Parent (Unit_Declaration_Node (Unit_Id))) = N_Subunit; + end Is_Subunit; + + -------------------- + -- Normalize_Unit -- + -------------------- + + function Normalize_Unit (Unit_Id : Entity_Id) return Entity_Id is + Result : Entity_Id; + + begin + -- Eliminate a potential chain of subunits to reach to proper body + + Result := Unit_Id; + while Present (Result) + and then Result /= Standard_Standard + and then Is_Subunit (Result) + loop + Result := Scope (Result); + end loop; + + -- Obtain the entity of the corresponding spec (if any) + + return Unique_Entity (Result); + end Normalize_Unit; + + -- Start of processing for Is_Same_Unit + + begin + return Normalize_Unit (Unit_1) = Normalize_Unit (Unit_2); + end Is_Same_Unit; + + ----------------- + -- Is_Scenario -- + ----------------- + + function Is_Scenario (N : Node_Id) return Boolean is + begin + case Nkind (N) is + when N_Assignment_Statement + | N_Attribute_Reference + | N_Call_Marker + | N_Entry_Call_Statement + | N_Expanded_Name + | N_Function_Call + | N_Function_Instantiation + | N_Identifier + | N_Package_Instantiation + | N_Procedure_Call_Statement + | N_Procedure_Instantiation + | N_Requeue_Statement + => + return True; + + when others => + return False; + end case; + end Is_Scenario; + + ------------------------------ + -- Is_SPARK_Semantic_Target -- + ------------------------------ + + function Is_SPARK_Semantic_Target (Id : Entity_Id) return Boolean is + begin + return + Is_Default_Initial_Condition_Proc (Id) + or else Is_Initial_Condition_Proc (Id); + end Is_SPARK_Semantic_Target; + + ------------------------ + -- Is_Suitable_Access -- + ------------------------ + + function Is_Suitable_Access (N : Node_Id) return Boolean is + Nam : Name_Id; + Pref : Node_Id; + Subp_Id : Entity_Id; + + begin + -- This scenario is relevant only when the static model is in effect + -- because it is graph-dependent and does not involve any run-time + -- checks. Allowing it in the dynamic model would create confusing + -- noise. + + if not Static_Elaboration_Checks then + return False; + + -- Nothing to do when switch -gnatd.U (ignore 'Access) is in effect + + elsif Debug_Flag_Dot_UU then + return False; + + -- Nothing to do when the scenario is not an attribute reference + + elsif Nkind (N) /= N_Attribute_Reference then + return False; + + -- Nothing to do for internally-generated attributes because they are + -- assumed to be ABE safe. + + elsif not Comes_From_Source (N) then + return False; + end if; + + Nam := Attribute_Name (N); + Pref := Prefix (N); + + -- Sanitize the prefix of the attribute + + if not Is_Entity_Name (Pref) then + return False; + + elsif No (Entity (Pref)) then + return False; + end if; - Context : Node_Id; - -- The context where the call to the subprogram occurs - end record; + Subp_Id := Entity (Pref); - package Elab_Visited is new Table.Table - (Table_Component_Type => Visited_Element, - Table_Index_Type => Int, - Table_Low_Bound => 1, - Table_Initial => 200, - Table_Increment => 100, - Table_Name => "Elab_Visited"); + if not Is_Subprogram_Or_Entry (Subp_Id) then + return False; + end if; - -- The following table records delayed calls which must be examined after - -- all generic bodies have been instantiated. + -- Traverse a possible chain of renamings to obtain the original entry + -- or subprogram which the prefix may rename. - type Delay_Element is record - N : Node_Id; - -- The parameter N from the call to Check_Internal_Call. Note that this - -- node may get rewritten over the delay period by expansion in the call - -- case (but not in the instantiation case). + Subp_Id := Get_Renamed_Entity (Subp_Id); - E : Entity_Id; - -- The parameter E from the call to Check_Internal_Call + -- To qualify, the attribute must meet the following prerequisites: - Orig_Ent : Entity_Id; - -- The parameter Orig_Ent from the call to Check_Internal_Call + return - Curscop : Entity_Id; - -- The current scope of the call. This is restored when we complete the - -- delayed call, so that we do this in the right scope. + -- The prefix must denote a source entry, operator, or subprogram + -- which is not imported. - Outer_Scope : Entity_Id; - -- Save scope of outer level call + Comes_From_Source (Subp_Id) + and then Is_Subprogram_Or_Entry (Subp_Id) + and then not Is_Bodiless_Subprogram (Subp_Id) - From_Elab_Code : Boolean; - -- Save indication of whether this call is from elaboration code + -- The attribute name must be one of the 'Access forms. Note that + -- 'Unchecked_Access cannot apply to a subprogram. - In_Task_Activation : Boolean; - -- Save indication of whether this call is from a task body. Tasks are - -- activated at the "begin", which is after all local procedure bodies, - -- so calls to those procedures can't fail, even if they occur after the - -- task body. + and then Nam_In (Nam, Name_Access, Name_Unrestricted_Access); + end Is_Suitable_Access; - From_SPARK_Code : Boolean; - -- Save indication of whether this call is under SPARK_Mode => On - end record; + ---------------------- + -- Is_Suitable_Call -- + ---------------------- - package Delay_Check is new Table.Table - (Table_Component_Type => Delay_Element, - Table_Index_Type => Int, - Table_Low_Bound => 1, - Table_Initial => 1000, - Table_Increment => 100, - Table_Name => "Delay_Check"); - - C_Scope : Entity_Id; - -- Top-level scope of current scope. Compute this only once at the outer - -- level, i.e. for a call to Check_Elab_Call from outside this unit. - - Outer_Level_Sloc : Source_Ptr; - -- Save Sloc value for outer level call node for comparisons of source - -- locations. A body is too late if it appears after the *outer* level - -- call, not the particular call that is being analyzed. - - From_Elab_Code : Boolean; - -- This flag shows whether the outer level call currently being examined - -- is or is not in elaboration code. We are only interested in calls to - -- routines in other units if this flag is True. - - In_Task_Activation : Boolean := False; - -- This flag indicates whether we are performing elaboration checks on task - -- bodies, at the point of activation. If true, we do not raise - -- Program_Error for calls to local procedures, because all local bodies - -- are known to be elaborated. However, we still need to trace such calls, - -- because a local procedure could call a procedure in another package, - -- so we might need an implicit Elaborate_All. - - Delaying_Elab_Checks : Boolean := True; - -- This is set True till the compilation is complete, including the - -- insertion of all instance bodies. Then when Check_Elab_Calls is called, - -- the delay table is used to make the delayed calls and this flag is reset - -- to False, so that the calls are processed. + function Is_Suitable_Call (N : Node_Id) return Boolean is + begin + -- Entry and subprogram calls are intentionally ignored because they + -- may undergo expansion depending on the compilation mode, previous + -- errors, generic context, etc. Call markers play the role of calls + -- and provide a uniform foundation for ABE processing. - ----------------------- - -- Local Subprograms -- - ----------------------- + return Nkind (N) = N_Call_Marker; + end Is_Suitable_Call; - -- Note: Outer_Scope in all following specs represents the scope of - -- interest of the outer level call. If it is set to Standard_Standard, - -- then it means the outer level call was at elaboration level, and that - -- thus all calls are of interest. If it was set to some other scope, - -- then the original call was an inner call, and we are not interested - -- in calls that go outside this scope. - - procedure Activate_Elaborate_All_Desirable (N : Node_Id; U : Entity_Id); - -- Analysis of construct N shows that we should set Elaborate_All_Desirable - -- for the WITH clause for unit U (which will always be present). A special - -- case is when N is a function or procedure instantiation, in which case - -- it is sufficient to set Elaborate_Desirable, since in this case there is - -- no possibility of transitive elaboration issues. - - procedure Check_A_Call - (N : Node_Id; - E : Entity_Id; - Outer_Scope : Entity_Id; - Inter_Unit_Only : Boolean; - Generate_Warnings : Boolean := True; - In_Init_Proc : Boolean := False); - -- This is the internal recursive routine that is called to check for - -- possible elaboration error. The argument N is a subprogram call or - -- generic instantiation, or 'Access attribute reference to be checked, and - -- E is the entity of the called subprogram, or instantiated generic unit, - -- or subprogram referenced by 'Access. - -- - -- In SPARK mode, N can also be a variable reference, since in SPARK this - -- also triggers a requirement for Elaborate_All, and in this case E is the - -- entity being referenced. - -- - -- Outer_Scope is the outer level scope for the original reference. - -- Inter_Unit_Only is set if the call is only to be checked in the - -- case where it is to another unit (and skipped if within a unit). - -- Generate_Warnings is set to False to suppress warning messages about - -- missing pragma Elaborate_All's. These messages are not wanted for - -- inner calls in the dynamic model. Note that an instance of the Access - -- attribute applied to a subprogram also generates a call to this - -- procedure (since the referenced subprogram may be called later - -- indirectly). Flag In_Init_Proc should be set whenever the current - -- context is a type init proc. - -- - -- Note: this might better be called Check_A_Reference to recognize the - -- variable case for SPARK, but we prefer to retain the historical name - -- since in practice this is mostly about checking calls for the possible - -- occurrence of an access-before-elaboration exception. - - procedure Check_Bad_Instantiation (N : Node_Id); - -- N is a node for an instantiation (if called with any other node kind, - -- Check_Bad_Instantiation ignores the call). This subprogram checks for - -- the special case of a generic instantiation of a generic spec in the - -- same declarative part as the instantiation where a body is present and - -- has not yet been seen. This is an obvious error, but needs to be checked - -- specially at the time of the instantiation, since it is a case where we - -- cannot insert the body anywhere. If this case is detected, warnings are - -- generated, and a raise of Program_Error is inserted. In addition any - -- subprograms in the generic spec are stubbed, and the Bad_Instantiation - -- flag is set on the instantiation node. The caller in Sem_Ch12 uses this - -- flag as an indication that no attempt should be made to insert an - -- instance body. - - procedure Check_Internal_Call - (N : Node_Id; - E : Entity_Id; - Outer_Scope : Entity_Id; - Orig_Ent : Entity_Id); - -- N is a function call or procedure statement call node and E is the - -- entity of the called function, which is within the current compilation - -- unit (where subunits count as part of the parent). This call checks if - -- this call, or any call within any accessed body could cause an ABE, and - -- if so, outputs a warning. Orig_Ent differs from E only in the case of - -- renamings, and points to the original name of the entity. This is used - -- for error messages. Outer_Scope is the outer level scope for the - -- original call. - - procedure Check_Internal_Call_Continue - (N : Node_Id; - E : Entity_Id; - Outer_Scope : Entity_Id; - Orig_Ent : Entity_Id); - -- The processing for Check_Internal_Call is divided up into two phases, - -- and this represents the second phase. The second phase is delayed if - -- Delaying_Elab_Checks is set to True. In this delayed case, the first - -- phase makes an entry in the Delay_Check table, which is processed when - -- Check_Elab_Calls is called. N, E and Orig_Ent are as for the call to - -- Check_Internal_Call. Outer_Scope is the outer level scope for the - -- original call. - - function Has_Generic_Body (N : Node_Id) return Boolean; - -- N is a generic package instantiation node, and this routine determines - -- if this package spec does in fact have a generic body. If so, then - -- True is returned, otherwise False. Note that this is not at all the - -- same as checking if the unit requires a body, since it deals with - -- the case of optional bodies accurately (i.e. if a body is optional, - -- then it looks to see if a body is actually present). Note: this - -- function can only do a fully correct job if in generating code mode - -- where all bodies have to be present. If we are operating in semantics - -- check only mode, then in some cases of optional bodies, a result of - -- False may incorrectly be given. In practice this simply means that - -- some cases of warnings for incorrect order of elaboration will only - -- be given when generating code, which is not a big problem (and is - -- inevitable, given the optional body semantics of Ada). - - procedure Insert_Elab_Check (N : Node_Id; C : Node_Id := Empty); - -- Given code for an elaboration check (or unconditional raise if the check - -- is not needed), inserts the code in the appropriate place. N is the call - -- or instantiation node for which the check code is required. C is the - -- test whose failure triggers the raise. - - function Is_Call_Of_Generic_Formal (N : Node_Id) return Boolean; - -- Returns True if node N is a call to a generic formal subprogram - - function Is_Finalization_Procedure (Id : Entity_Id) return Boolean; - -- Determine whether entity Id denotes a [Deep_]Finalize procedure - - procedure Output_Calls - (N : Node_Id; - Check_Elab_Flag : Boolean); - -- Outputs chain of calls stored in the Elab_Call table. The caller has - -- already generated the main warning message, so the warnings generated - -- are all continuation messages. The argument is the call node at which - -- the messages are to be placed. When Check_Elab_Flag is set, calls are - -- enumerated only when flag Elab_Warning is set for the dynamic case or - -- when flag Elab_Info_Messages is set for the static case. - - function Same_Elaboration_Scope (Scop1, Scop2 : Entity_Id) return Boolean; - -- Given two scopes, determine whether they are the same scope from an - -- elaboration point of view, i.e. packages and blocks are ignored. - - procedure Set_C_Scope; - -- On entry C_Scope is set to some scope. On return, C_Scope is reset - -- to be the enclosing compilation unit of this scope. - - function Get_Referenced_Ent (N : Node_Id) return Entity_Id; - -- N is either a function or procedure call or an access attribute that - -- references a subprogram. This call retrieves the relevant entity. If - -- this is a call to a protected subprogram, the entity is a selected - -- component. The callable entity may be absent, in which case Empty is - -- returned. This happens with non-analyzed calls in nested generics. - -- - -- If SPARK_Mode is On, then N can also be a reference to an E_Variable - -- entity, in which case, the value returned is simply this entity. - - procedure Set_Elaboration_Constraint - (Call : Node_Id; - Subp : Entity_Id; - Scop : Entity_Id); - -- The current unit U may depend semantically on some unit P that is not - -- in the current context. If there is an elaboration call that reaches P, - -- we need to indicate that P requires an Elaborate_All, but this is not - -- effective in U's ali file, if there is no with_clause for P. In this - -- case we add the Elaborate_All on the unit Q that directly or indirectly - -- makes P available. This can happen in two cases: - -- - -- a) Q declares a subtype of a type declared in P, and the call is an - -- initialization call for an object of that subtype. - -- - -- b) Q declares an object of some tagged type whose root type is - -- declared in P, and the initialization call uses object notation on - -- that object to reach a primitive operation or a classwide operation - -- declared in P. - -- - -- If P appears in the context of U, the current processing is correct. - -- Otherwise we must identify these two cases to retrieve Q and place the - -- Elaborate_All_Desirable on it. - - function Spec_Entity (E : Entity_Id) return Entity_Id; - -- Given a compilation unit entity, if it is a spec entity, it is returned - -- unchanged. If it is a body entity, then the spec for the corresponding - -- spec is returned - - procedure Supply_Bodies (N : Node_Id); - -- Given a node, N, that is either a subprogram declaration or a package - -- declaration, this procedure supplies dummy bodies for the subprogram - -- or for all subprograms in the package. If the given node is not one of - -- these two possibilities, then Supply_Bodies does nothing. The dummy body - -- contains a single Raise statement. - - procedure Supply_Bodies (L : List_Id); - -- Calls Supply_Bodies for all elements of the given list L - - function Within (E1, E2 : Entity_Id) return Boolean; - -- Given two scopes E1 and E2, returns True if E1 is equal to E2, or is one - -- of its contained scopes, False otherwise. - - function Within_Elaborate_All - (Unit : Unit_Number_Type; - E : Entity_Id) return Boolean; - -- Return True if we are within the scope of an Elaborate_All for E, or if - -- we are within the scope of an Elaborate_All for some other unit U, and U - -- with's E. This prevents spurious warnings when the called entity is - -- renamed within U, or in case of generic instances. + ------------------------------- + -- Is_Suitable_Instantiation -- + ------------------------------- - -------------------------------------- - -- Activate_Elaborate_All_Desirable -- - -------------------------------------- + function Is_Suitable_Instantiation (N : Node_Id) return Boolean is + Orig_N : constant Node_Id := Original_Node (N); + -- Use the original node in case an instantiation library unit is + -- rewritten as a package or subprogram. - procedure Activate_Elaborate_All_Desirable (N : Node_Id; U : Entity_Id) is - UN : constant Unit_Number_Type := Get_Code_Unit (N); - CU : constant Node_Id := Cunit (UN); - UE : constant Entity_Id := Cunit_Entity (UN); - Unm : constant Unit_Name_Type := Unit_Name (UN); - CI : constant List_Id := Context_Items (CU); - Itm : Node_Id; - Ent : Entity_Id; + begin + -- To qualify, the instantiation must come from source - procedure Add_To_Context_And_Mark (Itm : Node_Id); - -- This procedure is called when the elaborate indication must be - -- applied to a unit not in the context of the referencing unit. The - -- unit gets added to the context as an implicit with. + return + Comes_From_Source (Orig_N) + and then Nkind (Orig_N) in N_Generic_Instantiation; + end Is_Suitable_Instantiation; - function In_Withs_Of (UEs : Entity_Id) return Boolean; - -- UEs is the spec entity of a unit. If the unit to be marked is - -- in the context item list of this unit spec, then the call returns - -- True and Itm is left set to point to the relevant N_With_Clause node. + -------------------------- + -- Is_Suitable_Scenario -- + -------------------------- - procedure Set_Elab_Flag (Itm : Node_Id); - -- Sets Elaborate_[All_]Desirable as appropriate on Itm + function Is_Suitable_Scenario (N : Node_Id) return Boolean is + begin + return + Is_Suitable_Access (N) + or else Is_Suitable_Call (N) + or else Is_Suitable_Instantiation (N) + or else Is_Suitable_Variable_Assignment (N) + or else Is_Suitable_Variable_Read (N); + end Is_Suitable_Scenario; + + ------------------------------------- + -- Is_Suitable_Variable_Assignment -- + ------------------------------------- + + function Is_Suitable_Variable_Assignment (N : Node_Id) return Boolean is + N_Unit : Node_Id; + N_Unit_Id : Entity_Id; + Nam : Node_Id; + Var_Decl : Node_Id; + Var_Id : Entity_Id; + Var_Unit : Node_Id; + Var_Unit_Id : Entity_Id; - ----------------------------- - -- Add_To_Context_And_Mark -- - ----------------------------- + begin + -- This scenario is relevant only when the static model is in effect + -- because it is graph-dependent and does not involve any run-time + -- checks. Allowing it in the dynamic model would create confusing + -- noise. - procedure Add_To_Context_And_Mark (Itm : Node_Id) is - CW : constant Node_Id := - Make_With_Clause (Sloc (Itm), - Name => Name (Itm)); + if not Static_Elaboration_Checks then + return False; - begin - Set_Library_Unit (CW, Library_Unit (Itm)); - Set_Implicit_With (CW, True); + -- Nothing to do when the scenario is not an assignment - -- Set elaborate all desirable on copy and then append the copy to - -- the list of body with's and we are done. + elsif Nkind (N) /= N_Assignment_Statement then + return False; - Set_Elab_Flag (CW); - Append_To (CI, CW); - end Add_To_Context_And_Mark; + -- Nothing to do for internally-generated assignments because they are + -- assumed to be ABE safe. - ----------------- - -- In_Withs_Of -- - ----------------- + elsif not Comes_From_Source (N) then + return False; - function In_Withs_Of (UEs : Entity_Id) return Boolean is - UNs : constant Unit_Number_Type := Get_Source_Unit (UEs); - CUs : constant Node_Id := Cunit (UNs); - CIs : constant List_Id := Context_Items (CUs); + -- Assignments are ignored in GNAT mode on the assumption that they are + -- ABE-safe. This behaviour parallels that of the old ABE mechanism. - begin - Itm := First (CIs); - while Present (Itm) loop - if Nkind (Itm) = N_With_Clause then - Ent := - Cunit_Entity (Get_Cunit_Unit_Number (Library_Unit (Itm))); + elsif GNAT_Mode then + return False; + end if; - if U = Ent then - return True; - end if; - end if; + Nam := Extract_Assignment_Name (N); - Next (Itm); - end loop; + -- Sanitize the left hand side of the assignment + if not Is_Entity_Name (Nam) then return False; - end In_Withs_Of; - ------------------- - -- Set_Elab_Flag -- - ------------------- + elsif No (Entity (Nam)) then + return False; + end if; - procedure Set_Elab_Flag (Itm : Node_Id) is - begin - if Nkind (N) in N_Subprogram_Instantiation then - Set_Elaborate_Desirable (Itm); - else - Set_Elaborate_All_Desirable (Itm); - end if; - end Set_Elab_Flag; + Var_Id := Entity (Nam); - -- Start of processing for Activate_Elaborate_All_Desirable + -- Sanitize the variable - begin - -- Do not set binder indication if expansion is disabled, as when - -- compiling a generic unit. + if Var_Id = Any_Id then + return False; - if not Expander_Active then - return; + elsif Ekind (Var_Id) /= E_Variable then + return False; end if; - -- If an instance of a generic package contains a controlled object (so - -- we're calling Initialize at elaboration time), and the instance is in - -- a package body P that says "with P;", then we need to return without - -- adding "pragma Elaborate_All (P);" to P. + Var_Decl := Declaration_Node (Var_Id); - if U = Main_Unit_Entity then - return; + if Nkind (Var_Decl) /= N_Object_Declaration then + return False; end if; - Itm := First (CI); - while Present (Itm) loop - if Nkind (Itm) = N_With_Clause then - Ent := Cunit_Entity (Get_Cunit_Unit_Number (Library_Unit (Itm))); + N_Unit_Id := Find_Top_Unit (N); + N_Unit := Unit_Declaration_Node (N_Unit_Id); - -- If we find it, then mark elaborate all desirable and return + Var_Unit_Id := Find_Top_Unit (Var_Decl); + Var_Unit := Unit_Declaration_Node (Var_Unit_Id); - if U = Ent then - Set_Elab_Flag (Itm); - return; - end if; - end if; + -- To qualify, the assignment must meet the following prerequisites: - Next (Itm); - end loop; + return + Comes_From_Source (Var_Id) - -- If we fall through then the with clause is not present in the - -- current unit. One legitimate possibility is that the with clause - -- is present in the spec when we are a body. + -- The variable must be declared in the spec of compilation unit U - if Is_Body_Name (Unm) - and then In_Withs_Of (Spec_Entity (UE)) - then - Add_To_Context_And_Mark (Itm); - return; - end if; + and then Nkind (Var_Unit) = N_Package_Declaration - -- Similarly, we may be in the spec or body of a child unit, where - -- the unit in question is with'ed by some ancestor of the child unit. + -- Performance note: parent traversal - if Is_Child_Name (Unm) then - declare - Pkg : Entity_Id; + and then Find_Enclosing_Level (Var_Decl) = Package_Spec - begin - Pkg := UE; - loop - Pkg := Scope (Pkg); - exit when Pkg = Standard_Standard; - - if In_Withs_Of (Pkg) then - Add_To_Context_And_Mark (Itm); - return; - end if; - end loop; - end; - end if; + -- The assignment must occur in the body of compilation unit U - -- Here if we do not find with clause on spec or body. We just ignore - -- this case; it means that the elaboration involves some other unit - -- than the unit being compiled, and will be caught elsewhere. - end Activate_Elaborate_All_Desirable; + and then Nkind (N_Unit) = N_Package_Body + and then Present (Corresponding_Body (Var_Unit)) + and then Corresponding_Body (Var_Unit) = N_Unit_Id; + end Is_Suitable_Variable_Assignment; - ------------------ - -- Check_A_Call -- - ------------------ + ------------------------------- + -- Is_Suitable_Variable_Read -- + ------------------------------- - procedure Check_A_Call - (N : Node_Id; - E : Entity_Id; - Outer_Scope : Entity_Id; - Inter_Unit_Only : Boolean; - Generate_Warnings : Boolean := True; - In_Init_Proc : Boolean := False) - is - Access_Case : constant Boolean := Nkind (N) = N_Attribute_Reference; - -- Indicates if we have Access attribute case - - function Call_To_Instance_From_Outside (Id : Entity_Id) return Boolean; - -- True if we're calling an instance of a generic subprogram, or a - -- subprogram in an instance of a generic package, and the call is - -- outside that instance. - - procedure Elab_Warning - (Msg_D : String; - Msg_S : String; - Ent : Node_Or_Entity_Id); - -- Generate a call to Error_Msg_NE with parameters Msg_D or Msg_S (for - -- dynamic or static elaboration model), N and Ent. Msg_D is a real - -- warning (output if Msg_D is non-null and Elab_Warnings is set), - -- Msg_S is an info message (output if Elab_Info_Messages is set). - - function Find_W_Scope return Entity_Id; - -- Find top-level scope for called entity (not following renamings - -- or derivations). This is where the Elaborate_All will go if it is - -- needed. We start with the called entity, except in the case of an - -- initialization procedure outside the current package, where the init - -- proc is in the root package, and we start from the entity of the name - -- in the call. + function Is_Suitable_Variable_Read (N : Node_Id) return Boolean is + function In_Pragma (Nod : Node_Id) return Boolean; + -- Determine whether arbitrary node Nod appears within a pragma - ----------------------------------- - -- Call_To_Instance_From_Outside -- - ----------------------------------- + function Is_Variable_Read (Ref : Node_Id) return Boolean; + -- Determine whether variable reference Ref constitutes a read + + --------------- + -- In_Pragma -- + --------------- - function Call_To_Instance_From_Outside (Id : Entity_Id) return Boolean is - Scop : Entity_Id := Id; + function In_Pragma (Nod : Node_Id) return Boolean is + Par : Node_Id; begin - loop - if Scop = Standard_Standard then - return False; - end if; + Par := Nod; + while Present (Par) loop + if Nkind (Par) = N_Pragma then + return True; - if Is_Generic_Instance (Scop) then - return not In_Open_Scopes (Scop); + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (Par) then + exit; end if; - Scop := Scope (Scop); + Par := Parent (Par); end loop; - end Call_To_Instance_From_Outside; - ------------------ - -- Elab_Warning -- - ------------------ + return False; + end In_Pragma; - procedure Elab_Warning - (Msg_D : String; - Msg_S : String; - Ent : Node_Or_Entity_Id) - is - begin - -- Dynamic elaboration checks, real warning + ---------------------- + -- Is_Variable_Read -- + ---------------------- - if Dynamic_Elaboration_Checks then - if not Access_Case then - if Msg_D /= "" and then Elab_Warnings then - Error_Msg_NE (Msg_D, N, Ent); - end if; + function Is_Variable_Read (Ref : Node_Id) return Boolean is + function Is_Out_Actual (Call : Node_Id) return Boolean; + -- Determine whether the corresponding formal of actual Ref which + -- appears in call Call has mode OUT. - -- In the access case emit first warning message as well, - -- otherwise list of calls will appear as errors. + ------------------- + -- Is_Out_Actual -- + ------------------- - elsif Elab_Warnings then - Error_Msg_NE (Msg_S, N, Ent); - end if; + function Is_Out_Actual (Call : Node_Id) return Boolean is + Actual : Node_Id; + Call_Attrs : Call_Attributes; + Formal : Entity_Id; + Target_Id : Entity_Id; - -- Static elaboration checks, info message + begin + Extract_Call_Attributes + (Call => Call, + Target_Id => Target_Id, + Attrs => Call_Attrs); + + -- Inspect the actual and formal parameters, trying to find the + -- corresponding formal for Ref. + + Actual := First_Actual (Call); + Formal := First_Formal (Target_Id); + while Present (Actual) and then Present (Formal) loop + if Actual = Ref then + return Ekind (Formal) = E_Out_Parameter; + end if; - else - if Elab_Info_Messages then - Error_Msg_NE (Msg_S, N, Ent); - end if; - end if; - end Elab_Warning; + Next_Actual (Actual); + Next_Formal (Formal); + end loop; + + return False; + end Is_Out_Actual; - ------------------ - -- Find_W_Scope -- - ------------------ + -- Local variables - function Find_W_Scope return Entity_Id is - Refed_Ent : constant Entity_Id := Get_Referenced_Ent (N); - W_Scope : Entity_Id; + Context : constant Node_Id := Parent (Ref); + + -- Start of processing for Is_Variable_Read begin - if Is_Init_Proc (Refed_Ent) - and then not In_Same_Extended_Unit (N, Refed_Ent) + -- The majority of variable references are reads, and they can appear + -- in a great number of contexts. To determine whether a reference is + -- a read, it is more practical to find out whether it is a write. + + -- A reference is a write when it appears immediately on the left- + -- hand side of an assignment. + + if Nkind (Context) = N_Assignment_Statement + and then Name (Context) = Ref then - W_Scope := Scope (Refed_Ent); - else - W_Scope := E; - end if; + return False; - -- Now loop through scopes to get to the enclosing compilation unit + -- A reference is a write when it acts as an actual in a subprogram + -- call and the corresponding formal has mode OUT. - while not Is_Compilation_Unit (W_Scope) loop - W_Scope := Scope (W_Scope); - end loop; + elsif Nkind_In (Context, N_Function_Call, + N_Procedure_Call_Statement) + and then Is_Out_Actual (Context) + then + return False; + end if; - return W_Scope; - end Find_W_Scope; + -- Any other reference is a read + + return True; + end Is_Variable_Read; -- Local variables - Inst_Case : constant Boolean := Nkind (N) in N_Generic_Instantiation; - -- Indicates if we have instantiation case - - Loc : constant Source_Ptr := Sloc (N); - - Variable_Case : constant Boolean := - Nkind (N) in N_Has_Entity - and then Present (Entity (N)) - and then Ekind (Entity (N)) = E_Variable; - -- Indicates if we have variable reference case - - W_Scope : constant Entity_Id := Find_W_Scope; - -- Top-level scope of directly called entity for subprogram. This - -- differs from E_Scope in the case where renamings or derivations - -- are involved, since it does not follow these links. W_Scope is - -- generally in a visible unit, and it is this scope that may require - -- an Elaborate_All. However, there are some cases (initialization - -- calls and calls involving object notation) where W_Scope might not - -- be in the context of the current unit, and there is an intermediate - -- package that is, in which case the Elaborate_All has to be placed - -- on this intermediate package. These special cases are handled in - -- Set_Elaboration_Constraint. - - Ent : Entity_Id; - Callee_Unit_Internal : Boolean; - Caller_Unit_Internal : Boolean; - Decl : Node_Id; - Inst_Callee : Source_Ptr; - Inst_Caller : Source_Ptr; - Unit_Callee : Unit_Number_Type; - Unit_Caller : Unit_Number_Type; - - Body_Acts_As_Spec : Boolean; - -- Set to true if call is to body acting as spec (no separate spec) - - Cunit_SC : Boolean := False; - -- Set to suppress dynamic elaboration checks where one of the - -- enclosing scopes has Elaboration_Checks_Suppressed set, or else - -- if a pragma Elaborate[_All] applies to that scope, in which case - -- warnings on the scope are also suppressed. For the internal case, - -- we ignore this flag. - - E_Scope : Entity_Id; - -- Top-level scope of entity for called subprogram. This value includes - -- following renamings and derivations, so this scope can be in a - -- non-visible unit. This is the scope that is to be investigated to - -- see whether an elaboration check is required. - - Is_DIC : Boolean; - -- Flag set when the subprogram being invoked is the procedure generated - -- for pragma Default_Initial_Condition. - - SPARK_Elab_Errors : Boolean; - -- Flag set when an entity is called or a variable is read during SPARK - -- dynamic elaboration. - - -- Start of processing for Check_A_Call - - begin - -- If the call is known to be within a local Suppress Elaboration - -- pragma, nothing to check. This can happen in task bodies. But - -- we ignore this for a call to a generic formal. - - if Nkind (N) in N_Subprogram_Call - and then No_Elaboration_Check (N) - and then not Is_Call_Of_Generic_Formal (N) - then - return; + Prag : Node_Id; + Var_Id : Entity_Id; - -- If this is a rewrite of a Valid_Scalars attribute, then nothing to - -- check, we don't mind in this case if the call occurs before the body - -- since this is all generated code. + -- Start of processing for Is_Suitable_Variable_Read - elsif Nkind (Original_Node (N)) = N_Attribute_Reference - and then Attribute_Name (Original_Node (N)) = Name_Valid_Scalars - then - return; + begin + -- This scenario is relevant only when the static model is in effect + -- because it is graph-dependent and does not involve any run-time + -- checks. Allowing it in the dynamic model would create confusing + -- noise. + + if not Static_Elaboration_Checks then + return False; - -- Intrinsics such as instances of Unchecked_Deallocation do not have - -- any body, so elaboration checking is not needed, and would be wrong. + -- Attributes and operator sumbols are not considered to be suitable + -- references even though they are part of predicate Is_Entity_Name. - elsif Is_Intrinsic_Subprogram (E) then - return; + elsif not Nkind_In (N, N_Expanded_Name, N_Identifier) then + return False; - -- Do not consider references to internal variables for SPARK semantics + -- Nothing to do for internally-generated references because they are + -- assumed to be ABE safe. - elsif Variable_Case and then not Comes_From_Source (E) then - return; + elsif not Comes_From_Source (N) then + return False; end if; - -- Proceed with check + -- Sanitize the reference - Ent := E; + Var_Id := Entity (N); - -- For a variable reference, just set Body_Acts_As_Spec to False + if No (Var_Id) then + return False; - if Variable_Case then - Body_Acts_As_Spec := False; + elsif Var_Id = Any_Id then + return False; - -- Additional checks for all other cases + elsif Ekind (Var_Id) /= E_Variable then + return False; + end if; - else - -- Go to parent for derived subprogram, or to original subprogram in - -- the case of a renaming (Alias covers both these cases). + Prag := SPARK_Pragma (Var_Id); - loop - if (Suppress_Elaboration_Warnings (Ent) - or else Elaboration_Checks_Suppressed (Ent)) - and then (Inst_Case or else No (Alias (Ent))) - then - return; - end if; + -- To qualify, the reference must meet the following prerequisites: - -- Nothing to do for imported entities + return + Comes_From_Source (Var_Id) - if Is_Imported (Ent) then - return; - end if; + -- Both the variable and the reference must appear in SPARK_Mode On + -- regions because this scenario falls under the SPARK rules. - exit when Inst_Case or else No (Alias (Ent)); - Ent := Alias (Ent); - end loop; + and then Present (Prag) + and then Get_SPARK_Mode_From_Annotation (Prag) = On + and then Is_SPARK_Mode_On_Node (N) - Decl := Unit_Declaration_Node (Ent); + -- The reference must denote a variable read - if Nkind (Decl) = N_Subprogram_Body then - Body_Acts_As_Spec := True; + and then Is_Variable_Read (N) - elsif Nkind_In (Decl, N_Subprogram_Declaration, - N_Subprogram_Body_Stub) - or else Inst_Case - then - Body_Acts_As_Spec := False; + -- The reference must not be considered when it appears in a pragma. + -- If the pragma has run-time semantics, then the reference will be + -- reconsidered once the pragma is expanded. - -- If we have none of an instantiation, subprogram body or subprogram - -- declaration, or in the SPARK case, a variable reference, then - -- it is not a case that we want to check. (One case is a call to a - -- generic formal subprogram, where we do not want the check in the - -- template). + -- Performance note: parent traversal - else - return; - end if; - end if; + and then not In_Pragma (N); + end Is_Suitable_Variable_Read; - E_Scope := Ent; - loop - if Elaboration_Checks_Suppressed (E_Scope) - or else Suppress_Elaboration_Warnings (E_Scope) - then - Cunit_SC := True; - end if; + ------------------- + -- Is_Task_Entry -- + ------------------- - -- Exit when we get to compilation unit, not counting subunits + function Is_Task_Entry (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote an entry defined in a task type - exit when Is_Compilation_Unit (E_Scope) - and then (Is_Child_Unit (E_Scope) - or else Scope (E_Scope) = Standard_Standard); + return + Is_Entry (Id) and then Is_Task_Type (Non_Private_View (Scope (Id))); + end Is_Task_Entry; - pragma Assert (E_Scope /= Standard_Standard); + ------------------------ + -- Is_Up_Level_Target -- + ------------------------ - -- Move up a scope looking for compilation unit + function Is_Up_Level_Target (Target_Decl : Node_Id) return Boolean is + Root : constant Node_Id := Root_Scenario; - E_Scope := Scope (E_Scope); - end loop; + begin + -- The root appears within the declaratons of a block statement, entry + -- body, subprogram body, or task body ignoring enclosing packages. The + -- root is always within the main unit. An up level target is a notion + -- applicable only to the static model because scenarios are reached by + -- means of graph traversal started from a fixed declarative or library + -- level. - -- No checks needed for pure or preelaborated compilation units + -- Performance note: parent traversal - if Is_Pure (E_Scope) or else Is_Preelaborated (E_Scope) then - return; - end if; + if Static_Elaboration_Checks + and then Find_Enclosing_Level (Root) = Declaration_Level + then + -- The target is within the main unit. It acts as an up level target + -- when it appears within a context which encloses the root. - -- If the generic entity is within a deeper instance than we are, then - -- either the instantiation to which we refer itself caused an ABE, in - -- which case that will be handled separately, or else we know that the - -- body we need appears as needed at the point of the instantiation. - -- However, this assumption is only valid if we are in static mode. + -- package body Main_Unit is + -- function Func ...; -- target - if not Dynamic_Elaboration_Checks - and then - Instantiation_Depth (Sloc (Ent)) > Instantiation_Depth (Sloc (N)) - then - return; - end if; + -- procedure Proc is + -- X : ... := Func; -- root scenario - -- Do not give a warning for a package with no body + if In_Extended_Main_Code_Unit (Target_Decl) then - if Ekind (Ent) = E_Generic_Package and then not Has_Generic_Body (N) then - return; - end if; + -- Performance note: parent traversal - -- Case of entity is in same unit as call or instantiation. In the - -- instantiation case, W_Scope may be different from E_Scope; we want - -- the unit in which the instantiation occurs, since we're analyzing - -- based on the expansion. + return not In_Same_Context (Root, Target_Decl, Nested_OK => True); - if W_Scope = C_Scope then - if not Inter_Unit_Only then - Check_Internal_Call (N, Ent, Outer_Scope, E); - end if; + -- Otherwise the target is external to the main unit which makes it + -- an up level target. - return; + else + return True; + end if; end if; - -- Case of entity is not in current unit (i.e. with'ed unit case) - - -- We are only interested in such calls if the outer call was from - -- elaboration code, or if we are in Dynamic_Elaboration_Checks mode. + return False; + end Is_Up_Level_Target; - if not From_Elab_Code and then not Dynamic_Elaboration_Checks then - return; - end if; + ------------------------------- + -- Kill_Elaboration_Scenario -- + ------------------------------- - -- Nothing to do if some scope said that no checks were required + procedure Kill_Elaboration_Scenario (N : Node_Id) is + begin + -- Eliminate the scenario by suppressing the generation of conditional + -- ABE checks or guaranteed ABE failures. Note that other diagnostics + -- must be carried out ignoring the fact that the scenario is within + -- dead code. - if Cunit_SC then - return; + if Is_Scenario (N) then + Set_Is_Elaboration_Checks_OK_Node (N, False); end if; + end Kill_Elaboration_Scenario; - -- Nothing to do for a generic instance, because a call to an instance - -- cannot fail the elaboration check, because the body of the instance - -- is always elaborated immediately after the spec. + ---------------------------------- + -- Meet_Elaboration_Requirement -- + ---------------------------------- - if Call_To_Instance_From_Outside (Ent) then - return; - end if; + procedure Meet_Elaboration_Requirement + (N : Node_Id; + Target_Id : Entity_Id; + Req_Nam : Name_Id) + is + Main_Id : constant Entity_Id := Cunit_Entity (Main_Unit); + Unit_Id : constant Entity_Id := Find_Top_Unit (Target_Id); + + function Find_Preelaboration_Pragma + (Prag_Nam : Name_Id) return Node_Id; + pragma Inline (Find_Preelaboration_Pragma); + -- Traverse the visible declarations of unit Unit_Id and locate a source + -- preelaboration-related pragma with name Prag_Nam. + + procedure Info_Requirement_Met (Prag : Node_Id); + pragma Inline (Info_Requirement_Met); + -- Output information concerning pragma Prag which meets requirement + -- Req_Nam. + + procedure Info_Scenario; + pragma Inline (Info_Scenario); + -- Output information concerning scenario N + + -------------------------------- + -- Find_Preelaboration_Pragma -- + -------------------------------- + + function Find_Preelaboration_Pragma + (Prag_Nam : Name_Id) return Node_Id + is + Spec : constant Node_Id := Parent (Unit_Id); + Decl : Node_Id; - -- Nothing to do if subprogram with no separate spec. However, a call - -- to Deep_Initialize may result in a call to a user-defined Initialize - -- procedure, which imposes a body dependency. This happens only if the - -- type is controlled and the Initialize procedure is not inherited. + begin + -- A preelaboration-related pragma comes from source and appears at + -- the top of the visible declarations of a package. - if Body_Acts_As_Spec then - if Is_TSS (Ent, TSS_Deep_Initialize) then - declare - Typ : constant Entity_Id := Etype (First_Formal (Ent)); - Init : Entity_Id; + if Nkind (Spec) = N_Package_Specification then + Decl := First (Visible_Declarations (Spec)); + while Present (Decl) loop + if Comes_From_Source (Decl) then + if Nkind (Decl) = N_Pragma + and then Pragma_Name (Decl) = Prag_Nam + then + return Decl; - begin - if not Is_Controlled (Typ) then - return; - else - Init := Find_Prim_Op (Typ, Name_Initialize); + -- Otherwise the construct terminates the region where the + -- preelabortion-related pragma may appear. - if Comes_From_Source (Init) then - Ent := Init; else - return; + exit; end if; end if; - end; + + Next (Decl); + end loop; + end if; + + return Empty; + end Find_Preelaboration_Pragma; + + -------------------------- + -- Info_Requirement_Met -- + -------------------------- + + procedure Info_Requirement_Met (Prag : Node_Id) is + begin + pragma Assert (Present (Prag)); + + Error_Msg_Name_1 := Req_Nam; + Error_Msg_Sloc := Sloc (Prag); + Error_Msg_NE + ("\\% requirement for unit & met by pragma #", N, Unit_Id); + end Info_Requirement_Met; + + ------------------- + -- Info_Scenario -- + ------------------- + + procedure Info_Scenario is + begin + if Is_Suitable_Call (N) then + Info_Call + (Call => N, + Target_Id => Target_Id, + Info_Msg => False, + In_SPARK => True); + + elsif Is_Suitable_Instantiation (N) then + Info_Instantiation + (Inst => N, + Gen_Id => Target_Id, + Info_Msg => False, + In_SPARK => True); + + elsif Is_Suitable_Variable_Read (N) then + Info_Variable_Read + (Ref => N, + Var_Id => Target_Id, + Info_Msg => False, + In_SPARK => True); + + -- No other scenario may impose a requirement on the context of the + -- main unit. else - return; + pragma Assert (False); + null; end if; - end if; + end Info_Scenario; + + -- Local variables - -- Check cases of internal units + Elab_Attrs : Elaboration_Attributes; + Elab_Nam : Name_Id; + Req_Met : Boolean; - Callee_Unit_Internal := In_Internal_Unit (E_Scope); + -- Start of processing for Meet_Elaboration_Requirement - -- Do not give a warning if the with'ed unit is internal and this is - -- the generic instantiation case (this saves a lot of hassle dealing - -- with the Text_IO special child units) + begin + pragma Assert (Nam_In (Req_Nam, Name_Elaborate, Name_Elaborate_All)); - if Callee_Unit_Internal and Inst_Case then - return; - end if; + -- Assume that the requirement has not been met - if C_Scope = Standard_Standard then - Caller_Unit_Internal := False; - else - Caller_Unit_Internal := In_Internal_Unit (C_Scope); - end if; + Req_Met := False; - -- Do not give a warning if the with'ed unit is internal and the caller - -- is not internal (since the binder always elaborates internal units - -- first). + -- Elaboration requirements are verified only when the static model is + -- in effect because this diagnostic is graph-dependent. - if Callee_Unit_Internal and not Caller_Unit_Internal then + if not Static_Elaboration_Checks then return; - end if; - -- For now, if debug flag -gnatdE is not set, do no checking for one - -- internal unit withing another. This fixes the problem with the sgi - -- build and storage errors. To be resolved later ??? + -- If the target is within the main unit, either at the source level or + -- through an instantiation, then there is no real requirement to meet + -- because the main unit cannot force its own elaboration by means of an + -- Elaborate[_All] pragma. Treat this case as valid coverage. + + elsif In_Extended_Main_Code_Unit (Target_Id) then + Req_Met := True; - if (Callee_Unit_Internal and Caller_Unit_Internal) - and not Debug_Flag_EE + -- Otherwise the target resides in an external unit + + -- The requirement is met when the target comes from an internal unit + -- because such a unit is elaborated prior to a non-internal unit. + + elsif In_Internal_Unit (Unit_Id) + and then not In_Internal_Unit (Main_Id) then - return; - end if; + Req_Met := True; - if Is_TSS (E, TSS_Deep_Initialize) then - Ent := E; - end if; + -- The requirement is met when the target comes from a preelaborated + -- unit. This portion must parallel predicate Is_Preelaborated_Unit. + + elsif Is_Preelaborated_Unit (Unit_Id) then + Req_Met := True; + + -- Output extra information when switch -gnatel (info messages on + -- implicit Elaborate[_All] pragmas. + + if Elab_Info_Messages then + if Is_Preelaborated (Unit_Id) then + Elab_Nam := Name_Preelaborate; - -- If the call is in an instance, and the called entity is not - -- defined in the same instance, then the elaboration issue focuses - -- around the unit containing the template, it is this unit that - -- requires an Elaborate_All. + elsif Is_Pure (Unit_Id) then + Elab_Nam := Name_Pure; - -- However, if we are doing dynamic elaboration, we need to chase the - -- call in the usual manner. + elsif Is_Remote_Call_Interface (Unit_Id) then + Elab_Nam := Name_Remote_Call_Interface; - -- We also need to chase the call in the usual manner if it is a call - -- to a generic formal parameter, since that case was not handled as - -- part of the processing of the template. + elsif Is_Remote_Types (Unit_Id) then + Elab_Nam := Name_Remote_Types; - Inst_Caller := Instantiation (Get_Source_File_Index (Sloc (N))); - Inst_Callee := Instantiation (Get_Source_File_Index (Sloc (Ent))); + else + pragma Assert (Is_Shared_Passive (Unit_Id)); + Elab_Nam := Name_Shared_Passive; + end if; + + Info_Requirement_Met (Find_Preelaboration_Pragma (Elab_Nam)); + end if; + + -- Determine whether the context of the main unit has a pragma strong + -- enough to meet the requirement. - if Inst_Caller = No_Location then - Unit_Caller := No_Unit; else - Unit_Caller := Get_Source_Unit (N); + Elab_Attrs := Elaboration_Context.Get (Unit_Id); + + -- The pragma must be either Elaborate_All or be as strong as the + -- requirement. + + if Present (Elab_Attrs.Source_Pragma) + and then Nam_In (Pragma_Name (Elab_Attrs.Source_Pragma), + Name_Elaborate_All, + Req_Nam) + then + Req_Met := True; + + -- Output extra information when switch -gnatel (info messages on + -- implicit Elaborate[_All] pragmas. + + if Elab_Info_Messages then + Info_Requirement_Met (Elab_Attrs.Source_Pragma); + end if; + end if; end if; - if Inst_Callee = No_Location then - Unit_Callee := No_Unit; - else - Unit_Callee := Get_Source_Unit (Ent); + -- The requirement was not met by the context of the main unit, issue an + -- error. + + if not Req_Met then + Info_Scenario; + + Error_Msg_Name_1 := Req_Nam; + Error_Msg_Node_2 := Unit_Id; + Error_Msg_NE ("\\unit & requires pragma % for &", N, Main_Id); + + Output_Active_Scenarios (N); end if; + end Meet_Elaboration_Requirement; - if Unit_Caller /= No_Unit - and then Unit_Callee /= Unit_Caller - and then not Dynamic_Elaboration_Checks - and then not Is_Call_Of_Generic_Formal (N) - then - E_Scope := Spec_Entity (Cunit_Entity (Unit_Caller)); + ---------------------- + -- Non_Private_View -- + ---------------------- - -- If we don't get a spec entity, just ignore call. Not quite - -- clear why this check is necessary. ??? + function Non_Private_View (Typ : Entity_Id) return Entity_Id is + Result : Entity_Id; - if No (E_Scope) then - return; - end if; + begin + Result := Typ; + + if Is_Private_Type (Result) and then Present (Full_View (Result)) then + Result := Full_View (Result); + end if; - -- Otherwise step to enclosing compilation unit + return Result; + end Non_Private_View; - while not Is_Compilation_Unit (E_Scope) loop - E_Scope := Scope (E_Scope); - end loop; + ----------------------------- + -- Output_Active_Scenarios -- + ----------------------------- - -- For the case where N is not an instance, and is not a call within - -- instance to other than a generic formal, we recompute E_Scope - -- for the error message, since we do NOT want to go to the unit - -- that has the ultimate declaration in the case of renaming and - -- derivation and we also want to go to the generic unit in the - -- case of an instance, and no further. + procedure Output_Active_Scenarios (Error_Nod : Node_Id) is + procedure Output_Access (N : Node_Id); + -- Emit a specific diagnostic message for 'Access denote by N - else - -- Loop to carefully follow renamings and derivations one step - -- outside the current unit, but not further. + procedure Output_Activation_Call (N : Node_Id); + -- Emit a specific diagnostic message for task activation N - if not (Inst_Case or Variable_Case) - and then Present (Alias (Ent)) - then - E_Scope := Alias (Ent); - else - E_Scope := Ent; - end if; + procedure Output_Call (N : Node_Id; Target_Id : Entity_Id); + -- Emit a specific diagnostic message for call N which invokes target + -- Target_Id. + + procedure Output_Header; + -- Emit a specific diagnostic message for the unit of the root scenario + + procedure Output_Instantiation (N : Node_Id); + -- Emit a specific diagnostic message for instantiation N + + procedure Output_Variable_Assignment (N : Node_Id); + -- Emit a specific diagnostic message for assignment statement N + + procedure Output_Variable_Read (N : Node_Id); + -- Emit a specific diagnostic message for reference N which reads a + -- variable. + + ------------------- + -- Output_Access -- + ------------------- - loop - while not Is_Compilation_Unit (E_Scope) loop - E_Scope := Scope (E_Scope); - end loop; + procedure Output_Access (N : Node_Id) is + Subp_Id : constant Entity_Id := Entity (Prefix (N)); - -- If E_Scope is the same as C_Scope, it means that there - -- definitely was a local renaming or derivation, and we - -- are not yet out of the current unit. + begin + Error_Msg_Name_1 := Attribute_Name (N); + Error_Msg_Sloc := Sloc (N); + Error_Msg_NE ("\\ % of & taken #", Error_Nod, Subp_Id); + end Output_Access; - exit when E_Scope /= C_Scope; - Ent := Alias (Ent); - E_Scope := Ent; + ---------------------------- + -- Output_Activation_Call -- + ---------------------------- - -- If no alias, there could be a previous error, but not if we've - -- already reached the outermost level (Standard). + procedure Output_Activation_Call (N : Node_Id) is + function Find_Activator (Call : Node_Id) return Entity_Id; + -- Find the nearest enclosing construct which houses call Call - if No (Ent) then - return; - end if; - end loop; - end if; + -------------------- + -- Find_Activator -- + -------------------- - if Within_Elaborate_All (Current_Sem_Unit, E_Scope) then - return; - end if; + function Find_Activator (Call : Node_Id) return Entity_Id is + Par : Node_Id; - -- Determine whether the Default_Initial_Condition procedure of some - -- type is being invoked. + begin + -- Climb the parent chain looking for a package [body] or a + -- construct with a statement sequence. - Is_DIC := Ekind (Ent) = E_Procedure and then Is_DIC_Procedure (Ent); + Par := Parent (Call); + while Present (Par) loop + if Nkind_In (Par, N_Package_Body, N_Package_Declaration) then + return Defining_Entity (Par); - -- Checks related to Default_Initial_Condition fall under the SPARK - -- umbrella because this is a SPARK-specific annotation. + elsif Nkind (Par) = N_Handled_Sequence_Of_Statements then + return Defining_Entity (Parent (Par)); + end if; - SPARK_Elab_Errors := - SPARK_Mode = On and (Is_DIC or Dynamic_Elaboration_Checks); + Par := Parent (Par); + end loop; - -- Now check if an Elaborate_All (or dynamic check) is needed + return Empty; + end Find_Activator; - if (Elab_Info_Messages or Elab_Warnings or SPARK_Elab_Errors) - and then Generate_Warnings - and then not Suppress_Elaboration_Warnings (Ent) - and then not Elaboration_Checks_Suppressed (Ent) - and then not Suppress_Elaboration_Warnings (E_Scope) - and then not Elaboration_Checks_Suppressed (E_Scope) - then - -- Instantiation case + -- Local variables - if Inst_Case then - if Comes_From_Source (Ent) and then SPARK_Elab_Errors then - Error_Msg_NE - ("instantiation of & during elaboration in SPARK", N, Ent); - else - Elab_Warning - ("instantiation of & may raise Program_Error?l?", - "info: instantiation of & during elaboration?$?", Ent); - end if; + Activator : constant Entity_Id := Find_Activator (N); - -- Indirect call case, info message only in static elaboration - -- case, because the attribute reference itself cannot raise an - -- exception. Note that SPARK does not permit indirect calls. + -- Start of processing for Output_Activation_Call - elsif Access_Case then - Elab_Warning ("", "info: access to & during elaboration?$?", Ent); + begin + pragma Assert (Present (Activator)); - -- Variable reference in SPARK mode + Error_Msg_NE ("\\ local tasks of & activated", Error_Nod, Activator); + end Output_Activation_Call; - elsif Variable_Case then - if Comes_From_Source (Ent) and then SPARK_Elab_Errors then - Error_Msg_NE - ("reference to & during elaboration in SPARK", N, Ent); - end if; + ----------------- + -- Output_Call -- + ----------------- - -- Subprogram call case + procedure Output_Call (N : Node_Id; Target_Id : Entity_Id) is + procedure Output_Accept_Alternative; + pragma Inline (Output_Accept_Alternative); + -- Emit a specific diagnostic message concerning an accept + -- alternative. - else - if Nkind (Name (N)) in N_Has_Entity - and then Is_Init_Proc (Entity (Name (N))) - and then Comes_From_Source (Ent) - then - Elab_Warning - ("implicit call to & may raise Program_Error?l?", - "info: implicit call to & during elaboration?$?", - Ent); - - elsif SPARK_Elab_Errors then - - -- Emit a specialized error message when the elaboration of an - -- object of a private type evaluates the expression of pragma - -- Default_Initial_Condition. This prevents the internal name - -- of the procedure from appearing in the error message. - - if Is_DIC then - Error_Msg_N - ("call to Default_Initial_Condition during elaboration in " - & "SPARK", N); - else - Error_Msg_NE - ("call to & during elaboration in SPARK", N, Ent); - end if; + procedure Output_Call (Kind : String); + pragma Inline (Output_Call); + -- Emit a specific diagnostic message concerning a call of kind Kind - else - Elab_Warning - ("call to & may raise Program_Error?l?", - "info: call to & during elaboration?$?", - Ent); - end if; - end if; + procedure Output_Type_Actions (Action : String); + pragma Inline (Output_Type_Actions); + -- Emit a specific diagnostic message concerning action Action of a + -- type. + + procedure Output_Verification_Call + (Pred : String; + Id : Entity_Id; + Id_Kind : String); + pragma Inline (Output_Verification_Call); + -- Emit a specific diagnostic message concerning the verification of + -- predicate Pred applied to related entity Id with kind Id_Kind. - Error_Msg_Qual_Level := Nat'Last; + ------------------------------- + -- Output_Accept_Alternative -- + ------------------------------- - -- Case of Elaborate_All not present and required, for SPARK this - -- is an error, so give an error message. + procedure Output_Accept_Alternative is + Entry_Id : constant Entity_Id := Receiving_Entry (Target_Id); - if SPARK_Elab_Errors then - Error_Msg_NE -- CODEFIX - ("\Elaborate_All pragma required for&", N, W_Scope); + begin + pragma Assert (Present (Entry_Id)); - -- Otherwise we generate an implicit pragma. For a subprogram - -- instantiation, Elaborate is good enough, since no transitive - -- call is possible at elaboration time in this case. + Error_Msg_NE ("\\ entry & selected #", Error_Nod, Entry_Id); + end Output_Accept_Alternative; - elsif Nkind (N) in N_Subprogram_Instantiation then - Elab_Warning - ("\missing pragma Elaborate for&?l?", - "\implicit pragma Elaborate for& generated?$?", - W_Scope); + ----------------- + -- Output_Call -- + ----------------- - -- For all other cases, we need an implicit Elaborate_All + procedure Output_Call (Kind : String) is + begin + Error_Msg_NE ("\\ " & Kind & " & called #", Error_Nod, Target_Id); + end Output_Call; - else - Elab_Warning - ("\missing pragma Elaborate_All for&?l?", - "\implicit pragma Elaborate_All for & generated?$?", - W_Scope); - end if; + ------------------------- + -- Output_Type_Actions -- + ------------------------- - Error_Msg_Qual_Level := 0; + procedure Output_Type_Actions (Action : String) is + Typ : constant Entity_Id := First_Formal_Type (Target_Id); - -- Take into account the flags related to elaboration warning - -- messages when enumerating the various calls involved. This - -- ensures the proper pairing of the main warning and the - -- clarification messages generated by Output_Calls. + begin + pragma Assert (Present (Typ)); - Output_Calls (N, Check_Elab_Flag => True); + Error_Msg_NE + ("\\ " & Action & " actions for type & #", Error_Nod, Typ); + end Output_Type_Actions; + + ------------------------------ + -- Output_Verification_Call -- + ------------------------------ + + procedure Output_Verification_Call + (Pred : String; + Id : Entity_Id; + Id_Kind : String) + is + begin + pragma Assert (Present (Id)); - -- Set flag to prevent further warnings for same unit unless in - -- All_Errors_Mode. + Error_Msg_NE + ("\\ " & Pred & " of " & Id_Kind & " & verified #", + Error_Nod, Id); + end Output_Verification_Call; - if not All_Errors_Mode and not Dynamic_Elaboration_Checks then - Set_Suppress_Elaboration_Warnings (W_Scope); - end if; - end if; + -- Start of processing for Output_Call - -- Check for runtime elaboration check required + begin + Error_Msg_Sloc := Sloc (N); - if Dynamic_Elaboration_Checks then - if not Elaboration_Checks_Suppressed (Ent) - and then not Elaboration_Checks_Suppressed (W_Scope) - and then not Elaboration_Checks_Suppressed (E_Scope) - and then not Cunit_SC - then - -- Runtime elaboration check required. Generate check of the - -- elaboration Boolean for the unit containing the entity. + -- Accept alternative - -- Note that for this case, we do check the real unit (the one - -- from following renamings, since that is the issue). + if Is_Accept_Alternative_Proc (Target_Id) then + Output_Accept_Alternative; - -- Could this possibly miss a useless but required PE??? + -- Adjustment - Insert_Elab_Check (N, - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Elaborated, - Prefix => - New_Occurrence_Of (Spec_Entity (E_Scope), Loc))); + elsif Is_TSS (Target_Id, TSS_Deep_Adjust) then + Output_Type_Actions ("adjustment"); - -- Prevent duplicate elaboration checks on the same call, - -- which can happen if the body enclosing the call appears - -- itself in a call whose elaboration check is delayed. + -- Default_Initial_Condition - if Nkind (N) in N_Subprogram_Call then - Set_No_Elaboration_Check (N); - end if; - end if; + elsif Is_Default_Initial_Condition_Proc (Target_Id) then + Output_Verification_Call + (Pred => "Default_Initial_Condition", + Id => First_Formal_Type (Target_Id), + Id_Kind => "type"); - -- Case of static elaboration model + -- Entries - else - -- Do not do anything if elaboration checks suppressed. Note that - -- we check Ent here, not E, since we want the real entity for the - -- body to see if checks are suppressed for it, not the dummy - -- entry for renamings or derivations. - - if Elaboration_Checks_Suppressed (Ent) - or else Elaboration_Checks_Suppressed (E_Scope) - or else Elaboration_Checks_Suppressed (W_Scope) - then - null; + elsif Is_Protected_Entry (Target_Id) then + Output_Call ("entry"); - -- Do not generate an Elaborate_All for finalization routines - -- that perform partial clean up as part of initialization. + -- Task entry calls are never processed because the entry being + -- invoked does not have a corresponding "body", it has a select. A + -- task entry call appears in the stack of active scenarios for the + -- sole purpose of checking No_Entry_Calls_In_Elaboration_Code and + -- nothing more. - elsif In_Init_Proc and then Is_Finalization_Procedure (Ent) then + elsif Is_Task_Entry (Target_Id) then null; - -- Here we need to generate an implicit elaborate all + -- Finalization - else - -- Generate Elaborate_All warning unless suppressed + elsif Is_TSS (Target_Id, TSS_Deep_Finalize) then + Output_Type_Actions ("finalization"); - if (Elab_Info_Messages and Generate_Warnings and not Inst_Case) - and then not Suppress_Elaboration_Warnings (Ent) - and then not Suppress_Elaboration_Warnings (E_Scope) - and then not Suppress_Elaboration_Warnings (W_Scope) - then - Error_Msg_Node_2 := W_Scope; - Error_Msg_NE - ("info: call to& in elaboration code requires pragma " - & "Elaborate_All on&?$?", N, E); - end if; + -- Calls to _Finalizer procedures must not appear in the output + -- because this creates confusing noise. - -- Set indication for binder to generate Elaborate_All + elsif Is_Finalizer_Proc (Target_Id) then + null; - Set_Elaboration_Constraint (N, E, W_Scope); - end if; - end if; - end Check_A_Call; + -- Initial_Condition - ----------------------------- - -- Check_Bad_Instantiation -- - ----------------------------- + elsif Is_Initial_Condition_Proc (Target_Id) then + Output_Verification_Call + (Pred => "Initial_Condition", + Id => Find_Enclosing_Scope (N), + Id_Kind => "package"); - procedure Check_Bad_Instantiation (N : Node_Id) is - Ent : Entity_Id; + -- Initialization - begin - -- Nothing to do if we do not have an instantiation (happens in some - -- error cases, and also in the formal package declaration case) + elsif Is_Init_Proc (Target_Id) + or else Is_TSS (Target_Id, TSS_Deep_Initialize) + then + Output_Type_Actions ("initialization"); - if Nkind (N) not in N_Generic_Instantiation then - return; + -- Invariant - -- Nothing to do if serious errors detected (avoid cascaded errors) + elsif Is_Invariant_Proc (Target_Id) then + Output_Verification_Call + (Pred => "invariants", + Id => First_Formal_Type (Target_Id), + Id_Kind => "type"); - elsif Serious_Errors_Detected /= 0 then - return; + -- Partial invariant calls must not appear in the output because this + -- creates confusing noise. Note that a partial invariant is always + -- invoked by the "full" invariant which is already placed on the + -- stack. - -- Nothing to do if not in full analysis mode + elsif Is_Partial_Invariant_Proc (Target_Id) then + null; - elsif not Full_Analysis then - return; + -- _Postconditions - -- Nothing to do if inside a generic template + elsif Is_Postconditions_Proc (Target_Id) then + Output_Verification_Call + (Pred => "postconditions", + Id => Find_Enclosing_Scope (N), + Id_Kind => "subprogram"); - elsif Inside_A_Generic then - return; + -- Subprograms must come last because some of the previous cases fall + -- under this category. - -- Nothing to do if a library level instantiation + elsif Ekind (Target_Id) = E_Function then + Output_Call ("function"); - elsif Nkind (Parent (N)) = N_Compilation_Unit then - return; + elsif Ekind (Target_Id) = E_Procedure then + Output_Call ("procedure"); - -- Nothing to do if we are compiling a proper body for semantic - -- purposes only. The generic body may be in another proper body. + else + pragma Assert (False); + null; + end if; + end Output_Call; - elsif - Nkind (Parent (Unit_Declaration_Node (Main_Unit_Entity))) = N_Subunit - then - return; - end if; + ------------------- + -- Output_Header -- + ------------------- - Ent := Get_Generic_Entity (N); + procedure Output_Header is + Unit_Id : constant Entity_Id := Find_Top_Unit (Root_Scenario); - -- The case we are interested in is when the generic spec is in the - -- current declarative part + begin + if Ekind (Unit_Id) = E_Package then + Error_Msg_NE ("\\ spec of unit & elaborated", Error_Nod, Unit_Id); - if not Same_Elaboration_Scope (Current_Scope, Scope (Ent)) - or else not In_Same_Extended_Unit (N, Ent) - then - return; - end if; + elsif Ekind (Unit_Id) = E_Package_Body then + Error_Msg_NE ("\\ body of unit & elaborated", Error_Nod, Unit_Id); - -- If the generic entity is within a deeper instance than we are, then - -- either the instantiation to which we refer itself caused an ABE, in - -- which case that will be handled separately. Otherwise, we know that - -- the body we need appears as needed at the point of the instantiation. - -- If they are both at the same level but not within the same instance - -- then the body of the generic will be in the earlier instance. + else + Error_Msg_NE ("\\ in body of unit &", Error_Nod, Unit_Id); + end if; + end Output_Header; - declare - D1 : constant Nat := Instantiation_Depth (Sloc (Ent)); - D2 : constant Nat := Instantiation_Depth (Sloc (N)); + -------------------------- + -- Output_Instantiation -- + -------------------------- - begin - if D1 > D2 then - return; + procedure Output_Instantiation (N : Node_Id) is + procedure Output_Instantiation (Gen_Id : Entity_Id; Kind : String); + pragma Inline (Output_Instantiation); + -- Emit a specific diagnostic message concerning an instantiation of + -- generic unit Gen_Id. Kind denotes the kind of the instantiation. - elsif D1 = D2 - and then Is_Generic_Instance (Scope (Ent)) - and then not In_Open_Scopes (Scope (Ent)) - then - return; - end if; - end; + -------------------------- + -- Output_Instantiation -- + -------------------------- - -- Now we can proceed, if the entity being called has a completion, - -- then we are definitely OK, since we have already seen the body. + procedure Output_Instantiation (Gen_Id : Entity_Id; Kind : String) is + begin + Error_Msg_NE + ("\\ " & Kind & " & instantiated as & #", Error_Nod, Gen_Id); + end Output_Instantiation; - if Has_Completion (Ent) then - return; - end if; + -- Local variables - -- If there is no body, then nothing to do + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Inst_Id : Entity_Id; + Gen_Id : Entity_Id; - if not Has_Generic_Body (N) then - return; - end if; + -- Start of processing for Output_Instantiation - -- Here we definitely have a bad instantiation + begin + Extract_Instantiation_Attributes + (Exp_Inst => N, + Inst => Inst, + Inst_Id => Inst_Id, + Gen_Id => Gen_Id, + Attrs => Inst_Attrs); - Error_Msg_Warn := SPARK_Mode /= On; - Error_Msg_NE ("cannot instantiate& before body seen<<", N, Ent); + Error_Msg_Node_2 := Inst_Id; + Error_Msg_Sloc := Sloc (Inst); - if Present (Instance_Spec (N)) then - Supply_Bodies (Instance_Spec (N)); - end if; + if Nkind (Inst) = N_Function_Instantiation then + Output_Instantiation (Gen_Id, "function"); - Error_Msg_N ("\Program_Error [<<", N); - Insert_Elab_Check (N); - Set_ABE_Is_Certain (N); - end Check_Bad_Instantiation; + elsif Nkind (Inst) = N_Package_Instantiation then + Output_Instantiation (Gen_Id, "package"); - --------------------- - -- Check_Elab_Call -- - --------------------- + elsif Nkind (Inst) = N_Procedure_Instantiation then + Output_Instantiation (Gen_Id, "procedure"); - procedure Check_Elab_Call - (N : Node_Id; - Outer_Scope : Entity_Id := Empty; - In_Init_Proc : Boolean := False) - is - Ent : Entity_Id; - P : Node_Id; + else + pragma Assert (False); + null; + end if; + end Output_Instantiation; - begin - -- If the reference is not in the main unit, there is nothing to check. - -- Elaboration call from units in the context of the main unit will lead - -- to semantic dependencies when those units are compiled. + -------------------------------- + -- Output_Variable_Assignment -- + -------------------------------- - if not In_Extended_Main_Code_Unit (N) then - return; - end if; + procedure Output_Variable_Assignment (N : Node_Id) is + Var_Id : constant Entity_Id := Entity (Extract_Assignment_Name (N)); - -- For an entry call, check relevant restriction + begin + Error_Msg_Sloc := Sloc (N); + Error_Msg_NE ("\\ variable & assigned #", Error_Nod, Var_Id); + end Output_Variable_Assignment; - if Nkind (N) = N_Entry_Call_Statement - and then not In_Subprogram_Or_Concurrent_Unit - then - Check_Restriction (No_Entry_Calls_In_Elaboration_Code, N); + -------------------------- + -- Output_Variable_Read -- + -------------------------- - -- Nothing to do if this is not an expected type of reference (happens - -- in some error conditions, and in some cases where rewriting occurs). + procedure Output_Variable_Read (N : Node_Id) is + Dummy : Variable_Attributes; + Var_Id : Entity_Id; - elsif Nkind (N) not in N_Subprogram_Call - and then Nkind (N) /= N_Attribute_Reference - and then (SPARK_Mode /= On - or else Nkind (N) not in N_Has_Entity - or else No (Entity (N)) - or else Ekind (Entity (N)) /= E_Variable) - then - return; + begin + Extract_Variable_Reference_Attributes + (Ref => N, + Var_Id => Var_Id, + Attrs => Dummy); - -- Nothing to do if this is a call already rewritten for elab checking. - -- Such calls appear as the targets of If_Expressions. + Error_Msg_Sloc := Sloc (N); + Error_Msg_NE ("\\ variable & read #", Error_Nod, Var_Id); + end Output_Variable_Read; - -- This check MUST be wrong, it catches far too much + -- Local variables - elsif Nkind (Parent (N)) = N_If_Expression then - return; + package Stack renames Scenario_Stack; - -- Nothing to do if inside a generic template + Dummy : Call_Attributes; + N : Node_Id; + Posted : Boolean; + Target_Id : Entity_Id; - elsif Inside_A_Generic - and then No (Enclosing_Generic_Body (N)) - then - return; + -- Start of processing for Output_Active_Scenarios - -- Nothing to do if call is being pre-analyzed, as when within a - -- pre/postcondition, a predicate, or an invariant. + begin + -- Active scenarios are emitted only when the static model is in effect + -- because there is an inherent order by which all these scenarios were + -- reached from the declaration or library level. - elsif In_Spec_Expression then + if not Static_Elaboration_Checks then return; end if; - -- Nothing to do if this is a call to a postcondition, which is always - -- within a subprogram body, even though the current scope may be the - -- enclosing scope of the subprogram. + Posted := False; - if Nkind (N) = N_Procedure_Call_Statement - and then Is_Entity_Name (Name (N)) - and then Chars (Entity (Name (N))) = Name_uPostconditions - then - return; - end if; + for Index in Stack.First .. Stack.Last loop + N := Stack.Table (Index); - -- Here we have a reference at elaboration time that must be checked + if not Posted then + Posted := True; + Output_Header; + end if; - if Debug_Flag_LL then - Write_Str (" Check_Elab_Ref: "); + -- 'Access if Nkind (N) = N_Attribute_Reference then - if not Is_Entity_Name (Prefix (N)) then - Write_Str ("<>"); - else - Write_Name (Chars (Entity (Prefix (N)))); - end if; + Output_Access (N); - Write_Str ("'Access"); + -- Calls - elsif No (Name (N)) or else not Is_Entity_Name (Name (N)) then - Write_Str ("<> "); + elsif Is_Suitable_Call (N) then + Extract_Call_Attributes + (Call => N, + Target_Id => Target_Id, + Attrs => Dummy); - else - Write_Name (Chars (Entity (Name (N)))); - end if; + if Is_Activation_Proc (Target_Id) then + Output_Activation_Call (N); + else + Output_Call (N, Target_Id); + end if; - Write_Str (" reference at "); - Write_Location (Sloc (N)); - Write_Eol; - end if; + -- Instantiations - -- Climb up the tree to make sure we are not inside default expression - -- of a parameter specification or a record component, since in both - -- these cases, we will be doing the actual reference later, not now, - -- and it is at the time of the actual reference (statically speaking) - -- that we must do our static check, not at the time of its initial - -- analysis). + elsif Is_Suitable_Instantiation (N) then + Output_Instantiation (N); - -- However, we have to check references within component definitions - -- (e.g. a function call that determines an array component bound), - -- so we terminate the loop in that case. + -- Variable assignments - P := Parent (N); - while Present (P) loop - if Nkind_In (P, N_Parameter_Specification, - N_Component_Declaration) - then - return; + elsif Nkind (N) = N_Assignment_Statement then + Output_Variable_Assignment (N); - -- The reference occurs within the constraint of a component, - -- so it must be checked. + -- Variable read - elsif Nkind (P) = N_Component_Definition then - exit; + elsif Is_Suitable_Variable_Read (N) then + Output_Variable_Read (N); else - P := Parent (P); + pragma Assert (False); + null; end if; end loop; + end Output_Active_Scenarios; - -- Stuff that happens only at the outer level - - if No (Outer_Scope) then - Elab_Visited.Set_Last (0); - - -- Nothing to do if current scope is Standard (this is a bit odd, but - -- it happens in the case of generic instantiations). - - C_Scope := Current_Scope; + ------------------------- + -- Pop_Active_Scenario -- + ------------------------- - if C_Scope = Standard_Standard then - return; - end if; + procedure Pop_Active_Scenario (N : Node_Id) is + Top : Node_Id renames Scenario_Stack.Table (Scenario_Stack.Last); - -- First case, we are in elaboration code + begin + pragma Assert (Top = N); + Scenario_Stack.Decrement_Last; + end Pop_Active_Scenario; - From_Elab_Code := not In_Subprogram_Or_Concurrent_Unit; + -------------------- + -- Process_Access -- + -------------------- - if From_Elab_Code then + procedure Process_Access (Attr : Node_Id; In_Task_Body : Boolean) is + function Build_Access_Marker (Target_Id : Entity_Id) return Node_Id; + pragma Inline (Build_Access_Marker); + -- Create a suitable call marker which invokes target Target_Id - -- Complain if ref that comes from source in preelaborated unit - -- and we are not inside a subprogram (i.e. we are in elab code). + ------------------------- + -- Build_Access_Marker -- + ------------------------- - if Comes_From_Source (N) - and then In_Preelaborated_Unit - and then not In_Inlined_Body - and then Nkind (N) /= N_Attribute_Reference - then - -- This is a warning in GNAT mode allowing such calls to be - -- used in the predefined library with appropriate care. + function Build_Access_Marker (Target_Id : Entity_Id) return Node_Id is + Marker : Node_Id; - Error_Msg_Warn := GNAT_Mode; - Error_Msg_N - ("< Target_Id, + Attrs => Target_Attrs); + + -- Both the attribute and the corresponding body are in the same unit. + -- The corresponding body must appear prior to the root scenario which + -- started the recursive search. If this is not the case, then there is + -- a potential ABE if the access value is used to call the subprogram. + -- Emit a warning only when switch -gnatw.f (warnings on suspucious + -- 'Access) is in effect. + + if Warn_On_Elab_Access + and then Present (Target_Attrs.Body_Decl) + and then In_Extended_Main_Code_Unit (Target_Attrs.Body_Decl) + and then Earlier_In_Extended_Unit (Root, Target_Attrs.Body_Decl) + then + Error_Msg_Name_1 := Attribute_Name (Attr); + Error_Msg_NE ("??% attribute of & before body seen", Attr, Target_Id); + Error_Msg_N ("\possible Program_Error on later references", Attr); - -- Do the check in this case + Output_Active_Scenarios (Attr); + end if; - exit; + -- Treat the attribute as an immediate invocation of the target when + -- switch -gnatd.o (conservative elaboration order for indirect calls) + -- is in effect. Note that the prior elaboration of the unit containing + -- the target is ensured processing the corresponding call marker. - elsif Nkind (P) = N_Task_Body then + if Debug_Flag_Dot_O then + Process_Scenario + (N => Build_Access_Marker (Target_Id), + In_Task_Body => In_Task_Body); - -- The check is deferred until Check_Task_Activation - -- but we need to capture local suppress pragmas - -- that may inhibit checks on this call. + -- Otherwise ensure that the unit with the corresponding body is + -- elaborated prior to the main unit. - Ent := Get_Referenced_Ent (N); + else + Ensure_Prior_Elaboration + (N => Attr, + Unit_Id => Target_Attrs.Unit_Id, + In_Task_Body => In_Task_Body); + end if; + end Process_Access; - if No (Ent) then - return; + ----------------------------- + -- Process_Activation_Call -- + ----------------------------- - elsif Elaboration_Checks_Suppressed (Current_Scope) - or else Elaboration_Checks_Suppressed (Ent) - or else Elaboration_Checks_Suppressed (Scope (Ent)) - then - if Nkind (N) in N_Subprogram_Call then - Set_No_Elaboration_Check (N); - end if; - end if; + procedure Process_Activation_Call + (Call : Node_Id; + Call_Attrs : Call_Attributes; + In_Task_Body : Boolean) + is + procedure Process_Task_Object (Obj_Id : Entity_Id; Typ : Entity_Id); + -- Perform ABE checks and diagnostics for object Obj_Id with type Typ. + -- Typ may be a task type or a composite type with at least one task + -- component. - return; + procedure Process_Task_Objects (List : List_Id); + -- Perform ABE checks and diagnostics for all task objects found in + -- the list List. - -- Static model, call is not in elaboration code, we - -- never need to worry, because in the static model the - -- top-level caller always takes care of things. + ------------------------- + -- Process_Task_Object -- + ------------------------- - else - return; - end if; - end if; - end loop; - end; - end if; - end if; + procedure Process_Task_Object (Obj_Id : Entity_Id; Typ : Entity_Id) is + Base_Typ : constant Entity_Id := Base_Type (Typ); - Ent := Get_Referenced_Ent (N); + Comp_Id : Entity_Id; + Task_Attrs : Task_Attributes; - if No (Ent) then - return; - end if; + begin + if Is_Task_Type (Typ) then + Extract_Task_Attributes + (Typ => Base_Typ, + Attrs => Task_Attrs); - -- Determine whether a prior call to the same subprogram was already - -- examined within the same context. If this is the case, then there is - -- no need to proceed with the various warnings and checks because the - -- work was already done for the previous call. + Process_Single_Activation + (Call => Call, + Call_Attrs => Call_Attrs, + Obj_Id => Obj_Id, + Task_Attrs => Task_Attrs, + In_Task_Body => In_Task_Body); - declare - Self : constant Visited_Element := - (Subp_Id => Ent, Context => Parent (N)); + -- Examine the component type when the object is an array - begin - for Index in 1 .. Elab_Visited.Last loop - if Self = Elab_Visited.Table (Index) then - return; - end if; - end loop; - end; + elsif Is_Array_Type (Typ) and then Has_Task (Base_Typ) then + Process_Task_Object (Obj_Id, Component_Type (Typ)); - -- See if we need to analyze this reference. We analyze it if either of - -- the following conditions is met: + -- Examine individual component types when the object is a record - -- It is an inner level call (since in this case it was triggered - -- by an outer level call from elaboration code), but only if the - -- call is within the scope of the original outer level call. + elsif Is_Record_Type (Typ) and then Has_Task (Base_Typ) then + Comp_Id := First_Component (Typ); + while Present (Comp_Id) loop + Process_Task_Object (Obj_Id, Etype (Comp_Id)); + Next_Component (Comp_Id); + end loop; + end if; + end Process_Task_Object; - -- It is an outer level reference from elaboration code, or a call to - -- an entity is in the same elaboration scope. + -------------------------- + -- Process_Task_Objects -- + -------------------------- - -- And in these cases, we will check both inter-unit calls and - -- intra-unit (within a single unit) calls. + procedure Process_Task_Objects (List : List_Id) is + Item : Node_Id; + Item_Id : Entity_Id; + Item_Typ : Entity_Id; - C_Scope := Current_Scope; + begin + -- Examine the contents of the list looking for an object declaration + -- of a task type or one that contains a task within. - -- If not outer level reference, then we follow it if it is within the - -- original scope of the outer reference. + Item := First (List); + while Present (Item) loop + if Nkind (Item) = N_Object_Declaration then + Item_Id := Defining_Entity (Item); + Item_Typ := Etype (Item_Id); - if Present (Outer_Scope) - and then Within (Scope (Ent), Outer_Scope) - then - Set_C_Scope; - Check_A_Call - (N => N, - E => Ent, - Outer_Scope => Outer_Scope, - Inter_Unit_Only => False, - In_Init_Proc => In_Init_Proc); - - -- Nothing to do if elaboration checks suppressed for this scope. - -- However, an interesting exception, the fact that elaboration checks - -- are suppressed within an instance (because we can trace the body when - -- we process the template) does not extend to calls to generic formal - -- subprograms. - - elsif Elaboration_Checks_Suppressed (Current_Scope) - and then not Is_Call_Of_Generic_Formal (N) - then - null; + if Has_Task (Item_Typ) then + Process_Task_Object (Item_Id, Item_Typ); + end if; + end if; - elsif From_Elab_Code then - Set_C_Scope; - Check_A_Call (N, Ent, Standard_Standard, Inter_Unit_Only => False); + Next (Item); + end loop; + end Process_Task_Objects; - elsif Same_Elaboration_Scope (C_Scope, Scope (Ent)) then - Set_C_Scope; - Check_A_Call (N, Ent, Scope (Ent), Inter_Unit_Only => False); + -- Local variables - -- If none of those cases holds, but Dynamic_Elaboration_Checks mode - -- is set, then we will do the check, but only in the inter-unit case - -- (this is to accommodate unguarded elaboration calls from other units - -- in which this same mode is set). We don't want warnings in this case, - -- it would generate warnings having nothing to do with elaboration. + Context : Node_Id; + Spec : Node_Id; - elsif Dynamic_Elaboration_Checks then - Set_C_Scope; - Check_A_Call - (N, - Ent, - Standard_Standard, - Inter_Unit_Only => True, - Generate_Warnings => False); + -- Start of processing for Process_Activation_Call - -- Otherwise nothing to do + begin + -- Nothing to do when the activation is a guaranteed ABE - else + if Is_Known_Guaranteed_ABE (Call) then return; end if; - -- A call to an Init_Proc in elaboration code may bring additional - -- dependencies, if some of the record components thereof have - -- initializations that are function calls that come from source. We - -- treat the current node as a call to each of these functions, to check - -- their elaboration impact. + -- Find the proper context of the activation call where all task objects + -- being activated are declared. This is usually the immediate parent of + -- the call. - if Is_Init_Proc (Ent) and then From_Elab_Code then - Process_Init_Proc : declare - Unit_Decl : constant Node_Id := Unit_Declaration_Node (Ent); + Context := Parent (Call); - function Check_Init_Call (Nod : Node_Id) return Traverse_Result; - -- Find subprogram calls within body of Init_Proc for Traverse - -- instantiation below. + -- In the case of package bodies, the activation call is in the handled + -- sequence of statements, but the task objects are in the declaration + -- list of the body. - procedure Traverse_Body is new Traverse_Proc (Check_Init_Call); - -- Traversal procedure to find all calls with body of Init_Proc + if Nkind (Context) = N_Handled_Sequence_Of_Statements + and then Nkind (Parent (Context)) = N_Package_Body + then + Context := Parent (Context); + end if; - --------------------- - -- Check_Init_Call -- - --------------------- + -- Process all task objects defined in both the spec and body when the + -- activation call precedes the "begin" of a package body. - function Check_Init_Call (Nod : Node_Id) return Traverse_Result is - Func : Entity_Id; + if Nkind (Context) = N_Package_Body then + Spec := + Specification + (Unit_Declaration_Node (Corresponding_Spec (Context))); - begin - if Nkind (Nod) in N_Subprogram_Call - and then Is_Entity_Name (Name (Nod)) - then - Func := Entity (Name (Nod)); + Process_Task_Objects (Visible_Declarations (Spec)); + Process_Task_Objects (Private_Declarations (Spec)); + Process_Task_Objects (Declarations (Context)); - if Comes_From_Source (Func) then - Check_A_Call - (N, Func, Standard_Standard, Inter_Unit_Only => True); - end if; + -- Process all task objects defined in the spec when the activation call + -- appears at the end of a package spec. - return OK; + elsif Nkind (Context) = N_Package_Specification then + Process_Task_Objects (Visible_Declarations (Context)); + Process_Task_Objects (Private_Declarations (Context)); - else - return OK; - end if; - end Check_Init_Call; + -- Otherwise the context of the activation is some construct with a + -- declarative part. Note that the corresponding record type of a task + -- type is controlled. Because of this, the finalization machinery must + -- relocate the task object to the handled statements of the construct + -- to perform proper finalization in case of an exception. Examine the + -- statements of the construct rather than the declarations. - -- Start of processing for Process_Init_Proc + else + pragma Assert (Nkind (Context) = N_Handled_Sequence_Of_Statements); - begin - if Nkind (Unit_Decl) = N_Subprogram_Body then - Traverse_Body (Handled_Statement_Sequence (Unit_Decl)); - end if; - end Process_Init_Proc; + Process_Task_Objects (Statements (Context)); end if; - end Check_Elab_Call; - - ----------------------- - -- Check_Elab_Assign -- - ----------------------- - - procedure Check_Elab_Assign (N : Node_Id) is - Ent : Entity_Id; - Scop : Entity_Id; + end Process_Activation_Call; + + --------------------------------------------- + -- Process_Activation_Conditional_ABE_Impl -- + --------------------------------------------- + + procedure Process_Activation_Conditional_ABE_Impl + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Obj_Id : Entity_Id; + Task_Attrs : Task_Attributes; + In_Task_Body : Boolean) + is + Check_OK : constant Boolean := + not Is_Ignored_Ghost_Entity (Obj_Id) + and then not Task_Attrs.Ghost_Mode_Ignore + and then Is_Elaboration_Checks_OK_Id (Obj_Id) + and then Task_Attrs.Elab_Checks_OK; + -- A run-time ABE check may be installed only when the object and the + -- task type have active elaboration checks, and both are not ignored + -- Ghost constructs. - Pkg_Spec : Entity_Id; - Pkg_Body : Entity_Id; + Root : constant Node_Id := Root_Scenario; begin - -- For record or array component, check prefix. If it is an access type, - -- then there is nothing to do (we do not know what is being assigned), - -- but otherwise this is an assignment to the prefix. + -- Output relevant information when switch -gnatel (info messages on + -- implicit Elaborate[_All] pragmas) is in effect. - if Nkind_In (N, N_Indexed_Component, - N_Selected_Component, - N_Slice) - then - if not Is_Access_Type (Etype (Prefix (N))) then - Check_Elab_Assign (Prefix (N)); - end if; - - return; + if Elab_Info_Messages then + Error_Msg_NE + ("info: activation of & during elaboration", Call, Obj_Id); end if; - -- For type conversion, check expression + -- Nothing to do when the activation is a guaranteed ABE - if Nkind (N) = N_Type_Conversion then - Check_Elab_Assign (Expression (N)); + if Is_Known_Guaranteed_ABE (Call) then return; - end if; - -- Nothing to do if this is not an entity reference otherwise get entity + -- Nothing to do when the root scenario appears at the declaration + -- level and the task is in the same unit, but outside this context. - if Is_Entity_Name (N) then - Ent := Entity (N); - else - return; - end if; + -- task type Task_Typ; -- task declaration - -- What we are looking for is a reference in the body of a package that - -- modifies a variable declared in the visible part of the package spec. + -- procedure Proc is + -- function A ... is + -- begin + -- if Some_Condition then + -- declare + -- T : Task_Typ; + -- begin + -- -- activation site + -- end; + -- ... + -- end A; - if Present (Ent) - and then Comes_From_Source (N) - and then not Suppress_Elaboration_Warnings (Ent) - and then Ekind (Ent) = E_Variable - and then not In_Private_Part (Ent) - and then Is_Library_Level_Entity (Ent) - then - Scop := Current_Scope; - loop - if No (Scop) or else Scop = Standard_Standard then - return; - elsif Ekind (Scop) = E_Package - and then Is_Compilation_Unit (Scop) - then - exit; - else - Scop := Scope (Scop); - end if; - end loop; + -- X : ... := A; -- root scenario + -- ... - -- Here Scop points to the containing library package + -- task body Task_Typ is + -- ... + -- end Task_Typ; - Pkg_Spec := Scop; - Pkg_Body := Body_Entity (Pkg_Spec); + -- In the example above, the context of X is the declarative list of + -- Proc. The "elaboration" of X may reach the activation of T whose body + -- is defined outside of X's context. The task body is relevant only + -- when Proc is invoked, but this happens only in "normal" elaboration, + -- therefore the task body must not be considered if this is not the + -- case. - -- All OK if the package has an Elaborate_Body pragma + -- Performance note: parent traversal - if Has_Pragma_Elaborate_Body (Scop) then - return; - end if; + elsif Is_Up_Level_Target (Task_Attrs.Task_Decl) then + return; - -- OK if entity being modified is not in containing package spec + -- Nothing to do when the activation is ABE-safe - if not In_Same_Source_Unit (Scop, Ent) then - return; - end if; + -- generic + -- package Gen is + -- task type Task_Typ; + -- end Gen; - -- All OK if entity appears in generic package or generic instance. - -- We just get too messed up trying to give proper warnings in the - -- presence of generics. Better no message than a junk one. + -- package body Gen is + -- task body Task_Typ is + -- begin + -- ... + -- end Task_Typ; + -- end Gen; - Scop := Scope (Ent); - while Present (Scop) and then Scop /= Pkg_Spec loop - if Ekind (Scop) = E_Generic_Package then - return; - elsif Ekind (Scop) = E_Package - and then Is_Generic_Instance (Scop) - then - return; - end if; + -- with Gen; + -- procedure Main is + -- package Nested is + -- ... + -- end Nested; - Scop := Scope (Scop); - end loop; + -- package body Nested is + -- package Inst is new Gen; + -- T : Inst.Task_Typ; + -- [begin] + -- -- safe activation + -- end Nested; + -- ... - -- All OK if in task, don't issue warnings there + elsif Is_Safe_Activation (Call, Task_Attrs.Task_Decl) then - if In_Task_Activation then - return; - end if; + -- Note that the task body must still be examined for any nested + -- scenarios. - -- OK if no package body + null; - if No (Pkg_Body) then - return; - end if; + -- The activation call and the task body are both in the main unit - -- OK if reference is not in package body + elsif Present (Task_Attrs.Body_Decl) + and then In_Extended_Main_Code_Unit (Task_Attrs.Body_Decl) + then + -- If the root scenario appears prior to the task body, then this is + -- a possible ABE with respect to the root scenario. - if not In_Same_Source_Unit (Pkg_Body, N) then - return; - end if; + -- task type Task_Typ; - -- OK if package body has no handled statement sequence + -- function A ... is + -- begin + -- if Some_Condition then + -- declare + -- package Pack is + -- ... + -- end Pack; - declare - HSS : constant Node_Id := - Handled_Statement_Sequence (Declaration_Node (Pkg_Body)); - begin - if No (HSS) or else not Comes_From_Source (HSS) then - return; - end if; - end; + -- package body Pack is + -- T : Task_Typ; + -- [begin] + -- -- activation of T + -- end Pack; + -- ... + -- end A; - -- We definitely have a case of a modification of an entity in - -- the package spec from the elaboration code of the package body. - -- We may not give the warning (because there are some additional - -- checks to avoid too many false positives), but it would be a good - -- idea for the binder to try to keep the body elaboration close to - -- the spec elaboration. + -- X : ... := A; -- root scenario - Set_Elaborate_Body_Desirable (Pkg_Spec); + -- task body Task_Typ is -- task body + -- ... + -- end Task_Typ; - -- All OK in gnat mode (we know what we are doing) + -- Y : ... := A; -- root scenario - if GNAT_Mode then - return; - end if; + -- IMPORTANT: The activation of T is a possible ABE for X, but + -- not for Y. Intalling an unconditional ABE raise prior to the + -- activation call would be wrong as it will fail for Y as well + -- but in Y's case the activation of T is never an ABE. - -- All OK if all warnings suppressed + if Earlier_In_Extended_Unit (Root, Task_Attrs.Body_Decl) then - if Warning_Mode = Suppress then - return; - end if; + -- ABE diagnostics are emitted only in the static model because + -- there is a well-defined order to visiting scenarios. Without + -- this order diagnostics appear jumbled and result in unwanted + -- noise. - -- All OK if elaboration checks suppressed for entity + if Static_Elaboration_Checks then + Error_Msg_Sloc := Sloc (Call); + Error_Msg_N + ("??task & will be activated # before elaboration of its " + & "body", Obj_Id); + Error_Msg_N + ("\Program_Error may be raised at run time", Obj_Id); - if Checks_May_Be_Suppressed (Ent) - and then Is_Check_Suppressed (Ent, Elaboration_Check) - then - return; - end if; + Output_Active_Scenarios (Obj_Id); + end if; - -- OK if the entity is initialized. Note that the No_Initialization - -- flag usually means that the initialization has been rewritten into - -- assignments, but that still counts for us. + -- Install a conditional run-time ABE check to verify that the + -- task body has been elaborated prior to the activation call. - declare - Decl : constant Node_Id := Declaration_Node (Ent); - begin - if Nkind (Decl) = N_Object_Declaration - and then (Present (Expression (Decl)) - or else No_Initialization (Decl)) - then - return; + if Check_OK then + Install_ABE_Check + (N => Call, + Ins_Nod => Call, + Target_Id => Task_Attrs.Spec_Id, + Target_Decl => Task_Attrs.Task_Decl, + Target_Body => Task_Attrs.Body_Decl); end if; - end; + end if; - -- Here is where we give the warning + -- Otherwise the task body is not available in this compilation or it + -- resides in an external unit. Install a run-time ABE check to verify + -- that the task body has been elaborated prior to the activation call + -- when the dynamic model is in effect. - -- All OK if warnings suppressed on the entity + elsif Dynamic_Elaboration_Checks and then Check_OK then + Install_ABE_Check + (N => Call, + Ins_Nod => Call, + Id => Task_Attrs.Unit_Id); + end if; - if not Has_Warnings_Off (Ent) then - Error_Msg_Sloc := Sloc (Ent); + -- Both the activation call and task type are subject to SPARK_Mode + -- On, this triggers the SPARK rules for task activation. Compared to + -- calls and instantiations, task activation in SPARK does not require + -- the presence of Elaborate[_All] pragmas in case the task type is + -- defined outside the main unit. This is because SPARK utilizes a + -- special policy which activates all tasks after the main unit has + -- finished its elaboration. - Error_Msg_NE - ("??& can be accessed by clients before this initialization", - N, Ent); - Error_Msg_NE - ("\??add Elaborate_Body to spec to ensure & is initialized", - N, Ent); - end if; + if Call_Attrs.SPARK_Mode_On and Task_Attrs.SPARK_Mode_On then + null; - if not All_Errors_Mode then - Set_Suppress_Elaboration_Warnings (Ent); - end if; + -- Otherwise the Ada rules are in effect. Ensure that the unit with the + -- task body is elaborated prior to the main unit. + + else + Ensure_Prior_Elaboration + (N => Call, + Unit_Id => Task_Attrs.Unit_Id, + In_Task_Body => In_Task_Body); end if; - end Check_Elab_Assign; - ---------------------- - -- Check_Elab_Calls -- - ---------------------- + Traverse_Body (Task_Attrs.Body_Decl, In_Task_Body => True); + end Process_Activation_Conditional_ABE_Impl; + + procedure Process_Activation_Conditional_ABE is + new Process_Activation_Call (Process_Activation_Conditional_ABE_Impl); - -- WARNING: This routine manages SPARK regions + -------------------------------------------- + -- Process_Activation_Guaranteed_ABE_Impl -- + -------------------------------------------- - procedure Check_Elab_Calls is - Saved_SM : SPARK_Mode_Type; - Saved_SMP : Node_Id; + procedure Process_Activation_Guaranteed_ABE_Impl + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Obj_Id : Entity_Id; + Task_Attrs : Task_Attributes; + In_Task_Body : Boolean) + is + pragma Unreferenced (Call_Attrs); + pragma Unreferenced (In_Task_Body); + + Check_OK : constant Boolean := + not Is_Ignored_Ghost_Entity (Obj_Id) + and then not Task_Attrs.Ghost_Mode_Ignore + and then Is_Elaboration_Checks_OK_Id (Obj_Id) + and then Task_Attrs.Elab_Checks_OK; + -- A run-time ABE check may be installed only when the object and the + -- task type have active elaboration checks, and both are not ignored + -- Ghost constructs. begin - -- If expansion is disabled, do not generate any checks, unless we - -- are in GNATprove mode, so that errors are issued in GNATprove for - -- violations of static elaboration rules in SPARK code. Also skip - -- checks if any subunits are missing because in either case we lack the - -- full information that we need, and no object file will be created in - -- any case. + -- Nothing to do when the root scenario appears at the declaration + -- level and the task is in the same unit, but outside this context. + + -- task type Task_Typ; -- task declaration + + -- procedure Proc is + -- function A ... is + -- begin + -- if Some_Condition then + -- declare + -- T : Task_Typ; + -- begin + -- -- activation site + -- end; + -- ... + -- end A; + + -- X : ... := A; -- root scenario + -- ... + + -- task body Task_Typ is + -- ... + -- end Task_Typ; + + -- In the example above, the context of X is the declarative list of + -- Proc. The "elaboration" of X may reach the activation of T whose body + -- is defined outside of X's context. The task body is relevant only + -- when Proc is invoked, but this happens only in "normal" elaboration, + -- therefore the task body must not be considered if this is not the + -- case. + + -- Performance note: parent traversal + + if Is_Up_Level_Target (Task_Attrs.Task_Decl) then + return; - if (not Expander_Active and not GNATprove_Mode) - or else Is_Generic_Unit (Cunit_Entity (Main_Unit)) - or else Subunits_Missing - then + -- Nothing to do when the activation is ABE-safe + + -- generic + -- package Gen is + -- task type Task_Typ; + -- end Gen; + + -- package body Gen is + -- task body Task_Typ is + -- begin + -- ... + -- end Task_Typ; + -- end Gen; + + -- with Gen; + -- procedure Main is + -- package Nested is + -- ... + -- end Nested; + + -- package body Nested is + -- package Inst is new Gen; + -- T : Inst.Task_Typ; + -- [begin] + -- -- safe activation + -- end Nested; + -- ... + + elsif Is_Safe_Activation (Call, Task_Attrs.Task_Decl) then return; - end if; - -- Skip delayed calls if we had any errors + -- An activation call leads to a guaranteed ABE when the activation + -- call and the task appear within the same context ignoring library + -- levels, and the body of the task has not been seen yet or appears + -- after the activation call. - if Serious_Errors_Detected = 0 then - Delaying_Elab_Checks := False; - Expander_Mode_Save_And_Set (True); + -- procedure Guaranteed_ABE is + -- task type Task_Typ; - for J in Delay_Check.First .. Delay_Check.Last loop - Push_Scope (Delay_Check.Table (J).Curscop); - From_Elab_Code := Delay_Check.Table (J).From_Elab_Code; - In_Task_Activation := Delay_Check.Table (J).In_Task_Activation; + -- package Nested is + -- ... + -- end Nested; - Saved_SM := SPARK_Mode; - Saved_SMP := SPARK_Mode_Pragma; + -- package body Nested is + -- T : Task_Typ; + -- [begin] + -- -- guaranteed ABE + -- end Nested; - -- Set appropriate value of SPARK_Mode + -- task body Task_Typ is + -- ... + -- end Task_Typ; + -- ... - if Delay_Check.Table (J).From_SPARK_Code then - SPARK_Mode := On; - end if; + -- Performance note: parent traversal + + elsif Is_Guaranteed_ABE + (N => Call, + Target_Decl => Task_Attrs.Task_Decl, + Target_Body => Task_Attrs.Body_Decl) + then + Error_Msg_Sloc := Sloc (Call); + Error_Msg_N + ("??task & will be activated # before elaboration of its body", + Obj_Id); + Error_Msg_N ("\Program_Error will be raised at run time", Obj_Id); - Check_Internal_Call_Continue - (N => Delay_Check.Table (J).N, - E => Delay_Check.Table (J).E, - Outer_Scope => Delay_Check.Table (J).Outer_Scope, - Orig_Ent => Delay_Check.Table (J).Orig_Ent); + -- Mark the activation call as a guaranteed ABE - Restore_SPARK_Mode (Saved_SM, Saved_SMP); - Pop_Scope; - end loop; + Set_Is_Known_Guaranteed_ABE (Call); - -- Set Delaying_Elab_Checks back on for next main compilation + -- Install a run-time ABE failue because this activation call will + -- always result in an ABE. - Expander_Mode_Restore; - Delaying_Elab_Checks := True; + if Check_OK then + Install_ABE_Failure + (N => Call, + Ins_Nod => Call); + end if; end if; - end Check_Elab_Calls; + end Process_Activation_Guaranteed_ABE_Impl; - ------------------------------ - -- Check_Elab_Instantiation -- - ------------------------------ + procedure Process_Activation_Guaranteed_ABE is + new Process_Activation_Call (Process_Activation_Guaranteed_ABE_Impl); - procedure Check_Elab_Instantiation - (N : Node_Id; - Outer_Scope : Entity_Id := Empty) + ------------------ + -- Process_Call -- + ------------------ + + procedure Process_Call + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + In_Task_Body : Boolean) is - Ent : Entity_Id; + SPARK_Rules_On : Boolean; + Target_Attrs : Target_Attributes; begin - -- Check for and deal with bad instantiation case. There is some - -- duplicated code here, but we will worry about this later ??? + Extract_Target_Attributes + (Target_Id => Target_Id, + Attrs => Target_Attrs); - Check_Bad_Instantiation (N); + -- The SPARK rules are in effect when both the call and target are + -- subject to SPARK_Mode On. - if ABE_Is_Certain (N) then - return; - end if; + SPARK_Rules_On := + Call_Attrs.SPARK_Mode_On and Target_Attrs.SPARK_Mode_On; - -- Nothing to do if we do not have an instantiation (happens in some - -- error cases, and also in the formal package declaration case) + -- Output relevant information when switch -gnatel (info messages on + -- implicit Elaborate[_All] pragmas) is in effect. - if Nkind (N) not in N_Generic_Instantiation then - return; + if Elab_Info_Messages then + Info_Call + (Call => Call, + Target_Id => Target_Id, + Info_Msg => True, + In_SPARK => SPARK_Rules_On); end if; - -- Nothing to do if inside a generic template + -- Check whether the invocation of an entry clashes with an existing + -- restriction. + + if Is_Protected_Entry (Target_Id) then + Check_Restriction (No_Entry_Calls_In_Elaboration_Code, Call); + + elsif Is_Task_Entry (Target_Id) then + Check_Restriction (No_Entry_Calls_In_Elaboration_Code, Call); + + -- Task entry calls are never processed because the entry being + -- invoked does not have a corresponding "body", it has a select. - if Inside_A_Generic then return; end if; - -- Nothing to do if the instantiation is not in the main unit + -- Nothing to do when the call is a guaranteed ABE - if not In_Extended_Main_Code_Unit (N) then + if Is_Known_Guaranteed_ABE (Call) then return; - end if; - Ent := Get_Generic_Entity (N); - From_Elab_Code := not In_Subprogram_Or_Concurrent_Unit; + -- Nothing to do when the root scenario appears at the declaration level + -- and the target is in the same unit, but outside this context. - -- See if we need to analyze this instantiation. We analyze it if - -- either of the following conditions is met: + -- function B ...; -- target declaration - -- It is an inner level instantiation (since in this case it was - -- triggered by an outer level call from elaboration code), but - -- only if the instantiation is within the scope of the original - -- outer level call. + -- procedure Proc is + -- function A ... is + -- begin + -- if Some_Condition then + -- return B; -- call site + -- ... + -- end A; - -- It is an outer level instantiation from elaboration code, or the - -- instantiated entity is in the same elaboration scope. + -- X : ... := A; -- root scenario + -- ... - -- And in these cases, we will check both the inter-unit case and - -- the intra-unit (within a single unit) case. + -- function B ... is + -- ... + -- end B; - C_Scope := Current_Scope; + -- In the example above, the context of X is the declarative region of + -- Proc. The "elaboration" of X may eventually reach B which is defined + -- outside of X's context. B is relevant only when Proc is invoked, but + -- this happens only by means of "normal" elaboration, therefore B must + -- not be considered if this is not the case. - if Present (Outer_Scope) and then Within (Scope (Ent), Outer_Scope) then - Set_C_Scope; - Check_A_Call (N, Ent, Outer_Scope, Inter_Unit_Only => False); + -- Performance note: parent traversal - elsif From_Elab_Code then - Set_C_Scope; - Check_A_Call (N, Ent, Standard_Standard, Inter_Unit_Only => False); + elsif Is_Up_Level_Target (Target_Attrs.Spec_Decl) then + return; - elsif Same_Elaboration_Scope (C_Scope, Scope (Ent)) then - Set_C_Scope; - Check_A_Call (N, Ent, Scope (Ent), Inter_Unit_Only => False); + -- The SPARK rules are verified only when -gnatd.v (enforce SPARK + -- elaboration rules in SPARK code) is in effect. - -- If none of those cases holds, but Dynamic_Elaboration_Checks mode is - -- set, then we will do the check, but only in the inter-unit case (this - -- is to accommodate unguarded elaboration calls from other units in - -- which this same mode is set). We inhibit warnings in this case, since - -- this instantiation is not occurring in elaboration code. + elsif SPARK_Rules_On and Debug_Flag_Dot_V then + Process_Call_SPARK + (Call => Call, + Call_Attrs => Call_Attrs, + Target_Id => Target_Id, + Target_Attrs => Target_Attrs); - elsif Dynamic_Elaboration_Checks then - Set_C_Scope; - Check_A_Call - (N, - Ent, - Standard_Standard, - Inter_Unit_Only => True, - Generate_Warnings => False); + -- Otherwise the Ada rules are in effect, or SPARK code is allowed to + -- violate the SPARK rules. else - return; + Process_Call_Ada + (Call => Call, + Call_Attrs => Call_Attrs, + Target_Id => Target_Id, + Target_Attrs => Target_Attrs, + In_Task_Body => In_Task_Body); end if; - end Check_Elab_Instantiation; - ------------------------- - -- Check_Internal_Call -- - ------------------------- + -- Inspect the target body (and barried function) for other suitable + -- elaboration scenarios. - procedure Check_Internal_Call - (N : Node_Id; - E : Entity_Id; - Outer_Scope : Entity_Id; - Orig_Ent : Entity_Id) + Traverse_Body (Target_Attrs.Body_Barf, In_Task_Body); + Traverse_Body (Target_Attrs.Body_Decl, In_Task_Body); + end Process_Call; + + ---------------------- + -- Process_Call_Ada -- + ---------------------- + + procedure Process_Call_Ada + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + Target_Attrs : Target_Attributes; + In_Task_Body : Boolean) is - function Within_Initial_Condition (Call : Node_Id) return Boolean; - -- Determine whether call Call occurs within pragma Initial_Condition or - -- pragma Check with check_kind set to Initial_Condition. + function In_Initialization_Context (N : Node_Id) return Boolean; + -- Determine whether arbitrary node N appears within a type init proc or + -- primitive [Deep_]Initialize. - ------------------------------ - -- Within_Initial_Condition -- - ------------------------------ + ------------------------------- + -- In_Initialization_Context -- + ------------------------------- - function Within_Initial_Condition (Call : Node_Id) return Boolean is - Args : List_Id; - Nam : Name_Id; - Par : Node_Id; + function In_Initialization_Context (N : Node_Id) return Boolean is + Par : Node_Id; + Spec_Id : Entity_Id; begin - -- Traverse the parent chain looking for an enclosing pragma + -- Climb the parent chain looking for initialization actions - Par := Call; + Par := Parent (N); while Present (Par) loop - if Nkind (Par) = N_Pragma then - Nam := Pragma_Name (Par); - - -- Pragma Initial_Condition appears in its alternative from as - -- Check (Initial_Condition, ...). - if Nam = Name_Check then - Args := Pragma_Argument_Associations (Par); + -- A block may be part of the initialization actions of a default + -- initialized object. - -- Pragma Check should have at least two arguments + if Nkind (Par) = N_Block_Statement + and then Is_Initialization_Block (Par) + then + return True; - pragma Assert (Present (Args)); + -- A subprogram body may denote an initialization routine - return - Chars (Expression (First (Args))) = Name_Initial_Condition; + elsif Nkind (Par) = N_Subprogram_Body then + Spec_Id := Unique_Defining_Entity (Par); - -- Direct match + -- The current subprogram body denotes a type init proc or + -- primitive [Deep_]Initialize. - elsif Nam = Name_Initial_Condition then + if Is_Init_Proc (Spec_Id) + or else Is_Controlled_Proc (Spec_Id, Name_Initialize) + or else Is_TSS (Spec_Id, TSS_Deep_Initialize) + then return True; - - -- Since pragmas are never nested within other pragmas, stop - -- the traversal. - - else - return False; end if; -- Prevent the search from going too far @@ -2184,1667 +7037,1453 @@ package body Sem_Elab is end if; Par := Parent (Par); - - -- If assertions are not enabled, the check pragma is rewritten - -- as an if_statement in sem_prag, to generate various warnings - -- on boolean expressions. Retrieve the original pragma. - - if Nkind (Original_Node (Par)) = N_Pragma then - Par := Original_Node (Par); - end if; end loop; return False; - end Within_Initial_Condition; + end In_Initialization_Context; -- Local variables - Inst_Case : constant Boolean := Nkind (N) in N_Generic_Instantiation; + Check_OK : constant Boolean := + not Call_Attrs.Ghost_Mode_Ignore + and then not Target_Attrs.Ghost_Mode_Ignore + and then Call_Attrs.Elab_Checks_OK + and then Target_Attrs.Elab_Checks_OK; + -- A run-time ABE check may be installed only when both the call and the + -- target have active elaboration checks, and both are not ignored Ghost + -- constructs. - -- Start of processing for Check_Internal_Call + -- Start of processing for Process_Call_Ada begin - -- For P'Access, we want to warn if the -gnatw.f switch is set, and the - -- node comes from source. - - if Nkind (N) = N_Attribute_Reference - and then ((not Warn_On_Elab_Access and then not Debug_Flag_Dot_O) - or else not Comes_From_Source (N)) - then - return; - - -- If not function or procedure call, instantiation, or 'Access, then - -- ignore call (this happens in some error cases and rewriting cases). - - elsif not Nkind_In (N, N_Attribute_Reference, - N_Function_Call, - N_Procedure_Call_Statement) - and then not Inst_Case - then - return; + -- Nothing to do for an Ada dispatching call because there are no ABE + -- diagnostics for either models. ABE checks for the dynamic model are + -- handled by Install_Primitive_Elaboration_Check. - -- Nothing to do if this is a call or instantiation that has already - -- been found to be a sure ABE. - - elsif Nkind (N) /= N_Attribute_Reference and then ABE_Is_Certain (N) then + if Call_Attrs.Is_Dispatching then return; - -- Nothing to do if errors already detected (avoid cascaded errors) - - elsif Serious_Errors_Detected /= 0 then - return; + -- Nothing to do when the call is ABE-safe - -- Nothing to do if not in full analysis mode + -- generic + -- function Gen ...; - elsif not Full_Analysis then - return; + -- function Gen ... is + -- begin + -- ... + -- end Gen; - -- Nothing to do if analyzing in special spec-expression mode, since the - -- call is not actually being made at this time. + -- with Gen; + -- procedure Main is + -- function Inst is new Gen; + -- X : ... := Inst; -- safe call + -- ... - elsif In_Spec_Expression then + elsif Is_Safe_Call (Call, Target_Attrs) then return; - -- Nothing to do for call to intrinsic subprogram - - elsif Is_Intrinsic_Subprogram (E) then - return; + -- The call and the target body are both in the main unit - -- Nothing to do if call is within a generic unit + elsif Present (Target_Attrs.Body_Decl) + and then In_Extended_Main_Code_Unit (Target_Attrs.Body_Decl) + then + Process_Call_Conditional_ABE + (Call => Call, + Call_Attrs => Call_Attrs, + Target_Id => Target_Id, + Target_Attrs => Target_Attrs); + + -- Otherwise the target body is not available in this compilation or it + -- resides in an external unit. Install a run-time ABE check to verify + -- that the target body has been elaborated prior to the call site when + -- the dynamic model is in effect. + + elsif Dynamic_Elaboration_Checks and then Check_OK then + Install_ABE_Check + (N => Call, + Ins_Nod => Call, + Id => Target_Attrs.Unit_Id); + end if; - elsif Inside_A_Generic then - return; + -- No implicit pragma Elaborate[_All] is generated when the call has + -- elaboration checks suppressed. This behaviour parallels that of the + -- old ABE mechanism. - -- Nothing to do when the call appears within pragma Initial_Condition. - -- The pragma is part of the elaboration statements of a package body - -- and may only call external subprograms or subprograms whose body is - -- already available. + if not Call_Attrs.Elab_Checks_OK then + null; - elsif Within_Initial_Condition (N) then - return; - end if; + -- No implicit pragma Elaborate[_All] is generated for finalization + -- actions when primitive [Deep_]Finalize is not defined in the main + -- unit and the call appears within some initialization actions. This + -- behaviour parallels that of the old ABE mechanism. - -- Delay this call if we are still delaying calls + -- Performance note: parent traversal - if Delaying_Elab_Checks then - Delay_Check.Append - ((N => N, - E => E, - Orig_Ent => Orig_Ent, - Curscop => Current_Scope, - Outer_Scope => Outer_Scope, - From_Elab_Code => From_Elab_Code, - In_Task_Activation => In_Task_Activation, - From_SPARK_Code => SPARK_Mode = On)); - return; + elsif (Is_Controlled_Proc (Target_Id, Name_Finalize) + or else Is_TSS (Target_Id, TSS_Deep_Finalize)) + and then not In_Extended_Main_Code_Unit (Target_Attrs.Spec_Decl) + and then In_Initialization_Context (Call) + then + null; - -- Otherwise, call phase 2 continuation right now + -- Otherwise ensure that the unit with the target body is elaborated + -- prior to the main unit. else - Check_Internal_Call_Continue (N, E, Outer_Scope, Orig_Ent); + Ensure_Prior_Elaboration + (N => Call, + Unit_Id => Target_Attrs.Unit_Id, + In_Task_Body => In_Task_Body); end if; - end Check_Internal_Call; + end Process_Call_Ada; ---------------------------------- - -- Check_Internal_Call_Continue -- + -- Process_Call_Conditional_ABE -- ---------------------------------- - procedure Check_Internal_Call_Continue - (N : Node_Id; - E : Entity_Id; - Outer_Scope : Entity_Id; - Orig_Ent : Entity_Id) + procedure Process_Call_Conditional_ABE + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + Target_Attrs : Target_Attributes) is - function Find_Elab_Reference (N : Node_Id) return Traverse_Result; - -- Function applied to each node as we traverse the body. Checks for - -- call or entity reference that needs checking, and if so checks it. - -- Always returns OK, so entire tree is traversed, except that as - -- described below subprogram bodies are skipped for now. + Check_OK : constant Boolean := + not Call_Attrs.Ghost_Mode_Ignore + and then not Target_Attrs.Ghost_Mode_Ignore + and then Call_Attrs.Elab_Checks_OK + and then Target_Attrs.Elab_Checks_OK; + -- A run-time ABE check may be installed only when both the call and the + -- target have active elaboration checks, and both are not ignored Ghost + -- constructs. - procedure Traverse is new Atree.Traverse_Proc (Find_Elab_Reference); - -- Traverse procedure using above Find_Elab_Reference function + Root : constant Node_Id := Root_Scenario; - ------------------------- - -- Find_Elab_Reference -- - ------------------------- + begin + -- If the root scenario appears prior to the target body, then this is a + -- possible ABE with respect to the root scenario. - function Find_Elab_Reference (N : Node_Id) return Traverse_Result is - Actual : Node_Id; + -- function B ...; - begin - -- If user has specified that there are no entry calls in elaboration - -- code, do not trace past an accept statement, because the rendez- - -- vous will happen after elaboration. + -- function A ... is + -- begin + -- if Some_Condition then + -- return B; -- call site + -- ... + -- end A; - if Nkind_In (Original_Node (N), N_Accept_Statement, - N_Selective_Accept) - and then Restriction_Active (No_Entry_Calls_In_Elaboration_Code) - then - return Abandon; + -- X : ... := A; -- root scenario - -- If we have a function call, check it + -- function B ... is -- target body + -- ... + -- end B; - elsif Nkind (N) = N_Function_Call then - Check_Elab_Call (N, Outer_Scope); - return OK; + -- Y : ... := A; -- root scenario - -- If we have a procedure call, check the call, and also check - -- arguments that are assignments (OUT or IN OUT mode formals). + -- IMPORTANT: The call to B from A is a possible ABE for X, but not for + -- Y. Installing an unconditional ABE raise prior to the call to B would + -- be wrong as it will fail for Y as well, but in Y's case the call to B + -- is never an ABE. - elsif Nkind (N) = N_Procedure_Call_Statement then - Check_Elab_Call (N, Outer_Scope, In_Init_Proc => Is_Init_Proc (E)); + if Earlier_In_Extended_Unit (Root, Target_Attrs.Body_Decl) then - Actual := First_Actual (N); - while Present (Actual) loop - if Known_To_Be_Assigned (Actual) then - Check_Elab_Assign (Actual); - end if; + -- ABE diagnostics are emitted only in the static model because there + -- is a well-defined order to visiting scenarios. Without this order + -- diagnostics appear jumbled and result in unwanted noise. - Next_Actual (Actual); - end loop; + if Static_Elaboration_Checks then + Error_Msg_NE ("??cannot call & before body seen", Call, Target_Id); + Error_Msg_N ("\Program_Error may be raised at run time", Call); - return OK; + Output_Active_Scenarios (Call); + end if; - -- If we have an access attribute for a subprogram, check it. - -- Suppress this behavior under debug flag. + -- Install a conditional run-time ABE check to verify that the target + -- body has been elaborated prior to the call. - elsif not Debug_Flag_Dot_UU - and then Nkind (N) = N_Attribute_Reference - and then Nam_In (Attribute_Name (N), Name_Access, - Name_Unrestricted_Access) - and then Is_Entity_Name (Prefix (N)) - and then Is_Subprogram (Entity (Prefix (N))) - then - Check_Elab_Call (N, Outer_Scope); - return OK; + if Check_OK then + Install_ABE_Check + (N => Call, + Ins_Nod => Call, + Target_Id => Target_Attrs.Spec_Id, + Target_Decl => Target_Attrs.Spec_Decl, + Target_Body => Target_Attrs.Body_Decl); + end if; + end if; + end Process_Call_Conditional_ABE; - -- In SPARK mode, if we have an entity reference to a variable, then - -- check it. For now we consider any reference. + --------------------------------- + -- Process_Call_Guaranteed_ABE -- + --------------------------------- - elsif SPARK_Mode = On - and then Nkind (N) in N_Has_Entity - and then Present (Entity (N)) - and then Ekind (Entity (N)) = E_Variable - then - Check_Elab_Call (N, Outer_Scope); - return OK; + procedure Process_Call_Guaranteed_ABE + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id) + is + Target_Attrs : Target_Attributes; - -- If we have a generic instantiation, check it + begin + Extract_Target_Attributes + (Target_Id => Target_Id, + Attrs => Target_Attrs); - elsif Nkind (N) in N_Generic_Instantiation then - Check_Elab_Instantiation (N, Outer_Scope); - return OK; + -- Nothing to do when the root scenario appears at the declaration level + -- and the target is in the same unit, but outside this context. - -- Skip subprogram bodies that come from source (wait for call to - -- analyze these). The reason for the come from source test is to - -- avoid catching task bodies. + -- function B ...; -- target declaration - -- For task bodies, we should really avoid these too, waiting for the - -- task activation, but that's too much trouble to catch for now, so - -- we go in unconditionally. This is not so terrible, it means the - -- error backtrace is not quite complete, and we are too eager to - -- scan bodies of tasks that are unused, but this is hardly very - -- significant. + -- procedure Proc is + -- function A ... is + -- begin + -- if Some_Condition then + -- return B; -- call site + -- ... + -- end A; - elsif Nkind (N) = N_Subprogram_Body - and then Comes_From_Source (N) - then - return Skip; + -- X : ... := A; -- root scenario + -- ... - elsif Nkind (N) = N_Assignment_Statement - and then Comes_From_Source (N) - then - Check_Elab_Assign (Name (N)); - return OK; + -- function B ... is + -- ... + -- end B; - else - return OK; - end if; - end Find_Elab_Reference; + -- In the example above, the context of X is the declarative region of + -- Proc. The "elaboration" of X may eventually reach B which is defined + -- outside of X's context. B is relevant only when Proc is invoked, but + -- this happens only by means of "normal" elaboration, therefore B must + -- not be considered if this is not the case. - Inst_Case : constant Boolean := Is_Generic_Unit (E); - Loc : constant Source_Ptr := Sloc (N); + -- Performance note: parent traversal - Ebody : Entity_Id; - Sbody : Node_Id; + if Is_Up_Level_Target (Target_Attrs.Spec_Decl) then + return; - -- Start of processing for Check_Internal_Call_Continue + -- Nothing to do when the call is ABE-safe - begin - -- Save outer level call if at outer level + -- generic + -- function Gen ...; - if Elab_Call.Last = 0 then - Outer_Level_Sloc := Loc; - end if; + -- function Gen ... is + -- begin + -- ... + -- end Gen; - -- If the call is to a function that renames a literal, no check needed + -- with Gen; + -- procedure Main is + -- function Inst is new Gen; + -- X : ... := Inst; -- safe call + -- ... - if Ekind (E) = E_Enumeration_Literal then + elsif Is_Safe_Call (Call, Target_Attrs) then return; - end if; - - -- Register the subprogram as examined within this particular context. - -- This ensures that calls to the same subprogram but in different - -- contexts receive warnings and checks of their own since the calls - -- may be reached through different flow paths. - Elab_Visited.Append ((Subp_Id => E, Context => Parent (N))); + -- A call leads to a guaranteed ABE when the call and the target appear + -- within the same context ignoring library levels, and the body of the + -- target has not been seen yet or appears after the call. - Sbody := Unit_Declaration_Node (E); + -- procedure Guaranteed_ABE is + -- function Func ...; - if not Nkind_In (Sbody, N_Subprogram_Body, N_Package_Body) then - Ebody := Corresponding_Body (Sbody); + -- package Nested is + -- Obj : ... := Func; -- guaranteed ABE + -- end Nested; - if No (Ebody) then - return; - else - Sbody := Unit_Declaration_Node (Ebody); - end if; - end if; + -- function Func ... is + -- ... + -- end Func; + -- ... - -- If the body appears after the outer level call or instantiation then - -- we have an error case handled below. + -- Performance note: parent traversal - if Earlier_In_Extended_Unit (Outer_Level_Sloc, Sloc (Sbody)) - and then not In_Task_Activation + elsif Is_Guaranteed_ABE + (N => Call, + Target_Decl => Target_Attrs.Spec_Decl, + Target_Body => Target_Attrs.Body_Decl) then - null; + Error_Msg_NE ("??cannot call & before body seen", Call, Target_Id); + Error_Msg_N ("\Program_Error will be raised at run time", Call); - -- If we have the instantiation case we are done, since we now know that - -- the body of the generic appeared earlier. + -- Mark the call as a guarnateed ABE - elsif Inst_Case then - return; + Set_Is_Known_Guaranteed_ABE (Call); - -- Otherwise we have a call, so we trace through the called body to see - -- if it has any problems. + -- Install a run-time ABE failure because the call will always result + -- in an ABE. The failure is installed when both the call and target + -- have enabled elaboration checks, and both are not ignored Ghost + -- constructs. - else - pragma Assert (Nkind (Sbody) = N_Subprogram_Body); - - Elab_Call.Append ((Cloc => Loc, Ent => E)); - - if Debug_Flag_LL then - Write_Str ("Elab_Call.Last = "); - Write_Int (Int (Elab_Call.Last)); - Write_Str (" Ent = "); - Write_Name (Chars (E)); - Write_Str (" at "); - Write_Location (Sloc (N)); - Write_Eol; + if Call_Attrs.Elab_Checks_OK + and then Target_Attrs.Elab_Checks_OK + and then not Call_Attrs.Ghost_Mode_Ignore + and then not Target_Attrs.Ghost_Mode_Ignore + then + Install_ABE_Failure + (N => Call, + Ins_Nod => Call); end if; - - -- Now traverse declarations and statements of subprogram body. Note - -- that we cannot simply Traverse (Sbody), since traverse does not - -- normally visit subprogram bodies. - - declare - Decl : Node_Id; - begin - Decl := First (Declarations (Sbody)); - while Present (Decl) loop - Traverse (Decl); - Next (Decl); - end loop; - end; - - Traverse (Handled_Statement_Sequence (Sbody)); - - Elab_Call.Decrement_Last; - return; end if; + end Process_Call_Guaranteed_ABE; - -- Here is the case of calling a subprogram where the body has not yet - -- been encountered. A warning message is needed, except if this is the - -- case of appearing within an aspect specification that results in - -- a check call, we do not really have such a situation, so no warning - -- is needed (e.g. the case of a precondition, where the call appears - -- textually before the body, but in actual fact is moved to the - -- appropriate subprogram body and so does not need a check). + ------------------------ + -- Process_Call_SPARK -- + ------------------------ - declare - P : Node_Id; - O : Node_Id; + procedure Process_Call_SPARK + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + Target_Attrs : Target_Attributes) + is + begin + -- A call to a source target or to a target which emulates Ada or SPARK + -- semantics imposes an Elaborate_All requirement on the context of the + -- main unit. Determine whether the context has a pragma strong enough + -- to meet the requirement. The check is orthogonal to the ABE effects + -- of the call. + + if Target_Attrs.From_Source + or else Is_Ada_Semantic_Target (Target_Id) + or else Is_SPARK_Semantic_Target (Target_Id) + then + Meet_Elaboration_Requirement + (N => Call, + Target_Id => Target_Id, + Req_Nam => Name_Elaborate_All); + end if; - begin - P := Parent (N); - loop - -- Keep looking at parents if we are still in the subexpression + -- Nothing to do when the call is ABE-safe - if Nkind (P) in N_Subexpr then - P := Parent (P); + -- generic + -- function Gen ...; - -- Here P is the parent of the expression, check for special case + -- function Gen ... is + -- begin + -- ... + -- end Gen; - else - O := Original_Node (P); + -- with Gen; + -- procedure Main is + -- function Inst is new Gen; + -- X : ... := Inst; -- safe call + -- ... - -- Definitely not the special case if orig node is not a pragma + if Is_Safe_Call (Call, Target_Attrs) then + return; - exit when Nkind (O) /= N_Pragma; + -- The call and the target body are both in the main unit - -- Check we have an If statement or a null statement (happens - -- when the If has been expanded to be True). + elsif Present (Target_Attrs.Body_Decl) + and then In_Extended_Main_Code_Unit (Target_Attrs.Body_Decl) + then + Process_Call_Conditional_ABE + (Call => Call, + Call_Attrs => Call_Attrs, + Target_Id => Target_Id, + Target_Attrs => Target_Attrs); + + -- Otherwise the target body is not available in this compilation or it + -- resides in an external unit. There is no need to guarantee the prior + -- elaboration of the unit with the target body because either the main + -- unit meets the Elaborate_All requirement imposed by the call, or the + -- program is illegal. - exit when not Nkind_In (P, N_If_Statement, N_Null_Statement); + else + null; + end if; + end Process_Call_SPARK; - -- Our special case will be indicated either by the pragma - -- coming from an aspect ... + ---------------------------- + -- Process_Guaranteed_ABE -- + ---------------------------- - if Present (Corresponding_Aspect (O)) then - return; + procedure Process_Guaranteed_ABE (N : Node_Id) is + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; - -- Or, in the case of an initial condition, specifically by a - -- Check pragma specifying an Initial_Condition check. + begin + -- Add the current scenario to the stack of active scenarios - elsif Pragma_Name (O) = Name_Check - and then - Chars - (Expression (First (Pragma_Argument_Associations (O)))) = - Name_Initial_Condition - then - return; + Push_Active_Scenario (N); - -- For anything else, we have an error + -- Only calls, instantiations, and task activations may result in a + -- guaranteed ABE. - else - exit; - end if; - end if; - end loop; - end; + if Is_Suitable_Call (N) then + Extract_Call_Attributes + (Call => N, + Target_Id => Target_Id, + Attrs => Call_Attrs); - -- Not that special case, warning and dynamic check is required + if Is_Activation_Proc (Target_Id) then + Process_Activation_Guaranteed_ABE + (Call => N, + Call_Attrs => Call_Attrs, + In_Task_Body => False); - -- If we have nothing in the call stack, then this is at the outer - -- level, and the ABE is bound to occur, unless it's a 'Access, or - -- it's a renaming. + else + Process_Call_Guaranteed_ABE + (Call => N, + Call_Attrs => Call_Attrs, + Target_Id => Target_Id); + end if; - if Elab_Call.Last = 0 then - Error_Msg_Warn := SPARK_Mode /= On; + elsif Is_Suitable_Instantiation (N) then + Process_Instantiation_Guaranteed_ABE (N); + end if; - declare - Insert_Check : Boolean := True; - -- This flag is set to True if an elaboration check should be - -- inserted. + -- Remove the current scenario from the stack of active scenarios once + -- all ABE diagnostics and checks have been performed. - begin - if In_Task_Activation then - Insert_Check := False; + Pop_Active_Scenario (N); + end Process_Guaranteed_ABE; - elsif Inst_Case then - Error_Msg_NE - ("cannot instantiate& before body seen<<", N, Orig_Ent); + --------------------------- + -- Process_Instantiation -- + --------------------------- - elsif Nkind (N) = N_Attribute_Reference then - Error_Msg_NE - ("Access attribute of & before body seen<<", N, Orig_Ent); - Error_Msg_N ("\possible Program_Error on later references<", N); - Insert_Check := False; + procedure Process_Instantiation + (Exp_Inst : Node_Id; + In_Task_Body : Boolean) + is + Gen_Attrs : Target_Attributes; + Gen_Id : Entity_Id; + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Inst_Id : Entity_Id; - elsif Nkind (Unit_Declaration_Node (Orig_Ent)) /= - N_Subprogram_Renaming_Declaration - then - Error_Msg_NE - ("cannot call& before body seen<<", N, Orig_Ent); + SPARK_Rules_On : Boolean; + -- This flag is set when the SPARK rules are in effect - elsif not Is_Generic_Actual_Subprogram (Orig_Ent) then - Insert_Check := False; - end if; + begin + Extract_Instantiation_Attributes + (Exp_Inst => Exp_Inst, + Inst => Inst, + Inst_Id => Inst_Id, + Gen_Id => Gen_Id, + Attrs => Inst_Attrs); - if Insert_Check then - Error_Msg_N ("\Program_Error [<<", N); - Insert_Elab_Check (N); - end if; - end; + Extract_Target_Attributes (Gen_Id, Gen_Attrs); - -- Call is not at outer level + -- The SPARK rules are in effect when both the instantiation and generic + -- are subject to SPARK_Mode On. - else - -- Do not generate elaboration checks in GNATprove mode because the - -- elaboration counter and the check are both forms of expansion. + SPARK_Rules_On := Inst_Attrs.SPARK_Mode_On and Gen_Attrs.SPARK_Mode_On; - if GNATprove_Mode then - null; + -- Output relevant information when switch -gnatel (info messages on + -- implicit Elaborate[_All] pragmas) is in effect. - -- Generate an elaboration check - - elsif not Elaboration_Checks_Suppressed (E) then - Set_Elaboration_Entity_Required (E); - - -- Create a declaration of the elaboration entity, and insert it - -- prior to the subprogram or the generic unit, within the same - -- scope. Since the subprogram may be overloaded, create a unique - -- entity. - - if No (Elaboration_Entity (E)) then - declare - Loce : constant Source_Ptr := Sloc (E); - Ent : constant Entity_Id := - Make_Defining_Identifier (Loc, - New_External_Name (Chars (E), 'E', -1)); - - begin - Set_Elaboration_Entity (E, Ent); - Push_Scope (Scope (E)); - - Insert_Action (Declaration_Node (E), - Make_Object_Declaration (Loce, - Defining_Identifier => Ent, - Object_Definition => - New_Occurrence_Of (Standard_Short_Integer, Loce), - Expression => - Make_Integer_Literal (Loc, Uint_0))); - - -- Set elaboration flag at the point of the body - - Set_Elaboration_Flag (Sbody, E); - - -- Kill current value indication. This is necessary because - -- the tests of this flag are inserted out of sequence and - -- must not pick up bogus indications of the wrong constant - -- value. Also, this is never a true constant, since one way - -- or another, it gets reset. - - Set_Current_Value (Ent, Empty); - Set_Last_Assignment (Ent, Empty); - Set_Is_True_Constant (Ent, False); - Pop_Scope; - end; - end if; + if Elab_Info_Messages then + Info_Instantiation + (Inst => Inst, + Gen_Id => Gen_Id, + Info_Msg => True, + In_SPARK => SPARK_Rules_On); + end if; - -- Generate: - -- if Enn = 0 then - -- raise Program_Error with "access before elaboration"; - -- end if; + -- Nothing to do when the instantiation is a guaranteed ABE - Insert_Elab_Check (N, - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Elaborated, - Prefix => New_Occurrence_Of (E, Loc))); - end if; + if Is_Known_Guaranteed_ABE (Inst) then + return; - -- Generate the warning + -- Nothing to do when the root scenario appears at the declaration level + -- and the generic is in the same unit, but outside this context. - if not Suppress_Elaboration_Warnings (E) - and then not Elaboration_Checks_Suppressed (E) + -- generic + -- procedure Gen is ...; -- generic declaration - -- Suppress this warning if we have a function call that occurred - -- within an assertion expression, since we can get false warnings - -- in this case, due to the out of order handling in this case. + -- procedure Proc is + -- function A ... is + -- begin + -- if Some_Condition then + -- declare + -- procedure I is new Gen; -- instantiation site + -- ... + -- ... + -- end A; - and then - (Nkind (Original_Node (N)) /= N_Function_Call - or else not In_Assertion_Expression_Pragma (Original_Node (N))) - then - Error_Msg_Warn := SPARK_Mode /= On; + -- X : ... := A; -- root scenario + -- ... - if Inst_Case then - Error_Msg_NE - ("instantiation of& may occur before body is seen Exp_Inst, + Inst => Inst, + Inst_Attrs => Inst_Attrs, + Gen_Id => Gen_Id, + Gen_Attrs => Gen_Attrs); - <> + -- Otherwise the Ada rules are in effect, or SPARK code is allowed to + -- violate the SPARK rules. - Output_Calls (N, Check_Elab_Flag => False); - end if; + else + Process_Instantiation_Ada + (Exp_Inst => Exp_Inst, + Inst => Inst, + Inst_Attrs => Inst_Attrs, + Gen_Id => Gen_Id, + Gen_Attrs => Gen_Attrs, + In_Task_Body => In_Task_Body); end if; - end Check_Internal_Call_Continue; - - --------------------------- - -- Check_Task_Activation -- - --------------------------- - - procedure Check_Task_Activation (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Inter_Procs : constant Elist_Id := New_Elmt_List; - Intra_Procs : constant Elist_Id := New_Elmt_List; - Ent : Entity_Id; - P : Entity_Id; - Task_Scope : Entity_Id; - Cunit_SC : Boolean := False; - Decl : Node_Id; - Elmt : Elmt_Id; - Enclosing : Entity_Id; - - procedure Add_Task_Proc (Typ : Entity_Id); - -- Add to Task_Procs the task body procedure(s) of task types in Typ. - -- For record types, this procedure recurses over component types. - - procedure Collect_Tasks (Decls : List_Id); - -- Collect the types of the tasks that are to be activated in the given - -- list of declarations, in order to perform elaboration checks on the - -- corresponding task procedures that are called implicitly here. - - function Outer_Unit (E : Entity_Id) return Entity_Id; - -- find enclosing compilation unit of Entity, ignoring subunits, or - -- else enclosing subprogram. If E is not a package, there is no need - -- for inter-unit elaboration checks. - - ------------------- - -- Add_Task_Proc -- - ------------------- - - procedure Add_Task_Proc (Typ : Entity_Id) is - Comp : Entity_Id; - Proc : Entity_Id := Empty; - - begin - if Is_Task_Type (Typ) then - Proc := Get_Task_Body_Procedure (Typ); - - elsif Is_Array_Type (Typ) - and then Has_Task (Base_Type (Typ)) - then - Add_Task_Proc (Component_Type (Typ)); + end Process_Instantiation; - elsif Is_Record_Type (Typ) - and then Has_Task (Base_Type (Typ)) - then - Comp := First_Component (Typ); - while Present (Comp) loop - Add_Task_Proc (Etype (Comp)); - Comp := Next_Component (Comp); - end loop; - end if; + ------------------------------- + -- Process_Instantiation_Ada -- + ------------------------------- - -- If the task type is another unit, we will perform the usual - -- elaboration check on its enclosing unit. If the type is in the - -- same unit, we can trace the task body as for an internal call, - -- but we only need to examine other external calls, because at - -- the point the task is activated, internal subprogram bodies - -- will have been elaborated already. We keep separate lists for - -- each kind of task. + procedure Process_Instantiation_Ada + (Exp_Inst : Node_Id; + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Gen_Id : Entity_Id; + Gen_Attrs : Target_Attributes; + In_Task_Body : Boolean) + is + Check_OK : constant Boolean := + not Inst_Attrs.Ghost_Mode_Ignore + and then not Gen_Attrs.Ghost_Mode_Ignore + and then Inst_Attrs.Elab_Checks_OK + and then Gen_Attrs.Elab_Checks_OK; + -- A run-time ABE check may be installed only when both the instance and + -- the generic have active elaboration checks and both are not ignored + -- Ghost constructs. - -- Skip this test if errors have occurred, since in this case - -- we can get false indications. + begin + -- Nothing to do when the instantiation is ABE-safe - if Serious_Errors_Detected /= 0 then - return; - end if; + -- generic + -- package Gen is + -- ... + -- end Gen; - if Present (Proc) then - if Outer_Unit (Scope (Proc)) = Enclosing then + -- package body Gen is + -- ... + -- end Gen; - if No (Corresponding_Body (Unit_Declaration_Node (Proc))) - and then - (not Is_Generic_Instance (Scope (Proc)) - or else Scope (Proc) = Scope (Defining_Identifier (Decl))) - then - Error_Msg_Warn := SPARK_Mode /= On; - Error_Msg_N - ("task will be activated before elaboration of its body<<", - Decl); - Error_Msg_N ("\Program_Error [<<", Decl); - - elsif Present - (Corresponding_Body (Unit_Declaration_Node (Proc))) - then - Append_Elmt (Proc, Intra_Procs); - end if; + -- with Gen; + -- procedure Main is + -- package Inst is new Gen (ABE); -- safe instantiation + -- ... - else - -- No need for multiple entries of the same type + if Is_Safe_Instantiation (Inst, Gen_Attrs) then + return; - Elmt := First_Elmt (Inter_Procs); - while Present (Elmt) loop - if Node (Elmt) = Proc then - return; - end if; + -- The instantiation and the generic body are both in the main unit - Next_Elmt (Elmt); - end loop; + elsif Present (Gen_Attrs.Body_Decl) + and then In_Extended_Main_Code_Unit (Gen_Attrs.Body_Decl) + then + Process_Instantiation_Conditional_ABE + (Exp_Inst => Exp_Inst, + Inst => Inst, + Inst_Attrs => Inst_Attrs, + Gen_Id => Gen_Id, + Gen_Attrs => Gen_Attrs); + + -- Otherwise the generic body is not available in this compilation or it + -- resides in an external unit. Install a run-time ABE check to verify + -- that the generic body has been elaborated prior to the instantiation + -- when the dynamic model is in effect. + + elsif Dynamic_Elaboration_Checks and then Check_OK then + Install_ABE_Check + (N => Inst, + Ins_Nod => Exp_Inst, + Id => Gen_Attrs.Unit_Id); + end if; - Append_Elmt (Proc, Inter_Procs); - end if; - end if; - end Add_Task_Proc; + -- Ensure that the unit with the generic body is elaborated prior to + -- the main unit. No implicit pragma Elaborate[_All] is generated if + -- the instantiation has elaboration checks suppressed. This behaviour + -- parallels that of the old ABE mechanism. - ------------------- - -- Collect_Tasks -- - ------------------- + if Inst_Attrs.Elab_Checks_OK then + Ensure_Prior_Elaboration + (N => Inst, + Unit_Id => Gen_Attrs.Unit_Id, + In_Task_Body => In_Task_Body); + end if; + end Process_Instantiation_Ada; + + ------------------------------------------- + -- Process_Instantiation_Conditional_ABE -- + ------------------------------------------- + + procedure Process_Instantiation_Conditional_ABE + (Exp_Inst : Node_Id; + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Gen_Id : Entity_Id; + Gen_Attrs : Target_Attributes) + is + Check_OK : constant Boolean := + not Inst_Attrs.Ghost_Mode_Ignore + and then not Gen_Attrs.Ghost_Mode_Ignore + and then Inst_Attrs.Elab_Checks_OK + and then Gen_Attrs.Elab_Checks_OK; + -- A run-time ABE check may be installed only when both the instance and + -- the generic have active elaboration checks and both are not ignored + -- Ghost constructs. - procedure Collect_Tasks (Decls : List_Id) is - begin - if Present (Decls) then - Decl := First (Decls); - while Present (Decl) loop - if Nkind (Decl) = N_Object_Declaration - and then Has_Task (Etype (Defining_Identifier (Decl))) - then - Add_Task_Proc (Etype (Defining_Identifier (Decl))); - end if; + Root : constant Node_Id := Root_Scenario; - Next (Decl); - end loop; - end if; - end Collect_Tasks; + begin + -- If the root scenario appears prior to the generic body, then this is + -- a possible ABE with respect to the root scenario. - ---------------- - -- Outer_Unit -- - ---------------- + -- generic + -- package Gen is + -- ... + -- end Gen; - function Outer_Unit (E : Entity_Id) return Entity_Id is - Outer : Entity_Id; + -- function A ... is + -- begin + -- if Some_Condition then + -- declare + -- package Inst is new Gen; -- instantiation site + -- ... + -- end A; - begin - Outer := E; - while Present (Outer) loop - if Elaboration_Checks_Suppressed (Outer) then - Cunit_SC := True; - end if; + -- X : ... := A; -- root scenario - exit when Is_Child_Unit (Outer) - or else Scope (Outer) = Standard_Standard - or else Ekind (Outer) /= E_Package; - Outer := Scope (Outer); - end loop; + -- package body Gen is -- generic body + -- ... + -- end Gen; - return Outer; - end Outer_Unit; + -- Y : ... := A; -- root scenario - -- Start of processing for Check_Task_Activation + -- IMPORTANT: The instantiation of Gen is a possible ABE for X, but not + -- for Y. Installing an unconditional ABE raise prior to the instance + -- site would be wrong as it will fail for Y as well, but in Y's case + -- the instantiation of Gen is never an ABE. - begin - Enclosing := Outer_Unit (Current_Scope); + if Earlier_In_Extended_Unit (Root, Gen_Attrs.Body_Decl) then - -- Find all tasks declared in the current unit + -- ABE diagnostics are emitted only in the static model because there + -- is a well-defined order to visiting scenarios. Without this order + -- diagnostics appear jumbled and result in unwanted noise. - if Nkind (N) = N_Package_Body then - P := Unit_Declaration_Node (Corresponding_Spec (N)); + if Static_Elaboration_Checks then + Error_Msg_NE + ("??cannot instantiate & before body seen", Inst, Gen_Id); + Error_Msg_N ("\Program_Error may be raised at run time", Inst); - Collect_Tasks (Declarations (N)); - Collect_Tasks (Visible_Declarations (Specification (P))); - Collect_Tasks (Private_Declarations (Specification (P))); + Output_Active_Scenarios (Inst); + end if; - elsif Nkind (N) = N_Package_Declaration then - Collect_Tasks (Visible_Declarations (Specification (N))); - Collect_Tasks (Private_Declarations (Specification (N))); + -- Install a conditional run-time ABE check to verify that the + -- generic body has been elaborated prior to the instantiation. - else - Collect_Tasks (Declarations (N)); + if Check_OK then + Install_ABE_Check + (N => Inst, + Ins_Nod => Exp_Inst, + Target_Id => Gen_Attrs.Spec_Id, + Target_Decl => Gen_Attrs.Spec_Decl, + Target_Body => Gen_Attrs.Body_Decl); + end if; end if; + end Process_Instantiation_Conditional_ABE; - -- We only perform detailed checks in all tasks that are library level - -- entities. If the master is a subprogram or task, activation will - -- depend on the activation of the master itself. + ------------------------------------------ + -- Process_Instantiation_Guaranteed_ABE -- + ------------------------------------------ - -- Should dynamic checks be added in the more general case??? + procedure Process_Instantiation_Guaranteed_ABE (Exp_Inst : Node_Id) is + Gen_Attrs : Target_Attributes; + Gen_Id : Entity_Id; + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Inst_Id : Entity_Id; - if Ekind (Enclosing) /= E_Package then + begin + Extract_Instantiation_Attributes + (Exp_Inst => Exp_Inst, + Inst => Inst, + Inst_Id => Inst_Id, + Gen_Id => Gen_Id, + Attrs => Inst_Attrs); + + Extract_Target_Attributes (Gen_Id, Gen_Attrs); + + -- Nothing to do when the root scenario appears at the declaration level + -- and the generic is in the same unit, but outside this context. + + -- generic + -- procedure Gen is ...; -- generic declaration + + -- procedure Proc is + -- function A ... is + -- begin + -- if Some_Condition then + -- declare + -- procedure I is new Gen; -- instantiation site + -- ... + -- ... + -- end A; + + -- X : ... := A; -- root scenario + -- ... + + -- procedure Gen is + -- ... + -- end Gen; + + -- In the example above, the context of X is the declarative region of + -- Proc. The "elaboration" of X may eventually reach Gen which appears + -- outside of X's context. Gen is relevant only when Proc is invoked, + -- but this happens only by means of "normal" elaboration, therefore + -- Gen must not be considered if this is not the case. + + -- Performance note: parent traversal + + if Is_Up_Level_Target (Gen_Attrs.Spec_Decl) then return; - end if; - - -- For task types defined in other units, we want the unit containing - -- the task body to be elaborated before the current one. - - Elmt := First_Elmt (Inter_Procs); - while Present (Elmt) loop - Ent := Node (Elmt); - Task_Scope := Outer_Unit (Scope (Ent)); - - if not Is_Compilation_Unit (Task_Scope) then - null; - - elsif Suppress_Elaboration_Warnings (Task_Scope) - or else Elaboration_Checks_Suppressed (Task_Scope) - then - null; - - elsif Dynamic_Elaboration_Checks then - if not Elaboration_Checks_Suppressed (Ent) - and then not Cunit_SC - and then not Restriction_Active - (No_Entry_Calls_In_Elaboration_Code) - then - -- Runtime elaboration check required. Generate check of the - -- elaboration counter for the unit containing the entity. - - Insert_Elab_Check (N, - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Spec_Entity (Task_Scope), Loc), - Attribute_Name => Name_Elaborated)); - end if; - - else - -- Force the binder to elaborate other unit first - - if Elab_Info_Messages - and then not Suppress_Elaboration_Warnings (Ent) - and then not Elaboration_Checks_Suppressed (Ent) - and then not Suppress_Elaboration_Warnings (Task_Scope) - and then not Elaboration_Checks_Suppressed (Task_Scope) - then - Error_Msg_Node_2 := Task_Scope; - Error_Msg_NE - ("info: activation of an instance of task type & requires " - & "pragma Elaborate_All on &?$?", N, Ent); - end if; - - Activate_Elaborate_All_Desirable (N, Task_Scope); - Set_Suppress_Elaboration_Warnings (Task_Scope); - end if; - - Next_Elmt (Elmt); - end loop; - - -- For tasks declared in the current unit, trace other calls within the - -- task procedure bodies, which are available. - if not Debug_Flag_Dot_Y then - In_Task_Activation := True; + -- Nothing to do when the instantiation is ABE-safe - Elmt := First_Elmt (Intra_Procs); - while Present (Elmt) loop - Ent := Node (Elmt); - Check_Internal_Call_Continue (N, Ent, Enclosing, Ent); - Next_Elmt (Elmt); - end loop; + -- generic + -- package Gen is + -- ... + -- end Gen; - In_Task_Activation := False; - end if; - end Check_Task_Activation; + -- package body Gen is + -- ... + -- end Gen; - ------------------------------- - -- Is_Call_Of_Generic_Formal -- - ------------------------------- + -- with Gen; + -- procedure Main is + -- package Inst is new Gen (ABE); -- safe instantiation + -- ... - function Is_Call_Of_Generic_Formal (N : Node_Id) return Boolean is - begin - return Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) + elsif Is_Safe_Instantiation (Inst, Gen_Attrs) then + return; - -- Always return False if debug flag -gnatd.G is set + -- An instantiation leads to a guaranteed ABE when the instantiation and + -- the generic appear within the same context ignoring library levels, + -- and the body of the generic has not been seen yet or appears after + -- the instantiation. - and then not Debug_Flag_Dot_GG + -- procedure Guaranteed_ABE is + -- generic + -- procedure Gen; - -- For now, we detect this by looking for the strange identifier - -- node, whose Chars reflect the name of the generic formal, but - -- the Chars of the Entity references the generic actual. + -- package Nested is + -- procedure Inst is new Gen; -- guaranteed ABE + -- end Nested; - and then Nkind (Name (N)) = N_Identifier - and then Chars (Name (N)) /= Chars (Entity (Name (N))); - end Is_Call_Of_Generic_Formal; + -- procedure Gen is + -- ... + -- end Gen; + -- ... - -------------------------------- - -- Set_Elaboration_Constraint -- - -------------------------------- + -- Performance note: parent traversal - procedure Set_Elaboration_Constraint - (Call : Node_Id; - Subp : Entity_Id; - Scop : Entity_Id) - is - Elab_Unit : Entity_Id; + elsif Is_Guaranteed_ABE + (N => Inst, + Target_Decl => Gen_Attrs.Spec_Decl, + Target_Body => Gen_Attrs.Body_Decl) + then + Error_Msg_NE + ("??cannot instantiate & before body seen", Inst, Gen_Id); + Error_Msg_N ("\Program_Error will be raised at run time", Inst); - -- Check whether this is a call to an Initialize subprogram for a - -- controlled type. Note that Call can also be a 'Access attribute - -- reference, which now generates an elaboration check. + -- Mark the instantiation as a guarantee ABE. This automatically + -- suppresses the instantiation of the generic body. - Init_Call : constant Boolean := - Nkind (Call) = N_Procedure_Call_Statement - and then Chars (Subp) = Name_Initialize - and then Comes_From_Source (Subp) - and then Present (Parameter_Associations (Call)) - and then Is_Controlled (Etype (First_Actual (Call))); + Set_Is_Known_Guaranteed_ABE (Inst); - begin - -- If the unit is mentioned in a with_clause of the current unit, it is - -- visible, and we can set the elaboration flag. + -- Install a run-time ABE failure because the instantiation will + -- always result in an ABE. The failure is installed when both the + -- instance and the generic have enabled elaboration checks, and both + -- are not ignored Ghost constructs. - if Is_Immediately_Visible (Scop) - or else (Is_Child_Unit (Scop) and then Is_Visible_Lib_Unit (Scop)) - then - Activate_Elaborate_All_Desirable (Call, Scop); - Set_Suppress_Elaboration_Warnings (Scop); - return; + if Inst_Attrs.Elab_Checks_OK + and then Gen_Attrs.Elab_Checks_OK + and then not Inst_Attrs.Ghost_Mode_Ignore + and then not Gen_Attrs.Ghost_Mode_Ignore + then + Install_ABE_Failure + (N => Inst, + Ins_Nod => Exp_Inst); + end if; end if; + end Process_Instantiation_Guaranteed_ABE; + + --------------------------------- + -- Process_Instantiation_SPARK -- + --------------------------------- + + procedure Process_Instantiation_SPARK + (Exp_Inst : Node_Id; + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Gen_Id : Entity_Id; + Gen_Attrs : Target_Attributes) + is + Req_Nam : Name_Id; - -- If this is not an initialization call or a call using object notation - -- we know that the unit of the called entity is in the context, and we - -- can set the flag as well. The unit need not be visible if the call - -- occurs within an instantiation. - - if Is_Init_Proc (Subp) - or else Init_Call - or else Nkind (Original_Node (Call)) = N_Selected_Component - then - null; -- detailed processing follows. + begin + -- A source instantiation imposes an Elaborate[_All] requirement on the + -- context of the main unit. Determine whether the context has a pragma + -- strong enough to meet the requirement. The check is orthogonal to the + -- ABE ramifications of the instantiation. + if Nkind (Inst) = N_Package_Instantiation then + Req_Nam := Name_Elaborate_All; else - Activate_Elaborate_All_Desirable (Call, Scop); - Set_Suppress_Elaboration_Warnings (Scop); - return; + Req_Nam := Name_Elaborate; end if; - -- If the unit is not in the context, there must be an intermediate unit - -- that is, on which we need to place to elaboration flag. This happens - -- with init proc calls. + Meet_Elaboration_Requirement + (N => Inst, + Target_Id => Gen_Id, + Req_Nam => Req_Nam); - if Is_Init_Proc (Subp) or else Init_Call then + -- Nothing to do when the instantiation is ABE-safe - -- The initialization call is on an object whose type is not declared - -- in the same scope as the subprogram. The type of the object must - -- be a subtype of the type of operation. This object is the first - -- actual in the call. + -- generic + -- package Gen is + -- ... + -- end Gen; - declare - Typ : constant Entity_Id := - Etype (First (Parameter_Associations (Call))); - begin - Elab_Unit := Scope (Typ); - while (Present (Elab_Unit)) - and then not Is_Compilation_Unit (Elab_Unit) - loop - Elab_Unit := Scope (Elab_Unit); - end loop; - end; + -- package body Gen is + -- ... + -- end Gen; - -- If original node uses selected component notation, the prefix is - -- visible and determines the scope that must be elaborated. After - -- rewriting, the prefix is the first actual in the call. + -- with Gen; + -- procedure Main is + -- package Inst is new Gen (ABE); -- safe instantiation + -- ... - elsif Nkind (Original_Node (Call)) = N_Selected_Component then - Elab_Unit := Scope (Etype (First (Parameter_Associations (Call)))); + if Is_Safe_Instantiation (Inst, Gen_Attrs) then + return; - -- Not one of special cases above + -- The instantiation and the generic body are both in the main unit - else - -- Using previously computed scope. If the elaboration check is - -- done after analysis, the scope is not visible any longer, but - -- must still be in the context. + elsif Present (Gen_Attrs.Body_Decl) + and then In_Extended_Main_Code_Unit (Gen_Attrs.Body_Decl) + then + Process_Instantiation_Conditional_ABE + (Exp_Inst => Exp_Inst, + Inst => Inst, + Inst_Attrs => Inst_Attrs, + Gen_Id => Gen_Id, + Gen_Attrs => Gen_Attrs); + + -- Otherwise the generic body is not available in this compilation or + -- it resides in an external unit. There is no need to guarantee the + -- prior elaboration of the unit with the generic body because either + -- the main unit meets the Elaborate[_All] requirement imposed by the + -- instantiation, or the program is illegal. - Elab_Unit := Scop; + else + null; end if; + end Process_Instantiation_SPARK; - Activate_Elaborate_All_Desirable (Call, Elab_Unit); - Set_Suppress_Elaboration_Warnings (Elab_Unit); - end Set_Elaboration_Constraint; + --------------------------------- + -- Process_Variable_Assignment -- + --------------------------------- - ------------------------ - -- Get_Referenced_Ent -- - ------------------------ + procedure Process_Variable_Assignment (Asmt : Node_Id) is + Var_Id : constant Entity_Id := Entity (Extract_Assignment_Name (Asmt)); + Prag : constant Node_Id := SPARK_Pragma (Var_Id); - function Get_Referenced_Ent (N : Node_Id) return Entity_Id is - Nam : Node_Id; + SPARK_Rules_On : Boolean; + -- This flag is set when the SPARK rules are in effect begin - if Nkind (N) in N_Has_Entity - and then Present (Entity (N)) - and then Ekind (Entity (N)) = E_Variable - then - return Entity (N); + -- The SPARK rules are in effect when both the assignment and the + -- variable are subject to SPARK_Mode On. + + SPARK_Rules_On := + Present (Prag) + and then Get_SPARK_Mode_From_Annotation (Prag) = On + and then Is_SPARK_Mode_On_Node (Asmt); + + -- Output relevant information when switch -gnatel (info messages on + -- implicit Elaborate[_All] pragmas) is in effect. + + if Elab_Info_Messages then + Elab_Msg_NE + (Msg => "assignment to & during elaboration", + N => Asmt, + Id => Var_Id, + Info_Msg => True, + In_SPARK => SPARK_Rules_On); end if; - if Nkind (N) = N_Attribute_Reference then - Nam := Prefix (N); - else - Nam := Name (N); - end if; + -- The SPARK rules are in effect. These rules are applied regardless of + -- whether -gnatd.v (enforce SPARK elaboration rules in SPARK code) is + -- in effect because the static model cannot ensure safe assignment of + -- variables. + + if SPARK_Rules_On then + Process_Variable_Assignment_SPARK + (Asmt => Asmt, + Var_Id => Var_Id); + + -- Otherwise the Ada rules are in effect - if No (Nam) then - return Empty; - elsif Nkind (Nam) = N_Selected_Component then - return Entity (Selector_Name (Nam)); - elsif not Is_Entity_Name (Nam) then - return Empty; else - return Entity (Nam); + Process_Variable_Assignment_Ada + (Asmt => Asmt, + Var_Id => Var_Id); end if; - end Get_Referenced_Ent; - - ---------------------- - -- Has_Generic_Body -- - ---------------------- + end Process_Variable_Assignment; - function Has_Generic_Body (N : Node_Id) return Boolean is - Ent : constant Entity_Id := Get_Generic_Entity (N); - Decl : constant Node_Id := Unit_Declaration_Node (Ent); - Scop : Entity_Id; - - function Find_Body_In (E : Entity_Id; N : Node_Id) return Node_Id; - -- Determine if the list of nodes headed by N and linked by Next - -- contains a package body for the package spec entity E, and if so - -- return the package body. If not, then returns Empty. - - function Load_Package_Body (Nam : Unit_Name_Type) return Node_Id; - -- This procedure is called load the unit whose name is given by Nam. - -- This unit is being loaded to see whether it contains an optional - -- generic body. The returned value is the loaded unit, which is always - -- a package body (only package bodies can contain other entities in the - -- sense in which Has_Generic_Body is interested). We only attempt to - -- load bodies if we are generating code. If we are in semantics check - -- only mode, then it would be wrong to load bodies that are not - -- required from a semantic point of view, so in this case we return - -- Empty. The result is that the caller may incorrectly decide that a - -- generic spec does not have a body when in fact it does, but the only - -- harm in this is that some warnings on elaboration problems may be - -- lost in semantic checks only mode, which is not big loss. We also - -- return Empty if we go for a body and it is not there. - - function Locate_Corresponding_Body (PE : Entity_Id) return Node_Id; - -- PE is the entity for a package spec. This function locates the - -- corresponding package body, returning Empty if none is found. The - -- package body returned is fully parsed but may not yet be analyzed, - -- so only syntactic fields should be referenced. - - ------------------ - -- Find_Body_In -- - ------------------ - - function Find_Body_In (E : Entity_Id; N : Node_Id) return Node_Id is - Nod : Node_Id; + ------------------------------------- + -- Process_Variable_Assignment_Ada -- + ------------------------------------- - begin - Nod := N; - while Present (Nod) loop + procedure Process_Variable_Assignment_Ada + (Asmt : Node_Id; + Var_Id : Entity_Id) + is + Var_Decl : constant Node_Id := Declaration_Node (Var_Id); + Spec_Id : constant Entity_Id := Find_Top_Unit (Var_Decl); - -- If we found the package body we are looking for, return it + begin + -- Emit a warning when an uninitialized variable declared in a package + -- spec without a pragma Elaborate_Body is initialized by elaboration + -- code within the corresponding body. - if Nkind (Nod) = N_Package_Body - and then Chars (Defining_Unit_Name (Nod)) = Chars (E) - then - return Nod; + if not Warnings_Off (Var_Id) + and then not Is_Initialized (Var_Decl) + and then not Has_Pragma_Elaborate_Body (Spec_Id) + then + -- Generate an implicit Elaborate_Body in the spec - -- If we found the stub for the body, go after the subunit, - -- loading it if necessary. + Set_Elaborate_Body_Desirable (Spec_Id); - elsif Nkind (Nod) = N_Package_Body_Stub - and then Chars (Defining_Identifier (Nod)) = Chars (E) - then - if Present (Library_Unit (Nod)) then - return Unit (Library_Unit (Nod)); + Error_Msg_NE + ("??variable & can be accessed by clients before this " + & "initialization", Asmt, Var_Id); - else - return Load_Package_Body (Get_Unit_Name (Nod)); - end if; + Error_Msg_NE + ("\add pragma ""Elaborate_Body"" to spec & to ensure proper " + & "initialization", Asmt, Spec_Id); - -- If neither package body nor stub, keep looking on chain + Output_Active_Scenarios (Asmt); + end if; + end Process_Variable_Assignment_Ada; - else - Next (Nod); - end if; - end loop; + --------------------------------------- + -- Process_Variable_Assignment_SPARK -- + --------------------------------------- - return Empty; - end Find_Body_In; + procedure Process_Variable_Assignment_SPARK + (Asmt : Node_Id; + Var_Id : Entity_Id) + is + Var_Decl : constant Node_Id := Declaration_Node (Var_Id); + Spec_Id : constant Entity_Id := Find_Top_Unit (Var_Decl); - ----------------------- - -- Load_Package_Body -- - ----------------------- + begin + -- Emit an error when an initialized variable declared in a package spec + -- without pragma Elaborate_Body is further modified by elaboration code + -- within the corresponding body. - function Load_Package_Body (Nam : Unit_Name_Type) return Node_Id is - U : Unit_Number_Type; + if Is_Initialized (Var_Decl) + and then not Has_Pragma_Elaborate_Body (Spec_Id) + then + Error_Msg_NE + ("variable & modified by elaboration code in package body", + Asmt, Var_Id); - begin - if Operating_Mode /= Generate_Code then - return Empty; - else - U := - Load_Unit - (Load_Name => Nam, - Required => False, - Subunit => False, - Error_Node => N); + Error_Msg_NE + ("\add pragma ""Elaborate_Body"" to spec & to ensure full " + & "initialization", Asmt, Spec_Id); - if U = No_Unit then - return Empty; - else - return Unit (Cunit (U)); - end if; - end if; - end Load_Package_Body; + Output_Active_Scenarios (Asmt); + end if; + end Process_Variable_Assignment_SPARK; - ------------------------------- - -- Locate_Corresponding_Body -- - ------------------------------- + --------------------------- + -- Process_Variable_Read -- + --------------------------- - function Locate_Corresponding_Body (PE : Entity_Id) return Node_Id is - Spec : constant Node_Id := Declaration_Node (PE); - Decl : constant Node_Id := Parent (Spec); - Scop : constant Entity_Id := Scope (PE); - PBody : Node_Id; + procedure Process_Variable_Read (Ref : Node_Id) is + Var_Attrs : Variable_Attributes; + Var_Id : Entity_Id; - begin - if Is_Library_Level_Entity (PE) then + begin + Extract_Variable_Reference_Attributes + (Ref => Ref, + Var_Id => Var_Id, + Attrs => Var_Attrs); + + -- Output relevant information when switch -gnatel (info messages on + -- implicit Elaborate[_All] pragmas) is in effect. + + if Elab_Info_Messages then + Elab_Msg_NE + (Msg => "read of variable & during elaboration", + N => Ref, + Id => Var_Id, + Info_Msg => True, + In_SPARK => True); + end if; - -- If package is a library unit that requires a body, we have no - -- choice but to go after that body because it might contain an - -- optional body for the original generic package. + -- Nothing to do when the variable appears within the main unit because + -- diagnostics on reads are relevant only for external variables. - if Unit_Requires_Body (PE) then + if Is_Same_Unit (Var_Attrs.Unit_Id, Cunit_Entity (Main_Unit)) then + null; - -- Load the body. Note that we are a little careful here to use - -- Spec to get the unit number, rather than PE or Decl, since - -- in the case where the package is itself a library level - -- instantiation, Spec will properly reference the generic - -- template, which is what we really want. + -- Nothing to do when the variable is already initialized. Note that the + -- variable may be further modified by the external unit. - return - Load_Package_Body - (Get_Body_Name (Unit_Name (Get_Source_Unit (Spec)))); + elsif Is_Initialized (Declaration_Node (Var_Id)) then + null; - -- But if the package is a library unit that does NOT require - -- a body, then no body is permitted, so we are sure that there - -- is no body for the original generic package. + -- Nothing to do when the external unit guarantees the initialization of + -- the variable by means of pragma Elaborate_Body. - else - return Empty; - end if; + elsif Has_Pragma_Elaborate_Body (Var_Attrs.Unit_Id) then + null; - -- Otherwise look and see if we are embedded in a further package + -- A variable read imposes an Elaborate requirement on the context of + -- the main unit. Determine whether the context has a pragma strong + -- enough to meet the requirement. - elsif Is_Package_Or_Generic_Package (Scop) then + else + Meet_Elaboration_Requirement + (N => Ref, + Target_Id => Var_Id, + Req_Nam => Name_Elaborate); + end if; + end Process_Variable_Read; - -- If so, get the body of the enclosing package, and look in - -- its package body for the package body we are looking for. + -------------------------- + -- Push_Active_Scenario -- + -------------------------- - PBody := Locate_Corresponding_Body (Scop); + procedure Push_Active_Scenario (N : Node_Id) is + begin + Scenario_Stack.Append (N); + end Push_Active_Scenario; - if No (PBody) then - return Empty; - else - return Find_Body_In (PE, First (Declarations (PBody))); - end if; + ---------------------- + -- Process_Scenario -- + ---------------------- - -- If we are not embedded in a further package, then the body - -- must be in the same declarative part as we are. + procedure Process_Scenario (N : Node_Id; In_Task_Body : Boolean := False) is + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; - else - return Find_Body_In (PE, Next (Decl)); - end if; - end Locate_Corresponding_Body; + begin + -- Add the current scenario to the stack of active scenarios - -- Start of processing for Has_Generic_Body + Push_Active_Scenario (N); - begin - if Present (Corresponding_Body (Decl)) then - return True; + -- 'Access - elsif Unit_Requires_Body (Ent) then - return True; + if Is_Suitable_Access (N) then + Process_Access (N, In_Task_Body); - -- Compilation units cannot have optional bodies + -- Calls - elsif Is_Compilation_Unit (Ent) then - return False; + elsif Is_Suitable_Call (N) then - -- Otherwise look at what scope we are in + -- In general, only calls found within the main unit are processed + -- because the ALI information supplied to binde is for the main + -- unit only. However, to preserve the consistency of the tree and + -- ensure proper serialization of internal names, external calls + -- also receive corresponding call markers (see Build_Call_Marker). + -- Regardless of the reason, external calls must not be processed. - else - Scop := Scope (Ent); + if In_Main_Context (N) then + Extract_Call_Attributes + (Call => N, + Target_Id => Target_Id, + Attrs => Call_Attrs); - -- Case of entity is in other than a package spec, in this case - -- the body, if present, must be in the same declarative part. + if Is_Activation_Proc (Target_Id) then + Process_Activation_Conditional_ABE + (Call => N, + Call_Attrs => Call_Attrs, + In_Task_Body => In_Task_Body); - if not Is_Package_Or_Generic_Package (Scop) then - declare - P : Node_Id; + else + Process_Call + (Call => N, + Call_Attrs => Call_Attrs, + Target_Id => Target_Id, + In_Task_Body => In_Task_Body); + end if; + end if; - begin - -- Declaration node may get us a spec, so if so, go to - -- the parent declaration. + -- Instantiations - P := Declaration_Node (Ent); - while not Is_List_Member (P) loop - P := Parent (P); - end loop; + elsif Is_Suitable_Instantiation (N) then + Process_Instantiation (N, In_Task_Body); - return Present (Find_Body_In (Ent, Next (P))); - end; + -- Variable assignments - -- If the entity is in a package spec, then we have to locate - -- the corresponding package body, and look there. + elsif Is_Suitable_Variable_Assignment (N) then + Process_Variable_Assignment (N); - else - declare - PBody : constant Node_Id := Locate_Corresponding_Body (Scop); + -- Variable read - begin - if No (PBody) then - return False; - else - return - Present - (Find_Body_In (Ent, (First (Declarations (PBody))))); - end if; - end; - end if; + elsif Is_Suitable_Variable_Read (N) then + Process_Variable_Read (N); end if; - end Has_Generic_Body; - ----------------------- - -- Insert_Elab_Check -- - ----------------------- + -- Remove the current scenario from the stack of active scenarios once + -- all ABE diagnostics and checks have been performed. + + Pop_Active_Scenario (N); + end Process_Scenario; - procedure Insert_Elab_Check (N : Node_Id; C : Node_Id := Empty) is - Nod : Node_Id; - Loc : constant Source_Ptr := Sloc (N); + --------------------------------- + -- Record_Elaboration_Scenario -- + --------------------------------- - Chk : Node_Id; - -- The check (N_Raise_Program_Error) node to be inserted + procedure Record_Elaboration_Scenario (N : Node_Id) is + Level : Enclosing_Level_Kind; + + Declaration_Level_OK : Boolean; + -- This flag is set when a particular scenario is allowed to appear at + -- the declaration level. begin - -- If expansion is disabled, do not generate any checks. Also - -- skip checks if any subunits are missing because in either - -- case we lack the full information that we need, and no object - -- file will be created in any case. + -- Assume that the scenario must not appear at the declaration level + + Declaration_Level_OK := False; - if not Expander_Active or else Subunits_Missing then + -- Nothing to do for ASIS. As a result, no ABE checks and diagnostics + -- are performed in this mode. + + if ASIS_Mode then return; - end if; - -- If we have a generic instantiation, where Instance_Spec is set, - -- then this field points to a generic instance spec that has - -- been inserted before the instantiation node itself, so that - -- is where we want to insert a check. + -- Nothing to do when the scenario is being preanalyzed - if Nkind (N) in N_Generic_Instantiation - and then Present (Instance_Spec (N)) - then - Nod := Instance_Spec (N); - else - Nod := N; + elsif Preanalysis_Active then + return; end if; - -- Build check node, possibly with condition - - Chk := - Make_Raise_Program_Error (Loc, Reason => PE_Access_Before_Elaboration); + -- Ensure that a library level call does not appear in a preelaborated + -- unit. The check must come before ignoring scenarios within external + -- units or inside generics because calls in those context must also be + -- verified. - if Present (C) then - Set_Condition (Chk, Make_Op_Not (Loc, Right_Opnd => C)); + if Is_Suitable_Call (N) then + Check_Preelaborated_Call (N); end if; - -- If we are inserting at the top level, insert in Aux_Decls + -- Nothing to do when the scenario does not appear within the main unit - if Nkind (Parent (Nod)) = N_Compilation_Unit then - declare - ADN : constant Node_Id := Aux_Decls_Node (Parent (Nod)); + if not In_Main_Context (N) then + return; - begin - if No (Declarations (ADN)) then - Set_Declarations (ADN, New_List (Chk)); - else - Append_To (Declarations (ADN), Chk); - end if; + -- Scenarios within a generic unit are never considered because generics + -- cannot be elaborated. - Analyze (Chk); - end; + elsif Inside_A_Generic then + return; - -- Otherwise just insert as an action on the node in question + -- Scenarios which do not fall in one of the elaboration categories + -- listed below are not considered. The categories are: - else - Insert_Action (Nod, Chk); - end if; - end Insert_Elab_Check; + -- 'Access for entries, operators, and subprograms + -- Assignments to variables + -- Calls (includes task activation) + -- Instantiations + -- Reads of variables - ------------------------------- - -- Is_Finalization_Procedure -- - ------------------------------- + elsif Is_Suitable_Access (N) then - function Is_Finalization_Procedure (Id : Entity_Id) return Boolean is - begin - -- Check whether Id is a procedure with at least one parameter + -- Signal any enclosing local exception handlers that the 'Access may + -- raise Program_Error due to a failed ABE check when switch -gnatd.o + -- (conservative elaboration order for indirect calls) is in effect. + -- Marking the exception handlers ensures proper expansion by both + -- the front and back end restriction when No_Exception_Propagation + -- is in effect. - if Ekind (Id) = E_Procedure and then Present (First_Formal (Id)) then - declare - Typ : constant Entity_Id := Etype (First_Formal (Id)); - Deep_Fin : Entity_Id := Empty; - Fin : Entity_Id := Empty; + if Debug_Flag_Dot_O then + Possible_Local_Raise (N, Standard_Program_Error); + end if; - begin - -- If the type of the first formal does not require finalization - -- actions, then this is definitely not [Deep_]Finalize. + elsif Is_Suitable_Call (N) or else Is_Suitable_Instantiation (N) then + Declaration_Level_OK := True; - if not Needs_Finalization (Typ) then - return False; - end if; + -- Signal any enclosing local exception handlers that the call or + -- instantiation may raise Program_Error due to a failed ABE check. + -- Marking the exception handlers ensures proper expansion by both + -- the front and back end restriction when No_Exception_Propagation + -- is in effect. - -- At this point we have the following scenario: + Possible_Local_Raise (N, Standard_Program_Error); - -- procedure Name (Param1 : [in] [out] Ctrl[; Param2 : ...]); + elsif Is_Suitable_Variable_Assignment (N) + or else Is_Suitable_Variable_Read (N) + then + null; - -- Recover the two possible versions of [Deep_]Finalize using the - -- type of the first parameter and compare with the input. + -- Otherwise the input does not denote a suitable scenario - Deep_Fin := TSS (Typ, TSS_Deep_Finalize); + else + return; + end if; - if Is_Controlled (Typ) then - Fin := Find_Prim_Op (Typ, Name_Finalize); - end if; + -- The static model imposes additional restrictions on the placement of + -- scenarios. In contrast, the dynamic model assumes that every scenario + -- will be elaborated or invoked at some point. - return (Present (Deep_Fin) and then Id = Deep_Fin) - or else (Present (Fin) and then Id = Fin); - end; - end if; + if Static_Elaboration_Checks then - return False; - end Is_Finalization_Procedure; + -- Performance note: parent traversal - ------------------ - -- Output_Calls -- - ------------------ + Level := Find_Enclosing_Level (N); - procedure Output_Calls - (N : Node_Id; - Check_Elab_Flag : Boolean) - is - function Emit (Flag : Boolean) return Boolean; - -- Determine whether to emit an error message based on the combination - -- of flags Check_Elab_Flag and Flag. + -- Declaration level scenario - function Is_Printable_Error_Name return Boolean; - -- An internal function, used to determine if a name, stored in the - -- Name_Buffer, is either a non-internal name, or is an internal name - -- that is printable by the error message circuits (i.e. it has a single - -- upper case letter at the end). + if Declaration_Level_OK and then Level = Declaration_Level then + null; - ---------- - -- Emit -- - ---------- + -- Library level scenario - function Emit (Flag : Boolean) return Boolean is - begin - if Check_Elab_Flag then - return Flag; - else - return True; - end if; - end Emit; + elsif Level in Library_Level then + null; - ----------------------------- - -- Is_Printable_Error_Name -- - ----------------------------- + -- Instantiation library level scenario - function Is_Printable_Error_Name return Boolean is - begin - if not Is_Internal_Name then - return True; + elsif Level = Instantiation then + null; - elsif Name_Len = 1 then - return False; + -- Otherwise the scenario does not appear at the proper level and + -- cannot possibly act as a top level scenario. else - Name_Len := Name_Len - 1; - return not Is_Internal_Name; + return; end if; - end Is_Printable_Error_Name; + end if; - -- Local variables + -- Perform early detection of guaranteed ABEs in order to suppress the + -- instantiation of generic bodies as gigi cannot handle certain types + -- of premature instantiations. - Ent : Entity_Id; + Process_Guaranteed_ABE (N); - -- Start of processing for Output_Calls + -- At this point all checks have been performed. Record the scenario for + -- later processing by the ABE phase. - begin - for J in reverse 1 .. Elab_Call.Last loop - Error_Msg_Sloc := Elab_Call.Table (J).Cloc; + Top_Level_Scenarios.Append (N); - Ent := Elab_Call.Table (J).Ent; - Get_Name_String (Chars (Ent)); + -- Mark a scenario which may produce run-time conditional ABE checks or + -- guaranteed ABE failures as recorded. The flag ensures that scenario + -- rewriting performed by Atree.Rewrite will be properly reflected in + -- all relevant internal data structures. - -- Dynamic elaboration model, warnings controlled by -gnatwl + if Is_Check_Emitting_Scenario (N) then + Set_Is_Recorded_Scenario (N); + end if; + end Record_Elaboration_Scenario; - if Dynamic_Elaboration_Checks then - if Emit (Elab_Warnings) then - if Is_Generic_Unit (Ent) then - Error_Msg_NE ("\\?l?& instantiated #", N, Ent); - elsif Is_Init_Proc (Ent) then - Error_Msg_N ("\\?l?initialization procedure called #", N); - elsif Is_Printable_Error_Name then - Error_Msg_NE ("\\?l?& called #", N, Ent); - else - Error_Msg_N ("\\?l?called #", N); - end if; - end if; + ------------------- + -- Root_Scenario -- + ------------------- - -- Static elaboration model, info messages controlled by -gnatel + function Root_Scenario return Node_Id is + package Stack renames Scenario_Stack; - else - if Emit (Elab_Info_Messages) then - if Is_Generic_Unit (Ent) then - Error_Msg_NE ("\\?$?& instantiated #", N, Ent); - elsif Is_Init_Proc (Ent) then - Error_Msg_N ("\\?$?initialization procedure called #", N); - elsif Is_Printable_Error_Name then - Error_Msg_NE ("\\?$?& called #", N, Ent); - else - Error_Msg_N ("\\?$?called #", N); - end if; - end if; - end if; - end loop; - end Output_Calls; + begin + -- Ensure that the scenario stack has at least one active scenario in + -- it. The one at the bottom (index First) is the root scenario. - ---------------------------- - -- Same_Elaboration_Scope -- - ---------------------------- + pragma Assert (Stack.Last >= Stack.First); + return Stack.Table (Stack.First); + end Root_Scenario; - function Same_Elaboration_Scope (Scop1, Scop2 : Entity_Id) return Boolean is - S1 : Entity_Id; - S2 : Entity_Id; + ------------------------------- + -- Static_Elaboration_Checks -- + ------------------------------- + function Static_Elaboration_Checks return Boolean is begin - -- Find elaboration scope for Scop1 - -- This is either a subprogram or a compilation unit. + return not Dynamic_Elaboration_Checks; + end Static_Elaboration_Checks; - S1 := Scop1; - while S1 /= Standard_Standard - and then not Is_Compilation_Unit (S1) - and then Ekind_In (S1, E_Package, E_Protected_Type, E_Block) - loop - S1 := Scope (S1); - end loop; + ------------------- + -- Traverse_Body -- + ------------------- - -- Find elaboration scope for Scop2 + procedure Traverse_Body (N : Node_Id; In_Task_Body : Boolean) is + function Is_Potential_Scenario (Nod : Node_Id) return Traverse_Result; + -- Determine whether arbitrary node Nod denotes a suitable scenario and + -- if so, process it. - S2 := Scop2; - while S2 /= Standard_Standard - and then not Is_Compilation_Unit (S2) - and then Ekind_In (S2, E_Package, E_Protected_Type, E_Block) - loop - S2 := Scope (S2); - end loop; + procedure Traverse_Potential_Scenarios is + new Traverse_Proc (Is_Potential_Scenario); - return S1 = S2; - end Same_Elaboration_Scope; + procedure Traverse_List (List : List_Id); + -- Inspect list List for suitable elaboration scenarios and process them - ----------------- - -- Set_C_Scope -- - ----------------- + --------------------------- + -- Is_Potential_Scenario -- + --------------------------- - procedure Set_C_Scope is - begin - while not Is_Compilation_Unit (C_Scope) loop - C_Scope := Scope (C_Scope); - end loop; - end Set_C_Scope; + function Is_Potential_Scenario (Nod : Node_Id) return Traverse_Result is + begin + -- Special cases - ----------------- - -- Spec_Entity -- - ----------------- + -- Skip constructs which do not have elaboration of their own and + -- need to be elaborated by other means such as invocation, task + -- activation, etc. - function Spec_Entity (E : Entity_Id) return Entity_Id is - Decl : Node_Id; + if Is_Non_Library_Level_Encapsulator (Nod) then + return Skip; - begin - -- Check for case of body entity - -- Why is the check for E_Void needed??? + -- Terminate the traversal of a task body with an accept statement + -- when no entry calls in elaboration are allowed because the task + -- will block at run-time and none of the remaining statements will + -- be executed. - if Ekind_In (E, E_Void, E_Subprogram_Body, E_Package_Body) then - Decl := E; + elsif Nkind_In (Original_Node (Nod), N_Accept_Statement, + N_Selective_Accept) + and then Restriction_Active (No_Entry_Calls_In_Elaboration_Code) + then + return Abandon; - loop - Decl := Parent (Decl); - exit when Nkind (Decl) in N_Proper_Body; - end loop; + -- Certain nodes carry semantic lists which act as repositories until + -- expansion transforms the node and relocates the contents. Examine + -- these lists in case expansion is disabled. - return Corresponding_Spec (Decl); + elsif Nkind_In (Nod, N_And_Then, N_Or_Else) then + Traverse_List (Actions (Nod)); - else - return E; - end if; - end Spec_Entity; + elsif Nkind_In (Nod, N_Elsif_Part, N_Iteration_Scheme) then + Traverse_List (Condition_Actions (Nod)); - ------------------- - -- Supply_Bodies -- - ------------------- + elsif Nkind (Nod) = N_If_Expression then + Traverse_List (Then_Actions (Nod)); + Traverse_List (Else_Actions (Nod)); - procedure Supply_Bodies (N : Node_Id) is - begin - if Nkind (N) = N_Subprogram_Declaration then - declare - Ent : constant Entity_Id := Defining_Unit_Name (Specification (N)); + elsif Nkind_In (Nod, N_Component_Association, + N_Iterated_Component_Association) + then + Traverse_List (Loop_Actions (Nod)); - begin - -- Internal subprograms will already have a generated body, so - -- there is no need to provide a stub for them. - - if No (Corresponding_Body (N)) then - declare - Loc : constant Source_Ptr := Sloc (N); - Formals : constant List_Id := Copy_Parameter_List (Ent); - Nam : constant Entity_Id := - Make_Defining_Identifier (Loc, Chars (Ent)); - Stats : constant List_Id := - New_List ( - Make_Raise_Program_Error (Loc, - Reason => PE_Access_Before_Elaboration)); - Spec : Node_Id; - - begin - if Ekind (Ent) = E_Function then - Spec := - Make_Function_Specification (Loc, - Defining_Unit_Name => Nam, - Parameter_Specifications => Formals, - Result_Definition => - New_Copy_Tree - (Result_Definition (Specification (N)))); - - -- We cannot reliably make a return statement for this - -- body, but none is needed because the call raises - -- program error. - - Set_Return_Present (Ent); + -- General case - else - Spec := - Make_Procedure_Specification (Loc, - Defining_Unit_Name => Nam, - Parameter_Specifications => Formals); - end if; + elsif Is_Suitable_Scenario (Nod) then + Process_Scenario (Nod, In_Task_Body); + end if; - Insert_After_And_Analyze (N, - Make_Subprogram_Body (Loc, - Specification => Spec, - Declarations => New_List, - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, Stats))); - end; - end if; - end; + return OK; + end Is_Potential_Scenario; - elsif Nkind (N) = N_Package_Declaration then - declare - Spec : constant Node_Id := Specification (N); - begin - Push_Scope (Defining_Unit_Name (Spec)); - Supply_Bodies (Visible_Declarations (Spec)); - Supply_Bodies (Private_Declarations (Spec)); - Pop_Scope; - end; - end if; - end Supply_Bodies; - - procedure Supply_Bodies (L : List_Id) is - Elmt : Node_Id; - begin - if Present (L) then - Elmt := First (L); - while Present (Elmt) loop - Supply_Bodies (Elmt); - Next (Elmt); - end loop; - end if; - end Supply_Bodies; + ------------------- + -- Traverse_List -- + ------------------- - ------------ - -- Within -- - ------------ + procedure Traverse_List (List : List_Id) is + Item : Node_Id; - function Within (E1, E2 : Entity_Id) return Boolean is - Scop : Entity_Id; - begin - Scop := E1; - loop - if Scop = E2 then - return True; - elsif Scop = Standard_Standard then - return False; - else - Scop := Scope (Scop); - end if; - end loop; - end Within; + begin + Item := First (List); + while Present (Item) loop + Traverse_Potential_Scenarios (Item); + Next (Item); + end loop; + end Traverse_List; - -------------------------- - -- Within_Elaborate_All -- - -------------------------- + -- Start of processing for Traverse_Body - function Within_Elaborate_All - (Unit : Unit_Number_Type; - E : Entity_Id) return Boolean - is - type Unit_Number_Set is array (Main_Unit .. Last_Unit) of Boolean; - pragma Pack (Unit_Number_Set); + begin + -- Nothing to do when there is no body - Seen : Unit_Number_Set := (others => False); - -- Seen (X) is True after we have seen unit X in the walk. This is used - -- to prevent processing the same unit more than once. + if No (N) then + return; - Result : Boolean := False; + elsif Nkind (N) /= N_Subprogram_Body then + return; + end if; - procedure Helper (Unit : Unit_Number_Type); - -- This helper procedure does all the work for Within_Elaborate_All. It - -- walks the dependency graph, and sets Result to True if it finds an - -- appropriate Elaborate_All. + -- Nothing to do if the body was already traversed during the processing + -- of the same top level scenario. - ------------ - -- Helper -- - ------------ + if Visited_Bodies.Get (N) then + return; - procedure Helper (Unit : Unit_Number_Type) is - CU : constant Node_Id := Cunit (Unit); + -- Otherwise mark the body as traversed - Item : Node_Id; - Item2 : Node_Id; - Elab_Id : Entity_Id; - Par : Node_Id; + else + Visited_Bodies.Set (N, True); + end if; - begin - if Seen (Unit) then - return; - else - Seen (Unit) := True; - end if; + -- Examine the declarations for suitable scenarios - -- First, check for Elaborate_Alls on this unit + Traverse_List (Declarations (N)); - Item := First (Context_Items (CU)); - while Present (Item) loop - if Nkind (Item) = N_Pragma - and then Pragma_Name (Item) = Name_Elaborate_All - then - -- Return if some previous error on the pragma itself. The - -- pragma may be unanalyzed, because of a previous error, or - -- if it is the context of a subunit, inherited by its parent. + -- Examine the handled sequence of statements. This also includes any + -- exceptions handlers. - if Error_Posted (Item) or else not Analyzed (Item) then - return; - end if; + Traverse_Potential_Scenarios (Handled_Statement_Sequence (N)); + end Traverse_Body; - Elab_Id := - Entity - (Expression (First (Pragma_Argument_Associations (Item)))); + --------------------------------- + -- Update_Elaboration_Scenario -- + --------------------------------- - if E = Elab_Id then - Result := True; - return; - end if; + procedure Update_Elaboration_Scenario (New_N : Node_Id; Old_N : Node_Id) is + package Scenarios renames Top_Level_Scenarios; - Par := Parent (Unit_Declaration_Node (Elab_Id)); + begin + -- A scenario is being transformed by Atree.Rewrite. Update all relevant + -- internal data structures to reflect this change. This ensures that a + -- potential run-time conditional ABE check or a guaranteed ABE failure + -- is inserted at the proper place in the tree. + + if Is_Check_Emitting_Scenario (Old_N) + and then Is_Recorded_Scenario (Old_N) + and then Old_N /= New_N + then + -- Performance note: list traversal - Item2 := First (Context_Items (Par)); - while Present (Item2) loop - if Nkind (Item2) = N_With_Clause - and then Entity (Name (Item2)) = E - and then not Limited_Present (Item2) - then - Result := True; - return; - end if; + for Index in Scenarios.First .. Scenarios.Last loop + if Scenarios.Table (Index) = Old_N then + Scenarios.Table (Index) := New_N; - Next (Item2); - end loop; + Set_Is_Recorded_Scenario (Old_N, False); + Set_Is_Recorded_Scenario (New_N); + return; end if; - - Next (Item); end loop; - -- Second, recurse on with's. We could do this as part of the above - -- loop, but it's probably more efficient to have two loops, because - -- the relevant Elaborate_All is likely to be on the initial unit. In - -- other words, we're walking the with's breadth-first. This part is - -- only necessary in the dynamic elaboration model. - - if Dynamic_Elaboration_Checks then - Item := First (Context_Items (CU)); - while Present (Item) loop - if Nkind (Item) = N_With_Clause - and then not Limited_Present (Item) - then - -- Note: the following call to Get_Cunit_Unit_Number does a - -- linear search, which could be slow, but it's OK because - -- we're about to give a warning anyway. Also, there might - -- be hundreds of units, but not millions. If it turns out - -- to be a problem, we could store the Get_Cunit_Unit_Number - -- in each N_Compilation_Unit node, but that would involve - -- rearranging N_Compilation_Unit_Aux to make room. - - Helper (Get_Cunit_Unit_Number (Library_Unit (Item))); - - if Result then - return; - end if; - end if; + -- A recorded scenario must be in the table of recorded scenarios - Next (Item); - end loop; - end if; - end Helper; + pragma Assert (False); + end if; + end Update_Elaboration_Scenario; - -- Start of processing for Within_Elaborate_All + ------------------------- + -- Visited_Bodies_Hash -- + ------------------------- + function Visited_Bodies_Hash (Key : Node_Id) return Visited_Bodies_Index is begin - Helper (Unit); - return Result; - end Within_Elaborate_All; + return Visited_Bodies_Index (Key mod Visited_Bodies_Max); + end Visited_Bodies_Hash; end Sem_Elab; diff --git a/gcc/ada/sem_elab.ads b/gcc/ada/sem_elab.ads index d24658276811f..ddcd43306b05e 100644 --- a/gcc/ada/sem_elab.ads +++ b/gcc/ada/sem_elab.ads @@ -23,158 +23,93 @@ -- -- ------------------------------------------------------------------------------ --- This package contains the routines used to deal with issuing warnings --- for cases of calls that may require warnings about possible access --- before elaboration. +-- This package contains routines which handle access-before-elaboration +-- run-time checks and compile-time diagnostics. See the body for details. with Types; use Types; package Sem_Elab is - ----------------------------- - -- Description of Approach -- - ----------------------------- - - -- Every non-static call that is encountered by Sem_Res results in a call - -- to Check_Elab_Call, with N being the call node, and Outer set to its - -- default value of True. In addition X'Access is treated like a call - -- for the access-to-procedure case, and in SPARK mode only we also - -- check variable references. - - -- The goal of Check_Elab_Call is to determine whether or not the reference - -- in question can generate an access before elaboration error (raising - -- Program_Error) either by directly calling a subprogram whose body - -- has not yet been elaborated, or indirectly, by calling a subprogram - -- whose body has been elaborated, but which contains a call to such a - -- subprogram. - - -- In addition, in SPARK mode, we are checking for a variable reference in - -- another package, which requires an explicit Elaborate_All pragma. - - -- The only references that we need to look at the outer level are - -- references that occur in elaboration code. There are two cases. The - -- reference can be at the outer level of elaboration code, or it can - -- be within another unit, e.g. the elaboration code of a subprogram. - - -- In the case of an elaboration call at the outer level, we must trace - -- all calls to outer level routines either within the current unit or to - -- other units that are with'ed. For calls within the current unit, we can - -- determine if the body has been elaborated or not, and if it has not, - -- then a warning is generated. - - -- Note that there are two subcases. If the original call directly calls a - -- subprogram whose body has not been elaborated, then we know that an ABE - -- will take place, and we replace the call by a raise of Program_Error. - -- If the call is indirect, then we don't know that the PE will be raised, - -- since the call might be guarded by a conditional. In this case we set - -- Do_Elab_Check on the call so that a dynamic check is generated, and - -- output a warning. - - -- For calls to a subprogram in a with'ed unit or a 'Access or variable - -- reference (SPARK mode case), we require that a pragma Elaborate_All - -- or pragma Elaborate be present, or that the referenced unit have a - -- pragma Preelaborate, pragma Pure, or pragma Elaborate_Body. If none - -- of these conditions is met, then a warning is generated that a pragma - -- Elaborate_All may be needed (error in the SPARK case), or an implicit - -- pragma is generated. - - -- For the case of an elaboration call at some inner level, we are - -- interested in tracing only calls to subprograms at the same level, - -- i.e. those that can be called during elaboration. Any calls to - -- outer level routines cannot cause ABE's as a result of the original - -- call (there might be an outer level call to the subprogram from - -- outside that causes the ABE, but that gets analyzed separately). - - -- Note that we never trace calls to inner level subprograms, since - -- these cannot result in ABE's unless there is an elaboration problem - -- at a lower level, which will be separately detected. - - -- Note on pragma Elaborate. The checking here assumes that a pragma - -- Elaborate on a with'ed unit guarantees that subprograms within the - -- unit can be called without causing an ABE. This is not in fact the - -- case since pragma Elaborate does not guarantee the transitive - -- coverage guaranteed by Elaborate_All. However, we decide to trust - -- the user in this case. - - -------------------------------------- - -- Instantiation Elaboration Errors -- - -------------------------------------- - - -- A special case arises when an instantiation appears in a context - -- that is known to be before the body is elaborated, e.g. - - -- generic package x is ... - -- ... - -- package xx is new x; - -- ... - -- package body x is ... - - -- In this situation it is certain that an elaboration error will - -- occur, and an unconditional raise Program_Error statement is - -- inserted before the instantiation, and a warning generated. - - -- The problem is that in this case we have no place to put the - -- body of the instantiation. We can't put it in the normal place, - -- because it is too early, and will cause errors to occur as a - -- result of referencing entities before they are declared. - - -- Our approach in this case is simply to avoid creating the body - -- of the instantiation in such a case. The instantiation spec is - -- modified to include dummy bodies for all subprograms, so that - -- the resulting code does not contain subprogram specs with no - -- corresponding bodies. - - procedure Check_Elab_Call - (N : Node_Id; - Outer_Scope : Entity_Id := Empty; - In_Init_Proc : Boolean := False); - -- Check a call for possible elaboration problems. The node N is either an - -- N_Function_Call or N_Procedure_Call_Statement node or an access - -- attribute reference whose prefix is a subprogram. - -- - -- If SPARK_Mode is On, then N can also be a variable reference, since - -- SPARK requires the use of Elaborate_All for references to variables - -- in other packages. - - -- The Outer_Scope argument indicates whether this is an outer level - -- call from Sem_Res (Outer_Scope set to Empty), or an internal recursive - -- call (Outer_Scope set to entity of outermost call, see body). The flag - -- In_Init_Proc should be set whenever the current context is a type - -- init proc. - - -- Note: this might better be called Check_Elab_Reference (to recognize - -- the SPARK case), but we prefer to keep the original name, since this - -- is primarily used for checking for calls that could generate an ABE). - - procedure Check_Elab_Calls; - -- Not all the processing for Check_Elab_Call can be done at the time - -- of calls to Check_Elab_Call. This is because for internal calls, we - -- need to wait to complete the check until all generic bodies have been - -- instantiated. The Check_Elab_Calls procedure cleans up these waiting - -- checks. It is called once after the completion of instantiation. - - procedure Check_Elab_Assign (N : Node_Id); - -- N is either the left side of an assignment, or a procedure argument for - -- a mode OUT or IN OUT formal. This procedure checks for a possible case - -- of access to an entity from elaboration code before the entity has been - -- initialized, and issues appropriate warnings. - - procedure Check_Elab_Instantiation - (N : Node_Id; - Outer_Scope : Entity_Id := Empty); - -- Check an instantiation for possible elaboration problems. N is an - -- instantiation node (N_Package_Instantiation, N_Function_Instantiation, - -- or N_Procedure_Instantiation), and Outer_Scope indicates if this is - -- an outer level call from Sem_Ch12 (Outer_Scope set to Empty), or an - -- internal recursive call (Outer_Scope set to scope of outermost call, - -- see body for further details). The returned value is relevant only - -- for an outer level call, and is set to False if an elaboration error - -- is bound to occur on the instantiation, and True otherwise. This is - -- used by the caller to signal that the body of the instance should - -- not be generated (see detailed description in body). - - procedure Check_Task_Activation (N : Node_Id); - -- At the point at which tasks are activated in a package body, check - -- that the bodies of the tasks are elaborated. + procedure Build_Call_Marker (N : Node_Id); + -- Create a call marker for call or requeue statement N and record it for + -- later processing by the ABE mechanism. + + procedure Check_Elaboration_Scenarios; + -- Examine each scenario recorded during analysis/resolution and apply the + -- Ada or SPARK elaboration rules taking into account the model in effect. + -- This processing detects and diagnoses ABE issues, installs conditional + -- ABE checks or guaranteed ABE failures, and ensures the elaboration of + -- units. + + -- The following type classifies the various enclosing levels used in ABE + -- diagnostics. + + type Enclosing_Level_Kind is + (Declaration_Level, + -- A construct is at the "declaration level" when it appears within the + -- declarations of a block statement, an entry body, a subprogram body, + -- or a task body, ignoring enclosing packages. Example: + + -- package Pack is + -- procedure Proc is -- subprogram body + -- package Nested is -- enclosing package ignored + -- X ... -- at declaration level + + Generic_Package_Spec, + Generic_Package_Body, + -- A construct is at the "generic library level" when it appears in a + -- generic package library unit, ignoring enclosing packages. Example: + + -- generic + -- package Pack is -- generic package spec + -- package Nested is -- enclosing package ignored + -- X ... -- at generic library level + + Instantiation, + -- A construct is at the "instantiation library level" when it appears + -- in a library unit which is also an instantiation. Example: + + -- package Inst is new Gen; -- at instantiation level + + Package_Spec, + Package_Body, + -- A construct is at the "library level" when it appears in a package + -- library unit, ignoring enclosing packages. Example: + + -- package body Pack is -- package body + -- package Nested is -- enclosing package ignored + -- X ... -- at library level + + No_Level); + -- This value is used to indicate that none of the levels above are in + -- effect. + + subtype Generic_Library_Level is Enclosing_Level_Kind range + Generic_Package_Spec .. + Generic_Package_Body; + + subtype Library_Level is Enclosing_Level_Kind range + Package_Spec .. + Package_Body; + + subtype Any_Library_Level is Enclosing_Level_Kind range + Generic_Package_Spec .. + Package_Body; + + function Find_Enclosing_Level (N : Node_Id) return Enclosing_Level_Kind; + -- Determine the enclosing level of arbitrary node N + + procedure Initialize; + -- Initialize the internal structures of this unit + + procedure Kill_Elaboration_Scenario (N : Node_Id); + -- Determine whether arbitrary node N denotes a scenario which requires + -- ABE diagnostics or runtime checks and eliminate it from a region with + -- dead code. + + procedure Record_Elaboration_Scenario (N : Node_Id); + -- Determine whether atribtray node N denotes a scenario which requires + -- ABE diagnostics or runtime checks. If this is the case, store N into + -- a table for later processing. end Sem_Elab; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 59bbdb5f0ab69..eae149805fa81 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -2818,10 +2818,16 @@ package body Sem_Prag is E_Constant, E_Variable) then + -- When the initialization item is undefined, it appears as + -- Any_Id. Do not continue with the analysis of the item. + + if Item_Id = Any_Id then + null; + -- The state or variable must be declared in the visible -- declarations of the package (SPARK RM 7.1.5(7)). - if not Contains (States_And_Objs, Item_Id) then + elsif not Contains (States_And_Objs, Item_Id) then Error_Msg_Name_1 := Chars (Pack_Id); SPARK_Msg_NE ("initialization item & must appear in the visible " @@ -13236,23 +13242,21 @@ package body Sem_Prag is Set_SCO_Pragma_Enabled (Loc); end if; - -- Deal with analyzing the string argument + -- Deal with analyzing the string argument. If checks are not + -- on we don't want any expansion (since such expansion would + -- not get properly deleted) but we do want to analyze (to get + -- proper references). The Preanalyze_And_Resolve routine does + -- just what we want. Ditto if pragma is active, because it will + -- be rewritten as an if-statement whose analysis will complete + -- analysis and expansion of the string message. This makes a + -- difference in the unusual case where the expression for the + -- string may have a side effect, such as raising an exception. + -- This is mandated by RM 11.4.2, which specifies that the string + -- expression is only evaluated if the check fails and + -- Assertion_Error is to be raised. if Arg_Count = 3 then - - -- If checks are not on we don't want any expansion (since - -- such expansion would not get properly deleted) but - -- we do want to analyze (to get proper references). - -- The Preanalyze_And_Resolve routine does just what we want - - if Is_Ignored (N) then - Preanalyze_And_Resolve (Str, Standard_String); - - -- Otherwise we need a proper analysis and expansion - - else - Analyze_And_Resolve (Str, Standard_String); - end if; + Preanalyze_And_Resolve (Str, Standard_String); end if; -- Now you might think we could just do the same with the Boolean @@ -14384,12 +14388,11 @@ package body Sem_Prag is Call := Get_Pragma_Arg (Arg1); end if; - if Nkind_In (Call, - N_Indexed_Component, - N_Function_Call, - N_Identifier, - N_Expanded_Name, - N_Selected_Component) + if Nkind_In (Call, N_Expanded_Name, + N_Function_Call, + N_Identifier, + N_Indexed_Component, + N_Selected_Component) then -- If this pragma Debug comes from source, its argument was -- parsed as a name form (which is syntactically identical). @@ -14999,26 +15002,6 @@ package body Sem_Prag is Set_Elaborate_Present (Citem, True); Set_Elab_Unit_Name (Get_Pragma_Arg (Arg), Name (Citem)); - -- With the pragma present, elaboration calls on - -- subprograms from the named unit need no further - -- checks, as long as the pragma appears in the current - -- compilation unit. If the pragma appears in some unit - -- in the context, there might still be a need for an - -- Elaborate_All_Desirable from the current compilation - -- to the named unit, so we keep the check enabled. - - if In_Extended_Main_Source_Unit (N) then - - -- This does not apply in SPARK mode, where we allow - -- pragma Elaborate, but we don't trust it to be right - -- so we will still insist on the Elaborate_All. - - if SPARK_Mode /= On then - Set_Suppress_Elaboration_Warnings - (Entity (Name (Citem))); - end if; - end if; - exit Inner; end if; @@ -15096,14 +15079,6 @@ package body Sem_Prag is Set_Elaborate_All_Present (Citem, True); Set_Elab_Unit_Name (Get_Pragma_Arg (Arg), Name (Citem)); - -- Suppress warnings and elaboration checks on the named - -- unit if the pragma is in the current compilation, as - -- for pragma Elaborate. - - if In_Extended_Main_Source_Unit (N) then - Set_Suppress_Elaboration_Warnings - (Entity (Name (Citem))); - end if; exit Innr; end if; @@ -15151,27 +15126,8 @@ package body Sem_Prag is then Error_Pragma ("pragma% must refer to a spec, not a body"); else - Set_Body_Required (Cunit_Node, True); + Set_Body_Required (Cunit_Node); Set_Has_Pragma_Elaborate_Body (Cunit_Ent); - - -- If we are in dynamic elaboration mode, then we suppress - -- elaboration warnings for the unit, since it is definitely - -- fine NOT to do dynamic checks at the first level (and such - -- checks will be suppressed because no elaboration boolean - -- is created for Elaborate_Body packages). - - -- But in the static model of elaboration, Elaborate_Body is - -- definitely NOT good enough to ensure elaboration safety on - -- its own, since the body may WITH other units that are not - -- safe from an elaboration point of view, so a client must - -- still do an Elaborate_All on such units. - - -- Debug flag -gnatdD restores the old behavior of 3.13, where - -- Elaborate_Body always suppressed elab warnings. - - if Dynamic_Elaboration_Checks or Debug_Flag_DD then - Set_Suppress_Elaboration_Warnings (Cunit_Ent); - end if; end if; end Elaborate_Body; @@ -20249,7 +20205,6 @@ package body Sem_Prag is else if not Debug_Flag_U then Set_Is_Preelaborated (Ent); - Set_Suppress_Elaboration_Warnings (Ent); end if; end if; end if; @@ -20877,7 +20832,6 @@ package body Sem_Prag is if not Debug_Flag_U then Set_Is_Pure (Ent); Set_Has_Pragma_Pure (Ent); - Set_Suppress_Elaboration_Warnings (Ent); end if; end Pure; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 1435e047f5afd..f5c5f9e96dc5d 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -63,8 +63,8 @@ with Sem_Ch13; use Sem_Ch13; with Sem_Dim; use Sem_Dim; with Sem_Disp; use Sem_Disp; with Sem_Dist; use Sem_Dist; -with Sem_Elim; use Sem_Elim; with Sem_Elab; use Sem_Elab; +with Sem_Elim; use Sem_Elim; with Sem_Eval; use Sem_Eval; with Sem_Intr; use Sem_Intr; with Sem_Util; use Sem_Util; @@ -1325,6 +1325,12 @@ package body Sem_Res is begin Op_Node := New_Node (Operator_Kind (Op_Name, Is_Binary), Sloc (N)); + -- Ensure that the corresponding operator has the same parent as the + -- original call. This guarantees that parent traversals performed by + -- the ABE mechanism succeed. + + Set_Parent (Op_Node, Parent (N)); + -- Binary operator if Is_Binary then @@ -3172,14 +3178,6 @@ package body Sem_Res is -- an instance of the default expression. The insertion is always -- a named association. - procedure Property_Error - (Var : Node_Id; - Var_Id : Entity_Id; - Prop_Nam : Name_Id); - -- Emit an error concerning variable Var with entity Var_Id that has - -- enabled property Prop_Nam when it acts as an actual parameter in a - -- call and the corresponding formal parameter is of mode IN. - function Same_Ancestor (T1, T2 : Entity_Id) return Boolean; -- Check whether T1 and T2, or their full views, are derived from a -- common type. Used to enforce the restrictions on array conversions @@ -3628,23 +3626,6 @@ package body Sem_Res is Prev := Actval; end Insert_Default; - -------------------- - -- Property_Error -- - -------------------- - - procedure Property_Error - (Var : Node_Id; - Var_Id : Entity_Id; - Prop_Nam : Name_Id) - is - begin - Error_Msg_Name_1 := Prop_Nam; - Error_Msg_NE - ("external variable & with enabled property % cannot appear as " - & "actual in procedure call (SPARK RM 7.1.3(10))", Var, Var_Id); - Error_Msg_N ("\\corresponding formal parameter has mode In", Var); - end Property_Error; - ------------------- -- Same_Ancestor -- ------------------- @@ -4653,26 +4634,28 @@ package body Sem_Res is Flag_Effectively_Volatile_Objects (A); end if; - -- Detect an external variable with an enabled property that - -- does not match the mode of the corresponding formal in a - -- procedure call. Functions are not considered because they - -- cannot have effectively volatile formal parameters in the - -- first place. + -- An effectively volatile variable cannot act as an actual + -- parameter in a procedure call when the variable has enabled + -- property Effective_Reads and the corresponding formal is of + -- mode IN (SPARK RM 7.1.3(10)). if Ekind (Nam) = E_Procedure and then Ekind (F) = E_In_Parameter and then Is_Entity_Name (A) - and then Present (Entity (A)) - and then Ekind (Entity (A)) = E_Variable then A_Id := Entity (A); - if Async_Readers_Enabled (A_Id) then - Property_Error (A, A_Id, Name_Async_Readers); - elsif Effective_Reads_Enabled (A_Id) then - Property_Error (A, A_Id, Name_Effective_Reads); - elsif Effective_Writes_Enabled (A_Id) then - Property_Error (A, A_Id, Name_Effective_Writes); + if Ekind (A_Id) = E_Variable + and then Is_Effectively_Volatile (Etype (A_Id)) + and then Effective_Reads_Enabled (A_Id) + then + Error_Msg_NE + ("effectively volatile variable & cannot appear as " + & "actual in procedure call", A, A_Id); + + Error_Msg_Name_1 := Name_Effective_Reads; + Error_Msg_N ("\\variable has enabled property %", A); + Error_Msg_N ("\\corresponding formal has mode IN", A); end if; end if; end if; @@ -4851,10 +4834,17 @@ package body Sem_Res is -- are explicitly marked as coming from source but do not need to be -- checked for limited initialization. To exclude this case, ensure -- that the parent of the allocator is a source node. + -- The return statement constructed for an Expression_Function does + -- not come from source but requires a limited check. if Is_Limited_Type (Etype (E)) and then Comes_From_Source (N) - and then Comes_From_Source (Parent (N)) + and then + (Comes_From_Source (Parent (N)) + or else + (Ekind (Current_Scope) = E_Function + and then Nkind (Original_Node (Unit_Declaration_Node + (Current_Scope))) = N_Expression_Function)) and then not In_Instance_Body then if not OK_For_Limited_Init (Etype (E), Expression (E)) then @@ -5785,6 +5775,15 @@ package body Sem_Res is -- Start of processing for Resolve_Call begin + -- Preserve relevant elaboration-related attributes of the context which + -- are no longer available or very expensive to recompute once analysis, + -- resolution, and expansion are over. + + Mark_Elaboration_Attributes + (N_Id => N, + Checks => True, + Modes => True); + -- The context imposes a unique interpretation with type Typ on a -- procedure or function call. Find the entity of the subprogram that -- yields the expected type, and propagate the corresponding formal @@ -5841,10 +5840,15 @@ package body Sem_Res is elsif Nkind_In (Subp, N_Selected_Component, N_Indexed_Component) or else (Is_Entity_Name (Subp) - and then Ekind (Entity (Subp)) = E_Entry) + and then Ekind_In (Entity (Subp), E_Entry, E_Entry_Family)) then Resolve_Entry_Call (N, Typ); - Check_Elab_Call (N); + + -- Annotate the tree by creating a call marker in case the original + -- call is transformed by expansion. The call marker is automatically + -- saved for later examination by the ABE Processing phase. + + Build_Call_Marker (N); -- Kill checks and constant values, as above for indirect case -- Who knows what happens when another task is activated? @@ -6100,14 +6104,14 @@ package body Sem_Res is -- the proper indexed component. Index_Node := - Make_Indexed_Component (Loc, - Prefix => - Make_Function_Call (Loc, - Name => New_Subp, - Parameter_Associations => - New_List - (Remove_Head (Parameter_Associations (N)))), - Expressions => Parameter_Associations (N)); + Make_Indexed_Component (Loc, + Prefix => + Make_Function_Call (Loc, + Name => New_Subp, + Parameter_Associations => + New_List + (Remove_Head (Parameter_Associations (N)))), + Expressions => Parameter_Associations (N)); end if; -- Preserve the parenthesis count of the node @@ -6122,7 +6126,13 @@ package body Sem_Res is Set_Etype (Prefix (N), Ret_Type); Set_Etype (N, Typ); Resolve_Indexed_Component (N, Typ); - Check_Elab_Call (Prefix (N)); + + -- Annotate the tree by creating a call marker in case + -- the original call is transformed by expansion. The call + -- marker is automatically saved for later examination by + -- the ABE Processing phase. + + Build_Call_Marker (Prefix (N)); end if; end if; @@ -6633,7 +6643,12 @@ package body Sem_Res is -- All done, evaluate call and deal with elaboration issues Eval_Call (N); - Check_Elab_Call (N); + + -- Annotate the tree by creating a call marker in case the original call + -- is transformed by expansion. The call marker is automatically saved + -- for later examination by the ABE Processing phase. + + Build_Call_Marker (N); -- In GNATprove mode, expansion is disabled, but we want to inline some -- subprograms to facilitate formal verification. Indirect calls through @@ -7176,7 +7191,7 @@ package body Sem_Res is else Error_Msg_N - ("invalid use of subtype mark in expression or call", N); + ("invalid use of subtype mark in expression or call", N); end if; -- Check discriminant use if entity is discriminant in current scope, @@ -7269,17 +7284,6 @@ package body Sem_Res is & "(SPARK RM 7.1.3(12))", N); end if; - -- Check for possible elaboration issues with respect to reads of - -- variables. The act of renaming the variable is not considered a - -- read as it simply establishes an alias. - - if Ekind (E) = E_Variable - and then Dynamic_Elaboration_Checks - and then Nkind (Par) /= N_Object_Renaming_Declaration - then - Check_Elab_Call (N); - end if; - -- The variable may eventually become a constituent of a single -- protected/task type. Record the reference now and verify its -- legality when analyzing the contract of the variable @@ -7524,14 +7528,13 @@ package body Sem_Res is ------------------------ procedure Resolve_Entry_Call (N : Node_Id; Typ : Entity_Id) is - Entry_Name : constant Node_Id := Name (N); - Loc : constant Source_Ptr := Sloc (Entry_Name); - Actuals : List_Id; - First_Named : Node_Id; - Nam : Entity_Id; - Norm_OK : Boolean; - Obj : Node_Id; - Was_Over : Boolean; + Entry_Name : constant Node_Id := Name (N); + Loc : constant Source_Ptr := Sloc (Entry_Name); + + Nam : Entity_Id; + Norm_OK : Boolean; + Obj : Node_Id; + Was_Over : Boolean; begin -- We kill all checks here, because it does not seem worth the effort to @@ -7645,7 +7648,6 @@ package body Sem_Res is and then Present (Contract_Wrapper (Nam)) and then Current_Scope /= Contract_Wrapper (Nam) then - -- Note the entity being called before rewriting the call, so that -- it appears used at this point. @@ -7760,16 +7762,29 @@ package body Sem_Res is Entry_Name); end if; - Actuals := Parameter_Associations (N); - First_Named := First_Named_Actual (N); + declare + Entry_Call : Node_Id; - Rewrite (N, - Make_Entry_Call_Statement (Loc, - Name => Entry_Name, - Parameter_Associations => Actuals)); + begin + Entry_Call := + Make_Entry_Call_Statement (Loc, + Name => Entry_Name, + Parameter_Associations => Parameter_Associations (N)); - Set_First_Named_Actual (N, First_Named); - Set_Analyzed (N, True); + -- Inherit relevant attributes from the original call + + Set_First_Named_Actual + (Entry_Call, First_Named_Actual (N)); + + Set_Is_Elaboration_Checks_OK_Node + (Entry_Call, Is_Elaboration_Checks_OK_Node (N)); + + Set_Is_SPARK_Mode_On_Node + (Entry_Call, Is_SPARK_Mode_On_Node (N)); + + Rewrite (N, Entry_Call); + Set_Analyzed (N, True); + end; -- Protected functions can return on the secondary stack, in which -- case we must trigger the transient scope mechanism. diff --git a/gcc/ada/sem_spark.adb b/gcc/ada/sem_spark.adb index 8c81d2e760fe6..5107d3bc5f4dc 100644 --- a/gcc/ada/sem_spark.adb +++ b/gcc/ada/sem_spark.adb @@ -2314,6 +2314,7 @@ package body Sem_SPARK is when N_Abstract_Subprogram_Declaration | N_At_Clause | N_Attribute_Definition_Clause + | N_Call_Marker | N_Delta_Constraint | N_Digits_Constraint | N_Empty @@ -5285,6 +5286,7 @@ package body Sem_SPARK is is begin case Nkind (N) is + -- Base identifier. Set permission to W or No depending on Mode. when N_Identifier @@ -5292,9 +5294,8 @@ package body Sem_SPARK is => declare P : constant Node_Id := Entity (N); - C : constant Perm_Tree_Access := - Get (Current_Perm_Env, Unique_Entity (P)); + Get (Current_Perm_Env, Unique_Entity (P)); begin -- The base tree can be RW (first move from this base path) or diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index c70d892bf0bf9..e2b3afdf898b0 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -761,15 +761,19 @@ package body Sem_Type is function Full_View_Covers (Typ1, Typ2 : Entity_Id) return Boolean is begin - return - Is_Private_Type (Typ1) - and then - ((Present (Full_View (Typ1)) - and then Covers (Full_View (Typ1), Typ2)) - or else (Present (Underlying_Full_View (Typ1)) - and then Covers (Underlying_Full_View (Typ1), Typ2)) - or else Base_Type (Typ1) = Typ2 - or else Base_Type (Typ2) = Typ1); + if Present (Full_View (Typ1)) + and then Covers (Full_View (Typ1), Typ2) + then + return True; + + elsif Present (Underlying_Full_View (Typ1)) + and then Covers (Underlying_Full_View (Typ1), Typ2) + then + return True; + + else + return False; + end if; end Full_View_Covers; ----------------- @@ -825,7 +829,7 @@ package body Sem_Type is -- Standard_Void_Type is a special entity that has some, but not all, -- properties of types. - if (T1 = Standard_Void_Type) /= (T2 = Standard_Void_Type) then + if T1 = Standard_Void_Type or else T2 = Standard_Void_Type then return False; end if; @@ -892,8 +896,8 @@ package body Sem_Type is or else (T2 = Universal_Real and then Is_Real_Type (T1)) or else (T2 = Universal_Fixed and then Is_Fixed_Point_Type (T1)) or else (T2 = Any_Fixed and then Is_Fixed_Point_Type (T1)) - or else (T2 = Any_String and then Is_String_Type (T1)) or else (T2 = Any_Character and then Is_Character_Type (T1)) + or else (T2 = Any_String and then Is_String_Type (T1)) or else (T2 = Any_Access and then Is_Access_Type (T1)) then return True; @@ -916,9 +920,9 @@ package body Sem_Type is -- task_type or protected_type that implements the interface. elsif Ada_Version >= Ada_2005 + and then Is_Concurrent_Type (T2) and then Is_Class_Wide_Type (T1) and then Is_Interface (Etype (T1)) - and then Is_Concurrent_Type (T2) and then Interface_Present_In_Ancestor (Typ => BT2, Iface => Etype (T1)) then @@ -928,9 +932,9 @@ package body Sem_Type is -- object T2 implementing T1. elsif Ada_Version >= Ada_2005 + and then Is_Tagged_Type (T2) and then Is_Class_Wide_Type (T1) and then Is_Interface (Etype (T1)) - and then Is_Tagged_Type (T2) then if Interface_Present_In_Ancestor (Typ => T2, Iface => Etype (T1)) @@ -1183,19 +1187,16 @@ package body Sem_Type is -- whether a partial and a full view match. Verify that types are -- legal, to prevent cascaded errors. - elsif In_Instance - and then (Full_View_Covers (T1, T2) or else Full_View_Covers (T2, T1)) - then - return True; - - elsif Is_Type (T2) - and then Is_Generic_Actual_Type (T2) + elsif Is_Private_Type (T1) + and then (In_Instance + or else (Is_Type (T2) and then Is_Generic_Actual_Type (T2))) and then Full_View_Covers (T1, T2) then return True; - elsif Is_Type (T1) - and then Is_Generic_Actual_Type (T1) + elsif Is_Private_Type (T2) + and then (In_Instance + or else (Is_Type (T1) and then Is_Generic_Actual_Type (T1))) and then Full_View_Covers (T2, T1) then return True; @@ -2837,11 +2838,9 @@ package body Sem_Type is return False; elsif Nkind (Par) in N_Declaration then - if Nkind (Par) = N_Object_Declaration then - return Present (Corresponding_Generic_Association (Par)); - else - return False; - end if; + return + Nkind (Par) = N_Object_Declaration + and then Present (Corresponding_Generic_Association (Par)); elsif Nkind (Par) = N_Object_Renaming_Declaration then return Present (Corresponding_Generic_Association (Par)); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 20cda2d800ea2..3698bbf16bdf0 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -53,6 +53,7 @@ with Sem_Attr; use Sem_Attr; with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; with Sem_Disp; use Sem_Disp; +with Sem_Elab; use Sem_Elab; with Sem_Eval; use Sem_Eval; with Sem_Prag; use Sem_Prag; with Sem_Res; use Sem_Res; @@ -941,6 +942,45 @@ package body Sem_Util is and then not In_Same_Extended_Unit (N, T); end Bad_Unordered_Enumeration_Reference; + ---------------------------- + -- Begin_Keyword_Location -- + ---------------------------- + + function Begin_Keyword_Location (N : Node_Id) return Source_Ptr is + HSS : Node_Id; + + begin + pragma Assert (Nkind_In (N, N_Block_Statement, + N_Entry_Body, + N_Package_Body, + N_Subprogram_Body, + N_Task_Body)); + + HSS := Handled_Statement_Sequence (N); + + -- When the handled sequence of statements comes from source, the + -- location of the "begin" keyword is that of the sequence itself. + -- Note that an internal construct may inherit a source sequence. + + if Comes_From_Source (HSS) then + return Sloc (HSS); + + -- The parser generates an internal handled sequence of statements to + -- capture the location of the "begin" keyword if present in the source. + -- Since there are no source statements, the location of the "begin" + -- keyword is effectively that of the "end" keyword. + + elsif Comes_From_Source (N) then + return Sloc (HSS); + + -- Otherwise the construct is internal and should carry the location of + -- the original construct which prompted its creation. + + else + return Sloc (N); + end if; + end Begin_Keyword_Location; + -------------------------- -- Build_Actual_Subtype -- -------------------------- @@ -3314,10 +3354,13 @@ package body Sem_Util is and then not Comes_From_Source (Par) then -- Continue to examine the context if the reference appears in a - -- subprogram body which was previously an expression function. + -- subprogram body which was previously an expression function, + -- unless this is during preanalysis (when In_Spec_Expression is + -- True), as the body may not yet be inserted in the tree. if Nkind (Par) = N_Subprogram_Body and then Was_Expression_Function (Par) + and then not In_Spec_Expression then null; @@ -5760,11 +5803,10 @@ package body Sem_Util is --------------------- function Defining_Entity - (N : Node_Id; - Empty_On_Errors : Boolean := False) return Entity_Id + (N : Node_Id; + Empty_On_Errors : Boolean := False; + Concurrent_Subunit : Boolean := False) return Entity_Id is - Err : Entity_Id := Empty; - begin case Nkind (N) is when N_Abstract_Subprogram_Declaration @@ -5816,7 +5858,23 @@ package body Sem_Util is return Defining_Identifier (N); when N_Subunit => - return Defining_Entity (Proper_Body (N)); + declare + Bod : constant Node_Id := Proper_Body (N); + Orig_Bod : constant Node_Id := Original_Node (Bod); + + begin + -- Retrieve the entity of the original protected or task body + -- if requested by the caller. + + if Concurrent_Subunit + and then Nkind (Bod) = N_Null_Statement + and then Nkind_In (Orig_Bod, N_Protected_Body, N_Task_Body) + then + return Defining_Entity (Orig_Bod); + else + return Defining_Entity (Bod); + end if; + end; when N_Function_Instantiation | N_Function_Specification @@ -5832,6 +5890,7 @@ package body Sem_Util is => declare Nam : constant Node_Id := Defining_Unit_Name (N); + Err : Entity_Id := Empty; begin if Nkind (Nam) in N_Entity then @@ -6862,6 +6921,82 @@ package body Sem_Util is end if; end Enclosing_Subprogram; + -------------------------- + -- End_Keyword_Location -- + -------------------------- + + function End_Keyword_Location (N : Node_Id) return Source_Ptr is + function End_Label_Loc (Nod : Node_Id) return Source_Ptr; + -- Return the source location of Nod's end label according to the + -- following precedence rules: + -- + -- 1) If the end label exists, return its location + -- 2) If Nod exists, return its location + -- 3) Return the location of N + + ------------------- + -- End_Label_Loc -- + ------------------- + + function End_Label_Loc (Nod : Node_Id) return Source_Ptr is + Label : Node_Id; + + begin + if Present (Nod) then + Label := End_Label (Nod); + + if Present (Label) then + return Sloc (Label); + else + return Sloc (Nod); + end if; + + else + return Sloc (N); + end if; + end End_Label_Loc; + + -- Local variables + + Owner : Node_Id; + + -- Start of processing for End_Keyword_Location + + begin + if Nkind_In (N, N_Block_Statement, + N_Entry_Body, + N_Package_Body, + N_Subprogram_Body, + N_Task_Body) + then + Owner := Handled_Statement_Sequence (N); + + elsif Nkind (N) = N_Package_Declaration then + Owner := Specification (N); + + elsif Nkind (N) = N_Protected_Body then + Owner := N; + + elsif Nkind_In (N, N_Protected_Type_Declaration, + N_Single_Protected_Declaration) + then + Owner := Protected_Definition (N); + + elsif Nkind_In (N, N_Single_Task_Declaration, + N_Task_Type_Declaration) + then + Owner := Task_Definition (N); + + -- This routine should not be called with other contexts + + else + pragma Assert (False); + null; + end if; + + return End_Label_Loc (Owner); + end End_Keyword_Location; + ------------------------ -- Ensure_Freeze_Node -- ------------------------ @@ -7735,6 +7870,101 @@ package body Sem_Util is return Empty; end Find_Enclosing_Iterator_Loop; + -------------------------- + -- Find_Enclosing_Scope -- + -------------------------- + + function Find_Enclosing_Scope (N : Node_Id) return Entity_Id is + Par : Node_Id; + Spec_Id : Entity_Id; + + begin + -- Examine the parent chain looking for a construct which defines a + -- scope. + + Par := Parent (N); + while Present (Par) loop + case Nkind (Par) is + + -- The construct denotes a declaration, the proper scope is its + -- entity. + + when N_Entry_Declaration + | N_Expression_Function + | N_Full_Type_Declaration + | N_Generic_Package_Declaration + | N_Generic_Subprogram_Declaration + | N_Package_Declaration + | N_Private_Extension_Declaration + | N_Protected_Type_Declaration + | N_Single_Protected_Declaration + | N_Single_Task_Declaration + | N_Subprogram_Declaration + | N_Task_Type_Declaration + => + return Defining_Entity (Par); + + -- The construct denotes a body, the proper scope is the entity of + -- the corresponding spec. + + when N_Entry_Body + | N_Package_Body + | N_Protected_Body + | N_Subprogram_Body + | N_Task_Body + => + Spec_Id := Corresponding_Spec (Par); + + -- The defining entity of a stand-alone subprogram body defines + -- a scope. + + if Nkind (Par) = N_Subprogram_Body and then No (Spec_Id) then + return Defining_Entity (Par); + + -- Otherwise there should be corresponding spec which defines a + -- scope. + + else + pragma Assert (Present (Spec_Id)); + + return Spec_Id; + end if; + + -- Special cases + + -- Blocks carry either a source or an internally-generated scope, + -- unless the block is a byproduct of exception handling. + + when N_Block_Statement => + if not Exception_Junk (Par) then + return Entity (Identifier (Par)); + end if; + + -- Loops carry an internally-generated scope + + when N_Loop_Statement => + return Entity (Identifier (Par)); + + -- Extended return statements carry an internally-generated scope + + when N_Extended_Return_Statement => + return Return_Statement_Entity (Par); + + -- A traversal from a subunit continues via the corresponding stub + + when N_Subunit => + Par := Corresponding_Stub (Par); + + when others => + null; + end case; + + Par := Parent (Par); + end loop; + + return Standard_Standard; + end Find_Enclosing_Scope; + ------------------------------------ -- Find_Loop_In_Conditional_Block -- ------------------------------------ @@ -9393,7 +9623,7 @@ package body Sem_Util is -- Get_Task_Body_Procedure -- ----------------------------- - function Get_Task_Body_Procedure (E : Entity_Id) return Node_Id is + function Get_Task_Body_Procedure (E : Entity_Id) return Entity_Id is begin -- Note: A task type may be the completion of a private type with -- discriminants. When performing elaboration checks on a task @@ -10523,12 +10753,14 @@ package body Sem_Util is -- Has_Non_Trivial_Precondition -- ---------------------------------- - function Has_Non_Trivial_Precondition (P : Entity_Id) return Boolean is - Cont : constant Node_Id := Find_Aspect (P, Aspect_Pre); + function Has_Non_Trivial_Precondition (Subp : Entity_Id) return Boolean is + Pre : constant Node_Id := Find_Aspect (Subp, Aspect_Pre); + begin - return Present (Cont) - and then Class_Present (Cont) - and then not Is_Entity_Name (Expression (Cont)); + return + Present (Pre) + and then Class_Present (Pre) + and then not Is_Entity_Name (Expression (Pre)); end Has_Non_Trivial_Precondition; ------------------- @@ -10769,160 +11001,6 @@ package body Sem_Util is Ent : Entity_Id; Exp : Node_Id; - function Is_Preelaborable_Expression (N : Node_Id) return Boolean; - -- Returns True if and only if the expression denoted by N does not - -- violate restrictions on preelaborable constructs (RM-10.2.1(5-9)). - - --------------------------------- - -- Is_Preelaborable_Expression -- - --------------------------------- - - function Is_Preelaborable_Expression (N : Node_Id) return Boolean is - Exp : Node_Id; - Assn : Node_Id; - Choice : Node_Id; - Comp_Type : Entity_Id; - Is_Array_Aggr : Boolean; - - begin - if Is_OK_Static_Expression (N) then - return True; - - elsif Nkind (N) = N_Null then - return True; - - -- Attributes are allowed in general, even if their prefix is a - -- formal type. (It seems that certain attributes known not to be - -- static might not be allowed, but there are no rules to prevent - -- them.) - - elsif Nkind (N) = N_Attribute_Reference then - return True; - - -- The name of a discriminant evaluated within its parent type is - -- defined to be preelaborable (10.2.1(8)). Note that we test for - -- names that denote discriminals as well as discriminants to - -- catch references occurring within init procs. - - elsif Is_Entity_Name (N) - and then - (Ekind (Entity (N)) = E_Discriminant - or else (Ekind_In (Entity (N), E_Constant, E_In_Parameter) - and then Present (Discriminal_Link (Entity (N))))) - then - return True; - - elsif Nkind (N) = N_Qualified_Expression then - return Is_Preelaborable_Expression (Expression (N)); - - -- For aggregates we have to check that each of the associations - -- is preelaborable. - - elsif Nkind_In (N, N_Aggregate, N_Extension_Aggregate) then - Is_Array_Aggr := Is_Array_Type (Etype (N)); - - if Is_Array_Aggr then - Comp_Type := Component_Type (Etype (N)); - end if; - - -- Check the ancestor part of extension aggregates, which must - -- be either the name of a type that has preelaborable init or - -- an expression that is preelaborable. - - if Nkind (N) = N_Extension_Aggregate then - declare - Anc_Part : constant Node_Id := Ancestor_Part (N); - - begin - if Is_Entity_Name (Anc_Part) - and then Is_Type (Entity (Anc_Part)) - then - if not Has_Preelaborable_Initialization - (Entity (Anc_Part)) - then - return False; - end if; - - elsif not Is_Preelaborable_Expression (Anc_Part) then - return False; - end if; - end; - end if; - - -- Check positional associations - - Exp := First (Expressions (N)); - while Present (Exp) loop - if not Is_Preelaborable_Expression (Exp) then - return False; - end if; - - Next (Exp); - end loop; - - -- Check named associations - - Assn := First (Component_Associations (N)); - while Present (Assn) loop - Choice := First (Choices (Assn)); - while Present (Choice) loop - if Is_Array_Aggr then - if Nkind (Choice) = N_Others_Choice then - null; - - elsif Nkind (Choice) = N_Range then - if not Is_OK_Static_Range (Choice) then - return False; - end if; - - elsif not Is_OK_Static_Expression (Choice) then - return False; - end if; - - else - Comp_Type := Etype (Choice); - end if; - - Next (Choice); - end loop; - - -- If the association has a <> at this point, then we have - -- to check whether the component's type has preelaborable - -- initialization. Note that this only occurs when the - -- association's corresponding component does not have a - -- default expression, the latter case having already been - -- expanded as an expression for the association. - - if Box_Present (Assn) then - if not Has_Preelaborable_Initialization (Comp_Type) then - return False; - end if; - - -- In the expression case we check whether the expression - -- is preelaborable. - - elsif - not Is_Preelaborable_Expression (Expression (Assn)) - then - return False; - end if; - - Next (Assn); - end loop; - - -- If we get here then aggregate as a whole is preelaborable - - return True; - - -- All other cases are not preelaborable - - else - return False; - end if; - end Is_Preelaborable_Expression; - - -- Start of processing for Check_Components - begin -- Loop through entities of record or protected type @@ -10969,7 +11047,7 @@ package body Sem_Util is -- Require the default expression to be preelaborable - elsif not Is_Preelaborable_Expression (Exp) then + elsif not Is_Preelaborable_Construct (Exp) then Has_PE := False; exit; end if; @@ -11714,21 +11792,23 @@ package body Sem_Util is -- In_Instance_Visible_Part -- ------------------------------ - function In_Instance_Visible_Part return Boolean is - S : Entity_Id; + function In_Instance_Visible_Part + (Id : Entity_Id := Current_Scope) return Boolean + is + Inst : Entity_Id; begin - S := Current_Scope; - while Present (S) and then S /= Standard_Standard loop - if Ekind (S) = E_Package - and then Is_Generic_Instance (S) - and then not In_Package_Body (S) - and then not In_Private_Part (S) + Inst := Id; + while Present (Inst) and then Inst /= Standard_Standard loop + if Ekind (Inst) = E_Package + and then Is_Generic_Instance (Inst) + and then not In_Package_Body (Inst) + and then not In_Private_Part (Inst) then return True; end if; - S := Scope (S); + Inst := Scope (Inst); end loop; return False; @@ -11887,7 +11967,7 @@ package body Sem_Util is -- In_Subtree -- ---------------- - function In_Subtree (Root : Node_Id; N : Node_Id) return Boolean is + function In_Subtree (N : Node_Id; Root : Node_Id) return Boolean is Curr : Node_Id; begin @@ -11903,6 +11983,30 @@ package body Sem_Util is return False; end In_Subtree; + ---------------- + -- In_Subtree -- + ---------------- + + function In_Subtree + (N : Node_Id; + Root1 : Node_Id; + Root2 : Node_Id) return Boolean + is + Curr : Node_Id; + + begin + Curr := N; + while Present (Curr) loop + if Curr = Root1 or else Curr = Root2 then + return True; + end if; + + Curr := Parent (Curr); + end loop; + + return False; + end In_Subtree; + --------------------- -- In_Visible_Part -- --------------------- @@ -12444,10 +12548,8 @@ package body Sem_Util is or else (Present (Renamed_Object (E)) and then Is_Aliased_View (Renamed_Object (E))))) - or else ((Is_Formal (E) - or else Ekind_In (E, E_Generic_In_Out_Parameter, - E_Generic_In_Parameter)) - and then Is_Tagged_Type (Etype (E))) + or else ((Is_Formal (E) or else Is_Formal_Object (E)) + and then Is_Tagged_Type (Etype (E))) or else (Is_Concurrent_Type (E) and then In_Open_Scopes (E)) @@ -13084,17 +13186,29 @@ package body Sem_Util is function Is_Controlling_Limited_Procedure (Proc_Nam : Entity_Id) return Boolean is + Param : Node_Id; Param_Typ : Entity_Id := Empty; begin if Ekind (Proc_Nam) = E_Procedure and then Present (Parameter_Specifications (Parent (Proc_Nam))) then - Param_Typ := Etype (Parameter_Type (First ( - Parameter_Specifications (Parent (Proc_Nam))))); + Param := Parameter_Type (First ( + Parameter_Specifications (Parent (Proc_Nam)))); + + -- The formal may be an anonymous access type. + + if Nkind (Param) = N_Access_Definition then + Param_Typ := Entity (Subtype_Mark (Param)); + + else + Param_Typ := Etype (Param); + end if; - -- In this case where an Itype was created, the procedure call has been - -- rewritten. + -- In the case where an Itype was created for a dispatchin call, the + -- procedure call has been rewritten. The actual may be an access to + -- interface type in which case it is the designated type that is the + -- controlling type. elsif Present (Associated_Node_For_Itype (Proc_Nam)) and then Present (Original_Node (Associated_Node_For_Itype (Proc_Nam))) @@ -13105,6 +13219,10 @@ package body Sem_Util is Param_Typ := Etype (First (Parameter_Associations (Associated_Node_For_Itype (Proc_Nam)))); + + if Ekind (Param_Typ) = E_Anonymous_Access_Type then + Param_Typ := Directly_Designated_Type (Param_Typ); + end if; end if; if Present (Param_Typ) then @@ -13286,7 +13404,7 @@ package body Sem_Util is end if; -- A discriminant check on a selected component may be expanded - -- into a dereference when removing side-effects. Recover the + -- into a dereference when removing side effects. Recover the -- original node and its type, which may be unconstrained. elsif Nkind (P) = N_Explicit_Dereference @@ -15287,40 +15405,196 @@ package body Sem_Util is end if; end Is_Potentially_Unevaluated; - --------------------------------- - -- Is_Protected_Self_Reference -- - --------------------------------- + -------------------------------- + -- Is_Preelaborable_Aggregate -- + -------------------------------- - function Is_Protected_Self_Reference (N : Node_Id) return Boolean is + function Is_Preelaborable_Aggregate (Aggr : Node_Id) return Boolean is + Aggr_Typ : constant Entity_Id := Etype (Aggr); + Array_Aggr : constant Boolean := Is_Array_Type (Aggr_Typ); - function In_Access_Definition (N : Node_Id) return Boolean; - -- Returns true if N belongs to an access definition + Anc_Part : Node_Id; + Assoc : Node_Id; + Choice : Node_Id; + Comp_Typ : Entity_Id; + Expr : Node_Id; - -------------------------- - -- In_Access_Definition -- - -------------------------- + begin + if Array_Aggr then + Comp_Typ := Component_Type (Aggr_Typ); + end if; - function In_Access_Definition (N : Node_Id) return Boolean is - P : Node_Id; + -- Inspect the ancestor part - begin - P := Parent (N); - while Present (P) loop - if Nkind (P) = N_Access_Definition then - return True; + if Nkind (Aggr) = N_Extension_Aggregate then + Anc_Part := Ancestor_Part (Aggr); + + -- The ancestor denotes a subtype mark + + if Is_Entity_Name (Anc_Part) + and then Is_Type (Entity (Anc_Part)) + then + if not Has_Preelaborable_Initialization (Entity (Anc_Part)) then + return False; end if; - P := Parent (P); - end loop; + -- Otherwise the ancestor denotes an expression - return False; - end In_Access_Definition; + elsif not Is_Preelaborable_Construct (Anc_Part) then + return False; + end if; + end if; - -- Start of processing for Is_Protected_Self_Reference + -- Inspect the positional associations - begin - -- Verify that prefix is analyzed and has the proper form. Note that - -- the attributes Elab_Spec, Elab_Body, and Elab_Subp_Body, which also + Expr := First (Expressions (Aggr)); + while Present (Expr) loop + if not Is_Preelaborable_Construct (Expr) then + return False; + end if; + + Next (Expr); + end loop; + + -- Inspect the named associations + + Assoc := First (Component_Associations (Aggr)); + while Present (Assoc) loop + + -- Inspect the choices of the current named association + + Choice := First (Choices (Assoc)); + while Present (Choice) loop + if Array_Aggr then + + -- For a choice to be preelaborable, it must denote either a + -- static range or a static expression. + + if Nkind (Choice) = N_Others_Choice then + null; + + elsif Nkind (Choice) = N_Range then + if not Is_OK_Static_Range (Choice) then + return False; + end if; + + elsif not Is_OK_Static_Expression (Choice) then + return False; + end if; + + else + Comp_Typ := Etype (Choice); + end if; + + Next (Choice); + end loop; + + -- The type of the choice must have preelaborable initialization if + -- the association carries a <>. + + if Box_Present (Assoc) then + if not Has_Preelaborable_Initialization (Comp_Typ) then + return False; + end if; + + -- The type of the expression must have preelaborable initialization + + elsif not Is_Preelaborable_Construct (Expression (Assoc)) then + return False; + end if; + + Next (Assoc); + end loop; + + -- At this point the aggregate is preelaborable + + return True; + end Is_Preelaborable_Aggregate; + + -------------------------------- + -- Is_Preelaborable_Construct -- + -------------------------------- + + function Is_Preelaborable_Construct (N : Node_Id) return Boolean is + begin + -- Aggregates + + if Nkind_In (N, N_Aggregate, N_Extension_Aggregate) then + return Is_Preelaborable_Aggregate (N); + + -- Attributes are allowed in general, even if their prefix is a formal + -- type. It seems that certain attributes known not to be static might + -- not be allowed, but there are no rules to prevent them. + + elsif Nkind (N) = N_Attribute_Reference then + return True; + + -- Expressions + + elsif Nkind (N) in N_Subexpr and then Is_OK_Static_Expression (N) then + return True; + + elsif Nkind (N) = N_Qualified_Expression then + return Is_Preelaborable_Construct (Expression (N)); + + -- Names are preelaborable when they denote a discriminant of an + -- enclosing type. Discriminals are also considered for this check. + + elsif Is_Entity_Name (N) + and then Present (Entity (N)) + and then + (Ekind (Entity (N)) = E_Discriminant + or else (Ekind_In (Entity (N), E_Constant, E_In_Parameter) + and then Present (Discriminal_Link (Entity (N))))) + then + return True; + + -- Statements + + elsif Nkind (N) = N_Null then + return True; + + -- Otherwise the construct is not preelaborable + + else + return False; + end if; + end Is_Preelaborable_Construct; + + --------------------------------- + -- Is_Protected_Self_Reference -- + --------------------------------- + + function Is_Protected_Self_Reference (N : Node_Id) return Boolean is + + function In_Access_Definition (N : Node_Id) return Boolean; + -- Returns true if N belongs to an access definition + + -------------------------- + -- In_Access_Definition -- + -------------------------- + + function In_Access_Definition (N : Node_Id) return Boolean is + P : Node_Id; + + begin + P := Parent (N); + while Present (P) loop + if Nkind (P) = N_Access_Definition then + return True; + end if; + + P := Parent (P); + end loop; + + return False; + end In_Access_Definition; + + -- Start of processing for Is_Protected_Self_Reference + + begin + -- Verify that prefix is analyzed and has the proper form. Note that + -- the attributes Elab_Spec, Elab_Body, and Elab_Subp_Body, which also -- produce the address of an entity, do not analyze their prefix -- because they denote entities that are not necessarily visible. -- Neither of them can apply to a protected type. @@ -16941,6 +17215,306 @@ package body Sem_Util is return N; end Last_Source_Statement; + ----------------------- + -- Mark_Coextensions -- + ----------------------- + + procedure Mark_Coextensions (Context_Nod : Node_Id; Root_Nod : Node_Id) is + Is_Dynamic : Boolean; + -- Indicates whether the context causes nested coextensions to be + -- dynamic or static + + function Mark_Allocator (N : Node_Id) return Traverse_Result; + -- Recognize an allocator node and label it as a dynamic coextension + + -------------------- + -- Mark_Allocator -- + -------------------- + + function Mark_Allocator (N : Node_Id) return Traverse_Result is + begin + if Nkind (N) = N_Allocator then + if Is_Dynamic then + Set_Is_Dynamic_Coextension (N); + + -- If the allocator expression is potentially dynamic, it may + -- be expanded out of order and require dynamic allocation + -- anyway, so we treat the coextension itself as dynamic. + -- Potential optimization ??? + + elsif Nkind (Expression (N)) = N_Qualified_Expression + and then Nkind (Expression (Expression (N))) = N_Op_Concat + then + Set_Is_Dynamic_Coextension (N); + else + Set_Is_Static_Coextension (N); + end if; + end if; + + return OK; + end Mark_Allocator; + + procedure Mark_Allocators is new Traverse_Proc (Mark_Allocator); + + -- Start of processing for Mark_Coextensions + + begin + -- An allocator that appears on the right-hand side of an assignment is + -- treated as a potentially dynamic coextension when the right-hand side + -- is an allocator or a qualified expression. + + -- Obj := new ...'(new Coextension ...); + + if Nkind (Context_Nod) = N_Assignment_Statement then + Is_Dynamic := + Nkind_In (Expression (Context_Nod), N_Allocator, + N_Qualified_Expression); + + -- An allocator that appears within the expression of a simple return + -- statement is treated as a potentially dynamic coextension when the + -- expression is either aggregate, allocator, or qualified expression. + + -- return (new Coextension ...); + -- return new ...'(new Coextension ...); + + elsif Nkind (Context_Nod) = N_Simple_Return_Statement then + Is_Dynamic := + Nkind_In (Expression (Context_Nod), N_Aggregate, + N_Allocator, + N_Qualified_Expression); + + -- An alloctor that appears within the initialization expression of an + -- object declaration is considered a potentially dynamic coextension + -- when the initialization expression is an allocator or a qualified + -- expression. + + -- Obj : ... := new ...'(new Coextension ...); + + -- A similar case arises when the object declaration is part of an + -- extended return statement. + + -- return Obj : ... := new ...'(new Coextension ...); + -- return Obj : ... := (new Coextension ...); + + elsif Nkind (Context_Nod) = N_Object_Declaration then + Is_Dynamic := + Nkind_In (Root_Nod, N_Allocator, N_Qualified_Expression) + or else + Nkind (Parent (Context_Nod)) = N_Extended_Return_Statement; + + -- This routine should not be called with constructs that cannot contain + -- coextensions. + + else + raise Program_Error; + end if; + + Mark_Allocators (Root_Nod); + end Mark_Coextensions; + + --------------------------------- + -- Mark_Elaboration_Attributes -- + --------------------------------- + + procedure Mark_Elaboration_Attributes + (N_Id : Node_Or_Entity_Id; + Checks : Boolean := False; + Level : Boolean := False; + Modes : Boolean := False) + is + function Elaboration_Checks_OK + (Target_Id : Entity_Id; + Context_Id : Entity_Id) return Boolean; + -- Determine whether elaboration checks are enabled for target Target_Id + -- which resides within context Context_Id. + + procedure Mark_Elaboration_Attributes_Id (Id : Entity_Id); + -- Preserve relevant attributes of the context in arbitrary entity Id + + procedure Mark_Elaboration_Attributes_Node (N : Node_Id); + -- Preserve relevant attributes of the context in arbitrary node N + + --------------------------- + -- Elaboration_Checks_OK -- + --------------------------- + + function Elaboration_Checks_OK + (Target_Id : Entity_Id; + Context_Id : Entity_Id) return Boolean + is + Encl_Scop : Entity_Id; + + begin + -- Elaboration checks are suppressed for the target + + if Elaboration_Checks_Suppressed (Target_Id) then + return False; + end if; + + -- Otherwise elaboration checks are OK for the target, but may be + -- suppressed for the context where the target is declared. + + Encl_Scop := Context_Id; + while Present (Encl_Scop) and then Encl_Scop /= Standard_Standard loop + if Elaboration_Checks_Suppressed (Encl_Scop) then + return False; + end if; + + Encl_Scop := Scope (Encl_Scop); + end loop; + + -- Neither the target nor its declarative context have elaboration + -- checks suppressed. + + return True; + end Elaboration_Checks_OK; + + ------------------------------------ + -- Mark_Elaboration_Attributes_Id -- + ------------------------------------ + + procedure Mark_Elaboration_Attributes_Id (Id : Entity_Id) is + begin + -- Mark the status of elaboration checks in effect. Do not reset the + -- status in case the entity is reanalyzed with checks suppressed. + + if Checks and then not Is_Elaboration_Checks_OK_Id (Id) then + Set_Is_Elaboration_Checks_OK_Id (Id, + Elaboration_Checks_OK + (Target_Id => Id, + Context_Id => Scope (Id))); + + -- Entities do not need to capture their enclosing level. The Ghost + -- and SPARK modes in effect are already marked during analysis. + + else + null; + end if; + end Mark_Elaboration_Attributes_Id; + + -------------------------------------- + -- Mark_Elaboration_Attributes_Node -- + -------------------------------------- + + procedure Mark_Elaboration_Attributes_Node (N : Node_Id) is + function Extract_Name (N : Node_Id) return Node_Id; + -- Obtain the Name attribute of call or instantiation N + + ------------------ + -- Extract_Name -- + ------------------ + + function Extract_Name (N : Node_Id) return Node_Id is + Nam : Node_Id; + + begin + Nam := Name (N); + + -- A call to an entry family appears in indexed form + + if Nkind (Nam) = N_Indexed_Component then + Nam := Prefix (Nam); + end if; + + -- The name may also appear in qualified form + + if Nkind (Nam) = N_Selected_Component then + Nam := Selector_Name (Nam); + end if; + + return Nam; + end Extract_Name; + + -- Local variables + + Context_Id : Entity_Id; + Nam : Node_Id; + + -- Start of processing for Mark_Elaboration_Attributes_Node + + begin + -- Mark the status of elaboration checks in effect. Do not reset the + -- status in case the node is reanalyzed with checks suppressed. + + if Checks and then not Is_Elaboration_Checks_OK_Node (N) then + + -- Assignments, attribute references, and variable references do + -- not have a "declarative" context. + + Context_Id := Empty; + + -- The status of elaboration checks for calls and instantiations + -- depends on the most recent pragma Suppress/Unsuppress, as well + -- as the suppression status of the context where the target is + -- defined. + + -- package Pack is + -- function Func ...; + -- end Pack; + + -- with Pack; + -- procedure Main is + -- pragma Suppress (Elaboration_Checks, Pack); + -- X : ... := Pack.Func; + -- ... + + -- In the example above, the call to Func has elaboration checks + -- enabled because there is no active general purpose suppression + -- pragma, however the elaboration checks of Pack are explicitly + -- suppressed. As a result the elaboration checks of the call must + -- be disabled in order to preserve this dependency. + + if Nkind_In (N, N_Entry_Call_Statement, + N_Function_Call, + N_Function_Instantiation, + N_Package_Instantiation, + N_Procedure_Call_Statement, + N_Procedure_Instantiation) + then + Nam := Extract_Name (N); + + if Is_Entity_Name (Nam) and then Present (Entity (Nam)) then + Context_Id := Scope (Entity (Nam)); + end if; + end if; + + Set_Is_Elaboration_Checks_OK_Node (N, + Elaboration_Checks_OK + (Target_Id => Empty, + Context_Id => Context_Id)); + end if; + + -- Mark the enclosing level of the node. Do not reset the status in + -- case the node is relocated and reanalyzed. + + if Level and then not Is_Declaration_Level_Node (N) then + Set_Is_Declaration_Level_Node (N, + Find_Enclosing_Level (N) = Declaration_Level); + end if; + + -- Mark the Ghost and SPARK mode in effect + + if Modes then + if Ghost_Mode = Ignore then + Set_Is_Ignored_Ghost_Node (N); + end if; + + if SPARK_Mode = On then + Set_Is_SPARK_Mode_On_Node (N); + end if; + end if; + end Mark_Elaboration_Attributes_Node; + + -- Start of processing for Mark_Elaboration_Attributes + + begin + if Nkind (N_Id) in N_Entity then + Mark_Elaboration_Attributes_Id (N_Id); + else + Mark_Elaboration_Attributes_Node (N_Id); + end if; + end Mark_Elaboration_Attributes; + ---------------------------------- -- Matching_Static_Array_Bounds -- ---------------------------------- @@ -17245,103 +17819,6 @@ package body Sem_Util is end case; end May_Be_Lvalue; - ----------------------- - -- Mark_Coextensions -- - ----------------------- - - procedure Mark_Coextensions (Context_Nod : Node_Id; Root_Nod : Node_Id) is - Is_Dynamic : Boolean; - -- Indicates whether the context causes nested coextensions to be - -- dynamic or static - - function Mark_Allocator (N : Node_Id) return Traverse_Result; - -- Recognize an allocator node and label it as a dynamic coextension - - -------------------- - -- Mark_Allocator -- - -------------------- - - function Mark_Allocator (N : Node_Id) return Traverse_Result is - begin - if Nkind (N) = N_Allocator then - if Is_Dynamic then - Set_Is_Dynamic_Coextension (N); - - -- If the allocator expression is potentially dynamic, it may - -- be expanded out of order and require dynamic allocation - -- anyway, so we treat the coextension itself as dynamic. - -- Potential optimization ??? - - elsif Nkind (Expression (N)) = N_Qualified_Expression - and then Nkind (Expression (Expression (N))) = N_Op_Concat - then - Set_Is_Dynamic_Coextension (N); - else - Set_Is_Static_Coextension (N); - end if; - end if; - - return OK; - end Mark_Allocator; - - procedure Mark_Allocators is new Traverse_Proc (Mark_Allocator); - - -- Start of processing for Mark_Coextensions - - begin - -- An allocator that appears on the right-hand side of an assignment is - -- treated as a potentially dynamic coextension when the right-hand side - -- is an allocator or a qualified expression. - - -- Obj := new ...'(new Coextension ...); - - if Nkind (Context_Nod) = N_Assignment_Statement then - Is_Dynamic := - Nkind_In (Expression (Context_Nod), N_Allocator, - N_Qualified_Expression); - - -- An allocator that appears within the expression of a simple return - -- statement is treated as a potentially dynamic coextension when the - -- expression is either aggregate, allocator, or qualified expression. - - -- return (new Coextension ...); - -- return new ...'(new Coextension ...); - - elsif Nkind (Context_Nod) = N_Simple_Return_Statement then - Is_Dynamic := - Nkind_In (Expression (Context_Nod), N_Aggregate, - N_Allocator, - N_Qualified_Expression); - - -- An allocator that appears within the initialization expression of an - -- object declaration is considered a potentially dynamic coextension - -- when the initialization expression is an allocator or a qualified - -- expression. - - -- Obj : ... := new ...'(new Coextension ...); - - -- A similar case arises when the object declaration is part of an - -- extended return statement. - - -- return Obj : ... := new ...'(new Coextension ...); - -- return Obj : ... := (new Coextension ...); - - elsif Nkind (Context_Nod) = N_Object_Declaration then - Is_Dynamic := - Nkind_In (Root_Nod, N_Allocator, N_Qualified_Expression) - or else - Nkind (Parent (Context_Nod)) = N_Extended_Return_Statement; - - -- This routine should not be called with constructs that cannot contain - -- coextensions. - - else - raise Program_Error; - end if; - - Mark_Allocators (Root_Nod); - end Mark_Coextensions; - ----------------- -- Might_Raise -- ----------------- @@ -18508,8 +18985,8 @@ package body Sem_Util is -- the subtree being replicated. elsif not In_Subtree - (Root => Source, - N => Declaration_Node (Id)) + (N => Declaration_Node (Id), + Root => Source) then return; end if; @@ -18653,8 +19130,8 @@ package body Sem_Util is -- the subtree being replicated. elsif not In_Subtree - (Root => Source, - N => Associated_Node_For_Itype (Itype)) + (N => Associated_Node_For_Itype (Itype), + Root => Source) then return; end if; @@ -19059,7 +19536,18 @@ package body Sem_Util is N := Next (Actual_Id); if Nkind (N) = N_Parameter_Association then - return First_Named_Actual (Parent (Actual_Id)); + + -- In case of a build-in-place call, the call will no longer be a + -- call; it will have been rewritten. + + if Nkind_In (Parent (Actual_Id), N_Entry_Call_Statement, + N_Function_Call, + N_Procedure_Call_Statement) + then + return First_Named_Actual (Parent (Actual_Id)); + else + return Empty; + end if; else return N; end if; @@ -20113,6 +20601,51 @@ package body Sem_Util is return False; end Null_To_Null_Address_Convert_OK; + --------------------------------- + -- Number_Of_Elements_In_Array -- + --------------------------------- + + function Number_Of_Elements_In_Array (T : Entity_Id) return Int is + Indx : Node_Id; + Typ : Entity_Id; + Low : Node_Id; + High : Node_Id; + Num : Int := 1; + + begin + pragma Assert (Is_Array_Type (T)); + + Indx := First_Index (T); + while Present (Indx) loop + Typ := Underlying_Type (Etype (Indx)); + + -- Never look at junk bounds of a generic type + + if Is_Generic_Type (Typ) then + return 0; + end if; + + -- Check the array bounds are known at compile time and return zero + -- if they are not. + + Low := Type_Low_Bound (Typ); + High := Type_High_Bound (Typ); + + if not Compile_Time_Known_Value (Low) then + return 0; + elsif not Compile_Time_Known_Value (High) then + return 0; + else + Num := + Num * UI_To_Int ((Expr_Value (High) - Expr_Value (Low) + 1)); + end if; + + Next_Index (Indx); + end loop; + + return Num; + end Number_Of_Elements_In_Array; + ------------------------- -- Object_Access_Level -- ------------------------- @@ -20132,7 +20665,7 @@ package body Sem_Util is -- This construct appears in the context of dispatching calls. function Reference_To (Obj : Node_Id) return Node_Id; - -- An explicit dereference is created when removing side-effects from + -- An explicit dereference is created when removing side effects from -- expressions for constraint checking purposes. In this case a local -- access type is created for it. The correct access level is that of -- the original source node. We detect this case by noting that the @@ -20372,6 +20905,17 @@ package body Sem_Util is (Nearest_Dynamic_Scope (Defining_Entity (Node_Par))); + -- For a return statement within a function, return + -- the depth of the function itself. This is not just + -- a small optimization, but matters when analyzing + -- the expression in an expression function before + -- the body is created. + + when N_Simple_Return_Statement => + if Ekind (Current_Scope) = E_Function then + return Scope_Depth (Current_Scope); + end if; + when others => null; end case; @@ -21964,15 +22508,18 @@ package body Sem_Util is -- Scope_Within -- ------------------ - function Scope_Within (Scope1, Scope2 : Entity_Id) return Boolean is - Scop : Entity_Id; + function Scope_Within + (Inner : Entity_Id; + Outer : Entity_Id) return Boolean + is + Curr : Entity_Id; begin - Scop := Scope1; - while Scop /= Standard_Standard loop - Scop := Scope (Scop); + Curr := Inner; + while Present (Curr) and then Curr /= Standard_Standard loop + Curr := Scope (Curr); - if Scop = Scope2 then + if Curr = Outer then return True; end if; end loop; @@ -21984,17 +22531,20 @@ package body Sem_Util is -- Scope_Within_Or_Same -- -------------------------- - function Scope_Within_Or_Same (Scope1, Scope2 : Entity_Id) return Boolean is - Scop : Entity_Id; + function Scope_Within_Or_Same + (Inner : Entity_Id; + Outer : Entity_Id) return Boolean + is + Curr : Entity_Id; begin - Scop := Scope1; - while Scop /= Standard_Standard loop - if Scop = Scope2 then + Curr := Inner; + while Present (Curr) and then Curr /= Standard_Standard loop + if Curr = Outer then return True; - else - Scop := Scope (Scop); end if; + + Curr := Scope (Curr); end loop; return False; @@ -22777,7 +23327,15 @@ package body Sem_Util is return "unknown subprogram"; end if; - Append_Entity_Name (Buf, Ent); + -- If the subprogram is a child unit, use its simple name to start the + -- construction of the fully qualified name. + + if Nkind (Ent) = N_Defining_Program_Unit_Name then + Append_Entity_Name (Buf, Defining_Identifier (Ent)); + else + Append_Entity_Name (Buf, Ent); + end if; + return +Buf; end Subprogram_Name; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 30c35cb15919b..c6958cb1aaad9 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -202,6 +202,10 @@ package Sem_Util is -- given, and the reference N is not in the same extended source unit as -- the declaration of T. + function Begin_Keyword_Location (N : Node_Id) return Source_Ptr; + -- Given block statement, entry body, package body, subprogram body, or + -- task body N, return the closest source location to the "begin" keyword. + function Build_Actual_Subtype (T : Entity_Id; N : Node_Or_Entity_Id) return Node_Id; @@ -547,8 +551,9 @@ package Sem_Util is -- instead of 0). function Defining_Entity - (N : Node_Id; - Empty_On_Errors : Boolean := False) return Entity_Id; + (N : Node_Id; + Empty_On_Errors : Boolean := False; + Concurrent_Subunit : Boolean := False) return Entity_Id; -- Given a declaration N, returns the associated defining entity. If the -- declaration has a specification, the entity is obtained from the -- specification. If the declaration has a defining unit name, then the @@ -572,6 +577,9 @@ package Sem_Util is -- -- The former semantics is appropriate for the back end; the latter -- semantics is appropriate for the front end. + -- + -- Set flag Concurrent_Subunit to handle rewritings of concurrent bodies + -- which act as subunits. Such bodies are generally rewritten as null. function Denotes_Discriminant (N : Node_Id; @@ -685,6 +693,12 @@ package Sem_Util is -- Utility function to return the Ada entity of the subprogram enclosing -- the entity E, if any. Returns Empty if no enclosing subprogram. + function End_Keyword_Location (N : Node_Id) return Source_Ptr; + -- Given block statement, entry body, package body, package declaration, + -- protected body, [single] protected type declaration, subprogram body, + -- task body, or [single] task type declaration N, return the closest + -- source location of the "end" keyword. + procedure Ensure_Freeze_Node (E : Entity_Id); -- Make sure a freeze node is allocated for entity E. If necessary, build -- and initialize a new freeze node and set Has_Delayed_Freeze True for E. @@ -740,12 +754,6 @@ package Sem_Util is -- Call is set to the node for the corresponding call. If the node N is not -- an actual parameter then Formal and Call are set to Empty. - function Find_Specific_Type (CW : Entity_Id) return Entity_Id; - -- Find specific type of a class-wide type, and handle the case of an - -- incomplete type coming either from a limited_with clause or from an - -- incomplete type declaration. If resulting type is private return its - -- full view. - function Find_Body_Discriminal (Spec_Discriminant : Entity_Id) return Entity_Id; -- Given a discriminant of the record type that implements a task or @@ -762,9 +770,12 @@ package Sem_Util is -- discriminant at the same position in this new type. function Find_Enclosing_Iterator_Loop (Id : Entity_Id) return Entity_Id; - -- Given an arbitrary entity, try to find the nearest enclosing iterator - -- loop. If such a loop is found, return the entity of its identifier (the - -- E_Loop scope), otherwise return Empty. + -- Find the nearest iterator loop which encloses arbitrary entity Id. If + -- such a loop exists, return the entity of its identifier (E_Loop scope), + -- otherwise return Empty. + + function Find_Enclosing_Scope (N : Node_Id) return Entity_Id; + -- Find the nearest scope which encloses arbitrary node N function Find_Loop_In_Conditional_Block (N : Node_Id) return Node_Id; -- Find the nested loop statement in a conditional block. Loops subject to @@ -868,6 +879,12 @@ package Sem_Util is -- If the state space is that of a package, Pack_Id denotes its entity, -- otherwise Pack_Id is Empty. + function Find_Specific_Type (CW : Entity_Id) return Entity_Id; + -- Find specific type of a class-wide type, and handle the case of an + -- incomplete type coming either from a limited_with clause or from an + -- incomplete type declaration. If resulting type is private return its + -- full view. + function Find_Static_Alternative (N : Node_Id) return Node_Id; -- N is a case statement whose expression is a compile-time value. -- Determine the alternative chosen, so that the code of non-selected @@ -1134,8 +1151,7 @@ package Sem_Util is -- subprogram or entry and returns it, or if no subprogram can be found, -- returns Empty. - function Get_Task_Body_Procedure (E : Entity_Id) return Node_Id; - pragma Inline (Get_Task_Body_Procedure); + function Get_Task_Body_Procedure (E : Entity_Id) return Entity_Id; -- Given an entity for a task type or subtype, retrieves the -- Task_Body_Procedure field from the corresponding task type declaration. @@ -1259,14 +1275,14 @@ package Sem_Util is -- as expressed in pragma Refined_State. This function does not take into -- account the visible refinement region of abstract state Id. - function Has_Null_Body (Proc_Id : Entity_Id) return Boolean; - -- Determine whether the body of procedure Proc_Id contains a sole - -- null statement, possibly followed by an optional return. Used to - -- optimize useless calls to assertion checks. + function Has_Non_Trivial_Precondition (Subp : Entity_Id) return Boolean; + -- Determine whether subprogram Subp has a class-wide precondition that is + -- not statically True. - function Has_Non_Trivial_Precondition (P : Entity_Id) return Boolean; - -- True if subprogram has a class-wide precondition that is not - -- statically True. + function Has_Null_Body (Proc_Id : Entity_Id) return Boolean; + -- Determine whether the body of procedure Proc_Id contains a sole null + -- statement, possibly followed by an optional return. Used to optimize + -- useless calls to assertion checks. function Has_Null_Exclusion (N : Node_Id) return Boolean; -- Determine whether node N has a null exclusion @@ -1357,9 +1373,10 @@ package Sem_Util is -- Returns True if current scope is with the private part or the body of -- an instance. Other semantic checks are suppressed in this context. - function In_Instance_Visible_Part return Boolean; - -- Returns True if current scope is within the visible part of a package - -- instance, where several additional semantic checks apply. + function In_Instance_Visible_Part + (Id : Entity_Id := Current_Scope) return Boolean; + -- Returns True if arbitrary entity Id is within the visible part of a + -- package instance, where several additional semantic checks apply. function In_Package_Body return Boolean; -- Returns True if current scope is within a package body @@ -1382,9 +1399,17 @@ package Sem_Util is -- appearing anywhere within such a construct (that is it does not need -- to be directly within). - function In_Subtree (Root : Node_Id; N : Node_Id) return Boolean; + function In_Subtree (N : Node_Id; Root : Node_Id) return Boolean; -- Determine whether node N is within the subtree rooted at Root + function In_Subtree + (N : Node_Id; + Root1 : Node_Id; + Root2 : Node_Id) return Boolean; + -- Determine whether node N is within the subtree rooted at Root1 or Root2. + -- This version is more efficient than calling the single root version of + -- Is_Subtree twice. + function In_Visible_Part (Scope_Id : Entity_Id) return Boolean; -- Determine whether a declaration occurs within the visible part of a -- package specification. The package must be on the scope stack, and the @@ -1765,6 +1790,14 @@ package Sem_Util is -- persistent. A private type is potentially persistent if the full type -- is potentially persistent. + function Is_Preelaborable_Aggregate (Aggr : Node_Id) return Boolean; + -- Determine whether aggregate Aggr violates the restrictions of + -- preelaborable constructs as defined in ARM 10.2.1(5-9). + + function Is_Preelaborable_Construct (N : Node_Id) return Boolean; + -- Determine whether arbitrary node N violates the restrictions of + -- preelaborable constructs as defined in ARM 10.2.1(5-9). + function Is_Protected_Self_Reference (N : Node_Id) return Boolean; -- Return True if node N denotes a protected type name which represents -- the current instance of a protected object according to RM 9.4(21/2). @@ -2028,6 +2061,24 @@ package Sem_Util is -- statement in Statements (HSS) that has Comes_From_Source set. If no -- such statement exists, Empty is returned. + procedure Mark_Coextensions (Context_Nod : Node_Id; Root_Nod : Node_Id); + -- Given a node which designates the context of analysis and an origin in + -- the tree, traverse from Root_Nod and mark all allocators as either + -- dynamic or static depending on Context_Nod. Any incorrect marking is + -- cleaned up during resolution. + + procedure Mark_Elaboration_Attributes + (N_Id : Node_Or_Entity_Id; + Checks : Boolean := False; + Level : Boolean := False; + Modes : Boolean := False); + -- Preserve relevant elaboration-related properties of the context in + -- arbitrary entity or node N_Id. When flag Checks is set, the routine + -- saves the status of Elaboration_Check. When flag Level is set, the + -- routine captures the declaration level of N_Id if applicable. When + -- flag Modes is set, the routine saves the Ghost and SPARK modes in + -- effect if applicable. + function Matching_Static_Array_Bounds (L_Typ : Node_Id; R_Typ : Node_Id) return Boolean; @@ -2035,12 +2086,6 @@ package Sem_Util is -- same number of dimensions, and the same static bounds for each index -- position. - procedure Mark_Coextensions (Context_Nod : Node_Id; Root_Nod : Node_Id); - -- Given a node which designates the context of analysis and an origin in - -- the tree, traverse from Root_Nod and mark all allocators as either - -- dynamic or static depending on Context_Nod. Any incorrect marking is - -- cleaned up during resolution. - function May_Be_Lvalue (N : Node_Id) return Boolean; -- Determines if N could be an lvalue (e.g. an assignment left hand side). -- An lvalue is defined as any expression which appears in a context where @@ -2230,6 +2275,11 @@ package Sem_Util is -- 2) N is a comparison operator, one of the operands is null, and the -- type of the other operand is a descendant of System.Address. + function Number_Of_Elements_In_Array (T : Entity_Id) return Int; + -- Returns the number of elements in the array T if the index bounds of T + -- is known at compile time. If the bounds are not known at compile time, + -- the function returns the value zero. + function Object_Access_Level (Obj : Node_Id) return Uint; -- Return the accessibility level of the view of the object Obj. For -- convenience, qualified expressions applied to object names are also @@ -2460,15 +2510,19 @@ package Sem_Util is -- this is the case, and False if no scalar parts are present (meaning that -- the result of Valid_Scalars applied to T is always vacuously True). - function Scope_Within_Or_Same (Scope1, Scope2 : Entity_Id) return Boolean; - -- Determines if the entity Scope1 is the same as Scope2, or if it is - -- inside it, where both entities represent scopes. Note that scopes - -- are only partially ordered, so Scope_Within_Or_Same (A,B) and - -- Scope_Within_Or_Same (B,A) can both be False for a given pair A,B. - - function Scope_Within (Scope1, Scope2 : Entity_Id) return Boolean; - -- Like Scope_Within_Or_Same, except that this function returns - -- False in the case where Scope1 and Scope2 are the same scope. + function Scope_Within + (Inner : Entity_Id; + Outer : Entity_Id) return Boolean; + -- Determine whether scope Inner appears within scope Outer. Note that + -- scopes are partially ordered, so Scope_Within (A, B) and Scope_Within + -- (B, A) may both return False. + + function Scope_Within_Or_Same + (Inner : Entity_Id; + Outer : Entity_Id) return Boolean; + -- Determine whether scope Inner appears within scope Outer or both renote + -- the same scope. Note that scopes are partially ordered, so Scope_Within + -- (A, B) and Scope_Within (B, A) may both return False. procedure Set_Convention (E : Entity_Id; Val : Convention_Id); -- Same as Basic_Set_Convention, but with an extra check for access types. diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index f20d9df5a9dad..0e498d3e6cb2c 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -248,6 +248,10 @@ package body Sem_Warn is -- If so, Ref is set to point to the reference node, and Var is set to -- the referenced Entity. + function Has_Condition_Actions (Iter : Node_Id) return Boolean; + -- Determine whether iteration scheme Iter has meaningful condition + -- actions. + function Has_Indirection (T : Entity_Id) return Boolean; -- If the controlling variable is an access type, or is a record type -- with access components, assume that it is changed indirectly and @@ -360,6 +364,29 @@ package body Sem_Warn is end if; end Find_Var; + --------------------------- + -- Has_Condition_Actions -- + --------------------------- + + function Has_Condition_Actions (Iter : Node_Id) return Boolean is + Action : Node_Id; + + begin + -- A call marker is not considered a meaningful action because it + -- acts as an annotation and has no runtime semantics. + + Action := First (Condition_Actions (Iter)); + while Present (Action) loop + if Nkind (Action) /= N_Call_Marker then + return True; + end if; + + Next (Action); + end loop; + + return False; + end Has_Condition_Actions; + --------------------- -- Has_Indirection -- --------------------- @@ -482,7 +509,7 @@ package body Sem_Warn is end if; -- If the condition contains a function call, we consider it may - -- be modified by side-effects from a procedure call. Otherwise, + -- be modified by side effects from a procedure call. Otherwise, -- we consider the condition may not be modified, although that -- might happen if Variable is itself a by-reference parameter, -- and the procedure called modifies the global object referred to @@ -597,7 +624,7 @@ package body Sem_Warn is -- Skip processing for while iteration with conditions actions, -- since they make it too complicated to get the warning right. - if Present (Condition_Actions (Iter)) then + if Has_Condition_Actions (Iter) then return; end if; @@ -4258,7 +4285,7 @@ package body Sem_Warn is then if not Has_Pragma_Unmodified_Check_Spec (E) then Error_Msg_N -- CODEFIX - ("?u?variable & is assigned but never read!", E); + ("?m?variable & is assigned but never read!", E); end if; Set_Last_Assignment (E, Empty); diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 4eb1c8c6f476a..dc4e8fb2c1a0e 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -61,19 +61,6 @@ package body Sinfo is -- uniform format of the conditions following this. Note that csinfo -- expects this uniform format. - function ABE_Is_Certain - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Call_Statement - or else NT (N).Nkind = N_Procedure_Instantiation); - return Flag18 (N); - end ABE_Is_Certain; - function Abort_Present (N : Node_Id) return Boolean is begin @@ -216,6 +203,14 @@ package body Sinfo is return Flag4 (N); end Aliased_Present; + function Alloc_For_BIP_Return + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Allocator); + return Flag1 (N); + end Alloc_For_BIP_Return; + function All_Others (N : Node_Id) return Boolean is begin @@ -439,7 +434,7 @@ package body Sinfo is end Classifications; function Cleanup_Actions - (N : Node_Id) return List_Id is + (N : Node_Id) return List_Id is begin pragma Assert (False or else NT (N).Nkind = N_Block_Statement); @@ -447,7 +442,7 @@ package body Sinfo is end Cleanup_Actions; function Comes_From_Extended_Return_Statement - (N : Node_Id) return Boolean is + (N : Node_Id) return Boolean is begin pragma Assert (False or else NT (N).Nkind = N_Simple_Return_Statement); @@ -951,7 +946,7 @@ package body Sinfo is or else NT (N).Nkind = N_Assignment_Statement or else NT (N).Nkind = N_Selected_Component or else NT (N).Nkind = N_Type_Conversion); - return Flag1 (N); + return Flag3 (N); end Do_Discriminant_Check; function Do_Division_Check @@ -1856,14 +1851,16 @@ package body Sinfo is return Flag16 (N); end Is_Controlling_Actual; - function Is_Disabled + function Is_Declaration_Level_Node (N : Node_Id) return Boolean is begin pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Pragma); - return Flag15 (N); - end Is_Disabled; + or else NT (N).Nkind = N_Call_Marker + or else NT (N).Nkind = N_Function_Instantiation + or else NT (N).Nkind = N_Package_Instantiation + or else NT (N).Nkind = N_Procedure_Instantiation); + return Flag5 (N); + end Is_Declaration_Level_Node; function Is_Delayed_Aspect (N : Node_Id) return Boolean is @@ -1875,6 +1872,23 @@ package body Sinfo is return Flag14 (N); end Is_Delayed_Aspect; + function Is_Disabled + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification + or else NT (N).Nkind = N_Pragma); + return Flag15 (N); + end Is_Disabled; + + function Is_Dispatching_Call + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Call_Marker); + return Flag3 (N); + end Is_Dispatching_Call; + function Is_Dynamic_Coextension (N : Node_Id) return Boolean is begin @@ -1892,8 +1906,27 @@ package body Sinfo is return Flag1 (N); end Is_Effective_Use_Clause; + function Is_Elaboration_Checks_OK_Node + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Assignment_Statement + or else NT (N).Nkind = N_Attribute_Reference + or else NT (N).Nkind = N_Call_Marker + or else NT (N).Nkind = N_Entry_Call_Statement + or else NT (N).Nkind = N_Expanded_Name + or else NT (N).Nkind = N_Function_Call + or else NT (N).Nkind = N_Function_Instantiation + or else NT (N).Nkind = N_Identifier + or else NT (N).Nkind = N_Package_Instantiation + or else NT (N).Nkind = N_Procedure_Call_Statement + or else NT (N).Nkind = N_Procedure_Instantiation + or else NT (N).Nkind = N_Requeue_Statement); + return Flag1 (N); + end Is_Elaboration_Checks_OK_Node; + function Is_Elsif - (N : Node_Id) return Boolean is + (N : Node_Id) return Boolean is begin pragma Assert (False or else NT (N).Nkind = N_If_Expression); @@ -1982,6 +2015,25 @@ package body Sinfo is return Flag4 (N); end Is_Inherited_Pragma; + function Is_Initialization_Block + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Block_Statement); + return Flag1 (N); + end Is_Initialization_Block; + + function Is_Known_Guaranteed_ABE + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Call_Marker + or else NT (N).Nkind = N_Function_Instantiation + or else NT (N).Nkind = N_Package_Instantiation + or else NT (N).Nkind = N_Procedure_Instantiation); + return Flag18 (N); + end Is_Known_Guaranteed_ABE; + function Is_Machine_Number (N : Node_Id) return Boolean is begin @@ -2038,6 +2090,44 @@ package body Sinfo is return Flag4 (N); end Is_Qualified_Universal_Literal; + function Is_Recorded_Scenario + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Call_Marker + or else NT (N).Nkind = N_Function_Instantiation + or else NT (N).Nkind = N_Package_Instantiation + or else NT (N).Nkind = N_Procedure_Instantiation); + return Flag6 (N); + end Is_Recorded_Scenario; + + function Is_Source_Call + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Call_Marker); + return Flag4 (N); + end Is_Source_Call; + + function Is_SPARK_Mode_On_Node + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Assignment_Statement + or else NT (N).Nkind = N_Attribute_Reference + or else NT (N).Nkind = N_Call_Marker + or else NT (N).Nkind = N_Entry_Call_Statement + or else NT (N).Nkind = N_Expanded_Name + or else NT (N).Nkind = N_Function_Call + or else NT (N).Nkind = N_Function_Instantiation + or else NT (N).Nkind = N_Identifier + or else NT (N).Nkind = N_Package_Instantiation + or else NT (N).Nkind = N_Procedure_Call_Statement + or else NT (N).Nkind = N_Procedure_Instantiation + or else NT (N).Nkind = N_Requeue_Statement); + return Flag2 (N); + end Is_SPARK_Mode_On_Node; + function Is_Static_Coextension (N : Node_Id) return Boolean is begin @@ -2425,15 +2515,6 @@ package body Sinfo is return Flag7 (N); end No_Ctrl_Actions; - function No_Elaboration_Check - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Procedure_Call_Statement); - return Flag14 (N); - end No_Elaboration_Check; - function No_Entities_Ref_In_Spec (N : Node_Id) return Boolean is begin @@ -2465,7 +2546,7 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Function_Call); - return Flag1 (N); + return Flag17 (N); end No_Side_Effect_Removal; function No_Truncation @@ -3192,6 +3273,14 @@ package body Sinfo is return Flag15 (N); end Tagged_Present; + function Target + (N : Node_Id) return Entity_Id is + begin + pragma Assert (False + or else NT (N).Nkind = N_Call_Marker); + return Node1 (N); + end Target; + function Target_Type (N : Node_Id) return Entity_Id is begin @@ -3364,6 +3453,14 @@ package body Sinfo is return Elist2 (N); end Used_Operations; + function Was_Attribute_Reference + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Subprogram_Body); + return Flag2 (N); + end Was_Attribute_Reference; + function Was_Expression_Function (N : Node_Id) return Boolean is begin @@ -3395,19 +3492,6 @@ package body Sinfo is -- Field Set Procedures -- -------------------------- - procedure Set_ABE_Is_Certain - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Call_Statement - or else NT (N).Nkind = N_Procedure_Instantiation); - Set_Flag18 (N, Val); - end Set_ABE_Is_Certain; - procedure Set_Abort_Present (N : Node_Id; Val : Boolean := True) is begin @@ -3550,6 +3634,14 @@ package body Sinfo is Set_Flag4 (N, Val); end Set_Aliased_Present; + procedure Set_Alloc_For_BIP_Return + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Allocator); + Set_Flag1 (N, Val); + end Set_Alloc_For_BIP_Return; + procedure Set_All_Others (N : Node_Id; Val : Boolean := True) is begin @@ -4285,7 +4377,7 @@ package body Sinfo is or else NT (N).Nkind = N_Assignment_Statement or else NT (N).Nkind = N_Selected_Component or else NT (N).Nkind = N_Type_Conversion); - Set_Flag1 (N, Val); + Set_Flag3 (N, Val); end Set_Do_Discriminant_Check; procedure Set_Do_Division_Check @@ -5181,6 +5273,17 @@ package body Sinfo is Set_Flag16 (N, Val); end Set_Is_Controlling_Actual; + procedure Set_Is_Declaration_Level_Node + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Call_Marker + or else NT (N).Nkind = N_Function_Instantiation + or else NT (N).Nkind = N_Package_Instantiation + or else NT (N).Nkind = N_Procedure_Instantiation); + Set_Flag5 (N, Val); + end Set_Is_Declaration_Level_Node; + procedure Set_Is_Delayed_Aspect (N : Node_Id; Val : Boolean := True) is begin @@ -5200,6 +5303,14 @@ package body Sinfo is Set_Flag15 (N, Val); end Set_Is_Disabled; + procedure Set_Is_Dispatching_Call + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Call_Marker); + Set_Flag3 (N, Val); + end Set_Is_Dispatching_Call; + procedure Set_Is_Dynamic_Coextension (N : Node_Id; Val : Boolean := True) is begin @@ -5217,8 +5328,27 @@ package body Sinfo is Set_Flag1 (N, Val); end Set_Is_Effective_Use_Clause; + procedure Set_Is_Elaboration_Checks_OK_Node + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Assignment_Statement + or else NT (N).Nkind = N_Attribute_Reference + or else NT (N).Nkind = N_Call_Marker + or else NT (N).Nkind = N_Entry_Call_Statement + or else NT (N).Nkind = N_Expanded_Name + or else NT (N).Nkind = N_Function_Call + or else NT (N).Nkind = N_Function_Instantiation + or else NT (N).Nkind = N_Identifier + or else NT (N).Nkind = N_Package_Instantiation + or else NT (N).Nkind = N_Procedure_Call_Statement + or else NT (N).Nkind = N_Procedure_Instantiation + or else NT (N).Nkind = N_Requeue_Statement); + Set_Flag1 (N, Val); + end Set_Is_Elaboration_Checks_OK_Node; + procedure Set_Is_Elsif - (N : Node_Id; Val : Boolean := True) is + (N : Node_Id; Val : Boolean := True) is begin pragma Assert (False or else NT (N).Nkind = N_If_Expression); @@ -5307,6 +5437,25 @@ package body Sinfo is Set_Flag4 (N, Val); end Set_Is_Inherited_Pragma; + procedure Set_Is_Initialization_Block + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Block_Statement); + Set_Flag1 (N, Val); + end Set_Is_Initialization_Block; + + procedure Set_Is_Known_Guaranteed_ABE + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Call_Marker + or else NT (N).Nkind = N_Function_Instantiation + or else NT (N).Nkind = N_Package_Instantiation + or else NT (N).Nkind = N_Procedure_Instantiation); + Set_Flag18 (N, Val); + end Set_Is_Known_Guaranteed_ABE; + procedure Set_Is_Machine_Number (N : Node_Id; Val : Boolean := True) is begin @@ -5363,6 +5512,44 @@ package body Sinfo is Set_Flag4 (N, Val); end Set_Is_Qualified_Universal_Literal; + procedure Set_Is_Recorded_Scenario + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Call_Marker + or else NT (N).Nkind = N_Function_Instantiation + or else NT (N).Nkind = N_Package_Instantiation + or else NT (N).Nkind = N_Procedure_Instantiation); + Set_Flag6 (N, Val); + end Set_Is_Recorded_Scenario; + + procedure Set_Is_Source_Call + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Call_Marker); + Set_Flag4 (N, Val); + end Set_Is_Source_Call; + + procedure Set_Is_SPARK_Mode_On_Node + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Assignment_Statement + or else NT (N).Nkind = N_Attribute_Reference + or else NT (N).Nkind = N_Call_Marker + or else NT (N).Nkind = N_Entry_Call_Statement + or else NT (N).Nkind = N_Expanded_Name + or else NT (N).Nkind = N_Function_Call + or else NT (N).Nkind = N_Function_Instantiation + or else NT (N).Nkind = N_Identifier + or else NT (N).Nkind = N_Package_Instantiation + or else NT (N).Nkind = N_Procedure_Call_Statement + or else NT (N).Nkind = N_Procedure_Instantiation + or else NT (N).Nkind = N_Requeue_Statement); + Set_Flag2 (N, Val); + end Set_Is_SPARK_Mode_On_Node; + procedure Set_Is_Static_Coextension (N : Node_Id; Val : Boolean := True) is begin @@ -5750,15 +5937,6 @@ package body Sinfo is Set_Flag7 (N, Val); end Set_No_Ctrl_Actions; - procedure Set_No_Elaboration_Check - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Procedure_Call_Statement); - Set_Flag14 (N, Val); - end Set_No_Elaboration_Check; - procedure Set_No_Entities_Ref_In_Spec (N : Node_Id; Val : Boolean := True) is begin @@ -5790,7 +5968,7 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Function_Call); - Set_Flag1 (N, Val); + Set_Flag17 (N, Val); end Set_No_Side_Effect_Removal; procedure Set_No_Truncation @@ -6517,6 +6695,14 @@ package body Sinfo is Set_Flag15 (N, Val); end Set_Tagged_Present; + procedure Set_Target + (N : Node_Id; Val : Entity_Id) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Call_Marker); + Set_Node1 (N, Val); -- semantic field, no parent set + end Set_Target; + procedure Set_Target_Type (N : Node_Id; Val : Entity_Id) is begin @@ -6689,6 +6875,14 @@ package body Sinfo is Set_Elist2 (N, Val); end Set_Used_Operations; + procedure Set_Was_Attribute_Reference + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Subprogram_Body); + Set_Flag2 (N, Val); + end Set_Was_Attribute_Reference; + procedure Set_Was_Expression_Function (N : Node_Id; Val : Boolean := True) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 0c4dfdf391029..cf220e4e563ae 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -770,7 +770,7 @@ package Sinfo is -- The following flag fields appear in all nodes: -- Analyzed - -- This flag is used to indicate that a node (and all its children have + -- This flag is used to indicate that a node (and all its children) have -- been analyzed. It is used to avoid reanalysis of a node that has -- already been analyzed, both for efficiency and functional correctness -- reasons. @@ -845,15 +845,6 @@ package Sinfo is -- section describes the usage of the semantic fields, which are used to -- contain additional information determined during semantic analysis. - -- ABE_Is_Certain (Flag18-Sem) - -- This flag is set in an instantiation node or a call node is determined - -- to be sure to raise an ABE. This is used to trigger special handling - -- of such cases, particularly in the instantiation case where we avoid - -- instantiating the body if this flag is set. This flag is also present - -- in an N_Formal_Package_Declaration node since formal package - -- declarations are treated like instantiations, but it is always set to - -- False in this context. - -- Accept_Handler_Records (List5-Sem) -- This field is present only in an N_Accept_Alternative node. It is used -- to temporarily hold the exception handler records from an accept @@ -912,6 +903,10 @@ package Sinfo is -- known at compile time, this field points to an N_Range node with those -- bounds. Otherwise Empty. + -- Alloc_For_BIP_Return (Flag1-Sem) + -- Present in N_Allocator nodes. True if the allocator is one of those + -- generated for a build-in-place return statement. + -- All_Others (Flag11-Sem) -- Present in an N_Others_Choice node. This flag is set for an others -- exception where all exceptions are to be caught, even those that are @@ -1159,7 +1154,7 @@ package Sinfo is -- that an accessibility check is required for the parameter. It is -- not yet decided who takes care of this check (TBD ???). - -- Do_Discriminant_Check (Flag1-Sem) + -- Do_Discriminant_Check (Flag3-Sem) -- This flag is set on N_Selected_Component nodes to indicate that a -- discriminant check is required using the discriminant check routine -- associated with the selector. The actual check is generated by the @@ -1481,10 +1476,7 @@ package Sinfo is -- Generic_Parent (Node5-Sem) -- Generic_Parent is defined on declaration nodes that are instances. The -- value of Generic_Parent is the generic entity from which the instance - -- is obtained. Generic_Parent is also defined for the renaming - -- declarations and object declarations created for the actuals in an - -- instantiation. The generic parent of such a declaration is the - -- corresponding generic association in the Instantiation node. + -- is obtained. -- Generic_Parent_Type (Node4-Sem) -- Generic_Parent_Type is defined on Subtype_Declaration nodes for the @@ -1663,10 +1655,6 @@ package Sinfo is -- place in the various Analyze_xxx_In_Decl_Part routines which perform -- full analysis. The flag prevents the reanalysis of a delayed pragma. - -- Is_Expanded_Contract (Flag1-Sem) - -- Present in N_Contract nodes. Set if the contract has already undergone - -- expansion activities. - -- Is_Asynchronous_Call_Block (Flag7-Sem) -- A flag set in a Block_Statement node to indicate that it is the -- expansion of an asynchronous entry call. Such a block needs cleanup @@ -1701,6 +1689,12 @@ package Sinfo is -- a dispatching call. It is off in all other cases. See Sem_Disp for -- details of its use. + -- Is_Declaration_Level_Node (Flag5-Sem) + -- Present in call marker and instantiation nodes. Set when the constuct + -- appears within the declarations of a block statement, an entry body, + -- a subprogram body, or a task body. The flag aids the ABE Processing + -- phase to catch certain forms of guaranteed ABEs. + -- Is_Delayed_Aspect (Flag14-Sem) -- Present in N_Pragma and N_Attribute_Definition_Clause nodes which -- come from aspect specifications, where the evaluation of the aspect @@ -1715,6 +1709,10 @@ package Sinfo is -- If this flag is set, the aspect or policy is not analyzed for semantic -- correctness, so any expressions etc will not be marked as analyzed. + -- Is_Dispatching_Call (Flag3-Sem) + -- Present in call marker nodes. Set when the related call which prompted + -- the creation of the marker is dispatching. + -- Is_Dynamic_Coextension (Flag18-Sem) -- Present in allocator nodes, to indicate that this is an allocator -- for an access discriminant of a dynamically allocated object. The @@ -1725,6 +1723,15 @@ package Sinfo is -- Present in both N_Use_Type_Clause and N_Use_Package_Clause to indicate -- a use clause is "used" in the current source. + -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) + -- Present in nodes which represent an elaboration scenario. Those are + -- assignment statement, attribute reference, call marker, entry call + -- statement, expanded name, function call, identifier, instantiation, + -- procedure call statement, and requeue statement nodes. Set when the + -- node appears within a context which allows for the generation of + -- run-time ABE checks. This flag detemines whether the ABE Processing + -- phase generates conditional ABE checks and guaranteed ABE failures. + -- Is_Entry_Barrier_Function (Flag8-Sem) -- This flag is set on N_Subprogram_Declaration and N_Subprogram_Body -- nodes which emulate the barrier function of a protected entry body. @@ -1735,6 +1742,10 @@ package Sinfo is -- actuals to support a build-in-place style of call have been added to -- the call. + -- Is_Expanded_Contract (Flag1-Sem) + -- Present in N_Contract nodes. Set if the contract has already undergone + -- expansion activities. + -- Is_Finalization_Wrapper (Flag9-Sem) -- This flag is present in N_Block_Statement nodes. It is set when the -- block acts as a wrapper of a handled construct which has controlled @@ -1794,6 +1805,19 @@ package Sinfo is -- This flag is set in an N_Pragma node that appears in a N_Contract node -- to indicate that the pragma has been inherited from a parent context. + -- Is_Initialization_Block (Flag1-Sem) + -- Defined in block nodes. Set when the block statement was created by + -- the finalization machinery to wrap initialization statements. This + -- flag aids the ABE Processing phase to suppress the diagnostics of + -- finalization actions in initialization contexts. + + -- Is_Known_Guaranteed_ABE (Flag18-Sem) + -- Present in call markers and instantiations. Set when the elaboration + -- or evaluation of the scenario results in a guaranteed ABE. The flag + -- is used to suppress the instantiation of generic bodies because gigi + -- cannot handle certain forms of premature instantiation, as well as to + -- prevent the reexamination of the node by the ABE Processing phase. + -- Is_Machine_Number (Flag11-Sem) -- This flag is set in an N_Real_Literal node to indicate that the value -- is a machine number. This avoids some unnecessary cases of converting @@ -1839,6 +1863,25 @@ package Sinfo is -- the resolution of accidental overloading of binary or unary operators -- which may occur in instances. + -- Is_Recorded_Scenario (Flag6-Sem) + -- Present in call marker and instantiation nodes. Set when the scenario + -- was saved by the ABE Recording phase. This flag aids the ABE machinery + -- to keep its internal data up-to-date in case the node is transformed + -- by Atree.Rewrite. + + -- Is_Source_Call (Flag4-Sem) + -- Present in call marker nodes. Set when the related call came from + -- source. + + -- Is_SPARK_Mode_On_Node (Flag2-Sem) + -- Present in nodes which represent an elaboration scenario. Those are + -- assignment statement, attribute reference, call marker, entry call + -- statement, expanded name, function call, identifier, instantiation, + -- procedure call statement, and requeue statement nodes. Set when the + -- node appears within a context subject to SPARK_Mode On. This flag + -- determines when the SPARK model of elaboration be activated by the + -- ABE Processing phase. + -- Is_Static_Coextension (Flag14-Sem) -- Present in N_Allocator nodes. Set if the allocator is a coextension -- of an object allocated on the stack rather than the heap. @@ -2040,13 +2083,6 @@ package Sinfo is -- expansions where the generated assignments are initializations, not -- real assignments. - -- No_Elaboration_Check (Flag14-Sem) - -- Present in N_Function_Call and N_Procedure_Call_Statement. Indicates - -- that no elaboration check is needed on the call, because it appears in - -- the context of a local Suppress pragma. This is used on calls within - -- task bodies, where the actual elaboration checks are applied after - -- analysis, when the local scope stack is not present. - -- No_Entities_Ref_In_Spec (Flag8-Sem) -- Present in N_With_Clause nodes. Set if the with clause is on the -- package or subprogram spec where the main unit is the corresponding @@ -2069,7 +2105,7 @@ package Sinfo is -- It is used to indicate that processing for extended overflow checking -- modes is not required (this is used to prevent infinite recursion). - -- No_Side_Effect_Removal (Flag1-Sem) + -- No_Side_Effect_Removal (Flag17-Sem) -- Present in N_Function_Call nodes. Set when a function call does not -- require side effect removal. This attribute suppresses the generation -- of a temporary to capture the result of the function which eventually @@ -2281,6 +2317,10 @@ package Sinfo is -- of a FOR loop is known to be null, or is probably null (loop would -- only execute if invalid values are present). + -- Target (Node1-Sem) + -- Present in call marker nodes. References the entity of the entry, + -- operator, or subprogram invoked by the related call or requeue. + -- Target_Type (Node2-Sem) -- Used in an N_Validate_Unchecked_Conversion node to point to the target -- type entity for the unchecked conversion instantiation which gigi must @@ -2353,6 +2393,12 @@ package Sinfo is -- on exit from the scope of the use_type_clause, in particular in the -- case of Use_All_Type, when those operations several scopes. + -- Was_Attribute_Reference (Flag2-Sem) + -- Present in N_Subprogram_Body. Set to True if the original source is an + -- attribute reference which is an actual in a generic instantiation. The + -- instantiation prologue renames these attributes, and expansion later + -- converts them into subprogram bodies. + -- Was_Expression_Function (Flag18-Sem) -- Present in N_Subprogram_Body. True if the original source had an -- N_Expression_Function, which was converted to the N_Subprogram_Body @@ -2478,9 +2524,11 @@ package Sinfo is -- Entity (Node4-Sem) -- Associated_Node (Node4-Sem) -- Original_Discriminant (Node2-Sem) + -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) + -- Is_SPARK_Mode_On_Node (Flag2-Sem) + -- Has_Private_View (Flag11-Sem) (set in generic units) -- Redundant_Use (Flag13-Sem) -- Atomic_Sync_Required (Flag14-Sem) - -- Has_Private_View (Flag11-Sem) (set in generic units) -- plus fields for expression -------------------------- @@ -2625,20 +2673,20 @@ package Sinfo is -- Corresponding_Aspect (Node3-Sem) (set to Empty if not present) -- Pragma_Identifier (Node4) -- Next_Rep_Item (Node5-Sem) - -- Class_Present (Flag6) set if from Aspect with 'Class - -- From_Aspect_Specification (Flag13-Sem) - -- Import_Interface_Present (Flag16-Sem) + -- Is_Generic_Contract_Pragma (Flag2-Sem) + -- Is_Checked_Ghost_Pragma (Flag3-Sem) + -- Is_Inherited_Pragma (Flag4-Sem) -- Is_Analyzed_Pragma (Flag5-Sem) + -- Class_Present (Flag6) set if from Aspect with 'Class + -- Uneval_Old_Accept (Flag7-Sem) + -- Is_Ignored_Ghost_Pragma (Flag8-Sem) + -- Is_Ignored (Flag9-Sem) -- Is_Checked (Flag11-Sem) - -- Is_Checked_Ghost_Pragma (Flag3-Sem) + -- From_Aspect_Specification (Flag13-Sem) -- Is_Delayed_Aspect (Flag14-Sem) -- Is_Disabled (Flag15-Sem) - -- Is_Generic_Contract_Pragma (Flag2-Sem) - -- Is_Ignored (Flag9-Sem) - -- Is_Ignored_Ghost_Pragma (Flag8-Sem) - -- Is_Inherited_Pragma (Flag4-Sem) + -- Import_Interface_Present (Flag16-Sem) -- Split_PPC (Flag17) set if corresponding aspect had Split_PPC set - -- Uneval_Old_Accept (Flag7-Sem) -- Uneval_Old_Warn (Flag18-Sem) -- Note: we should have a section on what pragmas are passed on to @@ -3780,8 +3828,8 @@ package Sinfo is -- Sloc points to ALL -- Prefix (Node3) -- Actual_Designated_Subtype (Node4-Sem) - -- Atomic_Sync_Required (Flag14-Sem) -- Has_Dereference_Action (Flag13-Sem) + -- Atomic_Sync_Required (Flag14-Sem) -- plus fields for expression ------------------------------- @@ -3847,10 +3895,10 @@ package Sinfo is -- Prefix (Node3) -- Selector_Name (Node2) -- Associated_Node (Node4-Sem) - -- Do_Discriminant_Check (Flag1-Sem) + -- Do_Discriminant_Check (Flag3-Sem) -- Is_In_Discriminant_Check (Flag11-Sem) - -- Is_Prefixed_Call (Flag17-Sem) -- Atomic_Sync_Required (Flag14-Sem) + -- Is_Prefixed_Call (Flag17-Sem) -- plus fields for expression -------------------------- @@ -3943,10 +3991,11 @@ package Sinfo is -- Expressions (List1) (set to No_List if no associated expressions) -- Entity (Node4-Sem) used if the attribute yields a type -- Associated_Node (Node4-Sem) - -- Do_Overflow_Check (Flag17-Sem) + -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) + -- Is_SPARK_Mode_On_Node (Flag2-Sem) -- Header_Size_Added (Flag11-Sem) - -- Must_Be_Byte_Aligned (Flag14-Sem) -- Redundant_Use (Flag13-Sem) + -- Must_Be_Byte_Aligned (Flag14-Sem) -- plus fields for expression -- Note: in Modify_Tree_For_C mode, Max and Min attributes are expanded @@ -4137,7 +4186,7 @@ package Sinfo is ---------------------------------- -- NAMED_ARRAY_AGGREGATE ::= - -- | (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION}) + -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION}) -- See Record_Aggregate (4.3.1) for node structure @@ -4674,7 +4723,7 @@ package Sinfo is -- Sloc points to first token of subtype mark -- Subtype_Mark (Node4) -- Expression (Node3) - -- Do_Discriminant_Check (Flag1-Sem) + -- Do_Discriminant_Check (Flag3-Sem) -- Do_Length_Check (Flag4-Sem) -- Float_Truncate (Flag11-Sem) -- Do_Tag_Check (Flag13-Sem) @@ -4728,6 +4777,7 @@ package Sinfo is -- Subpool_Handle_Name (Node4) (set to Empty if not present) -- Storage_Pool (Node1-Sem) -- Procedure_To_Call (Node2-Sem) + -- Alloc_For_BIP_Return (Flag1-Sem) -- Null_Exclusion_Present (Flag11) -- No_Initialization (Flag13-Sem) -- Is_Static_Coextension (Flag14-Sem) @@ -4839,13 +4889,15 @@ package Sinfo is -- Sloc points to := -- Name (Node2) -- Expression (Node3) - -- Do_Discriminant_Check (Flag1-Sem) - -- Do_Tag_Check (Flag13-Sem) + -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) + -- Is_SPARK_Mode_On_Node (Flag2-Sem) + -- Do_Discriminant_Check (Flag3-Sem) -- Do_Length_Check (Flag4-Sem) -- Forwards_OK (Flag5-Sem) -- Backwards_OK (Flag6-Sem) -- No_Ctrl_Actions (Flag7-Sem) -- Has_Target_Names (Flag8-Sem) + -- Do_Tag_Check (Flag13-Sem) -- Componentwise_Assignment (Flag14-Sem) -- Suppress_Assignment_Checks (Flag18-Sem) @@ -5101,15 +5153,16 @@ package Sinfo is -- Identifier (Node1) block direct name (set to Empty if not present) -- Declarations (List2) (set to No_List if no DECLARE part) -- Handled_Statement_Sequence (Node4) - -- Cleanup_Actions (List5-Sem) - -- Is_Abort_Block (Flag4-Sem) - -- Is_Task_Master (Flag5-Sem) -- Activation_Chain_Entity (Node3-Sem) + -- Cleanup_Actions (List5-Sem) -- Has_Created_Identifier (Flag15) - -- Is_Task_Allocation_Block (Flag6) -- Is_Asynchronous_Call_Block (Flag7) + -- Is_Task_Allocation_Block (Flag6) -- Exception_Junk (Flag8-Sem) + -- Is_Abort_Block (Flag4-Sem) -- Is_Finalization_Wrapper (Flag9-Sem) + -- Is_Initialization_Block (Flag1-Sem) + -- Is_Task_Master (Flag5-Sem) ------------------------- -- 5.7 Exit Statement -- @@ -5273,8 +5326,8 @@ package Sinfo is -- symbol turns out to be a normal string after all. -- Entity (Node4-Sem) -- Associated_Node (Node4-Sem) - -- Has_Private_View (Flag11-Sem) set in generic units. -- Etype (Node5-Sem) + -- Has_Private_View (Flag11-Sem) set in generic units -- Note: the Strval field may be set to No_String for generated -- operator symbols that are known not to be string literals @@ -5399,6 +5452,7 @@ package Sinfo is -- Is_Protected_Subprogram_Body (Flag7-Sem) -- Is_Task_Body_Procedure (Flag1-Sem) -- Is_Task_Master (Flag5-Sem) + -- Was_Attribute_Reference (Flag2-Sem) -- Was_Expression_Function (Flag18-Sem) -- Was_Originally_Stub (Flag13-Sem) @@ -5422,9 +5476,9 @@ package Sinfo is -- actual parameter part) -- First_Named_Actual (Node4-Sem) -- Controlling_Argument (Node1-Sem) (set to Empty if not dispatching) + -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) + -- Is_SPARK_Mode_On_Node (Flag2-Sem) -- Do_Tag_Check (Flag13-Sem) - -- No_Elaboration_Check (Flag14-Sem) - -- ABE_Is_Certain (Flag18-Sem) -- plus fields for expression -- If any IN parameter requires a range check, then the corresponding @@ -5452,11 +5506,11 @@ package Sinfo is -- actual parameter part) -- First_Named_Actual (Node4-Sem) -- Controlling_Argument (Node1-Sem) (set to Empty if not dispatching) - -- No_Side_Effect_Removal (Flag1-Sem) + -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) + -- Is_SPARK_Mode_On_Node (Flag2-Sem) -- Is_Expanded_Build_In_Place_Call (Flag11-Sem) -- Do_Tag_Check (Flag13-Sem) - -- No_Elaboration_Check (Flag14-Sem) - -- ABE_Is_Certain (Flag18-Sem) + -- No_Side_Effect_Removal (Flag17-Sem) -- plus fields for expression -------------------------------- @@ -6165,6 +6219,8 @@ package Sinfo is -- Parameter_Associations (List3) (set to No_List if no -- actual parameter part) -- First_Named_Actual (Node4-Sem) + -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) + -- Is_SPARK_Mode_On_Node (Flag2-Sem) ------------------------------ -- 9.5.4 Requeue Statement -- @@ -6180,6 +6236,8 @@ package Sinfo is -- Sloc points to REQUEUE -- Name (Node2) -- Abort_Present (Flag15) + -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) + -- Is_SPARK_Mode_On_Node (Flag2-Sem) -------------------------- -- 9.6 Delay Statement -- @@ -6975,7 +7033,11 @@ package Sinfo is -- generic actual part) -- Parent_Spec (Node4-Sem) -- Instance_Spec (Node5-Sem) - -- ABE_Is_Certain (Flag18-Sem) + -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) + -- Is_SPARK_Mode_On_Node (Flag2-Sem) + -- Is_Declaration_Level_Node (Flag5-Sem) + -- Is_Recorded_Scenario (Flag6-Sem) + -- Is_Known_Guaranteed_ABE (Flag18-Sem) -- N_Procedure_Instantiation -- Sloc points to PROCEDURE @@ -6985,9 +7047,13 @@ package Sinfo is -- Generic_Associations (List3) (set to No_List if no -- generic actual part) -- Instance_Spec (Node5-Sem) + -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) + -- Is_SPARK_Mode_On_Node (Flag2-Sem) + -- Is_Declaration_Level_Node (Flag5-Sem) + -- Is_Recorded_Scenario (Flag6-Sem) -- Must_Override (Flag14) set if overriding indicator present -- Must_Not_Override (Flag15) set if not_overriding indicator present - -- ABE_Is_Certain (Flag18-Sem) + -- Is_Known_Guaranteed_ABE (Flag18-Sem) -- N_Function_Instantiation -- Sloc points to FUNCTION @@ -6997,9 +7063,13 @@ package Sinfo is -- generic actual part) -- Parent_Spec (Node4-Sem) -- Instance_Spec (Node5-Sem) + -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) + -- Is_SPARK_Mode_On_Node (Flag2-Sem) + -- Is_Declaration_Level_Node (Flag5-Sem) + -- Is_Recorded_Scenario (Flag6-Sem) -- Must_Override (Flag14) set if overriding indicator present -- Must_Not_Override (Flag15) set if not_overriding indicator present - -- ABE_Is_Certain (Flag18-Sem) + -- Is_Known_Guaranteed_ABE (Flag18-Sem) -- Note: overriding indicator is an Ada 2005 feature @@ -7312,7 +7382,6 @@ package Sinfo is -- empty generic actual part) -- Box_Present (Flag15) -- Instance_Spec (Node5-Sem) - -- ABE_Is_Certain (Flag18-Sem) -------------------------------------- -- 12.7 Formal Package Actual Part -- @@ -7722,6 +7791,42 @@ package Sinfo is -- reconstructed tree printed by Sprint, and the node descriptions here -- show this syntax. + ----------------- + -- Call_Marker -- + ----------------- + + -- This node is created during the analysis/resolution of entry calls, + -- requeues, and subprogram calls. It performs several functions: + + -- * Call markers provide a uniform model for handling calls by the + -- ABE mechanism, regardless of whether expansion took place. + + -- * The call marker captures the target of the related call along + -- with other attributes which are either unavailabe or expensive + -- to recompute once analysis, resolution, and expansion are over. + + -- * The call marker aids the ABE Processing phase by signaling the + -- presence of a call in case the original call was transformed by + -- expansion. + + -- * The call marker acts as a reference point for the insertion of + -- run-time conditional ABE checks or guaranteed ABE failures. + + -- Sprint syntax: #target# + + -- The Sprint syntax shown above is not enabled by default + + -- N_Call_Marker + -- Sloc points to Sloc of original call + -- Target (Node1-Sem) + -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) + -- Is_SPARK_Mode_On_Node (Flag2-Sem) + -- Is_Dispatching_Call (Flag3-Sem) + -- Is_Source_Call (Flag4-Sem) + -- Is_Declaration_Level_Node (Flag5-Sem) + -- Is_Recorded_Scenario (Flag6-Sem) + -- Is_Known_Guaranteed_ABE (Flag18-Sem) + ------------------------ -- Compound Statement -- ------------------------ @@ -7737,7 +7842,7 @@ package Sinfo is -- The required semantics is that the set of actions is executed in -- the order in which it appears, as though they appeared by themselves - -- in the enclosing list of declarations of statements. Unlike what + -- in the enclosing list of declarations or statements. Unlike what -- happens when using an N_Block_Statement, no new scope is introduced. -- Note: for the time being, this is used only as a transient @@ -7851,7 +7956,9 @@ package Sinfo is -- Selector_Name (Node2) -- Entity (Node4-Sem) -- Associated_Node (Node4-Sem) - -- Has_Private_View (Flag11-Sem) set in generic units. + -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) + -- Is_SPARK_Mode_On_Node (Flag2-Sem) + -- Has_Private_View (Flag11-Sem) set in generic units -- Redundant_Use (Flag13-Sem) -- Atomic_Sync_Required (Flag14-Sem) -- plus fields for expression @@ -8352,8 +8459,8 @@ package Sinfo is -- Empty -- ----------- - -- Used as the contents of the Nkind field of the dummy Empty node - -- and in some other situations to indicate an uninitialized value. + -- Used as the contents of the Nkind field of the dummy Empty node and in + -- some other situations to indicate an uninitialized value. -- N_Empty -- Chars (Name1) is set to No_Name @@ -8709,6 +8816,7 @@ package Sinfo is N_Access_Definition, N_Access_To_Object_Definition, N_Aspect_Specification, + N_Call_Marker, N_Case_Expression_Alternative, N_Case_Statement_Alternative, N_Compilation_Unit, @@ -8977,9 +9085,6 @@ package Sinfo is -- these routines check that they are being applied to an appropriate -- node, as well as checking that the node is in range. - function ABE_Is_Certain - (N : Node_Id) return Boolean; -- Flag18 - function Abort_Present (N : Node_Id) return Boolean; -- Flag15 @@ -9025,6 +9130,9 @@ package Sinfo is function Aliased_Present (N : Node_Id) return Boolean; -- Flag4 + function Alloc_For_BIP_Return + (N : Node_Id) return Boolean; -- Flag1 + function All_Others (N : Node_Id) return Boolean; -- Flag11 @@ -9251,7 +9359,7 @@ package Sinfo is (N : Node_Id) return Boolean; -- Flag13 function Do_Discriminant_Check - (N : Node_Id) return Boolean; -- Flag1 + (N : Node_Id) return Boolean; -- Flag3 function Do_Division_Check (N : Node_Id) return Boolean; -- Flag13 @@ -9544,18 +9652,27 @@ package Sinfo is function Is_Controlling_Actual (N : Node_Id) return Boolean; -- Flag16 + function Is_Declaration_Level_Node + (N : Node_Id) return Boolean; -- Flag5 + function Is_Delayed_Aspect (N : Node_Id) return Boolean; -- Flag14 function Is_Disabled (N : Node_Id) return Boolean; -- Flag15 + function Is_Dispatching_Call + (N : Node_Id) return Boolean; -- Flag3 + function Is_Dynamic_Coextension (N : Node_Id) return Boolean; -- Flag18 function Is_Effective_Use_Clause (N : Node_Id) return Boolean; -- Flag1 + function Is_Elaboration_Checks_OK_Node + (N : Node_Id) return Boolean; -- Flag1 + function Is_Elsif (N : Node_Id) return Boolean; -- Flag13 @@ -9589,6 +9706,12 @@ package Sinfo is function Is_Inherited_Pragma (N : Node_Id) return Boolean; -- Flag4 + function Is_Initialization_Block + (N : Node_Id) return Boolean; -- Flag1 + + function Is_Known_Guaranteed_ABE + (N : Node_Id) return Boolean; -- Flag18 + function Is_Machine_Number (N : Node_Id) return Boolean; -- Flag11 @@ -9610,6 +9733,15 @@ package Sinfo is function Is_Qualified_Universal_Literal (N : Node_Id) return Boolean; -- Flag4 + function Is_Recorded_Scenario + (N : Node_Id) return Boolean; -- Flag6 + + function Is_Source_Call + (N : Node_Id) return Boolean; -- Flag4 + + function Is_SPARK_Mode_On_Node + (N : Node_Id) return Boolean; -- Flag2 + function Is_Static_Coextension (N : Node_Id) return Boolean; -- Flag14 @@ -9727,9 +9859,6 @@ package Sinfo is function No_Ctrl_Actions (N : Node_Id) return Boolean; -- Flag7 - function No_Elaboration_Check - (N : Node_Id) return Boolean; -- Flag14 - function No_Entities_Ref_In_Spec (N : Node_Id) return Boolean; -- Flag8 @@ -9740,7 +9869,7 @@ package Sinfo is (N : Node_Id) return Boolean; -- Flag17 function No_Side_Effect_Removal - (N : Node_Id) return Boolean; -- Flag1 + (N : Node_Id) return Boolean; -- Flag17 function No_Truncation (N : Node_Id) return Boolean; -- Flag17 @@ -9961,6 +10090,9 @@ package Sinfo is function Tagged_Present (N : Node_Id) return Boolean; -- Flag15 + function Target + (N : Node_Id) return Entity_Id; -- Node1 + function Target_Type (N : Node_Id) return Entity_Id; -- Node2 @@ -10021,6 +10153,9 @@ package Sinfo is function Used_Operations (N : Node_Id) return Elist_Id; -- Elist2 + function Was_Attribute_Reference + (N : Node_Id) return Boolean; -- Flag2 + function Was_Expression_Function (N : Node_Id) return Boolean; -- Flag18 @@ -10042,9 +10177,6 @@ package Sinfo is -- tree pointers (List1-4), the parent pointer of the Val node is set to -- point back to node N. This automates the setting of the parent pointer. - procedure Set_ABE_Is_Certain - (N : Node_Id; Val : Boolean := True); -- Flag18 - procedure Set_Abort_Present (N : Node_Id; Val : Boolean := True); -- Flag15 @@ -10090,6 +10222,9 @@ package Sinfo is procedure Set_Aliased_Present (N : Node_Id; Val : Boolean := True); -- Flag4 + procedure Set_Alloc_For_BIP_Return + (N : Node_Id; Val : Boolean := True); -- Flag1 + procedure Set_All_Others (N : Node_Id; Val : Boolean := True); -- Flag11 @@ -10316,7 +10451,7 @@ package Sinfo is (N : Node_Id; Val : Boolean := True); -- Flag13 procedure Set_Do_Discriminant_Check - (N : Node_Id; Val : Boolean := True); -- Flag1 + (N : Node_Id; Val : Boolean := True); -- Flag3 procedure Set_Do_Division_Check (N : Node_Id; Val : Boolean := True); -- Flag13 @@ -10606,18 +10741,27 @@ package Sinfo is procedure Set_Is_Controlling_Actual (N : Node_Id; Val : Boolean := True); -- Flag16 + procedure Set_Is_Declaration_Level_Node + (N : Node_Id; Val : Boolean := True); -- Flag5 + procedure Set_Is_Delayed_Aspect (N : Node_Id; Val : Boolean := True); -- Flag14 procedure Set_Is_Disabled (N : Node_Id; Val : Boolean := True); -- Flag15 + procedure Set_Is_Dispatching_Call + (N : Node_Id; Val : Boolean := True); -- Flag3 + procedure Set_Is_Dynamic_Coextension (N : Node_Id; Val : Boolean := True); -- Flag18 procedure Set_Is_Effective_Use_Clause (N : Node_Id; Val : Boolean := True); -- Flag1 + procedure Set_Is_Elaboration_Checks_OK_Node + (N : Node_Id; Val : Boolean := True); -- Flag1 + procedure Set_Is_Elsif (N : Node_Id; Val : Boolean := True); -- Flag13 @@ -10651,6 +10795,12 @@ package Sinfo is procedure Set_Is_Inherited_Pragma (N : Node_Id; Val : Boolean := True); -- Flag4 + procedure Set_Is_Initialization_Block + (N : Node_Id; Val : Boolean := True); -- Flag1 + + procedure Set_Is_Known_Guaranteed_ABE + (N : Node_Id; Val : Boolean := True); -- Flag18 + procedure Set_Is_Machine_Number (N : Node_Id; Val : Boolean := True); -- Flag11 @@ -10672,6 +10822,15 @@ package Sinfo is procedure Set_Is_Qualified_Universal_Literal (N : Node_Id; Val : Boolean := True); -- Flag4 + procedure Set_Is_Recorded_Scenario + (N : Node_Id; Val : Boolean := True); -- Flag6 + + procedure Set_Is_Source_Call + (N : Node_Id; Val : Boolean := True); -- Flag4 + + procedure Set_Is_SPARK_Mode_On_Node + (N : Node_Id; Val : Boolean := True); -- Flag2 + procedure Set_Is_Static_Coextension (N : Node_Id; Val : Boolean := True); -- Flag14 @@ -10789,9 +10948,6 @@ package Sinfo is procedure Set_No_Ctrl_Actions (N : Node_Id; Val : Boolean := True); -- Flag7 - procedure Set_No_Elaboration_Check - (N : Node_Id; Val : Boolean := True); -- Flag14 - procedure Set_No_Entities_Ref_In_Spec (N : Node_Id; Val : Boolean := True); -- Flag8 @@ -10802,7 +10958,7 @@ package Sinfo is (N : Node_Id; Val : Boolean := True); -- Flag17 procedure Set_No_Side_Effect_Removal - (N : Node_Id; Val : Boolean := True); -- Flag1 + (N : Node_Id; Val : Boolean := True); -- Flag17 procedure Set_No_Truncation (N : Node_Id; Val : Boolean := True); -- Flag17 @@ -11023,6 +11179,9 @@ package Sinfo is procedure Set_Tagged_Present (N : Node_Id; Val : Boolean := True); -- Flag15 + procedure Set_Target + (N : Node_Id; Val : Entity_Id); -- Node1 + procedure Set_Target_Type (N : Node_Id; Val : Entity_Id); -- Node2 @@ -11083,6 +11242,9 @@ package Sinfo is procedure Set_Used_Operations (N : Node_Id; Val : Elist_Id); -- Elist2 + procedure Set_Was_Attribute_Reference + (N : Node_Id; Val : Boolean := True); -- Flag2 + procedure Set_Was_Expression_Function (N : Node_Id; Val : Boolean := True); -- Flag18 @@ -12854,6 +13016,13 @@ package Sinfo is 4 => False, -- SCIL_Entity (Node4-Sem) 5 => False), -- SCIL_Tag_Value (Node5-Sem) + N_Call_Marker => + (1 => False, -- Target (Node1-Sem) + 2 => False, -- unused + 3 => False, -- unused + 4 => False, -- unused + 5 => False), -- unused + -- Entries for Empty, Error and Unused. Even thought these have a Chars -- field for debugging purposes, they are not really syntactic fields, so -- we mark all fields as unused. @@ -12890,7 +13059,6 @@ package Sinfo is -- Inline Pragmas -- -------------------- - pragma Inline (ABE_Is_Certain); pragma Inline (Abort_Present); pragma Inline (Abortable_Part); pragma Inline (Abstract_Present); @@ -12906,6 +13074,7 @@ package Sinfo is pragma Inline (Address_Warning_Posted); pragma Inline (Aggregate_Bounds); pragma Inline (Aliased_Present); + pragma Inline (Alloc_For_BIP_Return); pragma Inline (All_Others); pragma Inline (All_Present); pragma Inline (Alternatives); @@ -12988,10 +13157,10 @@ package Sinfo is pragma Inline (Do_Range_Check); pragma Inline (Do_Storage_Check); pragma Inline (Do_Tag_Check); - pragma Inline (Elaborate_Present); pragma Inline (Elaborate_All_Desirable); pragma Inline (Elaborate_All_Present); pragma Inline (Elaborate_Desirable); + pragma Inline (Elaborate_Present); pragma Inline (Else_Actions); pragma Inline (Else_Statements); pragma Inline (Elsif_Parts); @@ -13080,10 +13249,13 @@ package Sinfo is pragma Inline (Is_Component_Left_Opnd); pragma Inline (Is_Component_Right_Opnd); pragma Inline (Is_Controlling_Actual); + pragma Inline (Is_Declaration_Level_Node); pragma Inline (Is_Delayed_Aspect); pragma Inline (Is_Disabled); + pragma Inline (Is_Dispatching_Call); pragma Inline (Is_Dynamic_Coextension); pragma Inline (Is_Effective_Use_Clause); + pragma Inline (Is_Elaboration_Checks_OK_Node); pragma Inline (Is_Elsif); pragma Inline (Is_Entry_Barrier_Function); pragma Inline (Is_Expanded_Build_In_Place_Call); @@ -13095,6 +13267,8 @@ package Sinfo is pragma Inline (Is_Ignored_Ghost_Pragma); pragma Inline (Is_In_Discriminant_Check); pragma Inline (Is_Inherited_Pragma); + pragma Inline (Is_Initialization_Block); + pragma Inline (Is_Known_Guaranteed_ABE); pragma Inline (Is_Machine_Number); pragma Inline (Is_Null_Loop); pragma Inline (Is_Overloaded); @@ -13102,6 +13276,9 @@ package Sinfo is pragma Inline (Is_Prefixed_Call); pragma Inline (Is_Protected_Subprogram_Body); pragma Inline (Is_Qualified_Universal_Literal); + pragma Inline (Is_Recorded_Scenario); + pragma Inline (Is_Source_Call); + pragma Inline (Is_SPARK_Mode_On_Node); pragma Inline (Is_Static_Coextension); pragma Inline (Is_Static_Expression); pragma Inline (Is_Subprogram_Descriptor); @@ -13140,7 +13317,6 @@ package Sinfo is pragma Inline (Next_Rep_Item); pragma Inline (Next_Use_Clause); pragma Inline (No_Ctrl_Actions); - pragma Inline (No_Elaboration_Check); pragma Inline (No_Entities_Ref_In_Spec); pragma Inline (No_Initialization); pragma Inline (No_Minimize_Eliminate); @@ -13218,6 +13394,7 @@ package Sinfo is pragma Inline (Suppress_Loop_Warnings); pragma Inline (Synchronized_Present); pragma Inline (Tagged_Present); + pragma Inline (Target); pragma Inline (Target_Type); pragma Inline (Task_Definition); pragma Inline (Task_Present); @@ -13238,11 +13415,11 @@ package Sinfo is pragma Inline (Variants); pragma Inline (Visible_Declarations); pragma Inline (Used_Operations); + pragma Inline (Was_Attribute_Reference); pragma Inline (Was_Expression_Function); pragma Inline (Was_Originally_Stub); pragma Inline (Withed_Body); - pragma Inline (Set_ABE_Is_Certain); pragma Inline (Set_Abort_Present); pragma Inline (Set_Abortable_Part); pragma Inline (Set_Abstract_Present); @@ -13258,6 +13435,7 @@ package Sinfo is pragma Inline (Set_Address_Warning_Posted); pragma Inline (Set_Aggregate_Bounds); pragma Inline (Set_Aliased_Present); + pragma Inline (Set_Alloc_For_BIP_Return); pragma Inline (Set_All_Others); pragma Inline (Set_All_Present); pragma Inline (Set_Alternatives); @@ -13429,10 +13607,13 @@ package Sinfo is pragma Inline (Set_Is_Component_Left_Opnd); pragma Inline (Set_Is_Component_Right_Opnd); pragma Inline (Set_Is_Controlling_Actual); + pragma Inline (Set_Is_Declaration_Level_Node); pragma Inline (Set_Is_Delayed_Aspect); pragma Inline (Set_Is_Disabled); + pragma Inline (Set_Is_Dispatching_Call); pragma Inline (Set_Is_Dynamic_Coextension); pragma Inline (Set_Is_Effective_Use_Clause); + pragma Inline (Set_Is_Elaboration_Checks_OK_Node); pragma Inline (Set_Is_Elsif); pragma Inline (Set_Is_Entry_Barrier_Function); pragma Inline (Set_Is_Expanded_Build_In_Place_Call); @@ -13444,6 +13625,8 @@ package Sinfo is pragma Inline (Set_Is_Ignored_Ghost_Pragma); pragma Inline (Set_Is_In_Discriminant_Check); pragma Inline (Set_Is_Inherited_Pragma); + pragma Inline (Set_Is_Initialization_Block); + pragma Inline (Set_Is_Known_Guaranteed_ABE); pragma Inline (Set_Is_Machine_Number); pragma Inline (Set_Is_Null_Loop); pragma Inline (Set_Is_Overloaded); @@ -13451,6 +13634,9 @@ package Sinfo is pragma Inline (Set_Is_Prefixed_Call); pragma Inline (Set_Is_Protected_Subprogram_Body); pragma Inline (Set_Is_Qualified_Universal_Literal); + pragma Inline (Set_Is_Recorded_Scenario); + pragma Inline (Set_Is_Source_Call); + pragma Inline (Set_Is_SPARK_Mode_On_Node); pragma Inline (Set_Is_Static_Coextension); pragma Inline (Set_Is_Static_Expression); pragma Inline (Set_Is_Subprogram_Descriptor); @@ -13490,7 +13676,6 @@ package Sinfo is pragma Inline (Set_Next_Rep_Item); pragma Inline (Set_Next_Use_Clause); pragma Inline (Set_No_Ctrl_Actions); - pragma Inline (Set_No_Elaboration_Check); pragma Inline (Set_No_Entities_Ref_In_Spec); pragma Inline (Set_No_Initialization); pragma Inline (Set_No_Minimize_Eliminate); @@ -13567,6 +13752,7 @@ package Sinfo is pragma Inline (Set_Synchronized_Present); pragma Inline (Set_TSS_Elist); pragma Inline (Set_Tagged_Present); + pragma Inline (Set_Target); pragma Inline (Set_Target_Type); pragma Inline (Set_Task_Definition); pragma Inline (Set_Task_Present); @@ -13586,6 +13772,7 @@ package Sinfo is pragma Inline (Set_Variant_Part); pragma Inline (Set_Variants); pragma Inline (Set_Visible_Declarations); + pragma Inline (Set_Was_Attribute_Reference); pragma Inline (Set_Was_Expression_Function); pragma Inline (Set_Was_Originally_Stub); pragma Inline (Set_Withed_Body); diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb index 4806123865909..7f4b7861e1526 100644 --- a/gcc/ada/sinput-l.adb +++ b/gcc/ada/sinput-l.adb @@ -355,10 +355,10 @@ package body Sinput.L is T : Osint.File_Type) return Source_File_Index is FD : File_Descriptor; + Hi : Source_Ptr; + Lo : Source_Ptr; Src : Source_Buffer_Ptr; X : Source_File_Index; - Lo : Source_Ptr; - Hi : Source_Ptr; Preprocessing_Needed : Boolean := False; diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index bde59b131ddd1..ecbe83cdd88ad 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -755,6 +755,8 @@ private pragma Inline (Num_Source_Files); pragma Inline (Num_Source_Lines); + pragma Inline (Line_Start); + No_Instance_Id : constant Instance_Id := 0; ------------------------- diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 0052409b55253..ac2dcd8a14de1 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -1225,6 +1225,15 @@ package body Sprint is Write_Char (';'); + when N_Call_Marker => + null; + + -- Enable the following code for debugging purposes only + + -- Write_Indent_Str ("#"); + -- Write_Id (Target (Node)); + -- Write_Char ('#'); + when N_Case_Expression => declare Has_Parens : constant Boolean := Paren_Count (Node) > 0; diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb index 52a72e4de4031..61fe4404b7d0e 100644 --- a/gcc/ada/switch-b.adb +++ b/gcc/ada/switch-b.adb @@ -391,6 +391,18 @@ package body Switch.B is Ptr := Ptr + 1; Quiet_Output := True; + -- Processing for Q switch + + when 'Q' => + if Ptr = Max then + Bad_Switch (Switch_Chars); + end if; + + Ptr := Ptr + 1; + Scan_Pos + (Switch_Chars, Max, Ptr, + Quantity_Of_Default_Size_Sec_Stacks, C); + -- Processing for r switch when 'r' => diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index cd6b2006e220a..5ad10e348a5fa 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -548,7 +548,6 @@ package body Switch.C is Warn_On_Bad_Fixed_Value := True; -- -gnatwb Warn_On_Biased_Representation := True; -- -gnatw.b Warn_On_Export_Import := True; -- -gnatwx - Warn_On_Modified_Unread := True; -- -gnatwm Warn_On_No_Value_Assigned := True; -- -gnatwv Warn_On_Object_Renames_Function := True; -- -gnatw.r Warn_On_Overlap := True; -- -gnatw.i diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index 725bb4c2867eb..63b124ab72359 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -158,8 +158,8 @@ package body Targparm is Set_NUP : Set_NUP_Type := null) is FD : File_Descriptor; - Text : Source_Buffer_Ptr; Hi : Source_Ptr; + Text : Source_Buffer_Ptr; begin if Parameters_Obtained then @@ -173,11 +173,13 @@ package body Targparm is if Null_Source_Buffer_Ptr (Text) then Write_Line ("fatal error, run-time library not installed correctly"); + if FD = Null_FD then Write_Line ("cannot locate file system.ads"); else Write_Line ("no read access for file system.ads"); end if; + raise Unrecoverable_Error; end if; diff --git a/gcc/ada/widechar.ads b/gcc/ada/widechar.ads index a6e8293ae5dec..3d2f917097673 100644 --- a/gcc/ada/widechar.ads +++ b/gcc/ada/widechar.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -95,4 +95,7 @@ package Widechar is P : Source_Ptr) return Boolean; -- Determines if S (P) is the start of a wide character sequence +private + pragma Inline (Is_Start_Of_Wide_Char); + end Widechar; diff --git a/gcc/alias.c b/gcc/alias.c index e4865729a9b56..cb57c6a10ff12 100644 --- a/gcc/alias.c +++ b/gcc/alias.c @@ -2047,13 +2047,15 @@ compare_base_decls (tree base1, tree base2) return 1; /* If we have two register decls with register specification we - cannot decide unless their assembler name is the same. */ + cannot decide unless their assembler names are the same. */ if (DECL_REGISTER (base1) && DECL_REGISTER (base2) + && HAS_DECL_ASSEMBLER_NAME_P (base1) + && HAS_DECL_ASSEMBLER_NAME_P (base2) && DECL_ASSEMBLER_NAME_SET_P (base1) && DECL_ASSEMBLER_NAME_SET_P (base2)) { - if (DECL_ASSEMBLER_NAME (base1) == DECL_ASSEMBLER_NAME (base2)) + if (DECL_ASSEMBLER_NAME_RAW (base1) == DECL_ASSEMBLER_NAME_RAW (base2)) return 1; return -1; } diff --git a/gcc/asan.c b/gcc/asan.c index 2aa0a795af201..302ac4fcdecf2 100644 --- a/gcc/asan.c +++ b/gcc/asan.c @@ -628,10 +628,9 @@ handle_builtin_alloca (gcall *call, gimple_stmt_iterator *iter) tree ptr_type = gimple_call_lhs (call) ? TREE_TYPE (gimple_call_lhs (call)) : ptr_type_node; tree partial_size = NULL_TREE; - bool alloca_with_align - = DECL_FUNCTION_CODE (callee) == BUILT_IN_ALLOCA_WITH_ALIGN; unsigned int align - = alloca_with_align ? tree_to_uhwi (gimple_call_arg (call, 1)) : 0; + = DECL_FUNCTION_CODE (callee) == BUILT_IN_ALLOCA + ? 0 : tree_to_uhwi (gimple_call_arg (call, 1)); /* If ALIGN > ASAN_RED_ZONE_SIZE, we embed left redzone into first ALIGN bytes of allocated space. Otherwise, align alloca to ASAN_RED_ZONE_SIZE @@ -793,8 +792,7 @@ get_mem_refs_of_builtin_call (gcall *call, handle_builtin_stack_restore (call, iter); break; - case BUILT_IN_ALLOCA_WITH_ALIGN: - case BUILT_IN_ALLOCA: + CASE_BUILT_IN_ALLOCA: handle_builtin_alloca (call, iter); break; /* And now the __atomic* and __sync builtins. @@ -1809,7 +1807,6 @@ create_cond_insert_point (gimple_stmt_iterator *iter, /* Set up the fallthrough basic block. */ e = find_edge (cond_bb, fallthru_bb); e->flags = EDGE_FALSE_VALUE; - e->count = cond_bb->count; e->probability = fallthrough_probability; /* Update dominance info for the newly created then_bb; note that @@ -3400,6 +3397,10 @@ asan_expand_poison_ifn (gimple_stmt_iterator *iter, { edge e = gimple_phi_arg_edge (phi, i); + /* Do not insert on an edge we can't split. */ + if (e->flags & EDGE_ABNORMAL) + continue; + if (call_to_insert == NULL) call_to_insert = gimple_copy (call); diff --git a/gcc/attribs.c b/gcc/attribs.c index 4ef35b861f8f2..ed76a8dab6f2b 100644 --- a/gcc/attribs.c +++ b/gcc/attribs.c @@ -1182,6 +1182,9 @@ comp_type_attributes (const_tree type1, const_tree type2) } if (lookup_attribute ("transaction_safe", CONST_CAST_TREE (a))) return 0; + if ((lookup_attribute ("nocf_check", TYPE_ATTRIBUTES (type1)) != NULL) + ^ (lookup_attribute ("nocf_check", TYPE_ATTRIBUTES (type2)) != NULL)) + return 0; /* As some type combinations - like default calling-convention - might be compatible, we have to call the target hook to get the final result. */ return targetm.comp_type_attributes (type1, type2); diff --git a/gcc/auto-profile.c b/gcc/auto-profile.c index 9226e202d5037..378f48037eded 100644 --- a/gcc/auto-profile.c +++ b/gcc/auto-profile.c @@ -1234,7 +1234,7 @@ afdo_propagate_edge (bool is_succ, bb_set *annotated_bb, if (!is_edge_annotated (e, *annotated_edge)) num_unknown_edge++, unknown_edge = e; else - total_known_count += e->count; + total_known_count += e->count (); if (num_unknown_edge == 0) { @@ -1251,7 +1251,8 @@ afdo_propagate_edge (bool is_succ, bb_set *annotated_bb, } else if (num_unknown_edge == 1 && is_bb_annotated (bb, *annotated_bb)) { - unknown_edge->count = bb->count - total_known_count; + unknown_edge->probability + = total_known_count.probability_in (bb->count); set_edge_annotated (unknown_edge, annotated_edge); changed = true; } @@ -1349,15 +1350,13 @@ afdo_propagate_circuit (const bb_set &annotated_bb, edge_set *annotated_edge) if (!e->probability.initialized_p () && !is_edge_annotated (ep, *annotated_edge)) { - ep->probability = profile_probability::never (); - ep->count = profile_count::zero ().afdo (); + ep->probability = profile_probability::never ().afdo (); set_edge_annotated (ep, annotated_edge); } } if (total == 1 && !is_edge_annotated (only_one, *annotated_edge)) { only_one->probability = e->probability; - only_one->count = e->count; set_edge_annotated (only_one, annotated_edge); } } @@ -1433,23 +1432,16 @@ afdo_calculate_branch_prob (bb_set *annotated_bb, edge_set *annotated_edge) if (!is_edge_annotated (e, *annotated_edge)) num_unknown_succ++; else - total_count += e->count; + total_count += e->count (); } if (num_unknown_succ == 0 && total_count > profile_count::zero ()) { FOR_EACH_EDGE (e, ei, bb->succs) - e->probability = e->count.probability_in (total_count); + e->probability = e->count ().probability_in (total_count); } } FOR_ALL_BB_FN (bb, cfun) - { - edge e; - edge_iterator ei; - - FOR_EACH_EDGE (e, ei, bb->succs) - e->count = bb->count.apply_probability (e->probability); bb->aux = NULL; - } loop_optimizer_finalize (); free_dominance_info (CDI_DOMINATORS); @@ -1551,7 +1543,7 @@ afdo_annotate_cfg (const stmt_set &promoted_stmts) counters are zero when not seen by autoFDO. */ bb->count = profile_count::zero ().afdo (); FOR_EACH_EDGE (e, ei, bb->succs) - e->count = profile_count::zero ().afdo (); + e->probability = profile_probability::uninitialized (); if (afdo_set_bb_count (bb, promoted_stmts)) set_bb_annotated (bb, &annotated_bb); diff --git a/gcc/basic-block.h b/gcc/basic-block.h index c0c47784c0244..1505cce81bf58 100644 --- a/gcc/basic-block.h +++ b/gcc/basic-block.h @@ -46,8 +46,9 @@ struct GTY((user)) edge_def { int flags; /* see cfg-flags.def */ profile_probability probability; - profile_count count; /* Expected number of executions calculated - in profile.c */ + + /* Return count of edge E. */ + inline profile_count count () const; }; /* Masks for edge.flags. */ @@ -639,4 +640,10 @@ has_abnormal_call_or_eh_pred_edge_p (basic_block bb) return false; } +/* Return count of edge E. */ +inline profile_count edge_def::count () const +{ + return src->count.apply_probability (probability); +} + #endif /* GCC_BASIC_BLOCK_H */ diff --git a/gcc/bb-reorder.c b/gcc/bb-reorder.c index 4dad298fe596d..dc2025fac9c19 100644 --- a/gcc/bb-reorder.c +++ b/gcc/bb-reorder.c @@ -374,11 +374,11 @@ rotate_loop (edge back_edge, struct trace *trace, int trace_n) { /* The current edge E is also preferred. */ int freq = EDGE_FREQUENCY (e); - if (freq > best_freq || e->count > best_count) + if (freq > best_freq || e->count () > best_count) { best_freq = freq; - if (e->count.initialized_p ()) - best_count = e->count; + if (e->count ().initialized_p ()) + best_count = e->count (); best_edge = e; best_bb = bb; } @@ -392,17 +392,17 @@ rotate_loop (edge back_edge, struct trace *trace, int trace_n) /* The current edge E is preferred. */ is_preferred = true; best_freq = EDGE_FREQUENCY (e); - best_count = e->count; + best_count = e->count (); best_edge = e; best_bb = bb; } else { int freq = EDGE_FREQUENCY (e); - if (!best_edge || freq > best_freq || e->count > best_count) + if (!best_edge || freq > best_freq || e->count () > best_count) { best_freq = freq; - best_count = e->count; + best_count = e->count (); best_edge = e; best_bb = bb; } @@ -571,7 +571,7 @@ find_traces_1_round (int branch_th, int exec_th, gcov_type count_th, || !prob.initialized_p () || ((prob.to_reg_br_prob_base () < branch_th || EDGE_FREQUENCY (e) < exec_th - || e->count < count_th) && (!for_size))) + || e->count () < count_th) && (!for_size))) continue; /* If partitioning hot/cold basic blocks, don't consider edges @@ -656,7 +656,7 @@ find_traces_1_round (int branch_th, int exec_th, gcov_type count_th, || !prob.initialized_p () || prob.to_reg_br_prob_base () < branch_th || freq < exec_th - || e->count < count_th) + || e->count () < count_th) { /* When partitioning hot/cold basic blocks, make sure the cold blocks (and only the cold blocks) all get @@ -1285,7 +1285,7 @@ connect_traces (int n_traces, struct trace *traces) && !connected[bbd[di].start_of_trace] && BB_PARTITION (e2->dest) == current_partition && EDGE_FREQUENCY (e2) >= freq_threshold - && e2->count >= count_threshold + && e2->count () >= count_threshold && (!best2 || e2->probability > best2->probability || (e2->probability == best2->probability @@ -1311,8 +1311,8 @@ connect_traces (int n_traces, struct trace *traces) && copy_bb_p (best->dest, optimize_edge_for_speed_p (best) && EDGE_FREQUENCY (best) >= freq_threshold - && (!best->count.initialized_p () - || best->count >= count_threshold))) + && (!best->count ().initialized_p () + || best->count () >= count_threshold))) { basic_block new_bb; @@ -1528,7 +1528,7 @@ sanitize_hot_paths (bool walk_up, unsigned int cold_bb_count, /* Do not expect profile insanities when profile was not adjusted. */ if (e->probability == profile_probability::never () - || e->count == profile_count::zero ()) + || e->count () == profile_count::zero ()) continue; if (BB_PARTITION (reach_bb) != BB_COLD_PARTITION) @@ -1539,8 +1539,8 @@ sanitize_hot_paths (bool walk_up, unsigned int cold_bb_count, /* The following loop will look for the hottest edge via the edge count, if it is non-zero, then fallback to the edge frequency and finally the edge probability. */ - if (!highest_count.initialized_p () || e->count > highest_count) - highest_count = e->count; + if (!highest_count.initialized_p () || e->count () > highest_count) + highest_count = e->count (); int edge_freq = EDGE_FREQUENCY (e); if (edge_freq > highest_freq) highest_freq = edge_freq; @@ -1563,14 +1563,14 @@ sanitize_hot_paths (bool walk_up, unsigned int cold_bb_count, continue; /* Do not expect profile insanities when profile was not adjusted. */ if (e->probability == profile_probability::never () - || e->count == profile_count::zero ()) + || e->count () == profile_count::zero ()) continue; /* Select the hottest edge using the edge count, if it is non-zero, then fallback to the edge frequency and finally the edge probability. */ if (highest_count > 0) { - if (e->count < highest_count) + if (e->count () < highest_count) continue; } else if (highest_freq) diff --git a/gcc/brig/ChangeLog b/gcc/brig/ChangeLog index bdb701882400d..fa7668486b203 100644 --- a/gcc/brig/ChangeLog +++ b/gcc/brig/ChangeLog @@ -1,3 +1,18 @@ +2017-10-09 Pekka Jääskeläinen + + * brigfrontend/brig-to-generic.cc: Support BRIG_KIND_NONE + directives. These directives are legal everywhere. They + can be used to patch away BRIG entries at the binary level. + Also add extra error detection for zeroed regions: make sure + the byteCount field is never zero. + * brig/brigfrontend/phsa.h: Added a new error prefix for + errors which are due to corrupted BRIG modules. + +2017-10-09 Henry Linjamäki + + * brigfrontend/brig-branch-inst-handler.cc: The call code + still failed a few test cases. Now all PRM cases pass again. + 2017-10-03 Henry Linjamäki * brigfrontend/brig-branch-inst-handler.cc: Fix (more) crash with diff --git a/gcc/brig/brigfrontend/brig-branch-inst-handler.cc b/gcc/brig/brigfrontend/brig-branch-inst-handler.cc index 30aec373732ac..039f1853d4a30 100644 --- a/gcc/brig/brigfrontend/brig-branch-inst-handler.cc +++ b/gcc/brig/brigfrontend/brig-branch-inst-handler.cc @@ -70,7 +70,7 @@ brig_branch_inst_handler::operator () (const BrigBase *base) const BrigOperandOffset32_t *operand_ptr = (const BrigOperandOffset32_t *) data->bytes; - vec *&args = i == 0 ? out_args : in_args; + bool out_args_p = i == 0; while (bytes > 0) { @@ -85,7 +85,7 @@ brig_branch_inst_handler::operator () (const BrigBase *base) if (brig_var->type & BRIG_TYPE_ARRAY) { /* Array return values are passed as the first argument. */ - args = in_args; + out_args_p = false; /* Pass pointer to the element zero and use its element zero as the base address. */ tree etype = TREE_TYPE (TREE_TYPE (var)); @@ -97,8 +97,7 @@ brig_branch_inst_handler::operator () (const BrigBase *base) } gcc_assert (var != NULL_TREE); - vec_safe_reserve (args, 1); - vec_safe_push (args, var); + vec_safe_push (out_args_p ? out_args : in_args, var); ++operand_ptr; bytes -= 4; } diff --git a/gcc/brig/brigfrontend/brig-to-generic.cc b/gcc/brig/brigfrontend/brig-to-generic.cc index 6459f9e1076e7..41246ba2bfcde 100644 --- a/gcc/brig/brigfrontend/brig-to-generic.cc +++ b/gcc/brig/brigfrontend/brig-to-generic.cc @@ -248,7 +248,12 @@ brig_to_generic::analyze (const char *brig_blob) if (handlers[i].kind == entry->kind) handler = handlers[i].handler; } - b += (*handler) (entry); + + int bytes_processed = (*handler) (entry); + if (bytes_processed == 0) + fatal_error (UNKNOWN_LOCATION, PHSA_ERROR_PREFIX_CORRUPTED_MODULE + "Element with 0 bytes."); + b += bytes_processed; } if (m_cf != NULL) @@ -335,7 +340,10 @@ brig_to_generic::parse (const char *brig_blob) /* There are no supported pragmas at this moment. */ {BRIG_KIND_DIRECTIVE_PRAGMA, &skipped_handler}, {BRIG_KIND_DIRECTIVE_CONTROL, &control_handler}, - {BRIG_KIND_DIRECTIVE_EXTENSION, &skipped_handler}}; + {BRIG_KIND_DIRECTIVE_EXTENSION, &skipped_handler}, + /* BRIG_KIND_NONE entries are valid anywhere. They can be used + for patching BRIGs before finalization. */ + {BRIG_KIND_NONE, &skipped_handler}}; const BrigSectionHeader *csection_header = (const BrigSectionHeader *) m_code; diff --git a/gcc/brig/brigfrontend/phsa.h b/gcc/brig/brigfrontend/phsa.h index 2da21c8335c89..88e87eb6a9d8e 100644 --- a/gcc/brig/brigfrontend/phsa.h +++ b/gcc/brig/brigfrontend/phsa.h @@ -61,9 +61,10 @@ typedef struct __attribute__((__packed__)) #define PHSA_DESC_SECTION_PREFIX "phsa.desc." #define PHSA_HOST_DEF_PTR_PREFIX "__phsa.host_def." -/* The frontend error messages are parsed by the host runtime, known +/* The frontend error messages are parsed by the host runtime. Known prefix strings are used to separate the different runtime error codes. */ -#define PHSA_ERROR_PREFIX_INCOMPATIBLE_MODULE "Incompatible module:" +#define PHSA_ERROR_PREFIX_INCOMPATIBLE_MODULE "Incompatible module: " +#define PHSA_ERROR_PREFIX_CORRUPTED_MODULE "Corrupted module: " #endif diff --git a/gcc/builtins.c b/gcc/builtins.c index ff049aa9d378d..d3498bb16c479 100644 --- a/gcc/builtins.c +++ b/gcc/builtins.c @@ -1199,6 +1199,7 @@ void expand_builtin_update_setjmp_buf (rtx buf_addr) { machine_mode sa_mode = STACK_SAVEAREA_MODE (SAVE_NONLOCAL); + buf_addr = convert_memory_address (Pmode, buf_addr); rtx stack_save = gen_rtx_MEM (sa_mode, memory_address @@ -1608,7 +1609,7 @@ expand_builtin_apply (rtx function, rtx arguments, rtx argsize) arguments to the outgoing arguments address. We can pass TRUE as the 4th argument because we just saved the stack pointer and will restore it right after the call. */ - allocate_dynamic_stack_space (argsize, 0, BIGGEST_ALIGNMENT, true); + allocate_dynamic_stack_space (argsize, 0, BIGGEST_ALIGNMENT, -1, true); /* Set DRAP flag to true, even though allocate_dynamic_stack_space may have already set current_function_calls_alloca to true. @@ -4857,19 +4858,22 @@ expand_builtin_alloca (tree exp) rtx result; unsigned int align; tree fndecl = get_callee_fndecl (exp); - bool alloca_with_align = (DECL_FUNCTION_CODE (fndecl) - == BUILT_IN_ALLOCA_WITH_ALIGN); + HOST_WIDE_INT max_size; + enum built_in_function fcode = DECL_FUNCTION_CODE (fndecl); bool alloca_for_var = CALL_ALLOCA_FOR_VAR_P (exp); bool valid_arglist - = (alloca_with_align - ? validate_arglist (exp, INTEGER_TYPE, INTEGER_TYPE, VOID_TYPE) - : validate_arglist (exp, INTEGER_TYPE, VOID_TYPE)); + = (fcode == BUILT_IN_ALLOCA_WITH_ALIGN_AND_MAX + ? validate_arglist (exp, INTEGER_TYPE, INTEGER_TYPE, INTEGER_TYPE, + VOID_TYPE) + : fcode == BUILT_IN_ALLOCA_WITH_ALIGN + ? validate_arglist (exp, INTEGER_TYPE, INTEGER_TYPE, VOID_TYPE) + : validate_arglist (exp, INTEGER_TYPE, VOID_TYPE)); if (!valid_arglist) return NULL_RTX; - if ((alloca_with_align && !warn_vla_limit) - || (!alloca_with_align && !warn_alloca_limit)) + if ((alloca_for_var && !warn_vla_limit) + || (!alloca_for_var && !warn_alloca_limit)) { /* -Walloca-larger-than and -Wvla-larger-than settings override the more general -Walloc-size-larger-than so unless either of @@ -4884,13 +4888,19 @@ expand_builtin_alloca (tree exp) op0 = expand_normal (CALL_EXPR_ARG (exp, 0)); /* Compute the alignment. */ - align = (alloca_with_align - ? TREE_INT_CST_LOW (CALL_EXPR_ARG (exp, 1)) - : BIGGEST_ALIGNMENT); + align = (fcode == BUILT_IN_ALLOCA + ? BIGGEST_ALIGNMENT + : TREE_INT_CST_LOW (CALL_EXPR_ARG (exp, 1))); + + /* Compute the maximum size. */ + max_size = (fcode == BUILT_IN_ALLOCA_WITH_ALIGN_AND_MAX + ? TREE_INT_CST_LOW (CALL_EXPR_ARG (exp, 2)) + : -1); /* Allocate the desired space. If the allocation stems from the declaration of a variable-sized object, it cannot accumulate. */ - result = allocate_dynamic_stack_space (op0, 0, align, alloca_for_var); + result + = allocate_dynamic_stack_space (op0, 0, align, max_size, alloca_for_var); result = convert_memory_address (ptr_mode, result); return result; @@ -6481,8 +6491,7 @@ expand_builtin (tree exp, rtx target, rtx subtarget, machine_mode mode, && fcode != BUILT_IN_EXECLE && fcode != BUILT_IN_EXECVP && fcode != BUILT_IN_EXECVE - && fcode != BUILT_IN_ALLOCA - && fcode != BUILT_IN_ALLOCA_WITH_ALIGN + && !ALLOCA_FUNCTION_CODE_P (fcode) && fcode != BUILT_IN_FREE && fcode != BUILT_IN_CHKP_SET_PTR_BOUNDS && fcode != BUILT_IN_CHKP_INIT_PTR_BOUNDS @@ -6711,8 +6720,7 @@ expand_builtin (tree exp, rtx target, rtx subtarget, machine_mode mode, else return XEXP (DECL_RTL (DECL_RESULT (current_function_decl)), 0); - case BUILT_IN_ALLOCA: - case BUILT_IN_ALLOCA_WITH_ALIGN: + CASE_BUILT_IN_ALLOCA: target = expand_builtin_alloca (exp); if (target) return target; @@ -10424,8 +10432,7 @@ is_inexpensive_builtin (tree decl) switch (DECL_FUNCTION_CODE (decl)) { case BUILT_IN_ABS: - case BUILT_IN_ALLOCA: - case BUILT_IN_ALLOCA_WITH_ALIGN: + CASE_BUILT_IN_ALLOCA: case BUILT_IN_BSWAP16: case BUILT_IN_BSWAP32: case BUILT_IN_BSWAP64: diff --git a/gcc/builtins.def b/gcc/builtins.def index 1c1efceea2173..8802594220657 100644 --- a/gcc/builtins.def +++ b/gcc/builtins.def @@ -921,6 +921,7 @@ DEF_BUILTIN_STUB (BUILT_IN_SETJMP_RECEIVER, "__builtin_setjmp_receiver") DEF_BUILTIN_STUB (BUILT_IN_STACK_SAVE, "__builtin_stack_save") DEF_BUILTIN_STUB (BUILT_IN_STACK_RESTORE, "__builtin_stack_restore") DEF_BUILTIN_STUB (BUILT_IN_ALLOCA_WITH_ALIGN, "__builtin_alloca_with_align") +DEF_BUILTIN_STUB (BUILT_IN_ALLOCA_WITH_ALIGN_AND_MAX, "__builtin_alloca_with_align_and_max") /* An internal version of memcmp, used when the result is only tested for equality with zero. */ diff --git a/gcc/c-family/ChangeLog b/gcc/c-family/ChangeLog index f70b6f838322a..963c79a7e2b95 100644 --- a/gcc/c-family/ChangeLog +++ b/gcc/c-family/ChangeLog @@ -1,3 +1,57 @@ +2017-10-19 Eric Botcazou + + * c-common.c (check_builtin_function_arguments): Also check arguments + of __builtin_alloca_with_align_and_max. + +2017-10-17 David Malcolm + + * c-format.c (format_warning_at_char): Pass UNKNOWN_LOCATION + rather than NULL to format_warning_va. + (check_format_types): Likewise when calling format_type_warning. + Remove code to extract source_ranges and source_range * in favor + of just a location_t. + (format_type_warning): Convert source_range * param to a + location_t. + +2017-10-13 Jakub Jelinek + + * c-gimplify.c (c_gimplify_expr): Handle [LR]ROTATE_EXPR like + [LR]SHIFT_EXPR. + +2017-10-12 David Malcolm + + * c-common.c (enum missing_token_insertion_kind): New enum. + (get_missing_token_insertion_kind): New function. + (maybe_suggest_missing_token_insertion): New function. + * c-common.h (maybe_suggest_missing_token_insertion): New decl. + +2017-10-11 Nathan Sidwell + + * c-opts.c (add_prefixed_path): Change chain to incpath_kind. + (c_common_handle_option): Update incpath_kind names. + +2017-10-11 Martin Liska + + PR sanitizer/82490 + * c-attribs.c (handle_no_sanitize_attribute): Report directly + Wattributes warning. + +2017-10-10 Richard Sandiford + + * c-ada-spec.c (dump_generic_ada_node): Use wi::to_wide when + operating on trees as wide_ints. + * c-common.c (pointer_int_sum): Likewise. + * c-pretty-print.c (pp_c_integer_constant): Likewise. + * c-warn.c (match_case_to_enum_1): Likewise. + (c_do_switch_warnings): Likewise. + (maybe_warn_shift_overflow): Likewise. + +2017-10-10 Jakub Jelinek + + PR c/82437 + * c-warn.c (warn_tautological_bitwise_comparison): Use wi::to_wide + instead of wide_int::from. + 2017-10-06 Jakub Jelinek PR c/82437 diff --git a/gcc/c-family/c-ada-spec.c b/gcc/c-family/c-ada-spec.c index 834360f347e69..95aacd1697adf 100644 --- a/gcc/c-family/c-ada-spec.c +++ b/gcc/c-family/c-ada-spec.c @@ -2362,7 +2362,7 @@ dump_generic_ada_node (pretty_printer *buffer, tree node, tree type, int spc, pp_unsigned_wide_integer (buffer, tree_to_uhwi (node)); else { - wide_int val = node; + wide_int val = wi::to_wide (node); int i; if (wi::neg_p (val)) { diff --git a/gcc/c-family/c-attribs.c b/gcc/c-family/c-attribs.c index 4e6754fba2002..bb75cba4c39d1 100644 --- a/gcc/c-family/c-attribs.c +++ b/gcc/c-family/c-attribs.c @@ -65,6 +65,7 @@ static tree handle_asan_odr_indicator_attribute (tree *, tree, tree, int, static tree handle_stack_protect_attribute (tree *, tree, tree, int, bool *); static tree handle_noinline_attribute (tree *, tree, tree, int, bool *); static tree handle_noclone_attribute (tree *, tree, tree, int, bool *); +static tree handle_nocf_check_attribute (tree *, tree, tree, int, bool *); static tree handle_noicf_attribute (tree *, tree, tree, int, bool *); static tree handle_noipa_attribute (tree *, tree, tree, int, bool *); static tree handle_leaf_attribute (tree *, tree, tree, int, bool *); @@ -367,6 +368,8 @@ const struct attribute_spec c_common_attribute_table[] = { "patchable_function_entry", 1, 2, true, false, false, handle_patchable_function_entry_attribute, false }, + { "nocf_check", 0, 0, false, true, true, + handle_nocf_check_attribute, true }, { NULL, 0, 0, false, false, false, NULL, false } }; @@ -613,15 +616,8 @@ handle_no_sanitize_attribute (tree *node, tree name, tree args, int, return NULL_TREE; } - char *error_value = NULL; char *string = ASTRDUP (TREE_STRING_POINTER (id)); - unsigned int flags = parse_no_sanitize_attribute (string, &error_value); - - if (error_value) - { - error ("wrong argument: \"%s\"", error_value); - return NULL_TREE; - } + unsigned int flags = parse_no_sanitize_attribute (string); add_no_sanitize_value (*node, flags); @@ -779,6 +775,30 @@ handle_noclone_attribute (tree *node, tree name, return NULL_TREE; } +/* Handle a "nocf_check" attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_nocf_check_attribute (tree *node, tree name, + tree ARG_UNUSED (args), + int ARG_UNUSED (flags), bool *no_add_attrs) +{ + if (TREE_CODE (*node) != FUNCTION_TYPE + && TREE_CODE (*node) != METHOD_TYPE) + { + warning (OPT_Wattributes, "%qE attribute ignored", name); + *no_add_attrs = true; + } + else if (!(flag_cf_protection & CF_BRANCH)) + { + warning (OPT_Wattributes, "%qE attribute ignored. Use " + "-fcf-protection option to enable it", name); + *no_add_attrs = true; + } + + return NULL_TREE; +} + /* Handle a "no_icf" attribute; arguments as in struct attribute_spec.handler. */ diff --git a/gcc/c-family/c-common.c b/gcc/c-family/c-common.c index b3ec3a0f7e691..8f36c77967faa 100644 --- a/gcc/c-family/c-common.c +++ b/gcc/c-family/c-common.c @@ -3158,7 +3158,7 @@ pointer_int_sum (location_t loc, enum tree_code resultcode, convert (TREE_TYPE (intop), size_exp)); intop = convert (sizetype, t); if (TREE_OVERFLOW_P (intop) && !TREE_OVERFLOW (t)) - intop = wide_int_to_tree (TREE_TYPE (intop), intop); + intop = wide_int_to_tree (TREE_TYPE (intop), wi::to_wide (intop)); } /* Create the sum or difference. */ @@ -5695,6 +5695,16 @@ check_builtin_function_arguments (location_t loc, vec arg_loc, switch (DECL_FUNCTION_CODE (fndecl)) { + case BUILT_IN_ALLOCA_WITH_ALIGN_AND_MAX: + if (!tree_fits_uhwi_p (args[2])) + { + error_at (ARG_LOCATION (2), + "third argument to function %qE must be a constant integer", + fndecl); + return false; + } + /* fall through */ + case BUILT_IN_ALLOCA_WITH_ALIGN: { /* Get the requested alignment (in bits) if it's a constant @@ -7946,6 +7956,164 @@ c_flt_eval_method (bool maybe_c11_only_p) return c_ts18661_flt_eval_method (); } +/* An enum for get_missing_token_insertion_kind for describing the best + place to insert a missing token, if there is one. */ + +enum missing_token_insertion_kind +{ + MTIK_IMPOSSIBLE, + MTIK_INSERT_BEFORE_NEXT, + MTIK_INSERT_AFTER_PREV +}; + +/* Given a missing token of TYPE, determine if it is reasonable to + emit a fix-it hint suggesting the insertion of the token, and, + if so, where the token should be inserted relative to other tokens. + + It only makes sense to do this for values of TYPE that are symbols. + + Some symbols should go before the next token, e.g. in: + if flag) + we want to insert the missing '(' immediately before "flag", + giving: + if (flag) + rather than: + if( flag) + These use MTIK_INSERT_BEFORE_NEXT. + + Other symbols should go after the previous token, e.g. in: + if (flag + do_something (); + we want to insert the missing ')' immediately after the "flag", + giving: + if (flag) + do_something (); + rather than: + if (flag + )do_something (); + These use MTIK_INSERT_AFTER_PREV. */ + +static enum missing_token_insertion_kind +get_missing_token_insertion_kind (enum cpp_ttype type) +{ + switch (type) + { + /* Insert missing "opening" brackets immediately + before the next token. */ + case CPP_OPEN_SQUARE: + case CPP_OPEN_PAREN: + return MTIK_INSERT_BEFORE_NEXT; + + /* Insert other missing symbols immediately after + the previous token. */ + case CPP_CLOSE_PAREN: + case CPP_CLOSE_SQUARE: + case CPP_SEMICOLON: + case CPP_COMMA: + case CPP_COLON: + return MTIK_INSERT_AFTER_PREV; + + /* Other kinds of token don't get fix-it hints. */ + default: + return MTIK_IMPOSSIBLE; + } +} + +/* Given RICHLOC, a location for a diagnostic describing a missing token + of kind TOKEN_TYPE, potentially add a fix-it hint suggesting the + insertion of the token. + + The location of the attempted fix-it hint depends on TOKEN_TYPE: + it will either be: + (a) immediately after PREV_TOKEN_LOC, or + + (b) immediately before the primary location within RICHLOC (taken to + be that of the token following where the token was expected). + + If we manage to add a fix-it hint, then the location of the + fix-it hint is likely to be more useful as the primary location + of the diagnostic than that of the following token, so we swap + these locations. + + For example, given this bogus code: + 123456789012345678901234567890 + 1 | int missing_semicolon (void) + 2 | { + 3 | return 42 + 4 | } + + we will emit: + + "expected ';' before '}'" + + RICHLOC's primary location is at the closing brace, so before "swapping" + we would emit the error at line 4 column 1: + + 123456789012345678901234567890 + 3 | return 42 |< fix-it hint emitted for this line + | ; | + 4 | } |< "expected ';' before '}'" emitted at this line + | ^ | + + It's more useful for the location of the diagnostic to be at the + fix-it hint, so we swap the locations, so the primary location + is at the fix-it hint, with the old primary location inserted + as a secondary location, giving this, with the error at line 3 + column 12: + + 123456789012345678901234567890 + 3 | return 42 |< "expected ';' before '}'" emitted at this line, + | ^ | with fix-it hint + 4 | ; | + | } |< secondary range emitted here + | ~ |. */ + +void +maybe_suggest_missing_token_insertion (rich_location *richloc, + enum cpp_ttype token_type, + location_t prev_token_loc) +{ + gcc_assert (richloc); + + enum missing_token_insertion_kind mtik + = get_missing_token_insertion_kind (token_type); + + switch (mtik) + { + default: + gcc_unreachable (); + break; + + case MTIK_IMPOSSIBLE: + return; + + case MTIK_INSERT_BEFORE_NEXT: + /* Attempt to add the fix-it hint before the primary location + of RICHLOC. */ + richloc->add_fixit_insert_before (cpp_type2name (token_type, 0)); + break; + + case MTIK_INSERT_AFTER_PREV: + /* Attempt to add the fix-it hint after PREV_TOKEN_LOC. */ + richloc->add_fixit_insert_after (prev_token_loc, + cpp_type2name (token_type, 0)); + break; + } + + /* If we were successful, use the fix-it hint's location as the + primary location within RICHLOC, adding the old primary location + back as a secondary location. */ + if (!richloc->seen_impossible_fixit_p ()) + { + fixit_hint *hint = richloc->get_last_fixit_hint (); + location_t hint_loc = hint->get_start_loc (); + location_t old_loc = richloc->get_loc (); + + richloc->set_range (line_table, 0, hint_loc, true); + richloc->add_range (old_loc, false); + } +} + #if CHECKING_P namespace selftest { diff --git a/gcc/c-family/c-common.h b/gcc/c-family/c-common.h index da6a0be92000d..7e1877e8d164a 100644 --- a/gcc/c-family/c-common.h +++ b/gcc/c-family/c-common.h @@ -1550,6 +1550,9 @@ extern int c_flt_eval_method (bool ts18661_p); extern void add_no_sanitize_value (tree node, unsigned int flags); extern void maybe_add_include_fixit (rich_location *, const char *); +extern void maybe_suggest_missing_token_insertion (rich_location *richloc, + enum cpp_ttype token_type, + location_t prev_token_loc); #if CHECKING_P namespace selftest { diff --git a/gcc/c-family/c-format.c b/gcc/c-family/c-format.c index 0dba9793311b7..164d035396742 100644 --- a/gcc/c-family/c-format.c +++ b/gcc/c-family/c-format.c @@ -97,7 +97,8 @@ format_warning_at_char (location_t fmt_string_loc, tree format_string_cst, substring_loc fmt_loc (fmt_string_loc, string_type, char_idx, char_idx, char_idx); - bool warned = format_warning_va (fmt_loc, NULL, NULL, opt, gmsgid, &ap); + bool warned = format_warning_va (fmt_loc, UNKNOWN_LOCATION, NULL, opt, + gmsgid, &ap); va_end (ap); return warned; @@ -1039,7 +1040,7 @@ static void check_format_types (const substring_loc &fmt_loc, char conversion_char, vec *arglocs); static void format_type_warning (const substring_loc &fmt_loc, - source_range *param_range, + location_t param_loc, format_wanted_type *, tree, tree, const format_kind_info *fki, @@ -3073,8 +3074,9 @@ check_format_types (const substring_loc &fmt_loc, cur_param = types->param; if (!cur_param) { - format_type_warning (fmt_loc, NULL, types, wanted_type, NULL, fki, - offset_to_type_start, conversion_char); + format_type_warning (fmt_loc, UNKNOWN_LOCATION, types, wanted_type, + NULL, fki, offset_to_type_start, + conversion_char); continue; } @@ -3084,23 +3086,15 @@ check_format_types (const substring_loc &fmt_loc, orig_cur_type = cur_type; char_type_flag = 0; - source_range param_range; - source_range *param_range_ptr; + location_t param_loc = UNKNOWN_LOCATION; if (EXPR_HAS_LOCATION (cur_param)) - { - param_range = EXPR_LOCATION_RANGE (cur_param); - param_range_ptr = ¶m_range; - } + param_loc = EXPR_LOCATION (cur_param); else if (arglocs) { /* arg_num is 1-based. */ gcc_assert (types->arg_num > 0); - location_t param_loc = (*arglocs)[types->arg_num - 1]; - param_range = get_range_from_loc (line_table, param_loc); - param_range_ptr = ¶m_range; + param_loc = (*arglocs)[types->arg_num - 1]; } - else - param_range_ptr = NULL; STRIP_NOPS (cur_param); @@ -3166,7 +3160,7 @@ check_format_types (const substring_loc &fmt_loc, } else { - format_type_warning (fmt_loc, param_range_ptr, + format_type_warning (fmt_loc, param_loc, types, wanted_type, orig_cur_type, fki, offset_to_type_start, conversion_char); break; @@ -3236,7 +3230,7 @@ check_format_types (const substring_loc &fmt_loc, && TYPE_PRECISION (cur_type) == TYPE_PRECISION (wanted_type)) continue; /* Now we have a type mismatch. */ - format_type_warning (fmt_loc, param_range_ptr, types, + format_type_warning (fmt_loc, param_loc, types, wanted_type, orig_cur_type, fki, offset_to_type_start, conversion_char); } @@ -3544,8 +3538,9 @@ get_corrected_substring (const substring_loc &fmt_loc, /* Give a warning about a format argument of different type from that expected. The range of the diagnostic is taken from WHOLE_FMT_LOC; the caret location is based on the location of the char at TYPE->offset_loc. - If non-NULL, PARAM_RANGE is the source range of the - relevant argument. WANTED_TYPE is the type the argument should have, + PARAM_LOC is the location of the relevant argument, or UNKNOWN_LOCATION + if this is unavailable. + WANTED_TYPE is the type the argument should have, possibly stripped of pointer dereferences. The description (such as "field precision"), the placement in the format string, a possibly more friendly name of WANTED_TYPE, and the number of pointer dereferences @@ -3566,7 +3561,7 @@ get_corrected_substring (const substring_loc &fmt_loc, V~~~~~~~~ : range of WHOLE_FMT_LOC, from cols 23-31 sprintf (d, "before %-+*.*lld after", int_expr, int_expr, long_expr); ^ ^ ^~~~~~~~~ - | ` CONVERSION_CHAR: 'd' *PARAM_RANGE + | ` CONVERSION_CHAR: 'd' PARAM_LOC type starts here OFFSET_TO_TYPE_START is 13, the offset to the "lld" within the @@ -3574,7 +3569,7 @@ get_corrected_substring (const substring_loc &fmt_loc, static void format_type_warning (const substring_loc &whole_fmt_loc, - source_range *param_range, + location_t param_loc, format_wanted_type *type, tree wanted_type, tree arg_type, const format_kind_info *fki, @@ -3636,7 +3631,7 @@ format_type_warning (const substring_loc &whole_fmt_loc, { if (arg_type) format_warning_at_substring - (fmt_loc, param_range, + (fmt_loc, param_loc, corrected_substring, OPT_Wformat_, "%s %<%s%.*s%> expects argument of type %<%s%s%>, " "but argument %d has type %qT", @@ -3646,7 +3641,7 @@ format_type_warning (const substring_loc &whole_fmt_loc, wanted_type_name, p, arg_num, arg_type); else format_warning_at_substring - (fmt_loc, param_range, + (fmt_loc, param_loc, corrected_substring, OPT_Wformat_, "%s %<%s%.*s%> expects a matching %<%s%s%> argument", gettext (kind_descriptions[kind]), @@ -3657,7 +3652,7 @@ format_type_warning (const substring_loc &whole_fmt_loc, { if (arg_type) format_warning_at_substring - (fmt_loc, param_range, + (fmt_loc, param_loc, corrected_substring, OPT_Wformat_, "%s %<%s%.*s%> expects argument of type %<%T%s%>, " "but argument %d has type %qT", @@ -3667,7 +3662,7 @@ format_type_warning (const substring_loc &whole_fmt_loc, wanted_type, p, arg_num, arg_type); else format_warning_at_substring - (fmt_loc, param_range, + (fmt_loc, param_loc, corrected_substring, OPT_Wformat_, "%s %<%s%.*s%> expects a matching %<%T%s%> argument", gettext (kind_descriptions[kind]), diff --git a/gcc/c-family/c-gimplify.c b/gcc/c-family/c-gimplify.c index 6a4b7c77a34a4..91f9bf9c7a3ac 100644 --- a/gcc/c-family/c-gimplify.c +++ b/gcc/c-family/c-gimplify.c @@ -229,6 +229,8 @@ c_gimplify_expr (tree *expr_p, gimple_seq *pre_p ATTRIBUTE_UNUSED, { case LSHIFT_EXPR: case RSHIFT_EXPR: + case LROTATE_EXPR: + case RROTATE_EXPR: { /* We used to convert the right operand of a shift-expression to an integer_type_node in the FEs. But it is unnecessary diff --git a/gcc/c-family/c-opts.c b/gcc/c-family/c-opts.c index 3662aa37be696..6bd535532d3d3 100644 --- a/gcc/c-family/c-opts.c +++ b/gcc/c-family/c-opts.c @@ -118,7 +118,7 @@ static void set_std_c11 (int); static void check_deps_environment_vars (void); static void handle_deferred_opts (void); static void sanitize_cpp_opts (void); -static void add_prefixed_path (const char *, size_t); +static void add_prefixed_path (const char *, incpath_kind); static void push_command_line_include (void); static void cb_file_change (cpp_reader *, const line_map_ordinary *); static void cb_dir_change (cpp_reader *, const char *); @@ -316,7 +316,7 @@ c_common_handle_option (size_t scode, const char *arg, int value, case OPT_I: if (strcmp (arg, "-")) - add_path (xstrdup (arg), BRACKET, 0, true); + add_path (xstrdup (arg), INC_BRACKET, 0, true); else { if (quote_chain_split) @@ -550,7 +550,7 @@ c_common_handle_option (size_t scode, const char *arg, int value, break; case OPT_idirafter: - add_path (xstrdup (arg), AFTER, 0, true); + add_path (xstrdup (arg), INC_AFTER, 0, true); break; case OPT_imacros: @@ -567,7 +567,7 @@ c_common_handle_option (size_t scode, const char *arg, int value, break; case OPT_iquote: - add_path (xstrdup (arg), QUOTE, 0, true); + add_path (xstrdup (arg), INC_QUOTE, 0, true); break; case OPT_isysroot: @@ -575,15 +575,15 @@ c_common_handle_option (size_t scode, const char *arg, int value, break; case OPT_isystem: - add_path (xstrdup (arg), SYSTEM, 0, true); + add_path (xstrdup (arg), INC_SYSTEM, 0, true); break; case OPT_iwithprefix: - add_prefixed_path (arg, SYSTEM); + add_prefixed_path (arg, INC_SYSTEM); break; case OPT_iwithprefixbefore: - add_prefixed_path (arg, BRACKET); + add_prefixed_path (arg, INC_BRACKET); break; case OPT_lang_asm: @@ -1326,7 +1326,7 @@ sanitize_cpp_opts (void) /* Add include path with a prefix at the front of its name. */ static void -add_prefixed_path (const char *suffix, size_t chain) +add_prefixed_path (const char *suffix, incpath_kind chain) { char *path; const char *prefix; diff --git a/gcc/c-family/c-pretty-print.c b/gcc/c-family/c-pretty-print.c index 745f0fd60113e..0f48b9e958a7f 100644 --- a/gcc/c-family/c-pretty-print.c +++ b/gcc/c-family/c-pretty-print.c @@ -916,9 +916,9 @@ pp_c_integer_constant (c_pretty_printer *pp, tree i) pp_unsigned_wide_integer (pp, tree_to_uhwi (i)); else { - wide_int wi = i; + wide_int wi = wi::to_wide (i); - if (wi::lt_p (i, 0, TYPE_SIGN (TREE_TYPE (i)))) + if (wi::lt_p (wi::to_wide (i), 0, TYPE_SIGN (TREE_TYPE (i)))) { pp_minus (pp); wi = -wi; diff --git a/gcc/c-family/c-warn.c b/gcc/c-family/c-warn.c index 2eb4cf5dd4153..cb1db0327c3c0 100644 --- a/gcc/c-family/c-warn.c +++ b/gcc/c-family/c-warn.c @@ -362,8 +362,8 @@ warn_tautological_bitwise_comparison (location_t loc, tree_code code, int prec = MAX (TYPE_PRECISION (TREE_TYPE (cst)), TYPE_PRECISION (TREE_TYPE (bitopcst))); - wide_int bitopcstw = wide_int::from (bitopcst, prec, UNSIGNED); - wide_int cstw = wide_int::from (cst, prec, UNSIGNED); + wide_int bitopcstw = wi::to_wide (bitopcst, prec); + wide_int cstw = wi::to_wide (cst, prec); wide_int res; if (TREE_CODE (bitop) == BIT_AND_EXPR) @@ -1240,11 +1240,11 @@ match_case_to_enum_1 (tree key, tree type, tree label) char buf[WIDE_INT_PRINT_BUFFER_SIZE]; if (tree_fits_uhwi_p (key)) - print_dec (key, buf, UNSIGNED); + print_dec (wi::to_wide (key), buf, UNSIGNED); else if (tree_fits_shwi_p (key)) - print_dec (key, buf, SIGNED); + print_dec (wi::to_wide (key), buf, SIGNED); else - print_hex (key, buf); + print_hex (wi::to_wide (key), buf); if (TYPE_NAME (type) == NULL_TREE) warning_at (DECL_SOURCE_LOCATION (CASE_LABEL (label)), @@ -1346,8 +1346,8 @@ c_do_switch_warnings (splay_tree cases, location_t switch_location, /* If there's a case value > 1 or < 0, that is outside bool range, warn. */ if (outside_range_p - || (max && wi::gts_p (max, 1)) - || (min && wi::lts_p (min, 0)) + || (max && wi::gts_p (wi::to_wide (max), 1)) + || (min && wi::lts_p (wi::to_wide (min), 0)) /* And handle the switch (boolean) { @@ -1357,8 +1357,8 @@ c_do_switch_warnings (splay_tree cases, location_t switch_location, } case, where we want to warn. */ || (default_node - && max && wi::eq_p (max, 1) - && min && wi::eq_p (min, 0))) + && max && wi::to_wide (max) == 1 + && min && wi::to_wide (min) == 0)) warning_at (switch_location, OPT_Wswitch_bool, "switch condition has boolean value"); } @@ -2263,7 +2263,7 @@ maybe_warn_shift_overflow (location_t loc, tree op0, tree op1) if (TYPE_UNSIGNED (type0)) return false; - unsigned int min_prec = (wi::min_precision (op0, SIGNED) + unsigned int min_prec = (wi::min_precision (wi::to_wide (op0), SIGNED) + TREE_INT_CST_LOW (op1)); /* Handle the case of left-shifting 1 into the sign bit. * However, shifting 1 _out_ of the sign bit, as in diff --git a/gcc/c/ChangeLog b/gcc/c/ChangeLog index ae9d63991f062..1f697f17f9924 100644 --- a/gcc/c/ChangeLog +++ b/gcc/c/ChangeLog @@ -1,3 +1,24 @@ +2017-10-12 David Malcolm + + * c-parser.c (c_parser_require): Add "type_is_unique" param and + use it to guard calls to maybe_suggest_missing_token_insertion. + (c_parser_parms_list_declarator): Override default value of new + "type_is_unique" param to c_parser_require. + (c_parser_asm_statement): Likewise. + * c-parser.h (c_parser_require): Add "type_is_unique" param, + defaulting to true. + +2017-10-11 Nathan Sidwell + + * c-decl.c (grokdeclarator): Check HAS_DECL_ASSEMBLER_NAME_P too. + +2017-10-10 Richard Sandiford + + * c-parser.c (c_parser_cilk_clause_vectorlength): Use wi::to_wide when + operating on trees as wide_ints. + * c-typeck.c (build_c_cast, c_finish_omp_clauses): Likewise. + (c_tree_equal): Likewise. + 2017-10-04 David Malcolm * c-decl.c (push_parm_decl): Store c_parm's location into the diff --git a/gcc/c/c-decl.c b/gcc/c/c-decl.c index 724d193f01f74..26b34ab3e50ab 100644 --- a/gcc/c/c-decl.c +++ b/gcc/c/c-decl.c @@ -7011,7 +7011,8 @@ grokdeclarator (const struct c_declarator *declarator, /* This is the earliest point at which we might know the assembler name of a variable. Thus, if it's known before this, die horribly. */ - gcc_assert (!DECL_ASSEMBLER_NAME_SET_P (decl)); + gcc_assert (!HAS_DECL_ASSEMBLER_NAME_P (decl) + || !DECL_ASSEMBLER_NAME_SET_P (decl)); if (warn_cxx_compat && VAR_P (decl) diff --git a/gcc/c/c-parser.c b/gcc/c/c-parser.c index 1a5e39edf45bb..6b843247911e8 100644 --- a/gcc/c/c-parser.c +++ b/gcc/c/c-parser.c @@ -1041,13 +1041,21 @@ get_matching_symbol (enum cpp_ttype type) If MATCHING_LOCATION is not UNKNOWN_LOCATION, then highlight it within any error as the location of an "opening" token matching the close token TYPE (e.g. the location of the '(' when TYPE is - CPP_CLOSE_PAREN). */ + CPP_CLOSE_PAREN). + + If TYPE_IS_UNIQUE is true (the default) then msgid describes exactly + one type (e.g. "expected %<)%>") and thus it may be reasonable to + attempt to generate a fix-it hint for the problem. + Otherwise msgid describes multiple token types (e.g. + "expected %<;%>, %<,%> or %<)%>"), and thus we shouldn't attempt to + generate a fix-it hint. */ bool c_parser_require (c_parser *parser, enum cpp_ttype type, const char *msgid, - location_t matching_location) + location_t matching_location, + bool type_is_unique) { if (c_parser_next_token_is (parser, type)) { @@ -1059,6 +1067,13 @@ c_parser_require (c_parser *parser, location_t next_token_loc = c_parser_peek_token (parser)->location; gcc_rich_location richloc (next_token_loc); + /* Potentially supply a fix-it hint, suggesting to add the + missing token immediately after the *previous* token. + This may move the primary location within richloc. */ + if (!parser->error && type_is_unique) + maybe_suggest_missing_token_insertion (&richloc, type, + parser->last_token_location); + /* If matching_location != UNKNOWN_LOCATION, highlight it. Attempt to consolidate diagnostics by printing it as a secondary range within the main diagnostic. */ @@ -3975,7 +3990,8 @@ c_parser_parms_list_declarator (c_parser *parser, tree attrs, tree expr) return get_parm_info (false, expr); } if (!c_parser_require (parser, CPP_COMMA, - "expected %<;%>, %<,%> or %<)%>")) + "expected %<;%>, %<,%> or %<)%>", + UNKNOWN_LOCATION, false)) { c_parser_skip_until_found (parser, CPP_CLOSE_PAREN, NULL); return NULL; @@ -6429,7 +6445,8 @@ c_parser_asm_statement (c_parser *parser) if (!c_parser_require (parser, CPP_COLON, is_goto ? G_("expected %<:%>") - : G_("expected %<:%> or %<)%>"))) + : G_("expected %<:%> or %<)%>"), + UNKNOWN_LOCATION, is_goto)) goto error_close_paren; /* Once past any colon, we're no longer a simple asm. */ @@ -17832,7 +17849,7 @@ c_parser_cilk_clause_vectorlength (c_parser *parser, tree clauses, || !INTEGRAL_TYPE_P (TREE_TYPE (expr))) error_at (loc, "vectorlength must be an integer constant"); - else if (wi::exact_log2 (expr) == -1) + else if (wi::exact_log2 (wi::to_wide (expr)) == -1) error_at (loc, "vectorlength must be a power of 2"); else { diff --git a/gcc/c/c-parser.h b/gcc/c/c-parser.h index 01a7b724081ab..21e40541ce60e 100644 --- a/gcc/c/c-parser.h +++ b/gcc/c/c-parser.h @@ -137,7 +137,8 @@ extern c_token * c_parser_peek_2nd_token (c_parser *parser); extern c_token * c_parser_peek_nth_token (c_parser *parser, unsigned int n); extern bool c_parser_require (c_parser *parser, enum cpp_ttype type, const char *msgid, - location_t matching_location = UNKNOWN_LOCATION); + location_t matching_location = UNKNOWN_LOCATION, + bool type_is_unique=true); extern bool c_parser_error (c_parser *parser, const char *gmsgid); extern void c_parser_consume_token (c_parser *parser); extern void c_parser_skip_until_found (c_parser *parser, enum cpp_ttype type, diff --git a/gcc/c/c-typeck.c b/gcc/c/c-typeck.c index 2a10813190e52..cb9c589e061f4 100644 --- a/gcc/c/c-typeck.c +++ b/gcc/c/c-typeck.c @@ -5684,7 +5684,7 @@ build_c_cast (location_t loc, tree type, tree expr) } else if (TREE_OVERFLOW (value)) /* Reset VALUE's overflow flags, ensuring constant sharing. */ - value = wide_int_to_tree (TREE_TYPE (value), value); + value = wide_int_to_tree (TREE_TYPE (value), wi::to_wide (value)); } } @@ -13504,7 +13504,7 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort) if (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE) { tree offset = TREE_PURPOSE (t); - bool neg = wi::neg_p ((wide_int) offset); + bool neg = wi::neg_p (wi::to_wide (offset)); offset = fold_unary (ABS_EXPR, TREE_TYPE (offset), offset); tree t2 = pointer_int_sum (OMP_CLAUSE_LOCATION (c), neg ? MINUS_EXPR : PLUS_EXPR, @@ -14237,7 +14237,7 @@ c_tree_equal (tree t1, tree t2) switch (code1) { case INTEGER_CST: - return wi::eq_p (t1, t2); + return wi::to_wide (t1) == wi::to_wide (t2); case REAL_CST: return real_equal (&TREE_REAL_CST (t1), &TREE_REAL_CST (t2)); diff --git a/gcc/c/gimple-parser.c b/gcc/c/gimple-parser.c index 22f58f4e8207b..c2e31df218cc8 100644 --- a/gcc/c/gimple-parser.c +++ b/gcc/c/gimple-parser.c @@ -276,7 +276,7 @@ c_parser_gimple_statement (c_parser *parser, gimple_seq *seq) && TREE_CODE (lhs.value) == CALL_EXPR) { gimple *call; - call = gimple_build_call_from_tree (lhs.value); + call = gimple_build_call_from_tree (lhs.value, NULL); gimple_seq_add_stmt (seq, call); gimple_set_location (call, loc); return; @@ -407,7 +407,7 @@ c_parser_gimple_statement (c_parser *parser, gimple_seq *seq) rhs = c_parser_gimple_unary_expression (parser); if (rhs.value != error_mark_node) { - gimple *call = gimple_build_call_from_tree (rhs.value); + gimple *call = gimple_build_call_from_tree (rhs.value, NULL); gimple_call_set_lhs (call, lhs.value); gimple_seq_add_stmt (seq, call); gimple_set_location (call, loc); diff --git a/gcc/caller-save.c b/gcc/caller-save.c index 3ea8e29a09de7..7c787f751634f 100644 --- a/gcc/caller-save.c +++ b/gcc/caller-save.c @@ -1132,17 +1132,7 @@ replace_reg_with_saved_mem (rtx *loc, { /* This is gen_lowpart_if_possible(), but without validating the newly-formed address. */ - int offset = 0; - - if (WORDS_BIG_ENDIAN) - offset = (MAX (GET_MODE_SIZE (GET_MODE (mem)), UNITS_PER_WORD) - - MAX (GET_MODE_SIZE (mode), UNITS_PER_WORD)); - if (BYTES_BIG_ENDIAN) - /* Adjust the address so that the address-after-the-data is - unchanged. */ - offset -= (MIN (UNITS_PER_WORD, GET_MODE_SIZE (mode)) - - MIN (UNITS_PER_WORD, GET_MODE_SIZE (GET_MODE (mem)))); - + HOST_WIDE_INT offset = byte_lowpart_offset (mode, GET_MODE (mem)); mem = adjust_address_nv (mem, mode, offset); } } diff --git a/gcc/calls.c b/gcc/calls.c index 72cf9e016c805..3730f43c7a964 100644 --- a/gcc/calls.c +++ b/gcc/calls.c @@ -607,16 +607,9 @@ special_function_p (const_tree fndecl, int flags) flags |= ECF_RETURNS_TWICE; } - if (DECL_BUILT_IN_CLASS (fndecl) == BUILT_IN_NORMAL) - switch (DECL_FUNCTION_CODE (fndecl)) - { - case BUILT_IN_ALLOCA: - case BUILT_IN_ALLOCA_WITH_ALIGN: - flags |= ECF_MAY_BE_ALLOCA; - break; - default: - break; - } + if (DECL_BUILT_IN_CLASS (fndecl) == BUILT_IN_NORMAL + && ALLOCA_FUNCTION_CODE_P (DECL_FUNCTION_CODE (fndecl))) + flags |= ECF_MAY_BE_ALLOCA; return flags; } @@ -698,8 +691,7 @@ gimple_alloca_call_p (const gimple *stmt) if (fndecl && DECL_BUILT_IN_CLASS (fndecl) == BUILT_IN_NORMAL) switch (DECL_FUNCTION_CODE (fndecl)) { - case BUILT_IN_ALLOCA: - case BUILT_IN_ALLOCA_WITH_ALIGN: + CASE_BUILT_IN_ALLOCA: return true; default: break; @@ -719,8 +711,7 @@ alloca_call_p (const_tree exp) && DECL_BUILT_IN_CLASS (fndecl) == BUILT_IN_NORMAL) switch (DECL_FUNCTION_CODE (fndecl)) { - case BUILT_IN_ALLOCA: - case BUILT_IN_ALLOCA_WITH_ALIGN: + CASE_BUILT_IN_ALLOCA: return true; default: break; @@ -1293,8 +1284,6 @@ get_size_range (tree exp, tree range[2]) tree exptype = TREE_TYPE (exp); unsigned expprec = TYPE_PRECISION (exptype); - wide_int wzero = wi::zero (expprec); - wide_int wmaxval = wide_int (TYPE_MAX_VALUE (exptype)); bool signed_p = !TYPE_UNSIGNED (exptype); @@ -1302,7 +1291,7 @@ get_size_range (tree exp, tree range[2]) { if (signed_p) { - if (wi::les_p (max, wzero)) + if (wi::les_p (max, 0)) { /* EXP is not in a strictly negative range. That means it must be in some (not necessarily strictly) positive @@ -1310,24 +1299,24 @@ get_size_range (tree exp, tree range[2]) conversions negative values end up converted to large positive values, and otherwise they are not valid sizes, the resulting range is in both cases [0, TYPE_MAX]. */ - min = wzero; - max = wmaxval; + min = wi::zero (expprec); + max = wi::to_wide (TYPE_MAX_VALUE (exptype)); } - else if (wi::les_p (min - 1, wzero)) + else if (wi::les_p (min - 1, 0)) { /* EXP is not in a negative-positive range. That means EXP is either negative, or greater than max. Since negative sizes are invalid make the range [MAX + 1, TYPE_MAX]. */ min = max + 1; - max = wmaxval; + max = wi::to_wide (TYPE_MAX_VALUE (exptype)); } else { max = min - 1; - min = wzero; + min = wi::zero (expprec); } } - else if (wi::eq_p (wzero, min - 1)) + else if (wi::eq_p (0, min - 1)) { /* EXP is unsigned and not in the range [1, MAX]. That means it's either zero or greater than MAX. Even though 0 would @@ -1335,12 +1324,12 @@ get_size_range (tree exp, tree range[2]) [MAX, TYPE_MAX] so that when MAX is greater than the limit the whole range is diagnosed. */ min = max + 1; - max = wmaxval; + max = wi::to_wide (TYPE_MAX_VALUE (exptype)); } else { max = min - 1; - min = wzero; + min = wi::zero (expprec); } } @@ -1821,6 +1810,8 @@ initialize_argument_information (int num_actuals ATTRIBUTE_UNUSED, copy = allocate_dynamic_stack_space (size_rtx, TYPE_ALIGN (type), TYPE_ALIGN (type), + max_int_size_in_bytes + (type), true); copy = gen_rtx_MEM (BLKmode, copy); set_mem_attributes (copy, type, 1); @@ -3640,8 +3631,8 @@ expand_call (tree exp, rtx target, int ignore) /* We can pass TRUE as the 4th argument because we just saved the stack pointer and will restore it right after the call. */ - allocate_dynamic_stack_space (push_size, 0, - BIGGEST_ALIGNMENT, true); + allocate_dynamic_stack_space (push_size, 0, BIGGEST_ALIGNMENT, + -1, true); } /* If argument evaluation might modify the stack pointer, @@ -4119,7 +4110,6 @@ expand_call (tree exp, rtx target, int ignore) { tree type = rettype; int unsignedp = TYPE_UNSIGNED (type); - int offset = 0; machine_mode pmode; /* Ensure we promote as expected, and get the new unsignedness. */ @@ -4127,18 +4117,8 @@ expand_call (tree exp, rtx target, int ignore) funtype, 1); gcc_assert (GET_MODE (target) == pmode); - if ((WORDS_BIG_ENDIAN || BYTES_BIG_ENDIAN) - && (GET_MODE_SIZE (GET_MODE (target)) - > GET_MODE_SIZE (TYPE_MODE (type)))) - { - offset = GET_MODE_SIZE (GET_MODE (target)) - - GET_MODE_SIZE (TYPE_MODE (type)); - if (! BYTES_BIG_ENDIAN) - offset = (offset / UNITS_PER_WORD) * UNITS_PER_WORD; - else if (! WORDS_BIG_ENDIAN) - offset %= UNITS_PER_WORD; - } - + unsigned int offset = subreg_lowpart_offset (TYPE_MODE (type), + GET_MODE (target)); target = gen_rtx_SUBREG (TYPE_MODE (type), target, offset); SUBREG_PROMOTED_VAR_P (target) = 1; SUBREG_PROMOTED_SET (target, unsignedp); diff --git a/gcc/cfg.c b/gcc/cfg.c index 01e68aeda5189..41002ec00910b 100644 --- a/gcc/cfg.c +++ b/gcc/cfg.c @@ -263,7 +263,6 @@ unchecked_make_edge (basic_block src, basic_block dst, int flags) e = ggc_cleared_alloc (); n_edges_for_fn (cfun)++; - e->count = profile_count::uninitialized (); e->probability = profile_probability::uninitialized (); e->src = src; e->dest = dst; @@ -334,7 +333,6 @@ make_single_succ_edge (basic_block src, basic_block dest, int flags) edge e = make_edge (src, dest, flags); e->probability = profile_probability::always (); - e->count = src->count; return e; } @@ -445,18 +443,6 @@ check_bb_profile (basic_block bb, FILE * file, int indent) ";; %sInvalid sum of outgoing probabilities %.1f%%\n", s_indent, isum * 100.0 / REG_BR_PROB_BASE); } - profile_count lsum = profile_count::zero (); - FOR_EACH_EDGE (e, ei, bb->succs) - lsum += e->count; - if (EDGE_COUNT (bb->succs) && lsum.differs_from_p (bb->count)) - { - fprintf (file, ";; %sInvalid sum of outgoing counts ", - s_indent); - lsum.dump (file); - fprintf (file, ", should be "); - bb->count.dump (file); - fprintf (file, "\n"); - } } } if (bb != ENTRY_BLOCK_PTR_FOR_FN (fun)) @@ -468,18 +454,6 @@ check_bb_profile (basic_block bb, FILE * file, int indent) fprintf (file, ";; %sInvalid sum of incoming frequencies %i, should be %i\n", s_indent, sum, bb->frequency); - profile_count lsum = profile_count::zero (); - FOR_EACH_EDGE (e, ei, bb->preds) - lsum += e->count; - if (lsum.differs_from_p (bb->count)) - { - fprintf (file, ";; %sInvalid sum of incoming counts ", - s_indent); - lsum.dump (file); - fprintf (file, ", should be "); - bb->count.dump (file); - fprintf (file, "\n"); - } } if (BB_PARTITION (bb) == BB_COLD_PARTITION) { @@ -522,10 +496,10 @@ dump_edge_info (FILE *file, edge e, dump_flags_t flags, int do_succ) fprintf (file, "] "); } - if (e->count.initialized_p () && do_details) + if (e->count ().initialized_p () && do_details) { fputs (" count:", file); - e->count.dump (file); + e->count ().dump (file); } if (e->flags && do_details) @@ -941,10 +915,6 @@ update_bb_profile_for_threading (basic_block bb, int edge_frequency, } gcc_assert (bb == taken_edge->src); - if (dump_file && taken_edge->count < count) - fprintf (dump_file, "edge %i->%i count became negative after threading", - taken_edge->src->index, taken_edge->dest->index); - taken_edge->count -= count; } /* Multiply all frequencies of basic blocks in array BBS of length NBBS @@ -953,7 +923,6 @@ void scale_bbs_frequencies_int (basic_block *bbs, int nbbs, int num, int den) { int i; - edge e; if (num < 0) num = 0; @@ -973,14 +942,11 @@ scale_bbs_frequencies_int (basic_block *bbs, int nbbs, int num, int den) for (i = 0; i < nbbs; i++) { - edge_iterator ei; bbs[i]->frequency = RDIV (bbs[i]->frequency * num, den); /* Make sure the frequencies do not grow over BB_FREQ_MAX. */ if (bbs[i]->frequency > BB_FREQ_MAX) bbs[i]->frequency = BB_FREQ_MAX; bbs[i]->count = bbs[i]->count.apply_scale (num, den); - FOR_EACH_EDGE (e, ei, bbs[i]->succs) - e->count = e->count.apply_scale (num, den); } } @@ -996,7 +962,6 @@ scale_bbs_frequencies_gcov_type (basic_block *bbs, int nbbs, gcov_type num, gcov_type den) { int i; - edge e; gcov_type fraction = RDIV (num * 65536, den); gcc_assert (fraction >= 0); @@ -1004,29 +969,20 @@ scale_bbs_frequencies_gcov_type (basic_block *bbs, int nbbs, gcov_type num, if (num < MAX_SAFE_MULTIPLIER) for (i = 0; i < nbbs; i++) { - edge_iterator ei; bbs[i]->frequency = RDIV (bbs[i]->frequency * num, den); if (bbs[i]->count <= MAX_SAFE_MULTIPLIER) bbs[i]->count = bbs[i]->count.apply_scale (num, den); else bbs[i]->count = bbs[i]->count.apply_scale (fraction, 65536); - FOR_EACH_EDGE (e, ei, bbs[i]->succs) - if (bbs[i]->count <= MAX_SAFE_MULTIPLIER) - e->count = e->count.apply_scale (num, den); - else - e->count = e->count.apply_scale (fraction, 65536); } else for (i = 0; i < nbbs; i++) { - edge_iterator ei; if (sizeof (gcov_type) > sizeof (int)) bbs[i]->frequency = RDIV (bbs[i]->frequency * num, den); else bbs[i]->frequency = RDIV (bbs[i]->frequency * fraction, 65536); bbs[i]->count = bbs[i]->count.apply_scale (fraction, 65536); - FOR_EACH_EDGE (e, ei, bbs[i]->succs) - e->count = e->count.apply_scale (fraction, 65536); } } @@ -1038,16 +994,12 @@ scale_bbs_frequencies_profile_count (basic_block *bbs, int nbbs, profile_count num, profile_count den) { int i; - edge e; for (i = 0; i < nbbs; i++) { - edge_iterator ei; bbs[i]->frequency = RDIV (bbs[i]->frequency * num.to_gcov_type (), den.to_gcov_type ()); bbs[i]->count = bbs[i]->count.apply_scale (num, den); - FOR_EACH_EDGE (e, ei, bbs[i]->succs) - e->count = e->count.apply_scale (num, den); } } @@ -1059,15 +1011,11 @@ scale_bbs_frequencies (basic_block *bbs, int nbbs, profile_probability p) { int i; - edge e; for (i = 0; i < nbbs; i++) { - edge_iterator ei; bbs[i]->frequency = p.apply (bbs[i]->frequency); bbs[i]->count = bbs[i]->count.apply_probability (p); - FOR_EACH_EDGE (e, ei, bbs[i]->succs) - e->count = e->count.apply_probability (p); } } diff --git a/gcc/cfganal.c b/gcc/cfganal.c index 394d986c945a3..c506067fdcd19 100644 --- a/gcc/cfganal.c +++ b/gcc/cfganal.c @@ -612,7 +612,6 @@ connect_infinite_loops_to_exit (void) basic_block deadend_block = dfs_find_deadend (unvisited_block); edge e = make_edge (deadend_block, EXIT_BLOCK_PTR_FOR_FN (cfun), EDGE_FAKE); - e->count = profile_count::zero (); e->probability = profile_probability::never (); dfs.add_bb (deadend_block); } diff --git a/gcc/cfgbuild.c b/gcc/cfgbuild.c index 62956b2a6a2a0..c6d506ae47426 100644 --- a/gcc/cfgbuild.c +++ b/gcc/cfgbuild.c @@ -576,10 +576,8 @@ compute_outgoing_frequencies (basic_block b) e = BRANCH_EDGE (b); e->probability = profile_probability::from_reg_br_prob_note (probability); - e->count = b->count.apply_probability (e->probability); f = FALLTHRU_EDGE (b); f->probability = e->probability.invert (); - f->count = b->count - e->count; return; } else @@ -591,7 +589,6 @@ compute_outgoing_frequencies (basic_block b) { e = single_succ_edge (b); e->probability = profile_probability::always (); - e->count = b->count; return; } else @@ -610,10 +607,6 @@ compute_outgoing_frequencies (basic_block b) if (complex_edge) guess_outgoing_edge_probabilities (b); } - - if (b->count.initialized_p ()) - FOR_EACH_EDGE (e, ei, b->succs) - e->count = b->count.apply_probability (e->probability); } /* Assume that some pass has inserted labels or control flow @@ -679,9 +672,9 @@ find_many_sub_basic_blocks (sbitmap blocks) bb->frequency = 0; FOR_EACH_EDGE (e, ei, bb->preds) { - if (e->count.initialized_p ()) + if (e->count ().initialized_p ()) { - bb->count += e->count; + bb->count += e->count (); initialized_src = true; } else diff --git a/gcc/cfgcleanup.c b/gcc/cfgcleanup.c index 365c971effb3d..c2b0434f179bd 100644 --- a/gcc/cfgcleanup.c +++ b/gcc/cfgcleanup.c @@ -558,7 +558,7 @@ try_forward_edges (int mode, basic_block b) else { /* Save the values now, as the edge may get removed. */ - profile_count edge_count = e->count; + profile_count edge_count = e->count (); profile_probability edge_probability = e->probability; int edge_frequency; int n = 0; @@ -616,7 +616,6 @@ try_forward_edges (int mode, basic_block b) t = single_succ_edge (first); } - t->count -= edge_count; first = t->dest; } while (first != target); @@ -2129,22 +2128,16 @@ try_crossjump_to_edge (int mode, edge e1, edge e2, break; } - s->count += s2->count; - /* Take care to update possible forwarder blocks. We verified that there is no more than one in the chain, so we can't run into infinite loop. */ if (FORWARDER_BLOCK_P (s->dest)) { - single_succ_edge (s->dest)->count += s2->count; - s->dest->count += s2->count; s->dest->frequency += EDGE_FREQUENCY (s); } if (FORWARDER_BLOCK_P (s2->dest)) { - single_succ_edge (s2->dest)->count -= s2->count; - s2->dest->count -= s2->count; s2->dest->frequency -= EDGE_FREQUENCY (s); if (s2->dest->frequency < 0) s2->dest->frequency = 0; diff --git a/gcc/cfgexpand.c b/gcc/cfgexpand.c index bd3312eb3baa0..d0e0782148954 100644 --- a/gcc/cfgexpand.c +++ b/gcc/cfgexpand.c @@ -2507,7 +2507,7 @@ expand_gimple_cond (basic_block bb, gcond *stmt) dest = false_edge->dest; redirect_edge_succ (false_edge, new_bb); false_edge->flags |= EDGE_FALLTHRU; - new_bb->count = false_edge->count; + new_bb->count = false_edge->count (); new_bb->frequency = EDGE_FREQUENCY (false_edge); loop_p loop = find_common_loop (bb->loop_father, dest->loop_father); add_bb_to_loop (new_bb, loop); @@ -2634,8 +2634,7 @@ expand_call_stmt (gcall *stmt) CALL_EXPR_RETURN_SLOT_OPT (exp) = gimple_call_return_slot_opt_p (stmt); if (decl && DECL_BUILT_IN_CLASS (decl) == BUILT_IN_NORMAL - && (DECL_FUNCTION_CODE (decl) == BUILT_IN_ALLOCA - || DECL_FUNCTION_CODE (decl) == BUILT_IN_ALLOCA_WITH_ALIGN)) + && ALLOCA_FUNCTION_CODE_P (DECL_FUNCTION_CODE (decl))) CALL_ALLOCA_FOR_VAR_P (exp) = gimple_call_alloca_for_var_p (stmt); else CALL_FROM_THUNK_P (exp) = gimple_call_from_thunk_p (stmt); @@ -2659,12 +2658,28 @@ expand_call_stmt (gcall *stmt) } } + rtx_insn *before_call = get_last_insn (); lhs = gimple_call_lhs (stmt); if (lhs) expand_assignment (lhs, exp, false); else expand_expr (exp, const0_rtx, VOIDmode, EXPAND_NORMAL); + /* If the gimple call is an indirect call and has 'nocf_check' + attribute find a generated CALL insn to mark it as no + control-flow verification is needed. */ + if (gimple_call_nocf_check_p (stmt) + && !gimple_call_fndecl (stmt)) + { + rtx_insn *last = get_last_insn (); + while (!CALL_P (last) + && last != before_call) + last = PREV_INSN (last); + + if (last != before_call) + add_reg_note (last, REG_CALL_NOCF_CHECK, const0_rtx); + } + mark_transaction_restart_calls (stmt); } @@ -3818,7 +3833,6 @@ expand_gimple_tailcall (basic_block bb, gcall *stmt, bool *can_fallthru) the exit block. */ probability = profile_probability::never (); - profile_count count = profile_count::zero (); for (ei = ei_start (bb->succs); (e = ei_safe_edge (ei)); ) { @@ -3826,12 +3840,10 @@ expand_gimple_tailcall (basic_block bb, gcall *stmt, bool *can_fallthru) { if (e->dest != EXIT_BLOCK_PTR_FOR_FN (cfun)) { - e->dest->count -= e->count; e->dest->frequency -= EDGE_FREQUENCY (e); if (e->dest->frequency < 0) e->dest->frequency = 0; } - count += e->count; probability += e->probability; remove_edge (e); } @@ -3861,7 +3873,6 @@ expand_gimple_tailcall (basic_block bb, gcall *stmt, bool *can_fallthru) e = make_edge (bb, EXIT_BLOCK_PTR_FOR_FN (cfun), EDGE_ABNORMAL | EDGE_SIBCALL); e->probability = probability; - e->count = count; BB_END (bb) = last; update_bb_for_insn (bb); @@ -4326,9 +4337,11 @@ expand_debug_expr (tree exp) if (FLOAT_MODE_P (mode) && FLOAT_MODE_P (inner_mode)) { - if (GET_MODE_BITSIZE (mode) == GET_MODE_BITSIZE (inner_mode)) + if (GET_MODE_UNIT_BITSIZE (mode) + == GET_MODE_UNIT_BITSIZE (inner_mode)) op0 = simplify_gen_subreg (mode, op0, inner_mode, 0); - else if (GET_MODE_BITSIZE (mode) < GET_MODE_BITSIZE (inner_mode)) + else if (GET_MODE_UNIT_BITSIZE (mode) + < GET_MODE_UNIT_BITSIZE (inner_mode)) op0 = simplify_gen_unary (FLOAT_TRUNCATE, mode, op0, inner_mode); else op0 = simplify_gen_unary (FLOAT_EXTEND, mode, op0, inner_mode); @@ -5191,9 +5204,11 @@ expand_debug_source_expr (tree exp) if (FLOAT_MODE_P (mode) && FLOAT_MODE_P (inner_mode)) { - if (GET_MODE_BITSIZE (mode) == GET_MODE_BITSIZE (inner_mode)) + if (GET_MODE_UNIT_BITSIZE (mode) + == GET_MODE_UNIT_BITSIZE (inner_mode)) op0 = simplify_gen_subreg (mode, op0, inner_mode, 0); - else if (GET_MODE_BITSIZE (mode) < GET_MODE_BITSIZE (inner_mode)) + else if (GET_MODE_UNIT_BITSIZE (mode) + < GET_MODE_UNIT_BITSIZE (inner_mode)) op0 = simplify_gen_unary (FLOAT_TRUNCATE, mode, op0, inner_mode); else op0 = simplify_gen_unary (FLOAT_EXTEND, mode, op0, inner_mode); @@ -5927,8 +5942,7 @@ construct_exit_block (void) FOR_EACH_EDGE (e2, ei, EXIT_BLOCK_PTR_FOR_FN (cfun)->preds) if (e2 != e) { - e->count -= e2->count; - exit_block->count -= e2->count; + exit_block->count -= e2->count (); exit_block->frequency -= EDGE_FREQUENCY (e2); } if (exit_block->frequency < 0) diff --git a/gcc/cfghooks.c b/gcc/cfghooks.c index 18dc49a035e60..320036bc7577c 100644 --- a/gcc/cfghooks.c +++ b/gcc/cfghooks.c @@ -152,6 +152,7 @@ verify_flow_info (void) bb->index, bb->frequency); err = 1; } + FOR_EACH_EDGE (e, ei, bb->succs) { if (last_visited [e->dest->index] == bb) @@ -160,15 +161,18 @@ verify_flow_info (void) e->src->index, e->dest->index); err = 1; } - if (!e->probability.verify ()) + /* FIXME: Graphite and SLJL and target code still tends to produce + edges with no probablity. */ + if (profile_status_for_fn (cfun) >= PROFILE_GUESSED + && !e->probability.initialized_p () && 0) { - error ("verify_flow_info: Wrong probability of edge %i->%i", - e->src->index, e->dest->index); + error ("Uninitialized probability of edge %i->%i", e->src->index, + e->dest->index); err = 1; } - if (!e->count.verify ()) + if (!e->probability.verify ()) { - error ("verify_flow_info: Wrong count of edge %i->%i", + error ("verify_flow_info: Wrong probability of edge %i->%i", e->src->index, e->dest->index); err = 1; } @@ -443,7 +447,6 @@ redirect_edge_succ_nodup (edge e, basic_block new_succ) { s->flags |= e->flags; s->probability += e->probability; - s->count += e->count; /* FIXME: This should be called via a hook and only for IR_GIMPLE. */ redirect_edge_var_map_dup (s, e); remove_edge (e); @@ -622,7 +625,7 @@ basic_block split_edge (edge e) { basic_block ret; - profile_count count = e->count; + profile_count count = e->count (); int freq = EDGE_FREQUENCY (e); edge f; bool irr = (e->flags & EDGE_IRREDUCIBLE_LOOP) != 0; @@ -639,7 +642,6 @@ split_edge (edge e) ret->count = count; ret->frequency = freq; single_succ_edge (ret)->probability = profile_probability::always (); - single_succ_edge (ret)->count = count; if (irr) { @@ -868,7 +870,6 @@ make_forwarder_block (basic_block bb, bool (*redirect_edge_p) (edge), dummy = fallthru->src; dummy->count = profile_count::zero (); dummy->frequency = 0; - fallthru->count = profile_count::zero (); bb = fallthru->dest; /* Redirect back edges we want to keep. */ @@ -882,8 +883,7 @@ make_forwarder_block (basic_block bb, bool (*redirect_edge_p) (edge), if (dummy->frequency > BB_FREQ_MAX) dummy->frequency = BB_FREQ_MAX; - dummy->count += e->count; - fallthru->count += e->count; + dummy->count += e->count (); ei_next (&ei); continue; } @@ -1069,7 +1069,7 @@ duplicate_block (basic_block bb, edge e, basic_block after) { edge s, n; basic_block new_bb; - profile_count new_count = e ? e->count : profile_count::uninitialized (); + profile_count new_count = e ? e->count (): profile_count::uninitialized (); edge_iterator ei; if (!cfg_hooks->duplicate_block) @@ -1093,13 +1093,6 @@ duplicate_block (basic_block bb, edge e, basic_block after) is no need to actually check for duplicated edges. */ n = unchecked_make_edge (new_bb, s->dest, s->flags); n->probability = s->probability; - if (e && bb->count > profile_count::zero ()) - { - n->count = s->count.apply_scale (new_count, bb->count); - s->count -= n->count; - } - else - n->count = s->count; n->aux = s->aux; } @@ -1463,7 +1456,7 @@ account_profile_record (struct profile_record *record, int after_pass) record->num_mismatched_freq_out[after_pass]++; profile_count lsum = profile_count::zero (); FOR_EACH_EDGE (e, ei, bb->succs) - lsum += e->count; + lsum += e->count (); if (EDGE_COUNT (bb->succs) && (lsum.differs_from_p (bb->count))) record->num_mismatched_count_out[after_pass]++; } @@ -1479,7 +1472,7 @@ account_profile_record (struct profile_record *record, int after_pass) record->num_mismatched_freq_in[after_pass]++; profile_count lsum = profile_count::zero (); FOR_EACH_EDGE (e, ei, bb->preds) - lsum += e->count; + lsum += e->count (); if (lsum.differs_from_p (bb->count)) record->num_mismatched_count_in[after_pass]++; } diff --git a/gcc/cfgloop.c b/gcc/cfgloop.c index 6911426787b1f..4b0374abefa5a 100644 --- a/gcc/cfgloop.c +++ b/gcc/cfgloop.c @@ -599,12 +599,12 @@ find_subloop_latch_edge_by_profile (vec latches) FOR_EACH_VEC_ELT (latches, i, e) { - if (e->count > mcount) + if (e->count ()> mcount) { me = e; - mcount = e->count; + mcount = e->count(); } - tcount += e->count; + tcount += e->count(); } if (!tcount.initialized_p () || tcount < HEAVY_EDGE_MIN_SAMPLES @@ -1713,12 +1713,19 @@ loop_preheader_edge (const struct loop *loop) edge e; edge_iterator ei; - gcc_assert (loops_state_satisfies_p (LOOPS_HAVE_PREHEADERS)); + gcc_assert (loops_state_satisfies_p (LOOPS_HAVE_PREHEADERS) + && ! loops_state_satisfies_p (LOOPS_MAY_HAVE_MULTIPLE_LATCHES)); FOR_EACH_EDGE (e, ei, loop->header->preds) if (e->src != loop->latch) break; + if (! e) + { + gcc_assert (! loop_outer (loop)); + return single_succ_edge (ENTRY_BLOCK_PTR_FOR_FN (cfun)); + } + return e; } diff --git a/gcc/cfgloopanal.c b/gcc/cfgloopanal.c index 73710abac6e2e..15b39e335fd04 100644 --- a/gcc/cfgloopanal.c +++ b/gcc/cfgloopanal.c @@ -253,9 +253,9 @@ expected_loop_iterations_unbounded (const struct loop *loop, FOR_EACH_EDGE (e, ei, loop->header->preds) if (e->src == loop->latch) - count_latch = e->count; + count_latch = e->count (); else - count_in += e->count; + count_in += e->count (); if (!count_latch.initialized_p ()) ; diff --git a/gcc/cfgloopmanip.c b/gcc/cfgloopmanip.c index fd335c3fe1dd5..af65183bfaa41 100644 --- a/gcc/cfgloopmanip.c +++ b/gcc/cfgloopmanip.c @@ -546,16 +546,12 @@ scale_loop_profile (struct loop *loop, profile_probability p, /* Probability of exit must be 1/iterations. */ freq_delta = EDGE_FREQUENCY (e); + count_delta = e->count (); e->probability = profile_probability::always () .apply_scale (1, iteration_bound); other_e->probability = e->probability.invert (); freq_delta -= EDGE_FREQUENCY (e); - - /* Adjust counts accordingly. */ - count_delta = e->count; - e->count = e->src->count.apply_probability (e->probability); - other_e->count = e->src->count.apply_probability (other_e->probability); - count_delta -= e->count; + count_delta -= e->count (); /* If latch exists, change its frequency and count, since we changed probability of exit. Theoretically we should update everything from @@ -582,7 +578,7 @@ scale_loop_profile (struct loop *loop, profile_probability p, FOR_EACH_EDGE (e, ei, loop->header->preds) if (e->src != loop->latch) - count_in += e->count; + count_in += e->count (); if (count_in > profile_count::zero () ) { @@ -872,14 +868,12 @@ loopify (edge latch_edge, edge header_edge, struct loop *outer = loop_outer (succ_bb->loop_father); int freq; profile_count cnt; - edge e; - edge_iterator ei; loop->header = header_edge->dest; loop->latch = latch_edge->src; freq = EDGE_FREQUENCY (header_edge); - cnt = header_edge->count; + cnt = header_edge->count (); /* Redirect edges. */ loop_redirect_edge (latch_edge, loop->header); @@ -912,10 +906,6 @@ loopify (edge latch_edge, edge header_edge, { switch_bb->frequency = freq; switch_bb->count = cnt; - FOR_EACH_EDGE (e, ei, switch_bb->succs) - { - e->count = switch_bb->count.apply_probability (e->probability); - } } scale_loop_frequencies (loop, false_scale); scale_loop_frequencies (succ_bb->loop_father, true_scale); @@ -1650,8 +1640,6 @@ lv_adjust_loop_entry_edge (basic_block first_head, basic_block second_head, current_ir_type () == IR_GIMPLE ? EDGE_TRUE_VALUE : 0); e1->probability = then_prob; e->probability = else_prob; - e1->count = e->count.apply_probability (e1->probability); - e->count = e->count.apply_probability (e->probability); set_immediate_dominator (CDI_DOMINATORS, first_head, new_head); set_immediate_dominator (CDI_DOMINATORS, second_head, new_head); diff --git a/gcc/cfgrtl.c b/gcc/cfgrtl.c index 6ef47b7e61f4f..65e25dc129334 100644 --- a/gcc/cfgrtl.c +++ b/gcc/cfgrtl.c @@ -1156,7 +1156,6 @@ try_redirect_by_replacing_jump (edge e, basic_block target, bool in_cfglayout) e->flags = 0; e->probability = profile_probability::always (); - e->count = src->count; if (e->dest != target) redirect_edge_succ (e, target); @@ -1505,9 +1504,7 @@ force_nonfallthru_and_redirect (edge e, basic_block target, rtx jump_label) int prob = XINT (note, 0); b->probability = profile_probability::from_reg_br_prob_note (prob); - b->count = e->count.apply_probability (b->probability); e->probability -= e->probability; - e->count -= b->count; } } @@ -1615,7 +1612,7 @@ force_nonfallthru_and_redirect (edge e, basic_block target, rtx jump_label) if (EDGE_COUNT (e->src->succs) >= 2 || abnormal_edge_flags || asm_goto_edge) { rtx_insn *new_head; - profile_count count = e->count; + profile_count count = e->count (); profile_probability probability = e->probability; /* Create the new structures. */ @@ -1640,7 +1637,6 @@ force_nonfallthru_and_redirect (edge e, basic_block target, rtx jump_label) /* Wire edge in. */ new_edge = make_edge (e->src, jump_block, EDGE_FALLTHRU); new_edge->probability = probability; - new_edge->count = count; /* Redirect old edge. */ redirect_edge_pred (e, jump_block); @@ -1655,13 +1651,11 @@ force_nonfallthru_and_redirect (edge e, basic_block target, rtx jump_label) if (asm_goto_edge) { new_edge->probability = new_edge->probability.apply_scale (1, 2); - new_edge->count = new_edge->count.apply_scale (1, 2); jump_block->count = jump_block->count.apply_scale (1, 2); jump_block->frequency /= 2; edge new_edge2 = make_edge (new_edge->src, target, e->flags & ~EDGE_FALLTHRU); new_edge2->probability = probability - new_edge->probability; - new_edge2->count = count - new_edge->count; } new_bb = jump_block; @@ -3155,7 +3149,6 @@ purge_dead_edges (basic_block bb) if (single_succ_p (bb)) { single_succ_edge (bb)->probability = profile_probability::always (); - single_succ_edge (bb)->count = bb->count; } else { @@ -3168,8 +3161,6 @@ purge_dead_edges (basic_block bb) b->probability = profile_probability::from_reg_br_prob_note (XINT (note, 0)); f->probability = b->probability.invert (); - b->count = bb->count.apply_probability (b->probability); - f->count = bb->count.apply_probability (f->probability); } return purged; @@ -3221,7 +3212,6 @@ purge_dead_edges (basic_block bb) gcc_assert (single_succ_p (bb)); single_succ_edge (bb)->probability = profile_probability::always (); - single_succ_edge (bb)->count = bb->count; if (dump_file) fprintf (dump_file, "Purged non-fallthru edges from bb %i\n", @@ -4906,7 +4896,6 @@ rtl_flow_call_edges_add (sbitmap blocks) edge ne = make_edge (bb, EXIT_BLOCK_PTR_FOR_FN (cfun), EDGE_FAKE); ne->probability = profile_probability::guessed_never (); - ne->count = profile_count::guessed_zero (); } if (insn == BB_HEAD (bb)) @@ -5039,14 +5028,13 @@ rtl_account_profile_record (basic_block bb, int after_pass, FOR_BB_INSNS (bb, insn) if (INSN_P (insn)) { - record->size[after_pass] - += insn_rtx_cost (PATTERN (insn), false); + record->size[after_pass] += insn_cost (insn, false); if (bb->count.initialized_p ()) record->time[after_pass] - += insn_rtx_cost (PATTERN (insn), true) * bb->count.to_gcov_type (); + += insn_cost (insn, true) * bb->count.to_gcov_type (); else if (profile_status_for_fn (cfun) == PROFILE_GUESSED) record->time[after_pass] - += insn_rtx_cost (PATTERN (insn), true) * bb->frequency; + += insn_cost (insn, true) * bb->frequency; } } diff --git a/gcc/cgraph.c b/gcc/cgraph.c index 3d0cefbd46bac..d8da3dd76cdff 100644 --- a/gcc/cgraph.c +++ b/gcc/cgraph.c @@ -626,7 +626,7 @@ cgraph_node::create_thunk (tree alias, tree, bool this_adjusting, /* Make sure that if VIRTUAL_OFFSET is in sync with VIRTUAL_VALUE. */ gcc_checking_assert (virtual_offset - ? wi::eq_p (virtual_offset, virtual_value) + ? virtual_value == wi::to_wide (virtual_offset) : virtual_value == 0); node->thunk.fixed_offset = fixed_offset; diff --git a/gcc/cgraphunit.c b/gcc/cgraphunit.c index 8c1acf770b916..ea52f43dc6a7d 100644 --- a/gcc/cgraphunit.c +++ b/gcc/cgraphunit.c @@ -1296,6 +1296,93 @@ analyze_functions (bool first_time) input_location = saved_loc; } +/* Check declaration of the type of ALIAS for compatibility with its TARGET + (which may be an ifunc resolver) and issue a diagnostic when they are + not compatible according to language rules (plus a C++ extension for + non-static member functions). */ + +static void +maybe_diag_incompatible_alias (tree alias, tree target) +{ + tree altype = TREE_TYPE (alias); + tree targtype = TREE_TYPE (target); + + bool ifunc = lookup_attribute ("ifunc", DECL_ATTRIBUTES (alias)); + tree funcptr = altype; + + if (ifunc) + { + /* Handle attribute ifunc first. */ + if (TREE_CODE (altype) == METHOD_TYPE) + { + /* Set FUNCPTR to the type of the alias target. If the type + is a non-static member function of class C, construct a type + of an ordinary function taking C* as the first argument, + followed by the member function argument list, and use it + instead to check for incompatibility. This conversion is + not defined by the language but an extension provided by + G++. */ + + tree rettype = TREE_TYPE (altype); + tree args = TYPE_ARG_TYPES (altype); + altype = build_function_type (rettype, args); + funcptr = altype; + } + + targtype = TREE_TYPE (targtype); + + if (POINTER_TYPE_P (targtype)) + { + targtype = TREE_TYPE (targtype); + + /* Only issue Wattribute-alias for conversions to void* with + -Wextra. */ + if (VOID_TYPE_P (targtype) && !extra_warnings) + return; + + /* Proceed to handle incompatible ifunc resolvers below. */ + } + else + { + funcptr = build_pointer_type (funcptr); + + error_at (DECL_SOURCE_LOCATION (target), + "% resolver for %qD must return %qT", + alias, funcptr); + inform (DECL_SOURCE_LOCATION (alias), + "resolver indirect function declared here"); + return; + } + } + + if ((!FUNC_OR_METHOD_TYPE_P (targtype) + || (prototype_p (altype) + && prototype_p (targtype) + && !types_compatible_p (altype, targtype)))) + { + /* Warn for incompatibilities. Avoid warning for functions + without a prototype to make it possible to declare aliases + without knowing the exact type, as libstdc++ does. */ + if (ifunc) + { + funcptr = build_pointer_type (funcptr); + + if (warning_at (DECL_SOURCE_LOCATION (target), + OPT_Wattribute_alias, + "% resolver for %qD should return %qT", + alias, funcptr)) + inform (DECL_SOURCE_LOCATION (alias), + "resolver indirect function declared here"); + } + else if (warning_at (DECL_SOURCE_LOCATION (alias), + OPT_Wattribute_alias, + "%qD alias between functions of incompatible " + "types %qT and %qT", alias, altype, targtype)) + inform (DECL_SOURCE_LOCATION (target), + "aliased declaration here"); + } +} + /* Translate the ugly representation of aliases as alias pairs into nice representation in callgraph. We don't handle all cases yet, unfortunately. */ @@ -1305,7 +1392,7 @@ handle_alias_pairs (void) { alias_pair *p; unsigned i; - + for (i = 0; alias_pairs && alias_pairs->iterate (i, &p);) { symtab_node *target_node = symtab_node::get_for_asmname (p->target); @@ -1352,65 +1439,7 @@ handle_alias_pairs (void) if (TREE_CODE (p->decl) == FUNCTION_DECL && target_node && is_a (target_node)) { - tree t1 = TREE_TYPE (p->decl); - tree t2 = TREE_TYPE (target_node->decl); - - if (lookup_attribute ("ifunc", DECL_ATTRIBUTES (p->decl))) - { - t2 = TREE_TYPE (t2); - if (POINTER_TYPE_P (t2)) - { - t2 = TREE_TYPE (t2); - if (!FUNC_OR_METHOD_TYPE_P (t2)) - { - if (warning_at (DECL_SOURCE_LOCATION (p->decl), - OPT_Wattributes, - "%q+D % resolver should return " - "a function pointer", - p->decl)) - inform (DECL_SOURCE_LOCATION (target_node->decl), - "resolver declaration here"); - - t2 = NULL_TREE; - } - } - else - { - /* Deal with static member function pointers. */ - if (TREE_CODE (t2) == RECORD_TYPE - && TYPE_FIELDS (t2) - && TREE_CODE (TREE_TYPE (TYPE_FIELDS (t2))) == POINTER_TYPE - && (TREE_CODE (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (t2)))) - == METHOD_TYPE)) - t2 = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (t2))); - else - { - error ("%q+D % resolver must return a function " - "pointer", - p->decl); - inform (DECL_SOURCE_LOCATION (target_node->decl), - "resolver declaration here"); - - t2 = NULL_TREE; - } - } - } - - if (t2 - && (!FUNC_OR_METHOD_TYPE_P (t2) - || (prototype_p (t1) - && prototype_p (t2) - && !types_compatible_p (t1, t2)))) - { - /* Warn for incompatibilities. Avoid warning for functions - without a prototype to make it possible to declare aliases - without knowing the exact type, as libstdc++ does. */ - if (warning_at (DECL_SOURCE_LOCATION (p->decl), OPT_Wattributes, - "%q+D alias between functions of incompatible " - "types %qT and %qT", p->decl, t1, t2)) - inform (DECL_SOURCE_LOCATION (target_node->decl), - "aliased declaration here"); - } + maybe_diag_incompatible_alias (p->decl, target_node->decl); cgraph_node *src_node = cgraph_node::get (p->decl); if (src_node && src_node->definition) @@ -1579,10 +1608,8 @@ init_lowered_empty_function (tree decl, bool in_ssa, profile_count count) bb->count = count; bb->frequency = BB_FREQ_MAX; e = make_edge (ENTRY_BLOCK_PTR_FOR_FN (cfun), bb, EDGE_FALLTHRU); - e->count = count; e->probability = profile_probability::always (); e = make_edge (bb, EXIT_BLOCK_PTR_FOR_FN (cfun), 0); - e->count = count; e->probability = profile_probability::always (); add_bb_to_loop (bb, ENTRY_BLOCK_PTR_FOR_FN (cfun)->loop_father); @@ -1959,17 +1986,14 @@ cgraph_node::expand_thunk (bool output_asm_thunks, bool force_gimple_thunk) e = make_edge (bb, then_bb, EDGE_TRUE_VALUE); e->probability = profile_probability::guessed_always () .apply_scale (1, 16); - e->count = count - count.apply_scale (1, 16); e = make_edge (bb, else_bb, EDGE_FALSE_VALUE); e->probability = profile_probability::guessed_always () .apply_scale (1, 16); - e->count = count.apply_scale (1, 16); make_single_succ_edge (return_bb, EXIT_BLOCK_PTR_FOR_FN (cfun), 0); make_single_succ_edge (then_bb, return_bb, EDGE_FALLTHRU); e = make_edge (else_bb, return_bb, EDGE_FALLTHRU); e->probability = profile_probability::always (); - e->count = count.apply_scale (1, 16); bsi = gsi_last_bb (then_bb); } diff --git a/gcc/combine.c b/gcc/combine.c index 400cef3495a3f..a58bb1e9470c3 100644 --- a/gcc/combine.c +++ b/gcc/combine.c @@ -311,7 +311,7 @@ static bool optimize_this_for_speed_p; static int max_uid_known; -/* The following array records the insn_rtx_cost for every insn +/* The following array records the insn_cost for every insn in the instruction stream. */ static int *uid_insn_cost; @@ -841,7 +841,7 @@ do_SUBST_LINK (struct insn_link **into, struct insn_link *newval) #define SUBST_LINK(oldval, newval) do_SUBST_LINK (&oldval, newval) /* Subroutine of try_combine. Determine whether the replacement patterns - NEWPAT, NEWI2PAT and NEWOTHERPAT are cheaper according to insn_rtx_cost + NEWPAT, NEWI2PAT and NEWOTHERPAT are cheaper according to insn_cost than the original sequence I0, I1, I2, I3 and undobuf.other_insn. Note that I0, I1 and/or NEWI2PAT may be NULL_RTX. Similarly, NEWOTHERPAT and undobuf.other_insn may also both be NULL_RTX. Return false if the cost @@ -856,7 +856,7 @@ combine_validate_cost (rtx_insn *i0, rtx_insn *i1, rtx_insn *i2, rtx_insn *i3, int new_i2_cost, new_i3_cost; int old_cost, new_cost; - /* Lookup the original insn_rtx_costs. */ + /* Lookup the original insn_costs. */ i2_cost = INSN_COST (i2); i3_cost = INSN_COST (i3); @@ -888,11 +888,23 @@ combine_validate_cost (rtx_insn *i0, rtx_insn *i1, rtx_insn *i2, rtx_insn *i3, old_cost -= i1_cost; - /* Calculate the replacement insn_rtx_costs. */ - new_i3_cost = insn_rtx_cost (newpat, optimize_this_for_speed_p); + /* Calculate the replacement insn_costs. */ + rtx tmp = PATTERN (i3); + PATTERN (i3) = newpat; + int tmpi = INSN_CODE (i3); + INSN_CODE (i3) = -1; + new_i3_cost = insn_cost (i3, optimize_this_for_speed_p); + PATTERN (i3) = tmp; + INSN_CODE (i3) = tmpi; if (newi2pat) { - new_i2_cost = insn_rtx_cost (newi2pat, optimize_this_for_speed_p); + tmp = PATTERN (i2); + PATTERN (i2) = newi2pat; + tmpi = INSN_CODE (i2); + INSN_CODE (i2) = -1; + new_i2_cost = insn_cost (i2, optimize_this_for_speed_p); + PATTERN (i2) = tmp; + INSN_CODE (i2) = tmpi; new_cost = (new_i2_cost > 0 && new_i3_cost > 0) ? new_i2_cost + new_i3_cost : 0; } @@ -907,7 +919,14 @@ combine_validate_cost (rtx_insn *i0, rtx_insn *i1, rtx_insn *i2, rtx_insn *i3, int old_other_cost, new_other_cost; old_other_cost = INSN_COST (undobuf.other_insn); - new_other_cost = insn_rtx_cost (newotherpat, optimize_this_for_speed_p); + tmp = PATTERN (undobuf.other_insn); + PATTERN (undobuf.other_insn) = newotherpat; + tmpi = INSN_CODE (undobuf.other_insn); + INSN_CODE (undobuf.other_insn) = -1; + new_other_cost = insn_cost (undobuf.other_insn, + optimize_this_for_speed_p); + PATTERN (undobuf.other_insn) = tmp; + INSN_CODE (undobuf.other_insn) = tmpi; if (old_other_cost > 0 && new_other_cost > 0) { old_cost += old_other_cost; @@ -1208,10 +1227,9 @@ combine_instructions (rtx_insn *f, unsigned int nregs) set_nonzero_bits_and_sign_copies (XEXP (links, 0), NULL_RTX, insn); - /* Record the current insn_rtx_cost of this instruction. */ + /* Record the current insn_cost of this instruction. */ if (NONJUMP_INSN_P (insn)) - INSN_COST (insn) = insn_rtx_cost (PATTERN (insn), - optimize_this_for_speed_p); + INSN_COST (insn) = insn_cost (insn, optimize_this_for_speed_p); if (dump_file) { fprintf (dump_file, "insn_cost %d for ", INSN_COST (insn)); @@ -2457,6 +2475,12 @@ can_change_dest_mode (rtx x, int added_sets, machine_mode mode) if (!REG_P (x)) return false; + /* Don't change between modes with different underlying register sizes, + since this could lead to invalid subregs. */ + if (REGMODE_NATURAL_SIZE (mode) + != REGMODE_NATURAL_SIZE (GET_MODE (x))) + return false; + regno = REGNO (x); /* Allow hard registers if the new mode is legal, and occupies no more registers than the old mode. */ @@ -4081,7 +4105,7 @@ try_combine (rtx_insn *i3, rtx_insn *i2, rtx_insn *i1, rtx_insn *i0, } } - /* Only allow this combination if insn_rtx_costs reports that the + /* Only allow this combination if insn_cost reports that the replacement instructions are cheaper than the originals. */ if (!combine_validate_cost (i0, i1, i2, i3, newpat, newi2pat, other_pat)) { @@ -6286,7 +6310,8 @@ combine_simplify_rtx (rtx x, machine_mode op0_mode, int in_dest, SUBST (XEXP (x, 1), force_to_mode (XEXP (x, 1), GET_MODE (XEXP (x, 1)), (HOST_WIDE_INT_1U - << exact_log2 (GET_MODE_BITSIZE (GET_MODE (x)))) + << exact_log2 (GET_MODE_UNIT_BITSIZE + (GET_MODE (x)))) - 1, 0)); break; @@ -11600,8 +11625,6 @@ gen_lowpart_for_combine (machine_mode omode, rtx x) if (MEM_P (x)) { - int offset = 0; - /* Refuse to work on a volatile memory ref or one with a mode-dependent address. */ if (MEM_VOLATILE_P (x) @@ -11614,14 +11637,7 @@ gen_lowpart_for_combine (machine_mode omode, rtx x) if (paradoxical_subreg_p (omode, imode)) return gen_rtx_SUBREG (omode, x, 0); - if (WORDS_BIG_ENDIAN) - offset = MAX (isize, UNITS_PER_WORD) - MAX (osize, UNITS_PER_WORD); - - /* Adjust the address so that the address-after-the-data is - unchanged. */ - if (BYTES_BIG_ENDIAN) - offset -= MIN (UNITS_PER_WORD, osize) - MIN (UNITS_PER_WORD, isize); - + HOST_WIDE_INT offset = byte_lowpart_offset (omode, imode); return adjust_address_nv (x, omode, offset); } @@ -11775,6 +11791,7 @@ simplify_compare_const (enum rtx_code code, machine_mode mode, const_op -= 1; code = LEU; /* ... fall through ... */ + gcc_fallthrough (); } /* (unsigned) < 0x80000000 is equivalent to >= 0. */ else if (is_a (mode, &int_mode) @@ -11812,6 +11829,7 @@ simplify_compare_const (enum rtx_code code, machine_mode mode, const_op -= 1; code = GTU; /* ... fall through ... */ + gcc_fallthrough (); } /* (unsigned) >= 0x80000000 is equivalent to < 0. */ @@ -14167,6 +14185,7 @@ distribute_notes (rtx notes, rtx_insn *from_insn, rtx_insn *i3, rtx_insn *i2, case REG_SETJMP: case REG_TM: case REG_CALL_DECL: + case REG_CALL_NOCF_CHECK: /* These notes must remain with the call. It should not be possible for both I2 and I3 to be a call. */ if (CALL_P (i3)) diff --git a/gcc/common.opt b/gcc/common.opt index dfde6adba910f..8d62ec5044d5c 100644 --- a/gcc/common.opt +++ b/gcc/common.opt @@ -562,6 +562,10 @@ Wattributes Common Var(warn_attributes) Init(1) Warning Warn about inappropriate attribute usage. +Wattribute-alias +Common Var(warn_attributes) Init(1) Warning +Warn about type safety and similar errors in attribute alias and related. + Wcast-align Common Var(warn_cast_align) Warning Warn about pointer casts which increase alignment. @@ -721,6 +725,10 @@ Wstrict-overflow= Common Joined RejectNegative UInteger Var(warn_strict_overflow) Warning Warn about optimizations that assume that signed overflow is undefined. +Wsuggest-attribute=cold +Common Var(warn_suggest_attribute_cold) Warning +Warn about functions which might be candidates for __attribute__((cold)). + Wsuggest-attribute=const Common Var(warn_suggest_attribute_const) Warning Warn about functions which might be candidates for __attribute__((const)). @@ -1612,6 +1620,29 @@ finline-atomics Common Report Var(flag_inline_atomics) Init(1) Optimization Inline __atomic operations when a lock free instruction sequence is available. +fcf-protection +Common RejectNegative Alias(fcf-protection=,full) + +fcf-protection= +Common Report Joined RejectNegative Enum(cf_protection_level) Var(flag_cf_protection) Init(CF_NONE) +-fcf-protection=[full|branch|return|none] Instrument functions with checks to verify jump/call/return control-flow transfer +instructions have valid targets. + +Enum +Name(cf_protection_level) Type(enum cf_protection_level) UnknownError(unknown Cotrol-Flow Protection Level %qs) + +EnumValue +Enum(cf_protection_level) String(full) Value(CF_FULL) + +EnumValue +Enum(cf_protection_level) String(branch) Value(CF_BRANCH) + +EnumValue +Enum(cf_protection_level) String(return) Value(CF_RETURN) + +EnumValue +Enum(cf_protection_level) String(none) Value(CF_NONE) + finstrument-functions Common Report Var(flag_instrument_function_entry_exit) Instrument function entry and exit with profiling calls. diff --git a/gcc/common/config/arm/arm-common.c b/gcc/common/config/arm/arm-common.c index 7cb99ece71062..1588ca86e9b06 100644 --- a/gcc/common/config/arm/arm-common.c +++ b/gcc/common/config/arm/arm-common.c @@ -63,7 +63,13 @@ arm_except_unwind_info (struct gcc_options *opts) return UI_TARGET; } - /* ... we use sjlj exceptions for backwards compatibility. */ + /* ... honor target configurations requesting DWARF2 EH... */ +#ifdef DWARF2_UNWIND_INFO + if (DWARF2_UNWIND_INFO) + return UI_DWARF2; +#endif + + /* ... or fallback to sjlj exceptions for backwards compatibility. */ return UI_SJLJ; } diff --git a/gcc/common/config/i386/i386-common.c b/gcc/common/config/i386/i386-common.c index 4185176495a20..34edcb895fe12 100644 --- a/gcc/common/config/i386/i386-common.c +++ b/gcc/common/config/i386/i386-common.c @@ -137,6 +137,7 @@ along with GCC; see the file COPYING3. If not see #define OPTION_MASK_ISA_CLZERO_SET OPTION_MASK_ISA_CLZERO #define OPTION_MASK_ISA_PKU_SET OPTION_MASK_ISA_PKU #define OPTION_MASK_ISA_RDPID_SET OPTION_MASK_ISA_RDPID +#define OPTION_MASK_ISA_GFNI_SET OPTION_MASK_ISA_GFNI /* Define a set of ISAs which aren't available when a given ISA is disabled. MMX and SSE ISAs are handled separately. */ @@ -202,6 +203,7 @@ along with GCC; see the file COPYING3. If not see #define OPTION_MASK_ISA_CLZERO_UNSET OPTION_MASK_ISA_CLZERO #define OPTION_MASK_ISA_PKU_UNSET OPTION_MASK_ISA_PKU #define OPTION_MASK_ISA_RDPID_UNSET OPTION_MASK_ISA_RDPID +#define OPTION_MASK_ISA_GFNI_UNSET OPTION_MASK_ISA_GFNI /* SSE4 includes both SSE4.1 and SSE4.2. -mno-sse4 should the same as -mno-sse4.1. */ @@ -484,6 +486,19 @@ ix86_handle_option (struct gcc_options *opts, } return true; + case OPT_mgfni: + if (value) + { + opts->x_ix86_isa_flags2 |= OPTION_MASK_ISA_GFNI_SET; + opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA_GFNI_SET; + } + else + { + opts->x_ix86_isa_flags2 &= ~OPTION_MASK_ISA_GFNI_UNSET; + opts->x_ix86_isa_flags2_explicit |= OPTION_MASK_ISA_GFNI_UNSET; + } + return true; + case OPT_mavx5124fmaps: if (value) { diff --git a/gcc/compare-elim.c b/gcc/compare-elim.c index 7e557a245b5b9..086fbc76f011c 100644 --- a/gcc/compare-elim.c +++ b/gcc/compare-elim.c @@ -65,6 +65,7 @@ along with GCC; see the file COPYING3. If not see #include "tm_p.h" #include "insn-config.h" #include "recog.h" +#include "emit-rtl.h" #include "cfgrtl.h" #include "tree-pass.h" #include "domwalk.h" @@ -579,6 +580,143 @@ equivalent_reg_at_start (rtx reg, rtx_insn *end, rtx_insn *start) return reg; } +/* Return true if it is okay to merge the comparison CMP_INSN with + the instruction ARITH_INSN. Both instructions are assumed to be in the + same basic block with ARITH_INSN appearing before CMP_INSN. This checks + that there are no uses or defs of the condition flags or control flow + changes between the two instructions. */ + +static bool +can_merge_compare_into_arith (rtx_insn *cmp_insn, rtx_insn *arith_insn) +{ + for (rtx_insn *insn = PREV_INSN (cmp_insn); + insn && insn != arith_insn; + insn = PREV_INSN (insn)) + { + if (!NONDEBUG_INSN_P (insn)) + continue; + /* Bail if there are jumps or calls in between. */ + if (!NONJUMP_INSN_P (insn)) + return false; + + /* Bail on old-style asm statements because they lack + data flow information. */ + if (GET_CODE (PATTERN (insn)) == ASM_INPUT) + return false; + + df_ref ref; + /* Find a USE of the flags register. */ + FOR_EACH_INSN_USE (ref, insn) + if (DF_REF_REGNO (ref) == targetm.flags_regnum) + return false; + + /* Find a DEF of the flags register. */ + FOR_EACH_INSN_DEF (ref, insn) + if (DF_REF_REGNO (ref) == targetm.flags_regnum) + return false; + } + return true; +} + +/* Given two SET expressions, SET_A and SET_B determine whether they form + a recognizable pattern when emitted in parallel. Return that parallel + if so. Otherwise return NULL. */ + +static rtx +try_validate_parallel (rtx set_a, rtx set_b) +{ + rtx par + = gen_rtx_PARALLEL (VOIDmode, gen_rtvec (2, set_a, set_b)); + + rtx_insn *insn; + insn = gen_rtx_INSN (VOIDmode, 0, 0, 0, par, 0, -1, 0); + + return recog_memoized (insn) > 0 ? par : NULL_RTX; +} + +/* For a comparison instruction described by CMP check if it compares a + register with zero i.e. it is of the form CC := CMP R1, 0. + If it is, find the instruction defining R1 (say I1) and try to create a + PARALLEL consisting of I1 and the comparison, representing a flag-setting + arithmetic instruction. Example: + I1: R1 := R2 + R3 + + I2: CC := CMP R1 0 + I2 can be merged with I1 into: + I1: { R1 := R2 + R3 ; CC := CMP (R2 + R3) 0 } + This catches cases where R1 is used between I1 and I2 and therefore + combine and other RTL optimisations will not try to propagate it into + I2. Return true if we succeeded in merging CMP. */ + +static bool +try_merge_compare (struct comparison *cmp) +{ + rtx_insn *cmp_insn = cmp->insn; + + if (!REG_P (cmp->in_a) || cmp->in_b != const0_rtx) + return false; + rtx in_a = cmp->in_a; + df_ref use; + + FOR_EACH_INSN_USE (use, cmp_insn) + if (DF_REF_REGNO (use) == REGNO (in_a)) + break; + if (!use) + return false; + + /* Validate the data flow information before attempting to + find the instruction that defines in_a. */ + + struct df_link *ref_chain; + ref_chain = DF_REF_CHAIN (use); + if (!ref_chain || !ref_chain->ref + || !DF_REF_INSN_INFO (ref_chain->ref) || ref_chain->next != NULL) + return false; + + rtx_insn *def_insn = DF_REF_INSN (ref_chain->ref); + /* We found the insn that defines in_a. Only consider the cases where + it is in the same block as the comparison. */ + if (BLOCK_FOR_INSN (cmp_insn) != BLOCK_FOR_INSN (def_insn)) + return false; + + rtx set = single_set (def_insn); + if (!set) + return false; + + if (!can_merge_compare_into_arith (cmp_insn, def_insn)) + return false; + + rtx src = SET_SRC (set); + rtx flags = maybe_select_cc_mode (cmp, src, CONST0_RTX (GET_MODE (src))); + if (!flags) + { + /* We may already have a change group going through maybe_select_cc_mode. + Discard it properly. */ + cancel_changes (0); + return false; + } + + rtx flag_set + = gen_rtx_SET (flags, gen_rtx_COMPARE (GET_MODE (flags), + copy_rtx (src), + CONST0_RTX (GET_MODE (src)))); + rtx arith_set = copy_rtx (PATTERN (def_insn)); + rtx par = try_validate_parallel (flag_set, arith_set); + if (!par) + { + /* We may already have a change group going through maybe_select_cc_mode. + Discard it properly. */ + cancel_changes (0); + return false; + } + if (!apply_change_group ()) + return false; + emit_insn_after (par, def_insn); + delete_insn (def_insn); + delete_insn (cmp->insn); + return true; +} + /* Attempt to replace a comparison with a prior arithmetic insn that can compute the same flags value as the comparison itself. Return true if successful, having made all rtl modifications necessary. */ @@ -588,6 +726,9 @@ try_eliminate_compare (struct comparison *cmp) { rtx flags, in_a, in_b, cmp_src; + if (try_merge_compare (cmp)) + return true; + /* We must have found an interesting "clobber" preceding the compare. */ if (cmp->prev_clobber == NULL) return false; @@ -714,6 +855,7 @@ try_eliminate_compare (struct comparison *cmp) static unsigned int execute_compare_elim_after_reload (void) { + df_chain_add_problem (DF_UD_CHAIN + DF_DU_CHAIN); df_analyze (); gcc_checking_assert (!all_compares.exists ()); diff --git a/gcc/config.gcc b/gcc/config.gcc index 91a55e89d0469..94900aa4f815f 100644 --- a/gcc/config.gcc +++ b/gcc/config.gcc @@ -360,6 +360,7 @@ i[34567]86-*-*) cpu_type=i386 c_target_objs="i386-c.o" cxx_target_objs="i386-c.o" + extra_objs="x86-tune-sched.o x86-tune-sched-bd.o x86-tune-sched-atom.o x86-tune-sched-core.o" extra_options="${extra_options} fused-madd.opt" extra_headers="cpuid.h mmintrin.h mm3dnow.h xmmintrin.h emmintrin.h pmmintrin.h tmmintrin.h ammintrin.h smmintrin.h @@ -384,6 +385,7 @@ x86_64-*-*) c_target_objs="i386-c.o" cxx_target_objs="i386-c.o" extra_options="${extra_options} fused-madd.opt" + extra_objs="x86-tune-sched.o x86-tune-sched-bd.o x86-tune-sched-atom.o x86-tune-sched-core.o" extra_headers="cpuid.h mmintrin.h mm3dnow.h xmmintrin.h emmintrin.h pmmintrin.h tmmintrin.h ammintrin.h smmintrin.h nmmintrin.h bmmintrin.h fma4intrin.h wmmintrin.h @@ -461,6 +463,7 @@ powerpc*-*-*) extra_headers="${extra_headers} mmintrin.h x86intrin.h" extra_headers="${extra_headers} ppu_intrinsics.h spu2vmx.h vec_types.h si2vmx.h" extra_headers="${extra_headers} paired.h" + extra_headers="${extra_headers} amo.h" case x$with_cpu in xpowerpc64|xdefault64|x6[23]0|x970|xG5|xpower[3456789]|xpower6x|xrs64a|xcell|xa2|xe500mc64|xe5500|xe6500) cpu_is_64bit=yes @@ -871,7 +874,7 @@ case ${target} in tmake_file="${tmake_file} t-sol2 t-slibgcc" c_target_objs="${c_target_objs} sol2-c.o" cxx_target_objs="${cxx_target_objs} sol2-c.o sol2-cxx.o" - extra_objs="sol2.o sol2-stubs.o" + extra_objs="${extra_objs} sol2.o sol2-stubs.o" extra_options="${extra_options} sol2.opt" case ${enable_threads}:${have_pthread_h}:${have_thread_h} in "":yes:* | yes:yes:* ) @@ -1093,11 +1096,14 @@ arm*-*-freebsd*) # ARM FreeBSD EABI case $target in armv6*-*-freebsd*) target_cpu_cname="arm1176jzf-s" - tm_defines="${tm_defines} TARGET_FREEBSD_ARMv6=1" if test $fbsd_major -ge 11; then tm_defines="${tm_defines} TARGET_FREEBSD_ARM_HARD_FLOAT=1" fi ;; + armv7*-*-freebsd*) + target_cpu_cname="generic-armv7-a" + tm_defines="${tm_defines} TARGET_FREEBSD_ARM_HARD_FLOAT=1" + ;; *) target_cpu_cname="arm9" ;; @@ -1686,7 +1692,7 @@ i[34567]86-*-cygwin*) tmake_file="${tmake_file} i386/t-cygming t-slibgcc" target_gtfiles="\$(srcdir)/config/i386/winnt.c" extra_options="${extra_options} i386/cygming.opt i386/cygwin.opt" - extra_objs="winnt.o winnt-stubs.o" + extra_objs="${extra_objs} winnt.o winnt-stubs.o" c_target_objs="${c_target_objs} msformat-c.o" cxx_target_objs="${cxx_target_objs} winnt-cxx.o msformat-c.o" if test x$enable_threads = xyes; then @@ -1702,7 +1708,7 @@ x86_64-*-cygwin*) tmake_file="${tmake_file} i386/t-cygming t-slibgcc i386/t-cygwin-w64" target_gtfiles="\$(srcdir)/config/i386/winnt.c" extra_options="${extra_options} i386/cygming.opt i386/cygwin.opt" - extra_objs="winnt.o winnt-stubs.o" + extra_objs="${extra_objs} winnt.o winnt-stubs.o" c_target_objs="${c_target_objs} msformat-c.o" cxx_target_objs="${cxx_target_objs} winnt-cxx.o msformat-c.o" if test x$enable_threads = xyes; then @@ -1777,7 +1783,7 @@ i[34567]86-*-mingw* | x86_64-*-mingw*) *) ;; esac - extra_objs="winnt.o winnt-stubs.o" + extra_objs="${extra_objs} winnt.o winnt-stubs.o" c_target_objs="${c_target_objs} msformat-c.o" cxx_target_objs="${cxx_target_objs} winnt-cxx.o msformat-c.o" gas=yes @@ -2627,7 +2633,7 @@ rs6000-ibm-aix[789].* | powerpc-ibm-aix[789].*) use_collect2=yes thread_file='aix' use_gcc_stdint=wrap - extra_headers=altivec.h + extra_headers="altivec.h amo.h" default_use_cxa_atexit=yes ;; rl78-*-elf*) @@ -3104,7 +3110,7 @@ case ${target} in ;; *-*-linux*) case ${target} in - aarch64*-* | i[34567]86-* | powerpc*-* | s390*-* | sparc*-* | x86_64-*) + aarch64*-* | arm*-* | i[34567]86-* | powerpc*-* | s390*-* | sparc*-* | x86_64-*) default_gnu_indirect_function=yes ;; esac @@ -3431,11 +3437,18 @@ if test x$with_cpu = x ; then esac ;; powerpc*-*-*spe*) + # For SPE, start with 8540, then upgrade to 8548 if + # --enable-e500-double was requested explicitly or if we were + # configured for e500v2. + with_cpu=8540 if test x$enable_e500_double = xyes; then - with_cpu=8548 - else - with_cpu=8540 - fi + with_cpu=8548 + fi + case ${target_noncanonical} in + e500v2*) + with_cpu=8548 + ;; + esac ;; sparc*-*-*) case ${target} in diff --git a/gcc/config/aarch64/aarch64-builtins.c b/gcc/config/aarch64/aarch64-builtins.c index 7edf75c52effd..242b2e3dc31e1 100644 --- a/gcc/config/aarch64/aarch64-builtins.c +++ b/gcc/config/aarch64/aarch64-builtins.c @@ -168,6 +168,11 @@ aarch64_types_quadop_lane_qualifiers[SIMD_MAX_BUILTIN_ARGS] = { qualifier_none, qualifier_none, qualifier_none, qualifier_none, qualifier_lane_index }; #define TYPES_QUADOP_LANE (aarch64_types_quadop_lane_qualifiers) +static enum aarch64_type_qualifiers +aarch64_types_quadopu_lane_qualifiers[SIMD_MAX_BUILTIN_ARGS] + = { qualifier_unsigned, qualifier_unsigned, qualifier_unsigned, + qualifier_unsigned, qualifier_lane_index }; +#define TYPES_QUADOPU_LANE (aarch64_types_quadopu_lane_qualifiers) static enum aarch64_type_qualifiers aarch64_types_binop_imm_p_qualifiers[SIMD_MAX_BUILTIN_ARGS] diff --git a/gcc/config/aarch64/aarch64-c.c b/gcc/config/aarch64/aarch64-c.c index 177e638682f9d..c7d866f3b567b 100644 --- a/gcc/config/aarch64/aarch64-c.c +++ b/gcc/config/aarch64/aarch64-c.c @@ -106,6 +106,7 @@ aarch64_update_cpp_builtins (cpp_reader *pfile) aarch64_def_or_undef (TARGET_CRC32, "__ARM_FEATURE_CRC32", pfile); + aarch64_def_or_undef (TARGET_DOTPROD, "__ARM_FEATURE_DOTPROD", pfile); cpp_undef (pfile, "__AARCH64_CMODEL_TINY__"); cpp_undef (pfile, "__AARCH64_CMODEL_SMALL__"); diff --git a/gcc/config/aarch64/aarch64-cores.def b/gcc/config/aarch64/aarch64-cores.def index 10893324d3fd8..16e4485587211 100644 --- a/gcc/config/aarch64/aarch64-cores.def +++ b/gcc/config/aarch64/aarch64-cores.def @@ -83,8 +83,8 @@ AARCH64_CORE("thunderx2t99", thunderx2t99, thunderx2t99, 8_1A, AARCH64_FL_FOR /* ARMv8.2-A Architecture Processors. */ /* ARM ('A') cores. */ -AARCH64_CORE("cortex-a55", cortexa55, cortexa53, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_RCPC, cortexa53, 0x41, 0xd05, -1) -AARCH64_CORE("cortex-a75", cortexa75, cortexa57, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_RCPC, cortexa73, 0x41, 0xd0a, -1) +AARCH64_CORE("cortex-a55", cortexa55, cortexa53, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD, cortexa53, 0x41, 0xd05, -1) +AARCH64_CORE("cortex-a75", cortexa75, cortexa57, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD, cortexa73, 0x41, 0xd0a, -1) /* ARMv8-A big.LITTLE implementations. */ @@ -95,6 +95,6 @@ AARCH64_CORE("cortex-a73.cortex-a53", cortexa73cortexa53, cortexa53, 8A, AARCH /* ARM DynamIQ big.LITTLE configurations. */ -AARCH64_CORE("cortex-a75.cortex-a55", cortexa75cortexa55, cortexa53, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_RCPC, cortexa73, 0x41, AARCH64_BIG_LITTLE (0xd0a, 0xd05), -1) +AARCH64_CORE("cortex-a75.cortex-a55", cortexa75cortexa55, cortexa53, 8_2A, AARCH64_FL_FOR_ARCH8_2 | AARCH64_FL_RCPC | AARCH64_FL_DOTPROD, cortexa73, 0x41, AARCH64_BIG_LITTLE (0xd0a, 0xd05), -1) #undef AARCH64_CORE diff --git a/gcc/config/aarch64/aarch64-option-extensions.def b/gcc/config/aarch64/aarch64-option-extensions.def index a989a2ec23e53..2c808f0b9ef7c 100644 --- a/gcc/config/aarch64/aarch64-option-extensions.def +++ b/gcc/config/aarch64/aarch64-option-extensions.def @@ -43,8 +43,8 @@ AARCH64_OPT_EXTENSION("fp", AARCH64_FL_FP, 0, AARCH64_FL_SIMD | AARCH64_FL_CRYPTO | AARCH64_FL_F16, "fp") /* Enabling "simd" also enables "fp". - Disabling "simd" also disables "crypto". */ -AARCH64_OPT_EXTENSION("simd", AARCH64_FL_SIMD, AARCH64_FL_FP, AARCH64_FL_CRYPTO, "asimd") + Disabling "simd" also disables "crypto" and "dotprod". */ +AARCH64_OPT_EXTENSION("simd", AARCH64_FL_SIMD, AARCH64_FL_FP, AARCH64_FL_CRYPTO | AARCH64_FL_DOTPROD, "asimd") /* Enabling "crypto" also enables "fp", "simd". Disabling "crypto" just disables "crypto". */ @@ -67,4 +67,8 @@ AARCH64_OPT_EXTENSION("rcpc", AARCH64_FL_RCPC, 0, 0, "lrcpc") Disabling "rdma" just disables "rdma". */ AARCH64_OPT_EXTENSION("rdma", AARCH64_FL_RDMA, AARCH64_FL_FP | AARCH64_FL_SIMD, 0, "asimdrdm") +/* Enabling "dotprod" also enables "simd". + Disabling "dotprod" only disables "dotprod". */ +AARCH64_OPT_EXTENSION("dotprod", AARCH64_FL_DOTPROD, AARCH64_FL_SIMD, 0, "asimddp") + #undef AARCH64_OPT_EXTENSION diff --git a/gcc/config/aarch64/aarch64-simd-builtins.def b/gcc/config/aarch64/aarch64-simd-builtins.def index d713d5d8b8883..52d01342372e5 100644 --- a/gcc/config/aarch64/aarch64-simd-builtins.def +++ b/gcc/config/aarch64/aarch64-simd-builtins.def @@ -205,6 +205,14 @@ BUILTIN_VSDQ_I_DI (BINOP, srshl, 0) BUILTIN_VSDQ_I_DI (BINOP_UUS, urshl, 0) + /* Implemented by aarch64_{_lane}{q}. */ + BUILTIN_VB (TERNOP, sdot, 0) + BUILTIN_VB (TERNOPU, udot, 0) + BUILTIN_VB (QUADOP_LANE, sdot_lane, 0) + BUILTIN_VB (QUADOPU_LANE, udot_lane, 0) + BUILTIN_VB (QUADOP_LANE, sdot_laneq, 0) + BUILTIN_VB (QUADOPU_LANE, udot_laneq, 0) + BUILTIN_VDQ_I (SHIFTIMM, ashr, 3) VAR1 (SHIFTIMM, ashr_simd, 0, di) BUILTIN_VDQ_I (SHIFTIMM, lshr, 3) diff --git a/gcc/config/aarch64/aarch64-simd.md b/gcc/config/aarch64/aarch64-simd.md index 12da8be73e83d..49f615cfdbf70 100644 --- a/gcc/config/aarch64/aarch64-simd.md +++ b/gcc/config/aarch64/aarch64-simd.md @@ -393,6 +393,87 @@ } ) +;; These instructions map to the __builtins for the Dot Product operations. +(define_insn "aarch64_dot" + [(set (match_operand:VS 0 "register_operand" "=w") + (plus:VS (match_operand:VS 1 "register_operand" "0") + (unspec:VS [(match_operand: 2 "register_operand" "w") + (match_operand: 3 "register_operand" "w")] + DOTPROD)))] + "TARGET_DOTPROD" + "dot\\t%0., %2., %3." + [(set_attr "type" "neon_dot")] +) + +;; These expands map to the Dot Product optab the vectorizer checks for. +;; The auto-vectorizer expects a dot product builtin that also does an +;; accumulation into the provided register. +;; Given the following pattern +;; +;; for (i=0; idot_prod" + [(set (match_operand:VS 0 "register_operand") + (plus:VS (unspec:VS [(match_operand: 1 "register_operand") + (match_operand: 2 "register_operand")] + DOTPROD) + (match_operand:VS 3 "register_operand")))] + "TARGET_DOTPROD" +{ + emit_insn ( + gen_aarch64_dot (operands[3], operands[3], operands[1], + operands[2])); + emit_insn (gen_rtx_SET (operands[0], operands[3])); + DONE; +}) + +;; These instructions map to the __builtins for the Dot Product +;; indexed operations. +(define_insn "aarch64_dot_lane" + [(set (match_operand:VS 0 "register_operand" "=w") + (plus:VS (match_operand:VS 1 "register_operand" "0") + (unspec:VS [(match_operand: 2 "register_operand" "w") + (match_operand:V8QI 3 "register_operand" "") + (match_operand:SI 4 "immediate_operand" "i")] + DOTPROD)))] + "TARGET_DOTPROD" + { + operands[4] + = GEN_INT (ENDIAN_LANE_N (V8QImode, INTVAL (operands[4]))); + return "dot\\t%0., %2., %3.4b[%4]"; + } + [(set_attr "type" "neon_dot")] +) + +(define_insn "aarch64_dot_laneq" + [(set (match_operand:VS 0 "register_operand" "=w") + (plus:VS (match_operand:VS 1 "register_operand" "0") + (unspec:VS [(match_operand: 2 "register_operand" "w") + (match_operand:V16QI 3 "register_operand" "") + (match_operand:SI 4 "immediate_operand" "i")] + DOTPROD)))] + "TARGET_DOTPROD" + { + operands[4] + = GEN_INT (ENDIAN_LANE_N (V16QImode, INTVAL (operands[4]))); + return "dot\\t%0., %2., %3.4b[%4]"; + } + [(set_attr "type" "neon_dot")] +) + (define_expand "copysign3" [(match_operand:VHSDF 0 "register_operand") (match_operand:VHSDF 1 "register_operand") diff --git a/gcc/config/aarch64/aarch64.c b/gcc/config/aarch64/aarch64.c index ee98a1f822827..ed30b8c5858a7 100644 --- a/gcc/config/aarch64/aarch64.c +++ b/gcc/config/aarch64/aarch64.c @@ -1490,7 +1490,8 @@ aarch64_load_symref_appropriately (rtx dest, rtx imm, tp = gen_lowpart (mode, tp); emit_insn (gen_rtx_SET (dest, gen_rtx_PLUS (mode, tp, x0))); - set_unique_reg_note (get_last_insn (), REG_EQUIV, imm); + if (REG_P (dest)) + set_unique_reg_note (get_last_insn (), REG_EQUIV, imm); return; } @@ -1524,7 +1525,8 @@ aarch64_load_symref_appropriately (rtx dest, rtx imm, } emit_insn (gen_rtx_SET (dest, gen_rtx_PLUS (mode, tp, tmp_reg))); - set_unique_reg_note (get_last_insn (), REG_EQUIV, imm); + if (REG_P (dest)) + set_unique_reg_note (get_last_insn (), REG_EQUIV, imm); return; } @@ -1565,7 +1567,8 @@ aarch64_load_symref_appropriately (rtx dest, rtx imm, gcc_unreachable (); } - set_unique_reg_note (get_last_insn (), REG_EQUIV, imm); + if (REG_P (dest)) + set_unique_reg_note (get_last_insn (), REG_EQUIV, imm); return; } @@ -1594,7 +1597,8 @@ aarch64_load_symref_appropriately (rtx dest, rtx imm, emit_insn (gen_tlsie_tiny_sidi (dest, imm, tp)); } - set_unique_reg_note (get_last_insn (), REG_EQUIV, imm); + if (REG_P (dest)) + set_unique_reg_note (get_last_insn (), REG_EQUIV, imm); return; } @@ -8555,9 +8559,11 @@ aarch64_builtin_vectorization_cost (enum vect_cost_for_stmt type_of_cost, return costs->scalar_to_vec_cost; case unaligned_load: + case vector_gather_load: return costs->vec_unalign_load_cost; case unaligned_store: + case vector_scatter_store: return costs->vec_unalign_store_cost; case cond_branch_taken: @@ -11039,7 +11045,8 @@ aapcs_vfp_sub_candidate (const_tree type, machine_mode *modep) - tree_to_uhwi (TYPE_MIN_VALUE (index))); /* There must be no padding. */ - if (wi::ne_p (TYPE_SIZE (type), count * GET_MODE_BITSIZE (*modep))) + if (wi::to_wide (TYPE_SIZE (type)) + != count * GET_MODE_BITSIZE (*modep)) return -1; return count; @@ -11069,7 +11076,8 @@ aapcs_vfp_sub_candidate (const_tree type, machine_mode *modep) } /* There must be no padding. */ - if (wi::ne_p (TYPE_SIZE (type), count * GET_MODE_BITSIZE (*modep))) + if (wi::to_wide (TYPE_SIZE (type)) + != count * GET_MODE_BITSIZE (*modep)) return -1; return count; @@ -11101,7 +11109,8 @@ aapcs_vfp_sub_candidate (const_tree type, machine_mode *modep) } /* There must be no padding. */ - if (wi::ne_p (TYPE_SIZE (type), count * GET_MODE_BITSIZE (*modep))) + if (wi::to_wide (TYPE_SIZE (type)) + != count * GET_MODE_BITSIZE (*modep)) return -1; return count; diff --git a/gcc/config/aarch64/aarch64.h b/gcc/config/aarch64/aarch64.h index 1c3aff587d2ec..98d93c69e23b6 100644 --- a/gcc/config/aarch64/aarch64.h +++ b/gcc/config/aarch64/aarch64.h @@ -136,14 +136,15 @@ extern unsigned aarch64_architecture_version; #define AARCH64_FL_CRC (1 << 3) /* Has CRC. */ /* ARMv8.1-A architecture extensions. */ #define AARCH64_FL_LSE (1 << 4) /* Has Large System Extensions. */ -#define AARCH64_FL_RDMA (1 << 5) /* Has Round Double Multiply Add. */ -#define AARCH64_FL_V8_1 (1 << 6) /* Has ARMv8.1-A extensions. */ +#define AARCH64_FL_RDMA (1 << 5) /* Has Round Double Multiply Add. */ +#define AARCH64_FL_V8_1 (1 << 6) /* Has ARMv8.1-A extensions. */ /* ARMv8.2-A architecture extensions. */ -#define AARCH64_FL_V8_2 (1 << 8) /* Has ARMv8.2-A features. */ +#define AARCH64_FL_V8_2 (1 << 8) /* Has ARMv8.2-A features. */ #define AARCH64_FL_F16 (1 << 9) /* Has ARMv8.2-A FP16 extensions. */ /* ARMv8.3-A architecture extensions. */ -#define AARCH64_FL_V8_3 (1 << 10) /* Has ARMv8.3-A features. */ -#define AARCH64_FL_RCPC (1 << 11) /* Has support for RCpc model. */ +#define AARCH64_FL_V8_3 (1 << 10) /* Has ARMv8.3-A features. */ +#define AARCH64_FL_RCPC (1 << 11) /* Has support for RCpc model. */ +#define AARCH64_FL_DOTPROD (1 << 12) /* Has ARMv8.2-A Dot Product ins. */ /* Has FP and SIMD. */ #define AARCH64_FL_FPSIMD (AARCH64_FL_FP | AARCH64_FL_SIMD) @@ -172,6 +173,7 @@ extern unsigned aarch64_architecture_version; #define AARCH64_ISA_V8_2 (aarch64_isa_flags & AARCH64_FL_V8_2) #define AARCH64_ISA_F16 (aarch64_isa_flags & AARCH64_FL_F16) #define AARCH64_ISA_V8_3 (aarch64_isa_flags & AARCH64_FL_V8_3) +#define AARCH64_ISA_DOTPROD (aarch64_isa_flags & AARCH64_FL_DOTPROD) /* Crypto is an optional extension to AdvSIMD. */ #define TARGET_CRYPTO (TARGET_SIMD && AARCH64_ISA_CRYPTO) @@ -186,6 +188,9 @@ extern unsigned aarch64_architecture_version; #define TARGET_FP_F16INST (TARGET_FLOAT && AARCH64_ISA_F16) #define TARGET_SIMD_F16INST (TARGET_SIMD && AARCH64_ISA_F16) +/* Dot Product is an optional extension to AdvSIMD enabled through +dotprod. */ +#define TARGET_DOTPROD (TARGET_SIMD && AARCH64_ISA_DOTPROD) + /* ARMv8.3-A features. */ #define TARGET_ARMV8_3 (AARCH64_ISA_V8_3) diff --git a/gcc/config/aarch64/aarch64.md b/gcc/config/aarch64/aarch64.md index f8cdb063546af..389f2f9d31aad 100644 --- a/gcc/config/aarch64/aarch64.md +++ b/gcc/config/aarch64/aarch64.md @@ -4125,6 +4125,35 @@ [(set_attr "type" "shift_reg")] ) +(define_insn_and_split "*aarch64_reg__minus3" + [(set (match_operand:GPI 0 "register_operand" "=&r") + (ASHIFT:GPI + (match_operand:GPI 1 "register_operand" "r") + (minus:QI (match_operand 2 "const_int_operand" "n") + (match_operand:QI 3 "register_operand" "r"))))] + "INTVAL (operands[2]) == GET_MODE_BITSIZE (mode)" + "#" + "&& true" + [(const_int 0)] + { + rtx subreg_tmp = gen_lowpart (SImode, operands[3]); + + rtx tmp = (can_create_pseudo_p () ? gen_reg_rtx (SImode) + : gen_lowpart (SImode, operands[0])); + + emit_insn (gen_negsi2 (tmp, subreg_tmp)); + + rtx and_op = gen_rtx_AND (SImode, tmp, + GEN_INT (GET_MODE_BITSIZE (mode) - 1)); + + rtx subreg_tmp2 = gen_lowpart_SUBREG (QImode, and_op); + + emit_insn (gen_3 (operands[0], operands[1], subreg_tmp2)); + DONE; + } + [(set_attr "length" "8")] +) + ;; Logical left shift using SISD or Integer instruction (define_insn "*aarch64_ashl_sisd_or_int_3" [(set (match_operand:GPI 0 "register_operand" "=r,r,w,w") diff --git a/gcc/config/aarch64/arm_neon.h b/gcc/config/aarch64/arm_neon.h index d7b30b0e5ee61..96e740f91a7fb 100644 --- a/gcc/config/aarch64/arm_neon.h +++ b/gcc/config/aarch64/arm_neon.h @@ -31541,6 +31541,99 @@ vminnmvq_f16 (float16x8_t __a) #pragma GCC pop_options +/* AdvSIMD Dot Product intrinsics. */ + +#pragma GCC push_options +#pragma GCC target ("arch=armv8.2-a+dotprod") + +__extension__ extern __inline uint32x2_t +__attribute__ ((__always_inline__, __gnu_inline__, __artificial__)) +vdot_u32 (uint32x2_t __r, uint8x8_t __a, uint8x8_t __b) +{ + return __builtin_aarch64_udotv8qi_uuuu (__r, __a, __b); +} + +__extension__ extern __inline uint32x4_t +__attribute__ ((__always_inline__, __gnu_inline__, __artificial__)) +vdotq_u32 (uint32x4_t __r, uint8x16_t __a, uint8x16_t __b) +{ + return __builtin_aarch64_udotv16qi_uuuu (__r, __a, __b); +} + +__extension__ extern __inline int32x2_t +__attribute__ ((__always_inline__, __gnu_inline__, __artificial__)) +vdot_s32 (int32x2_t __r, int8x8_t __a, int8x8_t __b) +{ + return __builtin_aarch64_sdotv8qi (__r, __a, __b); +} + +__extension__ extern __inline int32x4_t +__attribute__ ((__always_inline__, __gnu_inline__, __artificial__)) +vdotq_s32 (int32x4_t __r, int8x16_t __a, int8x16_t __b) +{ + return __builtin_aarch64_sdotv16qi (__r, __a, __b); +} + +__extension__ extern __inline uint32x2_t +__attribute__ ((__always_inline__, __gnu_inline__, __artificial__)) +vdot_lane_u32 (uint32x2_t __r, uint8x8_t __a, uint8x8_t __b, const int __index) +{ + return __builtin_aarch64_udot_lanev8qi_uuuus (__r, __a, __b, __index); +} + +__extension__ extern __inline uint32x2_t +__attribute__ ((__always_inline__, __gnu_inline__, __artificial__)) +vdot_laneq_u32 (uint32x2_t __r, uint8x8_t __a, uint8x16_t __b, + const int __index) +{ + return __builtin_aarch64_udot_laneqv8qi_uuuus (__r, __a, __b, __index); +} + +__extension__ extern __inline uint32x4_t +__attribute__ ((__always_inline__, __gnu_inline__, __artificial__)) +vdotq_lane_u32 (uint32x4_t __r, uint8x16_t __a, uint8x8_t __b, + const int __index) +{ + return __builtin_aarch64_udot_lanev16qi_uuuus (__r, __a, __b, __index); +} + +__extension__ extern __inline uint32x4_t +__attribute__ ((__always_inline__, __gnu_inline__, __artificial__)) +vdotq_laneq_u32 (uint32x4_t __r, uint8x16_t __a, uint8x16_t __b, + const int __index) +{ + return __builtin_aarch64_udot_laneqv16qi_uuuus (__r, __a, __b, __index); +} + +__extension__ extern __inline int32x2_t +__attribute__ ((__always_inline__, __gnu_inline__, __artificial__)) +vdot_lane_s32 (int32x2_t __r, int8x8_t __a, int8x8_t __b, const int __index) +{ + return __builtin_aarch64_sdot_lanev8qi (__r, __a, __b, __index); +} + +__extension__ extern __inline int32x2_t +__attribute__ ((__always_inline__, __gnu_inline__, __artificial__)) +vdot_laneq_s32 (int32x2_t __r, int8x8_t __a, int8x16_t __b, const int __index) +{ + return __builtin_aarch64_sdot_laneqv8qi (__r, __a, __b, __index); +} + +__extension__ extern __inline int32x4_t +__attribute__ ((__always_inline__, __gnu_inline__, __artificial__)) +vdotq_lane_s32 (int32x4_t __r, int8x16_t __a, int8x8_t __b, const int __index) +{ + return __builtin_aarch64_sdot_lanev16qi (__r, __a, __b, __index); +} + +__extension__ extern __inline int32x4_t +__attribute__ ((__always_inline__, __gnu_inline__, __artificial__)) +vdotq_laneq_s32 (int32x4_t __r, int8x16_t __a, int8x16_t __b, const int __index) +{ + return __builtin_aarch64_sdot_laneqv16qi (__r, __a, __b, __index); +} +#pragma GCC pop_options + #undef __aarch64_vget_lane_any #undef __aarch64_vdup_lane_any diff --git a/gcc/config/aarch64/iterators.md b/gcc/config/aarch64/iterators.md index 477dc35daf6a1..48cedbe84a6b3 100644 --- a/gcc/config/aarch64/iterators.md +++ b/gcc/config/aarch64/iterators.md @@ -354,6 +354,8 @@ UNSPEC_SQRDMLSH ; Used in aarch64-simd.md. UNSPEC_FMAXNM ; Used in aarch64-simd.md. UNSPEC_FMINNM ; Used in aarch64-simd.md. + UNSPEC_SDOT ; Used in aarch64-simd.md. + UNSPEC_UDOT ; Used in aarch64-simd.md. ]) ;; ------------------------------------------------------------------ @@ -800,6 +802,10 @@ (define_mode_attr vsi2qi [(V2SI "v8qi") (V4SI "v16qi")]) (define_mode_attr VSI2QI [(V2SI "V8QI") (V4SI "V16QI")]) + +;; Register suffix for DOTPROD input types from the return type. +(define_mode_attr Vdottype [(V2SI "8b") (V4SI "16b")]) + ;; Sum of lengths of instructions needed to move vector registers of a mode. (define_mode_attr insn_count [(OI "8") (CI "12") (XI "16")]) @@ -1029,6 +1035,7 @@ UNSPEC_SHSUB UNSPEC_UHSUB UNSPEC_SRHSUB UNSPEC_URHSUB]) +(define_int_iterator DOTPROD [UNSPEC_SDOT UNSPEC_UDOT]) (define_int_iterator ADDSUBHN [UNSPEC_ADDHN UNSPEC_RADDHN UNSPEC_SUBHN UNSPEC_RSUBHN]) @@ -1166,6 +1173,7 @@ (UNSPEC_USHLL "u") (UNSPEC_SSHLL "s") (UNSPEC_URSHL "ur") (UNSPEC_SRSHL "sr") (UNSPEC_UQRSHL "u") (UNSPEC_SQRSHL "s") + (UNSPEC_SDOT "s") (UNSPEC_UDOT "u") ]) (define_int_attr r [(UNSPEC_SQDMULH "") (UNSPEC_SQRDMULH "r") diff --git a/gcc/config/alpha/alpha.c b/gcc/config/alpha/alpha.c index 41f3e3a195780..ece8879cb227e 100644 --- a/gcc/config/alpha/alpha.c +++ b/gcc/config/alpha/alpha.c @@ -2910,8 +2910,8 @@ alpha_split_conditional_move (enum rtx_code code, rtx dest, rtx cond, || (code == GE || code == GT)) { code = reverse_condition (code); - diff = t, t = f, f = diff; - diff = t - f; + std::swap (t, f); + diff = -diff; } subtarget = target = dest; @@ -6078,10 +6078,8 @@ alpha_stdarg_optimize_hook (struct stdarg_info *si, const gimple *stmt) else if (code2 == COMPONENT_REF && (code1 == MINUS_EXPR || code1 == PLUS_EXPR)) { - gimple *tem = arg1_stmt; + std::swap (arg1_stmt, arg2_stmt); code2 = code1; - arg1_stmt = arg2_stmt; - arg2_stmt = tem; } else goto escapes; @@ -9831,9 +9829,7 @@ alpha_canonicalize_comparison (int *code, rtx *op0, rtx *op1, && (*code == GE || *code == GT || *code == GEU || *code == GTU) && (REG_P (*op1) || *op1 == const0_rtx)) { - rtx tem = *op0; - *op0 = *op1; - *op1 = tem; + std::swap (*op0, *op1); *code = (int)swap_condition ((enum rtx_code)*code); } diff --git a/gcc/config/arm/arm-builtins.c b/gcc/config/arm/arm-builtins.c index 569f960fd2e53..6d1b20c80f9a2 100644 --- a/gcc/config/arm/arm-builtins.c +++ b/gcc/config/arm/arm-builtins.c @@ -105,6 +105,13 @@ arm_ternop_qualifiers[SIMD_MAX_BUILTIN_ARGS] = { qualifier_none, qualifier_none, qualifier_none, qualifier_none }; #define TERNOP_QUALIFIERS (arm_ternop_qualifiers) +/* unsigned T (unsigned T, unsigned T, unsigned T). */ +static enum arm_type_qualifiers +arm_unsigned_uternop_qualifiers[SIMD_MAX_BUILTIN_ARGS] + = { qualifier_unsigned, qualifier_unsigned, qualifier_unsigned, + qualifier_unsigned }; +#define UTERNOP_QUALIFIERS (arm_unsigned_uternop_qualifiers) + /* T (T, immediate). */ static enum arm_type_qualifiers arm_binop_imm_qualifiers[SIMD_MAX_BUILTIN_ARGS] @@ -131,6 +138,13 @@ arm_mac_lane_qualifiers[SIMD_MAX_BUILTIN_ARGS] qualifier_none, qualifier_lane_index }; #define MAC_LANE_QUALIFIERS (arm_mac_lane_qualifiers) +/* unsigned T (unsigned T, unsigned T, unsigend T, lane index). */ +static enum arm_type_qualifiers +arm_umac_lane_qualifiers[SIMD_MAX_BUILTIN_ARGS] + = { qualifier_unsigned, qualifier_unsigned, qualifier_unsigned, + qualifier_unsigned, qualifier_lane_index }; +#define UMAC_LANE_QUALIFIERS (arm_umac_lane_qualifiers) + /* T (T, T, immediate). */ static enum arm_type_qualifiers arm_ternop_imm_qualifiers[SIMD_MAX_BUILTIN_ARGS] diff --git a/gcc/config/arm/arm-c.c b/gcc/config/arm/arm-c.c index 9178937b6d9e0..295f03bf8ee02 100644 --- a/gcc/config/arm/arm-c.c +++ b/gcc/config/arm/arm-c.c @@ -72,11 +72,11 @@ arm_cpu_builtins (struct cpp_reader* pfile) def_or_undef_macro (pfile, "__ARM_FEATURE_QRDMX", TARGET_NEON_RDMA); - if (TARGET_CRC32) - builtin_define ("__ARM_FEATURE_CRC32"); - + def_or_undef_macro (pfile, "__ARM_FEATURE_CRC32", TARGET_CRC32); + def_or_undef_macro (pfile, "__ARM_FEATURE_DOTPROD", TARGET_DOTPROD); def_or_undef_macro (pfile, "__ARM_32BIT_STATE", TARGET_32BIT); + cpp_undef (pfile, "__ARM_FEATURE_CMSE"); if (arm_arch8 && !arm_arch_notm) { if (arm_arch_cmse && use_cmse) diff --git a/gcc/config/arm/arm-cpus.in b/gcc/config/arm/arm-cpus.in index 07de4c9375ba7..0820ad74c2e75 100644 --- a/gcc/config/arm/arm-cpus.in +++ b/gcc/config/arm/arm-cpus.in @@ -156,6 +156,8 @@ define feature crypto # FP16 data processing (half-precision float). define feature fp16 +# Dot Product instructions extension to ARMv8.2-a. +define feature dotprod # ISA Quirks (errata?). Don't forget to add this to the fgroup # ALL_QUIRKS below. @@ -173,6 +175,17 @@ define feature quirk_cm3_ldrd define feature smallmul # Feature groups. Conventionally all (or mostly) upper case. +# ALL_FPU lists all the feature bits associated with the floating-point +# unit; these will all be removed if the floating-point unit is disabled +# (eg -mfloat-abi=soft). ALL_FPU_INTERNAL must ONLY contain features that +# form part of a named -mfpu option; it is used to map the capabilities +# back to a named FPU for the benefit of the assembler. +# +# ALL_SIMD_INTERNAL and ALL_SIMD are similarly defined to help with the +# construction of ALL_FPU and ALL_FPU_INTERNAL; they describe the SIMD +# extensions that are either part of a named FPU or optional extensions +# respectively. + # List of all cryptographic extensions to stripout if crypto is # disabled. Currently, that's trivial, but we define it anyway for @@ -182,11 +195,12 @@ define fgroup ALL_CRYPTO crypto # List of all SIMD bits to strip out if SIMD is disabled. This does # strip off 32 D-registers, but does not remove support for # double-precision FP. -define fgroup ALL_SIMD fp_d32 neon ALL_CRYPTO +define fgroup ALL_SIMD_INTERNAL fp_d32 neon ALL_CRYPTO +define fgroup ALL_SIMD ALL_SIMD_INTERNAL dotprod # List of all FPU bits to strip out if -mfpu is used to override the # default. fp16 is deliberately missing from this list. -define fgroup ALL_FPU_INTERNAL vfpv2 vfpv3 vfpv4 fpv5 fp16conv fp_dbl ALL_SIMD +define fgroup ALL_FPU_INTERNAL vfpv2 vfpv3 vfpv4 fpv5 fp16conv fp_dbl ALL_SIMD_INTERNAL # Similarly, but including fp16 and other extensions that aren't part of # -mfpu support. @@ -239,6 +253,7 @@ define fgroup FP_D32 FP_DBL fp_d32 define fgroup FP_ARMv8 FPv5 FP_D32 define fgroup NEON FP_D32 neon define fgroup CRYPTO NEON crypto +define fgroup DOTPROD NEON dotprod # List of all quirk bits to strip out when comparing CPU features with # architectures. @@ -561,6 +576,7 @@ begin arch armv8.2-a option crypto add FP_ARMv8 CRYPTO option nocrypto remove ALL_CRYPTO option nofp remove ALL_FP + option dotprod add FP_ARMv8 DOTPROD end arch armv8.2-a begin arch armv8-m.base @@ -1473,7 +1489,7 @@ begin cpu cortex-a55 cname cortexa55 tune for cortex-a53 tune flags LDSCHED - architecture armv8.2-a+fp16 + architecture armv8.2-a+fp16+dotprod fpu neon-fp-armv8 option crypto add FP_ARMv8 CRYPTO option nofp remove ALL_FP @@ -1484,7 +1500,7 @@ begin cpu cortex-a75 cname cortexa75 tune for cortex-a57 tune flags LDSCHED - architecture armv8.2-a+fp16 + architecture armv8.2-a+fp16+dotprod fpu neon-fp-armv8 option crypto add FP_ARMv8 CRYPTO costs cortex_a73 @@ -1496,7 +1512,7 @@ begin cpu cortex-a75.cortex-a55 cname cortexa75cortexa55 tune for cortex-a53 tune flags LDSCHED - architecture armv8.2-a+fp16 + architecture armv8.2-a+fp16+dotprod fpu neon-fp-armv8 option crypto add FP_ARMv8 CRYPTO costs cortex_a73 @@ -1516,6 +1532,7 @@ begin cpu cortex-m33 architecture armv8-m.main+dsp fpu fpv5-sp-d16 option nofp remove ALL_FP + option nodsp remove armv7em costs v7m end cpu cortex-m33 diff --git a/gcc/config/arm/arm.c b/gcc/config/arm/arm.c index bece1f76011e2..6f01021a35132 100644 --- a/gcc/config/arm/arm.c +++ b/gcc/config/arm/arm.c @@ -971,6 +971,9 @@ int arm_condexec_masklen = 0; /* Nonzero if chip supports the ARMv8 CRC instructions. */ int arm_arch_crc = 0; +/* Nonzero if chip supports the AdvSIMD Dot Product instructions. */ +int arm_arch_dotprod = 0; + /* Nonzero if chip supports the ARMv8-M security extensions. */ int arm_arch_cmse = 0; @@ -5883,7 +5886,8 @@ aapcs_vfp_sub_candidate (const_tree type, machine_mode *modep) - tree_to_uhwi (TYPE_MIN_VALUE (index))); /* There must be no padding. */ - if (wi::ne_p (TYPE_SIZE (type), count * GET_MODE_BITSIZE (*modep))) + if (wi::to_wide (TYPE_SIZE (type)) + != count * GET_MODE_BITSIZE (*modep)) return -1; return count; @@ -5913,7 +5917,8 @@ aapcs_vfp_sub_candidate (const_tree type, machine_mode *modep) } /* There must be no padding. */ - if (wi::ne_p (TYPE_SIZE (type), count * GET_MODE_BITSIZE (*modep))) + if (wi::to_wide (TYPE_SIZE (type)) + != count * GET_MODE_BITSIZE (*modep)) return -1; return count; @@ -5945,7 +5950,8 @@ aapcs_vfp_sub_candidate (const_tree type, machine_mode *modep) } /* There must be no padding. */ - if (wi::ne_p (TYPE_SIZE (type), count * GET_MODE_BITSIZE (*modep))) + if (wi::to_wide (TYPE_SIZE (type)) + != count * GET_MODE_BITSIZE (*modep)) return -1; return count; @@ -11247,9 +11253,11 @@ arm_builtin_vectorization_cost (enum vect_cost_for_stmt type_of_cost, return current_tune->vec_costs->scalar_to_vec_cost; case unaligned_load: + case vector_gather_load: return current_tune->vec_costs->vec_unalign_load_cost; case unaligned_store: + case vector_scatter_store: return current_tune->vec_costs->vec_unalign_store_cost; case cond_branch_taken: @@ -15288,12 +15296,23 @@ operands_ok_ldrd_strd (rtx rt, rtx rt2, rtx rn, HOST_WIDE_INT offset, return true; } +/* Return true if a 64-bit access with alignment ALIGN and with a + constant offset OFFSET from the base pointer is permitted on this + architecture. */ +static bool +align_ok_ldrd_strd (HOST_WIDE_INT align, HOST_WIDE_INT offset) +{ + return (unaligned_access + ? (align >= BITS_PER_WORD && (offset & 3) == 0) + : (align >= 2 * BITS_PER_WORD && (offset & 7) == 0)); +} + /* Helper for gen_operands_ldrd_strd. Returns true iff the memory operand MEM's address contains an immediate offset from the base - register and has no side effects, in which case it sets BASE and - OFFSET accordingly. */ + register and has no side effects, in which case it sets BASE, + OFFSET and ALIGN accordingly. */ static bool -mem_ok_for_ldrd_strd (rtx mem, rtx *base, rtx *offset) +mem_ok_for_ldrd_strd (rtx mem, rtx *base, rtx *offset, HOST_WIDE_INT *align) { rtx addr; @@ -15312,6 +15331,7 @@ mem_ok_for_ldrd_strd (rtx mem, rtx *base, rtx *offset) gcc_assert (MEM_P (mem)); *offset = const0_rtx; + *align = MEM_ALIGN (mem); addr = XEXP (mem, 0); @@ -15352,7 +15372,7 @@ gen_operands_ldrd_strd (rtx *operands, bool load, bool const_store, bool commute) { int nops = 2; - HOST_WIDE_INT offsets[2], offset; + HOST_WIDE_INT offsets[2], offset, align[2]; rtx base = NULL_RTX; rtx cur_base, cur_offset, tmp; int i, gap; @@ -15364,7 +15384,8 @@ gen_operands_ldrd_strd (rtx *operands, bool load, registers, and the corresponding memory offsets. */ for (i = 0; i < nops; i++) { - if (!mem_ok_for_ldrd_strd (operands[nops+i], &cur_base, &cur_offset)) + if (!mem_ok_for_ldrd_strd (operands[nops+i], &cur_base, &cur_offset, + &align[i])) return false; if (i == 0) @@ -15478,6 +15499,7 @@ gen_operands_ldrd_strd (rtx *operands, bool load, /* Swap the instructions such that lower memory is accessed first. */ std::swap (operands[0], operands[1]); std::swap (operands[2], operands[3]); + std::swap (align[0], align[1]); if (const_store) std::swap (operands[4], operands[5]); } @@ -15491,6 +15513,9 @@ gen_operands_ldrd_strd (rtx *operands, bool load, if (gap != 4) return false; + if (!align_ok_ldrd_strd (align[0], offset)) + return false; + /* Make sure we generate legal instructions. */ if (operands_ok_ldrd_strd (operands[0], operands[1], base, offset, false, load)) @@ -26859,7 +26884,7 @@ arm_set_return_address (rtx source, rtx scratch) { arm_stack_offsets *offsets; HOST_WIDE_INT delta; - rtx addr; + rtx addr, mem; unsigned long saved_regs; offsets = arm_get_frame_offsets (); @@ -26889,11 +26914,12 @@ arm_set_return_address (rtx source, rtx scratch) addr = plus_constant (Pmode, addr, delta); } - /* The store needs to be marked as frame related in order to prevent - DSE from deleting it as dead if it is based on fp. */ - rtx insn = emit_move_insn (gen_frame_mem (Pmode, addr), source); - RTX_FRAME_RELATED_P (insn) = 1; - add_reg_note (insn, REG_CFA_RESTORE, gen_rtx_REG (Pmode, LR_REGNUM)); + + /* The store needs to be marked to prevent DSE from deleting + it as dead if it is based on fp. */ + mem = gen_frame_mem (Pmode, addr); + MEM_VOLATILE_P (mem) = true; + emit_move_insn (mem, source); } } @@ -26905,7 +26931,7 @@ thumb_set_return_address (rtx source, rtx scratch) HOST_WIDE_INT delta; HOST_WIDE_INT limit; int reg; - rtx addr; + rtx addr, mem; unsigned long mask; emit_use (source); @@ -26945,11 +26971,11 @@ thumb_set_return_address (rtx source, rtx scratch) else addr = plus_constant (Pmode, addr, delta); - /* The store needs to be marked as frame related in order to prevent - DSE from deleting it as dead if it is based on fp. */ - rtx insn = emit_move_insn (gen_frame_mem (Pmode, addr), source); - RTX_FRAME_RELATED_P (insn) = 1; - add_reg_note (insn, REG_CFA_RESTORE, gen_rtx_REG (Pmode, LR_REGNUM)); + /* The store needs to be marked to prevent DSE from deleting + it as dead if it is based on fp. */ + mem = gen_frame_mem (Pmode, addr); + MEM_VOLATILE_P (mem) = true; + emit_move_insn (mem, source); } else emit_move_insn (gen_rtx_REG (Pmode, LR_REGNUM), source); diff --git a/gcc/config/arm/arm.h b/gcc/config/arm/arm.h index a3ca800f7a5cb..7e1eeb5254c2c 100644 --- a/gcc/config/arm/arm.h +++ b/gcc/config/arm/arm.h @@ -210,6 +210,11 @@ extern tree arm_fp16_type_node; /* FPU supports ARMv8.1 Adv.SIMD extensions. */ #define TARGET_NEON_RDMA (TARGET_NEON && arm_arch8_1) +/* Supports for Dot Product AdvSIMD extensions. */ +#define TARGET_DOTPROD (TARGET_NEON \ + && bitmap_bit_p (arm_active_target.isa, \ + isa_bit_dotprod)) + /* FPU supports the floating point FP16 instructions for ARMv8.2 and later. */ #define TARGET_VFP_FP16INST \ (TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_VFP5 && arm_fp16_inst) diff --git a/gcc/config/arm/arm_neon_builtins.def b/gcc/config/arm/arm_neon_builtins.def index 07f0368343a0c..982eec810dafb 100644 --- a/gcc/config/arm/arm_neon_builtins.def +++ b/gcc/config/arm/arm_neon_builtins.def @@ -331,3 +331,7 @@ VAR11 (STORE1, vst4, v8qi, v4hi, v4hf, v2si, v2sf, di, v16qi, v8hi, v8hf, v4si, v4sf) VAR9 (STORE1LANE, vst4_lane, v8qi, v4hi, v4hf, v2si, v2sf, v8hi, v8hf, v4si, v4sf) +VAR2 (TERNOP, sdot, v8qi, v16qi) +VAR2 (UTERNOP, udot, v8qi, v16qi) +VAR2 (MAC_LANE, sdot_lane, v8qi, v16qi) +VAR2 (UMAC_LANE, udot_lane, v8qi, v16qi) diff --git a/gcc/config/arm/iterators.md b/gcc/config/arm/iterators.md index 7acbaf1bb40a4..a4fb234a84679 100644 --- a/gcc/config/arm/iterators.md +++ b/gcc/config/arm/iterators.md @@ -410,6 +410,8 @@ (define_int_iterator VFM_LANE_AS [UNSPEC_VFMA_LANE UNSPEC_VFMS_LANE]) +(define_int_iterator DOTPROD [UNSPEC_DOT_S UNSPEC_DOT_U]) + ;;---------------------------------------------------------------------------- ;; Mode attributes ;;---------------------------------------------------------------------------- @@ -720,6 +722,9 @@ (define_mode_attr pf [(V8QI "p") (V16QI "p") (V2SF "f") (V4SF "f")]) +(define_mode_attr VSI2QI [(V2SI "V8QI") (V4SI "V16QI")]) +(define_mode_attr vsi2qi [(V2SI "v8qi") (V4SI "v16qi")]) + ;;---------------------------------------------------------------------------- ;; Code attributes ;;---------------------------------------------------------------------------- @@ -816,6 +821,7 @@ (UNSPEC_VSRA_S_N "s") (UNSPEC_VSRA_U_N "u") (UNSPEC_VRSRA_S_N "s") (UNSPEC_VRSRA_U_N "u") (UNSPEC_VCVTH_S "s") (UNSPEC_VCVTH_U "u") + (UNSPEC_DOT_S "s") (UNSPEC_DOT_U "u") ]) (define_int_attr vcvth_op @@ -1003,3 +1009,6 @@ (define_int_attr mrrc [(VUNSPEC_MRRC "mrrc") (VUNSPEC_MRRC2 "mrrc2")]) (define_int_attr MRRC [(VUNSPEC_MRRC "MRRC") (VUNSPEC_MRRC2 "MRRC2")]) + +(define_int_attr opsuffix [(UNSPEC_DOT_S "s8") + (UNSPEC_DOT_U "u8")]) diff --git a/gcc/config/arm/neon.md b/gcc/config/arm/neon.md index 12ba2d98a0ae0..e715a5c2ae16e 100644 --- a/gcc/config/arm/neon.md +++ b/gcc/config/arm/neon.md @@ -3044,6 +3044,76 @@ DONE; }) +;; These instructions map to the __builtins for the Dot Product operations. +(define_insn "neon_dot" + [(set (match_operand:VCVTI 0 "register_operand" "=w") + (plus:VCVTI (match_operand:VCVTI 1 "register_operand" "0") + (unspec:VCVTI [(match_operand: 2 + "register_operand" "w") + (match_operand: 3 + "register_operand" "w")] + DOTPROD)))] + "TARGET_DOTPROD" + "vdot.\\t%0, %2, %3" + [(set_attr "type" "neon_dot")] +) + +;; These instructions map to the __builtins for the Dot Product +;; indexed operations. +(define_insn "neon_dot_lane" + [(set (match_operand:VCVTI 0 "register_operand" "=w") + (plus:VCVTI (match_operand:VCVTI 1 "register_operand" "0") + (unspec:VCVTI [(match_operand: 2 + "register_operand" "w") + (match_operand:V8QI 3 "register_operand" "t") + (match_operand:SI 4 "immediate_operand" "i")] + DOTPROD)))] + "TARGET_DOTPROD" + { + operands[4] + = GEN_INT (NEON_ENDIAN_LANE_N (V8QImode, INTVAL (operands[4]))); + return "vdot.\\t%0, %2, %P3[%c4]"; + } + [(set_attr "type" "neon_dot")] +) + +;; These expands map to the Dot Product optab the vectorizer checks for. +;; The auto-vectorizer expects a dot product builtin that also does an +;; accumulation into the provided register. +;; Given the following pattern +;; +;; for (i=0; idot_prod" + [(set (match_operand:VCVTI 0 "register_operand") + (plus:VCVTI (unspec:VCVTI [(match_operand: 1 + "register_operand") + (match_operand: 2 + "register_operand")] + DOTPROD) + (match_operand:VCVTI 3 "register_operand")))] + "TARGET_DOTPROD" +{ + emit_insn ( + gen_neon_dot (operands[3], operands[3], operands[1], + operands[2])); + emit_insn (gen_rtx_SET (operands[0], operands[3])); + DONE; +}) + (define_expand "neon_copysignf" [(match_operand:VCVTF 0 "register_operand") (match_operand:VCVTF 1 "register_operand") diff --git a/gcc/config/arm/t-multilib b/gcc/config/arm/t-multilib index ec4b76dbc8fc5..47f3673160a76 100644 --- a/gcc/config/arm/t-multilib +++ b/gcc/config/arm/t-multilib @@ -68,7 +68,7 @@ v7ve_vfpv4_simd_variants := +simd v8_a_nosimd_variants := +crc v8_a_simd_variants := $(call all_feat_combs, simd crypto) v8_1_a_simd_variants := $(call all_feat_combs, simd crypto) -v8_2_a_simd_variants := $(call all_feat_combs, simd fp16 crypto) +v8_2_a_simd_variants := $(call all_feat_combs, simd fp16 crypto dotprod) ifneq (,$(HAS_APROFILE)) diff --git a/gcc/config/arm/types.md b/gcc/config/arm/types.md index 22d993d46a30f..03e9cdebb7509 100644 --- a/gcc/config/arm/types.md +++ b/gcc/config/arm/types.md @@ -316,6 +316,8 @@ ; neon_cls_q ; neon_cnt ; neon_cnt_q +; neon_dot +; neon_dot_q ; neon_ext ; neon_ext_q ; neon_rbit @@ -764,6 +766,8 @@ \ neon_abs,\ neon_abs_q,\ + neon_dot,\ + neon_dot_q,\ neon_neg,\ neon_neg_q,\ neon_qneg,\ @@ -1110,8 +1114,8 @@ neon_sub, neon_sub_q, neon_sub_widen, neon_sub_long, neon_qsub,\ neon_qsub_q, neon_sub_halve, neon_sub_halve_q,\ neon_sub_halve_narrow_q,\ - neon_abs, neon_abs_q, neon_neg, neon_neg_q, neon_qneg,\ - neon_qneg_q, neon_qabs, neon_qabs_q, neon_abd, neon_abd_q,\ + neon_abs, neon_abs_q, neon_dot, neon_dot_q, neon_neg, neon_neg_q,\ + neon_qneg, neon_qneg_q, neon_qabs, neon_qabs_q, neon_abd, neon_abd_q,\ neon_abd_long, neon_minmax, neon_minmax_q, neon_compare,\ neon_compare_q, neon_compare_zero, neon_compare_zero_q,\ neon_arith_acc, neon_arith_acc_q, neon_reduc_add,\ diff --git a/gcc/config/arm/unspecs.md b/gcc/config/arm/unspecs.md index 99cfa41b08dad..c474f4bb5db99 100644 --- a/gcc/config/arm/unspecs.md +++ b/gcc/config/arm/unspecs.md @@ -410,4 +410,6 @@ UNSPEC_VRNDN UNSPEC_VRNDP UNSPEC_VRNDX + UNSPEC_DOT_S + UNSPEC_DOT_U ]) diff --git a/gcc/config/avr/avr.c b/gcc/config/avr/avr.c index 62ddc579d861a..d9c8277eff547 100644 --- a/gcc/config/avr/avr.c +++ b/gcc/config/avr/avr.c @@ -14495,7 +14495,7 @@ avr_fold_builtin (tree fndecl, int n_args ATTRIBUTE_UNUSED, tree *arg, break; } - tmap = wide_int_to_tree (map_type, arg[0]); + tmap = wide_int_to_tree (map_type, wi::to_wide (arg[0])); map = TREE_INT_CST_LOW (tmap); if (TREE_CODE (tval) != INTEGER_CST diff --git a/gcc/config/bfin/bfin.c b/gcc/config/bfin/bfin.c index ed9ea03682f69..c95f82dc3aebb 100644 --- a/gcc/config/bfin/bfin.c +++ b/gcc/config/bfin/bfin.c @@ -3318,7 +3318,7 @@ bfin_local_alignment (tree type, unsigned align) memcpy can use 32 bit loads/stores. */ if (TYPE_SIZE (type) && TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST - && wi::gtu_p (TYPE_SIZE (type), 8) + && wi::gtu_p (wi::to_wide (TYPE_SIZE (type)), 8) && align < 32) return 32; return align; diff --git a/gcc/config/darwin-c.c b/gcc/config/darwin-c.c index 157c2fd597dcf..91f08a0dceea5 100644 --- a/gcc/config/darwin-c.c +++ b/gcc/config/darwin-c.c @@ -433,7 +433,7 @@ add_system_framework_path (char *path) p->construct = framework_construct_pathname; using_frameworks = 1; - add_cpp_dir_path (p, SYSTEM); + add_cpp_dir_path (p, INC_SYSTEM); } /* Add PATH to the bracket includes. PATH must be malloc-ed and @@ -451,7 +451,7 @@ add_framework_path (char *path) p->construct = framework_construct_pathname; using_frameworks = 1; - add_cpp_dir_path (p, BRACKET); + add_cpp_dir_path (p, INC_BRACKET); } static const char *framework_defaults [] = @@ -488,7 +488,7 @@ darwin_register_objc_includes (const char *sysroot, const char *iprefix, { str = concat (iprefix, fname + len, NULL); /* FIXME: wrap the headers for C++awareness. */ - add_path (str, SYSTEM, /*c++aware=*/false, false); + add_path (str, INC_SYSTEM, /*c++aware=*/false, false); } /* Should this directory start with the sysroot? */ @@ -497,7 +497,7 @@ darwin_register_objc_includes (const char *sysroot, const char *iprefix, else str = update_path (fname, ""); - add_path (str, SYSTEM, /*c++aware=*/false, false); + add_path (str, INC_SYSTEM, /*c++aware=*/false, false); } } diff --git a/gcc/config/darwin.c b/gcc/config/darwin.c index b6dad70df0ab5..e633b88f6b0c7 100644 --- a/gcc/config/darwin.c +++ b/gcc/config/darwin.c @@ -1319,13 +1319,13 @@ darwin_mergeable_constant_section (tree exp, if (TREE_CODE (size) == INTEGER_CST) { - if (wi::eq_p (size, 4)) + if (wi::to_wide (size) == 4) return darwin_sections[literal4_section]; - else if (wi::eq_p (size, 8)) + else if (wi::to_wide (size) == 8) return darwin_sections[literal8_section]; else if (HAVE_GAS_LITERAL16 && TARGET_64BIT - && wi::eq_p (size, 16)) + && wi::to_wide (size) == 16) return darwin_sections[literal16_section]; } } diff --git a/gcc/config/gnu-user.h b/gcc/config/gnu-user.h index a967b69a3500a..df17b18090696 100644 --- a/gcc/config/gnu-user.h +++ b/gcc/config/gnu-user.h @@ -162,11 +162,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see LD_STATIC_OPTION " --whole-archive -lasan --no-whole-archive " \ LD_DYNAMIC_OPTION "}}%{!static-libasan:-lasan}" #undef LIBTSAN_EARLY_SPEC -#define LIBTSAN_EARLY_SPEC "%{static-libtsan:%{!shared:" \ +#define LIBTSAN_EARLY_SPEC "%{!shared:libtsan_preinit%O%s} " \ + "%{static-libtsan:%{!shared:" \ LD_STATIC_OPTION " --whole-archive -ltsan --no-whole-archive " \ LD_DYNAMIC_OPTION "}}%{!static-libtsan:-ltsan}" #undef LIBLSAN_EARLY_SPEC -#define LIBLSAN_EARLY_SPEC "%{static-liblsan:%{!shared:" \ +#define LIBLSAN_EARLY_SPEC "%{!shared:liblsan_preinit%O%s} " \ + "%{static-liblsan:%{!shared:" \ LD_STATIC_OPTION " --whole-archive -llsan --no-whole-archive " \ LD_DYNAMIC_OPTION "}}%{!static-liblsan:-llsan}" #endif diff --git a/gcc/config/i386/avx512dqintrin.h b/gcc/config/i386/avx512dqintrin.h index 88e8adb18c54b..8e887d8c5ba82 100644 --- a/gcc/config/i386/avx512dqintrin.h +++ b/gcc/config/i386/avx512dqintrin.h @@ -1160,16 +1160,63 @@ extern __inline __m128d __attribute__ ((__gnu_inline__, __always_inline__, __artificial__)) _mm_reduce_sd (__m128d __A, __m128d __B, int __C) { - return (__m128d) __builtin_ia32_reducesd ((__v2df) __A, - (__v2df) __B, __C); + return (__m128d) __builtin_ia32_reducesd_mask ((__v2df) __A, + (__v2df) __B, __C, + (__v2df) _mm_setzero_pd (), + (__mmask8) -1); +} + +extern __inline __m128d +__attribute__ ((__gnu_inline__, __always_inline__, __artificial__)) +_mm_mask_reduce_sd (__m128d __W, __mmask8 __U, __m128d __A, + __m128d __B, int __C) +{ + return (__m128d) __builtin_ia32_reducesd_mask ((__v2df) __A, + (__v2df) __B, __C, + (__v2df) __W, + (__mmask8) __U); +} + +extern __inline __m128d +__attribute__ ((__gnu_inline__, __always_inline__, __artificial__)) +_mm_maskz_reduce_sd (__mmask8 __U, __m128d __A, __m128d __B, int __C) +{ + return (__m128d) __builtin_ia32_reducesd_mask ((__v2df) __A, + (__v2df) __B, __C, + (__v2df) _mm_setzero_pd (), + (__mmask8) __U); } extern __inline __m128 __attribute__ ((__gnu_inline__, __always_inline__, __artificial__)) _mm_reduce_ss (__m128 __A, __m128 __B, int __C) { - return (__m128) __builtin_ia32_reducess ((__v4sf) __A, - (__v4sf) __B, __C); + return (__m128) __builtin_ia32_reducess_mask ((__v4sf) __A, + (__v4sf) __B, __C, + (__v4sf) _mm_setzero_ps (), + (__mmask8) -1); +} + + +extern __inline __m128 +__attribute__ ((__gnu_inline__, __always_inline__, __artificial__)) +_mm_mask_reduce_ss (__m128 __W, __mmask8 __U, __m128 __A, + __m128 __B, int __C) +{ + return (__m128) __builtin_ia32_reducess_mask ((__v4sf) __A, + (__v4sf) __B, __C, + (__v4sf) __W, + (__mmask8) __U); +} + +extern __inline __m128 +__attribute__ ((__gnu_inline__, __always_inline__, __artificial__)) +_mm_maskz_reduce_ss (__mmask8 __U, __m128 __A, __m128 __B, int __C) +{ + return (__m128) __builtin_ia32_reducess_mask ((__v4sf) __A, + (__v4sf) __B, __C, + (__v4sf) _mm_setzero_ps (), + (__mmask8) __U); } extern __inline __m128d @@ -2449,12 +2496,34 @@ _mm512_fpclass_ps_mask (__m512 __A, const int __imm) (int) (c),(__mmask8)-1)) #define _mm_reduce_sd(A, B, C) \ - ((__m128d) __builtin_ia32_reducesd ((__v2df)(__m128d)(A), \ - (__v2df)(__m128d)(B), (int)(C))) \ + ((__m128d) __builtin_ia32_reducesd_mask ((__v2df)(__m128d)(A), \ + (__v2df)(__m128d)(B), (int)(C), (__v2df) _mm_setzero_pd (), \ + (__mmask8)-1)) + +#define _mm_mask_reduce_sd(W, U, A, B, C) \ + ((__m128d) __builtin_ia32_reducesd_mask ((__v2df)(__m128d)(A), \ + (__v2df)(__m128d)(B), (int)(C), (__v2df)(__m128d)(W), (__mmask8)(U))) + +#define _mm_maskz_reduce_sd(U, A, B, C) \ + ((__m128d) __builtin_ia32_reducesd_mask ((__v2df)(__m128d)(A), \ + (__v2df)(__m128d)(B), (int)(C), (__v2df) _mm_setzero_pd (), \ + (__mmask8)(U))) #define _mm_reduce_ss(A, B, C) \ - ((__m128) __builtin_ia32_reducess ((__v4sf)(__m128)(A), \ - (__v4sf)(__m128)(A), (int)(C))) \ + ((__m128) __builtin_ia32_reducess_mask ((__v4sf)(__m128)(A), \ + (__v4sf)(__m128)(B), (int)(C), (__v4sf) _mm_setzero_ps (), \ + (__mmask8)-1)) + +#define _mm_mask_reduce_ss(W, U, A, B, C) \ + ((__m128) __builtin_ia32_reducess_mask ((__v4sf)(__m128)(A), \ + (__v4sf)(__m128)(B), (int)(C), (__v4sf)(__m128)(W), (__mmask8)(U))) + +#define _mm_maskz_reduce_ss(U, A, B, C) \ + ((__m128) __builtin_ia32_reducess_mask ((__v4sf)(__m128)(A), \ + (__v4sf)(__m128)(B), (int)(C), (__v4sf) _mm_setzero_ps (), \ + (__mmask8)(U))) + + #endif diff --git a/gcc/config/i386/cpuid.h b/gcc/config/i386/cpuid.h index b3b0f912c9864..a16c2d7a5b863 100644 --- a/gcc/config/i386/cpuid.h +++ b/gcc/config/i386/cpuid.h @@ -97,6 +97,7 @@ #define bit_AVX512VBMI (1 << 1) #define bit_PKU (1 << 3) #define bit_OSPKE (1 << 4) +#define bit_GFNI (1 << 8) #define bit_AVX512VPOPCNTDQ (1 << 14) #define bit_RDPID (1 << 22) diff --git a/gcc/config/i386/driver-i386.c b/gcc/config/i386/driver-i386.c index e78cd929d6f55..8f4babde62adc 100644 --- a/gcc/config/i386/driver-i386.c +++ b/gcc/config/i386/driver-i386.c @@ -415,6 +415,7 @@ const char *host_detect_local_cpu (int argc, const char **argv) unsigned int has_avx512vbmi = 0, has_avx512ifma = 0, has_clwb = 0; unsigned int has_mwaitx = 0, has_clzero = 0, has_pku = 0, has_rdpid = 0; unsigned int has_avx5124fmaps = 0, has_avx5124vnniw = 0; + unsigned int has_gfni = 0; bool arch; @@ -504,6 +505,7 @@ const char *host_detect_local_cpu (int argc, const char **argv) has_avx512vbmi = ecx & bit_AVX512VBMI; has_pku = ecx & bit_OSPKE; has_rdpid = ecx & bit_RDPID; + has_gfni = ecx & bit_GFNI; has_avx5124vnniw = edx & bit_AVX5124VNNIW; has_avx5124fmaps = edx & bit_AVX5124FMAPS; @@ -1048,6 +1050,7 @@ const char *host_detect_local_cpu (int argc, const char **argv) const char *clzero = has_clzero ? " -mclzero" : " -mno-clzero"; const char *pku = has_pku ? " -mpku" : " -mno-pku"; const char *rdpid = has_rdpid ? " -mrdpid" : " -mno-rdpid"; + const char *gfni = has_gfni ? " -mgfni" : " -mno-gfni"; options = concat (options, mmx, mmx3dnow, sse, sse2, sse3, ssse3, sse4a, cx16, sahf, movbe, aes, sha, pclmul, popcnt, abm, lwp, fma, fma4, xop, bmi, sgx, bmi2, @@ -1057,7 +1060,7 @@ const char *host_detect_local_cpu (int argc, const char **argv) avx512cd, avx512pf, prefetchwt1, clflushopt, xsavec, xsaves, avx512dq, avx512bw, avx512vl, avx512ifma, avx512vbmi, avx5124fmaps, avx5124vnniw, - clwb, mwaitx, clzero, pku, rdpid, NULL); + clwb, mwaitx, clzero, pku, rdpid, gfni, NULL); } done: diff --git a/gcc/config/i386/i386-builtin.def b/gcc/config/i386/i386-builtin.def index 7ff1bb1a7e04e..4666a4e63001d 100644 --- a/gcc/config/i386/i386-builtin.def +++ b/gcc/config/i386/i386-builtin.def @@ -137,7 +137,7 @@ BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_sse_storelps, "__builtin_ia32_storelps", IX /* SSE or 3DNow!A */ BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, CODE_FOR_sse_sfence, "__builtin_ia32_sfence", IX86_BUILTIN_SFENCE, UNKNOWN, (int) VOID_FTYPE_VOID) -BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, CODE_FOR_sse_movntq, "__builtin_ia32_movntq", IX86_BUILTIN_MOVNTQ, UNKNOWN, (int) VOID_FTYPE_PULONGLONG_ULONGLONG) +BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A | OPTION_MASK_ISA_MMX, CODE_FOR_sse_movntq, "__builtin_ia32_movntq", IX86_BUILTIN_MOVNTQ, UNKNOWN, (int) VOID_FTYPE_PULONGLONG_ULONGLONG) /* SSE2 */ BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_lfence, "__builtin_ia32_lfence", IX86_BUILTIN_LFENCE, UNKNOWN, (int) VOID_FTYPE_VOID) @@ -505,10 +505,10 @@ BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_sqrtv4sf2, "__builtin_ia32_sqrtps_nr", IX86 BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_sse_rsqrtv4sf2, "__builtin_ia32_rsqrtps", IX86_BUILTIN_RSQRTPS, UNKNOWN, (int) V4SF_FTYPE_V4SF) BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_rsqrtv4sf2, "__builtin_ia32_rsqrtps_nr", IX86_BUILTIN_RSQRTPS_NR, UNKNOWN, (int) V4SF_FTYPE_V4SF) BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_sse_rcpv4sf2, "__builtin_ia32_rcpps", IX86_BUILTIN_RCPPS, UNKNOWN, (int) V4SF_FTYPE_V4SF) -BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_sse_cvtps2pi, "__builtin_ia32_cvtps2pi", IX86_BUILTIN_CVTPS2PI, UNKNOWN, (int) V2SI_FTYPE_V4SF) +BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_MMX, CODE_FOR_sse_cvtps2pi, "__builtin_ia32_cvtps2pi", IX86_BUILTIN_CVTPS2PI, UNKNOWN, (int) V2SI_FTYPE_V4SF) BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_sse_cvtss2si, "__builtin_ia32_cvtss2si", IX86_BUILTIN_CVTSS2SI, UNKNOWN, (int) INT_FTYPE_V4SF) BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_64BIT, CODE_FOR_sse_cvtss2siq, "__builtin_ia32_cvtss2si64", IX86_BUILTIN_CVTSS2SI64, UNKNOWN, (int) INT64_FTYPE_V4SF) -BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_sse_cvttps2pi, "__builtin_ia32_cvttps2pi", IX86_BUILTIN_CVTTPS2PI, UNKNOWN, (int) V2SI_FTYPE_V4SF) +BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_MMX, CODE_FOR_sse_cvttps2pi, "__builtin_ia32_cvttps2pi", IX86_BUILTIN_CVTTPS2PI, UNKNOWN, (int) V2SI_FTYPE_V4SF) BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_sse_cvttss2si, "__builtin_ia32_cvttss2si", IX86_BUILTIN_CVTTSS2SI, UNKNOWN, (int) INT_FTYPE_V4SF) BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_64BIT, CODE_FOR_sse_cvttss2siq, "__builtin_ia32_cvttss2si64", IX86_BUILTIN_CVTTSS2SI64, UNKNOWN, (int) INT64_FTYPE_V4SF) @@ -562,7 +562,7 @@ BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_sse_movlhps_exp, "__builtin_ia32_movlhps", BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_vec_interleave_highv4sf, "__builtin_ia32_unpckhps", IX86_BUILTIN_UNPCKHPS, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF) BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_vec_interleave_lowv4sf, "__builtin_ia32_unpcklps", IX86_BUILTIN_UNPCKLPS, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF) -BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_sse_cvtpi2ps, "__builtin_ia32_cvtpi2ps", IX86_BUILTIN_CVTPI2PS, UNKNOWN, (int) V4SF_FTYPE_V4SF_V2SI) +BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_MMX, CODE_FOR_sse_cvtpi2ps, "__builtin_ia32_cvtpi2ps", IX86_BUILTIN_CVTPI2PS, UNKNOWN, (int) V4SF_FTYPE_V4SF_V2SI) BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_sse_cvtsi2ss, "__builtin_ia32_cvtsi2ss", IX86_BUILTIN_CVTSI2SS, UNKNOWN, (int) V4SF_FTYPE_V4SF_SI) BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_64BIT, CODE_FOR_sse_cvtsi2ssq, "__builtin_ia32_cvtsi642ss", IX86_BUILTIN_CVTSI642SS, UNKNOWN, V4SF_FTYPE_V4SF_DI) @@ -576,19 +576,19 @@ BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_abstf2, 0, IX86_BUILTIN_FABSQ, UNKNOWN, (in BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_copysigntf3, 0, IX86_BUILTIN_COPYSIGNQ, UNKNOWN, (int) FLOAT128_FTYPE_FLOAT128_FLOAT128) /* SSE MMX or 3Dnow!A */ -BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, CODE_FOR_mmx_uavgv8qi3, "__builtin_ia32_pavgb", IX86_BUILTIN_PAVGB, UNKNOWN, (int) V8QI_FTYPE_V8QI_V8QI) -BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, CODE_FOR_mmx_uavgv4hi3, "__builtin_ia32_pavgw", IX86_BUILTIN_PAVGW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) -BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, CODE_FOR_mmx_umulv4hi3_highpart, "__builtin_ia32_pmulhuw", IX86_BUILTIN_PMULHUW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) +BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A | OPTION_MASK_ISA_MMX, CODE_FOR_mmx_uavgv8qi3, "__builtin_ia32_pavgb", IX86_BUILTIN_PAVGB, UNKNOWN, (int) V8QI_FTYPE_V8QI_V8QI) +BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A | OPTION_MASK_ISA_MMX, CODE_FOR_mmx_uavgv4hi3, "__builtin_ia32_pavgw", IX86_BUILTIN_PAVGW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) +BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A | OPTION_MASK_ISA_MMX, CODE_FOR_mmx_umulv4hi3_highpart, "__builtin_ia32_pmulhuw", IX86_BUILTIN_PMULHUW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) -BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, CODE_FOR_mmx_umaxv8qi3, "__builtin_ia32_pmaxub", IX86_BUILTIN_PMAXUB, UNKNOWN, (int) V8QI_FTYPE_V8QI_V8QI) -BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, CODE_FOR_mmx_smaxv4hi3, "__builtin_ia32_pmaxsw", IX86_BUILTIN_PMAXSW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) -BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, CODE_FOR_mmx_uminv8qi3, "__builtin_ia32_pminub", IX86_BUILTIN_PMINUB, UNKNOWN, (int) V8QI_FTYPE_V8QI_V8QI) -BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, CODE_FOR_mmx_sminv4hi3, "__builtin_ia32_pminsw", IX86_BUILTIN_PMINSW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) +BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A | OPTION_MASK_ISA_MMX, CODE_FOR_mmx_umaxv8qi3, "__builtin_ia32_pmaxub", IX86_BUILTIN_PMAXUB, UNKNOWN, (int) V8QI_FTYPE_V8QI_V8QI) +BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A | OPTION_MASK_ISA_MMX, CODE_FOR_mmx_smaxv4hi3, "__builtin_ia32_pmaxsw", IX86_BUILTIN_PMAXSW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) +BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A | OPTION_MASK_ISA_MMX, CODE_FOR_mmx_uminv8qi3, "__builtin_ia32_pminub", IX86_BUILTIN_PMINUB, UNKNOWN, (int) V8QI_FTYPE_V8QI_V8QI) +BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A | OPTION_MASK_ISA_MMX, CODE_FOR_mmx_sminv4hi3, "__builtin_ia32_pminsw", IX86_BUILTIN_PMINSW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) -BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, CODE_FOR_mmx_psadbw, "__builtin_ia32_psadbw", IX86_BUILTIN_PSADBW, UNKNOWN, (int) V1DI_FTYPE_V8QI_V8QI) -BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, CODE_FOR_mmx_pmovmskb, "__builtin_ia32_pmovmskb", IX86_BUILTIN_PMOVMSKB, UNKNOWN, (int) INT_FTYPE_V8QI) +BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A | OPTION_MASK_ISA_MMX, CODE_FOR_mmx_psadbw, "__builtin_ia32_psadbw", IX86_BUILTIN_PSADBW, UNKNOWN, (int) V1DI_FTYPE_V8QI_V8QI) +BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A | OPTION_MASK_ISA_MMX, CODE_FOR_mmx_pmovmskb, "__builtin_ia32_pmovmskb", IX86_BUILTIN_PMOVMSKB, UNKNOWN, (int) INT_FTYPE_V8QI) -BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, CODE_FOR_mmx_pshufw, "__builtin_ia32_pshufw", IX86_BUILTIN_PSHUFW, UNKNOWN, (int) V4HI_FTYPE_V4HI_INT) +BDESC (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A | OPTION_MASK_ISA_MMX, CODE_FOR_mmx_pshufw, "__builtin_ia32_pshufw", IX86_BUILTIN_PSHUFW, UNKNOWN, (int) V4HI_FTYPE_V4HI_INT) /* SSE2 */ BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_shufpd, "__builtin_ia32_shufpd", IX86_BUILTIN_SHUFPD, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT) @@ -600,12 +600,12 @@ BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_cvtdq2pd, "__builtin_ia32_cvtdq2pd", BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_floatv4siv4sf2, "__builtin_ia32_cvtdq2ps", IX86_BUILTIN_CVTDQ2PS, UNKNOWN, (int) V4SF_FTYPE_V4SI) BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_cvtpd2dq, "__builtin_ia32_cvtpd2dq", IX86_BUILTIN_CVTPD2DQ, UNKNOWN, (int) V4SI_FTYPE_V2DF) -BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_cvtpd2pi, "__builtin_ia32_cvtpd2pi", IX86_BUILTIN_CVTPD2PI, UNKNOWN, (int) V2SI_FTYPE_V2DF) +BDESC (OPTION_MASK_ISA_SSE2 | OPTION_MASK_ISA_MMX, CODE_FOR_sse2_cvtpd2pi, "__builtin_ia32_cvtpd2pi", IX86_BUILTIN_CVTPD2PI, UNKNOWN, (int) V2SI_FTYPE_V2DF) BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_cvtpd2ps, "__builtin_ia32_cvtpd2ps", IX86_BUILTIN_CVTPD2PS, UNKNOWN, (int) V4SF_FTYPE_V2DF) BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_cvttpd2dq, "__builtin_ia32_cvttpd2dq", IX86_BUILTIN_CVTTPD2DQ, UNKNOWN, (int) V4SI_FTYPE_V2DF) -BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_cvttpd2pi, "__builtin_ia32_cvttpd2pi", IX86_BUILTIN_CVTTPD2PI, UNKNOWN, (int) V2SI_FTYPE_V2DF) +BDESC (OPTION_MASK_ISA_SSE2 | OPTION_MASK_ISA_MMX, CODE_FOR_sse2_cvttpd2pi, "__builtin_ia32_cvttpd2pi", IX86_BUILTIN_CVTTPD2PI, UNKNOWN, (int) V2SI_FTYPE_V2DF) -BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_cvtpi2pd, "__builtin_ia32_cvtpi2pd", IX86_BUILTIN_CVTPI2PD, UNKNOWN, (int) V2DF_FTYPE_V2SI) +BDESC (OPTION_MASK_ISA_SSE2 | OPTION_MASK_ISA_MMX, CODE_FOR_sse2_cvtpi2pd, "__builtin_ia32_cvtpi2pd", IX86_BUILTIN_CVTPI2PD, UNKNOWN, (int) V2DF_FTYPE_V2SI) BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_cvtsd2si, "__builtin_ia32_cvtsd2si", IX86_BUILTIN_CVTSD2SI, UNKNOWN, (int) INT_FTYPE_V2DF) BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_cvttsd2si, "__builtin_ia32_cvttsd2si", IX86_BUILTIN_CVTTSD2SI, UNKNOWN, (int) INT_FTYPE_V2DF) @@ -721,7 +721,7 @@ BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_packuswb, "__builtin_ia32_packuswb128 BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_umulv8hi3_highpart, "__builtin_ia32_pmulhuw128", IX86_BUILTIN_PMULHUW128, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI) BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_psadbw, "__builtin_ia32_psadbw128", IX86_BUILTIN_PSADBW128, UNKNOWN, (int) V2DI_FTYPE_V16QI_V16QI) -BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_umulv1siv1di3, "__builtin_ia32_pmuludq", IX86_BUILTIN_PMULUDQ, UNKNOWN, (int) V1DI_FTYPE_V2SI_V2SI) +BDESC (OPTION_MASK_ISA_SSE2 | OPTION_MASK_ISA_MMX, CODE_FOR_sse2_umulv1siv1di3, "__builtin_ia32_pmuludq", IX86_BUILTIN_PMULUDQ, UNKNOWN, (int) V1DI_FTYPE_V2SI_V2SI) BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_vec_widen_umult_even_v4si, "__builtin_ia32_pmuludq128", IX86_BUILTIN_PMULUDQ128, UNKNOWN, (int) V2DI_FTYPE_V4SI_V4SI) BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_pmaddwd, "__builtin_ia32_pmaddwd128", IX86_BUILTIN_PMADDWD128, UNKNOWN, (int) V4SI_FTYPE_V8HI_V8HI) @@ -761,8 +761,8 @@ BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_sse2_vmsqrtv2df2, "__builtin_ia32_sqrtsd", BDESC (OPTION_MASK_ISA_SSE, CODE_FOR_sse2_movq128, "__builtin_ia32_movq128", IX86_BUILTIN_MOVQ128, UNKNOWN, (int) V2DI_FTYPE_V2DI) /* SSE2 MMX */ -BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_mmx_addv1di3, "__builtin_ia32_paddq", IX86_BUILTIN_PADDQ, UNKNOWN, (int) V1DI_FTYPE_V1DI_V1DI) -BDESC (OPTION_MASK_ISA_SSE2, CODE_FOR_mmx_subv1di3, "__builtin_ia32_psubq", IX86_BUILTIN_PSUBQ, UNKNOWN, (int) V1DI_FTYPE_V1DI_V1DI) +BDESC (OPTION_MASK_ISA_SSE2 | OPTION_MASK_ISA_MMX, CODE_FOR_mmx_addv1di3, "__builtin_ia32_paddq", IX86_BUILTIN_PADDQ, UNKNOWN, (int) V1DI_FTYPE_V1DI_V1DI) +BDESC (OPTION_MASK_ISA_SSE2 | OPTION_MASK_ISA_MMX, CODE_FOR_mmx_subv1di3, "__builtin_ia32_psubq", IX86_BUILTIN_PSUBQ, UNKNOWN, (int) V1DI_FTYPE_V1DI_V1DI) /* SSE3 */ BDESC (OPTION_MASK_ISA_SSE3, CODE_FOR_sse3_movshdup, "__builtin_ia32_movshdup", IX86_BUILTIN_MOVSHDUP, UNKNOWN, (int) V4SF_FTYPE_V4SF) @@ -777,40 +777,40 @@ BDESC (OPTION_MASK_ISA_SSE3, CODE_FOR_sse3_hsubv2df3, "__builtin_ia32_hsubpd", I /* SSSE3 */ BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_absv16qi2, "__builtin_ia32_pabsb128", IX86_BUILTIN_PABSB128, UNKNOWN, (int) V16QI_FTYPE_V16QI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_absv8qi2, "__builtin_ia32_pabsb", IX86_BUILTIN_PABSB, UNKNOWN, (int) V8QI_FTYPE_V8QI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_absv8qi2, "__builtin_ia32_pabsb", IX86_BUILTIN_PABSB, UNKNOWN, (int) V8QI_FTYPE_V8QI) BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_absv8hi2, "__builtin_ia32_pabsw128", IX86_BUILTIN_PABSW128, UNKNOWN, (int) V8HI_FTYPE_V8HI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_absv4hi2, "__builtin_ia32_pabsw", IX86_BUILTIN_PABSW, UNKNOWN, (int) V4HI_FTYPE_V4HI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_absv4hi2, "__builtin_ia32_pabsw", IX86_BUILTIN_PABSW, UNKNOWN, (int) V4HI_FTYPE_V4HI) BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_absv4si2, "__builtin_ia32_pabsd128", IX86_BUILTIN_PABSD128, UNKNOWN, (int) V4SI_FTYPE_V4SI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_absv2si2, "__builtin_ia32_pabsd", IX86_BUILTIN_PABSD, UNKNOWN, (int) V2SI_FTYPE_V2SI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_absv2si2, "__builtin_ia32_pabsd", IX86_BUILTIN_PABSD, UNKNOWN, (int) V2SI_FTYPE_V2SI) BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_phaddwv8hi3, "__builtin_ia32_phaddw128", IX86_BUILTIN_PHADDW128, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_phaddwv4hi3, "__builtin_ia32_phaddw", IX86_BUILTIN_PHADDW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_ssse3_phaddwv4hi3, "__builtin_ia32_phaddw", IX86_BUILTIN_PHADDW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_phadddv4si3, "__builtin_ia32_phaddd128", IX86_BUILTIN_PHADDD128, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_phadddv2si3, "__builtin_ia32_phaddd", IX86_BUILTIN_PHADDD, UNKNOWN, (int) V2SI_FTYPE_V2SI_V2SI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_ssse3_phadddv2si3, "__builtin_ia32_phaddd", IX86_BUILTIN_PHADDD, UNKNOWN, (int) V2SI_FTYPE_V2SI_V2SI) BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_phaddswv8hi3, "__builtin_ia32_phaddsw128", IX86_BUILTIN_PHADDSW128, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_phaddswv4hi3, "__builtin_ia32_phaddsw", IX86_BUILTIN_PHADDSW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_ssse3_phaddswv4hi3, "__builtin_ia32_phaddsw", IX86_BUILTIN_PHADDSW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_phsubwv8hi3, "__builtin_ia32_phsubw128", IX86_BUILTIN_PHSUBW128, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_phsubwv4hi3, "__builtin_ia32_phsubw", IX86_BUILTIN_PHSUBW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_ssse3_phsubwv4hi3, "__builtin_ia32_phsubw", IX86_BUILTIN_PHSUBW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_phsubdv4si3, "__builtin_ia32_phsubd128", IX86_BUILTIN_PHSUBD128, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_phsubdv2si3, "__builtin_ia32_phsubd", IX86_BUILTIN_PHSUBD, UNKNOWN, (int) V2SI_FTYPE_V2SI_V2SI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_ssse3_phsubdv2si3, "__builtin_ia32_phsubd", IX86_BUILTIN_PHSUBD, UNKNOWN, (int) V2SI_FTYPE_V2SI_V2SI) BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_phsubswv8hi3, "__builtin_ia32_phsubsw128", IX86_BUILTIN_PHSUBSW128, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_phsubswv4hi3, "__builtin_ia32_phsubsw", IX86_BUILTIN_PHSUBSW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_ssse3_phsubswv4hi3, "__builtin_ia32_phsubsw", IX86_BUILTIN_PHSUBSW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_pmaddubsw128, "__builtin_ia32_pmaddubsw128", IX86_BUILTIN_PMADDUBSW128, UNKNOWN, (int) V8HI_FTYPE_V16QI_V16QI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_pmaddubsw, "__builtin_ia32_pmaddubsw", IX86_BUILTIN_PMADDUBSW, UNKNOWN, (int) V4HI_FTYPE_V8QI_V8QI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_ssse3_pmaddubsw, "__builtin_ia32_pmaddubsw", IX86_BUILTIN_PMADDUBSW, UNKNOWN, (int) V4HI_FTYPE_V8QI_V8QI) BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_pmulhrswv8hi3, "__builtin_ia32_pmulhrsw128", IX86_BUILTIN_PMULHRSW128, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_pmulhrswv4hi3, "__builtin_ia32_pmulhrsw", IX86_BUILTIN_PMULHRSW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_ssse3_pmulhrswv4hi3, "__builtin_ia32_pmulhrsw", IX86_BUILTIN_PMULHRSW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_pshufbv16qi3, "__builtin_ia32_pshufb128", IX86_BUILTIN_PSHUFB128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_pshufbv8qi3, "__builtin_ia32_pshufb", IX86_BUILTIN_PSHUFB, UNKNOWN, (int) V8QI_FTYPE_V8QI_V8QI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_ssse3_pshufbv8qi3, "__builtin_ia32_pshufb", IX86_BUILTIN_PSHUFB, UNKNOWN, (int) V8QI_FTYPE_V8QI_V8QI) BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_psignv16qi3, "__builtin_ia32_psignb128", IX86_BUILTIN_PSIGNB128, UNKNOWN, (int) V16QI_FTYPE_V16QI_V16QI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_psignv8qi3, "__builtin_ia32_psignb", IX86_BUILTIN_PSIGNB, UNKNOWN, (int) V8QI_FTYPE_V8QI_V8QI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_ssse3_psignv8qi3, "__builtin_ia32_psignb", IX86_BUILTIN_PSIGNB, UNKNOWN, (int) V8QI_FTYPE_V8QI_V8QI) BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_psignv8hi3, "__builtin_ia32_psignw128", IX86_BUILTIN_PSIGNW128, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_psignv4hi3, "__builtin_ia32_psignw", IX86_BUILTIN_PSIGNW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_ssse3_psignv4hi3, "__builtin_ia32_psignw", IX86_BUILTIN_PSIGNW, UNKNOWN, (int) V4HI_FTYPE_V4HI_V4HI) BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_psignv4si3, "__builtin_ia32_psignd128", IX86_BUILTIN_PSIGND128, UNKNOWN, (int) V4SI_FTYPE_V4SI_V4SI) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_psignv2si3, "__builtin_ia32_psignd", IX86_BUILTIN_PSIGND, UNKNOWN, (int) V2SI_FTYPE_V2SI_V2SI) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_ssse3_psignv2si3, "__builtin_ia32_psignd", IX86_BUILTIN_PSIGND, UNKNOWN, (int) V2SI_FTYPE_V2SI_V2SI) /* SSSE3. */ BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_palignrti, "__builtin_ia32_palignr128", IX86_BUILTIN_PALIGNR128, UNKNOWN, (int) V2DI_FTYPE_V2DI_V2DI_INT_CONVERT) -BDESC (OPTION_MASK_ISA_SSSE3, CODE_FOR_ssse3_palignrdi, "__builtin_ia32_palignr", IX86_BUILTIN_PALIGNR, UNKNOWN, (int) V1DI_FTYPE_V1DI_V1DI_INT_CONVERT) +BDESC (OPTION_MASK_ISA_SSSE3 | OPTION_MASK_ISA_MMX, CODE_FOR_ssse3_palignrdi, "__builtin_ia32_palignr", IX86_BUILTIN_PALIGNR, UNKNOWN, (int) V1DI_FTYPE_V1DI_V1DI_INT_CONVERT) /* SSE4.1 */ BDESC (OPTION_MASK_ISA_SSE4_1, CODE_FOR_sse4_1_blendpd, "__builtin_ia32_blendpd", IX86_BUILTIN_BLENDPD, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT) @@ -1666,8 +1666,8 @@ BDESC (OPTION_MASK_ISA_AVX512DQ | OPTION_MASK_ISA_AVX512VL, CODE_FOR_reducepv4df BDESC (OPTION_MASK_ISA_AVX512DQ | OPTION_MASK_ISA_AVX512VL, CODE_FOR_reducepv2df_mask, "__builtin_ia32_reducepd128_mask", IX86_BUILTIN_REDUCEPD128_MASK, UNKNOWN, (int) V2DF_FTYPE_V2DF_INT_V2DF_UQI) BDESC (OPTION_MASK_ISA_AVX512DQ | OPTION_MASK_ISA_AVX512VL, CODE_FOR_reducepv8sf_mask, "__builtin_ia32_reduceps256_mask", IX86_BUILTIN_REDUCEPS256_MASK, UNKNOWN, (int) V8SF_FTYPE_V8SF_INT_V8SF_UQI) BDESC (OPTION_MASK_ISA_AVX512DQ | OPTION_MASK_ISA_AVX512VL, CODE_FOR_reducepv4sf_mask, "__builtin_ia32_reduceps128_mask", IX86_BUILTIN_REDUCEPS128_MASK, UNKNOWN, (int) V4SF_FTYPE_V4SF_INT_V4SF_UQI) -BDESC (OPTION_MASK_ISA_AVX512DQ, CODE_FOR_reducesv2df, "__builtin_ia32_reducesd", IX86_BUILTIN_REDUCESD_MASK, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT) -BDESC (OPTION_MASK_ISA_AVX512DQ, CODE_FOR_reducesv4sf, "__builtin_ia32_reducess", IX86_BUILTIN_REDUCESS_MASK, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT) +BDESC (OPTION_MASK_ISA_AVX512DQ, CODE_FOR_reducesv2df_mask, "__builtin_ia32_reducesd_mask", IX86_BUILTIN_REDUCESD128_MASK, UNKNOWN, (int) V2DF_FTYPE_V2DF_V2DF_INT_V2DF_UQI) +BDESC (OPTION_MASK_ISA_AVX512DQ, CODE_FOR_reducesv4sf_mask, "__builtin_ia32_reducess_mask", IX86_BUILTIN_REDUCESS128_MASK, UNKNOWN, (int) V4SF_FTYPE_V4SF_V4SF_INT_V4SF_UQI) BDESC (OPTION_MASK_ISA_AVX512BW | OPTION_MASK_ISA_AVX512VL, CODE_FOR_avx512vl_permvarv16hi_mask, "__builtin_ia32_permvarhi256_mask", IX86_BUILTIN_VPERMVARHI256_MASK, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_V16HI_UHI) BDESC (OPTION_MASK_ISA_AVX512BW | OPTION_MASK_ISA_AVX512VL, CODE_FOR_avx512vl_permvarv8hi_mask, "__builtin_ia32_permvarhi128_mask", IX86_BUILTIN_VPERMVARHI128_MASK, UNKNOWN, (int) V8HI_FTYPE_V8HI_V8HI_V8HI_UQI) BDESC (OPTION_MASK_ISA_AVX512BW | OPTION_MASK_ISA_AVX512VL, CODE_FOR_avx512vl_vpermt2varv16hi3_mask, "__builtin_ia32_vpermt2varhi256_mask", IX86_BUILTIN_VPERMT2VARHI256, UNKNOWN, (int) V16HI_FTYPE_V16HI_V16HI_V16HI_UHI) diff --git a/gcc/config/i386/i386-c.c b/gcc/config/i386/i386-c.c index 44cbe28c8633a..0c6b9fd74fa18 100644 --- a/gcc/config/i386/i386-c.c +++ b/gcc/config/i386/i386-c.c @@ -457,6 +457,8 @@ ix86_target_macros_internal (HOST_WIDE_INT isa_flag, def_or_undef (parse_in, "__PKU__"); if (isa_flag2 & OPTION_MASK_ISA_RDPID) def_or_undef (parse_in, "__RDPID__"); + if (isa_flag2 & OPTION_MASK_ISA_GFNI) + def_or_undef (parse_in, "__GFNI__"); if (TARGET_IAMCU) { def_or_undef (parse_in, "__iamcu"); diff --git a/gcc/config/i386/i386-modes.def b/gcc/config/i386/i386-modes.def index 83216e38758d5..16bc1d8b71a87 100644 --- a/gcc/config/i386/i386-modes.def +++ b/gcc/config/i386/i386-modes.def @@ -39,19 +39,22 @@ ADJUST_ALIGNMENT (XF, TARGET_128BIT_LONG_DOUBLE ? 16 : 4); For the i386, we need separate modes when floating-point equality comparisons are being done. - Add CCNO to indicate comparisons against zero that requires + Add CCNO to indicate comparisons against zero that require Overflow flag to be unset. Sign bit test is used instead and thus can be used to form "a&b>0" type of tests. - Add CCGC to indicate comparisons against zero that allows + Add CCGC to indicate comparisons against zero that allow unspecified garbage in the Carry flag. This mode is used by inc/dec instructions. - Add CCGOC to indicate comparisons against zero that allows + Add CCGOC to indicate comparisons against zero that allow unspecified garbage in the Carry and Overflow flag. This mode is used to simulate comparisons of (a-b) and (a+b) against zero using sub/cmp/add operations. + Add CCGZ to indicate comparisons that allow unspecified garbage + in the Zero flag. This mode is used in double-word comparisons. + Add CCA to indicate that only the Above flag is valid. Add CCC to indicate that only the Carry flag is valid. Add CCO to indicate that only the Overflow flag is valid. @@ -62,6 +65,7 @@ ADJUST_ALIGNMENT (XF, TARGET_128BIT_LONG_DOUBLE ? 16 : 4); CC_MODE (CCGC); CC_MODE (CCGOC); CC_MODE (CCNO); +CC_MODE (CCGZ); CC_MODE (CCA); CC_MODE (CCC); CC_MODE (CCO); diff --git a/gcc/config/i386/i386-protos.h b/gcc/config/i386/i386-protos.h index fbe9f271434a2..6a7cdd3ed737f 100644 --- a/gcc/config/i386/i386-protos.h +++ b/gcc/config/i386/i386-protos.h @@ -27,6 +27,7 @@ extern bool ix86_handle_option (struct gcc_options *opts, extern bool ix86_target_stack_probe (void); extern bool ix86_can_use_return_insn_p (void); extern void ix86_setup_frame_addresses (void); +extern bool ix86_rip_relative_addr_p (struct ix86_address *parts); extern HOST_WIDE_INT ix86_initial_elimination_offset (int, int); extern void ix86_expand_prologue (void); @@ -165,9 +166,6 @@ extern void ix86_asm_output_function_label (FILE *, const char *, tree); extern void ix86_call_abi_override (const_tree); extern int ix86_reg_parm_stack_space (const_tree); -extern void ix86_split_fp_branch (enum rtx_code code, rtx, rtx, - rtx, rtx, rtx); - extern bool ix86_libc_has_function (enum function_class fn_class); extern void x86_order_regs_for_local_alloc (void); @@ -314,6 +312,21 @@ extern enum attr_cpu ix86_schedule; extern const char * ix86_output_call_insn (rtx_insn *insn, rtx call_op); extern bool ix86_operands_ok_for_move_multiple (rtx *operands, bool load, machine_mode mode); +extern int ix86_min_insn_size (rtx_insn *); + +extern int ix86_issue_rate (void); +extern int ix86_adjust_cost (rtx_insn *insn, int dep_type, rtx_insn *dep_insn, + int cost, unsigned int); +extern int ia32_multipass_dfa_lookahead (void); +extern bool ix86_macro_fusion_p (void); +extern bool ix86_macro_fusion_pair_p (rtx_insn *condgen, rtx_insn *condjmp); + +extern bool ix86_bd_has_dispatch (rtx_insn *insn, int action); +extern void ix86_bd_do_dispatch (rtx_insn *insn, int mode); + +extern void ix86_core2i7_init_hooks (void); + +extern int ix86_atom_sched_reorder (FILE *, int, rtx_insn **, int *, int); #ifdef RTX_CODE /* Target data for multipass lookahead scheduling. diff --git a/gcc/config/i386/i386.c b/gcc/config/i386/i386.c index e90cbfb50606d..45a219741dbb0 100644 --- a/gcc/config/i386/i386.c +++ b/gcc/config/i386/i386.c @@ -92,6 +92,8 @@ along with GCC; see the file COPYING3. If not see /* This file should be included last. */ #include "target-def.h" +#include "x86-tune-costs.h" + static rtx legitimize_dllimport_symbol (rtx, bool); static rtx legitimize_pe_coff_extern_decl (rtx, bool); static rtx legitimize_pe_coff_symbol (rtx, bool); @@ -111,2094 +113,12 @@ static bool ix86_function_naked (const_tree); : (mode) == DImode ? 3 \ : 4) -/* Processor costs (relative to an add) */ -/* We assume COSTS_N_INSNS is defined as (N)*4 and an addition is 2 bytes. */ -#define COSTS_N_BYTES(N) ((N) * 2) - -#define DUMMY_STRINGOP_ALGS {libcall, {{-1, libcall, false}}} - -static stringop_algs ix86_size_memcpy[2] = { - {rep_prefix_1_byte, {{-1, rep_prefix_1_byte, false}}}, - {rep_prefix_1_byte, {{-1, rep_prefix_1_byte, false}}}}; -static stringop_algs ix86_size_memset[2] = { - {rep_prefix_1_byte, {{-1, rep_prefix_1_byte, false}}}, - {rep_prefix_1_byte, {{-1, rep_prefix_1_byte, false}}}}; - -const -struct processor_costs ix86_size_cost = {/* costs for tuning for size */ - COSTS_N_BYTES (2), /* cost of an add instruction */ - COSTS_N_BYTES (3), /* cost of a lea instruction */ - COSTS_N_BYTES (2), /* variable shift costs */ - COSTS_N_BYTES (3), /* constant shift costs */ - {COSTS_N_BYTES (3), /* cost of starting multiply for QI */ - COSTS_N_BYTES (3), /* HI */ - COSTS_N_BYTES (3), /* SI */ - COSTS_N_BYTES (3), /* DI */ - COSTS_N_BYTES (5)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_BYTES (3), /* cost of a divide/mod for QI */ - COSTS_N_BYTES (3), /* HI */ - COSTS_N_BYTES (3), /* SI */ - COSTS_N_BYTES (3), /* DI */ - COSTS_N_BYTES (5)}, /* other */ - COSTS_N_BYTES (3), /* cost of movsx */ - COSTS_N_BYTES (3), /* cost of movzx */ - 0, /* "large" insn */ - 2, /* MOVE_RATIO */ - 2, /* cost for loading QImode using movzbl */ - {2, 2, 2}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {2, 2, 2}, /* cost of storing integer registers */ - 2, /* cost of reg,reg fld/fst */ - {2, 2, 2}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {2, 2, 2}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 3, /* cost of moving MMX register */ - {3, 3}, /* cost of loading MMX registers - in SImode and DImode */ - {3, 3}, /* cost of storing MMX registers - in SImode and DImode */ - 3, /* cost of moving SSE register */ - {3, 3, 3}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {3, 3, 3}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 3, /* MMX or SSE register to integer */ - 0, /* size of l1 cache */ - 0, /* size of l2 cache */ - 0, /* size of prefetch block */ - 0, /* number of parallel prefetches */ - 2, /* Branch cost */ - COSTS_N_BYTES (2), /* cost of FADD and FSUB insns. */ - COSTS_N_BYTES (2), /* cost of FMUL instruction. */ - COSTS_N_BYTES (2), /* cost of FDIV instruction. */ - COSTS_N_BYTES (2), /* cost of FABS instruction. */ - COSTS_N_BYTES (2), /* cost of FCHS instruction. */ - COSTS_N_BYTES (2), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - ix86_size_memcpy, - ix86_size_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 1, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 1, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 1, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -/* Processor costs (relative to an add) */ -static stringop_algs i386_memcpy[2] = { - {rep_prefix_1_byte, {{-1, rep_prefix_1_byte, false}}}, - DUMMY_STRINGOP_ALGS}; -static stringop_algs i386_memset[2] = { - {rep_prefix_1_byte, {{-1, rep_prefix_1_byte, false}}}, - DUMMY_STRINGOP_ALGS}; - -static const -struct processor_costs i386_cost = { /* 386 specific costs */ - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (1), /* cost of a lea instruction */ - COSTS_N_INSNS (3), /* variable shift costs */ - COSTS_N_INSNS (2), /* constant shift costs */ - {COSTS_N_INSNS (6), /* cost of starting multiply for QI */ - COSTS_N_INSNS (6), /* HI */ - COSTS_N_INSNS (6), /* SI */ - COSTS_N_INSNS (6), /* DI */ - COSTS_N_INSNS (6)}, /* other */ - COSTS_N_INSNS (1), /* cost of multiply per each bit set */ - {COSTS_N_INSNS (23), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (23), /* HI */ - COSTS_N_INSNS (23), /* SI */ - COSTS_N_INSNS (23), /* DI */ - COSTS_N_INSNS (23)}, /* other */ - COSTS_N_INSNS (3), /* cost of movsx */ - COSTS_N_INSNS (2), /* cost of movzx */ - 15, /* "large" insn */ - 3, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {2, 4, 2}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {2, 4, 2}, /* cost of storing integer registers */ - 2, /* cost of reg,reg fld/fst */ - {8, 8, 8}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {8, 8, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {4, 8}, /* cost of loading MMX registers - in SImode and DImode */ - {4, 8}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {4, 8, 16}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {4, 8, 16}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 3, /* MMX or SSE register to integer */ - 0, /* size of l1 cache */ - 0, /* size of l2 cache */ - 0, /* size of prefetch block */ - 0, /* number of parallel prefetches */ - 1, /* Branch cost */ - COSTS_N_INSNS (23), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (27), /* cost of FMUL instruction. */ - COSTS_N_INSNS (88), /* cost of FDIV instruction. */ - COSTS_N_INSNS (22), /* cost of FABS instruction. */ - COSTS_N_INSNS (24), /* cost of FCHS instruction. */ - COSTS_N_INSNS (122), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - i386_memcpy, - i386_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 1, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -static stringop_algs i486_memcpy[2] = { - {rep_prefix_4_byte, {{-1, rep_prefix_4_byte, false}}}, - DUMMY_STRINGOP_ALGS}; -static stringop_algs i486_memset[2] = { - {rep_prefix_4_byte, {{-1, rep_prefix_4_byte, false}}}, - DUMMY_STRINGOP_ALGS}; - -static const -struct processor_costs i486_cost = { /* 486 specific costs */ - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (1), /* cost of a lea instruction */ - COSTS_N_INSNS (3), /* variable shift costs */ - COSTS_N_INSNS (2), /* constant shift costs */ - {COSTS_N_INSNS (12), /* cost of starting multiply for QI */ - COSTS_N_INSNS (12), /* HI */ - COSTS_N_INSNS (12), /* SI */ - COSTS_N_INSNS (12), /* DI */ - COSTS_N_INSNS (12)}, /* other */ - 1, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (40), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (40), /* HI */ - COSTS_N_INSNS (40), /* SI */ - COSTS_N_INSNS (40), /* DI */ - COSTS_N_INSNS (40)}, /* other */ - COSTS_N_INSNS (3), /* cost of movsx */ - COSTS_N_INSNS (2), /* cost of movzx */ - 15, /* "large" insn */ - 3, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {2, 4, 2}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {2, 4, 2}, /* cost of storing integer registers */ - 2, /* cost of reg,reg fld/fst */ - {8, 8, 8}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {8, 8, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {4, 8}, /* cost of loading MMX registers - in SImode and DImode */ - {4, 8}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {4, 8, 16}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {4, 8, 16}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 3, /* MMX or SSE register to integer */ - 4, /* size of l1 cache. 486 has 8kB cache - shared for code and data, so 4kB is - not really precise. */ - 4, /* size of l2 cache */ - 0, /* size of prefetch block */ - 0, /* number of parallel prefetches */ - 1, /* Branch cost */ - COSTS_N_INSNS (8), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (16), /* cost of FMUL instruction. */ - COSTS_N_INSNS (73), /* cost of FDIV instruction. */ - COSTS_N_INSNS (3), /* cost of FABS instruction. */ - COSTS_N_INSNS (3), /* cost of FCHS instruction. */ - COSTS_N_INSNS (83), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - i486_memcpy, - i486_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 1, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -static stringop_algs pentium_memcpy[2] = { - {libcall, {{256, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - DUMMY_STRINGOP_ALGS}; -static stringop_algs pentium_memset[2] = { - {libcall, {{-1, rep_prefix_4_byte, false}}}, - DUMMY_STRINGOP_ALGS}; - -static const -struct processor_costs pentium_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (1), /* cost of a lea instruction */ - COSTS_N_INSNS (4), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (11), /* cost of starting multiply for QI */ - COSTS_N_INSNS (11), /* HI */ - COSTS_N_INSNS (11), /* SI */ - COSTS_N_INSNS (11), /* DI */ - COSTS_N_INSNS (11)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (25), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (25), /* HI */ - COSTS_N_INSNS (25), /* SI */ - COSTS_N_INSNS (25), /* DI */ - COSTS_N_INSNS (25)}, /* other */ - COSTS_N_INSNS (3), /* cost of movsx */ - COSTS_N_INSNS (2), /* cost of movzx */ - 8, /* "large" insn */ - 6, /* MOVE_RATIO */ - 6, /* cost for loading QImode using movzbl */ - {2, 4, 2}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {2, 4, 2}, /* cost of storing integer registers */ - 2, /* cost of reg,reg fld/fst */ - {2, 2, 6}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {4, 4, 6}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 8, /* cost of moving MMX register */ - {8, 8}, /* cost of loading MMX registers - in SImode and DImode */ - {8, 8}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {4, 8, 16}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {4, 8, 16}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 3, /* MMX or SSE register to integer */ - 8, /* size of l1 cache. */ - 8, /* size of l2 cache */ - 0, /* size of prefetch block */ - 0, /* number of parallel prefetches */ - 2, /* Branch cost */ - COSTS_N_INSNS (3), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (3), /* cost of FMUL instruction. */ - COSTS_N_INSNS (39), /* cost of FDIV instruction. */ - COSTS_N_INSNS (1), /* cost of FABS instruction. */ - COSTS_N_INSNS (1), /* cost of FCHS instruction. */ - COSTS_N_INSNS (70), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - pentium_memcpy, - pentium_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 1, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -static const -struct processor_costs lakemont_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (1) + 1, /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (11), /* cost of starting multiply for QI */ - COSTS_N_INSNS (11), /* HI */ - COSTS_N_INSNS (11), /* SI */ - COSTS_N_INSNS (11), /* DI */ - COSTS_N_INSNS (11)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (25), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (25), /* HI */ - COSTS_N_INSNS (25), /* SI */ - COSTS_N_INSNS (25), /* DI */ - COSTS_N_INSNS (25)}, /* other */ - COSTS_N_INSNS (3), /* cost of movsx */ - COSTS_N_INSNS (2), /* cost of movzx */ - 8, /* "large" insn */ - 17, /* MOVE_RATIO */ - 6, /* cost for loading QImode using movzbl */ - {2, 4, 2}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {2, 4, 2}, /* cost of storing integer registers */ - 2, /* cost of reg,reg fld/fst */ - {2, 2, 6}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {4, 4, 6}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 8, /* cost of moving MMX register */ - {8, 8}, /* cost of loading MMX registers - in SImode and DImode */ - {8, 8}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {4, 8, 16}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {4, 8, 16}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 3, /* MMX or SSE register to integer */ - 8, /* size of l1 cache. */ - 8, /* size of l2 cache */ - 0, /* size of prefetch block */ - 0, /* number of parallel prefetches */ - 2, /* Branch cost */ - COSTS_N_INSNS (3), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (3), /* cost of FMUL instruction. */ - COSTS_N_INSNS (39), /* cost of FDIV instruction. */ - COSTS_N_INSNS (1), /* cost of FABS instruction. */ - COSTS_N_INSNS (1), /* cost of FCHS instruction. */ - COSTS_N_INSNS (70), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - pentium_memcpy, - pentium_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 1, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -/* PentiumPro has optimized rep instructions for blocks aligned by 8 bytes - (we ensure the alignment). For small blocks inline loop is still a - noticeable win, for bigger blocks either rep movsl or rep movsb is - way to go. Rep movsb has apparently more expensive startup time in CPU, - but after 4K the difference is down in the noise. */ -static stringop_algs pentiumpro_memcpy[2] = { - {rep_prefix_4_byte, {{128, loop, false}, {1024, unrolled_loop, false}, - {8192, rep_prefix_4_byte, false}, - {-1, rep_prefix_1_byte, false}}}, - DUMMY_STRINGOP_ALGS}; -static stringop_algs pentiumpro_memset[2] = { - {rep_prefix_4_byte, {{1024, unrolled_loop, false}, - {8192, rep_prefix_4_byte, false}, - {-1, libcall, false}}}, - DUMMY_STRINGOP_ALGS}; -static const -struct processor_costs pentiumpro_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (1), /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (4), /* cost of starting multiply for QI */ - COSTS_N_INSNS (4), /* HI */ - COSTS_N_INSNS (4), /* SI */ - COSTS_N_INSNS (4), /* DI */ - COSTS_N_INSNS (4)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (17), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (17), /* HI */ - COSTS_N_INSNS (17), /* SI */ - COSTS_N_INSNS (17), /* DI */ - COSTS_N_INSNS (17)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 6, /* MOVE_RATIO */ - 2, /* cost for loading QImode using movzbl */ - {4, 4, 4}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {2, 2, 2}, /* cost of storing integer registers */ - 2, /* cost of reg,reg fld/fst */ - {2, 2, 6}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {4, 4, 6}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {2, 2}, /* cost of loading MMX registers - in SImode and DImode */ - {2, 2}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {2, 2, 8}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {2, 2, 8}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 3, /* MMX or SSE register to integer */ - 8, /* size of l1 cache. */ - 256, /* size of l2 cache */ - 32, /* size of prefetch block */ - 6, /* number of parallel prefetches */ - 2, /* Branch cost */ - COSTS_N_INSNS (3), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (5), /* cost of FMUL instruction. */ - COSTS_N_INSNS (56), /* cost of FDIV instruction. */ - COSTS_N_INSNS (2), /* cost of FABS instruction. */ - COSTS_N_INSNS (2), /* cost of FCHS instruction. */ - COSTS_N_INSNS (56), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - pentiumpro_memcpy, - pentiumpro_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 1, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -static stringop_algs geode_memcpy[2] = { - {libcall, {{256, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - DUMMY_STRINGOP_ALGS}; -static stringop_algs geode_memset[2] = { - {libcall, {{256, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - DUMMY_STRINGOP_ALGS}; -static const -struct processor_costs geode_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (1), /* cost of a lea instruction */ - COSTS_N_INSNS (2), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ - COSTS_N_INSNS (4), /* HI */ - COSTS_N_INSNS (7), /* SI */ - COSTS_N_INSNS (7), /* DI */ - COSTS_N_INSNS (7)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (15), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (23), /* HI */ - COSTS_N_INSNS (39), /* SI */ - COSTS_N_INSNS (39), /* DI */ - COSTS_N_INSNS (39)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 4, /* MOVE_RATIO */ - 1, /* cost for loading QImode using movzbl */ - {1, 1, 1}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {1, 1, 1}, /* cost of storing integer registers */ - 1, /* cost of reg,reg fld/fst */ - {1, 1, 1}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {4, 6, 6}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - - 2, /* cost of moving MMX register */ - {2, 2}, /* cost of loading MMX registers - in SImode and DImode */ - {2, 2}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {2, 2, 8}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {2, 2, 8}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 3, /* MMX or SSE register to integer */ - 64, /* size of l1 cache. */ - 128, /* size of l2 cache. */ - 32, /* size of prefetch block */ - 1, /* number of parallel prefetches */ - 1, /* Branch cost */ - COSTS_N_INSNS (6), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (11), /* cost of FMUL instruction. */ - COSTS_N_INSNS (47), /* cost of FDIV instruction. */ - COSTS_N_INSNS (1), /* cost of FABS instruction. */ - COSTS_N_INSNS (1), /* cost of FCHS instruction. */ - COSTS_N_INSNS (54), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - geode_memcpy, - geode_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 1, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -static stringop_algs k6_memcpy[2] = { - {libcall, {{256, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - DUMMY_STRINGOP_ALGS}; -static stringop_algs k6_memset[2] = { - {libcall, {{256, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - DUMMY_STRINGOP_ALGS}; -static const -struct processor_costs k6_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (2), /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ - COSTS_N_INSNS (3), /* HI */ - COSTS_N_INSNS (3), /* SI */ - COSTS_N_INSNS (3), /* DI */ - COSTS_N_INSNS (3)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (18), /* HI */ - COSTS_N_INSNS (18), /* SI */ - COSTS_N_INSNS (18), /* DI */ - COSTS_N_INSNS (18)}, /* other */ - COSTS_N_INSNS (2), /* cost of movsx */ - COSTS_N_INSNS (2), /* cost of movzx */ - 8, /* "large" insn */ - 4, /* MOVE_RATIO */ - 3, /* cost for loading QImode using movzbl */ - {4, 5, 4}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {2, 3, 2}, /* cost of storing integer registers */ - 4, /* cost of reg,reg fld/fst */ - {6, 6, 6}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {4, 4, 4}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {2, 2}, /* cost of loading MMX registers - in SImode and DImode */ - {2, 2}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {2, 2, 8}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {2, 2, 8}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 6, /* MMX or SSE register to integer */ - 32, /* size of l1 cache. */ - 32, /* size of l2 cache. Some models - have integrated l2 cache, but - optimizing for k6 is not important - enough to worry about that. */ - 32, /* size of prefetch block */ - 1, /* number of parallel prefetches */ - 1, /* Branch cost */ - COSTS_N_INSNS (2), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (2), /* cost of FMUL instruction. */ - COSTS_N_INSNS (56), /* cost of FDIV instruction. */ - COSTS_N_INSNS (2), /* cost of FABS instruction. */ - COSTS_N_INSNS (2), /* cost of FCHS instruction. */ - COSTS_N_INSNS (56), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - k6_memcpy, - k6_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 1, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -/* For some reason, Athlon deals better with REP prefix (relative to loops) - compared to K8. Alignment becomes important after 8 bytes for memcpy and - 128 bytes for memset. */ -static stringop_algs athlon_memcpy[2] = { - {libcall, {{2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - DUMMY_STRINGOP_ALGS}; -static stringop_algs athlon_memset[2] = { - {libcall, {{2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - DUMMY_STRINGOP_ALGS}; -static const -struct processor_costs athlon_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (2), /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (5), /* cost of starting multiply for QI */ - COSTS_N_INSNS (5), /* HI */ - COSTS_N_INSNS (5), /* SI */ - COSTS_N_INSNS (5), /* DI */ - COSTS_N_INSNS (5)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (26), /* HI */ - COSTS_N_INSNS (42), /* SI */ - COSTS_N_INSNS (74), /* DI */ - COSTS_N_INSNS (74)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 9, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {3, 4, 3}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {3, 4, 3}, /* cost of storing integer registers */ - 4, /* cost of reg,reg fld/fst */ - {4, 4, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {6, 6, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {4, 4}, /* cost of loading MMX registers - in SImode and DImode */ - {4, 4}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {4, 4, 6}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {4, 4, 5}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 5, /* MMX or SSE register to integer */ - 64, /* size of l1 cache. */ - 256, /* size of l2 cache. */ - 64, /* size of prefetch block */ - 6, /* number of parallel prefetches */ - 5, /* Branch cost */ - COSTS_N_INSNS (4), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (4), /* cost of FMUL instruction. */ - COSTS_N_INSNS (24), /* cost of FDIV instruction. */ - COSTS_N_INSNS (2), /* cost of FABS instruction. */ - COSTS_N_INSNS (2), /* cost of FCHS instruction. */ - COSTS_N_INSNS (35), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - athlon_memcpy, - athlon_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 1, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -/* K8 has optimized REP instruction for medium sized blocks, but for very - small blocks it is better to use loop. For large blocks, libcall can - do nontemporary accesses and beat inline considerably. */ -static stringop_algs k8_memcpy[2] = { - {libcall, {{6, loop, false}, {14, unrolled_loop, false}, - {-1, rep_prefix_4_byte, false}}}, - {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -static stringop_algs k8_memset[2] = { - {libcall, {{8, loop, false}, {24, unrolled_loop, false}, - {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - {libcall, {{48, unrolled_loop, false}, - {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; -static const -struct processor_costs k8_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (2), /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ - COSTS_N_INSNS (4), /* HI */ - COSTS_N_INSNS (3), /* SI */ - COSTS_N_INSNS (4), /* DI */ - COSTS_N_INSNS (5)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (26), /* HI */ - COSTS_N_INSNS (42), /* SI */ - COSTS_N_INSNS (74), /* DI */ - COSTS_N_INSNS (74)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 9, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {3, 4, 3}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {3, 4, 3}, /* cost of storing integer registers */ - 4, /* cost of reg,reg fld/fst */ - {4, 4, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {6, 6, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {3, 3}, /* cost of loading MMX registers - in SImode and DImode */ - {4, 4}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {4, 3, 6}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {4, 4, 5}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 5, /* MMX or SSE register to integer */ - 64, /* size of l1 cache. */ - 512, /* size of l2 cache. */ - 64, /* size of prefetch block */ - /* New AMD processors never drop prefetches; if they cannot be performed - immediately, they are queued. We set number of simultaneous prefetches - to a large constant to reflect this (it probably is not a good idea not - to limit number of prefetches at all, as their execution also takes some - time). */ - 100, /* number of parallel prefetches */ - 3, /* Branch cost */ - COSTS_N_INSNS (4), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (4), /* cost of FMUL instruction. */ - COSTS_N_INSNS (19), /* cost of FDIV instruction. */ - COSTS_N_INSNS (2), /* cost of FABS instruction. */ - COSTS_N_INSNS (2), /* cost of FCHS instruction. */ - COSTS_N_INSNS (35), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - k8_memcpy, - k8_memset, - 4, /* scalar_stmt_cost. */ - 2, /* scalar load_cost. */ - 2, /* scalar_store_cost. */ - 5, /* vec_stmt_cost. */ - 0, /* vec_to_scalar_cost. */ - 2, /* scalar_to_vec_cost. */ - 2, /* vec_align_load_cost. */ - 3, /* vec_unalign_load_cost. */ - 3, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 2, /* cond_not_taken_branch_cost. */ -}; - -/* AMDFAM10 has optimized REP instruction for medium sized blocks, but for - very small blocks it is better to use loop. For large blocks, libcall can - do nontemporary accesses and beat inline considerably. */ -static stringop_algs amdfam10_memcpy[2] = { - {libcall, {{6, loop, false}, {14, unrolled_loop, false}, - {-1, rep_prefix_4_byte, false}}}, - {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -static stringop_algs amdfam10_memset[2] = { - {libcall, {{8, loop, false}, {24, unrolled_loop, false}, - {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -struct processor_costs amdfam10_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (2), /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ - COSTS_N_INSNS (4), /* HI */ - COSTS_N_INSNS (3), /* SI */ - COSTS_N_INSNS (4), /* DI */ - COSTS_N_INSNS (5)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (19), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (35), /* HI */ - COSTS_N_INSNS (51), /* SI */ - COSTS_N_INSNS (83), /* DI */ - COSTS_N_INSNS (83)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 9, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {3, 4, 3}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {3, 4, 3}, /* cost of storing integer registers */ - 4, /* cost of reg,reg fld/fst */ - {4, 4, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {6, 6, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {3, 3}, /* cost of loading MMX registers - in SImode and DImode */ - {4, 4}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {4, 4, 3}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {4, 4, 5}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 3, /* MMX or SSE register to integer */ - /* On K8: - MOVD reg64, xmmreg Double FSTORE 4 - MOVD reg32, xmmreg Double FSTORE 4 - On AMDFAM10: - MOVD reg64, xmmreg Double FADD 3 - 1/1 1/1 - MOVD reg32, xmmreg Double FADD 3 - 1/1 1/1 */ - 64, /* size of l1 cache. */ - 512, /* size of l2 cache. */ - 64, /* size of prefetch block */ - /* New AMD processors never drop prefetches; if they cannot be performed - immediately, they are queued. We set number of simultaneous prefetches - to a large constant to reflect this (it probably is not a good idea not - to limit number of prefetches at all, as their execution also takes some - time). */ - 100, /* number of parallel prefetches */ - 2, /* Branch cost */ - COSTS_N_INSNS (4), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (4), /* cost of FMUL instruction. */ - COSTS_N_INSNS (19), /* cost of FDIV instruction. */ - COSTS_N_INSNS (2), /* cost of FABS instruction. */ - COSTS_N_INSNS (2), /* cost of FCHS instruction. */ - COSTS_N_INSNS (35), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - amdfam10_memcpy, - amdfam10_memset, - 4, /* scalar_stmt_cost. */ - 2, /* scalar load_cost. */ - 2, /* scalar_store_cost. */ - 6, /* vec_stmt_cost. */ - 0, /* vec_to_scalar_cost. */ - 2, /* scalar_to_vec_cost. */ - 2, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 2, /* vec_store_cost. */ - 2, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -/* BDVER1 has optimized REP instruction for medium sized blocks, but for - very small blocks it is better to use loop. For large blocks, libcall - can do nontemporary accesses and beat inline considerably. */ -static stringop_algs bdver1_memcpy[2] = { - {libcall, {{6, loop, false}, {14, unrolled_loop, false}, - {-1, rep_prefix_4_byte, false}}}, - {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -static stringop_algs bdver1_memset[2] = { - {libcall, {{8, loop, false}, {24, unrolled_loop, false}, - {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; - -const struct processor_costs bdver1_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (1), /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (4), /* cost of starting multiply for QI */ - COSTS_N_INSNS (4), /* HI */ - COSTS_N_INSNS (4), /* SI */ - COSTS_N_INSNS (6), /* DI */ - COSTS_N_INSNS (6)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (19), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (35), /* HI */ - COSTS_N_INSNS (51), /* SI */ - COSTS_N_INSNS (83), /* DI */ - COSTS_N_INSNS (83)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 9, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {5, 5, 4}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {4, 4, 4}, /* cost of storing integer registers */ - 2, /* cost of reg,reg fld/fst */ - {5, 5, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {4, 4, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {4, 4}, /* cost of loading MMX registers - in SImode and DImode */ - {4, 4}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {4, 4, 4}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {4, 4, 4}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 2, /* MMX or SSE register to integer */ - /* On K8: - MOVD reg64, xmmreg Double FSTORE 4 - MOVD reg32, xmmreg Double FSTORE 4 - On AMDFAM10: - MOVD reg64, xmmreg Double FADD 3 - 1/1 1/1 - MOVD reg32, xmmreg Double FADD 3 - 1/1 1/1 */ - 16, /* size of l1 cache. */ - 2048, /* size of l2 cache. */ - 64, /* size of prefetch block */ - /* New AMD processors never drop prefetches; if they cannot be performed - immediately, they are queued. We set number of simultaneous prefetches - to a large constant to reflect this (it probably is not a good idea not - to limit number of prefetches at all, as their execution also takes some - time). */ - 100, /* number of parallel prefetches */ - 2, /* Branch cost */ - COSTS_N_INSNS (6), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (6), /* cost of FMUL instruction. */ - COSTS_N_INSNS (42), /* cost of FDIV instruction. */ - COSTS_N_INSNS (2), /* cost of FABS instruction. */ - COSTS_N_INSNS (2), /* cost of FCHS instruction. */ - COSTS_N_INSNS (52), /* cost of FSQRT instruction. */ - 1, 2, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - bdver1_memcpy, - bdver1_memset, - 6, /* scalar_stmt_cost. */ - 4, /* scalar load_cost. */ - 4, /* scalar_store_cost. */ - 6, /* vec_stmt_cost. */ - 0, /* vec_to_scalar_cost. */ - 2, /* scalar_to_vec_cost. */ - 4, /* vec_align_load_cost. */ - 4, /* vec_unalign_load_cost. */ - 4, /* vec_store_cost. */ - 4, /* cond_taken_branch_cost. */ - 2, /* cond_not_taken_branch_cost. */ -}; - -/* BDVER2 has optimized REP instruction for medium sized blocks, but for - very small blocks it is better to use loop. For large blocks, libcall - can do nontemporary accesses and beat inline considerably. */ - -static stringop_algs bdver2_memcpy[2] = { - {libcall, {{6, loop, false}, {14, unrolled_loop, false}, - {-1, rep_prefix_4_byte, false}}}, - {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -static stringop_algs bdver2_memset[2] = { - {libcall, {{8, loop, false}, {24, unrolled_loop, false}, - {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; - -const struct processor_costs bdver2_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (1), /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (4), /* cost of starting multiply for QI */ - COSTS_N_INSNS (4), /* HI */ - COSTS_N_INSNS (4), /* SI */ - COSTS_N_INSNS (6), /* DI */ - COSTS_N_INSNS (6)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (19), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (35), /* HI */ - COSTS_N_INSNS (51), /* SI */ - COSTS_N_INSNS (83), /* DI */ - COSTS_N_INSNS (83)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 9, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {5, 5, 4}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {4, 4, 4}, /* cost of storing integer registers */ - 2, /* cost of reg,reg fld/fst */ - {5, 5, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {4, 4, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {4, 4}, /* cost of loading MMX registers - in SImode and DImode */ - {4, 4}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {4, 4, 4}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {4, 4, 4}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 2, /* MMX or SSE register to integer */ - /* On K8: - MOVD reg64, xmmreg Double FSTORE 4 - MOVD reg32, xmmreg Double FSTORE 4 - On AMDFAM10: - MOVD reg64, xmmreg Double FADD 3 - 1/1 1/1 - MOVD reg32, xmmreg Double FADD 3 - 1/1 1/1 */ - 16, /* size of l1 cache. */ - 2048, /* size of l2 cache. */ - 64, /* size of prefetch block */ - /* New AMD processors never drop prefetches; if they cannot be performed - immediately, they are queued. We set number of simultaneous prefetches - to a large constant to reflect this (it probably is not a good idea not - to limit number of prefetches at all, as their execution also takes some - time). */ - 100, /* number of parallel prefetches */ - 2, /* Branch cost */ - COSTS_N_INSNS (6), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (6), /* cost of FMUL instruction. */ - COSTS_N_INSNS (42), /* cost of FDIV instruction. */ - COSTS_N_INSNS (2), /* cost of FABS instruction. */ - COSTS_N_INSNS (2), /* cost of FCHS instruction. */ - COSTS_N_INSNS (52), /* cost of FSQRT instruction. */ - 1, 2, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - bdver2_memcpy, - bdver2_memset, - 6, /* scalar_stmt_cost. */ - 4, /* scalar load_cost. */ - 4, /* scalar_store_cost. */ - 6, /* vec_stmt_cost. */ - 0, /* vec_to_scalar_cost. */ - 2, /* scalar_to_vec_cost. */ - 4, /* vec_align_load_cost. */ - 4, /* vec_unalign_load_cost. */ - 4, /* vec_store_cost. */ - 4, /* cond_taken_branch_cost. */ - 2, /* cond_not_taken_branch_cost. */ -}; - - - /* BDVER3 has optimized REP instruction for medium sized blocks, but for - very small blocks it is better to use loop. For large blocks, libcall - can do nontemporary accesses and beat inline considerably. */ -static stringop_algs bdver3_memcpy[2] = { - {libcall, {{6, loop, false}, {14, unrolled_loop, false}, - {-1, rep_prefix_4_byte, false}}}, - {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -static stringop_algs bdver3_memset[2] = { - {libcall, {{8, loop, false}, {24, unrolled_loop, false}, - {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -struct processor_costs bdver3_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (1), /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (4), /* cost of starting multiply for QI */ - COSTS_N_INSNS (4), /* HI */ - COSTS_N_INSNS (4), /* SI */ - COSTS_N_INSNS (6), /* DI */ - COSTS_N_INSNS (6)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (19), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (35), /* HI */ - COSTS_N_INSNS (51), /* SI */ - COSTS_N_INSNS (83), /* DI */ - COSTS_N_INSNS (83)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 9, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {5, 5, 4}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {4, 4, 4}, /* cost of storing integer registers */ - 2, /* cost of reg,reg fld/fst */ - {5, 5, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {4, 4, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {4, 4}, /* cost of loading MMX registers - in SImode and DImode */ - {4, 4}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {4, 4, 4}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {4, 4, 4}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 2, /* MMX or SSE register to integer */ - 16, /* size of l1 cache. */ - 2048, /* size of l2 cache. */ - 64, /* size of prefetch block */ - /* New AMD processors never drop prefetches; if they cannot be performed - immediately, they are queued. We set number of simultaneous prefetches - to a large constant to reflect this (it probably is not a good idea not - to limit number of prefetches at all, as their execution also takes some - time). */ - 100, /* number of parallel prefetches */ - 2, /* Branch cost */ - COSTS_N_INSNS (6), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (6), /* cost of FMUL instruction. */ - COSTS_N_INSNS (42), /* cost of FDIV instruction. */ - COSTS_N_INSNS (2), /* cost of FABS instruction. */ - COSTS_N_INSNS (2), /* cost of FCHS instruction. */ - COSTS_N_INSNS (52), /* cost of FSQRT instruction. */ - 1, 2, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - bdver3_memcpy, - bdver3_memset, - 6, /* scalar_stmt_cost. */ - 4, /* scalar load_cost. */ - 4, /* scalar_store_cost. */ - 6, /* vec_stmt_cost. */ - 0, /* vec_to_scalar_cost. */ - 2, /* scalar_to_vec_cost. */ - 4, /* vec_align_load_cost. */ - 4, /* vec_unalign_load_cost. */ - 4, /* vec_store_cost. */ - 4, /* cond_taken_branch_cost. */ - 2, /* cond_not_taken_branch_cost. */ -}; - -/* BDVER4 has optimized REP instruction for medium sized blocks, but for - very small blocks it is better to use loop. For large blocks, libcall - can do nontemporary accesses and beat inline considerably. */ -static stringop_algs bdver4_memcpy[2] = { - {libcall, {{6, loop, false}, {14, unrolled_loop, false}, - {-1, rep_prefix_4_byte, false}}}, - {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -static stringop_algs bdver4_memset[2] = { - {libcall, {{8, loop, false}, {24, unrolled_loop, false}, - {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -struct processor_costs bdver4_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (1), /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (4), /* cost of starting multiply for QI */ - COSTS_N_INSNS (4), /* HI */ - COSTS_N_INSNS (4), /* SI */ - COSTS_N_INSNS (6), /* DI */ - COSTS_N_INSNS (6)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (19), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (35), /* HI */ - COSTS_N_INSNS (51), /* SI */ - COSTS_N_INSNS (83), /* DI */ - COSTS_N_INSNS (83)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 9, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {5, 5, 4}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {4, 4, 4}, /* cost of storing integer registers */ - 2, /* cost of reg,reg fld/fst */ - {5, 5, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {4, 4, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {4, 4}, /* cost of loading MMX registers - in SImode and DImode */ - {4, 4}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {4, 4, 4}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {4, 4, 4}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 2, /* MMX or SSE register to integer */ - 16, /* size of l1 cache. */ - 2048, /* size of l2 cache. */ - 64, /* size of prefetch block */ - /* New AMD processors never drop prefetches; if they cannot be performed - immediately, they are queued. We set number of simultaneous prefetches - to a large constant to reflect this (it probably is not a good idea not - to limit number of prefetches at all, as their execution also takes some - time). */ - 100, /* number of parallel prefetches */ - 2, /* Branch cost */ - COSTS_N_INSNS (6), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (6), /* cost of FMUL instruction. */ - COSTS_N_INSNS (42), /* cost of FDIV instruction. */ - COSTS_N_INSNS (2), /* cost of FABS instruction. */ - COSTS_N_INSNS (2), /* cost of FCHS instruction. */ - COSTS_N_INSNS (52), /* cost of FSQRT instruction. */ - 1, 2, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - bdver4_memcpy, - bdver4_memset, - 6, /* scalar_stmt_cost. */ - 4, /* scalar load_cost. */ - 4, /* scalar_store_cost. */ - 6, /* vec_stmt_cost. */ - 0, /* vec_to_scalar_cost. */ - 2, /* scalar_to_vec_cost. */ - 4, /* vec_align_load_cost. */ - 4, /* vec_unalign_load_cost. */ - 4, /* vec_store_cost. */ - 4, /* cond_taken_branch_cost. */ - 2, /* cond_not_taken_branch_cost. */ -}; - - -/* ZNVER1 has optimized REP instruction for medium sized blocks, but for - very small blocks it is better to use loop. For large blocks, libcall - can do nontemporary accesses and beat inline considerably. */ -static stringop_algs znver1_memcpy[2] = { - {libcall, {{6, loop, false}, {14, unrolled_loop, false}, - {-1, rep_prefix_4_byte, false}}}, - {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -static stringop_algs znver1_memset[2] = { - {libcall, {{8, loop, false}, {24, unrolled_loop, false}, - {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -struct processor_costs znver1_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction. */ - COSTS_N_INSNS (1), /* cost of a lea instruction. */ - COSTS_N_INSNS (1), /* variable shift costs. */ - COSTS_N_INSNS (1), /* constant shift costs. */ - {COSTS_N_INSNS (3), /* cost of starting multiply for QI. */ - COSTS_N_INSNS (3), /* HI. */ - COSTS_N_INSNS (3), /* SI. */ - COSTS_N_INSNS (4), /* DI. */ - COSTS_N_INSNS (4)}, /* other. */ - 0, /* cost of multiply per each bit - set. */ - {COSTS_N_INSNS (19), /* cost of a divide/mod for QI. */ - COSTS_N_INSNS (35), /* HI. */ - COSTS_N_INSNS (51), /* SI. */ - COSTS_N_INSNS (83), /* DI. */ - COSTS_N_INSNS (83)}, /* other. */ - COSTS_N_INSNS (1), /* cost of movsx. */ - COSTS_N_INSNS (1), /* cost of movzx. */ - 8, /* "large" insn. */ - 9, /* MOVE_RATIO. */ - 4, /* cost for loading QImode using - movzbl. */ - {5, 5, 4}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {4, 4, 4}, /* cost of storing integer - registers. */ - 2, /* cost of reg,reg fld/fst. */ - {5, 5, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode. */ - {4, 4, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode. */ - 2, /* cost of moving MMX register. */ - {4, 4}, /* cost of loading MMX registers - in SImode and DImode. */ - {4, 4}, /* cost of storing MMX registers - in SImode and DImode. */ - 2, /* cost of moving SSE register. */ - {4, 4, 4}, /* cost of loading SSE registers - in SImode, DImode and TImode. */ - {4, 4, 4}, /* cost of storing SSE registers - in SImode, DImode and TImode. */ - 2, /* MMX or SSE register to integer. */ - 32, /* size of l1 cache. */ - 512, /* size of l2 cache. */ - 64, /* size of prefetch block. */ - /* New AMD processors never drop prefetches; if they cannot be performed - immediately, they are queued. We set number of simultaneous prefetches - to a large constant to reflect this (it probably is not a good idea not - to limit number of prefetches at all, as their execution also takes some - time). */ - 100, /* number of parallel prefetches. */ - 3, /* Branch cost. */ - COSTS_N_INSNS (6), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (6), /* cost of FMUL instruction. */ - COSTS_N_INSNS (42), /* cost of FDIV instruction. */ - COSTS_N_INSNS (2), /* cost of FABS instruction. */ - COSTS_N_INSNS (2), /* cost of FCHS instruction. */ - COSTS_N_INSNS (52), /* cost of FSQRT instruction. */ - /* Zen can execute 4 integer operations per cycle. FP operations take 3 cycles - and it can execute 2 integer additions and 2 multiplications thus - reassociation may make sense up to with of 6. SPEC2k6 bencharks suggests - that 4 works better than 6 probably due to register pressure. - - Integer vector operations are taken by FP unit and execute 3 vector - plus/minus operations per cycle but only one multiply. This is adjusted - in ix86_reassociation_width. */ - 4, 4, 3, 6, /* reassoc int, fp, vec_int, vec_fp. */ - znver1_memcpy, - znver1_memset, - 6, /* scalar_stmt_cost. */ - 4, /* scalar load_cost. */ - 4, /* scalar_store_cost. */ - 6, /* vec_stmt_cost. */ - 0, /* vec_to_scalar_cost. */ - 2, /* scalar_to_vec_cost. */ - 4, /* vec_align_load_cost. */ - 4, /* vec_unalign_load_cost. */ - 4, /* vec_store_cost. */ - 4, /* cond_taken_branch_cost. */ - 2, /* cond_not_taken_branch_cost. */ -}; - - /* BTVER1 has optimized REP instruction for medium sized blocks, but for - very small blocks it is better to use loop. For large blocks, libcall can - do nontemporary accesses and beat inline considerably. */ -static stringop_algs btver1_memcpy[2] = { - {libcall, {{6, loop, false}, {14, unrolled_loop, false}, - {-1, rep_prefix_4_byte, false}}}, - {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -static stringop_algs btver1_memset[2] = { - {libcall, {{8, loop, false}, {24, unrolled_loop, false}, - {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -const struct processor_costs btver1_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (2), /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ - COSTS_N_INSNS (4), /* HI */ - COSTS_N_INSNS (3), /* SI */ - COSTS_N_INSNS (4), /* DI */ - COSTS_N_INSNS (5)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (19), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (35), /* HI */ - COSTS_N_INSNS (51), /* SI */ - COSTS_N_INSNS (83), /* DI */ - COSTS_N_INSNS (83)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 9, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {3, 4, 3}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {3, 4, 3}, /* cost of storing integer registers */ - 4, /* cost of reg,reg fld/fst */ - {4, 4, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {6, 6, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {3, 3}, /* cost of loading MMX registers - in SImode and DImode */ - {4, 4}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {4, 4, 3}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {4, 4, 5}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 3, /* MMX or SSE register to integer */ - /* On K8: - MOVD reg64, xmmreg Double FSTORE 4 - MOVD reg32, xmmreg Double FSTORE 4 - On AMDFAM10: - MOVD reg64, xmmreg Double FADD 3 - 1/1 1/1 - MOVD reg32, xmmreg Double FADD 3 - 1/1 1/1 */ - 32, /* size of l1 cache. */ - 512, /* size of l2 cache. */ - 64, /* size of prefetch block */ - 100, /* number of parallel prefetches */ - 2, /* Branch cost */ - COSTS_N_INSNS (4), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (4), /* cost of FMUL instruction. */ - COSTS_N_INSNS (19), /* cost of FDIV instruction. */ - COSTS_N_INSNS (2), /* cost of FABS instruction. */ - COSTS_N_INSNS (2), /* cost of FCHS instruction. */ - COSTS_N_INSNS (35), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - btver1_memcpy, - btver1_memset, - 4, /* scalar_stmt_cost. */ - 2, /* scalar load_cost. */ - 2, /* scalar_store_cost. */ - 6, /* vec_stmt_cost. */ - 0, /* vec_to_scalar_cost. */ - 2, /* scalar_to_vec_cost. */ - 2, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 2, /* vec_store_cost. */ - 2, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -static stringop_algs btver2_memcpy[2] = { - {libcall, {{6, loop, false}, {14, unrolled_loop, false}, - {-1, rep_prefix_4_byte, false}}}, - {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -static stringop_algs btver2_memset[2] = { - {libcall, {{8, loop, false}, {24, unrolled_loop, false}, - {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -const struct processor_costs btver2_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (2), /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ - COSTS_N_INSNS (4), /* HI */ - COSTS_N_INSNS (3), /* SI */ - COSTS_N_INSNS (4), /* DI */ - COSTS_N_INSNS (5)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (19), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (35), /* HI */ - COSTS_N_INSNS (51), /* SI */ - COSTS_N_INSNS (83), /* DI */ - COSTS_N_INSNS (83)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 9, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {3, 4, 3}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {3, 4, 3}, /* cost of storing integer registers */ - 4, /* cost of reg,reg fld/fst */ - {4, 4, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {6, 6, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {3, 3}, /* cost of loading MMX registers - in SImode and DImode */ - {4, 4}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {4, 4, 3}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {4, 4, 5}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 3, /* MMX or SSE register to integer */ - /* On K8: - MOVD reg64, xmmreg Double FSTORE 4 - MOVD reg32, xmmreg Double FSTORE 4 - On AMDFAM10: - MOVD reg64, xmmreg Double FADD 3 - 1/1 1/1 - MOVD reg32, xmmreg Double FADD 3 - 1/1 1/1 */ - 32, /* size of l1 cache. */ - 2048, /* size of l2 cache. */ - 64, /* size of prefetch block */ - 100, /* number of parallel prefetches */ - 2, /* Branch cost */ - COSTS_N_INSNS (4), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (4), /* cost of FMUL instruction. */ - COSTS_N_INSNS (19), /* cost of FDIV instruction. */ - COSTS_N_INSNS (2), /* cost of FABS instruction. */ - COSTS_N_INSNS (2), /* cost of FCHS instruction. */ - COSTS_N_INSNS (35), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - btver2_memcpy, - btver2_memset, - 4, /* scalar_stmt_cost. */ - 2, /* scalar load_cost. */ - 2, /* scalar_store_cost. */ - 6, /* vec_stmt_cost. */ - 0, /* vec_to_scalar_cost. */ - 2, /* scalar_to_vec_cost. */ - 2, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 2, /* vec_store_cost. */ - 2, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -static stringop_algs pentium4_memcpy[2] = { - {libcall, {{12, loop_1_byte, false}, {-1, rep_prefix_4_byte, false}}}, - DUMMY_STRINGOP_ALGS}; -static stringop_algs pentium4_memset[2] = { - {libcall, {{6, loop_1_byte, false}, {48, loop, false}, - {20480, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - DUMMY_STRINGOP_ALGS}; - -static const -struct processor_costs pentium4_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (3), /* cost of a lea instruction */ - COSTS_N_INSNS (4), /* variable shift costs */ - COSTS_N_INSNS (4), /* constant shift costs */ - {COSTS_N_INSNS (15), /* cost of starting multiply for QI */ - COSTS_N_INSNS (15), /* HI */ - COSTS_N_INSNS (15), /* SI */ - COSTS_N_INSNS (15), /* DI */ - COSTS_N_INSNS (15)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (56), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (56), /* HI */ - COSTS_N_INSNS (56), /* SI */ - COSTS_N_INSNS (56), /* DI */ - COSTS_N_INSNS (56)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 16, /* "large" insn */ - 6, /* MOVE_RATIO */ - 2, /* cost for loading QImode using movzbl */ - {4, 5, 4}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {2, 3, 2}, /* cost of storing integer registers */ - 2, /* cost of reg,reg fld/fst */ - {2, 2, 6}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {4, 4, 6}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {2, 2}, /* cost of loading MMX registers - in SImode and DImode */ - {2, 2}, /* cost of storing MMX registers - in SImode and DImode */ - 12, /* cost of moving SSE register */ - {12, 12, 12}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {2, 2, 8}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 10, /* MMX or SSE register to integer */ - 8, /* size of l1 cache. */ - 256, /* size of l2 cache. */ - 64, /* size of prefetch block */ - 6, /* number of parallel prefetches */ - 2, /* Branch cost */ - COSTS_N_INSNS (5), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (7), /* cost of FMUL instruction. */ - COSTS_N_INSNS (43), /* cost of FDIV instruction. */ - COSTS_N_INSNS (2), /* cost of FABS instruction. */ - COSTS_N_INSNS (2), /* cost of FCHS instruction. */ - COSTS_N_INSNS (43), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - pentium4_memcpy, - pentium4_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 1, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -static stringop_algs nocona_memcpy[2] = { - {libcall, {{12, loop_1_byte, false}, {-1, rep_prefix_4_byte, false}}}, - {libcall, {{32, loop, false}, {20000, rep_prefix_8_byte, false}, - {100000, unrolled_loop, false}, {-1, libcall, false}}}}; - -static stringop_algs nocona_memset[2] = { - {libcall, {{6, loop_1_byte, false}, {48, loop, false}, - {20480, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - {libcall, {{24, loop, false}, {64, unrolled_loop, false}, - {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; - -static const -struct processor_costs nocona_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (1), /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (10), /* cost of starting multiply for QI */ - COSTS_N_INSNS (10), /* HI */ - COSTS_N_INSNS (10), /* SI */ - COSTS_N_INSNS (10), /* DI */ - COSTS_N_INSNS (10)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (66), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (66), /* HI */ - COSTS_N_INSNS (66), /* SI */ - COSTS_N_INSNS (66), /* DI */ - COSTS_N_INSNS (66)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 16, /* "large" insn */ - 17, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {4, 4, 4}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {4, 4, 4}, /* cost of storing integer registers */ - 3, /* cost of reg,reg fld/fst */ - {12, 12, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {4, 4, 4}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 6, /* cost of moving MMX register */ - {12, 12}, /* cost of loading MMX registers - in SImode and DImode */ - {12, 12}, /* cost of storing MMX registers - in SImode and DImode */ - 6, /* cost of moving SSE register */ - {12, 12, 12}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {12, 12, 12}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 8, /* MMX or SSE register to integer */ - 8, /* size of l1 cache. */ - 1024, /* size of l2 cache. */ - 64, /* size of prefetch block */ - 8, /* number of parallel prefetches */ - 1, /* Branch cost */ - COSTS_N_INSNS (6), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (8), /* cost of FMUL instruction. */ - COSTS_N_INSNS (40), /* cost of FDIV instruction. */ - COSTS_N_INSNS (3), /* cost of FABS instruction. */ - COSTS_N_INSNS (3), /* cost of FCHS instruction. */ - COSTS_N_INSNS (44), /* cost of FSQRT instruction. */ - 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - nocona_memcpy, - nocona_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 1, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -static stringop_algs atom_memcpy[2] = { - {libcall, {{11, loop, false}, {-1, rep_prefix_4_byte, false}}}, - {libcall, {{32, loop, false}, {64, rep_prefix_4_byte, false}, - {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; -static stringop_algs atom_memset[2] = { - {libcall, {{8, loop, false}, {15, unrolled_loop, false}, - {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - {libcall, {{24, loop, false}, {32, unrolled_loop, false}, - {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; -static const -struct processor_costs atom_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (1) + 1, /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ - COSTS_N_INSNS (4), /* HI */ - COSTS_N_INSNS (3), /* SI */ - COSTS_N_INSNS (4), /* DI */ - COSTS_N_INSNS (2)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (26), /* HI */ - COSTS_N_INSNS (42), /* SI */ - COSTS_N_INSNS (74), /* DI */ - COSTS_N_INSNS (74)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 17, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {4, 4, 4}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {4, 4, 4}, /* cost of storing integer registers */ - 4, /* cost of reg,reg fld/fst */ - {12, 12, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {6, 6, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {8, 8}, /* cost of loading MMX registers - in SImode and DImode */ - {8, 8}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {8, 8, 8}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {8, 8, 8}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 5, /* MMX or SSE register to integer */ - 32, /* size of l1 cache. */ - 256, /* size of l2 cache. */ - 64, /* size of prefetch block */ - 6, /* number of parallel prefetches */ - 3, /* Branch cost */ - COSTS_N_INSNS (8), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (8), /* cost of FMUL instruction. */ - COSTS_N_INSNS (20), /* cost of FDIV instruction. */ - COSTS_N_INSNS (8), /* cost of FABS instruction. */ - COSTS_N_INSNS (8), /* cost of FCHS instruction. */ - COSTS_N_INSNS (40), /* cost of FSQRT instruction. */ - 2, 2, 2, 2, /* reassoc int, fp, vec_int, vec_fp. */ - atom_memcpy, - atom_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 1, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -static stringop_algs slm_memcpy[2] = { - {libcall, {{11, loop, false}, {-1, rep_prefix_4_byte, false}}}, - {libcall, {{32, loop, false}, {64, rep_prefix_4_byte, false}, - {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; -static stringop_algs slm_memset[2] = { - {libcall, {{8, loop, false}, {15, unrolled_loop, false}, - {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - {libcall, {{24, loop, false}, {32, unrolled_loop, false}, - {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; -static const -struct processor_costs slm_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (1) + 1, /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ - COSTS_N_INSNS (3), /* HI */ - COSTS_N_INSNS (3), /* SI */ - COSTS_N_INSNS (4), /* DI */ - COSTS_N_INSNS (2)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (26), /* HI */ - COSTS_N_INSNS (42), /* SI */ - COSTS_N_INSNS (74), /* DI */ - COSTS_N_INSNS (74)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 17, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {4, 4, 4}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {4, 4, 4}, /* cost of storing integer registers */ - 4, /* cost of reg,reg fld/fst */ - {12, 12, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {6, 6, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {8, 8}, /* cost of loading MMX registers - in SImode and DImode */ - {8, 8}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {8, 8, 8}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {8, 8, 8}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 5, /* MMX or SSE register to integer */ - 32, /* size of l1 cache. */ - 256, /* size of l2 cache. */ - 64, /* size of prefetch block */ - 6, /* number of parallel prefetches */ - 3, /* Branch cost */ - COSTS_N_INSNS (8), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (8), /* cost of FMUL instruction. */ - COSTS_N_INSNS (20), /* cost of FDIV instruction. */ - COSTS_N_INSNS (8), /* cost of FABS instruction. */ - COSTS_N_INSNS (8), /* cost of FCHS instruction. */ - COSTS_N_INSNS (40), /* cost of FSQRT instruction. */ - 1, 2, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - slm_memcpy, - slm_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 4, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -static stringop_algs intel_memcpy[2] = { - {libcall, {{11, loop, false}, {-1, rep_prefix_4_byte, false}}}, - {libcall, {{32, loop, false}, {64, rep_prefix_4_byte, false}, - {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; -static stringop_algs intel_memset[2] = { - {libcall, {{8, loop, false}, {15, unrolled_loop, false}, - {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, - {libcall, {{24, loop, false}, {32, unrolled_loop, false}, - {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; -static const -struct processor_costs intel_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - COSTS_N_INSNS (1) + 1, /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ - COSTS_N_INSNS (3), /* HI */ - COSTS_N_INSNS (3), /* SI */ - COSTS_N_INSNS (4), /* DI */ - COSTS_N_INSNS (2)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (26), /* HI */ - COSTS_N_INSNS (42), /* SI */ - COSTS_N_INSNS (74), /* DI */ - COSTS_N_INSNS (74)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 17, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {4, 4, 4}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {4, 4, 4}, /* cost of storing integer registers */ - 4, /* cost of reg,reg fld/fst */ - {12, 12, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {6, 6, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {8, 8}, /* cost of loading MMX registers - in SImode and DImode */ - {8, 8}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {8, 8, 8}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {8, 8, 8}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 5, /* MMX or SSE register to integer */ - 32, /* size of l1 cache. */ - 256, /* size of l2 cache. */ - 64, /* size of prefetch block */ - 6, /* number of parallel prefetches */ - 3, /* Branch cost */ - COSTS_N_INSNS (8), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (8), /* cost of FMUL instruction. */ - COSTS_N_INSNS (20), /* cost of FDIV instruction. */ - COSTS_N_INSNS (8), /* cost of FABS instruction. */ - COSTS_N_INSNS (8), /* cost of FCHS instruction. */ - COSTS_N_INSNS (40), /* cost of FSQRT instruction. */ - 1, 4, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - intel_memcpy, - intel_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 4, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -/* Generic should produce code tuned for Core-i7 (and newer chips) - and btver1 (and newer chips). */ - -static stringop_algs generic_memcpy[2] = { - {libcall, {{32, loop, false}, {8192, rep_prefix_4_byte, false}, - {-1, libcall, false}}}, - {libcall, {{32, loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -static stringop_algs generic_memset[2] = { - {libcall, {{32, loop, false}, {8192, rep_prefix_4_byte, false}, - {-1, libcall, false}}}, - {libcall, {{32, loop, false}, {8192, rep_prefix_8_byte, false}, - {-1, libcall, false}}}}; -static const -struct processor_costs generic_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - /* On all chips taken into consideration lea is 2 cycles and more. With - this cost however our current implementation of synth_mult results in - use of unnecessary temporary registers causing regression on several - SPECfp benchmarks. */ - COSTS_N_INSNS (1) + 1, /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ - COSTS_N_INSNS (4), /* HI */ - COSTS_N_INSNS (3), /* SI */ - COSTS_N_INSNS (4), /* DI */ - COSTS_N_INSNS (2)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (26), /* HI */ - COSTS_N_INSNS (42), /* SI */ - COSTS_N_INSNS (74), /* DI */ - COSTS_N_INSNS (74)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 17, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {4, 4, 4}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {4, 4, 4}, /* cost of storing integer registers */ - 4, /* cost of reg,reg fld/fst */ - {12, 12, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {6, 6, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {8, 8}, /* cost of loading MMX registers - in SImode and DImode */ - {8, 8}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {8, 8, 8}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {8, 8, 8}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 5, /* MMX or SSE register to integer */ - 32, /* size of l1 cache. */ - 512, /* size of l2 cache. */ - 64, /* size of prefetch block */ - 6, /* number of parallel prefetches */ - /* Benchmarks shows large regressions on K8 sixtrack benchmark when this - value is increased to perhaps more appropriate value of 5. */ - 3, /* Branch cost */ - COSTS_N_INSNS (8), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (8), /* cost of FMUL instruction. */ - COSTS_N_INSNS (20), /* cost of FDIV instruction. */ - COSTS_N_INSNS (8), /* cost of FABS instruction. */ - COSTS_N_INSNS (8), /* cost of FCHS instruction. */ - COSTS_N_INSNS (40), /* cost of FSQRT instruction. */ - 1, 2, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ - generic_memcpy, - generic_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 1, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - -/* core_cost should produce code tuned for Core familly of CPUs. */ -static stringop_algs core_memcpy[2] = { - {libcall, {{1024, rep_prefix_4_byte, true}, {-1, libcall, false}}}, - {libcall, {{24, loop, true}, {128, rep_prefix_8_byte, true}, - {-1, libcall, false}}}}; -static stringop_algs core_memset[2] = { - {libcall, {{6, loop_1_byte, true}, - {24, loop, true}, - {8192, rep_prefix_4_byte, true}, - {-1, libcall, false}}}, - {libcall, {{24, loop, true}, {512, rep_prefix_8_byte, true}, - {-1, libcall, false}}}}; - -static const -struct processor_costs core_cost = { - COSTS_N_INSNS (1), /* cost of an add instruction */ - /* On all chips taken into consideration lea is 2 cycles and more. With - this cost however our current implementation of synth_mult results in - use of unnecessary temporary registers causing regression on several - SPECfp benchmarks. */ - COSTS_N_INSNS (1) + 1, /* cost of a lea instruction */ - COSTS_N_INSNS (1), /* variable shift costs */ - COSTS_N_INSNS (1), /* constant shift costs */ - {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ - COSTS_N_INSNS (4), /* HI */ - COSTS_N_INSNS (3), /* SI */ - COSTS_N_INSNS (4), /* DI */ - COSTS_N_INSNS (2)}, /* other */ - 0, /* cost of multiply per each bit set */ - {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ - COSTS_N_INSNS (26), /* HI */ - COSTS_N_INSNS (42), /* SI */ - COSTS_N_INSNS (74), /* DI */ - COSTS_N_INSNS (74)}, /* other */ - COSTS_N_INSNS (1), /* cost of movsx */ - COSTS_N_INSNS (1), /* cost of movzx */ - 8, /* "large" insn */ - 17, /* MOVE_RATIO */ - 4, /* cost for loading QImode using movzbl */ - {4, 4, 4}, /* cost of loading integer registers - in QImode, HImode and SImode. - Relative to reg-reg move (2). */ - {4, 4, 4}, /* cost of storing integer registers */ - 4, /* cost of reg,reg fld/fst */ - {12, 12, 12}, /* cost of loading fp registers - in SFmode, DFmode and XFmode */ - {6, 6, 8}, /* cost of storing fp registers - in SFmode, DFmode and XFmode */ - 2, /* cost of moving MMX register */ - {8, 8}, /* cost of loading MMX registers - in SImode and DImode */ - {8, 8}, /* cost of storing MMX registers - in SImode and DImode */ - 2, /* cost of moving SSE register */ - {8, 8, 8}, /* cost of loading SSE registers - in SImode, DImode and TImode */ - {8, 8, 8}, /* cost of storing SSE registers - in SImode, DImode and TImode */ - 5, /* MMX or SSE register to integer */ - 64, /* size of l1 cache. */ - 512, /* size of l2 cache. */ - 64, /* size of prefetch block */ - 6, /* number of parallel prefetches */ - /* FIXME perhaps more appropriate value is 5. */ - 3, /* Branch cost */ - COSTS_N_INSNS (8), /* cost of FADD and FSUB insns. */ - COSTS_N_INSNS (8), /* cost of FMUL instruction. */ - COSTS_N_INSNS (20), /* cost of FDIV instruction. */ - COSTS_N_INSNS (8), /* cost of FABS instruction. */ - COSTS_N_INSNS (8), /* cost of FCHS instruction. */ - COSTS_N_INSNS (40), /* cost of FSQRT instruction. */ - 1, 4, 2, 2, /* reassoc int, fp, vec_int, vec_fp. */ - core_memcpy, - core_memset, - 1, /* scalar_stmt_cost. */ - 1, /* scalar load_cost. */ - 1, /* scalar_store_cost. */ - 1, /* vec_stmt_cost. */ - 1, /* vec_to_scalar_cost. */ - 1, /* scalar_to_vec_cost. */ - 1, /* vec_align_load_cost. */ - 2, /* vec_unalign_load_cost. */ - 1, /* vec_store_cost. */ - 3, /* cond_taken_branch_cost. */ - 1, /* cond_not_taken_branch_cost. */ -}; - /* Set by -mtune. */ -const struct processor_costs *ix86_tune_cost = &pentium_cost; +const struct processor_costs *ix86_tune_cost = NULL; /* Set by -mtune or -Os. */ -const struct processor_costs *ix86_cost = &pentium_cost; +const struct processor_costs *ix86_cost = NULL; /* Processor feature/optimization bitmasks. */ #define m_386 (1U< 128) + move_mode = TImode; + /* Find the corresponding vector mode with the same size as MOVE_MODE. MOVE_MODE is an integer mode at the moment (SI, DI, TI, etc.). */ if (GET_MODE_SIZE (move_mode) > GET_MODE_SIZE (word_mode)) @@ -30048,8 +27951,8 @@ ix86_get_modrm_for_rop (rtx_insn *insn, rtx *operands, int noperands, /* Check whether x86 address PARTS is a pc-relative address. */ -static bool -rip_relative_addr_p (struct ix86_address *parts) +bool +ix86_rip_relative_addr_p (struct ix86_address *parts) { rtx base, index, disp; @@ -30153,7 +28056,7 @@ memory_address_length (rtx addr, bool lea) else if (disp && !base && !index) { len += 4; - if (!rip_relative_addr_p (&parts)) + if (!ix86_rip_relative_addr_p (&parts)) len++; } else @@ -30335,773 +28238,6 @@ ix86_attr_length_vex_default (rtx_insn *insn, bool has_0f_opcode, return 2 + 1; } -/* Return the maximum number of instructions a cpu can issue. */ - -static int -ix86_issue_rate (void) -{ - switch (ix86_tune) - { - case PROCESSOR_PENTIUM: - case PROCESSOR_LAKEMONT: - case PROCESSOR_BONNELL: - case PROCESSOR_SILVERMONT: - case PROCESSOR_KNL: - case PROCESSOR_KNM: - case PROCESSOR_INTEL: - case PROCESSOR_K6: - case PROCESSOR_BTVER2: - case PROCESSOR_PENTIUM4: - case PROCESSOR_NOCONA: - return 2; - - case PROCESSOR_PENTIUMPRO: - case PROCESSOR_ATHLON: - case PROCESSOR_K8: - case PROCESSOR_AMDFAM10: - case PROCESSOR_GENERIC: - case PROCESSOR_BTVER1: - return 3; - - case PROCESSOR_BDVER1: - case PROCESSOR_BDVER2: - case PROCESSOR_BDVER3: - case PROCESSOR_BDVER4: - case PROCESSOR_ZNVER1: - case PROCESSOR_CORE2: - case PROCESSOR_NEHALEM: - case PROCESSOR_SANDYBRIDGE: - case PROCESSOR_HASWELL: - return 4; - - default: - return 1; - } -} - -/* A subroutine of ix86_adjust_cost -- return TRUE iff INSN reads flags set - by DEP_INSN and nothing set by DEP_INSN. */ - -static bool -ix86_flags_dependent (rtx_insn *insn, rtx_insn *dep_insn, enum attr_type insn_type) -{ - rtx set, set2; - - /* Simplify the test for uninteresting insns. */ - if (insn_type != TYPE_SETCC - && insn_type != TYPE_ICMOV - && insn_type != TYPE_FCMOV - && insn_type != TYPE_IBR) - return false; - - if ((set = single_set (dep_insn)) != 0) - { - set = SET_DEST (set); - set2 = NULL_RTX; - } - else if (GET_CODE (PATTERN (dep_insn)) == PARALLEL - && XVECLEN (PATTERN (dep_insn), 0) == 2 - && GET_CODE (XVECEXP (PATTERN (dep_insn), 0, 0)) == SET - && GET_CODE (XVECEXP (PATTERN (dep_insn), 0, 1)) == SET) - { - set = SET_DEST (XVECEXP (PATTERN (dep_insn), 0, 0)); - set2 = SET_DEST (XVECEXP (PATTERN (dep_insn), 0, 0)); - } - else - return false; - - if (!REG_P (set) || REGNO (set) != FLAGS_REG) - return false; - - /* This test is true if the dependent insn reads the flags but - not any other potentially set register. */ - if (!reg_overlap_mentioned_p (set, PATTERN (insn))) - return false; - - if (set2 && reg_overlap_mentioned_p (set2, PATTERN (insn))) - return false; - - return true; -} - -/* Return true iff USE_INSN has a memory address with operands set by - SET_INSN. */ - -bool -ix86_agi_dependent (rtx_insn *set_insn, rtx_insn *use_insn) -{ - int i; - extract_insn_cached (use_insn); - for (i = recog_data.n_operands - 1; i >= 0; --i) - if (MEM_P (recog_data.operand[i])) - { - rtx addr = XEXP (recog_data.operand[i], 0); - if (modified_in_p (addr, set_insn) != 0) - { - /* No AGI stall if SET_INSN is a push or pop and USE_INSN - has SP based memory (unless index reg is modified in a pop). */ - rtx set = single_set (set_insn); - if (set - && (push_operand (SET_DEST (set), GET_MODE (SET_DEST (set))) - || pop_operand (SET_SRC (set), GET_MODE (SET_SRC (set))))) - { - struct ix86_address parts; - if (ix86_decompose_address (addr, &parts) - && parts.base == stack_pointer_rtx - && (parts.index == NULL_RTX - || MEM_P (SET_DEST (set)) - || !modified_in_p (parts.index, set_insn))) - return false; - } - return true; - } - return false; - } - return false; -} - -/* Helper function for exact_store_load_dependency. - Return true if addr is found in insn. */ -static bool -exact_dependency_1 (rtx addr, rtx insn) -{ - enum rtx_code code; - const char *format_ptr; - int i, j; - - code = GET_CODE (insn); - switch (code) - { - case MEM: - if (rtx_equal_p (addr, insn)) - return true; - break; - case REG: - CASE_CONST_ANY: - case SYMBOL_REF: - case CODE_LABEL: - case PC: - case CC0: - case EXPR_LIST: - return false; - default: - break; - } - - format_ptr = GET_RTX_FORMAT (code); - for (i = 0; i < GET_RTX_LENGTH (code); i++) - { - switch (*format_ptr++) - { - case 'e': - if (exact_dependency_1 (addr, XEXP (insn, i))) - return true; - break; - case 'E': - for (j = 0; j < XVECLEN (insn, i); j++) - if (exact_dependency_1 (addr, XVECEXP (insn, i, j))) - return true; - break; - } - } - return false; -} - -/* Return true if there exists exact dependency for store & load, i.e. - the same memory address is used in them. */ -static bool -exact_store_load_dependency (rtx_insn *store, rtx_insn *load) -{ - rtx set1, set2; - - set1 = single_set (store); - if (!set1) - return false; - if (!MEM_P (SET_DEST (set1))) - return false; - set2 = single_set (load); - if (!set2) - return false; - if (exact_dependency_1 (SET_DEST (set1), SET_SRC (set2))) - return true; - return false; -} - -static int -ix86_adjust_cost (rtx_insn *insn, int dep_type, rtx_insn *dep_insn, int cost, - unsigned int) -{ - enum attr_type insn_type, dep_insn_type; - enum attr_memory memory; - rtx set, set2; - int dep_insn_code_number; - - /* Anti and output dependencies have zero cost on all CPUs. */ - if (dep_type != 0) - return 0; - - dep_insn_code_number = recog_memoized (dep_insn); - - /* If we can't recognize the insns, we can't really do anything. */ - if (dep_insn_code_number < 0 || recog_memoized (insn) < 0) - return cost; - - insn_type = get_attr_type (insn); - dep_insn_type = get_attr_type (dep_insn); - - switch (ix86_tune) - { - case PROCESSOR_PENTIUM: - case PROCESSOR_LAKEMONT: - /* Address Generation Interlock adds a cycle of latency. */ - if (insn_type == TYPE_LEA) - { - rtx addr = PATTERN (insn); - - if (GET_CODE (addr) == PARALLEL) - addr = XVECEXP (addr, 0, 0); - - gcc_assert (GET_CODE (addr) == SET); - - addr = SET_SRC (addr); - if (modified_in_p (addr, dep_insn)) - cost += 1; - } - else if (ix86_agi_dependent (dep_insn, insn)) - cost += 1; - - /* ??? Compares pair with jump/setcc. */ - if (ix86_flags_dependent (insn, dep_insn, insn_type)) - cost = 0; - - /* Floating point stores require value to be ready one cycle earlier. */ - if (insn_type == TYPE_FMOV - && get_attr_memory (insn) == MEMORY_STORE - && !ix86_agi_dependent (dep_insn, insn)) - cost += 1; - break; - - case PROCESSOR_PENTIUMPRO: - /* INT->FP conversion is expensive. */ - if (get_attr_fp_int_src (dep_insn)) - cost += 5; - - /* There is one cycle extra latency between an FP op and a store. */ - if (insn_type == TYPE_FMOV - && (set = single_set (dep_insn)) != NULL_RTX - && (set2 = single_set (insn)) != NULL_RTX - && rtx_equal_p (SET_DEST (set), SET_SRC (set2)) - && MEM_P (SET_DEST (set2))) - cost += 1; - - memory = get_attr_memory (insn); - - /* Show ability of reorder buffer to hide latency of load by executing - in parallel with previous instruction in case - previous instruction is not needed to compute the address. */ - if ((memory == MEMORY_LOAD || memory == MEMORY_BOTH) - && !ix86_agi_dependent (dep_insn, insn)) - { - /* Claim moves to take one cycle, as core can issue one load - at time and the next load can start cycle later. */ - if (dep_insn_type == TYPE_IMOV - || dep_insn_type == TYPE_FMOV) - cost = 1; - else if (cost > 1) - cost--; - } - break; - - case PROCESSOR_K6: - /* The esp dependency is resolved before - the instruction is really finished. */ - if ((insn_type == TYPE_PUSH || insn_type == TYPE_POP) - && (dep_insn_type == TYPE_PUSH || dep_insn_type == TYPE_POP)) - return 1; - - /* INT->FP conversion is expensive. */ - if (get_attr_fp_int_src (dep_insn)) - cost += 5; - - memory = get_attr_memory (insn); - - /* Show ability of reorder buffer to hide latency of load by executing - in parallel with previous instruction in case - previous instruction is not needed to compute the address. */ - if ((memory == MEMORY_LOAD || memory == MEMORY_BOTH) - && !ix86_agi_dependent (dep_insn, insn)) - { - /* Claim moves to take one cycle, as core can issue one load - at time and the next load can start cycle later. */ - if (dep_insn_type == TYPE_IMOV - || dep_insn_type == TYPE_FMOV) - cost = 1; - else if (cost > 2) - cost -= 2; - else - cost = 1; - } - break; - - case PROCESSOR_AMDFAM10: - case PROCESSOR_BDVER1: - case PROCESSOR_BDVER2: - case PROCESSOR_BDVER3: - case PROCESSOR_BDVER4: - case PROCESSOR_ZNVER1: - case PROCESSOR_BTVER1: - case PROCESSOR_BTVER2: - case PROCESSOR_GENERIC: - /* Stack engine allows to execute push&pop instructions in parall. */ - if ((insn_type == TYPE_PUSH || insn_type == TYPE_POP) - && (dep_insn_type == TYPE_PUSH || dep_insn_type == TYPE_POP)) - return 0; - /* FALLTHRU */ - - case PROCESSOR_ATHLON: - case PROCESSOR_K8: - memory = get_attr_memory (insn); - - /* Show ability of reorder buffer to hide latency of load by executing - in parallel with previous instruction in case - previous instruction is not needed to compute the address. */ - if ((memory == MEMORY_LOAD || memory == MEMORY_BOTH) - && !ix86_agi_dependent (dep_insn, insn)) - { - enum attr_unit unit = get_attr_unit (insn); - int loadcost = 3; - - /* Because of the difference between the length of integer and - floating unit pipeline preparation stages, the memory operands - for floating point are cheaper. - - ??? For Athlon it the difference is most probably 2. */ - if (unit == UNIT_INTEGER || unit == UNIT_UNKNOWN) - loadcost = 3; - else - loadcost = TARGET_ATHLON ? 2 : 0; - - if (cost >= loadcost) - cost -= loadcost; - else - cost = 0; - } - break; - - case PROCESSOR_CORE2: - case PROCESSOR_NEHALEM: - case PROCESSOR_SANDYBRIDGE: - case PROCESSOR_HASWELL: - /* Stack engine allows to execute push&pop instructions in parall. */ - if ((insn_type == TYPE_PUSH || insn_type == TYPE_POP) - && (dep_insn_type == TYPE_PUSH || dep_insn_type == TYPE_POP)) - return 0; - - memory = get_attr_memory (insn); - - /* Show ability of reorder buffer to hide latency of load by executing - in parallel with previous instruction in case - previous instruction is not needed to compute the address. */ - if ((memory == MEMORY_LOAD || memory == MEMORY_BOTH) - && !ix86_agi_dependent (dep_insn, insn)) - { - if (cost >= 4) - cost -= 4; - else - cost = 0; - } - break; - - case PROCESSOR_SILVERMONT: - case PROCESSOR_KNL: - case PROCESSOR_KNM: - case PROCESSOR_INTEL: - if (!reload_completed) - return cost; - - /* Increase cost of integer loads. */ - memory = get_attr_memory (dep_insn); - if (memory == MEMORY_LOAD || memory == MEMORY_BOTH) - { - enum attr_unit unit = get_attr_unit (dep_insn); - if (unit == UNIT_INTEGER && cost == 1) - { - if (memory == MEMORY_LOAD) - cost = 3; - else - { - /* Increase cost of ld/st for short int types only - because of store forwarding issue. */ - rtx set = single_set (dep_insn); - if (set && (GET_MODE (SET_DEST (set)) == QImode - || GET_MODE (SET_DEST (set)) == HImode)) - { - /* Increase cost of store/load insn if exact - dependence exists and it is load insn. */ - enum attr_memory insn_memory = get_attr_memory (insn); - if (insn_memory == MEMORY_LOAD - && exact_store_load_dependency (dep_insn, insn)) - cost = 3; - } - } - } - } - - default: - break; - } - - return cost; -} - -/* How many alternative schedules to try. This should be as wide as the - scheduling freedom in the DFA, but no wider. Making this value too - large results extra work for the scheduler. */ - -static int -ia32_multipass_dfa_lookahead (void) -{ - /* Generally, we want haifa-sched:max_issue() to look ahead as far - as many instructions can be executed on a cycle, i.e., - issue_rate. */ - if (reload_completed) - return ix86_issue_rate (); - /* Don't use lookahead for pre-reload schedule to save compile time. */ - return 0; -} - -/* Return true if target platform supports macro-fusion. */ - -static bool -ix86_macro_fusion_p () -{ - return TARGET_FUSE_CMP_AND_BRANCH; -} - -/* Check whether current microarchitecture support macro fusion - for insn pair "CONDGEN + CONDJMP". Refer to - "Intel Architectures Optimization Reference Manual". */ - -static bool -ix86_macro_fusion_pair_p (rtx_insn *condgen, rtx_insn *condjmp) -{ - rtx src, dest; - enum rtx_code ccode; - rtx compare_set = NULL_RTX, test_if, cond; - rtx alu_set = NULL_RTX, addr = NULL_RTX; - - if (!any_condjump_p (condjmp)) - return false; - - unsigned int condreg1, condreg2; - rtx cc_reg_1; - ix86_fixed_condition_code_regs (&condreg1, &condreg2); - cc_reg_1 = gen_rtx_REG (CCmode, condreg1); - if (!reg_referenced_p (cc_reg_1, PATTERN (condjmp)) - || !condgen - || !modified_in_p (cc_reg_1, condgen)) - return false; - - if (get_attr_type (condgen) != TYPE_TEST - && get_attr_type (condgen) != TYPE_ICMP - && get_attr_type (condgen) != TYPE_INCDEC - && get_attr_type (condgen) != TYPE_ALU) - return false; - - compare_set = single_set (condgen); - if (compare_set == NULL_RTX - && !TARGET_FUSE_ALU_AND_BRANCH) - return false; - - if (compare_set == NULL_RTX) - { - int i; - rtx pat = PATTERN (condgen); - for (i = 0; i < XVECLEN (pat, 0); i++) - if (GET_CODE (XVECEXP (pat, 0, i)) == SET) - { - rtx set_src = SET_SRC (XVECEXP (pat, 0, i)); - if (GET_CODE (set_src) == COMPARE) - compare_set = XVECEXP (pat, 0, i); - else - alu_set = XVECEXP (pat, 0, i); - } - } - if (compare_set == NULL_RTX) - return false; - src = SET_SRC (compare_set); - if (GET_CODE (src) != COMPARE) - return false; - - /* Macro-fusion for cmp/test MEM-IMM + conditional jmp is not - supported. */ - if ((MEM_P (XEXP (src, 0)) - && CONST_INT_P (XEXP (src, 1))) - || (MEM_P (XEXP (src, 1)) - && CONST_INT_P (XEXP (src, 0)))) - return false; - - /* No fusion for RIP-relative address. */ - if (MEM_P (XEXP (src, 0))) - addr = XEXP (XEXP (src, 0), 0); - else if (MEM_P (XEXP (src, 1))) - addr = XEXP (XEXP (src, 1), 0); - - if (addr) { - ix86_address parts; - int ok = ix86_decompose_address (addr, &parts); - gcc_assert (ok); - - if (rip_relative_addr_p (&parts)) - return false; - } - - test_if = SET_SRC (pc_set (condjmp)); - cond = XEXP (test_if, 0); - ccode = GET_CODE (cond); - /* Check whether conditional jump use Sign or Overflow Flags. */ - if (!TARGET_FUSE_CMP_AND_BRANCH_SOFLAGS - && (ccode == GE - || ccode == GT - || ccode == LE - || ccode == LT)) - return false; - - /* Return true for TYPE_TEST and TYPE_ICMP. */ - if (get_attr_type (condgen) == TYPE_TEST - || get_attr_type (condgen) == TYPE_ICMP) - return true; - - /* The following is the case that macro-fusion for alu + jmp. */ - if (!TARGET_FUSE_ALU_AND_BRANCH || !alu_set) - return false; - - /* No fusion for alu op with memory destination operand. */ - dest = SET_DEST (alu_set); - if (MEM_P (dest)) - return false; - - /* Macro-fusion for inc/dec + unsigned conditional jump is not - supported. */ - if (get_attr_type (condgen) == TYPE_INCDEC - && (ccode == GEU - || ccode == GTU - || ccode == LEU - || ccode == LTU)) - return false; - - return true; -} - -/* Try to reorder ready list to take advantage of Atom pipelined IMUL - execution. It is applied if - (1) IMUL instruction is on the top of list; - (2) There exists the only producer of independent IMUL instruction in - ready list. - Return index of IMUL producer if it was found and -1 otherwise. */ -static int -do_reorder_for_imul (rtx_insn **ready, int n_ready) -{ - rtx_insn *insn; - rtx set, insn1, insn2; - sd_iterator_def sd_it; - dep_t dep; - int index = -1; - int i; - - if (!TARGET_BONNELL) - return index; - - /* Check that IMUL instruction is on the top of ready list. */ - insn = ready[n_ready - 1]; - set = single_set (insn); - if (!set) - return index; - if (!(GET_CODE (SET_SRC (set)) == MULT - && GET_MODE (SET_SRC (set)) == SImode)) - return index; - - /* Search for producer of independent IMUL instruction. */ - for (i = n_ready - 2; i >= 0; i--) - { - insn = ready[i]; - if (!NONDEBUG_INSN_P (insn)) - continue; - /* Skip IMUL instruction. */ - insn2 = PATTERN (insn); - if (GET_CODE (insn2) == PARALLEL) - insn2 = XVECEXP (insn2, 0, 0); - if (GET_CODE (insn2) == SET - && GET_CODE (SET_SRC (insn2)) == MULT - && GET_MODE (SET_SRC (insn2)) == SImode) - continue; - - FOR_EACH_DEP (insn, SD_LIST_FORW, sd_it, dep) - { - rtx con; - con = DEP_CON (dep); - if (!NONDEBUG_INSN_P (con)) - continue; - insn1 = PATTERN (con); - if (GET_CODE (insn1) == PARALLEL) - insn1 = XVECEXP (insn1, 0, 0); - - if (GET_CODE (insn1) == SET - && GET_CODE (SET_SRC (insn1)) == MULT - && GET_MODE (SET_SRC (insn1)) == SImode) - { - sd_iterator_def sd_it1; - dep_t dep1; - /* Check if there is no other dependee for IMUL. */ - index = i; - FOR_EACH_DEP (con, SD_LIST_BACK, sd_it1, dep1) - { - rtx pro; - pro = DEP_PRO (dep1); - if (!NONDEBUG_INSN_P (pro)) - continue; - if (pro != insn) - index = -1; - } - if (index >= 0) - break; - } - } - if (index >= 0) - break; - } - return index; -} - -/* Try to find the best candidate on the top of ready list if two insns - have the same priority - candidate is best if its dependees were - scheduled earlier. Applied for Silvermont only. - Return true if top 2 insns must be interchanged. */ -static bool -swap_top_of_ready_list (rtx_insn **ready, int n_ready) -{ - rtx_insn *top = ready[n_ready - 1]; - rtx_insn *next = ready[n_ready - 2]; - rtx set; - sd_iterator_def sd_it; - dep_t dep; - int clock1 = -1; - int clock2 = -1; - #define INSN_TICK(INSN) (HID (INSN)->tick) - - if (!TARGET_SILVERMONT && !TARGET_INTEL) - return false; - - if (!NONDEBUG_INSN_P (top)) - return false; - if (!NONJUMP_INSN_P (top)) - return false; - if (!NONDEBUG_INSN_P (next)) - return false; - if (!NONJUMP_INSN_P (next)) - return false; - set = single_set (top); - if (!set) - return false; - set = single_set (next); - if (!set) - return false; - - if (INSN_PRIORITY_KNOWN (top) && INSN_PRIORITY_KNOWN (next)) - { - if (INSN_PRIORITY (top) != INSN_PRIORITY (next)) - return false; - /* Determine winner more precise. */ - FOR_EACH_DEP (top, SD_LIST_RES_BACK, sd_it, dep) - { - rtx pro; - pro = DEP_PRO (dep); - if (!NONDEBUG_INSN_P (pro)) - continue; - if (INSN_TICK (pro) > clock1) - clock1 = INSN_TICK (pro); - } - FOR_EACH_DEP (next, SD_LIST_RES_BACK, sd_it, dep) - { - rtx pro; - pro = DEP_PRO (dep); - if (!NONDEBUG_INSN_P (pro)) - continue; - if (INSN_TICK (pro) > clock2) - clock2 = INSN_TICK (pro); - } - - if (clock1 == clock2) - { - /* Determine winner - load must win. */ - enum attr_memory memory1, memory2; - memory1 = get_attr_memory (top); - memory2 = get_attr_memory (next); - if (memory2 == MEMORY_LOAD && memory1 != MEMORY_LOAD) - return true; - } - return (bool) (clock2 < clock1); - } - return false; - #undef INSN_TICK -} - -/* Perform possible reodering of ready list for Atom/Silvermont only. - Return issue rate. */ -static int -ix86_sched_reorder (FILE *dump, int sched_verbose, rtx_insn **ready, - int *pn_ready, int clock_var) -{ - int issue_rate = -1; - int n_ready = *pn_ready; - int i; - rtx_insn *insn; - int index = -1; - - /* Set up issue rate. */ - issue_rate = ix86_issue_rate (); - - /* Do reodering for BONNELL/SILVERMONT only. */ - if (!TARGET_BONNELL && !TARGET_SILVERMONT && !TARGET_INTEL) - return issue_rate; - - /* Nothing to do if ready list contains only 1 instruction. */ - if (n_ready <= 1) - return issue_rate; - - /* Do reodering for post-reload scheduler only. */ - if (!reload_completed) - return issue_rate; - - if ((index = do_reorder_for_imul (ready, n_ready)) >= 0) - { - if (sched_verbose > 1) - fprintf (dump, ";;\tatom sched_reorder: put %d insn on top\n", - INSN_UID (ready[index])); - - /* Put IMUL producer (ready[index]) at the top of ready list. */ - insn = ready[index]; - for (i = index; i < n_ready - 1; i++) - ready[i] = ready[i + 1]; - ready[n_ready - 1] = insn; - return issue_rate; - } - - /* Skip selective scheduling since HID is not populated in it. */ - if (clock_var != 0 - && !sel_sched_p () - && swap_top_of_ready_list (ready, n_ready)) - { - if (sched_verbose > 1) - fprintf (dump, ";;\tslm sched_reorder: swap %d and %d insns\n", - INSN_UID (ready[n_ready - 1]), INSN_UID (ready[n_ready - 2])); - /* Swap 2 top elements of ready list. */ - insn = ready[n_ready - 1]; - ready[n_ready - 1] = ready[n_ready - 2]; - ready[n_ready - 2] = insn; - } - return issue_rate; -} static bool ix86_class_likely_spilled_p (reg_class_t); @@ -31327,204 +28463,6 @@ ix86_adjust_priority (rtx_insn *insn, int priority) return priority; } -/* Model decoder of Core 2/i7. - Below hooks for multipass scheduling (see haifa-sched.c:max_issue) - track the instruction fetch block boundaries and make sure that long - (9+ bytes) instructions are assigned to D0. */ - -/* Maximum length of an insn that can be handled by - a secondary decoder unit. '8' for Core 2/i7. */ -static int core2i7_secondary_decoder_max_insn_size; - -/* Ifetch block size, i.e., number of bytes decoder reads per cycle. - '16' for Core 2/i7. */ -static int core2i7_ifetch_block_size; - -/* Maximum number of instructions decoder can handle per cycle. - '6' for Core 2/i7. */ -static int core2i7_ifetch_block_max_insns; - -typedef struct ix86_first_cycle_multipass_data_ * - ix86_first_cycle_multipass_data_t; -typedef const struct ix86_first_cycle_multipass_data_ * - const_ix86_first_cycle_multipass_data_t; - -/* A variable to store target state across calls to max_issue within - one cycle. */ -static struct ix86_first_cycle_multipass_data_ _ix86_first_cycle_multipass_data, - *ix86_first_cycle_multipass_data = &_ix86_first_cycle_multipass_data; - -/* Initialize DATA. */ -static void -core2i7_first_cycle_multipass_init (void *_data) -{ - ix86_first_cycle_multipass_data_t data - = (ix86_first_cycle_multipass_data_t) _data; - - data->ifetch_block_len = 0; - data->ifetch_block_n_insns = 0; - data->ready_try_change = NULL; - data->ready_try_change_size = 0; -} - -/* Advancing the cycle; reset ifetch block counts. */ -static void -core2i7_dfa_post_advance_cycle (void) -{ - ix86_first_cycle_multipass_data_t data = ix86_first_cycle_multipass_data; - - gcc_assert (data->ifetch_block_n_insns <= core2i7_ifetch_block_max_insns); - - data->ifetch_block_len = 0; - data->ifetch_block_n_insns = 0; -} - -static int min_insn_size (rtx_insn *); - -/* Filter out insns from ready_try that the core will not be able to issue - on current cycle due to decoder. */ -static void -core2i7_first_cycle_multipass_filter_ready_try -(const_ix86_first_cycle_multipass_data_t data, - signed char *ready_try, int n_ready, bool first_cycle_insn_p) -{ - while (n_ready--) - { - rtx_insn *insn; - int insn_size; - - if (ready_try[n_ready]) - continue; - - insn = get_ready_element (n_ready); - insn_size = min_insn_size (insn); - - if (/* If this is a too long an insn for a secondary decoder ... */ - (!first_cycle_insn_p - && insn_size > core2i7_secondary_decoder_max_insn_size) - /* ... or it would not fit into the ifetch block ... */ - || data->ifetch_block_len + insn_size > core2i7_ifetch_block_size - /* ... or the decoder is full already ... */ - || data->ifetch_block_n_insns + 1 > core2i7_ifetch_block_max_insns) - /* ... mask the insn out. */ - { - ready_try[n_ready] = 1; - - if (data->ready_try_change) - bitmap_set_bit (data->ready_try_change, n_ready); - } - } -} - -/* Prepare for a new round of multipass lookahead scheduling. */ -static void -core2i7_first_cycle_multipass_begin (void *_data, - signed char *ready_try, int n_ready, - bool first_cycle_insn_p) -{ - ix86_first_cycle_multipass_data_t data - = (ix86_first_cycle_multipass_data_t) _data; - const_ix86_first_cycle_multipass_data_t prev_data - = ix86_first_cycle_multipass_data; - - /* Restore the state from the end of the previous round. */ - data->ifetch_block_len = prev_data->ifetch_block_len; - data->ifetch_block_n_insns = prev_data->ifetch_block_n_insns; - - /* Filter instructions that cannot be issued on current cycle due to - decoder restrictions. */ - core2i7_first_cycle_multipass_filter_ready_try (data, ready_try, n_ready, - first_cycle_insn_p); -} - -/* INSN is being issued in current solution. Account for its impact on - the decoder model. */ -static void -core2i7_first_cycle_multipass_issue (void *_data, - signed char *ready_try, int n_ready, - rtx_insn *insn, const void *_prev_data) -{ - ix86_first_cycle_multipass_data_t data - = (ix86_first_cycle_multipass_data_t) _data; - const_ix86_first_cycle_multipass_data_t prev_data - = (const_ix86_first_cycle_multipass_data_t) _prev_data; - - int insn_size = min_insn_size (insn); - - data->ifetch_block_len = prev_data->ifetch_block_len + insn_size; - data->ifetch_block_n_insns = prev_data->ifetch_block_n_insns + 1; - gcc_assert (data->ifetch_block_len <= core2i7_ifetch_block_size - && data->ifetch_block_n_insns <= core2i7_ifetch_block_max_insns); - - /* Allocate or resize the bitmap for storing INSN's effect on ready_try. */ - if (!data->ready_try_change) - { - data->ready_try_change = sbitmap_alloc (n_ready); - data->ready_try_change_size = n_ready; - } - else if (data->ready_try_change_size < n_ready) - { - data->ready_try_change = sbitmap_resize (data->ready_try_change, - n_ready, 0); - data->ready_try_change_size = n_ready; - } - bitmap_clear (data->ready_try_change); - - /* Filter out insns from ready_try that the core will not be able to issue - on current cycle due to decoder. */ - core2i7_first_cycle_multipass_filter_ready_try (data, ready_try, n_ready, - false); -} - -/* Revert the effect on ready_try. */ -static void -core2i7_first_cycle_multipass_backtrack (const void *_data, - signed char *ready_try, - int n_ready ATTRIBUTE_UNUSED) -{ - const_ix86_first_cycle_multipass_data_t data - = (const_ix86_first_cycle_multipass_data_t) _data; - unsigned int i = 0; - sbitmap_iterator sbi; - - gcc_assert (bitmap_last_set_bit (data->ready_try_change) < n_ready); - EXECUTE_IF_SET_IN_BITMAP (data->ready_try_change, 0, i, sbi) - { - ready_try[i] = 0; - } -} - -/* Save the result of multipass lookahead scheduling for the next round. */ -static void -core2i7_first_cycle_multipass_end (const void *_data) -{ - const_ix86_first_cycle_multipass_data_t data - = (const_ix86_first_cycle_multipass_data_t) _data; - ix86_first_cycle_multipass_data_t next_data - = ix86_first_cycle_multipass_data; - - if (data != NULL) - { - next_data->ifetch_block_len = data->ifetch_block_len; - next_data->ifetch_block_n_insns = data->ifetch_block_n_insns; - } -} - -/* Deallocate target data. */ -static void -core2i7_first_cycle_multipass_fini (void *_data) -{ - ix86_first_cycle_multipass_data_t data - = (ix86_first_cycle_multipass_data_t) _data; - - if (data->ready_try_change) - { - sbitmap_free (data->ready_try_change); - data->ready_try_change = NULL; - data->ready_try_change_size = 0; - } -} - /* Prepare for scheduling pass. */ static void ix86_sched_init_global (FILE *, int, int) @@ -31542,25 +28480,7 @@ ix86_sched_init_global (FILE *, int, int) to save compile time. */ if (reload_completed) { - targetm.sched.dfa_post_advance_cycle - = core2i7_dfa_post_advance_cycle; - targetm.sched.first_cycle_multipass_init - = core2i7_first_cycle_multipass_init; - targetm.sched.first_cycle_multipass_begin - = core2i7_first_cycle_multipass_begin; - targetm.sched.first_cycle_multipass_issue - = core2i7_first_cycle_multipass_issue; - targetm.sched.first_cycle_multipass_backtrack - = core2i7_first_cycle_multipass_backtrack; - targetm.sched.first_cycle_multipass_end - = core2i7_first_cycle_multipass_end; - targetm.sched.first_cycle_multipass_fini - = core2i7_first_cycle_multipass_fini; - - /* Set decoder parameters. */ - core2i7_secondary_decoder_max_insn_size = 8; - core2i7_ifetch_block_size = 16; - core2i7_ifetch_block_max_insns = 6; + ix86_core2i7_init_hooks (); break; } /* Fall through. */ @@ -31667,12 +28587,12 @@ ix86_data_alignment (tree type, int align, bool opt) && TYPE_SIZE (type) && TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST) { - if (wi::geu_p (TYPE_SIZE (type), max_align_compat) + if (wi::geu_p (wi::to_wide (TYPE_SIZE (type)), max_align_compat) && align < max_align_compat) align = max_align_compat; - if (wi::geu_p (TYPE_SIZE (type), max_align) - && align < max_align) - align = max_align; + if (wi::geu_p (wi::to_wide (TYPE_SIZE (type)), max_align) + && align < max_align) + align = max_align; } /* x86-64 ABI requires arrays greater than 16 bytes to be aligned @@ -31682,7 +28602,7 @@ ix86_data_alignment (tree type, int align, bool opt) if ((opt ? AGGREGATE_TYPE_P (type) : TREE_CODE (type) == ARRAY_TYPE) && TYPE_SIZE (type) && TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST - && wi::geu_p (TYPE_SIZE (type), 128) + && wi::geu_p (wi::to_wide (TYPE_SIZE (type)), 128) && align < 128) return 128; } @@ -31801,7 +28721,7 @@ ix86_local_alignment (tree exp, machine_mode mode, != TYPE_MAIN_VARIANT (va_list_type_node))) && TYPE_SIZE (type) && TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST - && wi::geu_p (TYPE_SIZE (type), 128) + && wi::geu_p (wi::to_wide (TYPE_SIZE (type)), 128) && align < 128) return 128; } @@ -32985,7 +29905,9 @@ ix86_init_mmx_sse_builtins (void) UNSIGNED_FTYPE_VOID, IX86_BUILTIN_STMXCSR); /* SSE or 3DNow!A */ - def_builtin (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, + def_builtin (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A + /* As it uses V4HImode, we have to require -mmmx too. */ + | OPTION_MASK_ISA_MMX, "__builtin_ia32_maskmovq", VOID_FTYPE_V8QI_V8QI_PCHAR, IX86_BUILTIN_MASKMOVQ); @@ -33423,7 +30345,9 @@ ix86_init_mmx_sse_builtins (void) def_builtin_const (OPTION_MASK_ISA_SSE2, "__builtin_ia32_vec_ext_v8hi", HI_FTYPE_V8HI_INT, IX86_BUILTIN_VEC_EXT_V8HI); - def_builtin_const (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, + def_builtin_const (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A + /* As it uses V4HImode, we have to require -mmmx too. */ + | OPTION_MASK_ISA_MMX, "__builtin_ia32_vec_ext_v4hi", HI_FTYPE_V4HI_INT, IX86_BUILTIN_VEC_EXT_V4HI); @@ -33447,7 +30371,9 @@ ix86_init_mmx_sse_builtins (void) def_builtin_const (OPTION_MASK_ISA_SSE2, "__builtin_ia32_vec_set_v8hi", V8HI_FTYPE_V8HI_HI_INT, IX86_BUILTIN_VEC_SET_V8HI); - def_builtin_const (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A, + def_builtin_const (OPTION_MASK_ISA_SSE | OPTION_MASK_ISA_3DNOW_A + /* As it uses V4HImode, we have to require -mmmx too. */ + | OPTION_MASK_ISA_MMX, "__builtin_ia32_vec_set_v4hi", V4HI_FTYPE_V4HI_HI_INT, IX86_BUILTIN_VEC_SET_V4HI); @@ -37911,18 +34837,23 @@ ix86_expand_builtin (tree exp, rtx target, rtx subtarget, Originally the builtin was not created if it wasn't applicable to the current ISA based on the command line switches. With function specific options, we need to check in the context of the function making the call - whether it is supported. Treat AVX512VL specially. For other flags, + whether it is supported. Treat AVX512VL and MMX specially. For other flags, if isa includes more than one ISA bit, treat those are requiring any of them. For AVX512VL, require both AVX512VL and the non-AVX512VL - ISAs. Similarly for 64BIT, but we shouldn't be building such builtins + ISAs. Likewise for MMX, require both MMX and the non-MMX ISAs. + Similarly for 64BIT, but we shouldn't be building such builtins at all, -m64 is a whole TU option. */ if (((ix86_builtins_isa[fcode].isa - & ~(OPTION_MASK_ISA_AVX512VL | OPTION_MASK_ISA_64BIT)) + & ~(OPTION_MASK_ISA_AVX512VL | OPTION_MASK_ISA_MMX + | OPTION_MASK_ISA_64BIT)) && !(ix86_builtins_isa[fcode].isa - & ~(OPTION_MASK_ISA_AVX512VL | OPTION_MASK_ISA_64BIT) + & ~(OPTION_MASK_ISA_AVX512VL | OPTION_MASK_ISA_MMX + | OPTION_MASK_ISA_64BIT) & ix86_isa_flags)) || ((ix86_builtins_isa[fcode].isa & OPTION_MASK_ISA_AVX512VL) && !(ix86_isa_flags & OPTION_MASK_ISA_AVX512VL)) + || ((ix86_builtins_isa[fcode].isa & OPTION_MASK_ISA_MMX) + && !(ix86_isa_flags & OPTION_MASK_ISA_MMX)) || (ix86_builtins_isa[fcode].isa2 && !(ix86_builtins_isa[fcode].isa2 & ix86_isa_flags2))) { @@ -41849,6 +38780,27 @@ ix86_set_reg_reg_cost (machine_mode mode) return COSTS_N_INSNS (CEIL (GET_MODE_SIZE (mode), units)); } +/* Return cost of vector operation in MODE given that scalar version has + COST. If PARALLEL is true assume that CPU has more than one unit + performing the operation. */ + +static int +ix86_vec_cost (machine_mode mode, int cost, bool parallel) +{ + if (!VECTOR_MODE_P (mode)) + return cost; + + if (!parallel) + return cost * GET_MODE_NUNITS (mode); + if (GET_MODE_BITSIZE (mode) == 128 + && TARGET_SSE_SPLIT_REGS) + return cost * 2; + if (GET_MODE_BITSIZE (mode) > 128 + && TARGET_AVX128_OPTIMAL) + return cost * GET_MODE_BITSIZE (mode) / 128; + return cost; +} + /* Compute a (partial) cost for rtx X. Return true if the complete cost has been computed, and false if subexpressions should be scanned. In either case, *TOTAL contains the cost result. */ @@ -41862,6 +38814,9 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, enum rtx_code outer_code = (enum rtx_code) outer_code_i; const struct processor_costs *cost = speed ? ix86_cost : &ix86_size_cost; int src_cost; + machine_mode inner_mode = mode; + if (VECTOR_MODE_P (mode)) + inner_mode = GET_MODE_INNER (mode); switch (code) { @@ -42006,19 +38961,20 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, shift with one insn set the cost to prefer paddb. */ if (CONSTANT_P (XEXP (x, 1))) { - *total = (cost->fabs + *total = ix86_vec_cost (mode, + cost->sse_op + rtx_cost (XEXP (x, 0), mode, code, 0, speed) - + (speed ? 2 : COSTS_N_BYTES (16))); + + (speed ? 2 : COSTS_N_BYTES (16)), true); return true; } count = 3; } else if (TARGET_SSSE3) count = 7; - *total = cost->fabs * count; + *total = ix86_vec_cost (mode, cost->sse_op * count, true); } else - *total = cost->fabs; + *total = ix86_vec_cost (mode, cost->sse_op, true); } else if (GET_MODE_SIZE (mode) > UNITS_PER_WORD) { @@ -42060,9 +39016,9 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, gcc_assert (FLOAT_MODE_P (mode)); gcc_assert (TARGET_FMA || TARGET_FMA4 || TARGET_AVX512F); - /* ??? SSE scalar/vector cost should be used here. */ - /* ??? Bald assumption that fma has the same cost as fmul. */ - *total = cost->fmul; + *total = ix86_vec_cost (mode, + mode == SFmode ? cost->fmass : cost->fmasd, + true); *total += rtx_cost (XEXP (x, 1), mode, FMA, 1, speed); /* Negate in op0 or op2 is free: FMS, FNMA, FNMS. */ @@ -42081,8 +39037,7 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, case MULT: if (SSE_FLOAT_MODE_P (mode) && TARGET_SSE_MATH) { - /* ??? SSE scalar cost should be used here. */ - *total = cost->fmul; + *total = inner_mode == DFmode ? cost->mulsd : cost->mulss; return false; } else if (X87_FLOAT_MODE_P (mode)) @@ -42092,8 +39047,9 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, } else if (FLOAT_MODE_P (mode)) { - /* ??? SSE vector cost should be used here. */ - *total = cost->fmul; + *total = ix86_vec_cost (mode, + inner_mode == DFmode + ? cost->mulsd : cost->mulss, true); return false; } else if (GET_MODE_CLASS (mode) == MODE_VECTOR_INT) @@ -42106,22 +39062,29 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, extra = 5; else if (TARGET_SSSE3) extra = 6; - *total = cost->fmul * 2 + cost->fabs * extra; + *total = ix86_vec_cost (mode, + cost->mulss * 2 + cost->sse_op * extra, + true); } /* V*DImode is emulated with 5-8 insns. */ else if (mode == V2DImode || mode == V4DImode) { if (TARGET_XOP && mode == V2DImode) - *total = cost->fmul * 2 + cost->fabs * 3; + *total = ix86_vec_cost (mode, + cost->mulss * 2 + cost->sse_op * 3, + true); else - *total = cost->fmul * 3 + cost->fabs * 5; + *total = ix86_vec_cost (mode, + cost->mulss * 3 + cost->sse_op * 5, + true); } /* Without sse4.1, we don't have PMULLD; it's emulated with 7 insns, including two PMULUDQ. */ else if (mode == V4SImode && !(TARGET_SSE4_1 || TARGET_AVX)) - *total = cost->fmul * 2 + cost->fabs * 5; + *total = ix86_vec_cost (mode, cost->mulss * 2 + cost->sse_op * 5, + true); else - *total = cost->fmul; + *total = ix86_vec_cost (mode, cost->mulss, true); return false; } else @@ -42175,13 +39138,13 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, case MOD: case UMOD: if (SSE_FLOAT_MODE_P (mode) && TARGET_SSE_MATH) - /* ??? SSE cost should be used here. */ - *total = cost->fdiv; + *total = inner_mode == DFmode ? cost->divsd : cost->divss; else if (X87_FLOAT_MODE_P (mode)) *total = cost->fdiv; else if (FLOAT_MODE_P (mode)) - /* ??? SSE vector cost should be used here. */ - *total = cost->fdiv; + *total = ix86_vec_cost (mode, + inner_mode == DFmode ? cost->divsd : cost->divss, + true); else *total = cost->divide[MODE_INDEX (mode)]; return false; @@ -42260,8 +39223,7 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, if (SSE_FLOAT_MODE_P (mode) && TARGET_SSE_MATH) { - /* ??? SSE cost should be used here. */ - *total = cost->fadd; + *total = cost->addss; return false; } else if (X87_FLOAT_MODE_P (mode)) @@ -42271,8 +39233,7 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, } else if (FLOAT_MODE_P (mode)) { - /* ??? SSE vector cost should be used here. */ - *total = cost->fadd; + *total = ix86_vec_cost (mode, cost->addss, true); return false; } /* FALLTHRU */ @@ -42295,8 +39256,7 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, case NEG: if (SSE_FLOAT_MODE_P (mode) && TARGET_SSE_MATH) { - /* ??? SSE cost should be used here. */ - *total = cost->fchs; + *total = cost->sse_op; return false; } else if (X87_FLOAT_MODE_P (mode)) @@ -42306,20 +39266,14 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, } else if (FLOAT_MODE_P (mode)) { - /* ??? SSE vector cost should be used here. */ - *total = cost->fchs; + *total = ix86_vec_cost (mode, cost->sse_op, true); return false; } /* FALLTHRU */ case NOT: if (GET_MODE_CLASS (mode) == MODE_VECTOR_INT) - { - /* ??? Should be SSE vector operation cost. */ - /* At least for published AMD latencies, this really is the same - as the latency for a simple fpu operation like fabs. */ - *total = cost->fabs; - } + *total = ix86_vec_cost (mode, cost->sse_op, true); else if (GET_MODE_SIZE (mode) > UNITS_PER_WORD) *total = cost->add * 2; else @@ -42352,28 +39306,38 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, case FLOAT_EXTEND: if (!(SSE_FLOAT_MODE_P (mode) && TARGET_SSE_MATH)) *total = 0; + else + *total = ix86_vec_cost (mode, cost->addss, true); + return false; + + case FLOAT_TRUNCATE: + if (!(SSE_FLOAT_MODE_P (mode) && TARGET_SSE_MATH)) + *total = cost->fadd; + else + *total = ix86_vec_cost (mode, cost->addss, true); return false; case ABS: + /* SSE requires memory load for the constant operand. It may make + sense to account for this. Of course the constant operand may or + may not be reused. */ if (SSE_FLOAT_MODE_P (mode) && TARGET_SSE_MATH) - /* ??? SSE cost should be used here. */ - *total = cost->fabs; + *total = cost->sse_op; else if (X87_FLOAT_MODE_P (mode)) *total = cost->fabs; else if (FLOAT_MODE_P (mode)) - /* ??? SSE vector cost should be used here. */ - *total = cost->fabs; + *total = ix86_vec_cost (mode, cost->sse_op, true); return false; case SQRT: if (SSE_FLOAT_MODE_P (mode) && TARGET_SSE_MATH) - /* ??? SSE cost should be used here. */ - *total = cost->fsqrt; + *total = mode == SFmode ? cost->sqrtss : cost->sqrtsd; else if (X87_FLOAT_MODE_P (mode)) *total = cost->fsqrt; else if (FLOAT_MODE_P (mode)) - /* ??? SSE vector cost should be used here. */ - *total = cost->fsqrt; + *total = ix86_vec_cost (mode, + mode == SFmode ? cost->sqrtss : cost->sqrtsd, + true); return false; case UNSPEC: @@ -42387,7 +39351,7 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, /* ??? Assume all of these vector manipulation patterns are recognizable. In which case they all pretty much have the same cost. */ - *total = cost->fabs; + *total = cost->sse_op; return true; case VEC_MERGE: mask = XEXP (x, 2); @@ -42396,7 +39360,7 @@ ix86_rtx_costs (rtx x, machine_mode mode, int outer_code_i, int opno, if (TARGET_AVX512F && register_operand (mask, GET_MODE (mask))) *total = rtx_cost (XEXP (x, 0), mode, outer_code, opno, speed); else - *total = cost->fabs; + *total = cost->sse_op; return true; default: @@ -43114,8 +40078,8 @@ x86_function_profiler (FILE *file, int labelno ATTRIBUTE_UNUSED) address sizes. This is enough to eliminate unnecessary padding in 99% of cases. */ -static int -min_insn_size (rtx_insn *insn) +int +ix86_min_insn_size (rtx_insn *insn) { int l = 0, len; @@ -43224,13 +40188,13 @@ ix86_avoid_jump_mispredicts (void) njumps--, isjump = true; else isjump = false; - nbytes -= min_insn_size (start); + nbytes -= ix86_min_insn_size (start); } } continue; } - min_size = min_insn_size (insn); + min_size = ix86_min_insn_size (insn); nbytes += min_size; if (dump_file) fprintf (dump_file, "Insn %i estimated to %i bytes\n", @@ -43249,7 +40213,7 @@ ix86_avoid_jump_mispredicts (void) njumps--, isjump = true; else isjump = false; - nbytes -= min_insn_size (start); + nbytes -= ix86_min_insn_size (start); } gcc_assert (njumps >= 0); if (dump_file) @@ -43258,7 +40222,7 @@ ix86_avoid_jump_mispredicts (void) if (njumps == 3 && isjump && nbytes < 16) { - int padsize = 15 - nbytes + min_insn_size (insn); + int padsize = 15 - nbytes + ix86_min_insn_size (insn); if (dump_file) fprintf (dump_file, "Padding insn %i by %i bytes!\n", @@ -47115,6 +44079,8 @@ ix86_builtin_vectorization_cost (enum vect_cost_for_stmt type_of_cost, case unaligned_load: case unaligned_store: + case vector_gather_load: + case vector_scatter_store: return ix86_cost->vec_unalign_load_cost; case cond_branch_taken: @@ -51021,805 +47987,19 @@ ix86_enum_va_list (int idx, const char **pname, tree *ptree) } #undef TARGET_SCHED_DISPATCH -#define TARGET_SCHED_DISPATCH has_dispatch +#define TARGET_SCHED_DISPATCH ix86_bd_has_dispatch #undef TARGET_SCHED_DISPATCH_DO -#define TARGET_SCHED_DISPATCH_DO do_dispatch +#define TARGET_SCHED_DISPATCH_DO ix86_bd_do_dispatch #undef TARGET_SCHED_REASSOCIATION_WIDTH #define TARGET_SCHED_REASSOCIATION_WIDTH ix86_reassociation_width #undef TARGET_SCHED_REORDER -#define TARGET_SCHED_REORDER ix86_sched_reorder +#define TARGET_SCHED_REORDER ix86_atom_sched_reorder #undef TARGET_SCHED_ADJUST_PRIORITY #define TARGET_SCHED_ADJUST_PRIORITY ix86_adjust_priority #undef TARGET_SCHED_DEPENDENCIES_EVALUATION_HOOK #define TARGET_SCHED_DEPENDENCIES_EVALUATION_HOOK \ ix86_dependencies_evaluation_hook -/* The size of the dispatch window is the total number of bytes of - object code allowed in a window. */ -#define DISPATCH_WINDOW_SIZE 16 - -/* Number of dispatch windows considered for scheduling. */ -#define MAX_DISPATCH_WINDOWS 3 - -/* Maximum number of instructions in a window. */ -#define MAX_INSN 4 - -/* Maximum number of immediate operands in a window. */ -#define MAX_IMM 4 - -/* Maximum number of immediate bits allowed in a window. */ -#define MAX_IMM_SIZE 128 - -/* Maximum number of 32 bit immediates allowed in a window. */ -#define MAX_IMM_32 4 - -/* Maximum number of 64 bit immediates allowed in a window. */ -#define MAX_IMM_64 2 - -/* Maximum total of loads or prefetches allowed in a window. */ -#define MAX_LOAD 2 - -/* Maximum total of stores allowed in a window. */ -#define MAX_STORE 1 - -#undef BIG -#define BIG 100 - - -/* Dispatch groups. Istructions that affect the mix in a dispatch window. */ -enum dispatch_group { - disp_no_group = 0, - disp_load, - disp_store, - disp_load_store, - disp_prefetch, - disp_imm, - disp_imm_32, - disp_imm_64, - disp_branch, - disp_cmp, - disp_jcc, - disp_last -}; - -/* Number of allowable groups in a dispatch window. It is an array - indexed by dispatch_group enum. 100 is used as a big number, - because the number of these kind of operations does not have any - effect in dispatch window, but we need them for other reasons in - the table. */ -static unsigned int num_allowable_groups[disp_last] = { - 0, 2, 1, 1, 2, 4, 4, 2, 1, BIG, BIG -}; - -char group_name[disp_last + 1][16] = { - "disp_no_group", "disp_load", "disp_store", "disp_load_store", - "disp_prefetch", "disp_imm", "disp_imm_32", "disp_imm_64", - "disp_branch", "disp_cmp", "disp_jcc", "disp_last" -}; - -/* Instruction path. */ -enum insn_path { - no_path = 0, - path_single, /* Single micro op. */ - path_double, /* Double micro op. */ - path_multi, /* Instructions with more than 2 micro op.. */ - last_path -}; - -/* sched_insn_info defines a window to the instructions scheduled in - the basic block. It contains a pointer to the insn_info table and - the instruction scheduled. - - Windows are allocated for each basic block and are linked - together. */ -typedef struct sched_insn_info_s { - rtx insn; - enum dispatch_group group; - enum insn_path path; - int byte_len; - int imm_bytes; -} sched_insn_info; - -/* Linked list of dispatch windows. This is a two way list of - dispatch windows of a basic block. It contains information about - the number of uops in the window and the total number of - instructions and of bytes in the object code for this dispatch - window. */ -typedef struct dispatch_windows_s { - int num_insn; /* Number of insn in the window. */ - int num_uops; /* Number of uops in the window. */ - int window_size; /* Number of bytes in the window. */ - int window_num; /* Window number between 0 or 1. */ - int num_imm; /* Number of immediates in an insn. */ - int num_imm_32; /* Number of 32 bit immediates in an insn. */ - int num_imm_64; /* Number of 64 bit immediates in an insn. */ - int imm_size; /* Total immediates in the window. */ - int num_loads; /* Total memory loads in the window. */ - int num_stores; /* Total memory stores in the window. */ - int violation; /* Violation exists in window. */ - sched_insn_info *window; /* Pointer to the window. */ - struct dispatch_windows_s *next; - struct dispatch_windows_s *prev; -} dispatch_windows; - -/* Immediate valuse used in an insn. */ -typedef struct imm_info_s - { - int imm; - int imm32; - int imm64; - } imm_info; - -static dispatch_windows *dispatch_window_list; -static dispatch_windows *dispatch_window_list1; - -/* Get dispatch group of insn. */ - -static enum dispatch_group -get_mem_group (rtx_insn *insn) -{ - enum attr_memory memory; - - if (INSN_CODE (insn) < 0) - return disp_no_group; - memory = get_attr_memory (insn); - if (memory == MEMORY_STORE) - return disp_store; - - if (memory == MEMORY_LOAD) - return disp_load; - - if (memory == MEMORY_BOTH) - return disp_load_store; - - return disp_no_group; -} - -/* Return true if insn is a compare instruction. */ - -static bool -is_cmp (rtx_insn *insn) -{ - enum attr_type type; - - type = get_attr_type (insn); - return (type == TYPE_TEST - || type == TYPE_ICMP - || type == TYPE_FCMP - || GET_CODE (PATTERN (insn)) == COMPARE); -} - -/* Return true if a dispatch violation encountered. */ - -static bool -dispatch_violation (void) -{ - if (dispatch_window_list->next) - return dispatch_window_list->next->violation; - return dispatch_window_list->violation; -} - -/* Return true if insn is a branch instruction. */ - -static bool -is_branch (rtx_insn *insn) -{ - return (CALL_P (insn) || JUMP_P (insn)); -} - -/* Return true if insn is a prefetch instruction. */ - -static bool -is_prefetch (rtx_insn *insn) -{ - return NONJUMP_INSN_P (insn) && GET_CODE (PATTERN (insn)) == PREFETCH; -} - -/* This function initializes a dispatch window and the list container holding a - pointer to the window. */ - -static void -init_window (int window_num) -{ - int i; - dispatch_windows *new_list; - - if (window_num == 0) - new_list = dispatch_window_list; - else - new_list = dispatch_window_list1; - - new_list->num_insn = 0; - new_list->num_uops = 0; - new_list->window_size = 0; - new_list->next = NULL; - new_list->prev = NULL; - new_list->window_num = window_num; - new_list->num_imm = 0; - new_list->num_imm_32 = 0; - new_list->num_imm_64 = 0; - new_list->imm_size = 0; - new_list->num_loads = 0; - new_list->num_stores = 0; - new_list->violation = false; - - for (i = 0; i < MAX_INSN; i++) - { - new_list->window[i].insn = NULL; - new_list->window[i].group = disp_no_group; - new_list->window[i].path = no_path; - new_list->window[i].byte_len = 0; - new_list->window[i].imm_bytes = 0; - } - return; -} - -/* This function allocates and initializes a dispatch window and the - list container holding a pointer to the window. */ - -static dispatch_windows * -allocate_window (void) -{ - dispatch_windows *new_list = XNEW (struct dispatch_windows_s); - new_list->window = XNEWVEC (struct sched_insn_info_s, MAX_INSN + 1); - - return new_list; -} - -/* This routine initializes the dispatch scheduling information. It - initiates building dispatch scheduler tables and constructs the - first dispatch window. */ - -static void -init_dispatch_sched (void) -{ - /* Allocate a dispatch list and a window. */ - dispatch_window_list = allocate_window (); - dispatch_window_list1 = allocate_window (); - init_window (0); - init_window (1); -} - -/* This function returns true if a branch is detected. End of a basic block - does not have to be a branch, but here we assume only branches end a - window. */ - -static bool -is_end_basic_block (enum dispatch_group group) -{ - return group == disp_branch; -} - -/* This function is called when the end of a window processing is reached. */ - -static void -process_end_window (void) -{ - gcc_assert (dispatch_window_list->num_insn <= MAX_INSN); - if (dispatch_window_list->next) - { - gcc_assert (dispatch_window_list1->num_insn <= MAX_INSN); - gcc_assert (dispatch_window_list->window_size - + dispatch_window_list1->window_size <= 48); - init_window (1); - } - init_window (0); -} - -/* Allocates a new dispatch window and adds it to WINDOW_LIST. - WINDOW_NUM is either 0 or 1. A maximum of two windows are generated - for 48 bytes of instructions. Note that these windows are not dispatch - windows that their sizes are DISPATCH_WINDOW_SIZE. */ - -static dispatch_windows * -allocate_next_window (int window_num) -{ - if (window_num == 0) - { - if (dispatch_window_list->next) - init_window (1); - init_window (0); - return dispatch_window_list; - } - - dispatch_window_list->next = dispatch_window_list1; - dispatch_window_list1->prev = dispatch_window_list; - - return dispatch_window_list1; -} - -/* Compute number of immediate operands of an instruction. */ - -static void -find_constant (rtx in_rtx, imm_info *imm_values) -{ - if (INSN_P (in_rtx)) - in_rtx = PATTERN (in_rtx); - subrtx_iterator::array_type array; - FOR_EACH_SUBRTX (iter, array, in_rtx, ALL) - if (const_rtx x = *iter) - switch (GET_CODE (x)) - { - case CONST: - case SYMBOL_REF: - case CONST_INT: - (imm_values->imm)++; - if (x86_64_immediate_operand (CONST_CAST_RTX (x), SImode)) - (imm_values->imm32)++; - else - (imm_values->imm64)++; - break; - - case CONST_DOUBLE: - case CONST_WIDE_INT: - (imm_values->imm)++; - (imm_values->imm64)++; - break; - - case CODE_LABEL: - if (LABEL_KIND (x) == LABEL_NORMAL) - { - (imm_values->imm)++; - (imm_values->imm32)++; - } - break; - - default: - break; - } -} - -/* Return total size of immediate operands of an instruction along with number - of corresponding immediate-operands. It initializes its parameters to zero - befor calling FIND_CONSTANT. - INSN is the input instruction. IMM is the total of immediates. - IMM32 is the number of 32 bit immediates. IMM64 is the number of 64 - bit immediates. */ - -static int -get_num_immediates (rtx_insn *insn, int *imm, int *imm32, int *imm64) -{ - imm_info imm_values = {0, 0, 0}; - - find_constant (insn, &imm_values); - *imm = imm_values.imm; - *imm32 = imm_values.imm32; - *imm64 = imm_values.imm64; - return imm_values.imm32 * 4 + imm_values.imm64 * 8; -} - -/* This function indicates if an operand of an instruction is an - immediate. */ - -static bool -has_immediate (rtx_insn *insn) -{ - int num_imm_operand; - int num_imm32_operand; - int num_imm64_operand; - - if (insn) - return get_num_immediates (insn, &num_imm_operand, &num_imm32_operand, - &num_imm64_operand); - return false; -} - -/* Return single or double path for instructions. */ - -static enum insn_path -get_insn_path (rtx_insn *insn) -{ - enum attr_amdfam10_decode path = get_attr_amdfam10_decode (insn); - - if ((int)path == 0) - return path_single; - - if ((int)path == 1) - return path_double; - - return path_multi; -} - -/* Return insn dispatch group. */ - -static enum dispatch_group -get_insn_group (rtx_insn *insn) -{ - enum dispatch_group group = get_mem_group (insn); - if (group) - return group; - - if (is_branch (insn)) - return disp_branch; - - if (is_cmp (insn)) - return disp_cmp; - - if (has_immediate (insn)) - return disp_imm; - - if (is_prefetch (insn)) - return disp_prefetch; - - return disp_no_group; -} - -/* Count number of GROUP restricted instructions in a dispatch - window WINDOW_LIST. */ - -static int -count_num_restricted (rtx_insn *insn, dispatch_windows *window_list) -{ - enum dispatch_group group = get_insn_group (insn); - int imm_size; - int num_imm_operand; - int num_imm32_operand; - int num_imm64_operand; - - if (group == disp_no_group) - return 0; - - if (group == disp_imm) - { - imm_size = get_num_immediates (insn, &num_imm_operand, &num_imm32_operand, - &num_imm64_operand); - if (window_list->imm_size + imm_size > MAX_IMM_SIZE - || num_imm_operand + window_list->num_imm > MAX_IMM - || (num_imm32_operand > 0 - && (window_list->num_imm_32 + num_imm32_operand > MAX_IMM_32 - || window_list->num_imm_64 * 2 + num_imm32_operand > MAX_IMM_32)) - || (num_imm64_operand > 0 - && (window_list->num_imm_64 + num_imm64_operand > MAX_IMM_64 - || window_list->num_imm_32 + num_imm64_operand * 2 > MAX_IMM_32)) - || (window_list->imm_size + imm_size == MAX_IMM_SIZE - && num_imm64_operand > 0 - && ((window_list->num_imm_64 > 0 - && window_list->num_insn >= 2) - || window_list->num_insn >= 3))) - return BIG; - - return 1; - } - - if ((group == disp_load_store - && (window_list->num_loads >= MAX_LOAD - || window_list->num_stores >= MAX_STORE)) - || ((group == disp_load - || group == disp_prefetch) - && window_list->num_loads >= MAX_LOAD) - || (group == disp_store - && window_list->num_stores >= MAX_STORE)) - return BIG; - - return 1; -} - -/* This function returns true if insn satisfies dispatch rules on the - last window scheduled. */ - -static bool -fits_dispatch_window (rtx_insn *insn) -{ - dispatch_windows *window_list = dispatch_window_list; - dispatch_windows *window_list_next = dispatch_window_list->next; - unsigned int num_restrict; - enum dispatch_group group = get_insn_group (insn); - enum insn_path path = get_insn_path (insn); - int sum; - - /* Make disp_cmp and disp_jcc get scheduled at the latest. These - instructions should be given the lowest priority in the - scheduling process in Haifa scheduler to make sure they will be - scheduled in the same dispatch window as the reference to them. */ - if (group == disp_jcc || group == disp_cmp) - return false; - - /* Check nonrestricted. */ - if (group == disp_no_group || group == disp_branch) - return true; - - /* Get last dispatch window. */ - if (window_list_next) - window_list = window_list_next; - - if (window_list->window_num == 1) - { - sum = window_list->prev->window_size + window_list->window_size; - - if (sum == 32 - || (min_insn_size (insn) + sum) >= 48) - /* Window 1 is full. Go for next window. */ - return true; - } - - num_restrict = count_num_restricted (insn, window_list); - - if (num_restrict > num_allowable_groups[group]) - return false; - - /* See if it fits in the first window. */ - if (window_list->window_num == 0) - { - /* The first widow should have only single and double path - uops. */ - if (path == path_double - && (window_list->num_uops + 2) > MAX_INSN) - return false; - else if (path != path_single) - return false; - } - return true; -} - -/* Add an instruction INSN with NUM_UOPS micro-operations to the - dispatch window WINDOW_LIST. */ - -static void -add_insn_window (rtx_insn *insn, dispatch_windows *window_list, int num_uops) -{ - int byte_len = min_insn_size (insn); - int num_insn = window_list->num_insn; - int imm_size; - sched_insn_info *window = window_list->window; - enum dispatch_group group = get_insn_group (insn); - enum insn_path path = get_insn_path (insn); - int num_imm_operand; - int num_imm32_operand; - int num_imm64_operand; - - if (!window_list->violation && group != disp_cmp - && !fits_dispatch_window (insn)) - window_list->violation = true; - - imm_size = get_num_immediates (insn, &num_imm_operand, &num_imm32_operand, - &num_imm64_operand); - - /* Initialize window with new instruction. */ - window[num_insn].insn = insn; - window[num_insn].byte_len = byte_len; - window[num_insn].group = group; - window[num_insn].path = path; - window[num_insn].imm_bytes = imm_size; - - window_list->window_size += byte_len; - window_list->num_insn = num_insn + 1; - window_list->num_uops = window_list->num_uops + num_uops; - window_list->imm_size += imm_size; - window_list->num_imm += num_imm_operand; - window_list->num_imm_32 += num_imm32_operand; - window_list->num_imm_64 += num_imm64_operand; - - if (group == disp_store) - window_list->num_stores += 1; - else if (group == disp_load - || group == disp_prefetch) - window_list->num_loads += 1; - else if (group == disp_load_store) - { - window_list->num_stores += 1; - window_list->num_loads += 1; - } -} - -/* Adds a scheduled instruction, INSN, to the current dispatch window. - If the total bytes of instructions or the number of instructions in - the window exceed allowable, it allocates a new window. */ - -static void -add_to_dispatch_window (rtx_insn *insn) -{ - int byte_len; - dispatch_windows *window_list; - dispatch_windows *next_list; - dispatch_windows *window0_list; - enum insn_path path; - enum dispatch_group insn_group; - bool insn_fits; - int num_insn; - int num_uops; - int window_num; - int insn_num_uops; - int sum; - - if (INSN_CODE (insn) < 0) - return; - - byte_len = min_insn_size (insn); - window_list = dispatch_window_list; - next_list = window_list->next; - path = get_insn_path (insn); - insn_group = get_insn_group (insn); - - /* Get the last dispatch window. */ - if (next_list) - window_list = dispatch_window_list->next; - - if (path == path_single) - insn_num_uops = 1; - else if (path == path_double) - insn_num_uops = 2; - else - insn_num_uops = (int) path; - - /* If current window is full, get a new window. - Window number zero is full, if MAX_INSN uops are scheduled in it. - Window number one is full, if window zero's bytes plus window - one's bytes is 32, or if the bytes of the new instruction added - to the total makes it greater than 48, or it has already MAX_INSN - instructions in it. */ - num_insn = window_list->num_insn; - num_uops = window_list->num_uops; - window_num = window_list->window_num; - insn_fits = fits_dispatch_window (insn); - - if (num_insn >= MAX_INSN - || num_uops + insn_num_uops > MAX_INSN - || !(insn_fits)) - { - window_num = ~window_num & 1; - window_list = allocate_next_window (window_num); - } - - if (window_num == 0) - { - add_insn_window (insn, window_list, insn_num_uops); - if (window_list->num_insn >= MAX_INSN - && insn_group == disp_branch) - { - process_end_window (); - return; - } - } - else if (window_num == 1) - { - window0_list = window_list->prev; - sum = window0_list->window_size + window_list->window_size; - if (sum == 32 - || (byte_len + sum) >= 48) - { - process_end_window (); - window_list = dispatch_window_list; - } - - add_insn_window (insn, window_list, insn_num_uops); - } - else - gcc_unreachable (); - - if (is_end_basic_block (insn_group)) - { - /* End of basic block is reached do end-basic-block process. */ - process_end_window (); - return; - } -} - -/* Print the dispatch window, WINDOW_NUM, to FILE. */ - -DEBUG_FUNCTION static void -debug_dispatch_window_file (FILE *file, int window_num) -{ - dispatch_windows *list; - int i; - - if (window_num == 0) - list = dispatch_window_list; - else - list = dispatch_window_list1; - - fprintf (file, "Window #%d:\n", list->window_num); - fprintf (file, " num_insn = %d, num_uops = %d, window_size = %d\n", - list->num_insn, list->num_uops, list->window_size); - fprintf (file, " num_imm = %d, num_imm_32 = %d, num_imm_64 = %d, imm_size = %d\n", - list->num_imm, list->num_imm_32, list->num_imm_64, list->imm_size); - - fprintf (file, " num_loads = %d, num_stores = %d\n", list->num_loads, - list->num_stores); - fprintf (file, " insn info:\n"); - - for (i = 0; i < MAX_INSN; i++) - { - if (!list->window[i].insn) - break; - fprintf (file, " group[%d] = %s, insn[%d] = %p, path[%d] = %d byte_len[%d] = %d, imm_bytes[%d] = %d\n", - i, group_name[list->window[i].group], - i, (void *)list->window[i].insn, - i, list->window[i].path, - i, list->window[i].byte_len, - i, list->window[i].imm_bytes); - } -} - -/* Print to stdout a dispatch window. */ - -DEBUG_FUNCTION void -debug_dispatch_window (int window_num) -{ - debug_dispatch_window_file (stdout, window_num); -} - -/* Print INSN dispatch information to FILE. */ - -DEBUG_FUNCTION static void -debug_insn_dispatch_info_file (FILE *file, rtx_insn *insn) -{ - int byte_len; - enum insn_path path; - enum dispatch_group group; - int imm_size; - int num_imm_operand; - int num_imm32_operand; - int num_imm64_operand; - - if (INSN_CODE (insn) < 0) - return; - - byte_len = min_insn_size (insn); - path = get_insn_path (insn); - group = get_insn_group (insn); - imm_size = get_num_immediates (insn, &num_imm_operand, &num_imm32_operand, - &num_imm64_operand); - - fprintf (file, " insn info:\n"); - fprintf (file, " group = %s, path = %d, byte_len = %d\n", - group_name[group], path, byte_len); - fprintf (file, " num_imm = %d, num_imm_32 = %d, num_imm_64 = %d, imm_size = %d\n", - num_imm_operand, num_imm32_operand, num_imm64_operand, imm_size); -} - -/* Print to STDERR the status of the ready list with respect to - dispatch windows. */ - -DEBUG_FUNCTION void -debug_ready_dispatch (void) -{ - int i; - int no_ready = number_in_ready (); - - fprintf (stdout, "Number of ready: %d\n", no_ready); - - for (i = 0; i < no_ready; i++) - debug_insn_dispatch_info_file (stdout, get_ready_element (i)); -} - -/* This routine is the driver of the dispatch scheduler. */ - -static void -do_dispatch (rtx_insn *insn, int mode) -{ - if (mode == DISPATCH_INIT) - init_dispatch_sched (); - else if (mode == ADD_TO_DISPATCH_WINDOW) - add_to_dispatch_window (insn); -} - -/* Return TRUE if Dispatch Scheduling is supported. */ - -static bool -has_dispatch (rtx_insn *insn, int action) -{ - if ((TARGET_BDVER1 || TARGET_BDVER2 || TARGET_BDVER3 - || TARGET_BDVER4 || TARGET_ZNVER1) && flag_dispatch_scheduler) - switch (action) - { - default: - return false; - - case IS_DISPATCH_ON: - return true; - - case IS_CMP: - return is_cmp (insn); - - case DISPATCH_VIOLATION: - return dispatch_violation (); - - case FITS_DISPATCH_WINDOW: - return fits_dispatch_window (insn); - } - - return false; -} /* Implementation of reassociation_width target hook used by reassoc phase to identify parallelism level in reassociated @@ -53509,6 +49689,9 @@ ix86_run_selftests (void) #undef TARGET_CONDITIONAL_REGISTER_USAGE #define TARGET_CONDITIONAL_REGISTER_USAGE ix86_conditional_register_usage +#undef TARGET_CANONICALIZE_COMPARISON +#define TARGET_CANONICALIZE_COMPARISON ix86_canonicalize_comparison + #undef TARGET_LOOP_UNROLL_ADJUST #define TARGET_LOOP_UNROLL_ADJUST ix86_loop_unroll_adjust diff --git a/gcc/config/i386/i386.h b/gcc/config/i386/i386.h index ef88d89cae2fb..04b590c9a6fcc 100644 --- a/gcc/config/i386/i386.h +++ b/gcc/config/i386/i386.h @@ -103,6 +103,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #define TARGET_SGX_P(x) TARGET_ISA_SGX_P(x) #define TARGET_RDPID TARGET_ISA_RDPID #define TARGET_RDPID_P(x) TARGET_ISA_RDPID_P(x) +#define TARGET_GFNI TARGET_ISA_GFNI +#define TARGET_GFNI_P(x) TARGET_ISA_GFNI_P(x) #define TARGET_BMI TARGET_ISA_BMI #define TARGET_BMI_P(x) TARGET_ISA_BMI_P(x) #define TARGET_BMI2 TARGET_ISA_BMI2 @@ -257,6 +259,16 @@ struct processor_costs { const int fsqrt; /* cost of FSQRT instruction. */ /* Specify what algorithm to use for stringops on unknown size. */ + const int sse_op; /* cost of cheap SSE instruction. */ + const int addss; /* cost of ADDSS/SD SUBSS/SD instructions. */ + const int mulss; /* cost of MULSS instructions. */ + const int mulsd; /* cost of MULSD instructions. */ + const int fmass; /* cost of FMASS instructions. */ + const int fmasd; /* cost of FMASD instructions. */ + const int divss; /* cost of DIVSS instructions. */ + const int divsd; /* cost of DIVSD instructions. */ + const int sqrtss; /* cost of SQRTSS instructions. */ + const int sqrtsd; /* cost of SQRTSD instructions. */ const int reassoc_int, reassoc_fp, reassoc_vec_int, reassoc_vec_fp; /* Specify reassociation width for integer, fp, vector integer and vector fp @@ -2603,6 +2615,7 @@ struct GTY(()) machine_function { #define ix86_current_function_calls_tls_descriptor \ (ix86_tls_descriptor_calls_expanded_in_cfun && df_regs_ever_live_p (SP_REG)) #define ix86_static_chain_on_stack (cfun->machine->static_chain_on_stack) +#define ix86_red_zone_size (cfun->machine->frame.red_zone_size) /* Control behavior of x86_file_start. */ #define X86_FILE_START_VERSION_DIRECTIVE false diff --git a/gcc/config/i386/i386.md b/gcc/config/i386/i386.md index 99497a9f65425..8c576a2e0364a 100644 --- a/gcc/config/i386/i386.md +++ b/gcc/config/i386/i386.md @@ -798,7 +798,7 @@ (define_attr "isa" "base,x64,x64_sse4,x64_sse4_noavx,x64_avx,nox64, sse2,sse2_noavx,sse3,sse4,sse4_noavx,avx,noavx, avx2,noavx2,bmi,bmi2,fma4,fma,avx512f,noavx512f, - fma_avx512f,avx512bw,noavx512bw,avx512dq,noavx512dq, + avx512bw,noavx512bw,avx512dq,noavx512dq, avx512vl,noavx512vl,x64_avx512dq,x64_avx512bw" (const_string "base")) @@ -832,8 +832,6 @@ (eq_attr "isa" "fma") (symbol_ref "TARGET_FMA") (eq_attr "isa" "avx512f") (symbol_ref "TARGET_AVX512F") (eq_attr "isa" "noavx512f") (symbol_ref "!TARGET_AVX512F") - (eq_attr "isa" "fma_avx512f") - (symbol_ref "TARGET_FMA || TARGET_AVX512F") (eq_attr "isa" "avx512bw") (symbol_ref "TARGET_AVX512BW") (eq_attr "isa" "noavx512bw") (symbol_ref "!TARGET_AVX512BW") (eq_attr "isa" "avx512dq") (symbol_ref "TARGET_AVX512DQ") @@ -1612,8 +1610,8 @@ (unspec:HI [(compare:CCFP (match_operand:X87MODEF 1 "register_operand" "f") - (match_operator:X87MODEF 3 "float_operator" - [(match_operand:SWI24 2 "memory_operand" "m")]))] + (float:X87MODEF + (match_operand:SWI24 2 "memory_operand" "m")))] UNSPEC_FNSTSW))] "TARGET_80387 && (TARGET_USE_MODE_FIOP @@ -1628,8 +1626,8 @@ [(set (reg:CCFP FLAGS_REG) (compare:CCFP (match_operand:X87MODEF 1 "register_operand" "f") - (match_operator:X87MODEF 3 "float_operator" - [(match_operand:SWI24 2 "memory_operand" "m")]))) + (float:X87MODEF + (match_operand:SWI24 2 "memory_operand" "m")))) (clobber (match_operand:HI 0 "register_operand" "=a"))] "TARGET_80387 && TARGET_SAHF && !TARGET_CMOVE && (TARGET_USE_MODE_FIOP @@ -1640,7 +1638,7 @@ (unspec:HI [(compare:CCFP (match_dup 1) - (match_op_dup 3 [(match_dup 2)]))] + (float:X87MODEF (match_dup 2)))] UNSPEC_FNSTSW)) (set (reg:CC FLAGS_REG) (unspec:CC [(match_dup 0)] UNSPEC_SAHF))] @@ -1685,8 +1683,7 @@ (set_attr "mode" "SI")]) ;; Pentium Pro can do steps 1 through 3 in one go. -;; comi*, ucomi*, fcomi*, ficomi*, fucomi* -;; (these i387 instructions set flags directly) +;; (these instructions set flags directly) (define_mode_iterator FPCMP [CCFP CCFPU]) (define_mode_attr unord [(CCFP "") (CCFPU "u")]) @@ -1698,8 +1695,10 @@ (match_operand:MODEF 1 "register_ssemem_operand" "f,vm")))] "(SSE_FLOAT_MODE_P (mode) && TARGET_SSE_MATH) || (TARGET_80387 && TARGET_CMOVE)" - "* return output_fp_compare (insn, operands, true, - mode == CCFPUmode);" + "@ + * return output_fp_compare (insn, operands, true, \ + mode == CCFPUmode); + %vcomi\t{%1, %0|%0, %1}" [(set_attr "type" "fcmp,ssecomi") (set_attr "prefix" "orig,maybe_vex") (set_attr "mode" "") @@ -6264,7 +6263,7 @@ (set_attr "mode" "")]) (define_insn "addqi_ext_1" - [(set (zero_extract:SI (match_operand 0 "ext_register_operand" "=Q,Q") + [(set (zero_extract:SI (match_operand 0 "ext_register_operand" "+Q,Q") (const_int 8) (const_int 8)) (subreg:SI @@ -6275,7 +6274,8 @@ (const_int 8)) 0) (match_operand:QI 2 "general_operand" "QnBc,m")) 0)) (clobber (reg:CC FLAGS_REG))] - "" + "/* FIXME: without this LRA can't reload this pattern, see PR82524. */ + rtx_equal_p (operands[0], operands[1])" { switch (get_attr_type (insn)) { @@ -6300,7 +6300,7 @@ (set_attr "mode" "QI")]) (define_insn "*addqi_ext_2" - [(set (zero_extract:SI (match_operand 0 "ext_register_operand" "=Q") + [(set (zero_extract:SI (match_operand 0 "ext_register_operand" "+Q") (const_int 8) (const_int 8)) (subreg:SI @@ -6314,7 +6314,9 @@ (const_int 8) (const_int 8)) 0)) 0)) (clobber (reg:CC FLAGS_REG))] - "" + "/* FIXME: without this LRA can't reload this pattern, see PR82524. */ + rtx_equal_p (operands[0], operands[1]) + || rtx_equal_p (operands[0], operands[2])" "add{b}\t{%h2, %h0|%h0, %h2}" [(set_attr "type" "alu") (set_attr "mode" "QI")]) @@ -6762,6 +6764,17 @@ [(set_attr "type" "alu") (set_attr "mode" "")]) +(define_peephole2 + [(parallel + [(set (reg:CC FLAGS_REG) + (compare:CC (match_operand:SWI 0 "general_reg_operand") + (match_operand:SWI 1 "general_gr_operand"))) + (set (match_dup 0) + (minus:SWI (match_dup 0) (match_dup 1)))])] + "find_regno_note (peep2_next_insn (0), REG_UNUSED, REGNO (operands[0])) != 0" + [(set (reg:CC FLAGS_REG) + (compare:CC (match_dup 0) (match_dup 1)))]) + (define_insn "*subsi_3_zext" [(set (reg FLAGS_REG) (compare (match_operand:SI 1 "register_operand" "0") @@ -6867,6 +6880,19 @@ (set_attr "pent_pair" "pu") (set_attr "mode" "SI")]) +(define_insn "sub3_carry_ccgz" + [(set (reg:CCGZ FLAGS_REG) + (compare:CCGZ + (match_operand:DWIH 1 "register_operand" "0") + (plus:DWIH + (ltu:DWIH (reg:CC FLAGS_REG) (const_int 0)) + (match_operand:DWIH 2 "x86_64_general_operand" "rme")))) + (clobber (match_scratch:DWIH 0 "=r"))] + "" + "sbb{}\t{%2, %0|%0, %2}" + [(set_attr "type" "alu") + (set_attr "mode" "")]) + (define_insn "subborrow" [(set (reg:CCC FLAGS_REG) (compare:CCC @@ -8998,7 +9024,7 @@ (set_attr "mode" "QI")]) (define_insn "andqi_ext_1" - [(set (zero_extract:SI (match_operand 0 "ext_register_operand" "=Q,Q") + [(set (zero_extract:SI (match_operand 0 "ext_register_operand" "+Q,Q") (const_int 8) (const_int 8)) (subreg:SI @@ -9009,7 +9035,8 @@ (const_int 8)) 0) (match_operand:QI 2 "general_operand" "QnBc,m")) 0)) (clobber (reg:CC FLAGS_REG))] - "" + "/* FIXME: without this LRA can't reload this pattern, see PR82524. */ + rtx_equal_p (operands[0], operands[1])" "and{b}\t{%2, %h0|%h0, %2}" [(set_attr "isa" "*,nox64") (set_attr "type" "alu") @@ -9027,7 +9054,7 @@ (const_int 8)) 0) (match_operand:QI 2 "general_operand" "QnBc,m")) (const_int 0))) - (set (zero_extract:SI (match_operand 0 "ext_register_operand" "=Q,Q") + (set (zero_extract:SI (match_operand 0 "ext_register_operand" "+Q,Q") (const_int 8) (const_int 8)) (subreg:SI @@ -9037,14 +9064,16 @@ (const_int 8) (const_int 8)) 0) (match_dup 2)) 0))] - "ix86_match_ccmode (insn, CCNOmode)" + "ix86_match_ccmode (insn, CCNOmode) + /* FIXME: without this LRA can't reload this pattern, see PR82524. */ + && rtx_equal_p (operands[0], operands[1])" "and{b}\t{%2, %h0|%h0, %2}" [(set_attr "isa" "*,nox64") (set_attr "type" "alu") (set_attr "mode" "QI")]) (define_insn "*andqi_ext_2" - [(set (zero_extract:SI (match_operand 0 "ext_register_operand" "=Q") + [(set (zero_extract:SI (match_operand 0 "ext_register_operand" "+Q") (const_int 8) (const_int 8)) (subreg:SI @@ -9058,7 +9087,9 @@ (const_int 8) (const_int 8)) 0)) 0)) (clobber (reg:CC FLAGS_REG))] - "" + "/* FIXME: without this LRA can't reload this pattern, see PR82524. */ + rtx_equal_p (operands[0], operands[1]) + || rtx_equal_p (operands[0], operands[2])" "and{b}\t{%h2, %h0|%h0, %h2}" [(set_attr "type" "alu") (set_attr "mode" "QI")]) @@ -9431,7 +9462,7 @@ (set_attr "mode" "")]) (define_insn "*qi_ext_1" - [(set (zero_extract:SI (match_operand 0 "ext_register_operand" "=Q,Q") + [(set (zero_extract:SI (match_operand 0 "ext_register_operand" "+Q,Q") (const_int 8) (const_int 8)) (subreg:SI @@ -9442,14 +9473,16 @@ (const_int 8)) 0) (match_operand:QI 2 "general_operand" "QnBc,m")) 0)) (clobber (reg:CC FLAGS_REG))] - "!TARGET_PARTIAL_REG_STALL || optimize_function_for_size_p (cfun)" + "(!TARGET_PARTIAL_REG_STALL || optimize_function_for_size_p (cfun)) + /* FIXME: without this LRA can't reload this pattern, see PR82524. */ + && rtx_equal_p (operands[0], operands[1])" "{b}\t{%2, %h0|%h0, %2}" [(set_attr "isa" "*,nox64") (set_attr "type" "alu") (set_attr "mode" "QI")]) (define_insn "*qi_ext_2" - [(set (zero_extract:SI (match_operand 0 "ext_register_operand" "=Q") + [(set (zero_extract:SI (match_operand 0 "ext_register_operand" "+Q") (const_int 8) (const_int 8)) (subreg:SI @@ -9463,7 +9496,10 @@ (const_int 8) (const_int 8)) 0)) 0)) (clobber (reg:CC FLAGS_REG))] - "!TARGET_PARTIAL_REG_STALL || optimize_function_for_size_p (cfun)" + "(!TARGET_PARTIAL_REG_STALL || optimize_function_for_size_p (cfun)) + /* FIXME: without this LRA can't reload this pattern, see PR82524. */ + && (rtx_equal_p (operands[0], operands[1]) + || rtx_equal_p (operands[0], operands[2]))" "{b}\t{%h2, %h0|%h0, %h2}" [(set_attr "type" "alu") (set_attr "mode" "QI")]) @@ -9552,7 +9588,7 @@ (const_int 8)) 0) (match_operand:QI 2 "general_operand" "QnBc,m")) (const_int 0))) - (set (zero_extract:SI (match_operand 0 "ext_register_operand" "=Q,Q") + (set (zero_extract:SI (match_operand 0 "ext_register_operand" "+Q,Q") (const_int 8) (const_int 8)) (subreg:SI @@ -9562,7 +9598,9 @@ (const_int 8) (const_int 8)) 0) (match_dup 2)) 0))] - "ix86_match_ccmode (insn, CCNOmode)" + "ix86_match_ccmode (insn, CCNOmode) + /* FIXME: without this LRA can't reload this pattern, see PR82524. */ + && rtx_equal_p (operands[0], operands[1])" "xor{b}\t{%2, %h0|%h0, %2}" [(set_attr "isa" "*,nox64") (set_attr "type" "alu") @@ -10228,6 +10266,26 @@ (clobber (reg:CC FLAGS_REG))])] "operands[2] = gen_lowpart (QImode, operands[2]);") +(define_insn_and_split "*ashl3_mask_1" + [(set (match_operand:SWI48 0 "nonimmediate_operand") + (ashift:SWI48 + (match_operand:SWI48 1 "nonimmediate_operand") + (and:QI + (match_operand:QI 2 "register_operand") + (match_operand:QI 3 "const_int_operand")))) + (clobber (reg:CC FLAGS_REG))] + "ix86_binary_operator_ok (ASHIFT, mode, operands) + && (INTVAL (operands[3]) & (GET_MODE_BITSIZE (mode)-1)) + == GET_MODE_BITSIZE (mode)-1 + && can_create_pseudo_p ()" + "#" + "&& 1" + [(parallel + [(set (match_dup 0) + (ashift:SWI48 (match_dup 1) + (match_dup 2))) + (clobber (reg:CC FLAGS_REG))])]) + (define_insn "*bmi2_ashl3_1" [(set (match_operand:SWI48 0 "register_operand" "=r") (ashift:SWI48 (match_operand:SWI48 1 "nonimmediate_operand" "rm") @@ -10728,6 +10786,26 @@ (clobber (reg:CC FLAGS_REG))])] "operands[2] = gen_lowpart (QImode, operands[2]);") +(define_insn_and_split "*3_mask_1" + [(set (match_operand:SWI48 0 "nonimmediate_operand") + (any_shiftrt:SWI48 + (match_operand:SWI48 1 "nonimmediate_operand") + (and:QI + (match_operand:QI 2 "register_operand") + (match_operand:QI 3 "const_int_operand")))) + (clobber (reg:CC FLAGS_REG))] + "ix86_binary_operator_ok (, mode, operands) + && (INTVAL (operands[3]) & (GET_MODE_BITSIZE (mode)-1)) + == GET_MODE_BITSIZE (mode)-1 + && can_create_pseudo_p ()" + "#" + "&& 1" + [(parallel + [(set (match_dup 0) + (any_shiftrt:SWI48 (match_dup 1) + (match_dup 2))) + (clobber (reg:CC FLAGS_REG))])]) + (define_insn_and_split "*3_doubleword" [(set (match_operand:DWI 0 "register_operand" "=&r") (any_shiftrt:DWI (match_operand:DWI 1 "register_operand" "0") @@ -11187,6 +11265,26 @@ (clobber (reg:CC FLAGS_REG))])] "operands[2] = gen_lowpart (QImode, operands[2]);") +(define_insn_and_split "*3_mask_1" + [(set (match_operand:SWI48 0 "nonimmediate_operand") + (any_rotate:SWI48 + (match_operand:SWI48 1 "nonimmediate_operand") + (and:QI + (match_operand:QI 2 "register_operand") + (match_operand:QI 3 "const_int_operand")))) + (clobber (reg:CC FLAGS_REG))] + "ix86_binary_operator_ok (, mode, operands) + && (INTVAL (operands[3]) & (GET_MODE_BITSIZE (mode)-1)) + == GET_MODE_BITSIZE (mode)-1 + && can_create_pseudo_p ()" + "#" + "&& 1" + [(parallel + [(set (match_dup 0) + (any_rotate:SWI48 (match_dup 1) + (match_dup 2))) + (clobber (reg:CC FLAGS_REG))])]) + ;; Implement rotation using two double-precision ;; shift instructions and a scratch register. @@ -11494,6 +11592,30 @@ (clobber (reg:CC FLAGS_REG))])] "operands[1] = gen_lowpart (QImode, operands[1]);") +(define_insn_and_split "*_mask_1" + [(set (match_operand:SWI48 0 "register_operand") + (any_or:SWI48 + (ashift:SWI48 + (const_int 1) + (and:QI + (match_operand:QI 1 "register_operand") + (match_operand:QI 2 "const_int_operand"))) + (match_operand:SWI48 3 "register_operand"))) + (clobber (reg:CC FLAGS_REG))] + "TARGET_USE_BT + && (INTVAL (operands[2]) & (GET_MODE_BITSIZE (mode)-1)) + == GET_MODE_BITSIZE (mode)-1 + && can_create_pseudo_p ()" + "#" + "&& 1" + [(parallel + [(set (match_dup 0) + (any_or:SWI48 + (ashift:SWI48 (const_int 1) + (match_dup 1)) + (match_dup 3))) + (clobber (reg:CC FLAGS_REG))])]) + (define_insn "*btr" [(set (match_operand:SWI48 0 "register_operand" "=r") (and:SWI48 @@ -11535,6 +11657,30 @@ (clobber (reg:CC FLAGS_REG))])] "operands[1] = gen_lowpart (QImode, operands[1]);") +(define_insn_and_split "*btr_mask_1" + [(set (match_operand:SWI48 0 "register_operand") + (and:SWI48 + (rotate:SWI48 + (const_int -2) + (and:QI + (match_operand:QI 1 "register_operand") + (match_operand:QI 2 "const_int_operand"))) + (match_operand:SWI48 3 "register_operand"))) + (clobber (reg:CC FLAGS_REG))] + "TARGET_USE_BT + && (INTVAL (operands[2]) & (GET_MODE_BITSIZE (mode)-1)) + == GET_MODE_BITSIZE (mode)-1 + && can_create_pseudo_p ()" + "#" + "&& 1" + [(parallel + [(set (match_dup 0) + (and:SWI48 + (rotate:SWI48 (const_int -2) + (match_dup 1)) + (match_dup 3))) + (clobber (reg:CC FLAGS_REG))])]) + ;; These instructions are never faster than the corresponding ;; and/ior/xor operations when using immediate operand, so with ;; 32-bit there's no point. But in 64-bit, we can't hold the @@ -11963,7 +12109,7 @@ ;; Basic conditional jump instructions. ;; We ignore the overflow flag for signed branch instructions. -(define_insn "*jcc_1" +(define_insn "*jcc" [(set (pc) (if_then_else (match_operator 1 "ix86_comparison_operator" [(reg FLAGS_REG) (const_int 0)]) @@ -11983,26 +12129,6 @@ (const_int 6))) (set_attr "maybe_prefix_bnd" "1")]) -(define_insn "*jcc_2" - [(set (pc) - (if_then_else (match_operator 1 "ix86_comparison_operator" - [(reg FLAGS_REG) (const_int 0)]) - (pc) - (label_ref (match_operand 0))))] - "" - "%!%+j%c1\t%l0" - [(set_attr "type" "ibr") - (set_attr "modrm" "0") - (set (attr "length") - (if_then_else - (and (ge (minus (match_dup 0) (pc)) - (const_int -126)) - (lt (minus (match_dup 0) (pc)) - (const_int 128))) - (const_int 2) - (const_int 6))) - (set_attr "maybe_prefix_bnd" "1")]) - ;; In general it is not safe to assume too much about CCmode registers, ;; so simplify-rtx stops when it sees a second one. Under certain ;; conditions this is safe on x86, so help combine not create @@ -12052,211 +12178,6 @@ if (! ix86_comparison_operator (operands[0], VOIDmode)) FAIL; }) - -;; Define combination compare-and-branch fp compare instructions to help -;; combine. - -(define_insn "*jcc_0_i387" - [(set (pc) - (if_then_else (match_operator:CCFP 0 "ix86_fp_comparison_operator" - [(match_operand:X87MODEF 1 "register_operand" "f") - (match_operand:X87MODEF 2 "const0_operand")]) - (label_ref (match_operand 3)) - (pc))) - (clobber (reg:CCFP FPSR_REG)) - (clobber (reg:CCFP FLAGS_REG)) - (clobber (match_scratch:HI 4 "=a"))] - "TARGET_80387 && !TARGET_CMOVE" - "#") - -(define_insn "*jcc_0_r_i387" - [(set (pc) - (if_then_else (match_operator:CCFP 0 "ix86_fp_comparison_operator" - [(match_operand:X87MODEF 1 "register_operand" "f") - (match_operand:X87MODEF 2 "const0_operand")]) - (pc) - (label_ref (match_operand 3)))) - (clobber (reg:CCFP FPSR_REG)) - (clobber (reg:CCFP FLAGS_REG)) - (clobber (match_scratch:HI 4 "=a"))] - "TARGET_80387 && !TARGET_CMOVE" - "#") - -(define_insn "*jccxf_i387" - [(set (pc) - (if_then_else (match_operator:CCFP 0 "ix86_fp_comparison_operator" - [(match_operand:XF 1 "register_operand" "f") - (match_operand:XF 2 "register_operand" "f")]) - (label_ref (match_operand 3)) - (pc))) - (clobber (reg:CCFP FPSR_REG)) - (clobber (reg:CCFP FLAGS_REG)) - (clobber (match_scratch:HI 4 "=a"))] - "TARGET_80387 && !TARGET_CMOVE" - "#") - -(define_insn "*jccxf_r_i387" - [(set (pc) - (if_then_else (match_operator:CCFP 0 "ix86_fp_comparison_operator" - [(match_operand:XF 1 "register_operand" "f") - (match_operand:XF 2 "register_operand" "f")]) - (pc) - (label_ref (match_operand 3)))) - (clobber (reg:CCFP FPSR_REG)) - (clobber (reg:CCFP FLAGS_REG)) - (clobber (match_scratch:HI 4 "=a"))] - "TARGET_80387 && !TARGET_CMOVE" - "#") - -(define_insn "*jcc_i387" - [(set (pc) - (if_then_else (match_operator:CCFP 0 "ix86_fp_comparison_operator" - [(match_operand:MODEF 1 "register_operand" "f") - (match_operand:MODEF 2 "nonimmediate_operand" "fm")]) - (label_ref (match_operand 3)) - (pc))) - (clobber (reg:CCFP FPSR_REG)) - (clobber (reg:CCFP FLAGS_REG)) - (clobber (match_scratch:HI 4 "=a"))] - "TARGET_80387 && !TARGET_CMOVE" - "#") - -(define_insn "*jcc_r_i387" - [(set (pc) - (if_then_else (match_operator:CCFP 0 "ix86_fp_comparison_operator" - [(match_operand:MODEF 1 "register_operand" "f") - (match_operand:MODEF 2 "nonimmediate_operand" "fm")]) - (pc) - (label_ref (match_operand 3)))) - (clobber (reg:CCFP FPSR_REG)) - (clobber (reg:CCFP FLAGS_REG)) - (clobber (match_scratch:HI 4 "=a"))] - "TARGET_80387 && !TARGET_CMOVE" - "#") - -(define_insn "*jccu_i387" - [(set (pc) - (if_then_else (match_operator:CCFPU 0 "ix86_fp_comparison_operator" - [(match_operand:X87MODEF 1 "register_operand" "f") - (match_operand:X87MODEF 2 "register_operand" "f")]) - (label_ref (match_operand 3)) - (pc))) - (clobber (reg:CCFP FPSR_REG)) - (clobber (reg:CCFP FLAGS_REG)) - (clobber (match_scratch:HI 4 "=a"))] - "TARGET_80387 && !TARGET_CMOVE" - "#") - -(define_insn "*jccu_r_i387" - [(set (pc) - (if_then_else (match_operator:CCFPU 0 "ix86_fp_comparison_operator" - [(match_operand:X87MODEF 1 "register_operand" "f") - (match_operand:X87MODEF 2 "register_operand" "f")]) - (pc) - (label_ref (match_operand 3)))) - (clobber (reg:CCFP FPSR_REG)) - (clobber (reg:CCFP FLAGS_REG)) - (clobber (match_scratch:HI 4 "=a"))] - "TARGET_80387 && !TARGET_CMOVE" - "#") - -(define_split - [(set (pc) - (if_then_else (match_operator 0 "ix86_fp_comparison_operator" - [(match_operand:X87MODEF 1 "register_operand") - (match_operand:X87MODEF 2 "nonimmediate_operand")]) - (match_operand 3) - (match_operand 4))) - (clobber (reg:CCFP FPSR_REG)) - (clobber (reg:CCFP FLAGS_REG))] - "TARGET_80387 && !TARGET_CMOVE - && reload_completed" - [(const_int 0)] -{ - ix86_split_fp_branch (GET_CODE (operands[0]), operands[1], operands[2], - operands[3], operands[4], NULL_RTX); - DONE; -}) - -(define_split - [(set (pc) - (if_then_else (match_operator 0 "ix86_fp_comparison_operator" - [(match_operand:X87MODEF 1 "register_operand") - (match_operand:X87MODEF 2 "general_operand")]) - (match_operand 3) - (match_operand 4))) - (clobber (reg:CCFP FPSR_REG)) - (clobber (reg:CCFP FLAGS_REG)) - (clobber (match_scratch:HI 5))] - "TARGET_80387 && !TARGET_CMOVE - && reload_completed" - [(const_int 0)] -{ - ix86_split_fp_branch (GET_CODE (operands[0]), operands[1], operands[2], - operands[3], operands[4], operands[5]); - DONE; -}) - -;; The order of operands in *jcc__i387 is forced by combine in -;; simplify_comparison () function. Float operator is treated as RTX_OBJ -;; with a precedence over other operators and is always put in the first -;; place. Swap condition and operands to match ficom instruction. - -(define_insn "*jcc__i387" - [(set (pc) - (if_then_else - (match_operator:CCFP 0 "ix86_swapped_fp_comparison_operator" - [(match_operator:X87MODEF 1 "float_operator" - [(match_operand:SWI24 2 "nonimmediate_operand" "m")]) - (match_operand:X87MODEF 3 "register_operand" "f")]) - (label_ref (match_operand 4)) - (pc))) - (clobber (reg:CCFP FPSR_REG)) - (clobber (reg:CCFP FLAGS_REG)) - (clobber (match_scratch:HI 5 "=a"))] - "TARGET_80387 && !TARGET_CMOVE - && (TARGET_USE_MODE_FIOP - || optimize_function_for_size_p (cfun))" - "#") - -(define_insn "*jcc__r_i387" - [(set (pc) - (if_then_else - (match_operator:CCFP 0 "ix86_swapped_fp_comparison_operator" - [(match_operator:X87MODEF 1 "float_operator" - [(match_operand:SWI24 2 "nonimmediate_operand" "m")]) - (match_operand:X87MODEF 3 "register_operand" "f")]) - (pc) - (label_ref (match_operand 4)))) - (clobber (reg:CCFP FPSR_REG)) - (clobber (reg:CCFP FLAGS_REG)) - (clobber (match_scratch:HI 5 "=a"))] - "TARGET_80387 && !TARGET_CMOVE - && (TARGET_USE_MODE_FIOP - || optimize_function_for_size_p (cfun))" - "#") - -(define_split - [(set (pc) - (if_then_else - (match_operator:CCFP 0 "ix86_swapped_fp_comparison_operator" - [(match_operator:X87MODEF 1 "float_operator" - [(match_operand:SWI24 2 "memory_operand")]) - (match_operand:X87MODEF 3 "register_operand")]) - (match_operand 4) - (match_operand 5))) - (clobber (reg:CCFP FPSR_REG)) - (clobber (reg:CCFP FLAGS_REG)) - (clobber (match_scratch:HI 6))] - "TARGET_80387 && !TARGET_CMOVE - && reload_completed" - [(const_int 0)] -{ - ix86_split_fp_branch (swap_condition (GET_CODE (operands[0])), operands[3], - gen_rtx_FLOAT (GET_MODE (operands[1]), operands[2]), - operands[4], operands[5], operands[6]); - DONE; -}) ;; Unconditional and other jump instructions @@ -12388,6 +12309,34 @@ ix86_expand_clear (operands[3]); }) +(define_peephole2 + [(set (reg FLAGS_REG) (match_operand 0)) + (parallel [(set (reg FLAGS_REG) (match_operand 1)) + (match_operand 5)]) + (set (match_operand:QI 2 "register_operand") + (match_operator:QI 3 "ix86_comparison_operator" + [(reg FLAGS_REG) (const_int 0)])) + (set (match_operand 4 "any_QIreg_operand") + (zero_extend (match_dup 2)))] + "(peep2_reg_dead_p (4, operands[2]) + || operands_match_p (operands[2], operands[4])) + && ! reg_overlap_mentioned_p (operands[4], operands[0]) + && ! reg_overlap_mentioned_p (operands[4], operands[1]) + && ! reg_set_p (operands[4], operands[5]) + && refers_to_regno_p (FLAGS_REG, operands[1], (rtx *)NULL) + && peep2_regno_dead_p (0, FLAGS_REG)" + [(set (match_dup 6) (match_dup 0)) + (parallel [(set (match_dup 7) (match_dup 1)) + (match_dup 5)]) + (set (strict_low_part (match_dup 8)) + (match_dup 3))] +{ + operands[6] = gen_rtx_REG (GET_MODE (operands[0]), FLAGS_REG); + operands[7] = gen_rtx_REG (GET_MODE (operands[1]), FLAGS_REG); + operands[8] = gen_lowpart (QImode, operands[4]); + ix86_expand_clear (operands[4]); +}) + ;; Similar, but match zero extend with andsi3. (define_peephole2 @@ -12433,6 +12382,35 @@ operands[6] = gen_lowpart (QImode, operands[3]); ix86_expand_clear (operands[3]); }) + +(define_peephole2 + [(set (reg FLAGS_REG) (match_operand 0)) + (parallel [(set (reg FLAGS_REG) (match_operand 1)) + (match_operand 5)]) + (set (match_operand:QI 2 "register_operand") + (match_operator:QI 3 "ix86_comparison_operator" + [(reg FLAGS_REG) (const_int 0)])) + (parallel [(set (match_operand 4 "any_QIreg_operand") + (zero_extend (match_dup 2))) + (clobber (reg:CC FLAGS_REG))])] + "(peep2_reg_dead_p (4, operands[2]) + || operands_match_p (operands[2], operands[4])) + && ! reg_overlap_mentioned_p (operands[4], operands[0]) + && ! reg_overlap_mentioned_p (operands[4], operands[1]) + && ! reg_set_p (operands[4], operands[5]) + && refers_to_regno_p (FLAGS_REG, operands[1], (rtx *)NULL) + && peep2_regno_dead_p (0, FLAGS_REG)" + [(set (match_dup 6) (match_dup 0)) + (parallel [(set (match_dup 7) (match_dup 1)) + (match_dup 5)]) + (set (strict_low_part (match_dup 8)) + (match_dup 3))] +{ + operands[6] = gen_rtx_REG (GET_MODE (operands[0]), FLAGS_REG); + operands[7] = gen_rtx_REG (GET_MODE (operands[1]), FLAGS_REG); + operands[8] = gen_lowpart (QImode, operands[4]); + ix86_expand_clear (operands[4]); +}) ;; Call instructions. @@ -18916,7 +18894,7 @@ (clobber (mem:BLK (scratch)))])] "(TARGET_SINGLE_PUSH || optimize_insn_for_size_p ()) && INTVAL (operands[0]) == -GET_MODE_SIZE (word_mode) - && !ix86_using_red_zone ()" + && ix86_red_zone_size == 0" [(clobber (match_dup 1)) (parallel [(set (mem:W (pre_dec:P (reg:P SP_REG))) (match_dup 1)) (clobber (mem:BLK (scratch)))])]) @@ -18930,7 +18908,7 @@ (clobber (mem:BLK (scratch)))])] "(TARGET_DOUBLE_PUSH || optimize_insn_for_size_p ()) && INTVAL (operands[0]) == -2*GET_MODE_SIZE (word_mode) - && !ix86_using_red_zone ()" + && ix86_red_zone_size == 0" [(clobber (match_dup 1)) (set (mem:W (pre_dec:P (reg:P SP_REG))) (match_dup 1)) (parallel [(set (mem:W (pre_dec:P (reg:P SP_REG))) (match_dup 1)) @@ -18945,7 +18923,7 @@ (clobber (reg:CC FLAGS_REG))])] "(TARGET_SINGLE_PUSH || optimize_insn_for_size_p ()) && INTVAL (operands[0]) == -GET_MODE_SIZE (word_mode) - && !ix86_using_red_zone ()" + && ix86_red_zone_size == 0" [(clobber (match_dup 1)) (set (mem:W (pre_dec:P (reg:P SP_REG))) (match_dup 1))]) @@ -18957,7 +18935,7 @@ (clobber (reg:CC FLAGS_REG))])] "(TARGET_DOUBLE_PUSH || optimize_insn_for_size_p ()) && INTVAL (operands[0]) == -2*GET_MODE_SIZE (word_mode) - && !ix86_using_red_zone ()" + && ix86_red_zone_size == 0" [(clobber (match_dup 1)) (set (mem:W (pre_dec:P (reg:P SP_REG))) (match_dup 1)) (set (mem:W (pre_dec:P (reg:P SP_REG))) (match_dup 1))]) diff --git a/gcc/config/i386/i386.opt b/gcc/config/i386/i386.opt index 9064bf09eb535..42d44b2eb4a9d 100644 --- a/gcc/config/i386/i386.opt +++ b/gcc/config/i386/i386.opt @@ -753,6 +753,10 @@ mrdpid Target Report Mask(ISA_RDPID) Var(ix86_isa_flags2) Save Support RDPID built-in functions and code generation. +mgfni +Target Report Mask(ISA_GFNI) Var(ix86_isa_flags2) Save +Support GFNI built-in functions and code generation. + mbmi Target Report Mask(ISA_BMI) Var(ix86_isa_flags) Save Support BMI built-in functions and code generation. diff --git a/gcc/config/i386/ia32intrin.h b/gcc/config/i386/ia32intrin.h index 5f954fce85eec..1f4e484d55b82 100644 --- a/gcc/config/i386/ia32intrin.h +++ b/gcc/config/i386/ia32intrin.h @@ -147,7 +147,8 @@ extern __inline unsigned int __attribute__((__gnu_inline__, __always_inline__, __artificial__)) __rold (unsigned int __X, int __C) { - return (__X << __C) | (__X >> (32 - __C)); + __C &= 31; + return (__X << __C) | (__X >> (-__C & 31)); } /* 8bit ror */ @@ -171,7 +172,8 @@ extern __inline unsigned int __attribute__((__gnu_inline__, __always_inline__, __artificial__)) __rord (unsigned int __X, int __C) { - return (__X >> __C) | (__X << (32 - __C)); + __C &= 31; + return (__X >> __C) | (__X << (-__C & 31)); } /* Pause */ @@ -239,7 +241,8 @@ extern __inline unsigned long long __attribute__((__gnu_inline__, __always_inline__, __artificial__)) __rolq (unsigned long long __X, int __C) { - return (__X << __C) | (__X >> (64 - __C)); + __C &= 63; + return (__X << __C) | (__X >> (-__C & 63)); } /* 64bit ror */ @@ -247,7 +250,8 @@ extern __inline unsigned long long __attribute__((__gnu_inline__, __always_inline__, __artificial__)) __rorq (unsigned long long __X, int __C) { - return (__X >> __C) | (__X << (64 - __C)); + __C &= 63; + return (__X >> __C) | (__X << (-__C & 63)); } /* Read flags register */ diff --git a/gcc/config/i386/predicates.md b/gcc/config/i386/predicates.md index 4e023afb1107c..4f3f1560f458e 100644 --- a/gcc/config/i386/predicates.md +++ b/gcc/config/i386/predicates.md @@ -1329,14 +1329,20 @@ switch (code) { case EQ: case NE: + if (inmode == CCGZmode) + return false; return true; - case LT: case GE: + case GE: case LT: if (inmode == CCmode || inmode == CCGCmode - || inmode == CCGOCmode || inmode == CCNOmode) + || inmode == CCGOCmode || inmode == CCNOmode || inmode == CCGZmode) return true; return false; - case LTU: case GTU: case LEU: case GEU: - if (inmode == CCmode || inmode == CCCmode) + case GEU: case LTU: + if (inmode == CCGZmode) + return true; + /* FALLTHRU */ + case GTU: case LEU: + if (inmode == CCmode || inmode == CCCmode || inmode == CCGZmode) return true; return false; case ORDERED: case UNORDERED: @@ -1387,19 +1393,6 @@ (match_operand 0 "comparison_operator") (match_operand 0 "ix86_trivial_fp_comparison_operator"))) -;; Same as above, but for swapped comparison used in *jcc__i387. -(define_predicate "ix86_swapped_fp_comparison_operator" - (match_operand 0 "comparison_operator") -{ - enum rtx_code code = GET_CODE (op); - bool ret; - - PUT_CODE (op, swap_condition (code)); - ret = ix86_fp_comparison_operator (op, mode); - PUT_CODE (op, code); - return ret; -}) - ;; Nearly general operand, but accept any const_double, since we wish ;; to be able to drop them into memory rather than have them get pulled ;; into registers. @@ -1423,10 +1416,6 @@ (define_predicate "plusminuslogic_operator" (match_code "plus,minus,and,ior,xor")) -;; Return true if this is a float extend operation. -(define_predicate "float_operator" - (match_code "float")) - ;; Return true for ARITHMETIC_P. (define_predicate "arith_or_logical_operator" (match_code "plus,mult,and,ior,xor,smin,smax,umin,umax,compare,minus,div, diff --git a/gcc/config/i386/sse.md b/gcc/config/i386/sse.md index 0c26bd13d019c..35e4bc95c4a0b 100644 --- a/gcc/config/i386/sse.md +++ b/gcc/config/i386/sse.md @@ -403,11 +403,19 @@ [(V8SI "TARGET_AVX2") V4SI (V4DI "TARGET_AVX2") V2DI]) +(define_mode_iterator VI248_AVX2 + [(V16HI "TARGET_AVX2") V8HI + (V8SI "TARGET_AVX2") V4SI + (V4DI "TARGET_AVX2") V2DI]) + (define_mode_iterator VI248_AVX2_8_AVX512F_24_AVX512BW [(V32HI "TARGET_AVX512BW") (V16HI "TARGET_AVX2") V8HI (V16SI "TARGET_AVX512BW") (V8SI "TARGET_AVX2") V4SI (V8DI "TARGET_AVX512F") (V4DI "TARGET_AVX2") V2DI]) +(define_mode_iterator VI248_AVX512BW + [(V32HI "TARGET_AVX512BW") V16SI V8DI]) + (define_mode_iterator VI248_AVX512BW_AVX512VL [(V32HI "TARGET_AVX512BW") (V4DI "TARGET_AVX512VL") V16SI V8DI]) @@ -418,6 +426,11 @@ V8SI V4SI V2DI]) +(define_mode_iterator VI248_AVX512BW_2 + [(V16HI "TARGET_AVX512BW") (V8HI "TARGET_AVX512BW") + V8SI V4SI + V4DI V2DI]) + (define_mode_iterator VI48_AVX512F [(V16SI "TARGET_AVX512F") V8SI V4SI (V8DI "TARGET_AVX512F") V4DI V2DI]) @@ -2522,7 +2535,7 @@ (set_attr "prefix" "evex") (set_attr "mode" "")]) -(define_insn "reduces" +(define_insn "reduces" [(set (match_operand:VF_128 0 "register_operand" "=v") (vec_merge:VF_128 (unspec:VF_128 @@ -2533,7 +2546,7 @@ (match_dup 1) (const_int 1)))] "TARGET_AVX512DQ" - "vreduce\t{%3, %2, %1, %0|%0, %1, %2, %3}" + "vreduce\t{%3, %2, %1, %0|%0, %1, %2, %3}" [(set_attr "type" "sse") (set_attr "prefix" "evex") (set_attr "mode" "")]) @@ -3700,8 +3713,7 @@ "@ vfmadd132\t{%2, %3, %0%{%4%}|%0%{%4%}, %3, %2} vfmadd213\t{%3, %2, %0%{%4%}|%0%{%4%}, %2, %3}" - [(set_attr "isa" "fma_avx512f,fma_avx512f") - (set_attr "type" "ssemuladd") + [(set_attr "type" "ssemuladd") (set_attr "mode" "")]) (define_insn "_fmadd__mask3" @@ -3715,8 +3727,7 @@ (match_operand: 4 "register_operand" "Yk")))] "TARGET_AVX512F" "vfmadd231\t{%2, %1, %0%{%4%}|%0%{%4%}, %1, %2}" - [(set_attr "isa" "fma_avx512f") - (set_attr "type" "ssemuladd") + [(set_attr "type" "ssemuladd") (set_attr "mode" "")]) (define_insn "*fma_fmsub_" @@ -3766,8 +3777,7 @@ "@ vfmsub132\t{%2, %3, %0%{%4%}|%0%{%4%}, %3, %2} vfmsub213\t{%3, %2, %0%{%4%}|%0%{%4%}, %2, %3}" - [(set_attr "isa" "fma_avx512f,fma_avx512f") - (set_attr "type" "ssemuladd") + [(set_attr "type" "ssemuladd") (set_attr "mode" "")]) (define_insn "_fmsub__mask3" @@ -3782,8 +3792,7 @@ (match_operand: 4 "register_operand" "Yk")))] "TARGET_AVX512F && " "vfmsub231\t{%2, %1, %0%{%4%}|%0%{%4%}, %1, %2}" - [(set_attr "isa" "fma_avx512f") - (set_attr "type" "ssemuladd") + [(set_attr "type" "ssemuladd") (set_attr "mode" "")]) (define_insn "*fma_fnmadd_" @@ -3833,8 +3842,7 @@ "@ vfnmadd132\t{%2, %3, %0%{%4%}|%0%{%4%}, %3, %2} vfnmadd213\t{%3, %2, %0%{%4%}|%0%{%4%}, %2, %3}" - [(set_attr "isa" "fma_avx512f,fma_avx512f") - (set_attr "type" "ssemuladd") + [(set_attr "type" "ssemuladd") (set_attr "mode" "")]) (define_insn "_fnmadd__mask3" @@ -3849,8 +3857,7 @@ (match_operand: 4 "register_operand" "Yk")))] "TARGET_AVX512F && " "vfnmadd231\t{%2, %1, %0%{%4%}|%0%{%4%}, %1, %2}" - [(set_attr "isa" "fma_avx512f") - (set_attr "type" "ssemuladd") + [(set_attr "type" "ssemuladd") (set_attr "mode" "")]) (define_insn "*fma_fnmsub_" @@ -3903,8 +3910,7 @@ "@ vfnmsub132\t{%2, %3, %0%{%4%}|%0%{%4%}, %3, %2} vfnmsub213\t{%3, %2, %0%{%4%}|%0%{%4%}, %2, %3}" - [(set_attr "isa" "fma_avx512f,fma_avx512f") - (set_attr "type" "ssemuladd") + [(set_attr "type" "ssemuladd") (set_attr "mode" "")]) (define_insn "_fnmsub__mask3" @@ -3920,8 +3926,7 @@ (match_operand: 4 "register_operand" "Yk")))] "TARGET_AVX512F" "vfnmsub231\t{%2, %1, %0%{%4%}|%0%{%4%}, %1, %2}" - [(set_attr "isa" "fma_avx512f") - (set_attr "type" "ssemuladd") + [(set_attr "type" "ssemuladd") (set_attr "mode" "")]) ;; FMA parallel floating point multiply addsub and subadd operations. @@ -4005,8 +4010,7 @@ "@ vfmaddsub132\t{%2, %3, %0%{%4%}|%0%{%4%}, %3, %2} vfmaddsub213\t{%3, %2, %0%{%4%}|%0%{%4%}, %2, %3}" - [(set_attr "isa" "fma_avx512f,fma_avx512f") - (set_attr "type" "ssemuladd") + [(set_attr "type" "ssemuladd") (set_attr "mode" "")]) (define_insn "_fmaddsub__mask3" @@ -4021,8 +4025,7 @@ (match_operand: 4 "register_operand" "Yk")))] "TARGET_AVX512F" "vfmaddsub231\t{%2, %1, %0%{%4%}|%0%{%4%}, %1, %2}" - [(set_attr "isa" "fma_avx512f") - (set_attr "type" "ssemuladd") + [(set_attr "type" "ssemuladd") (set_attr "mode" "")]) (define_insn "*fma_fmsubadd_" @@ -4075,8 +4078,7 @@ "@ vfmsubadd132\t{%2, %3, %0%{%4%}|%0%{%4%}, %3, %2} vfmsubadd213\t{%3, %2, %0%{%4%}|%0%{%4%}, %2, %3}" - [(set_attr "isa" "fma_avx512f,fma_avx512f") - (set_attr "type" "ssemuladd") + [(set_attr "type" "ssemuladd") (set_attr "mode" "")]) (define_insn "_fmsubadd__mask3" @@ -4092,8 +4094,7 @@ (match_operand: 4 "register_operand" "Yk")))] "TARGET_AVX512F" "vfmsubadd231\t{%2, %1, %0%{%4%}|%0%{%4%}, %1, %2}" - [(set_attr "isa" "fma_avx512f") - (set_attr "type" "ssemuladd") + [(set_attr "type" "ssemuladd") (set_attr "mode" "")]) ;; FMA3 floating point scalar intrinsics. These merge result with @@ -10168,8 +10169,7 @@ (const_int 12) (const_int 14)])))))] "TARGET_AVX512F && ix86_binary_operator_ok (MULT, V16SImode, operands)" "vpmuludq\t{%2, %1, %0|%0, %1, %2}" - [(set_attr "isa" "avx512f") - (set_attr "type" "sseimul") + [(set_attr "type" "sseimul") (set_attr "prefix_extra" "1") (set_attr "prefix" "evex") (set_attr "mode" "XI")]) @@ -10285,8 +10285,7 @@ (const_int 12) (const_int 14)])))))] "TARGET_AVX512F && ix86_binary_operator_ok (MULT, V16SImode, operands)" "vpmuldq\t{%2, %1, %0|%0, %1, %2}" - [(set_attr "isa" "avx512f") - (set_attr "type" "sseimul") + [(set_attr "type" "sseimul") (set_attr "prefix_extra" "1") (set_attr "prefix" "evex") (set_attr "mode" "XI")]) @@ -10731,59 +10730,51 @@ (const_string "0"))) (set_attr "mode" "")]) -(define_insn "3" - [(set (match_operand:VI2_AVX2_AVX512BW 0 "register_operand" "=x,v") - (any_lshift:VI2_AVX2_AVX512BW - (match_operand:VI2_AVX2_AVX512BW 1 "register_operand" "0,v") - (match_operand:DI 2 "nonmemory_operand" "xN,vN")))] - "TARGET_SSE2 && && " - "@ - p\t{%2, %0|%0, %2} - vp\t{%2, %1, %0|%0, %1, %2}" - [(set_attr "isa" "noavx,avx") - (set_attr "type" "sseishft") +(define_insn "3" + [(set (match_operand:VI248_AVX512BW_2 0 "register_operand" "=v,v") + (any_lshift:VI248_AVX512BW_2 + (match_operand:VI248_AVX512BW_2 1 "nonimmediate_operand" "v,vm") + (match_operand:DI 2 "nonmemory_operand" "v,N")))] + "TARGET_AVX512VL" + "vp\t{%2, %1, %0|%0, %1, %2}" + [(set_attr "type" "sseishft") (set (attr "length_immediate") (if_then_else (match_operand 2 "const_int_operand") (const_string "1") (const_string "0"))) - (set_attr "prefix_data16" "1,*") - (set_attr "prefix" "orig,vex") (set_attr "mode" "")]) -(define_insn "3" - [(set (match_operand:VI48_AVX2 0 "register_operand" "=x,x,v") - (any_lshift:VI48_AVX2 - (match_operand:VI48_AVX2 1 "register_operand" "0,x,v") - (match_operand:DI 2 "nonmemory_operand" "xN,xN,vN")))] - "TARGET_SSE2 && " +(define_insn "3" + [(set (match_operand:VI248_AVX2 0 "register_operand" "=x,x") + (any_lshift:VI248_AVX2 + (match_operand:VI248_AVX2 1 "register_operand" "0,x") + (match_operand:DI 2 "nonmemory_operand" "xN,xN")))] + "TARGET_SSE2" "@ p\t{%2, %0|%0, %2} - vp\t{%2, %1, %0|%0, %1, %2} - vp\t{%2, %1, %0|%0, %1, %2}" - [(set_attr "isa" "noavx,avx,avx512bw") + vp\t{%2, %1, %0|%0, %1, %2}" + [(set_attr "isa" "noavx,avx") (set_attr "type" "sseishft") (set (attr "length_immediate") (if_then_else (match_operand 2 "const_int_operand") (const_string "1") (const_string "0"))) - (set_attr "prefix_data16" "1,*,*") - (set_attr "prefix" "orig,vex,evex") + (set_attr "prefix_data16" "1,*") + (set_attr "prefix" "orig,vex") (set_attr "mode" "")]) (define_insn "3" - [(set (match_operand:VI48_512 0 "register_operand" "=v,v") - (any_lshift:VI48_512 - (match_operand:VI48_512 1 "nonimmediate_operand" "v,m") + [(set (match_operand:VI248_AVX512BW 0 "register_operand" "=v,v") + (any_lshift:VI248_AVX512BW + (match_operand:VI248_AVX512BW 1 "nonimmediate_operand" "v,m") (match_operand:DI 2 "nonmemory_operand" "vN,N")))] - "TARGET_AVX512F && " + "TARGET_AVX512F" "vp\t{%2, %1, %0|%0, %1, %2}" - [(set_attr "isa" "avx512f") - (set_attr "type" "sseishft") + [(set_attr "type" "sseishft") (set (attr "length_immediate") (if_then_else (match_operand 2 "const_int_operand") (const_string "1") (const_string "0"))) - (set_attr "prefix" "evex") (set_attr "mode" "")]) @@ -11568,10 +11559,10 @@ "TARGET_AVX512BW") (define_insn "*andnot3" - [(set (match_operand:VI 0 "register_operand" "=x,v") + [(set (match_operand:VI 0 "register_operand" "=x,x,v") (and:VI - (not:VI (match_operand:VI 1 "register_operand" "0,v")) - (match_operand:VI 2 "vector_operand" "xBm,vm")))] + (not:VI (match_operand:VI 1 "register_operand" "0,x,v")) + (match_operand:VI 2 "vector_operand" "xBm,xm,vm")))] "TARGET_SSE" { static char buf[64]; @@ -11606,10 +11597,11 @@ case E_V4DImode: case E_V4SImode: case E_V2DImode: - ssesuffix = TARGET_AVX512VL ? "" : ""; + ssesuffix = (TARGET_AVX512VL && which_alternative == 2 + ? "" : ""); break; default: - ssesuffix = TARGET_AVX512VL ? "q" : ""; + ssesuffix = TARGET_AVX512VL && which_alternative == 2 ? "q" : ""; } break; @@ -11635,6 +11627,7 @@ ops = "%s%s\t{%%2, %%0|%%0, %%2}"; break; case 1: + case 2: ops = "v%s%s\t{%%2, %%1, %%0|%%0, %%1, %%2}"; break; default: @@ -11644,7 +11637,7 @@ snprintf (buf, sizeof (buf), ops, tmp, ssesuffix); return buf; } - [(set_attr "isa" "noavx,avx") + [(set_attr "isa" "noavx,avx,avx") (set_attr "type" "sselog") (set (attr "prefix_data16") (if_then_else @@ -11652,7 +11645,7 @@ (eq_attr "mode" "TI")) (const_string "1") (const_string "*"))) - (set_attr "prefix" "orig,vex") + (set_attr "prefix" "orig,vex,evex") (set (attr "mode") (cond [(and (match_test " == 16") (match_test "TARGET_SSE_PACKED_SINGLE_INSN_OPTIMAL")) @@ -11697,10 +11690,10 @@ }) (define_insn "3" - [(set (match_operand:VI48_AVX_AVX512F 0 "register_operand" "=x,v") + [(set (match_operand:VI48_AVX_AVX512F 0 "register_operand" "=x,x,v") (any_logic:VI48_AVX_AVX512F - (match_operand:VI48_AVX_AVX512F 1 "vector_operand" "%0,v") - (match_operand:VI48_AVX_AVX512F 2 "vector_operand" "xBm,vm")))] + (match_operand:VI48_AVX_AVX512F 1 "vector_operand" "%0,x,v") + (match_operand:VI48_AVX_AVX512F 2 "vector_operand" "xBm,xm,vm")))] "TARGET_SSE && && ix86_binary_operator_ok (, mode, operands)" { @@ -11730,7 +11723,9 @@ case E_V4DImode: case E_V4SImode: case E_V2DImode: - ssesuffix = TARGET_AVX512VL ? "" : ""; + ssesuffix = (TARGET_AVX512VL + && ( || which_alternative == 2) + ? "" : ""); break; default: gcc_unreachable (); @@ -11759,6 +11754,7 @@ ops = "%s%s\t{%%2, %%0|%%0, %%2}"; break; case 1: + case 2: ops = "v%s%s\t{%%2, %%1, %%0|%%0, %%1, %%2}"; break; default: @@ -11768,7 +11764,7 @@ snprintf (buf, sizeof (buf), ops, tmp, ssesuffix); return buf; } - [(set_attr "isa" "noavx,avx") + [(set_attr "isa" "noavx,avx,avx") (set_attr "type" "sselog") (set (attr "prefix_data16") (if_then_else @@ -11776,7 +11772,7 @@ (eq_attr "mode" "TI")) (const_string "1") (const_string "*"))) - (set_attr "prefix" "") + (set_attr "prefix" ",evex") (set (attr "mode") (cond [(and (match_test " == 16") (match_test "TARGET_SSE_PACKED_SINGLE_INSN_OPTIMAL")) @@ -11795,10 +11791,10 @@ (const_string "")))]) (define_insn "*3" - [(set (match_operand:VI12_AVX_AVX512F 0 "register_operand" "=x,v") + [(set (match_operand:VI12_AVX_AVX512F 0 "register_operand" "=x,x,v") (any_logic: VI12_AVX_AVX512F - (match_operand:VI12_AVX_AVX512F 1 "vector_operand" "%0,v") - (match_operand:VI12_AVX_AVX512F 2 "vector_operand" "xBm,vm")))] + (match_operand:VI12_AVX_AVX512F 1 "vector_operand" "%0,x,v") + (match_operand:VI12_AVX_AVX512F 2 "vector_operand" "xBm,xm,vm")))] "TARGET_SSE && ix86_binary_operator_ok (, mode, operands)" { static char buf[64]; @@ -11827,7 +11823,7 @@ case E_V16HImode: case E_V16QImode: case E_V8HImode: - ssesuffix = TARGET_AVX512VL ? "q" : ""; + ssesuffix = TARGET_AVX512VL && which_alternative == 2 ? "q" : ""; break; default: gcc_unreachable (); @@ -11853,6 +11849,7 @@ ops = "%s%s\t{%%2, %%0|%%0, %%2}"; break; case 1: + case 2: ops = "v%s%s\t{%%2, %%1, %%0|%%0, %%1, %%2}"; break; default: @@ -11862,7 +11859,7 @@ snprintf (buf, sizeof (buf), ops, tmp, ssesuffix); return buf; } - [(set_attr "isa" "noavx,avx") + [(set_attr "isa" "noavx,avx,avx") (set_attr "type" "sselog") (set (attr "prefix_data16") (if_then_else @@ -11870,7 +11867,7 @@ (eq_attr "mode" "TI")) (const_string "1") (const_string "*"))) - (set_attr "prefix" "") + (set_attr "prefix" ",evex") (set (attr "mode") (cond [(and (match_test " == 16") (match_test "TARGET_SSE_PACKED_SINGLE_INSN_OPTIMAL")) @@ -19619,8 +19616,7 @@ UNSPEC_DBPSADBW))] "TARGET_AVX512BW" "vdbpsadbw\t{%3, %2, %1, %0|%0, %1, %2, %3}" - [(set_attr "isa" "avx") - (set_attr "type" "sselog1") + [(set_attr "type" "sselog1") (set_attr "length_immediate" "1") (set_attr "prefix" "evex") (set_attr "mode" "")]) diff --git a/gcc/config/i386/subst.md b/gcc/config/i386/subst.md index a318a8d4c8018..c93a526343555 100644 --- a/gcc/config/i386/subst.md +++ b/gcc/config/i386/subst.md @@ -62,8 +62,8 @@ (define_subst_attr "store_mask_predicate" "mask" "nonimmediate_operand" "register_operand") (define_subst_attr "mask_prefix" "mask" "vex" "evex") (define_subst_attr "mask_prefix2" "mask" "maybe_vex" "evex") -(define_subst_attr "mask_prefix3" "mask" "orig,vex" "evex") -(define_subst_attr "mask_prefix4" "mask" "orig,orig,vex" "evex") +(define_subst_attr "mask_prefix3" "mask" "orig,vex" "evex,evex") +(define_subst_attr "mask_prefix4" "mask" "orig,orig,vex" "evex,evex,evex") (define_subst_attr "mask_expand_op3" "mask" "3" "5") (define_subst "mask" diff --git a/gcc/config/i386/sync.md b/gcc/config/i386/sync.md index 29b82f86d43a0..eceaa73a67991 100644 --- a/gcc/config/i386/sync.md +++ b/gcc/config/i386/sync.md @@ -219,14 +219,35 @@ (set (match_operand:DI 2 "memory_operand") (unspec:DI [(match_dup 0)] UNSPEC_FIST_ATOMIC)) - (set (match_operand:DF 3 "fp_register_operand") + (set (match_operand:DF 3 "any_fp_register_operand") (match_operand:DF 4 "memory_operand"))] "!TARGET_64BIT && peep2_reg_dead_p (2, operands[0]) - && rtx_equal_p (operands[4], adjust_address_nv (operands[2], DFmode, 0))" + && rtx_equal_p (XEXP (operands[4], 0), XEXP (operands[2], 0))" [(set (match_dup 3) (match_dup 5))] "operands[5] = gen_lowpart (DFmode, operands[1]);") +(define_peephole2 + [(set (match_operand:DF 0 "fp_register_operand") + (unspec:DF [(match_operand:DI 1 "memory_operand")] + UNSPEC_FILD_ATOMIC)) + (set (match_operand:DI 2 "memory_operand") + (unspec:DI [(match_dup 0)] + UNSPEC_FIST_ATOMIC)) + (set (mem:BLK (scratch:SI)) + (unspec:BLK [(mem:BLK (scratch:SI))] UNSPEC_MEMORY_BLOCKAGE)) + (set (match_operand:DF 3 "any_fp_register_operand") + (match_operand:DF 4 "memory_operand"))] + "!TARGET_64BIT + && peep2_reg_dead_p (2, operands[0]) + && rtx_equal_p (XEXP (operands[4], 0), XEXP (operands[2], 0))" + [(const_int 0)] +{ + emit_move_insn (operands[3], gen_lowpart (DFmode, operands[1])); + emit_insn (gen_memory_blockage ()); + DONE; +}) + (define_peephole2 [(set (match_operand:DF 0 "sse_reg_operand") (unspec:DF [(match_operand:DI 1 "memory_operand")] @@ -234,14 +255,35 @@ (set (match_operand:DI 2 "memory_operand") (unspec:DI [(match_dup 0)] UNSPEC_STX_ATOMIC)) - (set (match_operand:DF 3 "fp_register_operand") + (set (match_operand:DF 3 "any_fp_register_operand") (match_operand:DF 4 "memory_operand"))] "!TARGET_64BIT && peep2_reg_dead_p (2, operands[0]) - && rtx_equal_p (operands[4], adjust_address_nv (operands[2], DFmode, 0))" + && rtx_equal_p (XEXP (operands[4], 0), XEXP (operands[2], 0))" [(set (match_dup 3) (match_dup 5))] "operands[5] = gen_lowpart (DFmode, operands[1]);") +(define_peephole2 + [(set (match_operand:DF 0 "sse_reg_operand") + (unspec:DF [(match_operand:DI 1 "memory_operand")] + UNSPEC_LDX_ATOMIC)) + (set (match_operand:DI 2 "memory_operand") + (unspec:DI [(match_dup 0)] + UNSPEC_STX_ATOMIC)) + (set (mem:BLK (scratch:SI)) + (unspec:BLK [(mem:BLK (scratch:SI))] UNSPEC_MEMORY_BLOCKAGE)) + (set (match_operand:DF 3 "any_fp_register_operand") + (match_operand:DF 4 "memory_operand"))] + "!TARGET_64BIT + && peep2_reg_dead_p (2, operands[0]) + && rtx_equal_p (XEXP (operands[4], 0), XEXP (operands[2], 0))" + [(const_int 0)] +{ + emit_move_insn (operands[3], gen_lowpart (DFmode, operands[1])); + emit_insn (gen_memory_blockage ()); + DONE; +}) + (define_expand "atomic_store" [(set (match_operand:ATOMIC 0 "memory_operand") (unspec:ATOMIC [(match_operand:ATOMIC 1 "nonimmediate_operand") @@ -331,7 +373,7 @@ (define_peephole2 [(set (match_operand:DF 0 "memory_operand") - (match_operand:DF 1 "fp_register_operand")) + (match_operand:DF 1 "any_fp_register_operand")) (set (match_operand:DF 2 "fp_register_operand") (unspec:DF [(match_operand:DI 3 "memory_operand")] UNSPEC_FILD_ATOMIC)) @@ -340,13 +382,34 @@ UNSPEC_FIST_ATOMIC))] "!TARGET_64BIT && peep2_reg_dead_p (3, operands[2]) - && rtx_equal_p (operands[0], adjust_address_nv (operands[3], DFmode, 0))" + && rtx_equal_p (XEXP (operands[0], 0), XEXP (operands[3], 0))" [(set (match_dup 5) (match_dup 1))] "operands[5] = gen_lowpart (DFmode, operands[4]);") (define_peephole2 [(set (match_operand:DF 0 "memory_operand") - (match_operand:DF 1 "fp_register_operand")) + (match_operand:DF 1 "any_fp_register_operand")) + (set (mem:BLK (scratch:SI)) + (unspec:BLK [(mem:BLK (scratch:SI))] UNSPEC_MEMORY_BLOCKAGE)) + (set (match_operand:DF 2 "fp_register_operand") + (unspec:DF [(match_operand:DI 3 "memory_operand")] + UNSPEC_FILD_ATOMIC)) + (set (match_operand:DI 4 "memory_operand") + (unspec:DI [(match_dup 2)] + UNSPEC_FIST_ATOMIC))] + "!TARGET_64BIT + && peep2_reg_dead_p (4, operands[2]) + && rtx_equal_p (XEXP (operands[0], 0), XEXP (operands[3], 0))" + [(const_int 0)] +{ + emit_insn (gen_memory_blockage ()); + emit_move_insn (gen_lowpart (DFmode, operands[4]), operands[1]); + DONE; +}) + +(define_peephole2 + [(set (match_operand:DF 0 "memory_operand") + (match_operand:DF 1 "any_fp_register_operand")) (set (match_operand:DF 2 "sse_reg_operand") (unspec:DF [(match_operand:DI 3 "memory_operand")] UNSPEC_LDX_ATOMIC)) @@ -355,10 +418,31 @@ UNSPEC_STX_ATOMIC))] "!TARGET_64BIT && peep2_reg_dead_p (3, operands[2]) - && rtx_equal_p (operands[0], adjust_address_nv (operands[3], DFmode, 0))" + && rtx_equal_p (XEXP (operands[0], 0), XEXP (operands[3], 0))" [(set (match_dup 5) (match_dup 1))] "operands[5] = gen_lowpart (DFmode, operands[4]);") +(define_peephole2 + [(set (match_operand:DF 0 "memory_operand") + (match_operand:DF 1 "any_fp_register_operand")) + (set (mem:BLK (scratch:SI)) + (unspec:BLK [(mem:BLK (scratch:SI))] UNSPEC_MEMORY_BLOCKAGE)) + (set (match_operand:DF 2 "sse_reg_operand") + (unspec:DF [(match_operand:DI 3 "memory_operand")] + UNSPEC_LDX_ATOMIC)) + (set (match_operand:DI 4 "memory_operand") + (unspec:DI [(match_dup 2)] + UNSPEC_STX_ATOMIC))] + "!TARGET_64BIT + && peep2_reg_dead_p (4, operands[2]) + && rtx_equal_p (XEXP (operands[0], 0), XEXP (operands[3], 0))" + [(const_int 0)] +{ + emit_insn (gen_memory_blockage ()); + emit_move_insn (gen_lowpart (DFmode, operands[4]), operands[1]); + DONE; +}) + ;; ??? You'd think that we'd be able to perform this via FLOAT + FIX_TRUNC ;; operations. But the fix_trunc patterns want way more setup than we want ;; to provide. Note that the scratch is DFmode instead of XFmode in order diff --git a/gcc/config/i386/t-i386 b/gcc/config/i386/t-i386 index 0a8524bfbe2bc..8411a9680ff1d 100644 --- a/gcc/config/i386/t-i386 +++ b/gcc/config/i386/t-i386 @@ -24,6 +24,22 @@ i386-c.o: $(srcdir)/config/i386/i386-c.c $(COMPILE) $< $(POSTCOMPILE) +x86-tune-sched.o: $(srcdir)/config/i386/x86-tune-sched.c + $(COMPILE) $< + $(POSTCOMPILE) + +x86-tune-sched-bd.o: $(srcdir)/config/i386/x86-tune-sched-bd.c + $(COMPILE) $< + $(POSTCOMPILE) + +x86-tune-sched-atom.o: $(srcdir)/config/i386/x86-tune-sched-atom.c + $(COMPILE) $< + $(POSTCOMPILE) + +x86-tune-sched-core.o: $(srcdir)/config/i386/x86-tune-sched-core.c + $(COMPILE) $< + $(POSTCOMPILE) + i386.o: i386-builtin-types.inc i386-builtin-types.inc: s-i386-bt ; @true diff --git a/gcc/config/i386/x86-tune-costs.h b/gcc/config/i386/x86-tune-costs.h new file mode 100644 index 0000000000000..3f7a4f23c92e4 --- /dev/null +++ b/gcc/config/i386/x86-tune-costs.h @@ -0,0 +1,2381 @@ + +/* Processor costs (relative to an add) */ +/* We assume COSTS_N_INSNS is defined as (N)*4 and an addition is 2 bytes. */ +#define COSTS_N_BYTES(N) ((N) * 2) + +#define DUMMY_STRINGOP_ALGS {libcall, {{-1, libcall, false}}} + +static stringop_algs ix86_size_memcpy[2] = { + {rep_prefix_1_byte, {{-1, rep_prefix_1_byte, false}}}, + {rep_prefix_1_byte, {{-1, rep_prefix_1_byte, false}}}}; +static stringop_algs ix86_size_memset[2] = { + {rep_prefix_1_byte, {{-1, rep_prefix_1_byte, false}}}, + {rep_prefix_1_byte, {{-1, rep_prefix_1_byte, false}}}}; + +const +struct processor_costs ix86_size_cost = {/* costs for tuning for size */ + COSTS_N_BYTES (2), /* cost of an add instruction */ + COSTS_N_BYTES (3), /* cost of a lea instruction */ + COSTS_N_BYTES (2), /* variable shift costs */ + COSTS_N_BYTES (3), /* constant shift costs */ + {COSTS_N_BYTES (3), /* cost of starting multiply for QI */ + COSTS_N_BYTES (3), /* HI */ + COSTS_N_BYTES (3), /* SI */ + COSTS_N_BYTES (3), /* DI */ + COSTS_N_BYTES (5)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_BYTES (3), /* cost of a divide/mod for QI */ + COSTS_N_BYTES (3), /* HI */ + COSTS_N_BYTES (3), /* SI */ + COSTS_N_BYTES (3), /* DI */ + COSTS_N_BYTES (5)}, /* other */ + COSTS_N_BYTES (3), /* cost of movsx */ + COSTS_N_BYTES (3), /* cost of movzx */ + 0, /* "large" insn */ + 2, /* MOVE_RATIO */ + 2, /* cost for loading QImode using movzbl */ + {2, 2, 2}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {2, 2, 2}, /* cost of storing integer registers */ + 2, /* cost of reg,reg fld/fst */ + {2, 2, 2}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {2, 2, 2}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 3, /* cost of moving MMX register */ + {3, 3}, /* cost of loading MMX registers + in SImode and DImode */ + {3, 3}, /* cost of storing MMX registers + in SImode and DImode */ + 3, /* cost of moving SSE register */ + {3, 3, 3}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {3, 3, 3}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 3, /* MMX or SSE register to integer */ + 0, /* size of l1 cache */ + 0, /* size of l2 cache */ + 0, /* size of prefetch block */ + 0, /* number of parallel prefetches */ + 2, /* Branch cost */ + COSTS_N_BYTES (2), /* cost of FADD and FSUB insns. */ + COSTS_N_BYTES (2), /* cost of FMUL instruction. */ + COSTS_N_BYTES (2), /* cost of FDIV instruction. */ + COSTS_N_BYTES (2), /* cost of FABS instruction. */ + COSTS_N_BYTES (2), /* cost of FCHS instruction. */ + COSTS_N_BYTES (2), /* cost of FSQRT instruction. */ + + COSTS_N_BYTES (2), /* cost of cheap SSE instruction. */ + COSTS_N_BYTES (2), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_BYTES (2), /* cost of MULSS instruction. */ + COSTS_N_BYTES (2), /* cost of MULSD instruction. */ + COSTS_N_BYTES (2), /* cost of FMA SS instruction. */ + COSTS_N_BYTES (2), /* cost of FMA SD instruction. */ + COSTS_N_BYTES (2), /* cost of DIVSS instruction. */ + COSTS_N_BYTES (2), /* cost of DIVSD instruction. */ + COSTS_N_BYTES (2), /* cost of SQRTSS instruction. */ + COSTS_N_BYTES (2), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + ix86_size_memcpy, + ix86_size_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 1, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 1, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 1, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +/* Processor costs (relative to an add) */ +static stringop_algs i386_memcpy[2] = { + {rep_prefix_1_byte, {{-1, rep_prefix_1_byte, false}}}, + DUMMY_STRINGOP_ALGS}; +static stringop_algs i386_memset[2] = { + {rep_prefix_1_byte, {{-1, rep_prefix_1_byte, false}}}, + DUMMY_STRINGOP_ALGS}; + +static const +struct processor_costs i386_cost = { /* 386 specific costs */ + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (1), /* cost of a lea instruction */ + COSTS_N_INSNS (3), /* variable shift costs */ + COSTS_N_INSNS (2), /* constant shift costs */ + {COSTS_N_INSNS (6), /* cost of starting multiply for QI */ + COSTS_N_INSNS (6), /* HI */ + COSTS_N_INSNS (6), /* SI */ + COSTS_N_INSNS (6), /* DI */ + COSTS_N_INSNS (6)}, /* other */ + COSTS_N_INSNS (1), /* cost of multiply per each bit set */ + {COSTS_N_INSNS (23), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (23), /* HI */ + COSTS_N_INSNS (23), /* SI */ + COSTS_N_INSNS (23), /* DI */ + COSTS_N_INSNS (23)}, /* other */ + COSTS_N_INSNS (3), /* cost of movsx */ + COSTS_N_INSNS (2), /* cost of movzx */ + 15, /* "large" insn */ + 3, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {2, 4, 2}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {2, 4, 2}, /* cost of storing integer registers */ + 2, /* cost of reg,reg fld/fst */ + {8, 8, 8}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {8, 8, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {4, 8}, /* cost of loading MMX registers + in SImode and DImode */ + {4, 8}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {4, 8, 16}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {4, 8, 16}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 3, /* MMX or SSE register to integer */ + 0, /* size of l1 cache */ + 0, /* size of l2 cache */ + 0, /* size of prefetch block */ + 0, /* number of parallel prefetches */ + 1, /* Branch cost */ + COSTS_N_INSNS (23), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (27), /* cost of FMUL instruction. */ + COSTS_N_INSNS (88), /* cost of FDIV instruction. */ + COSTS_N_INSNS (22), /* cost of FABS instruction. */ + COSTS_N_INSNS (24), /* cost of FCHS instruction. */ + COSTS_N_INSNS (122), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (1), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (23), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (27), /* cost of MULSS instruction. */ + COSTS_N_INSNS (27), /* cost of MULSD instruction. */ + COSTS_N_INSNS (27), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (27), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (88), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (88), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (122), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (122), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + i386_memcpy, + i386_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 1, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +static stringop_algs i486_memcpy[2] = { + {rep_prefix_4_byte, {{-1, rep_prefix_4_byte, false}}}, + DUMMY_STRINGOP_ALGS}; +static stringop_algs i486_memset[2] = { + {rep_prefix_4_byte, {{-1, rep_prefix_4_byte, false}}}, + DUMMY_STRINGOP_ALGS}; + +static const +struct processor_costs i486_cost = { /* 486 specific costs */ + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (1), /* cost of a lea instruction */ + COSTS_N_INSNS (3), /* variable shift costs */ + COSTS_N_INSNS (2), /* constant shift costs */ + {COSTS_N_INSNS (12), /* cost of starting multiply for QI */ + COSTS_N_INSNS (12), /* HI */ + COSTS_N_INSNS (12), /* SI */ + COSTS_N_INSNS (12), /* DI */ + COSTS_N_INSNS (12)}, /* other */ + 1, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (40), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (40), /* HI */ + COSTS_N_INSNS (40), /* SI */ + COSTS_N_INSNS (40), /* DI */ + COSTS_N_INSNS (40)}, /* other */ + COSTS_N_INSNS (3), /* cost of movsx */ + COSTS_N_INSNS (2), /* cost of movzx */ + 15, /* "large" insn */ + 3, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {2, 4, 2}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {2, 4, 2}, /* cost of storing integer registers */ + 2, /* cost of reg,reg fld/fst */ + {8, 8, 8}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {8, 8, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {4, 8}, /* cost of loading MMX registers + in SImode and DImode */ + {4, 8}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {4, 8, 16}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {4, 8, 16}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 3, /* MMX or SSE register to integer */ + 4, /* size of l1 cache. 486 has 8kB cache + shared for code and data, so 4kB is + not really precise. */ + 4, /* size of l2 cache */ + 0, /* size of prefetch block */ + 0, /* number of parallel prefetches */ + 1, /* Branch cost */ + COSTS_N_INSNS (8), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (16), /* cost of FMUL instruction. */ + COSTS_N_INSNS (73), /* cost of FDIV instruction. */ + COSTS_N_INSNS (3), /* cost of FABS instruction. */ + COSTS_N_INSNS (3), /* cost of FCHS instruction. */ + COSTS_N_INSNS (83), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (1), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (8), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (16), /* cost of MULSS instruction. */ + COSTS_N_INSNS (16), /* cost of MULSD instruction. */ + COSTS_N_INSNS (16), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (16), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (73), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (74), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (83), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (83), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + i486_memcpy, + i486_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 1, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +static stringop_algs pentium_memcpy[2] = { + {libcall, {{256, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + DUMMY_STRINGOP_ALGS}; +static stringop_algs pentium_memset[2] = { + {libcall, {{-1, rep_prefix_4_byte, false}}}, + DUMMY_STRINGOP_ALGS}; + +static const +struct processor_costs pentium_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (1), /* cost of a lea instruction */ + COSTS_N_INSNS (4), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (11), /* cost of starting multiply for QI */ + COSTS_N_INSNS (11), /* HI */ + COSTS_N_INSNS (11), /* SI */ + COSTS_N_INSNS (11), /* DI */ + COSTS_N_INSNS (11)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (25), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (25), /* HI */ + COSTS_N_INSNS (25), /* SI */ + COSTS_N_INSNS (25), /* DI */ + COSTS_N_INSNS (25)}, /* other */ + COSTS_N_INSNS (3), /* cost of movsx */ + COSTS_N_INSNS (2), /* cost of movzx */ + 8, /* "large" insn */ + 6, /* MOVE_RATIO */ + 6, /* cost for loading QImode using movzbl */ + {2, 4, 2}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {2, 4, 2}, /* cost of storing integer registers */ + 2, /* cost of reg,reg fld/fst */ + {2, 2, 6}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {4, 4, 6}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 8, /* cost of moving MMX register */ + {8, 8}, /* cost of loading MMX registers + in SImode and DImode */ + {8, 8}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {4, 8, 16}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {4, 8, 16}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 3, /* MMX or SSE register to integer */ + 8, /* size of l1 cache. */ + 8, /* size of l2 cache */ + 0, /* size of prefetch block */ + 0, /* number of parallel prefetches */ + 2, /* Branch cost */ + COSTS_N_INSNS (3), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (3), /* cost of FMUL instruction. */ + COSTS_N_INSNS (39), /* cost of FDIV instruction. */ + COSTS_N_INSNS (1), /* cost of FABS instruction. */ + COSTS_N_INSNS (1), /* cost of FCHS instruction. */ + COSTS_N_INSNS (70), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (1), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (3), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (3), /* cost of MULSS instruction. */ + COSTS_N_INSNS (3), /* cost of MULSD instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (39), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (39), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (70), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (70), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + pentium_memcpy, + pentium_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 1, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +static const +struct processor_costs lakemont_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (1) + 1, /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (11), /* cost of starting multiply for QI */ + COSTS_N_INSNS (11), /* HI */ + COSTS_N_INSNS (11), /* SI */ + COSTS_N_INSNS (11), /* DI */ + COSTS_N_INSNS (11)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (25), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (25), /* HI */ + COSTS_N_INSNS (25), /* SI */ + COSTS_N_INSNS (25), /* DI */ + COSTS_N_INSNS (25)}, /* other */ + COSTS_N_INSNS (3), /* cost of movsx */ + COSTS_N_INSNS (2), /* cost of movzx */ + 8, /* "large" insn */ + 17, /* MOVE_RATIO */ + 6, /* cost for loading QImode using movzbl */ + {2, 4, 2}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {2, 4, 2}, /* cost of storing integer registers */ + 2, /* cost of reg,reg fld/fst */ + {2, 2, 6}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {4, 4, 6}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 8, /* cost of moving MMX register */ + {8, 8}, /* cost of loading MMX registers + in SImode and DImode */ + {8, 8}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {4, 8, 16}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {4, 8, 16}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 3, /* MMX or SSE register to integer */ + 8, /* size of l1 cache. */ + 8, /* size of l2 cache */ + 0, /* size of prefetch block */ + 0, /* number of parallel prefetches */ + 2, /* Branch cost */ + COSTS_N_INSNS (3), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (3), /* cost of FMUL instruction. */ + COSTS_N_INSNS (39), /* cost of FDIV instruction. */ + COSTS_N_INSNS (1), /* cost of FABS instruction. */ + COSTS_N_INSNS (1), /* cost of FCHS instruction. */ + COSTS_N_INSNS (70), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (1), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (5), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (5), /* cost of MULSS instruction. */ + COSTS_N_INSNS (5), /* cost of MULSD instruction. */ + COSTS_N_INSNS (10), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (10), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (31), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (60), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (31), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (63), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + pentium_memcpy, + pentium_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 1, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +/* PentiumPro has optimized rep instructions for blocks aligned by 8 bytes + (we ensure the alignment). For small blocks inline loop is still a + noticeable win, for bigger blocks either rep movsl or rep movsb is + way to go. Rep movsb has apparently more expensive startup time in CPU, + but after 4K the difference is down in the noise. */ +static stringop_algs pentiumpro_memcpy[2] = { + {rep_prefix_4_byte, {{128, loop, false}, {1024, unrolled_loop, false}, + {8192, rep_prefix_4_byte, false}, + {-1, rep_prefix_1_byte, false}}}, + DUMMY_STRINGOP_ALGS}; +static stringop_algs pentiumpro_memset[2] = { + {rep_prefix_4_byte, {{1024, unrolled_loop, false}, + {8192, rep_prefix_4_byte, false}, + {-1, libcall, false}}}, + DUMMY_STRINGOP_ALGS}; +static const +struct processor_costs pentiumpro_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (1), /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (4), /* cost of starting multiply for QI */ + COSTS_N_INSNS (4), /* HI */ + COSTS_N_INSNS (4), /* SI */ + COSTS_N_INSNS (4), /* DI */ + COSTS_N_INSNS (4)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (17), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (17), /* HI */ + COSTS_N_INSNS (17), /* SI */ + COSTS_N_INSNS (17), /* DI */ + COSTS_N_INSNS (17)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 6, /* MOVE_RATIO */ + 2, /* cost for loading QImode using movzbl */ + {4, 4, 4}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {2, 2, 2}, /* cost of storing integer registers */ + 2, /* cost of reg,reg fld/fst */ + {2, 2, 6}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {4, 4, 6}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {2, 2}, /* cost of loading MMX registers + in SImode and DImode */ + {2, 2}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {2, 2, 8}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {2, 2, 8}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 3, /* MMX or SSE register to integer */ + 8, /* size of l1 cache. */ + 256, /* size of l2 cache */ + 32, /* size of prefetch block */ + 6, /* number of parallel prefetches */ + 2, /* Branch cost */ + COSTS_N_INSNS (3), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (5), /* cost of FMUL instruction. */ + COSTS_N_INSNS (56), /* cost of FDIV instruction. */ + COSTS_N_INSNS (2), /* cost of FABS instruction. */ + COSTS_N_INSNS (2), /* cost of FCHS instruction. */ + COSTS_N_INSNS (56), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (1), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (3), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (4), /* cost of MULSS instruction. */ + COSTS_N_INSNS (4), /* cost of MULSD instruction. */ + COSTS_N_INSNS (7), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (7), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (18), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (18), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (31), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (31), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + pentiumpro_memcpy, + pentiumpro_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 1, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +static stringop_algs geode_memcpy[2] = { + {libcall, {{256, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + DUMMY_STRINGOP_ALGS}; +static stringop_algs geode_memset[2] = { + {libcall, {{256, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + DUMMY_STRINGOP_ALGS}; +static const +struct processor_costs geode_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (1), /* cost of a lea instruction */ + COSTS_N_INSNS (2), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ + COSTS_N_INSNS (4), /* HI */ + COSTS_N_INSNS (7), /* SI */ + COSTS_N_INSNS (7), /* DI */ + COSTS_N_INSNS (7)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (15), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (23), /* HI */ + COSTS_N_INSNS (39), /* SI */ + COSTS_N_INSNS (39), /* DI */ + COSTS_N_INSNS (39)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 4, /* MOVE_RATIO */ + 1, /* cost for loading QImode using movzbl */ + {1, 1, 1}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {1, 1, 1}, /* cost of storing integer registers */ + 1, /* cost of reg,reg fld/fst */ + {1, 1, 1}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {4, 6, 6}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + + 2, /* cost of moving MMX register */ + {2, 2}, /* cost of loading MMX registers + in SImode and DImode */ + {2, 2}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {2, 2, 8}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {2, 2, 8}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 3, /* MMX or SSE register to integer */ + 64, /* size of l1 cache. */ + 128, /* size of l2 cache. */ + 32, /* size of prefetch block */ + 1, /* number of parallel prefetches */ + 1, /* Branch cost */ + COSTS_N_INSNS (6), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (11), /* cost of FMUL instruction. */ + COSTS_N_INSNS (47), /* cost of FDIV instruction. */ + COSTS_N_INSNS (1), /* cost of FABS instruction. */ + COSTS_N_INSNS (1), /* cost of FCHS instruction. */ + COSTS_N_INSNS (54), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (1), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (6), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (11), /* cost of MULSS instruction. */ + COSTS_N_INSNS (11), /* cost of MULSD instruction. */ + COSTS_N_INSNS (17), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (17), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (47), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (47), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (54), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (54), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + geode_memcpy, + geode_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 1, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +static stringop_algs k6_memcpy[2] = { + {libcall, {{256, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + DUMMY_STRINGOP_ALGS}; +static stringop_algs k6_memset[2] = { + {libcall, {{256, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + DUMMY_STRINGOP_ALGS}; +static const +struct processor_costs k6_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (2), /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ + COSTS_N_INSNS (3), /* HI */ + COSTS_N_INSNS (3), /* SI */ + COSTS_N_INSNS (3), /* DI */ + COSTS_N_INSNS (3)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (18), /* HI */ + COSTS_N_INSNS (18), /* SI */ + COSTS_N_INSNS (18), /* DI */ + COSTS_N_INSNS (18)}, /* other */ + COSTS_N_INSNS (2), /* cost of movsx */ + COSTS_N_INSNS (2), /* cost of movzx */ + 8, /* "large" insn */ + 4, /* MOVE_RATIO */ + 3, /* cost for loading QImode using movzbl */ + {4, 5, 4}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {2, 3, 2}, /* cost of storing integer registers */ + 4, /* cost of reg,reg fld/fst */ + {6, 6, 6}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {4, 4, 4}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {2, 2}, /* cost of loading MMX registers + in SImode and DImode */ + {2, 2}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {2, 2, 8}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {2, 2, 8}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 6, /* MMX or SSE register to integer */ + 32, /* size of l1 cache. */ + 32, /* size of l2 cache. Some models + have integrated l2 cache, but + optimizing for k6 is not important + enough to worry about that. */ + 32, /* size of prefetch block */ + 1, /* number of parallel prefetches */ + 1, /* Branch cost */ + COSTS_N_INSNS (2), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (2), /* cost of FMUL instruction. */ + COSTS_N_INSNS (56), /* cost of FDIV instruction. */ + COSTS_N_INSNS (2), /* cost of FABS instruction. */ + COSTS_N_INSNS (2), /* cost of FCHS instruction. */ + COSTS_N_INSNS (56), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (1), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (2), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (2), /* cost of MULSS instruction. */ + COSTS_N_INSNS (2), /* cost of MULSD instruction. */ + COSTS_N_INSNS (4), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (4), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (56), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (56), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (56), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (56), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + k6_memcpy, + k6_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 1, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +/* For some reason, Athlon deals better with REP prefix (relative to loops) + compared to K8. Alignment becomes important after 8 bytes for memcpy and + 128 bytes for memset. */ +static stringop_algs athlon_memcpy[2] = { + {libcall, {{2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + DUMMY_STRINGOP_ALGS}; +static stringop_algs athlon_memset[2] = { + {libcall, {{2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + DUMMY_STRINGOP_ALGS}; +static const +struct processor_costs athlon_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (2), /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (5), /* cost of starting multiply for QI */ + COSTS_N_INSNS (5), /* HI */ + COSTS_N_INSNS (5), /* SI */ + COSTS_N_INSNS (5), /* DI */ + COSTS_N_INSNS (5)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (26), /* HI */ + COSTS_N_INSNS (42), /* SI */ + COSTS_N_INSNS (74), /* DI */ + COSTS_N_INSNS (74)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 9, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {3, 4, 3}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {3, 4, 3}, /* cost of storing integer registers */ + 4, /* cost of reg,reg fld/fst */ + {4, 4, 12}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {6, 6, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {4, 4}, /* cost of loading MMX registers + in SImode and DImode */ + {4, 4}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {4, 4, 6}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {4, 4, 5}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 5, /* MMX or SSE register to integer */ + 64, /* size of l1 cache. */ + 256, /* size of l2 cache. */ + 64, /* size of prefetch block */ + 6, /* number of parallel prefetches */ + 5, /* Branch cost */ + COSTS_N_INSNS (4), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (4), /* cost of FMUL instruction. */ + COSTS_N_INSNS (24), /* cost of FDIV instruction. */ + COSTS_N_INSNS (2), /* cost of FABS instruction. */ + COSTS_N_INSNS (2), /* cost of FCHS instruction. */ + COSTS_N_INSNS (35), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (2), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (4), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (4), /* cost of MULSS instruction. */ + COSTS_N_INSNS (4), /* cost of MULSD instruction. */ + COSTS_N_INSNS (8), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (8), /* cost of FMA SD instruction. */ + /* 11-16 */ + COSTS_N_INSNS (16), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (24), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (19), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (19), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + athlon_memcpy, + athlon_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 1, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +/* K8 has optimized REP instruction for medium sized blocks, but for very + small blocks it is better to use loop. For large blocks, libcall can + do nontemporary accesses and beat inline considerably. */ +static stringop_algs k8_memcpy[2] = { + {libcall, {{6, loop, false}, {14, unrolled_loop, false}, + {-1, rep_prefix_4_byte, false}}}, + {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +static stringop_algs k8_memset[2] = { + {libcall, {{8, loop, false}, {24, unrolled_loop, false}, + {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + {libcall, {{48, unrolled_loop, false}, + {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; +static const +struct processor_costs k8_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (2), /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ + COSTS_N_INSNS (4), /* HI */ + COSTS_N_INSNS (3), /* SI */ + COSTS_N_INSNS (4), /* DI */ + COSTS_N_INSNS (5)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (26), /* HI */ + COSTS_N_INSNS (42), /* SI */ + COSTS_N_INSNS (74), /* DI */ + COSTS_N_INSNS (74)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 9, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {3, 4, 3}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {3, 4, 3}, /* cost of storing integer registers */ + 4, /* cost of reg,reg fld/fst */ + {4, 4, 12}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {6, 6, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {3, 3}, /* cost of loading MMX registers + in SImode and DImode */ + {4, 4}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {4, 3, 6}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {4, 4, 5}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 5, /* MMX or SSE register to integer */ + 64, /* size of l1 cache. */ + 512, /* size of l2 cache. */ + 64, /* size of prefetch block */ + /* New AMD processors never drop prefetches; if they cannot be performed + immediately, they are queued. We set number of simultaneous prefetches + to a large constant to reflect this (it probably is not a good idea not + to limit number of prefetches at all, as their execution also takes some + time). */ + 100, /* number of parallel prefetches */ + 3, /* Branch cost */ + COSTS_N_INSNS (4), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (4), /* cost of FMUL instruction. */ + COSTS_N_INSNS (19), /* cost of FDIV instruction. */ + COSTS_N_INSNS (2), /* cost of FABS instruction. */ + COSTS_N_INSNS (2), /* cost of FCHS instruction. */ + COSTS_N_INSNS (35), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (2), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (4), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (4), /* cost of MULSS instruction. */ + COSTS_N_INSNS (4), /* cost of MULSD instruction. */ + COSTS_N_INSNS (8), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (8), /* cost of FMA SD instruction. */ + /* 11-16 */ + COSTS_N_INSNS (16), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (20), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (19), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (27), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + k8_memcpy, + k8_memset, + 4, /* scalar_stmt_cost. */ + 2, /* scalar load_cost. */ + 2, /* scalar_store_cost. */ + 5, /* vec_stmt_cost. */ + 0, /* vec_to_scalar_cost. */ + 2, /* scalar_to_vec_cost. */ + 2, /* vec_align_load_cost. */ + 3, /* vec_unalign_load_cost. */ + 3, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 2, /* cond_not_taken_branch_cost. */ +}; + +/* AMDFAM10 has optimized REP instruction for medium sized blocks, but for + very small blocks it is better to use loop. For large blocks, libcall can + do nontemporary accesses and beat inline considerably. */ +static stringop_algs amdfam10_memcpy[2] = { + {libcall, {{6, loop, false}, {14, unrolled_loop, false}, + {-1, rep_prefix_4_byte, false}}}, + {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +static stringop_algs amdfam10_memset[2] = { + {libcall, {{8, loop, false}, {24, unrolled_loop, false}, + {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +struct processor_costs amdfam10_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (2), /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ + COSTS_N_INSNS (4), /* HI */ + COSTS_N_INSNS (3), /* SI */ + COSTS_N_INSNS (4), /* DI */ + COSTS_N_INSNS (5)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (19), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (35), /* HI */ + COSTS_N_INSNS (51), /* SI */ + COSTS_N_INSNS (83), /* DI */ + COSTS_N_INSNS (83)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 9, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {3, 4, 3}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {3, 4, 3}, /* cost of storing integer registers */ + 4, /* cost of reg,reg fld/fst */ + {4, 4, 12}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {6, 6, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {3, 3}, /* cost of loading MMX registers + in SImode and DImode */ + {4, 4}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {4, 4, 3}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {4, 4, 5}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 3, /* MMX or SSE register to integer */ + /* On K8: + MOVD reg64, xmmreg Double FSTORE 4 + MOVD reg32, xmmreg Double FSTORE 4 + On AMDFAM10: + MOVD reg64, xmmreg Double FADD 3 + 1/1 1/1 + MOVD reg32, xmmreg Double FADD 3 + 1/1 1/1 */ + 64, /* size of l1 cache. */ + 512, /* size of l2 cache. */ + 64, /* size of prefetch block */ + /* New AMD processors never drop prefetches; if they cannot be performed + immediately, they are queued. We set number of simultaneous prefetches + to a large constant to reflect this (it probably is not a good idea not + to limit number of prefetches at all, as their execution also takes some + time). */ + 100, /* number of parallel prefetches */ + 2, /* Branch cost */ + COSTS_N_INSNS (4), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (4), /* cost of FMUL instruction. */ + COSTS_N_INSNS (19), /* cost of FDIV instruction. */ + COSTS_N_INSNS (2), /* cost of FABS instruction. */ + COSTS_N_INSNS (2), /* cost of FCHS instruction. */ + COSTS_N_INSNS (35), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (2), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (4), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (4), /* cost of MULSS instruction. */ + COSTS_N_INSNS (4), /* cost of MULSD instruction. */ + COSTS_N_INSNS (8), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (8), /* cost of FMA SD instruction. */ + /* 11-16 */ + COSTS_N_INSNS (16), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (20), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (19), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (27), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + amdfam10_memcpy, + amdfam10_memset, + 4, /* scalar_stmt_cost. */ + 2, /* scalar load_cost. */ + 2, /* scalar_store_cost. */ + 6, /* vec_stmt_cost. */ + 0, /* vec_to_scalar_cost. */ + 2, /* scalar_to_vec_cost. */ + 2, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 2, /* vec_store_cost. */ + 2, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +/* BDVER1 has optimized REP instruction for medium sized blocks, but for + very small blocks it is better to use loop. For large blocks, libcall + can do nontemporary accesses and beat inline considerably. */ +static stringop_algs bdver1_memcpy[2] = { + {libcall, {{6, loop, false}, {14, unrolled_loop, false}, + {-1, rep_prefix_4_byte, false}}}, + {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +static stringop_algs bdver1_memset[2] = { + {libcall, {{8, loop, false}, {24, unrolled_loop, false}, + {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; + +const struct processor_costs bdver1_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (1), /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (4), /* cost of starting multiply for QI */ + COSTS_N_INSNS (4), /* HI */ + COSTS_N_INSNS (4), /* SI */ + COSTS_N_INSNS (6), /* DI */ + COSTS_N_INSNS (6)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (19), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (35), /* HI */ + COSTS_N_INSNS (51), /* SI */ + COSTS_N_INSNS (83), /* DI */ + COSTS_N_INSNS (83)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 9, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {5, 5, 4}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {4, 4, 4}, /* cost of storing integer registers */ + 2, /* cost of reg,reg fld/fst */ + {5, 5, 12}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {4, 4, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {4, 4}, /* cost of loading MMX registers + in SImode and DImode */ + {4, 4}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {4, 4, 4}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {4, 4, 4}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 2, /* MMX or SSE register to integer */ + /* On K8: + MOVD reg64, xmmreg Double FSTORE 4 + MOVD reg32, xmmreg Double FSTORE 4 + On AMDFAM10: + MOVD reg64, xmmreg Double FADD 3 + 1/1 1/1 + MOVD reg32, xmmreg Double FADD 3 + 1/1 1/1 */ + 16, /* size of l1 cache. */ + 2048, /* size of l2 cache. */ + 64, /* size of prefetch block */ + /* New AMD processors never drop prefetches; if they cannot be performed + immediately, they are queued. We set number of simultaneous prefetches + to a large constant to reflect this (it probably is not a good idea not + to limit number of prefetches at all, as their execution also takes some + time). */ + 100, /* number of parallel prefetches */ + 2, /* Branch cost */ + COSTS_N_INSNS (6), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (6), /* cost of FMUL instruction. */ + COSTS_N_INSNS (42), /* cost of FDIV instruction. */ + COSTS_N_INSNS (2), /* cost of FABS instruction. */ + COSTS_N_INSNS (2), /* cost of FCHS instruction. */ + COSTS_N_INSNS (52), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (2), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (6), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (6), /* cost of MULSS instruction. */ + COSTS_N_INSNS (6), /* cost of MULSD instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SD instruction. */ + /* 9-24 */ + COSTS_N_INSNS (24), /* cost of DIVSS instruction. */ + /* 9-27 */ + COSTS_N_INSNS (27), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (15), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (26), /* cost of SQRTSD instruction. */ + 1, 2, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + bdver1_memcpy, + bdver1_memset, + 6, /* scalar_stmt_cost. */ + 4, /* scalar load_cost. */ + 4, /* scalar_store_cost. */ + 6, /* vec_stmt_cost. */ + 0, /* vec_to_scalar_cost. */ + 2, /* scalar_to_vec_cost. */ + 4, /* vec_align_load_cost. */ + 4, /* vec_unalign_load_cost. */ + 4, /* vec_store_cost. */ + 4, /* cond_taken_branch_cost. */ + 2, /* cond_not_taken_branch_cost. */ +}; + +/* BDVER2 has optimized REP instruction for medium sized blocks, but for + very small blocks it is better to use loop. For large blocks, libcall + can do nontemporary accesses and beat inline considerably. */ + +static stringop_algs bdver2_memcpy[2] = { + {libcall, {{6, loop, false}, {14, unrolled_loop, false}, + {-1, rep_prefix_4_byte, false}}}, + {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +static stringop_algs bdver2_memset[2] = { + {libcall, {{8, loop, false}, {24, unrolled_loop, false}, + {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; + +const struct processor_costs bdver2_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (1), /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (4), /* cost of starting multiply for QI */ + COSTS_N_INSNS (4), /* HI */ + COSTS_N_INSNS (4), /* SI */ + COSTS_N_INSNS (6), /* DI */ + COSTS_N_INSNS (6)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (19), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (35), /* HI */ + COSTS_N_INSNS (51), /* SI */ + COSTS_N_INSNS (83), /* DI */ + COSTS_N_INSNS (83)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 9, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {5, 5, 4}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {4, 4, 4}, /* cost of storing integer registers */ + 2, /* cost of reg,reg fld/fst */ + {5, 5, 12}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {4, 4, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {4, 4}, /* cost of loading MMX registers + in SImode and DImode */ + {4, 4}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {4, 4, 4}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {4, 4, 4}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 2, /* MMX or SSE register to integer */ + /* On K8: + MOVD reg64, xmmreg Double FSTORE 4 + MOVD reg32, xmmreg Double FSTORE 4 + On AMDFAM10: + MOVD reg64, xmmreg Double FADD 3 + 1/1 1/1 + MOVD reg32, xmmreg Double FADD 3 + 1/1 1/1 */ + 16, /* size of l1 cache. */ + 2048, /* size of l2 cache. */ + 64, /* size of prefetch block */ + /* New AMD processors never drop prefetches; if they cannot be performed + immediately, they are queued. We set number of simultaneous prefetches + to a large constant to reflect this (it probably is not a good idea not + to limit number of prefetches at all, as their execution also takes some + time). */ + 100, /* number of parallel prefetches */ + 2, /* Branch cost */ + COSTS_N_INSNS (6), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (6), /* cost of FMUL instruction. */ + COSTS_N_INSNS (42), /* cost of FDIV instruction. */ + COSTS_N_INSNS (2), /* cost of FABS instruction. */ + COSTS_N_INSNS (2), /* cost of FCHS instruction. */ + COSTS_N_INSNS (52), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (2), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (6), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (6), /* cost of MULSS instruction. */ + COSTS_N_INSNS (6), /* cost of MULSD instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SD instruction. */ + /* 9-24 */ + COSTS_N_INSNS (24), /* cost of DIVSS instruction. */ + /* 9-27 */ + COSTS_N_INSNS (27), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (15), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (26), /* cost of SQRTSD instruction. */ + 1, 2, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + bdver2_memcpy, + bdver2_memset, + 6, /* scalar_stmt_cost. */ + 4, /* scalar load_cost. */ + 4, /* scalar_store_cost. */ + 6, /* vec_stmt_cost. */ + 0, /* vec_to_scalar_cost. */ + 2, /* scalar_to_vec_cost. */ + 4, /* vec_align_load_cost. */ + 4, /* vec_unalign_load_cost. */ + 4, /* vec_store_cost. */ + 4, /* cond_taken_branch_cost. */ + 2, /* cond_not_taken_branch_cost. */ +}; + + + /* BDVER3 has optimized REP instruction for medium sized blocks, but for + very small blocks it is better to use loop. For large blocks, libcall + can do nontemporary accesses and beat inline considerably. */ +static stringop_algs bdver3_memcpy[2] = { + {libcall, {{6, loop, false}, {14, unrolled_loop, false}, + {-1, rep_prefix_4_byte, false}}}, + {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +static stringop_algs bdver3_memset[2] = { + {libcall, {{8, loop, false}, {24, unrolled_loop, false}, + {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +struct processor_costs bdver3_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (1), /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (4), /* cost of starting multiply for QI */ + COSTS_N_INSNS (4), /* HI */ + COSTS_N_INSNS (4), /* SI */ + COSTS_N_INSNS (6), /* DI */ + COSTS_N_INSNS (6)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (19), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (35), /* HI */ + COSTS_N_INSNS (51), /* SI */ + COSTS_N_INSNS (83), /* DI */ + COSTS_N_INSNS (83)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 9, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {5, 5, 4}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {4, 4, 4}, /* cost of storing integer registers */ + 2, /* cost of reg,reg fld/fst */ + {5, 5, 12}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {4, 4, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {4, 4}, /* cost of loading MMX registers + in SImode and DImode */ + {4, 4}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {4, 4, 4}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {4, 4, 4}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 2, /* MMX or SSE register to integer */ + 16, /* size of l1 cache. */ + 2048, /* size of l2 cache. */ + 64, /* size of prefetch block */ + /* New AMD processors never drop prefetches; if they cannot be performed + immediately, they are queued. We set number of simultaneous prefetches + to a large constant to reflect this (it probably is not a good idea not + to limit number of prefetches at all, as their execution also takes some + time). */ + 100, /* number of parallel prefetches */ + 2, /* Branch cost */ + COSTS_N_INSNS (6), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (6), /* cost of FMUL instruction. */ + COSTS_N_INSNS (42), /* cost of FDIV instruction. */ + COSTS_N_INSNS (2), /* cost of FABS instruction. */ + COSTS_N_INSNS (2), /* cost of FCHS instruction. */ + COSTS_N_INSNS (52), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (2), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (6), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (6), /* cost of MULSS instruction. */ + COSTS_N_INSNS (6), /* cost of MULSD instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SD instruction. */ + /* 9-24 */ + COSTS_N_INSNS (24), /* cost of DIVSS instruction. */ + /* 9-27 */ + COSTS_N_INSNS (27), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (15), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (26), /* cost of SQRTSD instruction. */ + 1, 2, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + bdver3_memcpy, + bdver3_memset, + 6, /* scalar_stmt_cost. */ + 4, /* scalar load_cost. */ + 4, /* scalar_store_cost. */ + 6, /* vec_stmt_cost. */ + 0, /* vec_to_scalar_cost. */ + 2, /* scalar_to_vec_cost. */ + 4, /* vec_align_load_cost. */ + 4, /* vec_unalign_load_cost. */ + 4, /* vec_store_cost. */ + 4, /* cond_taken_branch_cost. */ + 2, /* cond_not_taken_branch_cost. */ +}; + +/* BDVER4 has optimized REP instruction for medium sized blocks, but for + very small blocks it is better to use loop. For large blocks, libcall + can do nontemporary accesses and beat inline considerably. */ +static stringop_algs bdver4_memcpy[2] = { + {libcall, {{6, loop, false}, {14, unrolled_loop, false}, + {-1, rep_prefix_4_byte, false}}}, + {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +static stringop_algs bdver4_memset[2] = { + {libcall, {{8, loop, false}, {24, unrolled_loop, false}, + {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +struct processor_costs bdver4_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (1), /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (4), /* cost of starting multiply for QI */ + COSTS_N_INSNS (4), /* HI */ + COSTS_N_INSNS (4), /* SI */ + COSTS_N_INSNS (6), /* DI */ + COSTS_N_INSNS (6)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (19), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (35), /* HI */ + COSTS_N_INSNS (51), /* SI */ + COSTS_N_INSNS (83), /* DI */ + COSTS_N_INSNS (83)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 9, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {5, 5, 4}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {4, 4, 4}, /* cost of storing integer registers */ + 2, /* cost of reg,reg fld/fst */ + {5, 5, 12}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {4, 4, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {4, 4}, /* cost of loading MMX registers + in SImode and DImode */ + {4, 4}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {4, 4, 4}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {4, 4, 4}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 2, /* MMX or SSE register to integer */ + 16, /* size of l1 cache. */ + 2048, /* size of l2 cache. */ + 64, /* size of prefetch block */ + /* New AMD processors never drop prefetches; if they cannot be performed + immediately, they are queued. We set number of simultaneous prefetches + to a large constant to reflect this (it probably is not a good idea not + to limit number of prefetches at all, as their execution also takes some + time). */ + 100, /* number of parallel prefetches */ + 2, /* Branch cost */ + COSTS_N_INSNS (6), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (6), /* cost of FMUL instruction. */ + COSTS_N_INSNS (42), /* cost of FDIV instruction. */ + COSTS_N_INSNS (2), /* cost of FABS instruction. */ + COSTS_N_INSNS (2), /* cost of FCHS instruction. */ + COSTS_N_INSNS (52), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (2), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (6), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (6), /* cost of MULSS instruction. */ + COSTS_N_INSNS (6), /* cost of MULSD instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SD instruction. */ + /* 9-24 */ + COSTS_N_INSNS (24), /* cost of DIVSS instruction. */ + /* 9-27 */ + COSTS_N_INSNS (27), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (15), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (26), /* cost of SQRTSD instruction. */ + 1, 2, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + bdver4_memcpy, + bdver4_memset, + 6, /* scalar_stmt_cost. */ + 4, /* scalar load_cost. */ + 4, /* scalar_store_cost. */ + 6, /* vec_stmt_cost. */ + 0, /* vec_to_scalar_cost. */ + 2, /* scalar_to_vec_cost. */ + 4, /* vec_align_load_cost. */ + 4, /* vec_unalign_load_cost. */ + 4, /* vec_store_cost. */ + 4, /* cond_taken_branch_cost. */ + 2, /* cond_not_taken_branch_cost. */ +}; + + +/* ZNVER1 has optimized REP instruction for medium sized blocks, but for + very small blocks it is better to use loop. For large blocks, libcall + can do nontemporary accesses and beat inline considerably. */ +static stringop_algs znver1_memcpy[2] = { + {libcall, {{6, loop, false}, {14, unrolled_loop, false}, + {-1, rep_prefix_4_byte, false}}}, + {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +static stringop_algs znver1_memset[2] = { + {libcall, {{8, loop, false}, {24, unrolled_loop, false}, + {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +struct processor_costs znver1_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction. */ + COSTS_N_INSNS (1), /* cost of a lea instruction. */ + COSTS_N_INSNS (1), /* variable shift costs. */ + COSTS_N_INSNS (1), /* constant shift costs. */ + {COSTS_N_INSNS (3), /* cost of starting multiply for QI. */ + COSTS_N_INSNS (3), /* HI. */ + COSTS_N_INSNS (3), /* SI. */ + COSTS_N_INSNS (3), /* DI. */ + COSTS_N_INSNS (3)}, /* other. */ + 0, /* cost of multiply per each bit + set. */ + /* Depending on parameters, idiv can get faster on ryzen. This is upper + bound. */ + {COSTS_N_INSNS (16), /* cost of a divide/mod for QI. */ + COSTS_N_INSNS (22), /* HI. */ + COSTS_N_INSNS (30), /* SI. */ + COSTS_N_INSNS (45), /* DI. */ + COSTS_N_INSNS (45)}, /* other. */ + COSTS_N_INSNS (1), /* cost of movsx. */ + COSTS_N_INSNS (1), /* cost of movzx. */ + 8, /* "large" insn. */ + 9, /* MOVE_RATIO. */ + + /* reg-reg moves are done by renaming and thus they are even cheaper than + 1 cycle. Becuase reg-reg move cost is 2 and the following tables correspond + to doubles of latencies, we do not model this correctly. It does not + seem to make practical difference to bump prices up even more. */ + 6, /* cost for loading QImode using + movzbl. */ + {6, 6, 6}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {8, 8, 8}, /* cost of storing integer + registers. */ + 2, /* cost of reg,reg fld/fst. */ + {6, 6, 16}, /* cost of loading fp registers + in SFmode, DFmode and XFmode. */ + {8, 8, 16}, /* cost of storing fp registers + in SFmode, DFmode and XFmode. */ + 2, /* cost of moving MMX register. */ + {6, 6}, /* cost of loading MMX registers + in SImode and DImode. */ + {8, 8}, /* cost of storing MMX registers + in SImode and DImode. */ + 2, /* cost of moving SSE register. */ + {6, 6, 6}, /* cost of loading SSE registers + in SImode, DImode and TImode. */ + {8, 8, 8}, /* cost of storing SSE registers + in SImode, DImode and TImode. */ + 6, /* MMX or SSE register to integer. */ + 32, /* size of l1 cache. */ + 512, /* size of l2 cache. */ + 64, /* size of prefetch block. */ + /* New AMD processors never drop prefetches; if they cannot be performed + immediately, they are queued. We set number of simultaneous prefetches + to a large constant to reflect this (it probably is not a good idea not + to limit number of prefetches at all, as their execution also takes some + time). */ + 100, /* number of parallel prefetches. */ + 3, /* Branch cost. */ + COSTS_N_INSNS (5), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (5), /* cost of FMUL instruction. */ + /* Latency of fdiv is 8-15. */ + COSTS_N_INSNS (15), /* cost of FDIV instruction. */ + COSTS_N_INSNS (1), /* cost of FABS instruction. */ + COSTS_N_INSNS (1), /* cost of FCHS instruction. */ + /* Latency of fsqrt is 4-10. */ + COSTS_N_INSNS (10), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (1), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (3), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (3), /* cost of MULSS instruction. */ + COSTS_N_INSNS (4), /* cost of MULSD instruction. */ + COSTS_N_INSNS (5), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (5), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (10), /* cost of DIVSS instruction. */ + /* 9-13 */ + COSTS_N_INSNS (13), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (10), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (15), /* cost of SQRTSD instruction. */ + /* Zen can execute 4 integer operations per cycle. FP operations take 3 cycles + and it can execute 2 integer additions and 2 multiplications thus + reassociation may make sense up to with of 6. SPEC2k6 bencharks suggests + that 4 works better than 6 probably due to register pressure. + + Integer vector operations are taken by FP unit and execute 3 vector + plus/minus operations per cycle but only one multiply. This is adjusted + in ix86_reassociation_width. */ + 4, 4, 3, 6, /* reassoc int, fp, vec_int, vec_fp. */ + znver1_memcpy, + znver1_memset, + 6, /* scalar_stmt_cost. */ + 4, /* scalar load_cost. */ + 4, /* scalar_store_cost. */ + 6, /* vec_stmt_cost. */ + 0, /* vec_to_scalar_cost. */ + 2, /* scalar_to_vec_cost. */ + 4, /* vec_align_load_cost. */ + 4, /* vec_unalign_load_cost. */ + 4, /* vec_store_cost. */ + 4, /* cond_taken_branch_cost. */ + 2, /* cond_not_taken_branch_cost. */ +}; + + /* BTVER1 has optimized REP instruction for medium sized blocks, but for + very small blocks it is better to use loop. For large blocks, libcall can + do nontemporary accesses and beat inline considerably. */ +static stringop_algs btver1_memcpy[2] = { + {libcall, {{6, loop, false}, {14, unrolled_loop, false}, + {-1, rep_prefix_4_byte, false}}}, + {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +static stringop_algs btver1_memset[2] = { + {libcall, {{8, loop, false}, {24, unrolled_loop, false}, + {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +const struct processor_costs btver1_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (2), /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ + COSTS_N_INSNS (4), /* HI */ + COSTS_N_INSNS (3), /* SI */ + COSTS_N_INSNS (4), /* DI */ + COSTS_N_INSNS (5)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (19), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (35), /* HI */ + COSTS_N_INSNS (51), /* SI */ + COSTS_N_INSNS (83), /* DI */ + COSTS_N_INSNS (83)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 9, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {3, 4, 3}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {3, 4, 3}, /* cost of storing integer registers */ + 4, /* cost of reg,reg fld/fst */ + {4, 4, 12}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {6, 6, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {3, 3}, /* cost of loading MMX registers + in SImode and DImode */ + {4, 4}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {4, 4, 3}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {4, 4, 5}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 3, /* MMX or SSE register to integer */ + /* On K8: + MOVD reg64, xmmreg Double FSTORE 4 + MOVD reg32, xmmreg Double FSTORE 4 + On AMDFAM10: + MOVD reg64, xmmreg Double FADD 3 + 1/1 1/1 + MOVD reg32, xmmreg Double FADD 3 + 1/1 1/1 */ + 32, /* size of l1 cache. */ + 512, /* size of l2 cache. */ + 64, /* size of prefetch block */ + 100, /* number of parallel prefetches */ + 2, /* Branch cost */ + COSTS_N_INSNS (4), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (4), /* cost of FMUL instruction. */ + COSTS_N_INSNS (19), /* cost of FDIV instruction. */ + COSTS_N_INSNS (2), /* cost of FABS instruction. */ + COSTS_N_INSNS (2), /* cost of FCHS instruction. */ + COSTS_N_INSNS (35), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (1), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (3), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (2), /* cost of MULSS instruction. */ + COSTS_N_INSNS (4), /* cost of MULSD instruction. */ + COSTS_N_INSNS (5), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (5), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (13), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (17), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (14), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (48), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + btver1_memcpy, + btver1_memset, + 4, /* scalar_stmt_cost. */ + 2, /* scalar load_cost. */ + 2, /* scalar_store_cost. */ + 6, /* vec_stmt_cost. */ + 0, /* vec_to_scalar_cost. */ + 2, /* scalar_to_vec_cost. */ + 2, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 2, /* vec_store_cost. */ + 2, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +static stringop_algs btver2_memcpy[2] = { + {libcall, {{6, loop, false}, {14, unrolled_loop, false}, + {-1, rep_prefix_4_byte, false}}}, + {libcall, {{16, loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +static stringop_algs btver2_memset[2] = { + {libcall, {{8, loop, false}, {24, unrolled_loop, false}, + {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + {libcall, {{48, unrolled_loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +const struct processor_costs btver2_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (2), /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ + COSTS_N_INSNS (4), /* HI */ + COSTS_N_INSNS (3), /* SI */ + COSTS_N_INSNS (4), /* DI */ + COSTS_N_INSNS (5)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (19), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (35), /* HI */ + COSTS_N_INSNS (51), /* SI */ + COSTS_N_INSNS (83), /* DI */ + COSTS_N_INSNS (83)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 9, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {3, 4, 3}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {3, 4, 3}, /* cost of storing integer registers */ + 4, /* cost of reg,reg fld/fst */ + {4, 4, 12}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {6, 6, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {3, 3}, /* cost of loading MMX registers + in SImode and DImode */ + {4, 4}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {4, 4, 3}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {4, 4, 5}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 3, /* MMX or SSE register to integer */ + /* On K8: + MOVD reg64, xmmreg Double FSTORE 4 + MOVD reg32, xmmreg Double FSTORE 4 + On AMDFAM10: + MOVD reg64, xmmreg Double FADD 3 + 1/1 1/1 + MOVD reg32, xmmreg Double FADD 3 + 1/1 1/1 */ + 32, /* size of l1 cache. */ + 2048, /* size of l2 cache. */ + 64, /* size of prefetch block */ + 100, /* number of parallel prefetches */ + 2, /* Branch cost */ + COSTS_N_INSNS (4), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (4), /* cost of FMUL instruction. */ + COSTS_N_INSNS (19), /* cost of FDIV instruction. */ + COSTS_N_INSNS (2), /* cost of FABS instruction. */ + COSTS_N_INSNS (2), /* cost of FCHS instruction. */ + COSTS_N_INSNS (35), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (1), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (3), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (2), /* cost of MULSS instruction. */ + COSTS_N_INSNS (4), /* cost of MULSD instruction. */ + COSTS_N_INSNS (5), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (5), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (13), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (19), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (16), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (21), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + btver2_memcpy, + btver2_memset, + 4, /* scalar_stmt_cost. */ + 2, /* scalar load_cost. */ + 2, /* scalar_store_cost. */ + 6, /* vec_stmt_cost. */ + 0, /* vec_to_scalar_cost. */ + 2, /* scalar_to_vec_cost. */ + 2, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 2, /* vec_store_cost. */ + 2, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +static stringop_algs pentium4_memcpy[2] = { + {libcall, {{12, loop_1_byte, false}, {-1, rep_prefix_4_byte, false}}}, + DUMMY_STRINGOP_ALGS}; +static stringop_algs pentium4_memset[2] = { + {libcall, {{6, loop_1_byte, false}, {48, loop, false}, + {20480, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + DUMMY_STRINGOP_ALGS}; + +static const +struct processor_costs pentium4_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (3), /* cost of a lea instruction */ + COSTS_N_INSNS (4), /* variable shift costs */ + COSTS_N_INSNS (4), /* constant shift costs */ + {COSTS_N_INSNS (15), /* cost of starting multiply for QI */ + COSTS_N_INSNS (15), /* HI */ + COSTS_N_INSNS (15), /* SI */ + COSTS_N_INSNS (15), /* DI */ + COSTS_N_INSNS (15)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (56), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (56), /* HI */ + COSTS_N_INSNS (56), /* SI */ + COSTS_N_INSNS (56), /* DI */ + COSTS_N_INSNS (56)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 16, /* "large" insn */ + 6, /* MOVE_RATIO */ + 2, /* cost for loading QImode using movzbl */ + {4, 5, 4}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {2, 3, 2}, /* cost of storing integer registers */ + 2, /* cost of reg,reg fld/fst */ + {2, 2, 6}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {4, 4, 6}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {2, 2}, /* cost of loading MMX registers + in SImode and DImode */ + {2, 2}, /* cost of storing MMX registers + in SImode and DImode */ + 12, /* cost of moving SSE register */ + {12, 12, 12}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {2, 2, 8}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 10, /* MMX or SSE register to integer */ + 8, /* size of l1 cache. */ + 256, /* size of l2 cache. */ + 64, /* size of prefetch block */ + 6, /* number of parallel prefetches */ + 2, /* Branch cost */ + COSTS_N_INSNS (5), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (7), /* cost of FMUL instruction. */ + COSTS_N_INSNS (43), /* cost of FDIV instruction. */ + COSTS_N_INSNS (2), /* cost of FABS instruction. */ + COSTS_N_INSNS (2), /* cost of FCHS instruction. */ + COSTS_N_INSNS (43), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (2), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (4), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (6), /* cost of MULSS instruction. */ + COSTS_N_INSNS (6), /* cost of MULSD instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (23), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (38), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (23), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (38), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + pentium4_memcpy, + pentium4_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 1, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +static stringop_algs nocona_memcpy[2] = { + {libcall, {{12, loop_1_byte, false}, {-1, rep_prefix_4_byte, false}}}, + {libcall, {{32, loop, false}, {20000, rep_prefix_8_byte, false}, + {100000, unrolled_loop, false}, {-1, libcall, false}}}}; + +static stringop_algs nocona_memset[2] = { + {libcall, {{6, loop_1_byte, false}, {48, loop, false}, + {20480, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + {libcall, {{24, loop, false}, {64, unrolled_loop, false}, + {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; + +static const +struct processor_costs nocona_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (1), /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (10), /* cost of starting multiply for QI */ + COSTS_N_INSNS (10), /* HI */ + COSTS_N_INSNS (10), /* SI */ + COSTS_N_INSNS (10), /* DI */ + COSTS_N_INSNS (10)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (66), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (66), /* HI */ + COSTS_N_INSNS (66), /* SI */ + COSTS_N_INSNS (66), /* DI */ + COSTS_N_INSNS (66)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 16, /* "large" insn */ + 17, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {4, 4, 4}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {4, 4, 4}, /* cost of storing integer registers */ + 3, /* cost of reg,reg fld/fst */ + {12, 12, 12}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {4, 4, 4}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 6, /* cost of moving MMX register */ + {12, 12}, /* cost of loading MMX registers + in SImode and DImode */ + {12, 12}, /* cost of storing MMX registers + in SImode and DImode */ + 6, /* cost of moving SSE register */ + {12, 12, 12}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {12, 12, 12}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 8, /* MMX or SSE register to integer */ + 8, /* size of l1 cache. */ + 1024, /* size of l2 cache. */ + 64, /* size of prefetch block */ + 8, /* number of parallel prefetches */ + 1, /* Branch cost */ + COSTS_N_INSNS (6), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (8), /* cost of FMUL instruction. */ + COSTS_N_INSNS (40), /* cost of FDIV instruction. */ + COSTS_N_INSNS (3), /* cost of FABS instruction. */ + COSTS_N_INSNS (3), /* cost of FCHS instruction. */ + COSTS_N_INSNS (44), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (2), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (5), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (7), /* cost of MULSS instruction. */ + COSTS_N_INSNS (7), /* cost of MULSD instruction. */ + COSTS_N_INSNS (7), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (7), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (32), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (40), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (32), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (41), /* cost of SQRTSD instruction. */ + 1, 1, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + nocona_memcpy, + nocona_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 1, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +static stringop_algs atom_memcpy[2] = { + {libcall, {{11, loop, false}, {-1, rep_prefix_4_byte, false}}}, + {libcall, {{32, loop, false}, {64, rep_prefix_4_byte, false}, + {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; +static stringop_algs atom_memset[2] = { + {libcall, {{8, loop, false}, {15, unrolled_loop, false}, + {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + {libcall, {{24, loop, false}, {32, unrolled_loop, false}, + {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; +static const +struct processor_costs atom_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (1) + 1, /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ + COSTS_N_INSNS (4), /* HI */ + COSTS_N_INSNS (3), /* SI */ + COSTS_N_INSNS (4), /* DI */ + COSTS_N_INSNS (2)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (26), /* HI */ + COSTS_N_INSNS (42), /* SI */ + COSTS_N_INSNS (74), /* DI */ + COSTS_N_INSNS (74)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 17, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {4, 4, 4}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {4, 4, 4}, /* cost of storing integer registers */ + 4, /* cost of reg,reg fld/fst */ + {12, 12, 12}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {6, 6, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {8, 8}, /* cost of loading MMX registers + in SImode and DImode */ + {8, 8}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {8, 8, 8}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {8, 8, 8}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 5, /* MMX or SSE register to integer */ + 32, /* size of l1 cache. */ + 256, /* size of l2 cache. */ + 64, /* size of prefetch block */ + 6, /* number of parallel prefetches */ + 3, /* Branch cost */ + COSTS_N_INSNS (8), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (8), /* cost of FMUL instruction. */ + COSTS_N_INSNS (20), /* cost of FDIV instruction. */ + COSTS_N_INSNS (8), /* cost of FABS instruction. */ + COSTS_N_INSNS (8), /* cost of FCHS instruction. */ + COSTS_N_INSNS (40), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (1), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (5), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (4), /* cost of MULSS instruction. */ + COSTS_N_INSNS (5), /* cost of MULSD instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (31), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (60), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (31), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (63), /* cost of SQRTSD instruction. */ + 2, 2, 2, 2, /* reassoc int, fp, vec_int, vec_fp. */ + atom_memcpy, + atom_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 1, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +static stringop_algs slm_memcpy[2] = { + {libcall, {{11, loop, false}, {-1, rep_prefix_4_byte, false}}}, + {libcall, {{32, loop, false}, {64, rep_prefix_4_byte, false}, + {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; +static stringop_algs slm_memset[2] = { + {libcall, {{8, loop, false}, {15, unrolled_loop, false}, + {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + {libcall, {{24, loop, false}, {32, unrolled_loop, false}, + {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; +static const +struct processor_costs slm_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (1) + 1, /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ + COSTS_N_INSNS (3), /* HI */ + COSTS_N_INSNS (3), /* SI */ + COSTS_N_INSNS (4), /* DI */ + COSTS_N_INSNS (2)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (26), /* HI */ + COSTS_N_INSNS (42), /* SI */ + COSTS_N_INSNS (74), /* DI */ + COSTS_N_INSNS (74)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 17, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {4, 4, 4}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {4, 4, 4}, /* cost of storing integer registers */ + 4, /* cost of reg,reg fld/fst */ + {12, 12, 12}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {6, 6, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {8, 8}, /* cost of loading MMX registers + in SImode and DImode */ + {8, 8}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {8, 8, 8}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {8, 8, 8}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 5, /* MMX or SSE register to integer */ + 32, /* size of l1 cache. */ + 256, /* size of l2 cache. */ + 64, /* size of prefetch block */ + 6, /* number of parallel prefetches */ + 3, /* Branch cost */ + COSTS_N_INSNS (8), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (8), /* cost of FMUL instruction. */ + COSTS_N_INSNS (20), /* cost of FDIV instruction. */ + COSTS_N_INSNS (8), /* cost of FABS instruction. */ + COSTS_N_INSNS (8), /* cost of FCHS instruction. */ + COSTS_N_INSNS (40), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (1), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (3), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (4), /* cost of MULSS instruction. */ + COSTS_N_INSNS (5), /* cost of MULSD instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (39), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (69), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (20), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (35), /* cost of SQRTSD instruction. */ + 1, 2, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + slm_memcpy, + slm_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 4, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +static stringop_algs intel_memcpy[2] = { + {libcall, {{11, loop, false}, {-1, rep_prefix_4_byte, false}}}, + {libcall, {{32, loop, false}, {64, rep_prefix_4_byte, false}, + {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; +static stringop_algs intel_memset[2] = { + {libcall, {{8, loop, false}, {15, unrolled_loop, false}, + {2048, rep_prefix_4_byte, false}, {-1, libcall, false}}}, + {libcall, {{24, loop, false}, {32, unrolled_loop, false}, + {8192, rep_prefix_8_byte, false}, {-1, libcall, false}}}}; +static const +struct processor_costs intel_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + COSTS_N_INSNS (1) + 1, /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ + COSTS_N_INSNS (3), /* HI */ + COSTS_N_INSNS (3), /* SI */ + COSTS_N_INSNS (4), /* DI */ + COSTS_N_INSNS (2)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (26), /* HI */ + COSTS_N_INSNS (42), /* SI */ + COSTS_N_INSNS (74), /* DI */ + COSTS_N_INSNS (74)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 17, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {4, 4, 4}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {4, 4, 4}, /* cost of storing integer registers */ + 4, /* cost of reg,reg fld/fst */ + {12, 12, 12}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {6, 6, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {8, 8}, /* cost of loading MMX registers + in SImode and DImode */ + {8, 8}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {8, 8, 8}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {8, 8, 8}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 5, /* MMX or SSE register to integer */ + 32, /* size of l1 cache. */ + 256, /* size of l2 cache. */ + 64, /* size of prefetch block */ + 6, /* number of parallel prefetches */ + 3, /* Branch cost */ + COSTS_N_INSNS (8), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (8), /* cost of FMUL instruction. */ + COSTS_N_INSNS (20), /* cost of FDIV instruction. */ + COSTS_N_INSNS (8), /* cost of FABS instruction. */ + COSTS_N_INSNS (8), /* cost of FCHS instruction. */ + COSTS_N_INSNS (40), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (8), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (8), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (8), /* cost of MULSS instruction. */ + COSTS_N_INSNS (8), /* cost of MULSD instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (6), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (20), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (20), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (40), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (40), /* cost of SQRTSD instruction. */ + 1, 4, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + intel_memcpy, + intel_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 4, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +/* Generic should produce code tuned for Core-i7 (and newer chips) + and btver1 (and newer chips). */ + +static stringop_algs generic_memcpy[2] = { + {libcall, {{32, loop, false}, {8192, rep_prefix_4_byte, false}, + {-1, libcall, false}}}, + {libcall, {{32, loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +static stringop_algs generic_memset[2] = { + {libcall, {{32, loop, false}, {8192, rep_prefix_4_byte, false}, + {-1, libcall, false}}}, + {libcall, {{32, loop, false}, {8192, rep_prefix_8_byte, false}, + {-1, libcall, false}}}}; +static const +struct processor_costs generic_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + /* Setting cost to 2 makes our current implementation of synth_mult result in + use of unnecessary temporary registers causing regression on several + SPECfp benchmarks. */ + COSTS_N_INSNS (1) + 1, /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ + COSTS_N_INSNS (4), /* HI */ + COSTS_N_INSNS (3), /* SI */ + COSTS_N_INSNS (4), /* DI */ + COSTS_N_INSNS (2)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (18), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (26), /* HI */ + COSTS_N_INSNS (42), /* SI */ + COSTS_N_INSNS (74), /* DI */ + COSTS_N_INSNS (74)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 17, /* MOVE_RATIO */ + 4, /* cost for loading QImode using movzbl */ + {4, 4, 4}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {4, 4, 4}, /* cost of storing integer registers */ + 4, /* cost of reg,reg fld/fst */ + {12, 12, 12}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {6, 6, 8}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {8, 8}, /* cost of loading MMX registers + in SImode and DImode */ + {8, 8}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {8, 8, 8}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {8, 8, 8}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 5, /* MMX or SSE register to integer */ + 32, /* size of l1 cache. */ + 512, /* size of l2 cache. */ + 64, /* size of prefetch block */ + 6, /* number of parallel prefetches */ + /* Benchmarks shows large regressions on K8 sixtrack benchmark when this + value is increased to perhaps more appropriate value of 5. */ + 3, /* Branch cost */ + COSTS_N_INSNS (3), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (3), /* cost of FMUL instruction. */ + COSTS_N_INSNS (20), /* cost of FDIV instruction. */ + COSTS_N_INSNS (1), /* cost of FABS instruction. */ + COSTS_N_INSNS (1), /* cost of FCHS instruction. */ + COSTS_N_INSNS (40), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (1), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (3), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (4), /* cost of MULSS instruction. */ + COSTS_N_INSNS (5), /* cost of MULSD instruction. */ + COSTS_N_INSNS (5), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (5), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (18), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (32), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (30), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (58), /* cost of SQRTSD instruction. */ + 1, 2, 1, 1, /* reassoc int, fp, vec_int, vec_fp. */ + generic_memcpy, + generic_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 1, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + +/* core_cost should produce code tuned for Core familly of CPUs. */ +static stringop_algs core_memcpy[2] = { + {libcall, {{1024, rep_prefix_4_byte, true}, {-1, libcall, false}}}, + {libcall, {{24, loop, true}, {128, rep_prefix_8_byte, true}, + {-1, libcall, false}}}}; +static stringop_algs core_memset[2] = { + {libcall, {{6, loop_1_byte, true}, + {24, loop, true}, + {8192, rep_prefix_4_byte, true}, + {-1, libcall, false}}}, + {libcall, {{24, loop, true}, {512, rep_prefix_8_byte, true}, + {-1, libcall, false}}}}; + +static const +struct processor_costs core_cost = { + COSTS_N_INSNS (1), /* cost of an add instruction */ + /* On all chips taken into consideration lea is 2 cycles and more. With + this cost however our current implementation of synth_mult results in + use of unnecessary temporary registers causing regression on several + SPECfp benchmarks. */ + COSTS_N_INSNS (1) + 1, /* cost of a lea instruction */ + COSTS_N_INSNS (1), /* variable shift costs */ + COSTS_N_INSNS (1), /* constant shift costs */ + {COSTS_N_INSNS (3), /* cost of starting multiply for QI */ + COSTS_N_INSNS (4), /* HI */ + COSTS_N_INSNS (3), /* SI */ + COSTS_N_INSNS (4), /* DI */ + COSTS_N_INSNS (4)}, /* other */ + 0, /* cost of multiply per each bit set */ + {COSTS_N_INSNS (8), /* cost of a divide/mod for QI */ + COSTS_N_INSNS (8), /* HI */ + /* 8-11 */ + COSTS_N_INSNS (11), /* SI */ + /* 24-81 */ + COSTS_N_INSNS (81), /* DI */ + COSTS_N_INSNS (81)}, /* other */ + COSTS_N_INSNS (1), /* cost of movsx */ + COSTS_N_INSNS (1), /* cost of movzx */ + 8, /* "large" insn */ + 17, /* MOVE_RATIO */ + 6, /* cost for loading QImode using movzbl */ + {4, 4, 4}, /* cost of loading integer registers + in QImode, HImode and SImode. + Relative to reg-reg move (2). */ + {6, 6, 6}, /* cost of storing integer registers */ + 2, /* cost of reg,reg fld/fst */ + {6, 6, 8}, /* cost of loading fp registers + in SFmode, DFmode and XFmode */ + {8, 6, 10}, /* cost of storing fp registers + in SFmode, DFmode and XFmode */ + 2, /* cost of moving MMX register */ + {6, 6}, /* cost of loading MMX registers + in SImode and DImode */ + {6, 6}, /* cost of storing MMX registers + in SImode and DImode */ + 2, /* cost of moving SSE register */ + {6, 6, 6}, /* cost of loading SSE registers + in SImode, DImode and TImode */ + {6, 6, 6}, /* cost of storing SSE registers + in SImode, DImode and TImode */ + 2, /* MMX or SSE register to integer */ + 64, /* size of l1 cache. */ + 512, /* size of l2 cache. */ + 64, /* size of prefetch block */ + 6, /* number of parallel prefetches */ + /* FIXME perhaps more appropriate value is 5. */ + 3, /* Branch cost */ + COSTS_N_INSNS (3), /* cost of FADD and FSUB insns. */ + COSTS_N_INSNS (5), /* cost of FMUL instruction. */ + /* 10-24 */ + COSTS_N_INSNS (24), /* cost of FDIV instruction. */ + COSTS_N_INSNS (1), /* cost of FABS instruction. */ + COSTS_N_INSNS (1), /* cost of FCHS instruction. */ + COSTS_N_INSNS (23), /* cost of FSQRT instruction. */ + + COSTS_N_INSNS (1), /* cost of cheap SSE instruction. */ + COSTS_N_INSNS (3), /* cost of ADDSS/SD SUBSS/SD insns. */ + COSTS_N_INSNS (4), /* cost of MULSS instruction. */ + COSTS_N_INSNS (5), /* cost of MULSD instruction. */ + COSTS_N_INSNS (5), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (5), /* cost of FMA SD instruction. */ + COSTS_N_INSNS (18), /* cost of DIVSS instruction. */ + COSTS_N_INSNS (32), /* cost of DIVSD instruction. */ + COSTS_N_INSNS (30), /* cost of SQRTSS instruction. */ + COSTS_N_INSNS (58), /* cost of SQRTSD instruction. */ + 1, 4, 2, 2, /* reassoc int, fp, vec_int, vec_fp. */ + core_memcpy, + core_memset, + 1, /* scalar_stmt_cost. */ + 1, /* scalar load_cost. */ + 1, /* scalar_store_cost. */ + 1, /* vec_stmt_cost. */ + 1, /* vec_to_scalar_cost. */ + 1, /* scalar_to_vec_cost. */ + 1, /* vec_align_load_cost. */ + 2, /* vec_unalign_load_cost. */ + 1, /* vec_store_cost. */ + 3, /* cond_taken_branch_cost. */ + 1, /* cond_not_taken_branch_cost. */ +}; + diff --git a/gcc/config/i386/x86-tune-sched-atom.c b/gcc/config/i386/x86-tune-sched-atom.c new file mode 100644 index 0000000000000..86942c0703d5e --- /dev/null +++ b/gcc/config/i386/x86-tune-sched-atom.c @@ -0,0 +1,244 @@ +/* Scheduler hooks for IA-32 which implement atom+ specific logic. + Copyright (C) 1988-2017 Free Software Foundation, Inc. + +This file is part of GCC. + +GCC is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +GCC is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GCC; see the file COPYING3. If not see +. */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "backend.h" +#include "rtl.h" +#include "tree.h" +#include "cfghooks.h" +#include "tm_p.h" +#include "insn-config.h" +#include "insn-attr.h" +#include "recog.h" +#include "target.h" +#include "rtl-iter.h" +#include "regset.h" +#include "sched-int.h" + +/* Try to reorder ready list to take advantage of Atom pipelined IMUL + execution. It is applied if + (1) IMUL instruction is on the top of list; + (2) There exists the only producer of independent IMUL instruction in + ready list. + Return index of IMUL producer if it was found and -1 otherwise. */ +static int +do_reorder_for_imul (rtx_insn **ready, int n_ready) +{ + rtx_insn *insn; + rtx set, insn1, insn2; + sd_iterator_def sd_it; + dep_t dep; + int index = -1; + int i; + + if (!TARGET_BONNELL) + return index; + + /* Check that IMUL instruction is on the top of ready list. */ + insn = ready[n_ready - 1]; + set = single_set (insn); + if (!set) + return index; + if (!(GET_CODE (SET_SRC (set)) == MULT + && GET_MODE (SET_SRC (set)) == SImode)) + return index; + + /* Search for producer of independent IMUL instruction. */ + for (i = n_ready - 2; i >= 0; i--) + { + insn = ready[i]; + if (!NONDEBUG_INSN_P (insn)) + continue; + /* Skip IMUL instruction. */ + insn2 = PATTERN (insn); + if (GET_CODE (insn2) == PARALLEL) + insn2 = XVECEXP (insn2, 0, 0); + if (GET_CODE (insn2) == SET + && GET_CODE (SET_SRC (insn2)) == MULT + && GET_MODE (SET_SRC (insn2)) == SImode) + continue; + + FOR_EACH_DEP (insn, SD_LIST_FORW, sd_it, dep) + { + rtx con; + con = DEP_CON (dep); + if (!NONDEBUG_INSN_P (con)) + continue; + insn1 = PATTERN (con); + if (GET_CODE (insn1) == PARALLEL) + insn1 = XVECEXP (insn1, 0, 0); + + if (GET_CODE (insn1) == SET + && GET_CODE (SET_SRC (insn1)) == MULT + && GET_MODE (SET_SRC (insn1)) == SImode) + { + sd_iterator_def sd_it1; + dep_t dep1; + /* Check if there is no other dependee for IMUL. */ + index = i; + FOR_EACH_DEP (con, SD_LIST_BACK, sd_it1, dep1) + { + rtx pro; + pro = DEP_PRO (dep1); + if (!NONDEBUG_INSN_P (pro)) + continue; + if (pro != insn) + index = -1; + } + if (index >= 0) + break; + } + } + if (index >= 0) + break; + } + return index; +} + +/* Try to find the best candidate on the top of ready list if two insns + have the same priority - candidate is best if its dependees were + scheduled earlier. Applied for Silvermont only. + Return true if top 2 insns must be interchanged. */ +static bool +swap_top_of_ready_list (rtx_insn **ready, int n_ready) +{ + rtx_insn *top = ready[n_ready - 1]; + rtx_insn *next = ready[n_ready - 2]; + rtx set; + sd_iterator_def sd_it; + dep_t dep; + int clock1 = -1; + int clock2 = -1; + #define INSN_TICK(INSN) (HID (INSN)->tick) + + if (!TARGET_SILVERMONT && !TARGET_INTEL) + return false; + + if (!NONDEBUG_INSN_P (top)) + return false; + if (!NONJUMP_INSN_P (top)) + return false; + if (!NONDEBUG_INSN_P (next)) + return false; + if (!NONJUMP_INSN_P (next)) + return false; + set = single_set (top); + if (!set) + return false; + set = single_set (next); + if (!set) + return false; + + if (INSN_PRIORITY_KNOWN (top) && INSN_PRIORITY_KNOWN (next)) + { + if (INSN_PRIORITY (top) != INSN_PRIORITY (next)) + return false; + /* Determine winner more precise. */ + FOR_EACH_DEP (top, SD_LIST_RES_BACK, sd_it, dep) + { + rtx pro; + pro = DEP_PRO (dep); + if (!NONDEBUG_INSN_P (pro)) + continue; + if (INSN_TICK (pro) > clock1) + clock1 = INSN_TICK (pro); + } + FOR_EACH_DEP (next, SD_LIST_RES_BACK, sd_it, dep) + { + rtx pro; + pro = DEP_PRO (dep); + if (!NONDEBUG_INSN_P (pro)) + continue; + if (INSN_TICK (pro) > clock2) + clock2 = INSN_TICK (pro); + } + + if (clock1 == clock2) + { + /* Determine winner - load must win. */ + enum attr_memory memory1, memory2; + memory1 = get_attr_memory (top); + memory2 = get_attr_memory (next); + if (memory2 == MEMORY_LOAD && memory1 != MEMORY_LOAD) + return true; + } + return (bool) (clock2 < clock1); + } + return false; + #undef INSN_TICK +} + +/* Perform possible reodering of ready list for Atom/Silvermont only. + Return issue rate. */ +int +ix86_atom_sched_reorder (FILE *dump, int sched_verbose, rtx_insn **ready, + int *pn_ready, int clock_var) +{ + int issue_rate = -1; + int n_ready = *pn_ready; + int i; + rtx_insn *insn; + int index = -1; + + /* Set up issue rate. */ + issue_rate = ix86_issue_rate (); + + /* Do reodering for BONNELL/SILVERMONT only. */ + if (!TARGET_BONNELL && !TARGET_SILVERMONT && !TARGET_INTEL) + return issue_rate; + + /* Nothing to do if ready list contains only 1 instruction. */ + if (n_ready <= 1) + return issue_rate; + + /* Do reodering for post-reload scheduler only. */ + if (!reload_completed) + return issue_rate; + + if ((index = do_reorder_for_imul (ready, n_ready)) >= 0) + { + if (sched_verbose > 1) + fprintf (dump, ";;\tatom sched_reorder: put %d insn on top\n", + INSN_UID (ready[index])); + + /* Put IMUL producer (ready[index]) at the top of ready list. */ + insn = ready[index]; + for (i = index; i < n_ready - 1; i++) + ready[i] = ready[i + 1]; + ready[n_ready - 1] = insn; + return issue_rate; + } + + /* Skip selective scheduling since HID is not populated in it. */ + if (clock_var != 0 + && !sel_sched_p () + && swap_top_of_ready_list (ready, n_ready)) + { + if (sched_verbose > 1) + fprintf (dump, ";;\tslm sched_reorder: swap %d and %d insns\n", + INSN_UID (ready[n_ready - 1]), INSN_UID (ready[n_ready - 2])); + /* Swap 2 top elements of ready list. */ + insn = ready[n_ready - 1]; + ready[n_ready - 1] = ready[n_ready - 2]; + ready[n_ready - 2] = insn; + } + return issue_rate; +} diff --git a/gcc/config/i386/x86-tune-sched-bd.c b/gcc/config/i386/x86-tune-sched-bd.c new file mode 100644 index 0000000000000..c862fc156e218 --- /dev/null +++ b/gcc/config/i386/x86-tune-sched-bd.c @@ -0,0 +1,822 @@ +/* Scheduler hooks for IA-32 which implement bdver1-4 specific logic. + Copyright (C) 1988-2017 Free Software Foundation, Inc. + +This file is part of GCC. + +GCC is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +GCC is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GCC; see the file COPYING3. If not see +. */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "backend.h" +#include "rtl.h" +#include "tree.h" +#include "cfghooks.h" +#include "tm_p.h" +#include "insn-config.h" +#include "insn-attr.h" +#include "recog.h" +#include "target.h" +#include "rtl-iter.h" +#include "regset.h" +#include "sched-int.h" + +/* The size of the dispatch window is the total number of bytes of + object code allowed in a window. */ +#define DISPATCH_WINDOW_SIZE 16 + +/* Number of dispatch windows considered for scheduling. */ +#define MAX_DISPATCH_WINDOWS 3 + +/* Maximum number of instructions in a window. */ +#define MAX_INSN 4 + +/* Maximum number of immediate operands in a window. */ +#define MAX_IMM 4 + +/* Maximum number of immediate bits allowed in a window. */ +#define MAX_IMM_SIZE 128 + +/* Maximum number of 32 bit immediates allowed in a window. */ +#define MAX_IMM_32 4 + +/* Maximum number of 64 bit immediates allowed in a window. */ +#define MAX_IMM_64 2 + +/* Maximum total of loads or prefetches allowed in a window. */ +#define MAX_LOAD 2 + +/* Maximum total of stores allowed in a window. */ +#define MAX_STORE 1 + +#undef BIG +#define BIG 100 + + +/* Dispatch groups. Istructions that affect the mix in a dispatch window. */ +enum dispatch_group { + disp_no_group = 0, + disp_load, + disp_store, + disp_load_store, + disp_prefetch, + disp_imm, + disp_imm_32, + disp_imm_64, + disp_branch, + disp_cmp, + disp_jcc, + disp_last +}; + +/* Number of allowable groups in a dispatch window. It is an array + indexed by dispatch_group enum. 100 is used as a big number, + because the number of these kind of operations does not have any + effect in dispatch window, but we need them for other reasons in + the table. */ +static unsigned int num_allowable_groups[disp_last] = { + 0, 2, 1, 1, 2, 4, 4, 2, 1, BIG, BIG +}; + +char group_name[disp_last + 1][16] = { + "disp_no_group", "disp_load", "disp_store", "disp_load_store", + "disp_prefetch", "disp_imm", "disp_imm_32", "disp_imm_64", + "disp_branch", "disp_cmp", "disp_jcc", "disp_last" +}; + +/* Instruction path. */ +enum insn_path { + no_path = 0, + path_single, /* Single micro op. */ + path_double, /* Double micro op. */ + path_multi, /* Instructions with more than 2 micro op.. */ + last_path +}; + +/* sched_insn_info defines a window to the instructions scheduled in + the basic block. It contains a pointer to the insn_info table and + the instruction scheduled. + + Windows are allocated for each basic block and are linked + together. */ +typedef struct sched_insn_info_s { + rtx insn; + enum dispatch_group group; + enum insn_path path; + int byte_len; + int imm_bytes; +} sched_insn_info; + +/* Linked list of dispatch windows. This is a two way list of + dispatch windows of a basic block. It contains information about + the number of uops in the window and the total number of + instructions and of bytes in the object code for this dispatch + window. */ +typedef struct dispatch_windows_s { + int num_insn; /* Number of insn in the window. */ + int num_uops; /* Number of uops in the window. */ + int window_size; /* Number of bytes in the window. */ + int window_num; /* Window number between 0 or 1. */ + int num_imm; /* Number of immediates in an insn. */ + int num_imm_32; /* Number of 32 bit immediates in an insn. */ + int num_imm_64; /* Number of 64 bit immediates in an insn. */ + int imm_size; /* Total immediates in the window. */ + int num_loads; /* Total memory loads in the window. */ + int num_stores; /* Total memory stores in the window. */ + int violation; /* Violation exists in window. */ + sched_insn_info *window; /* Pointer to the window. */ + struct dispatch_windows_s *next; + struct dispatch_windows_s *prev; +} dispatch_windows; + +/* Immediate valuse used in an insn. */ +typedef struct imm_info_s + { + int imm; + int imm32; + int imm64; + } imm_info; + +static dispatch_windows *dispatch_window_list; +static dispatch_windows *dispatch_window_list1; + +/* Get dispatch group of insn. */ + +static enum dispatch_group +get_mem_group (rtx_insn *insn) +{ + enum attr_memory memory; + + if (INSN_CODE (insn) < 0) + return disp_no_group; + memory = get_attr_memory (insn); + if (memory == MEMORY_STORE) + return disp_store; + + if (memory == MEMORY_LOAD) + return disp_load; + + if (memory == MEMORY_BOTH) + return disp_load_store; + + return disp_no_group; +} + +/* Return true if insn is a compare instruction. */ + +static bool +is_cmp (rtx_insn *insn) +{ + enum attr_type type; + + type = get_attr_type (insn); + return (type == TYPE_TEST + || type == TYPE_ICMP + || type == TYPE_FCMP + || GET_CODE (PATTERN (insn)) == COMPARE); +} + +/* Return true if a dispatch violation encountered. */ + +static bool +dispatch_violation (void) +{ + if (dispatch_window_list->next) + return dispatch_window_list->next->violation; + return dispatch_window_list->violation; +} + +/* Return true if insn is a branch instruction. */ + +static bool +is_branch (rtx_insn *insn) +{ + return (CALL_P (insn) || JUMP_P (insn)); +} + +/* Return true if insn is a prefetch instruction. */ + +static bool +is_prefetch (rtx_insn *insn) +{ + return NONJUMP_INSN_P (insn) && GET_CODE (PATTERN (insn)) == PREFETCH; +} + +/* This function initializes a dispatch window and the list container holding a + pointer to the window. */ + +static void +init_window (int window_num) +{ + int i; + dispatch_windows *new_list; + + if (window_num == 0) + new_list = dispatch_window_list; + else + new_list = dispatch_window_list1; + + new_list->num_insn = 0; + new_list->num_uops = 0; + new_list->window_size = 0; + new_list->next = NULL; + new_list->prev = NULL; + new_list->window_num = window_num; + new_list->num_imm = 0; + new_list->num_imm_32 = 0; + new_list->num_imm_64 = 0; + new_list->imm_size = 0; + new_list->num_loads = 0; + new_list->num_stores = 0; + new_list->violation = false; + + for (i = 0; i < MAX_INSN; i++) + { + new_list->window[i].insn = NULL; + new_list->window[i].group = disp_no_group; + new_list->window[i].path = no_path; + new_list->window[i].byte_len = 0; + new_list->window[i].imm_bytes = 0; + } + return; +} + +/* This function allocates and initializes a dispatch window and the + list container holding a pointer to the window. */ + +static dispatch_windows * +allocate_window (void) +{ + dispatch_windows *new_list = XNEW (struct dispatch_windows_s); + new_list->window = XNEWVEC (struct sched_insn_info_s, MAX_INSN + 1); + + return new_list; +} + +/* This routine initializes the dispatch scheduling information. It + initiates building dispatch scheduler tables and constructs the + first dispatch window. */ + +static void +init_dispatch_sched (void) +{ + /* Allocate a dispatch list and a window. */ + dispatch_window_list = allocate_window (); + dispatch_window_list1 = allocate_window (); + init_window (0); + init_window (1); +} + +/* This function returns true if a branch is detected. End of a basic block + does not have to be a branch, but here we assume only branches end a + window. */ + +static bool +is_end_basic_block (enum dispatch_group group) +{ + return group == disp_branch; +} + +/* This function is called when the end of a window processing is reached. */ + +static void +process_end_window (void) +{ + gcc_assert (dispatch_window_list->num_insn <= MAX_INSN); + if (dispatch_window_list->next) + { + gcc_assert (dispatch_window_list1->num_insn <= MAX_INSN); + gcc_assert (dispatch_window_list->window_size + + dispatch_window_list1->window_size <= 48); + init_window (1); + } + init_window (0); +} + +/* Allocates a new dispatch window and adds it to WINDOW_LIST. + WINDOW_NUM is either 0 or 1. A maximum of two windows are generated + for 48 bytes of instructions. Note that these windows are not dispatch + windows that their sizes are DISPATCH_WINDOW_SIZE. */ + +static dispatch_windows * +allocate_next_window (int window_num) +{ + if (window_num == 0) + { + if (dispatch_window_list->next) + init_window (1); + init_window (0); + return dispatch_window_list; + } + + dispatch_window_list->next = dispatch_window_list1; + dispatch_window_list1->prev = dispatch_window_list; + + return dispatch_window_list1; +} + +/* Compute number of immediate operands of an instruction. */ + +static void +find_constant (rtx in_rtx, imm_info *imm_values) +{ + if (INSN_P (in_rtx)) + in_rtx = PATTERN (in_rtx); + subrtx_iterator::array_type array; + FOR_EACH_SUBRTX (iter, array, in_rtx, ALL) + if (const_rtx x = *iter) + switch (GET_CODE (x)) + { + case CONST: + case SYMBOL_REF: + case CONST_INT: + (imm_values->imm)++; + if (x86_64_immediate_operand (CONST_CAST_RTX (x), SImode)) + (imm_values->imm32)++; + else + (imm_values->imm64)++; + break; + + case CONST_DOUBLE: + case CONST_WIDE_INT: + (imm_values->imm)++; + (imm_values->imm64)++; + break; + + case CODE_LABEL: + if (LABEL_KIND (x) == LABEL_NORMAL) + { + (imm_values->imm)++; + (imm_values->imm32)++; + } + break; + + default: + break; + } +} + +/* Return total size of immediate operands of an instruction along with number + of corresponding immediate-operands. It initializes its parameters to zero + befor calling FIND_CONSTANT. + INSN is the input instruction. IMM is the total of immediates. + IMM32 is the number of 32 bit immediates. IMM64 is the number of 64 + bit immediates. */ + +static int +get_num_immediates (rtx_insn *insn, int *imm, int *imm32, int *imm64) +{ + imm_info imm_values = {0, 0, 0}; + + find_constant (insn, &imm_values); + *imm = imm_values.imm; + *imm32 = imm_values.imm32; + *imm64 = imm_values.imm64; + return imm_values.imm32 * 4 + imm_values.imm64 * 8; +} + +/* This function indicates if an operand of an instruction is an + immediate. */ + +static bool +has_immediate (rtx_insn *insn) +{ + int num_imm_operand; + int num_imm32_operand; + int num_imm64_operand; + + if (insn) + return get_num_immediates (insn, &num_imm_operand, &num_imm32_operand, + &num_imm64_operand); + return false; +} + +/* Return single or double path for instructions. */ + +static enum insn_path +get_insn_path (rtx_insn *insn) +{ + enum attr_amdfam10_decode path = get_attr_amdfam10_decode (insn); + + if ((int)path == 0) + return path_single; + + if ((int)path == 1) + return path_double; + + return path_multi; +} + +/* Return insn dispatch group. */ + +static enum dispatch_group +get_insn_group (rtx_insn *insn) +{ + enum dispatch_group group = get_mem_group (insn); + if (group) + return group; + + if (is_branch (insn)) + return disp_branch; + + if (is_cmp (insn)) + return disp_cmp; + + if (has_immediate (insn)) + return disp_imm; + + if (is_prefetch (insn)) + return disp_prefetch; + + return disp_no_group; +} + +/* Count number of GROUP restricted instructions in a dispatch + window WINDOW_LIST. */ + +static int +count_num_restricted (rtx_insn *insn, dispatch_windows *window_list) +{ + enum dispatch_group group = get_insn_group (insn); + int imm_size; + int num_imm_operand; + int num_imm32_operand; + int num_imm64_operand; + + if (group == disp_no_group) + return 0; + + if (group == disp_imm) + { + imm_size = get_num_immediates (insn, &num_imm_operand, &num_imm32_operand, + &num_imm64_operand); + if (window_list->imm_size + imm_size > MAX_IMM_SIZE + || num_imm_operand + window_list->num_imm > MAX_IMM + || (num_imm32_operand > 0 + && (window_list->num_imm_32 + num_imm32_operand > MAX_IMM_32 + || window_list->num_imm_64 * 2 + num_imm32_operand > MAX_IMM_32)) + || (num_imm64_operand > 0 + && (window_list->num_imm_64 + num_imm64_operand > MAX_IMM_64 + || window_list->num_imm_32 + num_imm64_operand * 2 > MAX_IMM_32)) + || (window_list->imm_size + imm_size == MAX_IMM_SIZE + && num_imm64_operand > 0 + && ((window_list->num_imm_64 > 0 + && window_list->num_insn >= 2) + || window_list->num_insn >= 3))) + return BIG; + + return 1; + } + + if ((group == disp_load_store + && (window_list->num_loads >= MAX_LOAD + || window_list->num_stores >= MAX_STORE)) + || ((group == disp_load + || group == disp_prefetch) + && window_list->num_loads >= MAX_LOAD) + || (group == disp_store + && window_list->num_stores >= MAX_STORE)) + return BIG; + + return 1; +} + +/* This function returns true if insn satisfies dispatch rules on the + last window scheduled. */ + +static bool +fits_dispatch_window (rtx_insn *insn) +{ + dispatch_windows *window_list = dispatch_window_list; + dispatch_windows *window_list_next = dispatch_window_list->next; + unsigned int num_restrict; + enum dispatch_group group = get_insn_group (insn); + enum insn_path path = get_insn_path (insn); + int sum; + + /* Make disp_cmp and disp_jcc get scheduled at the latest. These + instructions should be given the lowest priority in the + scheduling process in Haifa scheduler to make sure they will be + scheduled in the same dispatch window as the reference to them. */ + if (group == disp_jcc || group == disp_cmp) + return false; + + /* Check nonrestricted. */ + if (group == disp_no_group || group == disp_branch) + return true; + + /* Get last dispatch window. */ + if (window_list_next) + window_list = window_list_next; + + if (window_list->window_num == 1) + { + sum = window_list->prev->window_size + window_list->window_size; + + if (sum == 32 + || (ix86_min_insn_size (insn) + sum) >= 48) + /* Window 1 is full. Go for next window. */ + return true; + } + + num_restrict = count_num_restricted (insn, window_list); + + if (num_restrict > num_allowable_groups[group]) + return false; + + /* See if it fits in the first window. */ + if (window_list->window_num == 0) + { + /* The first widow should have only single and double path + uops. */ + if (path == path_double + && (window_list->num_uops + 2) > MAX_INSN) + return false; + else if (path != path_single) + return false; + } + return true; +} + +/* Add an instruction INSN with NUM_UOPS micro-operations to the + dispatch window WINDOW_LIST. */ + +static void +add_insn_window (rtx_insn *insn, dispatch_windows *window_list, int num_uops) +{ + int byte_len = ix86_min_insn_size (insn); + int num_insn = window_list->num_insn; + int imm_size; + sched_insn_info *window = window_list->window; + enum dispatch_group group = get_insn_group (insn); + enum insn_path path = get_insn_path (insn); + int num_imm_operand; + int num_imm32_operand; + int num_imm64_operand; + + if (!window_list->violation && group != disp_cmp + && !fits_dispatch_window (insn)) + window_list->violation = true; + + imm_size = get_num_immediates (insn, &num_imm_operand, &num_imm32_operand, + &num_imm64_operand); + + /* Initialize window with new instruction. */ + window[num_insn].insn = insn; + window[num_insn].byte_len = byte_len; + window[num_insn].group = group; + window[num_insn].path = path; + window[num_insn].imm_bytes = imm_size; + + window_list->window_size += byte_len; + window_list->num_insn = num_insn + 1; + window_list->num_uops = window_list->num_uops + num_uops; + window_list->imm_size += imm_size; + window_list->num_imm += num_imm_operand; + window_list->num_imm_32 += num_imm32_operand; + window_list->num_imm_64 += num_imm64_operand; + + if (group == disp_store) + window_list->num_stores += 1; + else if (group == disp_load + || group == disp_prefetch) + window_list->num_loads += 1; + else if (group == disp_load_store) + { + window_list->num_stores += 1; + window_list->num_loads += 1; + } +} + +/* Adds a scheduled instruction, INSN, to the current dispatch window. + If the total bytes of instructions or the number of instructions in + the window exceed allowable, it allocates a new window. */ + +static void +add_to_dispatch_window (rtx_insn *insn) +{ + int byte_len; + dispatch_windows *window_list; + dispatch_windows *next_list; + dispatch_windows *window0_list; + enum insn_path path; + enum dispatch_group insn_group; + bool insn_fits; + int num_insn; + int num_uops; + int window_num; + int insn_num_uops; + int sum; + + if (INSN_CODE (insn) < 0) + return; + + byte_len = ix86_min_insn_size (insn); + window_list = dispatch_window_list; + next_list = window_list->next; + path = get_insn_path (insn); + insn_group = get_insn_group (insn); + + /* Get the last dispatch window. */ + if (next_list) + window_list = dispatch_window_list->next; + + if (path == path_single) + insn_num_uops = 1; + else if (path == path_double) + insn_num_uops = 2; + else + insn_num_uops = (int) path; + + /* If current window is full, get a new window. + Window number zero is full, if MAX_INSN uops are scheduled in it. + Window number one is full, if window zero's bytes plus window + one's bytes is 32, or if the bytes of the new instruction added + to the total makes it greater than 48, or it has already MAX_INSN + instructions in it. */ + num_insn = window_list->num_insn; + num_uops = window_list->num_uops; + window_num = window_list->window_num; + insn_fits = fits_dispatch_window (insn); + + if (num_insn >= MAX_INSN + || num_uops + insn_num_uops > MAX_INSN + || !(insn_fits)) + { + window_num = ~window_num & 1; + window_list = allocate_next_window (window_num); + } + + if (window_num == 0) + { + add_insn_window (insn, window_list, insn_num_uops); + if (window_list->num_insn >= MAX_INSN + && insn_group == disp_branch) + { + process_end_window (); + return; + } + } + else if (window_num == 1) + { + window0_list = window_list->prev; + sum = window0_list->window_size + window_list->window_size; + if (sum == 32 + || (byte_len + sum) >= 48) + { + process_end_window (); + window_list = dispatch_window_list; + } + + add_insn_window (insn, window_list, insn_num_uops); + } + else + gcc_unreachable (); + + if (is_end_basic_block (insn_group)) + { + /* End of basic block is reached do end-basic-block process. */ + process_end_window (); + return; + } +} + +/* Print the dispatch window, WINDOW_NUM, to FILE. */ + +DEBUG_FUNCTION static void +debug_dispatch_window_file (FILE *file, int window_num) +{ + dispatch_windows *list; + int i; + + if (window_num == 0) + list = dispatch_window_list; + else + list = dispatch_window_list1; + + fprintf (file, "Window #%d:\n", list->window_num); + fprintf (file, " num_insn = %d, num_uops = %d, window_size = %d\n", + list->num_insn, list->num_uops, list->window_size); + fprintf (file, " num_imm = %d, num_imm_32 = %d, num_imm_64 = %d, imm_size = %d\n", + list->num_imm, list->num_imm_32, list->num_imm_64, list->imm_size); + + fprintf (file, " num_loads = %d, num_stores = %d\n", list->num_loads, + list->num_stores); + fprintf (file, " insn info:\n"); + + for (i = 0; i < MAX_INSN; i++) + { + if (!list->window[i].insn) + break; + fprintf (file, " group[%d] = %s, insn[%d] = %p, path[%d] = %d byte_len[%d] = %d, imm_bytes[%d] = %d\n", + i, group_name[list->window[i].group], + i, (void *)list->window[i].insn, + i, list->window[i].path, + i, list->window[i].byte_len, + i, list->window[i].imm_bytes); + } +} + +/* Print to stdout a dispatch window. */ + +DEBUG_FUNCTION void +debug_dispatch_window (int window_num) +{ + debug_dispatch_window_file (stdout, window_num); +} + +/* Print INSN dispatch information to FILE. */ + +DEBUG_FUNCTION static void +debug_insn_dispatch_info_file (FILE *file, rtx_insn *insn) +{ + int byte_len; + enum insn_path path; + enum dispatch_group group; + int imm_size; + int num_imm_operand; + int num_imm32_operand; + int num_imm64_operand; + + if (INSN_CODE (insn) < 0) + return; + + byte_len = ix86_min_insn_size (insn); + path = get_insn_path (insn); + group = get_insn_group (insn); + imm_size = get_num_immediates (insn, &num_imm_operand, &num_imm32_operand, + &num_imm64_operand); + + fprintf (file, " insn info:\n"); + fprintf (file, " group = %s, path = %d, byte_len = %d\n", + group_name[group], path, byte_len); + fprintf (file, " num_imm = %d, num_imm_32 = %d, num_imm_64 = %d, imm_size = %d\n", + num_imm_operand, num_imm32_operand, num_imm64_operand, imm_size); +} + +/* Print to STDERR the status of the ready list with respect to + dispatch windows. */ + +DEBUG_FUNCTION void +debug_ready_dispatch (void) +{ + int i; + int no_ready = number_in_ready (); + + fprintf (stdout, "Number of ready: %d\n", no_ready); + + for (i = 0; i < no_ready; i++) + debug_insn_dispatch_info_file (stdout, get_ready_element (i)); +} + +/* This routine is the driver of the dispatch scheduler. */ + +void +ix86_bd_do_dispatch (rtx_insn *insn, int mode) +{ + if (mode == DISPATCH_INIT) + init_dispatch_sched (); + else if (mode == ADD_TO_DISPATCH_WINDOW) + add_to_dispatch_window (insn); +} + +/* Return TRUE if Dispatch Scheduling is supported. */ + +bool +ix86_bd_has_dispatch (rtx_insn *insn, int action) +{ + /* Current implementation of dispatch scheduler models buldozer only. */ + if ((TARGET_BDVER1 || TARGET_BDVER2 || TARGET_BDVER3 + || TARGET_BDVER4) && flag_dispatch_scheduler) + switch (action) + { + default: + return false; + + case IS_DISPATCH_ON: + return true; + + case IS_CMP: + return is_cmp (insn); + + case DISPATCH_VIOLATION: + return dispatch_violation (); + + case FITS_DISPATCH_WINDOW: + return fits_dispatch_window (insn); + } + + return false; +} diff --git a/gcc/config/i386/x86-tune-sched-core.c b/gcc/config/i386/x86-tune-sched-core.c new file mode 100644 index 0000000000000..67b14a708e8c3 --- /dev/null +++ b/gcc/config/i386/x86-tune-sched-core.c @@ -0,0 +1,255 @@ +/* Scheduler hooks for IA-32 which implement bdver1-4 specific logic. + Copyright (C) 1988-2017 Free Software Foundation, Inc. + +This file is part of GCC. + +GCC is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +GCC is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GCC; see the file COPYING3. If not see +. */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "backend.h" +#include "rtl.h" +#include "tree.h" +#include "cfghooks.h" +#include "tm_p.h" +#include "insn-config.h" +#include "insn-attr.h" +#include "recog.h" +#include "target.h" +#include "rtl-iter.h" +#include "regset.h" +#include "sched-int.h" + + +/* Model decoder of Core 2/i7. + Below hooks for multipass scheduling (see haifa-sched.c:max_issue) + track the instruction fetch block boundaries and make sure that long + (9+ bytes) instructions are assigned to D0. */ + +/* Maximum length of an insn that can be handled by + a secondary decoder unit. '8' for Core 2/i7. */ +static int core2i7_secondary_decoder_max_insn_size; + +/* Ifetch block size, i.e., number of bytes decoder reads per cycle. + '16' for Core 2/i7. */ +static int core2i7_ifetch_block_size; + +/* Maximum number of instructions decoder can handle per cycle. + '6' for Core 2/i7. */ +static int core2i7_ifetch_block_max_insns; + +typedef struct ix86_first_cycle_multipass_data_ * + ix86_first_cycle_multipass_data_t; +typedef const struct ix86_first_cycle_multipass_data_ * + const_ix86_first_cycle_multipass_data_t; + +/* A variable to store target state across calls to max_issue within + one cycle. */ +static struct ix86_first_cycle_multipass_data_ _ix86_first_cycle_multipass_data, + *ix86_first_cycle_multipass_data = &_ix86_first_cycle_multipass_data; + +/* Initialize DATA. */ +static void +core2i7_first_cycle_multipass_init (void *_data) +{ + ix86_first_cycle_multipass_data_t data + = (ix86_first_cycle_multipass_data_t) _data; + + data->ifetch_block_len = 0; + data->ifetch_block_n_insns = 0; + data->ready_try_change = NULL; + data->ready_try_change_size = 0; +} + +/* Advancing the cycle; reset ifetch block counts. */ +static void +core2i7_dfa_post_advance_cycle (void) +{ + ix86_first_cycle_multipass_data_t data = ix86_first_cycle_multipass_data; + + gcc_assert (data->ifetch_block_n_insns <= core2i7_ifetch_block_max_insns); + + data->ifetch_block_len = 0; + data->ifetch_block_n_insns = 0; +} + +/* Filter out insns from ready_try that the core will not be able to issue + on current cycle due to decoder. */ +static void +core2i7_first_cycle_multipass_filter_ready_try +(const_ix86_first_cycle_multipass_data_t data, + signed char *ready_try, int n_ready, bool first_cycle_insn_p) +{ + while (n_ready--) + { + rtx_insn *insn; + int insn_size; + + if (ready_try[n_ready]) + continue; + + insn = get_ready_element (n_ready); + insn_size = ix86_min_insn_size (insn); + + if (/* If this is a too long an insn for a secondary decoder ... */ + (!first_cycle_insn_p + && insn_size > core2i7_secondary_decoder_max_insn_size) + /* ... or it would not fit into the ifetch block ... */ + || data->ifetch_block_len + insn_size > core2i7_ifetch_block_size + /* ... or the decoder is full already ... */ + || data->ifetch_block_n_insns + 1 > core2i7_ifetch_block_max_insns) + /* ... mask the insn out. */ + { + ready_try[n_ready] = 1; + + if (data->ready_try_change) + bitmap_set_bit (data->ready_try_change, n_ready); + } + } +} + +/* Prepare for a new round of multipass lookahead scheduling. */ +static void +core2i7_first_cycle_multipass_begin (void *_data, + signed char *ready_try, int n_ready, + bool first_cycle_insn_p) +{ + ix86_first_cycle_multipass_data_t data + = (ix86_first_cycle_multipass_data_t) _data; + const_ix86_first_cycle_multipass_data_t prev_data + = ix86_first_cycle_multipass_data; + + /* Restore the state from the end of the previous round. */ + data->ifetch_block_len = prev_data->ifetch_block_len; + data->ifetch_block_n_insns = prev_data->ifetch_block_n_insns; + + /* Filter instructions that cannot be issued on current cycle due to + decoder restrictions. */ + core2i7_first_cycle_multipass_filter_ready_try (data, ready_try, n_ready, + first_cycle_insn_p); +} + +/* INSN is being issued in current solution. Account for its impact on + the decoder model. */ +static void +core2i7_first_cycle_multipass_issue (void *_data, + signed char *ready_try, int n_ready, + rtx_insn *insn, const void *_prev_data) +{ + ix86_first_cycle_multipass_data_t data + = (ix86_first_cycle_multipass_data_t) _data; + const_ix86_first_cycle_multipass_data_t prev_data + = (const_ix86_first_cycle_multipass_data_t) _prev_data; + + int insn_size = ix86_min_insn_size (insn); + + data->ifetch_block_len = prev_data->ifetch_block_len + insn_size; + data->ifetch_block_n_insns = prev_data->ifetch_block_n_insns + 1; + gcc_assert (data->ifetch_block_len <= core2i7_ifetch_block_size + && data->ifetch_block_n_insns <= core2i7_ifetch_block_max_insns); + + /* Allocate or resize the bitmap for storing INSN's effect on ready_try. */ + if (!data->ready_try_change) + { + data->ready_try_change = sbitmap_alloc (n_ready); + data->ready_try_change_size = n_ready; + } + else if (data->ready_try_change_size < n_ready) + { + data->ready_try_change = sbitmap_resize (data->ready_try_change, + n_ready, 0); + data->ready_try_change_size = n_ready; + } + bitmap_clear (data->ready_try_change); + + /* Filter out insns from ready_try that the core will not be able to issue + on current cycle due to decoder. */ + core2i7_first_cycle_multipass_filter_ready_try (data, ready_try, n_ready, + false); +} + +/* Revert the effect on ready_try. */ +static void +core2i7_first_cycle_multipass_backtrack (const void *_data, + signed char *ready_try, + int n_ready ATTRIBUTE_UNUSED) +{ + const_ix86_first_cycle_multipass_data_t data + = (const_ix86_first_cycle_multipass_data_t) _data; + unsigned int i = 0; + sbitmap_iterator sbi; + + gcc_assert (bitmap_last_set_bit (data->ready_try_change) < n_ready); + EXECUTE_IF_SET_IN_BITMAP (data->ready_try_change, 0, i, sbi) + { + ready_try[i] = 0; + } +} + +/* Save the result of multipass lookahead scheduling for the next round. */ +static void +core2i7_first_cycle_multipass_end (const void *_data) +{ + const_ix86_first_cycle_multipass_data_t data + = (const_ix86_first_cycle_multipass_data_t) _data; + ix86_first_cycle_multipass_data_t next_data + = ix86_first_cycle_multipass_data; + + if (data != NULL) + { + next_data->ifetch_block_len = data->ifetch_block_len; + next_data->ifetch_block_n_insns = data->ifetch_block_n_insns; + } +} + +/* Deallocate target data. */ +static void +core2i7_first_cycle_multipass_fini (void *_data) +{ + ix86_first_cycle_multipass_data_t data + = (ix86_first_cycle_multipass_data_t) _data; + + if (data->ready_try_change) + { + sbitmap_free (data->ready_try_change); + data->ready_try_change = NULL; + data->ready_try_change_size = 0; + } +} + +void +ix86_core2i7_init_hooks (void) +{ + targetm.sched.dfa_post_advance_cycle + = core2i7_dfa_post_advance_cycle; + targetm.sched.first_cycle_multipass_init + = core2i7_first_cycle_multipass_init; + targetm.sched.first_cycle_multipass_begin + = core2i7_first_cycle_multipass_begin; + targetm.sched.first_cycle_multipass_issue + = core2i7_first_cycle_multipass_issue; + targetm.sched.first_cycle_multipass_backtrack + = core2i7_first_cycle_multipass_backtrack; + targetm.sched.first_cycle_multipass_end + = core2i7_first_cycle_multipass_end; + targetm.sched.first_cycle_multipass_fini + = core2i7_first_cycle_multipass_fini; + + /* Set decoder parameters. */ + core2i7_secondary_decoder_max_insn_size = 8; + core2i7_ifetch_block_size = 16; + core2i7_ifetch_block_max_insns = 6; +} diff --git a/gcc/config/i386/x86-tune-sched.c b/gcc/config/i386/x86-tune-sched.c new file mode 100644 index 0000000000000..aac2bae806155 --- /dev/null +++ b/gcc/config/i386/x86-tune-sched.c @@ -0,0 +1,627 @@ +/* Scheduler hooks for IA-32 which implement CPU specific logic. + Copyright (C) 1988-2017 Free Software Foundation, Inc. + +This file is part of GCC. + +GCC is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +GCC is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GCC; see the file COPYING3. If not see +. */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "backend.h" +#include "rtl.h" +#include "tree.h" +#include "cfghooks.h" +#include "tm_p.h" +#include "insn-config.h" +#include "insn-attr.h" +#include "recog.h" +#include "target.h" + +/* Return the maximum number of instructions a cpu can issue. */ + +int +ix86_issue_rate (void) +{ + switch (ix86_tune) + { + case PROCESSOR_PENTIUM: + case PROCESSOR_LAKEMONT: + case PROCESSOR_BONNELL: + case PROCESSOR_SILVERMONT: + case PROCESSOR_KNL: + case PROCESSOR_KNM: + case PROCESSOR_INTEL: + case PROCESSOR_K6: + case PROCESSOR_BTVER2: + case PROCESSOR_PENTIUM4: + case PROCESSOR_NOCONA: + return 2; + + case PROCESSOR_PENTIUMPRO: + case PROCESSOR_ATHLON: + case PROCESSOR_K8: + case PROCESSOR_AMDFAM10: + case PROCESSOR_GENERIC: + case PROCESSOR_BTVER1: + return 3; + + case PROCESSOR_BDVER1: + case PROCESSOR_BDVER2: + case PROCESSOR_BDVER3: + case PROCESSOR_BDVER4: + case PROCESSOR_ZNVER1: + case PROCESSOR_CORE2: + case PROCESSOR_NEHALEM: + case PROCESSOR_SANDYBRIDGE: + case PROCESSOR_HASWELL: + return 4; + + default: + return 1; + } +} + +/* Return true iff USE_INSN has a memory address with operands set by + SET_INSN. */ + +bool +ix86_agi_dependent (rtx_insn *set_insn, rtx_insn *use_insn) +{ + int i; + extract_insn_cached (use_insn); + for (i = recog_data.n_operands - 1; i >= 0; --i) + if (MEM_P (recog_data.operand[i])) + { + rtx addr = XEXP (recog_data.operand[i], 0); + if (modified_in_p (addr, set_insn) != 0) + { + /* No AGI stall if SET_INSN is a push or pop and USE_INSN + has SP based memory (unless index reg is modified in a pop). */ + rtx set = single_set (set_insn); + if (set + && (push_operand (SET_DEST (set), GET_MODE (SET_DEST (set))) + || pop_operand (SET_SRC (set), GET_MODE (SET_SRC (set))))) + { + struct ix86_address parts; + if (ix86_decompose_address (addr, &parts) + && parts.base == stack_pointer_rtx + && (parts.index == NULL_RTX + || MEM_P (SET_DEST (set)) + || !modified_in_p (parts.index, set_insn))) + return false; + } + return true; + } + return false; + } + return false; +} + +/* A subroutine of ix86_adjust_cost -- return TRUE iff INSN reads flags set + by DEP_INSN and nothing set by DEP_INSN. */ + +static bool +ix86_flags_dependent (rtx_insn *insn, rtx_insn *dep_insn, enum attr_type insn_type) +{ + rtx set, set2; + + /* Simplify the test for uninteresting insns. */ + if (insn_type != TYPE_SETCC + && insn_type != TYPE_ICMOV + && insn_type != TYPE_FCMOV + && insn_type != TYPE_IBR) + return false; + + if ((set = single_set (dep_insn)) != 0) + { + set = SET_DEST (set); + set2 = NULL_RTX; + } + else if (GET_CODE (PATTERN (dep_insn)) == PARALLEL + && XVECLEN (PATTERN (dep_insn), 0) == 2 + && GET_CODE (XVECEXP (PATTERN (dep_insn), 0, 0)) == SET + && GET_CODE (XVECEXP (PATTERN (dep_insn), 0, 1)) == SET) + { + set = SET_DEST (XVECEXP (PATTERN (dep_insn), 0, 0)); + set2 = SET_DEST (XVECEXP (PATTERN (dep_insn), 0, 0)); + } + else + return false; + + if (!REG_P (set) || REGNO (set) != FLAGS_REG) + return false; + + /* This test is true if the dependent insn reads the flags but + not any other potentially set register. */ + if (!reg_overlap_mentioned_p (set, PATTERN (insn))) + return false; + + if (set2 && reg_overlap_mentioned_p (set2, PATTERN (insn))) + return false; + + return true; +} + +/* Helper function for exact_store_load_dependency. + Return true if addr is found in insn. */ +static bool +exact_dependency_1 (rtx addr, rtx insn) +{ + enum rtx_code code; + const char *format_ptr; + int i, j; + + code = GET_CODE (insn); + switch (code) + { + case MEM: + if (rtx_equal_p (addr, insn)) + return true; + break; + case REG: + CASE_CONST_ANY: + case SYMBOL_REF: + case CODE_LABEL: + case PC: + case CC0: + case EXPR_LIST: + return false; + default: + break; + } + + format_ptr = GET_RTX_FORMAT (code); + for (i = 0; i < GET_RTX_LENGTH (code); i++) + { + switch (*format_ptr++) + { + case 'e': + if (exact_dependency_1 (addr, XEXP (insn, i))) + return true; + break; + case 'E': + for (j = 0; j < XVECLEN (insn, i); j++) + if (exact_dependency_1 (addr, XVECEXP (insn, i, j))) + return true; + break; + } + } + return false; +} + +/* Return true if there exists exact dependency for store & load, i.e. + the same memory address is used in them. */ +static bool +exact_store_load_dependency (rtx_insn *store, rtx_insn *load) +{ + rtx set1, set2; + + set1 = single_set (store); + if (!set1) + return false; + if (!MEM_P (SET_DEST (set1))) + return false; + set2 = single_set (load); + if (!set2) + return false; + if (exact_dependency_1 (SET_DEST (set1), SET_SRC (set2))) + return true; + return false; +} + + +/* This function corrects the value of COST (latency) based on the relationship + between INSN and DEP_INSN through a dependence of type DEP_TYPE, and strength + DW. It should return the new value. + + On x86 CPUs this is most commonly used to model the fact that valus of + registers used to compute address of memory operand needs to be ready + earlier than values of registers used in the actual operation. */ + +int +ix86_adjust_cost (rtx_insn *insn, int dep_type, rtx_insn *dep_insn, int cost, + unsigned int) +{ + enum attr_type insn_type, dep_insn_type; + enum attr_memory memory; + rtx set, set2; + int dep_insn_code_number; + + /* Anti and output dependencies have zero cost on all CPUs. */ + if (dep_type != 0) + return 0; + + dep_insn_code_number = recog_memoized (dep_insn); + + /* If we can't recognize the insns, we can't really do anything. */ + if (dep_insn_code_number < 0 || recog_memoized (insn) < 0) + return cost; + + insn_type = get_attr_type (insn); + dep_insn_type = get_attr_type (dep_insn); + + switch (ix86_tune) + { + case PROCESSOR_PENTIUM: + case PROCESSOR_LAKEMONT: + /* Address Generation Interlock adds a cycle of latency. */ + if (insn_type == TYPE_LEA) + { + rtx addr = PATTERN (insn); + + if (GET_CODE (addr) == PARALLEL) + addr = XVECEXP (addr, 0, 0); + + gcc_assert (GET_CODE (addr) == SET); + + addr = SET_SRC (addr); + if (modified_in_p (addr, dep_insn)) + cost += 1; + } + else if (ix86_agi_dependent (dep_insn, insn)) + cost += 1; + + /* ??? Compares pair with jump/setcc. */ + if (ix86_flags_dependent (insn, dep_insn, insn_type)) + cost = 0; + + /* Floating point stores require value to be ready one cycle earlier. */ + if (insn_type == TYPE_FMOV + && get_attr_memory (insn) == MEMORY_STORE + && !ix86_agi_dependent (dep_insn, insn)) + cost += 1; + break; + + case PROCESSOR_PENTIUMPRO: + /* INT->FP conversion is expensive. */ + if (get_attr_fp_int_src (dep_insn)) + cost += 5; + + /* There is one cycle extra latency between an FP op and a store. */ + if (insn_type == TYPE_FMOV + && (set = single_set (dep_insn)) != NULL_RTX + && (set2 = single_set (insn)) != NULL_RTX + && rtx_equal_p (SET_DEST (set), SET_SRC (set2)) + && MEM_P (SET_DEST (set2))) + cost += 1; + + memory = get_attr_memory (insn); + + /* Show ability of reorder buffer to hide latency of load by executing + in parallel with previous instruction in case + previous instruction is not needed to compute the address. */ + if ((memory == MEMORY_LOAD || memory == MEMORY_BOTH) + && !ix86_agi_dependent (dep_insn, insn)) + { + /* Claim moves to take one cycle, as core can issue one load + at time and the next load can start cycle later. */ + if (dep_insn_type == TYPE_IMOV + || dep_insn_type == TYPE_FMOV) + cost = 1; + else if (cost > 1) + cost--; + } + break; + + case PROCESSOR_K6: + /* The esp dependency is resolved before + the instruction is really finished. */ + if ((insn_type == TYPE_PUSH || insn_type == TYPE_POP) + && (dep_insn_type == TYPE_PUSH || dep_insn_type == TYPE_POP)) + return 1; + + /* INT->FP conversion is expensive. */ + if (get_attr_fp_int_src (dep_insn)) + cost += 5; + + memory = get_attr_memory (insn); + + /* Show ability of reorder buffer to hide latency of load by executing + in parallel with previous instruction in case + previous instruction is not needed to compute the address. */ + if ((memory == MEMORY_LOAD || memory == MEMORY_BOTH) + && !ix86_agi_dependent (dep_insn, insn)) + { + /* Claim moves to take one cycle, as core can issue one load + at time and the next load can start cycle later. */ + if (dep_insn_type == TYPE_IMOV + || dep_insn_type == TYPE_FMOV) + cost = 1; + else if (cost > 2) + cost -= 2; + else + cost = 1; + } + break; + + case PROCESSOR_AMDFAM10: + case PROCESSOR_BDVER1: + case PROCESSOR_BDVER2: + case PROCESSOR_BDVER3: + case PROCESSOR_BDVER4: + case PROCESSOR_BTVER1: + case PROCESSOR_BTVER2: + case PROCESSOR_GENERIC: + /* Stack engine allows to execute push&pop instructions in parall. */ + if ((insn_type == TYPE_PUSH || insn_type == TYPE_POP) + && (dep_insn_type == TYPE_PUSH || dep_insn_type == TYPE_POP)) + return 0; + /* FALLTHRU */ + + case PROCESSOR_ATHLON: + case PROCESSOR_K8: + memory = get_attr_memory (insn); + + /* Show ability of reorder buffer to hide latency of load by executing + in parallel with previous instruction in case + previous instruction is not needed to compute the address. */ + if ((memory == MEMORY_LOAD || memory == MEMORY_BOTH) + && !ix86_agi_dependent (dep_insn, insn)) + { + enum attr_unit unit = get_attr_unit (insn); + int loadcost = 3; + + /* Because of the difference between the length of integer and + floating unit pipeline preparation stages, the memory operands + for floating point are cheaper. + + ??? For Athlon it the difference is most probably 2. */ + if (unit == UNIT_INTEGER || unit == UNIT_UNKNOWN) + loadcost = 3; + else + loadcost = TARGET_ATHLON ? 2 : 0; + + if (cost >= loadcost) + cost -= loadcost; + else + cost = 0; + } + break; + + case PROCESSOR_ZNVER1: + /* Stack engine allows to execute push&pop instructions in parall. */ + if ((insn_type == TYPE_PUSH || insn_type == TYPE_POP) + && (dep_insn_type == TYPE_PUSH || dep_insn_type == TYPE_POP)) + return 0; + + memory = get_attr_memory (insn); + + /* Show ability of reorder buffer to hide latency of load by executing + in parallel with previous instruction in case + previous instruction is not needed to compute the address. */ + if ((memory == MEMORY_LOAD || memory == MEMORY_BOTH) + && !ix86_agi_dependent (dep_insn, insn)) + { + enum attr_unit unit = get_attr_unit (insn); + int loadcost; + + if (unit == UNIT_INTEGER || unit == UNIT_UNKNOWN) + loadcost = 4; + else + loadcost = 7; + + if (cost >= loadcost) + cost -= loadcost; + else + cost = 0; + } + break; + + case PROCESSOR_CORE2: + case PROCESSOR_NEHALEM: + case PROCESSOR_SANDYBRIDGE: + case PROCESSOR_HASWELL: + /* Stack engine allows to execute push&pop instructions in parall. */ + if ((insn_type == TYPE_PUSH || insn_type == TYPE_POP) + && (dep_insn_type == TYPE_PUSH || dep_insn_type == TYPE_POP)) + return 0; + + memory = get_attr_memory (insn); + + /* Show ability of reorder buffer to hide latency of load by executing + in parallel with previous instruction in case + previous instruction is not needed to compute the address. */ + if ((memory == MEMORY_LOAD || memory == MEMORY_BOTH) + && !ix86_agi_dependent (dep_insn, insn)) + { + if (cost >= 4) + cost -= 4; + else + cost = 0; + } + break; + + case PROCESSOR_SILVERMONT: + case PROCESSOR_KNL: + case PROCESSOR_KNM: + case PROCESSOR_INTEL: + if (!reload_completed) + return cost; + + /* Increase cost of integer loads. */ + memory = get_attr_memory (dep_insn); + if (memory == MEMORY_LOAD || memory == MEMORY_BOTH) + { + enum attr_unit unit = get_attr_unit (dep_insn); + if (unit == UNIT_INTEGER && cost == 1) + { + if (memory == MEMORY_LOAD) + cost = 3; + else + { + /* Increase cost of ld/st for short int types only + because of store forwarding issue. */ + rtx set = single_set (dep_insn); + if (set && (GET_MODE (SET_DEST (set)) == QImode + || GET_MODE (SET_DEST (set)) == HImode)) + { + /* Increase cost of store/load insn if exact + dependence exists and it is load insn. */ + enum attr_memory insn_memory = get_attr_memory (insn); + if (insn_memory == MEMORY_LOAD + && exact_store_load_dependency (dep_insn, insn)) + cost = 3; + } + } + } + } + + default: + break; + } + + return cost; +} + +/* How many alternative schedules to try. This should be as wide as the + scheduling freedom in the DFA, but no wider. Making this value too + large results extra work for the scheduler. */ + +int +ia32_multipass_dfa_lookahead (void) +{ + /* Generally, we want haifa-sched:max_issue() to look ahead as far + as many instructions can be executed on a cycle, i.e., + issue_rate. */ + if (reload_completed) + return ix86_issue_rate (); + /* Don't use lookahead for pre-reload schedule to save compile time. */ + return 0; +} + +/* Return true if target platform supports macro-fusion. */ + +bool +ix86_macro_fusion_p () +{ + return TARGET_FUSE_CMP_AND_BRANCH; +} + +/* Check whether current microarchitecture support macro fusion + for insn pair "CONDGEN + CONDJMP". Refer to + "Intel Architectures Optimization Reference Manual". */ + +bool +ix86_macro_fusion_pair_p (rtx_insn *condgen, rtx_insn *condjmp) +{ + rtx src, dest; + enum rtx_code ccode; + rtx compare_set = NULL_RTX, test_if, cond; + rtx alu_set = NULL_RTX, addr = NULL_RTX; + + if (!any_condjump_p (condjmp)) + return false; + + unsigned int condreg1, condreg2; + rtx cc_reg_1; + targetm.fixed_condition_code_regs (&condreg1, &condreg2); + cc_reg_1 = gen_rtx_REG (CCmode, condreg1); + if (!reg_referenced_p (cc_reg_1, PATTERN (condjmp)) + || !condgen + || !modified_in_p (cc_reg_1, condgen)) + return false; + + if (get_attr_type (condgen) != TYPE_TEST + && get_attr_type (condgen) != TYPE_ICMP + && get_attr_type (condgen) != TYPE_INCDEC + && get_attr_type (condgen) != TYPE_ALU) + return false; + + compare_set = single_set (condgen); + if (compare_set == NULL_RTX + && !TARGET_FUSE_ALU_AND_BRANCH) + return false; + + if (compare_set == NULL_RTX) + { + int i; + rtx pat = PATTERN (condgen); + for (i = 0; i < XVECLEN (pat, 0); i++) + if (GET_CODE (XVECEXP (pat, 0, i)) == SET) + { + rtx set_src = SET_SRC (XVECEXP (pat, 0, i)); + if (GET_CODE (set_src) == COMPARE) + compare_set = XVECEXP (pat, 0, i); + else + alu_set = XVECEXP (pat, 0, i); + } + } + if (compare_set == NULL_RTX) + return false; + src = SET_SRC (compare_set); + if (GET_CODE (src) != COMPARE) + return false; + + /* Macro-fusion for cmp/test MEM-IMM + conditional jmp is not + supported. */ + if ((MEM_P (XEXP (src, 0)) + && CONST_INT_P (XEXP (src, 1))) + || (MEM_P (XEXP (src, 1)) + && CONST_INT_P (XEXP (src, 0)))) + return false; + + /* No fusion for RIP-relative address. */ + if (MEM_P (XEXP (src, 0))) + addr = XEXP (XEXP (src, 0), 0); + else if (MEM_P (XEXP (src, 1))) + addr = XEXP (XEXP (src, 1), 0); + + if (addr) { + ix86_address parts; + int ok = ix86_decompose_address (addr, &parts); + gcc_assert (ok); + + if (ix86_rip_relative_addr_p (&parts)) + return false; + } + + test_if = SET_SRC (pc_set (condjmp)); + cond = XEXP (test_if, 0); + ccode = GET_CODE (cond); + /* Check whether conditional jump use Sign or Overflow Flags. */ + if (!TARGET_FUSE_CMP_AND_BRANCH_SOFLAGS + && (ccode == GE + || ccode == GT + || ccode == LE + || ccode == LT)) + return false; + + /* Return true for TYPE_TEST and TYPE_ICMP. */ + if (get_attr_type (condgen) == TYPE_TEST + || get_attr_type (condgen) == TYPE_ICMP) + return true; + + /* The following is the case that macro-fusion for alu + jmp. */ + if (!TARGET_FUSE_ALU_AND_BRANCH || !alu_set) + return false; + + /* No fusion for alu op with memory destination operand. */ + dest = SET_DEST (alu_set); + if (MEM_P (dest)) + return false; + + /* Macro-fusion for inc/dec + unsigned conditional jump is not + supported. */ + if (get_attr_type (condgen) == TYPE_INCDEC + && (ccode == GEU + || ccode == GTU + || ccode == LEU + || ccode == LTU)) + return false; + + return true; +} + diff --git a/gcc/config/i386/x86-tune.def b/gcc/config/i386/x86-tune.def index 63f69b4b50389..9d01761eff9aa 100644 --- a/gcc/config/i386/x86-tune.def +++ b/gcc/config/i386/x86-tune.def @@ -284,6 +284,22 @@ DEF_TUNE (X86_TUNE_USE_BT, "use_bt", m_CORE_ALL | m_BONNELL | m_SILVERMONT | m_KNL | m_KNM | m_INTEL | m_LAKEMONT | m_AMD_MULTIPLE | m_GENERIC) +/* X86_TUNE_AVOID_FALSE_DEP_FOR_BMI: Avoid false dependency + for bit-manipulation instructions. */ +DEF_TUNE (X86_TUNE_AVOID_FALSE_DEP_FOR_BMI, "avoid_false_dep_for_bmi", + m_SANDYBRIDGE | m_HASWELL | m_GENERIC) + +/* X86_TUNE_ADJUST_UNROLL: This enables adjusting the unroll factor based + on hardware capabilities. Bdver3 hardware has a loop buffer which makes + unrolling small loop less important. For, such architectures we adjust + the unroll factor so that the unrolled loop fits the loop buffer. */ +DEF_TUNE (X86_TUNE_ADJUST_UNROLL, "adjust_unroll_factor", m_BDVER3 | m_BDVER4) + +/* X86_TUNE_ONE_IF_CONV_INSNS: Restrict a number of cmov insns in + if-converted sequence to one. */ +DEF_TUNE (X86_TUNE_ONE_IF_CONV_INSN, "one_if_conv_insn", + m_SILVERMONT | m_KNL | m_KNM | m_INTEL | m_CORE_ALL | m_GENERIC) + /*****************************************************************************/ /* 387 instruction selection tuning */ /*****************************************************************************/ @@ -503,11 +519,6 @@ DEF_TUNE (X86_TUNE_NOT_VECTORMODE, "not_vectormode", m_K6) DEF_TUNE (X86_TUNE_AVOID_VECTOR_DECODE, "avoid_vector_decode", m_K8) -/* X86_TUNE_AVOID_FALSE_DEP_FOR_BMI: Avoid false dependency - for bit-manipulation instructions. */ -DEF_TUNE (X86_TUNE_AVOID_FALSE_DEP_FOR_BMI, "avoid_false_dep_for_bmi", - m_SANDYBRIDGE | m_HASWELL | m_GENERIC) - /*****************************************************************************/ /* This never worked well before. */ /*****************************************************************************/ @@ -525,14 +536,3 @@ DEF_TUNE (X86_TUNE_QIMODE_MATH, "qimode_math", ~0U) arithmetic to 32bit via PROMOTE_MODE macro. This code generation scheme is usually used for RISC targets. */ DEF_TUNE (X86_TUNE_PROMOTE_QI_REGS, "promote_qi_regs", 0U) - -/* X86_TUNE_ADJUST_UNROLL: This enables adjusting the unroll factor based - on hardware capabilities. Bdver3 hardware has a loop buffer which makes - unrolling small loop less important. For, such architectures we adjust - the unroll factor so that the unrolled loop fits the loop buffer. */ -DEF_TUNE (X86_TUNE_ADJUST_UNROLL, "adjust_unroll_factor", m_BDVER3 | m_BDVER4) - -/* X86_TUNE_ONE_IF_CONV_INSNS: Restrict a number of cmov insns in - if-converted sequence to one. */ -DEF_TUNE (X86_TUNE_ONE_IF_CONV_INSN, "one_if_conv_insn", - m_SILVERMONT | m_KNL | m_KNM | m_INTEL | m_CORE_ALL | m_GENERIC) diff --git a/gcc/config/msp430/msp430.c b/gcc/config/msp430/msp430.c index 80ea1190fbaac..9466d0989f089 100644 --- a/gcc/config/msp430/msp430.c +++ b/gcc/config/msp430/msp430.c @@ -751,6 +751,10 @@ hwmult_name (unsigned int val) static void msp430_option_override (void) { + /* The MSP430 architecture can safely dereference a NULL pointer. In fact, + there are memory mapped registers there. */ + flag_delete_null_pointer_checks = 0; + init_machine_status = msp430_init_machine_status; if (target_cpu) @@ -1877,7 +1881,7 @@ msp430_attr (tree * node, break; case INTEGER_CST: - if (wi::gtu_p (value, 63)) + if (wi::gtu_p (wi::to_wide (value), 63)) /* Allow the attribute to be added - the linker script being used may still recognise this value. */ warning (OPT_Wattributes, diff --git a/gcc/config/nds32/nds32.c b/gcc/config/nds32/nds32.c index 65095ffaff1ad..c1eb66abc171c 100644 --- a/gcc/config/nds32/nds32.c +++ b/gcc/config/nds32/nds32.c @@ -2576,8 +2576,8 @@ nds32_insert_attributes (tree decl, tree *attributes) id = TREE_VALUE (id_list); /* Issue error if it is not a valid integer value. */ if (TREE_CODE (id) != INTEGER_CST - || wi::ltu_p (id, lower_bound) - || wi::gtu_p (id, upper_bound)) + || wi::ltu_p (wi::to_wide (id), lower_bound) + || wi::gtu_p (wi::to_wide (id), upper_bound)) error ("invalid id value for interrupt/exception attribute"); /* Advance to next id. */ @@ -2604,8 +2604,8 @@ nds32_insert_attributes (tree decl, tree *attributes) /* 3. Check valid integer value for reset. */ if (TREE_CODE (id) != INTEGER_CST - || wi::ltu_p (id, lower_bound) - || wi::gtu_p (id, upper_bound)) + || wi::ltu_p (wi::to_wide (id), lower_bound) + || wi::gtu_p (wi::to_wide (id), upper_bound)) error ("invalid id value for reset attribute"); /* 4. Check valid function for nmi/warm. */ diff --git a/gcc/config/powerpcspe/powerpcspe-c.c b/gcc/config/powerpcspe/powerpcspe-c.c index db04153120922..661480fd479f5 100644 --- a/gcc/config/powerpcspe/powerpcspe-c.c +++ b/gcc/config/powerpcspe/powerpcspe-c.c @@ -6055,7 +6055,8 @@ altivec_resolve_overloaded_builtin (location_t loc, tree fndecl, /* If the second argument is an integer constant, if the value is in the expected range, generate the built-in code if we can. We need 64-bit and direct move to extract the small integer vectors. */ - if (TREE_CODE (arg2) == INTEGER_CST && wi::ltu_p (arg2, nunits)) + if (TREE_CODE (arg2) == INTEGER_CST + && wi::ltu_p (wi::to_wide (arg2), nunits)) { switch (mode) { @@ -6217,7 +6218,7 @@ altivec_resolve_overloaded_builtin (location_t loc, tree fndecl, mode = TYPE_MODE (arg1_type); if ((mode == V2DFmode || mode == V2DImode) && VECTOR_UNIT_VSX_P (mode) && TREE_CODE (arg2) == INTEGER_CST - && wi::ltu_p (arg2, 2)) + && wi::ltu_p (wi::to_wide (arg2), 2)) { tree call = NULL_TREE; @@ -6233,7 +6234,7 @@ altivec_resolve_overloaded_builtin (location_t loc, tree fndecl, } else if (mode == V1TImode && VECTOR_UNIT_VSX_P (mode) && TREE_CODE (arg2) == INTEGER_CST - && wi::eq_p (arg2, 0)) + && wi::eq_p (wi::to_wide (arg2), 0)) { tree call = rs6000_builtin_decls[VSX_BUILTIN_VEC_SET_V1TI]; diff --git a/gcc/config/powerpcspe/powerpcspe.c b/gcc/config/powerpcspe/powerpcspe.c index 12af88417ba90..0f90e95f1e0ae 100644 --- a/gcc/config/powerpcspe/powerpcspe.c +++ b/gcc/config/powerpcspe/powerpcspe.c @@ -5855,6 +5855,7 @@ rs6000_builtin_vectorization_cost (enum vect_cost_for_stmt type_of_cost, return 3; case unaligned_load: + case vector_gather_load: if (TARGET_P9_VECTOR) return 3; @@ -5896,6 +5897,7 @@ rs6000_builtin_vectorization_cost (enum vect_cost_for_stmt type_of_cost, return 2; case unaligned_store: + case vector_scatter_store: if (TARGET_EFFICIENT_UNALIGNED_VSX) return 1; @@ -11617,7 +11619,8 @@ rs6000_aggregate_candidate (const_tree type, machine_mode *modep) - tree_to_uhwi (TYPE_MIN_VALUE (index))); /* There must be no padding. */ - if (wi::ne_p (TYPE_SIZE (type), count * GET_MODE_BITSIZE (*modep))) + if (wi::to_wide (TYPE_SIZE (type)) + != count * GET_MODE_BITSIZE (*modep)) return -1; return count; @@ -11647,7 +11650,8 @@ rs6000_aggregate_candidate (const_tree type, machine_mode *modep) } /* There must be no padding. */ - if (wi::ne_p (TYPE_SIZE (type), count * GET_MODE_BITSIZE (*modep))) + if (wi::to_wide (TYPE_SIZE (type)) + != count * GET_MODE_BITSIZE (*modep)) return -1; return count; @@ -11679,7 +11683,8 @@ rs6000_aggregate_candidate (const_tree type, machine_mode *modep) } /* There must be no padding. */ - if (wi::ne_p (TYPE_SIZE (type), count * GET_MODE_BITSIZE (*modep))) + if (wi::to_wide (TYPE_SIZE (type)) + != count * GET_MODE_BITSIZE (*modep)) return -1; return count; @@ -15936,14 +15941,15 @@ rs6000_expand_ternop_builtin (enum insn_code icode, tree exp, rtx target) /* Check whether the 2nd and 3rd arguments are integer constants and in range and prepare arguments. */ STRIP_NOPS (arg1); - if (TREE_CODE (arg1) != INTEGER_CST || wi::geu_p (arg1, 2)) + if (TREE_CODE (arg1) != INTEGER_CST || wi::geu_p (wi::to_wide (arg1), 2)) { error ("argument 2 must be 0 or 1"); return CONST0_RTX (tmode); } STRIP_NOPS (arg2); - if (TREE_CODE (arg2) != INTEGER_CST || wi::geu_p (arg2, 16)) + if (TREE_CODE (arg2) != INTEGER_CST + || wi::geu_p (wi::to_wide (arg2), 16)) { error ("argument 3 must be in the range 0..15"); return CONST0_RTX (tmode); diff --git a/gcc/config/rl78/rl78-protos.h b/gcc/config/rl78/rl78-protos.h index a155df61b9920..976bffa61e7fa 100644 --- a/gcc/config/rl78/rl78-protos.h +++ b/gcc/config/rl78/rl78-protos.h @@ -54,3 +54,13 @@ void rl78_output_aligned_common (FILE *, tree, const char *, int, int, int); int rl78_one_far_p (rtx *operands, int num_operands); + +#ifdef RTX_CODE +#ifdef HAVE_MACHINE_MODES + +rtx rl78_emit_libcall (const char*, enum rtx_code, + enum machine_mode, enum machine_mode, + int, rtx*); + +#endif +#endif diff --git a/gcc/config/rl78/rl78.c b/gcc/config/rl78/rl78.c index 6b13a80a8f3b4..c835dc0317bb6 100644 --- a/gcc/config/rl78/rl78.c +++ b/gcc/config/rl78/rl78.c @@ -4791,6 +4791,45 @@ rl78_addsi3_internal (rtx * operands, unsigned int alternative) } } +rtx +rl78_emit_libcall (const char *name, enum rtx_code code, + enum machine_mode dmode, enum machine_mode smode, + int noperands, rtx *operands) +{ + rtx ret; + rtx_insn *insns; + rtx libcall; + rtx equiv; + + start_sequence (); + libcall = gen_rtx_SYMBOL_REF (Pmode, name); + + switch (noperands) + { + case 2: + ret = emit_library_call_value (libcall, NULL_RTX, LCT_CONST, + dmode, operands[1], smode); + equiv = gen_rtx_fmt_e (code, dmode, operands[1]); + break; + + case 3: + ret = emit_library_call_value (libcall, NULL_RTX, + LCT_CONST, dmode, + operands[1], smode, operands[2], + smode); + equiv = gen_rtx_fmt_ee (code, dmode, operands[1], operands[2]); + break; + + default: + gcc_unreachable (); + } + + insns = get_insns (); + end_sequence (); + emit_libcall_block (insns, operands[0], ret, equiv); + return ret; +} + #undef TARGET_PREFERRED_RELOAD_CLASS #define TARGET_PREFERRED_RELOAD_CLASS rl78_preferred_reload_class diff --git a/gcc/config/rl78/rl78.md b/gcc/config/rl78/rl78.md index 722d98439b2b4..105d9bef360fd 100644 --- a/gcc/config/rl78/rl78.md +++ b/gcc/config/rl78/rl78.md @@ -224,6 +224,16 @@ DONE;" ) +(define_expand "adddi3" + [(set (match_operand:DI 0 "nonimmediate_operand" "") + (plus:DI (match_operand:DI 1 "general_operand" "") + (match_operand:DI 2 "general_operand" ""))) + ] + "" + "rl78_emit_libcall (\"__adddi3\", PLUS, DImode, DImode, 3, operands); + DONE;" +) + (define_insn "addsi3_internal_virt" [(set (match_operand:SI 0 "nonimmediate_operand" "=v,&vm, vm") (plus:SI (match_operand:SI 1 "general_operand" "0, vim, vim") diff --git a/gcc/config/rs6000/amo.h b/gcc/config/rs6000/amo.h new file mode 100644 index 0000000000000..d83e035da0593 --- /dev/null +++ b/gcc/config/rs6000/amo.h @@ -0,0 +1,152 @@ +/* Power ISA 3.0 atomic memory operation include file. + Copyright (C) 2017 Free Software Foundation, Inc. + Contributed by Michael Meissner . + + This file is part of GCC. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published + by the Free Software Foundation; either version 3, or (at your + option) any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + +#ifndef _AMO_H +#define _AMO_H + +#if !defined(_ARCH_PWR9) || !defined(_ARCH_PPC64) +#error "The atomic memory operations require Power 64-bit ISA 3.0" + +#else +#include + +/* Enumeration of the LWAT/LDAT sub-opcodes. */ +enum _AMO_LD { + _AMO_LD_ADD = 0x00, /* Fetch and Add. */ + _AMO_LD_XOR = 0x01, /* Fetch and Xor. */ + _AMO_LD_IOR = 0x02, /* Fetch and Ior. */ + _AMO_LD_AND = 0x03, /* Fetch and And. */ + _AMO_LD_UMAX = 0x04, /* Fetch and Unsigned Maximum. */ + _AMO_LD_SMAX = 0x05, /* Fetch and Signed Maximum. */ + _AMO_LD_UMIN = 0x06, /* Fetch and Unsigned Minimum. */ + _AMO_LD_SMIN = 0x07, /* Fetch and Signed Minimum. */ + _AMO_LD_SWAP = 0x08, /* Swap. */ + _AMO_LD_CS_NE = 0x10, /* Compare and Swap Not Equal. */ + _AMO_LD_INC_BOUNDED = 0x18, /* Fetch and Increment Bounded. */ + _AMO_LD_INC_EQUAL = 0x19, /* Fetch and Increment Equal. */ + _AMO_LD_DEC_BOUNDED = 0x1A /* Fetch and Decrement Bounded. */ +}; + +/* Implementation of the simple LWAT/LDAT operations that take one register and + modify one word or double-word of memory and return the value that was + previously in the memory location. + + The LWAT/LDAT opcode requires the address to be a single register, and that + points to a suitably aligned memory location. Asm volatile is used to + prevent the optimizer from moving the operation. */ + +#define _AMO_LD_SIMPLE(NAME, TYPE, OPCODE, FC) \ +static __inline__ TYPE \ +NAME (TYPE *_PTR, TYPE _VALUE) \ +{ \ + unsigned __int128 _TMP; \ + TYPE _RET; \ + __asm__ volatile ("mr %L1,%3\n" \ + "\t" OPCODE " %1,%P0,%4\n" \ + "\tmr %2,%1\n" \ + : "+Q" (_PTR[0]), "=&r" (_TMP), "=r" (_RET) \ + : "r" (_VALUE), "n" (FC)); \ + return _RET; \ +} + +_AMO_LD_SIMPLE (amo_lwat_add, uint32_t, "lwat", _AMO_LD_ADD) +_AMO_LD_SIMPLE (amo_lwat_xor, uint32_t, "lwat", _AMO_LD_XOR) +_AMO_LD_SIMPLE (amo_lwat_ior, uint32_t, "lwat", _AMO_LD_IOR) +_AMO_LD_SIMPLE (amo_lwat_and, uint32_t, "lwat", _AMO_LD_AND) +_AMO_LD_SIMPLE (amo_lwat_umax, uint32_t, "lwat", _AMO_LD_UMAX) +_AMO_LD_SIMPLE (amo_lwat_umin, uint32_t, "lwat", _AMO_LD_UMIN) +_AMO_LD_SIMPLE (amo_lwat_swap, uint32_t, "lwat", _AMO_LD_SWAP) + +_AMO_LD_SIMPLE (amo_lwat_sadd, int32_t, "lwat", _AMO_LD_ADD) +_AMO_LD_SIMPLE (amo_lwat_smax, int32_t, "lwat", _AMO_LD_SMAX) +_AMO_LD_SIMPLE (amo_lwat_smin, int32_t, "lwat", _AMO_LD_SMIN) +_AMO_LD_SIMPLE (amo_lwat_sswap, int32_t, "lwat", _AMO_LD_SWAP) + +_AMO_LD_SIMPLE (amo_ldat_add, uint64_t, "ldat", _AMO_LD_ADD) +_AMO_LD_SIMPLE (amo_ldat_xor, uint64_t, "ldat", _AMO_LD_XOR) +_AMO_LD_SIMPLE (amo_ldat_ior, uint64_t, "ldat", _AMO_LD_IOR) +_AMO_LD_SIMPLE (amo_ldat_and, uint64_t, "ldat", _AMO_LD_AND) +_AMO_LD_SIMPLE (amo_ldat_umax, uint64_t, "ldat", _AMO_LD_UMAX) +_AMO_LD_SIMPLE (amo_ldat_umin, uint64_t, "ldat", _AMO_LD_UMIN) +_AMO_LD_SIMPLE (amo_ldat_swap, uint64_t, "ldat", _AMO_LD_SWAP) + +_AMO_LD_SIMPLE (amo_ldat_sadd, int64_t, "ldat", _AMO_LD_ADD) +_AMO_LD_SIMPLE (amo_ldat_smax, int64_t, "ldat", _AMO_LD_SMAX) +_AMO_LD_SIMPLE (amo_ldat_smin, int64_t, "ldat", _AMO_LD_SMIN) +_AMO_LD_SIMPLE (amo_ldat_sswap, int64_t, "ldat", _AMO_LD_SWAP) + +/* Enumeration of the STWAT/STDAT sub-opcodes. */ +enum _AMO_ST { + _AMO_ST_ADD = 0x00, /* Store Add. */ + _AMO_ST_XOR = 0x01, /* Store Xor. */ + _AMO_ST_IOR = 0x02, /* Store Ior. */ + _AMO_ST_AND = 0x03, /* Store And. */ + _AMO_ST_UMAX = 0x04, /* Store Unsigned Maximum. */ + _AMO_ST_SMAX = 0x05, /* Store Signed Maximum. */ + _AMO_ST_UMIN = 0x06, /* Store Unsigned Minimum. */ + _AMO_ST_SMIN = 0x07, /* Store Signed Minimum. */ + _AMO_ST_TWIN = 0x18 /* Store Twin. */ +}; + +/* Implementation of the simple STWAT/STDAT operations that take one register + and modify one word or double-word of memory. No value is returned. + + The STWAT/STDAT opcode requires the address to be a single register, and + that points to a suitably aligned memory location. Asm volatile is used to + prevent the optimizer from moving the operation. */ + +#define _AMO_ST_SIMPLE(NAME, TYPE, OPCODE, FC) \ +static __inline__ void \ +NAME (TYPE *_PTR, TYPE _VALUE) \ +{ \ + __asm__ volatile (OPCODE " %1,%P0,%2" \ + : "+Q" (_PTR[0]) \ + : "r" (_VALUE), "n" (FC)); \ + return; \ +} + +_AMO_ST_SIMPLE (amo_stwat_add, uint32_t, "stwat", _AMO_ST_ADD) +_AMO_ST_SIMPLE (amo_stwat_xor, uint32_t, "stwat", _AMO_ST_XOR) +_AMO_ST_SIMPLE (amo_stwat_ior, uint32_t, "stwat", _AMO_ST_IOR) +_AMO_ST_SIMPLE (amo_stwat_and, uint32_t, "stwat", _AMO_ST_AND) +_AMO_ST_SIMPLE (amo_stwat_umax, uint32_t, "stwat", _AMO_ST_UMAX) +_AMO_ST_SIMPLE (amo_stwat_umin, uint32_t, "stwat", _AMO_ST_UMIN) + +_AMO_ST_SIMPLE (amo_stwat_sadd, int32_t, "stwat", _AMO_ST_ADD) +_AMO_ST_SIMPLE (amo_stwat_smax, int32_t, "stwat", _AMO_ST_SMAX) +_AMO_ST_SIMPLE (amo_stwat_smin, int32_t, "stwat", _AMO_ST_SMIN) + +_AMO_ST_SIMPLE (amo_stdat_add, uint64_t, "stdat", _AMO_ST_ADD) +_AMO_ST_SIMPLE (amo_stdat_xor, uint64_t, "stdat", _AMO_ST_XOR) +_AMO_ST_SIMPLE (amo_stdat_ior, uint64_t, "stdat", _AMO_ST_IOR) +_AMO_ST_SIMPLE (amo_stdat_and, uint64_t, "stdat", _AMO_ST_AND) +_AMO_ST_SIMPLE (amo_stdat_umax, uint64_t, "stdat", _AMO_ST_UMAX) +_AMO_ST_SIMPLE (amo_stdat_umin, uint64_t, "stdat", _AMO_ST_UMIN) + +_AMO_ST_SIMPLE (amo_stdat_sadd, int64_t, "stdat", _AMO_ST_ADD) +_AMO_ST_SIMPLE (amo_stdat_smax, int64_t, "stdat", _AMO_ST_SMAX) +_AMO_ST_SIMPLE (amo_stdat_smin, int64_t, "stdat", _AMO_ST_SMIN) +#endif /* _ARCH_PWR9 && _ARCH_PPC64. */ +#endif /* _POWERPC_AMO_H. */ diff --git a/gcc/config/rs6000/predicates.md b/gcc/config/rs6000/predicates.md index 237b4323b4ced..569158f4c355f 100644 --- a/gcc/config/rs6000/predicates.md +++ b/gcc/config/rs6000/predicates.md @@ -199,6 +199,16 @@ return CA_REGNO_P (REGNO (op)); }) +;; Return 1 if operand is constant zero (scalars and vectors). +(define_predicate "zero_constant" + (and (match_code "const_int,const_double,const_wide_int,const_vector") + (match_test "op == CONST0_RTX (mode)"))) + +;; Return 1 if operand is constant -1 (scalars and vectors). +(define_predicate "all_ones_constant" + (and (match_code "const_int,const_double,const_wide_int,const_vector") + (match_test "op == CONSTM1_RTX (mode) && !FLOAT_MODE_P (mode)"))) + ;; Return 1 if op is a signed 5-bit constant integer. (define_predicate "s5bit_cint_operand" (and (match_code "const_int") @@ -543,12 +553,16 @@ (match_operand 0 "u_short_cint_operand") (match_operand 0 "gpc_reg_operand"))) -;; Return 1 if op is any constant integer -;; or non-special register. +;; Return 1 if op is any constant integer or a non-special register. (define_predicate "reg_or_cint_operand" (ior (match_code "const_int") (match_operand 0 "gpc_reg_operand"))) +;; Return 1 if op is constant zero or a non-special register. +(define_predicate "reg_or_zero_operand" + (ior (match_operand 0 "zero_constant") + (match_operand 0 "gpc_reg_operand"))) + ;; Return 1 if op is a constant integer valid for addition with addis, addi. (define_predicate "add_cint_operand" (and (match_code "const_int") @@ -744,16 +758,6 @@ (and (match_test "easy_altivec_constant (op, mode)") (match_test "vspltis_shifted (op) != 0"))))) -;; Return 1 if operand is constant zero (scalars and vectors). -(define_predicate "zero_constant" - (and (match_code "const_int,const_double,const_wide_int,const_vector") - (match_test "op == CONST0_RTX (mode)"))) - -;; Return 1 if operand is constant -1 (scalars and vectors). -(define_predicate "all_ones_constant" - (and (match_code "const_int,const_double,const_wide_int,const_vector") - (match_test "op == CONSTM1_RTX (mode) && !FLOAT_MODE_P (mode)"))) - ;; Return 1 if operand is a vector int register or is either a vector constant ;; of all 0 bits of a vector constant of all 1 bits. (define_predicate "vector_int_reg_or_same_bit" diff --git a/gcc/config/rs6000/rs6000-c.c b/gcc/config/rs6000/rs6000-c.c index 2a916b4387371..8e581249b7402 100644 --- a/gcc/config/rs6000/rs6000-c.c +++ b/gcc/config/rs6000/rs6000-c.c @@ -6253,7 +6253,8 @@ altivec_resolve_overloaded_builtin (location_t loc, tree fndecl, /* If the second argument is an integer constant, if the value is in the expected range, generate the built-in code if we can. We need 64-bit and direct move to extract the small integer vectors. */ - if (TREE_CODE (arg2) == INTEGER_CST && wi::ltu_p (arg2, nunits)) + if (TREE_CODE (arg2) == INTEGER_CST + && wi::ltu_p (wi::to_wide (arg2), nunits)) { switch (mode) { @@ -6415,7 +6416,7 @@ altivec_resolve_overloaded_builtin (location_t loc, tree fndecl, mode = TYPE_MODE (arg1_type); if ((mode == V2DFmode || mode == V2DImode) && VECTOR_UNIT_VSX_P (mode) && TREE_CODE (arg2) == INTEGER_CST - && wi::ltu_p (arg2, 2)) + && wi::ltu_p (wi::to_wide (arg2), 2)) { tree call = NULL_TREE; @@ -6431,7 +6432,7 @@ altivec_resolve_overloaded_builtin (location_t loc, tree fndecl, } else if (mode == V1TImode && VECTOR_UNIT_VSX_P (mode) && TREE_CODE (arg2) == INTEGER_CST - && wi::eq_p (arg2, 0)) + && wi::eq_p (wi::to_wide (arg2), 0)) { tree call = rs6000_builtin_decls[VSX_BUILTIN_VEC_SET_V1TI]; diff --git a/gcc/config/rs6000/rs6000-p8swap.c b/gcc/config/rs6000/rs6000-p8swap.c index 83df9c871cf5f..e1324b72c2516 100644 --- a/gcc/config/rs6000/rs6000-p8swap.c +++ b/gcc/config/rs6000/rs6000-p8swap.c @@ -1882,6 +1882,7 @@ rs6000_analyze_swaps (function *fun) /* Pre-pass to recombine lvx and stvx patterns so we don't lose info. */ recombine_lvx_stvx_patterns (fun); + df_process_deferred_rescans (); /* Allocate structure to represent webs of insns. */ insn_entry = XCNEWVEC (swap_web_entry, get_max_uid ()); diff --git a/gcc/config/rs6000/rs6000-protos.h b/gcc/config/rs6000/rs6000-protos.h index c6be5b1ef59f8..db0e692739c9b 100644 --- a/gcc/config/rs6000/rs6000-protos.h +++ b/gcc/config/rs6000/rs6000-protos.h @@ -209,7 +209,6 @@ extern void rs6000_emit_epilogue (int); extern void rs6000_expand_split_stack_prologue (void); extern void rs6000_split_stack_space_check (rtx, rtx); extern void rs6000_emit_eh_reg_restore (rtx, rtx); -extern const char * output_isel (rtx *); extern void rs6000_call_aix (rtx, rtx, rtx, rtx); extern void rs6000_sibcall_aix (rtx, rtx, rtx, rtx); extern void rs6000_aix_asm_output_dwarf_table_ref (char *); diff --git a/gcc/config/rs6000/rs6000-string.c b/gcc/config/rs6000/rs6000-string.c index 19463c98687fc..8c2a93e3d9119 100644 --- a/gcc/config/rs6000/rs6000-string.c +++ b/gcc/config/rs6000/rs6000-string.c @@ -674,10 +674,10 @@ expand_strncmp_align_check (rtx strncmp_label, rtx src, HOST_WIDE_INT bytes) emit_move_insn (cond, gen_rtx_COMPARE (CCmode, src_check, GEN_INT (4096 - bytes))); - rtx cmp_rtx = gen_rtx_LT (VOIDmode, cond, const0_rtx); + rtx cmp_rtx = gen_rtx_GE (VOIDmode, cond, const0_rtx); rtx ifelse = gen_rtx_IF_THEN_ELSE (VOIDmode, cmp_rtx, - pc_rtx, lab_ref); + lab_ref, pc_rtx); rtx j = emit_jump_insn (gen_rtx_SET (pc_rtx, ifelse)); JUMP_LABEL (j) = strncmp_label; LABEL_NUSES (strncmp_label) += 1; diff --git a/gcc/config/rs6000/rs6000.c b/gcc/config/rs6000/rs6000.c index b903f47ee2769..4837e14a0e62d 100644 --- a/gcc/config/rs6000/rs6000.c +++ b/gcc/config/rs6000/rs6000.c @@ -637,31 +637,10 @@ mode_supports_vsx_dform_quad (machine_mode mode) } -/* Target cpu costs. */ - -struct processor_costs { - const int mulsi; /* cost of SImode multiplication. */ - const int mulsi_const; /* cost of SImode multiplication by constant. */ - const int mulsi_const9; /* cost of SImode mult by short constant. */ - const int muldi; /* cost of DImode multiplication. */ - const int divsi; /* cost of SImode division. */ - const int divdi; /* cost of DImode division. */ - const int fp; /* cost of simple SFmode and DFmode insns. */ - const int dmul; /* cost of DFmode multiplication (and fmadd). */ - const int sdiv; /* cost of SFmode division (fdivs). */ - const int ddiv; /* cost of DFmode division (fdiv). */ - const int cache_line_size; /* cache line size in bytes. */ - const int l1_cache_size; /* size of l1 cache, in kilobytes. */ - const int l2_cache_size; /* size of l2 cache, in kilobytes. */ - const int simultaneous_prefetches; /* number of parallel prefetch - operations. */ - const int sfdf_convert; /* cost of SF->DF conversion. */ -}; +/* Processor costs (relative to an add) */ const struct processor_costs *rs6000_cost; -/* Processor costs (relative to an add) */ - /* Instruction size costs on 32bit processors. */ static const struct processor_costs size32_cost = { @@ -1749,6 +1728,8 @@ static const struct attribute_spec rs6000_attribute_table[] = #define TARGET_RTX_COSTS rs6000_rtx_costs #undef TARGET_ADDRESS_COST #define TARGET_ADDRESS_COST hook_int_rtx_mode_as_bool_0 +#undef TARGET_INSN_COST +#define TARGET_INSN_COST rs6000_insn_cost #undef TARGET_INIT_DWARF_REG_SIZES_EXTRA #define TARGET_INIT_DWARF_REG_SIZES_EXTRA rs6000_init_dwarf_reg_sizes_extra @@ -5438,9 +5419,7 @@ rs6000_builtin_vectorization_cost (enum vect_cost_for_stmt type_of_cost, return 3; case unaligned_load: - if (TARGET_P9_VECTOR) - return 3; - + case vector_gather_load: if (TARGET_EFFICIENT_UNALIGNED_VSX) return 1; @@ -5479,6 +5458,7 @@ rs6000_builtin_vectorization_cost (enum vect_cost_for_stmt type_of_cost, return 2; case unaligned_store: + case vector_scatter_store: if (TARGET_EFFICIENT_UNALIGNED_VSX) return 1; @@ -9051,11 +9031,7 @@ rs6000_legitimate_combined_insn (rtx_insn *insn) && (icode == CODE_FOR_ctrsi_internal1 || icode == CODE_FOR_ctrdi_internal1 || icode == CODE_FOR_ctrsi_internal2 - || icode == CODE_FOR_ctrdi_internal2 - || icode == CODE_FOR_ctrsi_internal3 - || icode == CODE_FOR_ctrdi_internal3 - || icode == CODE_FOR_ctrsi_internal4 - || icode == CODE_FOR_ctrdi_internal4)) + || icode == CODE_FOR_ctrdi_internal2)) return false; return true; @@ -10983,7 +10959,8 @@ rs6000_aggregate_candidate (const_tree type, machine_mode *modep) - tree_to_uhwi (TYPE_MIN_VALUE (index))); /* There must be no padding. */ - if (wi::ne_p (TYPE_SIZE (type), count * GET_MODE_BITSIZE (*modep))) + if (wi::to_wide (TYPE_SIZE (type)) + != count * GET_MODE_BITSIZE (*modep)) return -1; return count; @@ -11013,7 +10990,8 @@ rs6000_aggregate_candidate (const_tree type, machine_mode *modep) } /* There must be no padding. */ - if (wi::ne_p (TYPE_SIZE (type), count * GET_MODE_BITSIZE (*modep))) + if (wi::to_wide (TYPE_SIZE (type)) + != count * GET_MODE_BITSIZE (*modep)) return -1; return count; @@ -11045,7 +11023,8 @@ rs6000_aggregate_candidate (const_tree type, machine_mode *modep) } /* There must be no padding. */ - if (wi::ne_p (TYPE_SIZE (type), count * GET_MODE_BITSIZE (*modep))) + if (wi::to_wide (TYPE_SIZE (type)) + != count * GET_MODE_BITSIZE (*modep)) return -1; return count; @@ -15116,14 +15095,15 @@ rs6000_expand_ternop_builtin (enum insn_code icode, tree exp, rtx target) /* Check whether the 2nd and 3rd arguments are integer constants and in range and prepare arguments. */ STRIP_NOPS (arg1); - if (TREE_CODE (arg1) != INTEGER_CST || wi::geu_p (arg1, 2)) + if (TREE_CODE (arg1) != INTEGER_CST || wi::geu_p (wi::to_wide (arg1), 2)) { error ("argument 2 must be 0 or 1"); return CONST0_RTX (tmode); } STRIP_NOPS (arg2); - if (TREE_CODE (arg2) != INTEGER_CST || wi::geu_p (arg2, 16)) + if (TREE_CODE (arg2) != INTEGER_CST + || wi::geu_p (wi::to_wide (arg2), 16)) { error ("argument 3 must be in the range 0..15"); return CONST0_RTX (tmode); @@ -23274,24 +23254,6 @@ rs6000_emit_int_cmove (rtx dest, rtx op, rtx true_cond, rtx false_cond) return 1; } -const char * -output_isel (rtx *operands) -{ - enum rtx_code code; - - code = GET_CODE (operands[1]); - - if (code == GE || code == GEU || code == LE || code == LEU || code == NE) - { - gcc_assert (GET_CODE (operands[2]) == REG - && GET_CODE (operands[3]) == REG); - PUT_CODE (operands[1], reverse_condition (code)); - return "isel %0,%3,%2,%j1"; - } - - return "isel %0,%2,%3,%j1"; -} - void rs6000_emit_minmax (rtx dest, enum rtx_code code, rtx op0, rtx op1) { @@ -34412,7 +34374,8 @@ rs6000_xcoff_asm_output_aligned_decl_common (FILE *stream, size, align2); #ifdef HAVE_GAS_HIDDEN - fputs (rs6000_xcoff_visibility (decl), stream); + if (decl != NULL) + fputs (rs6000_xcoff_visibility (decl), stream); #endif putc ('\n', stream); } @@ -34957,6 +34920,88 @@ rs6000_debug_rtx_costs (rtx x, machine_mode mode, int outer_code, return ret; } +static int +rs6000_insn_cost (rtx_insn *insn, bool speed) +{ + if (recog_memoized (insn) < 0) + return 0; + + if (!speed) + return get_attr_length (insn); + + int cost = get_attr_cost (insn); + if (cost > 0) + return cost; + + int n = get_attr_length (insn) / 4; + enum attr_type type = get_attr_type (insn); + + switch (type) + { + case TYPE_LOAD: + case TYPE_FPLOAD: + case TYPE_VECLOAD: + cost = COSTS_N_INSNS (n + 1); + break; + + case TYPE_MUL: + switch (get_attr_size (insn)) + { + case SIZE_8: + cost = COSTS_N_INSNS (n - 1) + rs6000_cost->mulsi_const9; + break; + case SIZE_16: + cost = COSTS_N_INSNS (n - 1) + rs6000_cost->mulsi_const; + break; + case SIZE_32: + cost = COSTS_N_INSNS (n - 1) + rs6000_cost->mulsi; + break; + case SIZE_64: + cost = COSTS_N_INSNS (n - 1) + rs6000_cost->muldi; + break; + default: + gcc_unreachable (); + } + break; + case TYPE_DIV: + switch (get_attr_size (insn)) + { + case SIZE_32: + cost = COSTS_N_INSNS (n - 1) + rs6000_cost->divsi; + break; + case SIZE_64: + cost = COSTS_N_INSNS (n - 1) + rs6000_cost->divdi; + break; + default: + gcc_unreachable (); + } + break; + + case TYPE_FP: + cost = n * rs6000_cost->fp; + break; + case TYPE_DMUL: + cost = n * rs6000_cost->dmul; + break; + case TYPE_SDIV: + cost = n * rs6000_cost->sdiv; + break; + case TYPE_DDIV: + cost = n * rs6000_cost->ddiv; + break; + + case TYPE_SYNC: + case TYPE_LOAD_L: + cost = COSTS_N_INSNS (n + 2); + break; + + default: + cost = COSTS_N_INSNS (n); + } + + return cost; +} + /* Debug form of ADDRESS_COST that is selected if -mdebug=cost. */ static int diff --git a/gcc/config/rs6000/rs6000.h b/gcc/config/rs6000/rs6000.h index 60219726f9df0..5a5244aff8530 100644 --- a/gcc/config/rs6000/rs6000.h +++ b/gcc/config/rs6000/rs6000.h @@ -565,8 +565,6 @@ extern int rs6000_vector_align[]; #define TARGET_ALTIVEC_ABI rs6000_altivec_abi #define TARGET_LDBRX (TARGET_POPCNTD || rs6000_cpu == PROCESSOR_CELL) -#define TARGET_ISEL64 (TARGET_ISEL && TARGET_POWERPC64) - /* ISA 2.01 allowed FCFID to be done in 32-bit, previously it was 64-bit only. Enable 32-bit fcfid's on any of the switches for newer ISA machines or XILINX. */ @@ -2064,6 +2062,29 @@ extern scalar_int_mode rs6000_pmode; /* Given a condition code and a mode, return the inverse condition. */ #define REVERSE_CONDITION(CODE, MODE) rs6000_reverse_condition (MODE, CODE) + +/* Target cpu costs. */ + +struct processor_costs { + const int mulsi; /* cost of SImode multiplication. */ + const int mulsi_const; /* cost of SImode multiplication by constant. */ + const int mulsi_const9; /* cost of SImode mult by short constant. */ + const int muldi; /* cost of DImode multiplication. */ + const int divsi; /* cost of SImode division. */ + const int divdi; /* cost of DImode division. */ + const int fp; /* cost of simple SFmode and DFmode insns. */ + const int dmul; /* cost of DFmode multiplication (and fmadd). */ + const int sdiv; /* cost of SFmode division (fdivs). */ + const int ddiv; /* cost of DFmode division (fdiv). */ + const int cache_line_size; /* cache line size in bytes. */ + const int l1_cache_size; /* size of l1 cache, in kilobytes. */ + const int l2_cache_size; /* size of l2 cache, in kilobytes. */ + const int simultaneous_prefetches; /* number of parallel prefetch + operations. */ + const int sfdf_convert; /* cost of SF->DF conversion. */ +}; + +extern const struct processor_costs *rs6000_cost; /* Control the assembler format that we output. */ diff --git a/gcc/config/rs6000/rs6000.md b/gcc/config/rs6000/rs6000.md index d8767dee05c7b..62bd19b19c513 100644 --- a/gcc/config/rs6000/rs6000.md +++ b/gcc/config/rs6000/rs6000.md @@ -193,6 +193,10 @@ ;; This is used for insert, mul and others as necessary. (define_attr "size" "8,16,32,64,128" (const_string "32")) +;; What is the insn_cost for this insn? The target hook can still override +;; this. For optimizing for size the "length" attribute is used instead. +(define_attr "cost" "" (const_int 0)) + ;; Is this instruction record form ("dot", signed compare to 0, writing CR0)? ;; This is used for add, logical, shift, exts, mul. (define_attr "dot" "no,yes" (const_string "no")) @@ -574,9 +578,6 @@ ; DImode bits (define_mode_attr dbits [(QI "56") (HI "48") (SI "32")]) -;; ISEL/ISEL64 target selection -(define_mode_attr sel [(SI "") (DI "64")]) - ;; Bitmask for shift instructions (define_mode_attr hH [(SI "h") (DI "H")]) @@ -4911,7 +4912,7 @@ (if_then_else:GPR (match_operand 1 "comparison_operator" "") (match_operand:GPR 2 "gpc_reg_operand" "") (match_operand:GPR 3 "gpc_reg_operand" "")))] - "TARGET_ISEL" + "TARGET_ISEL" " { if (rs6000_emit_cmove (operands[0], operands[1], operands[2], operands[3])) @@ -4934,13 +4935,11 @@ (match_operator 1 "scc_comparison_operator" [(match_operand:CC 4 "cc_reg_operand" "y,y") (const_int 0)]) - (match_operand:GPR 2 "reg_or_cint_operand" "O,b") + (match_operand:GPR 2 "reg_or_zero_operand" "O,b") (match_operand:GPR 3 "gpc_reg_operand" "r,r")))] - "TARGET_ISEL" - "* -{ return output_isel (operands); }" - [(set_attr "type" "isel") - (set_attr "length" "4")]) + "TARGET_ISEL" + "isel %0,%2,%3,%j1" + [(set_attr "type" "isel")]) (define_insn "isel_unsigned_" [(set (match_operand:GPR 0 "gpc_reg_operand" "=r,r") @@ -4948,45 +4947,45 @@ (match_operator 1 "scc_comparison_operator" [(match_operand:CCUNS 4 "cc_reg_operand" "y,y") (const_int 0)]) - (match_operand:GPR 2 "reg_or_cint_operand" "O,b") + (match_operand:GPR 2 "reg_or_zero_operand" "O,b") (match_operand:GPR 3 "gpc_reg_operand" "r,r")))] - "TARGET_ISEL" - "* -{ return output_isel (operands); }" - [(set_attr "type" "isel") - (set_attr "length" "4")]) + "TARGET_ISEL" + "isel %0,%2,%3,%j1" + [(set_attr "type" "isel")]) ;; These patterns can be useful for combine; they let combine know that ;; isel can handle reversed comparisons so long as the operands are ;; registers. (define_insn "*isel_reversed_signed_" - [(set (match_operand:GPR 0 "gpc_reg_operand" "=r") + [(set (match_operand:GPR 0 "gpc_reg_operand" "=r,r") (if_then_else:GPR (match_operator 1 "scc_rev_comparison_operator" - [(match_operand:CC 4 "cc_reg_operand" "y") + [(match_operand:CC 4 "cc_reg_operand" "y,y") (const_int 0)]) - (match_operand:GPR 2 "gpc_reg_operand" "b") - (match_operand:GPR 3 "gpc_reg_operand" "b")))] - "TARGET_ISEL" - "* -{ return output_isel (operands); }" - [(set_attr "type" "isel") - (set_attr "length" "4")]) + (match_operand:GPR 2 "gpc_reg_operand" "r,r") + (match_operand:GPR 3 "reg_or_zero_operand" "O,b")))] + "TARGET_ISEL" +{ + PUT_CODE (operands[1], reverse_condition (GET_CODE (operands[1]))); + return "isel %0,%3,%2,%j1"; +} + [(set_attr "type" "isel")]) (define_insn "*isel_reversed_unsigned_" - [(set (match_operand:GPR 0 "gpc_reg_operand" "=r") + [(set (match_operand:GPR 0 "gpc_reg_operand" "=r,r") (if_then_else:GPR (match_operator 1 "scc_rev_comparison_operator" - [(match_operand:CCUNS 4 "cc_reg_operand" "y") + [(match_operand:CCUNS 4 "cc_reg_operand" "y,y") (const_int 0)]) - (match_operand:GPR 2 "gpc_reg_operand" "b") - (match_operand:GPR 3 "gpc_reg_operand" "b")))] - "TARGET_ISEL" - "* -{ return output_isel (operands); }" - [(set_attr "type" "isel") - (set_attr "length" "4")]) + (match_operand:GPR 2 "gpc_reg_operand" "r,r") + (match_operand:GPR 3 "reg_or_zero_operand" "O,b")))] + "TARGET_ISEL" +{ + PUT_CODE (operands[1], reverse_condition (GET_CODE (operands[1]))); + return "isel %0,%3,%2,%j1"; +} + [(set_attr "type" "isel")]) ;; Floating point conditional move (define_expand "movcc" @@ -11158,7 +11157,7 @@ [(call (mem:SI (match_operand:P 0 "register_operand" "c,*l")) (match_operand 1 "" "g,g")) (use (match_operand:P 2 "memory_operand" ",")) - (set (reg:P TOC_REGNUM) (unspec [(match_operand:P 3 "const_int_operand" "n,n")] UNSPEC_TOCSLOT)) + (set (reg:P TOC_REGNUM) (unspec:P [(match_operand:P 3 "const_int_operand" "n,n")] UNSPEC_TOCSLOT)) (clobber (reg:P LR_REGNO))] "DEFAULT_ABI == ABI_AIX" " 2,%2\;b%T0l\; 2,%3(1)" @@ -11170,7 +11169,7 @@ (call (mem:SI (match_operand:P 1 "register_operand" "c,*l")) (match_operand 2 "" "g,g"))) (use (match_operand:P 3 "memory_operand" ",")) - (set (reg:P TOC_REGNUM) (unspec [(match_operand:P 4 "const_int_operand" "n,n")] UNSPEC_TOCSLOT)) + (set (reg:P TOC_REGNUM) (unspec:P [(match_operand:P 4 "const_int_operand" "n,n")] UNSPEC_TOCSLOT)) (clobber (reg:P LR_REGNO))] "DEFAULT_ABI == ABI_AIX" " 2,%3\;b%T1l\; 2,%4(1)" @@ -11184,7 +11183,7 @@ (define_insn "*call_indirect_elfv2" [(call (mem:SI (match_operand:P 0 "register_operand" "c,*l")) (match_operand 1 "" "g,g")) - (set (reg:P TOC_REGNUM) (unspec [(match_operand:P 2 "const_int_operand" "n,n")] UNSPEC_TOCSLOT)) + (set (reg:P TOC_REGNUM) (unspec:P [(match_operand:P 2 "const_int_operand" "n,n")] UNSPEC_TOCSLOT)) (clobber (reg:P LR_REGNO))] "DEFAULT_ABI == ABI_ELFv2" "b%T0l\; 2,%2(1)" @@ -11195,7 +11194,7 @@ [(set (match_operand 0 "" "") (call (mem:SI (match_operand:P 1 "register_operand" "c,*l")) (match_operand 2 "" "g,g"))) - (set (reg:P TOC_REGNUM) (unspec [(match_operand:P 3 "const_int_operand" "n,n")] UNSPEC_TOCSLOT)) + (set (reg:P TOC_REGNUM) (unspec:P [(match_operand:P 3 "const_int_operand" "n,n")] UNSPEC_TOCSLOT)) (clobber (reg:P LR_REGNO))] "DEFAULT_ABI == ABI_ELFv2" "b%T1l\; 2,%3(1)" @@ -12598,62 +12597,27 @@ (define_insn "" [(set (pc) (if_then_else (match_operator 1 "branch_comparison_operator" - [(match_operand 2 - "cc_reg_operand" "y") + [(match_operand 2 "cc_reg_operand" "y") (const_int 0)]) - (label_ref (match_operand 0 "" "")) + (label_ref (match_operand 0)) (pc)))] "" - "* { - return output_cbranch (operands[1], \"%l0\", 0, insn); -}" + return output_cbranch (operands[1], "%l0", 0, insn); +} [(set_attr "type" "branch")]) (define_insn "" [(set (pc) (if_then_else (match_operator 0 "branch_comparison_operator" - [(match_operand 1 - "cc_reg_operand" "y") + [(match_operand 1 "cc_reg_operand" "y") (const_int 0)]) (any_return) (pc)))] "" - "* { return output_cbranch (operands[0], NULL, 0, insn); -}" - [(set_attr "type" "jmpreg") - (set_attr "length" "4")]) - -(define_insn "" - [(set (pc) - (if_then_else (match_operator 1 "branch_comparison_operator" - [(match_operand 2 - "cc_reg_operand" "y") - (const_int 0)]) - (pc) - (label_ref (match_operand 0 "" ""))))] - "" - "* -{ - return output_cbranch (operands[1], \"%l0\", 1, insn); -}" - [(set_attr "type" "branch")]) - -(define_insn "" - [(set (pc) - (if_then_else (match_operator 0 "branch_comparison_operator" - [(match_operand 1 - "cc_reg_operand" "y") - (const_int 0)]) - (pc) - (any_return)))] - "" - "* -{ - return output_cbranch (operands[0], NULL, 1, insn); -}" +} [(set_attr "type" "jmpreg") (set_attr "length" "4")]) @@ -12774,7 +12738,7 @@ (define_insn "jump" [(set (pc) - (label_ref (match_operand 0 "" "")))] + (label_ref (match_operand 0)))] "" "b %l0" [(set_attr "type" "branch")]) @@ -12786,66 +12750,64 @@ [(set_attr "type" "jmpreg")]) (define_expand "indirect_jump" - [(set (pc) (match_operand 0 "register_operand" ""))]) + [(set (pc) (match_operand 0 "register_operand"))]) (define_insn "*indirect_jump" - [(set (pc) (match_operand:P 0 "register_operand" "c,*l"))] + [(set (pc) + (match_operand:P 0 "register_operand" "c,*l"))] "" - "@ - bctr - blr" + "b%T0" [(set_attr "type" "jmpreg")]) ;; Table jump for switch statements: (define_expand "tablejump" - [(use (match_operand 0 "" "")) - (use (label_ref (match_operand 1 "" "")))] + [(use (match_operand 0)) + (use (label_ref (match_operand 1)))] "" - " { if (TARGET_32BIT) emit_jump_insn (gen_tablejumpsi (operands[0], operands[1])); else emit_jump_insn (gen_tablejumpdi (operands[0], operands[1])); DONE; -}") +}) (define_expand "tablejumpsi" [(set (match_dup 3) - (plus:SI (match_operand:SI 0 "" "") + (plus:SI (match_operand:SI 0) (match_dup 2))) - (parallel [(set (pc) (match_dup 3)) - (use (label_ref (match_operand 1 "" "")))])] + (parallel [(set (pc) + (match_dup 3)) + (use (label_ref (match_operand 1)))])] "TARGET_32BIT" - " -{ operands[0] = force_reg (SImode, operands[0]); +{ + operands[0] = force_reg (SImode, operands[0]); operands[2] = force_reg (SImode, gen_rtx_LABEL_REF (SImode, operands[1])); operands[3] = gen_reg_rtx (SImode); -}") +}) (define_expand "tablejumpdi" [(set (match_dup 4) - (sign_extend:DI (match_operand:SI 0 "lwa_operand" ""))) + (sign_extend:DI (match_operand:SI 0 "lwa_operand"))) (set (match_dup 3) (plus:DI (match_dup 4) (match_dup 2))) - (parallel [(set (pc) (match_dup 3)) - (use (label_ref (match_operand 1 "" "")))])] + (parallel [(set (pc) + (match_dup 3)) + (use (label_ref (match_operand 1)))])] "TARGET_64BIT" - " -{ operands[2] = force_reg (DImode, gen_rtx_LABEL_REF (DImode, operands[1])); +{ + operands[2] = force_reg (DImode, gen_rtx_LABEL_REF (DImode, operands[1])); operands[3] = gen_reg_rtx (DImode); operands[4] = gen_reg_rtx (DImode); -}") +}) (define_insn "*tablejump_internal1" [(set (pc) (match_operand:P 0 "register_operand" "c,*l")) - (use (label_ref (match_operand 1 "" "")))] + (use (label_ref (match_operand 1)))] "" - "@ - bctr - blr" + "b%T0" [(set_attr "type" "jmpreg")]) (define_insn "nop" @@ -12856,21 +12818,19 @@ (define_insn "group_ending_nop" [(unspec [(const_int 0)] UNSPEC_GRP_END_NOP)] "" - "* { if (rs6000_cpu_attr == CPU_POWER6) - return \"ori 1,1,0\"; - return \"ori 2,2,0\"; -}") + return "ori 1,1,0"; + return "ori 2,2,0"; +}) ;; Define the subtract-one-and-jump insns, starting with the template ;; so loop.c knows what to generate. (define_expand "doloop_end" - [(use (match_operand 0 "" "")) ; loop pseudo - (use (match_operand 1 "" ""))] ; label + [(use (match_operand 0)) ; loop pseudo + (use (match_operand 1))] ; label "" - " { if (TARGET_64BIT) { @@ -12885,19 +12845,19 @@ emit_jump_insn (gen_ctrsi (operands[0], operands[1])); } DONE; -}") +}) (define_expand "ctr" [(parallel [(set (pc) - (if_then_else (ne (match_operand:P 0 "register_operand" "") + (if_then_else (ne (match_operand:P 0 "register_operand") (const_int 1)) - (label_ref (match_operand 1 "" "")) + (label_ref (match_operand 1)) (pc))) (set (match_dup 0) (plus:P (match_dup 0) (const_int -1))) - (clobber (match_scratch:CC 2 "")) - (clobber (match_scratch:P 3 ""))])] + (clobber (match_scratch:CC 2)) + (clobber (match_scratch:P 3))])] "" "") @@ -12913,97 +12873,47 @@ [(set (pc) (if_then_else (ne (match_operand:P 1 "register_operand" "c,*b,*b,*b") (const_int 1)) - (label_ref (match_operand 0 "" "")) + (label_ref (match_operand 0)) (pc))) (set (match_operand:P 2 "nonimmediate_operand" "=1,*r,m,*d*wi*c*l") (plus:P (match_dup 1) - (const_int -1))) - (clobber (match_scratch:CC 3 "=X,&x,&x,&x")) - (clobber (match_scratch:P 4 "=X,X,&r,r"))] - "" - "* -{ - if (which_alternative != 0) - return \"#\"; - else if (get_attr_length (insn) == 4) - return \"bdnz %l0\"; - else - return \"bdz $+8\;b %l0\"; -}" - [(set_attr "type" "branch") - (set_attr "length" "*,16,20,20")]) - -(define_insn "ctr_internal2" - [(set (pc) - (if_then_else (ne (match_operand:P 1 "register_operand" "c,*b,*b,*b") - (const_int 1)) - (pc) - (label_ref (match_operand 0 "" "")))) - (set (match_operand:P 2 "nonimmediate_operand" "=1,*r,m,*d*wi*c*l") - (plus:P (match_dup 1) - (const_int -1))) + (const_int -1))) (clobber (match_scratch:CC 3 "=X,&x,&x,&x")) (clobber (match_scratch:P 4 "=X,X,&r,r"))] "" - "* { if (which_alternative != 0) - return \"#\"; + return "#"; else if (get_attr_length (insn) == 4) - return \"bdz %l0\"; + return "bdnz %l0"; else - return \"bdnz $+8\;b %l0\"; -}" + return "bdz $+8\;b %l0"; +} [(set_attr "type" "branch") (set_attr "length" "*,16,20,20")]) ;; Similar but use EQ -(define_insn "ctr_internal3" +(define_insn "ctr_internal2" [(set (pc) (if_then_else (eq (match_operand:P 1 "register_operand" "c,*b,*b,*b") (const_int 1)) - (label_ref (match_operand 0 "" "")) + (label_ref (match_operand 0)) (pc))) (set (match_operand:P 2 "nonimmediate_operand" "=1,*r,m,*d*wi*c*l") (plus:P (match_dup 1) - (const_int -1))) - (clobber (match_scratch:CC 3 "=X,&x,&x,&x")) - (clobber (match_scratch:P 4 "=X,X,&r,r"))] - "" - "* -{ - if (which_alternative != 0) - return \"#\"; - else if (get_attr_length (insn) == 4) - return \"bdz %l0\"; - else - return \"bdnz $+8\;b %l0\"; -}" - [(set_attr "type" "branch") - (set_attr "length" "*,16,20,20")]) - -(define_insn "ctr_internal4" - [(set (pc) - (if_then_else (eq (match_operand:P 1 "register_operand" "c,*b,*b,*b") - (const_int 1)) - (pc) - (label_ref (match_operand 0 "" "")))) - (set (match_operand:P 2 "nonimmediate_operand" "=1,*r,m,*d*wi*c*l") - (plus:P (match_dup 1) - (const_int -1))) + (const_int -1))) (clobber (match_scratch:CC 3 "=X,&x,&x,&x")) (clobber (match_scratch:P 4 "=X,X,&r,r"))] "" - "* { if (which_alternative != 0) - return \"#\"; + return "#"; else if (get_attr_length (insn) == 4) - return \"bdnz %l0\"; + return "bdz %l0"; else - return \"bdz $+8\;b %l0\"; -}" + return "bdnz $+8\;b %l0"; +} [(set_attr "type" "branch") (set_attr "length" "*,16,20,20")]) @@ -13012,14 +12922,15 @@ (define_split [(set (pc) (if_then_else (match_operator 2 "comparison_operator" - [(match_operand:P 1 "gpc_reg_operand" "") + [(match_operand:P 1 "gpc_reg_operand") (const_int 1)]) - (match_operand 5 "" "") - (match_operand 6 "" ""))) - (set (match_operand:P 0 "int_reg_operand" "") - (plus:P (match_dup 1) (const_int -1))) - (clobber (match_scratch:CC 3 "")) - (clobber (match_scratch:P 4 ""))] + (match_operand 5) + (match_operand 6))) + (set (match_operand:P 0 "int_reg_operand") + (plus:P (match_dup 1) + (const_int -1))) + (clobber (match_scratch:CC 3)) + (clobber (match_scratch:P 4))] "reload_completed" [(set (match_dup 3) (compare:CC (match_dup 1) @@ -13027,25 +12938,28 @@ (set (match_dup 0) (plus:P (match_dup 1) (const_int -1))) - (set (pc) (if_then_else (match_dup 7) - (match_dup 5) - (match_dup 6)))] - " -{ operands[7] = gen_rtx_fmt_ee (GET_CODE (operands[2]), VOIDmode, - operands[3], const0_rtx); }") + (set (pc) + (if_then_else (match_dup 7) + (match_dup 5) + (match_dup 6)))] +{ + operands[7] = gen_rtx_fmt_ee (GET_CODE (operands[2]), VOIDmode, operands[3], + const0_rtx); +}) (define_split [(set (pc) (if_then_else (match_operator 2 "comparison_operator" - [(match_operand:P 1 "gpc_reg_operand" "") + [(match_operand:P 1 "gpc_reg_operand") (const_int 1)]) - (match_operand 5 "" "") - (match_operand 6 "" ""))) - (set (match_operand:P 0 "nonimmediate_operand" "") - (plus:P (match_dup 1) (const_int -1))) - (clobber (match_scratch:CC 3 "")) - (clobber (match_scratch:P 4 ""))] - "reload_completed && ! gpc_reg_operand (operands[0], SImode)" + (match_operand 5) + (match_operand 6))) + (set (match_operand:P 0 "nonimmediate_operand") + (plus:P (match_dup 1) + (const_int -1))) + (clobber (match_scratch:CC 3)) + (clobber (match_scratch:P 4))] + "reload_completed && !gpc_reg_operand (operands[0], SImode)" [(set (match_dup 3) (compare:CC (match_dup 1) (const_int 1))) @@ -13054,12 +12968,14 @@ (const_int -1))) (set (match_dup 0) (match_dup 4)) - (set (pc) (if_then_else (match_dup 7) - (match_dup 5) - (match_dup 6)))] - " -{ operands[7] = gen_rtx_fmt_ee (GET_CODE (operands[2]), VOIDmode, - operands[3], const0_rtx); }") + (set (pc) + (if_then_else (match_dup 7) + (match_dup 5) + (match_dup 6)))] +{ + operands[7] = gen_rtx_fmt_ee (GET_CODE (operands[2]), VOIDmode, operands[3], + const0_rtx); +}) (define_insn "trap" [(trap_if (const_int 1) (const_int 0))] diff --git a/gcc/config/s390/s390-builtins.def b/gcc/config/s390/s390-builtins.def index 5cfe9a43de990..ea561f7e2af0b 100644 --- a/gcc/config/s390/s390-builtins.def +++ b/gcc/config/s390/s390-builtins.def @@ -1621,6 +1621,9 @@ OB_DEF_VAR (s390_vec_xor_s64_c, s390_vx, B_DEP, OB_DEF_VAR (s390_vec_xor_u64_a, s390_vx, B_DEP, 0, BT_OV_UV2DI_BV2DI_UV2DI) OB_DEF_VAR (s390_vec_xor_u64_b, s390_vx, 0, 0, BT_OV_UV2DI_UV2DI_UV2DI) OB_DEF_VAR (s390_vec_xor_u64_c, s390_vx, B_DEP, 0, BT_OV_UV2DI_UV2DI_BV2DI) +OB_DEF_VAR (s390_vec_xor_flt_a, s390_vx, B_VXE | B_DEP, 0, BT_OV_V4SF_BV4SI_V4SF) +OB_DEF_VAR (s390_vec_xor_flt_b, s390_vx, B_VXE, 0, BT_OV_V4SF_V4SF_V4SF) +OB_DEF_VAR (s390_vec_xor_flt_c, s390_vx, B_VXE | B_DEP, 0, BT_OV_V4SF_V4SF_BV4SI) OB_DEF_VAR (s390_vec_xor_dbl_a, s390_vx, B_DEP, 0, BT_OV_V2DF_BV2DI_V2DF) OB_DEF_VAR (s390_vec_xor_dbl_b, s390_vx, 0, 0, BT_OV_V2DF_V2DF_V2DF) OB_DEF_VAR (s390_vec_xor_dbl_c, s390_vx, B_DEP, 0, BT_OV_V2DF_V2DF_BV2DI) @@ -2779,7 +2782,7 @@ OB_DEF_VAR (s390_vec_ctd_s64, s390_vec_ctd_s64, 0, OB_DEF_VAR (s390_vec_ctd_u64, s390_vec_ctd_u64, 0, O2_U5, BT_OV_V2DF_UV2DI_INT) /* vcdlgb */ OB_DEF (s390_vfi, s390_vfi_flt, s390_vfi_dbl, B_VX, BT_FN_V2DF_V2DF_UINT_UINT) -OB_DEF_VAR (s390_vfi_flt, s390_vfisb, 0, O2_U4 | O3_U3, BT_OV_V4SF_V4SF_UCHAR_UCHAR) /* vfisb */ +OB_DEF_VAR (s390_vfi_flt, s390_vfisb, B_VXE, O2_U4 | O3_U3, BT_OV_V4SF_V4SF_UCHAR_UCHAR) /* vfisb */ OB_DEF_VAR (s390_vfi_dbl, s390_vfidb, 0, O2_U4 | O3_U3, BT_OV_V2DF_V2DF_UCHAR_UCHAR) /* vfidb */ B_DEF (s390_vec_ctd_s64, vec_ctd_s64, 0, B_VX, O2_U3, BT_FN_V2DF_V2DI_INT) /* vcdgb */ @@ -2836,13 +2839,13 @@ OB_DEF_VAR (s390_vec_nmsub_dbl, s390_vfnmsdb, 0, B_DEF (s390_vflnsb, negabsv4sf2, 0, B_VXE, 0, BT_FN_V4SF_V4SF) B_DEF (s390_vflndb, negabsv2df2, 0, B_VX, 0, BT_FN_V2DF_V2DF) -OB_DEF (s390_vec_nabs, s390_vec_nabs_flt, s390_vec_nabs_dbl, B_VXE, BT_FN_OV4SI_OV4SI) -OB_DEF_VAR (s390_vec_nabs_flt, s390_vflnsb, 0, 0, BT_OV_V4SF_V4SF) -OB_DEF_VAR (s390_vec_nabs_dbl, s390_vflndb, B_VX, 0, BT_OV_V2DF_V2DF) +OB_DEF (s390_vec_nabs, s390_vec_nabs_flt, s390_vec_nabs_dbl, B_VX, BT_FN_OV4SI_OV4SI) +OB_DEF_VAR (s390_vec_nabs_flt, s390_vflnsb, B_VXE, 0, BT_OV_V4SF_V4SF) +OB_DEF_VAR (s390_vec_nabs_dbl, s390_vflndb, 0, 0, BT_OV_V2DF_V2DF) -OB_DEF (s390_vec_sqrt, s390_vec_sqrt_flt, s390_vec_sqrt_dbl, B_VXE, BT_FN_OV4SI_OV4SI) -OB_DEF_VAR (s390_vec_sqrt_flt, s390_vfsqsb, 0, 0, BT_OV_V4SF_V4SF) -OB_DEF_VAR (s390_vec_sqrt_dbl, s390_vfsqdb, B_VX, 0, BT_OV_V2DF_V2DF) +OB_DEF (s390_vec_sqrt, s390_vec_sqrt_flt, s390_vec_sqrt_dbl, B_VX, BT_FN_OV4SI_OV4SI) +OB_DEF_VAR (s390_vec_sqrt_flt, s390_vfsqsb, B_VXE, 0, BT_OV_V4SF_V4SF) +OB_DEF_VAR (s390_vec_sqrt_dbl, s390_vfsqdb, 0, 0, BT_OV_V2DF_V2DF) /* Test data class with boolean result *AND* cc mode. */ diff --git a/gcc/config/s390/s390.c b/gcc/config/s390/s390.c index 52a82df0044e4..4e089557e1023 100644 --- a/gcc/config/s390/s390.c +++ b/gcc/config/s390/s390.c @@ -83,6 +83,7 @@ along with GCC; see the file COPYING3. If not see #include "symbol-summary.h" #include "ipa-prop.h" #include "ipa-fnsummary.h" +#include "sched-int.h" /* This file should be included last. */ #include "target-def.h" @@ -355,6 +356,18 @@ static rtx_insn *last_scheduled_insn; #define MAX_SCHED_UNITS 3 static int last_scheduled_unit_distance[MAX_SCHED_UNITS]; +#define NUM_SIDES 2 +static int current_side = 1; +#define LONGRUNNING_THRESHOLD 5 + +/* Estimate of number of cycles a long-running insn occupies an + execution unit. */ +static unsigned fxu_longrunning[NUM_SIDES]; +static unsigned vfu_longrunning[NUM_SIDES]; + +/* Factor to scale latencies by, determined by measurements. */ +#define LATENCY_FACTOR 4 + /* The maximum score added for an instruction whose unit hasn't been in use for MAX_SCHED_MIX_DISTANCE steps. Increase this value to give instruction mix scheduling more priority over instruction @@ -1102,11 +1115,11 @@ s390_handle_hotpatch_attribute (tree *node, tree name, tree args, err = 1; else if (TREE_CODE (expr) != INTEGER_CST || !INTEGRAL_TYPE_P (TREE_TYPE (expr)) - || wi::gtu_p (expr, s390_hotpatch_hw_max)) + || wi::gtu_p (wi::to_wide (expr), s390_hotpatch_hw_max)) err = 1; else if (TREE_CODE (expr2) != INTEGER_CST || !INTEGRAL_TYPE_P (TREE_TYPE (expr2)) - || wi::gtu_p (expr2, s390_hotpatch_hw_max)) + || wi::gtu_p (wi::to_wide (expr2), s390_hotpatch_hw_max)) err = 1; else err = 0; @@ -3717,6 +3730,8 @@ s390_builtin_vectorization_cost (enum vect_cost_for_stmt type_of_cost, case vector_stmt: case vector_load: case vector_store: + case vector_gather_load: + case vector_scatter_store: case vec_to_scalar: case scalar_to_vec: case cond_branch_not_taken: @@ -14604,6 +14619,28 @@ s390_z10_prevent_earlyload_conflicts (rtx_insn **ready, int *nready_p) ready[0] = tmp; } +/* Returns TRUE if BB is entered via a fallthru edge and all other + incoming edges are less than unlikely. */ +static bool +s390_bb_fallthru_entry_likely (basic_block bb) +{ + edge e, fallthru_edge; + edge_iterator ei; + + if (!bb) + return false; + + fallthru_edge = find_fallthru_edge (bb->preds); + if (!fallthru_edge) + return false; + + FOR_EACH_EDGE (e, ei, bb->preds) + if (e != fallthru_edge + && e->probability >= profile_probability::unlikely ()) + return false; + + return true; +} /* The s390_sched_state variable tracks the state of the current or the last instruction group. @@ -14612,7 +14649,7 @@ s390_z10_prevent_earlyload_conflicts (rtx_insn **ready, int *nready_p) 3 the last group is complete - normal insns 4 the last group was a cracked/expanded insn */ -static int s390_sched_state; +static int s390_sched_state = 0; #define S390_SCHED_STATE_NORMAL 3 #define S390_SCHED_STATE_CRACKED 4 @@ -14753,7 +14790,24 @@ s390_sched_score (rtx_insn *insn) if (m & unit_mask) score += (last_scheduled_unit_distance[i] * MAX_SCHED_MIX_SCORE / MAX_SCHED_MIX_DISTANCE); + + unsigned latency = insn_default_latency (insn); + + int other_side = 1 - current_side; + + /* Try to delay long-running insns when side is busy. */ + if (latency > LONGRUNNING_THRESHOLD) + { + if (get_attr_z13_unit_fxu (insn) && fxu_longrunning[current_side] + && fxu_longrunning[other_side] <= fxu_longrunning[current_side]) + score = MAX (0, score - 10); + + if (get_attr_z13_unit_vfu (insn) && vfu_longrunning[current_side] + && vfu_longrunning[other_side] <= vfu_longrunning[current_side]) + score = MAX (0, score - 10); + } } + return score; } @@ -14872,12 +14926,19 @@ s390_sched_variable_issue (FILE *file, int verbose, rtx_insn *insn, int more) { last_scheduled_insn = insn; + bool starts_group = false; + if (s390_tune >= PROCESSOR_2827_ZEC12 && reload_completed && recog_memoized (insn) >= 0) { unsigned int mask = s390_get_sched_attrmask (insn); + if ((mask & S390_SCHED_ATTR_MASK_CRACKED) != 0 + || (mask & S390_SCHED_ATTR_MASK_EXPANDED) != 0 + || (mask & S390_SCHED_ATTR_MASK_GROUPALONE) != 0) + starts_group = true; + if ((mask & S390_SCHED_ATTR_MASK_CRACKED) != 0 || (mask & S390_SCHED_ATTR_MASK_EXPANDED) != 0) s390_sched_state = S390_SCHED_STATE_CRACKED; @@ -14890,14 +14951,15 @@ s390_sched_variable_issue (FILE *file, int verbose, rtx_insn *insn, int more) switch (s390_sched_state) { case 0: + starts_group = true; + /* fallthrough */ case 1: case 2: + s390_sched_state++; + break; case S390_SCHED_STATE_NORMAL: - if (s390_sched_state == S390_SCHED_STATE_NORMAL) - s390_sched_state = 1; - else - s390_sched_state++; - + starts_group = true; + s390_sched_state = 1; break; case S390_SCHED_STATE_CRACKED: s390_sched_state = S390_SCHED_STATE_NORMAL; @@ -14920,6 +14982,27 @@ s390_sched_variable_issue (FILE *file, int verbose, rtx_insn *insn, int more) last_scheduled_unit_distance[i]++; } + /* If this insn started a new group, the side flipped. */ + if (starts_group) + current_side = current_side ? 0 : 1; + + for (int i = 0; i < 2; i++) + { + if (fxu_longrunning[i] >= 1) + fxu_longrunning[i] -= 1; + if (vfu_longrunning[i] >= 1) + vfu_longrunning[i] -= 1; + } + + unsigned latency = insn_default_latency (insn); + if (latency > LONGRUNNING_THRESHOLD) + { + if (get_attr_z13_unit_fxu (insn)) + fxu_longrunning[current_side] = latency * LATENCY_FACTOR; + else + vfu_longrunning[current_side] = latency * LATENCY_FACTOR; + } + if (verbose > 5) { unsigned int sched_mask; @@ -14976,7 +15059,21 @@ s390_sched_init (FILE *file ATTRIBUTE_UNUSED, { last_scheduled_insn = NULL; memset (last_scheduled_unit_distance, 0, MAX_SCHED_UNITS * sizeof (int)); - s390_sched_state = 0; + + /* If the next basic block is most likely entered via a fallthru edge + we keep the last sched state. Otherwise we start a new group. + The scheduler traverses basic blocks in "instruction stream" ordering + so if we see a fallthru edge here, s390_sched_state will be of its + source block. + + current_sched_info->prev_head is the insn before the first insn of the + block of insns to be scheduled. + */ + rtx_insn *insn = current_sched_info->prev_head + ? NEXT_INSN (current_sched_info->prev_head) : NULL; + basic_block bb = insn ? BLOCK_FOR_INSN (insn) : NULL; + if (s390_tune < PROCESSOR_2964_Z13 || !s390_bb_fallthru_entry_likely (bb)) + s390_sched_state = 0; } /* This target hook implementation for TARGET_LOOP_UNROLL_ADJUST calculates diff --git a/gcc/config/s390/vecintrin.h b/gcc/config/s390/vecintrin.h index 38cc0692df8b1..80eb2b30867c5 100644 --- a/gcc/config/s390/vecintrin.h +++ b/gcc/config/s390/vecintrin.h @@ -113,8 +113,6 @@ __lcbb(const void *ptr, int bndry) #define vec_unsigned(X) __builtin_s390_vclgdb((X), 0, 0) #define vec_doublee(X) __builtin_s390_vfll((X)) #define vec_floate(X) __builtin_s390_vflr((X), 0, 0) -#define vec_madd __builtin_s390_vfmadb -#define vec_msub __builtin_s390_vfmsdb #define vec_load_len_r(X,Y) __builtin_s390_vlrl((Y),(X)) #define vec_store_len_r(X,Y) __builtin_s390_vstrl((Y),(X)) @@ -306,6 +304,8 @@ __lcbb(const void *ptr, int bndry) #define vec_ld2f __builtin_s390_vec_ld2f #define vec_st2f __builtin_s390_vec_st2f #define vec_double __builtin_s390_vec_double +#define vec_madd __builtin_s390_vec_madd +#define vec_msub __builtin_s390_vec_msub #define vec_nmadd __builtin_s390_vec_nmadd #define vec_nmsub __builtin_s390_vec_nmsub #define vec_nabs __builtin_s390_vec_nabs diff --git a/gcc/config/spu/spu.c b/gcc/config/spu/spu.c index b9af9a969f7af..eda7fcaaeb9ec 100644 --- a/gcc/config/spu/spu.c +++ b/gcc/config/spu/spu.c @@ -6640,6 +6640,8 @@ spu_builtin_vectorization_cost (enum vect_cost_for_stmt type_of_cost, return 2; case unaligned_load: + case vector_gather_load: + case vector_scatter_store: return 2; case cond_branch_taken: diff --git a/gcc/config/visium/visium.c b/gcc/config/visium/visium.c index 381d432778d2a..3311dd2a349d3 100644 --- a/gcc/config/visium/visium.c +++ b/gcc/config/visium/visium.c @@ -2938,12 +2938,6 @@ visium_select_cc_mode (enum rtx_code code, rtx op0, rtx op1) /* This is a btst, the result is in C instead of Z. */ return CCCmode; - case CONST_INT: - /* This is a degenerate case, typically an uninitialized variable. */ - gcc_assert (op0 == constm1_rtx); - - /* ... fall through ... */ - case REG: case AND: case IOR: @@ -2960,6 +2954,17 @@ visium_select_cc_mode (enum rtx_code code, rtx op0, rtx op1) when applied to a comparison with zero. */ return CCmode; + /* ??? Cater to the junk RTXes sent by try_merge_compare. */ + case ASM_OPERANDS: + case CALL: + case CONST_INT: + case LO_SUM: + case HIGH: + case MEM: + case UNSPEC: + case ZERO_EXTEND: + return CCmode; + default: gcc_unreachable (); } diff --git a/gcc/config/vms/vms-c.c b/gcc/config/vms/vms-c.c index c666ad18065b3..278c8e236be5e 100644 --- a/gcc/config/vms/vms-c.c +++ b/gcc/config/vms/vms-c.c @@ -418,7 +418,7 @@ vms_c_register_includes (const char *sysroot, if (!stdinc) return; - for (dir = get_added_cpp_dirs (SYSTEM); dir != NULL; dir = dir->next) + for (dir = get_added_cpp_dirs (INC_SYSTEM); dir != NULL; dir = dir->next) { const char * const *lib; for (lib = vms_std_modules; *lib != NULL; lib++) @@ -441,7 +441,7 @@ vms_c_register_includes (const char *sysroot, p->sysp = 1; p->construct = vms_construct_include_filename; p->user_supplied_p = 0; - add_cpp_dir_path (p, SYSTEM); + add_cpp_dir_path (p, INC_SYSTEM); } else free (path); diff --git a/gcc/configure b/gcc/configure index 13f97cd3663be..aa5937df84c42 100755 --- a/gcc/configure +++ b/gcc/configure @@ -4987,7 +4987,7 @@ acx_cv_cc_gcc_supports_ada=no # Other compilers, like HP Tru64 UNIX cc, exit successfully when # given a .adb file, but produce no object file. So we must check # if an object file was really produced to guard against this. -errors=`(${CC} -I"$srcdir"/ada -c conftest.adb) 2>&1 || echo failure` +errors=`(${CC} -I"$srcdir"/ada/libgnat -c conftest.adb) 2>&1 || echo failure` if test x"$errors" = x && test -f conftest.$ac_objext; then acx_cv_cc_gcc_supports_ada=yes fi diff --git a/gcc/configure.ac b/gcc/configure.ac index 8271138928173..d905d0d980ab9 100644 --- a/gcc/configure.ac +++ b/gcc/configure.ac @@ -362,7 +362,7 @@ rm -f a.out a.exe b.out # Find the native compiler AC_PROG_CC AC_PROG_CXX -ACX_PROG_GNAT([-I"$srcdir"/ada]) +ACX_PROG_GNAT([-I"$srcdir"/ada/libgnat]) # Do configure tests with the C++ compiler, since that's what we build with. AC_LANG(C++) diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 6c92e1b38562e..ed89364a16ebf 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,146 @@ +2017-10-20 Nathan Sidwell + + * class.c (layout_class_type): Cleanup as-base creation, determine + mode here. + (finish_struct_1): ... not here. + +2017-10-19 Jakub Jelinek + + PR c++/82600 + * typeck.c (check_return_expr): Don't call + maybe_warn_about_returning_address_of_local in templates. + +2017-10-17 Nathan Sidwell + + PR c++/82560 + * call.c (build_over_call): Don't pass tf_no_cleanup to nested + calls. + + PR middle-end/82546 + * cp-objcp-common.c (cp_tree_size): Reformat. Adjust returns size + of TYPE nodes. + +2017-10-13 Jason Merrill + + PR c++/82357 - bit-field in template + * tree.c (cp_stabilize_reference): Just return a NON_DEPENDENT_EXPR. + +2017-10-13 David Malcolm + + * cp-tree.h (maybe_show_extern_c_location): New decl. + * decl.c (grokfndecl): When complaining about literal operators + with C linkage, issue a note giving the location of the + extern "C". + * parser.c (cp_parser_new): Initialize new field + "innermost_linkage_specification_location". + (cp_parser_linkage_specification): Store the location + of the linkage specification within the cp_parser. + (cp_parser_explicit_specialization): When complaining about + template specializations with C linkage, issue a note giving the + location of the extern "C". + (cp_parser_explicit_template_declaration): Likewise for templates. + (maybe_show_extern_c_location): New function. + * parser.h (struct cp_parser): New field + "innermost_linkage_specification_location". + +2017-10-12 Nathan Sidwell + + * cp-tree.h (cp_expr): Add const operator * and operator-> + accessors. + (cp_tree_node_structure_enum): Delete TS_CP_BINDING, + TS_CP_WRAPPER, LAST_TS_CP_ENUM. + +2017-10-12 David Malcolm + + * parser.c (get_required_cpp_ttype): New function. + (cp_parser_error_1): Call it, using the result to call + maybe_suggest_missing_token_insertion. + +2017-10-12 David Malcolm + + * parser.c (get_matching_symbol): Move to before... + (cp_parser_error): Split out into... + (cp_parser_error_1): ...this new function, merging in content + from... + (cp_parser_required_error): ...here. Eliminate partial duplicate + of body of cp_parser_error in favor of a call to the new + cp_parser_error_1 helper function. + +2017-10-11 Nathan Sidwell + + * decl2.c (struct mangled_decl_hash): Use DECL_ASSEMBLER_NAME_RAW. + (record_mangling): Likewise. + +2017-10-10 Nathan Sidwell + + * name-lookup.c (extern_c_fns): Rename to ... + (extern_c_decls): ... here. + (check_extern_c_conflict, extern_c_linkage_bindings): Update. + (do_pushdecl): Check extern-c fns and vars. + + * cp-tree.h (default_hash_traits ): Delete + specialization. + + * decl2.c (struct mangled_decl_hash): New hash traits. + (mangled_decls): Make hash_table. + (generate_mangling_alias, record_mangling): Adjust. + +2017-10-10 Jason Merrill + + More delayed lambda capture fixes. + * call.c (add_function_candidate): Use build_address. + (build_op_call_1): Call mark_lvalue_use early. + (build_over_call): Handle error from build_this. + * constexpr.c (cxx_bind_parameters_in_call): Use build_address. + (cxx_eval_increment_expression): Don't use rvalue(). + * cvt.c (convert_to_void): Use mark_discarded_use. + * expr.c (mark_use): Handle PARM_DECL, NON_DEPENDENT_EXPR. Fix + reference handling. Don't copy the expression. + (mark_discarded_use): New. + * lambda.c (insert_capture_proxy): Add some sanity checking. + (maybe_add_lambda_conv_op): Set cp_unevaluated_operand. + * pt.c (register_local_specialization): Add sanity check. + * semantics.c (process_outer_var_ref): Fix check for existing proxy. + * typeck.c (cp_build_addr_expr_1): Handle error from + mark_lvalue_use. + (cp_build_modify_expr): Call mark_lvalue_use_nonread, handle error + from rvalue. + + Handle generic lambda capture in dependent expressions. + * lambda.c (need_generic_capture, dependent_capture_r) + (do_dependent_capture): New. + * pt.c (processing_nonlambda_template): Use need_generic_capture. + * semantics.c (maybe_cleanup_point_expr) + (maybe_cleanup_point_expr_void, finish_goto_stmt) + (maybe_convert_cond): Call do_dependent_capture. + * typeck.c (build_static_cast): Remove dependent capture handling. + + * typeck.c (condition_conversion): Assert !processing_template_decl. + * semantics.c (finish_omp_clauses): Don't + fold_build_cleanup_point_expr if processing_template_decl. + (outer_var_p): A temporary can't be from an outer scope. + * pt.c (type_dependent_expression_p): Fix dependency checking of + functions without DECL_TEMPLATE_INFO. + (instantiate_decl): Use lss_copy. + * constexpr.c (is_valid_constexpr_fn): Fix lambdas before C++17. + + * typeck.c (check_return_expr): Check non-dependent conversion in + templates. + * constraint.cc (check_function_concept): Don't complain about an + empty concept if seen_error. + +2017-10-10 Richard Sandiford + + * cvt.c (ignore_overflows): Use wi::to_wide when + operating on trees as wide_ints. + * decl.c (check_array_designated_initializer): Likewise. + * mangle.c (write_integer_cst): Likewise. + * semantics.c (cp_finish_omp_clause_depend_sink): Likewise. + +2017-10-10 Nathan Sidwell + + * name-lookup.c (set_global_binding): Don't deal with STAT_HACK. + 2017-10-06 Paolo Carlini PR c++/47791 diff --git a/gcc/cp/call.c b/gcc/cp/call.c index 9d747be9d79b8..8f33ab5169092 100644 --- a/gcc/cp/call.c +++ b/gcc/cp/call.c @@ -2160,7 +2160,10 @@ add_function_candidate (struct z_candidate **candidates, else { parmtype = build_pointer_type (parmtype); - arg = build_this (arg); + /* We don't use build_this here because we don't want to + capture the object argument until we've chosen a + non-static member function. */ + arg = build_address (arg); argtype = lvalue_type (arg); } } @@ -4446,14 +4449,17 @@ build_op_call_1 (tree obj, vec **args, tsubst_flags_t complain) { struct z_candidate *candidates = 0, *cand; tree fns, convs, first_mem_arg = NULL_TREE; - tree type = TREE_TYPE (obj); bool any_viable_p; tree result = NULL_TREE; void *p; + obj = mark_lvalue_use (obj); + if (error_operand_p (obj)) return error_mark_node; + tree type = TREE_TYPE (obj); + obj = prep_operand (obj); if (TYPE_PTRMEMFUNC_P (type)) @@ -7711,8 +7717,11 @@ build_over_call (struct z_candidate *cand, int flags, tsubst_flags_t complain) } /* N3276 magic doesn't apply to nested calls. */ - int decltype_flag = (complain & tf_decltype); + tsubst_flags_t decltype_flag = (complain & tf_decltype); complain &= ~tf_decltype; + /* No-Cleanup doesn't apply to nested calls either. */ + tsubst_flags_t no_cleanup_complain = complain; + complain &= ~tf_no_cleanup; /* Find maximum size of vector to hold converted arguments. */ parmlen = list_length (parm); @@ -7772,6 +7781,9 @@ build_over_call (struct z_candidate *cand, int flags, tsubst_flags_t complain) tree converted_arg; tree base_binfo; + if (arg == error_mark_node) + return error_mark_node; + if (convs[i]->bad_p) { if (complain & tf_error) @@ -7907,7 +7919,7 @@ build_over_call (struct z_candidate *cand, int flags, tsubst_flags_t complain) if (flags & LOOKUP_NO_CONVERSION) conv->user_conv_p = true; - tsubst_flags_t arg_complain = complain & (~tf_no_cleanup); + tsubst_flags_t arg_complain = complain; if (!conversion_warning) arg_complain &= ~tf_warning; @@ -8155,7 +8167,8 @@ build_over_call (struct z_candidate *cand, int flags, tsubst_flags_t complain) else if (default_ctor_p (fn)) { if (is_dummy_object (argarray[0])) - return force_target_expr (DECL_CONTEXT (fn), void_node, complain); + return force_target_expr (DECL_CONTEXT (fn), void_node, + no_cleanup_complain); else return cp_build_indirect_ref (argarray[0], RO_NULL, complain); } @@ -9053,7 +9066,6 @@ build_new_method_call_1 (tree instance, tree fns, vec **args, static member function. */ instance = mark_type_use (instance); - /* Figure out whether to skip the first argument for the error message we will display to users if an error occurs. We don't want to display any compiler-generated arguments. The "this" diff --git a/gcc/cp/class.c b/gcc/cp/class.c index a90b85f2a5c73..9ef50657caebd 100644 --- a/gcc/cp/class.c +++ b/gcc/cp/class.c @@ -5992,8 +5992,6 @@ layout_class_type (tree t, tree *virtuals_p) bool last_field_was_bitfield = false; /* The location at which the next field should be inserted. */ tree *next_field; - /* T, as a base class. */ - tree base_t; /* Keep track of the first non-static data member. */ non_static_data_members = TYPE_FIELDS (t); @@ -6218,15 +6216,11 @@ layout_class_type (tree t, tree *virtuals_p) that the type is laid out they are no longer important. */ remove_zero_width_bit_fields (t); - /* Create the version of T used for virtual bases. We do not use - make_class_type for this version; this is an artificial type. For - a POD type, we just reuse T. */ if (CLASSTYPE_NON_LAYOUT_POD_P (t) || CLASSTYPE_EMPTY_P (t)) { - base_t = make_node (TREE_CODE (t)); - - /* Set the size and alignment for the new type. */ - tree eoc; + /* T needs a different layout as a base (eliding virtual bases + or whatever). Create that version. */ + tree base_t = make_node (TREE_CODE (t)); /* If the ABI version is not at least two, and the last field was a bit-field, RLI may not be on a byte @@ -6235,7 +6229,7 @@ layout_class_type (tree t, tree *virtuals_p) indicates the total number of bits used. Therefore, rli_size_so_far, rather than rli_size_unit_so_far, is used to compute TYPE_SIZE_UNIT. */ - eoc = end_of_class (t, /*include_virtuals_p=*/0); + tree eoc = end_of_class (t, /*include_virtuals_p=*/0); TYPE_SIZE_UNIT (base_t) = size_binop (MAX_EXPR, fold_convert (sizetype, @@ -6252,7 +6246,8 @@ layout_class_type (tree t, tree *virtuals_p) SET_TYPE_ALIGN (base_t, rli->record_align); TYPE_USER_ALIGN (base_t) = TYPE_USER_ALIGN (t); - /* Copy the fields from T. */ + /* Copy the non-static data members of T. This will include its + direct non-virtual bases & vtable. */ next_field = &TYPE_FIELDS (base_t); for (field = TYPE_FIELDS (t); field; field = DECL_CHAIN (field)) if (TREE_CODE (field) == FIELD_DECL) @@ -6263,9 +6258,14 @@ layout_class_type (tree t, tree *virtuals_p) } *next_field = NULL_TREE; + /* We use the base type for trivial assignments, and hence it + needs a mode. */ + compute_record_mode (base_t); + + TYPE_CONTEXT (base_t) = t; + /* Record the base version of the type. */ CLASSTYPE_AS_BASE (t) = base_t; - TYPE_CONTEXT (base_t) = t; } else CLASSTYPE_AS_BASE (t) = t; @@ -6822,11 +6822,6 @@ finish_struct_1 (tree t) set_class_bindings (t); - if (CLASSTYPE_AS_BASE (t) != t) - /* We use the base type for trivial assignments, and hence it - needs a mode. */ - compute_record_mode (CLASSTYPE_AS_BASE (t)); - /* With the layout complete, check for flexible array members and zero-length arrays that might overlap other members in the final layout. */ diff --git a/gcc/cp/constexpr.c b/gcc/cp/constexpr.c index 8a5be2079d8df..59192829d7125 100644 --- a/gcc/cp/constexpr.c +++ b/gcc/cp/constexpr.c @@ -196,7 +196,14 @@ is_valid_constexpr_fn (tree fun, bool complain) } } - if (!DECL_CONSTRUCTOR_P (fun)) + if (LAMBDA_TYPE_P (CP_DECL_CONTEXT (fun)) && cxx_dialect < cxx17) + { + ret = false; + if (complain) + inform (DECL_SOURCE_LOCATION (fun), + "lambdas are implicitly constexpr only in C++17 and later"); + } + else if (!DECL_CONSTRUCTOR_P (fun)) { tree rettype = TREE_TYPE (TREE_TYPE (fun)); if (!literal_type_p (rettype)) @@ -1261,7 +1268,10 @@ cxx_bind_parameters_in_call (const constexpr_ctx *ctx, tree t, && is_dummy_object (x)) { x = ctx->object; - x = cp_build_addr_expr (x, tf_warning_or_error); + /* We don't use cp_build_addr_expr here because we don't want to + capture the object argument until we've chosen a non-static member + function. */ + x = build_address (x); } bool lval = false; arg = cxx_eval_constant_expression (ctx, x, lval, @@ -3635,9 +3645,9 @@ cxx_eval_increment_expression (const constexpr_ctx *ctx, tree t, non_constant_p, overflow_p); /* The operand as an rvalue. */ - tree val = rvalue (op); - val = cxx_eval_constant_expression (ctx, val, false, - non_constant_p, overflow_p); + tree val + = cxx_eval_constant_expression (ctx, op, false, + non_constant_p, overflow_p); /* Don't VERIFY_CONSTANT if this might be dealing with a pointer to a local array in a constexpr function. */ bool ptr = POINTER_TYPE_P (TREE_TYPE (val)); diff --git a/gcc/cp/constraint.cc b/gcc/cp/constraint.cc index 64a8ea926d2a1..8b49455a52634 100644 --- a/gcc/cp/constraint.cc +++ b/gcc/cp/constraint.cc @@ -2504,7 +2504,12 @@ check_function_concept (tree fn) { location_t loc = DECL_SOURCE_LOCATION (fn); if (TREE_CODE (body) == STATEMENT_LIST && !STATEMENT_LIST_HEAD (body)) - error_at (loc, "definition of concept %qD is empty", fn); + { + if (seen_error ()) + /* The definition was probably erroneous, not empty. */; + else + error_at (loc, "definition of concept %qD is empty", fn); + } else error_at (loc, "definition of concept %qD has multiple statements", fn); } diff --git a/gcc/cp/cp-objcp-common.c b/gcc/cp/cp-objcp-common.c index f251b05775b2d..e051d66b67b83 100644 --- a/gcc/cp/cp-objcp-common.c +++ b/gcc/cp/cp-objcp-common.c @@ -61,43 +61,34 @@ cxx_warn_unused_global_decl (const_tree decl) size_t cp_tree_size (enum tree_code code) { + gcc_checking_assert (code >= NUM_TREE_CODES); switch (code) { - case PTRMEM_CST: return sizeof (struct ptrmem_cst); - case BASELINK: return sizeof (struct tree_baselink); + case PTRMEM_CST: return sizeof (ptrmem_cst); + case BASELINK: return sizeof (tree_baselink); case TEMPLATE_PARM_INDEX: return sizeof (template_parm_index); - case DEFAULT_ARG: return sizeof (struct tree_default_arg); - case DEFERRED_NOEXCEPT: return sizeof (struct tree_deferred_noexcept); - case OVERLOAD: return sizeof (struct tree_overload); - case STATIC_ASSERT: return sizeof (struct tree_static_assert); + case DEFAULT_ARG: return sizeof (tree_default_arg); + case DEFERRED_NOEXCEPT: return sizeof (tree_deferred_noexcept); + case OVERLOAD: return sizeof (tree_overload); + case STATIC_ASSERT: return sizeof (tree_static_assert); case TYPE_ARGUMENT_PACK: - case TYPE_PACK_EXPANSION: - return sizeof (struct tree_common); - + case TYPE_PACK_EXPANSION: return sizeof (tree_type_non_common); case NONTYPE_ARGUMENT_PACK: - case EXPR_PACK_EXPANSION: - return sizeof (struct tree_exp); - - case ARGUMENT_PACK_SELECT: - return sizeof (struct tree_argument_pack_select); - - case TRAIT_EXPR: - return sizeof (struct tree_trait_expr); - - case LAMBDA_EXPR: return sizeof (struct tree_lambda_expr); - - case TEMPLATE_INFO: return sizeof (struct tree_template_info); - - case CONSTRAINT_INFO: return sizeof (struct tree_constraint_info); - - case USERDEF_LITERAL: return sizeof (struct tree_userdef_literal); - - case TEMPLATE_DECL: return sizeof (struct tree_template_decl); - + case EXPR_PACK_EXPANSION: return sizeof (tree_exp); + case ARGUMENT_PACK_SELECT: return sizeof (tree_argument_pack_select); + case TRAIT_EXPR: return sizeof (tree_trait_expr); + case LAMBDA_EXPR: return sizeof (tree_lambda_expr); + case TEMPLATE_INFO: return sizeof (tree_template_info); + case CONSTRAINT_INFO: return sizeof (tree_constraint_info); + case USERDEF_LITERAL: return sizeof (tree_userdef_literal); + case TEMPLATE_DECL: return sizeof (tree_template_decl); default: - if (TREE_CODE_CLASS (code) == tcc_declaration) - return sizeof (struct tree_decl_non_common); - gcc_unreachable (); + switch (TREE_CODE_CLASS (code)) + { + case tcc_declaration: return sizeof (tree_decl_non_common); + case tcc_type: return sizeof (tree_type_non_common); + default: gcc_unreachable (); + } } /* NOTREACHED */ } diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h index b29e4e0be0263..b74b6d9d9503f 100644 --- a/gcc/cp/cp-tree.h +++ b/gcc/cp/cp-tree.h @@ -65,7 +65,9 @@ class cp_expr /* Implicit conversions to tree. */ operator tree () const { return m_value; } tree & operator* () { return m_value; } + tree operator* () const { return m_value; } tree & operator-> () { return m_value; } + tree operator-> () const { return m_value; } tree get_value () const { return m_value; } location_t get_location () const { return m_loc; } @@ -572,30 +574,6 @@ identifier_p (tree t) return NULL; } -/* Hash trait specialization for lang_identifiers. This allows - PCH-safe maps keyed by DECL_NAME. If it wasn't for PCH, we could - just use a regular tree key. */ - -template <> -struct default_hash_traits - : pointer_hash -{ - /* Use a regular tree as the type, to make using the hash table - simpler. We'll get dynamic type checking with the hash function - itself. */ - GTY((skip)) typedef tree value_type; - GTY((skip)) typedef tree compare_type; - - static hashval_t hash (const value_type id) - { - return IDENTIFIER_HASH_VALUE (id); - } - - /* Nothing is deletable. Everything is insertable. */ - static bool is_deleted (value_type) { return false; } - static void remove (value_type) { gcc_unreachable (); } -}; - #define LANG_IDENTIFIER_CAST(NODE) \ ((struct lang_identifier*)IDENTIFIER_NODE_CHECK (NODE)) @@ -1491,11 +1469,9 @@ enum cp_tree_node_structure_enum { TS_CP_IDENTIFIER, TS_CP_TPI, TS_CP_PTRMEM, - TS_CP_BINDING, TS_CP_OVERLOAD, TS_CP_BASELINK, TS_CP_TEMPLATE_DECL, - TS_CP_WRAPPER, TS_CP_DEFAULT_ARG, TS_CP_DEFERRED_NOEXCEPT, TS_CP_STATIC_ASSERT, @@ -1504,8 +1480,7 @@ enum cp_tree_node_structure_enum { TS_CP_LAMBDA_EXPR, TS_CP_TEMPLATE_INFO, TS_CP_CONSTRAINT_INFO, - TS_CP_USERDEF_LITERAL, - LAST_TS_CP_ENUM + TS_CP_USERDEF_LITERAL }; /* The resulting tree type. */ @@ -6270,6 +6245,7 @@ extern tree mark_rvalue_use (tree, extern tree mark_lvalue_use (tree); extern tree mark_lvalue_use_nonread (tree); extern tree mark_type_use (tree); +extern tree mark_discarded_use (tree); extern void mark_exp_read (tree); /* friend.c */ @@ -6380,6 +6356,7 @@ extern bool parsing_nsdmi (void); extern bool parsing_default_capturing_generic_lambda_in_template (void); extern void inject_this_parameter (tree, cp_cv_quals); extern location_t defarg_location (tree); +extern void maybe_show_extern_c_location (void); /* in pt.c */ extern bool check_template_shadow (tree); @@ -6432,6 +6409,7 @@ extern tree lookup_template_variable (tree, tree); extern int uses_template_parms (tree); extern bool uses_template_parms_level (tree, int); extern bool in_template_function (void); +extern bool need_generic_capture (void); extern bool processing_nonlambda_template (void); extern tree instantiate_class_template (tree); extern tree instantiate_template (tree, tree, tsubst_flags_t); @@ -6833,6 +6811,7 @@ extern tree current_nonlambda_function (void); extern tree nonlambda_method_basetype (void); extern tree current_nonlambda_scope (void); extern bool generic_lambda_fn_p (tree); +extern tree do_dependent_capture (tree, bool = false); extern bool lambda_fn_in_template_p (tree); extern void maybe_add_lambda_conv_op (tree); extern bool is_lambda_ignored_entity (tree); diff --git a/gcc/cp/cvt.c b/gcc/cp/cvt.c index a3bd4a137d82a..c0d0a6005628d 100644 --- a/gcc/cp/cvt.c +++ b/gcc/cp/cvt.c @@ -582,7 +582,7 @@ ignore_overflows (tree expr, tree orig) { gcc_assert (!TREE_OVERFLOW (orig)); /* Ensure constant sharing. */ - expr = wide_int_to_tree (TREE_TYPE (expr), expr); + expr = wide_int_to_tree (TREE_TYPE (expr), wi::to_wide (expr)); } return expr; } @@ -1055,24 +1055,10 @@ convert_to_void (tree expr, impl_conv_void implicit, tsubst_flags_t complain) || TREE_TYPE (expr) == error_mark_node) return error_mark_node; + expr = mark_discarded_use (expr); if (implicit == ICV_CAST) + /* An explicit cast to void avoids all -Wunused-but-set* warnings. */ mark_exp_read (expr); - else - { - tree exprv = expr; - - while (TREE_CODE (exprv) == COMPOUND_EXPR) - exprv = TREE_OPERAND (exprv, 1); - if (DECL_P (exprv) - || handled_component_p (exprv) - || INDIRECT_REF_P (exprv)) - /* Expr is not being 'used' here, otherwise we whould have - called mark_{rl}value_use use here, which would have in turn - called mark_exp_read. Rather, we call mark_exp_read directly - to avoid some warnings when - -Wunused-but-set-{variable,parameter} is in effect. */ - mark_exp_read (exprv); - } if (!TREE_TYPE (expr)) return expr; diff --git a/gcc/cp/decl.c b/gcc/cp/decl.c index 0e70bb5d59d5a..a3cc80cf7a30f 100644 --- a/gcc/cp/decl.c +++ b/gcc/cp/decl.c @@ -5298,7 +5298,7 @@ check_array_designated_initializer (constructor_elt *ce, == INTEGER_CST)) { /* A C99 designator is OK if it matches the current index. */ - if (wi::eq_p (ce_index, index)) + if (wi::to_wide (ce_index) == index) return true; else sorry ("non-trivial designated initializers not supported"); @@ -6867,6 +6867,8 @@ cp_finish_decl (tree decl, tree init, bool init_const_expr_p, DECL_INITIAL (decl) = NULL_TREE; } + init = do_dependent_capture (init); + /* Generally, initializers in templates are expanded when the template is instantiated. But, if DECL is a variable constant then it can be used in future constant expressions, so its value @@ -8727,6 +8729,7 @@ grokfndecl (tree ctype, if (DECL_LANGUAGE (decl) == lang_c) { error ("literal operator with C linkage"); + maybe_show_extern_c_location (); return NULL_TREE; } diff --git a/gcc/cp/decl2.c b/gcc/cp/decl2.c index 1cbd11dac454c..bc509623b3650 100644 --- a/gcc/cp/decl2.c +++ b/gcc/cp/decl2.c @@ -102,9 +102,35 @@ static GTY(()) vec *no_linkage_decls; is to be an alias for the former if the former is defined. */ static GTY(()) vec *mangling_aliases; -/* A hash table of mangled names to decls. Used to figure out if we - need compatibility aliases. */ -static GTY(()) hash_map *mangled_decls; +/* hash traits for declarations. Hashes single decls via + DECL_ASSEMBLER_NAME_RAW. */ + +struct mangled_decl_hash : ggc_remove +{ + typedef tree value_type; /* A DECL. */ + typedef tree compare_type; /* An identifier. */ + + static hashval_t hash (const value_type decl) + { + return IDENTIFIER_HASH_VALUE (DECL_ASSEMBLER_NAME_RAW (decl)); + } + static bool equal (const value_type existing, compare_type candidate) + { + tree name = DECL_ASSEMBLER_NAME_RAW (existing); + return candidate == name; + } + + static inline void mark_empty (value_type &p) {p = NULL_TREE;} + static inline bool is_empty (value_type p) {return !p;} + + /* Nothing is deletable. Everything is insertable. */ + static bool is_deleted (value_type) { return false; } + static void mark_deleted (value_type) { gcc_unreachable (); } +}; + +/* A hash table of decls keyed by mangled name. Used to figure out if + we need compatibility aliases. */ +static GTY(()) hash_table *mangled_decls; /* Nonzero if we're done parsing and into end-of-file activities. */ @@ -4304,12 +4330,13 @@ generate_mangling_alias (tree decl, tree id2) return; } - bool existed; - tree *slot = &mangled_decls->get_or_insert (id2, &existed); + tree *slot + = mangled_decls->find_slot_with_hash (id2, IDENTIFIER_HASH_VALUE (id2), + INSERT); /* If there's a declaration already using this mangled name, don't create a compatibility alias that conflicts. */ - if (existed) + if (*slot) return; tree alias = make_alias_for (decl, id2); @@ -4369,24 +4396,25 @@ void record_mangling (tree decl, bool need_warning) { if (!mangled_decls) - mangled_decls = hash_map::create_ggc (499); + mangled_decls = hash_table::create_ggc (499); gcc_checking_assert (DECL_ASSEMBLER_NAME_SET_P (decl)); - tree id = DECL_ASSEMBLER_NAME (decl); - bool existed; - tree *slot = &mangled_decls->get_or_insert (id, &existed); + tree id = DECL_ASSEMBLER_NAME_RAW (decl); + tree *slot + = mangled_decls->find_slot_with_hash (id, IDENTIFIER_HASH_VALUE (id), + INSERT); /* If this is already an alias, remove the alias, because the real decl takes precedence. */ - if (existed && DECL_ARTIFICIAL (*slot) && DECL_IGNORED_P (*slot)) + if (*slot && DECL_ARTIFICIAL (*slot) && DECL_IGNORED_P (*slot)) if (symtab_node *n = symtab_node::get (*slot)) if (n->cpp_implicit_alias) { n->remove (); - existed = false; + *slot = NULL_TREE; } - if (!existed) + if (!*slot) *slot = decl; else if (need_warning) { diff --git a/gcc/cp/expr.c b/gcc/cp/expr.c index f5c8e80191887..23e30cf789c08 100644 --- a/gcc/cp/expr.c +++ b/gcc/cp/expr.c @@ -96,16 +96,21 @@ mark_use (tree expr, bool rvalue_p, bool read_p, { #define RECUR(t) mark_use ((t), rvalue_p, read_p, loc, reject_builtin) + if (expr == NULL_TREE || expr == error_mark_node) + return expr; + if (reject_builtin && reject_gcc_builtin (expr, loc)) return error_mark_node; if (read_p) mark_exp_read (expr); + tree oexpr = expr; bool recurse_op[3] = { false, false, false }; switch (TREE_CODE (expr)) { case VAR_DECL: + case PARM_DECL: if (outer_automatic_var_p (expr) && decl_constant_var_p (expr)) { @@ -119,10 +124,13 @@ mark_use (tree expr, bool rvalue_p, bool read_p, } } expr = process_outer_var_ref (expr, tf_warning_or_error, true); - expr = convert_from_reference (expr); + if (!(TREE_TYPE (oexpr) + && TREE_CODE (TREE_TYPE (oexpr)) == REFERENCE_TYPE)) + expr = convert_from_reference (expr); } break; case COMPONENT_REF: + case NON_DEPENDENT_EXPR: recurse_op[0] = true; break; case COMPOUND_EXPR: @@ -140,35 +148,23 @@ mark_use (tree expr, bool rvalue_p, bool read_p, tree ref = TREE_OPERAND (expr, 0); tree r = mark_rvalue_use (ref, loc, reject_builtin); if (r != ref) - { - expr = copy_node (expr); - TREE_OPERAND (expr, 0) = r; - } + expr = convert_from_reference (r); } break; default: break; } - bool changed = false; - tree ops[3]; for (int i = 0; i < 3; ++i) if (recurse_op[i]) { tree op = TREE_OPERAND (expr, i); - ops[i] = RECUR (op); - if (ops[i] != op) - changed = true; + op = RECUR (op); + if (op == error_mark_node) + return error_mark_node; + TREE_OPERAND (expr, i) = op; } - if (changed) - { - expr = copy_node (expr); - for (int i = 0; i < 3; ++i) - if (recurse_op[i]) - TREE_OPERAND (expr, i) = ops[i]; - } - return expr; #undef RECUR } @@ -187,6 +183,52 @@ mark_rvalue_use (tree e, return mark_use (e, true, true, loc, reject_builtin); } +/* Called when expr appears as a discarded-value expression. */ + +tree +mark_discarded_use (tree expr) +{ + /* The lvalue-to-rvalue conversion (7.1) is applied if and only if the + expression is a glvalue of volatile-qualified type and it is one of the + following: + * ( expression ), where expression is one of these expressions, + * id-expression (8.1.4), + * subscripting (8.2.1), + * class member access (8.2.5), + * indirection (8.3.1), + * pointer-to-member operation (8.5), + * conditional expression (8.16) where both the second and the third + operands are one of these expressions, or + * comma expression (8.19) where the right operand is one of these + expressions. */ + if (expr == NULL_TREE) + return expr; + + switch (TREE_CODE (expr)) + { + case COND_EXPR: + TREE_OPERAND (expr, 2) = mark_discarded_use (TREE_OPERAND (expr, 2)); + gcc_fallthrough (); + case COMPOUND_EXPR: + TREE_OPERAND (expr, 1) = mark_discarded_use (TREE_OPERAND (expr, 1)); + return expr; + + case COMPONENT_REF: + case ARRAY_REF: + case INDIRECT_REF: + case MEMBER_REF: + break; + default: + if (DECL_P (expr)) + break; + else + return expr; + } + + /* Like mark_rvalue_use, but don't reject built-ins. */ + return mark_use (expr, true, true, input_location, false); +} + /* Called whenever an expression is used in an lvalue context. */ tree diff --git a/gcc/cp/lambda.c b/gcc/cp/lambda.c index 78bd89782aaba..76f2f29578fe1 100644 --- a/gcc/cp/lambda.c +++ b/gcc/cp/lambda.c @@ -297,7 +297,17 @@ void insert_capture_proxy (tree var) { if (is_normal_capture_proxy (var)) - register_local_specialization (var, DECL_CAPTURED_VARIABLE (var)); + { + tree cap = DECL_CAPTURED_VARIABLE (var); + if (CHECKING_P) + { + gcc_assert (!is_normal_capture_proxy (cap)); + tree old = retrieve_local_specialization (cap); + if (old) + gcc_assert (DECL_CONTEXT (old) != DECL_CONTEXT (var)); + } + register_local_specialization (var, cap); + } /* Put the capture proxy in the extra body block so that it won't clash with a later local variable. */ @@ -977,6 +987,121 @@ generic_lambda_fn_p (tree callop) && PRIMARY_TEMPLATE_P (DECL_TI_TEMPLATE (callop))); } +/* Returns true iff we need to consider default capture for an enclosing + generic lambda. */ + +bool +need_generic_capture (void) +{ + if (!processing_template_decl) + return false; + + tree outer_closure = NULL_TREE; + for (tree t = current_class_type; t; + t = decl_type_context (TYPE_MAIN_DECL (t))) + { + tree lam = CLASSTYPE_LAMBDA_EXPR (t); + if (!lam || LAMBDA_EXPR_DEFAULT_CAPTURE_MODE (lam) == CPLD_NONE) + /* No default capture. */ + break; + outer_closure = t; + } + + if (!outer_closure) + /* No lambda. */ + return false; + else if (dependent_type_p (outer_closure)) + /* The enclosing context isn't instantiated. */ + return false; + else + return true; +} + +/* A lambda-expression...is said to implicitly capture the entity...if the + compound-statement...names the entity in a potentially-evaluated + expression where the enclosing full-expression depends on a generic lambda + parameter declared within the reaching scope of the lambda-expression. */ + +static tree +dependent_capture_r (tree *tp, int *walk_subtrees, void *data) +{ + hash_set *pset = (hash_set *)data; + + if (TYPE_P (*tp)) + *walk_subtrees = 0; + + if (outer_automatic_var_p (*tp)) + { + tree t = process_outer_var_ref (*tp, tf_warning_or_error, /*force*/true); + if (t != *tp + && TREE_CODE (TREE_TYPE (t)) == REFERENCE_TYPE + && TREE_CODE (TREE_TYPE (*tp)) != REFERENCE_TYPE) + t = convert_from_reference (t); + *tp = t; + } + + if (pset->add (*tp)) + *walk_subtrees = 0; + + switch (TREE_CODE (*tp)) + { + /* Don't walk into unevaluated context or another lambda. */ + case SIZEOF_EXPR: + case ALIGNOF_EXPR: + case TYPEID_EXPR: + case NOEXCEPT_EXPR: + case LAMBDA_EXPR: + *walk_subtrees = 0; + break; + + /* Don't walk into statements whose subexpressions we already + handled. */ + case TRY_BLOCK: + case EH_SPEC_BLOCK: + case HANDLER: + case IF_STMT: + case FOR_STMT: + case RANGE_FOR_STMT: + case WHILE_STMT: + case DO_STMT: + case SWITCH_STMT: + case STATEMENT_LIST: + case RETURN_EXPR: + *walk_subtrees = 0; + break; + + case DECL_EXPR: + { + tree decl = DECL_EXPR_DECL (*tp); + if (VAR_P (decl)) + { + /* walk_tree_1 won't step in here. */ + cp_walk_tree (&DECL_INITIAL (decl), + dependent_capture_r, &pset, NULL); + *walk_subtrees = 0; + } + } + break; + + default: + break; + } + + return NULL_TREE; +} + +tree +do_dependent_capture (tree expr, bool force) +{ + if (!need_generic_capture () + || (!force && !instantiation_dependent_expression_p (expr))) + return expr; + + hash_set pset; + cp_walk_tree (&expr, dependent_capture_r, &pset, NULL); + return expr; +} + /* If the closure TYPE has a static op(), also add a conversion to function pointer. */ @@ -1073,7 +1198,10 @@ maybe_add_lambda_conv_op (tree type) if (generic_lambda_p) { + /* Avoid capturing variables in this context. */ + ++cp_unevaluated_operand; tree a = forward_parm (tgt); + --cp_unevaluated_operand; CALL_EXPR_ARG (call, ix) = a; if (decltype_call) diff --git a/gcc/cp/mangle.c b/gcc/cp/mangle.c index 6046906e77d76..64397cdddcb63 100644 --- a/gcc/cp/mangle.c +++ b/gcc/cp/mangle.c @@ -1725,7 +1725,7 @@ write_integer_cst (const tree cst) type = c_common_signed_or_unsigned_type (1, TREE_TYPE (cst)); base = build_int_cstu (type, chunk); - n = wide_int_to_tree (type, cst); + n = wide_int_to_tree (type, wi::to_wide (cst)); if (sign < 0) { diff --git a/gcc/cp/name-lookup.c b/gcc/cp/name-lookup.c index a3da34d7549c8..b1b4ebbb7de28 100644 --- a/gcc/cp/name-lookup.c +++ b/gcc/cp/name-lookup.c @@ -2511,13 +2511,13 @@ update_binding (cp_binding_level *level, cxx_binding *binding, tree *slot, return decl; } -/* Table of identifiers to extern C functions (or LISTS thereof). */ +/* Table of identifiers to extern C declarations (or LISTS thereof). */ -static GTY(()) hash_table *extern_c_fns; +static GTY(()) hash_table *extern_c_decls; -/* DECL has C linkage. If we have an existing instance, make sure it - has the same exception specification [7.5, 7.6]. If there's no - instance, add DECL to the map. */ +/* DECL has C linkage. If we have an existing instance, make sure the + new one is compatible. Make sure it has the same exception + specification [7.5, 7.6]. Add DECL to the map. */ static void check_extern_c_conflict (tree decl) @@ -2526,10 +2526,10 @@ check_extern_c_conflict (tree decl) if (DECL_ARTIFICIAL (decl) || DECL_IN_SYSTEM_HEADER (decl)) return; - if (!extern_c_fns) - extern_c_fns = hash_table::create_ggc (127); + if (!extern_c_decls) + extern_c_decls = hash_table::create_ggc (127); - tree *slot = extern_c_fns + tree *slot = extern_c_decls ->find_slot_with_hash (DECL_NAME (decl), IDENTIFIER_HASH_VALUE (DECL_NAME (decl)), INSERT); if (tree old = *slot) @@ -2543,9 +2543,10 @@ check_extern_c_conflict (tree decl) about a (possible) mismatch, when inserting the decl. */ else if (!decls_match (decl, old)) mismatch = 1; - else if (!comp_except_specs (TYPE_RAISES_EXCEPTIONS (TREE_TYPE (old)), - TYPE_RAISES_EXCEPTIONS (TREE_TYPE (decl)), - ce_normal)) + else if (TREE_CODE (decl) == FUNCTION_DECL + && !comp_except_specs (TYPE_RAISES_EXCEPTIONS (TREE_TYPE (old)), + TYPE_RAISES_EXCEPTIONS (TREE_TYPE (decl)), + ce_normal)) mismatch = -1; else if (DECL_ASSEMBLER_NAME_SET_P (old)) SET_DECL_ASSEMBLER_NAME (decl, DECL_ASSEMBLER_NAME (old)); @@ -2553,12 +2554,12 @@ check_extern_c_conflict (tree decl) if (mismatch) { pedwarn (input_location, 0, - "declaration of %q#D with C language linkage", decl); - pedwarn (DECL_SOURCE_LOCATION (old), 0, - "conflicts with previous declaration %q#D", old); + "conflicting C language linkage declaration %q#D", decl); + inform (DECL_SOURCE_LOCATION (old), + "previous declaration %q#D", old); if (mismatch < 0) - pedwarn (input_location, 0, - "due to different exception specifications"); + inform (input_location, + "due to different exception specifications"); } else { @@ -2587,8 +2588,8 @@ check_extern_c_conflict (tree decl) tree c_linkage_bindings (tree name) { - if (extern_c_fns) - if (tree *slot = extern_c_fns + if (extern_c_decls) + if (tree *slot = extern_c_decls ->find_slot_with_hash (name, IDENTIFIER_HASH_VALUE (name), NO_INSERT)) { tree result = *slot; @@ -3030,9 +3031,8 @@ do_pushdecl (tree decl, bool is_friend) else *slot = head; } - if (TREE_CODE (match) == FUNCTION_DECL - && DECL_EXTERN_C_P (match)) - /* We need to check and register the fn now. */ + if (DECL_EXTERN_C_P (match)) + /* We need to check and register the decl now. */ check_extern_c_conflict (match); } return match; @@ -3113,7 +3113,9 @@ do_pushdecl (tree decl, bool is_friend) } else if (VAR_P (decl)) maybe_register_incomplete_var (decl); - else if (TREE_CODE (decl) == FUNCTION_DECL && DECL_EXTERN_C_P (decl)) + + if ((VAR_P (decl) || TREE_CODE (decl) == FUNCTION_DECL) + && DECL_EXTERN_C_P (decl)) check_extern_c_conflict (decl); } else @@ -4858,22 +4860,13 @@ set_global_binding (tree decl) bool subtime = timevar_cond_start (TV_NAME_LOOKUP); tree *slot = find_namespace_slot (global_namespace, DECL_NAME (decl), true); - tree old = MAYBE_STAT_DECL (*slot); - if (!old) - *slot = decl; - else if (old == decl) - ; - else if (!STAT_HACK_P (*slot) - && TREE_CODE (decl) == TYPE_DECL && DECL_ARTIFICIAL (decl)) - *slot = stat_hack (old, decl); - else if (!STAT_HACK_P (*slot) - && TREE_CODE (old) == TYPE_DECL && DECL_ARTIFICIAL (old)) - *slot = stat_hack (decl, old); - else - /* The user's placed something in the implementor's - namespace. */ - diagnose_name_conflict (decl, old); + if (*slot) + /* The user's placed something in the implementor's namespace. */ + diagnose_name_conflict (decl, MAYBE_STAT_DECL (*slot)); + + /* Force the binding, so compiler internals continue to work. */ + *slot = decl; timevar_cond_stop (TV_NAME_LOOKUP, subtime); } diff --git a/gcc/cp/parser.c b/gcc/cp/parser.c index 7883c64f33f81..2337be52c382b 100644 --- a/gcc/cp/parser.c +++ b/gcc/cp/parser.c @@ -2770,51 +2770,159 @@ cp_lexer_peek_conflict_marker (cp_lexer *lexer, enum cpp_ttype tok1_kind, return true; } -/* If not parsing tentatively, issue a diagnostic of the form +/* Get a description of the matching symbol to TOKEN_DESC e.g. "(" for + RT_CLOSE_PAREN. */ + +static const char * +get_matching_symbol (required_token token_desc) +{ + switch (token_desc) + { + default: + gcc_unreachable (); + return ""; + case RT_CLOSE_BRACE: + return "{"; + case RT_CLOSE_PAREN: + return "("; + } +} + +/* Attempt to convert TOKEN_DESC from a required_token to an + enum cpp_ttype, returning CPP_EOF if there is no good conversion. */ + +static enum cpp_ttype +get_required_cpp_ttype (required_token token_desc) +{ + switch (token_desc) + { + case RT_SEMICOLON: + return CPP_SEMICOLON; + case RT_OPEN_PAREN: + return CPP_OPEN_PAREN; + case RT_CLOSE_BRACE: + return CPP_CLOSE_BRACE; + case RT_OPEN_BRACE: + return CPP_OPEN_BRACE; + case RT_CLOSE_SQUARE: + return CPP_CLOSE_SQUARE; + case RT_OPEN_SQUARE: + return CPP_OPEN_SQUARE; + case RT_COMMA: + return CPP_COMMA; + case RT_COLON: + return CPP_COLON; + case RT_CLOSE_PAREN: + return CPP_CLOSE_PAREN; + + default: + /* Use CPP_EOF as a "no completions possible" code. */ + return CPP_EOF; + } +} + + +/* Subroutine of cp_parser_error and cp_parser_required_error. + + Issue a diagnostic of the form FILE:LINE: MESSAGE before TOKEN where TOKEN is the next token in the input stream. MESSAGE (specified by the caller) is usually of the form "expected - OTHER-TOKEN". */ + OTHER-TOKEN". + + This bypasses the check for tentative passing, and potentially + adds material needed by cp_parser_required_error. + + If MISSING_TOKEN_DESC is not RT_NONE, then potentially add fix-it hints + suggesting insertion of the missing token. + + Additionally, if MATCHING_LOCATION is not UNKNOWN_LOCATION, then we + have an unmatched symbol at MATCHING_LOCATION; highlight this secondary + location. */ static void -cp_parser_error (cp_parser* parser, const char* gmsgid) +cp_parser_error_1 (cp_parser* parser, const char* gmsgid, + required_token missing_token_desc, + location_t matching_location) { - if (!cp_parser_simulate_error (parser)) + cp_token *token = cp_lexer_peek_token (parser->lexer); + /* This diagnostic makes more sense if it is tagged to the line + of the token we just peeked at. */ + cp_lexer_set_source_position_from_token (token); + + if (token->type == CPP_PRAGMA) { - cp_token *token = cp_lexer_peek_token (parser->lexer); - /* This diagnostic makes more sense if it is tagged to the line - of the token we just peeked at. */ - cp_lexer_set_source_position_from_token (token); + error_at (token->location, + "%<#pragma%> is not allowed here"); + cp_parser_skip_to_pragma_eol (parser, token); + return; + } - if (token->type == CPP_PRAGMA) + /* If this is actually a conflict marker, report it as such. */ + if (token->type == CPP_LSHIFT + || token->type == CPP_RSHIFT + || token->type == CPP_EQ_EQ) + { + location_t loc; + if (cp_lexer_peek_conflict_marker (parser->lexer, token->type, &loc)) { - error_at (token->location, - "%<#pragma%> is not allowed here"); - cp_parser_skip_to_pragma_eol (parser, token); + error_at (loc, "version control conflict marker in file"); return; } + } - /* If this is actually a conflict marker, report it as such. */ - if (token->type == CPP_LSHIFT - || token->type == CPP_RSHIFT - || token->type == CPP_EQ_EQ) - { - location_t loc; - if (cp_lexer_peek_conflict_marker (parser->lexer, token->type, &loc)) - { - error_at (loc, "version control conflict marker in file"); - return; - } - } + gcc_rich_location richloc (input_location); + + bool added_matching_location = false; - rich_location richloc (line_table, input_location); - c_parse_error (gmsgid, - /* Because c_parser_error does not understand - CPP_KEYWORD, keywords are treated like - identifiers. */ - (token->type == CPP_KEYWORD ? CPP_NAME : token->type), - token->u.value, token->flags, &richloc); + if (missing_token_desc != RT_NONE) + { + /* Potentially supply a fix-it hint, suggesting to add the + missing token immediately after the *previous* token. + This may move the primary location within richloc. */ + enum cpp_ttype ttype = get_required_cpp_ttype (missing_token_desc); + location_t prev_token_loc + = cp_lexer_previous_token (parser->lexer)->location; + maybe_suggest_missing_token_insertion (&richloc, ttype, prev_token_loc); + + /* If matching_location != UNKNOWN_LOCATION, highlight it. + Attempt to consolidate diagnostics by printing it as a + secondary range within the main diagnostic. */ + if (matching_location != UNKNOWN_LOCATION) + added_matching_location + = richloc.add_location_if_nearby (matching_location); } + + /* Actually emit the error. */ + c_parse_error (gmsgid, + /* Because c_parser_error does not understand + CPP_KEYWORD, keywords are treated like + identifiers. */ + (token->type == CPP_KEYWORD ? CPP_NAME : token->type), + token->u.value, token->flags, &richloc); + + if (missing_token_desc != RT_NONE) + { + /* If we weren't able to consolidate matching_location, then + print it as a secondary diagnostic. */ + if (matching_location != UNKNOWN_LOCATION + && !added_matching_location) + inform (matching_location, "to match this %qs", + get_matching_symbol (missing_token_desc)); + } +} + +/* If not parsing tentatively, issue a diagnostic of the form + FILE:LINE: MESSAGE before TOKEN + where TOKEN is the next token in the input stream. MESSAGE + (specified by the caller) is usually of the form "expected + OTHER-TOKEN". */ + +static void +cp_parser_error (cp_parser* parser, const char* gmsgid) +{ + if (!cp_parser_simulate_error (parser)) + cp_parser_error_1 (parser, gmsgid, RT_NONE, UNKNOWN_LOCATION); } /* Issue an error about name-lookup failing. NAME is the @@ -3829,6 +3937,9 @@ cp_parser_new (void) /* Allow constrained-type-specifiers. */ parser->prevent_constrained_type_specifiers = 0; + /* We haven't yet seen an 'extern "C"'. */ + parser->innermost_linkage_specification_location = UNKNOWN_LOCATION; + return parser; } @@ -11873,6 +11984,8 @@ cp_convert_range_for (tree statement, tree range_decl, tree range_expr, tree iter_type, begin_expr, end_expr; tree condition, expression; + range_expr = mark_lvalue_use (range_expr); + if (range_decl == error_mark_node || range_expr == error_mark_node) /* If an error happened previously do nothing or else a lot of unhelpful errors would be issued. */ @@ -13738,9 +13851,11 @@ cp_parser_linkage_specification (cp_parser* parser) tree linkage; /* Look for the `extern' keyword. */ - cp_parser_require_keyword (parser, RID_EXTERN, RT_EXTERN); + cp_token *extern_token + = cp_parser_require_keyword (parser, RID_EXTERN, RT_EXTERN); /* Look for the string-literal. */ + cp_token *string_token = cp_lexer_peek_token (parser->lexer); linkage = cp_parser_string_literal (parser, false, false); /* Transform the literal into an identifier. If the literal is a @@ -13759,6 +13874,20 @@ cp_parser_linkage_specification (cp_parser* parser) /* We're now using the new linkage. */ push_lang_context (linkage); + /* Preserve the location of the the innermost linkage specification, + tracking the locations of nested specifications via a local. */ + location_t saved_location + = parser->innermost_linkage_specification_location; + /* Construct a location ranging from the start of the "extern" to + the end of the string-literal, with the caret at the start, e.g.: + extern "C" { + ^~~~~~~~~~ + */ + parser->innermost_linkage_specification_location + = make_location (extern_token->location, + extern_token->location, + get_finish (string_token->location)); + /* If the next token is a `{', then we're using the first production. */ if (cp_lexer_next_token_is (parser->lexer, CPP_OPEN_BRACE)) @@ -13789,6 +13918,9 @@ cp_parser_linkage_specification (cp_parser* parser) /* We're done with the linkage-specification. */ pop_lang_context (); + + /* Restore location of parent linkage specification, if any. */ + parser->innermost_linkage_specification_location = saved_location; } /* Parse a static_assert-declaration. @@ -16533,6 +16665,7 @@ cp_parser_explicit_specialization (cp_parser* parser) if (current_lang_name == lang_name_c) { error_at (token->location, "template specialization with C linkage"); + maybe_show_extern_c_location (); /* Give it C++ linkage to avoid confusing other parts of the front end. */ push_lang_context (lang_name_cplusplus); @@ -26869,6 +27002,7 @@ cp_parser_explicit_template_declaration (cp_parser* parser, bool member_p) if (current_lang_name == lang_name_c) { error_at (location, "template with C linkage"); + maybe_show_extern_c_location (); /* Give it C++ linkage to avoid confusing other parts of the front end. */ push_lang_context (lang_name_cplusplus); @@ -28079,24 +28213,6 @@ cp_parser_friend_p (const cp_decl_specifier_seq *decl_specifiers) return decl_spec_seq_has_spec_p (decl_specifiers, ds_friend); } -/* Get a description of the matching symbol to TOKEN_DESC e.g. "(" for - RT_CLOSE_PAREN. */ - -static const char * -get_matching_symbol (required_token token_desc) -{ - switch (token_desc) - { - default: - gcc_unreachable (); - return ""; - case RT_CLOSE_BRACE: - return "{"; - case RT_CLOSE_PAREN: - return "("; - } -} - /* Issue an error message indicating that TOKEN_DESC was expected. If KEYWORD is true, it indicated this function is called by cp_parser_require_keword and the required token can only be @@ -28274,31 +28390,7 @@ cp_parser_required_error (cp_parser *parser, } if (gmsgid) - { - /* Emulate rest of cp_parser_error. */ - cp_token *token = cp_lexer_peek_token (parser->lexer); - cp_lexer_set_source_position_from_token (token); - - gcc_rich_location richloc (input_location); - - /* If matching_location != UNKNOWN_LOCATION, highlight it. - Attempt to consolidate diagnostics by printing it as a - secondary range within the main diagnostic. */ - bool added_matching_location = false; - if (matching_location != UNKNOWN_LOCATION) - added_matching_location - = richloc.add_location_if_nearby (matching_location); - - c_parse_error (gmsgid, - (token->type == CPP_KEYWORD ? CPP_NAME : token->type), - token->u.value, token->flags, &richloc); - - /* If we weren't able to consolidate matching_location, then - print it as a secondary diagnostic. */ - if (matching_location != UNKNOWN_LOCATION && !added_matching_location) - inform (matching_location, "to match this %qs", - get_matching_symbol (token_desc)); - } + cp_parser_error_1 (parser, gmsgid, token_desc, matching_location); } @@ -39484,4 +39576,17 @@ finish_fully_implicit_template (cp_parser *parser, tree member_decl_opt) return member_decl_opt; } +/* Helper function for diagnostics that have complained about things + being used with 'extern "C"' linkage. + + Attempt to issue a note showing where the 'extern "C"' linkage began. */ + +void +maybe_show_extern_c_location (void) +{ + if (the_parser->innermost_linkage_specification_location != UNKNOWN_LOCATION) + inform (the_parser->innermost_linkage_specification_location, + "% linkage started here"); +} + #include "gt-cp-parser.h" diff --git a/gcc/cp/parser.h b/gcc/cp/parser.h index 0994e1e7f4fc8..f4f4a010964df 100644 --- a/gcc/cp/parser.h +++ b/gcc/cp/parser.h @@ -412,6 +412,10 @@ struct GTY(()) cp_parser { context e.g., because they could never be deduced. */ int prevent_constrained_type_specifiers; + /* Location of the string-literal token within the current linkage + specification, if any, or UNKNOWN_LOCATION otherwise. */ + location_t innermost_linkage_specification_location; + }; /* In parser.c */ diff --git a/gcc/cp/pt.c b/gcc/cp/pt.c index 52fc4d6a222e6..ba52f3b57a62d 100644 --- a/gcc/cp/pt.c +++ b/gcc/cp/pt.c @@ -1895,6 +1895,7 @@ reregister_specialization (tree spec, tree tinfo, tree new_spec) void register_local_specialization (tree spec, tree tmpl) { + gcc_assert (tmpl != spec); local_specializations->put (tmpl, spec); } @@ -9494,30 +9495,14 @@ in_template_function (void) return ret; } -/* Returns true iff we are currently within a template other than a generic - lambda. We test this by finding the outermost closure type and checking - whether it is dependent. */ +/* Returns true iff we are currently within a template other than a + default-capturing generic lambda, so we don't need to worry about semantic + processing. */ bool processing_nonlambda_template (void) { - if (!processing_template_decl) - return false; - - tree outer_closure = NULL_TREE; - for (tree t = current_class_type; t; - t = decl_type_context (TYPE_MAIN_DECL (t))) - { - if (LAMBDA_TYPE_P (t)) - outer_closure = t; - else - break; - } - - if (outer_closure) - return dependent_type_p (outer_closure); - else - return true; + return processing_template_decl && !need_generic_capture (); } /* Returns true if T depends on any template parameter with level LEVEL. */ @@ -23224,15 +23209,9 @@ instantiate_decl (tree d, bool defer_ok, bool expl_inst_class_mem_p) synthesize_method (d); else if (TREE_CODE (d) == FUNCTION_DECL) { - hash_map *saved_local_specializations; - tree block = NULL_TREE; - - /* Save away the current list, in case we are instantiating one - template from within the body of another. */ - saved_local_specializations = local_specializations; - /* Set up the list of local specializations. */ - local_specializations = new hash_map; + local_specialization_stack lss (push_to_top ? lss_blank : lss_copy); + tree block = NULL_TREE; /* Set up context. */ if (DECL_OMP_DECLARE_REDUCTION_P (code_pattern) @@ -23271,10 +23250,6 @@ instantiate_decl (tree d, bool defer_ok, bool expl_inst_class_mem_p) = DECL_STRUCT_FUNCTION (code_pattern)->language->infinite_loop; } - /* We don't need the local specializations any more. */ - delete local_specializations; - local_specializations = saved_local_specializations; - /* Finish the function. */ if (DECL_OMP_DECLARE_REDUCTION_P (code_pattern) && TREE_CODE (DECL_CONTEXT (code_pattern)) == FUNCTION_DECL) @@ -24307,21 +24282,22 @@ type_dependent_expression_p (tree expression) && (any_dependent_template_arguments_p (INNERMOST_TEMPLATE_ARGS (DECL_TI_ARGS (expression))))) return true; + } - /* Otherwise, if the decl isn't from a dependent scope, it can't be - type-dependent. Checking this is important for functions with auto - return type, which looks like a dependent type. */ - if (TREE_CODE (expression) == FUNCTION_DECL - && (!DECL_CLASS_SCOPE_P (expression) - || !dependent_type_p (DECL_CONTEXT (expression))) - && (!DECL_FRIEND_CONTEXT (expression) - || !dependent_type_p (DECL_FRIEND_CONTEXT (expression))) - && !DECL_LOCAL_FUNCTION_P (expression)) - { - gcc_assert (!dependent_type_p (TREE_TYPE (expression)) - || undeduced_auto_decl (expression)); - return false; - } + /* Otherwise, if the function decl isn't from a dependent scope, it can't be + type-dependent. Checking this is important for functions with auto return + type, which looks like a dependent type. */ + if (TREE_CODE (expression) == FUNCTION_DECL + && !(DECL_CLASS_SCOPE_P (expression) + && dependent_type_p (DECL_CONTEXT (expression))) + && !(DECL_FRIEND_P (expression) + && (!DECL_FRIEND_CONTEXT (expression) + || dependent_type_p (DECL_FRIEND_CONTEXT (expression)))) + && !DECL_LOCAL_FUNCTION_P (expression)) + { + gcc_assert (!dependent_type_p (TREE_TYPE (expression)) + || undeduced_auto_decl (expression)); + return false; } /* Always dependent, on the number of arguments if nothing else. */ diff --git a/gcc/cp/semantics.c b/gcc/cp/semantics.c index d96423f23487a..a512664e3966f 100644 --- a/gcc/cp/semantics.c +++ b/gcc/cp/semantics.c @@ -410,6 +410,8 @@ maybe_cleanup_point_expr (tree expr) { if (!processing_template_decl && stmts_are_full_exprs_p ()) expr = fold_build_cleanup_point_expr (TREE_TYPE (expr), expr); + else + expr = do_dependent_capture (expr); return expr; } @@ -423,6 +425,8 @@ maybe_cleanup_point_expr_void (tree expr) { if (!processing_template_decl && stmts_are_full_exprs_p ()) expr = fold_build_cleanup_point_expr (void_type_node, expr); + else + expr = do_dependent_capture (expr); return expr; } @@ -629,6 +633,8 @@ finish_goto_stmt (tree destination) = fold_build_cleanup_point_expr (TREE_TYPE (destination), destination); } + else + destination = do_dependent_capture (destination); } check_goto (destination); @@ -650,7 +656,7 @@ maybe_convert_cond (tree cond) /* Wait until we instantiate templates before doing conversion. */ if (processing_template_decl) - return cond; + return do_dependent_capture (cond); if (warn_sequence_point) verify_sequence_points (cond); @@ -3265,6 +3271,8 @@ outer_var_p (tree decl) { return ((VAR_P (decl) || TREE_CODE (decl) == PARM_DECL) && DECL_FUNCTION_SCOPE_P (decl) + /* Don't get confused by temporaries. */ + && DECL_NAME (decl) && (DECL_CONTEXT (decl) != current_function_decl || parsing_nsdmi ())); } @@ -3312,8 +3320,12 @@ process_outer_var_ref (tree decl, tsubst_flags_t complain, bool force_use) if (containing_function && LAMBDA_FUNCTION_P (containing_function)) { /* Check whether we've already built a proxy. */ - tree d = retrieve_local_specialization (decl); - if (d && is_capture_proxy (d)) + tree var = decl; + while (is_normal_capture_proxy (var)) + var = DECL_CAPTURED_VARIABLE (var); + tree d = retrieve_local_specialization (var); + + if (d && d != decl && is_capture_proxy (d)) { if (DECL_CONTEXT (d) == containing_function) /* We already have an inner proxy. */ @@ -5761,7 +5773,7 @@ cp_finish_omp_clause_depend_sink (tree sink_clause) if (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE) { tree offset = TREE_PURPOSE (t); - bool neg = wi::neg_p ((wide_int) offset); + bool neg = wi::neg_p (wi::to_wide (offset)); offset = fold_unary (ABS_EXPR, TREE_TYPE (offset), offset); decl = mark_rvalue_use (decl); decl = convert_from_reference (decl); @@ -6213,8 +6225,8 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) "positive"); t = integer_one_node; } + t = fold_build_cleanup_point_expr (TREE_TYPE (t), t); } - t = fold_build_cleanup_point_expr (TREE_TYPE (t), t); } OMP_CLAUSE_OPERAND (c, 1) = t; } @@ -7095,8 +7107,8 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) "integral constant"); remove = true; } + t = fold_build_cleanup_point_expr (TREE_TYPE (t), t); } - t = fold_build_cleanup_point_expr (TREE_TYPE (t), t); } /* Update list item. */ diff --git a/gcc/cp/tree.c b/gcc/cp/tree.c index e21ff6a1572f8..366f46f150656 100644 --- a/gcc/cp/tree.c +++ b/gcc/cp/tree.c @@ -333,6 +333,10 @@ cp_stabilize_reference (tree ref) { switch (TREE_CODE (ref)) { + case NON_DEPENDENT_EXPR: + /* We aren't actually evaluating this. */ + return ref; + /* We need to treat specially anything stabilize_reference doesn't handle specifically. */ case VAR_DECL: diff --git a/gcc/cp/typeck.c b/gcc/cp/typeck.c index c3310db7b3b68..19fbe3c4a4ac6 100644 --- a/gcc/cp/typeck.c +++ b/gcc/cp/typeck.c @@ -5603,8 +5603,9 @@ tree condition_conversion (tree expr) { tree t; - if (processing_template_decl) - return expr; + /* Anything that might happen in a template should go through + maybe_convert_cond. */ + gcc_assert (!processing_template_decl); t = perform_implicit_conversion_flags (boolean_type_node, expr, tf_warning_or_error, LOOKUP_NORMAL); t = fold_build_cleanup_point_expr (boolean_type_node, t); @@ -5653,6 +5654,9 @@ cp_build_addr_expr_1 (tree arg, bool strict_lvalue, tsubst_flags_t complain) return error_mark_node; arg = mark_lvalue_use (arg); + if (error_operand_p (arg)) + return error_mark_node; + argtype = lvalue_type (arg); gcc_assert (!(identifier_p (arg) && IDENTIFIER_ANY_OP_P (arg))); @@ -7058,11 +7062,7 @@ build_static_cast (tree type, tree oexpr, tsubst_flags_t complain) if (dependent) { tmpl: - expr = oexpr; - if (dependent) - /* Handle generic lambda capture. */ - expr = mark_lvalue_use (expr); - expr = build_min (STATIC_CAST_EXPR, type, expr); + expr = build_min (STATIC_CAST_EXPR, type, oexpr); /* We don't know if it will or will not have side effects. */ TREE_SIDE_EFFECTS (expr) = 1; return convert_from_reference (expr); @@ -7701,6 +7701,8 @@ tree cp_build_modify_expr (location_t loc, tree lhs, enum tree_code modifycode, tree rhs, tsubst_flags_t complain) { + lhs = mark_lvalue_use_nonread (lhs); + tree result = NULL_TREE; tree newrhs = rhs; tree lhstype = TREE_TYPE (lhs); @@ -7923,6 +7925,8 @@ cp_build_modify_expr (location_t loc, tree lhs, enum tree_code modifycode, operator. -- end note ] */ lhs = cp_stabilize_reference (lhs); rhs = rvalue (rhs); + if (rhs == error_mark_node) + return error_mark_node; rhs = stabilize_expr (rhs, &init); newrhs = cp_build_binary_op (loc, modifycode, lhs, rhs, complain); if (newrhs == error_mark_node) @@ -8957,10 +8961,14 @@ check_return_expr (tree retval, bool *no_warning) if (check_for_bare_parameter_packs (retval)) return error_mark_node; - if (WILDCARD_TYPE_P (TREE_TYPE (DECL_RESULT (current_function_decl))) + /* If one of the types might be void, we can't tell whether we're + returning a value. */ + if ((WILDCARD_TYPE_P (TREE_TYPE (DECL_RESULT (current_function_decl))) + && !current_function_auto_return_pattern) || (retval != NULL_TREE - && type_dependent_expression_p (retval))) - return retval; + && (TREE_TYPE (retval) == NULL_TREE + || WILDCARD_TYPE_P (TREE_TYPE (retval))))) + goto dependent; } functype = TREE_TYPE (TREE_TYPE (current_function_decl)); @@ -9098,11 +9106,13 @@ check_return_expr (tree retval, bool *no_warning) warning (OPT_Weffc__, "% should return a reference to %<*this%>"); } - if (processing_template_decl) + if (dependent_type_p (functype) + || type_dependent_expression_p (retval)) { + dependent: /* We should not have changed the return value. */ gcc_assert (retval == saved_retval); - return retval; + return do_dependent_capture (retval, /*force*/true); } /* The fabled Named Return Value optimization, as per [class.copy]/15: @@ -9126,6 +9136,7 @@ check_return_expr (tree retval, bool *no_warning) named_return_value_okay_p = (retval != NULL_TREE + && !processing_template_decl /* Must be a local, automatic variable. */ && VAR_P (retval) && DECL_CONTEXT (retval) == current_function_decl @@ -9217,11 +9228,15 @@ check_return_expr (tree retval, bool *no_warning) && TREE_CODE (TREE_OPERAND (retval, 1)) == AGGR_INIT_EXPR) retval = build2 (COMPOUND_EXPR, TREE_TYPE (retval), retval, TREE_OPERAND (retval, 0)); - else if (maybe_warn_about_returning_address_of_local (retval)) + else if (!processing_template_decl + && maybe_warn_about_returning_address_of_local (retval)) retval = build2 (COMPOUND_EXPR, TREE_TYPE (retval), retval, build_zero_cst (TREE_TYPE (retval))); } + if (processing_template_decl) + return saved_retval; + /* Actually copy the value returned into the appropriate location. */ if (retval && retval != result) retval = build2 (INIT_EXPR, TREE_TYPE (result), result, retval); diff --git a/gcc/cse.c b/gcc/cse.c index 672fd2eaea970..25653ac77bb0d 100644 --- a/gcc/cse.c +++ b/gcc/cse.c @@ -3612,7 +3612,7 @@ fold_rtx (rtx x, rtx_insn *insn) { if (SHIFT_COUNT_TRUNCATED) canon_const_arg1 = GEN_INT (INTVAL (const_arg1) - & (GET_MODE_BITSIZE (mode) + & (GET_MODE_UNIT_BITSIZE (mode) - 1)); else break; @@ -3661,7 +3661,8 @@ fold_rtx (rtx x, rtx_insn *insn) { if (SHIFT_COUNT_TRUNCATED) inner_const = GEN_INT (INTVAL (inner_const) - & (GET_MODE_BITSIZE (mode) - 1)); + & (GET_MODE_UNIT_BITSIZE (mode) + - 1)); else break; } @@ -3691,7 +3692,7 @@ fold_rtx (rtx x, rtx_insn *insn) /* As an exception, we can turn an ASHIFTRT of this form into a shift of the number of bits - 1. */ if (code == ASHIFTRT) - new_const = GEN_INT (GET_MODE_BITSIZE (mode) - 1); + new_const = GEN_INT (GET_MODE_UNIT_BITSIZE (mode) - 1); else if (!side_effects_p (XEXP (y, 0))) return CONST0_RTX (mode); else @@ -5977,7 +5978,6 @@ cse_insn (rtx_insn *insn) rtx new_src = 0; unsigned src_hash; struct table_elt *src_elt; - int byte = 0; /* Ignore invalid entries. */ if (!REG_P (elt->exp) @@ -5990,13 +5990,8 @@ cse_insn (rtx_insn *insn) new_src = elt->exp; else { - /* Calculate big endian correction for the SUBREG_BYTE. - We have already checked that M1 (GET_MODE (dest)) - is not narrower than M2 (new_mode). */ - if (BYTES_BIG_ENDIAN) - byte = (GET_MODE_SIZE (GET_MODE (dest)) - - GET_MODE_SIZE (new_mode)); - + unsigned int byte + = subreg_lowpart_offset (new_mode, GET_MODE (dest)); new_src = simplify_gen_subreg (new_mode, elt->exp, GET_MODE (dest), byte); } diff --git a/gcc/dbxout.c b/gcc/dbxout.c index ea7c97ccb3185..0615e84fc831b 100644 --- a/gcc/dbxout.c +++ b/gcc/dbxout.c @@ -714,7 +714,7 @@ stabstr_O (tree cst) /* If the value is zero, the base indicator will serve as the value all by itself. */ - if (wi::eq_p (cst, 0)) + if (wi::to_wide (cst) == 0) return; /* GDB wants constants with no extra leading "1" bits, so @@ -722,19 +722,19 @@ stabstr_O (tree cst) present. */ if (res_pres == 1) { - digit = wi::extract_uhwi (cst, prec - 1, 1); + digit = wi::extract_uhwi (wi::to_wide (cst), prec - 1, 1); stabstr_C ('0' + digit); } else if (res_pres == 2) { - digit = wi::extract_uhwi (cst, prec - 2, 2); + digit = wi::extract_uhwi (wi::to_wide (cst), prec - 2, 2); stabstr_C ('0' + digit); } prec -= res_pres; for (i = prec - 3; i >= 0; i = i - 3) { - digit = wi::extract_uhwi (cst, i, 3); + digit = wi::extract_uhwi (wi::to_wide (cst), i, 3); stabstr_C ('0' + digit); } } diff --git a/gcc/diagnostic-color.c b/gcc/diagnostic-color.c index 6adb872146b69..b8cf6f2c04556 100644 --- a/gcc/diagnostic-color.c +++ b/gcc/diagnostic-color.c @@ -20,6 +20,10 @@ #include "system.h" #include "diagnostic-color.h" +#ifdef __MINGW32__ +# include +#endif + /* Select Graphic Rendition (SGR, "\33[...m") strings. */ /* Also Erase in Line (EL) to Right ("\33[K") by default. */ /* Why have EL to Right after SGR? @@ -275,23 +279,28 @@ parse_gcc_colors (void) return true; } -#if defined(_WIN32) -bool -colorize_init (diagnostic_color_rule_t) -{ - return false; -} -#else - /* Return true if we should use color when in auto mode, false otherwise. */ static bool should_colorize (void) { +#ifdef __MINGW32__ + /* For consistency reasons, one should check the handle returned by + _get_osfhandle(_fileno(stderr)) because the function + pp_write_text_to_stream() in pretty-print.c calls fputs() on + that stream. However, the code below for non-Windows doesn't seem + to care about it either... */ + HANDLE h; + DWORD m; + + h = GetStdHandle (STD_ERROR_HANDLE); + return (h != INVALID_HANDLE_VALUE) && (h != NULL) + && GetConsoleMode (h, &m); +#else char const *t = getenv ("TERM"); return t && strcmp (t, "dumb") != 0 && isatty (STDERR_FILENO); +#endif } - bool colorize_init (diagnostic_color_rule_t rule) { @@ -310,4 +319,3 @@ colorize_init (diagnostic_color_rule_t rule) gcc_unreachable (); } } -#endif diff --git a/gcc/doc/extend.texi b/gcc/doc/extend.texi index 4156291b6423f..71d638f05c017 100644 --- a/gcc/doc/extend.texi +++ b/gcc/doc/extend.texi @@ -2801,7 +2801,7 @@ void *my_memcpy (void *dst, const void *src, size_t len) static void * (*resolve_memcpy (void))(void *, const void *, size_t) @{ - return my_memcpy; // we'll just always select this routine + return my_memcpy; // we will just always select this routine @} @end smallexample @@ -2814,15 +2814,56 @@ extern void *memcpy (void *, const void *, size_t); @end smallexample @noindent -allowing the user to call this as a regular function, unaware of the -implementation. Finally, the indirect function needs to be defined in -the same translation unit as the resolver function: +allowing the user to call @code{memcpy} as a regular function, unaware of +the actual implementation. Finally, the indirect function needs to be +defined in the same translation unit as the resolver function: @smallexample void *memcpy (void *, const void *, size_t) __attribute__ ((ifunc ("resolve_memcpy"))); @end smallexample +In C++, the @code{ifunc} attribute takes a string that is the mangled name +of the resolver function. A C++ resolver for a non-static member function +of class @code{C} should be declared to return a pointer to a non-member +function taking pointer to @code{C} as the first argument, followed by +the same arguments as of the implementation function. G++ checks +the signatures of the two functions and issues +a @option{-Wattribute-alias} warning for mismatches. To suppress a warning +for the necessary cast from a pointer to the implementation member function +to the type of the corresponding non-member function use +the @option{-Wno-pmf-conversions} option. For example: + +@smallexample +class S +@{ +private: + int debug_impl (int); + int optimized_impl (int); + + typedef int Func (S*, int); + + static Func* resolver (); +public: + + int interface (int); +@}; + +int S::debug_impl (int) @{ /* @r{@dots{}} */ @} +int S::optimized_impl (int) @{ /* @r{@dots{}} */ @} + +S::Func* S::resolver () +@{ + int (S::*pimpl) (int) + = getenv ("DEBUG") ? &S::debug_impl : &S::optimized_impl; + + // Cast triggers -Wno-pmf-conversions. + return reinterpret_cast(pimpl); +@} + +int S::interface (int) __attribute__ ((ifunc ("_ZN1S8resolverEv"))); +@end smallexample + Indirect functions cannot be weak. Binutils version 2.20.1 or higher and GNU C Library version 2.11.1 are required to use this feature. @@ -5649,6 +5690,58 @@ Specify which floating-point unit to use. You must specify the @code{target("fpmath=sse,387")} option as @code{target("fpmath=sse+387")} because the comma would separate different options. + +@item nocf_check +@cindex @code{nocf_check} function attribute +The @code{nocf_check} attribute on a function is used to inform the +compiler that the function's prologue should not be instrumented when +compiled with the @option{-fcf-protection=branch} option. The +compiler assumes that the function's address is a valid target for a +control-flow transfer. + +The @code{nocf_check} attribute on a type of pointer to function is +used to inform the compiler that a call through the pointer should +not be instrumented when compiled with the +@option{-fcf-protection=branch} option. The compiler assumes +that the function's address from the pointer is a valid target for +a control-flow transfer. A direct function call through a function +name is assumed to be a safe call thus direct calls are not +instrumented by the compiler. + +The @code{nocf_check} attribute is applied to an object's type. +In case of assignment of a function address or a function pointer to +another pointer, the attribute is not carried over from the right-hand +object's type; the type of left-hand object stays unchanged. The +compiler checks for @code{nocf_check} attribute mismatch and reports +a warning in case of mismatch. + +@smallexample +@{ +int foo (void) __attribute__(nocf_check); +void (*foo1)(void) __attribute__(nocf_check); +void (*foo2)(void); + +int +foo (void) /* The function's address is assumed to be valid. */ + + /* This call site is not checked for control-flow validity. */ + (*foo1)(); + + foo1 = foo2; /* A warning is printed about attribute mismatch. */ + /* This call site is still not checked for control-flow validity. */ + (*foo1)(); + + /* This call site is checked for control-flow validity. */ + (*foo2)(); + + foo2 = foo1; /* A warning is printed about attribute mismatch. */ + /* This call site is still checked for control-flow validity. */ + (*foo2)(); + + return 0; +@} +@end smallexample + @end table On the x86, the inliner does not inline a @@ -8081,7 +8174,7 @@ A comma-separated list of C expressions read by the instructions in the @item Clobbers A comma-separated list of registers or other values changed by the @var{AssemblerTemplate}, beyond those listed as outputs. -An empty list is permitted. @xref{Clobbers}. +An empty list is permitted. @xref{Clobbers and Scratch Registers}. @item GotoLabels When you are using the @code{goto} form of @code{asm}, this section contains @@ -8441,7 +8534,7 @@ The enclosing parentheses are a required part of the syntax. When the compiler selects the registers to use to represent the output operands, it does not use any of the clobbered registers -(@pxref{Clobbers}). +(@pxref{Clobbers and Scratch Registers}). Output operand expressions must be lvalues. The compiler cannot check whether the operands have data types that are reasonable for the instruction being @@ -8677,7 +8770,8 @@ as input. The enclosing parentheses are a required part of the syntax. @end table When the compiler selects the registers to use to represent the input -operands, it does not use any of the clobbered registers (@pxref{Clobbers}). +operands, it does not use any of the clobbered registers +(@pxref{Clobbers and Scratch Registers}). If there are no output operands but there are input operands, place two consecutive colons where the output operands would go: @@ -8728,9 +8822,10 @@ asm ("cmoveq %1, %2, %[result]" : "r" (test), "r" (new), "[result]" (old)); @end example -@anchor{Clobbers} -@subsubsection Clobbers +@anchor{Clobbers and Scratch Registers} +@subsubsection Clobbers and Scratch Registers @cindex @code{asm} clobbers +@cindex @code{asm} scratch registers While the compiler is aware of changes to entries listed in the output operands, the inline @code{asm} code may modify more than just the outputs. For @@ -8761,7 +8856,7 @@ registers: asm volatile ("movc3 %0, %1, %2" : /* No outputs. */ : "g" (from), "g" (to), "g" (count) - : "r0", "r1", "r2", "r3", "r4", "r5"); + : "r0", "r1", "r2", "r3", "r4", "r5", "memory"); @end example Also, there are two special clobber arguments: @@ -8792,14 +8887,141 @@ Note that this clobber does not prevent the @emph{processor} from doing speculative reads past the @code{asm} statement. To prevent that, you need processor-specific fence instructions. -Flushing registers to memory has performance implications and may be an issue -for time-sensitive code. You can use a trick to avoid this if the size of -the memory being accessed is known at compile time. For example, if accessing -ten bytes of a string, use a memory input like: +@end table -@code{@{"m"( (@{ struct @{ char x[10]; @} *p = (void *)ptr ; *p; @}) )@}}. +Flushing registers to memory has performance implications and may be +an issue for time-sensitive code. You can provide better information +to GCC to avoid this, as shown in the following examples. At a +minimum, aliasing rules allow GCC to know what memory @emph{doesn't} +need to be flushed. -@end table +Here is a fictitious sum of squares instruction, that takes two +pointers to floating point values in memory and produces a floating +point register output. +Notice that @code{x}, and @code{y} both appear twice in the @code{asm} +parameters, once to specify memory accessed, and once to specify a +base register used by the @code{asm}. You won't normally be wasting a +register by doing this as GCC can use the same register for both +purposes. However, it would be foolish to use both @code{%1} and +@code{%3} for @code{x} in this @code{asm} and expect them to be the +same. In fact, @code{%3} may well not be a register. It might be a +symbolic memory reference to the object pointed to by @code{x}. + +@smallexample +asm ("sumsq %0, %1, %2" + : "+f" (result) + : "r" (x), "r" (y), "m" (*x), "m" (*y)); +@end smallexample + +Here is a fictitious @code{*z++ = *x++ * *y++} instruction. +Notice that the @code{x}, @code{y} and @code{z} pointer registers +must be specified as input/output because the @code{asm} modifies +them. + +@smallexample +asm ("vecmul %0, %1, %2" + : "+r" (z), "+r" (x), "+r" (y), "=m" (*z) + : "m" (*x), "m" (*y)); +@end smallexample + +An x86 example where the string memory argument is of unknown length. + +@smallexample +asm("repne scasb" + : "=c" (count), "+D" (p) + : "m" (*(const char (*)[]) p), "0" (-1), "a" (0)); +@end smallexample + +If you know the above will only be reading a ten byte array then you +could instead use a memory input like: +@code{"m" (*(const char (*)[10]) p)}. + +Here is an example of a PowerPC vector scale implemented in assembly, +complete with vector and condition code clobbers, and some initialized +offset registers that are unchanged by the @code{asm}. + +@smallexample +void +dscal (size_t n, double *x, double alpha) +@{ + asm ("/* lots of asm here */" + : "+m" (*(double (*)[n]) x), "+&r" (n), "+b" (x) + : "d" (alpha), "b" (32), "b" (48), "b" (64), + "b" (80), "b" (96), "b" (112) + : "cr0", + "vs32","vs33","vs34","vs35","vs36","vs37","vs38","vs39", + "vs40","vs41","vs42","vs43","vs44","vs45","vs46","vs47"); +@} +@end smallexample + +Rather than allocating fixed registers via clobbers to provide scratch +registers for an @code{asm} statement, an alternative is to define a +variable and make it an early-clobber output as with @code{a2} and +@code{a3} in the example below. This gives the compiler register +allocator more freedom. You can also define a variable and make it an +output tied to an input as with @code{a0} and @code{a1}, tied +respectively to @code{ap} and @code{lda}. Of course, with tied +outputs your @code{asm} can't use the input value after modifying the +output register since they are one and the same register. What's +more, if you omit the early-clobber on the output, it is possible that +GCC might allocate the same register to another of the inputs if GCC +could prove they had the same value on entry to the @code{asm}. This +is why @code{a1} has an early-clobber. Its tied input, @code{lda} +might conceivably be known to have the value 16 and without an +early-clobber share the same register as @code{%11}. On the other +hand, @code{ap} can't be the same as any of the other inputs, so an +early-clobber on @code{a0} is not needed. It is also not desirable in +this case. An early-clobber on @code{a0} would cause GCC to allocate +a separate register for the @code{"m" (*(const double (*)[]) ap)} +input. Note that tying an input to an output is the way to set up an +initialized temporary register modified by an @code{asm} statement. +An input not tied to an output is assumed by GCC to be unchanged, for +example @code{"b" (16)} below sets up @code{%11} to 16, and GCC might +use that register in following code if the value 16 happened to be +needed. You can even use a normal @code{asm} output for a scratch if +all inputs that might share the same register are consumed before the +scratch is used. The VSX registers clobbered by the @code{asm} +statement could have used this technique except for GCC's limit on the +number of @code{asm} parameters. + +@smallexample +static void +dgemv_kernel_4x4 (long n, const double *ap, long lda, + const double *x, double *y, double alpha) +@{ + double *a0; + double *a1; + double *a2; + double *a3; + + __asm__ + ( + /* lots of asm here */ + "#n=%1 ap=%8=%12 lda=%13 x=%7=%10 y=%0=%2 alpha=%9 o16=%11\n" + "#a0=%3 a1=%4 a2=%5 a3=%6" + : + "+m" (*(double (*)[n]) y), + "+&r" (n), // 1 + "+b" (y), // 2 + "=b" (a0), // 3 + "=&b" (a1), // 4 + "=&b" (a2), // 5 + "=&b" (a3) // 6 + : + "m" (*(const double (*)[n]) x), + "m" (*(const double (*)[]) ap), + "d" (alpha), // 9 + "r" (x), // 10 + "b" (16), // 11 + "3" (ap), // 12 + "4" (lda) // 13 + : + "cr0", + "vs32","vs33","vs34","vs35","vs36","vs37", + "vs40","vs41","vs42","vs43","vs44","vs45","vs46","vs47" + ); +@} +@end smallexample @anchor{GotoLabels} @subsubsection Goto Labels @@ -10699,6 +10921,7 @@ in the Cilk Plus language manual which can be found at @cindex built-in functions @findex __builtin_alloca @findex __builtin_alloca_with_align +@findex __builtin_alloca_with_align_and_max @findex __builtin_call_with_static_chain @findex __builtin_fpclassify @findex __builtin_isfinite @@ -11346,6 +11569,16 @@ an extension. @xref{Variable Length}, for details. @end deftypefn +@deftypefn {Built-in Function} void *__builtin_alloca_with_align_and_max (size_t size, size_t alignment, size_t max_size) +Similar to @code{__builtin_alloca_with_align} but takes an extra argument +specifying an upper bound for @var{size} in case its value cannot be computed +at compile time, for use by @option{-fstack-usage}, @option{-Wstack-usage} +and @option{-Walloca-larger-than}. @var{max_size} must be a constant integer +expression, it has no effect on code generation and no attempt is made to +check its compatibility with @var{size}. + +@end deftypefn + @deftypefn {Built-in Function} int __builtin_types_compatible_p (@var{type1}, @var{type2}) You can use the built-in function @code{__builtin_types_compatible_p} to @@ -12041,6 +12274,7 @@ instructions, but allow the compiler to schedule those calls. * PowerPC Built-in Functions:: * PowerPC AltiVec/VSX Built-in Functions:: * PowerPC Hardware Transactional Memory Built-in Functions:: +* PowerPC Atomic Memory Operation Functions:: * RX Built-in Functions:: * S/390 System z Built-in Functions:: * SH Built-in Functions:: @@ -19126,6 +19360,67 @@ while (1) @} @end smallexample +@node PowerPC Atomic Memory Operation Functions +@subsection PowerPC Atomic Memory Operation Functions +ISA 3.0 of the PowerPC added new atomic memory operation (amo) +instructions. GCC provides support for these instructions in 64-bit +environments. All of the functions are declared in the include file +@code{amo.h}. + +The functions supported are: + +@smallexample +#include + +uint32_t amo_lwat_add (uint32_t *, uint32_t); +uint32_t amo_lwat_xor (uint32_t *, uint32_t); +uint32_t amo_lwat_ior (uint32_t *, uint32_t); +uint32_t amo_lwat_and (uint32_t *, uint32_t); +uint32_t amo_lwat_umax (uint32_t *, uint32_t); +uint32_t amo_lwat_umin (uint32_t *, uint32_t); +uint32_t amo_lwat_swap (uint32_t *, uint32_t); + +int32_t amo_lwat_sadd (int32_t *, int32_t); +int32_t amo_lwat_smax (int32_t *, int32_t); +int32_t amo_lwat_smin (int32_t *, int32_t); +int32_t amo_lwat_sswap (int32_t *, int32_t); + +uint64_t amo_ldat_add (uint64_t *, uint64_t); +uint64_t amo_ldat_xor (uint64_t *, uint64_t); +uint64_t amo_ldat_ior (uint64_t *, uint64_t); +uint64_t amo_ldat_and (uint64_t *, uint64_t); +uint64_t amo_ldat_umax (uint64_t *, uint64_t); +uint64_t amo_ldat_umin (uint64_t *, uint64_t); +uint64_t amo_ldat_swap (uint64_t *, uint64_t); + +int64_t amo_ldat_sadd (int64_t *, int64_t); +int64_t amo_ldat_smax (int64_t *, int64_t); +int64_t amo_ldat_smin (int64_t *, int64_t); +int64_t amo_ldat_sswap (int64_t *, int64_t); + +void amo_stwat_add (uint32_t *, uint32_t); +void amo_stwat_xor (uint32_t *, uint32_t); +void amo_stwat_ior (uint32_t *, uint32_t); +void amo_stwat_and (uint32_t *, uint32_t); +void amo_stwat_umax (uint32_t *, uint32_t); +void amo_stwat_umin (uint32_t *, uint32_t); + +void amo_stwat_sadd (int32_t *, int32_t); +void amo_stwat_smax (int32_t *, int32_t); +void amo_stwat_smin (int32_t *, int32_t); + +void amo_stdat_add (uint64_t *, uint64_t); +void amo_stdat_xor (uint64_t *, uint64_t); +void amo_stdat_ior (uint64_t *, uint64_t); +void amo_stdat_and (uint64_t *, uint64_t); +void amo_stdat_umax (uint64_t *, uint64_t); +void amo_stdat_umin (uint64_t *, uint64_t); + +void amo_stdat_sadd (int64_t *, int64_t); +void amo_stdat_smax (int64_t *, int64_t); +void amo_stdat_smin (int64_t *, int64_t); +@end smallexample + @node RX Built-in Functions @subsection RX Built-in Functions GCC supports some of the RX instructions which cannot be expressed in diff --git a/gcc/doc/gimple.texi b/gcc/doc/gimple.texi index 635abd39b6e50..fa98800a675b9 100644 --- a/gcc/doc/gimple.texi +++ b/gcc/doc/gimple.texi @@ -1310,11 +1310,13 @@ operand is validated with @code{is_gimple_operand}). @end deftypefn -@deftypefn {GIMPLE function} gcall *gimple_build_call_from_tree (tree call_expr) -Build a @code{GIMPLE_CALL} from a @code{CALL_EXPR} node. The arguments and the -function are taken from the expression directly. This routine -assumes that @code{call_expr} is already in GIMPLE form. That is, its -operands are GIMPLE values and the function call needs no further +@deftypefn {GIMPLE function} gcall *gimple_build_call_from_tree (tree call_expr, @ +tree fnptrtype) +Build a @code{GIMPLE_CALL} from a @code{CALL_EXPR} node. The arguments +and the function are taken from the expression directly. The type of the +@code{GIMPLE_CALL} is set from the second parameter passed by a caller. +This routine assumes that @code{call_expr} is already in GIMPLE form. +That is, its operands are GIMPLE values and the function call needs no further simplification. All the call flags in @code{call_expr} are copied over to the new @code{GIMPLE_CALL}. @end deftypefn diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 84cc43a7355cf..7b1a697d5bbd5 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -461,6 +461,7 @@ Objective-C and Objective-C++ Dialects}. -fchkp-check-read -fchkp-check-write -fchkp-store-bounds @gol -fchkp-instrument-calls -fchkp-instrument-marked-only @gol -fchkp-use-wrappers -fchkp-flexible-struct-trailing-arrays@gol +-fcf-protection==@r{[}full@r{|}branch@r{|}return@r{|}none@r{]} @gol -fstack-protector -fstack-protector-all -fstack-protector-strong @gol -fstack-protector-explicit -fstack-check @gol -fstack-limit-register=@var{reg} -fstack-limit-symbol=@var{sym} @gol @@ -5201,7 +5202,7 @@ whether to issue a warning. Similarly to @option{-Wstringop-overflow=3} this setting of the option may result in warnings for benign code. @end table -@item -Wsuggest-attribute=@r{[}pure@r{|}const@r{|}noreturn@r{|}format@r{]} +@item -Wsuggest-attribute=@r{[}pure@r{|}const@r{|}noreturn@r{|}format@r{|}cold@r{]} @opindex Wsuggest-attribute= @opindex Wno-suggest-attribute= Warn for cases where adding an attribute may be beneficial. The @@ -5253,6 +5254,15 @@ might be appropriate for any function that calls a function like @code{vprintf} or @code{vscanf}, but this might not always be the case, and some functions for which @code{format} attributes are appropriate may not be detected. + +@item -Wsuggest-attribute=cold +@opindex Wsuggest-attribute=cold +@opindex Wno-suggest-attribute=cold + +Warn about functions that might be candidates for @code{cold} attribute. This +is based on static detection and generally will only warn about functions which +always leads to a call to another @code{cold} function such as wrappers of +C++ @code{throw} or fatal error reporting functions leading to @code{abort}. @end table @item -Wsuggest-final-types @@ -5393,6 +5403,11 @@ pointers. This warning level may give a larger number of false positives and is deactivated by default. @end table +@item -Wattribute-alias +Warn about declarations using the @code{alias} and similar attributes whose +target is incompatible with the type of the alias. @xref{Function Attributes, +,Declaring Attributes of Functions}. + @item -Wbool-compare @opindex Wno-bool-compare @opindex Wbool-compare @@ -7823,7 +7838,7 @@ Use @option{-fno-delete-null-pointer-checks} to disable this optimization for programs that depend on that behavior. This option is enabled by default on most targets. On Nios II ELF, it -defaults to off. On AVR and CR16, this option is completely disabled. +defaults to off. On AVR, CR16, and MSP430, this option is completely disabled. Passes that use the dataflow information are enabled independently at different optimization levels. @@ -9698,18 +9713,26 @@ file if the target supports arbitrary sections. The name of the function or the name of the data item determines the section's name in the output file. -Use these options on systems where the linker can perform optimizations -to improve locality of reference in the instruction space. Most systems -using the ELF object format and SPARC processors running Solaris 2 have -linkers with such optimizations. AIX may have these optimizations in -the future. - -Only use these options when there are significant benefits from doing -so. When you specify these options, the assembler and linker -create larger object and executable files and are also slower. -You cannot use @command{gprof} on all systems if you -specify this option, and you may have problems with debugging if -you specify both this option and @option{-g}. +Use these options on systems where the linker can perform optimizations to +improve locality of reference in the instruction space. Most systems using the +ELF object format have linkers with such optimizations. On AIX, the linker +rearranges sections (CSECTs) based on the call graph. The performance impact +varies. + +Together with a linker garbage collection (linker @option{--gc-sections} +option) these options may lead to smaller statically-linked executables (after +stripping). + +On ELF/DWARF systems these options do not degenerate the quality of the debug +information. There could be issues with other object files/debug info formats. + +Only use these options when there are significant benefits from doing so. When +you specify these options, the assembler and linker create larger object and +executable files and are also slower. These options affect code generation. +They prevent optimizations by the compiler and assembler using relative +locations inside a translation unit since the locations are unknown until +link time. An example of such an optimization is relaxing calls to short call +instructions. @item -fbranch-target-load-optimize @opindex fbranch-target-load-optimize @@ -11127,6 +11150,15 @@ to verify the referenced object has the correct dynamic type. This option enables instrumentation of pointer arithmetics. If the pointer arithmetics overflows, a run-time error is issued. +@item -fsanitize=builtin +@opindex fsanitize=builtin + +This option enables instrumentation of arguments to selected builtin +functions. If an invalid value is passed to such arguments, a run-time +error is issued. E.g.@ passing 0 as the argument to @code{__builtin_ctz} +or @code{__builtin_clz} invokes undefined behavior and is diagnosed +by this option. + @end table While @option{-ftrapv} causes traps for signed overflows to be emitted, @@ -11387,6 +11419,28 @@ is used to link a program, the GCC driver automatically links against @file{libmpxwrappers}. See also @option{-static-libmpxwrappers}. Enabled by default. +@item -fcf-protection==@r{[}full@r{|}branch@r{|}return@r{|}none@r{]} +@opindex fcf-protection +Enable code instrumentation of control-flow transfers to increase +program security by checking that target addresses of control-flow +transfer instructions (such as indirect function call, function return, +indirect jump) are valid. This prevents diverting the flow of control +to an unexpected target. This is intended to protect against such +threats as Return-oriented Programming (ROP), and similarly +call/jmp-oriented programming (COP/JOP). + +The value @code{branch} tells the compiler to implement checking of +validity of control-flow transfer at the point of indirect branch +instructions, i.e. call/jmp instructions. The value @code{return} +implements checking of validity at the point of returning from a +function. The value @code{full} is an alias for specifying both +@code{branch} and @code{return}. The value @code{none} turns off +instrumentation. + +You can also use the @code{nocf_check} attribute to identify +which functions and calls should be skipped from instrumentation +(@pxref{Function Attributes}). + @item -fstack-protector @opindex fstack-protector Emit extra code to check for buffer overflows, such as stack smashing @@ -14368,6 +14422,8 @@ Enable FP16 extension. This also enables floating-point instructions. Enable the RcPc extension. This does not change code generation from GCC, but is passed on to the assembler, enabling inline asm statements to use instructions from the RcPc extension. +@item dotprod +Enable the Dot Product extension. This also enables Advanced SIMD instructions. @end table @@ -15608,6 +15664,9 @@ The ARMv8.1 Advanced SIMD and floating-point instructions. The cryptographic instructions. This also enables the Advanced SIMD and floating-point instructions. +@item +dotprod +Enable the Dot Product extension. This also enables Advanced SIMD instructions. + @item +nocrypto Disable the cryptographic extension. @@ -15794,6 +15853,9 @@ Permissible names for this option are the same as those for The following extension options are common to the listed CPUs: @table @samp +@item +nodsp +Disable the DSP instructions on @samp{cortex-m33}. + @item +nofp Disables the floating-point instructions on @samp{arm9e}, @samp{arm946e-s}, @samp{arm966e-s}, @samp{arm968e-s}, @samp{arm10e}, diff --git a/gcc/doc/md.texi b/gcc/doc/md.texi index 14aab9474bc21..c4c113850fe1f 100644 --- a/gcc/doc/md.texi +++ b/gcc/doc/md.texi @@ -6734,6 +6734,15 @@ scheduler and other passes from moving instructions and using register equivalences across the boundary defined by the blockage insn. This needs to be an UNSPEC_VOLATILE pattern or a volatile ASM. +@cindex @code{memory_blockage} instruction pattern +@item @samp{memory_blockage} +This pattern, if defined, represents a compiler memory barrier, and will be +placed at points across which RTL passes may not propagate memory accesses. +This instruction needs to read and write volatile BLKmode memory. It does +not need to generate any machine instruction. If this pattern is not defined, +the compiler falls back to emitting an instruction corresponding +to @code{asm volatile ("" ::: "memory")}. + @cindex @code{memory_barrier} instruction pattern @item @samp{memory_barrier} If the target memory model is not fully synchronous, then this pattern diff --git a/gcc/doc/rtl.texi b/gcc/doc/rtl.texi index 3b2b24748b885..8b47416003054 100644 --- a/gcc/doc/rtl.texi +++ b/gcc/doc/rtl.texi @@ -4040,6 +4040,22 @@ is used in place of the actual insn pattern. This is done in cases where the pattern is either complex or misleading. @end table +The note @code{REG_CALL_NOCF_CHECK} is used in conjunction with the +@option{-fcf-protection=branch} option. The note is set if a +@code{nocf_check} attribute is specified for a function type or a +pointer to function type. The note is stored in the @code{REG_NOTES} +field of an insn. + +@table @code +@findex REG_CALL_NOCF_CHECK +@item REG_CALL_NOCF_CHECK +Users have control through the @code{nocf_check} attribute to identify +which calls to a function should be skipped from control-flow instrumentation +when the option @option{-fcf-protection=branch} is specified. The compiler +puts a @code{REG_CALL_NOCF_CHECK} note on each @code{CALL_INSN} instruction +that has a function type marked with a @code{nocf_check} attribute. +@end table + For convenience, the machine mode in an @code{insn_list} or @code{expr_list} is printed using these symbolic codes in debugging dumps. diff --git a/gcc/doc/sourcebuild.texi b/gcc/doc/sourcebuild.texi index a2f0429119499..7d6d4a381a63d 100644 --- a/gcc/doc/sourcebuild.texi +++ b/gcc/doc/sourcebuild.texi @@ -2358,6 +2358,9 @@ Skip the test if the target does not support the @code{-fstack-check} option. If @var{check} is @code{""}, support for @code{-fstack-check} is checked, for @code{-fstack-check=("@var{check}")} otherwise. +@item dg-require-stack-size @var{size} +Skip the test if the target does not support a stack size of @var{size}. + @item dg-require-visibility @var{vis} Skip the test if the target does not support the @code{visibility} attribute. If @var{vis} is @code{""}, support for @code{visibility("hidden")} is diff --git a/gcc/doc/tm.texi b/gcc/doc/tm.texi index 8f503e1904ecb..03772177d0dee 100644 --- a/gcc/doc/tm.texi +++ b/gcc/doc/tm.texi @@ -6652,6 +6652,18 @@ should probably only be given to addresses with different numbers of registers on machines with lots of registers. @end deftypefn +@deftypefn {Target Hook} int TARGET_INSN_COST (rtx_insn *@var{insn}, bool @var{speed}) +This target hook describes the relative costs of RTL instructions. + +In implementing this hook, you can use the construct +@code{COSTS_N_INSNS (@var{n})} to specify a cost equal to @var{n} fast +instructions. + +When optimizing for code size, i.e.@: when @code{speed} is +false, this target hook should be used to estimate the relative +size cost of an expression, again relative to @code{COSTS_N_INSNS}. +@end deftypefn + @deftypefn {Target Hook} {unsigned int} TARGET_MAX_NOCE_IFCVT_SEQ_COST (edge @var{e}) This hook returns a value in the same units as @code{TARGET_RTX_COSTS}, giving the maximum acceptable cost for a sequence generated by the RTL diff --git a/gcc/doc/tm.texi.in b/gcc/doc/tm.texi.in index 15b3f1f67715a..d2cf68fee0086 100644 --- a/gcc/doc/tm.texi.in +++ b/gcc/doc/tm.texi.in @@ -4600,6 +4600,8 @@ Define this macro if a non-short-circuit operation produced by @hook TARGET_ADDRESS_COST +@hook TARGET_INSN_COST + @hook TARGET_MAX_NOCE_IFCVT_SEQ_COST @hook TARGET_NOCE_CONVERSION_PROFITABLE_P diff --git a/gcc/dse.c b/gcc/dse.c index cff3ac47356fb..563ca9f56f3f2 100644 --- a/gcc/dse.c +++ b/gcc/dse.c @@ -1653,7 +1653,7 @@ find_shift_sequence (int access_size, cost = 0; for (insn = shift_seq; insn != NULL_RTX; insn = NEXT_INSN (insn)) if (INSN_P (insn)) - cost += insn_rtx_cost (PATTERN (insn), speed); + cost += insn_cost (insn, speed); /* The computation up to here is essentially independent of the arguments and could be precomputed. It may diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c index e97ceb61b46ed..ec9b40602b1a4 100644 --- a/gcc/dwarf2out.c +++ b/gcc/dwarf2out.c @@ -5364,6 +5364,16 @@ splice_child_die (dw_die_ref parent, dw_die_ref child) reparent_child (child, parent); } +/* Create and return a new die with TAG_VALUE as tag. */ + +static inline dw_die_ref +new_die_raw (enum dwarf_tag tag_value) +{ + dw_die_ref die = ggc_cleared_alloc (); + die->die_tag = tag_value; + return die; +} + /* Create and return a new die with a parent of PARENT_DIE. If PARENT_DIE is NULL, the new DIE is placed in limbo and an associated tree T must be supplied to determine parenthood @@ -5372,9 +5382,7 @@ splice_child_die (dw_die_ref parent, dw_die_ref child) static inline dw_die_ref new_die (enum dwarf_tag tag_value, dw_die_ref parent_die, tree t) { - dw_die_ref die = ggc_cleared_alloc (); - - die->die_tag = tag_value; + dw_die_ref die = new_die_raw (tag_value); if (parent_die != NULL) add_child_die (parent_die, die); @@ -5568,8 +5576,7 @@ add_AT_external_die_ref (dw_die_ref die, enum dwarf_attribute attr_kind, { /* Create a fake DIE that contains the reference. Don't use new_die because we don't want to end up in the limbo list. */ - dw_die_ref ref = ggc_cleared_alloc (); - ref->die_tag = die->die_tag; + dw_die_ref ref = new_die_raw (die->die_tag); ref->die_id.die_symbol = IDENTIFIER_POINTER (get_identifier (symbol)); ref->die_offset = offset; ref->with_offset = 1; @@ -7712,13 +7719,10 @@ should_move_die_to_comdat (dw_die_ref die) static dw_die_ref clone_die (dw_die_ref die) { - dw_die_ref clone; + dw_die_ref clone = new_die_raw (die->die_tag); dw_attr_node *a; unsigned ix; - clone = ggc_cleared_alloc (); - clone->die_tag = die->die_tag; - FOR_EACH_VEC_SAFE_ELT (die->die_attr, ix, a) add_dwarf_attr (clone, a); @@ -7762,8 +7766,7 @@ clone_as_declaration (dw_die_ref die) return clone; } - clone = ggc_cleared_alloc (); - clone->die_tag = die->die_tag; + clone = new_die_raw (die->die_tag); FOR_EACH_VEC_SAFE_ELT (die->die_attr, ix, a) { @@ -12090,9 +12093,6 @@ base_type_die (tree type, bool reverse) struct fixed_point_type_info fpt_info; tree type_bias = NULL_TREE; - if (TREE_CODE (type) == ERROR_MARK || TREE_CODE (type) == VOID_TYPE) - return 0; - /* If this is a subtype that should not be emitted as a subrange type, use the base type. See subrange_type_for_debug_p. */ if (TREE_CODE (type) == INTEGER_TYPE && TREE_TYPE (type) != NULL_TREE) @@ -12185,7 +12185,7 @@ base_type_die (tree type, bool reverse) gcc_unreachable (); } - base_type_result = new_die (DW_TAG_base_type, comp_unit_die (), type); + base_type_result = new_die_raw (DW_TAG_base_type); add_AT_unsigned (base_type_result, DW_AT_byte_size, int_size_in_bytes (type)); @@ -12241,8 +12241,6 @@ base_type_die (tree type, bool reverse) | dw_scalar_form_reference, NULL); - add_pubtype (type, base_type_result); - return base_type_result; } @@ -12270,8 +12268,6 @@ is_base_type (tree type) { switch (TREE_CODE (type)) { - case ERROR_MARK: - case VOID_TYPE: case INTEGER_TYPE: case REAL_TYPE: case FIXED_POINT_TYPE: @@ -12280,6 +12276,7 @@ is_base_type (tree type) case POINTER_BOUNDS_TYPE: return 1; + case VOID_TYPE: case ARRAY_TYPE: case RECORD_TYPE: case UNION_TYPE: @@ -12485,6 +12482,8 @@ modified_type_die (tree type, int cv_quals, bool reverse, /* Only these cv-qualifiers are currently handled. */ const int cv_qual_mask = (TYPE_QUAL_CONST | TYPE_QUAL_VOLATILE | TYPE_QUAL_RESTRICT | TYPE_QUAL_ATOMIC); + const bool reverse_base_type + = need_endianity_attribute_p (reverse) && is_base_type (type); if (code == ERROR_MARK) return NULL; @@ -12535,29 +12534,33 @@ modified_type_die (tree type, int cv_quals, bool reverse, qualified_type = size_type_node; } - /* If we do, then we can just use its DIE, if it exists. */ if (qualified_type) { mod_type_die = lookup_type_die (qualified_type); - /* DW_AT_endianity doesn't come from a qualifier on the type. */ + /* DW_AT_endianity doesn't come from a qualifier on the type, so it is + dealt with specially: the DIE with the attribute, if it exists, is + placed immediately after the regular DIE for the same base type. */ if (mod_type_die - && (!need_endianity_attribute_p (reverse) - || !is_base_type (type) - || get_AT_unsigned (mod_type_die, DW_AT_endianity))) + && (!reverse_base_type + || ((mod_type_die = mod_type_die->die_sib) != NULL + && get_AT_unsigned (mod_type_die, DW_AT_endianity)))) return mod_type_die; } name = qualified_type ? TYPE_NAME (qualified_type) : NULL; /* Handle C typedef types. */ - if (name && TREE_CODE (name) == TYPE_DECL && DECL_ORIGINAL_TYPE (name) + if (name + && TREE_CODE (name) == TYPE_DECL + && DECL_ORIGINAL_TYPE (name) && !DECL_ARTIFICIAL (name)) { tree dtype = TREE_TYPE (name); - if (qualified_type == dtype) + /* Skip the typedef for base types with DW_AT_endianity, no big deal. */ + if (qualified_type == dtype && !reverse_base_type) { tree origin = decl_ultimate_origin (name); @@ -12670,8 +12673,7 @@ modified_type_die (tree type, int cv_quals, bool reverse, } if (first) { - d = ggc_cleared_alloc (); - d->die_tag = dwarf_qual_info[i].t; + d = new_die_raw (dwarf_qual_info[i].t); add_child_die_after (mod_scope, d, last); last = d; } @@ -12729,7 +12731,21 @@ modified_type_die (tree type, int cv_quals, bool reverse, item_type = TREE_TYPE (type); } else if (is_base_type (type)) - mod_type_die = base_type_die (type, reverse); + { + mod_type_die = base_type_die (type, reverse); + + /* The DIE with DW_AT_endianity is placed right after the naked DIE. */ + if (reverse_base_type) + { + dw_die_ref after_die + = modified_type_die (type, cv_quals, false, context_die); + add_child_die_after (comp_unit_die (), mod_type_die, after_die); + } + else + add_child_die (comp_unit_die (), mod_type_die); + + add_pubtype (type, mod_type_die); + } else { gen_type_die (type, context_die); @@ -12791,7 +12807,7 @@ modified_type_die (tree type, int cv_quals, bool reverse, name ? IDENTIFIER_POINTER (name) : "__unknown__"); } - if (qualified_type) + if (qualified_type && !reverse_base_type) equate_type_number_to_die (qualified_type, mod_type_die); if (item_type) @@ -19077,12 +19093,11 @@ rtl_for_decl_location (tree decl) else if (VAR_P (decl) && rtl && MEM_P (rtl) - && GET_MODE (rtl) != TYPE_MODE (TREE_TYPE (decl)) - && BYTES_BIG_ENDIAN) + && GET_MODE (rtl) != TYPE_MODE (TREE_TYPE (decl))) { machine_mode addr_mode = get_address_mode (rtl); - int rsize = GET_MODE_SIZE (GET_MODE (rtl)); - int dsize = GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (decl))); + HOST_WIDE_INT offset = byte_lowpart_offset (TYPE_MODE (TREE_TYPE (decl)), + GET_MODE (rtl)); /* If a variable is declared "register" yet is smaller than a register, then if we store the variable to memory, it @@ -19090,10 +19105,9 @@ rtl_for_decl_location (tree decl) fact we are not. We need to adjust the offset of the storage location to reflect the actual value's bytes, else gdb will not be able to display it. */ - if (rsize > dsize) + if (offset != 0) rtl = gen_rtx_MEM (TYPE_MODE (TREE_TYPE (decl)), - plus_constant (addr_mode, XEXP (rtl, 0), - rsize - dsize)); + plus_constant (addr_mode, XEXP (rtl, 0), offset)); } /* A variable with no DECL_RTL but a DECL_INITIAL is a compile-time constant, @@ -19820,7 +19834,7 @@ add_scalar_info (dw_die_ref die, enum dwarf_attribute attr, tree value, the precision of its type. The precision and signedness of the type will be necessary to re-interpret it unambiguously. */ - add_AT_wide (die, attr, value); + add_AT_wide (die, attr, wi::to_wide (value)); return; } @@ -20502,8 +20516,7 @@ dwarf2out_vms_debug_main_pointer (void) dw_die_ref die; /* Allocate the VMS debug main subprogram die. */ - die = ggc_cleared_alloc (); - die->die_tag = DW_TAG_subprogram; + die = new_die_raw (DW_TAG_subprogram); add_name_attribute (die, VMS_DEBUG_MAIN_POINTER); ASM_GENERATE_INTERNAL_LABEL (label, PROLOGUE_END_LABEL, current_function_funcdef_no); @@ -21236,7 +21249,7 @@ gen_enumeration_type_die (tree type, dw_die_ref context_die) /* Enumeration constants may be wider than HOST_WIDE_INT. Handle that here. TODO: This should be re-worked to use correct signed/unsigned double tags for all cases. */ - add_AT_wide (enum_die, DW_AT_const_value, value); + add_AT_wide (enum_die, DW_AT_const_value, wi::to_wide (value)); } add_gnat_descriptive_type_attribute (type_die, type, context_die); diff --git a/gcc/emit-rtl.c b/gcc/emit-rtl.c index e790cbcb6ff09..d91988e902d45 100644 --- a/gcc/emit-rtl.c +++ b/gcc/emit-rtl.c @@ -3789,6 +3789,7 @@ try_split (rtx pat, rtx_insn *trial, int last) case REG_NORETURN: case REG_SETJMP: case REG_TM: + case REG_CALL_NOCF_CHECK: for (insn = insn_last; insn != NULL_RTX; insn = PREV_INSN (insn)) { if (CALL_P (insn)) diff --git a/gcc/except.c b/gcc/except.c index 10b5a7c7cd0f1..041f89a55e5bb 100644 --- a/gcc/except.c +++ b/gcc/except.c @@ -147,7 +147,9 @@ along with GCC; see the file COPYING3. If not see static GTY(()) int call_site_base; -static GTY (()) hash_map *type_to_runtime_map; +static GTY(()) hash_map *type_to_runtime_map; + +static GTY(()) tree setjmp_fn; /* Describe the SjLj_Function_Context structure. */ static GTY(()) tree sjlj_fc_type_node; @@ -331,6 +333,16 @@ init_eh (void) sjlj_fc_jbuf_ofs = (tree_to_uhwi (DECL_FIELD_OFFSET (f_jbuf)) + tree_to_uhwi (DECL_FIELD_BIT_OFFSET (f_jbuf)) / BITS_PER_UNIT); + +#ifdef DONT_USE_BUILTIN_SETJMP + tmp = build_function_type_list (integer_type_node, TREE_TYPE (f_jbuf), + NULL); + setjmp_fn = build_decl (BUILTINS_LOCATION, FUNCTION_DECL, + get_identifier ("setjmp"), tmp); + TREE_PUBLIC (setjmp_fn) = 1; + DECL_EXTERNAL (setjmp_fn) = 1; + DECL_ASSEMBLER_NAME (setjmp_fn); +#endif } } @@ -1176,8 +1188,7 @@ sjlj_emit_function_enter (rtx_code_label *dispatch_label) addr = convert_memory_address (ptr_mode, addr); tree addr_tree = make_tree (ptr_type_node, addr); - tree fn = builtin_decl_implicit (BUILT_IN_SETJMP); - tree call_expr = build_call_expr (fn, 1, addr_tree); + tree call_expr = build_call_expr (setjmp_fn, 1, addr_tree); rtx x = expand_call (call_expr, NULL_RTX, false); emit_cmp_and_jump_insns (x, const0_rtx, NE, 0, @@ -1209,6 +1220,28 @@ sjlj_emit_function_enter (rtx_code_label *dispatch_label) fn_begin_outside_block = false; } +#ifdef DONT_USE_BUILTIN_SETJMP + if (dispatch_label) + { + /* The sequence contains a branch in the middle so we need to force + the creation of a new basic block by means of BB_SUPERBLOCK. */ + if (fn_begin_outside_block) + { + basic_block bb + = split_edge (single_succ_edge (ENTRY_BLOCK_PTR_FOR_FN (cfun))); + if (JUMP_P (BB_END (bb))) + emit_insn_before (seq, BB_END (bb)); + else + emit_insn_after (seq, BB_END (bb)); + } + else + emit_insn_after (seq, fn_begin); + + single_succ (ENTRY_BLOCK_PTR_FOR_FN (cfun))->flags |= BB_SUPERBLOCK; + return; + } +#endif + if (fn_begin_outside_block) insert_insn_on_edge (seq, single_succ_edge (ENTRY_BLOCK_PTR_FOR_FN (cfun))); else diff --git a/gcc/explow.c b/gcc/explow.c index 6131d1810cba1..662865d2808be 100644 --- a/gcc/explow.c +++ b/gcc/explow.c @@ -1322,6 +1322,9 @@ get_stack_check_protect (void) REQUIRED_ALIGN is the alignment (in bits) required for the region of memory. + MAX_SIZE is an upper bound for SIZE, if SIZE is not constant, or -1 if + no such upper bound is known. + If CANNOT_ACCUMULATE is set to TRUE, the caller guarantees that the stack space allocated by the generated code cannot be added with itself in the course of the execution of the function. It is always safe to @@ -1331,7 +1334,9 @@ get_stack_check_protect (void) rtx allocate_dynamic_stack_space (rtx size, unsigned size_align, - unsigned required_align, bool cannot_accumulate) + unsigned required_align, + HOST_WIDE_INT max_size, + bool cannot_accumulate) { HOST_WIDE_INT stack_usage_size = -1; rtx_code_label *final_label; @@ -1370,8 +1375,12 @@ allocate_dynamic_stack_space (rtx size, unsigned size_align, } } - /* If the size is not constant, we can't say anything. */ - if (stack_usage_size == -1) + /* If the size is not constant, try the maximum size. */ + if (stack_usage_size < 0) + stack_usage_size = max_size; + + /* If the size is still not constant, we can't say anything. */ + if (stack_usage_size < 0) { current_function_has_unbounded_dynamic_stack_size = 1; stack_usage_size = 0; diff --git a/gcc/explow.h b/gcc/explow.h index b85c051e8ce90..8eca20b2fd28f 100644 --- a/gcc/explow.h +++ b/gcc/explow.h @@ -94,7 +94,8 @@ extern void update_nonlocal_goto_save_area (void); extern void record_new_stack_level (void); /* Allocate some space on the stack dynamically and return its address. */ -extern rtx allocate_dynamic_stack_space (rtx, unsigned, unsigned, bool); +extern rtx allocate_dynamic_stack_space (rtx, unsigned, unsigned, + HOST_WIDE_INT, bool); /* Calculate the necessary size of a constant dynamic stack allocation from the size of the variable area. */ diff --git a/gcc/expr.c b/gcc/expr.c index 2f8432d92ccac..1bba9330cd337 100644 --- a/gcc/expr.c +++ b/gcc/expr.c @@ -6749,8 +6749,11 @@ store_field (rtx target, HOST_WIDE_INT bitsize, HOST_WIDE_INT bitpos, return const0_rtx; /* If we have nothing to store, do nothing unless the expression has - side-effects. */ - if (bitsize == 0) + side-effects. Don't do that for zero sized addressable lhs of + calls. */ + if (bitsize == 0 + && (!TREE_ADDRESSABLE (TREE_TYPE (exp)) + || TREE_CODE (exp) != CALL_EXPR)) return expand_expr (exp, const0_rtx, VOIDmode, EXPAND_NORMAL); if (GET_CODE (target) == CONCAT) @@ -7153,7 +7156,7 @@ get_inner_reference (tree exp, HOST_WIDE_INT *pbitsize, if (wi::neg_p (bit_offset) || !wi::fits_shwi_p (bit_offset)) { offset_int mask = wi::mask (LOG2_BITS_PER_UNIT, false); - offset_int tem = bit_offset.and_not (mask); + offset_int tem = wi::bit_and_not (bit_offset, mask); /* TEM is the bitpos rounded to BITS_PER_UNIT towards -Inf. Subtract it to BIT_OFFSET and add it (scaled) to OFFSET. */ bit_offset -= tem; @@ -9909,24 +9912,43 @@ expand_expr_real_1 (tree exp, rtx target, machine_mode tmode, && GET_MODE (decl_rtl) != dmode) { machine_mode pmode; + bool always_initialized_rtx; /* Get the signedness to be used for this variable. Ensure we get the same mode we got when the variable was declared. */ if (code != SSA_NAME) - pmode = promote_decl_mode (exp, &unsignedp); + { + pmode = promote_decl_mode (exp, &unsignedp); + always_initialized_rtx = true; + } else if ((g = SSA_NAME_DEF_STMT (ssa_name)) && gimple_code (g) == GIMPLE_CALL && !gimple_call_internal_p (g)) - pmode = promote_function_mode (type, mode, &unsignedp, - gimple_call_fntype (g), - 2); + { + pmode = promote_function_mode (type, mode, &unsignedp, + gimple_call_fntype (g), 2); + always_initialized_rtx + = always_initialized_rtx_for_ssa_name_p (ssa_name); + } else - pmode = promote_ssa_mode (ssa_name, &unsignedp); + { + pmode = promote_ssa_mode (ssa_name, &unsignedp); + always_initialized_rtx + = always_initialized_rtx_for_ssa_name_p (ssa_name); + } + gcc_assert (GET_MODE (decl_rtl) == pmode); temp = gen_lowpart_SUBREG (mode, decl_rtl); - SUBREG_PROMOTED_VAR_P (temp) = 1; - SUBREG_PROMOTED_SET (temp, unsignedp); + + /* We cannot assume anything about an existing extension if the + register may contain uninitialized bits. */ + if (always_initialized_rtx) + { + SUBREG_PROMOTED_VAR_P (temp) = 1; + SUBREG_PROMOTED_SET (temp, unsignedp); + } + return temp; } @@ -11769,7 +11791,7 @@ const_vector_from_tree (tree exp) RTVEC_ELT (v, i) = CONST_FIXED_FROM_FIXED_VALUE (TREE_FIXED_CST (elt), inner); else - RTVEC_ELT (v, i) = immed_wide_int_const (elt, inner); + RTVEC_ELT (v, i) = immed_wide_int_const (wi::to_wide (elt), inner); } return gen_rtx_CONST_VECTOR (mode, v); diff --git a/gcc/file-find.c b/gcc/file-find.c index b072a4993d76e..b5a1fe8494e88 100644 --- a/gcc/file-find.c +++ b/gcc/file-find.c @@ -208,38 +208,3 @@ prefix_from_string (const char *p, struct path_prefix *pprefix) } free (nstore); } - -void -remove_prefix (const char *prefix, struct path_prefix *pprefix) -{ - struct prefix_list *remove, **prev, **remove_prev = NULL; - int max_len = 0; - - if (pprefix->plist) - { - prev = &pprefix->plist; - for (struct prefix_list *pl = pprefix->plist; pl->next; pl = pl->next) - { - if (strcmp (prefix, pl->prefix) == 0) - { - remove = pl; - remove_prev = prev; - continue; - } - - int l = strlen (pl->prefix); - if (l > max_len) - max_len = l; - - prev = &pl; - } - - if (remove_prev) - { - *remove_prev = remove->next; - free (remove); - } - - pprefix->max_len = max_len; - } -} diff --git a/gcc/file-find.h b/gcc/file-find.h index 8f49a3af273e9..407feba26e745 100644 --- a/gcc/file-find.h +++ b/gcc/file-find.h @@ -41,7 +41,6 @@ extern void find_file_set_debug (bool); extern char *find_a_file (struct path_prefix *, const char *, int); extern void add_prefix (struct path_prefix *, const char *); extern void add_prefix_begin (struct path_prefix *, const char *); -extern void remove_prefix (const char *prefix, struct path_prefix *); extern void prefix_from_env (const char *, struct path_prefix *); extern void prefix_from_string (const char *, struct path_prefix *); diff --git a/gcc/final.c b/gcc/final.c index eff2ee6c4966e..0ddf7793209bc 100644 --- a/gcc/final.c +++ b/gcc/final.c @@ -3199,14 +3199,7 @@ alter_subreg (rtx *xp, bool final_p) /* For paradoxical subregs on big-endian machines, SUBREG_BYTE contains 0 instead of the proper offset. See simplify_subreg. */ if (paradoxical_subreg_p (x)) - { - int difference = GET_MODE_SIZE (GET_MODE (y)) - - GET_MODE_SIZE (GET_MODE (x)); - if (WORDS_BIG_ENDIAN) - offset += (difference / UNITS_PER_WORD) * UNITS_PER_WORD; - if (BYTES_BIG_ENDIAN) - offset += difference % UNITS_PER_WORD; - } + offset = byte_lowpart_offset (GET_MODE (x), GET_MODE (y)); if (final_p) *xp = adjust_address (y, GET_MODE (x), offset); diff --git a/gcc/flag-types.h b/gcc/flag-types.h index 1f439d35b07b6..2b2302963f051 100644 --- a/gcc/flag-types.h +++ b/gcc/flag-types.h @@ -246,6 +246,7 @@ enum sanitize_code { SANITIZE_VPTR = 1UL << 22, SANITIZE_BOUNDS_STRICT = 1UL << 23, SANITIZE_POINTER_OVERFLOW = 1UL << 24, + SANITIZE_BUILTIN = 1UL << 25, SANITIZE_SHIFT = SANITIZE_SHIFT_BASE | SANITIZE_SHIFT_EXPONENT, SANITIZE_UNDEFINED = SANITIZE_SHIFT | SANITIZE_DIVIDE | SANITIZE_UNREACHABLE | SANITIZE_VLA | SANITIZE_NULL | SANITIZE_RETURN @@ -254,7 +255,7 @@ enum sanitize_code { | SANITIZE_NONNULL_ATTRIBUTE | SANITIZE_RETURNS_NONNULL_ATTRIBUTE | SANITIZE_OBJECT_SIZE | SANITIZE_VPTR - | SANITIZE_POINTER_OVERFLOW, + | SANITIZE_POINTER_OVERFLOW | SANITIZE_BUILTIN, SANITIZE_UNDEFINED_NONDEFAULT = SANITIZE_FLOAT_DIVIDE | SANITIZE_FLOAT_CAST | SANITIZE_BOUNDS_STRICT }; @@ -325,4 +326,13 @@ enum gfc_convert }; +/* Control-Flow Protection values. */ +enum cf_protection_level +{ + CF_NONE = 0, + CF_BRANCH = 1 << 0, + CF_RETURN = 1 << 1, + CF_FULL = CF_BRANCH | CF_RETURN, + CF_SET = 1 << 2 +}; #endif /* ! GCC_FLAG_TYPES_H */ diff --git a/gcc/fold-const-call.c b/gcc/fold-const-call.c index 71f0b52468040..98ac09117434d 100644 --- a/gcc/fold-const-call.c +++ b/gcc/fold-const-call.c @@ -60,7 +60,8 @@ host_size_t_cst_p (tree t, size_t *size_out) { if (types_compatible_p (size_type_node, TREE_TYPE (t)) && integer_cst_p (t) - && wi::min_precision (t, UNSIGNED) <= sizeof (size_t) * CHAR_BIT) + && (wi::min_precision (wi::to_wide (t), UNSIGNED) + <= sizeof (size_t) * CHAR_BIT)) { *size_out = tree_to_uhwi (t); return true; @@ -1041,8 +1042,8 @@ fold_const_call_1 (combined_fn fn, tree type, tree arg) if (SCALAR_INT_MODE_P (mode)) { wide_int result; - if (fold_const_call_ss (&result, fn, arg, TYPE_PRECISION (type), - TREE_TYPE (arg))) + if (fold_const_call_ss (&result, fn, wi::to_wide (arg), + TYPE_PRECISION (type), TREE_TYPE (arg))) return wide_int_to_tree (type, result); } return NULL_TREE; @@ -1322,7 +1323,8 @@ fold_const_call_1 (combined_fn fn, tree type, tree arg0, tree arg1) /* real, int -> real. */ REAL_VALUE_TYPE result; if (fold_const_call_sss (&result, fn, TREE_REAL_CST_PTR (arg0), - arg1, REAL_MODE_FORMAT (mode))) + wi::to_wide (arg1), + REAL_MODE_FORMAT (mode))) return build_real (type, result); } return NULL_TREE; @@ -1336,7 +1338,7 @@ fold_const_call_1 (combined_fn fn, tree type, tree arg0, tree arg1) { /* int, real -> real. */ REAL_VALUE_TYPE result; - if (fold_const_call_sss (&result, fn, arg0, + if (fold_const_call_sss (&result, fn, wi::to_wide (arg0), TREE_REAL_CST_PTR (arg1), REAL_MODE_FORMAT (mode))) return build_real (type, result); diff --git a/gcc/fold-const.c b/gcc/fold-const.c index d8dc56cea6b7d..c16959b84ace9 100644 --- a/gcc/fold-const.c +++ b/gcc/fold-const.c @@ -360,7 +360,7 @@ may_negate_without_overflow_p (const_tree t) if (TYPE_UNSIGNED (type)) return false; - return !wi::only_sign_bit_p (t); + return !wi::only_sign_bit_p (wi::to_wide (t)); } /* Determine whether an expression T can be cheaply negated using @@ -452,9 +452,11 @@ negate_expr_p (tree t) if (INTEGRAL_TYPE_P (TREE_TYPE (t)) && ! TYPE_OVERFLOW_WRAPS (TREE_TYPE (t)) && ! ((TREE_CODE (TREE_OPERAND (t, 0)) == INTEGER_CST - && wi::popcount (wi::abs (TREE_OPERAND (t, 0))) != 1) + && (wi::popcount + (wi::abs (wi::to_wide (TREE_OPERAND (t, 0))))) != 1) || (TREE_CODE (TREE_OPERAND (t, 1)) == INTEGER_CST - && wi::popcount (wi::abs (TREE_OPERAND (t, 1))) != 1))) + && (wi::popcount + (wi::abs (wi::to_wide (TREE_OPERAND (t, 1))))) != 1))) break; /* Fall through. */ @@ -503,7 +505,7 @@ negate_expr_p (tree t) if (TREE_CODE (TREE_OPERAND (t, 1)) == INTEGER_CST) { tree op1 = TREE_OPERAND (t, 1); - if (wi::eq_p (op1, TYPE_PRECISION (type) - 1)) + if (wi::to_wide (op1) == TYPE_PRECISION (type) - 1) return true; } break; @@ -695,7 +697,7 @@ fold_negate_expr_1 (location_t loc, tree t) if (TREE_CODE (TREE_OPERAND (t, 1)) == INTEGER_CST) { tree op1 = TREE_OPERAND (t, 1); - if (wi::eq_p (op1, TYPE_PRECISION (type) - 1)) + if (wi::to_wide (op1) == TYPE_PRECISION (type) - 1) { tree ntype = TYPE_UNSIGNED (type) ? signed_type_for (type) @@ -959,20 +961,21 @@ int_binop_types_match_p (enum tree_code code, const_tree type1, const_tree type2 } -/* Combine two integer constants ARG1 and ARG2 under operation CODE +/* Combine two integer constants PARG1 and PARG2 under operation CODE to produce a new constant. Return NULL_TREE if we don't know how to evaluate CODE at compile-time. */ static tree -int_const_binop_1 (enum tree_code code, const_tree arg1, const_tree parg2, +int_const_binop_1 (enum tree_code code, const_tree parg1, const_tree parg2, int overflowable) { wide_int res; tree t; - tree type = TREE_TYPE (arg1); + tree type = TREE_TYPE (parg1); signop sign = TYPE_SIGN (type); bool overflow = false; + wi::tree_to_wide_ref arg1 = wi::to_wide (parg1); wide_int arg2 = wi::to_wide (parg2, TYPE_PRECISION (type)); switch (code) @@ -1106,7 +1109,7 @@ int_const_binop_1 (enum tree_code code, const_tree arg1, const_tree parg2, t = force_fit_type (type, res, overflowable, (((sign == SIGNED || overflowable == -1) && overflow) - | TREE_OVERFLOW (arg1) | TREE_OVERFLOW (parg2))); + | TREE_OVERFLOW (parg1) | TREE_OVERFLOW (parg2))); return t; } @@ -1258,7 +1261,7 @@ const_binop (enum tree_code code, tree arg1, tree arg2) { if (TREE_CODE (arg2) != INTEGER_CST) return NULL_TREE; - wide_int w2 = arg2; + wi::tree_to_wide_ref w2 = wi::to_wide (arg2); f2.data.high = w2.elt (1); f2.data.low = w2.ulow (); f2.mode = SImode; @@ -1909,7 +1912,7 @@ fold_convert_const_int_from_real (enum tree_code code, tree type, const_tree arg if (real_less (&r, &l)) { overflow = true; - val = lt; + val = wi::to_wide (lt); } } @@ -1922,7 +1925,7 @@ fold_convert_const_int_from_real (enum tree_code code, tree type, const_tree arg if (real_less (&u, &r)) { overflow = true; - val = ut; + val = wi::to_wide (ut); } } } @@ -3793,47 +3796,6 @@ invert_truthvalue_loc (location_t loc, tree arg) : TRUTH_NOT_EXPR, type, arg); } - -/* Knowing that ARG0 and ARG1 are both RDIV_EXPRs, simplify a binary operation - with code CODE. This optimization is unsafe. */ -static tree -distribute_real_division (location_t loc, enum tree_code code, tree type, - tree arg0, tree arg1) -{ - bool mul0 = TREE_CODE (arg0) == MULT_EXPR; - bool mul1 = TREE_CODE (arg1) == MULT_EXPR; - - /* (A / C) +- (B / C) -> (A +- B) / C. */ - if (mul0 == mul1 - && operand_equal_p (TREE_OPERAND (arg0, 1), - TREE_OPERAND (arg1, 1), 0)) - return fold_build2_loc (loc, mul0 ? MULT_EXPR : RDIV_EXPR, type, - fold_build2_loc (loc, code, type, - TREE_OPERAND (arg0, 0), - TREE_OPERAND (arg1, 0)), - TREE_OPERAND (arg0, 1)); - - /* (A / C1) +- (A / C2) -> A * (1 / C1 +- 1 / C2). */ - if (operand_equal_p (TREE_OPERAND (arg0, 0), - TREE_OPERAND (arg1, 0), 0) - && TREE_CODE (TREE_OPERAND (arg0, 1)) == REAL_CST - && TREE_CODE (TREE_OPERAND (arg1, 1)) == REAL_CST) - { - REAL_VALUE_TYPE r0, r1; - r0 = TREE_REAL_CST (TREE_OPERAND (arg0, 1)); - r1 = TREE_REAL_CST (TREE_OPERAND (arg1, 1)); - if (!mul0) - real_arithmetic (&r0, RDIV_EXPR, &dconst1, &r0); - if (!mul1) - real_arithmetic (&r1, RDIV_EXPR, &dconst1, &r1); - real_arithmetic (&r0, code, &r0, &r1); - return fold_build2_loc (loc, MULT_EXPR, type, - TREE_OPERAND (arg0, 0), - build_real (type, r0)); - } - - return NULL_TREE; -} /* Return a BIT_FIELD_REF of type TYPE to refer to BITSIZE bits of INNER starting at BITPOS. The field is unsigned if UNSIGNEDP is nonzero @@ -4010,21 +3972,20 @@ optimize_bit_field_compare (location_t loc, enum tree_code code, size_int (nbitsize - lbitsize - lbitpos)); if (! const_p) - /* If not comparing with constant, just rework the comparison - and return. */ - return fold_build2_loc (loc, code, compare_type, - fold_build2_loc (loc, BIT_AND_EXPR, unsigned_type, - make_bit_field_ref (loc, linner, lhs, - unsigned_type, - nbitsize, nbitpos, - 1, lreversep), - mask), - fold_build2_loc (loc, BIT_AND_EXPR, unsigned_type, - make_bit_field_ref (loc, rinner, rhs, - unsigned_type, - nbitsize, nbitpos, - 1, rreversep), - mask)); + { + if (nbitpos < 0) + return 0; + + /* If not comparing with constant, just rework the comparison + and return. */ + tree t1 = make_bit_field_ref (loc, linner, lhs, unsigned_type, + nbitsize, nbitpos, 1, lreversep); + t1 = fold_build2_loc (loc, BIT_AND_EXPR, unsigned_type, t1, mask); + tree t2 = make_bit_field_ref (loc, rinner, rhs, unsigned_type, + nbitsize, nbitpos, 1, rreversep); + t2 = fold_build2_loc (loc, BIT_AND_EXPR, unsigned_type, t2, mask); + return fold_build2_loc (loc, code, compare_type, t1, t2); + } /* Otherwise, we are handling the constant case. See if the constant is too big for the field. Warn and return a tree for 0 (false) if so. We do @@ -4037,7 +3998,7 @@ optimize_bit_field_compare (location_t loc, enum tree_code code, if (lunsignedp) { - if (wi::lrshift (rhs, lbitsize) != 0) + if (wi::lrshift (wi::to_wide (rhs), lbitsize) != 0) { warning (0, "comparison is always %d due to width of bit-field", code == NE_EXPR); @@ -4046,7 +4007,7 @@ optimize_bit_field_compare (location_t loc, enum tree_code code, } else { - wide_int tem = wi::arshift (rhs, lbitsize - 1); + wide_int tem = wi::arshift (wi::to_wide (rhs), lbitsize - 1); if (tem != 0 && tem != -1) { warning (0, "comparison is always %d due to width of bit-field", @@ -4055,6 +4016,9 @@ optimize_bit_field_compare (location_t loc, enum tree_code code, } } + if (nbitpos < 0) + return 0; + /* Single-bit compares should always be against zero. */ if (lbitsize == 1 && ! integer_zerop (rhs)) { @@ -4196,7 +4160,7 @@ all_ones_mask_p (const_tree mask, unsigned int size) if (size > precision || TYPE_SIGN (type) == UNSIGNED) return false; - return wi::mask (size, false, precision) == mask; + return wi::mask (size, false, precision) == wi::to_wide (mask); } /* Subroutine for fold: determine if VAL is the INTEGER_CONST that @@ -4222,7 +4186,7 @@ sign_bit_p (tree exp, const_tree val) return NULL_TREE; width = TYPE_PRECISION (t); - if (wi::only_sign_bit_p (val, width)) + if (wi::only_sign_bit_p (wi::to_wide (val), width)) return exp; /* Handle extension from a narrower type. */ @@ -5449,7 +5413,8 @@ unextend (tree c, int p, int unsignedp, tree mask) /* We work by getting just the sign bit into the low-order bit, then into the high-order bit, then sign-extend. We then XOR that value with C. */ - temp = build_int_cst (TREE_TYPE (c), wi::extract_uhwi (c, p - 1, 1)); + temp = build_int_cst (TREE_TYPE (c), + wi::extract_uhwi (wi::to_wide (c), p - 1, 1)); /* We must use a signed type in order to get an arithmetic right shift. However, we must also avoid introducing accidental overflows, so that @@ -5870,7 +5835,10 @@ fold_truth_andor_1 (location_t loc, enum tree_code code, tree truth_type, results. */ ll_mask = const_binop (BIT_IOR_EXPR, ll_mask, rl_mask); lr_mask = const_binop (BIT_IOR_EXPR, lr_mask, rr_mask); - if (lnbitsize == rnbitsize && xll_bitpos == xlr_bitpos) + if (lnbitsize == rnbitsize + && xll_bitpos == xlr_bitpos + && lnbitpos >= 0 + && rnbitpos >= 0) { lhs = make_bit_field_ref (loc, ll_inner, ll_arg, lntype, lnbitsize, lnbitpos, @@ -5894,10 +5862,14 @@ fold_truth_andor_1 (location_t loc, enum tree_code code, tree truth_type, Note that we still must mask the lhs/rhs expressions. Furthermore, the mask must be shifted to account for the shift done by make_bit_field_ref. */ - if ((ll_bitsize + ll_bitpos == rl_bitpos - && lr_bitsize + lr_bitpos == rr_bitpos) - || (ll_bitpos == rl_bitpos + rl_bitsize - && lr_bitpos == rr_bitpos + rr_bitsize)) + if (((ll_bitsize + ll_bitpos == rl_bitpos + && lr_bitsize + lr_bitpos == rr_bitpos) + || (ll_bitpos == rl_bitpos + rl_bitsize + && lr_bitpos == rr_bitpos + rr_bitsize)) + && ll_bitpos >= 0 + && rl_bitpos >= 0 + && lr_bitpos >= 0 + && rr_bitpos >= 0) { tree type; @@ -5966,6 +5938,9 @@ fold_truth_andor_1 (location_t loc, enum tree_code code, tree truth_type, } } + if (lnbitpos < 0) + return 0; + /* Construct the expression we will return. First get the component reference we will make. Unless the mask is all ones the width of that field, perform the mask operation. Then compare with the @@ -6055,7 +6030,8 @@ extract_muldiv_1 (tree t, tree c, enum tree_code code, tree wide_type, /* For a constant, we can always simplify if we are a multiply or (for divide and modulus) if it is a multiple of our constant. */ if (code == MULT_EXPR - || wi::multiple_of_p (t, c, TYPE_SIGN (type))) + || wi::multiple_of_p (wi::to_wide (t), wi::to_wide (c), + TYPE_SIGN (type))) { tree tem = const_binop (code, fold_convert (ctype, t), fold_convert (ctype, c)); @@ -6172,7 +6148,8 @@ extract_muldiv_1 (tree t, tree c, enum tree_code code, tree wide_type, && (tcode == RSHIFT_EXPR || TYPE_UNSIGNED (TREE_TYPE (op0))) /* const_binop may not detect overflow correctly, so check for it explicitly here. */ - && wi::gtu_p (TYPE_PRECISION (TREE_TYPE (size_one_node)), op1) + && wi::gtu_p (TYPE_PRECISION (TREE_TYPE (size_one_node)), + wi::to_wide (op1)) && 0 != (t1 = fold_convert (ctype, const_binop (LSHIFT_EXPR, size_one_node, @@ -6241,7 +6218,8 @@ extract_muldiv_1 (tree t, tree c, enum tree_code code, tree wide_type, /* If it's a multiply or a division/modulus operation of a multiple of our constant, do the operation and verify it doesn't overflow. */ if (code == MULT_EXPR - || wi::multiple_of_p (op1, c, TYPE_SIGN (type))) + || wi::multiple_of_p (wi::to_wide (op1), wi::to_wide (c), + TYPE_SIGN (type))) { op1 = const_binop (code, fold_convert (ctype, op1), fold_convert (ctype, c)); @@ -6280,7 +6258,8 @@ extract_muldiv_1 (tree t, tree c, enum tree_code code, tree wide_type, /* If the multiplication can overflow we cannot optimize this. */ && TYPE_OVERFLOW_UNDEFINED (TREE_TYPE (t)) && TREE_CODE (TREE_OPERAND (t, 1)) == INTEGER_CST - && wi::multiple_of_p (op1, c, TYPE_SIGN (type))) + && wi::multiple_of_p (wi::to_wide (op1), wi::to_wide (c), + TYPE_SIGN (type))) { *strict_overflow_p = true; return omit_one_operand (type, integer_zero_node, op0); @@ -6342,7 +6321,8 @@ extract_muldiv_1 (tree t, tree c, enum tree_code code, tree wide_type, && code != FLOOR_MOD_EXPR && code != ROUND_MOD_EXPR && code != MULT_EXPR))) { - if (wi::multiple_of_p (op1, c, TYPE_SIGN (type))) + if (wi::multiple_of_p (wi::to_wide (op1), wi::to_wide (c), + TYPE_SIGN (type))) { if (TYPE_OVERFLOW_UNDEFINED (ctype)) *strict_overflow_p = true; @@ -6351,7 +6331,8 @@ extract_muldiv_1 (tree t, tree c, enum tree_code code, tree wide_type, const_binop (TRUNC_DIV_EXPR, op1, c))); } - else if (wi::multiple_of_p (c, op1, TYPE_SIGN (type))) + else if (wi::multiple_of_p (wi::to_wide (c), wi::to_wide (op1), + TYPE_SIGN (type))) { if (TYPE_OVERFLOW_UNDEFINED (ctype)) *strict_overflow_p = true; @@ -6534,7 +6515,7 @@ fold_div_compare (enum tree_code code, tree c1, tree c2, tree *lo, /* We have to do this the hard way to detect unsigned overflow. prod = int_const_binop (MULT_EXPR, c1, c2); */ - wide_int val = wi::mul (c1, c2, sign, &overflow); + wide_int val = wi::mul (wi::to_wide (c1), wi::to_wide (c2), sign, &overflow); prod = force_fit_type (type, val, -1, overflow); *neg_overflow = false; @@ -6544,7 +6525,7 @@ fold_div_compare (enum tree_code code, tree c1, tree c2, tree *lo, *lo = prod; /* Likewise *hi = int_const_binop (PLUS_EXPR, prod, tmp). */ - val = wi::add (prod, tmp, sign, &overflow); + val = wi::add (wi::to_wide (prod), wi::to_wide (tmp), sign, &overflow); *hi = force_fit_type (type, val, -1, overflow | TREE_OVERFLOW (prod)); } else if (tree_int_cst_sgn (c1) >= 0) @@ -6688,7 +6669,7 @@ fold_single_bit_test (location_t loc, enum tree_code code, if (TREE_CODE (inner) == RSHIFT_EXPR && TREE_CODE (TREE_OPERAND (inner, 1)) == INTEGER_CST && bitnum < TYPE_PRECISION (type) - && wi::ltu_p (TREE_OPERAND (inner, 1), + && wi::ltu_p (wi::to_wide (TREE_OPERAND (inner, 1)), TYPE_PRECISION (type) - bitnum)) { bitnum += tree_to_uhwi (TREE_OPERAND (inner, 1)); @@ -6868,7 +6849,7 @@ fold_plusminus_mult_expr (location_t loc, enum tree_code code, tree type, arg10 = build_one_cst (type); /* As we canonicalize A - 2 to A + -2 get rid of that sign for the purpose of this canonicalization. */ - if (wi::neg_p (arg1, TYPE_SIGN (TREE_TYPE (arg1))) + if (wi::neg_p (wi::to_wide (arg1), TYPE_SIGN (TREE_TYPE (arg1))) && negate_expr_p (arg1) && code == PLUS_EXPR) { @@ -6960,7 +6941,8 @@ fold_plusminus_mult_expr (location_t loc, enum tree_code code, tree type, /* If the sum evaluated to a constant that is not -INF the multiplication cannot overflow. */ if (TREE_CODE (tem) == INTEGER_CST - && ! wi::eq_p (tem, wi::min_value (TYPE_PRECISION (utype), SIGNED))) + && (wi::to_wide (tem) + != wi::min_value (TYPE_PRECISION (utype), SIGNED))) return fold_build2_loc (loc, MULT_EXPR, type, fold_convert (type, tem), same); @@ -8215,7 +8197,7 @@ pointer_may_wrap_p (tree base, tree offset, HOST_WIDE_INT bitpos) else if (TREE_CODE (offset) != INTEGER_CST || TREE_OVERFLOW (offset)) return true; else - wi_offset = offset; + wi_offset = wi::to_wide (offset); bool overflow; wide_int units = wi::shwi (bitpos / BITS_PER_UNIT, precision); @@ -9017,7 +8999,7 @@ expr_not_equal_to (tree t, const wide_int &w) switch (TREE_CODE (t)) { case INTEGER_CST: - return wi::ne_p (t, w); + return wi::to_wide (t) != w; case SSA_NAME: if (!INTEGRAL_TYPE_P (TREE_TYPE (t))) @@ -9372,12 +9354,6 @@ fold_binary_loc (location_t loc, } } - if (flag_unsafe_math_optimizations - && (TREE_CODE (arg0) == RDIV_EXPR || TREE_CODE (arg0) == MULT_EXPR) - && (TREE_CODE (arg1) == RDIV_EXPR || TREE_CODE (arg1) == MULT_EXPR) - && (tem = distribute_real_division (loc, code, type, arg0, arg1))) - return tem; - /* Convert a + (b*c + d*e) into (a + b*c) + d*e. We associate floats only if the user has specified -fassociative-math. */ @@ -9418,7 +9394,10 @@ fold_binary_loc (location_t loc, /* (A << C1) + (A >> C2) if A is unsigned and C1+C2 is the size of A is a rotate of A by C1 bits. */ /* (A << B) + (A >> (Z - B)) if A is unsigned and Z is the size of A - is a rotate of A by B bits. */ + is a rotate of A by B bits. + Similarly for (A << B) | (A >> (-B & C3)) where C3 is Z-1, + though in this case CODE must be | and not + or ^, otherwise + it doesn't return A when B is 0. */ { enum tree_code code0, code1; tree rtype; @@ -9436,25 +9415,32 @@ fold_binary_loc (location_t loc, == GET_MODE_UNIT_PRECISION (TYPE_MODE (rtype)))) { tree tree01, tree11; + tree orig_tree01, orig_tree11; enum tree_code code01, code11; - tree01 = TREE_OPERAND (arg0, 1); - tree11 = TREE_OPERAND (arg1, 1); + tree01 = orig_tree01 = TREE_OPERAND (arg0, 1); + tree11 = orig_tree11 = TREE_OPERAND (arg1, 1); STRIP_NOPS (tree01); STRIP_NOPS (tree11); code01 = TREE_CODE (tree01); code11 = TREE_CODE (tree11); + if (code11 != MINUS_EXPR + && (code01 == MINUS_EXPR || code01 == BIT_AND_EXPR)) + { + std::swap (code0, code1); + std::swap (code01, code11); + std::swap (tree01, tree11); + std::swap (orig_tree01, orig_tree11); + } if (code01 == INTEGER_CST && code11 == INTEGER_CST && (wi::to_widest (tree01) + wi::to_widest (tree11) - == element_precision (TREE_TYPE (TREE_OPERAND (arg0, 0))))) + == element_precision (rtype))) { tem = build2_loc (loc, LROTATE_EXPR, - TREE_TYPE (TREE_OPERAND (arg0, 0)), - TREE_OPERAND (arg0, 0), + rtype, TREE_OPERAND (arg0, 0), code0 == LSHIFT_EXPR - ? TREE_OPERAND (arg0, 1) - : TREE_OPERAND (arg1, 1)); + ? orig_tree01 : orig_tree11); return fold_convert_loc (loc, type, tem); } else if (code11 == MINUS_EXPR) @@ -9466,39 +9452,37 @@ fold_binary_loc (location_t loc, STRIP_NOPS (tree111); if (TREE_CODE (tree110) == INTEGER_CST && 0 == compare_tree_int (tree110, - element_precision - (TREE_TYPE (TREE_OPERAND - (arg0, 0)))) + element_precision (rtype)) && operand_equal_p (tree01, tree111, 0)) - return - fold_convert_loc (loc, type, - build2 ((code0 == LSHIFT_EXPR - ? LROTATE_EXPR - : RROTATE_EXPR), - TREE_TYPE (TREE_OPERAND (arg0, 0)), - TREE_OPERAND (arg0, 0), - TREE_OPERAND (arg0, 1))); + { + tem = build2_loc (loc, (code0 == LSHIFT_EXPR + ? LROTATE_EXPR : RROTATE_EXPR), + rtype, TREE_OPERAND (arg0, 0), + orig_tree01); + return fold_convert_loc (loc, type, tem); + } } - else if (code01 == MINUS_EXPR) + else if (code == BIT_IOR_EXPR + && code11 == BIT_AND_EXPR + && pow2p_hwi (element_precision (rtype))) { - tree tree010, tree011; - tree010 = TREE_OPERAND (tree01, 0); - tree011 = TREE_OPERAND (tree01, 1); - STRIP_NOPS (tree010); - STRIP_NOPS (tree011); - if (TREE_CODE (tree010) == INTEGER_CST - && 0 == compare_tree_int (tree010, - element_precision - (TREE_TYPE (TREE_OPERAND - (arg0, 0)))) - && operand_equal_p (tree11, tree011, 0)) - return fold_convert_loc - (loc, type, - build2 ((code0 != LSHIFT_EXPR - ? LROTATE_EXPR - : RROTATE_EXPR), - TREE_TYPE (TREE_OPERAND (arg0, 0)), - TREE_OPERAND (arg0, 0), TREE_OPERAND (arg1, 1))); + tree tree110, tree111; + tree110 = TREE_OPERAND (tree11, 0); + tree111 = TREE_OPERAND (tree11, 1); + STRIP_NOPS (tree110); + STRIP_NOPS (tree111); + if (TREE_CODE (tree110) == NEGATE_EXPR + && TREE_CODE (tree111) == INTEGER_CST + && 0 == compare_tree_int (tree111, + element_precision (rtype) - 1) + && operand_equal_p (tree01, TREE_OPERAND (tree110, 0), 0)) + { + tem = build2_loc (loc, (code0 == LSHIFT_EXPR + ? LROTATE_EXPR : RROTATE_EXPR), + rtype, TREE_OPERAND (arg0, 0), + orig_tree01); + return fold_convert_loc (loc, type, tem); + } } } } @@ -9769,13 +9753,6 @@ fold_binary_loc (location_t loc, return tem; } - if (FLOAT_TYPE_P (type) - && flag_unsafe_math_optimizations - && (TREE_CODE (arg0) == RDIV_EXPR || TREE_CODE (arg0) == MULT_EXPR) - && (TREE_CODE (arg1) == RDIV_EXPR || TREE_CODE (arg1) == MULT_EXPR) - && (tem = distribute_real_division (loc, code, type, arg0, arg1))) - return tem; - /* Handle (A1 * C1) - (A2 * C2) with A1, A2 or C1, C2 being the same or one. Make sure the type is not saturating and has the signedness of the stripped operands, as fold_plusminus_mult_expr will re-associate. @@ -9876,8 +9853,8 @@ fold_binary_loc (location_t loc, && TREE_CODE (TREE_OPERAND (arg0, 1)) == INTEGER_CST) { int width = TYPE_PRECISION (type), w; - wide_int c1 = TREE_OPERAND (arg0, 1); - wide_int c2 = arg1; + wide_int c1 = wi::to_wide (TREE_OPERAND (arg0, 1)); + wide_int c2 = wi::to_wide (arg1); /* If (C1&C2) == C1, then (X&C1)|C2 becomes (X,C2). */ if ((c1 & c2) == c1) @@ -9888,7 +9865,7 @@ fold_binary_loc (location_t loc, TYPE_PRECISION (TREE_TYPE (arg1))); /* If (C1|C2) == ~0 then (X&C1)|C2 becomes X|C2. */ - if (msk.and_not (c1 | c2) == 0) + if (wi::bit_and_not (msk, c1 | c2) == 0) { tem = fold_convert_loc (loc, type, TREE_OPERAND (arg0, 0)); return fold_build2_loc (loc, BIT_IOR_EXPR, type, tem, arg1); @@ -9899,12 +9876,13 @@ fold_binary_loc (location_t loc, mode which allows further optimizations. */ c1 &= msk; c2 &= msk; - wide_int c3 = c1.and_not (c2); + wide_int c3 = wi::bit_and_not (c1, c2); for (w = BITS_PER_UNIT; w <= width; w <<= 1) { wide_int mask = wi::mask (w, false, TYPE_PRECISION (type)); - if (((c1 | c2) & mask) == mask && c1.and_not (mask) == 0) + if (((c1 | c2) & mask) == mask + && wi::bit_and_not (c1, mask) == 0) { c3 = mask; break; @@ -9978,7 +9956,7 @@ fold_binary_loc (location_t loc, multiple of 1 << CST. */ if (TREE_CODE (arg1) == INTEGER_CST) { - wide_int cst1 = arg1; + wi::tree_to_wide_ref cst1 = wi::to_wide (arg1); wide_int ncst1 = -cst1; if ((cst1 & ncst1) == ncst1 && multiple_of_p (type, arg0, @@ -9992,8 +9970,9 @@ fold_binary_loc (location_t loc, && TREE_CODE (arg0) == MULT_EXPR && TREE_CODE (TREE_OPERAND (arg0, 1)) == INTEGER_CST) { - wide_int warg1 = arg1; - wide_int masked = mask_with_tz (type, warg1, TREE_OPERAND (arg0, 1)); + wi::tree_to_wide_ref warg1 = wi::to_wide (arg1); + wide_int masked + = mask_with_tz (type, warg1, wi::to_wide (TREE_OPERAND (arg0, 1))); if (masked == 0) return omit_two_operands_loc (loc, type, build_zero_cst (type), @@ -10020,7 +9999,7 @@ fold_binary_loc (location_t loc, If B is constant and (B & M) == 0, fold into A & M. */ if (TREE_CODE (arg1) == INTEGER_CST) { - wide_int cst1 = arg1; + wi::tree_to_wide_ref cst1 = wi::to_wide (arg1); if ((~cst1 != 0) && (cst1 & (cst1 + 1)) == 0 && INTEGRAL_TYPE_P (TREE_TYPE (arg0)) && (TREE_CODE (arg0) == PLUS_EXPR @@ -10056,8 +10035,7 @@ fold_binary_loc (location_t loc, if (TREE_CODE (TREE_OPERAND (pmop[which], 1)) != INTEGER_CST) break; - cst0 = TREE_OPERAND (pmop[which], 1); - cst0 &= cst1; + cst0 = wi::to_wide (TREE_OPERAND (pmop[which], 1)) & cst1; if (TREE_CODE (pmop[which]) == BIT_AND_EXPR) { if (cst0 != cst1) @@ -10075,7 +10053,7 @@ fold_binary_loc (location_t loc, omitted (assumed 0). */ if ((TREE_CODE (arg0) == PLUS_EXPR || (TREE_CODE (arg0) == MINUS_EXPR && which == 0)) - && (cst1 & pmop[which]) == 0) + && (cst1 & wi::to_wide (pmop[which])) == 0) pmop[which] = NULL; break; default: @@ -10133,7 +10111,7 @@ fold_binary_loc (location_t loc, { prec = element_precision (TREE_TYPE (TREE_OPERAND (arg0, 0))); - wide_int mask = wide_int::from (arg1, prec, UNSIGNED); + wide_int mask = wide_int::from (wi::to_wide (arg1), prec, UNSIGNED); if (mask == -1) return fold_convert_loc (loc, type, TREE_OPERAND (arg0, 0)); @@ -10176,7 +10154,7 @@ fold_binary_loc (location_t loc, { tree sh_cnt = TREE_OPERAND (arg1, 1); tree pow2 = build_int_cst (TREE_TYPE (sh_cnt), - wi::exact_log2 (sval)); + wi::exact_log2 (wi::to_wide (sval))); if (strict_overflow_p) fold_overflow_warning (("assuming signed overflow does not " @@ -10307,7 +10285,8 @@ fold_binary_loc (location_t loc, if (code == RROTATE_EXPR && TREE_CODE (arg1) == INTEGER_CST && TREE_CODE (arg0) == RROTATE_EXPR && TREE_CODE (TREE_OPERAND (arg0, 1)) == INTEGER_CST - && wi::umod_trunc (wi::add (arg1, TREE_OPERAND (arg0, 1)), + && wi::umod_trunc (wi::to_wide (arg1) + + wi::to_wide (TREE_OPERAND (arg0, 1)), prec) == 0) return fold_convert_loc (loc, type, TREE_OPERAND (arg0, 0)); @@ -10489,40 +10468,6 @@ fold_binary_loc (location_t loc, && code == NE_EXPR) return non_lvalue_loc (loc, fold_convert_loc (loc, type, arg0)); - /* Transform comparisons of the form X +- Y CMP X to Y CMP 0. */ - if ((TREE_CODE (arg0) == PLUS_EXPR - || TREE_CODE (arg0) == POINTER_PLUS_EXPR - || TREE_CODE (arg0) == MINUS_EXPR) - && operand_equal_p (tree_strip_nop_conversions (TREE_OPERAND (arg0, - 0)), - arg1, 0) - && (INTEGRAL_TYPE_P (TREE_TYPE (arg0)) - || POINTER_TYPE_P (TREE_TYPE (arg0)))) - { - tree val = TREE_OPERAND (arg0, 1); - val = fold_build2_loc (loc, code, type, val, - build_int_cst (TREE_TYPE (val), 0)); - return omit_two_operands_loc (loc, type, val, - TREE_OPERAND (arg0, 0), arg1); - } - - /* Transform comparisons of the form X CMP X +- Y to Y CMP 0. */ - if ((TREE_CODE (arg1) == PLUS_EXPR - || TREE_CODE (arg1) == POINTER_PLUS_EXPR - || TREE_CODE (arg1) == MINUS_EXPR) - && operand_equal_p (tree_strip_nop_conversions (TREE_OPERAND (arg1, - 0)), - arg0, 0) - && (INTEGRAL_TYPE_P (TREE_TYPE (arg1)) - || POINTER_TYPE_P (TREE_TYPE (arg1)))) - { - tree val = TREE_OPERAND (arg1, 1); - val = fold_build2_loc (loc, code, type, val, - build_int_cst (TREE_TYPE (val), 0)); - return omit_two_operands_loc (loc, type, val, - TREE_OPERAND (arg1, 0), arg0); - } - /* If this is an EQ or NE comparison with zero and ARG0 is (1 << foo) & bar, convert it to (bar >> foo) & 1. Both require two operations, but the latter can be done in one less insn @@ -10594,7 +10539,7 @@ fold_binary_loc (location_t loc, prec = TYPE_PRECISION (itype); /* Check for a valid shift count. */ - if (wi::ltu_p (arg001, prec)) + if (wi::ltu_p (wi::to_wide (arg001), prec)) { tree arg01 = TREE_OPERAND (arg0, 1); tree arg000 = TREE_OPERAND (TREE_OPERAND (arg0, 0), 0); @@ -10670,7 +10615,7 @@ fold_binary_loc (location_t loc, tree arg00 = TREE_OPERAND (arg0, 0); tree arg01 = TREE_OPERAND (arg0, 1); tree itype = TREE_TYPE (arg00); - if (wi::eq_p (arg01, element_precision (itype) - 1)) + if (wi::to_wide (arg01) == element_precision (itype) - 1) { if (TYPE_UNSIGNED (itype)) { @@ -10905,130 +10850,38 @@ fold_binary_loc (location_t loc, /* Transform comparisons of the form X +- C CMP X. */ if ((TREE_CODE (arg0) == PLUS_EXPR || TREE_CODE (arg0) == MINUS_EXPR) && operand_equal_p (TREE_OPERAND (arg0, 0), arg1, 0) - && ((TREE_CODE (TREE_OPERAND (arg0, 1)) == REAL_CST - && !HONOR_SNANS (arg0)) - || (TREE_CODE (TREE_OPERAND (arg0, 1)) == INTEGER_CST - && TYPE_OVERFLOW_UNDEFINED (TREE_TYPE (arg1))))) + && TREE_CODE (TREE_OPERAND (arg0, 1)) == REAL_CST + && !HONOR_SNANS (arg0)) { tree arg01 = TREE_OPERAND (arg0, 1); enum tree_code code0 = TREE_CODE (arg0); - int is_positive; - - if (TREE_CODE (arg01) == REAL_CST) - is_positive = REAL_VALUE_NEGATIVE (TREE_REAL_CST (arg01)) ? -1 : 1; - else - is_positive = tree_int_cst_sgn (arg01); + int is_positive = REAL_VALUE_NEGATIVE (TREE_REAL_CST (arg01)) ? -1 : 1; /* (X - c) > X becomes false. */ if (code == GT_EXPR && ((code0 == MINUS_EXPR && is_positive >= 0) || (code0 == PLUS_EXPR && is_positive <= 0))) - { - if (TREE_CODE (arg01) == INTEGER_CST - && TYPE_OVERFLOW_UNDEFINED (TREE_TYPE (arg1))) - fold_overflow_warning (("assuming signed overflow does not " - "occur when assuming that (X - c) > X " - "is always false"), - WARN_STRICT_OVERFLOW_ALL); - return constant_boolean_node (0, type); - } + return constant_boolean_node (0, type); /* Likewise (X + c) < X becomes false. */ if (code == LT_EXPR && ((code0 == PLUS_EXPR && is_positive >= 0) || (code0 == MINUS_EXPR && is_positive <= 0))) - { - if (TREE_CODE (arg01) == INTEGER_CST - && TYPE_OVERFLOW_UNDEFINED (TREE_TYPE (arg1))) - fold_overflow_warning (("assuming signed overflow does not " - "occur when assuming that " - "(X + c) < X is always false"), - WARN_STRICT_OVERFLOW_ALL); - return constant_boolean_node (0, type); - } + return constant_boolean_node (0, type); /* Convert (X - c) <= X to true. */ if (!HONOR_NANS (arg1) && code == LE_EXPR && ((code0 == MINUS_EXPR && is_positive >= 0) || (code0 == PLUS_EXPR && is_positive <= 0))) - { - if (TREE_CODE (arg01) == INTEGER_CST - && TYPE_OVERFLOW_UNDEFINED (TREE_TYPE (arg1))) - fold_overflow_warning (("assuming signed overflow does not " - "occur when assuming that " - "(X - c) <= X is always true"), - WARN_STRICT_OVERFLOW_ALL); - return constant_boolean_node (1, type); - } + return constant_boolean_node (1, type); /* Convert (X + c) >= X to true. */ if (!HONOR_NANS (arg1) && code == GE_EXPR && ((code0 == PLUS_EXPR && is_positive >= 0) || (code0 == MINUS_EXPR && is_positive <= 0))) - { - if (TREE_CODE (arg01) == INTEGER_CST - && TYPE_OVERFLOW_UNDEFINED (TREE_TYPE (arg1))) - fold_overflow_warning (("assuming signed overflow does not " - "occur when assuming that " - "(X + c) >= X is always true"), - WARN_STRICT_OVERFLOW_ALL); - return constant_boolean_node (1, type); - } - - if (TREE_CODE (arg01) == INTEGER_CST) - { - /* Convert X + c > X and X - c < X to true for integers. */ - if (code == GT_EXPR - && ((code0 == PLUS_EXPR && is_positive > 0) - || (code0 == MINUS_EXPR && is_positive < 0))) - { - if (TYPE_OVERFLOW_UNDEFINED (TREE_TYPE (arg1))) - fold_overflow_warning (("assuming signed overflow does " - "not occur when assuming that " - "(X + c) > X is always true"), - WARN_STRICT_OVERFLOW_ALL); - return constant_boolean_node (1, type); - } - - if (code == LT_EXPR - && ((code0 == MINUS_EXPR && is_positive > 0) - || (code0 == PLUS_EXPR && is_positive < 0))) - { - if (TYPE_OVERFLOW_UNDEFINED (TREE_TYPE (arg1))) - fold_overflow_warning (("assuming signed overflow does " - "not occur when assuming that " - "(X - c) < X is always true"), - WARN_STRICT_OVERFLOW_ALL); - return constant_boolean_node (1, type); - } - - /* Convert X + c <= X and X - c >= X to false for integers. */ - if (code == LE_EXPR - && ((code0 == PLUS_EXPR && is_positive > 0) - || (code0 == MINUS_EXPR && is_positive < 0))) - { - if (TYPE_OVERFLOW_UNDEFINED (TREE_TYPE (arg1))) - fold_overflow_warning (("assuming signed overflow does " - "not occur when assuming that " - "(X + c) <= X is always false"), - WARN_STRICT_OVERFLOW_ALL); - return constant_boolean_node (0, type); - } - - if (code == GE_EXPR - && ((code0 == MINUS_EXPR && is_positive > 0) - || (code0 == PLUS_EXPR && is_positive < 0))) - { - if (TYPE_OVERFLOW_UNDEFINED (TREE_TYPE (arg1))) - fold_overflow_warning (("assuming signed overflow does " - "not occur when assuming that " - "(X - c) >= X is always false"), - WARN_STRICT_OVERFLOW_ALL); - return constant_boolean_node (0, type); - } - } + return constant_boolean_node (1, type); } /* If we are comparing an ABS_EXPR with a constant, we can @@ -11420,7 +11273,7 @@ fold_ternary_loc (location_t loc, enum tree_code code, tree type, (inner_width, outer_width - inner_width, false, TYPE_PRECISION (TREE_TYPE (arg1))); - wide_int common = mask & arg1; + wide_int common = mask & wi::to_wide (arg1); if (common == mask) { tem_type = signed_type_for (TREE_TYPE (tem)); @@ -11643,7 +11496,7 @@ fold_ternary_loc (location_t loc, enum tree_code code, tree type, /* Make sure that the perm value is in an acceptable range. */ - wide_int t = val; + wi::tree_to_wide_ref t = wi::to_wide (val); need_mask_canon |= wi::gtu_p (t, mask); need_mask_canon2 |= wi::gtu_p (t, mask2); unsigned int elt = t.to_uhwi () & mask; @@ -11725,9 +11578,9 @@ fold_ternary_loc (location_t loc, enum tree_code code, tree type, { unsigned HOST_WIDE_INT bitpos = tree_to_uhwi (op2); unsigned bitsize = TYPE_PRECISION (TREE_TYPE (arg1)); - wide_int tem = wi::bit_and (arg0, - wi::shifted_mask (bitpos, bitsize, true, - TYPE_PRECISION (type))); + wide_int tem = (wi::to_wide (arg0) + & wi::shifted_mask (bitpos, bitsize, true, + TYPE_PRECISION (type))); wide_int tem2 = wi::lshift (wi::zext (wi::to_wide (arg1, TYPE_PRECISION (type)), bitsize), bitpos); @@ -12547,7 +12400,8 @@ multiple_of_p (tree type, const_tree top, const_tree bottom) op1 = TREE_OPERAND (top, 1); /* const_binop may not detect overflow correctly, so check for it explicitly here. */ - if (wi::gtu_p (TYPE_PRECISION (TREE_TYPE (size_one_node)), op1) + if (wi::gtu_p (TYPE_PRECISION (TREE_TYPE (size_one_node)), + wi::to_wide (op1)) && 0 != (t1 = fold_convert (type, const_binop (LSHIFT_EXPR, size_one_node, @@ -13681,7 +13535,7 @@ fold_negate_const (tree arg0, tree type) case INTEGER_CST: { bool overflow; - wide_int val = wi::neg (arg0, &overflow); + wide_int val = wi::neg (wi::to_wide (arg0), &overflow); t = force_fit_type (type, val, 1, (overflow && ! TYPE_UNSIGNED (type)) || TREE_OVERFLOW (arg0)); @@ -13728,7 +13582,7 @@ fold_abs_const (tree arg0, tree type) { /* If the value is unsigned or non-negative, then the absolute value is the same as the ordinary value. */ - if (!wi::neg_p (arg0, TYPE_SIGN (type))) + if (!wi::neg_p (wi::to_wide (arg0), TYPE_SIGN (type))) t = arg0; /* If the value is negative, then the absolute value is @@ -13736,7 +13590,7 @@ fold_abs_const (tree arg0, tree type) else { bool overflow; - wide_int val = wi::neg (arg0, &overflow); + wide_int val = wi::neg (wi::to_wide (arg0), &overflow); t = force_fit_type (type, val, -1, overflow | TREE_OVERFLOW (arg0)); } @@ -13765,7 +13619,7 @@ fold_not_const (const_tree arg0, tree type) { gcc_assert (TREE_CODE (arg0) == INTEGER_CST); - return force_fit_type (type, wi::bit_not (arg0), 0, TREE_OVERFLOW (arg0)); + return force_fit_type (type, ~wi::to_wide (arg0), 0, TREE_OVERFLOW (arg0)); } /* Given CODE, a relational operator, the target type, TYPE and two @@ -14220,7 +14074,7 @@ round_up_loc (location_t loc, tree value, unsigned int divisor) { if (TREE_CODE (value) == INTEGER_CST) { - wide_int val = value; + wide_int val = wi::to_wide (value); bool overflow_p; if ((val & (divisor - 1)) == 0) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c38b34b944e66..962dbe888f637 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,186 @@ +2017-10-19 Bernhard Reutner-Fischer + + * interface.c (check_sym_interfaces, check_uop_interfaces, + gfc_check_interfaces): Base interface_name buffer off + GFC_MAX_SYMBOL_LEN. + +2017-10-19 Jakub Jelinek + + PR fortran/82568 + * gfortran.h (gfc_resolve_do_iterator): Add a bool arg. + (gfc_resolve_omp_local_vars): New declaration. + * openmp.c (omp_current_ctx): Make static. + (gfc_resolve_omp_parallel_blocks): Handle EXEC_OMP_TASKLOOP + and EXEC_OMP_TASKLOOP_SIMD. + (gfc_resolve_do_iterator): Add ADD_CLAUSE argument, if false, + don't actually add any clause. Move omp_current_ctx test + earlier. + (handle_local_var, gfc_resolve_omp_local_vars): New functions. + * resolve.c (gfc_resolve_code): Call gfc_resolve_omp_parallel_blocks + instead of just gfc_resolve_omp_do_blocks for EXEC_OMP_TASKLOOP + and EXEC_OMP_TASKLOOP_SIMD. + (gfc_resolve_code): Adjust gfc_resolve_do_iterator caller. + (resolve_codes): Call gfc_resolve_omp_local_vars. + +2017-10-19 Bernhard Reutner-Fischer + + * gfortran.h (gfc_lookup_function_fuzzy): New declaration. + (gfc_closest_fuzzy_match): New declaration. + (vec_push): New definition. + * misc.c (gfc_closest_fuzzy_match): New definition. + * resolve.c: Include spellcheck.h. + (lookup_function_fuzzy_find_candidates): New static function. + (lookup_uop_fuzzy_find_candidates): Likewise. + (lookup_uop_fuzzy): Likewise. + (resolve_operator) : Call lookup_uop_fuzzy. + (gfc_lookup_function_fuzzy): New definition. + (resolve_unknown_f): Call gfc_lookup_function_fuzzy. + * interface.c (check_interface0): Likewise. + (lookup_arg_fuzzy_find_candidates): New static function. + (lookup_arg_fuzzy ): Likewise. + (compare_actual_formal): Call lookup_arg_fuzzy. + * symbol.c: Include spellcheck.h. + (lookup_symbol_fuzzy_find_candidates): New static function. + (lookup_symbol_fuzzy): Likewise. + (gfc_set_default_type): Call lookup_symbol_fuzzy. + (lookup_component_fuzzy_find_candidates): New static function. + (lookup_component_fuzzy): Likewise. + (gfc_find_component): Call lookup_component_fuzzy. + +2017-10-18 Thomas Koenig + + PR fortran/82567 + * frontend-passes.c (combine_array_constructor): If an array + constructor is all constants and has more elements than a small + constant, don't convert a*[b,c] to [a*b,a*c] to reduce compilation + times. + +2017-10-18 Thomas Koenig + + PR fortran/79795 + * resolve.c (resovle_symbol): Change gcc_assert to + sensible error message. + +2017-10-18 Paul Thomas + + PR fortran/82550 + * trans_decl.c (gfc_get_symbol_decl): Procedure symbols that + have the 'used_in_submodule' attribute should be processed by + 'gfc_get_extern_function_decl'. + +2017-10-16 Fritz Reese + + PR fortran/82511 + * trans-io.c (transfer_expr): Treat BT_UNION as BT_DERIVED. + +2017-10-15 Thomas Koenig + + PR fortran/82372 + * fortran/scanner.c (last_error_char): New global variable. + (gfc_scanner_init_1): Set last_error_char to NULL. + (gfc_gobble_whitespace): If a character not printable or + not newline, issue an error. + +2017-10-13 Paul Thomas + + PR fortran/81048 + * resolve.c (resolve_symbol): Ensure that derived type array + results get default initialization. + +2017-10-11 Nathan Sidwell + + * cpp.c (gfc_cpp_add_include_path): Update incpath_e names. + (gfc_cpp_add_include_path_after): Likewise. + +2017-10-10 Richard Sandiford + + * target-memory.c (gfc_interpret_logical): Use wi::to_wide when + operating on trees as wide_ints. + * trans-const.c (gfc_conv_tree_to_mpz): Likewise. + * trans-expr.c (gfc_conv_cst_int_power): Likewise. + * trans-intrinsic.c (trans_this_image): Likewise. + (gfc_conv_intrinsic_bound): Likewise. + (conv_intrinsic_cobound): Likewise. + +2017-10-08 Steven G. Kargl + + * check.c (gfc_check_x): Remove function. + * intrinsic.c (add_functions): Use gfc_check_fn_r. + +2017-10-08 Paul Thomas + + PR fortran/82375 + * module.c : Bump up MOD_VERSION to 15. + (mio_component): Edit comment about PDT specification list. + (mio_expr, mio_symbol): Include the expression and symbol PDT + specification lists in the same way as in mio_component. + +2017-10-08 Thomas Koenig + + * dump_prase_tree (show_symbol): Output list of variables in + NAMELIST. + (show_code_node): Add new line for ELSE and END DO for DO + CONCURRENT. + * invoke.texi: Document that the output of + -fdump-fortran-original, -fdump-fortran-optimized and + -fdump-parse-tree is unsable and may lead to ICEs. + +2017-10-07 Paul Thomas + + PR fortran/82375 + * class.c (gfc_find_derived_vtab): Return NULL for a passed + pdt template to prevent bad procedures from being written. + * decl.c (gfc_get_pdt_instance): Do not use the default + initializer for pointer and allocatable pdt type components. If + the component is allocatbale, set the 'alloc_comp' attribute of + 'instance'. + * module.c : Add a prototype for 'mio_actual_arglist'. Add a + boolean argument 'pdt'. + (mio_component): Call it for the parameter list of pdt type + components with 'pdt' set to true. + (mio_actual_arg): Add the boolean 'pdt' and, if it is set, call + mio_integer for the 'spec_type'. + (mio_actual_arglist): Add the boolean 'pdt' and use it in the + call to mio_actual_arg. + (mio_expr, mio_omp_udr_expr): Call mio_actual_arglist with + 'pdt' set false. + * resolve.c (get_pdt_spec_expr): Add the parameter name to the + KIND parameter error. + (get_pdt_constructor): Check that cons->expr is non-null. + * trans-array.c (structure_alloc_comps): For deallocation of + allocatable components, ensure that parameterized components + are deallocated first. Likewise, when parameterized components + are allocated, nullify allocatable components first. Do not + recurse into pointer or allocatable pdt components while + allocating or deallocating parameterized components. Test that + parameterized arrays or strings are allocated before freeing + them. + (gfc_trans_pointer_assignment): Call the new function. Tidy up + a minor whitespace issue. + trans-decl.c (gfc_trans_deferred_vars): Set 'tmp' to NULL_TREE + to prevent the expression from being used a second time. + +2017-10-07 Thomas Koenig + + PR fortran/49232 + * expr.c (gfc_check_pointer_assign): Error + for non-contiguous rhs. + +2017-10-07 Thomas Koenig + + * gfortran.h (async_io_dt): Add external reference. + * io.c (async_io_dt): Add variable. + (compare_to_allowed_values): Add prototyte. Add optional argument + num. If present, set it to the number of the entry that was + matched. + (check_io_constraints): If this is for an asynchronous I/O + statement, set async_io_dt and set the asynchronous flag for + a SIZE tag. + * resolve.c (resolve_transfer): If async_io_dt is set, set + the asynchronous flag on the variable. + (resolve_fl_namelist): If async_io_dt is set, set the asynchronous + flag on all elements of the namelist. + 2017-10-04 Paul Thomas PR fortran/60458 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index e85e398cd4330..681950e782f96 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -2262,6 +2262,7 @@ gfc_check_fn_c (gfc_expr *a) return true; } + /* A single real argument. */ bool @@ -5512,19 +5513,6 @@ gfc_check_ttynam (gfc_expr *unit) } -/* Common check function for the half a dozen intrinsics that have a - single real argument. */ - -bool -gfc_check_x (gfc_expr *x) -{ - if (!type_check (x, 0, BT_REAL)) - return false; - - return true; -} - - /************* Check functions for intrinsic subroutines *************/ bool diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index a345d13144297..ebbd41b0d96ef 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -2211,6 +2211,9 @@ gfc_find_derived_vtab (gfc_symbol *derived) gfc_gsymbol *gsym = NULL; gfc_symbol *dealloc = NULL, *arg = NULL; + if (derived->attr.pdt_template) + return NULL; + /* Find the top-level namespace. */ for (ns = gfc_current_ns; ns; ns = ns->parent) if (!ns->parent) diff --git a/gcc/fortran/cpp.c b/gcc/fortran/cpp.c index 4d1b56a00450d..af8a69ca3f765 100644 --- a/gcc/fortran/cpp.c +++ b/gcc/fortran/cpp.c @@ -683,14 +683,14 @@ gfc_cpp_add_include_path (char *path, bool user_supplied) include path. Fortran does not define any system include paths. */ int cxx_aware = 0; - add_path (path, BRACKET, cxx_aware, user_supplied); + add_path (path, INC_BRACKET, cxx_aware, user_supplied); } void gfc_cpp_add_include_path_after (char *path, bool user_supplied) { int cxx_aware = 0; - add_path (path, AFTER, cxx_aware, user_supplied); + add_path (path, INC_AFTER, cxx_aware, user_supplied); } void diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 18220a127c3c6..5bf56c4d4b04d 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -3570,7 +3570,11 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, type_param_spec_list = old_param_spec_list; c2->param_list = params; - c2->initializer = gfc_default_initializer (&c2->ts); + if (!(c2->attr.pointer || c2->attr.allocatable)) + c2->initializer = gfc_default_initializer (&c2->ts); + + if (c2->attr.allocatable) + instance->attr.alloc_comp = 1; } } diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index a0098d70743b8..5193c29186bf6 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -967,8 +967,17 @@ show_symbol (gfc_symbol *sym) show_indent (); fputs ("PDT parameters", dumpfile); show_actual_arglist (sym->param_list); + } + if (sym->attr.flavor == FL_NAMELIST) + { + gfc_namelist *nl; + show_indent (); + fputs ("variables : ", dumpfile); + for (nl = sym->namelist; nl; nl = nl->next) + fprintf (dumpfile, " %s",nl->sym->name); } + --show_level; } @@ -1979,8 +1988,8 @@ show_code_node (int level, gfc_code *c) d = d->block; for (; d; d = d->block) { + fputs("\n", dumpfile); code_indent (level, 0); - if (d->expr1 == NULL) fputs ("ELSE", dumpfile); else @@ -2170,9 +2179,12 @@ show_code_node (int level, gfc_code *c) fputc (',', dumpfile); } show_expr (c->expr1); + ++show_level; show_code (level + 1, c->block->next); + --show_level; code_indent (level, c->label1); + show_indent (); fputs ("END DO", dumpfile); break; diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index bfbb19ee577fa..bc05db2fbaead 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3851,6 +3851,14 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) } } + /* Error for assignments of contiguous pointers to targets which is not + contiguous. Be lenient in the definition of what counts as + congiguous. */ + + if (lhs_attr.contiguous && !gfc_is_simply_contiguous (rvalue, false, true)) + gfc_error ("Assignment to contiguous pointer from non-contiguous " + "target at %L", &rvalue->where); + /* Warn if it is the LHS pointer may lives longer than the RHS target. */ if (warn_target_lifetime && rvalue->expr_type == EXPR_VARIABLE diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index ae4fba63b3c88..fcfaf9508c2ec 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -1635,6 +1635,8 @@ combine_array_constructor (gfc_expr *e) gfc_constructor *c, *new_c; gfc_constructor_base oldbase, newbase; bool scalar_first; + int n_elem; + bool all_const; /* Array constructors have rank one. */ if (e->rank != 1) @@ -1674,12 +1676,38 @@ combine_array_constructor (gfc_expr *e) if (op2->ts.type == BT_CHARACTER) return false; - scalar = create_var (gfc_copy_expr (op2), "constr"); + /* This might be an expanded constructor with very many constant values. If + we perform the operation here, we might end up with a long compile time + and actually longer execution time, so a length bound is in order here. + If the constructor constains something which is not a constant, it did + not come from an expansion, so leave it alone. */ + +#define CONSTR_LEN_MAX 4 oldbase = op1->value.constructor; + + n_elem = 0; + all_const = true; + for (c = gfc_constructor_first (oldbase); c; c = gfc_constructor_next(c)) + { + if (c->expr->expr_type != EXPR_CONSTANT) + { + all_const = false; + break; + } + n_elem += 1; + } + + if (all_const && n_elem > CONSTR_LEN_MAX) + return false; + +#undef CONSTR_LEN_MAX + newbase = NULL; e->expr_type = EXPR_ARRAY; + scalar = create_var (gfc_copy_expr (op2), "constr"); + for (c = gfc_constructor_first (oldbase); c; c = gfc_constructor_next (c)) { diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 18a534d3c9d6f..2c2fc6367081d 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2796,6 +2796,17 @@ void gfc_done_2 (void); int get_c_kind (const char *, CInteropKind_t *); +const char *gfc_closest_fuzzy_match (const char *, char **); +static inline void +vec_push (char **&optr, size_t &osz, const char *elt) +{ + /* {auto,}vec.safe_push () replacement. Don't ask.. */ + // if (strlen (elt) < 4) return; premature optimization: eliminated by cutoff + optr = XRESIZEVEC (char *, optr, osz + 2); + optr[osz] = CONST_CAST (char *, elt); + optr[++osz] = NULL; +} + /* options.c */ unsigned int gfc_option_lang_mask (void); void gfc_init_options_struct (struct gcc_options *); @@ -3103,7 +3114,8 @@ void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *); void gfc_free_omp_udr (gfc_omp_udr *); gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *); void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *); -void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *); +void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *, bool); +void gfc_resolve_omp_local_vars (gfc_namespace *); void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *); void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *); void gfc_resolve_omp_declare_simd (gfc_namespace *); @@ -3228,6 +3240,7 @@ bool gfc_type_is_extensible (gfc_symbol *); bool gfc_resolve_intrinsic (gfc_symbol *, locus *); bool gfc_explicit_interface_required (gfc_symbol *, char *, int); extern int gfc_do_concurrent_flag; +const char* gfc_lookup_function_fuzzy (const char *, gfc_symtree *); /* array.c */ @@ -3311,6 +3324,7 @@ void gfc_free_dt (gfc_dt *); bool gfc_resolve_dt (gfc_dt *, locus *); void gfc_free_wait (gfc_wait *); bool gfc_resolve_wait (gfc_wait *); +extern bool async_io_dt; /* module.c */ void gfc_module_init_2 (void); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index f8ef33fc7785c..9f0fcc82f2408 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1793,13 +1793,27 @@ check_interface0 (gfc_interface *p, const char *interface_name) || !p->sym->attr.if_source) && !gfc_fl_struct (p->sym->attr.flavor)) { + const char *guessed + = gfc_lookup_function_fuzzy (p->sym->name, p->sym->ns->sym_root); + if (p->sym->attr.external) - gfc_error ("Procedure %qs in %s at %L has no explicit interface", - p->sym->name, interface_name, &p->sym->declared_at); + if (guessed) + gfc_error ("Procedure %qs in %s at %L has no explicit interface" + "; did you mean %qs?", + p->sym->name, interface_name, &p->sym->declared_at, + guessed); + else + gfc_error ("Procedure %qs in %s at %L has no explicit interface", + p->sym->name, interface_name, &p->sym->declared_at); else - gfc_error ("Procedure %qs in %s at %L is neither function nor " - "subroutine", p->sym->name, interface_name, - &p->sym->declared_at); + if (guessed) + gfc_error ("Procedure %qs in %s at %L is neither function nor " + "subroutine; did you mean %qs?", p->sym->name, + interface_name, &p->sym->declared_at, guessed); + else + gfc_error ("Procedure %qs in %s at %L is neither function nor " + "subroutine", p->sym->name, interface_name, + &p->sym->declared_at); return true; } @@ -1904,7 +1918,7 @@ check_interface1 (gfc_interface *p, gfc_interface *q0, static void check_sym_interfaces (gfc_symbol *sym) { - char interface_name[100]; + char interface_name[GFC_MAX_SYMBOL_LEN + sizeof("generic interface ''")]; gfc_interface *p; if (sym->ns != gfc_current_ns) @@ -1941,7 +1955,7 @@ check_sym_interfaces (gfc_symbol *sym) static void check_uop_interfaces (gfc_user_op *uop) { - char interface_name[100]; + char interface_name[GFC_MAX_SYMBOL_LEN + sizeof("operator interface ''")]; gfc_user_op *uop2; gfc_namespace *ns; @@ -2018,7 +2032,7 @@ void gfc_check_interfaces (gfc_namespace *ns) { gfc_namespace *old_ns, *ns2; - char interface_name[100]; + char interface_name[GFC_MAX_SYMBOL_LEN + sizeof("intrinsic '' operator")]; int i; old_ns = gfc_current_ns; @@ -2778,6 +2792,31 @@ is_procptr_result (gfc_expr *expr) } +/* Recursively append candidate argument ARG to CANDIDATES. Store the + number of total candidates in CANDIDATES_LEN. */ + +static void +lookup_arg_fuzzy_find_candidates (gfc_formal_arglist *arg, + char **&candidates, + size_t &candidates_len) +{ + for (gfc_formal_arglist *p = arg; p && p->sym; p = p->next) + vec_push (candidates, candidates_len, p->sym->name); +} + + +/* Lookup argument ARG fuzzily, taking names in ARGUMENTS into account. */ + +static const char* +lookup_arg_fuzzy (const char *arg, gfc_formal_arglist *arguments) +{ + char **candidates = NULL; + size_t candidates_len = 0; + lookup_arg_fuzzy_find_candidates (arguments, candidates, candidates_len); + return gfc_closest_fuzzy_match (arg, candidates); +} + + /* Given formal and actual argument lists, see if they are compatible. If they are compatible, the actual argument list is sorted to correspond with the formal list, and elements for missing optional @@ -2831,8 +2870,16 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (f == NULL) { if (where) - gfc_error ("Keyword argument %qs at %L is not in " - "the procedure", a->name, &a->expr->where); + { + const char *guessed = lookup_arg_fuzzy (a->name, formal); + if (guessed) + gfc_error ("Keyword argument %qs at %L is not in " + "the procedure; did you mean %qs?", + a->name, &a->expr->where, guessed); + else + gfc_error ("Keyword argument %qs at %L is not in " + "the procedure", a->name, &a->expr->where); + } return false; } @@ -3552,8 +3599,15 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) { if (sym->ns->has_implicit_none_export && sym->attr.proc == PROC_UNKNOWN) { - gfc_error ("Procedure %qs called at %L is not explicitly declared", - sym->name, where); + const char *guessed + = gfc_lookup_function_fuzzy (sym->name, sym->ns->sym_root); + if (guessed) + gfc_error ("Procedure %qs called at %L is not explicitly declared" + "; did you mean %qs?", + sym->name, where, guessed); + else + gfc_error ("Procedure %qs called at %L is not explicitly declared", + sym->name, where); return false; } if (warn_implicit_interface) diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 8965d509882bc..da96e8ff30c4f 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1760,8 +1760,8 @@ add_functions (void) make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95); - add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95, - gfc_check_x, gfc_simplify_epsilon, NULL, + add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, + GFC_STD_F95, gfc_check_fn_r, gfc_simplify_epsilon, NULL, x, BT_REAL, dr, REQUIRED); make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95); @@ -1827,8 +1827,8 @@ add_functions (void) make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77); - add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95, - gfc_check_x, gfc_simplify_exponent, gfc_resolve_exponent, + add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, + GFC_STD_F95, gfc_check_fn_r, gfc_simplify_exponent, gfc_resolve_exponent, x, BT_REAL, dr, REQUIRED); make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95); @@ -1865,8 +1865,8 @@ add_functions (void) make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU); - add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95, - gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction, + add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, + GFC_STD_F95, gfc_check_fn_r, gfc_simplify_fraction, gfc_resolve_fraction, x, BT_REAL, dr, REQUIRED); make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95); @@ -2449,8 +2449,8 @@ add_functions (void) make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77); - add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, - GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL, + add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, + di, GFC_STD_F95, gfc_check_fn_r, gfc_simplify_maxexponent, NULL, x, BT_UNKNOWN, dr, REQUIRED); make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95); @@ -2525,8 +2525,8 @@ add_functions (void) make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77); - add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, - GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL, + add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, + di, GFC_STD_F95, gfc_check_fn_r, gfc_simplify_minexponent, NULL, x, BT_UNKNOWN, dr, REQUIRED); make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95); @@ -2753,8 +2753,8 @@ add_functions (void) make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95); - add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95, - gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing, + add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, + GFC_STD_F95, gfc_check_fn_r, gfc_simplify_rrspacing, gfc_resolve_rrspacing, x, BT_REAL, dr, REQUIRED); make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95); @@ -2960,8 +2960,8 @@ add_functions (void) NULL, gfc_simplify_compiler_version, NULL); make_from_module(); - add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95, - gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing, + add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, + GFC_STD_F95, gfc_check_fn_r, gfc_simplify_spacing, gfc_resolve_spacing, x, BT_REAL, dr, REQUIRED); make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95); @@ -3070,8 +3070,7 @@ add_functions (void) make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU); add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95, - gfc_check_x, gfc_simplify_tiny, NULL, - x, BT_REAL, dr, REQUIRED); + gfc_check_fn_r, gfc_simplify_tiny, NULL, x, BT_REAL, dr, REQUIRED); make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95); diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 63a144276fa42..8892d501d5888 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -1120,20 +1120,28 @@ either your program or the GNU Fortran compiler. @item -fdump-fortran-original @opindex @code{fdump-fortran-original} Output the internal parse tree after translating the source program -into internal representation. Only really useful for debugging the -GNU Fortran compiler itself. +into internal representation. This option is mostly useful for +debugging the GNU Fortran compiler itself. The output generated by +this option might change between releases. This option may also +generate internal compiler errors for features which have only +recently been added. @item -fdump-fortran-optimized @opindex @code{fdump-fortran-optimized} -Output the parse tree after front-end optimization. Only really -useful for debugging the GNU Fortran compiler itself. +Output the parse tree after front-end optimization. Mostly useful for +debugging the GNU Fortran compiler itself. The output generated by +this option might change between releases. This option may also +generate internal compiler errors for features which have only +recently been added. @item -fdump-parse-tree @opindex @code{fdump-parse-tree} Output the internal parse tree after translating the source program -into internal representation. Only really useful for debugging the -GNU Fortran compiler itself. This option is deprecated; use -@code{-fdump-fortran-original} instead. +into internal representation. Mostly useful for debugging the GNU +Fortran compiler itself. The output generated by this option might +change between releases. This option may also generate internal +compiler errors for features which have only recently been added. This +option is deprecated; use @code{-fdump-fortran-original} instead. @item -ffpe-trap=@var{list} @opindex @code{ffpe-trap=}@var{list} diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index af465dc00ea7b..463c00c2b2924 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -111,6 +111,9 @@ static gfc_dt *current_dt; #define RESOLVE_TAG(x, y) if (!resolve_tag (x, y)) return false; +/* Are we currently processing an asynchronous I/O statement? */ + +bool async_io_dt; /**************** Fortran 95 FORMAT parser *****************/ @@ -1944,7 +1947,15 @@ static int compare_to_allowed_values (const char *specifier, const char *allowed[], const char *allowed_f2003[], const char *allowed_gnu[], gfc_char_t *value, - const char *statement, bool warn) + const char *statement, bool warn, + int *num = NULL); + + +static int +compare_to_allowed_values (const char *specifier, const char *allowed[], + const char *allowed_f2003[], + const char *allowed_gnu[], gfc_char_t *value, + const char *statement, bool warn, int *num) { int i; unsigned int len; @@ -1961,7 +1972,11 @@ compare_to_allowed_values (const char *specifier, const char *allowed[], for (i = 0; allowed[i]; i++) if (len == strlen (allowed[i]) && gfc_wide_strncasecmp (value, allowed[i], strlen (allowed[i])) == 0) + { + if (num) + *num = i; return 1; + } for (i = 0; allowed_f2003 && allowed_f2003[i]; i++) if (len == strlen (allowed_f2003[i]) @@ -3611,7 +3626,8 @@ terminate_io (gfc_code *io_code) /* Check the constraints for a data transfer statement. The majority of the constraints appearing in 9.4 of the standard appear here. Some are handled - in resolve_tag and others in gfc_resolve_dt. */ + in resolve_tag and others in gfc_resolve_dt. Also set the async_io_dt flag + and, if necessary, the asynchronous flag on the SIZE argument. */ static match check_io_constraints (io_kind k, gfc_dt *dt, gfc_code *io_code, @@ -3719,6 +3735,7 @@ if (condition) \ if (dt->asynchronous) { + int num; static const char * asynchronous[] = { "YES", "NO", NULL }; if (!gfc_reduce_init_expr (dt->asynchronous)) @@ -3734,9 +3751,16 @@ if (condition) \ if (!compare_to_allowed_values ("ASYNCHRONOUS", asynchronous, NULL, NULL, dt->asynchronous->value.character.string, - io_kind_name (k), warn)) + io_kind_name (k), warn, &num)) return MATCH_ERROR; + + /* Best to put this here because the yes/no info is still around. */ + async_io_dt = num == 0; + if (async_io_dt && dt->size) + dt->size->symtree->n.sym->attr.asynchronous = 1; } + else + async_io_dt = false; if (dt->id) { diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c index a2c199efb56a0..f47d111ba47e0 100644 --- a/gcc/fortran/misc.c +++ b/gcc/fortran/misc.c @@ -22,6 +22,7 @@ along with GCC; see the file COPYING3. If not see #include "system.h" #include "coretypes.h" #include "gfortran.h" +#include "spellcheck.h" /* Initialize a typespec to unknown. */ @@ -280,3 +281,43 @@ get_c_kind(const char *c_kind_name, CInteropKind_t kinds_table[]) return ISOCBINDING_INVALID; } + + +/* For a given name TYPO, determine the best candidate from CANDIDATES + perusing Levenshtein distance. Frees CANDIDATES before returning. */ + +const char * +gfc_closest_fuzzy_match (const char *typo, char **candidates) +{ + /* Determine closest match. */ + const char *best = NULL; + char **cand = candidates; + edit_distance_t best_distance = MAX_EDIT_DISTANCE; + const size_t tl = strlen (typo); + + while (cand && *cand) + { + edit_distance_t dist = levenshtein_distance (typo, tl, *cand, + strlen (*cand)); + if (dist < best_distance) + { + best_distance = dist; + best = *cand; + } + cand++; + } + /* If more than half of the letters were misspelled, the suggestion is + likely to be meaningless. */ + if (best) + { + unsigned int cutoff = MAX (tl, strlen (best)) / 2; + + if (best_distance > cutoff) + { + XDELETEVEC (candidates); + return NULL; + } + XDELETEVEC (candidates); + } + return best; +} diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 63877a080500c..16585a959b634 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -84,7 +84,7 @@ along with GCC; see the file COPYING3. If not see /* Don't put any single quote (') in MOD_VERSION, if you want it to be recognized. */ -#define MOD_VERSION "14" +#define MOD_VERSION "15" /* Structure that describes a position within a module file. */ @@ -2788,6 +2788,7 @@ mio_component_ref (gfc_component **cp) static void mio_namespace_ref (gfc_namespace **nsp); static void mio_formal_arglist (gfc_formal_arglist **formal); static void mio_typebound_proc (gfc_typebound_proc** proc); +static void mio_actual_arglist (gfc_actual_arglist **ap, bool pdt); static void mio_component (gfc_component *c, int vtype) @@ -2819,6 +2820,9 @@ mio_component (gfc_component *c, int vtype) /* PDT templates store the expression for the kind of a component here. */ mio_expr (&c->kind_expr); + /* PDT types store the component specification list here. */ + mio_actual_arglist (&c->param_list, true); + mio_symbol_attribute (&c->attr); if (c->ts.type == BT_CLASS) c->attr.class_ok = 1; @@ -2874,17 +2878,19 @@ mio_component_list (gfc_component **cp, int vtype) static void -mio_actual_arg (gfc_actual_arglist *a) +mio_actual_arg (gfc_actual_arglist *a, bool pdt) { mio_lparen (); mio_pool_string (&a->name); mio_expr (&a->expr); + if (pdt) + mio_integer ((int *)&a->spec_type); mio_rparen (); } static void -mio_actual_arglist (gfc_actual_arglist **ap) +mio_actual_arglist (gfc_actual_arglist **ap, bool pdt) { gfc_actual_arglist *a, *tail; @@ -2893,7 +2899,7 @@ mio_actual_arglist (gfc_actual_arglist **ap) if (iomode == IO_OUTPUT) { for (a = *ap; a; a = a->next) - mio_actual_arg (a); + mio_actual_arg (a, pdt); } else @@ -2913,7 +2919,7 @@ mio_actual_arglist (gfc_actual_arglist **ap) tail->next = a; tail = a; - mio_actual_arg (a); + mio_actual_arg (a, pdt); } } @@ -3538,7 +3544,7 @@ mio_expr (gfc_expr **ep) case EXPR_FUNCTION: mio_symtree_ref (&e->symtree); - mio_actual_arglist (&e->value.function.actual); + mio_actual_arglist (&e->value.function.actual, false); if (iomode == IO_OUTPUT) { @@ -3660,6 +3666,9 @@ mio_expr (gfc_expr **ep) break; } + /* PDT types store the expression specification list here. */ + mio_actual_arglist (&e->param_list, true); + mio_rparen (); } @@ -4203,7 +4212,7 @@ mio_omp_udr_expr (gfc_omp_udr *udr, gfc_symbol **sym1, gfc_symbol **sym2, int flag; mio_name (1, omp_declare_reduction_stmt); mio_symtree_ref (&ns->code->symtree); - mio_actual_arglist (&ns->code->ext.actual); + mio_actual_arglist (&ns->code->ext.actual, false); flag = ns->code->resolved_isym != NULL; mio_integer (&flag); @@ -4245,7 +4254,7 @@ mio_omp_udr_expr (gfc_omp_udr *udr, gfc_symbol **sym1, gfc_symbol **sym2, int flag; ns->code = gfc_get_code (EXEC_CALL); mio_symtree_ref (&ns->code->symtree); - mio_actual_arglist (&ns->code->ext.actual); + mio_actual_arglist (&ns->code->ext.actual, false); mio_integer (&flag); if (flag) @@ -4315,6 +4324,9 @@ mio_symbol (gfc_symbol *sym) /* Load/save the f2k_derived namespace of a derived-type symbol. */ mio_full_f2k_derived (sym); + /* PDT types store the symbol specification list here. */ + mio_actual_arglist (&sym->param_list, true); + mio_namelist (sym); /* Add the fields that say whether this is from an intrinsic module, diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index c5e00888bbecb..2606323d42a71 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -5262,7 +5262,7 @@ resolve_omp_atomic (gfc_code *code) } -struct fortran_omp_context +static struct fortran_omp_context { gfc_code *code; hash_set *sharing_clauses; @@ -5345,6 +5345,8 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: @@ -5390,8 +5392,11 @@ gfc_omp_restore_state (struct gfc_omp_saved_state *state) construct, where they are predetermined private. */ void -gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym) +gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym, bool add_clause) { + if (omp_current_ctx == NULL) + return; + int i = omp_current_do_collapse; gfc_code *c = omp_current_do_code; @@ -5410,9 +5415,6 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym) c = c->block->next; } - if (omp_current_ctx == NULL) - return; - /* An openacc context may represent a data clause. Abort if so. */ if (!omp_current_ctx->is_openmp && !oacc_is_loop (omp_current_ctx->code)) return; @@ -5421,7 +5423,7 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym) && omp_current_ctx->sharing_clauses->contains (sym)) return; - if (! omp_current_ctx->private_iterators->add (sym)) + if (! omp_current_ctx->private_iterators->add (sym) && add_clause) { gfc_omp_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses; gfc_omp_namelist *p; @@ -5433,6 +5435,22 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym) } } +static void +handle_local_var (gfc_symbol *sym) +{ + if (sym->attr.flavor != FL_VARIABLE + || sym->as != NULL + || (sym->ts.type != BT_INTEGER && sym->ts.type != BT_REAL)) + return; + gfc_resolve_do_iterator (sym->ns->code, sym, false); +} + +void +gfc_resolve_omp_local_vars (gfc_namespace *ns) +{ + if (omp_current_ctx) + gfc_traverse_ns (ns, handle_local_var); +} static void resolve_omp_do (gfc_code *code) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e6f95d513d34d..04d4e8ab6cb5e 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1161,8 +1161,8 @@ get_pdt_spec_expr (gfc_component *c, gfc_expr *expr) param_tail->spec_type = SPEC_ASSUMED; if (c->attr.pdt_kind) { - gfc_error ("The KIND parameter in the PDT constructor " - "at %C has no value"); + gfc_error ("The KIND parameter %qs in the PDT constructor " + "at %C has no value", param->name); return false; } } @@ -1188,7 +1188,8 @@ get_pdt_constructor (gfc_expr *expr, gfc_constructor **constr, for (; comp && cons; comp = comp->next, cons = gfc_constructor_next (cons)) { - if (cons->expr->expr_type == EXPR_STRUCTURE + if (cons->expr + && cons->expr->expr_type == EXPR_STRUCTURE && comp->ts.type == BT_DERIVED) { t = get_pdt_constructor (cons->expr, NULL, comp->ts.u.derived); @@ -2800,6 +2801,43 @@ resolve_specific_f (gfc_expr *expr) return true; } +/* Recursively append candidate SYM to CANDIDATES. Store the number of + candidates in CANDIDATES_LEN. */ + +static void +lookup_function_fuzzy_find_candidates (gfc_symtree *sym, + char **&candidates, + size_t &candidates_len) +{ + gfc_symtree *p; + + if (sym == NULL) + return; + if ((sym->n.sym->ts.type != BT_UNKNOWN || sym->n.sym->attr.external) + && sym->n.sym->attr.flavor == FL_PROCEDURE) + vec_push (candidates, candidates_len, sym->name); + + p = sym->left; + if (p) + lookup_function_fuzzy_find_candidates (p, candidates, candidates_len); + + p = sym->right; + if (p) + lookup_function_fuzzy_find_candidates (p, candidates, candidates_len); +} + + +/* Lookup function FN fuzzily, taking names in SYMROOT into account. */ + +const char* +gfc_lookup_function_fuzzy (const char *fn, gfc_symtree *symroot) +{ + char **candidates = NULL; + size_t candidates_len = 0; + lookup_function_fuzzy_find_candidates (symroot, candidates, candidates_len); + return gfc_closest_fuzzy_match (fn, candidates); +} + /* Resolve a procedure call not known to be generic nor specific. */ @@ -2850,8 +2888,15 @@ resolve_unknown_f (gfc_expr *expr) if (ts->type == BT_UNKNOWN) { - gfc_error ("Function %qs at %L has no IMPLICIT type", - sym->name, &expr->where); + const char *guessed + = gfc_lookup_function_fuzzy (sym->name, sym->ns->sym_root); + if (guessed) + gfc_error ("Function %qs at %L has no IMPLICIT type" + "; did you mean %qs?", + sym->name, &expr->where, guessed); + else + gfc_error ("Function %qs at %L has no IMPLICIT type", + sym->name, &expr->where); return false; } else @@ -3712,6 +3757,46 @@ logical_to_bitwise (gfc_expr *e) return e; } +/* Recursively append candidate UOP to CANDIDATES. Store the number of + candidates in CANDIDATES_LEN. */ +static void +lookup_uop_fuzzy_find_candidates (gfc_symtree *uop, + char **&candidates, + size_t &candidates_len) +{ + gfc_symtree *p; + + if (uop == NULL) + return; + + /* Not sure how to properly filter here. Use all for a start. + n.uop.op is NULL for empty interface operators (is that legal?) disregard + these as i suppose they don't make terribly sense. */ + + if (uop->n.uop->op != NULL) + vec_push (candidates, candidates_len, uop->name); + + p = uop->left; + if (p) + lookup_uop_fuzzy_find_candidates (p, candidates, candidates_len); + + p = uop->right; + if (p) + lookup_uop_fuzzy_find_candidates (p, candidates, candidates_len); +} + +/* Lookup user-operator OP fuzzily, taking names in UOP into account. */ + +static const char* +lookup_uop_fuzzy (const char *op, gfc_symtree *uop) +{ + char **candidates = NULL; + size_t candidates_len = 0; + lookup_uop_fuzzy_find_candidates (uop, candidates, candidates_len); + return gfc_closest_fuzzy_match (op, candidates); +} + + /* Resolve an operator expression node. This can involve replacing the operation with a user defined function call. */ @@ -3934,8 +4019,16 @@ resolve_operator (gfc_expr *e) case INTRINSIC_USER: if (e->value.op.uop->op == NULL) - sprintf (msg, _("Unknown operator %%<%s%%> at %%L"), - e->value.op.uop->name); + { + const char *name = e->value.op.uop->name; + const char *guessed; + guessed = lookup_uop_fuzzy (name, e->value.op.uop->ns->uop_root); + if (guessed) + sprintf (msg, _("Unknown operator %%<%s%%> at %%L; did you mean '%s'?"), + name, guessed); + else + sprintf (msg, _("Unknown operator %%<%s%%> at %%L"), name); + } else if (op2 == NULL) sprintf (msg, _("Operand of user operator %%<%s%%> at %%L is %s"), e->value.op.uop->name, gfc_typename (&op1->ts)); @@ -9196,6 +9289,9 @@ resolve_transfer (gfc_code *code) "an assumed-size array", &code->loc); return; } + + if (async_io_dt && exp->expr_type == EXPR_VARIABLE) + exp->symtree->n.sym->attr.asynchronous = 1; } @@ -10912,6 +11008,8 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_TASK: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TEAMS: case EXEC_OMP_TEAMS_DISTRIBUTE: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -10927,8 +11025,6 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_DO_SIMD: case EXEC_OMP_SIMD: case EXEC_OMP_TARGET_SIMD: - case EXEC_OMP_TASKLOOP: - case EXEC_OMP_TASKLOOP_SIMD: gfc_resolve_omp_do_blocks (code, ns); break; case EXEC_SELECT_TYPE: @@ -11189,7 +11285,8 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns) { gfc_iterator *iter = code->ext.iterator; if (gfc_resolve_iterator (iter, true, false)) - gfc_resolve_do_iterator (code, iter->var->symtree->n.sym); + gfc_resolve_do_iterator (code, iter->var->symtree->n.sym, + true); } break; @@ -14079,6 +14176,11 @@ resolve_fl_namelist (gfc_symbol *sym) } } + if (async_io_dt) + { + for (nl = sym->namelist; nl; nl = nl->next) + nl->sym->attr.asynchronous = 1; + } return true; } @@ -14394,7 +14496,23 @@ resolve_symbol (gfc_symbol *sym) if (as) { - gcc_assert (as->type != AS_IMPLIED_SHAPE); + /* If AS_IMPLIED_SHAPE makes it to here, it must be a bad + specification expression. */ + if (as->type == AS_IMPLIED_SHAPE) + { + int i; + for (i=0; irank; i++) + { + if (as->lower[i] != NULL && as->upper[i] == NULL) + { + gfc_error ("Bad specification for assumed size array at %L", + &as->lower[i]->where); + return; + } + } + gcc_unreachable(); + } + if (((as->type == AS_ASSUMED_SIZE && !as->cp_was_assumed) || as->type == AS_ASSUMED_SHAPE) && !sym->attr.dummy && !sym->attr.select_type_temporary) @@ -14958,7 +15076,12 @@ resolve_symbol (gfc_symbol *sym) if ((!a->save && !a->dummy && !a->pointer && !a->in_common && !a->use_assoc - && !a->result && !a->function) + && a->referenced + && !((a->function || a->result) + && (!a->dimension + || sym->ts.u.derived->attr.alloc_comp + || sym->ts.u.derived->attr.pointer_comp)) + && !(a->function && sym != sym->result)) || (a->dummy && a->intent == INTENT_OUT && !a->pointer)) apply_default_init (sym); else if (a->function && sym->result && a->access != ACCESS_PRIVATE @@ -16230,6 +16353,7 @@ resolve_codes (gfc_namespace *ns) bitmap_obstack_initialize (&labels_obstack); gfc_resolve_oacc_declare (ns); + gfc_resolve_omp_local_vars (ns); gfc_resolve_code (ns->code, ns); bitmap_obstack_release (&labels_obstack); diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 82f431da52799..49decfac52a03 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -80,6 +80,7 @@ static struct gfc_file_change size_t file_changes_cur, file_changes_count; size_t file_changes_allocated; +static gfc_char_t *last_error_char; /* Functions dealing with our wide characters (gfc_char_t) and sequences of such characters. */ @@ -269,6 +270,7 @@ gfc_scanner_init_1 (void) continue_line = 0; end_flag = 0; + last_error_char = NULL; } @@ -1700,6 +1702,14 @@ gfc_gobble_whitespace (void) } while (gfc_is_whitespace (c)); + if (!ISPRINT(c) && c != '\n' && last_error_char != gfc_current_locus.nextc) + { + char buf[20]; + last_error_char = gfc_current_locus.nextc; + snprintf (buf, 20, "%2.2X", c); + gfc_error_now ("Invalid character 0x%s at %C", buf); + } + gfc_current_locus = old_loc; } diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 4c109fdfbad0d..36abba5a4881e 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -245,6 +245,44 @@ gfc_get_default_type (const char *name, gfc_namespace *ns) } +/* Recursively append candidate SYM to CANDIDATES. Store the number of + candidates in CANDIDATES_LEN. */ + +static void +lookup_symbol_fuzzy_find_candidates (gfc_symtree *sym, + char **&candidates, + size_t &candidates_len) +{ + gfc_symtree *p; + + if (sym == NULL) + return; + + if (sym->n.sym->ts.type != BT_UNKNOWN && sym->n.sym->ts.type != BT_PROCEDURE) + vec_push (candidates, candidates_len, sym->name); + p = sym->left; + if (p) + lookup_symbol_fuzzy_find_candidates (p, candidates, candidates_len); + + p = sym->right; + if (p) + lookup_symbol_fuzzy_find_candidates (p, candidates, candidates_len); +} + + +/* Lookup symbol SYM_NAME fuzzily, taking names in SYMBOL into account. */ + +static const char* +lookup_symbol_fuzzy (const char *sym_name, gfc_symbol *symbol) +{ + char **candidates = NULL; + size_t candidates_len = 0; + lookup_symbol_fuzzy_find_candidates (symbol->ns->sym_root, candidates, + candidates_len); + return gfc_closest_fuzzy_match (sym_name, candidates); +} + + /* Given a pointer to a symbol, set its type according to the first letter of its name. Fails if the letter in question has no default type. */ @@ -263,8 +301,14 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) { if (error_flag && !sym->attr.untyped) { - gfc_error ("Symbol %qs at %L has no IMPLICIT type", - sym->name, &sym->declared_at); + const char *guessed = lookup_symbol_fuzzy (sym->name, sym); + if (guessed) + gfc_error ("Symbol %qs at %L has no IMPLICIT type" + "; did you mean %qs?", + sym->name, &sym->declared_at, guessed); + else + gfc_error ("Symbol %qs at %L has no IMPLICIT type", + sym->name, &sym->declared_at); sym->attr.untyped = 1; /* Ensure we only give an error once. */ } @@ -2336,6 +2380,32 @@ find_union_component (gfc_symbol *un, const char *name, } +/* Recursively append candidate COMPONENT structures to CANDIDATES. Store + the number of total candidates in CANDIDATES_LEN. */ + +static void +lookup_component_fuzzy_find_candidates (gfc_component *component, + char **&candidates, + size_t &candidates_len) +{ + for (gfc_component *p = component; p; p = p->next) + vec_push (candidates, candidates_len, p->name); +} + + +/* Lookup component MEMBER fuzzily, taking names in COMPONENT into account. */ + +static const char* +lookup_component_fuzzy (const char *member, gfc_component *component) +{ + char **candidates = NULL; + size_t candidates_len = 0; + lookup_component_fuzzy_find_candidates (component, candidates, + candidates_len); + return gfc_closest_fuzzy_match (member, candidates); +} + + /* Given a derived type node and a component name, try to locate the component structure. Returns the NULL pointer if the component is not found or the components are private. If noaccess is set, no access @@ -2433,8 +2503,16 @@ gfc_find_component (gfc_symbol *sym, const char *name, } if (p == NULL && !silent) - gfc_error ("%qs at %C is not a member of the %qs structure", - name, sym->name); + { + const char *guessed = lookup_component_fuzzy (name, sym->components); + if (guessed) + gfc_error ("%qs at %C is not a member of the %qs structure" + "; did you mean %qs?", + name, sym->name, guessed); + else + gfc_error ("%qs at %C is not a member of the %qs structure", + name, sym->name); + } /* Component was found; build the ultimate component reference. */ if (p != NULL && ref) diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index ceca3accd9390..b2fe8eee01c18 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -429,7 +429,7 @@ gfc_interpret_logical (int kind, unsigned char *buffer, size_t buffer_size, { tree t = native_interpret_expr (gfc_get_logical_type (kind), buffer, buffer_size); - *logical = wi::eq_p (t, 0) ? 0 : 1; + *logical = wi::to_wide (t) == 0 ? 0 : 1; return size_logical (kind); } diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 328da4e78b193..a357389ae646e 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -8400,6 +8400,19 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, return tmp; } + if (purpose == DEALLOCATE_ALLOC_COMP && der_type->attr.pdt_type) + { + tmp = structure_alloc_comps (der_type, decl, NULL_TREE, rank, + DEALLOCATE_PDT_COMP, 0); + gfc_add_expr_to_block (&fnblock, tmp); + } + else if (purpose == ALLOCATE_PDT_COMP && der_type->attr.alloc_comp) + { + tmp = structure_alloc_comps (der_type, decl, NULL_TREE, rank, + NULLIFY_ALLOC_COMP, 0); + gfc_add_expr_to_block (&fnblock, tmp); + } + /* Otherwise, act on the components or recursively call self to act on a chain of components. */ for (c = der_type->components; c; c = c->next) @@ -9072,7 +9085,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, /* Recurse in to PDT components. */ if ((c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) - && c->ts.u.derived && c->ts.u.derived->attr.pdt_type) + && c->ts.u.derived && c->ts.u.derived->attr.pdt_type + && !(c->attr.pointer || c->attr.allocatable)) { bool is_deferred = false; gfc_actual_arglist *tail = c->param_list; @@ -9106,7 +9120,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, /* Recurse in to PDT components. */ if ((c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) - && c->ts.u.derived && c->ts.u.derived->attr.pdt_type) + && c->ts.u.derived && c->ts.u.derived->attr.pdt_type + && (!c->attr.pointer && !c->attr.allocatable)) { tmp = gfc_deallocate_pdt_comp (c->ts.u.derived, comp, c->as ? c->as->rank : 0); @@ -9116,13 +9131,23 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, if (c->attr.pdt_array) { tmp = gfc_conv_descriptor_data_get (comp); + null_cond = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, tmp, + build_int_cst (TREE_TYPE (tmp), 0)); tmp = gfc_call_free (tmp); + tmp = build3_v (COND_EXPR, null_cond, tmp, + build_empty_stmt (input_location)); gfc_add_expr_to_block (&fnblock, tmp); gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node); } else if (c->attr.pdt_string) { + null_cond = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, comp, + build_int_cst (TREE_TYPE (comp), 0)); tmp = gfc_call_free (comp); + tmp = build3_v (COND_EXPR, null_cond, tmp, + build_empty_stmt (input_location)); gfc_add_expr_to_block (&fnblock, tmp); tmp = fold_convert (TREE_TYPE (comp), null_pointer_node); gfc_add_modify (&fnblock, comp, tmp); diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index 128d47d0fa316..62b85f738fc21 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -211,7 +211,7 @@ gfc_conv_mpz_to_tree (mpz_t i, int kind) void gfc_conv_tree_to_mpz (mpz_t i, tree source) { - wi::to_mpz (source, i, TYPE_SIGN (TREE_TYPE (source))); + wi::to_mpz (wi::to_wide (source), i, TYPE_SIGN (TREE_TYPE (source))); } /* Converts a real constant into backend form. */ diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index b4f515f21d955..c21611c5d6c87 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1670,7 +1670,9 @@ gfc_get_symbol_decl (gfc_symbol * sym) { /* Catch functions. Only used for actual parameters, procedure pointers and procptr initialization targets. */ - if (sym->attr.use_assoc || sym->attr.intrinsic + if (sym->attr.use_assoc + || sym->attr.used_in_submodule + || sym->attr.intrinsic || sym->attr.if_source != IFSRC_DECL) { decl = gfc_get_extern_function_decl (sym); @@ -4634,6 +4636,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) } gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp); + /* TODO find out why this is necessary to stop double calls to + free. Somebody is reusing the expression in 'tmp' because + it is being used unititialized. */ + tmp = NULL_TREE; } } else if (sym->ts.type == BT_CHARACTER && sym->ts.deferred) diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index d1b61b5228bb2..4e8bfc5d6f92a 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2861,7 +2861,7 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs) HOST_WIDE_INT m; unsigned HOST_WIDE_INT n; int sgn; - wide_int wrhs = rhs; + wi::tree_to_wide_ref wrhs = wi::to_wide (rhs); /* If exponent is too large, we won't expand it anyway, so don't bother with large integer values. */ diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 9bc465e43d93d..532d3ab237d03 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2235,8 +2235,9 @@ trans_this_image (gfc_se * se, gfc_expr *expr) if (INTEGER_CST_P (dim_arg)) { - if (wi::ltu_p (dim_arg, 1) - || wi::gtu_p (dim_arg, GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc)))) + if (wi::ltu_p (wi::to_wide (dim_arg), 1) + || wi::gtu_p (wi::to_wide (dim_arg), + GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc)))) gfc_error ("% argument of %s intrinsic at %L is not a valid " "dimension index", expr->value.function.isym->name, &expr->where); @@ -2657,8 +2658,9 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) if (INTEGER_CST_P (bound)) { if (((!as || as->type != AS_ASSUMED_RANK) - && wi::geu_p (bound, GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc)))) - || wi::gtu_p (bound, GFC_MAX_DIMENSIONS)) + && wi::geu_p (wi::to_wide (bound), + GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc)))) + || wi::gtu_p (wi::to_wide (bound), GFC_MAX_DIMENSIONS)) gfc_error ("% argument of %s intrinsic at %L is not a valid " "dimension index", upper ? "UBOUND" : "LBOUND", &expr->where); @@ -2853,8 +2855,9 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr) if (INTEGER_CST_P (bound)) { - if (wi::ltu_p (bound, 1) - || wi::gtu_p (bound, GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc)))) + if (wi::ltu_p (wi::to_wide (bound), 1) + || wi::gtu_p (wi::to_wide (bound), + GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc)))) gfc_error ("% argument of %s intrinsic at %L is not a valid " "dimension index", expr->value.function.isym->name, &expr->where); diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 026f9a993d2b4..f3e1f3e4d09b9 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -2404,7 +2404,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, case BT_CLASS: if (ts->u.derived->components == NULL) return; - if (ts->type == BT_DERIVED || ts->type == BT_CLASS) + if (gfc_bt_struct (ts->type) || ts->type == BT_CLASS) { gfc_symbol *derived; gfc_symbol *dtio_sub = NULL; @@ -2438,7 +2438,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, function = iocall[IOCALL_X_DERIVED]; break; } - else if (ts->type == BT_DERIVED) + else if (gfc_bt_struct (ts->type)) { /* Recurse into the elements of the derived type. */ expr = gfc_evaluate_now (addr_expr, &se->pre); diff --git a/gcc/function.c b/gcc/function.c index c03e2ac514270..10bcefb2cfe61 100644 --- a/gcc/function.c +++ b/gcc/function.c @@ -4049,10 +4049,9 @@ gimplify_parameters (void) DECL_IGNORED_P (addr) = 0; local = build_fold_indirect_ref (addr); - t = builtin_decl_explicit (BUILT_IN_ALLOCA_WITH_ALIGN); - t = build_call_expr (t, 2, DECL_SIZE_UNIT (parm), - size_int (DECL_ALIGN (parm))); - + t = build_alloca_call_expr (DECL_SIZE_UNIT (parm), + DECL_ALIGN (parm), + max_int_size_in_bytes (type)); /* The call has been built for a variable-sized object. */ CALL_ALLOCA_FOR_VAR_P (t) = 1; t = fold_convert (ptr_type, t); diff --git a/gcc/fwprop.c b/gcc/fwprop.c index ca997490cf164..b77006b48019d 100644 --- a/gcc/fwprop.c +++ b/gcc/fwprop.c @@ -357,8 +357,8 @@ canonicalize_address (rtx x) { case ASHIFT: if (CONST_INT_P (XEXP (x, 1)) - && INTVAL (XEXP (x, 1)) < GET_MODE_BITSIZE (GET_MODE (x)) - && INTVAL (XEXP (x, 1)) >= 0) + && INTVAL (XEXP (x, 1)) < GET_MODE_UNIT_BITSIZE (GET_MODE (x)) + && INTVAL (XEXP (x, 1)) >= 0) { HOST_WIDE_INT shift = INTVAL (XEXP (x, 1)); PUT_CODE (x, MULT); diff --git a/gcc/gcc-ar.c b/gcc/gcc-ar.c index 78d2fc1ad3066..d5d80e042e5a4 100644 --- a/gcc/gcc-ar.c +++ b/gcc/gcc-ar.c @@ -194,14 +194,6 @@ main (int ac, char **av) #ifdef CROSS_DIRECTORY_STRUCTURE real_exe_name = concat (target_machine, "-", PERSONALITY, NULL); #endif - /* Do not search original location in the same folder. */ - char *exe_folder = lrealpath (av[0]); - exe_folder[strlen (exe_folder) - strlen (lbasename (exe_folder))] = '\0'; - char *location = concat (exe_folder, PERSONALITY, NULL); - - if (access (location, X_OK) == 0) - remove_prefix (exe_folder, &path); - exe_name = find_a_file (&path, real_exe_name, X_OK); if (!exe_name) { diff --git a/gcc/genrecog.c b/gcc/genrecog.c index 902762fbc5737..b3d02d755ebb4 100644 --- a/gcc/genrecog.c +++ b/gcc/genrecog.c @@ -751,6 +751,21 @@ validate_pattern (rtx pattern, md_rtx_info *info, rtx set, int set_code) error_at (info->loc, "vec_select parallel with %d elements, expected %d", XVECLEN (XEXP (pattern, 1), 0), expected); + else if (VECTOR_MODE_P (imode)) + { + unsigned int nelems = GET_MODE_NUNITS (imode); + int i; + for (i = 0; i < expected; ++i) + if (CONST_INT_P (XVECEXP (XEXP (pattern, 1), 0, i)) + && (UINTVAL (XVECEXP (XEXP (pattern, 1), 0, i)) + >= nelems)) + error_at (info->loc, + "out of bounds selector %u in vec_select, " + "expected at most %u", + (unsigned) + UINTVAL (XVECEXP (XEXP (pattern, 1), 0, i)), + nelems - 1); + } } if (imode != VOIDmode && !VECTOR_MODE_P (imode)) error_at (info->loc, "%smode of first vec_select operand is not a " diff --git a/gcc/gimple-expr.c b/gcc/gimple-expr.c index c1771fcf1d055..324f101658515 100644 --- a/gcc/gimple-expr.c +++ b/gcc/gimple-expr.c @@ -337,9 +337,8 @@ gimple_decl_printable_name (tree decl, int verbosity) if (!DECL_NAME (decl)) return NULL; - if (DECL_ASSEMBLER_NAME_SET_P (decl)) + if (HAS_DECL_ASSEMBLER_NAME_P (decl) && DECL_ASSEMBLER_NAME_SET_P (decl)) { - const char *str, *mangled_str; int dmgl_opts = DMGL_NO_OPTS; if (verbosity >= 2) @@ -352,9 +351,10 @@ gimple_decl_printable_name (tree decl, int verbosity) dmgl_opts |= DMGL_PARAMS; } - mangled_str = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (decl)); - str = cplus_demangle_v3 (mangled_str, dmgl_opts); - return (str) ? str : mangled_str; + const char *mangled_str + = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME_RAW (decl)); + const char *str = cplus_demangle_v3 (mangled_str, dmgl_opts); + return str ? str : mangled_str; } return IDENTIFIER_POINTER (DECL_NAME (decl)); diff --git a/gcc/gimple-fold.c b/gcc/gimple-fold.c index b9e08897f6d81..cb33c1e09fe4b 100644 --- a/gcc/gimple-fold.c +++ b/gcc/gimple-fold.c @@ -6784,7 +6784,7 @@ gimple_fold_indirect_ref (tree t) || DECL_P (TREE_OPERAND (addr, 0))) return fold_build2 (MEM_REF, type, addr, - wide_int_to_tree (ptype, off)); + wide_int_to_tree (ptype, wi::to_wide (off))); } /* *(foo *)fooarrptr => (*fooarrptr)[0] */ diff --git a/gcc/gimple-pretty-print.c b/gcc/gimple-pretty-print.c index ed8e51c1c4677..0da90740165b1 100644 --- a/gcc/gimple-pretty-print.c +++ b/gcc/gimple-pretty-print.c @@ -109,7 +109,7 @@ dump_profile (int frequency, profile_count &count) by xstrdup_for_dump. */ static const char * -dump_probability (profile_probability probability, profile_count &count) +dump_probability (profile_probability probability) { float minimum = 0.01f; float fvalue = -1; @@ -122,13 +122,10 @@ dump_probability (profile_probability probability, profile_count &count) } char *buf; - if (count.initialized_p ()) - buf = xasprintf ("[%.2f%%] [count: %" PRId64 "]", fvalue, - count.to_gcov_type ()); - else if (probability.initialized_p ()) - buf = xasprintf ("[%.2f%%] [count: INV]", fvalue); + if (probability.initialized_p ()) + buf = xasprintf ("[%.2f%%]", fvalue); else - buf = xasprintf ("[INV] [count: INV]"); + buf = xasprintf ("[INV]"); const char *ret = xstrdup_for_dump (buf); free (buf); @@ -141,7 +138,7 @@ dump_probability (profile_probability probability, profile_count &count) static void dump_edge_probability (pretty_printer *buffer, edge e) { - pp_scalar (buffer, " %s", dump_probability (e->probability, e->count)); + pp_scalar (buffer, " %s", dump_probability (e->probability)); } /* Print GIMPLE statement G to FILE using SPC indentation spaces and diff --git a/gcc/gimple-ssa-isolate-paths.c b/gcc/gimple-ssa-isolate-paths.c index 807e00324105d..ba5c6a3a71532 100644 --- a/gcc/gimple-ssa-isolate-paths.c +++ b/gcc/gimple-ssa-isolate-paths.c @@ -169,7 +169,6 @@ isolate_path (basic_block bb, basic_block duplicate, /* Update profile only when redirection is really processed. */ bb->frequency += EDGE_FREQUENCY (e); - bb->count += e->count; } /* There may be more than one statement in DUPLICATE which exhibits diff --git a/gcc/gimple-ssa-sprintf.c b/gcc/gimple-ssa-sprintf.c index 7899e09195fe2..9770df72898a7 100644 --- a/gcc/gimple-ssa-sprintf.c +++ b/gcc/gimple-ssa-sprintf.c @@ -583,7 +583,7 @@ get_format_string (tree format, location_t *ploc) /* For convenience and brevity. */ static bool - (* const fmtwarn) (const substring_loc &, const source_range *, + (* const fmtwarn) (const substring_loc &, location_t, const char *, int, const char *, ...) = format_warning_at_substring; @@ -2418,7 +2418,7 @@ should_warn_p (const pass_sprintf_length::call_info &info, Return true if a warning has been issued. */ static bool -maybe_warn (substring_loc &dirloc, source_range *pargrange, +maybe_warn (substring_loc &dirloc, location_t argloc, const pass_sprintf_length::call_info &info, const result_range &avail_range, const result_range &res, const directive &dir) @@ -2476,8 +2476,8 @@ maybe_warn (substring_loc &dirloc, source_range *pargrange, : G_("%qE writing a terminating nul past the end " "of the destination"))); - return fmtwarn (dirloc, NULL, NULL, info.warnopt (), fmtstr, - info.func); + return fmtwarn (dirloc, UNKNOWN_LOCATION, NULL, info.warnopt (), + fmtstr, info.func); } if (res.min == res.max) @@ -2500,7 +2500,7 @@ maybe_warn (substring_loc &dirloc, source_range *pargrange, "%wu bytes into a region of size %wu")) : G_("%<%.*s%> directive writing %wu bytes " "into a region of size %wu"))); - return fmtwarn (dirloc, pargrange, NULL, + return fmtwarn (dirloc, argloc, NULL, info.warnopt (), fmtstr, dir.len, target_to_host (hostdir, sizeof hostdir, dir.beg), res.min, navail); @@ -2517,7 +2517,7 @@ maybe_warn (substring_loc &dirloc, source_range *pargrange, "up to %wu bytes into a region of size %wu")) : G_("%<%.*s%> directive writing up to %wu bytes " "into a region of size %wu")); - return fmtwarn (dirloc, pargrange, NULL, + return fmtwarn (dirloc, argloc, NULL, info.warnopt (), fmtstr, dir.len, target_to_host (hostdir, sizeof hostdir, dir.beg), res.max, navail); @@ -2537,7 +2537,7 @@ maybe_warn (substring_loc &dirloc, source_range *pargrange, "likely %wu or more bytes into a region of size %wu")) : G_("%<%.*s%> directive writing likely %wu or more bytes " "into a region of size %wu")); - return fmtwarn (dirloc, pargrange, NULL, + return fmtwarn (dirloc, argloc, NULL, info.warnopt (), fmtstr, dir.len, target_to_host (hostdir, sizeof hostdir, dir.beg), res.likely, navail); @@ -2554,7 +2554,7 @@ maybe_warn (substring_loc &dirloc, source_range *pargrange, "between %wu and %wu bytes into a region of size %wu")) : G_("%<%.*s%> directive writing between %wu and " "%wu bytes into a region of size %wu")); - return fmtwarn (dirloc, pargrange, NULL, + return fmtwarn (dirloc, argloc, NULL, info.warnopt (), fmtstr, dir.len, target_to_host (hostdir, sizeof hostdir, dir.beg), res.min, res.max, navail); @@ -2569,7 +2569,7 @@ maybe_warn (substring_loc &dirloc, source_range *pargrange, "%wu or more bytes into a region of size %wu")) : G_("%<%.*s%> directive writing %wu or more bytes " "into a region of size %wu")); - return fmtwarn (dirloc, pargrange, NULL, + return fmtwarn (dirloc, argloc, NULL, info.warnopt (), fmtstr, dir.len, target_to_host (hostdir, sizeof hostdir, dir.beg), res.min, navail); @@ -2603,7 +2603,7 @@ maybe_warn (substring_loc &dirloc, source_range *pargrange, : G_("%qE writing a terminating nul past the end " "of the destination"))); - return fmtwarn (dirloc, NULL, NULL, info.warnopt (), fmtstr, + return fmtwarn (dirloc, UNKNOWN_LOCATION, NULL, info.warnopt (), fmtstr, info.func); } @@ -2628,7 +2628,7 @@ maybe_warn (substring_loc &dirloc, source_range *pargrange, : G_("%<%.*s%> directive writing %wu bytes " "into a region of size between %wu and %wu"))); - return fmtwarn (dirloc, pargrange, NULL, + return fmtwarn (dirloc, argloc, NULL, info.warnopt (), fmtstr, dir.len, target_to_host (hostdir, sizeof hostdir, dir.beg), res.min, avail_range.min, avail_range.max); @@ -2647,7 +2647,7 @@ maybe_warn (substring_loc &dirloc, source_range *pargrange, "%wu and %wu")) : G_("%<%.*s%> directive writing up to %wu bytes " "into a region of size between %wu and %wu")); - return fmtwarn (dirloc, pargrange, NULL, + return fmtwarn (dirloc, argloc, NULL, info.warnopt (), fmtstr, dir.len, target_to_host (hostdir, sizeof hostdir, dir.beg), res.max, avail_range.min, avail_range.max); @@ -2669,7 +2669,7 @@ maybe_warn (substring_loc &dirloc, source_range *pargrange, "%wu and %wu")) : G_("%<%.*s%> directive writing likely %wu or more bytes " "into a region of size between %wu and %wu")); - return fmtwarn (dirloc, pargrange, NULL, + return fmtwarn (dirloc, argloc, NULL, info.warnopt (), fmtstr, dir.len, target_to_host (hostdir, sizeof hostdir, dir.beg), res.likely, avail_range.min, avail_range.max); @@ -2688,7 +2688,7 @@ maybe_warn (substring_loc &dirloc, source_range *pargrange, "between %wu and %wu")) : G_("%<%.*s%> directive writing between %wu and " "%wu bytes into a region of size between %wu and %wu")); - return fmtwarn (dirloc, pargrange, NULL, + return fmtwarn (dirloc, argloc, NULL, info.warnopt (), fmtstr, dir.len, target_to_host (hostdir, sizeof hostdir, dir.beg), res.min, res.max, avail_range.min, avail_range.max); @@ -2705,7 +2705,7 @@ maybe_warn (substring_loc &dirloc, source_range *pargrange, "%wu and %wu")) : G_("%<%.*s%> directive writing %wu or more bytes " "into a region of size between %wu and %wu")); - return fmtwarn (dirloc, pargrange, NULL, + return fmtwarn (dirloc, argloc, NULL, info.warnopt (), fmtstr, dir.len, target_to_host (hostdir, sizeof hostdir, dir.beg), res.min, avail_range.min, avail_range.max); @@ -2730,17 +2730,11 @@ format_directive (const pass_sprintf_length::call_info &info, substring_loc dirloc (info.fmtloc, TREE_TYPE (info.format), offset, start, length); - /* Also create a location range for the argument if possible. + /* Also get the location of the argument if possible. This doesn't work for integer literals or function calls. */ - source_range argrange; - source_range *pargrange; - if (dir.arg && CAN_HAVE_LOCATION_P (dir.arg)) - { - argrange = EXPR_LOCATION_RANGE (dir.arg); - pargrange = &argrange; - } - else - pargrange = NULL; + location_t argloc = UNKNOWN_LOCATION; + if (dir.arg) + argloc = EXPR_LOCATION (dir.arg); /* Bail when there is no function to compute the output length, or when minimum length checking has been disabled. */ @@ -2797,7 +2791,7 @@ format_directive (const pass_sprintf_length::call_info &info, if (fmtres.nullp) { - fmtwarn (dirloc, pargrange, NULL, info.warnopt (), + fmtwarn (dirloc, argloc, NULL, info.warnopt (), "%<%.*s%> directive argument is null", dirlen, target_to_host (hostdir, sizeof hostdir, dir.beg)); @@ -2816,7 +2810,7 @@ format_directive (const pass_sprintf_length::call_info &info, bool warned = res->warned; if (!warned) - warned = maybe_warn (dirloc, pargrange, info, avail_range, + warned = maybe_warn (dirloc, argloc, info, avail_range, fmtres.range, dir); /* Bump up the total maximum if it isn't too big. */ @@ -2862,7 +2856,7 @@ format_directive (const pass_sprintf_length::call_info &info, (like Glibc does under some conditions). */ if (fmtres.range.min == fmtres.range.max) - warned = fmtwarn (dirloc, pargrange, NULL, + warned = fmtwarn (dirloc, argloc, NULL, info.warnopt (), "%<%.*s%> directive output of %wu bytes exceeds " "minimum required size of 4095", @@ -2878,7 +2872,7 @@ format_directive (const pass_sprintf_length::call_info &info, : G_("%<%.*s%> directive output between %wu and %wu " "bytes exceeds minimum required size of 4095")); - warned = fmtwarn (dirloc, pargrange, NULL, + warned = fmtwarn (dirloc, argloc, NULL, info.warnopt (), fmtstr, dirlen, target_to_host (hostdir, sizeof hostdir, dir.beg), fmtres.range.min, fmtres.range.max); @@ -2906,7 +2900,7 @@ format_directive (const pass_sprintf_length::call_info &info, to exceed INT_MAX bytes. */ if (fmtres.range.min == fmtres.range.max) - warned = fmtwarn (dirloc, pargrange, NULL, info.warnopt (), + warned = fmtwarn (dirloc, argloc, NULL, info.warnopt (), "%<%.*s%> directive output of %wu bytes causes " "result to exceed %", dirlen, @@ -2920,7 +2914,7 @@ format_directive (const pass_sprintf_length::call_info &info, "bytes causes result to exceed %") : G_ ("%<%.*s%> directive output between %wu and %wu " "bytes may cause result to exceed %")); - warned = fmtwarn (dirloc, pargrange, NULL, + warned = fmtwarn (dirloc, argloc, NULL, info.warnopt (), fmtstr, dirlen, target_to_host (hostdir, sizeof hostdir, dir.beg), fmtres.range.min, fmtres.range.max); @@ -3351,7 +3345,7 @@ parse_directive (pass_sprintf_length::call_info &info, substring_loc dirloc (info.fmtloc, TREE_TYPE (info.format), caret, begin, end); - fmtwarn (dirloc, NULL, NULL, + fmtwarn (dirloc, UNKNOWN_LOCATION, NULL, info.warnopt (), "%<%.*s%> directive width out of range", dir.len, target_to_host (hostdir, sizeof hostdir, dir.beg)); } @@ -3385,7 +3379,7 @@ parse_directive (pass_sprintf_length::call_info &info, substring_loc dirloc (info.fmtloc, TREE_TYPE (info.format), caret, begin, end); - fmtwarn (dirloc, NULL, NULL, + fmtwarn (dirloc, UNKNOWN_LOCATION, NULL, info.warnopt (), "%<%.*s%> directive precision out of range", dir.len, target_to_host (hostdir, sizeof hostdir, dir.beg)); } diff --git a/gcc/gimple-ssa-warn-alloca.c b/gcc/gimple-ssa-warn-alloca.c index ab4f9d82858f4..08c2195575a03 100644 --- a/gcc/gimple-ssa-warn-alloca.c +++ b/gcc/gimple-ssa-warn-alloca.c @@ -194,7 +194,8 @@ alloca_call_type_by_arg (tree arg, tree arg_casted, edge e, unsigned max_size) // degrade into "if (N > Y) alloca(N)". if (cond_code == GT_EXPR || cond_code == GE_EXPR) rhs = integer_zero_node; - return alloca_type_and_limit (ALLOCA_BOUND_MAYBE_LARGE, rhs); + return alloca_type_and_limit (ALLOCA_BOUND_MAYBE_LARGE, + wi::to_wide (rhs)); } } else @@ -263,7 +264,7 @@ is_max (tree x, wide_int max) // Analyze the alloca call in STMT and return the alloca type with its // corresponding limit (if applicable). IS_VLA is set if the alloca -// call is really a BUILT_IN_ALLOCA_WITH_ALIGN, signifying a VLA. +// call was created by the gimplifier for a VLA. // // If the alloca call may be too large because of a cast from a signed // type to an unsigned type, set *INVALID_CASTED_TYPE to the @@ -277,7 +278,8 @@ alloca_call_type (gimple *stmt, bool is_vla, tree *invalid_casted_type) tree len = gimple_call_arg (stmt, 0); tree len_casted = NULL; wide_int min, max; - struct alloca_type_and_limit ret = alloca_type_and_limit (ALLOCA_UNBOUNDED); + edge_iterator ei; + edge e; gcc_assert (!is_vla || (unsigned HOST_WIDE_INT) warn_vla_limit > 0); gcc_assert (is_vla || (unsigned HOST_WIDE_INT) warn_alloca_limit > 0); @@ -294,19 +296,22 @@ alloca_call_type (gimple *stmt, bool is_vla, tree *invalid_casted_type) if (TREE_CODE (len) == INTEGER_CST) { if (tree_to_uhwi (len) > max_size) - return alloca_type_and_limit (ALLOCA_BOUND_DEFINITELY_LARGE, len); + return alloca_type_and_limit (ALLOCA_BOUND_DEFINITELY_LARGE, + wi::to_wide (len)); if (integer_zerop (len)) return alloca_type_and_limit (ALLOCA_ARG_IS_ZERO); - ret = alloca_type_and_limit (ALLOCA_OK); + + return alloca_type_and_limit (ALLOCA_OK); } + // Check the range info if available. - else if (TREE_CODE (len) == SSA_NAME) + if (TREE_CODE (len) == SSA_NAME) { value_range_type range_type = get_range_info (len, &min, &max); if (range_type == VR_RANGE) { if (wi::leu_p (max, max_size)) - ret = alloca_type_and_limit (ALLOCA_OK); + return alloca_type_and_limit (ALLOCA_OK); else { // A cast may have created a range we don't care @@ -389,52 +394,41 @@ alloca_call_type (gimple *stmt, bool is_vla, tree *invalid_casted_type) // If we couldn't find anything, try a few heuristics for things we // can easily determine. Check these misc cases but only accept // them if all predecessors have a known bound. - basic_block bb = gimple_bb (stmt); - if (ret.type == ALLOCA_UNBOUNDED) + struct alloca_type_and_limit ret = alloca_type_and_limit (ALLOCA_OK); + FOR_EACH_EDGE (e, ei, gimple_bb (stmt)->preds) { - ret.type = ALLOCA_OK; - for (unsigned ix = 0; ix < EDGE_COUNT (bb->preds); ix++) - { - gcc_assert (!len_casted || TYPE_UNSIGNED (TREE_TYPE (len_casted))); - ret = alloca_call_type_by_arg (len, len_casted, - EDGE_PRED (bb, ix), max_size); - if (ret.type != ALLOCA_OK) - break; - } + gcc_assert (!len_casted || TYPE_UNSIGNED (TREE_TYPE (len_casted))); + ret = alloca_call_type_by_arg (len, len_casted, e, max_size); + if (ret.type != ALLOCA_OK) + break; + } + + if (ret.type != ALLOCA_OK && tentative_cast_from_signed) + ret = alloca_type_and_limit (ALLOCA_CAST_FROM_SIGNED); + + // If we have a declared maximum size, we can take it into account. + if (ret.type != ALLOCA_OK + && gimple_call_builtin_p (stmt, BUILT_IN_ALLOCA_WITH_ALIGN_AND_MAX)) + { + tree arg = gimple_call_arg (stmt, 2); + if (compare_tree_int (arg, max_size) <= 0) + ret = alloca_type_and_limit (ALLOCA_OK); + else + ret = alloca_type_and_limit (ALLOCA_BOUND_MAYBE_LARGE, + wi::to_wide (arg)); } - if (tentative_cast_from_signed && ret.type != ALLOCA_OK) - return alloca_type_and_limit (ALLOCA_CAST_FROM_SIGNED); return ret; } -// Return TRUE if the alloca call in STMT is in a loop, otherwise -// return FALSE. As an exception, ignore alloca calls for VLAs that -// occur in a loop since those will be cleaned up when they go out of -// scope. +// Return TRUE if STMT is in a loop, otherwise return FALSE. static bool -in_loop_p (bool is_vla, gimple *stmt) +in_loop_p (gimple *stmt) { basic_block bb = gimple_bb (stmt); - if (bb->loop_father - && bb->loop_father->header != ENTRY_BLOCK_PTR_FOR_FN (cfun)) - { - // Do not warn on VLAs occurring in a loop, since VLAs are - // guaranteed to be cleaned up when they go out of scope. - // That is, there is a corresponding __builtin_stack_restore - // at the end of the scope in which the VLA occurs. - tree fndecl = gimple_call_fn (stmt); - while (TREE_CODE (fndecl) == ADDR_EXPR) - fndecl = TREE_OPERAND (fndecl, 0); - if (DECL_BUILT_IN_CLASS (fndecl) == BUILT_IN_NORMAL - && is_vla - && DECL_FUNCTION_CODE (fndecl) == BUILT_IN_ALLOCA_WITH_ALIGN) - return false; - - return true; - } - return false; + return + bb->loop_father && bb->loop_father->header != ENTRY_BLOCK_PTR_FOR_FN (cfun); } unsigned int @@ -453,8 +447,8 @@ pass_walloca::execute (function *fun) continue; gcc_assert (gimple_call_num_args (stmt) >= 1); - bool is_vla = gimple_alloca_call_p (stmt) - && gimple_call_alloca_for_var_p (as_a (stmt)); + const bool is_vla + = gimple_call_alloca_for_var_p (as_a (stmt)); // Strict mode whining for VLAs is handled by the front-end, // so we can safely ignore this case. Also, ignore VLAs if @@ -474,9 +468,10 @@ pass_walloca::execute (function *fun) struct alloca_type_and_limit t = alloca_call_type (stmt, is_vla, &invalid_casted_type); - // Even if we think the alloca call is OK, make sure it's - // not in a loop. - if (t.type == ALLOCA_OK && in_loop_p (is_vla, stmt)) + // Even if we think the alloca call is OK, make sure it's not in a + // loop, except for a VLA, since VLAs are guaranteed to be cleaned + // up when they go out of scope, including in a loop. + if (t.type == ALLOCA_OK && !is_vla && in_loop_p (stmt)) t = alloca_type_and_limit (ALLOCA_IN_LOOP); enum opt_code wcode diff --git a/gcc/gimple.c b/gcc/gimple.c index c4e6f8176b9a4..1f291e10286d4 100644 --- a/gcc/gimple.c +++ b/gcc/gimple.c @@ -346,7 +346,7 @@ gimple_build_call_internal_vec (enum internal_fn fn, vec args) this fact. */ gcall * -gimple_build_call_from_tree (tree t) +gimple_build_call_from_tree (tree t, tree fnptrtype) { unsigned i, nargs; gcall *call; @@ -369,8 +369,7 @@ gimple_build_call_from_tree (tree t) gimple_call_set_return_slot_opt (call, CALL_EXPR_RETURN_SLOT_OPT (t)); if (fndecl && DECL_BUILT_IN_CLASS (fndecl) == BUILT_IN_NORMAL - && (DECL_FUNCTION_CODE (fndecl) == BUILT_IN_ALLOCA - || DECL_FUNCTION_CODE (fndecl) == BUILT_IN_ALLOCA_WITH_ALIGN)) + && ALLOCA_FUNCTION_CODE_P (DECL_FUNCTION_CODE (fndecl))) gimple_call_set_alloca_for_var (call, CALL_ALLOCA_FOR_VAR_P (t)); else gimple_call_set_from_thunk (call, CALL_FROM_THUNK_P (t)); @@ -380,6 +379,23 @@ gimple_build_call_from_tree (tree t) gimple_set_no_warning (call, TREE_NO_WARNING (t)); gimple_call_set_with_bounds (call, CALL_WITH_BOUNDS_P (t)); + if (fnptrtype) + { + gimple_call_set_fntype (call, TREE_TYPE (fnptrtype)); + + /* Check if it's an indirect CALL and the type has the + nocf_check attribute. In that case propagate the information + to the gimple CALL insn. */ + if (!fndecl) + { + gcc_assert (POINTER_TYPE_P (fnptrtype)); + tree fntype = TREE_TYPE (fnptrtype); + + if (lookup_attribute ("nocf_check", TYPE_ATTRIBUTES (fntype))) + gimple_call_set_nocf_check (call, TRUE); + } + } + return call; } @@ -2965,13 +2981,14 @@ preprocess_case_label_vec_for_gimple (vec labels, if (CASE_HIGH (labels[i]) != NULL_TREE && (CASE_HIGH (widest_label) == NULL_TREE - || wi::gtu_p (wi::sub (CASE_HIGH (labels[i]), - CASE_LOW (labels[i])), - wi::sub (CASE_HIGH (widest_label), - CASE_LOW (widest_label))))) + || (wi::gtu_p + (wi::to_wide (CASE_HIGH (labels[i])) + - wi::to_wide (CASE_LOW (labels[i])), + wi::to_wide (CASE_HIGH (widest_label)) + - wi::to_wide (CASE_LOW (widest_label)))))) widest_label = labels[i]; - if (wi::add (low, 1) != high) + if (wi::to_wide (low) + 1 != wi::to_wide (high)) break; } if (i == len) diff --git a/gcc/gimple.h b/gcc/gimple.h index 6213c49b91f46..334def89398ed 100644 --- a/gcc/gimple.h +++ b/gcc/gimple.h @@ -148,6 +148,7 @@ enum gf_mask { GF_CALL_WITH_BOUNDS = 1 << 8, GF_CALL_MUST_TAIL_CALL = 1 << 9, GF_CALL_BY_DESCRIPTOR = 1 << 10, + GF_CALL_NOCF_CHECK = 1 << 11, GF_OMP_PARALLEL_COMBINED = 1 << 0, GF_OMP_PARALLEL_GRID_PHONY = 1 << 1, GF_OMP_TASK_TASKLOOP = 1 << 0, @@ -1425,7 +1426,7 @@ gcall *gimple_build_call (tree, unsigned, ...); gcall *gimple_build_call_valist (tree, unsigned, va_list); gcall *gimple_build_call_internal (enum internal_fn, unsigned, ...); gcall *gimple_build_call_internal_vec (enum internal_fn, vec ); -gcall *gimple_build_call_from_tree (tree); +gcall *gimple_build_call_from_tree (tree, tree); gassign *gimple_build_assign (tree, tree CXX_MEM_STAT_INFO); gassign *gimple_build_assign (tree, enum tree_code, tree, tree, tree CXX_MEM_STAT_INFO); @@ -2893,6 +2894,25 @@ gimple_call_set_with_bounds (gimple *gs, bool with_bounds) } +/* Return true if call GS is marked as nocf_check. */ + +static inline bool +gimple_call_nocf_check_p (const gcall *gs) +{ + return (gs->subcode & GF_CALL_NOCF_CHECK) != 0; +} + +/* Mark statement GS as nocf_check call. */ + +static inline void +gimple_call_set_nocf_check (gcall *gs, bool nocf_check) +{ + if (nocf_check) + gs->subcode |= GF_CALL_NOCF_CHECK; + else + gs->subcode &= ~GF_CALL_NOCF_CHECK; +} + /* Return the target of internal call GS. */ static inline enum internal_fn diff --git a/gcc/gimplify.c b/gcc/gimplify.c index c3fd6ace84e6d..4c245103fc49f 100644 --- a/gcc/gimplify.c +++ b/gcc/gimplify.c @@ -1574,9 +1574,8 @@ gimplify_vla_decl (tree decl, gimple_seq *seq_p) SET_DECL_VALUE_EXPR (decl, t); DECL_HAS_VALUE_EXPR_P (decl) = 1; - t = builtin_decl_explicit (BUILT_IN_ALLOCA_WITH_ALIGN); - t = build_call_expr (t, 2, DECL_SIZE_UNIT (decl), - size_int (DECL_ALIGN (decl))); + t = build_alloca_call_expr (DECL_SIZE_UNIT (decl), DECL_ALIGN (decl), + max_int_size_in_bytes (TREE_TYPE (decl))); /* The call has been built for a variable-sized object. */ CALL_ALLOCA_FOR_VAR_P (t) = 1; t = fold_convert (ptr_type, t); @@ -1656,6 +1655,7 @@ gimplify_decl_expr (tree *stmt_p, gimple_seq *seq_p) && TREE_ADDRESSABLE (decl) && !TREE_STATIC (decl) && !DECL_HAS_VALUE_EXPR_P (decl) + && DECL_ALIGN (decl) <= MAX_SUPPORTED_STACK_ALIGNMENT && dbg_cnt (asan_use_after_scope)) { asan_poisoned_variables->add (decl); @@ -3173,8 +3173,7 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p, bool want_value) && DECL_BUILT_IN_CLASS (fndecl) == BUILT_IN_NORMAL) switch (DECL_FUNCTION_CODE (fndecl)) { - case BUILT_IN_ALLOCA: - case BUILT_IN_ALLOCA_WITH_ALIGN: + CASE_BUILT_IN_ALLOCA: /* If the call has been built for a variable-sized object, then we want to restore the stack level when the enclosing BIND_EXPR is exited to reclaim the allocated space; otherwise, we precisely @@ -3379,8 +3378,7 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p, bool want_value) /* The CALL_EXPR in *EXPR_P is already in GIMPLE form, so all we have to do is replicate it as a GIMPLE_CALL tuple. */ gimple_stmt_iterator gsi; - call = gimple_build_call_from_tree (*expr_p); - gimple_call_set_fntype (call, TREE_TYPE (fnptrtype)); + call = gimple_build_call_from_tree (*expr_p, fnptrtype); notice_special_calls (call); if (EXPR_CILK_SPAWN (*expr_p)) gimplify_cilk_detach (pre_p); @@ -5661,8 +5659,7 @@ gimplify_modify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p, CALL_EXPR_ARG (*from_p, 2)); else { - call_stmt = gimple_build_call_from_tree (*from_p); - gimple_call_set_fntype (call_stmt, TREE_TYPE (fnptrtype)); + call_stmt = gimple_build_call_from_tree (*from_p, fnptrtype); } } notice_special_calls (call_stmt); @@ -6505,7 +6502,9 @@ gimplify_target_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p) clobber = build2 (MODIFY_EXPR, TREE_TYPE (temp), temp, clobber); gimple_push_cleanup (temp, clobber, false, pre_p, true); } - if (asan_poisoned_variables && dbg_cnt (asan_use_after_scope)) + if (asan_poisoned_variables + && DECL_ALIGN (temp) <= MAX_SUPPORTED_STACK_ALIGNMENT + && dbg_cnt (asan_use_after_scope)) { tree asan_cleanup = build_asan_poison_call_expr (temp); if (asan_cleanup) diff --git a/gcc/go/ChangeLog b/gcc/go/ChangeLog index 3918fa814d735..1c0ef93291464 100644 --- a/gcc/go/ChangeLog +++ b/gcc/go/ChangeLog @@ -1,3 +1,8 @@ +2017-10-11 Tony Reix + + * go-system.h (__STDC_FORMAT_MACROS): Define before including any + system header files, as is done in ../system.h. + 2017-10-05 Ian Lance Taylor * Make-lang.in (GO_OBJS): Add go/names.o. diff --git a/gcc/go/go-system.h b/gcc/go/go-system.h index 90185435c1edc..b1c67c3cd7300 100644 --- a/gcc/go/go-system.h +++ b/gcc/go/go-system.h @@ -22,6 +22,12 @@ #include "config.h" +/* Define this so that inttypes.h defines the PRI?64 macros even + when compiling with a C++ compiler. Define it here so in the + event inttypes.h gets pulled in by another header it is already + defined. */ +#define __STDC_FORMAT_MACROS + // These must be included before the #poison declarations in system.h. #include diff --git a/gcc/go/gofrontend/MERGE b/gcc/go/gofrontend/MERGE index acb1d9584a31a..8b1846d07c4f3 100644 --- a/gcc/go/gofrontend/MERGE +++ b/gcc/go/gofrontend/MERGE @@ -1,4 +1,4 @@ -adc6eb826f156d0980f0ad9f9efc5c919ec4905e +a409ac2c78899e638a014c97891925bec93cb3ad The first line of this file holds the git revision number of the last merge done from the gofrontend repository. diff --git a/gcc/go/gofrontend/import.cc b/gcc/go/gofrontend/import.cc index 20b077f7f9985..2a3ea83ca7896 100644 --- a/gcc/go/gofrontend/import.cc +++ b/gcc/go/gofrontend/import.cc @@ -756,13 +756,6 @@ Import::read_type() this->require_c_string(" "); - bool is_alias = false; - if (this->match_c_string("= ")) - { - stream->advance(2); - is_alias = true; - } - // The package name may follow. This is the name of the package in // the package clause of that package. The type name will include // the pkgpath, which may be different. @@ -775,6 +768,13 @@ Import::read_type() this->require_c_string(" "); } + bool is_alias = false; + if (this->match_c_string("= ")) + { + stream->advance(2); + is_alias = true; + } + // Declare the type in the appropriate package. If we haven't seen // it before, mark it as invisible. We declare it before we read // the actual definition of the type, since the definition may refer diff --git a/gcc/godump.c b/gcc/godump.c index 28d81a1e26005..9a9d70fd59e77 100644 --- a/gcc/godump.c +++ b/gcc/godump.c @@ -1159,7 +1159,7 @@ go_output_typedef (struct godump_container *container, tree decl) snprintf (buf, sizeof buf, HOST_WIDE_INT_PRINT_UNSIGNED, tree_to_uhwi (TREE_VALUE (element))); else - print_hex (element, buf); + print_hex (wi::to_wide (element), buf); mhval->value = xstrdup (buf); *slot = mhval; diff --git a/gcc/graphite-dependences.c b/gcc/graphite-dependences.c index 2066b2ea59cd2..bd3e91ba86088 100644 --- a/gcc/graphite-dependences.c +++ b/gcc/graphite-dependences.c @@ -67,9 +67,9 @@ add_pdr_constraints (poly_dr_p pdr, poly_bb_p pbb) reads are returned in READS and writes in MUST_WRITES and MAY_WRITES. */ static void -scop_get_reads_and_writes (scop_p scop, isl_union_map *reads, - isl_union_map *must_writes, - isl_union_map *may_writes) +scop_get_reads_and_writes (scop_p scop, isl_union_map *&reads, + isl_union_map *&must_writes, + isl_union_map *&may_writes) { int i, j; poly_bb_p pbb; diff --git a/gcc/graphite-isl-ast-to-gimple.c b/gcc/graphite-isl-ast-to-gimple.c index dddc07b5b433a..b39ac5441c3cc 100644 --- a/gcc/graphite-isl-ast-to-gimple.c +++ b/gcc/graphite-isl-ast-to-gimple.c @@ -56,17 +56,9 @@ along with GCC; see the file COPYING3. If not see #include "cfganal.h" #include "value-prof.h" #include "tree-ssa.h" +#include "tree-vectorizer.h" #include "graphite.h" -/* We always try to use signed 128 bit types, but fall back to smaller types - in case a platform does not provide types of these sizes. In the future we - should use isl to derive the optimal type for each subexpression. */ - -static int max_mode_int_precision = - GET_MODE_PRECISION (int_mode_for_size (MAX_FIXED_MODE_SIZE, 0).require ()); -static int graphite_expression_type_precision = 128 <= max_mode_int_precision ? - 128 : max_mode_int_precision; - struct ast_build_info { ast_build_info() @@ -143,8 +135,7 @@ enum phi_node_kind class translate_isl_ast_to_gimple { public: - translate_isl_ast_to_gimple (sese_info_p r) - : region (r), codegen_error (false) { } + translate_isl_ast_to_gimple (sese_info_p r); edge translate_isl_ast (loop_p context_loop, __isl_keep isl_ast_node *node, edge next_e, ivs_params &ip); edge translate_isl_ast_node_for (loop_p context_loop, @@ -177,6 +168,7 @@ class translate_isl_ast_to_gimple tree gcc_expression_from_isl_ast_expr_id (tree type, __isl_keep isl_ast_expr *expr_id, ivs_params &ip); + widest_int widest_int_from_isl_expr_int (__isl_keep isl_ast_expr *expr); tree gcc_expression_from_isl_expr_int (tree type, __isl_take isl_ast_expr *expr); tree gcc_expression_from_isl_expr_op (tree type, @@ -198,14 +190,12 @@ class translate_isl_ast_to_gimple __isl_give isl_ast_node * scop_to_isl_ast (scop_p scop); tree get_rename_from_scev (tree old_name, gimple_seq *stmts, loop_p loop, - basic_block new_bb, basic_block old_bb, vec iv_map); - bool graphite_copy_stmts_from_block (basic_block bb, basic_block new_bb, + void graphite_copy_stmts_from_block (basic_block bb, basic_block new_bb, vec iv_map); edge copy_bb_and_scalar_dependences (basic_block bb, edge next_e, vec iv_map); void set_rename (tree old_name, tree expr); - void set_rename_for_each_def (gimple *stmt); void gsi_insert_earliest (gimple_seq seq); bool codegen_error_p () const { return codegen_error; } @@ -234,8 +224,24 @@ class translate_isl_ast_to_gimple /* A vector of all the edges at if_condition merge points. */ auto_vec merge_points; + + tree graphite_expr_type; }; +translate_isl_ast_to_gimple::translate_isl_ast_to_gimple (sese_info_p r) + : region (r), codegen_error (false) +{ + /* We always try to use signed 128 bit types, but fall back to smaller types + in case a platform does not provide types of these sizes. In the future we + should use isl to derive the optimal type for each subexpression. */ + int max_mode_int_precision + = GET_MODE_PRECISION (int_mode_for_size (MAX_FIXED_MODE_SIZE, 0).require ()); + int graphite_expr_type_precision + = 128 <= max_mode_int_precision ? 128 : max_mode_int_precision; + graphite_expr_type + = build_nonstandard_integer_type (graphite_expr_type_precision, 0); +} + /* Return the tree variable that corresponds to the given isl ast identifier expression (an isl_ast_expr of type isl_ast_expr_id). @@ -258,36 +264,51 @@ gcc_expression_from_isl_ast_expr_id (tree type, "Could not map isl_id to tree expression"); isl_ast_expr_free (expr_id); tree t = res->second; - tree *val = region->parameter_rename_map->get(t); - - if (!val) - val = &t; - return fold_convert (type, *val); + if (useless_type_conversion_p (type, TREE_TYPE (t))) + return t; + return fold_convert (type, t); } -/* Converts an isl_ast_expr_int expression E to a GCC expression tree of - type TYPE. */ +/* Converts an isl_ast_expr_int expression E to a widest_int. + Raises a code generation error when the constant doesn't fit. */ -tree translate_isl_ast_to_gimple:: -gcc_expression_from_isl_expr_int (tree type, __isl_take isl_ast_expr *expr) +widest_int translate_isl_ast_to_gimple:: +widest_int_from_isl_expr_int (__isl_keep isl_ast_expr *expr) { gcc_assert (isl_ast_expr_get_type (expr) == isl_ast_expr_int); isl_val *val = isl_ast_expr_get_val (expr); size_t n = isl_val_n_abs_num_chunks (val, sizeof (HOST_WIDE_INT)); HOST_WIDE_INT *chunks = XALLOCAVEC (HOST_WIDE_INT, n); - tree res; - if (isl_val_get_abs_num_chunks (val, sizeof (HOST_WIDE_INT), chunks) == -1) - res = NULL_TREE; - else + if (n > WIDE_INT_MAX_ELTS + || isl_val_get_abs_num_chunks (val, sizeof (HOST_WIDE_INT), chunks) == -1) { - widest_int wi = widest_int::from_array (chunks, n, true); - if (isl_val_is_neg (val)) - wi = -wi; - res = wide_int_to_tree (type, wi); + isl_val_free (val); + set_codegen_error (); + return 0; } + widest_int wi = widest_int::from_array (chunks, n, true); + if (isl_val_is_neg (val)) + wi = -wi; isl_val_free (val); + return wi; +} + +/* Converts an isl_ast_expr_int expression E to a GCC expression tree of + type TYPE. Raises a code generation error when the constant doesn't fit. */ + +tree translate_isl_ast_to_gimple:: +gcc_expression_from_isl_expr_int (tree type, __isl_take isl_ast_expr *expr) +{ + widest_int wi = widest_int_from_isl_expr_int (expr); isl_ast_expr_free (expr); - return res; + if (codegen_error_p ()) + return NULL_TREE; + if (wi::min_precision (wi, TYPE_SIGN (type)) > TYPE_PRECISION (type)) + { + set_codegen_error (); + return NULL_TREE; + } + return wide_int_to_tree (type, wi); } /* Converts a binary isl_ast_expr_op expression E to a GCC expression tree of @@ -296,14 +317,25 @@ gcc_expression_from_isl_expr_int (tree type, __isl_take isl_ast_expr *expr) tree translate_isl_ast_to_gimple:: binary_op_to_tree (tree type, __isl_take isl_ast_expr *expr, ivs_params &ip) { + enum isl_ast_op_type expr_type = isl_ast_expr_get_op_type (expr); isl_ast_expr *arg_expr = isl_ast_expr_get_op_arg (expr, 0); tree tree_lhs_expr = gcc_expression_from_isl_expression (type, arg_expr, ip); arg_expr = isl_ast_expr_get_op_arg (expr, 1); - tree tree_rhs_expr = gcc_expression_from_isl_expression (type, arg_expr, ip); - - enum isl_ast_op_type expr_type = isl_ast_expr_get_op_type (expr); isl_ast_expr_free (expr); + /* From our constraint generation we may get modulo operations that + we cannot represent explicitely but that are no-ops for TYPE. + Elide those. */ + if (expr_type == isl_ast_op_pdiv_r + && isl_ast_expr_get_type (arg_expr) == isl_ast_expr_int + && (wi::exact_log2 (widest_int_from_isl_expr_int (arg_expr)) + >= TYPE_PRECISION (type))) + { + isl_ast_expr_free (arg_expr); + return tree_lhs_expr; + } + + tree tree_rhs_expr = gcc_expression_from_isl_expression (type, arg_expr, ip); if (codegen_error_p ()) return NULL_TREE; @@ -319,44 +351,16 @@ binary_op_to_tree (tree type, __isl_take isl_ast_expr *expr, ivs_params &ip) return fold_build2 (MULT_EXPR, type, tree_lhs_expr, tree_rhs_expr); case isl_ast_op_div: - /* As isl operates on arbitrary precision numbers, we may end up with - division by 2^64 that is folded to 0. */ - if (integer_zerop (tree_rhs_expr)) - { - set_codegen_error (); - return NULL_TREE; - } return fold_build2 (EXACT_DIV_EXPR, type, tree_lhs_expr, tree_rhs_expr); case isl_ast_op_pdiv_q: - /* As isl operates on arbitrary precision numbers, we may end up with - division by 2^64 that is folded to 0. */ - if (integer_zerop (tree_rhs_expr)) - { - set_codegen_error (); - return NULL_TREE; - } return fold_build2 (TRUNC_DIV_EXPR, type, tree_lhs_expr, tree_rhs_expr); case isl_ast_op_zdiv_r: case isl_ast_op_pdiv_r: - /* As isl operates on arbitrary precision numbers, we may end up with - division by 2^64 that is folded to 0. */ - if (integer_zerop (tree_rhs_expr)) - { - set_codegen_error (); - return NULL_TREE; - } return fold_build2 (TRUNC_MOD_EXPR, type, tree_lhs_expr, tree_rhs_expr); case isl_ast_op_fdiv_q: - /* As isl operates on arbitrary precision numbers, we may end up with - division by 2^64 that is folded to 0. */ - if (integer_zerop (tree_rhs_expr)) - { - set_codegen_error (); - return NULL_TREE; - } return fold_build2 (FLOOR_DIV_EXPR, type, tree_lhs_expr, tree_rhs_expr); case isl_ast_op_and: @@ -701,8 +705,7 @@ translate_isl_ast_node_for (loop_p context_loop, __isl_keep isl_ast_node *node, edge next_e, ivs_params &ip) { gcc_assert (isl_ast_node_get_type (node) == isl_ast_node_for); - tree type - = build_nonstandard_integer_type (graphite_expression_type_precision, 0); + tree type = graphite_expr_type; isl_ast_expr *for_init = isl_ast_node_for_get_init (node); tree lb = gcc_expression_from_isl_expression (type, for_init, ip); @@ -741,18 +744,15 @@ build_iv_mapping (vec iv_map, gimple_poly_bb_p gbb, for (i = 1; i < isl_ast_expr_get_op_n_arg (user_expr); i++) { arg_expr = isl_ast_expr_get_op_arg (user_expr, i); - tree type = - build_nonstandard_integer_type (graphite_expression_type_precision, 0); + tree type = graphite_expr_type; tree t = gcc_expression_from_isl_expression (type, arg_expr, ip); /* To fail code generation, we generate wrong code until we discard it. */ if (codegen_error_p ()) t = integer_zero_node; - loop_p old_loop = gbb_loop_at_index (gbb, region, i - 2); - /* Record sth only for real loops. */ - if (loop_in_sese_p (old_loop, region)) - iv_map[old_loop->num] = t; + loop_p old_loop = gbb_loop_at_index (gbb, region, i - 1); + iv_map[old_loop->num] = t; } } @@ -791,13 +791,12 @@ translate_isl_ast_node_user (__isl_keep isl_ast_node *node, isl_ast_expr_free (user_expr); basic_block old_bb = GBB_BB (gbb); - if (dump_file) + if (dump_file && (dump_flags & TDF_DETAILS)) { fprintf (dump_file, "[codegen] copying from bb_%d on edge (bb_%d, bb_%d)\n", old_bb->index, next_e->src->index, next_e->dest->index); print_loops_bb (dump_file, GBB_BB (gbb), 0, 3); - } next_e = copy_bb_and_scalar_dependences (old_bb, next_e, iv_map); @@ -807,7 +806,7 @@ translate_isl_ast_node_user (__isl_keep isl_ast_node *node, if (codegen_error_p ()) return NULL; - if (dump_file) + if (dump_file && (dump_flags & TDF_DETAILS)) { fprintf (dump_file, "[codegen] (after copy) new basic block\n"); print_loops_bb (dump_file, next_e->src, 0, 3); @@ -842,8 +841,7 @@ edge translate_isl_ast_to_gimple:: graphite_create_new_guard (edge entry_edge, __isl_take isl_ast_expr *if_cond, ivs_params &ip) { - tree type = - build_nonstandard_integer_type (graphite_expression_type_precision, 0); + tree type = graphite_expr_type; tree cond_expr = gcc_expression_from_isl_expression (type, if_cond, ip); /* To fail code generation, we generate wrong code until we discard it. */ @@ -933,32 +931,12 @@ set_rename (tree old_name, tree expr) { fprintf (dump_file, "[codegen] setting rename: old_name = "); print_generic_expr (dump_file, old_name); - fprintf (dump_file, ", new_name = "); + fprintf (dump_file, ", new decl = "); print_generic_expr (dump_file, expr); fprintf (dump_file, "\n"); } - - if (old_name == expr) - return; - - vec *renames = region->rename_map->get (old_name); - - if (renames) - renames->safe_push (expr); - else - { - vec r; - r.create (2); - r.safe_push (expr); - region->rename_map->put (old_name, r); - } - - tree t; - int i; - /* For a parameter of a scop we don't want to rename it. */ - FOR_EACH_VEC_ELT (region->params, i, t) - if (old_name == t) - region->parameter_rename_map->put(old_name, expr); + bool res = region->rename_map->put (old_name, expr); + gcc_assert (! res); } /* Return an iterator to the instructions comes last in the execution order. @@ -1070,9 +1048,9 @@ gsi_insert_earliest (gimple_seq seq) if (dump_file) { - fprintf (dump_file, "[codegen] inserting statement: "); + fprintf (dump_file, "[codegen] inserting statement in BB %d: ", + gimple_bb (use_stmt)->index); print_gimple_stmt (dump_file, use_stmt, 0, TDF_VOPS | TDF_MEMSYMS); - print_loops_bb (dump_file, gimple_bb (use_stmt), 0, 3); } } } @@ -1082,7 +1060,6 @@ gsi_insert_earliest (gimple_seq seq) tree translate_isl_ast_to_gimple:: get_rename_from_scev (tree old_name, gimple_seq *stmts, loop_p loop, - basic_block new_bb, basic_block, vec iv_map) { tree scev = scalar_evolution_in_region (region->region, loop, old_name); @@ -1111,16 +1088,6 @@ get_rename_from_scev (tree old_name, gimple_seq *stmts, loop_p loop, return build_zero_cst (TREE_TYPE (old_name)); } - if (TREE_CODE (new_expr) == SSA_NAME) - { - basic_block bb = gimple_bb (SSA_NAME_DEF_STMT (new_expr)); - if (bb && !dominated_by_p (CDI_DOMINATORS, new_bb, bb)) - { - set_codegen_error (); - return build_zero_cst (TREE_TYPE (old_name)); - } - } - /* Replace the old_name with the new_expr. */ return force_gimple_operand (unshare_expr (new_expr), stmts, true, NULL_TREE); @@ -1148,36 +1115,13 @@ should_copy_to_new_region (gimple *stmt, sese_info_p region) && scev_analyzable_p (lhs, region->region)) return false; - /* Do not copy parameters that have been generated in the header of the - scop. */ - if (is_gimple_assign (stmt) - && (lhs = gimple_assign_lhs (stmt)) - && TREE_CODE (lhs) == SSA_NAME - && region->parameter_rename_map->get(lhs)) - return false; - return true; } -/* Create new names for all the definitions created by COPY and add replacement - mappings for each new name. */ - -void translate_isl_ast_to_gimple:: -set_rename_for_each_def (gimple *stmt) -{ - def_operand_p def_p; - ssa_op_iter op_iter; - FOR_EACH_SSA_DEF_OPERAND (def_p, stmt, op_iter, SSA_OP_ALL_DEFS) - { - tree old_name = DEF_FROM_PTR (def_p); - create_new_def_for (old_name, stmt, def_p); - } -} - /* Duplicates the statements of basic block BB into basic block NEW_BB and compute the new induction variables according to the IV_MAP. */ -bool translate_isl_ast_to_gimple:: +void translate_isl_ast_to_gimple:: graphite_copy_stmts_from_block (basic_block bb, basic_block new_bb, vec iv_map) { @@ -1194,7 +1138,6 @@ graphite_copy_stmts_from_block (basic_block bb, basic_block new_bb, /* Create a new copy of STMT and duplicate STMT's virtual operands. */ gimple *copy = gimple_copy (stmt); - gsi_insert_after (&gsi_tgt, copy, GSI_NEW_STMT); /* Rather than not copying debug stmts we reset them. ??? Where we can rewrite uses without inserting new @@ -1209,22 +1152,26 @@ graphite_copy_stmts_from_block (basic_block bb, basic_block new_bb, gcc_unreachable (); } - if (dump_file) - { - fprintf (dump_file, "[codegen] inserting statement: "); - print_gimple_stmt (dump_file, copy, 0); - } - maybe_duplicate_eh_stmt (copy, stmt); gimple_duplicate_stmt_histograms (cfun, copy, cfun, stmt); /* Crete new names for each def in the copied stmt. */ - set_rename_for_each_def (copy); + def_operand_p def_p; + ssa_op_iter op_iter; + FOR_EACH_SSA_DEF_OPERAND (def_p, copy, op_iter, SSA_OP_ALL_DEFS) + { + tree old_name = DEF_FROM_PTR (def_p); + create_new_def_for (old_name, copy, def_p); + } - if (codegen_error_p ()) - return false; + gsi_insert_after (&gsi_tgt, copy, GSI_NEW_STMT); + if (dump_file) + { + fprintf (dump_file, "[codegen] inserting statement: "); + print_gimple_stmt (dump_file, copy, 0); + } - /* For each SSA_NAME in the parameter_rename_map rename their usage. */ + /* For each SCEV analyzable SSA_NAME, rename their usage. */ ssa_op_iter iter; use_operand_p use_p; if (!is_gimple_debug (copy)) @@ -1233,33 +1180,20 @@ graphite_copy_stmts_from_block (basic_block bb, basic_block new_bb, tree old_name = USE_FROM_PTR (use_p); if (TREE_CODE (old_name) != SSA_NAME - || SSA_NAME_IS_DEFAULT_DEF (old_name)) + || SSA_NAME_IS_DEFAULT_DEF (old_name) + || ! scev_analyzable_p (old_name, region->region)) continue; - tree *new_expr = region->parameter_rename_map->get (old_name); - tree new_name; - if (!new_expr - && scev_analyzable_p (old_name, region->region)) - { - gimple_seq stmts = NULL; - new_name = get_rename_from_scev (old_name, &stmts, - bb->loop_father, - new_bb, bb, iv_map); - if (! codegen_error_p ()) - gsi_insert_earliest (stmts); - new_expr = &new_name; - } - - if (!new_expr) - continue; - - replace_exp (use_p, *new_expr); + gimple_seq stmts = NULL; + tree new_name = get_rename_from_scev (old_name, &stmts, + bb->loop_father, iv_map); + if (! codegen_error_p ()) + gsi_insert_earliest (stmts); + replace_exp (use_p, new_name); } update_stmt (copy); } - - return true; } @@ -1282,39 +1216,21 @@ copy_bb_and_scalar_dependences (basic_block bb, edge next_e, vec iv_map) continue; tree new_phi_def; - vec *renames = region->rename_map->get (res); - if (! renames || renames->is_empty ()) + tree *rename = region->rename_map->get (res); + if (! rename) { new_phi_def = create_tmp_reg (TREE_TYPE (res)); set_rename (res, new_phi_def); } else - { - gcc_assert (renames->length () == 1); - new_phi_def = (*renames)[0]; - } + new_phi_def = *rename; gassign *ass = gimple_build_assign (NULL_TREE, new_phi_def); create_new_def_for (res, ass, NULL); gsi_insert_after (&gsi_tgt, ass, GSI_NEW_STMT); } - vec *copied_bbs = region->copied_bb_map->get (bb); - if (copied_bbs) - copied_bbs->safe_push (new_bb); - else - { - vec bbs; - bbs.create (2); - bbs.safe_push (new_bb); - region->copied_bb_map->put (bb, bbs); - } - - if (!graphite_copy_stmts_from_block (bb, new_bb, iv_map)) - { - set_codegen_error (); - return NULL; - } + graphite_copy_stmts_from_block (bb, new_bb, iv_map); /* Insert out-of SSA copies on the original BB outgoing edges. */ gsi_tgt = gsi_last_bb (new_bb); @@ -1340,17 +1256,14 @@ copy_bb_and_scalar_dependences (basic_block bb, edge next_e, vec iv_map) continue; tree new_phi_def; - vec *renames = region->rename_map->get (res); - if (! renames || renames->is_empty ()) + tree *rename = region->rename_map->get (res); + if (! rename) { new_phi_def = create_tmp_reg (TREE_TYPE (res)); set_rename (res, new_phi_def); } else - { - gcc_assert (renames->length () == 1); - new_phi_def = (*renames)[0]; - } + new_phi_def = *rename; tree arg = PHI_ARG_DEF_FROM_EDGE (phi, e); if (TREE_CODE (arg) == SSA_NAME @@ -1359,7 +1272,7 @@ copy_bb_and_scalar_dependences (basic_block bb, edge next_e, vec iv_map) gimple_seq stmts = NULL; tree new_name = get_rename_from_scev (arg, &stmts, bb->loop_father, - new_bb, bb, iv_map); + iv_map); if (! codegen_error_p ()) gsi_insert_earliest (stmts); arg = new_name; @@ -1385,13 +1298,14 @@ add_parameters_to_ivs_params (scop_p scop, ivs_params &ip) { sese_info_p region = scop->scop_info; unsigned nb_parameters = isl_set_dim (scop->param_context, isl_dim_param); - gcc_assert (nb_parameters == region->params.length ()); + gcc_assert (nb_parameters == sese_nb_params (region)); unsigned i; - for (i = 0; i < nb_parameters; i++) + tree param; + FOR_EACH_VEC_ELT (region->params, i, param) { isl_id *tmp_id = isl_set_get_dim_id (scop->param_context, isl_dim_param, i); - ip[tmp_id] = region->params[i]; + ip[tmp_id] = param; } } @@ -1427,6 +1341,13 @@ ast_build_before_for (__isl_keep isl_ast_build *build, void *user) __isl_give isl_ast_node *translate_isl_ast_to_gimple:: scop_to_isl_ast (scop_p scop) { + int old_err = isl_options_get_on_error (scop->isl_context); + int old_max_operations = isl_ctx_get_max_operations (scop->isl_context); + int max_operations = PARAM_VALUE (PARAM_MAX_ISL_OPERATIONS); + if (max_operations) + isl_ctx_set_max_operations (scop->isl_context, max_operations); + isl_options_set_on_error (scop->isl_context, ISL_ON_ERROR_CONTINUE); + gcc_assert (scop->transformed_schedule); /* Set the separate option to reduce control flow overhead. */ @@ -1445,70 +1366,56 @@ scop_to_isl_ast (scop_p scop) isl_ast_node *ast_isl = isl_ast_build_node_from_schedule (context_isl, schedule); isl_ast_build_free (context_isl); - return ast_isl; -} - -/* Copy def from sese REGION to the newly created TO_REGION. TR is defined by - DEF_STMT. GSI points to entry basic block of the TO_REGION. */ - -static void -copy_def (tree tr, gimple *def_stmt, sese_info_p region, sese_info_p to_region, - gimple_stmt_iterator *gsi) -{ - if (!defined_in_sese_p (tr, region->region)) - return; - - ssa_op_iter iter; - use_operand_p use_p; - FOR_EACH_SSA_USE_OPERAND (use_p, def_stmt, iter, SSA_OP_USE) - { - tree use_tr = USE_FROM_PTR (use_p); - - /* Do not copy parameters that have been generated in the header of the - scop. */ - if (region->parameter_rename_map->get(use_tr)) - continue; - - gimple *def_of_use = SSA_NAME_DEF_STMT (use_tr); - if (!def_of_use) - continue; - copy_def (use_tr, def_of_use, region, to_region, gsi); - } - - gimple *copy = gimple_copy (def_stmt); - gsi_insert_after (gsi, copy, GSI_NEW_STMT); - - /* Create new names for all the definitions created by COPY and - add replacement mappings for each new name. */ - def_operand_p def_p; - ssa_op_iter op_iter; - FOR_EACH_SSA_DEF_OPERAND (def_p, copy, op_iter, SSA_OP_ALL_DEFS) + isl_options_set_on_error (scop->isl_context, old_err); + isl_ctx_reset_operations (scop->isl_context); + isl_ctx_set_max_operations (scop->isl_context, old_max_operations); + if (isl_ctx_last_error (scop->isl_context) != isl_error_none) { - tree old_name = DEF_FROM_PTR (def_p); - tree new_name = create_new_def_for (old_name, copy, def_p); - region->parameter_rename_map->put(old_name, new_name); + location_t loc = find_loop_location + (scop->scop_info->region.entry->dest->loop_father); + if (isl_ctx_last_error (scop->isl_context) == isl_error_quota) + dump_printf_loc (MSG_MISSED_OPTIMIZATION, loc, + "loop nest not optimized, AST generation timed out " + "after %d operations [--param max-isl-operations]\n", + max_operations); + else + dump_printf_loc (MSG_MISSED_OPTIMIZATION, loc, + "loop nest not optimized, ISL AST generation " + "signalled an error\n"); + isl_ast_node_free (ast_isl); + return NULL; } - update_stmt (copy); + return ast_isl; } +/* Generate out-of-SSA copies for the entry edge FALSE_ENTRY/TRUE_ENTRY + in REGION. */ + static void -copy_internal_parameters (sese_info_p region, sese_info_p to_region) +generate_entry_out_of_ssa_copies (edge false_entry, + edge true_entry, + sese_info_p region) { - /* For all the parameters which definitino is in the if_region->false_region, - insert code on true_region (if_region->true_region->entry). */ - - int i; - tree tr; - gimple_stmt_iterator gsi = gsi_start_bb(to_region->region.entry->dest); - - FOR_EACH_VEC_ELT (region->params, i, tr) + gimple_stmt_iterator gsi_tgt = gsi_start_bb (true_entry->dest); + for (gphi_iterator psi = gsi_start_phis (false_entry->dest); + !gsi_end_p (psi); gsi_next (&psi)) { - // If def is not in region. - gimple *def_stmt = SSA_NAME_DEF_STMT (tr); - if (def_stmt) - copy_def (tr, def_stmt, region, to_region, &gsi); + gphi *phi = psi.phi (); + tree res = gimple_phi_result (phi); + if (virtual_operand_p (res)) + continue; + /* When there's no out-of-SSA var registered do not bother + to create one. */ + tree *rename = region->rename_map->get (res); + if (! rename) + continue; + tree new_phi_def = *rename; + gassign *ass = gimple_build_assign (new_phi_def, + PHI_ARG_DEF_FROM_EDGE (phi, + false_entry)); + gsi_insert_after (&gsi_tgt, ass, GSI_NEW_STMT); } } @@ -1528,6 +1435,12 @@ graphite_regenerate_ast_isl (scop_p scop) timevar_push (TV_GRAPHITE_CODE_GEN); t.add_parameters_to_ivs_params (scop, ip); root_node = t.scop_to_isl_ast (scop); + if (! root_node) + { + ivs_params_clear (ip); + timevar_pop (TV_GRAPHITE_CODE_GEN); + return false; + } if (dump_file && (dump_flags & TDF_DETAILS)) { @@ -1546,10 +1459,6 @@ graphite_regenerate_ast_isl (scop_p scop) region->if_region = if_region; loop_p context_loop = region->region.entry->src->loop_father; - - /* Copy all the parameters which are defined in the region. */ - copy_internal_parameters(if_region->false_region, if_region->true_region); - edge e = single_succ_edge (if_region->true_region->region.entry->dest); basic_block bb = split_edge (e); @@ -1559,29 +1468,24 @@ graphite_regenerate_ast_isl (scop_p scop) t.translate_isl_ast (context_loop, root_node, e, ip); if (! t.codegen_error_p ()) { + generate_entry_out_of_ssa_copies (if_region->false_region->region.entry, + if_region->true_region->region.entry, + region); sese_insert_phis_for_liveouts (region, if_region->region->region.exit->src, if_region->false_region->region.exit, if_region->true_region->region.exit); if (dump_file) fprintf (dump_file, "[codegen] isl AST to Gimple succeeded.\n"); - - mark_virtual_operands_for_renaming (cfun); - update_ssa (TODO_update_ssa); - checking_verify_ssa (true, true); - rewrite_into_loop_closed_ssa (NULL, 0); } if (t.codegen_error_p ()) { - if (dump_file) - fprintf (dump_file, "codegen error: " - "reverting back to the original code.\n"); - set_ifsese_condition (if_region, integer_zero_node); + location_t loc = find_loop_location + (scop->scop_info->region.entry->dest->loop_father); + dump_printf_loc (MSG_MISSED_OPTIMIZATION, loc, + "loop nest not optimized, code generation error\n"); - /* We registered new names, scrap that. */ - if (need_ssa_update_p (cfun)) - delete_update_ssa (); /* Remove the unreachable region. */ remove_edge_and_dominated_blocks (if_region->true_region->region.entry); basic_block ifb = if_region->false_region->region.entry->src; @@ -1597,9 +1501,11 @@ graphite_regenerate_ast_isl (scop_p scop) delete_loop (loop); } - /* Verifies properties that GRAPHITE should maintain during translation. */ - checking_verify_loop_structure (); - checking_verify_loop_closed_ssa (true); + /* We are delaying SSA update to after code-generating all SCOPs. + This is because we analyzed DRs and parameters on the unmodified + IL and thus rely on SSA update to pick up new dominating definitions + from for example SESE liveout PHIs. This is also for efficiency + as SSA update does work depending on the size of the function. */ free (if_region->true_region); free (if_region->region); diff --git a/gcc/graphite-scop-detection.c b/gcc/graphite-scop-detection.c index 93ab0354efb98..c236556522ad1 100644 --- a/gcc/graphite-scop-detection.c +++ b/gcc/graphite-scop-detection.c @@ -254,28 +254,6 @@ dot_cfg () scops.release (); } -/* Can all ivs be represented by a signed integer? - As isl might generate negative values in its expressions, signed loop ivs - are required in the backend. */ - -static bool -loop_ivs_can_be_represented (loop_p loop) -{ - unsigned type_long_long = TYPE_PRECISION (long_long_integer_type_node); - for (gphi_iterator psi = gsi_start_phis (loop->header); !gsi_end_p (psi); - gsi_next (&psi)) - { - gphi *phi = psi.phi (); - tree res = PHI_RESULT (phi); - tree type = TREE_TYPE (res); - - if (TYPE_UNSIGNED (type) && TYPE_PRECISION (type) >= type_long_long) - return false; - } - - return true; -} - /* Returns a COND_EXPR statement when BB has a single predecessor, the edge between BB and its predecessor is not a loop exit edge, and the last statement of the single predecessor is a COND_EXPR. */ @@ -403,7 +381,7 @@ class scop_detection Something like "i * n" or "n * m" is not allowed. */ - static bool graphite_can_represent_scev (tree scev); + static bool graphite_can_represent_scev (sese_l scop, tree scev); /* Return true when EXPR can be represented in the polyhedral model. @@ -822,13 +800,6 @@ scop_detection::harmful_loop_in_region (sese_l scop) const return true; } - if (! loop_ivs_can_be_represented (loop)) - { - DEBUG_PRINT (dp << "[scop-detection-fail] loop_" << loop->num - << "IV cannot be represented.\n"); - return true; - } - /* Check if all loop nests have at least one data reference. ??? This check is expensive and loops premature at this point. If important to retain we can pre-compute this for all innermost @@ -963,32 +934,24 @@ scop_detection::graphite_can_represent_init (tree e) Something like "i * n" or "n * m" is not allowed. */ bool -scop_detection::graphite_can_represent_scev (tree scev) +scop_detection::graphite_can_represent_scev (sese_l scop, tree scev) { if (chrec_contains_undetermined (scev)) return false; - /* We disable the handling of pointer types, because it’s currently not - supported by Graphite with the isl AST generator. SSA_NAME nodes are - the only nodes, which are disabled in case they are pointers to object - types, but this can be changed. */ - - if (POINTER_TYPE_P (TREE_TYPE (scev)) && TREE_CODE (scev) == SSA_NAME) - return false; - switch (TREE_CODE (scev)) { case NEGATE_EXPR: case BIT_NOT_EXPR: CASE_CONVERT: case NON_LVALUE_EXPR: - return graphite_can_represent_scev (TREE_OPERAND (scev, 0)); + return graphite_can_represent_scev (scop, TREE_OPERAND (scev, 0)); case PLUS_EXPR: case POINTER_PLUS_EXPR: case MINUS_EXPR: - return graphite_can_represent_scev (TREE_OPERAND (scev, 0)) - && graphite_can_represent_scev (TREE_OPERAND (scev, 1)); + return graphite_can_represent_scev (scop, TREE_OPERAND (scev, 0)) + && graphite_can_represent_scev (scop, TREE_OPERAND (scev, 1)); case MULT_EXPR: return !CONVERT_EXPR_CODE_P (TREE_CODE (TREE_OPERAND (scev, 0))) @@ -996,18 +959,20 @@ scop_detection::graphite_can_represent_scev (tree scev) && !(chrec_contains_symbols (TREE_OPERAND (scev, 0)) && chrec_contains_symbols (TREE_OPERAND (scev, 1))) && graphite_can_represent_init (scev) - && graphite_can_represent_scev (TREE_OPERAND (scev, 0)) - && graphite_can_represent_scev (TREE_OPERAND (scev, 1)); + && graphite_can_represent_scev (scop, TREE_OPERAND (scev, 0)) + && graphite_can_represent_scev (scop, TREE_OPERAND (scev, 1)); case POLYNOMIAL_CHREC: /* Check for constant strides. With a non constant stride of 'n' we would have a value of 'iv * n'. Also check that the initial value can represented: for example 'n * m' cannot be represented. */ + gcc_assert (loop_in_sese_p (get_loop (cfun, + CHREC_VARIABLE (scev)), scop)); if (!evolution_function_right_is_integer_cst (scev) || !graphite_can_represent_init (scev)) return false; - return graphite_can_represent_scev (CHREC_LEFT (scev)); + return graphite_can_represent_scev (scop, CHREC_LEFT (scev)); default: break; @@ -1031,7 +996,7 @@ scop_detection::graphite_can_represent_expr (sese_l scop, loop_p loop, tree expr) { tree scev = scalar_evolution_in_region (scop, loop, expr); - return graphite_can_represent_scev (scev); + return graphite_can_represent_scev (scop, scev); } /* Return true if the data references of STMT can be represented by Graphite. @@ -1040,12 +1005,10 @@ scop_detection::graphite_can_represent_expr (sese_l scop, loop_p loop, bool scop_detection::stmt_has_simple_data_refs_p (sese_l scop, gimple *stmt) { - loop_p nest; + edge nest = scop.entry;; loop_p loop = loop_containing_stmt (stmt); if (!loop_in_sese_p (loop, scop)) - nest = loop; - else - nest = outermost_loop_in_sese (scop, gimple_bb (stmt)); + loop = NULL; auto_vec drs; if (! graphite_find_data_references_in_stmt (nest, loop, stmt, &drs)) @@ -1056,7 +1019,7 @@ scop_detection::stmt_has_simple_data_refs_p (sese_l scop, gimple *stmt) FOR_EACH_VEC_ELT (drs, j, dr) { for (unsigned i = 0; i < DR_NUM_DIMENSIONS (dr); ++i) - if (! graphite_can_represent_scev (DR_ACCESS_FN (dr, i))) + if (! graphite_can_represent_scev (scop, DR_ACCESS_FN (dr, i))) return false; } @@ -1140,7 +1103,7 @@ scop_detection::stmt_simple_for_scop_p (sese_l scop, gimple *stmt, tree op = gimple_op (stmt, i); if (!graphite_can_represent_expr (scop, loop, op) /* We can only constrain on integer type. */ - || (TREE_CODE (TREE_TYPE (op)) != INTEGER_TYPE)) + || ! INTEGRAL_TYPE_P (TREE_TYPE (op))) { DEBUG_PRINT (dp << "[scop-detection-fail] " << "Graphite cannot represent stmt:\n"; @@ -1183,49 +1146,23 @@ scop_detection::nb_pbbs_in_loops (scop_p scop) return res; } -/* When parameter NAME is in REGION, returns its index in SESE_PARAMS. - Otherwise returns -1. */ +/* Assigns the parameter NAME an index in REGION. */ -static inline int -parameter_index_in_region_1 (tree name, sese_info_p region) +static void +assign_parameter_index_in_region (tree name, sese_info_p region) { + gcc_assert (TREE_CODE (name) == SSA_NAME + && INTEGRAL_TYPE_P (TREE_TYPE (name)) + && ! defined_in_sese_p (name, region->region)); + int i; tree p; - - gcc_assert (TREE_CODE (name) == SSA_NAME); - FOR_EACH_VEC_ELT (region->params, i, p) if (p == name) - return i; - - return -1; -} - -/* When the parameter NAME is in REGION, returns its index in - SESE_PARAMS. Otherwise this function inserts NAME in SESE_PARAMS - and returns the index of NAME. */ - -static int -parameter_index_in_region (tree name, sese_info_p region) -{ - int i; - - gcc_assert (TREE_CODE (name) == SSA_NAME); - - /* Cannot constrain on anything else than INTEGER_TYPE parameters. */ - if (TREE_CODE (TREE_TYPE (name)) != INTEGER_TYPE) - return -1; - - if (!invariant_in_sese_p_rec (name, region->region, NULL)) - return -1; - - i = parameter_index_in_region_1 (name, region); - if (i != -1) - return i; + return; i = region->params.length (); region->params.safe_push (name); - return i; } /* In the context of sese S, scan the expression E and translate it to @@ -1267,7 +1204,7 @@ scan_tree_for_params (sese_info_p s, tree e) break; case SSA_NAME: - parameter_index_in_region (e, s); + assign_parameter_index_in_region (e, s); break; case INTEGER_CST: @@ -1413,12 +1350,10 @@ try_generate_gimple_bb (scop_p scop, basic_block bb) vec reads = vNULL; sese_l region = scop->scop_info->region; - loop_p nest; + edge nest = region.entry; loop_p loop = bb->loop_father; if (!loop_in_sese_p (loop, region)) - nest = loop; - else - nest = outermost_loop_in_sese (region, bb); + loop = NULL; for (gimple_stmt_iterator gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi)) @@ -1737,10 +1672,6 @@ build_scops (vec *scops) sese_l *s; FOR_EACH_VEC_ELT (scops_l, i, s) { - /* For our out-of-SSA we need a block on s->entry, similar to how - we include the LCSSA block in the region. */ - s->entry = single_pred_edge (split_edge (s->entry)); - scop_p scop = new_scop (s->entry, s->exit); /* Record all basic blocks and their conditions in REGION. */ diff --git a/gcc/graphite-sese-to-poly.c b/gcc/graphite-sese-to-poly.c index 6cd5bc7c9d9a2..248c34a41c95a 100644 --- a/gcc/graphite-sese-to-poly.c +++ b/gcc/graphite-sese-to-poly.c @@ -63,7 +63,7 @@ along with GCC; see the file COPYING3. If not see static inline void tree_int_to_gmp (tree t, mpz_t res) { - wi::to_mpz (t, res, TYPE_SIGN (TREE_TYPE (t))); + wi::to_mpz (wi::to_wide (t), res, TYPE_SIGN (TREE_TYPE (t))); } /* Return an isl identifier for the polyhedral basic block PBB. */ @@ -86,7 +86,7 @@ extract_affine_chrec (scop_p s, tree e, __isl_take isl_space *space) isl_pw_aff *lhs = extract_affine (s, CHREC_LEFT (e), isl_space_copy (space)); isl_pw_aff *rhs = extract_affine (s, CHREC_RIGHT (e), isl_space_copy (space)); isl_local_space *ls = isl_local_space_from_space (space); - unsigned pos = sese_loop_depth (s->scop_info->region, get_chrec_loop (e)); + unsigned pos = sese_loop_depth (s->scop_info->region, get_chrec_loop (e)) - 1; isl_aff *loop = isl_aff_set_coefficient_si (isl_aff_zero_on_domain (ls), isl_dim_in, pos, 1); isl_pw_aff *l = isl_pw_aff_from_aff (loop); @@ -142,11 +142,8 @@ isl_id_for_dr (scop_p s) /* Extract an affine expression from the ssa_name E. */ static isl_pw_aff * -extract_affine_name (scop_p s, tree e, __isl_take isl_space *space) +extract_affine_name (int dimension, __isl_take isl_space *space) { - isl_id *id = isl_id_for_ssa_name (s, e); - int dimension = isl_space_find_dim_by_id (space, isl_dim_param, id); - isl_id_free (id); isl_set *dom = isl_set_universe (isl_space_copy (space)); isl_aff *aff = isl_aff_zero_on_domain (isl_local_space_from_space (space)); aff = isl_aff_add_coefficient_si (aff, isl_dim_param, dimension, 1); @@ -211,17 +208,13 @@ wrap (isl_pw_aff *pwaff, unsigned width) Otherwise returns -1. */ static inline int -parameter_index_in_region_1 (tree name, sese_info_p region) +parameter_index_in_region (tree name, sese_info_p region) { int i; tree p; - - gcc_assert (TREE_CODE (name) == SSA_NAME); - FOR_EACH_VEC_ELT (region->params, i, p) if (p == name) return i; - return -1; } @@ -288,10 +281,13 @@ extract_affine (scop_p s, tree e, __isl_take isl_space *space) break; case SSA_NAME: - gcc_assert (-1 != parameter_index_in_region_1 (e, s->scop_info) - || defined_in_sese_p (e, s->scop_info->region)); - res = extract_affine_name (s, e, space); - break; + { + gcc_assert (! defined_in_sese_p (e, s->scop_info->region)); + int dim = parameter_index_in_region (e, s->scop_info); + gcc_assert (dim != -1); + res = extract_affine_name (dim, space); + break; + } case INTEGER_CST: res = extract_affine_int (e, space); @@ -431,54 +427,40 @@ add_conditions_to_domain (poly_bb_p pbb) of P. */ static void -add_param_constraints (scop_p scop, graphite_dim_t p) +add_param_constraints (scop_p scop, graphite_dim_t p, tree parameter) { - tree parameter = scop->scop_info->params[p]; tree type = TREE_TYPE (parameter); - tree lb = NULL_TREE; - tree ub = NULL_TREE; + wide_int min, max; - if (POINTER_TYPE_P (type) || !TYPE_MIN_VALUE (type)) - lb = lower_bound_in_type (type, type); - else - lb = TYPE_MIN_VALUE (type); + gcc_assert (INTEGRAL_TYPE_P (type) || POINTER_TYPE_P (type)); - if (POINTER_TYPE_P (type) || !TYPE_MAX_VALUE (type)) - ub = upper_bound_in_type (type, type); + if (INTEGRAL_TYPE_P (type) + && get_range_info (parameter, &min, &max) == VR_RANGE) + ; else - ub = TYPE_MAX_VALUE (type); - - if (lb) { - isl_space *space = isl_set_get_space (scop->param_context); - isl_constraint *c; - isl_val *v; - - c = isl_inequality_alloc (isl_local_space_from_space (space)); - v = isl_val_int_from_wi (scop->isl_context, wi::to_widest (lb)); - v = isl_val_neg (v); - c = isl_constraint_set_constant_val (c, v); - c = isl_constraint_set_coefficient_si (c, isl_dim_param, p, 1); - - scop->param_context = isl_set_coalesce - (isl_set_add_constraint (scop->param_context, c)); + min = wi::min_value (TYPE_PRECISION (type), TYPE_SIGN (type)); + max = wi::max_value (TYPE_PRECISION (type), TYPE_SIGN (type)); } - if (ub) - { - isl_space *space = isl_set_get_space (scop->param_context); - isl_constraint *c; - isl_val *v; - - c = isl_inequality_alloc (isl_local_space_from_space (space)); - - v = isl_val_int_from_wi (scop->isl_context, wi::to_widest (ub)); - c = isl_constraint_set_constant_val (c, v); - c = isl_constraint_set_coefficient_si (c, isl_dim_param, p, -1); - - scop->param_context = isl_set_coalesce - (isl_set_add_constraint (scop->param_context, c)); - } + isl_space *space = isl_set_get_space (scop->param_context); + isl_constraint *c = isl_inequality_alloc (isl_local_space_from_space (space)); + isl_val *v = isl_val_int_from_wi (scop->isl_context, + widest_int::from (min, TYPE_SIGN (type))); + v = isl_val_neg (v); + c = isl_constraint_set_constant_val (c, v); + c = isl_constraint_set_coefficient_si (c, isl_dim_param, p, 1); + scop->param_context = isl_set_coalesce + (isl_set_add_constraint (scop->param_context, c)); + + space = isl_set_get_space (scop->param_context); + c = isl_inequality_alloc (isl_local_space_from_space (space)); + v = isl_val_int_from_wi (scop->isl_context, + widest_int::from (max, TYPE_SIGN (type))); + c = isl_constraint_set_constant_val (c, v); + c = isl_constraint_set_coefficient_si (c, isl_dim_param, p, -1); + scop->param_context = isl_set_coalesce + (isl_set_add_constraint (scop->param_context, c)); } /* Add a constrain to the ACCESSES polyhedron for the alias set of @@ -763,10 +745,10 @@ add_loop_constraints (scop_p scop, __isl_take isl_set *domain, loop_p loop, return domain; const sese_l ®ion = scop->scop_info->region; if (!loop_in_sese_p (loop, region)) - ; - else - /* Recursion all the way up to the context loop. */ - domain = add_loop_constraints (scop, domain, loop_outer (loop), context); + return domain; + + /* Recursion all the way up to the context loop. */ + domain = add_loop_constraints (scop, domain, loop_outer (loop), context); /* Then, build constraints over the loop in post-order: outer to inner. */ @@ -777,21 +759,6 @@ add_loop_constraints (scop_p scop, __isl_take isl_set *domain, loop_p loop, domain = add_iter_domain_dimension (domain, loop, scop); isl_space *space = isl_set_get_space (domain); - if (!loop_in_sese_p (loop, region)) - { - /* 0 == loop_i */ - isl_local_space *ls = isl_local_space_from_space (space); - isl_constraint *c = isl_equality_alloc (ls); - c = isl_constraint_set_coefficient_si (c, isl_dim_set, loop_index, 1); - if (dump_file) - { - fprintf (dump_file, "[sese-to-poly] adding constraint to the domain: "); - print_isl_constraint (dump_file, c); - } - domain = isl_set_add_constraint (domain, c); - return domain; - } - /* 0 <= loop_i */ isl_local_space *ls = isl_local_space_from_space (isl_space_copy (space)); isl_constraint *c = isl_inequality_alloc (ls); @@ -945,9 +912,8 @@ build_scop_context (scop_p scop) scop->param_context = isl_set_universe (space); - graphite_dim_t p; - for (p = 0; p < nbp; p++) - add_param_constraints (scop, p); + FOR_EACH_VEC_ELT (region->params, i, e) + add_param_constraints (scop, i, e); } /* Return true when loop A is nested in loop B. */ @@ -1066,8 +1032,6 @@ outer_projection_mupa (__isl_take isl_union_set *set, int n) return isl_multi_union_pw_aff_from_union_pw_multi_aff (data.res); } -static bool schedule_error; - /* Embed SCHEDULE in the constraints of the LOOP domain. */ static isl_schedule * @@ -1082,11 +1046,9 @@ add_loop_schedule (__isl_take isl_schedule *schedule, loop_p loop, return empty < 0 ? isl_schedule_free (schedule) : schedule; isl_union_set *domain = isl_schedule_get_domain (schedule); - /* We cannot apply an empty domain to pbbs in this loop so fail. - ??? Somehow drop pbbs in the loop instead. */ + /* We cannot apply an empty domain to pbbs in this loop so return early. */ if (isl_union_set_is_empty (domain)) { - schedule_error = true; isl_union_set_free (domain); return schedule; } @@ -1213,11 +1175,9 @@ build_schedule_loop_nest (scop_p scop, int *index, loop_p context_loop) /* Build the schedule of the SCOP. */ -static bool +static void build_original_schedule (scop_p scop) { - schedule_error = false; - int i = 0; int n = scop->pbbs.length (); while (i < n) @@ -1232,22 +1192,11 @@ build_original_schedule (scop_p scop) scop->original_schedule = add_in_sequence (scop->original_schedule, s); } - if (schedule_error) - { - if (dump_file) - fprintf (dump_file, "[sese-to-poly] failed to build " - "original schedule\n"); - return false; - } - if (dump_file) { fprintf (dump_file, "[sese-to-poly] original schedule:\n"); print_isl_schedule (dump_file, scop->original_schedule); } - if (!scop->original_schedule) - return false; - return true; } /* Builds the polyhedral representation for a SESE region. */ diff --git a/gcc/graphite.c b/gcc/graphite.c index 0bdcc28cba8a3..22d83307bd225 100644 --- a/gcc/graphite.c +++ b/gcc/graphite.c @@ -55,6 +55,8 @@ along with GCC; see the file COPYING3. If not see #include "tree-cfgcleanup.h" #include "tree-vectorizer.h" #include "tree-ssa-loop-manip.h" +#include "tree-ssa.h" +#include "tree-into-ssa.h" #include "graphite.h" /* Print global statistics to FILE. */ @@ -109,7 +111,7 @@ print_global_statistics (FILE* file) fprintf (file, "LOOPS:%ld, ", n_loops); fprintf (file, "CONDITIONS:%ld, ", n_conditions); fprintf (file, "STMTS:%ld)\n", n_stmts); - fprintf (file, "\nGlobal profiling statistics ("); + fprintf (file, "Global profiling statistics ("); fprintf (file, "BBS:"); n_p_bbs.dump (file); fprintf (file, ", LOOPS:"); @@ -118,7 +120,7 @@ print_global_statistics (FILE* file) n_p_conditions.dump (file); fprintf (file, ", STMTS:"); n_p_stmts.dump (file); - fprintf (file, ")\n"); + fprintf (file, ")\n\n"); } /* Print statistics for SCOP to FILE. */ @@ -183,7 +185,7 @@ print_graphite_scop_statistics (FILE* file, scop_p scop) fprintf (file, "LOOPS:%ld, ", n_loops); fprintf (file, "CONDITIONS:%ld, ", n_conditions); fprintf (file, "STMTS:%ld)\n", n_stmts); - fprintf (file, "\nSCoP profiling statistics ("); + fprintf (file, "SCoP profiling statistics ("); fprintf (file, "BBS:"); n_p_bbs.dump (file); fprintf (file, ", LOOPS:"); @@ -192,7 +194,7 @@ print_graphite_scop_statistics (FILE* file, scop_p scop) n_p_conditions.dump (file); fprintf (file, ", STMTS:"); n_p_stmts.dump (file); - fprintf (file, ")\n"); + fprintf (file, ")\n\n"); } /* Print statistics for SCOPS to FILE. */ @@ -201,73 +203,10 @@ static void print_graphite_statistics (FILE* file, vec scops) { int i; - scop_p scop; FOR_EACH_VEC_ELT (scops, i, scop) print_graphite_scop_statistics (file, scop); - - /* Print the loop structure. */ - print_loops (file, 2); - print_loops (file, 3); -} - -/* Initialize graphite: when there are no loops returns false. */ - -static bool -graphite_initialize (void) -{ - int min_loops = PARAM_VALUE (PARAM_GRAPHITE_MIN_LOOPS_PER_FUNCTION); - int nloops = number_of_loops (cfun); - - if (nloops <= min_loops) - { - if (dump_file && (dump_flags & TDF_DETAILS)) - { - if (nloops <= min_loops) - fprintf (dump_file, "\nFunction does not have enough loops: " - "PARAM_GRAPHITE_MIN_LOOPS_PER_FUNCTION = %d.\n", - min_loops); - - fprintf (dump_file, "\nnumber of SCoPs: 0\n"); - print_global_statistics (dump_file); - } - - return false; - } - - calculate_dominance_info (CDI_DOMINATORS); - initialize_original_copy_tables (); - - if (dump_file && dump_flags) - { - dump_function_to_file (current_function_decl, dump_file, dump_flags); - print_loops (dump_file, 3); - } - - return true; -} - -/* Finalize graphite: perform CFG cleanup when NEED_CFG_CLEANUP_P is - true. */ - -static void -graphite_finalize (bool need_cfg_cleanup_p) -{ - if (need_cfg_cleanup_p) - { - free_dominance_info (CDI_DOMINATORS); - scev_reset (); - cleanup_tree_cfg (); - profile_status_for_fn (cfun) = PROFILE_ABSENT; - release_recorded_exits (cfun); - tree_estimate_probability (false); - } - - free_original_copy_tables (); - - if (dump_file && dump_flags) - print_loops (dump_file, 3); } /* Deletes all scops in SCOPS. */ @@ -396,7 +335,7 @@ graphite_transform_loops (void) { int i; scop_p scop; - bool need_cfg_cleanup_p = false; + bool changed = false; vec scops = vNULL; isl_ctx *ctx; @@ -405,8 +344,7 @@ graphite_transform_loops (void) if (parallelized_function_p (cfun->decl)) return; - if (!graphite_initialize ()) - return; + calculate_dominance_info (CDI_DOMINATORS); ctx = isl_ctx_alloc (); isl_options_set_on_error (ctx, ISL_ON_ERROR_ABORT); @@ -415,6 +353,13 @@ graphite_transform_loops (void) sort_sibling_loops (cfun); canonicalize_loop_closed_ssa_form (); + /* Print the loop structure. */ + if (dump_file && (dump_flags & TDF_DETAILS)) + { + print_loops (dump_file, 2); + print_loops (dump_file, 3); + } + calculate_dominance_info (CDI_POST_DOMINATORS); build_scops (&scops); free_dominance_info (CDI_POST_DOMINATORS); @@ -435,18 +380,26 @@ graphite_transform_loops (void) if (!apply_poly_transforms (scop)) continue; - location_t loc = find_loop_location - (scops[i]->scop_info->region.entry->dest->loop_father); - - need_cfg_cleanup_p = true; - if (!graphite_regenerate_ast_isl (scop)) - dump_printf_loc (MSG_MISSED_OPTIMIZATION, loc, - "loop nest not optimized, code generation error\n"); - else - dump_printf_loc (MSG_OPTIMIZED_LOCATIONS, loc, - "loop nest optimized\n"); + changed = true; + if (graphite_regenerate_ast_isl (scop)) + { + location_t loc = find_loop_location + (scops[i]->scop_info->region.entry->dest->loop_father); + dump_printf_loc (MSG_OPTIMIZED_LOCATIONS, loc, + "loop nest optimized\n"); + } } + if (changed) + { + mark_virtual_operands_for_renaming (cfun); + update_ssa (TODO_update_ssa); + checking_verify_ssa (true, true); + rewrite_into_loop_closed_ssa (NULL, 0); + scev_reset (); + checking_verify_loop_structure (); + } + if (dump_file && (dump_flags & TDF_DETAILS)) { loop_p loop; @@ -461,9 +414,17 @@ graphite_transform_loops (void) } free_scops (scops); - graphite_finalize (need_cfg_cleanup_p); the_isl_ctx = NULL; isl_ctx_free (ctx); + + if (changed) + { + cleanup_tree_cfg (); + profile_status_for_fn (cfun) = PROFILE_ABSENT; + release_recorded_exits (cfun); + tree_estimate_probability (false); + } + } #else /* If isl is not available: #ifndef HAVE_isl. */ diff --git a/gcc/haifa-sched.c b/gcc/haifa-sched.c index e7014cbb8b378..0c73003ebcaab 100644 --- a/gcc/haifa-sched.c +++ b/gcc/haifa-sched.c @@ -6303,7 +6303,7 @@ prune_ready_list (state_t temp_state, bool first_cycle_insn_p, { int i, pass; bool sched_group_found = false; - int min_cost_group = 1; + int min_cost_group = 0; if (sched_fusion) return; @@ -6319,8 +6319,8 @@ prune_ready_list (state_t temp_state, bool first_cycle_insn_p, } /* Make two passes if there's a SCHED_GROUP_P insn; make sure to handle - such an insn first and note its cost, then schedule all other insns - for one cycle later. */ + such an insn first and note its cost. If at least one SCHED_GROUP_P insn + gets queued, then all other insns get queued for one cycle later. */ for (pass = sched_group_found ? 0 : 1; pass < 2; ) { int n = ready.n_ready; @@ -6333,7 +6333,8 @@ prune_ready_list (state_t temp_state, bool first_cycle_insn_p, if (DEBUG_INSN_P (insn)) continue; - if (sched_group_found && !SCHED_GROUP_P (insn)) + if (sched_group_found && !SCHED_GROUP_P (insn) + && ((pass == 0) || (min_cost_group >= 1))) { if (pass == 0) continue; @@ -8310,11 +8311,9 @@ sched_create_recovery_edges (basic_block first_bb, basic_block rec, 'todo_spec' variable in create_check_block_twin and in sel-sched.c `check_ds' in create_speculation_check. */ e->probability = profile_probability::very_unlikely (); - e->count = first_bb->count.apply_probability (e->probability); - rec->count = e->count; + rec->count = e->count (); rec->frequency = EDGE_FREQUENCY (e); e2->probability = e->probability.invert (); - e2->count = first_bb->count - e2->count; rtx_code_label *label = block_label (second_bb); rtx_jump_insn *jump = emit_jump_insn_after (targetm.gen_jump (label), diff --git a/gcc/hsa-common.h b/gcc/hsa-common.h index 810624e4e1c9b..3075163a02032 100644 --- a/gcc/hsa-common.h +++ b/gcc/hsa-common.h @@ -157,6 +157,9 @@ class hsa_op_with_type : public hsa_op_base /* Convert an operand to a destination type DTYPE and attach insns to HBB if needed. */ hsa_op_with_type *get_in_type (BrigType16_t dtype, hsa_bb *hbb); + /* If this operand has integer type smaller than 32 bits, extend it to 32 + bits, adding instructions to HBB if needed. */ + hsa_op_with_type *extend_int_to_32bit (hsa_bb *hbb); protected: hsa_op_with_type (BrigKind16_t k, BrigType16_t t); diff --git a/gcc/hsa-gen.c b/gcc/hsa-gen.c index 6e054c0ce82f5..a2cb8b24e16f5 100644 --- a/gcc/hsa-gen.c +++ b/gcc/hsa-gen.c @@ -564,6 +564,19 @@ get_integer_type_by_bytes (unsigned size, bool sign) return 0; } +/* If T points to an integral type smaller than 32 bits, change it to a 32bit + equivalent and return the result. Otherwise just return the result. */ + +static BrigType16_t +hsa_extend_inttype_to_32bit (BrigType16_t t) +{ + if (t == BRIG_TYPE_U8 || t == BRIG_TYPE_U16) + return BRIG_TYPE_U32; + else if (t == BRIG_TYPE_S8 || t == BRIG_TYPE_S16) + return BRIG_TYPE_S32; + return t; +} + /* Return HSA type for tree TYPE, which has to fit into BrigType16_t. Pointers are assumed to use flat addressing. If min32int is true, always expand integer types to one that has at least 32 bits. */ @@ -580,8 +593,13 @@ hsa_type_for_scalar_tree_type (const_tree type, bool min32int) if (POINTER_TYPE_P (type)) return hsa_get_segment_addr_type (BRIG_SEGMENT_FLAT); - if (TREE_CODE (type) == VECTOR_TYPE || TREE_CODE (type) == COMPLEX_TYPE) + if (TREE_CODE (type) == VECTOR_TYPE) base = TREE_TYPE (type); + else if (TREE_CODE (type) == COMPLEX_TYPE) + { + base = TREE_TYPE (type); + min32int = true; + } else base = type; @@ -652,14 +670,9 @@ hsa_type_for_scalar_tree_type (const_tree type, bool min32int) } if (min32int) - { - /* Registers/immediate operands can only be 32bit or more except for - f16. */ - if (res == BRIG_TYPE_U8 || res == BRIG_TYPE_U16) - res = BRIG_TYPE_U32; - else if (res == BRIG_TYPE_S8 || res == BRIG_TYPE_S16) - res = BRIG_TYPE_S32; - } + /* Registers/immediate operands can only be 32bit or more except for + f16. */ + res = hsa_extend_inttype_to_32bit (res); if (TREE_CODE (type) == COMPLEX_TYPE) { @@ -1009,6 +1022,16 @@ hsa_get_string_cst_symbol (tree string_cst) return sym; } +/* Make the type of a MOV instruction larger if mandated by HSAIL rules. */ + +static void +hsa_fixup_mov_insn_type (hsa_insn_basic *insn) +{ + insn->m_type = hsa_extend_inttype_to_32bit (insn->m_type); + if (insn->m_type == BRIG_TYPE_B8 || insn->m_type == BRIG_TYPE_B16) + insn->m_type = BRIG_TYPE_B32; +} + /* Constructor of the ancestor of all operands. K is BRIG kind that identified what the operator is. */ @@ -1050,9 +1073,11 @@ hsa_op_with_type::get_in_type (BrigType16_t dtype, hsa_bb *hbb) else { dest = new hsa_op_reg (m_type); - hbb->append_insn (new hsa_insn_basic (2, BRIG_OPCODE_MOV, - dest->m_type, dest, this)); + hsa_insn_basic *mov = new hsa_insn_basic (2, BRIG_OPCODE_MOV, + dest->m_type, dest, this); + hsa_fixup_mov_insn_type (mov); + hbb->append_insn (mov); /* We cannot simply for instance: 'mov_u32 $_3, 48 (s32)' because type of the operand must be same as type of the instruction. */ dest->m_type = dtype; @@ -1061,6 +1086,20 @@ hsa_op_with_type::get_in_type (BrigType16_t dtype, hsa_bb *hbb) return dest; } +/* If this operand has integer type smaller than 32 bits, extend it to 32 bits, + adding instructions to HBB if needed. */ + +hsa_op_with_type * +hsa_op_with_type::extend_int_to_32bit (hsa_bb *hbb) +{ + if (m_type == BRIG_TYPE_U8 || m_type == BRIG_TYPE_U16) + return get_in_type (BRIG_TYPE_U32, hbb); + else if (m_type == BRIG_TYPE_S8 || m_type == BRIG_TYPE_S16) + return get_in_type (BRIG_TYPE_S32, hbb); + else + return this; +} + /* Constructor of class representing HSA immediate values. TREE_VAL is the tree representation of the immediate value. If min32int is true, always expand integer types to one that has at least 32 bits. */ @@ -1292,7 +1331,7 @@ hsa_function_representation::reg_for_gimple_ssa (tree ssa) return m_ssa_map[SSA_NAME_VERSION (ssa)]; hreg = new hsa_op_reg (hsa_type_for_scalar_tree_type (TREE_TYPE (ssa), - true)); + false)); hreg->m_gimple_ssa = ssa; m_ssa_map[SSA_NAME_VERSION (ssa)] = hreg; @@ -1799,7 +1838,7 @@ gen_address_calculation (tree exp, hsa_bb *hbb, BrigType16_t addrtype) case INTEGER_CST: { - hsa_op_immed *imm = new hsa_op_immed (exp); + hsa_op_immed *imm = new hsa_op_immed (exp); if (addrtype != imm->m_type) imm->m_type = addrtype; return imm; @@ -1957,8 +1996,10 @@ gen_hsa_addr (tree ref, hsa_bb *hbb, HOST_WIDE_INT *output_bitsize = NULL, case SSA_NAME: { addrtype = hsa_get_segment_addr_type (BRIG_SEGMENT_PRIVATE); - symbol = hsa_cfun->create_hsa_temporary (flat_addrtype); - hsa_op_reg *r = hsa_cfun->reg_for_gimple_ssa (ref); + hsa_op_with_type *r = hsa_cfun->reg_for_gimple_ssa (ref); + if (r->m_type == BRIG_TYPE_B1) + r = r->get_in_type (BRIG_TYPE_U32, hbb); + symbol = hsa_cfun->create_hsa_temporary (r->m_type); hbb->append_insn (new hsa_insn_mem (BRIG_OPCODE_ST, r->m_type, r, new hsa_op_address (symbol))); @@ -2247,13 +2288,18 @@ hsa_build_append_simple_mov (hsa_op_reg *dest, hsa_op_base *src, hsa_bb *hbb) rules like when dealing with memory. */ BrigType16_t tp = mem_type_for_type (dest->m_type); hsa_insn_basic *insn = new hsa_insn_basic (2, BRIG_OPCODE_MOV, tp, dest, src); + hsa_fixup_mov_insn_type (insn); + unsigned dest_size = hsa_type_bit_size (dest->m_type); if (hsa_op_reg *sreg = dyn_cast (src)) - gcc_assert (hsa_type_bit_size (dest->m_type) - == hsa_type_bit_size (sreg->m_type)); + gcc_assert (dest_size == hsa_type_bit_size (sreg->m_type)); else - gcc_assert (hsa_type_bit_size (dest->m_type) - == hsa_type_bit_size (as_a (src)->m_type)); - + { + unsigned imm_size + = hsa_type_bit_size (as_a (src)->m_type); + gcc_assert ((dest_size == imm_size) + /* Eventually < 32bit registers will be promoted to 32bit. */ + || (dest_size < 32 && imm_size == 32)); + } hbb->append_insn (insn); } @@ -2268,13 +2314,15 @@ gen_hsa_insns_for_bitfield (hsa_op_reg *dest, hsa_op_reg *value_reg, HOST_WIDE_INT bitsize, HOST_WIDE_INT bitpos, hsa_bb *hbb) { - unsigned type_bitsize = hsa_type_bit_size (dest->m_type); + unsigned type_bitsize + = hsa_type_bit_size (hsa_extend_inttype_to_32bit (dest->m_type)); unsigned left_shift = type_bitsize - (bitsize + bitpos); unsigned right_shift = left_shift + bitpos; if (left_shift) { - hsa_op_reg *value_reg_2 = new hsa_op_reg (dest->m_type); + hsa_op_reg *value_reg_2 + = new hsa_op_reg (hsa_extend_inttype_to_32bit (dest->m_type)); hsa_op_immed *c = new hsa_op_immed (left_shift, BRIG_TYPE_U32); hsa_insn_basic *lshift @@ -2288,7 +2336,8 @@ gen_hsa_insns_for_bitfield (hsa_op_reg *dest, hsa_op_reg *value_reg, if (right_shift) { - hsa_op_reg *value_reg_2 = new hsa_op_reg (dest->m_type); + hsa_op_reg *value_reg_2 + = new hsa_op_reg (hsa_extend_inttype_to_32bit (dest->m_type)); hsa_op_immed *c = new hsa_op_immed (right_shift, BRIG_TYPE_U32); hsa_insn_basic *rshift @@ -2301,8 +2350,10 @@ gen_hsa_insns_for_bitfield (hsa_op_reg *dest, hsa_op_reg *value_reg, } hsa_insn_basic *assignment - = new hsa_insn_basic (2, BRIG_OPCODE_MOV, dest->m_type, dest, value_reg); + = new hsa_insn_basic (2, BRIG_OPCODE_MOV, dest->m_type, NULL, value_reg); + hsa_fixup_mov_insn_type (assignment); hbb->append_insn (assignment); + assignment->set_output_in_type (dest, 0, hbb); } @@ -2318,8 +2369,10 @@ gen_hsa_insns_for_bitfield_load (hsa_op_reg *dest, hsa_op_address *addr, hsa_bb *hbb, BrigAlignment8_t align) { hsa_op_reg *value_reg = new hsa_op_reg (dest->m_type); - hsa_insn_mem *mem = new hsa_insn_mem (BRIG_OPCODE_LD, dest->m_type, value_reg, - addr); + hsa_insn_mem *mem + = new hsa_insn_mem (BRIG_OPCODE_LD, + hsa_extend_inttype_to_32bit (dest->m_type), + value_reg, addr); mem->set_align (align); hbb->append_insn (mem); gen_hsa_insns_for_bitfield (dest, value_reg, bitsize, bitpos, hbb); @@ -2446,9 +2499,10 @@ gen_hsa_insns_for_load (hsa_op_reg *dest, tree rhs, tree type, hsa_bb *hbb) real_reg : imag_reg; hsa_insn_basic *insn = new hsa_insn_basic (2, BRIG_OPCODE_MOV, - dest->m_type, dest, source); - + dest->m_type, NULL, source); + hsa_fixup_mov_insn_type (insn); hbb->append_insn (insn); + insn->set_output_in_type (dest, 0, hbb); } else if (TREE_CODE (rhs) == BIT_FIELD_REF && TREE_CODE (TREE_OPERAND (rhs, 0)) == SSA_NAME) @@ -2584,6 +2638,7 @@ gen_hsa_insns_for_store (tree lhs, hsa_op_base *src, hsa_bb *hbb) hsa_insn_basic *basic = new hsa_insn_basic (2, BRIG_OPCODE_MOV, mem_type, new_value_reg, src); + hsa_fixup_mov_insn_type (basic); hbb->append_insn (basic); if (bitpos) @@ -2954,8 +3009,10 @@ gen_hsa_cmp_insn_from_gimple (enum tree_code code, tree lhs, tree rhs, ? (BrigType16_t) BRIG_TYPE_B1 : dest->m_type; hsa_insn_cmp *cmp = new hsa_insn_cmp (compare, dest_type); - cmp->set_op (1, hsa_reg_or_immed_for_gimple_op (lhs, hbb)); - cmp->set_op (2, hsa_reg_or_immed_for_gimple_op (rhs, hbb)); + hsa_op_with_type *op1 = hsa_reg_or_immed_for_gimple_op (lhs, hbb); + cmp->set_op (1, op1->extend_int_to_32bit (hbb)); + hsa_op_with_type *op2 = hsa_reg_or_immed_for_gimple_op (rhs, hbb); + cmp->set_op (2, op2->extend_int_to_32bit (hbb)); hbb->append_insn (cmp); cmp->set_output_in_type (dest, 0, hbb); @@ -2973,8 +3030,14 @@ gen_hsa_unary_operation (BrigOpcode opcode, hsa_op_reg *dest, hsa_insn_basic *insn; if (opcode == BRIG_OPCODE_MOV && hsa_needs_cvt (dest->m_type, op1->m_type)) - insn = new hsa_insn_cvt (dest, op1); - else if (opcode == BRIG_OPCODE_FIRSTBIT || opcode == BRIG_OPCODE_LASTBIT) + { + insn = new hsa_insn_cvt (dest, op1); + hbb->append_insn (insn); + return; + } + + op1 = op1->extend_int_to_32bit (hbb); + if (opcode == BRIG_OPCODE_FIRSTBIT || opcode == BRIG_OPCODE_LASTBIT) { BrigType16_t srctype = hsa_type_integer_p (op1->m_type) ? op1->m_type : hsa_unsigned_type_for_type (op1->m_type); @@ -2983,9 +3046,12 @@ gen_hsa_unary_operation (BrigOpcode opcode, hsa_op_reg *dest, } else { - insn = new hsa_insn_basic (2, opcode, dest->m_type, dest, op1); + BrigType16_t optype = hsa_extend_inttype_to_32bit (dest->m_type); + insn = new hsa_insn_basic (2, opcode, optype, NULL, op1); - if (opcode == BRIG_OPCODE_ABS || opcode == BRIG_OPCODE_NEG) + if (opcode == BRIG_OPCODE_MOV) + hsa_fixup_mov_insn_type (insn); + else if (opcode == BRIG_OPCODE_ABS || opcode == BRIG_OPCODE_NEG) { /* ABS and NEG only exist in _s form :-/ */ if (insn->m_type == BRIG_TYPE_U32) @@ -2996,9 +3062,7 @@ gen_hsa_unary_operation (BrigOpcode opcode, hsa_op_reg *dest, } hbb->append_insn (insn); - - if (opcode == BRIG_OPCODE_FIRSTBIT || opcode == BRIG_OPCODE_LASTBIT) - insn->set_output_in_type (dest, 0, hbb); + insn->set_output_in_type (dest, 0, hbb); } /* Generate a binary instruction with OPCODE and append it to a basic block @@ -3007,10 +3071,15 @@ gen_hsa_unary_operation (BrigOpcode opcode, hsa_op_reg *dest, static void gen_hsa_binary_operation (int opcode, hsa_op_reg *dest, - hsa_op_base *op1, hsa_op_base *op2, hsa_bb *hbb) + hsa_op_with_type *op1, hsa_op_with_type *op2, + hsa_bb *hbb) { gcc_checking_assert (dest); + BrigType16_t optype = hsa_extend_inttype_to_32bit (dest->m_type); + op1 = op1->extend_int_to_32bit (hbb); + op2 = op2->extend_int_to_32bit (hbb); + if ((opcode == BRIG_OPCODE_SHL || opcode == BRIG_OPCODE_SHR) && is_a (op2)) { @@ -3026,9 +3095,10 @@ gen_hsa_binary_operation (int opcode, hsa_op_reg *dest, i->set_type (hsa_unsigned_type_for_type (i->m_type)); } - hsa_insn_basic *insn = new hsa_insn_basic (3, opcode, dest->m_type, dest, + hsa_insn_basic *insn = new hsa_insn_basic (3, opcode, optype, NULL, op1, op2); hbb->append_insn (insn); + insn->set_output_in_type (dest, 0, hbb); } /* Generate HSA instructions for a single assignment. HBB is the basic block @@ -3150,6 +3220,7 @@ gen_hsa_insns_for_operation_assignment (gimple *assign, hsa_bb *hbb) else if (TREE_CODE (rhs2) == SSA_NAME) { hsa_op_reg *s = hsa_cfun->reg_for_gimple_ssa (rhs2); + s = as_a (s->extend_int_to_32bit (hbb)); hsa_op_reg *d = new hsa_op_reg (s->m_type); hsa_op_immed *size_imm = new hsa_op_immed (bitsize, BRIG_TYPE_U32); @@ -3253,8 +3324,11 @@ gen_hsa_insns_for_operation_assignment (gimple *assign, hsa_bb *hbb) hsa_op_with_type *op2 = hsa_reg_or_immed_for_gimple_op (rhs2, hbb); hsa_op_with_type *op3 = hsa_reg_or_immed_for_gimple_op (rhs3, hbb); + op2 = op2->extend_int_to_32bit (hbb); + op3 = op3->extend_int_to_32bit (hbb); - BrigType16_t utype = hsa_unsigned_type_for_type (dest->m_type); + BrigType16_t type = hsa_extend_inttype_to_32bit (dest->m_type); + BrigType16_t utype = hsa_unsigned_type_for_type (type); if (is_a (op2)) op2->m_type = utype; if (is_a (op3)) @@ -3262,10 +3336,11 @@ gen_hsa_insns_for_operation_assignment (gimple *assign, hsa_bb *hbb) hsa_insn_basic *insn = new hsa_insn_basic (4, BRIG_OPCODE_CMOV, - hsa_bittype_for_type (dest->m_type), - dest, ctrl, op2, op3); + hsa_bittype_for_type (type), + NULL, ctrl, op2, op3); hbb->append_insn (insn); + insn->set_output_in_type (dest, 0, hbb); return; } case COMPLEX_EXPR: @@ -3273,7 +3348,9 @@ gen_hsa_insns_for_operation_assignment (gimple *assign, hsa_bb *hbb) hsa_op_reg *dest = hsa_cfun->reg_for_gimple_ssa (gimple_assign_lhs (assign)); hsa_op_with_type *rhs1_reg = hsa_reg_or_immed_for_gimple_op (rhs1, hbb); + rhs1_reg = rhs1_reg->extend_int_to_32bit (hbb); hsa_op_with_type *rhs2_reg = hsa_reg_or_immed_for_gimple_op (rhs2, hbb); + rhs2_reg = rhs2_reg->extend_int_to_32bit (hbb); if (hsa_seen_error ()) return; @@ -3298,11 +3375,10 @@ gen_hsa_insns_for_operation_assignment (gimple *assign, hsa_bb *hbb) } - hsa_op_reg *dest = hsa_cfun->reg_for_gimple_ssa (gimple_assign_lhs (assign)); - + hsa_op_reg *dest = hsa_cfun->reg_for_gimple_ssa (lhs); hsa_op_with_type *op1 = hsa_reg_or_immed_for_gimple_op (rhs1, hbb); - hsa_op_with_type *op2 = rhs2 != NULL_TREE ? - hsa_reg_or_immed_for_gimple_op (rhs2, hbb) : NULL; + hsa_op_with_type *op2 + = rhs2 ? hsa_reg_or_immed_for_gimple_op (rhs2, hbb) : NULL; if (hsa_seen_error ()) return; @@ -3312,6 +3388,7 @@ gen_hsa_insns_for_operation_assignment (gimple *assign, hsa_bb *hbb) case GIMPLE_TERNARY_RHS: { hsa_op_with_type *op3 = hsa_reg_or_immed_for_gimple_op (rhs3, hbb); + op3 = op3->extend_int_to_32bit (hbb); hsa_insn_basic *insn = new hsa_insn_basic (4, opcode, dest->m_type, dest, op1, op2, op3); hbb->append_insn (insn); @@ -3407,14 +3484,15 @@ gen_hsa_insns_for_switch_stmt (gswitch *s, hsa_bb *hbb) tree highest = get_switch_high (s); hsa_op_reg *index = hsa_cfun->reg_for_gimple_ssa (index_tree); + index = as_a (index->extend_int_to_32bit (hbb)); hsa_op_reg *cmp1_reg = new hsa_op_reg (BRIG_TYPE_B1); - hsa_op_immed *cmp1_immed = new hsa_op_immed (lowest); + hsa_op_immed *cmp1_immed = new hsa_op_immed (lowest, true); hbb->append_insn (new hsa_insn_cmp (BRIG_COMPARE_GE, cmp1_reg->m_type, cmp1_reg, index, cmp1_immed)); hsa_op_reg *cmp2_reg = new hsa_op_reg (BRIG_TYPE_B1); - hsa_op_immed *cmp2_immed = new hsa_op_immed (highest); + hsa_op_immed *cmp2_immed = new hsa_op_immed (highest, true); hbb->append_insn (new hsa_insn_cmp (BRIG_COMPARE_LE, cmp2_reg->m_type, cmp2_reg, index, cmp2_immed)); @@ -3444,7 +3522,7 @@ gen_hsa_insns_for_switch_stmt (gswitch *s, hsa_bb *hbb) hsa_op_reg *sub_index = new hsa_op_reg (index->m_type); hbb->append_insn (new hsa_insn_basic (3, BRIG_OPCODE_SUB, sub_index->m_type, sub_index, index, - new hsa_op_immed (lowest))); + new hsa_op_immed (lowest, true))); hsa_op_base *tmp = sub_index->get_in_type (BRIG_TYPE_U64, hbb); sub_index = as_a (tmp); @@ -3760,7 +3838,6 @@ void hsa_insn_basic::set_output_in_type (hsa_op_reg *dest, unsigned op_index, hsa_bb *hbb) { - hsa_insn_basic *insn; gcc_checking_assert (op_output_p (op_index)); if (dest->m_type == m_type) @@ -3769,15 +3846,28 @@ hsa_insn_basic::set_output_in_type (hsa_op_reg *dest, unsigned op_index, return; } - hsa_op_reg *tmp = new hsa_op_reg (m_type); - set_op (op_index, tmp); - + hsa_insn_basic *insn; + hsa_op_reg *tmp; if (hsa_needs_cvt (dest->m_type, m_type)) - insn = new hsa_insn_cvt (dest, tmp); + { + tmp = new hsa_op_reg (m_type); + insn = new hsa_insn_cvt (dest, tmp); + } + else if (hsa_type_bit_size (dest->m_type) == hsa_type_bit_size (m_type)) + { + /* When output, HSA registers do not really have types, only sizes, so if + the sizes match, we can use the register directly. */ + set_op (op_index, dest); + return; + } else - insn = new hsa_insn_basic (2, BRIG_OPCODE_MOV, dest->m_type, - dest, tmp->get_in_type (dest->m_type, hbb)); - + { + tmp = new hsa_op_reg (m_type); + insn = new hsa_insn_basic (2, BRIG_OPCODE_MOV, dest->m_type, + dest, tmp->get_in_type (dest->m_type, hbb)); + hsa_fixup_mov_insn_type (insn); + } + set_op (op_index, tmp); hbb->append_insn (insn); } @@ -4148,12 +4238,11 @@ gen_hsa_alloca (gcall *call, hsa_bb *hbb) built_in_function fn = DECL_FUNCTION_CODE (gimple_call_fndecl (call)); - gcc_checking_assert (fn == BUILT_IN_ALLOCA - || fn == BUILT_IN_ALLOCA_WITH_ALIGN); + gcc_checking_assert (ALLOCA_FUNCTION_CODE_P (fn)); unsigned bit_alignment = 0; - if (fn == BUILT_IN_ALLOCA_WITH_ALIGN) + if (fn != BUILT_IN_ALLOCA) { tree alignment_tree = gimple_call_arg (call, 1); if (TREE_CODE (alignment_tree) != INTEGER_CST) @@ -4200,6 +4289,7 @@ gen_hsa_clrsb (gcall *call, hsa_bb *hbb) hsa_op_reg *dest = hsa_cfun->reg_for_gimple_ssa (lhs); tree rhs1 = gimple_call_arg (call, 0); hsa_op_with_type *arg = hsa_reg_or_immed_for_gimple_op (rhs1, hbb); + arg->extend_int_to_32bit (hbb); BrigType16_t bittype = hsa_bittype_for_type (arg->m_type); unsigned bitsize = tree_to_uhwi (TYPE_SIZE (TREE_TYPE (rhs1))); @@ -4272,6 +4362,7 @@ gen_hsa_ffs (gcall *call, hsa_bb *hbb) tree rhs1 = gimple_call_arg (call, 0); hsa_op_with_type *arg = hsa_reg_or_immed_for_gimple_op (rhs1, hbb); + arg = arg->extend_int_to_32bit (hbb); hsa_op_reg *tmp = new hsa_op_reg (BRIG_TYPE_U32); hsa_insn_srctype *insn = new hsa_insn_srctype (2, BRIG_OPCODE_LASTBIT, @@ -4361,7 +4452,9 @@ gen_hsa_divmod (gcall *call, hsa_bb *hbb) tree rhs1 = gimple_call_arg (call, 1); hsa_op_with_type *arg0 = hsa_reg_or_immed_for_gimple_op (rhs0, hbb); + arg0 = arg0->extend_int_to_32bit (hbb); hsa_op_with_type *arg1 = hsa_reg_or_immed_for_gimple_op (rhs1, hbb); + arg1 = arg1->extend_int_to_32bit (hbb); hsa_op_reg *dest0 = new hsa_op_reg (arg0->m_type); hsa_op_reg *dest1 = new hsa_op_reg (arg1->m_type); @@ -4374,11 +4467,13 @@ gen_hsa_divmod (gcall *call, hsa_bb *hbb) hbb->append_insn (insn); hsa_op_reg *dest = hsa_cfun->reg_for_gimple_ssa (lhs); + BrigType16_t dst_type = hsa_extend_inttype_to_32bit (dest->m_type); BrigType16_t src_type = hsa_bittype_for_type (dest0->m_type); - insn = new hsa_insn_packed (3, BRIG_OPCODE_COMBINE, dest->m_type, - src_type, dest, dest0, dest1); + insn = new hsa_insn_packed (3, BRIG_OPCODE_COMBINE, dst_type, + src_type, NULL, dest0, dest1); hbb->append_insn (insn); + insn->set_output_in_type (dest, 0, hbb); } /* Set VALUE to a shadow kernel debug argument and append a new instruction @@ -4936,8 +5031,8 @@ gen_hsa_atomic_for_builtin (bool ret_orig, enum BrigAtomicOperation acode, tgt = addr; } - hsa_op_base *op = hsa_reg_or_immed_for_gimple_op (gimple_call_arg (stmt, 1), - hbb); + hsa_op_with_type *op + = hsa_reg_or_immed_for_gimple_op (gimple_call_arg (stmt, 1), hbb); if (lhs) { atominsn->set_op (0, dest); @@ -5560,8 +5655,7 @@ gen_hsa_insns_for_call (gimple *stmt, hsa_bb *hbb) break; } - case BUILT_IN_ALLOCA: - case BUILT_IN_ALLOCA_WITH_ALIGN: + CASE_BUILT_IN_ALLOCA: { gen_hsa_alloca (call, hbb); break; @@ -6175,7 +6269,7 @@ convert_switch_statements (void) tree label = gimple_switch_label (s, i); basic_block label_bb = label_to_block_fn (func, CASE_LABEL (label)); edge e = find_edge (bb, label_bb); - edge_counts.safe_push (e->count); + edge_counts.safe_push (e->count ()); edge_probabilities.safe_push (e->probability); gphi_iterator phi_gsi; @@ -6265,7 +6359,6 @@ convert_switch_statements (void) if (prob_sum.initialized_p ()) new_edge->probability = edge_probabilities[i] / prob_sum; - new_edge->count = edge_counts[i]; new_edges.safe_push (new_edge); if (i < labels - 1) @@ -6281,9 +6374,6 @@ convert_switch_statements (void) edge next_edge = make_edge (cur_bb, next_bb, EDGE_FALSE_VALUE); next_edge->probability = new_edge->probability.invert (); - next_edge->count = edge_counts[0] - + sum_slice (edge_counts, i, labels, - profile_count::zero ()); next_bb->frequency = EDGE_FREQUENCY (next_edge); cur_bb = next_bb; } @@ -6292,7 +6382,6 @@ convert_switch_statements (void) { edge e = make_edge (cur_bb, default_label_bb, EDGE_FALSE_VALUE); e->probability = new_edge->probability.invert (); - e->count = edge_counts[0]; new_edges.safe_insert (0, e); } } diff --git a/gcc/ifcvt.c b/gcc/ifcvt.c index e1b163cd42eec..72bab82491f48 100644 --- a/gcc/ifcvt.c +++ b/gcc/ifcvt.c @@ -121,7 +121,7 @@ count_bb_insns (const_basic_block bb) return count; } -/* Determine whether the total insn_rtx_cost on non-jump insns in +/* Determine whether the total insn_cost on non-jump insns in basic block BB is less than MAX_COST. This function returns false if the cost of any instruction could not be estimated. @@ -140,7 +140,7 @@ cheap_bb_rtx_cost_p (const_basic_block bb, : REG_BR_PROB_BASE; /* Set scale to REG_BR_PROB_BASE to void the identical scaling - applied to insn_rtx_cost when optimizing for size. Only do + applied to insn_cost when optimizing for size. Only do this after combine because if-conversion might interfere with passes before combine. @@ -163,7 +163,7 @@ cheap_bb_rtx_cost_p (const_basic_block bb, { if (NONJUMP_INSN_P (insn)) { - int cost = insn_rtx_cost (PATTERN (insn), speed) * REG_BR_PROB_BASE; + int cost = insn_cost (insn, speed) * REG_BR_PROB_BASE; if (cost == 0) return false; @@ -3021,7 +3021,7 @@ bb_valid_for_noce_process_p (basic_block test_bb, rtx cond, if (first_insn == last_insn) { *simple_p = noce_operand_ok (SET_DEST (first_set)); - *cost += insn_rtx_cost (first_set, speed_p); + *cost += pattern_cost (first_set, speed_p); return *simple_p; } @@ -3037,7 +3037,7 @@ bb_valid_for_noce_process_p (basic_block test_bb, rtx cond, /* The regs that are live out of test_bb. */ bitmap test_bb_live_out = df_get_live_out (test_bb); - int potential_cost = insn_rtx_cost (last_set, speed_p); + int potential_cost = pattern_cost (last_set, speed_p); rtx_insn *insn; FOR_BB_INSNS (test_bb, insn) { @@ -3057,7 +3057,7 @@ bb_valid_for_noce_process_p (basic_block test_bb, rtx cond, || reg_overlap_mentioned_p (SET_DEST (sset), cond)) goto free_bitmap_and_fail; - potential_cost += insn_rtx_cost (sset, speed_p); + potential_cost += pattern_cost (sset, speed_p); bitmap_set_bit (test_bb_temps, REGNO (SET_DEST (sset))); } } @@ -5283,8 +5283,6 @@ dead_or_predicable (basic_block test_bb, basic_block merge_bb, redirect_edge_succ (BRANCH_EDGE (test_bb), new_dest); if (reversep) { - std::swap (BRANCH_EDGE (test_bb)->count, - FALLTHRU_EDGE (test_bb)->count); std::swap (BRANCH_EDGE (test_bb)->probability, FALLTHRU_EDGE (test_bb)->probability); update_br_prob_note (test_bb); diff --git a/gcc/incpath.c b/gcc/incpath.c index 47942e2547dbe..a2ee69f428ceb 100644 --- a/gcc/incpath.c +++ b/gcc/incpath.c @@ -46,7 +46,7 @@ static const char dir_separator_str[] = { DIR_SEPARATOR, 0 }; -static void add_env_var_paths (const char *, int); +static void add_env_var_paths (const char *, incpath_kind); static void add_standard_paths (const char *, const char *, const char *, int); static void free_path (struct cpp_dir *, int); static void merge_include_chains (const char *, cpp_reader *, int); @@ -56,8 +56,9 @@ static struct cpp_dir *remove_duplicates (cpp_reader *, struct cpp_dir *, struct cpp_dir *, int); /* Include chains heads and tails. */ -static struct cpp_dir *heads[4]; -static struct cpp_dir *tails[4]; +static struct cpp_dir *heads[INC_MAX]; +static struct cpp_dir *tails[INC_MAX]; + static bool quote_ignores_source_dir; enum { REASON_QUIET = 0, REASON_NOENT, REASON_DUP, REASON_DUP_SYS }; @@ -92,7 +93,7 @@ free_path (struct cpp_dir *path, int reason) /* Read ENV_VAR for a PATH_SEPARATOR-separated list of file names; and append all the names to the search path CHAIN. */ static void -add_env_var_paths (const char *env_var, int chain) +add_env_var_paths (const char *env_var, incpath_kind chain) { char *p, *q, *path; @@ -116,7 +117,7 @@ add_env_var_paths (const char *env_var, int chain) path[q - p] = '\0'; } - add_path (path, chain, chain == SYSTEM, false); + add_path (path, chain, chain == INC_SYSTEM, false); } } @@ -159,7 +160,7 @@ add_standard_paths (const char *sysroot, const char *iprefix, str = reconcat (str, str, dir_separator_str, imultiarch, NULL); } - add_path (str, SYSTEM, p->cxx_aware, false); + add_path (str, INC_SYSTEM, p->cxx_aware, false); } } } @@ -225,7 +226,7 @@ add_standard_paths (const char *sysroot, const char *iprefix, str = reconcat (str, str, dir_separator_str, imultiarch, NULL); } - add_path (str, SYSTEM, p->cxx_aware, false); + add_path (str, INC_SYSTEM, p->cxx_aware, false); } } } @@ -349,29 +350,32 @@ merge_include_chains (const char *sysroot, cpp_reader *pfile, int verbose) /* Add the sysroot to user-supplied paths starting with "=". */ if (sysroot) { - add_sysroot_to_chain (sysroot, QUOTE); - add_sysroot_to_chain (sysroot, BRACKET); - add_sysroot_to_chain (sysroot, SYSTEM); - add_sysroot_to_chain (sysroot, AFTER); + add_sysroot_to_chain (sysroot, INC_QUOTE); + add_sysroot_to_chain (sysroot, INC_BRACKET); + add_sysroot_to_chain (sysroot, INC_SYSTEM); + add_sysroot_to_chain (sysroot, INC_AFTER); } /* Join the SYSTEM and AFTER chains. Remove duplicates in the resulting SYSTEM chain. */ - if (heads[SYSTEM]) - tails[SYSTEM]->next = heads[AFTER]; + if (heads[INC_SYSTEM]) + tails[INC_SYSTEM]->next = heads[INC_AFTER]; else - heads[SYSTEM] = heads[AFTER]; - heads[SYSTEM] = remove_duplicates (pfile, heads[SYSTEM], 0, 0, verbose); + heads[INC_SYSTEM] = heads[INC_AFTER]; + heads[INC_SYSTEM] + = remove_duplicates (pfile, heads[INC_SYSTEM], 0, 0, verbose); /* Remove duplicates from BRACKET that are in itself or SYSTEM, and join it to SYSTEM. */ - heads[BRACKET] = remove_duplicates (pfile, heads[BRACKET], heads[SYSTEM], - heads[SYSTEM], verbose); + heads[INC_BRACKET] + = remove_duplicates (pfile, heads[INC_BRACKET], heads[INC_SYSTEM], + heads[INC_SYSTEM], verbose); /* Remove duplicates from QUOTE that are in itself or SYSTEM, and join it to BRACKET. */ - heads[QUOTE] = remove_duplicates (pfile, heads[QUOTE], heads[SYSTEM], - heads[BRACKET], verbose); + heads[INC_QUOTE] + = remove_duplicates (pfile, heads[INC_QUOTE], heads[INC_SYSTEM], + heads[INC_BRACKET], verbose); /* If verbose, print the list of dirs to search. */ if (verbose) @@ -379,9 +383,9 @@ merge_include_chains (const char *sysroot, cpp_reader *pfile, int verbose) struct cpp_dir *p; fprintf (stderr, _("#include \"...\" search starts here:\n")); - for (p = heads[QUOTE];; p = p->next) + for (p = heads[INC_QUOTE];; p = p->next) { - if (p == heads[BRACKET]) + if (p == heads[INC_BRACKET]) fprintf (stderr, _("#include <...> search starts here:\n")); if (!p) break; @@ -398,14 +402,14 @@ merge_include_chains (const char *sysroot, cpp_reader *pfile, int verbose) void split_quote_chain (void) { - if (heads[QUOTE]) - free_path (heads[QUOTE], REASON_QUIET); - if (tails[QUOTE]) - free_path (tails[QUOTE], REASON_QUIET); - heads[QUOTE] = heads[BRACKET]; - tails[QUOTE] = tails[BRACKET]; - heads[BRACKET] = NULL; - tails[BRACKET] = NULL; + if (heads[INC_QUOTE]) + free_path (heads[INC_QUOTE], REASON_QUIET); + if (tails[INC_QUOTE]) + free_path (tails[INC_QUOTE], REASON_QUIET); + heads[INC_QUOTE] = heads[INC_BRACKET]; + tails[INC_QUOTE] = tails[INC_BRACKET]; + heads[INC_BRACKET] = NULL; + tails[INC_BRACKET] = NULL; /* This is NOT redundant. */ quote_ignores_source_dir = true; } @@ -413,7 +417,7 @@ split_quote_chain (void) /* Add P to the chain specified by CHAIN. */ void -add_cpp_dir_path (cpp_dir *p, int chain) +add_cpp_dir_path (cpp_dir *p, incpath_kind chain) { if (tails[chain]) tails[chain]->next = p; @@ -425,7 +429,7 @@ add_cpp_dir_path (cpp_dir *p, int chain) /* Add PATH to the include chain CHAIN. PATH must be malloc-ed and NUL-terminated. */ void -add_path (char *path, int chain, int cxx_aware, bool user_supplied_p) +add_path (char *path, incpath_kind chain, int cxx_aware, bool user_supplied_p) { cpp_dir *p; @@ -450,7 +454,7 @@ add_path (char *path, int chain, int cxx_aware, bool user_supplied_p) #ifndef INO_T_EQ p->canonical_name = lrealpath (path); #endif - if (chain == SYSTEM || chain == AFTER) + if (chain == INC_SYSTEM || chain == INC_AFTER) p->sysp = 1 + !cxx_aware; else p->sysp = 0; @@ -480,8 +484,8 @@ register_include_chains (cpp_reader *pfile, const char *sysroot, /* CPATH and language-dependent environment variables may add to the include chain. */ - add_env_var_paths ("CPATH", BRACKET); - add_env_var_paths (lang_env_vars[idx], SYSTEM); + add_env_var_paths ("CPATH", INC_BRACKET); + add_env_var_paths (lang_env_vars[idx], INC_SYSTEM); target_c_incpath.extra_pre_includes (sysroot, iprefix, stdinc); @@ -493,14 +497,14 @@ register_include_chains (cpp_reader *pfile, const char *sysroot, merge_include_chains (sysroot, pfile, verbose); - cpp_set_include_chains (pfile, heads[QUOTE], heads[BRACKET], + cpp_set_include_chains (pfile, heads[INC_QUOTE], heads[INC_BRACKET], quote_ignores_source_dir); } /* Return the current chain of cpp dirs. */ struct cpp_dir * -get_added_cpp_dirs (int chain) +get_added_cpp_dirs (incpath_kind chain) { return heads[chain]; } diff --git a/gcc/incpath.h b/gcc/incpath.h index 39a29cdd47eb0..32c3dceb78b1a 100644 --- a/gcc/incpath.h +++ b/gcc/incpath.h @@ -18,13 +18,22 @@ #ifndef GCC_INCPATH_H #define GCC_INCPATH_H +/* Various fragments of include path. */ +enum incpath_kind { + INC_QUOTE = 0, /* include "foo" */ + INC_BRACKET, /* include */ + INC_SYSTEM, /* sysinclude */ + INC_AFTER, /* post-sysinclude. */ + INC_MAX +}; + extern void split_quote_chain (void); -extern void add_path (char *, int, int, bool); +extern void add_path (char *, incpath_kind, int, bool); extern void register_include_chains (cpp_reader *, const char *, const char *, const char *, int, int, int); -extern void add_cpp_dir_path (struct cpp_dir *, int); -extern struct cpp_dir *get_added_cpp_dirs (int); +extern void add_cpp_dir_path (struct cpp_dir *, incpath_kind); +extern struct cpp_dir *get_added_cpp_dirs (incpath_kind); struct target_c_incpath_s { /* Do extra includes processing. STDINC is false iff -nostdinc was given. */ @@ -34,6 +43,4 @@ struct target_c_incpath_s { extern struct target_c_incpath_s target_c_incpath; -enum { QUOTE = 0, BRACKET, SYSTEM, AFTER }; - #endif /* GCC_INCPATH_H */ diff --git a/gcc/internal-fn.c b/gcc/internal-fn.c index 051f78715c220..ce9e8bb75e988 100644 --- a/gcc/internal-fn.c +++ b/gcc/internal-fn.c @@ -485,7 +485,7 @@ get_min_precision (tree arg, signop sign) p = wi::min_precision (w, sign); } else - p = wi::min_precision (arg, sign); + p = wi::min_precision (wi::to_wide (arg), sign); return MIN (p, prec); } while (CONVERT_EXPR_P (arg) @@ -1770,8 +1770,8 @@ expand_mul_overflow (location_t loc, tree lhs, tree arg0, tree arg1, } /* At this point hipart{0,1} are both in [-1, 0]. If they are - the same, overflow happened if res is negative, if they are - different, overflow happened if res is positive. */ + the same, overflow happened if res is non-positive, if they + are different, overflow happened if res is positive. */ if (op0_sign != 1 && op1_sign != 1 && op0_sign != op1_sign) emit_jump (hipart_different); else if (op0_sign == 1 || op1_sign == 1) @@ -1779,7 +1779,7 @@ expand_mul_overflow (location_t loc, tree lhs, tree arg0, tree arg1, NULL_RTX, NULL, hipart_different, profile_probability::even ()); - do_compare_rtx_and_jump (res, const0_rtx, LT, false, mode, + do_compare_rtx_and_jump (res, const0_rtx, LE, false, mode, NULL_RTX, NULL, do_error, profile_probability::very_unlikely ()); emit_jump (done_label); diff --git a/gcc/ipa-cp.c b/gcc/ipa-cp.c index 6b3d8d7364ced..d23c1d8ba3eca 100644 --- a/gcc/ipa-cp.c +++ b/gcc/ipa-cp.c @@ -4971,8 +4971,8 @@ ipcp_store_vr_results (void) { vr.known = true; vr.type = plats->m_value_range.m_vr.type; - vr.min = plats->m_value_range.m_vr.min; - vr.max = plats->m_value_range.m_vr.max; + vr.min = wi::to_wide (plats->m_value_range.m_vr.min); + vr.max = wi::to_wide (plats->m_value_range.m_vr.max); } else { diff --git a/gcc/ipa-icf.c b/gcc/ipa-icf.c index 4d152ceab1e03..e666d5ab2d00e 100644 --- a/gcc/ipa-icf.c +++ b/gcc/ipa-icf.c @@ -1422,6 +1422,7 @@ sem_function::init (void) } } + hstate.commit_flag (); gcode_hash = hstate.end (); bb_sizes.safe_push (nondbg_stmt_count); @@ -1644,6 +1645,11 @@ sem_function::hash_stmt (gimple *stmt, inchash::hash &hstate) if (gimple_op (stmt, i)) add_type (TREE_TYPE (gimple_op (stmt, i)), hstate); } + /* Consider nocf_check attribute in hash as it affects code + generation. */ + if (code == GIMPLE_CALL + && flag_cf_protection & CF_BRANCH) + hstate.add_flag (gimple_call_nocf_check_p (as_a (stmt))); default: break; } diff --git a/gcc/ipa-inline-transform.c b/gcc/ipa-inline-transform.c index dc224f7a39469..1e7fafa1bff88 100644 --- a/gcc/ipa-inline-transform.c +++ b/gcc/ipa-inline-transform.c @@ -692,14 +692,7 @@ inline_transform (struct cgraph_node *node) basic_block bb; FOR_ALL_BB_FN (bb, cfun) - { - bb->count = bb->count.apply_scale (num, den); - - edge e; - edge_iterator ei; - FOR_EACH_EDGE (e, ei, bb->succs) - e->count = e->count.apply_scale (num, den); - } + bb->count = bb->count.apply_scale (num, den); ENTRY_BLOCK_PTR_FOR_FN (cfun)->count = node->count; } todo = optimize_inline_calls (current_function_decl); diff --git a/gcc/ipa-polymorphic-call.c b/gcc/ipa-polymorphic-call.c index 9ac5153bf6716..1c5aca4abdcfe 100644 --- a/gcc/ipa-polymorphic-call.c +++ b/gcc/ipa-polymorphic-call.c @@ -967,8 +967,9 @@ ipa_polymorphic_call_context::ipa_polymorphic_call_context (tree fndecl, else if (TREE_CODE (base_pointer) == POINTER_PLUS_EXPR && TREE_CODE (TREE_OPERAND (base_pointer, 1)) == INTEGER_CST) { - offset_int o = offset_int::from (TREE_OPERAND (base_pointer, 1), - SIGNED); + offset_int o + = offset_int::from (wi::to_wide (TREE_OPERAND (base_pointer, 1)), + SIGNED); o *= BITS_PER_UNIT; o += offset; if (!wi::fits_shwi_p (o)) diff --git a/gcc/ipa-prop.c b/gcc/ipa-prop.c index 51f6221850114..a687f7cb29e99 100644 --- a/gcc/ipa-prop.c +++ b/gcc/ipa-prop.c @@ -397,9 +397,9 @@ ipa_print_node_jump_functions_for_edge (FILE *f, struct cgraph_edge *cs) fprintf (f, " VR "); fprintf (f, "%s[", (jump_func->m_vr->type == VR_ANTI_RANGE) ? "~" : ""); - print_decs (jump_func->m_vr->min, f); + print_decs (wi::to_wide (jump_func->m_vr->min), f); fprintf (f, ", "); - print_decs (jump_func->m_vr->max, f); + print_decs (wi::to_wide (jump_func->m_vr->max), f); fprintf (f, "]\n"); } else @@ -1931,9 +1931,9 @@ ipa_compute_jump_functions_for_edge (struct ipa_func_body_info *fbi, unsigned align; get_pointer_alignment_1 (arg, &align, &bitpos); - widest_int mask - = wi::mask(TYPE_PRECISION (TREE_TYPE (arg)), false) - .and_not (align / BITS_PER_UNIT - 1); + widest_int mask = wi::bit_and_not + (wi::mask (TYPE_PRECISION (TREE_TYPE (arg)), false), + align / BITS_PER_UNIT - 1); widest_int value = bitpos / BITS_PER_UNIT; ipa_set_jfunc_bits (jfunc, value, mask); } @@ -4373,7 +4373,8 @@ ipa_modify_call_arguments (struct cgraph_edge *cs, gcall *stmt, if (TYPE_ALIGN (type) > align) align = TYPE_ALIGN (type); } - misalign += (offset_int::from (off, SIGNED).to_short_addr () + misalign += (offset_int::from (wi::to_wide (off), + SIGNED).to_short_addr () * BITS_PER_UNIT); misalign = misalign & (align - 1); if (misalign != 0) diff --git a/gcc/ipa-pure-const.c b/gcc/ipa-pure-const.c index dac8f0d5f2144..3c06e2d303328 100644 --- a/gcc/ipa-pure-const.c +++ b/gcc/ipa-pure-const.c @@ -156,7 +156,8 @@ class pass_ipa_pure_const : public ipa_opt_pass_d static bool function_always_visible_to_compiler_p (tree decl) { - return (!TREE_PUBLIC (decl) || DECL_DECLARED_INLINE_P (decl)); + return (!TREE_PUBLIC (decl) || DECL_DECLARED_INLINE_P (decl) + || DECL_COMDAT (decl)); } /* Emit suggestion about attribute ATTRIB_NAME for DECL. KNOWN_FINITE @@ -232,6 +233,21 @@ warn_function_noreturn (tree decl) true, warned_about, "noreturn"); } +void +warn_function_cold (tree decl) +{ + tree original_decl = decl; + + cgraph_node *node = cgraph_node::get (decl); + if (node->instrumentation_clone) + decl = node->instrumented_version->decl; + + static hash_set *warned_about; + warned_about + = suggest_attribute (OPT_Wsuggest_attribute_cold, original_decl, + true, warned_about, "cold"); +} + /* Return true if we have a function state for NODE. */ static inline bool @@ -502,8 +518,7 @@ special_builtin_state (enum pure_const_state_e *state, bool *looping, { case BUILT_IN_RETURN: case BUILT_IN_UNREACHABLE: - case BUILT_IN_ALLOCA: - case BUILT_IN_ALLOCA_WITH_ALIGN: + CASE_BUILT_IN_ALLOCA: case BUILT_IN_STACK_SAVE: case BUILT_IN_STACK_RESTORE: case BUILT_IN_EH_POINTER: @@ -1788,6 +1803,7 @@ pass_local_pure_const::execute (function *fun) node = cgraph_node::get (current_function_decl); skip = skip_function_for_local_pure_const (node); + if (!warn_suggest_attribute_const && !warn_suggest_attribute_pure && skip) diff --git a/gcc/ipa-split.c b/gcc/ipa-split.c index e3759d6c50e40..f2d1478d5903f 100644 --- a/gcc/ipa-split.c +++ b/gcc/ipa-split.c @@ -1285,7 +1285,6 @@ split_function (basic_block return_bb, struct split_point *split_point, FOR_EACH_EDGE (e, ei, return_bb->preds) if (bitmap_bit_p (split_point->split_bbs, e->src->index)) { - new_return_bb->count += e->count; new_return_bb->frequency += EDGE_FREQUENCY (e); redirect_edge_and_branch (e, new_return_bb); redirected = true; diff --git a/gcc/ipa-utils.c b/gcc/ipa-utils.c index 708710d61353a..a27e406efec95 100644 --- a/gcc/ipa-utils.c +++ b/gcc/ipa-utils.c @@ -524,20 +524,28 @@ ipa_merge_profiles (struct cgraph_node *dst, unsigned int i; dstbb = BASIC_BLOCK_FOR_FN (dstcfun, srcbb->index); - if (dstbb->count.initialized_p ()) - dstbb->count += srcbb->count; - else - dstbb->count = srcbb->count; - for (i = 0; i < EDGE_COUNT (srcbb->succs); i++) + if (!dstbb->count.initialized_p ()) { - edge srce = EDGE_SUCC (srcbb, i); - edge dste = EDGE_SUCC (dstbb, i); - if (dstbb->count.initialized_p ()) - dste->count += srce->count; - else - dste->count = srce->count; - if (dstbb->count > 0 && dste->count.initialized_p ()) - dste->probability = dste->count.probability_in (dstbb->count); + dstbb->count = srcbb->count; + for (i = 0; i < EDGE_COUNT (srcbb->succs); i++) + { + edge srce = EDGE_SUCC (srcbb, i); + edge dste = EDGE_SUCC (dstbb, i); + if (srce->probability.initialized_p ()) + dste->probability = srce->probability; + } + } + else if (srcbb->count.initialized_p ()) + { + for (i = 0; i < EDGE_COUNT (srcbb->succs); i++) + { + edge srce = EDGE_SUCC (srcbb, i); + edge dste = EDGE_SUCC (dstbb, i); + dste->probability = + dste->probability * dstbb->count.probability_in (dstbb->count + srcbb->count) + + srce->probability * srcbb->count.probability_in (dstbb->count + srcbb->count); + } + dstbb->count += srcbb->count; } } push_cfun (dstcfun); diff --git a/gcc/ipa-utils.h b/gcc/ipa-utils.h index f061c84c8a961..2affbd66d1378 100644 --- a/gcc/ipa-utils.h +++ b/gcc/ipa-utils.h @@ -217,11 +217,11 @@ type_in_anonymous_namespace_p (const_tree t) { /* C++ FE uses magic as assembler names of anonymous types. verify that this match with type_in_anonymous_namespace_p. */ - gcc_checking_assert (!in_lto_p || !DECL_ASSEMBLER_NAME_SET_P (t) - || !strcmp - ("", - IDENTIFIER_POINTER - (DECL_ASSEMBLER_NAME (TYPE_NAME (t))))); + gcc_checking_assert (!in_lto_p + || !DECL_ASSEMBLER_NAME_SET_P (TYPE_NAME (t)) + || !strcmp ("", + IDENTIFIER_POINTER + (DECL_ASSEMBLER_NAME (TYPE_NAME (t))))); return true; } return false; @@ -245,14 +245,13 @@ odr_type_p (const_tree t) if (type_in_anonymous_namespace_p (t)) return true; - if (TYPE_NAME (t) && TREE_CODE (TYPE_NAME (t)) == TYPE_DECL - && DECL_ASSEMBLER_NAME_SET_P (TYPE_NAME (t))) + if (TYPE_NAME (t) && DECL_ASSEMBLER_NAME_SET_P (TYPE_NAME (t))) { /* C++ FE uses magic as assembler names of anonymous types. verify that this match with type_in_anonymous_namespace_p. */ gcc_checking_assert (strcmp ("", - IDENTIFIER_POINTER - (DECL_ASSEMBLER_NAME (TYPE_NAME (t))))); + IDENTIFIER_POINTER + (DECL_ASSEMBLER_NAME (TYPE_NAME (t))))); return true; } return false; diff --git a/gcc/ira-color.c b/gcc/ira-color.c index 22fdb88274db4..31a4a8074d19e 100644 --- a/gcc/ira-color.c +++ b/gcc/ira-color.c @@ -3005,14 +3005,13 @@ allocno_priority_compare_func (const void *v1p, const void *v2p) { ira_allocno_t a1 = *(const ira_allocno_t *) v1p; ira_allocno_t a2 = *(const ira_allocno_t *) v2p; - int pri1, pri2; + int pri1, pri2, diff; /* Assign hard reg to static chain pointer pseudo first when non-local goto is used. */ - if (non_spilled_static_chain_regno_p (ALLOCNO_REGNO (a1))) - return 1; - else if (non_spilled_static_chain_regno_p (ALLOCNO_REGNO (a2))) - return -1; + if ((diff = (non_spilled_static_chain_regno_p (ALLOCNO_REGNO (a2)) + - non_spilled_static_chain_regno_p (ALLOCNO_REGNO (a1)))) != 0) + return diff; pri1 = allocno_priorities[ALLOCNO_NUM (a1)]; pri2 = allocno_priorities[ALLOCNO_NUM (a2)]; if (pri2 != pri1) diff --git a/gcc/ira.c b/gcc/ira.c index 046ce3bc49508..8c93d3df518e0 100644 --- a/gcc/ira.c +++ b/gcc/ira.c @@ -4400,6 +4400,12 @@ rtx_moveable_p (rtx *loc, enum op_type type) for a reason. */ return false; + case ASM_OPERANDS: + /* The same is true for volatile asm: it has unknown side effects, it + cannot be moved at will. */ + if (MEM_VOLATILE_P (x)) + return false; + default: break; } diff --git a/gcc/langhooks.c b/gcc/langhooks.c index c54b790f0cc5e..9b3212b90cf19 100644 --- a/gcc/langhooks.c +++ b/gcc/langhooks.c @@ -266,8 +266,8 @@ lhd_gimplify_expr (tree *expr_p ATTRIBUTE_UNUSED, } /* lang_hooks.tree_size: Determine the size of a tree with code C, - which is a language-specific tree code in category tcc_constant or - tcc_exceptional. The default expects never to be called. */ + which is a language-specific tree code in category tcc_constant, + tcc_exceptional or tcc_type. The default expects never to be called. */ size_t lhd_tree_size (enum tree_code c ATTRIBUTE_UNUSED) { diff --git a/gcc/langhooks.h b/gcc/langhooks.h index b0c9829a6cd4d..d1288f1965d19 100644 --- a/gcc/langhooks.h +++ b/gcc/langhooks.h @@ -307,10 +307,10 @@ struct lang_hooks /* Remove any parts of the tree that are used only by the FE. */ void (*free_lang_data) (tree); - /* Determines the size of any language-specific tcc_constant or - tcc_exceptional nodes. Since it is called from make_node, the - only information available is the tree code. Expected to die - on unrecognized codes. */ + /* Determines the size of any language-specific tcc_constant, + tcc_exceptional or tcc_type nodes. Since it is called from + make_node, the only information available is the tree code. + Expected to die on unrecognized codes. */ size_t (*tree_size) (enum tree_code); /* Return the language mask used for converting argv into a sequence diff --git a/gcc/loop-doloop.c b/gcc/loop-doloop.c index 5769d9deccb36..421b35513d2a7 100644 --- a/gcc/loop-doloop.c +++ b/gcc/loop-doloop.c @@ -393,9 +393,7 @@ add_test (rtx cond, edge *e, basic_block dest) edge e2 = make_edge (bb, dest, (*e)->flags & ~EDGE_FALLTHRU); e2->probability = prob; - e2->count = e2->src->count.apply_probability (prob); (*e)->probability = prob.invert (); - (*e)->count = (*e)->count.apply_probability (prob); update_br_prob_note (e2->src); return true; } diff --git a/gcc/loop-iv.c b/gcc/loop-iv.c index 1d0c66f2b2ffc..45e822980ff40 100644 --- a/gcc/loop-iv.c +++ b/gcc/loop-iv.c @@ -353,7 +353,7 @@ iv_get_reaching_def (rtx_insn *insn, rtx reg, df_ref *def) adef = DF_REF_CHAIN (use)->ref; /* We do not handle setting only part of the register. */ - if (DF_REF_FLAGS (adef) & DF_REF_READ_WRITE) + if (DF_REF_FLAGS (adef) & (DF_REF_READ_WRITE | DF_REF_SUBREG)) return GRD_INVALID; def_insn = DF_REF_INSN (adef); diff --git a/gcc/loop-unroll.c b/gcc/loop-unroll.c index 322f151ac5dfd..816302b9e70d8 100644 --- a/gcc/loop-unroll.c +++ b/gcc/loop-unroll.c @@ -977,7 +977,6 @@ unroll_loop_runtime_iterations (struct loop *loop) iter_count = new_count = swtch->count.apply_scale (1, max_unroll + 1); swtch->frequency = new_freq; swtch->count = new_count; - single_succ_edge (swtch)->count = new_count; for (i = 0; i < n_peel; i++) { @@ -999,7 +998,6 @@ unroll_loop_runtime_iterations (struct loop *loop) /* Add in frequency/count of edge from switch block. */ preheader->frequency += iter_freq; preheader->count += iter_count; - single_succ_edge (preheader)->count = preheader->count; branch_code = compare_and_jump_seq (copy_rtx (niter), GEN_INT (j), EQ, block_label (preheader), p, NULL); @@ -1011,14 +1009,12 @@ unroll_loop_runtime_iterations (struct loop *loop) swtch = split_edge_and_insert (single_pred_edge (swtch), branch_code); set_immediate_dominator (CDI_DOMINATORS, preheader, swtch); single_succ_edge (swtch)->probability = p.invert (); - single_succ_edge (swtch)->count = new_count; new_freq += iter_freq; new_count += iter_count; swtch->frequency = new_freq; swtch->count = new_count; e = make_edge (swtch, preheader, single_succ_edge (swtch)->flags & EDGE_IRREDUCIBLE_LOOP); - e->count = iter_count; e->probability = p; } @@ -1035,7 +1031,6 @@ unroll_loop_runtime_iterations (struct loop *loop) /* Add in frequency/count of edge from switch block. */ preheader->frequency += iter_freq; preheader->count += iter_count; - single_succ_edge (preheader)->count = preheader->count; branch_code = compare_and_jump_seq (copy_rtx (niter), const0_rtx, EQ, block_label (preheader), p, NULL); @@ -1044,10 +1039,8 @@ unroll_loop_runtime_iterations (struct loop *loop) swtch = split_edge_and_insert (single_succ_edge (swtch), branch_code); set_immediate_dominator (CDI_DOMINATORS, preheader, swtch); single_succ_edge (swtch)->probability = p.invert (); - single_succ_edge (swtch)->count -= iter_count; e = make_edge (swtch, preheader, single_succ_edge (swtch)->flags & EDGE_IRREDUCIBLE_LOOP); - e->count = iter_count; e->probability = p; } diff --git a/gcc/lra-constraints.c b/gcc/lra-constraints.c index 4734c072c96fc..6163d7d505670 100644 --- a/gcc/lra-constraints.c +++ b/gcc/lra-constraints.c @@ -4271,7 +4271,13 @@ curr_insn_transform (bool check_only_p) } else if (curr_static_id->operand[i].type == OP_IN && (curr_static_id->operand[goal_alt_matched[i][0]].type - == OP_OUT)) + == OP_OUT + || (curr_static_id->operand[goal_alt_matched[i][0]].type + == OP_INOUT + && (operands_match_p + (*curr_id->operand_loc[i], + *curr_id->operand_loc[goal_alt_matched[i][0]], + -1))))) { /* generate reloads for input and matched outputs. */ match_inputs[0] = i; @@ -4282,9 +4288,14 @@ curr_insn_transform (bool check_only_p) [goal_alt_number * n_operands + goal_alt_matched[i][0]] .earlyclobber); } - else if (curr_static_id->operand[i].type == OP_OUT + else if ((curr_static_id->operand[i].type == OP_OUT + || (curr_static_id->operand[i].type == OP_INOUT + && (operands_match_p + (*curr_id->operand_loc[i], + *curr_id->operand_loc[goal_alt_matched[i][0]], + -1)))) && (curr_static_id->operand[goal_alt_matched[i][0]].type - == OP_IN)) + == OP_IN)) /* Generate reloads for output and matched inputs. */ match_reload (i, goal_alt_matched[i], outputs, goal_alt[i], &before, &after, curr_static_id->operand_alternative diff --git a/gcc/lra-lives.c b/gcc/lra-lives.c index 4648eca5ace8a..df7e2537dd09a 100644 --- a/gcc/lra-lives.c +++ b/gcc/lra-lives.c @@ -220,6 +220,9 @@ lra_intersected_live_ranges_p (lra_live_range_t r1, lra_live_range_t r2) return false; } +/* The corresponding bitmaps of BB currently being processed. */ +static bitmap bb_killed_pseudos, bb_gen_pseudos; + /* The function processing birth of hard register REGNO. It updates living hard regs, START_LIVING, and conflict hard regs for living pseudos. Conflict hard regs for the pic pseudo is not updated if @@ -243,6 +246,8 @@ make_hard_regno_born (int regno, bool check_pic_pseudo_p ATTRIBUTE_UNUSED) || i != REGNO (pic_offset_table_rtx)) #endif SET_HARD_REG_BIT (lra_reg_info[i].conflict_hard_regs, regno); + if (fixed_regs[regno]) + bitmap_set_bit (bb_gen_pseudos, regno); } /* Process the death of hard register REGNO. This updates @@ -255,6 +260,11 @@ make_hard_regno_dead (int regno) return; sparseset_set_bit (start_dying, regno); CLEAR_HARD_REG_BIT (hard_regs_live, regno); + if (fixed_regs[regno]) + { + bitmap_clear_bit (bb_gen_pseudos, regno); + bitmap_set_bit (bb_killed_pseudos, regno); + } } /* Mark pseudo REGNO as living at program point POINT, update conflicting @@ -299,9 +309,6 @@ mark_pseudo_dead (int regno, int point) } } -/* The corresponding bitmaps of BB currently being processed. */ -static bitmap bb_killed_pseudos, bb_gen_pseudos; - /* Mark register REGNO (pseudo or hard register) in MODE as live at program point POINT. Update BB_GEN_PSEUDOS. Return TRUE if the liveness tracking sets were modified, or FALSE diff --git a/gcc/lra.c b/gcc/lra.c index a4737773b6e8f..3122f2c25053a 100644 --- a/gcc/lra.c +++ b/gcc/lra.c @@ -820,7 +820,8 @@ collect_non_operand_hard_regs (rtx *x, lra_insn_recog_data_t data, const char *fmt = GET_RTX_FORMAT (code); for (i = 0; i < data->insn_static_data->n_operands; i++) - if (x == data->operand_loc[i]) + if (! data->insn_static_data->operand[i].is_operator + && x == data->operand_loc[i]) /* It is an operand loc. Stop here. */ return list; for (i = 0; i < data->insn_static_data->n_dups; i++) diff --git a/gcc/lto-streamer-in.c b/gcc/lto-streamer-in.c index 51d9a7b222b56..ea6f92b174f5d 100644 --- a/gcc/lto-streamer-in.c +++ b/gcc/lto-streamer-in.c @@ -715,8 +715,7 @@ make_new_block (struct function *fn, unsigned int index) static void input_cfg (struct lto_input_block *ib, struct data_in *data_in, - struct function *fn, - int count_materialization_scale) + struct function *fn) { unsigned int bb_count; basic_block p_bb; @@ -756,13 +755,10 @@ input_cfg (struct lto_input_block *ib, struct data_in *data_in, unsigned int edge_flags; basic_block dest; profile_probability probability; - profile_count count; edge e; dest_index = streamer_read_uhwi (ib); probability = profile_probability::stream_in (ib); - count = profile_count::stream_in (ib).apply_scale - (count_materialization_scale, REG_BR_PROB_BASE); edge_flags = streamer_read_uhwi (ib); dest = BASIC_BLOCK_FOR_FN (fn, dest_index); @@ -772,7 +768,6 @@ input_cfg (struct lto_input_block *ib, struct data_in *data_in, e = make_edge (bb, dest, edge_flags); e->probability = probability; - e->count = count; } index = streamer_read_hwi (ib); @@ -1070,7 +1065,7 @@ input_function (tree fn_decl, struct data_in *data_in, if (!node) node = cgraph_node::create (fn_decl); input_struct_function_base (fn, data_in, ib); - input_cfg (ib_cfg, data_in, fn, node->count_materialization_scale); + input_cfg (ib_cfg, data_in, fn); /* Read all the SSA names. */ input_ssa_names (ib, data_in, fn); diff --git a/gcc/lto-streamer-out.c b/gcc/lto-streamer-out.c index 944502be3f8ae..d007c0af5d66a 100644 --- a/gcc/lto-streamer-out.c +++ b/gcc/lto-streamer-out.c @@ -1883,7 +1883,6 @@ output_cfg (struct output_block *ob, struct function *fn) { streamer_write_uhwi (ob, e->dest->index); e->probability.stream_out (ob); - e->count.stream_out (ob); streamer_write_uhwi (ob, e->flags); } } diff --git a/gcc/lto/ChangeLog b/gcc/lto/ChangeLog index 1911e84d1ca91..173cde67369d7 100644 --- a/gcc/lto/ChangeLog +++ b/gcc/lto/ChangeLog @@ -1,3 +1,18 @@ +2017-10-13 Jan Hubicka + + * lto-lang.c (lto_post_options): Clean shlib flag when not doing PIC. + +2017-10-11 Nathan Sidwell + + * lto.c (mentions_vars_p_decl_with_vis): Use + DECL_ASSEMBLER_NAME_RAW. + (lto_fixup_prevailing_decls): Likewise. + +2017-10-10 Richard Sandiford + + * lto.c (compare_tree_sccs_1): Use wi::to_wide when + operating on trees as wide_ints. + 2017-08-30 Richard Sandiford Alan Hayward David Sherwood diff --git a/gcc/lto/lto-lang.c b/gcc/lto/lto-lang.c index eaf793383f771..88f29705e65cb 100644 --- a/gcc/lto/lto-lang.c +++ b/gcc/lto/lto-lang.c @@ -854,11 +854,13 @@ lto_post_options (const char **pfilename ATTRIBUTE_UNUSED) flag_pie is 2. */ flag_pie = MAX (flag_pie, flag_pic); flag_pic = flag_pie; + flag_shlib = 0; break; case LTO_LINKER_OUTPUT_EXEC: /* Normal executable */ flag_pic = 0; flag_pie = 0; + flag_shlib = 0; break; case LTO_LINKER_OUTPUT_UNKNOWN: diff --git a/gcc/lto/lto.c b/gcc/lto/lto.c index 182607b6fa4b5..63ba73c0dbf2f 100644 --- a/gcc/lto/lto.c +++ b/gcc/lto/lto.c @@ -591,7 +591,7 @@ mentions_vars_p_decl_with_vis (tree t) return true; /* Accessor macro has side-effects, use field-name here. */ - CHECK_NO_VAR (t->decl_with_vis.assembler_name); + CHECK_NO_VAR (DECL_ASSEMBLER_NAME_RAW (t)); return false; } @@ -1039,7 +1039,7 @@ compare_tree_sccs_1 (tree t1, tree t2, tree **map) if (CODE_CONTAINS_STRUCT (code, TS_INT_CST)) { - if (!wi::eq_p (t1, t2)) + if (wi::to_wide (t1) != wi::to_wide (t2)) return false; } @@ -2557,7 +2557,7 @@ lto_fixup_prevailing_decls (tree t) } if (CODE_CONTAINS_STRUCT (code, TS_DECL_WITH_VIS)) { - LTO_NO_PREVAIL (t->decl_with_vis.assembler_name); + LTO_NO_PREVAIL (DECL_ASSEMBLER_NAME_RAW (t)); } if (CODE_CONTAINS_STRUCT (code, TS_DECL_NON_COMMON)) { diff --git a/gcc/match.pd b/gcc/match.pd index e58a65af59b44..f2c43737b800d 100644 --- a/gcc/match.pd +++ b/gcc/match.pd @@ -276,7 +276,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (div (div @0 INTEGER_CST@1) INTEGER_CST@2) (with { bool overflow_p; - wide_int mul = wi::mul (@1, @2, TYPE_SIGN (type), &overflow_p); + wide_int mul = wi::mul (wi::to_wide (@1), wi::to_wide (@2), + TYPE_SIGN (type), &overflow_p); } (if (!overflow_p) (div @0 { wide_int_to_tree (type, mul); }) @@ -290,7 +291,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (mult (mult @0 INTEGER_CST@1) INTEGER_CST@2) (with { bool overflow_p; - wide_int mul = wi::mul (@1, @2, TYPE_SIGN (type), &overflow_p); + wide_int mul = wi::mul (wi::to_wide (@1), wi::to_wide (@2), + TYPE_SIGN (type), &overflow_p); } /* Skip folding on overflow: the only special case is @1 * @2 == -INT_MIN, otherwise undefined overflow implies that @0 must be zero. */ @@ -359,9 +361,10 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (if (integer_pow2p (@2) && tree_int_cst_sgn (@2) > 0 && tree_nop_conversion_p (type, TREE_TYPE (@0)) - && wi::add (@2, @1) == 0) - (rshift (convert @0) { build_int_cst (integer_type_node, - wi::exact_log2 (@2)); })))) + && wi::to_wide (@2) + wi::to_wide (@1) == 0) + (rshift (convert @0) + { build_int_cst (integer_type_node, + wi::exact_log2 (wi::to_wide (@2))); })))) /* If ARG1 is a constant, we can convert this to a multiply by the reciprocal. This does not have the same rounding properties, @@ -414,7 +417,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (mod (mult @0 INTEGER_CST@1) INTEGER_CST@2) (if (ANY_INTEGRAL_TYPE_P (type) && TYPE_OVERFLOW_UNDEFINED (type) - && wi::multiple_of_p (@1, @2, TYPE_SIGN (type))) + && wi::multiple_of_p (wi::to_wide (@1), wi::to_wide (@2), + TYPE_SIGN (type))) { build_zero_cst (type); }))) /* X % -C is the same as X % C. */ @@ -422,7 +426,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (trunc_mod @0 INTEGER_CST@1) (if (TYPE_SIGN (type) == SIGNED && !TREE_OVERFLOW (@1) - && wi::neg_p (@1) + && wi::neg_p (wi::to_wide (@1)) && !TYPE_OVERFLOW_TRAPS (type) /* Avoid this transformation if C is INT_MIN, i.e. C == -C. */ && !sign_bit_p (@1, @1)) @@ -438,7 +442,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) /* Avoid this transformation if X might be INT_MIN or Y might be -1, because we would then change valid INT_MIN % -(-1) into invalid INT_MIN % -1. */ - && (expr_not_equal_to (@0, TYPE_MIN_VALUE (type)) + && (expr_not_equal_to (@0, wi::to_wide (TYPE_MIN_VALUE (type))) || expr_not_equal_to (@1, wi::minus_one (TYPE_PRECISION (TREE_TYPE (@1)))))) (trunc_mod @0 (convert @1)))) @@ -471,7 +475,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (trunc_div (mult @0 integer_pow2p@1) @1) (if (TYPE_UNSIGNED (TREE_TYPE (@0))) (bit_and @0 { wide_int_to_tree - (type, wi::mask (TYPE_PRECISION (type) - wi::exact_log2 (@1), + (type, wi::mask (TYPE_PRECISION (type) + - wi::exact_log2 (wi::to_wide (@1)), false, TYPE_PRECISION (type))); }))) /* Simplify (unsigned t / 2) * 2 -> unsigned t & ~1. */ @@ -505,7 +510,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (for pows (POWI) (simplify (pows (op @0) INTEGER_CST@1) - (if (wi::bit_and (@1, 1) == 0) + (if ((wi::to_wide (@1) & 1) == 0) (pows @0 @1)))) /* Strip negate and abs from both operands of hypot. */ (for hypots (HYPOT) @@ -546,7 +551,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) copysigns (COPYSIGN) (simplify (pows (copysigns @0 @2) INTEGER_CST@1) - (if (wi::bit_and (@1, 1) == 0) + (if ((wi::to_wide (@1) & 1) == 0) (pows @0 @1)))) (for hypots (HYPOT) @@ -657,7 +662,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (minus (bit_xor @0 @1) @1)) (simplify (minus (bit_and:s @0 INTEGER_CST@2) (bit_and:s @0 INTEGER_CST@1)) - (if (wi::bit_not (@2) == @1) + (if (~wi::to_wide (@2) == wi::to_wide (@1)) (minus (bit_xor @0 @1) @1))) /* Fold (A & B) - (A & ~B) into B - (A ^ B). */ @@ -672,7 +677,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (bit_xor @0 @1)) (simplify (op:c (bit_and @0 INTEGER_CST@2) (bit_and (bit_not @0) INTEGER_CST@1)) - (if (wi::bit_not (@2) == @1) + (if (~wi::to_wide (@2) == wi::to_wide (@1)) (bit_xor @0 @1)))) /* PR53979: Transform ((a ^ b) | a) -> (a | b) */ @@ -685,7 +690,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (simplify (bit_and (bit_not SSA_NAME@0) INTEGER_CST@1) (if (INTEGRAL_TYPE_P (TREE_TYPE (@0)) - && (get_nonzero_bits (@0) & wi::bit_not (@1)) == 0) + && wi::bit_and_not (get_nonzero_bits (@0), wi::to_wide (@1)) == 0) (bit_xor @0 @1))) #endif @@ -750,7 +755,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (simplify (bit_and SSA_NAME@0 INTEGER_CST@1) (if (INTEGRAL_TYPE_P (TREE_TYPE (@0)) - && (get_nonzero_bits (@0) & wi::bit_not (@1)) == 0) + && wi::bit_and_not (get_nonzero_bits (@0), wi::to_wide (@1)) == 0) @0)) #endif @@ -851,7 +856,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (convert2? (bit_and@5 @2 INTEGER_CST@3))) (if (tree_nop_conversion_p (type, TREE_TYPE (@0)) && tree_nop_conversion_p (type, TREE_TYPE (@2)) - && wi::bit_and (@1, @3) == 0) + && (wi::to_wide (@1) & wi::to_wide (@3)) == 0) (bit_ior (convert @4) (convert @5))))) /* (X | Y) ^ X -> Y & ~ X*/ @@ -1150,7 +1155,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (if (tree_expr_nonnegative_p (@1) && tree_expr_nonzero_p (@1)) (cmp @0 @2) (if (TREE_CODE (@1) == INTEGER_CST - && wi::neg_p (@1, TYPE_SIGN (TREE_TYPE (@1)))) + && wi::neg_p (wi::to_wide (@1), TYPE_SIGN (TREE_TYPE (@1)))) (cmp @2 @0)))))) /* (X - 1U) <= INT_MAX-1U into (int) X > 0. */ @@ -1161,8 +1166,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (if (INTEGRAL_TYPE_P (TREE_TYPE (@0)) && TYPE_UNSIGNED (TREE_TYPE (@0)) && TYPE_PRECISION (TREE_TYPE (@0)) > 1 - && wi::eq_p (@2, wi::max_value (TYPE_PRECISION (TREE_TYPE (@0)), - SIGNED) - 1)) + && (wi::to_wide (@2) + == wi::max_value (TYPE_PRECISION (TREE_TYPE (@0)), SIGNED) - 1)) (with { tree stype = signed_type_for (TREE_TYPE (@0)); } (icmp (convert:stype @0) { build_int_cst (stype, 0); }))))) @@ -1170,7 +1175,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (for cmp (simple_comparison) (simplify (cmp (exact_div @0 INTEGER_CST@2) (exact_div @1 @2)) - (if (wi::gt_p(@2, 0, TYPE_SIGN (TREE_TYPE (@2)))) + (if (wi::gt_p (wi::to_wide (@2), 0, TYPE_SIGN (TREE_TYPE (@2)))) (cmp @0 @1)))) /* X / C1 op C2 into a simple range test. */ @@ -1275,6 +1280,44 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) || TYPE_OVERFLOW_WRAPS (TREE_TYPE (@0)))) (op @1 @0)))) +/* X + Y < Y is the same as X < 0 when there is no overflow. */ +(for op (lt le gt ge) + (simplify + (op:c (plus:c@2 @0 @1) @1) + (if (ANY_INTEGRAL_TYPE_P (TREE_TYPE (@0)) + && TYPE_OVERFLOW_UNDEFINED (TREE_TYPE (@0)) + && (CONSTANT_CLASS_P (@0) || single_use (@2))) + (op @0 { build_zero_cst (TREE_TYPE (@0)); })))) +/* For equality, this is also true with wrapping overflow. */ +(for op (eq ne) + (simplify + (op:c (nop_convert@3 (plus:c@2 @0 (convert1? @1))) (convert2? @1)) + (if (ANY_INTEGRAL_TYPE_P (TREE_TYPE (@0)) + && (TYPE_OVERFLOW_UNDEFINED (TREE_TYPE (@0)) + || TYPE_OVERFLOW_WRAPS (TREE_TYPE (@0))) + && (CONSTANT_CLASS_P (@0) || (single_use (@2) && single_use (@3))) + && tree_nop_conversion_p (TREE_TYPE (@3), TREE_TYPE (@2)) + && tree_nop_conversion_p (TREE_TYPE (@3), TREE_TYPE (@1))) + (op @0 { build_zero_cst (TREE_TYPE (@0)); }))) + (simplify + (op:c (nop_convert@3 (pointer_plus@2 (convert1? @0) @1)) (convert2? @0)) + (if (tree_nop_conversion_p (TREE_TYPE (@2), TREE_TYPE (@0)) + && tree_nop_conversion_p (TREE_TYPE (@3), TREE_TYPE (@0)) + && (CONSTANT_CLASS_P (@1) || (single_use (@2) && single_use (@3)))) + (op @1 { build_zero_cst (TREE_TYPE (@1)); })))) + +/* X - Y < X is the same as Y > 0 when there is no overflow. + For equality, this is also true with wrapping overflow. */ +(for op (simple_comparison) + (simplify + (op:c @0 (minus@2 @0 @1)) + (if (ANY_INTEGRAL_TYPE_P (TREE_TYPE (@0)) + && (TYPE_OVERFLOW_UNDEFINED (TREE_TYPE (@0)) + || ((op == EQ_EXPR || op == NE_EXPR) + && TYPE_OVERFLOW_WRAPS (TREE_TYPE (@0)))) + && (CONSTANT_CLASS_P (@1) || single_use (@2))) + (op @1 { build_zero_cst (TREE_TYPE (@1)); })))) + /* Transform: * (X / Y) == 0 -> X < Y if X, Y are unsigned. * (X / Y) != 0 -> X >= Y, if X, Y are unsigned. @@ -1318,7 +1361,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (for cmp (eq ne) (simplify (cmp:c (with_possible_nonzero_bits2 @0) (with_certain_nonzero_bits2 @1)) - (if ((~get_nonzero_bits (@0) & @1) != 0) + (if (wi::bit_and_not (wi::to_wide (@1), get_nonzero_bits (@0)) != 0) { constant_boolean_node (cmp == NE_EXPR, type); }))) /* ((X inner_op C0) outer_op C1) @@ -1350,18 +1393,18 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) if (inner_op == BIT_XOR_EXPR) { - C0 = wi::bit_and_not (@0, @1); - cst_emit = wi::bit_or (C0, @1); + C0 = wi::bit_and_not (wi::to_wide (@0), wi::to_wide (@1)); + cst_emit = C0 | wi::to_wide (@1); } else { - C0 = @0; - cst_emit = wi::bit_xor (@0, @1); + C0 = wi::to_wide (@0); + cst_emit = C0 ^ wi::to_wide (@1); } } - (if (!fail && wi::bit_and (C0, zero_mask_not) == 0) + (if (!fail && (C0 & zero_mask_not) == 0) (outer_op @2 { wide_int_to_tree (type, cst_emit); }) - (if (!fail && wi::bit_and (@1, zero_mask_not) == 0) + (if (!fail && (wi::to_wide (@1) & zero_mask_not) == 0) (inner_op @2 { wide_int_to_tree (type, cst_emit); })))))) /* Associate (p +p off1) +p off2 as (p +p (off1 + off2)). */ @@ -1394,7 +1437,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) ... = ptr & ~algn; */ (simplify (pointer_plus @0 (negate (bit_and (convert @0) INTEGER_CST@1))) - (with { tree algn = wide_int_to_tree (TREE_TYPE (@0), wi::bit_not (@1)); } + (with { tree algn = wide_int_to_tree (TREE_TYPE (@0), ~wi::to_wide (@1)); } (bit_and @0 { algn; }))) /* Try folding difference of addresses. */ @@ -1424,8 +1467,9 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) unsigned HOST_WIDE_INT bitpos; get_pointer_alignment_1 (@0, &align, &bitpos); } - (if (wi::ltu_p (@1, align / BITS_PER_UNIT)) - { wide_int_to_tree (type, wi::bit_and (@1, bitpos / BITS_PER_UNIT)); })))) + (if (wi::ltu_p (wi::to_wide (@1), align / BITS_PER_UNIT)) + { wide_int_to_tree (type, (wi::to_wide (@1) + & (bitpos / BITS_PER_UNIT))); })))) /* We can't reassociate at all for saturating types. */ @@ -1535,8 +1579,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (inner_op @0 { cst; } ) /* X+INT_MAX+1 is X-INT_MIN. */ (if (INTEGRAL_TYPE_P (type) && cst - && wi::eq_p (cst, wi::min_value (type))) - (neg_inner_op @0 { wide_int_to_tree (type, cst); }) + && wi::to_wide (cst) == wi::min_value (type)) + (neg_inner_op @0 { wide_int_to_tree (type, wi::to_wide (cst)); }) /* Last resort, use some unsigned type. */ (with { tree utype = unsigned_type_for (type); } (view_convert (inner_op @@ -1788,16 +1832,20 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (for cmp (eq ne) (simplify (cmp (min @0 INTEGER_CST@1) INTEGER_CST@2) - (if (wi::lt_p (@1, @2, TYPE_SIGN (TREE_TYPE (@0)))) + (if (wi::lt_p (wi::to_wide (@1), wi::to_wide (@2), + TYPE_SIGN (TREE_TYPE (@0)))) { constant_boolean_node (cmp == NE_EXPR, type); } - (if (wi::gt_p (@1, @2, TYPE_SIGN (TREE_TYPE (@0)))) + (if (wi::gt_p (wi::to_wide (@1), wi::to_wide (@2), + TYPE_SIGN (TREE_TYPE (@0)))) (cmp @0 @2))))) (for cmp (eq ne) (simplify (cmp (max @0 INTEGER_CST@1) INTEGER_CST@2) - (if (wi::gt_p (@1, @2, TYPE_SIGN (TREE_TYPE (@0)))) + (if (wi::gt_p (wi::to_wide (@1), wi::to_wide (@2), + TYPE_SIGN (TREE_TYPE (@0)))) { constant_boolean_node (cmp == NE_EXPR, type); } - (if (wi::lt_p (@1, @2, TYPE_SIGN (TREE_TYPE (@0)))) + (if (wi::lt_p (wi::to_wide (@1), wi::to_wide (@2), + TYPE_SIGN (TREE_TYPE (@0)))) (cmp @0 @2))))) /* MIN (X, C1) < C2 -> X < C2 || C1 < C2 */ (for minmax (min min max max min min max max ) @@ -1824,7 +1872,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) /* Optimize (x >> c) << c into x & (-1<> c into x & ((unsigned)-1 >> c) for unsigned @@ -1832,7 +1880,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (simplify (rshift (lshift @0 INTEGER_CST@1) @1) (if (TYPE_UNSIGNED (type) - && (wi::ltu_p (@1, element_precision (type)))) + && (wi::ltu_p (wi::to_wide (@1), element_precision (type)))) (bit_and @0 (rshift { build_minus_one_cst (type); } @1)))) (for shiftrotate (lrotate rrotate lshift rshift) @@ -1879,10 +1927,10 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (simplify (op (op @0 INTEGER_CST@1) INTEGER_CST@2) (with { unsigned int prec = element_precision (type); } - (if (wi::ge_p (@1, 0, TYPE_SIGN (TREE_TYPE (@1))) - && wi::lt_p (@1, prec, TYPE_SIGN (TREE_TYPE (@1))) - && wi::ge_p (@2, 0, TYPE_SIGN (TREE_TYPE (@2))) - && wi::lt_p (@2, prec, TYPE_SIGN (TREE_TYPE (@2)))) + (if (wi::ge_p (wi::to_wide (@1), 0, TYPE_SIGN (TREE_TYPE (@1))) + && wi::lt_p (wi::to_wide (@1), prec, TYPE_SIGN (TREE_TYPE (@1))) + && wi::ge_p (wi::to_wide (@2), 0, TYPE_SIGN (TREE_TYPE (@2))) + && wi::lt_p (wi::to_wide (@2), prec, TYPE_SIGN (TREE_TYPE (@2)))) (with { unsigned int low = (tree_to_uhwi (@1) + tree_to_uhwi (@2)); } /* Deal with a OP (c1 + c2) being undefined but (a OP c1) OP c2 @@ -1910,13 +1958,13 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (for cmp (ne eq) (simplify (cmp (lshift INTEGER_CST@0 @1) INTEGER_CST@2) - (with { int cand = wi::ctz (@2) - wi::ctz (@0); } + (with { int cand = wi::ctz (wi::to_wide (@2)) - wi::ctz (wi::to_wide (@0)); } (if (cand < 0 || (!integer_zerop (@2) - && wi::ne_p (wi::lshift (@0, cand), @2))) + && wi::lshift (wi::to_wide (@0), cand) != wi::to_wide (@2))) { constant_boolean_node (cmp == NE_EXPR, type); } (if (!integer_zerop (@2) - && wi::eq_p (wi::lshift (@0, cand), @2)) + && wi::lshift (wi::to_wide (@0), cand) == wi::to_wide (@2)) (cmp @1 { build_int_cst (TREE_TYPE (@1), cand); })))))) /* Fold (X << C1) & C2 into (X << C1) & (C2 | ((1 << C1) - 1)) @@ -2454,7 +2502,10 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) { bool overflow = false; enum tree_code code, cmp_code = cmp; - wide_int real_c1, c1 = @1, c2 = @2, c3 = @3; + wide_int real_c1; + wide_int c1 = wi::to_wide (@1); + wide_int c2 = wi::to_wide (@2); + wide_int c3 = wi::to_wide (@3); signop sgn = TYPE_SIGN (from_type); /* Handle special case A), given x of unsigned type: @@ -2592,13 +2643,13 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (simplify (cmp @0 INTEGER_CST@1) (if (tree_int_cst_sgn (@1) == -1) - (acmp @0 { wide_int_to_tree (TREE_TYPE (@1), wi::add (@1, 1)); })))) + (acmp @0 { wide_int_to_tree (TREE_TYPE (@1), wi::to_wide (@1) + 1); })))) (for cmp (ge lt) acmp (gt le) (simplify (cmp @0 INTEGER_CST@1) (if (tree_int_cst_sgn (@1) == 1) - (acmp @0 { wide_int_to_tree (TREE_TYPE (@1), wi::sub (@1, 1)); })))) + (acmp @0 { wide_int_to_tree (TREE_TYPE (@1), wi::to_wide (@1) - 1); })))) /* We can simplify a logical negation of a comparison to the @@ -2998,13 +3049,14 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (simplify (cmp (exact_div @0 @1) INTEGER_CST@2) (if (!integer_zerop (@1)) - (if (wi::eq_p (@2, 0)) + (if (wi::to_wide (@2) == 0) (cmp @0 @2) (if (TREE_CODE (@1) == INTEGER_CST) (with { bool ovf; - wide_int prod = wi::mul (@2, @1, TYPE_SIGN (TREE_TYPE (@1)), &ovf); + wide_int prod = wi::mul (wi::to_wide (@2), wi::to_wide (@1), + TYPE_SIGN (TREE_TYPE (@1)), &ovf); } (if (ovf) { constant_boolean_node (cmp == NE_EXPR, type); } @@ -3012,14 +3064,16 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (for cmp (lt le gt ge) (simplify (cmp (exact_div @0 INTEGER_CST@1) INTEGER_CST@2) - (if (wi::gt_p (@1, 0, TYPE_SIGN (TREE_TYPE (@1)))) + (if (wi::gt_p (wi::to_wide (@1), 0, TYPE_SIGN (TREE_TYPE (@1)))) (with { bool ovf; - wide_int prod = wi::mul (@2, @1, TYPE_SIGN (TREE_TYPE (@1)), &ovf); + wide_int prod = wi::mul (wi::to_wide (@2), wi::to_wide (@1), + TYPE_SIGN (TREE_TYPE (@1)), &ovf); } (if (ovf) - { constant_boolean_node (wi::lt_p (@2, 0, TYPE_SIGN (TREE_TYPE (@2))) + { constant_boolean_node (wi::lt_p (wi::to_wide (@2), 0, + TYPE_SIGN (TREE_TYPE (@2))) != (cmp == LT_EXPR || cmp == LE_EXPR), type); } (cmp @0 { wide_int_to_tree (TREE_TYPE (@0), prod); })))))) @@ -3109,7 +3163,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (op (abs @0) zerop@1) (op @0 @1))) -/* From fold_sign_changed_comparison and fold_widened_comparison. */ +/* From fold_sign_changed_comparison and fold_widened_comparison. + FIXME: the lack of symmetry is disturbing. */ (for cmp (simple_comparison) (simplify (cmp (convert@0 @00) (convert?@1 @10)) @@ -3122,11 +3177,11 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) && single_use (@0)) (if (TYPE_PRECISION (TREE_TYPE (@00)) == TYPE_PRECISION (TREE_TYPE (@0)) && (TREE_CODE (@10) == INTEGER_CST - || (@1 != @10 && types_match (TREE_TYPE (@10), TREE_TYPE (@00)))) + || @1 != @10) && (TYPE_UNSIGNED (TREE_TYPE (@00)) == TYPE_UNSIGNED (TREE_TYPE (@0)) || cmp == NE_EXPR || cmp == EQ_EXPR) - && (POINTER_TYPE_P (TREE_TYPE (@00)) == POINTER_TYPE_P (TREE_TYPE (@0)))) + && !POINTER_TYPE_P (TREE_TYPE (@00))) /* ??? The special-casing of INTEGER_CST conversion was in the original code and here to avoid a spurious overflow flag on the resulting constant which fold_convert produces. */ @@ -3191,7 +3246,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (simplify (cmp (convert?@3 (bit_ior @0 INTEGER_CST@1)) INTEGER_CST@2) (if (tree_nop_conversion_p (TREE_TYPE (@3), TREE_TYPE (@0)) - && wi::bit_and_not (@1, @2) != 0) + && wi::bit_and_not (wi::to_wide (@1), wi::to_wide (@2)) != 0) { constant_boolean_node (cmp == NE_EXPR, type); })) /* (X ^ Y) == 0 becomes X == Y, and (X ^ Y) != 0 becomes X != Y. */ @@ -3231,7 +3286,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (ne (bit_and @0 integer_pow2p@1) integer_zerop) integer_pow2p@2 integer_zerop) (with { - int shift = wi::exact_log2 (@2) - wi::exact_log2 (@1); + int shift = (wi::exact_log2 (wi::to_wide (@2)) + - wi::exact_log2 (wi::to_wide (@1))); } (if (shift > 0) (bit_and @@ -3248,7 +3304,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (if (INTEGRAL_TYPE_P (TREE_TYPE (@0)) && type_has_mode_precision_p (TREE_TYPE (@0)) && element_precision (@2) >= element_precision (@0) - && wi::only_sign_bit_p (@1, element_precision (@0))) + && wi::only_sign_bit_p (wi::to_wide (@1), element_precision (@0))) (with { tree stype = signed_type_for (TREE_TYPE (@0)); } (ncmp (convert:stype @0) { build_zero_cst (stype); }))))) @@ -3260,7 +3316,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) integer_pow2p@1 integer_zerop) (if (!TYPE_UNSIGNED (TREE_TYPE (@0))) (with { - int shift = element_precision (@0) - wi::exact_log2 (@1) - 1; + int shift = element_precision (@0) - wi::exact_log2 (wi::to_wide (@1)) - 1; } (if (shift >= 0) (bit_and @@ -3381,7 +3437,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) wide_int min = wi::min_value (arg1_type); } (switch - (if (wi::eq_p (@1, max)) + (if (wi::to_wide (@1) == max) (switch (if (cmp == GT_EXPR) { constant_boolean_node (false, type); }) @@ -3391,7 +3447,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) { constant_boolean_node (true, type); }) (if (cmp == LT_EXPR) (ne @2 @1)))) - (if (wi::eq_p (@1, min)) + (if (wi::to_wide (@1) == min) (switch (if (cmp == LT_EXPR) { constant_boolean_node (false, type); }) @@ -3401,19 +3457,19 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) { constant_boolean_node (true, type); }) (if (cmp == GT_EXPR) (ne @2 @1)))) - (if (wi::eq_p (@1, max - 1)) + (if (wi::to_wide (@1) == max - 1) (switch (if (cmp == GT_EXPR) - (eq @2 { wide_int_to_tree (TREE_TYPE (@1), wi::add (@1, 1)); })) + (eq @2 { wide_int_to_tree (TREE_TYPE (@1), wi::to_wide (@1) + 1); })) (if (cmp == LE_EXPR) - (ne @2 { wide_int_to_tree (TREE_TYPE (@1), wi::add (@1, 1)); })))) - (if (wi::eq_p (@1, min + 1)) + (ne @2 { wide_int_to_tree (TREE_TYPE (@1), wi::to_wide (@1) + 1); })))) + (if (wi::to_wide (@1) == min + 1) (switch (if (cmp == GE_EXPR) - (ne @2 { wide_int_to_tree (TREE_TYPE (@1), wi::sub (@1, 1)); })) + (ne @2 { wide_int_to_tree (TREE_TYPE (@1), wi::to_wide (@1) - 1); })) (if (cmp == LT_EXPR) - (eq @2 { wide_int_to_tree (TREE_TYPE (@1), wi::sub (@1, 1)); })))) - (if (wi::eq_p (@1, signed_max) + (eq @2 { wide_int_to_tree (TREE_TYPE (@1), wi::to_wide (@1) - 1); })))) + (if (wi::to_wide (@1) == signed_max && TYPE_UNSIGNED (arg1_type) /* We will flip the signedness of the comparison operator associated with the mode of @1, so the sign bit is @@ -3469,10 +3525,12 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (cmp:c (plus@2 @0 INTEGER_CST@1) @0) (if (TYPE_UNSIGNED (TREE_TYPE (@0)) && TYPE_OVERFLOW_WRAPS (TREE_TYPE (@0)) - && wi::ne_p (@1, 0) + && wi::to_wide (@1) != 0 && single_use (@2)) - (out @0 { wide_int_to_tree (TREE_TYPE (@0), wi::max_value - (TYPE_PRECISION (TREE_TYPE (@0)), UNSIGNED) - @1); })))) + (with { unsigned int prec = TYPE_PRECISION (TREE_TYPE (@0)); } + (out @0 { wide_int_to_tree (TREE_TYPE (@0), + wi::max_value (prec, UNSIGNED) + - wi::to_wide (@1)); }))))) /* To detect overflow in unsigned A - B, A < B is simpler than A - B > A. However, the detection logic for SUB_OVERFLOW in tree-ssa-math-opts.c @@ -4034,13 +4092,13 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (POWI @0 INTEGER_CST@1) (switch /* powi(x,0) -> 1. */ - (if (wi::eq_p (@1, 0)) + (if (wi::to_wide (@1) == 0) { build_real (type, dconst1); }) /* powi(x,1) -> x. */ - (if (wi::eq_p (@1, 1)) + (if (wi::to_wide (@1) == 1) @0) /* powi(x,-1) -> 1/x. */ - (if (wi::eq_p (@1, -1)) + (if (wi::to_wide (@1) == -1) (rdiv { build_real (type, dconst1); } @0)))) /* Narrowing of arithmetic and logical operations. @@ -4105,8 +4163,9 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) && types_match (@0, @1) && (tree_int_cst_min_precision (@4, TYPE_SIGN (TREE_TYPE (@0))) <= TYPE_PRECISION (TREE_TYPE (@0))) - && (wi::bit_and (@4, wi::mask (TYPE_PRECISION (TREE_TYPE (@0)), - true, TYPE_PRECISION (type))) == 0)) + && (wi::to_wide (@4) + & wi::mask (TYPE_PRECISION (TREE_TYPE (@0)), + true, TYPE_PRECISION (type))) == 0) (if (TYPE_OVERFLOW_WRAPS (TREE_TYPE (@0))) (with { tree ntype = TREE_TYPE (@0); } (convert (bit_and (op @0 @1) (convert:ntype @4)))) @@ -4166,7 +4225,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) WARN_STRICT_OVERFLOW_CONDITIONAL); bool less = cmp == LE_EXPR || cmp == LT_EXPR; /* wi::ges_p (@2, 0) should be sufficient for a signed type. */ - bool ovf_high = wi::lt_p (@1, 0, TYPE_SIGN (TREE_TYPE (@1))) + bool ovf_high = wi::lt_p (wi::to_wide (@1), 0, + TYPE_SIGN (TREE_TYPE (@1))) != (op == MINUS_EXPR); constant_boolean_node (less == ovf_high, type); } @@ -4292,10 +4352,14 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) isize = tree_to_uhwi (TYPE_SIZE (TREE_TYPE (@1))); } (switch - (if (wi::leu_p (@ipos, @rpos) - && wi::leu_p (wi::add (@rpos, @rsize), wi::add (@ipos, isize))) + (if (wi::leu_p (wi::to_wide (@ipos), wi::to_wide (@rpos)) + && wi::leu_p (wi::to_wide (@rpos) + wi::to_wide (@rsize), + wi::to_wide (@ipos) + isize)) (BIT_FIELD_REF @1 @rsize { wide_int_to_tree (bitsizetype, - wi::sub (@rpos, @ipos)); })) - (if (wi::geu_p (@ipos, wi::add (@rpos, @rsize)) - || wi::geu_p (@rpos, wi::add (@ipos, isize))) + wi::to_wide (@rpos) + - wi::to_wide (@ipos)); })) + (if (wi::geu_p (wi::to_wide (@ipos), + wi::to_wide (@rpos) + wi::to_wide (@rsize)) + || wi::geu_p (wi::to_wide (@rpos), + wi::to_wide (@ipos) + isize)) (BIT_FIELD_REF @0 @rsize @rpos))))) diff --git a/gcc/modulo-sched.c b/gcc/modulo-sched.c index f85011e90c216..71b2a6160964f 100644 --- a/gcc/modulo-sched.c +++ b/gcc/modulo-sched.c @@ -1422,15 +1422,15 @@ sms_schedule (void) get_ebb_head_tail (bb, bb, &head, &tail); latch_edge = loop_latch_edge (loop); gcc_assert (single_exit (loop)); - if (single_exit (loop)->count > profile_count::zero ()) - trip_count = latch_edge->count.to_gcov_type () - / single_exit (loop)->count.to_gcov_type (); + if (single_exit (loop)->count () > profile_count::zero ()) + trip_count = latch_edge->count ().to_gcov_type () + / single_exit (loop)->count ().to_gcov_type (); /* Perform SMS only on loops that their average count is above threshold. */ - if ( latch_edge->count > profile_count::zero () - && (latch_edge->count - < single_exit (loop)->count.apply_scale + if ( latch_edge->count () > profile_count::zero () + && (latch_edge->count() + < single_exit (loop)->count ().apply_scale (SMS_LOOP_AVERAGE_COUNT_THRESHOLD, 1))) { if (dump_file) @@ -1552,9 +1552,9 @@ sms_schedule (void) latch_edge = loop_latch_edge (loop); gcc_assert (single_exit (loop)); - if (single_exit (loop)->count > profile_count::zero ()) - trip_count = latch_edge->count.to_gcov_type () - / single_exit (loop)->count.to_gcov_type (); + if (single_exit (loop)->count ()> profile_count::zero ()) + trip_count = latch_edge->count ().to_gcov_type () + / single_exit (loop)->count ().to_gcov_type (); if (dump_file) { diff --git a/gcc/objc/ChangeLog b/gcc/objc/ChangeLog index ddfdb1c8c9011..a387814e9adc5 100644 --- a/gcc/objc/ChangeLog +++ b/gcc/objc/ChangeLog @@ -1,3 +1,12 @@ +2017-10-17 Nathan Sidwell + + * objc-act.c (objc_common_tree_size): Return size of TYPE nodes. + +2017-10-10 Richard Sandiford + + * objc-act.c (objc_decl_method_attributes): Use wi::to_wide when + operating on trees as wide_ints. + 2017-09-29 Jakub Jelinek * objc-act.c (check_ivars, gen_declaration): For OBJCPLUS look at diff --git a/gcc/objc/objc-act.c b/gcc/objc/objc-act.c index 5d81af7fbd6b8..765192c82aaa5 100644 --- a/gcc/objc/objc-act.c +++ b/gcc/objc/objc-act.c @@ -4900,10 +4900,10 @@ objc_decl_method_attributes (tree *node, tree attributes, int flags) number = TREE_VALUE (second_argument); if (number && TREE_CODE (number) == INTEGER_CST - && !wi::eq_p (number, 0)) + && wi::to_wide (number) != 0) TREE_VALUE (second_argument) = wide_int_to_tree (TREE_TYPE (number), - wi::add (number, 2)); + wi::to_wide (number) + 2); /* This is the third argument, the "first-to-check", which specifies the index of the first argument to @@ -4913,10 +4913,10 @@ objc_decl_method_attributes (tree *node, tree attributes, int flags) number = TREE_VALUE (third_argument); if (number && TREE_CODE (number) == INTEGER_CST - && !wi::eq_p (number, 0)) + && wi::to_wide (number) != 0) TREE_VALUE (third_argument) = wide_int_to_tree (TREE_TYPE (number), - wi::add (number, 2)); + wi::to_wide (number) + 2); } filtered_attributes = chainon (filtered_attributes, new_attribute); @@ -4949,10 +4949,10 @@ objc_decl_method_attributes (tree *node, tree attributes, int flags) /* Get the value of the argument and add 2. */ tree number = TREE_VALUE (argument); if (number && TREE_CODE (number) == INTEGER_CST - && !wi::eq_p (number, 0)) + && wi::to_wide (number) != 0) TREE_VALUE (argument) = wide_int_to_tree (TREE_TYPE (number), - wi::add (number, 2)); + wi::to_wide (number) + 2); argument = TREE_CHAIN (argument); } @@ -10118,11 +10118,14 @@ objc_common_tree_size (enum tree_code code) case CLASS_METHOD_DECL: case INSTANCE_METHOD_DECL: case KEYWORD_DECL: - case PROPERTY_DECL: - return sizeof (struct tree_decl_non_common); + case PROPERTY_DECL: return sizeof (tree_decl_non_common); + case CLASS_INTERFACE_TYPE: + case CLASS_IMPLEMENTATION_TYPE: + case CATEGORY_INTERFACE_TYPE: + case CATEGORY_IMPLEMENTATION_TYPE: + case PROTOCOL_INTERFACE_TYPE: return sizeof (tree_type_non_common); default: gcc_unreachable (); - } } diff --git a/gcc/omp-low.c b/gcc/omp-low.c index 3645661038afe..afa758bf49948 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -3081,7 +3081,7 @@ scan_omp_1_op (tree *tp, int *walk_subtrees, void *data) if (tem != TREE_TYPE (t)) { if (TREE_CODE (t) == INTEGER_CST) - *tp = wide_int_to_tree (tem, t); + *tp = wide_int_to_tree (tem, wi::to_wide (t)); else TREE_TYPE (t) = tem; } @@ -6372,14 +6372,14 @@ lower_omp_ordered_clauses (gimple_stmt_iterator *gsi_p, gomp_ordered *ord_stmt, tree itype = TREE_TYPE (TREE_VALUE (vec)); if (POINTER_TYPE_P (itype)) itype = sizetype; - wide_int offset = wide_int::from (TREE_PURPOSE (vec), + wide_int offset = wide_int::from (wi::to_wide (TREE_PURPOSE (vec)), TYPE_PRECISION (itype), TYPE_SIGN (itype)); /* Ignore invalid offsets that are not multiples of the step. */ - if (!wi::multiple_of_p - (wi::abs (offset), wi::abs ((wide_int) fd.loops[i].step), - UNSIGNED)) + if (!wi::multiple_of_p (wi::abs (offset), + wi::abs (wi::to_wide (fd.loops[i].step)), + UNSIGNED)) { warning_at (OMP_CLAUSE_LOCATION (c), 0, "ignoring sink clause with offset that is not " diff --git a/gcc/optabs.c b/gcc/optabs.c index 67dfa58ff462b..94092fc1594d7 100644 --- a/gcc/optabs.c +++ b/gcc/optabs.c @@ -138,8 +138,8 @@ add_equal_note (rtx_insn *insns, rtx target, enum rtx_code code, rtx op0, rtx op if (GET_MODE (op0) != VOIDmode && GET_MODE (target) != GET_MODE (op0)) { note = gen_rtx_fmt_e (code, GET_MODE (op0), copy_rtx (op0)); - if (GET_MODE_SIZE (GET_MODE (op0)) - > GET_MODE_SIZE (GET_MODE (target))) + if (GET_MODE_UNIT_SIZE (GET_MODE (op0)) + > GET_MODE_UNIT_SIZE (GET_MODE (target))) note = simplify_gen_unary (TRUNCATE, GET_MODE (target), note, GET_MODE (op0)); else @@ -173,12 +173,12 @@ widened_mode (machine_mode to_mode, rtx op0, rtx op1) if (m0 == VOIDmode && m1 == VOIDmode) return to_mode; - else if (m0 == VOIDmode || GET_MODE_SIZE (m0) < GET_MODE_SIZE (m1)) + else if (m0 == VOIDmode || GET_MODE_UNIT_SIZE (m0) < GET_MODE_UNIT_SIZE (m1)) result = m1; else result = m0; - if (GET_MODE_SIZE (result) > GET_MODE_SIZE (to_mode)) + if (GET_MODE_UNIT_SIZE (result) > GET_MODE_UNIT_SIZE (to_mode)) return to_mode; return result; @@ -2977,9 +2977,9 @@ expand_unop (machine_mode mode, optab unoptab, rtx op0, rtx target, else { eq_value = gen_rtx_fmt_e (optab_to_code (unoptab), mode, op0); - if (GET_MODE_SIZE (outmode) < GET_MODE_SIZE (mode)) + if (GET_MODE_UNIT_SIZE (outmode) < GET_MODE_UNIT_SIZE (mode)) eq_value = simplify_gen_unary (TRUNCATE, outmode, eq_value, mode); - else if (GET_MODE_SIZE (outmode) > GET_MODE_SIZE (mode)) + else if (GET_MODE_UNIT_SIZE (outmode) > GET_MODE_UNIT_SIZE (mode)) eq_value = simplify_gen_unary (ZERO_EXTEND, outmode, eq_value, mode); } @@ -6273,10 +6273,10 @@ expand_atomic_compare_and_swap (rtx *ptarget_bool, rtx *ptarget_oval, return true; } -/* Generate asm volatile("" : : : "memory") as the memory barrier. */ +/* Generate asm volatile("" : : : "memory") as the memory blockage. */ static void -expand_asm_memory_barrier (void) +expand_asm_memory_blockage (void) { rtx asm_op, clob; @@ -6292,6 +6292,17 @@ expand_asm_memory_barrier (void) emit_insn (gen_rtx_PARALLEL (VOIDmode, gen_rtvec (2, asm_op, clob))); } +/* Do not propagate memory accesses across this point. */ + +static void +expand_memory_blockage (void) +{ + if (targetm.have_memory_blockage ()) + emit_insn (targetm.gen_memory_blockage ()); + else + expand_asm_memory_blockage (); +} + /* This routine will either emit the mem_thread_fence pattern or issue a sync_synchronize to generate a fence for memory model MEMMODEL. */ @@ -6303,14 +6314,14 @@ expand_mem_thread_fence (enum memmodel model) if (targetm.have_mem_thread_fence ()) { emit_insn (targetm.gen_mem_thread_fence (GEN_INT (model))); - expand_asm_memory_barrier (); + expand_memory_blockage (); } else if (targetm.have_memory_barrier ()) emit_insn (targetm.gen_memory_barrier ()); else if (synchronize_libfunc != NULL_RTX) emit_library_call (synchronize_libfunc, LCT_NORMAL, VOIDmode); else - expand_asm_memory_barrier (); + expand_memory_blockage (); } /* Emit a signal fence with given memory model. */ @@ -6321,7 +6332,7 @@ expand_mem_signal_fence (enum memmodel model) /* No machine barrier is required to implement a signal fence, but a compiler memory barrier must be issued, except for relaxed MM. */ if (!is_mm_relaxed (model)) - expand_asm_memory_barrier (); + expand_memory_blockage (); } /* This function expands the atomic load operation: @@ -6343,7 +6354,7 @@ expand_atomic_load (rtx target, rtx mem, enum memmodel model) struct expand_operand ops[3]; rtx_insn *last = get_last_insn (); if (is_mm_seq_cst (model)) - expand_asm_memory_barrier (); + expand_memory_blockage (); create_output_operand (&ops[0], target, mode); create_fixed_operand (&ops[1], mem); @@ -6351,7 +6362,7 @@ expand_atomic_load (rtx target, rtx mem, enum memmodel model) if (maybe_expand_insn (icode, 3, ops)) { if (!is_mm_relaxed (model)) - expand_asm_memory_barrier (); + expand_memory_blockage (); return ops[0].value; } delete_insns_since (last); @@ -6401,14 +6412,14 @@ expand_atomic_store (rtx mem, rtx val, enum memmodel model, bool use_release) { rtx_insn *last = get_last_insn (); if (!is_mm_relaxed (model)) - expand_asm_memory_barrier (); + expand_memory_blockage (); create_fixed_operand (&ops[0], mem); create_input_operand (&ops[1], val, mode); create_integer_operand (&ops[2], model); if (maybe_expand_insn (icode, 3, ops)) { if (is_mm_seq_cst (model)) - expand_asm_memory_barrier (); + expand_memory_blockage (); return const0_rtx; } delete_insns_since (last); diff --git a/gcc/opts.c b/gcc/opts.c index 5aa5d066dbe29..ee95c84cdef93 100644 --- a/gcc/opts.c +++ b/gcc/opts.c @@ -1521,6 +1521,7 @@ const struct sanitizer_opts_s sanitizer_opts[] = SANITIZER_OPT (object-size, SANITIZE_OBJECT_SIZE, true), SANITIZER_OPT (vptr, SANITIZE_VPTR, true), SANITIZER_OPT (pointer-overflow, SANITIZE_POINTER_OVERFLOW, true), + SANITIZER_OPT (builtin, SANITIZE_BUILTIN, true), SANITIZER_OPT (all, ~0U, true), #undef SANITIZER_OPT { NULL, 0U, 0UL, false } @@ -1700,11 +1701,10 @@ parse_sanitizer_options (const char *p, location_t loc, int scode, } /* Parse string values of no_sanitize attribute passed in VALUE. - Values are separated with comma. Wrong argument is stored to - WRONG_ARGUMENT variable. */ + Values are separated with comma. */ unsigned int -parse_no_sanitize_attribute (char *value, char **wrong_argument) +parse_no_sanitize_attribute (char *value) { unsigned int flags = 0; unsigned int i; @@ -1722,7 +1722,8 @@ parse_no_sanitize_attribute (char *value, char **wrong_argument) } if (sanitizer_opts[i].name == NULL) - *wrong_argument = q; + warning (OPT_Wattributes, + "%<%s%> attribute directive ignored", q); q = strtok (NULL, ","); } diff --git a/gcc/opts.h b/gcc/opts.h index 2774e2c8b40bd..1093861572583 100644 --- a/gcc/opts.h +++ b/gcc/opts.h @@ -390,7 +390,7 @@ extern void handle_common_deferred_options (void); unsigned int parse_sanitizer_options (const char *, location_t, int, unsigned int, int, bool); -unsigned int parse_no_sanitize_attribute (char *value, char **wrong_argument); +unsigned int parse_no_sanitize_attribute (char *value); extern bool common_handle_option (struct gcc_options *opts, struct gcc_options *opts_set, const struct cl_decoded_option *decoded, diff --git a/gcc/params.def b/gcc/params.def index e55afc2805303..8881f4c403a07 100644 --- a/gcc/params.def +++ b/gcc/params.def @@ -882,13 +882,6 @@ DEFPARAM (PARAM_GRAPHITE_MAX_ARRAYS_PER_SCOP, "maximum number of arrays per scop.", 100, 0, 0) -/* Maximal number of basic blocks in the functions analyzed by Graphite. */ - -DEFPARAM (PARAM_GRAPHITE_MIN_LOOPS_PER_FUNCTION, - "graphite-min-loops-per-function", - "minimal number of loops per function to be analyzed by Graphite.", - 2, 0, 0) - DEFPARAM (PARAM_MAX_ISL_OPERATIONS, "max-isl-operations", "maximum number of isl operations, 0 means unlimited", diff --git a/gcc/passes.c b/gcc/passes.c index 2c9add84c1d88..65568e052fcd7 100644 --- a/gcc/passes.c +++ b/gcc/passes.c @@ -197,7 +197,9 @@ rest_of_decl_compilation (tree decl, /* Can't defer this, because it needs to happen before any later function definitions are processed. */ - if (DECL_ASSEMBLER_NAME_SET_P (decl) && DECL_REGISTER (decl)) + if (HAS_DECL_ASSEMBLER_NAME_P (decl) + && DECL_ASSEMBLER_NAME_SET_P (decl) + && DECL_REGISTER (decl)) make_decl_rtl (decl); /* Forward declarations for nested functions are not "external", diff --git a/gcc/postreload-gcse.c b/gcc/postreload-gcse.c index a1dcac2600c7a..15fdb7e0cfe77 100644 --- a/gcc/postreload-gcse.c +++ b/gcc/postreload-gcse.c @@ -1108,14 +1108,14 @@ eliminate_partially_redundant_load (basic_block bb, rtx_insn *insn, avail_insn = NULL; } - if (EDGE_CRITICAL_P (pred) && pred->count.initialized_p ()) - critical_count += pred->count; + if (EDGE_CRITICAL_P (pred) && pred->count ().initialized_p ()) + critical_count += pred->count (); if (avail_insn != NULL_RTX) { npred_ok++; - if (pred->count.initialized_p ()) - ok_count = ok_count + pred->count; + if (pred->count ().initialized_p ()) + ok_count = ok_count + pred->count (); if (! set_noop_p (PATTERN (gen_move_insn (copy_rtx (dest), copy_rtx (avail_reg))))) { @@ -1139,8 +1139,8 @@ eliminate_partially_redundant_load (basic_block bb, rtx_insn *insn, /* Adding a load on a critical edge will cause a split. */ if (EDGE_CRITICAL_P (pred)) critical_edge_split = true; - if (pred->count.initialized_p ()) - not_ok_count = not_ok_count + pred->count; + if (pred->count ().initialized_p ()) + not_ok_count = not_ok_count + pred->count (); unoccr = (struct unoccr *) obstack_alloc (&unoccr_obstack, sizeof (struct unoccr)); unoccr->insn = NULL; diff --git a/gcc/predict.c b/gcc/predict.c index 80c2c1966d84c..0a85d0b00b43d 100644 --- a/gcc/predict.c +++ b/gcc/predict.c @@ -203,7 +203,7 @@ maybe_hot_bb_p (struct function *fun, const_basic_block bb) bool maybe_hot_edge_p (edge e) { - if (!maybe_hot_count_p (cfun, e->count)) + if (!maybe_hot_count_p (cfun, e->count ())) return false; return maybe_hot_frequency_p (cfun, EDGE_FREQUENCY (e)); } @@ -247,7 +247,7 @@ probably_never_executed_bb_p (struct function *fun, const_basic_block bb) static bool unlikely_executed_edge_p (edge e) { - return (e->count == profile_count::zero () + return (e->count () == profile_count::zero () || e->probability == profile_probability::never ()) || (e->flags & (EDGE_EH | EDGE_FAKE)); } @@ -259,7 +259,7 @@ probably_never_executed_edge_p (struct function *fun, edge e) { if (unlikely_executed_edge_p (e)) return true; - return probably_never_executed (fun, e->count, EDGE_FREQUENCY (e)); + return probably_never_executed (fun, e->count (), EDGE_FREQUENCY (e)); } /* Return true when current function should always be optimized for size. */ @@ -746,8 +746,8 @@ dump_prediction (FILE *file, enum br_predictor predictor, int probability, if (e) { fprintf (file, " hit "); - e->count.dump (file); - fprintf (file, " (%.1f%%)", e->count.to_gcov_type() * 100.0 + e->count ().dump (file); + fprintf (file, " (%.1f%%)", e->count ().to_gcov_type() * 100.0 / bb->count.to_gcov_type ()); } } @@ -3199,21 +3199,14 @@ drop_profile (struct cgraph_node *node, profile_count call_count) FOR_ALL_BB_FN (bb, fn) { bb->count = profile_count::uninitialized (); - - edge_iterator ei; - edge e; - FOR_EACH_EDGE (e, ei, bb->preds) - e->count = profile_count::uninitialized (); } struct cgraph_edge *e; for (e = node->callees; e; e = e->next_caller) { - e->count = profile_count::uninitialized (); e->frequency = compute_call_stmt_bb_frequency (e->caller->decl, gimple_bb (e->call_stmt)); } - node->count = profile_count::uninitialized (); profile_status_for_fn (fn) = (flag_guess_branch_prob ? PROFILE_GUESSED : PROFILE_ABSENT); @@ -3396,7 +3389,7 @@ propagate_unlikely_bbs_forward (void) { bb = worklist.pop (); FOR_EACH_EDGE (e, ei, bb->succs) - if (!(e->count == profile_count::zero ()) + if (!(e->count () == profile_count::zero ()) && !(e->dest->count == profile_count::zero ()) && !e->dest->aux) { @@ -3417,8 +3410,6 @@ propagate_unlikely_bbs_forward (void) bb->index); bb->count = profile_count::zero (); bb->frequency = 0; - FOR_EACH_EDGE (e, ei, bb->succs) - e->count = profile_count::zero (); } else bb->aux = NULL; @@ -3450,20 +3441,16 @@ determine_unlikely_bbs () } if (bb->count == profile_count::zero ()) - { - bb->frequency = 0; - FOR_EACH_EDGE (e, ei, bb->preds) - e->count = profile_count::zero (); - } + bb->frequency = 0; FOR_EACH_EDGE (e, ei, bb->succs) - if (!(e->count == profile_count::zero ()) + if (!(e->probability == profile_probability::never ()) && unlikely_executed_edge_p (e)) { if (dump_file && (dump_flags & TDF_DETAILS)) fprintf (dump_file, "Edge %i->%i is locally unlikely\n", bb->index, e->dest->index); - e->count = profile_count::zero (); + e->probability = profile_probability::never (); } gcc_checking_assert (!bb->aux); @@ -3477,7 +3464,8 @@ determine_unlikely_bbs () { nsuccs[bb->index] = 0; FOR_EACH_EDGE (e, ei, bb->succs) - if (!(e->count == profile_count::zero ())) + if (!(e->probability == profile_probability::never ()) + && !(e->dest->count == profile_count::zero ())) nsuccs[bb->index]++; if (!nsuccs[bb->index]) worklist.safe_push (bb); @@ -3511,9 +3499,9 @@ determine_unlikely_bbs () bb->count = profile_count::zero (); bb->frequency = 0; FOR_EACH_EDGE (e, ei, bb->preds) - if (!(e->count == profile_count::zero ())) + if (!(e->probability == profile_probability::never ())) { - e->count = profile_count::zero (); + e->probability = profile_probability::never (); if (!(e->src->count == profile_count::zero ())) { nsuccs[e->src->index]--; @@ -3613,7 +3601,10 @@ compute_function_frequency (void) if (ENTRY_BLOCK_PTR_FOR_FN (cfun)->count == profile_count::zero () || lookup_attribute ("cold", DECL_ATTRIBUTES (current_function_decl)) != NULL) - node->frequency = NODE_FREQUENCY_UNLIKELY_EXECUTED; + { + node->frequency = NODE_FREQUENCY_UNLIKELY_EXECUTED; + warn_function_cold (current_function_decl); + } else if (lookup_attribute ("hot", DECL_ATTRIBUTES (current_function_decl)) != NULL) node->frequency = NODE_FREQUENCY_HOT; @@ -3632,7 +3623,10 @@ compute_function_frequency (void) Ipa-profile pass will drop functions only called from unlikely functions to unlikely and that is most of what we care about. */ if (!cfun->after_inlining) - node->frequency = NODE_FREQUENCY_UNLIKELY_EXECUTED; + { + node->frequency = NODE_FREQUENCY_UNLIKELY_EXECUTED; + warn_function_cold (current_function_decl); + } FOR_EACH_BB_FN (bb, cfun) { if (maybe_hot_bb_p (cfun, bb)) @@ -3922,8 +3916,6 @@ force_edge_cold (edge e, bool impossible) profile_probability prob_sum = profile_probability::never (); edge_iterator ei; edge e2; - profile_count old_count = e->count; - profile_probability old_probability = e->probability; bool uninitialized_exit = false; profile_probability goal = (impossible ? profile_probability::never () @@ -3931,13 +3923,13 @@ force_edge_cold (edge e, bool impossible) /* If edge is already improbably or cold, just return. */ if (e->probability <= goal - && (!impossible || e->count == profile_count::zero ())) + && (!impossible || e->count () == profile_count::zero ())) return; FOR_EACH_EDGE (e2, ei, e->src->succs) if (e2 != e) { - if (e2->count.initialized_p ()) - count_sum += e2->count; + if (e2->count ().initialized_p ()) + count_sum += e2->count (); else uninitialized_exit = true; if (e2->probability.initialized_p ()) @@ -3950,13 +3942,6 @@ force_edge_cold (edge e, bool impossible) { if (!(e->probability < goal)) e->probability = goal; - if (impossible) - e->count = profile_count::zero (); - else if (old_probability > profile_probability::never ()) - e->count = e->count.apply_probability (e->probability - / old_probability); - else - e->count = e->count.apply_scale (1, REG_BR_PROB_BASE); profile_probability prob_comp = prob_sum / e->probability.invert (); @@ -3965,12 +3950,9 @@ force_edge_cold (edge e, bool impossible) "probability to other edges.\n", e->src->index, e->dest->index, impossible ? "impossible" : "cold"); - profile_count count_sum2 = count_sum + old_count - e->count; FOR_EACH_EDGE (e2, ei, e->src->succs) if (e2 != e) { - if (count_sum > 0) - e2->count.apply_scale (count_sum2, count_sum); e2->probability /= prob_comp; } if (current_ir_type () != IR_GIMPLE @@ -4021,7 +4003,6 @@ force_edge_cold (edge e, bool impossible) fprintf (dump_file, "Making bb %i impossible and dropping count to 0.\n", e->src->index); - e->count = profile_count::zero (); e->src->count = profile_count::zero (); FOR_EACH_EDGE (e2, ei, e->src->preds) force_edge_cold (e2, impossible); @@ -4044,10 +4025,10 @@ force_edge_cold (edge e, bool impossible) impossible ? "impossible" : "cold"); e->src->frequency = MIN (e->src->frequency, impossible ? 0 : 1); if (impossible) - e->src->count = e->count = profile_count::zero (); + e->src->count = profile_count::zero (); else - e->src->count = e->count = e->count.apply_scale (e->src->frequency, - old_frequency); + e->src->count = e->count ().apply_scale (e->src->frequency, + old_frequency); force_edge_cold (single_pred_edge (e->src), impossible); } else if (dump_file && (dump_flags & TDF_DETAILS) diff --git a/gcc/predict.h b/gcc/predict.h index 9b8b14022e389..1b73ae28a4920 100644 --- a/gcc/predict.h +++ b/gcc/predict.h @@ -102,4 +102,7 @@ extern void propagate_unlikely_bbs_forward (void); extern void add_reg_br_prob_note (rtx_insn *, profile_probability); +/* In ipa-pure-const.c */ +extern void warn_function_cold (tree); + #endif /* GCC_PREDICT_H */ diff --git a/gcc/pretty-print.c b/gcc/pretty-print.c index 7340cd4a565fa..e66d898a645ee 100644 --- a/gcc/pretty-print.c +++ b/gcc/pretty-print.c @@ -30,6 +30,666 @@ along with GCC; see the file COPYING3. If not see #include #endif +#ifdef __MINGW32__ + +/* Replacement for fputs() that handles ANSI escape codes on Windows NT. + Contributed by: Liu Hao (lh_mouse at 126 dot com) + + XXX: This file is compiled into libcommon.a that will be self-contained. + It looks like that these functions can be put nowhere else. */ + +#include +#define WIN32_LEAN_AND_MEAN 1 +#include + +/* Write all bytes in [s,s+n) into the specified stream. + Errors are ignored. */ +static void +write_all (HANDLE h, const char *s, size_t n) +{ + size_t rem = n; + DWORD step; + + while (rem != 0) + { + if (rem <= UINT_MAX) + step = rem; + else + step = UINT_MAX; + if (!WriteFile (h, s + n - rem, step, &step, NULL)) + break; + rem -= step; + } +} + +/* Find the beginning of an escape sequence. + There are two cases: + 1. If the sequence begins with an ESC character (0x1B) and a second + character X in [0x40,0x5F], returns X and stores a pointer to + the third character into *head. + 2. If the sequence begins with a character X in [0x80,0x9F], returns + (X-0x40) and stores a pointer to the second character into *head. + Stores the number of ESC character(s) in *prefix_len. + Returns 0 if no such sequence can be found. */ +static int +find_esc_head (int *prefix_len, const char **head, const char *str) +{ + int c; + const char *r = str; + int escaped = 0; + + for (;;) + { + c = (unsigned char) *r; + if (c == 0) + { + /* Not found. */ + return 0; + } + if (escaped && 0x40 <= c && c <= 0x5F) + { + /* Found (case 1). */ + *prefix_len = 2; + *head = r + 1; + return c; + } + if (0x80 <= c && c <= 0x9F) + { + /* Found (case 2). */ + *prefix_len = 1; + *head = r + 1; + return c - 0x40; + } + ++r; + escaped = c == 0x1B; + } +} + +/* Find the terminator of an escape sequence. + str should be the value stored in *head by a previous successful + call to find_esc_head(). + Returns 0 if no such sequence can be found. */ +static int +find_esc_terminator (const char **term, const char *str) +{ + int c; + const char *r = str; + + for (;;) + { + c = (unsigned char) *r; + if (c == 0) + { + /* Not found. */ + return 0; + } + if (0x40 <= c && c <= 0x7E) + { + /* Found. */ + *term = r; + return c; + } + ++r; + } +} + +/* Handle a sequence of codes. Sequences that are invalid, reserved, + unrecognized or unimplemented are ignored silently. + There isn't much we can do because of lameness of Windows consoles. */ +static void +eat_esc_sequence (HANDLE h, int esc_code, + const char *esc_head, const char *esc_term) +{ + /* Numbers in an escape sequence cannot be negative, because + a minus sign in the middle of it would have terminated it. */ + long n1, n2; + char *eptr, *delim; + CONSOLE_SCREEN_BUFFER_INFO sb; + COORD cr; + /* ED and EL parameters. */ + DWORD cnt, step; + long rows; + /* SGR parameters. */ + WORD attrib_add, attrib_rm; + const char *param; + + switch (MAKEWORD (esc_code, *esc_term)) + { + /* ESC [ n1 'A' + Move the cursor up by n1 characters. */ + case MAKEWORD ('[', 'A'): + if (esc_head == esc_term) + n1 = 1; + else + { + n1 = strtol (esc_head, &eptr, 10); + if (eptr != esc_term) + break; + } + + if (GetConsoleScreenBufferInfo (h, &sb)) + { + cr = sb.dwCursorPosition; + /* Stop at the topmost boundary. */ + if (cr.Y > n1) + cr.Y -= n1; + else + cr.Y = 0; + SetConsoleCursorPosition (h, cr); + } + break; + + /* ESC [ n1 'B' + Move the cursor down by n1 characters. */ + case MAKEWORD ('[', 'B'): + if (esc_head == esc_term) + n1 = 1; + else + { + n1 = strtol (esc_head, &eptr, 10); + if (eptr != esc_term) + break; + } + + if (GetConsoleScreenBufferInfo (h, &sb)) + { + cr = sb.dwCursorPosition; + /* Stop at the bottommost boundary. */ + if (sb.dwSize.Y - cr.Y > n1) + cr.Y += n1; + else + cr.Y = sb.dwSize.Y; + SetConsoleCursorPosition (h, cr); + } + break; + + /* ESC [ n1 'C' + Move the cursor right by n1 characters. */ + case MAKEWORD ('[', 'C'): + if (esc_head == esc_term) + n1 = 1; + else + { + n1 = strtol (esc_head, &eptr, 10); + if (eptr != esc_term) + break; + } + + if (GetConsoleScreenBufferInfo (h, &sb)) + { + cr = sb.dwCursorPosition; + /* Stop at the rightmost boundary. */ + if (sb.dwSize.X - cr.X > n1) + cr.X += n1; + else + cr.X = sb.dwSize.X; + SetConsoleCursorPosition (h, cr); + } + break; + + /* ESC [ n1 'D' + Move the cursor left by n1 characters. */ + case MAKEWORD ('[', 'D'): + if (esc_head == esc_term) + n1 = 1; + else + { + n1 = strtol (esc_head, &eptr, 10); + if (eptr != esc_term) + break; + } + + if (GetConsoleScreenBufferInfo (h, &sb)) + { + cr = sb.dwCursorPosition; + /* Stop at the leftmost boundary. */ + if (cr.X > n1) + cr.X -= n1; + else + cr.X = 0; + SetConsoleCursorPosition (h, cr); + } + break; + + /* ESC [ n1 'E' + Move the cursor to the beginning of the n1-th line downwards. */ + case MAKEWORD ('[', 'E'): + if (esc_head == esc_term) + n1 = 1; + else + { + n1 = strtol (esc_head, &eptr, 10); + if (eptr != esc_term) + break; + } + + if (GetConsoleScreenBufferInfo (h, &sb)) + { + cr = sb.dwCursorPosition; + cr.X = 0; + /* Stop at the bottommost boundary. */ + if (sb.dwSize.Y - cr.Y > n1) + cr.Y += n1; + else + cr.Y = sb.dwSize.Y; + SetConsoleCursorPosition (h, cr); + } + break; + + /* ESC [ n1 'F' + Move the cursor to the beginning of the n1-th line upwards. */ + case MAKEWORD ('[', 'F'): + if (esc_head == esc_term) + n1 = 1; + else + { + n1 = strtol (esc_head, &eptr, 10); + if (eptr != esc_term) + break; + } + + if (GetConsoleScreenBufferInfo (h, &sb)) + { + cr = sb.dwCursorPosition; + cr.X = 0; + /* Stop at the topmost boundary. */ + if (cr.Y > n1) + cr.Y -= n1; + else + cr.Y = 0; + SetConsoleCursorPosition (h, cr); + } + break; + + /* ESC [ n1 'G' + Move the cursor to the (1-based) n1-th column. */ + case MAKEWORD ('[', 'G'): + if (esc_head == esc_term) + n1 = 1; + else + { + n1 = strtol (esc_head, &eptr, 10); + if (eptr != esc_term) + break; + } + + if (GetConsoleScreenBufferInfo (h, &sb)) + { + cr = sb.dwCursorPosition; + n1 -= 1; + /* Stop at the leftmost or rightmost boundary. */ + if (n1 < 0) + cr.X = 0; + else if (n1 > sb.dwSize.X) + cr.X = sb.dwSize.X; + else + cr.X = n1; + SetConsoleCursorPosition (h, cr); + } + break; + + /* ESC [ n1 ';' n2 'H' + ESC [ n1 ';' n2 'f' + Move the cursor to the (1-based) n1-th row and + (also 1-based) n2-th column. */ + case MAKEWORD ('[', 'H'): + case MAKEWORD ('[', 'f'): + if (esc_head == esc_term) + { + /* Both parameters are omitted and set to 1 by default. */ + n1 = 1; + n2 = 1; + } + else if (!(delim = (char *) memchr (esc_head, ';', + esc_term - esc_head))) + { + /* Only the first parameter is given. The second one is + set to 1 by default. */ + n1 = strtol (esc_head, &eptr, 10); + if (eptr != esc_term) + break; + n2 = 1; + } + else + { + /* Both parameters are given. The first one shall be + terminated by the semicolon. */ + n1 = strtol (esc_head, &eptr, 10); + if (eptr != delim) + break; + n2 = strtol (delim + 1, &eptr, 10); + if (eptr != esc_term) + break; + } + + if (GetConsoleScreenBufferInfo (h, &sb)) + { + cr = sb.dwCursorPosition; + n1 -= 1; + n2 -= 1; + /* The cursor position shall be relative to the view coord of + the console window, which is usually smaller than the actual + buffer. FWIW, the 'appropriate' solution will be shrinking + the buffer to match the size of the console window, + destroying scrollback in the process. */ + n1 += sb.srWindow.Top; + n2 += sb.srWindow.Left; + /* Stop at the topmost or bottommost boundary. */ + if (n1 < 0) + cr.Y = 0; + else if (n1 > sb.dwSize.Y) + cr.Y = sb.dwSize.Y; + else + cr.Y = n1; + /* Stop at the leftmost or rightmost boundary. */ + if (n2 < 0) + cr.X = 0; + else if (n2 > sb.dwSize.X) + cr.X = sb.dwSize.X; + else + cr.X = n2; + SetConsoleCursorPosition (h, cr); + } + break; + + /* ESC [ n1 'J' + Erase display. */ + case MAKEWORD ('[', 'J'): + if (esc_head == esc_term) + /* This is one of the very few codes whose parameters have + a default value of zero. */ + n1 = 0; + else + { + n1 = strtol (esc_head, &eptr, 10); + if (eptr != esc_term) + break; + } + + if (GetConsoleScreenBufferInfo (h, &sb)) + { + /* The cursor is not necessarily in the console window, which + makes the behavior of this code harder to define. */ + switch (n1) + { + case 0: + /* If the cursor is in or above the window, erase from + it to the bottom of the window; otherwise, do nothing. */ + cr = sb.dwCursorPosition; + cnt = sb.dwSize.X - sb.dwCursorPosition.X; + rows = sb.srWindow.Bottom - sb.dwCursorPosition.Y; + break; + case 1: + /* If the cursor is in or under the window, erase from + it to the top of the window; otherwise, do nothing. */ + cr.X = 0; + cr.Y = sb.srWindow.Top; + cnt = sb.dwCursorPosition.X + 1; + rows = sb.dwCursorPosition.Y - sb.srWindow.Top; + break; + case 2: + /* Erase the entire window. */ + cr.X = sb.srWindow.Left; + cr.Y = sb.srWindow.Top; + cnt = 0; + rows = sb.srWindow.Bottom - sb.srWindow.Top + 1; + break; + default: + /* Erase the entire buffer. */ + cr.X = 0; + cr.Y = 0; + cnt = 0; + rows = sb.dwSize.Y; + break; + } + if (rows < 0) + break; + cnt += rows * sb.dwSize.X; + FillConsoleOutputCharacterW (h, L' ', cnt, cr, &step); + FillConsoleOutputAttribute (h, sb.wAttributes, cnt, cr, &step); + } + break; + + /* ESC [ n1 'K' + Erase line. */ + case MAKEWORD ('[', 'K'): + if (esc_head == esc_term) + /* This is one of the very few codes whose parameters have + a default value of zero. */ + n1 = 0; + else + { + n1 = strtol (esc_head, &eptr, 10); + if (eptr != esc_term) + break; + } + + if (GetConsoleScreenBufferInfo (h, &sb)) + { + switch (n1) + { + case 0: + /* Erase from the cursor to the end. */ + cr = sb.dwCursorPosition; + cnt = sb.dwSize.X - sb.dwCursorPosition.X; + break; + case 1: + /* Erase from the cursor to the beginning. */ + cr = sb.dwCursorPosition; + cr.X = 0; + cnt = sb.dwCursorPosition.X + 1; + break; + default: + /* Erase the entire line. */ + cr = sb.dwCursorPosition; + cr.X = 0; + cnt = sb.dwSize.X; + break; + } + FillConsoleOutputCharacterW (h, L' ', cnt, cr, &step); + FillConsoleOutputAttribute (h, sb.wAttributes, cnt, cr, &step); + } + break; + + /* ESC [ n1 ';' n2 'm' + Set SGR parameters. Zero or more parameters will follow. */ + case MAKEWORD ('[', 'm'): + attrib_add = 0; + attrib_rm = 0; + if (esc_head == esc_term) + { + /* When no parameter is given, reset the console. */ + attrib_add |= (FOREGROUND_RED | FOREGROUND_GREEN + | FOREGROUND_BLUE); + attrib_rm = -1; /* Removes everything. */ + goto sgr_set_it; + } + param = esc_head; + do + { + /* Parse a parameter. */ + n1 = strtol (param, &eptr, 10); + if (*eptr != ';' && eptr != esc_term) + goto sgr_set_it; + + switch (n1) + { + case 0: + /* Reset. */ + attrib_add |= (FOREGROUND_RED | FOREGROUND_GREEN + | FOREGROUND_BLUE); + attrib_rm = -1; /* Removes everything. */ + break; + case 1: + /* Bold. */ + attrib_add |= FOREGROUND_INTENSITY; + break; + case 4: + /* Underline. */ + attrib_add |= COMMON_LVB_UNDERSCORE; + break; + case 5: + /* Blink. */ + /* XXX: It is not BLINKING at all! */ + attrib_add |= BACKGROUND_INTENSITY; + break; + case 7: + /* Reverse. */ + attrib_add |= COMMON_LVB_REVERSE_VIDEO; + break; + case 22: + /* No bold. */ + attrib_add &= ~FOREGROUND_INTENSITY; + attrib_rm |= FOREGROUND_INTENSITY; + break; + case 24: + /* No underline. */ + attrib_add &= ~COMMON_LVB_UNDERSCORE; + attrib_rm |= COMMON_LVB_UNDERSCORE; + break; + case 25: + /* No blink. */ + /* XXX: It is not BLINKING at all! */ + attrib_add &= ~BACKGROUND_INTENSITY; + attrib_rm |= BACKGROUND_INTENSITY; + break; + case 27: + /* No reverse. */ + attrib_add &= ~COMMON_LVB_REVERSE_VIDEO; + attrib_rm |= COMMON_LVB_REVERSE_VIDEO; + break; + case 30: + case 31: + case 32: + case 33: + case 34: + case 35: + case 36: + case 37: + /* Foreground color. */ + attrib_add &= ~(FOREGROUND_RED | FOREGROUND_GREEN + | FOREGROUND_BLUE); + n1 -= 30; + if (n1 & 1) + attrib_add |= FOREGROUND_RED; + if (n1 & 2) + attrib_add |= FOREGROUND_GREEN; + if (n1 & 4) + attrib_add |= FOREGROUND_BLUE; + attrib_rm |= (FOREGROUND_RED | FOREGROUND_GREEN + | FOREGROUND_BLUE); + break; + case 38: + /* Reserved for extended foreground color. + Don't know how to handle parameters remaining. + Bail out. */ + goto sgr_set_it; + case 39: + /* Reset foreground color. */ + /* Set to grey. */ + attrib_add |= (FOREGROUND_RED | FOREGROUND_GREEN + | FOREGROUND_BLUE); + attrib_rm |= (FOREGROUND_RED | FOREGROUND_GREEN + | FOREGROUND_BLUE); + break; + case 40: + case 41: + case 42: + case 43: + case 44: + case 45: + case 46: + case 47: + /* Background color. */ + attrib_add &= ~(BACKGROUND_RED | BACKGROUND_GREEN + | BACKGROUND_BLUE); + n1 -= 40; + if (n1 & 1) + attrib_add |= BACKGROUND_RED; + if (n1 & 2) + attrib_add |= BACKGROUND_GREEN; + if (n1 & 4) + attrib_add |= BACKGROUND_BLUE; + attrib_rm |= (BACKGROUND_RED | BACKGROUND_GREEN + | BACKGROUND_BLUE); + break; + case 48: + /* Reserved for extended background color. + Don't know how to handle parameters remaining. + Bail out. */ + goto sgr_set_it; + case 49: + /* Reset background color. */ + /* Set to black. */ + attrib_add &= ~(BACKGROUND_RED | BACKGROUND_GREEN + | BACKGROUND_BLUE); + attrib_rm |= (BACKGROUND_RED | BACKGROUND_GREEN + | BACKGROUND_BLUE); + break; + } + + /* Prepare the next parameter. */ + param = eptr + 1; + } + while (param != esc_term); + +sgr_set_it: + /* 0xFFFF removes everything. If it is not the case, + care must be taken to preserve old attributes. */ + if (attrib_rm != 0xFFFF && GetConsoleScreenBufferInfo (h, &sb)) + { + attrib_add |= sb.wAttributes & ~attrib_rm; + } + SetConsoleTextAttribute (h, attrib_add); + break; + } +} + +int +mingw_ansi_fputs (const char *str, FILE *fp) +{ + const char *read = str; + HANDLE h; + DWORD mode; + int esc_code, prefix_len; + const char *esc_head, *esc_term; + + h = (HANDLE) _get_osfhandle (_fileno (fp)); + if (h == INVALID_HANDLE_VALUE) + return EOF; + + /* Don't mess up stdio functions with Windows APIs. */ + fflush (fp); + + if (GetConsoleMode (h, &mode)) + /* If it is a console, translate ANSI escape codes as needed. */ + for (;;) + { + if ((esc_code = find_esc_head (&prefix_len, &esc_head, read)) == 0) + { + /* Write all remaining characters, then exit. */ + write_all (h, read, strlen (read)); + break; + } + if (find_esc_terminator (&esc_term, esc_head) == 0) + /* Ignore incomplete escape sequences at the moment. + FIXME: The escape state shall be cached for further calls + to this function. */ + break; + write_all (h, read, esc_head - prefix_len - read); + eat_esc_sequence (h, esc_code, esc_head, esc_term); + read = esc_term + 1; + } + else + /* If it is not a console, write everything as-is. */ + write_all (h, read, strlen (read)); + + _close ((intptr_t) h); + return 1; +} + +#endif /* __MINGW32__ */ + static void pp_quoted_string (pretty_printer *, const char *, size_t = -1); /* Overwrite the given location/range within this text_info's rich_location. @@ -140,7 +800,11 @@ void pp_write_text_to_stream (pretty_printer *pp) { const char *text = pp_formatted_text (pp); +#ifdef __MINGW32__ + mingw_ansi_fputs (text, pp_buffer (pp)->stream); +#else fputs (text, pp_buffer (pp)->stream); +#endif pp_clear_output_area (pp); } diff --git a/gcc/print-rtl.c b/gcc/print-rtl.c index 79ec463df4513..28d99862cad25 100644 --- a/gcc/print-rtl.c +++ b/gcc/print-rtl.c @@ -1792,11 +1792,11 @@ print_insn (pretty_printer *pp, const rtx_insn *x, int verbose) case DEBUG_INSN: { const char *name = "?"; + char idbuf[32]; if (DECL_P (INSN_VAR_LOCATION_DECL (x))) { tree id = DECL_NAME (INSN_VAR_LOCATION_DECL (x)); - char idbuf[32]; if (id) name = IDENTIFIER_POINTER (id); else if (TREE_CODE (INSN_VAR_LOCATION_DECL (x)) diff --git a/gcc/print-tree.c b/gcc/print-tree.c index 9497cb4f23838..d534c76ee495d 100644 --- a/gcc/print-tree.c +++ b/gcc/print-tree.c @@ -118,7 +118,7 @@ print_node_brief (FILE *file, const char *prefix, const_tree node, int indent) fprintf (file, " overflow"); fprintf (file, " "); - print_dec (node, file, TYPE_SIGN (TREE_TYPE (node))); + print_dec (wi::to_wide (node), file, TYPE_SIGN (TREE_TYPE (node))); } if (TREE_CODE (node) == REAL_CST) { @@ -721,7 +721,7 @@ print_node (FILE *file, const char *prefix, tree node, int indent, fprintf (file, " overflow"); fprintf (file, " "); - print_dec (node, file, TYPE_SIGN (TREE_TYPE (node))); + print_dec (wi::to_wide (node), file, TYPE_SIGN (TREE_TYPE (node))); break; case REAL_CST: diff --git a/gcc/profile-count.c b/gcc/profile-count.c index 4d22428a195bc..44ceaed2d6614 100644 --- a/gcc/profile-count.c +++ b/gcc/profile-count.c @@ -30,6 +30,7 @@ along with GCC; see the file COPYING3. If not see #include "gimple.h" #include "data-streamer.h" #include "cgraph.h" +#include "wide-int.h" /* Dump THIS to F. */ @@ -146,12 +147,12 @@ profile_probability::differs_from_p (profile_probability other) const { if (!initialized_p () || !other.initialized_p ()) return false; - if ((uint64_t)m_val - (uint64_t)other.m_val < 10 - || (uint64_t)other.m_val - (uint64_t)m_val < 10) + if ((uint64_t)m_val - (uint64_t)other.m_val < max_probability / 1000 + || (uint64_t)other.m_val - (uint64_t)max_probability < 1000) return false; if (!other.m_val) return true; - int64_t ratio = m_val * 100 / other.m_val; + int64_t ratio = (int64_t)m_val * 100 / other.m_val; return ratio < 99 || ratio > 101; } @@ -194,3 +195,21 @@ profile_probability::stream_out (struct lto_output_stream *ob) streamer_write_uhwi_stream (ob, m_val); streamer_write_uhwi_stream (ob, m_quality); } + +/* Compute RES=(a*b + c/2)/c capping and return false if overflow happened. */ + +bool +slow_safe_scale_64bit (uint64_t a, uint64_t b, uint64_t c, uint64_t *res) +{ + FIXED_WIDE_INT (128) tmp = a; + bool overflow; + tmp = wi::udiv_floor (wi::umul (tmp, b, &overflow) + (c / 2), c); + gcc_checking_assert (!overflow); + if (wi::fits_uhwi_p (tmp)) + { + *res = tmp.to_uhwi (); + return true; + } + *res = (uint64_t) -1; + return false; +} diff --git a/gcc/profile-count.h b/gcc/profile-count.h index 8fd22b8b68abf..4546e199f2401 100644 --- a/gcc/profile-count.h +++ b/gcc/profile-count.h @@ -43,6 +43,38 @@ enum profile_quality { #define RDIV(X,Y) (((X) + (Y) / 2) / (Y)) +bool slow_safe_scale_64bit (uint64_t a, uint64_t b, uint64_t c, uint64_t *res); + +/* Compute RES=(a*b + c/2)/c capping and return false if overflow happened. */ + +inline bool +safe_scale_64bit (uint64_t a, uint64_t b, uint64_t c, uint64_t *res) +{ +#if (GCC_VERSION >= 5000) + uint64_t tmp; + if (!__builtin_mul_overflow (a, b, &tmp) + && !__builtin_add_overflow (tmp, c/2, &tmp)) + { + *res = tmp / c; + return true; + } + if (c == 1) + { + *res = (uint64_t) -1; + return false; + } +#else + if (a < ((uint64_t)1 << 31) + && b < ((uint64_t)1 << 31) + && c < ((uint64_t)1 << 31)) + { + *res = (a * b + (c / 2)) / c; + return true; + } +#endif + return slow_safe_scale_64bit (a, b, c, res); +} + /* Data type to hold probabilities. It implements fixed point arithmetics with capping so probability is always in range [0,1] and scaling requiring values greater than 1 needs to be represented otherwise. @@ -82,12 +114,12 @@ enum profile_quality { class GTY((user)) profile_probability { - /* For now use values in range 0...REG_BR_PROB_BASE. Later we can use full - precision of 30 bits available. */ - static const int n_bits = 30; - static const uint32_t max_probability = REG_BR_PROB_BASE; - static const uint32_t uninitialized_probability = ((uint32_t) 1 << n_bits) - 1; + /* We can technically use ((uint32_t) 1 << (n_bits - 1)) - 2 but that + will lead to harder multiplication sequences. */ + static const uint32_t max_probability = (uint32_t) 1 << (n_bits - 2); + static const uint32_t uninitialized_probability + = ((uint32_t) 1 << (n_bits - 1)) - 1; uint32_t m_val : 30; enum profile_quality m_quality : 2; @@ -171,7 +203,7 @@ class GTY((user)) profile_probability /* Return true if value can be trusted. */ bool reliable_p () const { - return initialized_p (); + return m_quality >= profile_adjusted; } /* Conversion from and to REG_BR_PROB_BASE integer fixpoint arithmetics. @@ -180,14 +212,14 @@ class GTY((user)) profile_probability { profile_probability ret; gcc_checking_assert (v >= 0 && v <= REG_BR_PROB_BASE); - ret.m_val = RDIV (v * max_probability, REG_BR_PROB_BASE); + ret.m_val = RDIV (v * (uint64_t) max_probability, REG_BR_PROB_BASE); ret.m_quality = profile_guessed; return ret; } int to_reg_br_prob_base () const { gcc_checking_assert (initialized_p ()); - return RDIV (m_val * REG_BR_PROB_BASE, max_probability); + return RDIV (m_val * (uint64_t) REG_BR_PROB_BASE, max_probability); } /* Conversion to and from RTL representation of profile probabilities. */ @@ -216,7 +248,12 @@ class GTY((user)) profile_probability if (val1 > val2) ret.m_val = max_probability; else - ret.m_val = RDIV (val1 * max_probability, val2); + { + uint64_t tmp; + safe_scale_64bit (val1, max_probability, val2, &tmp); + gcc_checking_assert (tmp <= max_probability); + ret.m_val = tmp; + } ret.m_quality = profile_precise; return ret; } @@ -413,8 +450,9 @@ class GTY((user)) profile_probability if (!initialized_p ()) return profile_probability::uninitialized (); profile_probability ret; - ret.m_val = MIN (RDIV (m_val * num, den), - max_probability); + uint64_t tmp; + safe_scale_64bit (m_val, num, den, &tmp); + ret.m_val = MIN (tmp, max_probability); ret.m_quality = MIN (m_quality, profile_adjusted); return ret; } @@ -452,7 +490,7 @@ class GTY((user)) profile_probability if (m_val == uninitialized_probability) return m_quality == profile_guessed; else - return m_val <= REG_BR_PROB_BASE; + return m_val <= max_probability; } /* Comparsions are three-state and conservative. False is returned if @@ -535,11 +573,6 @@ class GTY(()) profile_count uint64_t m_val : n_bits; enum profile_quality m_quality : 2; - - /* Assume numbers smaller than this to multiply. This is set to make - testsuite pass, in future we may implement precise multiplication in higer - rangers. */ - static const uint64_t max_safe_multiplier = 131072; public: /* Used for counters which are expected to be never executed. */ @@ -595,7 +628,7 @@ class GTY(()) profile_count /* Return true if value can be trusted. */ bool reliable_p () const { - return initialized_p (); + return m_quality >= profile_adjusted; } /* When merging basic blocks, the two different profile counts are unified. @@ -756,8 +789,10 @@ class GTY(()) profile_count if (!initialized_p ()) return profile_count::uninitialized (); profile_count ret; - ret.m_val = RDIV (m_val * prob.m_val, - profile_probability::max_probability); + uint64_t tmp; + safe_scale_64bit (m_val, prob.m_val, profile_probability::max_probability, + &tmp); + ret.m_val = tmp; ret.m_quality = MIN (m_quality, prob.m_quality); return ret; } @@ -769,11 +804,11 @@ class GTY(()) profile_count if (!initialized_p ()) return profile_count::uninitialized (); profile_count ret; + uint64_t tmp; + gcc_checking_assert (num >= 0 && den > 0); - /* FIXME: shrink wrapping violates this sanity check. */ - gcc_checking_assert ((num <= REG_BR_PROB_BASE - || den <= REG_BR_PROB_BASE) || 1); - ret.m_val = RDIV (m_val * num, den); + safe_scale_64bit (m_val, num, den, &tmp); + ret.m_val = MIN (tmp, max_count); ret.m_quality = MIN (m_quality, profile_adjusted); return ret; } @@ -790,12 +825,9 @@ class GTY(()) profile_count return *this; profile_count ret; - /* Take care for overflows! */ - if (num.m_val < max_safe_multiplier || m_val < max_safe_multiplier) - ret.m_val = RDIV (m_val * num.m_val, den.m_val); - else - ret.m_val = RDIV (m_val * RDIV (num.m_val * max_safe_multiplier, - den.m_val), max_safe_multiplier); + uint64_t val; + safe_scale_64bit (m_val, num.m_val, den.m_val, &val); + ret.m_val = MIN (val, max_count); ret.m_quality = MIN (m_quality, profile_adjusted); return ret; } diff --git a/gcc/profile.c b/gcc/profile.c index 6d40241a37bcc..95dd578a4937b 100644 --- a/gcc/profile.c +++ b/gcc/profile.c @@ -831,12 +831,7 @@ compute_branch_probabilities (unsigned cfg_checksum, unsigned lineno_checksum) FOR_ALL_BB_FN (bb, cfun) { - edge e; - edge_iterator ei; - bb->count = profile_count::from_gcov_type (bb_gcov_count (bb)); - FOR_EACH_EDGE (e, ei, bb->succs) - e->count = profile_count::from_gcov_type (edge_gcov_count (e)); } bb_gcov_counts.release (); delete edge_gcov_counts; diff --git a/gcc/recog.c b/gcc/recog.c index cfce0291ba037..9aaa6cd7a73ce 100644 --- a/gcc/recog.c +++ b/gcc/recog.c @@ -408,6 +408,7 @@ verify_changes (int num) && REG_P (changes[i].old) && asm_noperands (PATTERN (object)) > 0 && REG_EXPR (changes[i].old) != NULL_TREE + && HAS_DECL_ASSEMBLER_NAME_P (REG_EXPR (changes[i].old)) && DECL_ASSEMBLER_NAME_SET_P (REG_EXPR (changes[i].old)) && DECL_REGISTER (REG_EXPR (changes[i].old))) { @@ -3380,6 +3381,7 @@ peep2_attempt (basic_block bb, rtx_insn *insn, int match_len, rtx_insn *attempt) case REG_NORETURN: case REG_SETJMP: case REG_TM: + case REG_CALL_NOCF_CHECK: add_reg_note (new_insn, REG_NOTE_KIND (note), XEXP (note, 0)); break; diff --git a/gcc/ree.c b/gcc/ree.c index 19225d5833b9a..8915cbe0d6fdb 100644 --- a/gcc/ree.c +++ b/gcc/ree.c @@ -428,7 +428,8 @@ transform_ifelse (ext_cand *cand, rtx_insn *def_insn) srcreg2 = XEXP (SET_SRC (set_insn), 2); /* If the conditional move already has the right or wider mode, there is nothing to do. */ - if (GET_MODE_SIZE (GET_MODE (dstreg)) >= GET_MODE_SIZE (cand->mode)) + if (GET_MODE_UNIT_SIZE (GET_MODE (dstreg)) + >= GET_MODE_UNIT_SIZE (cand->mode)) return true; map_srcreg = gen_rtx_REG (cand->mode, REGNO (srcreg)); @@ -718,8 +719,8 @@ merge_def_and_ext (ext_cand *cand, rtx_insn *def_insn, ext_state *state) && state->modified[INSN_UID (def_insn)].mode == ext_src_mode))) { - if (GET_MODE_SIZE (GET_MODE (SET_DEST (*sub_rtx))) - >= GET_MODE_SIZE (cand->mode)) + if (GET_MODE_UNIT_SIZE (GET_MODE (SET_DEST (*sub_rtx))) + >= GET_MODE_UNIT_SIZE (cand->mode)) return true; /* If def_insn is already scheduled to be deleted, don't attempt to modify it. */ @@ -926,7 +927,8 @@ combine_reaching_defs (ext_cand *cand, const_rtx set_pat, ext_state *state) || (set = single_set (cand->insn)) == NULL_RTX) return false; mode = GET_MODE (SET_DEST (set)); - gcc_assert (GET_MODE_SIZE (mode) >= GET_MODE_SIZE (cand->mode)); + gcc_assert (GET_MODE_UNIT_SIZE (mode) + >= GET_MODE_UNIT_SIZE (cand->mode)); cand->mode = mode; } diff --git a/gcc/reg-notes.def b/gcc/reg-notes.def index a542990cde2d6..d83fc45ef72c8 100644 --- a/gcc/reg-notes.def +++ b/gcc/reg-notes.def @@ -232,3 +232,10 @@ REG_NOTE (STACK_CHECK) The decl might not be available in the call due to splitting of the call insn. This note is a SYMBOL_REF. */ REG_NOTE (CALL_DECL) + +/* Indicate that a call should not be verified for control-flow consistency. + The target address of the call is assumed as a valid address and no check + to validate a branch to the target address is needed. The call is marked + when a called function has a 'notrack' attribute. This note is used by the + compiler when the option -fcf-protection=branch is specified. */ +REG_NOTE (CALL_NOCF_CHECK) diff --git a/gcc/reg-stack.c b/gcc/reg-stack.c index f2381067f5e38..62f7d7b965373 100644 --- a/gcc/reg-stack.c +++ b/gcc/reg-stack.c @@ -262,7 +262,7 @@ static bool move_for_stack_reg (rtx_insn *, stack_ptr, rtx); static bool move_nan_for_stack_reg (rtx_insn *, stack_ptr, rtx); static int swap_rtx_condition_1 (rtx); static int swap_rtx_condition (rtx_insn *); -static void compare_for_stack_reg (rtx_insn *, stack_ptr, rtx); +static void compare_for_stack_reg (rtx_insn *, stack_ptr, rtx, bool); static bool subst_stack_regs_pat (rtx_insn *, stack_ptr, rtx); static void subst_asm_stack_regs (rtx_insn *, stack_ptr); static bool subst_stack_regs (rtx_insn *, stack_ptr); @@ -1325,7 +1325,8 @@ swap_rtx_condition (rtx_insn *insn) set up. */ static void -compare_for_stack_reg (rtx_insn *insn, stack_ptr regstack, rtx pat_src) +compare_for_stack_reg (rtx_insn *insn, stack_ptr regstack, + rtx pat_src, bool can_pop_second_op) { rtx *src1, *src2; rtx src1_note, src2_note; @@ -1366,8 +1367,18 @@ compare_for_stack_reg (rtx_insn *insn, stack_ptr regstack, rtx pat_src) if (src1_note) { - pop_stack (regstack, REGNO (XEXP (src1_note, 0))); - replace_reg (&XEXP (src1_note, 0), FIRST_STACK_REG); + if (*src2 == CONST0_RTX (GET_MODE (*src2))) + { + /* This is `ftst' insn that can't pop register. */ + remove_regno_note (insn, REG_DEAD, REGNO (XEXP (src1_note, 0))); + emit_pop_insn (insn, regstack, XEXP (src1_note, 0), + EMIT_AFTER); + } + else + { + pop_stack (regstack, REGNO (XEXP (src1_note, 0))); + replace_reg (&XEXP (src1_note, 0), FIRST_STACK_REG); + } } /* If the second operand dies, handle that. But if the operands are @@ -1384,7 +1395,7 @@ compare_for_stack_reg (rtx_insn *insn, stack_ptr regstack, rtx pat_src) at top (FIRST_STACK_REG) now. */ if (get_hard_regnum (regstack, XEXP (src2_note, 0)) == FIRST_STACK_REG - && src1_note) + && src1_note && can_pop_second_op) { pop_stack (regstack, REGNO (XEXP (src2_note, 0))); replace_reg (&XEXP (src2_note, 0), FIRST_STACK_REG + 1); @@ -1550,7 +1561,9 @@ subst_stack_regs_pat (rtx_insn *insn, stack_ptr regstack, rtx pat) switch (GET_CODE (pat_src)) { case COMPARE: - compare_for_stack_reg (insn, regstack, pat_src); + /* `fcomi' insn can't pop two regs. */ + compare_for_stack_reg (insn, regstack, pat_src, + REGNO (*dest) != FLAGS_REG); break; case CALL: @@ -1970,7 +1983,7 @@ subst_stack_regs_pat (rtx_insn *insn, stack_ptr regstack, rtx pat) pat_src = XVECEXP (pat_src, 0, 0); gcc_assert (GET_CODE (pat_src) == COMPARE); - compare_for_stack_reg (insn, regstack, pat_src); + compare_for_stack_reg (insn, regstack, pat_src, true); break; default: @@ -2948,9 +2961,9 @@ better_edge (edge e1, edge e2) if (EDGE_FREQUENCY (e1) < EDGE_FREQUENCY (e2)) return e2; - if (e1->count > e2->count) + if (e1->count () > e2->count ()) return e1; - if (e1->count < e2->count) + if (e1->count () < e2->count ()) return e2; /* Prefer critical edges to minimize inserting compensation code on diff --git a/gcc/regcprop.c b/gcc/regcprop.c index 73e945d45ae65..5db5b5d9fdffa 100644 --- a/gcc/regcprop.c +++ b/gcc/regcprop.c @@ -345,8 +345,7 @@ copy_value (rtx dest, rtx src, struct value_data *vd) We can't properly represent the latter case in our tables, so don't record anything then. */ else if (sn < hard_regno_nregs (sr, vd->e[sr].mode) - && (GET_MODE_SIZE (vd->e[sr].mode) > UNITS_PER_WORD - ? WORDS_BIG_ENDIAN : BYTES_BIG_ENDIAN)) + && subreg_lowpart_offset (GET_MODE (dest), vd->e[sr].mode) != 0) return; /* If SRC had been assigned a mode narrower than the copy, we can't @@ -871,8 +870,7 @@ copyprop_hardreg_forward_1 (basic_block bb, struct value_data *vd) /* And likewise, if we are narrowing on big endian the transformation is also invalid. */ if (REG_NREGS (src) < hard_regno_nregs (regno, vd->e[regno].mode) - && (GET_MODE_SIZE (vd->e[regno].mode) > UNITS_PER_WORD - ? WORDS_BIG_ENDIAN : BYTES_BIG_ENDIAN)) + && subreg_lowpart_offset (mode, vd->e[regno].mode) != 0) goto no_move_special_case; } diff --git a/gcc/rtl.h b/gcc/rtl.h index a63f33e747a5a..f854550bb8343 100644 --- a/gcc/rtl.h +++ b/gcc/rtl.h @@ -3203,7 +3203,8 @@ extern int loc_mentioned_in_p (rtx *, const_rtx); extern rtx_insn *find_first_parameter_load (rtx_insn *, rtx_insn *); extern bool keep_with_call_p (const rtx_insn *); extern bool label_is_jump_target_p (const_rtx, const rtx_insn *); -extern int insn_rtx_cost (rtx, bool); +extern int pattern_cost (rtx, bool); +extern int insn_cost (rtx_insn *, bool); extern unsigned seq_cost (const rtx_insn *, bool); /* Given an insn and condition, return a canonical description of diff --git a/gcc/rtlanal.c b/gcc/rtlanal.c index b28325e644ba3..eadf691d077dd 100644 --- a/gcc/rtlanal.c +++ b/gcc/rtlanal.c @@ -5269,11 +5269,11 @@ num_sign_bit_copies1 (const_rtx x, scalar_int_mode mode, const_rtx known_x, ? 1 : bitwidth - floor_log2 (nonzero) - 1; } -/* Calculate the rtx_cost of a single instruction. A return value of +/* Calculate the rtx_cost of a single instruction pattern. A return value of zero indicates an instruction pattern without a known cost. */ int -insn_rtx_cost (rtx pat, bool speed) +pattern_cost (rtx pat, bool speed) { int i, cost; rtx set; @@ -5323,6 +5323,18 @@ insn_rtx_cost (rtx pat, bool speed) return cost > 0 ? cost : COSTS_N_INSNS (1); } +/* Calculate the cost of a single instruction. A return value of zero + indicates an instruction pattern without a known cost. */ + +int +insn_cost (rtx_insn *insn, bool speed) +{ + if (targetm.insn_cost) + return targetm.insn_cost (insn, speed); + + return pattern_cost (PATTERN (insn), speed); +} + /* Returns estimate on cost of computing SEQ. */ unsigned diff --git a/gcc/rtlhooks.c b/gcc/rtlhooks.c index 4d04ebd0c4716..d20815e255b71 100644 --- a/gcc/rtlhooks.c +++ b/gcc/rtlhooks.c @@ -59,8 +59,6 @@ gen_lowpart_general (machine_mode mode, rtx x) } else { - int offset = 0; - /* The only additional case we can do is MEM. */ gcc_assert (MEM_P (x)); @@ -72,16 +70,7 @@ gen_lowpart_general (machine_mode mode, rtx x) && !reload_completed) return gen_lowpart_general (mode, force_reg (xmode, x)); - if (WORDS_BIG_ENDIAN) - offset = (MAX (GET_MODE_SIZE (GET_MODE (x)), UNITS_PER_WORD) - - MAX (GET_MODE_SIZE (mode), UNITS_PER_WORD)); - - if (BYTES_BIG_ENDIAN) - /* Adjust the address so that the address-after-the-data - is unchanged. */ - offset -= (MIN (UNITS_PER_WORD, GET_MODE_SIZE (mode)) - - MIN (UNITS_PER_WORD, GET_MODE_SIZE (GET_MODE (x)))); - + HOST_WIDE_INT offset = byte_lowpart_offset (mode, GET_MODE (x)); return adjust_address (x, mode, offset); } } @@ -126,19 +115,8 @@ gen_lowpart_if_possible (machine_mode mode, rtx x) else if (MEM_P (x)) { /* This is the only other case we handle. */ - int offset = 0; - rtx new_rtx; - - if (WORDS_BIG_ENDIAN) - offset = (MAX (GET_MODE_SIZE (GET_MODE (x)), UNITS_PER_WORD) - - MAX (GET_MODE_SIZE (mode), UNITS_PER_WORD)); - if (BYTES_BIG_ENDIAN) - /* Adjust the address so that the address-after-the-data is - unchanged. */ - offset -= (MIN (UNITS_PER_WORD, GET_MODE_SIZE (mode)) - - MIN (UNITS_PER_WORD, GET_MODE_SIZE (GET_MODE (x)))); - - new_rtx = adjust_address_nv (x, mode, offset); + HOST_WIDE_INT offset = byte_lowpart_offset (mode, GET_MODE (x)); + rtx new_rtx = adjust_address_nv (x, mode, offset); if (! memory_address_addr_space_p (mode, XEXP (new_rtx, 0), MEM_ADDR_SPACE (x))) return 0; diff --git a/gcc/sanitizer.def b/gcc/sanitizer.def index 9d963f05c21d6..00e7ae031e677 100644 --- a/gcc/sanitizer.def +++ b/gcc/sanitizer.def @@ -424,8 +424,8 @@ DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_VLA_BOUND_NOT_POSITIVE, "__ubsan_handle_vla_bound_not_positive", BT_FN_VOID_PTR_PTR, ATTR_COLD_NOTHROW_LEAF_LIST) -DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_TYPE_MISMATCH, - "__ubsan_handle_type_mismatch", +DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_TYPE_MISMATCH_V1, + "__ubsan_handle_type_mismatch_v1", BT_FN_VOID_PTR_PTR, ATTR_COLD_NOTHROW_LEAF_LIST) DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_ADD_OVERFLOW, @@ -464,8 +464,8 @@ DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_VLA_BOUND_NOT_POSITIVE_ABORT, "__ubsan_handle_vla_bound_not_positive_abort", BT_FN_VOID_PTR_PTR, ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST) -DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_TYPE_MISMATCH_ABORT, - "__ubsan_handle_type_mismatch_abort", +DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_TYPE_MISMATCH_V1_ABORT, + "__ubsan_handle_type_mismatch_v1_abort", BT_FN_VOID_PTR_PTR, ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST) DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_ADD_OVERFLOW_ABORT, @@ -516,12 +516,20 @@ DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_NONNULL_ARG_ABORT, "__ubsan_handle_nonnull_arg_abort", BT_FN_VOID_PTR, ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST) -DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_NONNULL_RETURN, - "__ubsan_handle_nonnull_return", +DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_NONNULL_RETURN_V1, + "__ubsan_handle_nonnull_return_v1", + BT_FN_VOID_PTR_PTR, + ATTR_COLD_NOTHROW_LEAF_LIST) +DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_NONNULL_RETURN_V1_ABORT, + "__ubsan_handle_nonnull_return_v1_abort", + BT_FN_VOID_PTR_PTR, + ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST) +DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_INVALID_BUILTIN, + "__ubsan_handle_invalid_builtin", BT_FN_VOID_PTR, ATTR_COLD_NOTHROW_LEAF_LIST) -DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_NONNULL_RETURN_ABORT, - "__ubsan_handle_nonnull_return_abort", +DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_INVALID_BUILTIN_ABORT, + "__ubsan_handle_invalid_builtin_abort", BT_FN_VOID_PTR, ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST) DEF_SANITIZER_BUILTIN(BUILT_IN_UBSAN_HANDLE_DYNAMIC_TYPE_CACHE_MISS, diff --git a/gcc/sbitmap.c b/gcc/sbitmap.c index 4bf13a11a1d20..df933f6516cd6 100644 --- a/gcc/sbitmap.c +++ b/gcc/sbitmap.c @@ -21,6 +21,7 @@ along with GCC; see the file COPYING3. If not see #include "system.h" #include "coretypes.h" #include "sbitmap.h" +#include "selftest.h" typedef SBITMAP_ELT_TYPE *sbitmap_ptr; typedef const SBITMAP_ELT_TYPE *const_sbitmap_ptr; @@ -179,6 +180,8 @@ sbitmap_vector_alloc (unsigned int n_vecs, unsigned int n_elms) void bitmap_copy (sbitmap dst, const_sbitmap src) { + gcc_checking_assert (src->size <= dst->size); + memcpy (dst->elms, src->elms, sizeof (SBITMAP_ELT_TYPE) * dst->size); } @@ -186,6 +189,8 @@ bitmap_copy (sbitmap dst, const_sbitmap src) int bitmap_equal_p (const_sbitmap a, const_sbitmap b) { + bitmap_check_sizes (a, b); + return !memcmp (a->elms, b->elms, sizeof (SBITMAP_ELT_TYPE) * a->size); } @@ -210,6 +215,8 @@ bitmap_clear_range (sbitmap bmap, unsigned int start, unsigned int count) if (count == 0) return; + bitmap_check_index (bmap, start + count - 1); + unsigned int start_word = start / SBITMAP_ELT_BITS; unsigned int start_bitno = start % SBITMAP_ELT_BITS; @@ -266,6 +273,8 @@ bitmap_set_range (sbitmap bmap, unsigned int start, unsigned int count) if (count == 0) return; + bitmap_check_index (bmap, start + count - 1); + unsigned int start_word = start / SBITMAP_ELT_BITS; unsigned int start_bitno = start % SBITMAP_ELT_BITS; @@ -322,29 +331,24 @@ bitmap_set_range (sbitmap bmap, unsigned int start, unsigned int count) bool bitmap_bit_in_range_p (const_sbitmap bmap, unsigned int start, unsigned int end) { + gcc_checking_assert (start <= end); + bitmap_check_index (bmap, end); + unsigned int start_word = start / SBITMAP_ELT_BITS; unsigned int start_bitno = start % SBITMAP_ELT_BITS; - /* Testing within a word, starting at the beginning of a word. */ - if (start_bitno == 0 && (end - start) < SBITMAP_ELT_BITS) - { - SBITMAP_ELT_TYPE mask = ((SBITMAP_ELT_TYPE)1 << (end - start)) - 1; - return (bmap->elms[start_word] & mask) != 0; - } - unsigned int end_word = end / SBITMAP_ELT_BITS; unsigned int end_bitno = end % SBITMAP_ELT_BITS; - /* Testing starts somewhere in the middle of a word. Test up to the - end of the word or the end of the requested region, whichever comes - first. */ + /* Check beginning of first word if different from zero. */ if (start_bitno != 0) { - unsigned int nbits = ((start_word == end_word) - ? end_bitno - start_bitno - : SBITMAP_ELT_BITS - start_bitno); - SBITMAP_ELT_TYPE mask = ((SBITMAP_ELT_TYPE)1 << nbits) - 1; - mask <<= start_bitno; + SBITMAP_ELT_TYPE high_mask = ~(SBITMAP_ELT_TYPE)0; + if (start_word == end_word && end_bitno + 1 < SBITMAP_ELT_BITS) + high_mask = ((SBITMAP_ELT_TYPE)1 << (end_bitno + 1)) - 1; + + SBITMAP_ELT_TYPE low_mask = ((SBITMAP_ELT_TYPE)1 << start_bitno) - 1; + SBITMAP_ELT_TYPE mask = high_mask - low_mask; if (bmap->elms[start_word] & mask) return true; start_word++; @@ -364,8 +368,9 @@ bitmap_bit_in_range_p (const_sbitmap bmap, unsigned int start, unsigned int end) } /* Now handle residuals in the last word. */ - SBITMAP_ELT_TYPE mask - = ((SBITMAP_ELT_TYPE)1 << (SBITMAP_ELT_BITS - end_bitno)) - 1; + SBITMAP_ELT_TYPE mask = ~(SBITMAP_ELT_TYPE)0; + if (end_bitno + 1 < SBITMAP_ELT_BITS) + mask = ((SBITMAP_ELT_TYPE)1 << (end_bitno + 1)) - 1; return (bmap->elms[start_word] & mask) != 0; } @@ -472,6 +477,9 @@ bitmap_vector_ones (sbitmap *bmap, unsigned int n_vecs) bool bitmap_ior_and_compl (sbitmap dst, const_sbitmap a, const_sbitmap b, const_sbitmap c) { + bitmap_check_sizes (a, b); + bitmap_check_sizes (b, c); + unsigned int i, n = dst->size; sbitmap_ptr dstp = dst->elms; const_sbitmap_ptr ap = a->elms; @@ -494,6 +502,8 @@ bitmap_ior_and_compl (sbitmap dst, const_sbitmap a, const_sbitmap b, const_sbitm void bitmap_not (sbitmap dst, const_sbitmap src) { + bitmap_check_sizes (src, dst); + unsigned int i, n = dst->size; sbitmap_ptr dstp = dst->elms; const_sbitmap_ptr srcp = src->elms; @@ -515,6 +525,9 @@ bitmap_not (sbitmap dst, const_sbitmap src) void bitmap_and_compl (sbitmap dst, const_sbitmap a, const_sbitmap b) { + bitmap_check_sizes (a, b); + bitmap_check_sizes (b, dst); + unsigned int i, dst_size = dst->size; unsigned int min_size = dst->size; sbitmap_ptr dstp = dst->elms; @@ -542,6 +555,8 @@ bitmap_and_compl (sbitmap dst, const_sbitmap a, const_sbitmap b) bool bitmap_intersect_p (const_sbitmap a, const_sbitmap b) { + bitmap_check_sizes (a, b); + const_sbitmap_ptr ap = a->elms; const_sbitmap_ptr bp = b->elms; unsigned int i, n; @@ -560,6 +575,9 @@ bitmap_intersect_p (const_sbitmap a, const_sbitmap b) bool bitmap_and (sbitmap dst, const_sbitmap a, const_sbitmap b) { + bitmap_check_sizes (a, b); + bitmap_check_sizes (b, dst); + unsigned int i, n = dst->size; sbitmap_ptr dstp = dst->elms; const_sbitmap_ptr ap = a->elms; @@ -582,6 +600,9 @@ bitmap_and (sbitmap dst, const_sbitmap a, const_sbitmap b) bool bitmap_xor (sbitmap dst, const_sbitmap a, const_sbitmap b) { + bitmap_check_sizes (a, b); + bitmap_check_sizes (b, dst); + unsigned int i, n = dst->size; sbitmap_ptr dstp = dst->elms; const_sbitmap_ptr ap = a->elms; @@ -604,6 +625,9 @@ bitmap_xor (sbitmap dst, const_sbitmap a, const_sbitmap b) bool bitmap_ior (sbitmap dst, const_sbitmap a, const_sbitmap b) { + bitmap_check_sizes (a, b); + bitmap_check_sizes (b, dst); + unsigned int i, n = dst->size; sbitmap_ptr dstp = dst->elms; const_sbitmap_ptr ap = a->elms; @@ -625,6 +649,8 @@ bitmap_ior (sbitmap dst, const_sbitmap a, const_sbitmap b) bool bitmap_subset_p (const_sbitmap a, const_sbitmap b) { + bitmap_check_sizes (a, b); + unsigned int i, n = a->size; const_sbitmap_ptr ap, bp; @@ -641,6 +667,10 @@ bitmap_subset_p (const_sbitmap a, const_sbitmap b) bool bitmap_or_and (sbitmap dst, const_sbitmap a, const_sbitmap b, const_sbitmap c) { + bitmap_check_sizes (a, b); + bitmap_check_sizes (b, c); + bitmap_check_sizes (c, dst); + unsigned int i, n = dst->size; sbitmap_ptr dstp = dst->elms; const_sbitmap_ptr ap = a->elms; @@ -664,6 +694,10 @@ bitmap_or_and (sbitmap dst, const_sbitmap a, const_sbitmap b, const_sbitmap c) bool bitmap_and_or (sbitmap dst, const_sbitmap a, const_sbitmap b, const_sbitmap c) { + bitmap_check_sizes (a, b); + bitmap_check_sizes (b, c); + bitmap_check_sizes (c, dst); + unsigned int i, n = dst->size; sbitmap_ptr dstp = dst->elms; const_sbitmap_ptr ap = a->elms; @@ -821,3 +855,146 @@ dump_bitmap_vector (FILE *file, const char *title, const char *subtitle, fprintf (file, "\n"); } + +#if CHECKING_P + +namespace selftest { + +/* Selftests for sbitmaps. */ + +/* Checking function that uses both bitmap_bit_in_range_p and + loop of bitmap_bit_p and verifies consistent results. */ + +static bool +bitmap_bit_in_range_p_checking (sbitmap s, unsigned int start, + unsigned end) +{ + bool r1 = bitmap_bit_in_range_p (s, start, end); + bool r2 = false; + + for (unsigned int i = start; i <= end; i++) + if (bitmap_bit_p (s, i)) + { + r2 = true; + break; + } + + ASSERT_EQ (r1, r2); + return r1; +} + +/* Verify bitmap_set_range functions for sbitmap. */ + +static void +test_set_range () +{ + sbitmap s = sbitmap_alloc (16); + bitmap_clear (s); + + bitmap_set_range (s, 0, 1); + ASSERT_TRUE (bitmap_bit_in_range_p_checking (s, 0, 0)); + ASSERT_FALSE (bitmap_bit_in_range_p_checking (s, 1, 15)); + bitmap_set_range (s, 15, 1); + ASSERT_FALSE (bitmap_bit_in_range_p_checking (s, 1, 14)); + ASSERT_TRUE (bitmap_bit_in_range_p_checking (s, 15, 15)); + + s = sbitmap_alloc (1024); + bitmap_clear (s); + bitmap_set_range (s, 512, 1); + ASSERT_FALSE (bitmap_bit_in_range_p_checking (s, 0, 511)); + ASSERT_FALSE (bitmap_bit_in_range_p_checking (s, 513, 1023)); + ASSERT_TRUE (bitmap_bit_in_range_p_checking (s, 512, 512)); + ASSERT_TRUE (bitmap_bit_in_range_p_checking (s, 508, 512)); + ASSERT_TRUE (bitmap_bit_in_range_p_checking (s, 508, 513)); + ASSERT_FALSE (bitmap_bit_in_range_p_checking (s, 508, 511)); + + bitmap_clear (s); + bitmap_set_range (s, 512, 64); + ASSERT_FALSE (bitmap_bit_in_range_p_checking (s, 0, 511)); + ASSERT_FALSE (bitmap_bit_in_range_p_checking (s, 512 + 64, 1023)); + ASSERT_TRUE (bitmap_bit_in_range_p_checking (s, 512, 512)); + ASSERT_TRUE (bitmap_bit_in_range_p_checking (s, 512 + 63, 512 + 63)); +} + +/* Verify bitmap_bit_in_range_p functions for sbitmap. */ + +static void +test_bit_in_range () +{ + sbitmap s = sbitmap_alloc (1024); + bitmap_clear (s); + + ASSERT_FALSE (bitmap_bit_in_range_p (s, 512, 1023)); + bitmap_set_bit (s, 100); + + ASSERT_FALSE (bitmap_bit_in_range_p (s, 512, 1023)); + ASSERT_FALSE (bitmap_bit_in_range_p (s, 0, 99)); + ASSERT_FALSE (bitmap_bit_in_range_p (s, 101, 1023)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 1, 100)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 64, 100)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 100, 100)); + ASSERT_TRUE (bitmap_bit_p (s, 100)); + + s = sbitmap_alloc (64); + bitmap_clear (s); + bitmap_set_bit (s, 63); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 0, 63)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 1, 63)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 63, 63)); + ASSERT_TRUE (bitmap_bit_p (s, 63)); + + s = sbitmap_alloc (1024); + bitmap_clear (s); + bitmap_set_bit (s, 128); + ASSERT_FALSE (bitmap_bit_in_range_p (s, 0, 127)); + ASSERT_FALSE (bitmap_bit_in_range_p (s, 129, 1023)); + + ASSERT_TRUE (bitmap_bit_in_range_p (s, 0, 128)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 1, 128)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 128, 255)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 128, 254)); + ASSERT_TRUE (bitmap_bit_p (s, 128)); + + bitmap_clear (s); + bitmap_set_bit (s, 8); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 0, 8)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 0, 12)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 0, 63)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 0, 127)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 0, 512)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 8, 8)); + ASSERT_TRUE (bitmap_bit_p (s, 8)); + + bitmap_clear (s); + ASSERT_FALSE (bitmap_bit_in_range_p (s, 0, 0)); + ASSERT_FALSE (bitmap_bit_in_range_p (s, 0, 8)); + ASSERT_FALSE (bitmap_bit_in_range_p (s, 0, 63)); + ASSERT_FALSE (bitmap_bit_in_range_p (s, 1, 63)); + ASSERT_FALSE (bitmap_bit_in_range_p (s, 0, 256)); + + bitmap_set_bit (s, 0); + bitmap_set_bit (s, 16); + bitmap_set_bit (s, 32); + bitmap_set_bit (s, 48); + bitmap_set_bit (s, 64); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 0, 0)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 1, 16)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 48, 63)); + ASSERT_TRUE (bitmap_bit_in_range_p (s, 64, 64)); + ASSERT_FALSE (bitmap_bit_in_range_p (s, 1, 15)); + ASSERT_FALSE (bitmap_bit_in_range_p (s, 17, 31)); + ASSERT_FALSE (bitmap_bit_in_range_p (s, 49, 63)); + ASSERT_FALSE (bitmap_bit_in_range_p (s, 65, 1023)); +} + +/* Run all of the selftests within this file. */ + +void +sbitmap_c_tests () +{ + test_set_range (); + test_bit_in_range (); +} + +} // namespace selftest +#endif /* CHECKING_P */ diff --git a/gcc/sbitmap.h b/gcc/sbitmap.h index ff52e939bf36c..a5ff0685e435a 100644 --- a/gcc/sbitmap.h +++ b/gcc/sbitmap.h @@ -96,10 +96,29 @@ struct simple_bitmap_def /* Return the number of bits in BITMAP. */ #define SBITMAP_SIZE(BITMAP) ((BITMAP)->n_bits) +/* Verify that access at INDEX in bitmap MAP is valid. */ + +static inline void +bitmap_check_index (const_sbitmap map, int index) +{ + gcc_checking_assert (index >= 0); + gcc_checking_assert ((unsigned int)index < map->n_bits); +} + +/* Verify that bitmaps A and B have same size. */ + +static inline void +bitmap_check_sizes (const_sbitmap a, const_sbitmap b) +{ + gcc_checking_assert (a->n_bits == b->n_bits); +} + /* Test if bit number bitno in the bitmap is set. */ static inline SBITMAP_ELT_TYPE bitmap_bit_p (const_sbitmap map, int bitno) { + bitmap_check_index (map, bitno); + size_t i = bitno / SBITMAP_ELT_BITS; unsigned int s = bitno % SBITMAP_ELT_BITS; return (map->elms[i] >> s) & (SBITMAP_ELT_TYPE) 1; @@ -110,6 +129,8 @@ bitmap_bit_p (const_sbitmap map, int bitno) static inline void bitmap_set_bit (sbitmap map, int bitno) { + bitmap_check_index (map, bitno); + map->elms[bitno / SBITMAP_ELT_BITS] |= (SBITMAP_ELT_TYPE) 1 << (bitno) % SBITMAP_ELT_BITS; } @@ -119,6 +140,8 @@ bitmap_set_bit (sbitmap map, int bitno) static inline void bitmap_clear_bit (sbitmap map, int bitno) { + bitmap_check_index (map, bitno); + map->elms[bitno / SBITMAP_ELT_BITS] &= ~((SBITMAP_ELT_TYPE) 1 << (bitno) % SBITMAP_ELT_BITS); } @@ -148,6 +171,8 @@ static inline void bmp_iter_set_init (sbitmap_iterator *i, const_sbitmap bmp, unsigned int min, unsigned *bit_no ATTRIBUTE_UNUSED) { + bitmap_check_index (bmp, min); + i->word_num = min / (unsigned int) SBITMAP_ELT_BITS; i->bit_num = min; i->size = bmp->size; diff --git a/gcc/selftest-run-tests.c b/gcc/selftest-run-tests.c index 30e476d14c5da..11bf0cc9cb706 100644 --- a/gcc/selftest-run-tests.c +++ b/gcc/selftest-run-tests.c @@ -56,6 +56,7 @@ selftest::run_tests () /* Low-level data structures. */ bitmap_c_tests (); + sbitmap_c_tests (); et_forest_c_tests (); hash_map_tests_c_tests (); hash_set_tests_c_tests (); @@ -66,6 +67,7 @@ selftest::run_tests () sreal_c_tests (); fibonacci_heap_c_tests (); typed_splay_tree_c_tests (); + unique_ptr_tests_cc_tests (); /* Mid-level data structures. */ input_c_tests (); diff --git a/gcc/selftest.h b/gcc/selftest.h index 0572fefd28121..6478922cd2cce 100644 --- a/gcc/selftest.h +++ b/gcc/selftest.h @@ -171,6 +171,7 @@ extern const char *path_to_selftest_files; /* Declarations for specific families of tests (by source file), in alphabetical order. */ extern void bitmap_c_tests (); +extern void sbitmap_c_tests (); extern void diagnostic_c_tests (); extern void diagnostic_show_locus_c_tests (); extern void edit_context_c_tests (); @@ -194,6 +195,7 @@ extern void store_merging_c_tests (); extern void typed_splay_tree_c_tests (); extern void tree_c_tests (); extern void tree_cfg_c_tests (); +extern void unique_ptr_tests_cc_tests (); extern void vec_c_tests (); extern void wide_int_cc_tests (); extern void predict_c_tests (); diff --git a/gcc/sese.c b/gcc/sese.c index b3bf6114fc78b..89cddf0ec974b 100644 --- a/gcc/sese.c +++ b/gcc/sese.c @@ -156,12 +156,8 @@ new_sese_info (edge entry, edge exit) region->liveout = NULL; region->debug_liveout = NULL; region->params.create (3); - region->rename_map = new rename_map_t; - region->parameter_rename_map = new parameter_rename_map_t; - region->copied_bb_map = new bb_map_t; + region->rename_map = new hash_map ; region->bbs.create (3); - region->incomplete_phis.create (3); - return region; } @@ -175,24 +171,9 @@ free_sese_info (sese_info_p region) BITMAP_FREE (region->liveout); BITMAP_FREE (region->debug_liveout); - for (rename_map_t::iterator it = region->rename_map->begin (); - it != region->rename_map->end (); ++it) - (*it).second.release (); - - for (bb_map_t::iterator it = region->copied_bb_map->begin (); - it != region->copied_bb_map->end (); ++it) - (*it).second.release (); - delete region->rename_map; - delete region->parameter_rename_map; - delete region->copied_bb_map; - region->rename_map = NULL; - region->parameter_rename_map = NULL; - region->copied_bb_map = NULL; - region->bbs.release (); - region->incomplete_phis.release (); XDELETE (region); } @@ -444,14 +425,13 @@ scev_analyzable_p (tree def, sese_l ®ion) loop = loop_containing_stmt (SSA_NAME_DEF_STMT (def)); scev = scalar_evolution_in_region (region, loop, def); - return !chrec_contains_undetermined (scev) - && (TREE_CODE (scev) != SSA_NAME - || !defined_in_sese_p (scev, region)) - && (tree_does_not_contain_chrecs (scev) - || evolution_function_is_affine_p (scev)) - && (! loop - || ! loop_in_sese_p (loop, region) - || ! chrec_contains_symbols_defined_in_loop (scev, loop->num)); + return (!chrec_contains_undetermined (scev) + && (TREE_CODE (scev) != SSA_NAME + || !defined_in_sese_p (scev, region)) + && scev_is_linear_expression (scev) + && (! loop + || ! loop_in_sese_p (loop, region) + || ! chrec_contains_symbols_defined_in_loop (scev, loop->num))); } /* Returns the scalar evolution of T in REGION. Every variable that @@ -460,42 +440,16 @@ scev_analyzable_p (tree def, sese_l ®ion) tree scalar_evolution_in_region (const sese_l ®ion, loop_p loop, tree t) { - gimple *def; - struct loop *def_loop; - basic_block before = region.entry->src; - /* SCOP parameters. */ if (TREE_CODE (t) == SSA_NAME && !defined_in_sese_p (t, region)) return t; - if (TREE_CODE (t) != SSA_NAME - || loop_in_sese_p (loop, region)) - /* FIXME: we would need instantiate SCEV to work on a region, and be more - flexible wrt. memory loads that may be invariant in the region. */ - return instantiate_scev (before, loop, - analyze_scalar_evolution (loop, t)); - - def = SSA_NAME_DEF_STMT (t); - def_loop = loop_containing_stmt (def); - - if (loop_in_sese_p (def_loop, region)) - { - t = analyze_scalar_evolution (def_loop, t); - def_loop = superloop_at_depth (def_loop, loop_depth (loop) + 1); - t = compute_overall_effect_of_inner_loop (def_loop, t); - return t; - } - - bool has_vdefs = false; - if (invariant_in_sese_p_rec (t, region, &has_vdefs)) - return t; - - /* T variates in REGION. */ - if (has_vdefs) - return chrec_dont_know; + if (!loop_in_sese_p (loop, region)) + loop = NULL; - return instantiate_scev (before, loop, t); + return instantiate_scev (region.entry, loop, + analyze_scalar_evolution (loop, t)); } /* Return true if BB is empty, contains only DEBUG_INSNs. */ diff --git a/gcc/sese.h b/gcc/sese.h index 190deeda8afe7..cbc20ab10644a 100644 --- a/gcc/sese.h +++ b/gcc/sese.h @@ -22,14 +22,7 @@ along with GCC; see the file COPYING3. If not see #ifndef GCC_SESE_H #define GCC_SESE_H -typedef hash_map parameter_rename_map_t; -typedef hash_map > bb_map_t; -typedef hash_map > rename_map_t; typedef struct ifsese_s *ifsese; -/* First phi is the new codegenerated phi second one is original phi. */ -typedef std::pair phi_rename; -/* First edge is the init edge and second is the back edge w.r.t. a loop. */ -typedef std::pair init_back_edge_pair_t; /* A Single Entry, Single Exit region is a part of the CFG delimited by two edges. */ @@ -92,24 +85,12 @@ typedef struct sese_info_t /* Parameters used within the SCOP. */ vec params; - /* Maps an old name to one or more new names. When there are several new - names, one has to select the definition corresponding to the immediate - dominator. */ - rename_map_t *rename_map; - - /* Parameters to be renamed. */ - parameter_rename_map_t *parameter_rename_map; + /* Maps an old name to a new decl. */ + hash_map *rename_map; /* Basic blocks contained in this SESE. */ vec bbs; - /* Copied basic blocks indexed by the original bb. */ - bb_map_t *copied_bb_map; - - /* A vector of phi nodes to be updated when all arguments are available. The - pair contains first the old_phi and second the new_phi. */ - vec incomplete_phis; - /* The condition region generated for this sese. */ ifsese if_region; @@ -334,6 +315,8 @@ gbb_loop_at_index (gimple_poly_bb_p gbb, sese_l ®ion, int index) while (--depth > index) loop = loop_outer (loop); + gcc_assert (loop_in_sese_p (loop, region)); + return loop; } diff --git a/gcc/shrink-wrap.c b/gcc/shrink-wrap.c index 3cad7760f9c4e..1a2802fbcc199 100644 --- a/gcc/shrink-wrap.c +++ b/gcc/shrink-wrap.c @@ -561,7 +561,6 @@ handle_simple_exit (edge e) BB_END (old_bb) = end; redirect_edge_succ (e, new_bb); - new_bb->count = e->count; new_bb->frequency = EDGE_FREQUENCY (e); e->flags |= EDGE_FALLTHRU; diff --git a/gcc/simplify-rtx.c b/gcc/simplify-rtx.c index 3b6cf6fa85071..c4d6ce7586cef 100644 --- a/gcc/simplify-rtx.c +++ b/gcc/simplify-rtx.c @@ -1272,10 +1272,9 @@ simplify_unary_operation_1 (enum rtx_code code, machine_mode mode, rtx op) if ((GET_CODE (op) == FLOAT_TRUNCATE && flag_unsafe_math_optimizations) || GET_CODE (op) == FLOAT_EXTEND) - return simplify_gen_unary (GET_MODE_SIZE (GET_MODE (XEXP (op, - 0))) - > GET_MODE_SIZE (mode) - ? FLOAT_TRUNCATE : FLOAT_EXTEND, + return simplify_gen_unary (GET_MODE_UNIT_SIZE (GET_MODE (XEXP (op, 0))) + > GET_MODE_UNIT_SIZE (mode) + ? FLOAT_TRUNCATE : FLOAT_EXTEND, mode, XEXP (op, 0), mode); diff --git a/gcc/stmt.c b/gcc/stmt.c index 92bd209ad64f0..410ae61bd4ddf 100644 --- a/gcc/stmt.c +++ b/gcc/stmt.c @@ -941,7 +941,7 @@ expand_case (gswitch *stmt) original type. Make sure to drop overflow flags. */ low = fold_convert (index_type, low); if (TREE_OVERFLOW (low)) - low = wide_int_to_tree (index_type, low); + low = wide_int_to_tree (index_type, wi::to_wide (low)); /* The canonical from of a case label in GIMPLE is that a simple case has an empty CASE_HIGH. For the casesi and tablejump expanders, @@ -950,7 +950,7 @@ expand_case (gswitch *stmt) high = low; high = fold_convert (index_type, high); if (TREE_OVERFLOW (high)) - high = wide_int_to_tree (index_type, high); + high = wide_int_to_tree (index_type, wi::to_wide (high)); case_list.safe_push (simple_case_node (low, high, lab)); } diff --git a/gcc/stor-layout.c b/gcc/stor-layout.c index 938be6745af4a..02739b0ed7fd3 100644 --- a/gcc/stor-layout.c +++ b/gcc/stor-layout.c @@ -2362,9 +2362,11 @@ layout_type (tree type) && tree_int_cst_lt (ub, lb)) { lb = wide_int_to_tree (ssizetype, - offset_int::from (lb, SIGNED)); + offset_int::from (wi::to_wide (lb), + SIGNED)); ub = wide_int_to_tree (ssizetype, - offset_int::from (ub, SIGNED)); + offset_int::from (wi::to_wide (ub), + SIGNED)); } length = fold_convert (sizetype, diff --git a/gcc/substring-locations.c b/gcc/substring-locations.c index 433023d984529..095e5d073a717 100644 --- a/gcc/substring-locations.c +++ b/gcc/substring-locations.c @@ -63,7 +63,7 @@ along with GCC; see the file COPYING3. If not see printf(fmt, msg); ^~~ - For each of cases 1-3, if param_range is non-NULL, then it is used + For each of cases 1-3, if param_loc is not UNKNOWN_LOCATION, then it is used as a secondary range within the warning. For example, here it is used with case 1: @@ -100,7 +100,7 @@ along with GCC; see the file COPYING3. If not see ATTRIBUTE_GCC_DIAG (5,0) bool format_warning_va (const substring_loc &fmt_loc, - const source_range *param_range, + location_t param_loc, const char *corrected_substring, int opt, const char *gmsgid, va_list *ap) { @@ -136,13 +136,8 @@ format_warning_va (const substring_loc &fmt_loc, rich_location richloc (line_table, primary_loc); - if (param_range) - { - location_t param_loc = make_location (param_range->m_start, - param_range->m_start, - param_range->m_finish); - richloc.add_range (param_loc, false); - } + if (param_loc != UNKNOWN_LOCATION) + richloc.add_range (param_loc, false); if (!err && corrected_substring && substring_within_range) richloc.add_fixit_replace (fmt_substring_range, corrected_substring); @@ -171,13 +166,13 @@ format_warning_va (const substring_loc &fmt_loc, bool format_warning_at_substring (const substring_loc &fmt_loc, - const source_range *param_range, + location_t param_loc, const char *corrected_substring, int opt, const char *gmsgid, ...) { va_list ap; va_start (ap, gmsgid); - bool warned = format_warning_va (fmt_loc, param_range, corrected_substring, + bool warned = format_warning_va (fmt_loc, param_loc, corrected_substring, opt, gmsgid, &ap); va_end (ap); diff --git a/gcc/substring-locations.h b/gcc/substring-locations.h index a91cc6c8b4a88..3d7796db3e6c6 100644 --- a/gcc/substring-locations.h +++ b/gcc/substring-locations.h @@ -77,13 +77,13 @@ class substring_loc /* Functions for emitting a warning about a format string. */ extern bool format_warning_va (const substring_loc &fmt_loc, - const source_range *param_range, + location_t param_loc, const char *corrected_substring, int opt, const char *gmsgid, va_list *ap) ATTRIBUTE_GCC_DIAG (5,0); extern bool format_warning_at_substring (const substring_loc &fmt_loc, - const source_range *param_range, + location_t param_loc, const char *corrected_substring, int opt, const char *gmsgid, ...) ATTRIBUTE_GCC_DIAG (5,0); diff --git a/gcc/target-insns.def b/gcc/target-insns.def index 4669439c7e1d3..75976b2f8d99b 100644 --- a/gcc/target-insns.def +++ b/gcc/target-insns.def @@ -60,6 +60,7 @@ DEF_TARGET_INSN (jump, (rtx x0)) DEF_TARGET_INSN (load_multiple, (rtx x0, rtx x1, rtx x2)) DEF_TARGET_INSN (mem_thread_fence, (rtx x0)) DEF_TARGET_INSN (memory_barrier, (void)) +DEF_TARGET_INSN (memory_blockage, (void)) DEF_TARGET_INSN (movstr, (rtx x0, rtx x1, rtx x2)) DEF_TARGET_INSN (nonlocal_goto, (rtx x0, rtx x1, rtx x2, rtx x3)) DEF_TARGET_INSN (nonlocal_goto_receiver, (void)) diff --git a/gcc/target.def b/gcc/target.def index 80ef7469a503b..aac5d2711a838 100644 --- a/gcc/target.def +++ b/gcc/target.def @@ -3715,6 +3715,20 @@ registers on machines with lots of registers.", int, (rtx address, machine_mode mode, addr_space_t as, bool speed), default_address_cost) +/* Compute a cost for INSN. */ +DEFHOOK +(insn_cost, + "This target hook describes the relative costs of RTL instructions.\n\ +\n\ +In implementing this hook, you can use the construct\n\ +@code{COSTS_N_INSNS (@var{n})} to specify a cost equal to @var{n} fast\n\ +instructions.\n\ +\n\ +When optimizing for code size, i.e.@: when @code{speed} is\n\ +false, this target hook should be used to estimate the relative\n\ +size cost of an expression, again relative to @code{COSTS_N_INSNS}.", + int, (rtx_insn *insn, bool speed), NULL) + /* Give a cost, in RTX Costs units, for an edge. Like BRANCH_COST, but with well defined units. */ DEFHOOK diff --git a/gcc/target.h b/gcc/target.h index ac43b16a549cf..6260193333849 100644 --- a/gcc/target.h +++ b/gcc/target.h @@ -171,9 +171,11 @@ enum vect_cost_for_stmt scalar_store, vector_stmt, vector_load, + vector_gather_load, unaligned_load, unaligned_store, vector_store, + vector_scatter_store, vec_to_scalar, scalar_to_vec, cond_branch_not_taken, diff --git a/gcc/targhooks.c b/gcc/targhooks.c index d56f53d35d8ec..ae2595113f891 100644 --- a/gcc/targhooks.c +++ b/gcc/targhooks.c @@ -245,7 +245,7 @@ default_unwind_word_mode (void) unsigned HOST_WIDE_INT default_shift_truncation_mask (machine_mode mode) { - return SHIFT_COUNT_TRUNCATED ? GET_MODE_BITSIZE (mode) - 1 : 0; + return SHIFT_COUNT_TRUNCATED ? GET_MODE_UNIT_BITSIZE (mode) - 1 : 0; } /* The default implementation of TARGET_MIN_DIVISIONS_FOR_RECIP_MUL. */ @@ -2235,7 +2235,7 @@ default_excess_precision (enum excess_precision_type ATTRIBUTE_UNUSED) return FLT_EVAL_METHOD_PROMOTE_TO_FLOAT; } -HOST_WIDE_INT +bool default_stack_clash_protection_final_dynamic_probe (rtx residual ATTRIBUTE_UNUSED) { return 0; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 97825c3319c4d..9e0b48d23b8e8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,865 @@ +2017-10-20 Igor Tsimbalist + + * c-c++-common/fcf-protection-1.c: New test. + * c-c++-common/fcf-protection-2.c: Likewise. + * c-c++-common/fcf-protection-3.c: Likewise. + * c-c++-common/fcf-protection-4.c: Likewise. + * c-c++-common/fcf-protection-5.c: Likewise. + * c-c++-common/attr-nocf-check-1.c: Likewise. + * c-c++-common/attr-nocf-check-2.c: Likewise. + * c-c++-common/attr-nocf-check-3.c: Likewise. + +2017-10-20 Ed Schonberg + + * gnat.dg/sync_iface_call.adb, gnat.dg/sync_iface_call_pkg.ads, + gnat.dg/sync_iface_call_pkg2.adb, gnat.dg/sync_iface_call_pkg2.ads: + New testcase. + +2017-10-20 Justin Squirek + + * gnat.dg/default_pkg_actual.adb, gnat.dg/default_pkg_actual2.adb: New + testcases. + +2017-10-20 Ed Schonberg + + * gnat.dg/dimensions.adb, gnat.dg/dimensions.ads: New testcase. + +2017-10-20 Richard Biener + + PR tree-optimization/82473 + * gcc.dg/torture/pr82473.c: New testcase. + +2017-10-20 Richard Biener + + PR tree-optimization/82603 + * gcc.dg/torture/pr82603.c: New testcase. + +2017-10-20 Tom de Vries + + * gcc.dg/tree-ssa/ldist-27.c: Remove dg-require-stack-size. + (main): Move s ... + (s): ... here. + +2017-10-20 Jakub Jelinek + + PR target/82158 + * gcc.dg/tree-ssa/noreturn-1.c: New test. + + PR target/82370 + * gcc.target/i386/avx-pr82370.c: New test. + * gcc.target/i386/avx2-pr82370.c: New test. + * gcc.target/i386/avx512f-pr82370.c: New test. + * gcc.target/i386/avx512bw-pr82370.c: New test. + * gcc.target/i386/avx512vl-pr82370.c: New test. + * gcc.target/i386/avx512vlbw-pr82370.c: New test. + +2017-10-20 Orlando Arias + + * lib/target-supports.exp (check_effective_target_keeps_null_pointer_checks): + Add msp430 to the list. + +2017-10-19 Paolo Carlini + + PR c++/82308 + * g++.dg/cpp1z/class-deduction45.C: New. + +2017-10-19 Uros Bizjak + Jakub Jelinek + + PR target/82618 + * gcc.target/i386/pr82618.c: New test. + +2017-10-19 Martin Sebor + + PR tree-optimization/82596 + * gcc/testsuite/gcc.dg/pr82596.c: New test. + +2017-10-19 Eric Botcazou + + * gcc.dg/Walloca-15.c: New test. + * gnat.dg/stack_usage4.adb: Likewise. + * gnat.dg/stack_usage4_pkg.ads: New helper. + +2017-10-19 Jakub Jelinek + + PR c++/82600 + * g++.dg/warn/Wreturn-local-addr-4.C: New test. + +2017-10-19 Eric Botcazou + + * gcc.dg/debug/dwarf2/sso.c: Rename into... + * gcc.dg/debug/dwarf2/sso-1.c: ...this. + * gcc.dg/debug/dwarf2/sso-2.c: New test. + * gcc.dg/debug/dwarf2/sso-3.c: Likewise. + +2017-10-19 Richard Earnshaw + + PR target/82445 + * gcc.target/arm/peep-ldrd-1.c: Tighten test scan pattern. + * gcc.target/arm/peep-strd-1.c: Likewise. + * gcc.target/arm/peep-ldrd-2.c: New test. + * gcc.target/arm/peep-strd-2.c: New test. + +2017-10-19 Jakub Jelinek + + * c-c++-common/ubsan/builtin-1.c: New test. + + * c-c++-common/ubsan/float-cast-overflow-1.c: Drop value keyword + from expected output regexps. + * c-c++-common/ubsan/float-cast-overflow-2.c: Likewise. + * c-c++-common/ubsan/float-cast-overflow-3.c: Likewise. + * c-c++-common/ubsan/float-cast-overflow-4.c: Likewise. + * c-c++-common/ubsan/float-cast-overflow-5.c: Likewise. + * c-c++-common/ubsan/float-cast-overflow-6.c: Likewise. + * c-c++-common/ubsan/float-cast-overflow-8.c: Likewise. + * c-c++-common/ubsan/float-cast-overflow-9.c: Likewise. + * c-c++-common/ubsan/float-cast-overflow-10.c: Likewise. + * g++.dg/ubsan/float-cast-overflow-bf.C: Likewise. + * gcc.dg/ubsan/float-cast-overflow-bf.c: Likewise. + * g++.dg/asan/default-options-1.C (__asan_default_options): Add + used attribute. + * g++.dg/asan/asan_test.C: Run with ASAN_OPTIONS=handle_segv=2 + in the environment. + + PR target/82580 + * gcc.target/i386/pr82580.c: Use {\msbb} instead of "sbb" in + scan-assembler-times. Check that there are no movzb* instructions + if lp64. + +2017-10-19 Tom de Vries + + * gcc.dg/tree-ssa/ldist-27.c: Use dg-require-stack-size. + +2017-10-19 Tom de Vries + + * lib/target-supports-dg.exp (dg-require-stack-size): New proc. + * gcc.c-torture/execute/20030209-1.c: Use dg-require-stack-size. + * gcc.c-torture/execute/20040805-1.c: Same. + * gcc.c-torture/execute/920410-1.c: Same. + * gcc.c-torture/execute/921113-1.c: Same. + * gcc.c-torture/execute/921208-2.c: Same. + * gcc.c-torture/execute/comp-goto-1.c: Same. + * gcc.c-torture/execute/pr20621-1.c: Same. + * gcc.c-torture/execute/pr28982b.c: Same. + * gcc.dg/tree-prof/comp-goto-1.c: Same. + +2017-10-19 Martin Liska + + PR sanitizer/82517 + * gcc.dg/asan/pr82517.c: New test. + +2017-10-19 Jakub Jelinek + + PR fortran/82568 + * gfortran.dg/gomp/pr82568.f90: New test. + +2017-10-19 Bernhard Reutner-Fischer + + * gfortran.dg/spellcheck-operator.f90: New testcase. + * gfortran.dg/spellcheck-procedure_1.f90: New testcase. + * gfortran.dg/spellcheck-procedure_2.f90: New testcase. + * gfortran.dg/spellcheck-structure.f90: New testcase. + * gfortran.dg/spellcheck-parameter.f90: New testcase. + +2017-10-18 Thomas Koenig + + PR fortran/82567 + * gfortran.dg/array_constructor_51.f90: New test. + +2017-10-18 Thomas Koenig + + PR fortran/79795 + * gfortran.dg/assumed_size_2.f90: New test. + +2017-10-18 Uros Bizjak + Jakub Jelinek + + PR target/82580 + * gcc.target/i386/pr82580.c: New test. + +2017-10-18 Thomas Koenig + + PR libfortran/82233 + * gfortran.dg/execute_command_line_3.f90: Remove unneeded output. + Move test with wait=.false. before the last test. + +2017-10-18 Vladimir Makarov + + PR middle-end/82556 + * gcc.target/i386/pr82556.c: New. + +2017-10-18 Bin Cheng + + * gcc.dg/tree-ssa/ldist-17.c: Adjust test string. + * gcc.dg/tree-ssa/ldist-32.c: New test. + * gcc.dg/tree-ssa/ldist-35.c: New test. + * gcc.dg/tree-ssa/ldist-36.c: New test. + +2017-10-18 Bin Cheng + + PR tree-optimization/82574 + * gcc.dg/tree-ssa/pr82574.c: New test. + +2017-10-18 Martin Liska + + * gcc.dg/tree-prof/switch-case-2.c: Scan IPA profile dump + file instead of expand. Reason is that switch statement is + not yet expanded as decision tree, which also contains a BB + with count == 2000. + +017-10-18 Paul Thomas + + PR fortran/82550 + * gfortran.dg/submodule_30.f08 : New test. + +2017-10-18 Andreas Krebbel + + * gcc.target/s390/zvector/vec-cmp-2.c + (all_eq_double, all_ne_double, all_gt_double) + (all_lt_double, all_ge_double, all_le_double) + (any_eq_double, any_ne_double, any_gt_double) + (any_lt_double, any_ge_double, any_le_double) + (all_eq_int, all_ne_int, all_gt_int) + (all_lt_int, all_ge_int, all_le_int) + (any_eq_int, any_ne_int, any_gt_int) + (any_lt_int, any_ge_int, any_le_int): Set global variable instead + of calling foo(). Fix return type. + +2017-10-18 Martin Liska + + PR sanitizer/82545 + * gcc.dg/asan/pr82545.c: New test. + +2017-10-18 Paolo Carlini + + PR c++/69057 + * g++.dg/cpp1y/auto-fn45.C: New. + +2017-10-18 Paolo Carlini + + PR c++/68884 + * g++.dg/cpp0x/variadic-crash4.C: New. + +2017-10-18 Paolo Carlini + + PR c++/79474 + * g++.dg/cpp1y/auto-fn44.C: New. + +2017-10-17 Eric Botcazou + + * gcc.dg/attr-alloc_size-11.c: UnXFAIL for visium-*-*. + +2017-10-17 Paolo Carlini + + PR c++/71821 + * g++.dg/cpp0x/alignas12.C: New. + +2017-10-17 Paolo Carlini + + PR c++/71368 + * g++.dg/concepts/pr71368.C: New. + +2017-10-17 Nathan Sidwell + + PR c++/82560 + * g++.dg/cpp0x/pr82560.C: New. + + PR middle-end/82577 + * g++.dg/opt/pr82577.C: New. + +2017-10-17 Qing Zhao + Wilco Dijkstra + + PR middle-end/80295 + * gcc.target/aarch64/pr80295.c: New test. + +2017-10-17 Richard Biener + + PR tree-optimization/82563 + * gcc.dg/graphite/pr82563.c: New testcase. + +2017-10-17 Paolo Carlini + + PR c++/67831 + * g++.dg/cpp0x/constexpr-ice18.C: New. + +2017-10-17 Paolo Carlini + + PR c++/82570 + * g++.dg/cpp1z/constexpr-lambda18.C: New. + +2017-10-17 Jakub Jelinek + + PR tree-optimization/82549 + * gcc.c-torture/compile/pr82549.c: New test. + +2017-10-17 Martin Liska + + * lib/scanasm.exp: Print how many times a regex pattern is + found. + * lib/scandump.exp: Likewise. + +2017-10-17 Olga Makhotina + + * gcc.target/i386/avx512dq-vreducesd-1.c (_mm_mask_reduce_sd, + _mm_maskz_reduce_sd): Test new intrinsics. + * gcc.target/i386/avx512dq-vreducesd-2.c: New. + * gcc.target/i386/avx512dq-vreducess-1.c (_mm_mask_reduce_ss, + _mm_maskz_reduce_ss): Test new intrinsics. + * gcc.target/i386/avx512dq-vreducess-2.c: New. + * gcc.target/i386/avx-1.c (__builtin_ia32_reducesd, + __builtin_ia32_reducess): Remove builtin. + (__builtin_ia32_reducesd_mask, + __builtin_ia32_reducess_mask): Test new builtin. + * gcc.target/i386/sse-13.c: Ditto. + * gcc.target/i386/sse-23.c: Ditto. + +2017-10-16 Martin Liska + + * c-c++-common/ubsan/attrib-5.c (float_cast2): Fix warning scan + so that it will work for both C and C++ FEs. + +2017-10-16 Fritz Reese + + PR fortran/82511 + * gfortran.dg/dec_structure_22.f90: New testcase. + +2017-10-16 Paolo Carlini + + PR c++/64931 + * g++.dg/cpp1y/auto-fn43.C: New. + +2017-10-16 Wilco Dijkstra + + PR target/82442 + * gcc.dg/vect/pr31699.c: Fix testcase. + +2017-10-16 Tamar Christina + + * gcc.target/aarch64/advsimd-intrinsics/vect-dot-qi.h: New. + * gcc.target/aarch64/advsimd-intrinsics/vdot-compile.c: New. + * gcc.target/aarch64/advsimd-intrinsics/vect-dot-s8.c: New. + * gcc.target/aarch64/advsimd-intrinsics/vect-dot-u8.c: New. + +2017-10-16 Jakub Jelinek + + PR c++/53574 + * g++.dg/other/pr53574.C: New test. + +2017-10-16 Paolo Carlini + + PR c++/61323 + * g++.dg/cpp0x/constexpr-61323.C: New. + +2017-10-15 Paolo Carlini + + PR c++/54090 + * g++.dg/template/crash128.C: New. + +2017-10-15 Thomas Koenig + + PR fortran/82372 + * gfortran.dg/illegal_char.f90: New test. + +2017-10-14 Kyrylo Tkachov + Michael Collison + + * gcc.target/aarch64/cmpelim_mult_uses_1.c: New test. + +2017-10-14 Paolo Carlini + + PR c++/80908 + * g++.dg/cpp1z/noexcept-type18.C: New. + +2017-10-14 Paolo Carlini + + PR c++/81016 + * g++.dg/cpp1z/pr81016.C: New. + +2017-10-14 Jakub Jelinek + + PR middle-end/62263 + PR middle-end/82498 + * c-c++-common/rotate-8.c: Expect no PHIs in optimized dump. + + PR middle-end/62263 + PR middle-end/82498 + * c-c++-common/rotate-5.c (f2): New function. Move old + function to ... + (f4): ... this. Use 127 instead of 128. + (f3, f5, f6): New functions. + (main): Test all f[1-6] functions, with both 0 and 1 as + second arguments. + * c-c++-common/rotate-6.c: New test. + * c-c++-common/rotate-6a.c: New test. + * c-c++-common/rotate-7.c: New test. + * c-c++-common/rotate-7a.c: New test. + * c-c++-common/rotate-8.c: New test. + +2017-10-14 Hristian Kirtchev + + * gnat.dg/remote_call_iface.ads, gnat.dg/remote_call_iface.adb: New + testcase. + +2017-10-14 Jakub Jelinek + + PR rtl-optimization/81423 + * gcc.c-torture/execute/pr81423.c (foo): Add missing cast. Change L + suffixes to LL. + (main): Punt if either long long isn't 64-bit or int isn't 32-bit. + +2017-10-13 Jakub Jelinek + + PR sanitizer/82353 + * g++.dg/ubsan/pr82353-2.C: New test. + * g++.dg/ubsan/pr82353-2-aux.cc: New file. + * g++.dg/ubsan/pr82353-2.h: New file. + +2017-10-13 Paul Thomas + + PR fortran/81048 + * gfortran.dg/derived_init_4.f90 : New test. + +2017-10-13 Paolo Carlini + + PR c++/69078 + * g++.dg/cpp1y/lambda-generic-69078-1.C: New. + * g++.dg/cpp1y/lambda-generic-69078-2.C: Likewise. + +2017-10-13 Jakub Jelinek + + PR target/82274 + * gcc.dg/pr82274-1.c: New test. + * gcc.dg/pr82274-2.c: New test. + +2017-10-13 Paolo Carlini + + PR c++/80873 + * g++.dg/cpp1y/auto-fn41.C: New. + * g++.dg/cpp1y/auto-fn42.C: Likewise. + +2017-10-13 David Malcolm + + * g++.dg/cpp0x/udlit-extern-c.C: New test case. + * g++.dg/diagnostic/unclosed-extern-c.C: Add example of a template + erroneously covered by an unclosed extern "C". + * g++.dg/template/extern-c.C: New test case. + +2017-10-13 Richard Biener + + * gcc.dg/graphite/pr35356-3.c: XFAIL again. + * gcc.dg/graphite/pr81373-2.c: Copy from gcc.dg/graphite/pr81373.c + with alternate flags. + +2017-10-13 Richard Biener + + * gcc.dg/graphite/scop-10.c: Enlarge array to avoid undefined + behavior. + * gcc.dg/graphite/scop-7.c: Likewise. + * gcc.dg/graphite/scop-8.c: Likewise. + +2017-10-13 H.J. Lu + + PR target/82499 + * gcc.target/i386/pr82499-1.c: New file. + * gcc.target/i386/pr82499-2.c: Likewise. + * gcc.target/i386/pr82499-3.c: Likewise. + +2017-10-13 Jakub Jelinek + + PR target/82524 + * gcc.c-torture/execute/pr82524.c: New test. + + PR target/82498 + * gcc.dg/tree-ssa/pr82498.c: New test. + + PR target/82498 + * gcc.dg/ubsan/pr82498.c: New test. + +2017-10-13 Richard Biener + + PR tree-optimization/82451 + * gcc.dg/graphite/pr82451.c: New testcase. + * gfortran.dg/graphite/id-27.f90: Likewise. + * gfortran.dg/graphite/pr82451.f: Likewise. + +2017-10-13 Richard Biener + + PR tree-optimization/82525 + * gcc.dg/graphite/id-30.c: New testcase. + * gfortran.dg/graphite/id-28.f90: Likewise. + +2017-10-13 Alan Modra + + * gcc.target/i386/asm-mem.c: New test. + +2017-10-12 Jakub Jelinek + + PR target/82498 + * gcc.target/i386/pr82498-1.c: New test. + * gcc.target/i386/pr82498-2.c: New test. + +2017-10-12 Jan Hubicka + + * gcc.dg/predict-13.c: Update template for probaility change. + * gcc.dg/predict-8.c: Likewise. + +2017-10-12 David Malcolm + + * c-c++-common/cilk-plus/AN/parser_errors.c: Update expected + output to reflect changes to reported locations of missing + symbols. + * c-c++-common/cilk-plus/AN/parser_errors2.c: Likewise. + * c-c++-common/cilk-plus/AN/parser_errors3.c: Likewise. + * c-c++-common/cilk-plus/AN/pr61191.c: Likewise. + * c-c++-common/gomp/pr63326.c: Likewise. + * c-c++-common/missing-close-symbol.c: Likewise, also update for + new fix-it hints. + * c-c++-common/missing-symbol.c: Likewise, also add test coverage + for missing colon in ternary operator. + * g++.dg/cpp1y/digit-sep-neg.C: Likewise. + * g++.dg/cpp1y/pr65202.C: Likewise. + * g++.dg/missing-symbol-2.C: New test case. + * g++.dg/other/do1.C: Update expected output to reflect + changes to reported locations of missing symbols. + * g++.dg/parse/error11.C: Likewise. + * g++.dg/template/error11.C: Likewise. + * gcc.dg/missing-symbol-2.c: New test case. + * gcc.dg/missing-symbol-3.c: New test case. + * gcc.dg/noncompile/940112-1.c: Update expected output to reflect + changes to reported locations of missing symbols. + * gcc.dg/noncompile/971104-1.c: Likewise. + * obj-c++.dg/exceptions-6.mm: Likewise. + * obj-c++.dg/pr48187.mm: Likewise. + * objc.dg/exceptions-6.m: Likewise. + +2017-10-12 Martin Sebor + + PR other/82301 + PR c/82435 + * g++.dg/ext/attr-ifunc-1.C: Update. + * g++.dg/ext/attr-ifunc-2.C: Same. + * g++.dg/ext/attr-ifunc-3.C: Same. + * g++.dg/ext/attr-ifunc-4.C: Same. + * g++.dg/ext/attr-ifunc-5.C: Same. + * g++.dg/ext/attr-ifunc-6.C: New test. + * g++.old-deja/g++.abi/vtable2.C: Update. + * gcc.dg/attr-ifunc-6.c: New test. + * gcc.dg/attr-ifunc-7.c: New test. + * gcc.dg/pr81854.c: Update. + * lib/target-supports.exp: Update. + +2017-10-12 David Malcolm + + * g++.dg/parse/pragma2.C: Update to reflect reinstatement of the + "#pragma is not allowed here" error. + +2017-10-12 Bin Cheng + + * gcc.dg/tree-ssa/ldist-28.c: New test. + * gcc.dg/tree-ssa/ldist-29.c: New test. + * gcc.dg/tree-ssa/ldist-30.c: New test. + * gcc.dg/tree-ssa/ldist-31.c: New test. + +2017-10-12 Bin Cheng + + * gcc.dg/tree-ssa/ldist-7.c: Adjust test string. + * gcc.dg/tree-ssa/ldist-16.c: Ditto. + * gcc.dg/tree-ssa/ldist-25.c: Ditto. + * gcc.dg/tree-ssa/ldist-33.c: New test. + +2017-10-12 Richard Biener + + PR tree-optimization/69728 + * gcc.dg/graphite/pr69728.c: Adjust to reflect we can handle + the loop now. Remove unrelated undefined behavior. + +2017-10-12 Jakub Jelinek + + PR c++/82159 + * g++.dg/opt/pr82159-2.C: New test. + + PR target/82353 + * gcc.target/i386/i386.exp (tests): Revert the '.C' extension change. + * gcc.target/i386/pr82353.C: Moved to ... + * g++.dg/ubsan/pr82353.C: ... here. Restrict to i?86/x86_64 && lp64. + +2017-10-11 Uros Bizjak + + * gcc.target/i386/387-ficom-2.c: New test. + +2017-10-11 Jakub Jelinek + + PR middle-end/80421 + * gcc.c-torture/execute/pr80421.c: New test. + + PR tree-optimization/78558 + * gcc.dg/vect/pr78558.c: New test. + + PR c++/82414 + * g++.dg/lto/pr82414_0.C: New test. + + PR c++/78523 + * g++.dg/cpp1y/pr78523.C: New test. + + PR c++/80194 + * g++.dg/cpp1y/pr80194.C: New test. + +2017-10-11 Qing Zhao + + PR target/81422 + * gcc.target/aarch64/pr81422.C: New test. + +2017-10-11 Vladimir Makarov + + PR sanitizer/82353 + * gcc.target/i386/i386.exp (tests): Permit '.C' extension. + * gcc.target/i386/pr82353.C: New. + +2017-10-11 Uros Bizjak + + * gcc.target/i386/387-ficom-1.c: New test. + +2017-10-11 Jeff Law + + * gcc.dg/struct-layout-1_generate.c (generate_fields): Fix typo in + address computation of end of complex_attrib_array_types. + +2017-10-11 Marc Glisse + + * gcc.dg/Wstrict-overflow-7.c: Xfail. + * gcc.dg/pragma-diag-3.c: Likewise. + +2017-10-11 Bin Cheng + + PR tree-optimization/82472 + * gcc.dg/tree-ssa/pr82472.c: New test. + +2017-10-11 Martin Liska + + PR sanitizer/82490 + * c-c++-common/ubsan/attrib-5.c: New test. + +2017-10-11 Martin Liska + + Revert r253637: + + PR sanitizer/82484 + * gcc.dg/asan/pr82484.c: New test. + +2017-10-11 Martin Liska + + PR sanitizer/82484 + * gcc.dg/asan/pr82484.c: New test. + +2017-10-11 Martin Liska + + * c-c++-common/ubsan/ptr-overflow-sanitization-1.c: Scan + optimized dump rather than assembly. + +2017-10-11 Nathan Sidwell + + * g++.dg/cpp/string-3.C: Fix dg-final. + +2017-10-11 Paolo Carlini + + PR c++/80412 + * g++.dg/cpp1z/class-deduction44.C: New. + +2017-10-11 Paolo Carlini + + PR c++/82230 + * g++.dg/cpp1y/lambda-generic-ice8.C: New. + +2017-10-11 Paolo Carlini + + PR c++/81299 + * g++.dg/cpp1y/lambda-generic-ice7.C: New. + +2017-10-10 Nathan Sidwell + + * g++.dg/lookup/extern-c-redecl6.C: New. + * g++.dg/lookup/extern-c-hidden.C: Adjust diagnostics. + * g++.dg/lookup/extern-c-redecl.C: Likewise. + * g++.old-deja/g++.other/using9.C: Likewise. + +2017-10-10 Paolo Carlini + + PR c++/78006 + * g++.dg/cpp1y/auto-fn40.C: New. + +2017-10-10 Paolo Carlini + + PR c++/81032 + * g++.dg/cpp1y/lambda-generic-ice6.C: New. + +2017-10-10 Jakub Jelinek + + PR rtl-optimization/68205 + * gcc.c-torture/execute/20040709-3.c: New test. + + PR c++/67625 + * g++.dg/cpp0x/pr67625.C: New test. + + PR middle-end/70887 + * g++.dg/cpp0x/pr70887.C: New test. + + PR c++/70338 + * g++.dg/cpp0x/pr70338.C: New test. + + PR c++/77786 + * g++.dg/cpp1y/pr77786.C: New test. + + PR c++/71875 + * g++.dg/cpp1y/pr71875.C: New test. + + PR c++/77578 + * g++.dg/gomp/pr77578.C: New test. + + PR middle-end/70100 + * g++.dg/opt/pr70100.C: New test. + + PR c++/68252 + * g++.dg/other/pr68252.C: New test. + + PR target/79565 + PR target/82483 + * gcc.target/i386/pr82483-1.c: New test. + * gcc.target/i386/pr82483-2.c: New test. + +2017-10-10 Will Schmidt + + * gcc.target/powerpc/fold-vec-mult-int128-p8.c: Update options + * gcc.target/powerpc/fold-vec-mult-int128-p9.c: Update expected + instruction list. + +2017-10-10 Nathan Sidwell + + PR preprocessor/82506 + * g++.dg/cpp/string-3.C: New. + +2017-10-10 Will Schmidt + + * gcc.target/powerpc/fold-vec-splat-16.c: New + * gcc.target/powerpc/fold-vec-splat-32.c: New. + * gcc.target/powerpc/fold-vec-splat-8.c: New. + +2017-10-10 Thomas Koenig + + PR libfortran/82233 + * gfortran.dg/execute_command_line_3.f90: New test. + +2017-10-10 Will Schmidt + + * gcc.target/powerpc/fold-vec-splat-16.c: New + * gcc.target/powerpc/fold-vec-splat-32.c: New. + * gcc.target/powerpc/fold-vec-splat-8.c: New. + +2017-10-10 Will Schmidt + + * gcc.target/powerpc/fold-vec-splats-char.c: New. + * gcc.target/powerpc/fold-vec-splats-floatdouble.c: New. + * gcc.target/powerpc/fold-vec-splats-int.c: New. + * gcc.target/powerpc/fold-vec-splats-longlong.c: New. + * gcc.target/powerpc/fold-vec-splats-short.c: New. + +2017-10-10 Jakub Jelinek + + PR c/82437 + * c-c++-common/Wtautological-compare-7.c: New test. + +2017-10-10 Bin Cheng + + * gcc.dg/tree-ssa/ldist-34.c: New test. + +2017-10-10 Bin Cheng + + * gcc.dg/tree-ssa/ldist-27.c: New test. + +2017-10-09 Ed Schonberg + + * gnat.dg/class_wide4.adb, gnat.dg/class_wide4_pkg.ads, + gnat.dg/class_wide4_pkg2.ads: New testcase. + +2017-10-09 Ed Schonberg + + * gnat.dg/class_wide3.adb, gnat.dg/class_wide3_pkg.ads: New testcase. + +2017-10-09 Ed Schonberg + + * gnat.dg/validity_check2.adb, gnat.dg/validity_check2_pkg.ads: + New testcase. + +2017-10-09 Michael Meissner + + * gcc.target/powerpc/amo1.c: New test. + * gcc.target/powerpc/amo2.c: Likewise. + +2017-10-09 Richard Biener + + PR tree-optimization/82449 + * gfortran.dg/graphite/pr82449.f: New testcase. + +2017-10-09 Andreas Krebbel + + PR target/82463 + * gcc.target/s390/zvector/pr82463.c: New test. + +2017-10-09 Andreas Krebbel + + PR target/82465 + * gcc.target/s390/zvector/pr82465.c: New test. + +2017-10-09 Wilco Dijkstra + + * gcc.dg/tree-ssa/ssa-dse-26.c (dg-options): Add -fno-short-enums. + +2017-10-09 Tom de Vries + + * gcc.dg/cold-1.c (foo1): Fix warning line number. Make warning line + number relative. + (abort): Declare. + +2017-10-08 Eric Botcazou + + * gcc.c-torture/execute/20171008-1.c: New test. + +2017-10-03 Jeff Law + + * gcc.dg/stack-check-5.c: Skip with -fstack-protector. + * gcc.dg/stack-check-6.c: Likewise. + * gcc.dg/stack-check-6a.c: Likewise. + +2017-10-07 Michael Collison + + * gcc.target/aarch64/var_shift_mask_2.c: New test. + +2017-10-07 Paul Thomas + + PR fortran/82375 + * gfortran.dg/pdt_13.f03 : New test. + * gfortran.dg/pdt_14.f03 : New test. + * gfortran.dg/pdt_15.f03 : New test. + +2017-10-07 Jan Hubicka + + * gcc.dg/cold-1.c: New testcase. + +2017-10-07 Paolo Carlini + + PR c++/80805 + * g++.dg/cpp0x/pr80805.C: New. + +2017-10-07 Thomas Koenig + + PR fortran/49232 + * gfortran.dg/contiguous_4.f90: New test. + +2017-10-06 Paolo Carlini + + PR c++/66690 + * g++.dg/cpp1y/pr66690.C: New. + 2017-10-06 Nathan Sidwell PR c++/82424 @@ -812,7 +1674,7 @@ 2017-09-22 Sergey Shalnov - * gcc.target/i386/avx512f-constant-set.c: New test. + * gcc.target/i386/avx512f-constant-set.c: New test. 2017-09-21 Sergey Shalnov @@ -2381,7 +3243,7 @@ 2017-08-23 Richard Biener - PR target/81921 + PR target/81921 * gcc.target/i386/pr81921.c: New testcase. 2017-08-23 Daniel Santos @@ -2462,8 +3324,8 @@ 2017-08-22 Yvan Roux - PR c++/80287 - * g++.dg/pr80287.C: New test. + PR c++/80287 + * g++.dg/pr80287.C: New test. 2017-08-22 Richard Biener diff --git a/gcc/testsuite/c-c++-common/Wtautological-compare-7.c b/gcc/testsuite/c-c++-common/Wtautological-compare-7.c new file mode 100644 index 0000000000000..1dab5877f3b9a --- /dev/null +++ b/gcc/testsuite/c-c++-common/Wtautological-compare-7.c @@ -0,0 +1,11 @@ +/* PR c/82437 */ +/* { dg-do compile { target int32 } } */ +/* { dg-options "-Wtautological-compare" } */ + +int +foo (unsigned long long int x) +{ + if ((x | 0x190000000ULL) != -1879048192) /* { dg-bogus "bitwise comparison always evaluates to" } */ + return 0; + return 1; +} diff --git a/gcc/testsuite/c-c++-common/attr-nocf-check-1.c b/gcc/testsuite/c-c++-common/attr-nocf-check-1.c new file mode 100644 index 0000000000000..62fa370b22e86 --- /dev/null +++ b/gcc/testsuite/c-c++-common/attr-nocf-check-1.c @@ -0,0 +1,30 @@ +/* { dg-do compile } */ + +int func (int) __attribute__ ((nocf_check)); /* { dg-warning "'nocf_check' attribute ignored. Use -fcf-protection option to enable it" } */ +int (*fptr) (int) __attribute__ ((nocf_check)); /* { dg-warning "'nocf_check' attribute ignored. Use -fcf-protection option to enable it" } */ +typedef void (*nocf_check_t) (void) __attribute__ ((nocf_check)); /* { dg-warning "'nocf_check' attribute ignored. Use -fcf-protection option to enable it" } */ + +int +foo1 (int arg) +{ + return func (arg) + fptr (arg); +} + +void +foo2 (void (*foo) (void)) +{ + void (*func) (void) __attribute__((nocf_check)) = foo; /* { dg-warning "'nocf_check' attribute ignored. Use -fcf-protection option to enable it" } */ + func (); +} + +void +foo3 (nocf_check_t foo) +{ + foo (); +} + +void +foo4 (void (*foo) (void) __attribute__((nocf_check))) /* { dg-warning "'nocf_check' attribute ignored. Use -fcf-protection option to enable it" } */ +{ + foo (); +} diff --git a/gcc/testsuite/c-c++-common/attr-nocf-check-2.c b/gcc/testsuite/c-c++-common/attr-nocf-check-2.c new file mode 100644 index 0000000000000..9ab01804782a3 --- /dev/null +++ b/gcc/testsuite/c-c++-common/attr-nocf-check-2.c @@ -0,0 +1,5 @@ +/* { dg-do compile } */ + +int var1 __attribute__((nocf_check)); /* { dg-warning "'nocf_check' attribute only applies to function types" } */ +int *var2 __attribute__((nocf_check)); /* { dg-warning "'nocf_check' attribute only applies to function types" } */ +void (**var3) (void) __attribute__((nocf_check)); /* { dg-warning "'nocf_check' attribute only applies to function types" } */ diff --git a/gcc/testsuite/c-c++-common/attr-nocf-check-3.c b/gcc/testsuite/c-c++-common/attr-nocf-check-3.c new file mode 100644 index 0000000000000..c7d9c8f401f05 --- /dev/null +++ b/gcc/testsuite/c-c++-common/attr-nocf-check-3.c @@ -0,0 +1,29 @@ +/* { dg-do compile } */ + +int foo (void) __attribute__ ((nocf_check)); /* { dg-warning "'nocf_check' attribute ignored. Use -fcf-protection option to enable it" } */ +void (*foo1) (void) __attribute__((nocf_check)); /* { dg-warning "'nocf_check' attribute ignored. Use -fcf-protection option to enable it" } */ +void (*foo2) (void); + +int +foo (void) /* The function's address is not tracked. */ +{ + /* This call site is not tracked for + control-flow instrumentation. */ + (*foo1)(); + + foo1 = foo2; + /* This call site is still not tracked for + control-flow instrumentation. */ + (*foo1)(); + + /* This call site is tracked for + control-flow instrumentation. */ + (*foo2)(); + + foo2 = foo1; + /* This call site is still tracked for + control-flow instrumentation. */ + (*foo2)(); + + return 0; +} diff --git a/gcc/testsuite/c-c++-common/cilk-plus/AN/parser_errors.c b/gcc/testsuite/c-c++-common/cilk-plus/AN/parser_errors.c index 18816e0ec6f81..fd4fe5419b641 100644 --- a/gcc/testsuite/c-c++-common/cilk-plus/AN/parser_errors.c +++ b/gcc/testsuite/c-c++-common/cilk-plus/AN/parser_errors.c @@ -7,5 +7,5 @@ int main (void) array2[:] = array2[: ; /* { dg-error "expected ']'" } */ - return 0; -} /* { dg-error "expected ';' before" "" { target c } } */ + return 0; /* { dg-error "expected ';' before" "" { target c } } */ +} diff --git a/gcc/testsuite/c-c++-common/cilk-plus/AN/parser_errors2.c b/gcc/testsuite/c-c++-common/cilk-plus/AN/parser_errors2.c index 2bb91343a79fd..d003d7cc2bb3e 100644 --- a/gcc/testsuite/c-c++-common/cilk-plus/AN/parser_errors2.c +++ b/gcc/testsuite/c-c++-common/cilk-plus/AN/parser_errors2.c @@ -7,6 +7,7 @@ int main (void) array2[:] = array2[1:2:] ; /* { dg-error "expected expression before" "" { target c } } */ /* { dg-error "expected primary-expression before" "" { target c++ } .-1 } */ + /* { dg-error "expected ';' before" "" { target c } .-2 } */ - return 0; /* { dg-error "expected ';' before" "" { target c } } */ + return 0; } diff --git a/gcc/testsuite/c-c++-common/cilk-plus/AN/parser_errors3.c b/gcc/testsuite/c-c++-common/cilk-plus/AN/parser_errors3.c index 9270007050e6a..14256e9579ee7 100644 --- a/gcc/testsuite/c-c++-common/cilk-plus/AN/parser_errors3.c +++ b/gcc/testsuite/c-c++-common/cilk-plus/AN/parser_errors3.c @@ -7,6 +7,7 @@ int main (void) array2[:] = array2[1: :] ; /* { dg-error "expected expression before" "" { target c } } */ /* { dg-error "expected primary-expression before" "" { target c++ } .-1 } */ + /* { dg-error "expected ';' before" "" { target c } .-2 } */ - return 0; /* { dg-error "expected ';' before" "" { target c } } */ + return 0; } diff --git a/gcc/testsuite/c-c++-common/cilk-plus/AN/pr61191.c b/gcc/testsuite/c-c++-common/cilk-plus/AN/pr61191.c index a9a9d6601bcf4..8c32ad9a267af 100644 --- a/gcc/testsuite/c-c++-common/cilk-plus/AN/pr61191.c +++ b/gcc/testsuite/c-c++-common/cilk-plus/AN/pr61191.c @@ -7,4 +7,5 @@ double f(double * A, double * B) return __sec_reduce_add((B[0:500])(; /* { dg-error "called object" "" { target c } } */ /* { dg-error "expected expression before ';' token" "" { target c } .-1 } */ /* { dg-error "expected primary-expression before ';' token" "" { target c++ } .-2 } */ -} /* { dg-error "expected" "" { target c } } */ +/* { dg-error "expected" "" { target c } .-3 } */ +} diff --git a/gcc/testsuite/c-c++-common/fcf-protection-1.c b/gcc/testsuite/c-c++-common/fcf-protection-1.c new file mode 100644 index 0000000000000..6a27e1973d89d --- /dev/null +++ b/gcc/testsuite/c-c++-common/fcf-protection-1.c @@ -0,0 +1,4 @@ +/* { dg-do compile } */ +/* { dg-options "-fcf-protection=full" } */ +/* { dg-error "'-fcf-protection=full' is not supported for this target" "" { target { "i?86-*-* x86_64-*-*" } } 0 } */ +/* { dg-error "'-fcf-protection=full' is not supported for this target" "" { target { ! "i?86-*-* x86_64-*-*" } } 0 } */ diff --git a/gcc/testsuite/c-c++-common/fcf-protection-2.c b/gcc/testsuite/c-c++-common/fcf-protection-2.c new file mode 100644 index 0000000000000..558f4c0a58027 --- /dev/null +++ b/gcc/testsuite/c-c++-common/fcf-protection-2.c @@ -0,0 +1,4 @@ +/* { dg-do compile } */ +/* { dg-options "-fcf-protection=branch" } */ +/* { dg-error "'-fcf-protection=branch' is not supported for this target" "" { target { "i?86-*-* x86_64-*-*" } } 0 } */ +/* { dg-error "'-fcf-protection=branch' is not supported for this target" "" { target { ! "i?86-*-* x86_64-*-*" } } 0 } */ diff --git a/gcc/testsuite/c-c++-common/fcf-protection-3.c b/gcc/testsuite/c-c++-common/fcf-protection-3.c new file mode 100644 index 0000000000000..ffc73469ad927 --- /dev/null +++ b/gcc/testsuite/c-c++-common/fcf-protection-3.c @@ -0,0 +1,4 @@ +/* { dg-do compile } */ +/* { dg-options "-fcf-protection=return" } */ +/* { dg-error "'-fcf-protection=return' is not supported for this target" "" { target { "i?86-*-* x86_64-*-*" } } 0 } */ +/* { dg-error "'-fcf-protection=return' is not supported for this target" "" { target { ! "i?86-*-* x86_64-*-*" } } 0 } */ diff --git a/gcc/testsuite/c-c++-common/fcf-protection-4.c b/gcc/testsuite/c-c++-common/fcf-protection-4.c new file mode 100644 index 0000000000000..af4fc0b281261 --- /dev/null +++ b/gcc/testsuite/c-c++-common/fcf-protection-4.c @@ -0,0 +1,2 @@ +/* { dg-do compile } */ +/* { dg-options "-fcf-protection=none" } */ diff --git a/gcc/testsuite/c-c++-common/fcf-protection-5.c b/gcc/testsuite/c-c++-common/fcf-protection-5.c new file mode 100644 index 0000000000000..2ea2ce0d82554 --- /dev/null +++ b/gcc/testsuite/c-c++-common/fcf-protection-5.c @@ -0,0 +1,4 @@ +/* { dg-do compile } */ +/* { dg-options "-fcf-protection" } */ +/* { dg-error "'-fcf-protection=full' is not supported for this target" "" { target { "i?86-*-* x86_64-*-*" } } 0 } */ +/* { dg-error "'-fcf-protection=full' is not supported for this target" "" { target { ! "i?86-*-* x86_64-*-*" } } 0 } */ diff --git a/gcc/testsuite/c-c++-common/gomp/pr63326.c b/gcc/testsuite/c-c++-common/gomp/pr63326.c index e319f49701117..3e627237c4317 100644 --- a/gcc/testsuite/c-c++-common/gomp/pr63326.c +++ b/gcc/testsuite/c-c++-common/gomp/pr63326.c @@ -156,34 +156,34 @@ f4 (int x) { do #pragma omp barrier /* { dg-error "may only be used in compound statements" } */ - while (0); + while (0); /* { dg-error "before" "" { target c++ } } */ } /* { dg-error "before" "" { target c++ } } */ { do #pragma omp flush /* { dg-error "may only be used in compound statements" } */ - while (0); + while (0); /* { dg-error "before" "" { target c++ } } */ } /* { dg-error "before" "" { target c++ } } */ { do #pragma omp taskwait /* { dg-error "may only be used in compound statements" } */ - while (0); + while (0); /* { dg-error "before" "" { target c++ } } */ } /* { dg-error "before" "" { target c++ } } */ { do #pragma omp taskyield /* { dg-error "may only be used in compound statements" } */ - while (0); + while (0); /* { dg-error "before" "" { target c++ } } */ } /* { dg-error "before" "" { target c++ } } */ #pragma omp parallel { do #pragma omp cancel parallel /* { dg-error "may only be used in compound statements" } */ - while (0); + while (0); /* { dg-error "before" "" { target c++ } } */ } /* { dg-error "before" "" { target c++ } } */ #pragma omp parallel { do #pragma omp cancellation point parallel /* { dg-error "may only be used in compound statements" } */ - while (0); + while (0); /* { dg-error "before" "" { target c++ } } */ } /* { dg-error "before" "" { target c++ } } */ #pragma omp for ordered(1) for (i = 0; i < 16; i++) @@ -191,28 +191,28 @@ f4 (int x) { do #pragma omp ordered depend(source) /* { dg-error "may only be used in compound statements" } */ - while (0); + while (0); /* { dg-error "before" "" { target c++ } } */ } /* { dg-error "before" "" { target c++ } } */ { do #pragma omp ordered depend(sink: i-1) /* { dg-error "may only be used in compound statements" } */ - while (0); + while (0); /* { dg-error "before" "" { target c++ } } */ } /* { dg-error "before" "" { target c++ } } */ } { do #pragma omp target enter data map(to:i) /* { dg-error "may only be used in compound statements" } */ - while (0); + while (0); /* { dg-error "before" "" { target c++ } } */ } /* { dg-error "before" "" { target c++ } } */ { do #pragma omp target update to(i) /* { dg-error "may only be used in compound statements" } */ - while (0); + while (0); /* { dg-error "before" "" { target c++ } } */ } /* { dg-error "before" "" { target c++ } } */ { do #pragma omp target exit data map(from:i) /* { dg-error "may only be used in compound statements" } */ - while (0); + while (0); /* { dg-error "before" "" { target c++ } } */ } /* { dg-error "before" "" { target c++ } } */ } diff --git a/gcc/testsuite/c-c++-common/missing-close-symbol.c b/gcc/testsuite/c-c++-common/missing-close-symbol.c index 85b96f28ef833..abeb83748c163 100644 --- a/gcc/testsuite/c-c++-common/missing-close-symbol.c +++ b/gcc/testsuite/c-c++-common/missing-close-symbol.c @@ -12,6 +12,7 @@ void test_static_assert_same_line (void) /* { dg-begin-multiline-output "" } _Static_assert(sizeof(int) >= sizeof(char), "msg"; ~ ^ + ) { dg-end-multiline-output "" } */ } @@ -25,6 +26,7 @@ void test_static_assert_different_line (void) /* { dg-begin-multiline-output "" } "msg"; ^ + ) { dg-end-multiline-output "" } */ /* { dg-begin-multiline-output "" } _Static_assert(sizeof(int) >= sizeof(char), diff --git a/gcc/testsuite/c-c++-common/missing-symbol.c b/gcc/testsuite/c-c++-common/missing-symbol.c index 33a501b998864..326b9faad7a90 100644 --- a/gcc/testsuite/c-c++-common/missing-symbol.c +++ b/gcc/testsuite/c-c++-common/missing-symbol.c @@ -5,15 +5,14 @@ extern int bar (void); int missing_close_paren_in_switch (int i) { - switch (i /* { dg-message "10: to match this '\\('" } */ - { /* { dg-error "5: expected '\\)' before '.' token" } */ - /* { dg-begin-multiline-output "" } - { - ^ - { dg-end-multiline-output "" } */ + switch (i /* { dg-error "12: expected '\\)' before '.' token" } */ + { /* { dg-begin-multiline-output "" } switch (i - ^ + ~ ^ + ) + { + ~ { dg-end-multiline-output "" } */ case 0: @@ -30,21 +29,33 @@ int missing_close_paren_in_switch (int i) void missing_close_paren_in_if (void) { if (foo () /* { dg-line start_of_if } */ - && bar () - { /* { dg-error "5: expected '\\)' before '.' token" } */ + && bar () /* { dg-error "16: expected '\\)' before '.' token" } */ + { /* { dg-begin-multiline-output "" } + && bar () + ^ + ) { - ^ + ~ { dg-end-multiline-output "" } */ /* { dg-message "6: to match this '\\('" "" { target *-*-* } start_of_if } */ /* { dg-begin-multiline-output "" } if (foo () ^ - { dg-end-multiline-output "" } */ + { dg-end-multiline-output "" } */ } - } /* { dg-error "1: expected" } */ /* { dg-begin-multiline-output "" } } ^ { dg-end-multiline-output "" } */ + +int missing_colon_in_ternary (int flag) +{ + return flag ? 42 0; /* { dg-error "expected ':' before numeric constant" } */ + /* { dg-begin-multiline-output "" } + return flag ? 42 0; + ^~ + : + { dg-end-multiline-output "" } */ +} diff --git a/gcc/testsuite/c-c++-common/rotate-5.c b/gcc/testsuite/c-c++-common/rotate-5.c index 35b14b86c3afd..629ab2f7274ef 100644 --- a/gcc/testsuite/c-c++-common/rotate-5.c +++ b/gcc/testsuite/c-c++-common/rotate-5.c @@ -15,12 +15,40 @@ f1 (unsigned long long x, unsigned int y) return (x << y) | (x >> ((-y) & 63)); } +__attribute__((noinline, noclone)) +unsigned long long +f2 (unsigned long long x, unsigned int y) +{ + return (x << y) + (x >> ((-y) & 63)); +} + +__attribute__((noinline, noclone)) +unsigned long long +f3 (unsigned long long x, unsigned int y) +{ + return (x << y) ^ (x >> ((-y) & 63)); +} + #if __CHAR_BIT__ * __SIZEOF_INT128__ == 128 __attribute__((noinline, noclone)) unsigned __int128 -f2 (unsigned __int128 x, unsigned int y) +f4 (unsigned __int128 x, unsigned int y) +{ + return (x << y) | (x >> ((-y) & 127)); +} + +__attribute__((noinline, noclone)) +unsigned __int128 +f5 (unsigned __int128 x, unsigned int y) { - return (x << y) | (x >> ((-y) & 128)); + return (x << y) + (x >> ((-y) & 127)); +} + +__attribute__((noinline, noclone)) +unsigned __int128 +f6 (unsigned __int128 x, unsigned int y) +{ + return (x << y) ^ (x >> ((-y) & 127)); } #endif #endif @@ -31,12 +59,45 @@ main () #if __CHAR_BIT__ * __SIZEOF_LONG_LONG__ == 64 if (f1 (0x123456789abcdef0ULL, 0) != 0x123456789abcdef0ULL) abort (); + if (f2 (0x123456789abcdef0ULL, 0) != 0x2468acf13579bde0ULL) + abort (); + if (f3 (0x123456789abcdef0ULL, 0) != 0) + abort (); + if (f1 (0x123456789abcdef0ULL, 1) != 0x2468acf13579bde0ULL) + abort (); + if (f2 (0x123456789abcdef0ULL, 1) != 0x2468acf13579bde0ULL) + abort (); + if (f3 (0x123456789abcdef0ULL, 1) != 0x2468acf13579bde0ULL) + abort (); #if __CHAR_BIT__ * __SIZEOF_INT128__ == 128 - if (f2 ((((unsigned __int128) 0x123456789abcdef0ULL) << 64) + if (f4 ((((unsigned __int128) 0x123456789abcdef0ULL) << 64) | 0x0fedcba987654321ULL, 0) != ((((unsigned __int128) 0x123456789abcdef0ULL) << 64) | 0x0fedcba987654321ULL)) abort (); + if (f5 ((((unsigned __int128) 0x123456789abcdef0ULL) << 64) + | 0x0fedcba987654321ULL, 0) + != ((((unsigned __int128) 0x2468acf13579bde0ULL) << 64) + | 0x1fdb97530eca8642ULL)) + abort (); + if (f6 ((((unsigned __int128) 0x123456789abcdef0ULL) << 64) + | 0x0fedcba987654321ULL, 0) != 0) + abort (); + if (f4 ((((unsigned __int128) 0x123456789abcdef0ULL) << 64) + | 0x0fedcba987654321ULL, 1) + != ((((unsigned __int128) 0x2468acf13579bde0ULL) << 64) + | 0x1fdb97530eca8642ULL)) + abort (); + if (f5 ((((unsigned __int128) 0x123456789abcdef0ULL) << 64) + | 0x0fedcba987654321ULL, 1) + != ((((unsigned __int128) 0x2468acf13579bde0ULL) << 64) + | 0x1fdb97530eca8642ULL)) + abort (); + if (f6 ((((unsigned __int128) 0x123456789abcdef0ULL) << 64) + | 0x0fedcba987654321ULL, 1) + != ((((unsigned __int128) 0x2468acf13579bde0ULL) << 64) + | 0x1fdb97530eca8642ULL)) + abort (); #endif #endif return 0; diff --git a/gcc/testsuite/c-c++-common/rotate-6.c b/gcc/testsuite/c-c++-common/rotate-6.c new file mode 100644 index 0000000000000..715f8a48c9368 --- /dev/null +++ b/gcc/testsuite/c-c++-common/rotate-6.c @@ -0,0 +1,582 @@ +/* Check rotate pattern detection. */ +/* { dg-do compile } */ +/* { dg-options "-O2 -fno-ipa-icf -fdump-tree-optimized" } */ +/* Rotates should be recognized only in functions with | instead of + or ^, + or in functions that have constant shift counts (unused attribute on y). */ +/* { dg-final { scan-tree-dump-times "r\[<>]\[<>]" 48 "optimized" } } */ + +unsigned int +f1 (unsigned int x, unsigned int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f2 (unsigned int x, unsigned long int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f3 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) | (x >> ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f4 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x >> 1); +} + +unsigned short int +f5 (unsigned short int x, unsigned int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) | (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned short int +f6 (unsigned short int x, unsigned long int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) | (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned char +f7 (unsigned char x, unsigned int y) +{ + return (x << (y & (__CHAR_BIT__ - 1))) | (x >> ((-y) & (__CHAR_BIT__ - 1))); +} + +unsigned char +f8 (unsigned char x, unsigned long int y) +{ + return (x << (y & (__CHAR_BIT__ - 1))) | (x >> ((-y) & (__CHAR_BIT__ - 1))); +} + +unsigned int +f9 (unsigned int x, unsigned int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) | (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f10 (unsigned int x, unsigned long int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) | (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f11 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) | (x >> ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f12 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) | (x >> 1); +} + +unsigned short int +f13 (unsigned short int x, unsigned int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) | (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned short int +f14 (unsigned short int x, unsigned long int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) | (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned char +f15 (unsigned char x, unsigned int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) | (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned char +f16 (unsigned char x, unsigned long int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) | (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned int +f17 (unsigned int x, unsigned int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) ^ (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f18 (unsigned int x, unsigned long int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) ^ (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f19 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) ^ (x << 1); +} + +unsigned int +f20 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> 1) ^ (x << ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned short int +f21 (unsigned short int x, unsigned int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) ^ (x << (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned short int +f22 (unsigned short int x, unsigned long int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) ^ (x << (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned char +f23 (unsigned char x, unsigned int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ - 1))) ^ (x << (y & (__CHAR_BIT__ - 1))); +} + +unsigned char +f24 (unsigned char x, unsigned long int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ - 1))) ^ (x << (y & (__CHAR_BIT__ - 1))); +} + +unsigned int +f25 (unsigned int x, unsigned int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) ^ (x << (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f26 (unsigned int x, unsigned long int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) ^ (x << (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f27 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) ^ (x << 1); +} + +unsigned int +f28 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> 1) ^ (x << ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned short int +f29 (unsigned short int x, unsigned int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) ^ (x << (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned short int +f30 (unsigned short int x, unsigned long int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) ^ (x << (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned char +f31 (unsigned char x, unsigned int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) ^ (x << (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned char +f32 (unsigned char x, unsigned long int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) ^ (x << (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned int +f33 (unsigned int x, unsigned int y) +{ + return (x >> (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f34 (unsigned int x, unsigned long int y) +{ + return (x >> (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f35 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> 1) | (x << ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f36 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x << 1); +} + +unsigned short int +f37 (unsigned short int x, unsigned int y) +{ + return (x >> (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) | (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned short int +f38 (unsigned short int x, unsigned long int y) +{ + return (x >> (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) | (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned char +f39 (unsigned char x, unsigned int y) +{ + return (x >> (y & (__CHAR_BIT__ - 1))) | (x << ((-y) & (__CHAR_BIT__ - 1))); +} + +unsigned char +f40 (unsigned char x, unsigned long int y) +{ + return (x >> (y & (__CHAR_BIT__ - 1))) | (x << ((-y) & (__CHAR_BIT__ - 1))); +} + +unsigned int +f41 (unsigned int x, unsigned int y) +{ + return (x >> (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) | (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f42 (unsigned int x, unsigned long int y) +{ + return (x >> (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) | (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f43 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> 1) | (x << ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f44 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) | (x << 1); +} + +unsigned short int +f45 (unsigned short int x, unsigned int y) +{ + return (x >> (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) | (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned short int +f46 (unsigned short int x, unsigned long int y) +{ + return (x >> (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) | (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned char +f47 (unsigned char x, unsigned int y) +{ + return (x >> (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) | (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned char +f48 (unsigned char x, unsigned long int y) +{ + return (x >> (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) | (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned int +f49 (unsigned int x, unsigned int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) ^ (x >> (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f50 (unsigned int x, unsigned long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) ^ (x >> (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f51 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) ^ (x >> 1); +} + +unsigned int +f52 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) ^ (x >> ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned short int +f53 (unsigned short int x, unsigned int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) ^ (x >> (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned short int +f54 (unsigned short int x, unsigned long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) ^ (x >> (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned char +f55 (unsigned char x, unsigned int y) +{ + return (x << ((-y) & (__CHAR_BIT__ - 1))) ^ (x >> (y & (__CHAR_BIT__ - 1))); +} + +unsigned char +f56 (unsigned char x, unsigned long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ - 1))) ^ (x >> (y & (__CHAR_BIT__ - 1))); +} + +unsigned int +f57 (unsigned int x, unsigned int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) ^ (x >> (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f58 (unsigned int x, unsigned long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) ^ (x >> (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f59 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) ^ (x >> 1); +} + +unsigned int +f60 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) ^ (x >> ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned short int +f61 (unsigned short int x, unsigned int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) ^ (x >> (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned short int +f62 (unsigned short int x, unsigned long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) ^ (x >> (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned char +f63 (unsigned char x, unsigned int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) ^ (x >> (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned char +f64 (unsigned char x, unsigned long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) ^ (x >> (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned int +f65 (unsigned int x, unsigned int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) + (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f66 (unsigned int x, unsigned long int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) + (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f67 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) + (x >> ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f68 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) + (x >> 1); +} + +unsigned short int +f69 (unsigned short int x, unsigned int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) + (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned short int +f70 (unsigned short int x, unsigned long int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) + (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned char +f71 (unsigned char x, unsigned int y) +{ + return (x << (y & (__CHAR_BIT__ - 1))) + (x >> ((-y) & (__CHAR_BIT__ - 1))); +} + +unsigned char +f72 (unsigned char x, unsigned long int y) +{ + return (x << (y & (__CHAR_BIT__ - 1))) + (x >> ((-y) & (__CHAR_BIT__ - 1))); +} + +unsigned int +f73 (unsigned int x, unsigned int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) + (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f74 (unsigned int x, unsigned long int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) + (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f75 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) + (x >> ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f76 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) + (x >> 1); +} + +unsigned short int +f77 (unsigned short int x, unsigned int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) + (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned short int +f78 (unsigned short int x, unsigned long int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) + (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned char +f79 (unsigned char x, unsigned int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) + (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned char +f80 (unsigned char x, unsigned long int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) + (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned int +f81 (unsigned int x, unsigned int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) + (x >> (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f82 (unsigned int x, unsigned long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) + (x >> (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f83 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) + (x >> 1); +} + +unsigned int +f84 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) + (x >> ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned short int +f85 (unsigned short int x, unsigned int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) + (x >> (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned short int +f86 (unsigned short int x, unsigned long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) + (x >> (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned char +f87 (unsigned char x, unsigned int y) +{ + return (x << ((-y) & (__CHAR_BIT__ - 1))) + (x >> (y & (__CHAR_BIT__ - 1))); +} + +unsigned char +f88 (unsigned char x, unsigned long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ - 1))) + (x >> (y & (__CHAR_BIT__ - 1))); +} + +unsigned int +f89 (unsigned int x, unsigned int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) + (x >> (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f90 (unsigned int x, unsigned long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) + (x >> (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f91 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) + (x >> 1); +} + +unsigned int +f92 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) + (x >> ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned short int +f93 (unsigned short int x, unsigned int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) + (x >> (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned short int +f94 (unsigned short int x, unsigned long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) + (x >> (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned char +f95 (unsigned char x, unsigned int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) + (x >> (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned char +f96 (unsigned char x, unsigned long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) + (x >> (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} diff --git a/gcc/testsuite/c-c++-common/rotate-6a.c b/gcc/testsuite/c-c++-common/rotate-6a.c new file mode 100644 index 0000000000000..06ba56a5dde03 --- /dev/null +++ b/gcc/testsuite/c-c++-common/rotate-6a.c @@ -0,0 +1,6 @@ +/* { dg-do run } */ +/* { dg-options "-O2 -Wno-overflow" } */ + +#define ROTATE_N "rotate-6.c" + +#include "rotate-1a.c" diff --git a/gcc/testsuite/c-c++-common/rotate-7.c b/gcc/testsuite/c-c++-common/rotate-7.c new file mode 100644 index 0000000000000..390cef680d9ec --- /dev/null +++ b/gcc/testsuite/c-c++-common/rotate-7.c @@ -0,0 +1,582 @@ +/* Check rotate pattern detection. */ +/* { dg-do compile } */ +/* { dg-options "-O2 -fno-ipa-icf -fdump-tree-optimized" } */ +/* Rotates should be recognized only in functions with | instead of + or ^, + or in functions that have constant shift counts (unused attribute on y). */ +/* { dg-final { scan-tree-dump-times "r\[<>]\[<>]" 48 "optimized" } } */ + +unsigned int +f1 (unsigned int x, int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f2 (unsigned int x, long int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f3 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) | (x >> ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f4 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x >> 1); +} + +unsigned short int +f5 (unsigned short int x, int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) | (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned short int +f6 (unsigned short int x, long int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) | (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned char +f7 (unsigned char x, int y) +{ + return (x << (y & (__CHAR_BIT__ - 1))) | (x >> ((-y) & (__CHAR_BIT__ - 1))); +} + +unsigned char +f8 (unsigned char x, long int y) +{ + return (x << (y & (__CHAR_BIT__ - 1))) | (x >> ((-y) & (__CHAR_BIT__ - 1))); +} + +unsigned int +f9 (unsigned int x, int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) | (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f10 (unsigned int x, long int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) | (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f11 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) | (x >> ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f12 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) | (x >> 1); +} + +unsigned short int +f13 (unsigned short int x, int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) | (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned short int +f14 (unsigned short int x, long int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) | (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned char +f15 (unsigned char x, int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) | (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned char +f16 (unsigned char x, long int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) | (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned int +f17 (unsigned int x, int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) ^ (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f18 (unsigned int x, long int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) ^ (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f19 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) ^ (x << 1); +} + +unsigned int +f20 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> 1) ^ (x << ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned short int +f21 (unsigned short int x, int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) ^ (x << (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned short int +f22 (unsigned short int x, long int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) ^ (x << (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned char +f23 (unsigned char x, int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ - 1))) ^ (x << (y & (__CHAR_BIT__ - 1))); +} + +unsigned char +f24 (unsigned char x, long int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ - 1))) ^ (x << (y & (__CHAR_BIT__ - 1))); +} + +unsigned int +f25 (unsigned int x, int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) ^ (x << (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f26 (unsigned int x, long int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) ^ (x << (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f27 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) ^ (x << 1); +} + +unsigned int +f28 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> 1) ^ (x << ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned short int +f29 (unsigned short int x, int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) ^ (x << (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned short int +f30 (unsigned short int x, long int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) ^ (x << (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned char +f31 (unsigned char x, int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) ^ (x << (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned char +f32 (unsigned char x, long int y) +{ + return (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) ^ (x << (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned int +f33 (unsigned int x, int y) +{ + return (x >> (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f34 (unsigned int x, long int y) +{ + return (x >> (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f35 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> 1) | (x << ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f36 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x << 1); +} + +unsigned short int +f37 (unsigned short int x, int y) +{ + return (x >> (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) | (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned short int +f38 (unsigned short int x, long int y) +{ + return (x >> (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) | (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned char +f39 (unsigned char x, int y) +{ + return (x >> (y & (__CHAR_BIT__ - 1))) | (x << ((-y) & (__CHAR_BIT__ - 1))); +} + +unsigned char +f40 (unsigned char x, long int y) +{ + return (x >> (y & (__CHAR_BIT__ - 1))) | (x << ((-y) & (__CHAR_BIT__ - 1))); +} + +unsigned int +f41 (unsigned int x, int y) +{ + return (x >> (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) | (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f42 (unsigned int x, long int y) +{ + return (x >> (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) | (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f43 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> 1) | (x << ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f44 (unsigned int x, int y __attribute__((unused))) +{ + return (x >> ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) | (x << 1); +} + +unsigned short int +f45 (unsigned short int x, int y) +{ + return (x >> (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) | (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned short int +f46 (unsigned short int x, long int y) +{ + return (x >> (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) | (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned char +f47 (unsigned char x, int y) +{ + return (x >> (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) | (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned char +f48 (unsigned char x, long int y) +{ + return (x >> (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) | (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned int +f49 (unsigned int x, int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) ^ (x >> (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f50 (unsigned int x, long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) ^ (x >> (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f51 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) ^ (x >> 1); +} + +unsigned int +f52 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) ^ (x >> ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned short int +f53 (unsigned short int x, int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) ^ (x >> (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned short int +f54 (unsigned short int x, long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) ^ (x >> (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned char +f55 (unsigned char x, int y) +{ + return (x << ((-y) & (__CHAR_BIT__ - 1))) ^ (x >> (y & (__CHAR_BIT__ - 1))); +} + +unsigned char +f56 (unsigned char x, long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ - 1))) ^ (x >> (y & (__CHAR_BIT__ - 1))); +} + +unsigned int +f57 (unsigned int x, int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) ^ (x >> (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f58 (unsigned int x, long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) ^ (x >> (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f59 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) ^ (x >> 1); +} + +unsigned int +f60 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) ^ (x >> ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned short int +f61 (unsigned short int x, int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) ^ (x >> (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned short int +f62 (unsigned short int x, long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) ^ (x >> (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned char +f63 (unsigned char x, int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) ^ (x >> (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned char +f64 (unsigned char x, long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) ^ (x >> (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned int +f65 (unsigned int x, int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) + (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f66 (unsigned int x, long int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) + (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f67 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) + (x >> ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f68 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) + (x >> 1); +} + +unsigned short int +f69 (unsigned short int x, int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) + (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned short int +f70 (unsigned short int x, long int y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) + (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned char +f71 (unsigned char x, int y) +{ + return (x << (y & (__CHAR_BIT__ - 1))) + (x >> ((-y) & (__CHAR_BIT__ - 1))); +} + +unsigned char +f72 (unsigned char x, long int y) +{ + return (x << (y & (__CHAR_BIT__ - 1))) + (x >> ((-y) & (__CHAR_BIT__ - 1))); +} + +unsigned int +f73 (unsigned int x, int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) + (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f74 (unsigned int x, long int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) + (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f75 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) + (x >> ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f76 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) + (x >> 1); +} + +unsigned short int +f77 (unsigned short int x, int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) + (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned short int +f78 (unsigned short int x, long int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) + (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned char +f79 (unsigned char x, int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) + (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned char +f80 (unsigned char x, long int y) +{ + return (x << (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) + (x >> ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned int +f81 (unsigned int x, int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) + (x >> (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f82 (unsigned int x, long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) + (x >> (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f83 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) + (x >> 1); +} + +unsigned int +f84 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) + (x >> ((-1) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned short int +f85 (unsigned short int x, int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) + (x >> (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned short int +f86 (unsigned short int x, long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))) + (x >> (y & (__CHAR_BIT__ * __SIZEOF_SHORT__ - 1))); +} + +unsigned char +f87 (unsigned char x, int y) +{ + return (x << ((-y) & (__CHAR_BIT__ - 1))) + (x >> (y & (__CHAR_BIT__ - 1))); +} + +unsigned char +f88 (unsigned char x, long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ - 1))) + (x >> (y & (__CHAR_BIT__ - 1))); +} + +unsigned int +f89 (unsigned int x, int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) + (x >> (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f90 (unsigned int x, long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) + (x >> (y & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned int +f91 (unsigned int x, int y __attribute__((unused))) +{ + return (x << ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))) + (x >> 1); +} + +unsigned int +f92 (unsigned int x, int y __attribute__((unused))) +{ + return (x << 1) + (x >> ((-1) & (__CHAR_BIT__ * sizeof (unsigned int) - 1))); +} + +unsigned short int +f93 (unsigned short int x, int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) + (x >> (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned short int +f94 (unsigned short int x, long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned short) - 1))) + (x >> (y & (__CHAR_BIT__ * sizeof (unsigned short) - 1))); +} + +unsigned char +f95 (unsigned char x, int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) + (x >> (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} + +unsigned char +f96 (unsigned char x, long int y) +{ + return (x << ((-y) & (__CHAR_BIT__ * sizeof (unsigned char) - 1))) + (x >> (y & (__CHAR_BIT__ * sizeof (unsigned char) - 1))); +} diff --git a/gcc/testsuite/c-c++-common/rotate-7a.c b/gcc/testsuite/c-c++-common/rotate-7a.c new file mode 100644 index 0000000000000..4fb084654032e --- /dev/null +++ b/gcc/testsuite/c-c++-common/rotate-7a.c @@ -0,0 +1,6 @@ +/* { dg-do run } */ +/* { dg-options "-O2 -Wno-overflow" } */ + +#define ROTATE_N "rotate-7.c" + +#include "rotate-1a.c" diff --git a/gcc/testsuite/c-c++-common/rotate-8.c b/gcc/testsuite/c-c++-common/rotate-8.c new file mode 100644 index 0000000000000..9ba3e94093021 --- /dev/null +++ b/gcc/testsuite/c-c++-common/rotate-8.c @@ -0,0 +1,171 @@ +/* PR middle-end/62263 */ +/* PR middle-end/82498 */ +/* { dg-do compile } */ +/* { dg-options "-O2 -fno-ipa-icf -fdump-tree-optimized" } */ +/* { dg-final { scan-tree-dump-times "r\[<>]\[<>]" 23 "optimized" } } */ +/* { dg-final { scan-tree-dump-not "PHI <" "optimized" } } */ + +unsigned int +f1 (unsigned int x, unsigned char y) +{ + y %= __CHAR_BIT__ * __SIZEOF_INT__; + return (x << y) | (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - y)); +} + +unsigned int +f2 (unsigned int x, signed char y) +{ + y &= __CHAR_BIT__ * __SIZEOF_INT__ - 1; + return (x << y) | (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - y)); +} + +unsigned int +f3 (unsigned int x, unsigned char y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1)))); +} + +unsigned int +f4 (unsigned int x, unsigned char y) +{ + y = y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1); + return y ? (x << y) | (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - y)) : x; +} + +unsigned int +f5 (unsigned int x, unsigned char y) +{ + y = y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1); + return (x << y) | (x >> ((__CHAR_BIT__ * __SIZEOF_INT__ - y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f6 (unsigned int x, unsigned char y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x >> ((__CHAR_BIT__ * __SIZEOF_INT__ - (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f7 (unsigned int x, unsigned char y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x >> ((__CHAR_BIT__ * __SIZEOF_INT__ - y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f8 (unsigned int x, unsigned char y) +{ + return (x << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x >> ((-y) & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f9 (unsigned int x, int y) +{ + return (0x12345678U << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (0x12345678U >> (-y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f10 (unsigned int x, int y) +{ + return (0x12345678U >> (-y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (0x12345678U << (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f11 (unsigned int x, int y) +{ + return (0x12345678U >> (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (0x12345678U << (-y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned int +f12 (unsigned int x, int y) +{ + return (0x12345678U << (-y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (0x12345678U >> (y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned +f13 (unsigned x, unsigned char y) +{ + if (y == 0) + return x; + y %= __CHAR_BIT__ * __SIZEOF_INT__; + return (x << y) | (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - y)); +} + +unsigned +f14 (unsigned x, unsigned y) +{ + if (y == 0) + return x; + y %= __CHAR_BIT__ * __SIZEOF_INT__; + return (x << y) | (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - y)); +} + +unsigned +f15 (unsigned x, unsigned short y) +{ + if (y == 0) + return x; + y %= __CHAR_BIT__ * __SIZEOF_INT__; + return (x << y) | (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - y)); +} + +unsigned +f16 (unsigned x, unsigned char y) +{ + y %= __CHAR_BIT__ * __SIZEOF_INT__; + if (y == 0) + return x; + return (x << y) | (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - y)); +} + +unsigned +f17 (unsigned x, unsigned y) +{ + y %= __CHAR_BIT__ * __SIZEOF_INT__; + if (y == 0) + return x; + return (x << y) | (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - y)); +} + +unsigned +f18 (unsigned x, unsigned short y) +{ + y %= __CHAR_BIT__ * __SIZEOF_INT__; + if (y == 0) + return x; + return (x << y) | (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - y)); +} + +unsigned +f19 (unsigned x, unsigned char y) +{ + y %= __CHAR_BIT__ * __SIZEOF_INT__; + return (x << y) | (x >> (((unsigned char) -y) % (__CHAR_BIT__ * __SIZEOF_INT__))); +} + +unsigned +f20 (unsigned x, unsigned int y) +{ + y %= __CHAR_BIT__ * __SIZEOF_INT__; + return (x << y) | (x >> (-y % (__CHAR_BIT__ * __SIZEOF_INT__))); +} + +unsigned +f21 (unsigned x, unsigned short y) +{ + y %= __CHAR_BIT__ * __SIZEOF_INT__; + return (x << y) | (x >> (((unsigned short) -y) % (__CHAR_BIT__ * __SIZEOF_INT__))); +} + +unsigned +f22 (unsigned x, unsigned char y) +{ + y %= __CHAR_BIT__ * __SIZEOF_INT__; + return (x << y) | (x >> (-y & ((__CHAR_BIT__ * __SIZEOF_INT__) - 1))); +} + +unsigned +f23 (unsigned x, unsigned short y) +{ + y %= __CHAR_BIT__ * __SIZEOF_INT__; + return (x << y) | (x >> (-y & ((__CHAR_BIT__ * __SIZEOF_INT__) - 1))); +} diff --git a/gcc/testsuite/c-c++-common/ubsan/attrib-5.c b/gcc/testsuite/c-c++-common/ubsan/attrib-5.c new file mode 100644 index 0000000000000..209b5dd7d2b96 --- /dev/null +++ b/gcc/testsuite/c-c++-common/ubsan/attrib-5.c @@ -0,0 +1,10 @@ +/* { dg-do compile } */ +/* { dg-options "-fsanitize=undefined" } */ + +__attribute__((no_sanitize("foobar"))) +static void +float_cast2 (void) { /* { dg-warning "attribute directive ignored" } */ + volatile double d = 300; + volatile signed char c; + c = d; +} diff --git a/gcc/testsuite/c-c++-common/ubsan/builtin-1.c b/gcc/testsuite/c-c++-common/ubsan/builtin-1.c new file mode 100644 index 0000000000000..2f340e3e70f17 --- /dev/null +++ b/gcc/testsuite/c-c++-common/ubsan/builtin-1.c @@ -0,0 +1,36 @@ +/* { dg-do run } */ +/* { dg-options "-fsanitize=undefined" } */ + +#include + +__attribute__((noinline, noclone)) unsigned long long +foo (unsigned int x, unsigned long int y, unsigned long long int z, __UINTMAX_TYPE__ w) +{ + unsigned long long ret = 0; + fprintf (stderr, "FOO MARKER1\n"); + ret += __builtin_ctz (x); + ret += __builtin_ctzl (y); + ret += __builtin_ctzll (z); + ret += __builtin_ctzimax (w); + fprintf (stderr, "FOO MARKER2\n"); + ret += __builtin_clz (x); + ret += __builtin_clzl (y); + ret += __builtin_clzll (z); + ret += __builtin_clzimax (w); + fprintf (stderr, "FOO MARKER3\n"); + return ret; +} + +int +main () +{ + volatile __UINTMAX_TYPE__ t = 0; + t = foo (t, t, t, t); + return 0; +} + +/* { dg-output "FOO MARKER1(\n|\r\n|\r)" } */ +/* { dg-output "(\[^\n\r]*runtime error: passing zero to ctz\\\(\\\), which is not a valid argument\[^\n\r]*(\n|\r\n|\r)){4}" } */ +/* { dg-output "FOO MARKER2(\n|\r\n|\r)" } */ +/* { dg-output "(\[^\n\r]*runtime error: passing zero to clz\\\(\\\), which is not a valid argument\[^\n\r]*(\n|\r\n|\r)){4}" } */ +/* { dg-output "FOO MARKER3" } */ diff --git a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-1.c b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-1.c index aae88aa318007..8139cc1723fbc 100644 --- a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-1.c +++ b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-1.c @@ -91,115 +91,115 @@ main (void) return 0; } -/* { dg-output "value -133 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -129.5 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -129 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 128 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 128.5 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 132 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value nan is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -?nan is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value inf is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -inf is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 256 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 256.5 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 260 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -5 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1.5 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value nan is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -?nan is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value inf is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -inf is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -32773 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -32769.5 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -32769 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 32768 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 32768.5 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 32772 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value nan is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -?nan is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value inf is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -inf is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 65536 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 65536.5 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 65540 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -5 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1.5 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value nan is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -?nan is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value inf is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -inf is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -2.14748e\\\+09 is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -2.14748e\\\+09 is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -2.14748e\\\+09 is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 2.14748e\\\+09 is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 2.14748e\\\+09 is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 2.14748e\\\+09 is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value nan is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -?nan is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value inf is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -inf is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 4.29497e\\\+09 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 4.29497e\\\+09 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 4.29497e\\\+09 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -5 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1.5 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value nan is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -?nan is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value inf is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -inf is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value nan is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -?nan is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value inf is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -inf is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -5 is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1.5 is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value nan is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -?nan is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value inf is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -inf is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value nan is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -?nan is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value inf is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -inf is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -5 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1.5 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value nan is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -?nan is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value inf is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -inf is outside the range of representable values of type 'long long unsigned int'" } */ +/* { dg-output " -133 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -129.5 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -129 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 128 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 128.5 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 132 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* nan is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -?nan is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* inf is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -inf is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 256 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 256.5 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 260 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -5 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1.5 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* nan is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -?nan is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* inf is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -inf is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -32773 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -32769.5 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -32769 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 32768 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 32768.5 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 32772 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* nan is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -?nan is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* inf is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -inf is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 65536 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 65536.5 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 65540 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -5 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1.5 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* nan is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -?nan is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* inf is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -inf is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -2.14748e\\\+09 is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -2.14748e\\\+09 is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -2.14748e\\\+09 is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 2.14748e\\\+09 is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 2.14748e\\\+09 is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 2.14748e\\\+09 is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* nan is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -?nan is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* inf is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -inf is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 4.29497e\\\+09 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 4.29497e\\\+09 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 4.29497e\\\+09 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -5 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1.5 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* nan is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -?nan is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* inf is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -inf is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* nan is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -?nan is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* inf is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -inf is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -5 is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1.5 is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* nan is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -?nan is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* inf is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -inf is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 9.22337e\\\+18 is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* nan is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -?nan is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* inf is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -inf is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 1.84467e\\\+19 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -5 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1.5 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* nan is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -?nan is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* inf is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -inf is outside the range of representable values of type 'long long unsigned int'" } */ diff --git a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-10.c b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-10.c index a54a838870b99..a4e8ec457b53e 100644 --- a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-10.c +++ b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-10.c @@ -9,38 +9,38 @@ #include "float-cast-overflow-8.c" /* _Decimal32 */ -/* { dg-output "value is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output " is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ /* _Decimal64 */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ /* _Decimal128 */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ diff --git a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-2.c b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-2.c index b25e312b61b3b..426c625fc6b58 100644 --- a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-2.c +++ b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-2.c @@ -30,44 +30,44 @@ main (void) return 0; } -/* { dg-output "runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value nan is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value -?nan is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value inf is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value -inf is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value -5 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value -1.5 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value -1 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value nan is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value -?nan is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value inf is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*runtime error: value -inf is outside the range of representable values of type '__int128 unsigned'" } */ +/* { dg-output "runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 1.70141e\\\+38 is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: nan is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: -?nan is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: inf is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: -inf is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: 3.40282e\\\+38 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: -5 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: -1.5 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: -1 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: nan is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: -?nan is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: inf is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]*runtime error: -inf is outside the range of representable values of type '__int128 unsigned'" } */ diff --git a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-3.c b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-3.c index ba82111a4dfb3..6567ca9a4442c 100644 --- a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-3.c +++ b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-3.c @@ -26,15 +26,15 @@ main (void) return 0; } -/* { dg-output "value -133* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -129.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -129 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 128 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 128.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 132 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 256 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 256.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 260 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type" } */ +/* { dg-output " -133* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -129.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -129 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 128 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 128.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 132 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 256 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 256.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 260 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type" } */ diff --git a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-4.c b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-4.c index af76e4a334336..48ad257c64100 100644 --- a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-4.c +++ b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-4.c @@ -30,23 +30,23 @@ main (void) return 0; } -/* { dg-output "value -2.14748e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -2.14748e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -2.14748e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 2.14748e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 2.14748e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 2.14748e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value nan is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -?nan is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value inf is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -inf is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 4.29497e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 4.29497e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 4.29497e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value nan is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -?nan is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value inf is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -inf is outside the range of representable values of type" } */ +/* { dg-output " -2.14748e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -2.14748e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -2.14748e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 2.14748e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 2.14748e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 2.14748e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* nan is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -?nan is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* inf is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -inf is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 4.29497e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 4.29497e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 4.29497e\\\+09 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* nan is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -?nan is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* inf is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -inf is outside the range of representable values of type" } */ diff --git a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-5.c b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-5.c index 4c2fbb4d9ea59..25a94950970fe 100644 --- a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-5.c +++ b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-5.c @@ -26,15 +26,15 @@ main (void) return 0; } -/* { dg-output "value \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[^\n\r]* is outside the range of representable values of type" } */ +/* { dg-output " \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[^\n\r]* is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[^\n\r]* is outside the range of representable values of type" } */ diff --git a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-6.c b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-6.c index a2b5f9a28ce9c..90ec26838f8fc 100644 --- a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-6.c +++ b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-6.c @@ -26,15 +26,15 @@ main (void) return 0; } -/* { dg-output "value -133 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -129.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -129 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 128 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 128.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 132 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 256 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 256.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value 260 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type" } */ +/* { dg-output " -133 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -129.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -129 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 128 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 128.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 132 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 256 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 256.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* 260 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1.5 is outside the range of representable values of type\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type" } */ diff --git a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-8.c b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-8.c index 4adb22ae3b471..4e7beeb08db36 100644 --- a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-8.c +++ b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-8.c @@ -99,45 +99,45 @@ main () } /* float */ -/* { dg-output "value -129 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ -/* { dg-output "\[^\n\r]*value (-129|-1) is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -32769 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" { target { int128 } } } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" { target { int128 } } } */ +/* { dg-output " -129 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ +/* { dg-output "\[^\n\r]* (-129|-1) is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -32769 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" { target { int128 } } } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" { target { int128 } } } */ /* No error for float and __int128 unsigned max value, as ui128_MAX is +Inf in float. */ /* double */ -/* { dg-output "\[^\n\r]*value -129 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ -/* { dg-output "\[^\n\r]*value (-129|-1) is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -32769 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" { target { int128 } } } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" { target { int128 } } } */ +/* { dg-output "\[^\n\r]* -129 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ +/* { dg-output "\[^\n\r]* (-129|-1) is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -32769 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" { target { int128 } } } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" { target { int128 } } } */ /* long double */ -/* { dg-output "\[^\n\r]*value -129 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ -/* { dg-output "\[^\n\r]*value (-129|-1) is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -32769 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" { target { int128 } } } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" { target { int128 } } } */ +/* { dg-output "\[^\n\r]* -129 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ +/* { dg-output "\[^\n\r]* (-129|-1) is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -32769 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" { target { ilp32 || lp64 } } } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" { target { int128 } } } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" { target { int128 } } } */ diff --git a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-9.c b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-9.c index f2d71f6a5333e..ca9b425d23ee0 100644 --- a/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-9.c +++ b/gcc/testsuite/c-c++-common/ubsan/float-cast-overflow-9.c @@ -6,30 +6,30 @@ #include "float-cast-overflow-8.c" /* __float80 */ -/* { dg-output "value -129 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value (-129|-1) is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -32769 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value \[0-9.e+-]* is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" { target int128 } } */ -/* { dg-output "\[^\n\r]*value -1 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" { target int128 } } */ +/* { dg-output " -129 is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* (-129|-1) is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -32769 is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* \[0-9.e+-]* is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" { target int128 } } */ +/* { dg-output "\[^\n\r]* -1 is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" { target int128 } } */ /* __float128 */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" { target int128 } } */ -/* { dg-output "\[^\n\r]*value is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" { target int128 } } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'signed char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'unsigned char'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'short int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'short unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long long int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type 'long long unsigned int'\[^\n\r]*(\n|\r\n|\r)" } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type '__int128'\[^\n\r]*(\n|\r\n|\r)" { target int128 } } */ +/* { dg-output "\[^\n\r]* is outside the range of representable values of type '__int128 unsigned'\[^\n\r]*(\n|\r\n|\r)" { target int128 } } */ diff --git a/gcc/testsuite/c-c++-common/ubsan/ptr-overflow-sanitization-1.c b/gcc/testsuite/c-c++-common/ubsan/ptr-overflow-sanitization-1.c index 42c14523764ae..c12c7df252b9b 100644 --- a/gcc/testsuite/c-c++-common/ubsan/ptr-overflow-sanitization-1.c +++ b/gcc/testsuite/c-c++-common/ubsan/ptr-overflow-sanitization-1.c @@ -1,5 +1,4 @@ -/* { dg-require-effective-target lp64 } */ -/* { dg-options "-O -fsanitize=pointer-overflow" } */ +/* { dg-options "-O -fsanitize=pointer-overflow -fdump-tree-optimized" } */ /* { dg-skip-if "" { *-*-* } "-flto" } */ #define SMAX __PTRDIFF_MAX__ @@ -76,5 +75,4 @@ void negative_to_negative (char *ptr) p2 += 5; } - -/* { dg-final { scan-assembler-times "call\\s+__ubsan_handle_pointer_overflow" 17 } } */ +/* { dg-final { scan-tree-dump-times "__ubsan_handle_pointer_overflow" 17 "optimized" } } */ diff --git a/gcc/testsuite/g++.dg/asan/asan_test.C b/gcc/testsuite/g++.dg/asan/asan_test.C index 410e4ce72d4f3..f3f7626ef3be8 100644 --- a/gcc/testsuite/g++.dg/asan/asan_test.C +++ b/gcc/testsuite/g++.dg/asan/asan_test.C @@ -8,6 +8,7 @@ // { dg-additional-options "-DASAN_AVOID_EXPENSIVE_TESTS=1" { target { ! run_expensive_tests } } } // { dg-additional-options "-msse2" { target { i?86-*-linux* x86_64-*-linux* } } } // { dg-additional-options "-D__NO_INLINE__" { target { *-*-linux-gnu } } } +// { dg-set-target-env-var ASAN_OPTIONS "handle_segv=2" } // { dg-final { asan-gtest } } #include "asan_test.cc" diff --git a/gcc/testsuite/g++.dg/asan/default-options-1.C b/gcc/testsuite/g++.dg/asan/default-options-1.C index dc818917ddc4d..98abdfbd3ff17 100644 --- a/gcc/testsuite/g++.dg/asan/default-options-1.C +++ b/gcc/testsuite/g++.dg/asan/default-options-1.C @@ -3,7 +3,7 @@ const char *kAsanDefaultOptions="verbosity=1 foo=bar"; extern "C" -__attribute__((no_sanitize_address)) +__attribute__((no_sanitize_address, used)) const char *__asan_default_options() { return kAsanDefaultOptions; } diff --git a/gcc/testsuite/g++.dg/concepts/pr71368.C b/gcc/testsuite/g++.dg/concepts/pr71368.C new file mode 100644 index 0000000000000..f0e0a9563667a --- /dev/null +++ b/gcc/testsuite/g++.dg/concepts/pr71368.C @@ -0,0 +1,25 @@ +// { dg-options "-std=c++17 -fconcepts" } + +struct inner; + +template concept bool CompoundReq = requires { + // fine with concrete type in trailing type, i.e. inner& instead of X& + { X::inner_member() } -> X&; +}; + +template concept bool Concept = requires { + { X::outer_member() } -> CompoundReq; +}; + +struct inner { static inner& inner_member(); }; +struct outer { static inner outer_member(); }; + +int main() +{ + // fine + static_assert( CompoundReq ); + static_assert( CompoundReq ); + + // ICE + static_assert( Concept ); +} diff --git a/gcc/testsuite/g++.dg/concepts/req6.C b/gcc/testsuite/g++.dg/concepts/req6.C index 670fd542f6f0c..50fa3b4daddf1 100644 --- a/gcc/testsuite/g++.dg/concepts/req6.C +++ b/gcc/testsuite/g++.dg/concepts/req6.C @@ -4,7 +4,7 @@ struct X { }; int operator==(X, X) { return 0; } template - concept bool C1() { return X(); } + concept bool C1() { return X(); } // { dg-error "bool" } template void h(T) { } // OK until used. diff --git a/gcc/testsuite/g++.dg/cpp/string-3.C b/gcc/testsuite/g++.dg/cpp/string-3.C new file mode 100644 index 0000000000000..ed9c42ce55755 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp/string-3.C @@ -0,0 +1,9 @@ +// PR c++/82506 +// { dg-do preprocess { target c++11 } } + +#define STRINGIZE(A) #A + +BEGIN STRINGIZE(R"( +)") END + +// { dg-final { scan-file string-3.i "BEGIN \"R\\\\\"\\(\\\\n\\)\\\\\"\"\n END" } } diff --git a/gcc/testsuite/g++.dg/cpp0x/alignas12.C b/gcc/testsuite/g++.dg/cpp0x/alignas12.C new file mode 100644 index 0000000000000..bc16344152907 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/alignas12.C @@ -0,0 +1,6 @@ +// PR c++/71821 +// { dg-do compile { target c++11 } } + +template < typename > constexpr int f () { return 4; } + +alignas (f < int >) char c; // { dg-error "non-integral type" } diff --git a/gcc/testsuite/g++.dg/cpp0x/constexpr-61323.C b/gcc/testsuite/g++.dg/cpp0x/constexpr-61323.C new file mode 100644 index 0000000000000..f194bb8be82b1 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/constexpr-61323.C @@ -0,0 +1,26 @@ +// PR c++/61323 +// { dg-do compile { target c++11 } } + +char* table1[10]; +template void test1() { } +void tester1() { test1<10,table1>(); } + +static char* table2[10]; +template void test2() { } +void tester2() { test2<10,table2>(); } + +const char* table3[10]; +template void test3() { } +void tester3() { test3<10,table3>(); } + +const char* const table4[10] = {}; +template void test4() { } +void tester4() { test4<10,table4>(); } + +const char* volatile table5[10] = {}; +template void test5() { } +void tester5() { test5<10,table5>(); } + +const char* const table6[10] = {}; +template void test6() { } +void tester6() { test6<10,table6>(); } diff --git a/gcc/testsuite/g++.dg/cpp0x/constexpr-ice18.C b/gcc/testsuite/g++.dg/cpp0x/constexpr-ice18.C new file mode 100644 index 0000000000000..0b5ff701306e2 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/constexpr-ice18.C @@ -0,0 +1,11 @@ +// PR c++/67831 +// { dg-do compile { target c++11 } } + +struct Task { + struct TaskStaticData { + constexpr TaskStaticData() {} + } const &tsd; + constexpr Task() : tsd(TaskStaticData()) {} +}; + +Task tasks{Task()}; diff --git a/gcc/testsuite/g++.dg/cpp0x/error1.C b/gcc/testsuite/g++.dg/cpp0x/error1.C index 33557f2f80b20..115d800bb35e4 100644 --- a/gcc/testsuite/g++.dg/cpp0x/error1.C +++ b/gcc/testsuite/g++.dg/cpp0x/error1.C @@ -1,10 +1,17 @@ // PR c++/34395 // { dg-do compile { target c++11 } } -template void foo (int... x[N]) // { dg-message "int \\\[N\\\]\\.\\.\\. x" } +void f(...); +template void foo (int... x[N]) // { dg-message "declared here" } { struct A { - A () { x; } // { dg-error "use of parameter from containing function" } + A () { f(x...); } // { dg-error "use of parameter from containing function" } }; } + +int main() +{ + int ar[4]; + foo<4>(ar); +} diff --git a/gcc/testsuite/g++.dg/cpp0x/pr67625.C b/gcc/testsuite/g++.dg/cpp0x/pr67625.C new file mode 100644 index 0000000000000..bcff5af583176 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/pr67625.C @@ -0,0 +1,12 @@ +// PR c++/67625 +// { dg-do compile { target c++11 } } + +constexpr unsigned short +bswap16 (unsigned short x) +{ + return __builtin_bswap16 (x); +} +constexpr int a = bswap16 (1); +enum { b = a }; +enum { c = __builtin_bswap16 (1) }; +enum { d = bswap16 (1) }; diff --git a/gcc/testsuite/g++.dg/cpp0x/pr70338.C b/gcc/testsuite/g++.dg/cpp0x/pr70338.C new file mode 100644 index 0000000000000..156cb9170803b --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/pr70338.C @@ -0,0 +1,17 @@ +// PR c++/70338 +// { dg-do compile { target c++11 } } +// { dg-options "-g" } + +template +void +foo (int x) +{ + T a[x]; + auto b = [&]() { for (auto &c: a) c = 0.; }; +} + +int +main () +{ + foo (3); +} diff --git a/gcc/testsuite/g++.dg/cpp0x/pr70887.C b/gcc/testsuite/g++.dg/cpp0x/pr70887.C new file mode 100644 index 0000000000000..f5b31b229003e --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/pr70887.C @@ -0,0 +1,31 @@ +// PR middle-end/70887 +// { dg-do compile { target { { i?86-*-* x86_64-*-* } && c++11 } } } +// { dg-options "-O2 -msse2" } + +#include + +enum R { S }; +template struct C { static constexpr int value = 10; }; +template class T, R... r> +struct A { + template struct B; + template + struct B { + static constexpr int d = T::value; + static __m128i generate() + { + __attribute__((__vector_size__(16))) long long + a = generate(), + b = _mm_bslli_si128 (a, 1), + c = _mm_bsrli_si128 (_mm_set1_epi32(d), 12); + return _mm_or_si128 (b, c); + } + }; + A () { B<0, r...>::generate(); } +}; + +int +main () { + using RI = A; + RI ri; +} diff --git a/gcc/testsuite/g++.dg/cpp0x/pr80805.C b/gcc/testsuite/g++.dg/cpp0x/pr80805.C new file mode 100644 index 0000000000000..a13ee1139c771 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/pr80805.C @@ -0,0 +1,21 @@ +// { dg-do compile { target c++11 } } +// { dg-options "-g" } + +template struct R { using type = T; }; +template F r(typename R::type f) { return f; } +template void s(F) {} +template void t(F f) { s(r(f)); } +template struct S {}; +template struct P { constexpr static bool value = false; }; +template +void g() +{ + constexpr static bool H = P::value; + using X = S; + []() -> X + { + t([]{}); + return X{}; + }(); +} +int main() { g(); } diff --git a/gcc/testsuite/g++.dg/cpp0x/pr82560.C b/gcc/testsuite/g++.dg/cpp0x/pr82560.C new file mode 100644 index 0000000000000..3408bae518e56 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/pr82560.C @@ -0,0 +1,28 @@ +// { dg-do run { target c++11 } } +// PR82560, failed to destruct default arg inside new + +static int liveness = 0; + +struct Foo { + + Foo (int) { + liveness++; + } + + ~Foo() { + liveness--; + } + +}; + +struct Bar { + Bar (Foo = 0) { } + ~Bar() { } +}; + +int main() +{ + delete new Bar(); + + return liveness != 0;; +} diff --git a/gcc/testsuite/g++.dg/cpp0x/udlit-extern-c.C b/gcc/testsuite/g++.dg/cpp0x/udlit-extern-c.C new file mode 100644 index 0000000000000..d47a49c3fa860 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/udlit-extern-c.C @@ -0,0 +1,7 @@ +// { dg-do compile { target c++11 } } + +extern "C" { // { dg-message "1: 'extern .C.' linkage started here" } + +constexpr double operator"" _deg ( double degrees ); // { dg-error "literal operator with C linkage" } + +} diff --git a/gcc/testsuite/g++.dg/cpp0x/variadic-crash4.C b/gcc/testsuite/g++.dg/cpp0x/variadic-crash4.C new file mode 100644 index 0000000000000..2974fe933e157 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/variadic-crash4.C @@ -0,0 +1,14 @@ +// PR c++/68884 +// { dg-do compile { target c++11 } } + +namespace std { + template struct A { static constexpr _Tp value = __v; }; +typedef A true_type; +} +template struct VsA; +template struct ValueTemplate { + template