diff options
| author | Gary Funck <gary@intrepid.com> | 2017-10-17 03:19:54 +0000 |
|---|---|---|
| committer | Gary Funck <gary@intrepid.com> | 2017-10-17 03:19:54 +0000 |
| commit | 94de5b24eede2f2ed005b253a2c584675cd682d8 (patch) | |
| tree | ac7aa645d5d9139bd11f7410e3654026e3e2cd44 | |
| parent | 7af4e6706d969f6d2402e0a50473a70a9c85e5be (diff) | |
| parent | 8905b0de50e8b67dda7c2e787c840720b98a637d (diff) | |
Merge trunk version 253779 into gupc branch.gupc
git-svn-id: https://gcc.gnu.org/svn/gcc/branches/gupc@253802 138bc75d-0d04-0410-961f-82ee72b054a4
553 files changed, 34891 insertions, 16303 deletions
diff --git a/fixincludes/ChangeLog b/fixincludes/ChangeLog index ffd171843e1..1f29148e8e3 100644 --- a/fixincludes/ChangeLog +++ b/fixincludes/ChangeLog @@ -1,3 +1,8 @@ +2017-10-13 Mike Frysinger <vapier@chromium.org> + + * fixinc.in (dirname): Change sed from 's|[^/]*/||' to + 's|[^/]*//*||'. + 2017-06-12 Doug Rupp <rupp@adacore.com> * inclhack.def (AAB_vxworks_stdint): Remove hack. diff --git a/fixincludes/fixinc.in b/fixincludes/fixinc.in index 15cbaa23544..cd0b458b8f8 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 1ad32a574b9..5bbd24fdac0 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,1140 @@ +2017-10-14 Jan Hubicka <hubicka@ucw.cz> + + * 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 <hubicka@ucw.cz> + + * 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 <kyrylo.tkachov@arm.com> + Michael Collison <michael.collison@arm.com> + + * 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 <jakub@redhat.com> + + 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 <ubizjak@gmail.com> + + PR bootstrap/82553 + * optabs.c (expand_memory_blockage): Fix call of + targetm.have_memory_blockage. + +2017-10-14 Jakub Jelinek <jakub@redhat.com> + + 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 <ubizjak@gmail.com> + + * 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 <ubizjak@gmail.com> + + * 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 <sebastian.perta@renesas.com> + + * 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 <hubicka@ucw.cz> + + * cfghooks.c (verify_flow_info): Disable check that all probabilities + are set correctly. + +2017-10-13 Jeff Law <law@redhat.com> + + * tree-ssa-reassoc.c (reassociate_bb): Clarify code slighly. + +2017-10-13 Jakub Jelinek <jakub@redhat.com> + + 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 <pthaugen@us.ibm.com> + + * config/rs6000/rs6000.c (rs6000_builtin_vectorization_cost): Remove + TARGET_P9_VECTOR code for unaligned_load case. + +2017-10-13 Jan Hubicka <hubicka@ucw.cz> + + * cfghooks.c (verify_flow_info): Check that edge probabilities are set. + +2017-10-13 Nathan Sidwell <nathan@acm.org> + + * 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 <rguenther@suse.de> + + * 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 <rguenther@suse.de> + + * 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 <hongjiu.lu@intel.com> + + 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 <richard.sandiford@linaro.org> + Alan Hayward <alan.hayward@arm.com> + David Sherwood <david.sherwood@arm.com> + + * combine.c (can_change_dest_mode): Reject changes in + REGMODE_NATURAL_SIZE. + +2017-10-13 Richard Sandiford <richard.sandiford@linaro.org> + Alan Hayward <alan.hayward@arm.com> + David Sherwood <david.sherwood@arm.com> + + * 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 <richard.sandiford@linaro.org> + Alan Hayward <alan.hayward@arm.com> + David Sherwood <david.sherwood@arm.com> + + * 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 <richard.sandiford@linaro.org> + Alan Hayward <alan.hayward@arm.com> + David Sherwood <david.sherwood@arm.com> + + * 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 <richard.sandiford@linaro.org> + Alan Hayward <alan.hayward@arm.com> + David Sherwood <david.sherwood@arm.com> + + * 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 <jakub@redhat.com> + + PR target/82524 + * config/i386/i386.md (addqi_ext_1, andqi_ext_1, + *andqi_ext_1_cc, *<code>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, *<code>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) <bit_rotate>: 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 <rguenther@suse.de> + + PR tree-optimization/82451 + Revert + 2017-10-02 Richard Biener <rguenther@suse.de> + + 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 <rguenther@suse.de> + + 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 <rguenther@suse.de> + + * 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 <amodra@gmail.com> + + * doc/extend.texi (Extended Asm <Clobbers>): Rename to + "Clobbers and Scratch Registers". Add paragraph on + alternative to clobbers for scratch registers and OpenBLAS + example. + +2017-10-13 Alan Modra <amodra@gmail.com> + + * 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 <mliska@suse.cz> + + 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 <meissner@linux.vnet.ibm.com> + + * config/rs6000/amo.h: Fix spacing issue. + +2017-10-12 Jakub Jelinek <jakub@redhat.com> + + PR target/82498 + * config/i386/i386.md (*ashl<mode>3_mask_1, + *<shift_insn><mode>3_mask_1, *<rotate_insn><mode>3_mask_1, + *<btsc><mode>_mask_1, *btr<mode>_mask_1): New define_insn_and_split + patterns. + +2017-10-12 Jan Hubicka <hubicka@ucw.cz> + + * 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 <law@redhat.com> + + * tree-ssa-dse.c (valid_ao_ref_for_dse): Reject ao_refs with + negative offsets. + +2017-10-12 Martin Sebor <msebor@redhat.com> + + 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 <vmakarov@redhat.com> + + Revert + 2017-10-11 Vladimir Makarov <vmakarov@redhat.com> + 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 <hubicka@ucw.cz> + + * config/i386/x86-tune-sched.c (ix86_adjust_cost): Fix Zen support. + +2017-10-12 Uros Bizjak <ubizjak@gmail.com> + + * 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 <bin.cheng@arm.com> + + * 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 <bin.cheng@arm.com> + + * 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 <bin.cheng@arm.com> + + * tree-loop-distribution.c (break_alias_scc_partitions): Add comment + and set PTYPE_SEQUENTIAL for merged partition. + +2017-10-12 Richard Biener <rguenther@suse.de> + + PR tree-optimization/69728 + Revert + 2017-09-19 Richard Biener <rguenther@suse.de> + + 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 <jakub@redhat.com> + + * 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 <aldyh@redhat.com> + + * Makefile.in (TAGS): Merge all the *.def files into one pattern. + Handle params.def. + +2017-10-12 Jakub Jelinek <jakub@redhat.com> + + 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 <segher@kernel.crashing.org> + + * config/rs6000/rs6000.h (TARGET_ISEL64): Delete. + * config/rs6000/rs6000.md (sel): Delete mode attribute. + (mov<mode>cc, isel_signed_<mode>, isel_unsigned_<mode>, + *isel_reversed_signed_<mode>, *isel_reversed_unsigned_<mode>): Use + TARGET_ISEL instead of TARGET_ISEL<sel>. + +2017-10-11 David Edelsohn <dje.gcc@gmail.com> + + * config/rs6000/rs6000.c + (rs6000_xcoff_asm_output_aligned_decl_common): Test for NULL decl. + +2017-10-11 Segher Boessenkool <segher@kernel.crashing.org> + + * 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_<mode>): Use reg_or_zero_operand + instead of reg_or_cint_operand. Output instruction directly (not via + output_isel). + (isel_unsigned_<mode>): Ditto. + (*isel_reversed_signed_<mode>): Use reg_or_zero_operand instead of + gpc_reg_operand. Add an instruction alternative for this. Output + instruction directly. + (*isel_reversed_unsigned_<mode>): Ditto. + +2017-10-11 Uros Bizjak <ubizjak@gmail.com> + + * config/i386/i386.c (ix86_canonicalize_comparison): New function. + (TARGET_CANONICALIZE_COMPARISON): Define. + +2017-10-11 Qing Zhao <qing.zhao@oracle.com> + + 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 <vmakarov@redhat.com> + + 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 <nathan@acm.org> + + * 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 <ubizjak@gmail.com> + + * config/i386/i386.md (*cmp<X87MODEF:mode>_<SWI24:mode>_i387): + Do not use float_operator operator predicate. + (*cmp<X87MODEF:mode>_<SWI24:mode>_cc_i387): Ditto. + * config/i386/predicates.md (float_operator): Remove predicate. + +2017-10-11 Uros Bizjak <ubizjak@gmail.com> + + * config/i386/i386.md (*jcc<mode>_0_i387): Remove insn pattern. + (*jccxf_i387): Ditto. + (*jcc<mode>_i387): Ditto. + (*jccu<mode>_i387): Ditto. + (*jcc<X87MODEF:mode>_<SWI24:mode>_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 <hubicka@ucw.cz> + + * 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 <nathan@acm.org> + + * 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 <hubicka@ucw.cz> + + * 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 <lh_mouse@126.com> + + * 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 <rguenther@suse.de> + + * 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 <rguenther@suse.de> + + * 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 <marc.glisse@inria.fr> + + * 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 <bin.cheng@arm.com> + + 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 <mliska@suse.cz> + + 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 <mliska@suse.cz> + + * print-rtl.c (print_insn): Move declaration of idbuf + to same scope as name. + +2017-10-11 Martin Liska <mliska@suse.cz> + + Revert r253637: + + PR sanitizer/82484 + * sanopt.c (sanitize_rewrite_addressable_params): Do not handle + volatile arguments. + +2017-10-11 Martin Liska <mliska@suse.cz> + + PR sanitizer/82484 + * sanopt.c (sanitize_rewrite_addressable_params): Do not handle + volatile arguments. + +2017-10-11 Adhemerval Zanella <adhemerval.zanella@linaro.org> + + * config.gcc (default_gnu_indirect_function): Default to yes for + arm*-*-linux* with glibc. + +2017-10-11 Richard Biener <rguenther@suse.de> + + * 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 <wilson@tuliptree.org> + + 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 <segher@kernel.crashing.org> + + * 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 <jakub@redhat.com> + H.J. Lu <hongjiu.lu@intel.com> + + 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 <andreast@gcc.gnu.org> + + * config.gcc (armv7*-*-freebsd*): New target. + (armv6*-*-freebsd*): Remove obsolete TARGET_FREEBSD_ARMv6 define. + +2017-10-10 Jan Hubicka <hubicka@ucw.cz> + + * 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 <richard.sandiford@linaro.org> + + * 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 <const_tree>): 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 <bin.cheng@arm.com> + + * 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 <rguenther@suse.de> + + * 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 <bin.cheng@arm.com> + + * 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 <bin.cheng@arm.com> + + * 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 <bin.cheng@arm.com> + + * 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 <law@redhat.com> + + * targhooks.c (default_stack_clash_protection_final_dynamic_probe): Fix + return type to match prototype and documentation. + +2010-10-09 Segher Boessenkool <segher@kernel.crashing.org> + + * config/rs6000/rs6000.c (processor_costs): Move to ... + * config/rs6000/rs6000.h: ... here. + (rs6000_cost): Declare. + +2017-10-09 Eric Botcazou <ebotcazou@adacore.com> + + * 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 <segher@kernel.crashing.org> + + * 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 <segher@kernel.crashing.org> + + * combine.c (combine_validate_cost): Compute the new insn_cost, + not just pattern_cost. + (try_combine): Adjust comment. + +2017-10-09 Segher Boessenkool <segher@kernel.crashing.org> + + * 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 <ubizjak@gmail.com> + + * config/i386/i386.md (*jcc_2): Remove insn pattern. + (*jcc<mode>_0_r_i387): Ditto. + (*jccxf_r_i387): Ditto. + (*jcc<mode>_r_i387): Ditto. + (*jccu<mode>_r_i387): Ditto. + (*jcc<X87MODEF:mode>_<SWI24:mode>_r_i387): Ditto. + (*jcc): Rename from *jcc_1. + +2017-10-09 Bill Schmidt <wschmidt@linux.vnet.ibm.com> + + * config/rs6000/rs6000-p8swap.c (rs6000_analyze_swaps): Process + deferred rescans after the lvx/stvx recombination pre-pass. + +2017-10-09 Michael Meissner <meissner@linux.vnet.ibm.com> + + * 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 <rguenther@suse.de> + + 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 <rguenther@suse.de> + + 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 <krebbel@linux.vnet.ibm.com> + + * config/s390/s390-builtins.def (vec_nabs, vec_vfi): Fix builtin + flags. + +2017-10-09 Andreas Krebbel <krebbel@linux.vnet.ibm.com> + + PR target/82463 + * config/s390/vecintrin.h (vec_madd, vec_msub): Fix macro + definitions. + +2017-10-09 Andreas Krebbel <krebbel@linux.vnet.ibm.com> + + PR target/82465 + * config/s390/s390-builtins.def (vec_sqrt): Fix builtin flags. + +2017-10-09 Jakub Jelinek <jakub@redhat.com> + + 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 <richard.sandiford@linaro.org> + + * 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 <mjambor@suse.cz> + + 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 <segher@kernel.crashing.org> * config/rs6000/rs6000.md (conditional branch): Clean up formatting. @@ -47,12 +1184,12 @@ 2017-10-08 Jan Hubicka <hubicka@ucw.cz> - * i386.c (ix86_expand_set_or_movmem): Disable 512bit loops for targets - that preffer 128bit. + * config/i386/i386.c (ix86_expand_set_or_movmem): Disable 512bit loops + for targets that preffer 128bit. 2017-10-08 Jan Hubicka <hubicka@ucw.cz> - * i386.c (has_dispatch): Disable for Ryzen. + * config/i386/i386.c (has_dispatch): Disable for Ryzen. 2017-10-08 Olivier Hainque <hainque@adacore.com> @@ -249,8 +1386,8 @@ 2017-10-05 Jan Hubicka <hubicka@ucw.cz> - * 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 <tamar.christina@arm.com> @@ -258,13 +1395,13 @@ 2017-10-05 Jan Hubicka <hubicka@ucw.cz> - * 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 <hubicka@ucw.cz> - * 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 @@ -272,13 +1409,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. @@ -538,7 +1676,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 <krister.walfridsson@gmail.com> @@ -983,7 +2121,7 @@ * rs6000.md (allocate_stack): Handle -fstack-clash-protection. (probe_stack_range<P:mode>): Operand 0 is now early-clobbered. Add additional operand and pass it to output_probe_stack_range. - + 2017-09-25 Bin Cheng <bin.cheng@arm.com> PR tree-optimization/82163 @@ -1415,7 +2553,7 @@ 2017-09-22 Sergey Shalnov <sergey.shalnov@intel.com> - * config/i386/sse.md ("mov<mode>_internal"): Use <sseinsnmode> + * config/i386/sse.md ("mov<mode>_internal"): Use <sseinsnmode> mode attribute for TARGET_AVX512VL. 2017-09-21 Sergey Shalnov <sergey.shalnov@intel.com> @@ -1694,9 +2832,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/ChangeLog.upc b/gcc/ChangeLog.upc index bf122213e48..6e69bcd9971 100644 --- a/gcc/ChangeLog.upc +++ b/gcc/ChangeLog.upc @@ -1,3 +1,7 @@ +2017-10-16 Gary Funck <gary@intrepid.com> + + Merge trunk version 253779 into gupc branch. + 2017-10-09 Gary Funck <gary@intrepid.com> Merge trunk version 253536 into gupc branch. diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 41bcb54a1ca..ec771937228 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20171009 +20171016 diff --git a/gcc/Makefile.in b/gcc/Makefile.in index 1ee6d31564f..4a87ea61ce6 100644 --- a/gcc/Makefile.in +++ b/gcc/Makefile.in @@ -4138,8 +4138,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 f4588406422..7708c5865e7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,781 @@ +2017-10-14 Hristian Kirtchev <kirtchev@adacore.com> + + * 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 <ebotcazou@adacore.com> + + * 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 <schonberg@adacore.com> + + * 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 <kirtchev@adacore.com> + + * 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 <dismukes@adacore.com> + + * exp_util.adb, freeze.adb, sem_aggr.adb, sem_util.ads, sem_util.adb, + sem_warn.adb: Minor reformattings. + +2017-10-14 Ed Schonberg <schonberg@adacore.com> + + * doc/gnat_rm/implementation_defined_aspects.rst: Add documentation + for reverse iteration over formal containers. + * gnat_rm.texi: Regenerate. + +2017-10-14 Hristian Kirtchev <kirtchev@adacore.com> + + * 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 <squirek@adacore.com> + + * sem_ch8.adb (Analyze_Subprogram_Renaming): Modify condition that + triggers marking on formal subprograms. + +2017-10-14 Javier Miranda <miranda@adacore.com> + + * 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 <ebotcazou@adacore.com> + + * 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 <bernardi@adacore.com> + + * Makefile.rtl (GNATRTL_NONTASKING_OBJ): Add s-soliin to + GNATRTL_NONTASKING_OBJ. + +2017-10-14 Bob Duff <duff@adacore.com> + + * 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 <squirek@adacore.com> + + * sem_elab.adb (Is_Suitable_Variable_Assignment): Replace call to + Has_Warnings_Off with Warnings_Off. + +2017-10-14 Piotr Trojanek <trojanek@adacore.com> + + * sinfo.ads (Generic_Parent): Remove wrong (possibly obsolete) comment. + +2017-10-14 Hristian Kirtchev <kirtchev@adacore.com> + + * 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 <bernardi@adacore.com> + + * 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 <richard.sandiford@linaro.org> + + * gcc-interface/decl.c (annotate_value): Use wi::to_wide when + operating on trees as wide_ints. + +2017-10-09 Hristian Kirtchev <kirtchev@adacore.com> + + * 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 <kirtchev@adacore.com> + + * 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 <schonberg@adacore.com> + + * 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 <brobecker@adacore.com> + + * 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 <ebotcazou@adacore.com> + + * 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 <duff@adacore.com> + + * exp_ch4.adb: Minor refactoring. + +2017-10-09 Javier Miranda <miranda@adacore.com> + + * sem_ch3.adb (Replace_Components): Browse the list of discriminants, + not components. + +2017-10-09 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_elab.adb (Static_Elaboration_Checks): Elaboration requirements + are verified only in the static model. + +2017-10-09 Ed Schonberg <schonberg@adacore.com> + + * 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 <schonberg@adacore.com> + + * 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 <squirek@adacore.com> + + * sem_ch3.adb: Rename Uses_Unseen_Priv into + Contains_Lib_Incomplete_Type. + +2017-10-09 Hristian Kirtchev <kirtchev@adacore.com> + + * 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 <kirtchev@adacore.com> + + * 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 <schonberg@adacore.com> + + * 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 <squirek@adacore.com> + + * 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 <squirek@adacore.com> + + * osint.ads: Document new parameter FD for Read_Source_File. + +2017-10-09 Ed Schonberg <schonberg@adacore.com> + + * 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 <dismukes@adacore.com> + + * exp_disp.adb: Minor reformatting. + +2017-10-09 Arnaud Charlet <charlet@adacore.com> + + * sem_warn.adb (Warn_On_Unreferenced_Entity): Fix typo. + +2017-10-09 Hristian Kirtchev <kirtchev@adacore.com> + + * 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 <duff@adacore.com> + + * 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 <schonberg@adacore.com> + + * 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 <ebotcazou@adacore.com> + + * repinfo.adb (List_Record_Layout): Tweak formatting. + (Write_Val): Remove superfluous spaces in back-end layout mode. + +2017-10-09 Piotr Trojanek <trojanek@adacore.com> + + * 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 <squirek@adacore.com> + + * 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 <duff@adacore.com> + + * 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 <kirtchev@adacore.com> + + * 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 <duff@adacore.com> + + * exp_ch7.adb (Create_Finalizer): Suppress checks within the finalizer. + +2017-10-09 Bob Duff <duff@adacore.com> + + * freeze.ads: Minor comment fixed. + +2017-10-09 Bob Duff <duff@adacore.com> + + * 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 <schonberg@adacore.com> + + * 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 <duff@adacore.com> + + * 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 <schonberg@adacore.com> + + * 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 <schonberg@adacore.com> + + * 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 <duff@adacore.com> + + * atree.adb: Make nnd apply to everything "interesting", including + Rewrite. Remove rrd. + +2017-10-09 Javier Miranda <miranda@adacore.com> + + * 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 <duff@adacore.com> + + * 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 <charlet@adacore.com> + + * doc/gnat_ugn/gnat_and_program_execution.rst: Minor edit. + +2017-10-09 Piotr Trojanek <trojanek@adacore.com> + + * libgnarl/s-taprob.adb: Minor whitespace fix. + +2017-10-09 Bob Duff <duff@adacore.com> + + * namet.ads: Minor comment fix. + +2017-10-09 Piotr Trojanek <trojanek@adacore.com> + + * 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 <squirek@adacore.com> + + * sem_ch8.adb (Update_Chain_In_Scope): Modify warning messages. + +2017-10-09 Ed Schonberg <schonberg@adacore.com> + + * 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 <derodat@adacore.com> + + * 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 <duff@adacore.com> + + * 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 <schonberg@adacore.com> + + * 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 <ebotcazou@adacore.com> PR ada/82393 diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 021da824c0d..ed43ae5273c 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 2ab4b19a1d8..ae0218e04de 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 2b1d472baba..959b3058728 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 e15a1c455bd..3fa4d99fb09 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 16feee0670b..1a7e36ca70d 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 5ed81e68531..bf0da1604ea 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 a9ea20ebd9b..b8d61a86095 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,48 @@ 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 +743,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 +830,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 +982,46 @@ 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 +1037,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 +2182,24 @@ 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 +2270,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 +2314,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 +2516,27 @@ 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 @@ -2873,6 +3052,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 6cf7710219e..7c17f939514 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 8a542ad34dd..b2c26ca4981 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 fe480beb426..e45c0542f26 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 25d08399220..2a812046247 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 @@ -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 be7338f7436..c6018227b06 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/elaboration_order_handling_in_gnat.rst b/gcc/ada/doc/gnat_ugn/elaboration_order_handling_in_gnat.rst index 688dd9961bc..c45d3fcdbee 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; + + <check that the body of Server.Gen is elaborated> + package Inst is new Server.Gen; + + T : Server.Task_Type; + + begin + <check that the body of Server.Task_Type is elaborated> + + <check that the body of Server.Proc is elaborated> + 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 + <check that the body of Server.Func is elaborated> + 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 68117ae2c49..ac45cee3305 100644 --- a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst +++ b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst @@ -4093,9 +4093,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/share/conf.py b/gcc/ada/doc/share/conf.py index 173648b26ea..e6fafcfaec0 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 e947cba2088..01d64f3aff5 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 13bf62019d7..d20440bcbf2 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -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 @@ -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 972f6d58c4c..9faed933b9f 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4125,25 +4125,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 +4157,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 +6653,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 +7458,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 d53466fc39c..73af9a05059 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 552cd0295b5..719699566e4 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -6512,7 +6512,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 +6525,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_ch3.adb b/gcc/ada/exp_ch3.adb index 0198e3e5f7e..837c8a98d86 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,116 @@ 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_Type + | E_Task_Subtype + => + -- 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_Type + | E_Array_Subtype + => + -- 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_Record_Type + | E_Record_Subtype + | E_Protected_Type + | E_Protected_Subtype + => + 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, 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_Type + | E_Limited_Private_Subtype + | E_Record_Type_With_Private + | E_Record_Subtype_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 +5929,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 +6072,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 +6087,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 +6254,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 +6318,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 +6473,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 +6763,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; @@ -6619,9 +6802,9 @@ package body Exp_Ch3 is 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))))) + and then + not Is_Definite_Subtype (Etype (Return_Applies_To + (Return_Statement_Entity (Parent (N))))) then null; @@ -8362,10 +8545,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 0fe189b8a40..770341ce9eb 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5451,12 +5451,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 +5558,66 @@ 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'); - - 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)))); + declare + Cnn : constant Entity_Id := Make_Temporary (Loc, 'C', N); + Ptr_Typ : constant Entity_Id := Make_Temporary (Loc, 'A'); + 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 := <Thenx>'Unrestricted_Access; - -- else - -- Cnn := <Elsex>'Unrestricted_Access; - -- end if; + -- Generate: + -- if Cond then + -- Cnn := <Thenx>'Unrestricted_Access; + -- else + -- Cnn := <Elsex>'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 @@ -5677,31 +5676,33 @@ package body Exp_Ch4 is -- and replace the if expression by a reference to Cnn - Cnn := Make_Temporary (Loc, 'C', N); - - Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Cnn, - Object_Definition => New_Occurrence_Of (Typ, Loc)); + declare + Cnn : constant Node_Id := Make_Temporary (Loc, 'C', N); + 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 5846874fc30..9d2f652f119 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 715e74cfebe..4e229c452a4 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2251,10 +2251,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 +3003,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 +4335,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 +4345,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 +5025,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)) @@ -5298,16 +5298,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 +6448,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 +7228,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 @@ -7213,7 +7240,37 @@ 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 + if True then + return False; -- ???disable bip for nonlimited types + end if; + + if Has_Interfaces (Typ) then + return False; + end if; + + -- For T'Class, return True if it's True for the corresponding + -- specific type. This is necessary because a class-wide function + -- might say "return F (...)", where F returns the corresponding + -- specific type. + + if Is_Class_Wide_Type (Typ) then + return Is_Build_In_Place_Result_Type (Etype (Typ)); + end if; + + declare + T : Entity_Id := Typ; + begin + if Present (Underlying_Type (Typ)) then + T := Underlying_Type (Typ); + end if; + + declare + Result : constant Boolean := Is_Controlled (T); + begin + return Result; + end; + end; end if; end Is_Build_In_Place_Result_Type; @@ -7301,6 +7358,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 +7746,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 +7776,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 +7797,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 +7831,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 +7906,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 +7926,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 +7987,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 +8009,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 +8133,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 +8210,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 +8237,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 + 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. - pragma Assert (not Is_Expanded_Build_In_Place_Call (Func_Call)); - Set_Is_Expanded_Build_In_Place_Call (Func_Call); + -- Start of processing for Make_Build_In_Place_Call_In_Object_Declaration - if Is_Entity_Name (Name (Func_Call)) then - Function_Id := Entity (Name (Func_Call)); - - 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 <function_Call>'reference: - -- - -- Obj : Subt renames <function_call>'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); + + -- 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 <function_Call>'reference: + -- + -- Obj : Subt renames <function_call>'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; - if Is_Class_Wide_Type (Etype (Defining_Identifier (Obj_Decl))) then - Set_Etype (Defining_Identifier (Obj_Decl), Result_Subt); + 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 +9295,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 +9328,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 07fd33ce465..713ba58b72b 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 37399adf98b..be205e47a7e 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; ------------------------------- @@ -5380,6 +5423,20 @@ package body Exp_Ch9 is 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); @@ -14095,11 +14210,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)); diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 97ac138e898..f3728f655d4 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; @@ -300,6 +301,32 @@ package body Exp_Disp is 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 cfd4b7821c9..cba4cac4145 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 57f60cd90eb..dfed6af66a7 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 + -- <IC spec> <IC body> + -- private begin + -- ... <IC call> + -- 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 + -- <IC spec> + -- <IC body> + -- private + -- <IC call> + -- 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 <Pack_Id>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, <Expr>); + -- procedure <Pack_Id>Initial_Condition is + -- begin + -- pragma Check (Initial_Condition, <Expr>); + -- end <Pack_Id>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: + -- <Pack_Id>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 48d1c2f6b54..9e5f042c181 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 811033e9d5b..5386fa6578b 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 1d64a3add34..d8ac4f8cea2 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); @@ -11220,7 +11249,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 +12650,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 99500584dd8..3fab6dd7b69 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/fmap.adb b/gcc/ada/fmap.adb index 4345dfa8005..2b95dc7be7d 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 794fdf3d095..a106d68ae86 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 079d7132abe..6ec74b466a6 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 bb28eae1192..828f6ff2999 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 113c84f390b..9c7b6e1496f 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 e6cd8d6ba50..e0d7a5f5568 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/trans.c b/gcc/ada/gcc-interface/trans.c index 18bf0713b2b..a7579378cca 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -7688,6 +7688,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 diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 882631f9bee..4bf910bca3e 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 8ed58c4fc7f..b042e2be3e1 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 49abd462265..08e4b4bff94 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 14, 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 @@ -27013,322 +27015,415 @@ 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 +@code{'Access} of entries, operators, and subprograms + +@item +Activation of tasks @item -@emph{Package initialization code} +Calls to 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 +Instantiations of generic templates +@end itemize @item -@emph{Library level task allocators} +@emph{Target} -Tasks that are declared using task allocators at the library level -start executing immediately and hence can execute at elaboration time. +A construct elaborated by a scenario is referred to as @emph{elaboration target} +or simply @strong{target}. GNAT recognizes the following targets: + + +@itemize - + +@item +For @code{'Access} of entries, operators, and subprograms, the target is the +entry, operator, or subprogram being aliased. + +@item +For activation of tasks, the target is the task body + +@item +For calls to entries, operators, and subprograms, the target is the entry, +operator, or subprogram being invoked. + +@item +For instantiations of generic templates, the target is the generic template +being instantiated. +@end itemize @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. +Elaboration code may appear in two distinct contexts: -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}. -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: +@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 -with Unit_1; -package Unit_2 is ... +with Server; +package Client is + procedure Proc; + + package Nested is + Val : ... := Server.Func; + end Nested; +end Client; @end example -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. +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. -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 +@emph{Package body statements} -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}: +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 -Sqrt_1 : Float := Sqrt (0.1); +package body Client is + procedure Proc is + begin + ... + end Proc; +begin + Proc; +end Client; @end example -The elaboration code of the body of @code{Unit_1} also contains: +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 -if expression_1 = 1 then - Q := Unit_2.Func_2; -end if; +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 -@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}: +In the example above, the elaboration order within package body @code{Client} is +as follows: + + +@enumerate + +@item +The object declaration of @code{Result} is elaborated. + + +@itemize * + +@item +Function @code{Server.Func} is invoked. +@end itemize + +@item +The subprogram body of @code{Proc} is elaborated. + +@item +Procedure @code{Proc} is invoked. + + +@itemize * + +@item +Generic unit @code{Server.Gen} is instantiated as @code{Inst}. + +@item +Instance @code{Inst} is elaborated. + +@item +Procedure @code{Inst.Eval} is invoked. +@end itemize +@end enumerate + +The elaboration order of all units within a partition depends on the following +factors: + + +@itemize * + +@item +@emph{with}ed units + +@item +purity of units + +@item +preelaborability of units + +@item +presence of elaboration control pragmas +@end itemize + +A program may have several elaboration orders depending on its structure. @example -Sqrt_2 : Float := Sqrt (0.1); +package Server is + function Func (Index : Integer) return Integer; +end Server; @end example -The elaboration code of the body of @code{Unit_2} also contains: - @example -if expression_2 = 2 then - Q := Unit_1.Func_1; -end if; +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; @end example -Now the question is, which of the following orders of elaboration is -acceptable: +@example +with Server; +package Client is + Val : constant Integer := Server.Func (3); +end Client; +@end example @example -Spec of Unit_1 -Spec of Unit_2 -Body of Unit_1 -Body of Unit_2 +with Client; +procedure Main is begin null; end Main; @end example -or +The following elaboration order exhibits a fundamental problem referred to as +@emph{access-before-elaboration} or simply @strong{ABE}. @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 +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. -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: +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}. +The following elaboration order avoids the ABE problem and the program can be +successfully elaborated. -@itemize * +@example +spec of Server +body of Server +spec of Client +body of Main +@end example -@item -@emph{Standard rules} +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. -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. -@end itemize +@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 -@geindex Elaboration checks -@geindex Checks -@geindex elaboration +To avoid placing the entire elaboration order burden on the programmer, Ada +provides three lines of defense: @itemize * @item -@emph{Dynamic elaboration checks} +@emph{Static semantics} -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. +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. @item -@emph{Elaboration control} - -Facilities are provided for the programmer to specify the desired order -of elaboration. -@end itemize +@emph{Dynamic semantics} -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: +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{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 @code{Program_Error} is raised. +An entry, operator, or subprogram can be called from elaboration code only +when the corresponding body has been elaborated. @item @emph{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 @code{Program_Error} is raised. +A generic unit can be instantiated by elaboration code only when the +corresponding body has been elaborated. + +@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 -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: +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{Elaboration control} + +Pragmas are provided for the programmer to specify the desired elaboration +order. +@end itemize + +@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{packages that do not require a body} +@emph{Packages without a body} -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: +A library package which does not require a completing body does not suffer +from ABE problems. @example -package Definitions is +package Pack 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; + type Element is private; + package Containers is + type Element_Array is array (1 .. 10) of Element; + end Containers; +end Pack; @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 +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 @geindex pragma Pure @@ -27339,12 +27434,8 @@ definitely is no package body to worry about in this case @item @emph{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 @code{Pure} places sufficient restrictions on a unit to guarantee that no +scenario within the unit can result in an ABE problem. @end itemize @geindex pragma Preelaborate @@ -27355,10 +27446,8 @@ in this unit. @item @emph{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 @code{Preelaborate} is slightly less restrictive than pragma @code{Pure}, +but still strong enough to prevent ABE problems within a unit. @end itemize @geindex pragma Elaborate_Body @@ -27369,1509 +27458,1509 @@ are no elaboration problems with any calls to the unit. @item @emph{pragma Elaborate_Body} -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. +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 +package Server is + pragma Elaborate_Body; + + function Func return Integer; +end Server; +@end example + +@example +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 + +In the example above, pragma @code{Elaborate_Body} guarantees the following +elaboration order: + +@example +spec of Server +body of Server +spec of Client +@end example + +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}. + +Removing pragma @code{Elaborate_Body} could result in the following incorrect +elaboration order: + +@example +spec of Server +spec of Client +body of Server +@end example + +where @code{Client} invokes @code{Server.Func}, but the body of @code{Server.Func} has +not been elaborated yet. @end itemize -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: +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}. + +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. -@geindex pragma Elaborate +@geindex pragma Elaborate (Unit) @itemize * @item -@emph{pragma Elaborate (unit)} +@emph{pragma Elaborate (Unit)} + +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 +package Server is + function Func return Integer; +end Server; +@end example + +@example +package body Server is + function Func return Integer is + begin + ... + end Func; +end Server; +@end example + +@example +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: + +@example +spec of Server +body of Server +spec of Client +@end example + +Removing pragma @code{Elaborate} could result in the following incorrect +elaboration order: + +@example +spec of Server +spec of Client +body of Server +@end example -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. +where @code{Client} invokes @code{Server.Func}, but the body of @code{Server.Func} +has not been elaborated yet. @end itemize -@geindex pragma Elaborate_All +@geindex pragma Elaborate_All (Unit) @itemize * @item -@emph{pragma Elaborate_All (unit)} +@emph{pragma Elaborate_All (Unit)} -This is a stronger version of the Elaborate pragma. Consider the -following example: +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 -Unit A |withs| unit B and calls B.Func in elab code -Unit B |withs| unit C, and B.Func calls C.Func +package Math is + function Factorial (Val : Natural) return Natural; +end Math; @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. +@example +package body Math is + function Factorial (Val : Natural) return Natural is + begin + ...; + end Factorial; +end Math; +@end example -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}. -@end itemize +@example +package Computer is + type Operation_Kind is (None, Op_Factorial); -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. + function Compute + (Val : Natural; + Op : Operation_Kind) return Natural; +end Computer; +@end example -The rule is simple: +@example +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; -@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.*} + return 0; + end Compute; +end Computer; +@end example + +@example +with Computer; +pragma Elaborate_All (Computer); +package Client is + Val : constant Natural := + Computer.Compute (123, Computer.Op_Factorial); +end Client; +@end example -By following this rule a client is -assured that calls can be made without risk of an exception. +In the example above, pragma @code{Elaborate_All} can result in the following +elaboration order: -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). +@example +spec of Math +body of Math +spec of Computer +body of Computer +spec of Client +@end example + +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 +spec of Math +spec of Computer +body of Computer +spec of Client +body of Math +@end example + +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 -If this rule is not followed, then a program may be in one of four -states: +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.} + +If the rule outlined above is not followed, then a program may fall in one of +the following states: @itemize * @item -@emph{No order exists} +@emph{No elaboration order exists} + +In this case a compiler must diagnose the situation, and refuse to build an +executable program. + +@item +@emph{One or more incorrect elaboration orders exist} -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. +In this case a compiler can build an executable program, but +@code{Program_Error} will be raised when the program is run. @item -@emph{One or more orders exist, all incorrect} +@emph{Several elaboration orders exist, some correct, some incorrect} -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. +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. @item -@emph{Several orders exist, some right, some incorrect} +@emph{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. +@end itemize + +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. + +@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 -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. + +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. + +@geindex Dynamic elaboration model + + +@itemize * @item -@emph{One or more orders exists, all correct} +@emph{Dynamic elaboration model} -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. +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 -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 Static elaboration model -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{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 @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 -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: +@geindex SPARK elaboration model + + +@itemize * + +@item +@emph{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. +@end itemize + +@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 + + +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}. + + +@itemize * + +@item +@emph{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 @code{Program_Error} at run time. The +checks can be suppressed using pragma @code{Suppress (Elaboration_Check)}. + +@item +@emph{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. @example -function One return Float; +package body Guaranteed_ABE is + function ABE return Integer; -Q : Float := One; + Val : constant Integer := ABE; -function One return Float is -begin - return 1.0; -end One; + function ABE return Integer is + begin + ... + end ABE; +end Guaranteed_ABE; @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}: +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 - 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 +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 One return Float is - 7. begin - 8. return 1.0; - 9. end One; -10. -11. begin -12. null; -13. end; +5. +6. function ABE return Integer is +7. begin +8. ... +9. end ABE; +10. end Guaranteed_ABE; @end example +@end itemize -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. +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}. -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: +@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 + + +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}. @example -function One return Float; +with Server; +package body Dynamic_Model is + procedure API is + begin + ... + end API; + + <check that the body of Server.Gen is elaborated> + package Inst is new Server.Gen; + + T : Server.Task_Type; -function One return Float is begin - return 1.0; -end One; + <check that the body of Server.Task_Type is elaborated> -Q : Float := One; + <check that the body of Server.Proc is elaborated> + Server.Proc; +end Dynamic_Model; @end example -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: +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. @example -function A return Integer; -function B return Integer; -function C return Integer; +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. -function B return Integer is begin return A; end; -function C return Integer is begin return B; end; -X : Integer := C; +@itemize * + +@item +@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 + <check that the body of Server.Func is elaborated> + package Inst is new Gen (Server.Func); + begin + ... + end Call_Func; -function A return Integer is begin return 1; end; + Val : constant Boolean := Call_Func; +end Static_Model; @end example -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: +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. -@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 +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. - 7. function C return Integer is begin return B; end; +@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. X : Integer := C; -10. -11. function A return Integer is begin return 1; end; -12. -13. begin -14. null; -15. end; -@end example + 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 + -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 +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 -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: +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; +@end example + +@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 + + +It is possible to mix units compiled with a different elaboration model, +however the following rules must be observed: @itemize * @item -Compile with the @code{-gnatws} switch set +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 - @item -Suppress @code{Elaboration_Check} for the called subprogram +The server unit is compiled with the dynamic model. @item -Use pragma @code{Warnings_Off} to turn warnings off for the call +The server unit is a GNAT implementation unit from the Ada, GNAT, +Interfaces, or System hierarchies. + +@item +The server unit has pragma @code{Pure} or @code{Preelaborate}. + +@item +The client unit has an explicit @code{Elaborate_All} pragma for the server +unit. +@end itemize @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. +These rules ensure that elaboration checks are not omitted. If the rules are +violated, the binder emits a warning: -@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 +@example +warning: "x.ads" has dynamic elaboration checks and with's +warning: "y.ads" which has static elaboration checks +@end example +The warnings can be suppressed by binder switch @code{-ws}. -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: +@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 + + +If the binder cannot find an acceptable elaboration order, it outputs detailed +diagnostics describing an @strong{elaboration circularity}. @example -package Math is - function Sqrt (Arg : Float) return Float; -end Math; +package Server is + function Func return Integer; +end Server; +@end example -package body Math is - function Sqrt (Arg : Float) return Float is +@example +with Client; +package body Server is + function Func return Integer is begin - ... - end Sqrt; -end Math; + ... + end Func; +end Server; +@end example -with Math; -package Stuff is - X : Float := Math.Sqrt (0.5); -end Stuff; +@example +with Server; +package Client is + Val : constant Integer := Server.Func; +end Client; +@end example -with Stuff; -procedure Main is -begin - ... -end Main; +@example +with Client; +procedure Main is begin null; end Main; +@end example + +@example +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 @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? +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 * + +@item +@emph{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. + +@item +@emph{Switch to more permissive elaboration model} + +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 all elaboration checks} -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: +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 elaboration checks selectively} + +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 - + +@item +@emph{Target suppression} + +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. @example -spec of Math -spec of Stuff -body of Math -body of Main +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 -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: +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 -with k; -package j is - m : integer := k.r; -end; +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 -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. +@item +@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); -@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 + function Func return Integer is + begin + return Server.Func; + end Func; + procedure Gen is + begin + Server.Proc; + end Gen; -@geindex Library tasks -@geindex elaboration issues + pragma Unsuppress (Elaboration_Check); -@geindex Elaboration of library tasks + task body Tsk is + begin + Server.Proc; + end Tsk; +end Range_Suppress; +@end example -In this section we examine special elaboration issues that arise for -programs that declare library level tasks. +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 -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. +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. -This can definitely result in unexpected circularities. Consider -the following example +A task can be activated in two different ways: + + +@itemize * + +@item +The task is created by an allocator in which case it is activated immediately +after the allocator is evaluated. + +@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 + +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 Decls is - task Lib_Task is - entry Start; - end Lib_Task; + task Lib_Task is + entry Start; + end Lib_Task; - type My_Int is new Integer; + type My_Int is new Integer; - function Ident (M : My_Int) return My_Int; + 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; + 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); + procedure Put_Val (Arg : Decls.My_Int); end Utils; +@end example -with Text_IO; +@example +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))); - end Put_Val; + procedure Put_Val (Arg : Decls.My_Int) is + begin + Put_Line (Arg'Img); + end Put_Val; end Utils; +@end example +@example with Decls; procedure Main is begin Decls.Lib_Task.Start; -end; +end Main; @end example -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}. - -Here is the exact chain of events we are worrying about: - - -@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. - -@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. - -@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. - -@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 +When the above example is compiled with the static model, an elaboration +circularity arises: -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. +@example +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)" +@end example -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. +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. -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. +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. -We have four possible answers to this question: +When faced with a task elaboration circularity, a programmer has several +options available: @itemize * @item -Use the dynamic model of elaboration. +@emph{Use the dynamic 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. +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}. @item -Split library tasks into separate packages. +@emph{Isolate the tasks} -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. +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: @example -package Decls1 is - task Lib_Task is - entry Start; - end Lib_Task; +package Decls1 is -- new + task Lib_Task is + entry Start; + end Lib_Task; end Decls1; +@end example +@example with Utils; -package body Decls1 is - task body Lib_Task is - begin - accept Start; - Utils.Put_Val (2); - end Lib_Task; +package body Decls1 is -- new + task body Lib_Task is + begin + accept Start; + Utils.Put_Val (2); + end Lib_Task; end Decls1; +@end example -package Decls2 is - type My_Int is new Integer; - function Ident (M : My_Int) return My_Int; +@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 - function Ident (M : My_Int) return My_Int is - begin - return M; - end Ident; +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); + procedure Put_Val (Arg : Decls2.My_Int); end Utils; +@end example -with Text_IO; +@example +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))); - end Put_Val; + 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 Decls1.Lib_Task.Start; -end; +end Main; @end example -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. - @item -Declare separate task types. +@emph{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 @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_Type is - entry Start; - end Lib_Task_Type; + task type Lib_Task is -- new + entry Start; + end Lib_Task; - type My_Int is new Integer; + type My_Int is new Integer; - function Ident (M : My_Int) return My_Int; + function Ident (M : My_Int) return My_Int; end Decls; +@end example +@example 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; + 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); + procedure Put_Val (Arg : Decls.My_Int); end Utils; +@end example -with Text_IO; +@example +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))); - end Put_Val; + procedure Put_Val (Arg : Decls.My_Int) is + begin + Put_Line (Arg'Img); + end Put_Val; end Utils; +@end example +@example with Decls; -package Declst is - Lib_Task : Decls.Lib_Task_Type; -end Declst; +package Obj_Decls is -- new + Task_Obj : Decls.Lib_Task; +end Obj_Decls; +@end example -with Declst; +@example +with Obj_Decls; procedure Main is begin - Declst.Lib_Task.Start; -end; + Obj_Decls.Task_Obj.Start; -- new +end Main; @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. +@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 -@geindex No_Entry_Calls_In_Elaboration_Code restriction +@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 -@itemize * +GNAT has several switches that affect the elaboration model and consequently +the elaboration order chosen by the binder. -@item -Use No_Entry_Calls_In_Elaboration_Code restriction. +@geindex -gnatdE (gnat) -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 @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. +@table @asis -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. +@item @code{-gnatdE} -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: +Elaboration checks on predefined units -@example -pragma Restrictions (No_Entry_Calls_In_Elaboration_Code); -@end 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. +@end table -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 +@geindex -gnatd.G (gnat) -@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} -@section Mixing Elaboration Models +@table @asis -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. +@item @code{-gnatd.G} -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. +Ignore calls through generic formal parameters for elaboration -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: +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; -@itemize * + generic + with function Gen_Formal return Integer; + package Gen is + Val : constant Integer := Gen_Formal; + end Gen; -@item -The @emph{with}ed unit is itself compiled with dynamic elaboration -checks (that is with the @code{-gnatE} switch. + package Inst is new Gen (ABE); -@item -The @emph{with}ed unit is an internal GNAT implementation unit from -the System, Interfaces, Ada, or GNAT hierarchies. + function ABE return Integer is + begin + ... + end ABE; +end Ignore_Calls; +@end example -@item -The @emph{with}ed unit has pragma Preelaborate or pragma Pure. +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 -@item -The @emph{with}ing unit (that is the client) has an explicit pragma -@code{Elaborate_All} for the @emph{with}ed unit. -@end itemize +@geindex -gnatdL (gnat) -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: + +@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 -warning: "x.ads" has dynamic elaboration checks and with's -warning: "y.ads" which has static elaboration checks +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 -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. +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 -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. +@geindex -gnatd.o (gnat) -@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 +@table @asis + +@item @code{-gnatd.o} -If the binder cannot find an acceptable order, it outputs detailed -diagnostics. For example: +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 -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. + 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 -@itemize * +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 -@item -@emph{Fix the program} +@geindex -gnatd.U (gnat) -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. -@item -@emph{Perform dynamic checks} +@table @asis -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. +@item @code{-gnatd.U} -@item -@emph{Suppress checks} +Ignore indirect calls for static elaboration -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. +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 -@item -@emph{Suppress checks selectively} +@geindex -gnatd.v (gnat) -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: +@table @asis -@itemize * +@item @code{-gnatd.v} -@item -Place the pragma that names the called subprogram in the declarative part -that contains the call. +Enforce SPARK elaboration rules in SPARK code -@item -Place the pragma in the declarative part, without naming an entity. This -disables warnings on all calls in the corresponding declarative region. +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 -@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. +@geindex -gnatd.y (gnat) -@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. -@item -Use Pragma Elaborate. +@table @asis -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. -@end itemize +@item @code{-gnatd.y} + +Disable implicit pragma Elaborate[_All] on task bodies -These five cases are listed in order of decreasing safety, and therefore -require increasing programmer care in their application. Consider the -following program: +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 -package Pack1 is - function F1 return Integer; - X1 : Integer; -end Pack1; +with Server; +package body Disable_Task is + task T; -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; + task body T is + begin + Server.Proc; + end T; +end Disable_Task; +@end example -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; +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 -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; +@geindex -gnatE (gnat) -with Pack1, Ada.Text_IO; -procedure Proc3 is -begin - Ada.Text_IO.Put_Line(Pack1.X1'Img); -- 101 -end Proc3; -@end example -In the absence of any pragmas, an attempt to bind this program produces -the following diagnostics: +@table @asis -@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: 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)" -@end example +@item @code{-gnatE} -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. +Dynamic elaboration checking mode enabled -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. +When this switch is in effect, GNAT activates the dynamic elaboration model. +@end table -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 +@geindex -gnatel (gnat) -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. +@table @asis -@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 @code{-gnatel} +Turn on info messages on generated Elaborate[_All] pragmas -@geindex Elaboration control +When this switch is in effect, GNAT will emit the following supplementary +information depending on the elaboration model in effect. -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; -begin - Constants.X := 3; - Constants.Y := 4; -end Init_Constants; -with Constants; -package Calc is - Z : Integer := Constants.X + Constants.Y; -end Calc; +@itemize - -with Calc; -with Text_IO; use Text_IO; -procedure Main is -begin - Put_Line (Calc.Z'Img); -end Main; -@end example +@item +@emph{Dynamic model} -In this example, there is more than one valid order of elaboration. For -example both the following are correct orders: +GNAT will indicate missing @code{Elaborate} and @code{Elaborate_All} pragmas for +all library-level scenarios within the partition. -@example -Init_Constants spec -Constants spec -Calc spec -Init_Constants body -Main body -@end example +@item +@emph{Static model} -and +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 -Init_Constants spec -Constants spec -Init_Constants body -Calc spec -Main body +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 + +@geindex -gnatw.f (gnat) + + +@table @asis -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. +@item @code{-gnatw.f} -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). +Turn on warnings for suspicious Subp'Access -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: +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 -pragma Elaborate_All (Constants); + 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 -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. +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 -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. +@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 -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 @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: +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. -@example -$ gnatmake -f -q main -$ main - 7 -$ gnatmake -f -q main -bargs -p -$ main - 0 -@end 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. -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. +@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. -@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 +@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}. -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: +@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 +28998,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 +29089,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 +29148,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 +29264,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 +29413,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 +29780,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 +29869,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 +29940,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 +29955,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 +30019,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 +30055,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 34c5b5d0f9a..52e84526ca4 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 57aa93e4f5a..246970fd8fd 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 1419422887f..0b0ea7f5057 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 d263b05dc1c..47109b4e3f9 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 f113b0a5993..a959e94e2fc 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 9373f9519e7..02eb1987d8e 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 a5b9858eaa9..f2b195c75c2 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 @@ -450,6 +464,8 @@ package Lib is 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 +497,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 +678,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 +817,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 +834,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 +849,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 +885,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-solita.adb b/gcc/ada/libgnarl/s-solita.adb index bb38578b06f..a5485aa268d 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 517b92d8af2..c4d33c53365 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 1dfcf39dd81..ba5a09907c1 100644 --- a/gcc/ada/libgnarl/s-taprop__linux.adb +++ b/gcc/ada/libgnarl/s-taprop__linux.adb @@ -152,11 +152,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-taprop__mingw.adb b/gcc/ada/libgnarl/s-taprop__mingw.adb index fa966514568..b14444ad185 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 3efc1e0de1a..a614507bd04 100644 --- a/gcc/ada/libgnarl/s-taprop__posix.adb +++ b/gcc/ada/libgnarl/s-taprop__posix.adb @@ -156,11 +156,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-taprop__solaris.adb b/gcc/ada/libgnarl/s-taprop__solaris.adb index e97662c12b1..26d83e584d6 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 b77fb106b37..83ebc22312e 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 daff5c1c3ae..7b9f260927e 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 ccc5683bd31..e51fa58ca61 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 462e229645c..d9fc6e3213b 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 cd53cf93471..7c8b44b952c 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 44c054fec3e..518a02c8b48 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 bc837fc9af8..a1129a1085a 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-tporft.adb b/gcc/ada/libgnarl/s-tporft.adb index 7b8a59276f8..56eda26e6a1 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 322f9915f6e..f3c2c0e969c 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 564ce205f49..a11cdd4a44d 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 0f4d45f2da8..27e352f2b46 100644 --- a/gcc/ada/libgnat/s-parame.adb +++ b/gcc/ada/libgnat/s-parame.adb @@ -50,6 +50,32 @@ 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 f48c7e0973f..60a5e997021 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 8a787f007bc..42d438e72ea 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 f20cfbebe7e..846b165561e 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 aa131147eb6..5a19c4396da 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 325aa2e4f08..97d74b6932e 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 919361ad10d..e395e017b05 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 0449ee4dbcd..b39cf0dc33d 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 534708d1a6f..ae5ec888453 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 f604f4df3be..94ead0306fa 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 402ea84818b..4242fcee7ee 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 00000000000..5364e46f6f4 --- /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 -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- 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 00000000000..ba9cf745f48 --- /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 -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- 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 cd4faaec1ed..185141b1f1b 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 ca871286fce..9e8b2abb946 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 124f7782036..72ac8fabf30 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 687d1eb75b9..96e2f3e2f92 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 781db47d0af..14fbba51152 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 4d6a4a4d8cd..b8edeec2b58 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 456c86358be..4dea281647a 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 7c56130c113..320d62222d3 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 630d592f2be..464b1b234d1 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 8f7e163cded..9398af393ba 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 bdad2520fd4..c4d7d3c80c6 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 e121e596913..aaa3ccb2e40 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 fca920a8a00..500f9220fd2 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 ad6e1ea9a3e..6c29b38b93a 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 5bedc6c8c12..5aef17df8ec 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 4f60f41e122..d34ed078be7 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 b89d8d32008..0616a201b79 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 ec270f3ad19..223703d2a43 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 - Check_Elab_Instantiation (N); + if Is_Known_Guaranteed_ABE (N) and then Needs_Body then + + -- 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); @@ -5292,6 +5377,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 +5639,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) @@ -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 + -- <or> + -- 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 79b22cd54b5..564ff0dfc0a 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 f6705d67232..1e3b78ccf2f 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 8801fb750ba..fad52ebd106 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -8860,7 +8860,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 +8921,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 e3aa50b2ddd..8c92669876c 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. @@ -971,6 +1094,8 @@ package body Sem_Ch5 is Expander_Mode_Restore; Full_Analysis := Save_Full_Analysis; end if; + + pragma Assert (not Should_Transform_BIP_Assignment (Typ => T1)); end Analyze_Assignment; ----------------------------- @@ -1833,12 +1958,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 +2080,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 +2332,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 +3646,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 cf1b83f0ade..a85ca60cd5f 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); @@ -1468,7 +1482,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 +1783,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 +1862,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 +1970,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 +4040,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 +4485,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 +4670,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 +4685,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 +8024,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 ba7ff3c848c..dc00cf9f249 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 a51cc636298..982b2221632 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 <<Done>> 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", + 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", Curr, Etype (N)); end if; end if; @@ -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 e87f5aafd51..bee5f49e874 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 cbebe2601d2..199cd8a8c7a 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_elab.adb b/gcc/ada/sem_elab.adb index 7be57cfce97..7f9ce089d4a 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -24,31 +24,27 @@ ------------------------------------------------------------------------------ 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_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,3795 +52,8367 @@ 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 + -- + -- - References to 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 references to 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 -------------------------+ - type Elab_Call_Element is record - Cloc : Source_Ptr; - Ent : Entity_Id; + ---------------------- + -- 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 conservarive 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; - package Elab_Call is new Table.Table - (Table_Component_Type => Elab_Call_Element, - Table_Index_Type => Int, - Table_Low_Bound => 1, - Table_Initial => 50, - Table_Increment => 100, - Table_Name => "Elab_Call"); + -- 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; - -- 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: + No_Elaboration_Attributes : constant Elaboration_Attributes := + (Source_Pragma => Empty, + With_Clause => Empty); - -- 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; + -- The following type captures relevant attributes which pertain to an + -- instantiation. - -- Call; -- requires a check, different context + type Instantiation_Attributes is record + Elab_Checks_OK : Boolean; + -- This flag is set when the instantiation has elaboration checks + -- enabled. - type Visited_Element is record - Subp_Id : Entity_Id; - -- The entity of the subprogram being called + 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. - Context : Node_Id; - -- The context where the call to the subprogram occurs + 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; - 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"); + -- 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 table records delayed calls which must be examined after - -- all generic bodies have been instantiated. + -- The following type captures relevant attributes which pertain to a task + -- type. - 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). + 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. - E : Entity_Id; - -- The parameter E from the call to Check_Internal_Call + Elab_Checks_OK : Boolean; + -- This flag is set when the task type has elaboration checks enabled - Orig_Ent : Entity_Id; - -- The parameter Orig_Ent from the call to Check_Internal_Call + 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. - 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. + 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. - Outer_Scope : Entity_Id; - -- Save scope of outer level call + 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. - From_Elab_Code : Boolean; - -- Save indication of whether this call is from elaboration code + 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; - 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. + -- The following type captures relevant attributes which pertain to a + -- variable. - From_SPARK_Code : Boolean; - -- Save indication of whether this call is under SPARK_Mode => On + 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 Delay_Check is new Table.Table - (Table_Component_Type => Delay_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 => "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 => "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. + Table_Name => "Top_Level_Scenarios"); + + -- 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. + + Visited_Bodies_Max : constant := 511; + + type Visited_Bodies_Index is range 0 .. Visited_Bodies_Max - 1; + + 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 -- + -- Local subprograms -- ----------------------- - -- 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 + 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 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; - 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 + 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; - 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. + 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. - -------------------------------------- - -- Activate_Elaborate_All_Desirable -- - -------------------------------------- + ----------------------- + -- Build_Call_Marker -- + ----------------------- - 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; + 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. - 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. + function In_Premature_Context (Call : Node_Id) return Boolean; + -- Determine whether call Call appears within a premature context - 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. + function Is_Bridge_Target (Id : Entity_Id) return Boolean; + pragma Inline (Is_Bridge_Target); + -- Determine whether arbitrary entity Id denotes a bridge target - procedure Set_Elab_Flag (Itm : Node_Id); - -- Sets Elaborate_[All_]Desirable as appropriate on Itm + 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. - ----------------------------- - -- Add_To_Context_And_Mark -- - ----------------------------- + 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. - procedure Add_To_Context_And_Mark (Itm : Node_Id) is - CW : constant Node_Id := - Make_With_Clause (Sloc (Itm), - Name => Name (Itm)); + ------------------------- + -- 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 - Set_Library_Unit (CW, Library_Unit (Itm)); - Set_Implicit_With (CW, True); + -- Performance note: parent traversal - -- Set elaborate all desirable on copy and then append the copy to - -- the list of body with's and we are done. + Inst := Find_Enclosing_Instance (Call); - Set_Elab_Flag (CW); - Append_To (CI, CW); - end Add_To_Context_And_Mark; + -- The call appears within an instance - ----------------- - -- In_Withs_Of -- - ----------------- + 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; - 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); + -- 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 - Itm := First (CIs); - while Present (Itm) loop - if Nkind (Itm) = N_With_Clause then - Ent := - Cunit_Entity (Get_Cunit_Unit_Number (Library_Unit (Itm))); + -- Climb the parent chain looking for premature contexts - if U = Ent then - return True; - end if; + 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; - Next (Itm); + Par := Parent (Par); end loop; return False; - end In_Withs_Of; + end In_Premature_Context; - ------------------- - -- Set_Elab_Flag -- - ------------------- + ---------------------- + -- Is_Bridge_Target -- + ---------------------- - procedure Set_Elab_Flag (Itm : Node_Id) is + function Is_Bridge_Target (Id : Entity_Id) return Boolean is begin - if Nkind (N) in N_Subprogram_Instantiation then - Set_Elaborate_Desirable (Itm); - else - Set_Elaborate_All_Desirable (Itm); + 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; - end Set_Elab_Flag; - -- Start of processing for Activate_Elaborate_All_Desirable + 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 - -- Do not set binder indication if expansion is disabled, as when - -- compiling a generic unit. + -- 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. - if not Expander_Active then + 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; - -- 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. + Call_Nam := Extract_Call_Name (N); + + -- Nothing to do when the call is erroneous or left in a bad state - if U = Main_Unit_Entity then + 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; - Itm := First (CI); - while Present (Itm) loop - if Nkind (Itm) = N_With_Clause then - Ent := Cunit_Entity (Get_Cunit_Unit_Number (Library_Unit (Itm))); + Extract_Call_Attributes + (Call => N, + Target_Id => Target_Id, + Attrs => Call_Attrs); - -- If we find it, then mark elaborate all desirable and return + -- 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 U = Ent then - Set_Elab_Flag (Itm); - return; - end if; - end if; + if Debug_Flag_LL + and then not Is_Generic_Formal_Subp (Entity (Call_Nam)) - Next (Itm); - end loop; + -- Performance note: parent traversal - -- 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. + 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; - if Is_Body_Name (Unm) - and then In_Withs_Of (Spec_Entity (UE)) + -- 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 - Add_To_Context_And_Mark (Itm); + 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; - -- 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. + -- 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. - if Is_Child_Name (Unm) then - declare - Pkg : Entity_Id; + Marker := Make_Call_Marker (Sloc (N)); - 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; + -- Inherit the attributes of the original call - -- 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; + 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); - ------------------ - -- Check_A_Call -- - ------------------ + -- The marker is inserted prior to the original call. This placement has + -- several desirable effects: - 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. + -- 1) The marker appears in the same context, in close proximity to + -- the call. - ----------------------------------- - -- Call_To_Instance_From_Outside -- - ----------------------------------- + -- <marker> + -- <call> - function Call_To_Instance_From_Outside (Id : Entity_Id) return Boolean is - Scop : Entity_Id := Id; + -- 2) Inserting the marker prior to the call ensures that an ABE check + -- will take effect prior to the call. - begin - loop - if Scop = Standard_Standard then - return False; - end if; + -- <ABE check> + -- <marker> + -- <call> - if Is_Generic_Instance (Scop) then - return not In_Open_Scopes (Scop); - end if; + -- 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. - Scop := Scope (Scop); - end loop; - end Call_To_Instance_From_Outside; + -- <ABE check> + -- <maker> + -- Temp : ... := Func_Call ...; + -- ... Temp ... - ------------------ - -- Elab_Warning -- - ------------------ + -- 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. - procedure Elab_Warning - (Msg_D : String; - Msg_S : String; - Ent : Node_Or_Entity_Id) - is - begin - -- Dynamic elaboration checks, real warning + Insert_Action (N, Marker); - 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; + -- The marker becomes the "corresponding" scenario for the call. Save + -- the marker for later processing by the ABE phase. - -- In the access case emit first warning message as well, - -- otherwise list of calls will appear as errors. + Record_Elaboration_Scenario (Marker); + end Build_Call_Marker; - elsif Elab_Warnings then - Error_Msg_NE (Msg_S, N, Ent); - end if; + --------------------------------- + -- Check_Elaboration_Scenarios -- + --------------------------------- - -- Static elaboration checks, info message + procedure Check_Elaboration_Scenarios is + begin + -- Nothing to do for ASIS. As a result, no ABE checks and diagnostics + -- are performed in this mode. - else - if Elab_Info_Messages then - Error_Msg_NE (Msg_S, N, Ent); - end if; - end if; - end Elab_Warning; + 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 - ------------------ - -- Find_W_Scope -- - ------------------ + ------------------------------ + -- In_Preelaborated_Context -- + ------------------------------ - function Find_W_Scope return Entity_Id is - Refed_Ent : constant Entity_Id := Get_Referenced_Ent (N); - W_Scope : Entity_Id; + 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 - if Is_Init_Proc (Refed_Ent) - and then not In_Same_Extended_Unit (N, Refed_Ent) + -- 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 - W_Scope := Scope (Refed_Ent); + return False; + + -- Otherwise the node appears within a preelaborated context when the + -- associated unit is preelaborated. + else - W_Scope := E; + return Is_Preelaborated_Unit (Spec_Id); end if; + end In_Preelaborated_Context; - -- Now loop through scopes to get to the enclosing compilation unit + -- Local variables - while not Is_Compilation_Unit (W_Scope) loop - W_Scope := Scope (W_Scope); - end loop; + Call_Attrs : Call_Attributes; + Level : Enclosing_Level_Kind; + Target_Id : Entity_Id; - return W_Scope; - end Find_W_Scope; + -- Start of processing for Check_Preelaborated_Call - -- Local variables + begin + Extract_Call_Attributes + (Call => Call, + Target_Id => Target_Id, + Attrs => Call_Attrs); - 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 + -- 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; - -- 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. + -- Performance note: parent traversal - elsif Nkind (Original_Node (N)) = N_Attribute_Reference - and then Attribute_Name (Original_Node (N)) = Name_Valid_Scalars - then - return; + Level := Find_Enclosing_Level (Call); - -- Intrinsics such as instances of Unchecked_Deallocation do not have - -- any body, so elaboration checking is not needed, and would be wrong. + -- Library level calls are always considered because they are part of + -- the associated unit's elaboration actions. - elsif Is_Intrinsic_Subprogram (E) then - return; + 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; - -- Do not consider references to internal variables for SPARK semantics + -- Otherwise the call does not appear at the proper level and must not + -- be considered for this check. - elsif Variable_Case and then not Comes_From_Source (E) then + else return; end if; - -- Proceed with check + -- The call appears within a preelaborated unit. Emit a warning only for + -- internal uses, otherwise this is an error. - Ent := E; + if In_Preelaborated_Context (Call) then + Error_Msg_Warn := GNAT_Mode; + Error_Msg_N + ("<<non-static call not allowed in preelaborated unit", Call); + end if; + end Check_Preelaborated_Call; - -- For a variable reference, just set Body_Acts_As_Spec to False + ---------------------- + -- Compilation_Unit -- + ---------------------- - if Variable_Case then - Body_Acts_As_Spec := False; + function Compilation_Unit (Unit_Id : Entity_Id) return Node_Id is + Comp_Unit : Node_Id; - -- Additional checks for all other cases + begin + Comp_Unit := Parent (Unit_Id); - else - -- Go to parent for derived subprogram, or to original subprogram in - -- the case of a renaming (Alias covers both these cases). + -- Handle the case where a concurrent subunit is rewritten as a null + -- statement due to expansion activities. - 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; + if Nkind (Comp_Unit) = N_Null_Statement + and then Nkind_In (Original_Node (Comp_Unit), N_Protected_Body, + N_Task_Body) + then + Comp_Unit := Parent (Comp_Unit); + pragma Assert (Nkind (Comp_Unit) = N_Subunit); - -- Nothing to do for imported entities + -- Otherwise use the declaration node of the unit - if Is_Imported (Ent) then - return; - end if; + else + Comp_Unit := Parent (Unit_Declaration_Node (Unit_Id)); + end if; - exit when Inst_Case or else No (Alias (Ent)); - Ent := Alias (Ent); - end loop; + if Nkind (Comp_Unit) = N_Subunit then + Comp_Unit := Parent (Comp_Unit); + end if; - Decl := Unit_Declaration_Node (Ent); + pragma Assert (Nkind (Comp_Unit) = N_Compilation_Unit); - if Nkind (Decl) = N_Subprogram_Body then - Body_Acts_As_Spec := True; + return Comp_Unit; + end Compilation_Unit; - elsif Nkind_In (Decl, N_Subprogram_Declaration, - N_Subprogram_Body_Stub) - or else Inst_Case - then - Body_Acts_As_Spec := False; + ----------------- + -- Elab_Msg_NE -- + ----------------- + + procedure Elab_Msg_NE + (Msg : String; + N : Node_Id; + Id : Entity_Id; + Info_Msg : Boolean; + In_SPARK : Boolean) + is + function Prefix return String; + -- Obtain the prefix of the message + + function Suffix return String; + -- Obtain the suffix of the message - -- 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). + ------------ + -- Prefix -- + ------------ + function Prefix return String is + begin + if Info_Msg then + return "info: "; else - return; + return ""; end if; - end if; + end Prefix; - E_Scope := Ent; - loop - if Elaboration_Checks_Suppressed (E_Scope) - or else Suppress_Elaboration_Warnings (E_Scope) - then - Cunit_SC := True; + ------------ + -- Suffix -- + ------------ + + function Suffix return String is + begin + if In_SPARK then + return " in SPARK"; + else + return ""; end if; + end Suffix; - -- Exit when we get to compilation unit, not counting subunits + -- Start of processing for Elab_Msg_NE - exit when Is_Compilation_Unit (E_Scope) - and then (Is_Child_Unit (E_Scope) - or else Scope (E_Scope) = Standard_Standard); + begin + Error_Msg_NE (Prefix & Msg & Suffix, N, Id); + end Elab_Msg_NE; - pragma Assert (E_Scope /= Standard_Standard); + ------------------------------ + -- Elaboration_Context_Hash -- + ------------------------------ - -- Move up a scope looking for compilation unit + function Elaboration_Context_Hash + (Key : Entity_Id) return Elaboration_Context_Index + is + begin + return Elaboration_Context_Index (Key mod Elaboration_Context_Max); + end Elaboration_Context_Hash; - E_Scope := Scope (E_Scope); - end loop; + ------------------------------ + -- Ensure_Prior_Elaboration -- + ------------------------------ - -- No checks needed for pure or preelaborated compilation units + procedure Ensure_Prior_Elaboration + (N : Node_Id; + Unit_Id : Entity_Id; + In_Task_Body : Boolean) + is + Prag_Nam : Name_Id; - if Is_Pure (E_Scope) or else Is_Preelaborated (E_Scope) then - return; + begin + -- Instantiating an external generic unit requires an implicit Elaborate + -- because Elaborate_All is too strong and could introduce non-existent + -- elaboration cycles. + + -- package External is + -- function Func ...; + -- end External; + + -- with External; + -- generic + -- package Gen is + -- X : ... := External.Func; + -- end Gen; + + -- [with External;] -- implicit with for External + -- [pragma Elaborate_All (External);] -- Elaborate_All for External + -- with Gen; + -- [pragma Elaborate (Gen);] -- Elaborate for generic + -- procedure Main is + -- package Inst is new Gen; -- calls External.Func + -- ... + -- end Main; + + if Nkind (N) in N_Generic_Instantiation then + Prag_Nam := Name_Elaborate; + + -- Otherwise generate an implicit Elaborate_All + + else + Prag_Nam := Name_Elaborate_All; end if; - -- 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. + -- Nothing to do when the need for prior elaboration came from a task + -- body and switch -gnatd.y (disable implicit pragma Elaborate_All on + -- task bodies) is in effect. + + if Debug_Flag_Dot_Y and then In_Task_Body then + return; - if not Dynamic_Elaboration_Checks - and then - Instantiation_Depth (Sloc (Ent)) > Instantiation_Depth (Sloc (N)) + -- Nothing to do when the unit is elaborated prior to the main unit. + -- This check must also consider the following cases: + + -- * No check is made against the context of the main unit because this + -- is specific to the elaboration model in effect and requires custom + -- handling (see Ensure_xxx_Prior_Elaboration). + + -- * Unit_Id is subject to pragma Elaborate_Body. An implicit pragma + -- Elaborate[_All] MUST be generated even though Unit_Id is always + -- elaborated prior to the main unit. This is a conservative strategy + -- which ensures that other units withed by Unit_Id will not lead to + -- an ABE. + + -- package A is package body A is + -- procedure ABE; procedure ABE is ... end ABE; + -- end A; end A; + + -- with A; + -- package B is package body B is + -- pragma Elaborate_Body; procedure Proc is + -- begin + -- procedure Proc; A.ABE; + -- package B; end Proc; + -- end B; + + -- with B; + -- package C is package body C is + -- ... ... + -- end C; begin + -- B.Proc; + -- end C; + + -- In the example above, the elaboration of C invokes B.Proc. B is + -- subject to pragma Elaborate_Body. If no pragma Elaborate[_All] is + -- generated for B in C, then the following elaboratio order will lead + -- to an ABE: + + -- spec of A elaborated + -- spec of B elaborated + -- body of B elaborated + -- spec of C elaborated + -- body of C elaborated <-- calls B.Proc which calls A.ABE + -- body of A elaborated <-- problem + + -- The generation of an implicit pragma Elaborate_All (B) ensures that + -- the elaboration order mechanism will not pick the above order. + + -- An implicit Elaborate is NOT generated when the unit is subject to + -- Elaborate_Body because both pragmas have the exact same effect. + + -- * Unit_Id is the main unit. An implicit pragma Elaborate[_All] MUST + -- NOT be generated in this case because a unit cannot depend on its + -- own elaboration. This case is therefore treated as valid prior + -- elaboration. + + elsif Has_Prior_Elaboration + (Unit_Id => Unit_Id, + Same_Unit_OK => True, + Elab_Body_OK => Prag_Nam = Name_Elaborate) then return; - end if; - -- Do not give a warning for a package with no body + -- Suggest the use of pragma Prag_Nam when the dynamic model is in + -- effect. - if Ekind (Ent) = E_Generic_Package and then not Has_Generic_Body (N) then - return; + 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. - -- 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. + Error_Msg_Name_1 := Prag_Nam; + Error_Msg_Qual_Level := Nat'Last; - if W_Scope = C_Scope then - if not Inter_Unit_Only then - Check_Internal_Call (N, Ent, Outer_Scope, E); + Error_Msg_NE ("info: missing pragma % for unit &", N, Unit_Id); + Error_Msg_Qual_Level := 0; end if; + end Info_Missing_Pragma; - return; - end if; + -- Local variables - -- Case of entity is not in current unit (i.e. with'ed unit case) + Elab_Attrs : Elaboration_Attributes; + Level : Enclosing_Level_Kind; - -- We are only interested in such calls if the outer call was from - -- elaboration code, or if we are in Dynamic_Elaboration_Checks mode. + -- Start of processing for Ensure_Prior_Elaboration_Dynamic - if not From_Elab_Code and then not Dynamic_Elaboration_Checks then - return; - end if; + begin + Elab_Attrs := Elaboration_Context.Get (Unit_Id); - -- Nothing to do if some scope said that no checks were required + -- Nothing to do when the unit is guaranteed prior elaboration by means + -- of a source Elaborate[_All] pragma. - if Cunit_SC then + if Present (Elab_Attrs.Source_Pragma) then return; end if; - -- 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. + -- Output extra information on a missing Elaborate[_All] pragma when + -- switch -gnatel (info messages on implicit Elaborate[_All] pragmas + -- is in effect. - if Call_To_Instance_From_Outside (Ent) then - return; - end if; + if Elab_Info_Messages then - -- 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. + -- Performance note: parent traversal - 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; + Level := Find_Enclosing_Level (N); - begin - if not Is_Controlled (Typ) then - return; - else - Init := Find_Prim_Op (Typ, Name_Initialize); + -- Declaration-level scenario - if Comes_From_Source (Init) then - Ent := Init; - else - return; - end if; - end if; - end; + 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; - -- Check cases of internal units + ------------------------------------- + -- Ensure_Prior_Elaboration_Static -- + ------------------------------------- - Callee_Unit_Internal := In_Internal_Unit (E_Scope); + 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; - -- 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 + -- Examine the context clauses looking for a suitable with. Note that + -- limited clauses do not affect the elaboration order. - if Callee_Unit_Internal and Inst_Case then - return; - end if; + 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; - if C_Scope = Standard_Standard then - Caller_Unit_Internal := False; - else - Caller_Unit_Internal := In_Internal_Unit (C_Scope); - end if; + Next (Item); + end loop; + + return Empty; + end Find_With_Clause; + + -------------------------- + -- Info_Implicit_Pragma -- + -------------------------- - -- 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). + 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 - if Callee_Unit_Internal and not Caller_Unit_Internal then + 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; - 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 ??? + -- 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; - if (Callee_Unit_Internal and Caller_Unit_Internal) - and not Debug_Flag_EE - then return; end if; - if Is_TSS (E, TSS_Deep_Initialize) then - Ent := E; + -- 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; - -- 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. + -- 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. - -- However, if we are doing dynamic elaboration, we need to chase the - -- call in the usual manner. + Clause := + Find_With_Clause + (Items => Items, + Withed_Id => Unit_Id); - -- 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. + -- Generate: + -- with Id; - Inst_Caller := Instantiation (Get_Source_File_Index (Sloc (N))); - Inst_Callee := Instantiation (Get_Source_File_Index (Sloc (Ent))); + -- 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 Inst_Caller = No_Location then - Unit_Caller := No_Unit; - else - Unit_Caller := Get_Source_Unit (N); + 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; - if Inst_Callee = No_Location then - Unit_Callee := No_Unit; + -- 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 - Unit_Callee := Get_Source_Unit (Ent); + Set_Elaborate_All_Desirable (Clause); end if; - 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)); + -- The implicit Elaborate[_All] ensures the prior elaboration of the + -- unit. Include the unit in the elaboration context of the main unit. - -- If we don't get a spec entity, just ignore call. Not quite - -- clear why this check is necessary. ??? + Elaboration_Context.Set (Unit_Id, + Elaboration_Attributes'(Source_Pragma => Empty, + With_Clause => Clause)); - if No (E_Scope) then - return; - end if; + -- Output extra information on an implicit Elaborate[_All] pragma when + -- switch -gnatel (info messages on implicit Elaborate[_All] pragmas is + -- in effect. - -- Otherwise step to enclosing compilation unit + if Elab_Info_Messages then + Info_Implicit_Pragma; + end if; + end Ensure_Prior_Elaboration_Static; - while not Is_Compilation_Unit (E_Scope) loop - E_Scope := Scope (E_Scope); - end loop; + ----------------------------- + -- Extract_Assignment_Name -- + ----------------------------- + + function Extract_Assignment_Name (Asmt : Node_Id) return Node_Id is + Nam : Node_Id; + + begin + Nam := Name (Asmt); - -- 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. + -- 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 - -- Loop to carefully follow renamings and derivations one step - -- outside the current unit, but not further. + pragma Assert (Nkind_In (Call, N_Entry_Call_Statement, + N_Function_Call, + N_Procedure_Call_Statement, + N_Requeue_Statement)); - if not (Inst_Case or Variable_Case) - and then Present (Alias (Ent)) - then - E_Scope := Alias (Ent); - else - E_Scope := Ent; - end if; + Target_Id := Entity (Extract_Call_Name (Call)); + From_Source := Comes_From_Source (Call); - loop - while not Is_Compilation_Unit (E_Scope) loop - E_Scope := Scope (E_Scope); - end loop; + -- Performance note: parent traversal - -- 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. + 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; - exit when E_Scope /= C_Scope; - Ent := Alias (Ent); - E_Scope := Ent; + -- 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 no alias, there could be a previous error, but not if we've - -- already reached the outermost level (Standard). + if not (Is_Subprogram (Target_Id) + and then Is_Generic_Instance (Target_Id)) + then + Target_Id := Get_Renamed_Entity (Target_Id); + end if; - if No (Ent) then - return; - end if; - end loop; + -- 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; - if Within_Elaborate_All (Current_Sem_Unit, E_Scope) then - return; + -- 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; - -- Determine whether the Default_Initial_Condition procedure of some - -- type is being invoked. + return Nam; + end Extract_Call_Name; + + --------------------------------- + -- Extract_Instance_Attributes -- + --------------------------------- - Is_DIC := Ekind (Ent) = E_Procedure and then Is_DIC_Procedure (Ent); + procedure Extract_Instance_Attributes + (Exp_Inst : Node_Id; + Inst_Body : out Node_Id; + Inst_Decl : out Node_Id) + is + Body_Id : Entity_Id; - -- Checks related to Default_Initial_Condition fall under the SPARK - -- umbrella because this is a SPARK-specific annotation. + begin + -- Assume that the attributes are unavailable - SPARK_Elab_Errors := - SPARK_Mode = On and (Is_DIC or Dynamic_Elaboration_Checks); + Inst_Body := Empty; + Inst_Decl := Empty; - -- Now check if an Elaborate_All (or dynamic check) is needed + -- Generic package or subprogram spec - 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) + if Nkind_In (Exp_Inst, N_Package_Declaration, + N_Subprogram_Declaration) then - -- Instantiation case + Inst_Decl := Exp_Inst; + Body_Id := Corresponding_Body (Inst_Decl); - 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; + if Present (Body_Id) then + Inst_Body := Unit_Declaration_Node (Body_Id); + end if; - -- 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. + -- Generic package or subprogram body - elsif Access_Case then - Elab_Warning ("", "info: access to & during elaboration?$?", Ent); + else + pragma Assert + (Nkind_In (Exp_Inst, N_Package_Body, N_Subprogram_Body)); - -- Variable reference in SPARK mode + Inst_Body := Exp_Inst; + Inst_Decl := Unit_Declaration_Node (Corresponding_Spec (Inst_Body)); + end if; + end Extract_Instance_Attributes; - 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; + -------------------------------------- + -- Extract_Instantiation_Attributes -- + -------------------------------------- - -- Subprogram call case + 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); - 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; + -- Traverse a possible chain of renamings to obtain the original generic + -- being instantiatied. - else - Elab_Warning - ("call to & may raise Program_Error?l?", - "info: call to & during elaboration?$?", - Ent); + 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; - Error_Msg_Qual_Level := Nat'Last; + ---------------------------------------- + -- Extract_Protected_Entry_Attributes -- + ---------------------------------------- - -- Case of Elaborate_All not present and required, for SPARK this - -- is an error, so give an error message. + 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; - if SPARK_Elab_Errors then - Error_Msg_NE -- CODEFIX - ("\Elaborate_All pragma required for&", N, W_Scope); + 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. - -- 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. + if Present (Protected_Body_Subprogram (Target_Id)) then + Spec_Id := Protected_Body_Subprogram (Target_Id); - elsif Nkind (N) in N_Subprogram_Instantiation then - Elab_Warning - ("\missing pragma Elaborate for&?l?", - "\implicit pragma Elaborate for& generated?$?", - W_Scope); + -- Extract the attributes of the barrier function - -- For all other cases, we need an implicit Elaborate_All + 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 - Elab_Warning - ("\missing pragma Elaborate_All for&?l?", - "\implicit pragma Elaborate_All for & generated?$?", - W_Scope); + Spec_Id := Target_Id; end if; - Error_Msg_Qual_Level := 0; + -- Extract the attributes of the entry body - -- 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. + Body_Id := Corresponding_Body (Unit_Declaration_Node (Spec_Id)); - Output_Calls (N, Check_Elab_Flag => True); + if Present (Body_Id) then + Body_Decl := Unit_Declaration_Node (Body_Id); + end if; + end Extract_Protected_Entry_Attributes; - -- Set flag to prevent further warnings for same unit unless in - -- All_Errors_Mode. + --------------------------------------------- + -- Extract_Protected_Subprogram_Attributes -- + --------------------------------------------- - if not All_Errors_Mode and not Dynamic_Elaboration_Checks then - Set_Suppress_Elaboration_Warnings (W_Scope); - end if; - end if; + procedure Extract_Protected_Subprogram_Attributes + (Spec_Id : out Entity_Id; + Body_Decl : out Node_Id) + is + Body_Id : Entity_Id; - -- Check for runtime elaboration check required + begin + -- Assume that the body is not available - 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. + Body_Decl := Empty; - -- Note that for this case, we do check the real unit (the one - -- from following renamings, since that is the issue). + -- When the protected subprogram has already been expanded, it + -- carries the subprogram which seizes the lock and invokes the + -- original statements. - -- Could this possibly miss a useless but required PE??? + if Present (Protected_Subprogram (Target_Id)) then + Spec_Id := + Protected_Body_Subprogram (Protected_Subprogram (Target_Id)); - Insert_Elab_Check (N, - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Elaborated, - Prefix => - New_Occurrence_Of (Spec_Entity (E_Scope), Loc))); + -- Otherwise no expansion took place - -- 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. + else + Spec_Id := Target_Id; + end if; - if Nkind (N) in N_Subprogram_Call then - Set_No_Elaboration_Check (N); - 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 -- + ----------------------------------- - -- Case of static elaboration model + 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; - 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; + begin + -- Assume that the body is not available - -- Do not generate an Elaborate_All for finalization routines - -- that perform partial clean up as part of initialization. + Body_Decl := Empty; - elsif In_Init_Proc and then Is_Finalization_Procedure (Ent) then - null; + -- 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); - -- Here we need to generate an implicit elaborate all + -- Otherwise no expansion took place else - -- Generate Elaborate_All warning unless suppressed + Spec_Id := Task_Typ; + end if; - 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; + -- Extract the attributes of the body - -- Set indication for binder to generate Elaborate_All + Body_Id := Corresponding_Body (Unit_Declaration_Node (Spec_Id)); - Set_Elaboration_Constraint (N, E, W_Scope); + 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; - end Check_A_Call; + + -- 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; ----------------------------- - -- Check_Bad_Instantiation -- + -- Extract_Task_Attributes -- ----------------------------- - procedure Check_Bad_Instantiation (N : Node_Id) is - Ent : Entity_Id; + 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 - -- Nothing to do if we do not have an instantiation (happens in some - -- error cases, and also in the formal package declaration case) + -- Assume that the body of the task procedure is not available - if Nkind (N) not in N_Generic_Instantiation then - return; + Body_Decl := Empty; - -- Nothing to do if serious errors detected (avoid cascaded errors) + -- The initial declaration is that of the task body procedure - elsif Serious_Errors_Detected /= 0 then - return; + Spec_Id := Get_Task_Body_Procedure (Task_Typ); + Body_Id := Corresponding_Body (Unit_Declaration_Node (Spec_Id)); - -- Nothing to do if not in full analysis mode + if Present (Body_Id) then + Body_Decl := Unit_Declaration_Node (Body_Id); + end if; - elsif not Full_Analysis then - return; + Prag := SPARK_Pragma (Task_Typ); - -- Nothing to do if inside a generic template + -- Set all attributes - elsif Inside_A_Generic then - return; + 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); - -- Nothing to do if a library level instantiation + -- At this point certain attributes should always be available - elsif Nkind (Parent (N)) = N_Compilation_Unit then - return; + pragma Assert (Present (Attrs.Spec_Id)); + pragma Assert (Present (Attrs.Task_Decl)); + pragma Assert (Present (Attrs.Unit_Id)); + end Extract_Task_Attributes; - -- Nothing to do if we are compiling a proper body for semantic - -- purposes only. The generic body may be in another proper body. + ------------------------------------------- + -- Extract_Variable_Reference_Attributes -- + ------------------------------------------- - elsif - Nkind (Parent (Unit_Declaration_Node (Main_Unit_Entity))) = N_Subunit - then - return; - end if; + 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. - Ent := Get_Generic_Entity (N); + Var_Id := Get_Renamed_Entity (Entity (Ref)); - -- The case we are interested in is when the generic spec is in the - -- current declarative part + Attrs.SPARK_Mode_On := Is_SPARK_Mode_On_Node (Ref); + Attrs.Unit_Id := Find_Top_Unit (Var_Id); - if not Same_Elaboration_Scope (Current_Scope, Scope (Ent)) - or else not In_Same_Extended_Unit (N, Ent) - then - return; - end if; + -- At this point certain attributes should always be available + + pragma Assert (Present (Attrs.Unit_Id)); + end Extract_Variable_Reference_Attributes; + + -------------------- + -- Find_Code_Unit -- + -------------------- - -- 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. + function Find_Code_Unit (N : Node_Or_Entity_Id) return Entity_Id is + N_Unit : constant Node_Id := Unit (Cunit (Get_Code_Unit (N))); + + begin + return Defining_Entity (N_Unit, Concurrent_Subunit => True); + end Find_Code_Unit; + + --------------------------- + -- Find_Elaborated_Units -- + --------------------------- - declare - D1 : constant Nat := Instantiation_Depth (Sloc (Ent)); - D2 : constant Nat := Instantiation_Depth (Sloc (N)); + 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 - if D1 > D2 then + -- Nothing to do if the pragma is not related to elaboration + + if not Nam_In (Prag_Nam, Name_Elaborate, Name_Elaborate_All) then return; - elsif D1 = D2 - and then Is_Generic_Instance (Scope (Ent)) - and then not In_Open_Scopes (Scope (Ent)) + -- 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; - end; - -- Now we can proceed, if the entity being called has a completion, - -- then we are definitely OK, since we have already seen the body. + -- Add or update the attributes of the unit - if Has_Completion (Ent) then - return; - end if; + Elaboration_Context.Set (Unit_Id, Elab_Attrs); - -- If there is no body, then nothing to do + -- Includes all units withed by the current one when computing the + -- full context. - if not Has_Generic_Body (N) then - return; - end if; + if Full_Context then - -- Here we definitely have a bad instantiation + -- Process all nonlimited with clauses found in the context of + -- the current unit. Note that limited clauses do not impose an + -- elaboration order. - Error_Msg_Warn := SPARK_Mode /= On; - Error_Msg_NE ("cannot instantiate& before body seen<<", N, Ent); + 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; - if Present (Instance_Spec (N)) then - Supply_Bodies (Instance_Spec (N)); - end if; + Next (Clause); + end loop; + end if; + end Add_Unit; - Error_Msg_N ("\Program_Error [<<", N); - Insert_Elab_Check (N); - Set_ABE_Is_Certain (N); - end Check_Bad_Instantiation; + ------------------------------ + -- Find_Elaboration_Context -- + ------------------------------ - --------------------- - -- Check_Elab_Call -- - --------------------- + procedure Find_Elaboration_Context (Comp_Unit : Node_Id) is + Prag : Node_Id; - procedure Check_Elab_Call - (N : Node_Id; - Outer_Scope : Entity_Id := Empty; - In_Init_Proc : Boolean := False) - is - Ent : Entity_Id; - P : 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 - -- 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. + -- 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: - if not In_Extended_Main_Code_Unit (N) then - return; - end if; + -- subunit -> parent subunit + -- parent subunit -> body + -- body -> spec + -- spec -> parent spec + -- parent spec -> grandparent spec and so on - -- For an entry call, check relevant restriction + -- 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. - 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); + Unt := Unit (Cunit (Main_Unit)); - -- Nothing to do if this is not an expected type of reference (happens - -- in some error conditions, and in some cases where rewriting occurs). + -- Perform the following traversals when the main unit is a subunit - 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; + -- subunit -> parent subunit + -- parent subunit -> body - -- Nothing to do if this is a call already rewritten for elab checking. - -- Such calls appear as the targets of If_Expressions. + while Present (Unt) and then Nkind (Unt) = N_Subunit loop + Find_Elaboration_Context (Parent (Unt)); - -- This check MUST be wrong, it catches far too much + -- Continue the traversal by going to the unit which contains the + -- corresponding stub. - elsif Nkind (Parent (N)) = N_If_Expression then - return; + if Present (Corresponding_Stub (Unt)) then + Unt := Unit (Cunit (Get_Source_Unit (Corresponding_Stub (Unt)))); - -- Nothing to do if inside a generic template + -- Otherwise the subunit may be erroneous or left in a bad state - elsif Inside_A_Generic - and then No (Enclosing_Generic_Body (N)) + 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 - return; + Find_Elaboration_Context (Parent (Unt)); - -- Nothing to do if call is being pre-analyzed, as when within a - -- pre/postcondition, a predicate, or an invariant. + -- Continue the traversal by going to the unit which contains the + -- corresponding spec. - elsif In_Spec_Expression then - return; + if Present (Corresponding_Spec (Unt)) then + Unt := Unit (Cunit (Get_Source_Unit (Corresponding_Spec (Unt)))); + end if; 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. + -- 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 Nkind (N) = N_Procedure_Call_Statement - and then Is_Entity_Name (Name (N)) - and then Chars (Entity (Name (N))) = Name_uPostconditions + if Present (Unt) + and then Nkind_In (Unt, N_Generic_Package_Declaration, + N_Generic_Subprogram_Declaration, + N_Package_Declaration, + N_Subprogram_Declaration) then - return; + 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; - -- Here we have a reference at elaboration time that must be checked + ----------------------------- + -- Find_Enclosing_Instance -- + ----------------------------- - if Debug_Flag_LL then - Write_Str (" Check_Elab_Ref: "); + function Find_Enclosing_Instance (N : Node_Id) return Node_Id is + Par : Node_Id; + Spec_Id : Entity_Id; - if Nkind (N) = N_Attribute_Reference then - if not Is_Entity_Name (Prefix (N)) then - Write_Str ("<<not entity name>>"); - else - Write_Name (Chars (Entity (Prefix (N)))); + 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; - Write_Str ("'Access"); + Par := Parent (Par); + end loop; - elsif No (Name (N)) or else not Is_Entity_Name (Name (N)) then - Write_Str ("<<not entity name>> "); + return Empty; + end Find_Enclosing_Instance; - else - Write_Name (Chars (Entity (Name (N)))); + -------------------------- + -- 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; - Write_Str (" reference at "); - Write_Location (Sloc (N)); - Write_Eol; + 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 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). + -- 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. - -- 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. + 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; - P := Parent (N); - while Present (P) loop - if Nkind_In (P, N_Parameter_Specification, - N_Component_Declaration) + -- 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 - return; + -- 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. - -- The reference occurs within the constraint of a component, - -- so it must be checked. + if Nkind (Prev) = N_Handled_Sequence_Of_Statements + and then Handled_Statement_Sequence (Curr) = Prev + then + return No_Level; - elsif Nkind (P) = N_Component_Definition then - exit; + -- Otherwise the traversal came from the declarations, the node is + -- at the declaration level. - else - P := Parent (P); - end if; - end loop; + else + return Declaration_Level; + end if; - -- Stuff that happens only at the outer level + -- 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. - if No (Outer_Scope) then - Elab_Visited.Set_Last (0); + elsif Is_Non_Library_Level_Encapsulator (Curr) then + Context := Parent (Curr); - -- Nothing to do if current scope is Standard (this is a bit odd, but - -- it happens in the case of generic instantiations). + -- The sole exception is when the encapsulator is the compilation + -- utit itself because the compilation unit node requires special + -- processing (see below). - C_Scope := Current_Scope; + if Present (Context) + and then Nkind (Context) = N_Compilation_Unit + then + null; - if C_Scope = Standard_Standard then - return; + -- 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; - -- First case, we are in elaboration code + Prev := Curr; + Curr := Parent (Prev); + end loop; - From_Elab_Code := not In_Subprogram_Or_Concurrent_Unit; + return No_Level; + end Find_Enclosing_Level; - if From_Elab_Code then + ------------------- + -- Find_Top_Unit -- + ------------------- - -- Complain if ref that comes from source in preelaborated unit - -- and we are not inside a subprogram (i.e. we are in elab code). + function Find_Top_Unit (N : Node_Or_Entity_Id) return Entity_Id is + N_Unit : constant Node_Id := Unit (Cunit (Get_Top_Level_Code_Unit (N))); - if Comes_From_Source (N) - and then In_Preelaborated_Unit - and then not In_Inlined_Body - and then Nkind (N) /= N_Attribute_Reference + begin + return Defining_Entity (N_Unit, Concurrent_Subunit => True); + end Find_Top_Unit; + + ----------------------- + -- 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 - -- This is a warning in GNAT mode allowing such calls to be - -- used in the predefined library with appropriate care. + Typ := Anonymous_Object (Typ); - Error_Msg_Warn := GNAT_Mode; - Error_Msg_N - ("<<non-static call not allowed in preelaborated unit", N); - return; + 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; - -- Second case, we are inside a subprogram or concurrent unit, which - -- means we are not in elaboration code. + return Typ; + end if; - else - -- In this case, the issue is whether we are inside the - -- declarative part of the unit in which we live, or inside its - -- statements. In the latter case, there is no issue of ABE calls - -- at this level (a call from outside to the unit in which we live - -- might cause an ABE, but that will be detected when we analyze - -- that outer level call, as it recurses into the called unit). - - -- Climb up the tree, doing this test, and also testing for being - -- inside a default expression, which, as discussed above, is not - -- checked at this stage. - - declare - P : Node_Id; - L : List_Id; - - begin - P := N; - loop - -- If we find a parentless subtree, it seems safe to assume - -- that we are not in a declarative part and that no - -- checking is required. - - if No (P) then - return; - end if; + return Empty; + end First_Formal_Type; - if Is_List_Member (P) then - L := List_Containing (P); - P := Parent (L); - else - L := No_List; - P := Parent (P); - end if; + -------------- + -- Has_Body -- + -------------- - exit when Nkind (P) = N_Subunit; + 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. - -- Filter out case of default expressions, where we do not - -- do the check at this stage. + 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. - if Nkind_In (P, N_Parameter_Specification, - N_Component_Declaration) - then - return; - end if; + 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 -- + ----------------------------- - -- A protected body has no elaboration code and contains - -- only other bodies. + 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; - if Nkind (P) = N_Protected_Body then - return; + begin + if Is_Compilation_Unit (Spec_Id) then + Body_Id := Corresponding_Body (Spec_Decl); - elsif Nkind_In (P, N_Subprogram_Body, - N_Task_Body, - N_Block_Statement, - N_Entry_Body) - then - if L = Declarations (P) then - exit; + if Present (Body_Id) then + return Unit_Declaration_Node (Body_Id); - -- We are not in elaboration code, but we are doing - -- dynamic elaboration checks, in this case, we still - -- need to do the reference, since the subprogram we are - -- in could be called from another unit, also in dynamic - -- elaboration check mode, at elaboration time. + -- The package is at the library and requires a body. Load the + -- corresponding body because the optional body may be declared + -- there. - elsif Dynamic_Elaboration_Checks then + elsif Unit_Requires_Body (Spec_Id) then + return + Load_Package_Body + (Get_Body_Name (Unit_Name (Get_Source_Unit (Spec_Decl)))); - -- We provide a debug flag to disable this check. That - -- way we have an easy work around for regressions - -- that are caused by this new check. This debug flag - -- can be removed later. + -- Otherwise there is no optional body - if Debug_Flag_DD then - return; - end if; + else + return Empty; + end if; - -- Do the check in this case + -- The immediate context is a package. The optional body may be + -- within the body of that package. - exit; + -- procedure Proc is + -- package Nested_1 is + -- package Nested_2 is + -- generic + -- package Pack is + -- end Pack; + -- end Nested_2; + -- end Nested_1; - elsif Nkind (P) = N_Task_Body then + -- package body Nested_1 is + -- package body Nested_2 is separate; + -- end Nested_1; - -- The check is deferred until Check_Task_Activation - -- but we need to capture local suppress pragmas - -- that may inhibit checks on this call. + -- separate (Proc.Nested_1.Nested_2) + -- package body Nested_2 is + -- package body Pack is -- optional body + -- ... + -- end Pack; + -- end Nested_2; - Ent := Get_Referenced_Ent (N); + elsif Is_Package_Or_Generic_Package (Context) then + Body_Decl := Find_Corresponding_Body (Context); - if No (Ent) then - return; + -- The optional body is within the body of the enclosing package - 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; + if Present (Body_Decl) then + return + Find_Body + (Spec_Id => Spec_Id, + From => First (Declarations (Body_Decl))); - return; + -- Otherwise the enclosing package does not have a body. This may + -- be the result of an error or a genuine lack of a body. - -- 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. + else + return Empty; + end if; - else - return; - end if; - end if; - end loop; - end; - end if; - end if; + -- Otherwise the immediate context is a body. The optional body may + -- be within the same list as the spec. - Ent := Get_Referenced_Ent (N); + -- procedure Proc is + -- generic + -- package Pack is + -- end Pack; - if No (Ent) then - return; - end if; + -- 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; - -- 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. + --------------- + -- Find_Body -- + --------------- - declare - Self : constant Visited_Element := - (Subp_Id => Ent, Context => Parent (N)); + 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 - for Index in 1 .. Elab_Visited.Last loop - if Self = Elab_Visited.Table (Index) then - return; + 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; - end; - -- See if we need to analyze this reference. We analyze it if either of - -- the following conditions is met: + return Empty; + end Find_Body; - -- 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. + ----------------------- + -- Load_Package_Body -- + ----------------------- - -- It is an outer level reference from elaboration code, or a call to - -- an entity is in the same elaboration scope. + function Load_Package_Body (Unit_Nam : Unit_Name_Type) return Node_Id is + Body_Decl : Node_Id; + Unit_Num : Unit_Number_Type; - -- And in these cases, we will check both inter-unit calls and - -- intra-unit (within a single unit) calls. + begin + -- The load is performed only when the compilation will generate code - C_Scope := Current_Scope; + if Operating_Mode = Generate_Code then + Unit_Num := + Load_Unit + (Load_Name => Unit_Nam, + Required => False, + Subunit => False, + Error_Node => Pack_Decl); - -- If not outer level reference, then we follow it if it is within the - -- original scope of the outer reference. + -- The load failed most likely because the physical file is + -- missing. - 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 Unit_Num = No_Unit then + return Empty; - elsif From_Elab_Code then - Set_C_Scope; - Check_A_Call (N, Ent, Standard_Standard, Inter_Unit_Only => False); + -- Otherwise the load was successful, return the body of the unit - elsif Same_Elaboration_Scope (C_Scope, Scope (Ent)) then - Set_C_Scope; - Check_A_Call (N, Ent, Scope (Ent), Inter_Unit_Only => False); + else + Body_Decl := Unit (Cunit (Unit_Num)); - -- 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. + -- If the unit is a subunit with an available proper body, + -- return the proper body. - elsif Dynamic_Elaboration_Checks then - Set_C_Scope; - Check_A_Call - (N, - Ent, - Standard_Standard, - Inter_Unit_Only => True, - Generate_Warnings => False); + if Nkind (Body_Decl) = N_Subunit + and then Present (Proper_Body (Body_Decl)) + then + Body_Decl := Proper_Body (Body_Decl); + end if; - -- Otherwise nothing to do + 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; + return Present (Find_Corresponding_Body (Pack_Id)); end if; + end Has_Body; - -- 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. + --------------------------- + -- Has_Prior_Elaboration -- + --------------------------- - if Is_Init_Proc (Ent) and then From_Elab_Code then - Process_Init_Proc : declare - Unit_Decl : constant Node_Id := Unit_Declaration_Node (Ent); + 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); - function Check_Init_Call (Nod : Node_Id) return Traverse_Result; - -- Find subprogram calls within body of Init_Proc for Traverse - -- instantiation below. + begin + -- A preelaborated unit is always elaborated prior to the main unit - procedure Traverse_Body is new Traverse_Proc (Check_Init_Call); - -- Traversal procedure to find all calls with body of Init_Proc + if Is_Preelaborated_Unit (Unit_Id) then + return True; - --------------------- - -- Check_Init_Call -- - --------------------- + -- An internal unit is always elaborated prior to a non-internal main + -- unit. - function Check_Init_Call (Nod : Node_Id) return Traverse_Result is - Func : Entity_Id; + elsif In_Internal_Unit (Unit_Id) + and then not In_Internal_Unit (Main_Id) + then + return True; - begin - if Nkind (Nod) in N_Subprogram_Call - and then Is_Entity_Name (Name (Nod)) - then - Func := Entity (Name (Nod)); + -- A unit has prior elaboration if it appears within the context of the + -- main unit. Consider this case only when requested by the caller. - if Comes_From_Source (Func) then - Check_A_Call - (N, Func, Standard_Standard, Inter_Unit_Only => True); - end if; + elsif Context_OK + and then Elaboration_Context.Get (Unit_Id) /= No_Elaboration_Attributes + then + return True; - return OK; + -- 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. - else - return OK; - end if; - end Check_Init_Call; + 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; - -- Start of processing for Process_Init_Proc + -- 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. - begin - if Nkind (Unit_Decl) = N_Subprogram_Body then - Traverse_Body (Handled_Statement_Sequence (Unit_Decl)); - end if; - end Process_Init_Proc; + elsif Same_Unit_OK and then Is_Same_Unit (Unit_Id, Main_Id) then + return True; end if; - end Check_Elab_Call; - ----------------------- - -- Check_Elab_Assign -- - ----------------------- + return False; + end Has_Prior_Elaboration; - procedure Check_Elab_Assign (N : Node_Id) is - Ent : Entity_Id; - Scop : Entity_Id; + -------------------------- + -- In_External_Instance -- + -------------------------- - Pkg_Spec : Entity_Id; - Pkg_Body : Entity_Id; + 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 - -- 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. + -- 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 Nkind_In (N, N_Indexed_Component, - N_Selected_Component, - N_Slice) + if Present (Inst_Decl) + and then Nkind (Inst_Decl) = N_Package_Declaration then - if not Is_Access_Type (Etype (Prefix (N))) then - Check_Elab_Assign (Prefix (N)); - end if; + -- The scenario comes from the main unit and the instance does not - return; - end if; + if In_Extended_Main_Code_Unit (N) + and then not In_Extended_Main_Code_Unit (Inst_Decl) + then + return True; - -- For type conversion, check expression + -- Otherwise the scenario must not appear within the instance spec or + -- body. - if Nkind (N) = N_Type_Conversion then - Check_Elab_Assign (Expression (N)); - return; + 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; - -- Nothing to do if this is not an entity reference otherwise get entity + return False; + end In_External_Instance; - if Is_Entity_Name (N) then - Ent := Entity (N); - else - return; + --------------------- + -- 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; - -- 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. + return True; + end In_Main_Context; - 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); + --------------------- + -- 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; - end loop; - -- Here Scop points to the containing library package + Par := Parent (Par); + end loop; - Pkg_Spec := Scop; - Pkg_Body := Body_Entity (Pkg_Spec); + return Empty; + end Find_Enclosing_Context; - -- All OK if the package has an Elaborate_Body pragma + ----------------------- + -- In_Nested_Context -- + ----------------------- - if Has_Pragma_Elaborate_Body (Scop) then - return; - end if; + function In_Nested_Context + (Outer : Node_Id; + Inner : Node_Id) return Boolean + is + Par : Node_Id; - -- OK if entity being modified is not in containing package spec + begin + Par := Inner; + while Present (Par) loop - if not In_Same_Source_Unit (Scop, Ent) then - return; - end if; + -- A traversal from a subunit continues via the corresponding stub - -- 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. + if Nkind (Par) = N_Subunit then + Par := Corresponding_Stub (Par); - 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; + elsif Par = Outer then + return True; end if; - Scop := Scope (Scop); + Par := Parent (Par); end loop; - -- All OK if in task, don't issue warnings there + return False; + end In_Nested_Context; - if In_Task_Activation then - return; - end if; + -- Local variables - -- OK if no package body + Context_1 : constant Node_Id := Find_Enclosing_Context (N1); + Context_2 : constant Node_Id := Find_Enclosing_Context (N2); - if No (Pkg_Body) then - return; - end if; + -- Start of processing for In_Same_Context - -- OK if reference is not in package body + begin + -- Both nodes appear within the same context - if not In_Same_Source_Unit (Pkg_Body, N) then - return; - end if; + if Context_1 = Context_2 then + return True; - -- OK if package body has no handled statement sequence + -- Both nodes appear in compilation units. Determine whether one unit + -- is the body of the other. - 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; + 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))); - -- 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. + -- The context of N1 encloses the context of N2 - Set_Elaborate_Body_Desirable (Pkg_Spec); + elsif Nested_OK and then In_Nested_Context (Context_1, Context_2) then + return True; + end if; - -- All OK in gnat mode (we know what we are doing) + return False; + end In_Same_Context; - if GNAT_Mode then - return; - end if; + ---------------- + -- Initialize -- + ---------------- - -- All OK if all warnings suppressed + 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. - if Warning_Mode = Suppress then - return; - end if; + 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 - -- All OK if elaboration checks suppressed for entity + elsif Is_TSS (Target_Id, TSS_Deep_Finalize) then + Info_Type_Actions ("finalization"); - if Checks_May_Be_Suppressed (Ent) - and then Is_Check_Suppressed (Ent, Elaboration_Check) + -- 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 - return; - end if; + Info_Type_Actions ("initialization"); - -- 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. + -- Invariant - 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; - end if; - end; + elsif Is_Invariant_Proc (Target_Id) then + Info_Verification_Call + (Pred => "invariants", + Id => First_Formal_Type (Target_Id), + Id_Kind => "type"); - -- Here is where we give the warning + -- Partial invariant calls must not appear in the output because this + -- creates confusing noise. - -- All OK if warnings suppressed on the entity + elsif Is_Partial_Invariant_Proc (Target_Id) then + null; - if not Has_Warnings_Off (Ent) then - Error_Msg_Sloc := Sloc (Ent); + -- _Postconditions - 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; + 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; - if not All_Errors_Mode then - Set_Suppress_Elaboration_Warnings (Ent); + else + pragma Assert (False); + null; end if; end if; - end Check_Elab_Assign; + end Info_Call; - ---------------------- - -- Check_Elab_Calls -- - ---------------------- + ------------------------ + -- Info_Instantiation -- + ------------------------ - -- WARNING: This routine manages SPARK regions + 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; - procedure Check_Elab_Calls is - Saved_SM : SPARK_Mode_Type; - Saved_SMP : Node_Id; + ------------------------ + -- 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 - -- 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. + -- 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 (not Expander_Active and not GNATprove_Mode) - or else Is_Generic_Unit (Cunit_Entity (Main_Unit)) - or else Subunits_Missing + if Nkind (N) in N_Generic_Instantiation + and then Present (Instance_Spec (N)) then - return; + return Instance_Spec (N); + + -- Otherwise the proper insertion node is the candidate insertion node + + else + return Ins_Nod; end if; + end Insertion_Node; - -- Skip delayed calls if we had any errors + ----------------------- + -- Install_ABE_Check -- + ----------------------- - if Serious_Errors_Detected = 0 then - Delaying_Elab_Checks := False; - Expander_Mode_Save_And_Set (True); + 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 - 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; + 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; - Saved_SM := SPARK_Mode; - Saved_SMP := SPARK_Mode_Pragma; + begin + -- Nothing to do when compiling for GNATprove because raise statements + -- are not supported. - -- Set appropriate value of SPARK_Mode + if GNATprove_Mode then + return; - if Delay_Check.Table (J).From_SPARK_Code then - SPARK_Mode := On; - end if; + -- Nothing to do when the compilation will not produce an executable - 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); + elsif Serious_Errors_Detected > 0 then + return; - Restore_SPARK_Mode (Saved_SM, Saved_SMP); - Pop_Scope; - end loop; + -- 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: - -- Set Delaying_Elab_Checks back on for next main compilation + -- * Id's unit appears in the context of the main unit - Expander_Mode_Restore; - Delaying_Elab_Checks := True; + -- * 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; - end Check_Elab_Calls; - ------------------------------ - -- Check_Elab_Instantiation -- - ------------------------------ + -- 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 - procedure Check_Elab_Instantiation + 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; - Outer_Scope : Entity_Id := Empty) + Target_Id : Entity_Id; + Target_Decl : Node_Id; + Target_Body : Node_Id; + Ins_Nod : Node_Id) is - Ent : Entity_Id; + 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 - -- Check for and deal with bad instantiation case. There is some - -- duplicated code here, but we will worry about this later ??? + -- Nothing to do when compiling for GNATprove because raise statements + -- are not supported. + + if GNATprove_Mode then + return; - Check_Bad_Instantiation (N); + -- Nothing to do when the compilation will not produce an executable - if ABE_Is_Certain (N) then + elsif Serious_Errors_Detected > 0 then return; - end if; - -- Nothing to do if we do not have an instantiation (happens in some - -- error cases, and also in the formal package declaration case) + -- Nothing to do when the target is a protected subprogram because the + -- check is associated with the protected body subprogram. - if Nkind (N) not in N_Generic_Instantiation then + elsif Is_Protected_Subp (Target_Id) then return; - end if; - -- Nothing to do if inside a generic template + -- 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). - if Inside_A_Generic then + 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; - -- Nothing to do if the instantiation is not in the main unit + Install_ABE_Check + (N => N, + Ins_Nod => Ins_Nod, + Id => Target_Id); + end Install_ABE_Check; - if not In_Extended_Main_Code_Unit (N) then + ------------------------- + -- 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; - Ent := Get_Generic_Entity (N); - From_Elab_Code := not In_Subprogram_Or_Concurrent_Unit; + -- Prevent multiple scenarios from installing the same ABE failure - -- See if we need to analyze this instantiation. We analyze it if - -- either of the following conditions is met: + Set_Is_Elaboration_Checks_OK_Node (N, False); - -- 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. + -- Install the nearest enclosing scope of the scenario as there must be + -- something on the scope stack. - -- It is an outer level instantiation from elaboration code, or the - -- instantiated entity is in the same elaboration scope. + -- Performance note: parent traversal - -- And in these cases, we will check both the inter-unit case and - -- the intra-unit (within a single unit) case. + Scop_Id := Find_Enclosing_Scope (Fail_Ins_Nod); + pragma Assert (Present (Scop_Id)); - C_Scope := Current_Scope; + Push_Scope (Scop_Id); - 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); + -- Generate: + -- raise Program_Error with "access before elaboration"; - elsif From_Elab_Code then - Set_C_Scope; - Check_A_Call (N, Ent, Standard_Standard, Inter_Unit_Only => False); + Insert_Action (Fail_Ins_Nod, + Make_Raise_Program_Error (Loc, + Reason => PE_Access_Before_Elaboration)); - elsif Same_Elaboration_Scope (C_Scope, Scope (Ent)) then - Set_C_Scope; - Check_A_Call (N, Ent, Scope (Ent), Inter_Unit_Only => False); + Pop_Scope; + end Install_ABE_Failure; - -- 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. + -------------------------------- + -- Is_Accept_Alternative_Proc -- + -------------------------------- - elsif Dynamic_Elaboration_Checks then - Set_C_Scope; - Check_A_Call - (N, - Ent, - Standard_Standard, - Inter_Unit_Only => True, - Generate_Warnings => False); + function Is_Accept_Alternative_Proc (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote a procedure with a receiving entry - else - return; + 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; - end Check_Elab_Instantiation; - ------------------------- - -- Check_Internal_Call -- - ------------------------- + 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 -- + ---------------------------- - procedure Check_Internal_Call + 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; - E : Entity_Id; - Outer_Scope : Entity_Id; - Orig_Ent : Entity_Id) + Target_Decl : Node_Id; + Target_Body : Node_Id) return 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. + 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. - ------------------------------ - -- Within_Initial_Condition -- - ------------------------------ + if Serious_Errors_Detected > 0 then + return False; - function Within_Initial_Condition (Call : Node_Id) return Boolean is - Args : List_Id; - Nam : Name_Id; - Par : Node_Id; + -- The scenario and the target appear within the same context ignoring + -- enclosing library levels. - begin - -- Traverse the parent chain looking for an enclosing pragma + -- Performance note: parent traversal - Par := Call; - while Present (Par) loop - if Nkind (Par) = N_Pragma then - Nam := Pragma_Name (Par); + elsif In_Same_Context (N, Target_Decl) then - -- Pragma Initial_Condition appears in its alternative from as - -- Check (Initial_Condition, ...). + -- The target body has already been encountered. The scenario results + -- in a guaranteed ABE if it appears prior to the body. - if Nam = Name_Check then - Args := Pragma_Argument_Associations (Par); + if Present (Target_Body) then + return Earlier_In_Extended_Unit (N, Target_Body); - -- Pragma Check should have at least two arguments + -- 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. - pragma Assert (Present (Args)); + else + return True; + end if; + end if; - return - Chars (Expression (First (Args))) = Name_Initial_Condition; + return False; + end Is_Guaranteed_ABE; - -- Direct match + ------------------------------- + -- Is_Initial_Condition_Proc -- + ------------------------------- - elsif Nam = Name_Initial_Condition then - return True; + function Is_Initial_Condition_Proc (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote an Initial_Condition procedure - -- Since pragmas are never nested within other pragmas, stop - -- the traversal. + return + Ekind (Id) = E_Procedure and then Is_Initial_Condition_Procedure (Id); + end Is_Initial_Condition_Proc; - else - return False; - end if; + -------------------- + -- Is_Initialized -- + -------------------- - -- Prevent the search from going too far + function Is_Initialized (Obj_Decl : Node_Id) return Boolean is + begin + -- To qualify, the object declaration must have an expression - elsif Is_Body_Or_Package_Declaration (Par) then - exit; - end if; + return + Present (Expression (Obj_Decl)) or else Has_Init_Expression (Obj_Decl); + end Is_Initialized; - Par := Parent (Par); + ----------------------- + -- Is_Invariant_Proc -- + ----------------------- - -- 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. + function Is_Invariant_Proc (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote the "full" invariant procedure - if Nkind (Original_Node (Par)) = N_Pragma then - Par := Original_Node (Par); - end if; - end loop; + return Ekind (Id) = E_Procedure and then Is_Invariant_Procedure (Id); + end Is_Invariant_Proc; - return False; - end Within_Initial_Condition; + --------------------------------------- + -- Is_Non_Library_Level_Encapsulator -- + --------------------------------------- - -- Local variables + 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; - Inst_Case : constant Boolean := Nkind (N) in N_Generic_Instantiation; + --------------------------- + -- 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 -- + ---------------------------- - -- Start of processing for Check_Internal_Call + 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 - -- For P'Access, we want to warn if the -gnatw.f switch is set, and the - -- node comes from source. + -- 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. - 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)) + elsif In_External_Instance + (N => Call, + Target_Decl => Target_Attrs.Spec_Decl) then - return; + return True; - -- If not function or procedure call, instantiation, or 'Access, then - -- ignore call (this happens in some error cases and rewriting cases). + -- The target is a subprogram body without a previous declaration. The + -- call cannot cause an ABE because the body has already been seen. - elsif not Nkind_In (N, N_Attribute_Reference, - N_Function_Call, - N_Procedure_Call_Statement) - and then not Inst_Case + elsif Nkind (Target_Attrs.Spec_Decl) = N_Subprogram_Body + and then No (Corresponding_Spec (Target_Attrs.Spec_Decl)) then - return; + return True; - -- Nothing to do if this is a call or instantiation that has already - -- been found to be a sure ABE. + -- 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 (N) /= N_Attribute_Reference and then ABE_Is_Certain (N) then - return; + elsif Nkind (Target_Attrs.Spec_Decl) = N_Subprogram_Body_Stub + and then No (Corresponding_Spec_Of_Stub (Target_Attrs.Spec_Decl)) + then + return True; - -- Nothing to do if errors already detected (avoid cascaded errors) + -- Subprogram bodies which wrap attribute references used as actuals + -- in instantiations are always ABE-safe. These bodies are artifacts + -- of expansion. - elsif Serious_Errors_Detected /= 0 then - return; + 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; - -- Nothing to do if not in full analysis mode + return False; + end Is_Safe_Call; - elsif not Full_Analysis then - return; + --------------------------- + -- Is_Safe_Instantiation -- + --------------------------- - -- Nothing to do if analyzing in special spec-expression mode, since the - -- call is not actually being made at this time. + 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. - elsif In_Spec_Expression then - return; + if Is_Bodiless_Subprogram (Gen_Attrs.Spec_Id) then + return True; - -- Nothing to do for call to intrinsic subprogram + -- 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 Is_Intrinsic_Subprogram (E) then - return; + elsif In_External_Instance + (N => Inst, + Target_Decl => Gen_Attrs.Spec_Decl) + then + return True; - -- Nothing to do if call is within a generic unit + -- The generic is a package. The instantiation cannot cause an ABE when + -- the package has no body. - elsif Inside_A_Generic then - return; + elsif Ekind (Gen_Attrs.Spec_Id) = E_Generic_Package + and then not Has_Body (Gen_Attrs.Spec_Decl) + then + return True; + end if; - -- 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. + return False; + end Is_Safe_Instantiation; - elsif Within_Initial_Condition (N) then - return; + ------------------ + -- 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; - -- Delay this call if we are still delaying calls + Nam := Attribute_Name (N); + Pref := Prefix (N); - 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; + -- Sanitize the prefix of the attribute - -- Otherwise, call phase 2 continuation right now + if not Is_Entity_Name (Pref) then + return False; - else - Check_Internal_Call_Continue (N, E, Outer_Scope, Orig_Ent); + elsif No (Entity (Pref)) then + return False; end if; - end Check_Internal_Call; - ---------------------------------- - -- Check_Internal_Call_Continue -- - ---------------------------------- + Subp_Id := Entity (Pref); - procedure Check_Internal_Call_Continue - (N : Node_Id; - E : Entity_Id; - Outer_Scope : Entity_Id; - Orig_Ent : Entity_Id) - 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. + if not Is_Subprogram_Or_Entry (Subp_Id) then + return False; + end if; - procedure Traverse is new Atree.Traverse_Proc (Find_Elab_Reference); - -- Traverse procedure using above Find_Elab_Reference function + -- Traverse a possible chain of renamings to obtain the original entry + -- or subprogram which the prefix may rename. - ------------------------- - -- Find_Elab_Reference -- - ------------------------- + Subp_Id := Get_Renamed_Entity (Subp_Id); + + -- To qualify, the attribute must meet the following prerequisites: + + return + + -- The prefix must denote a source entry, operator, or subprogram + -- which is not imported. + + Comes_From_Source (Subp_Id) + and then Is_Subprogram_Or_Entry (Subp_Id) + and then not Is_Bodiless_Subprogram (Subp_Id) + + -- The attribute name must be one of the 'Access forms. Note that + -- 'Unchecked_Access cannot apply to a subprogram. + + and then Nam_In (Nam, Name_Access, Name_Unrestricted_Access); + end Is_Suitable_Access; + + ---------------------- + -- Is_Suitable_Call -- + ---------------------- + + 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. + + return Nkind (N) = N_Call_Marker; + end Is_Suitable_Call; + + ------------------------------- + -- Is_Suitable_Instantiation -- + ------------------------------- + + 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. + + begin + -- To qualify, the instantiation must come from source + + return + Comes_From_Source (Orig_N) + and then Nkind (Orig_N) in N_Generic_Instantiation; + end Is_Suitable_Instantiation; + + -------------------------- + -- Is_Suitable_Scenario -- + -------------------------- + + 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; + + 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 the scenario is not an assignment + + elsif Nkind (N) /= N_Assignment_Statement then + return False; + + -- Nothing to do for internally-generated assignments because they are + -- assumed to be ABE safe. + + elsif not Comes_From_Source (N) then + return False; + + -- Assignments are ignored in GNAT mode on the assumption that they are + -- ABE-safe. This behaviour parallels that of the old ABE mechanism. + + elsif GNAT_Mode then + return False; + end if; + + Nam := Extract_Assignment_Name (N); + + -- Sanitize the left hand side of the assignment + + if not Is_Entity_Name (Nam) then + return False; + + elsif No (Entity (Nam)) then + return False; + end if; + + Var_Id := Entity (Nam); - function Find_Elab_Reference (N : Node_Id) return Traverse_Result is - Actual : Node_Id; + -- Sanitize the variable + + if Var_Id = Any_Id then + return False; + + elsif Ekind (Var_Id) /= E_Variable then + return False; + end if; + + Var_Decl := Declaration_Node (Var_Id); + + if Nkind (Var_Decl) /= N_Object_Declaration then + return False; + end if; + + N_Unit_Id := Find_Top_Unit (N); + N_Unit := Unit_Declaration_Node (N_Unit_Id); + + Var_Unit_Id := Find_Top_Unit (Var_Decl); + Var_Unit := Unit_Declaration_Node (Var_Unit_Id); + + -- To qualify, the assignment must meet the following prerequisites: + + return + Comes_From_Source (Var_Id) + + -- The variable must be declared in the spec of compilation unit U + + and then Nkind (Var_Unit) = N_Package_Declaration + + -- Performance note: parent traversal + + and then Find_Enclosing_Level (Var_Decl) = Package_Spec + + -- The assignment must occur in the body of compilation unit U + + 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; + + ------------------------------- + -- Is_Suitable_Variable_Read -- + ------------------------------- + + 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 + + function Is_Variable_Read (Ref : Node_Id) return Boolean; + -- Determine whether variable reference Ref constitutes a read + + --------------- + -- In_Pragma -- + --------------- + + function In_Pragma (Nod : Node_Id) return Boolean is + Par : Node_Id; 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. + Par := Nod; + while Present (Par) loop + if Nkind (Par) = N_Pragma then + return True; - 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; + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (Par) then + exit; + end if; + + Par := Parent (Par); + end loop; - -- If we have a function call, check it + return False; + end In_Pragma; - elsif Nkind (N) = N_Function_Call then - Check_Elab_Call (N, Outer_Scope); - return OK; + ---------------------- + -- Is_Variable_Read -- + ---------------------- - -- If we have a procedure call, check the call, and also check - -- arguments that are assignments (OUT or IN OUT mode formals). + 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. - elsif Nkind (N) = N_Procedure_Call_Statement then - Check_Elab_Call (N, Outer_Scope, In_Init_Proc => Is_Init_Proc (E)); + ------------------- + -- Is_Out_Actual -- + ------------------- - Actual := First_Actual (N); - while Present (Actual) loop - if Known_To_Be_Assigned (Actual) then - Check_Elab_Assign (Actual); + function Is_Out_Actual (Call : Node_Id) return Boolean is + Actual : Node_Id; + Call_Attrs : Call_Attributes; + Formal : Entity_Id; + Target_Id : Entity_Id; + + 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; Next_Actual (Actual); + Next_Formal (Formal); end loop; - return OK; - - -- If we have an access attribute for a subprogram, check it. - -- Suppress this behavior under debug flag. + return False; + end Is_Out_Actual; - 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; + -- Local variables - -- In SPARK mode, if we have an entity reference to a variable, then - -- check it. For now we consider any reference. + Context : constant Node_Id := Parent (Ref); - 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; + -- Start of processing for Is_Variable_Read - -- If we have a generic instantiation, check it + begin + -- 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. - elsif Nkind (N) in N_Generic_Instantiation then - Check_Elab_Instantiation (N, Outer_Scope); - return OK; + -- A reference is a write when appearing immediately on the left-hand + -- side of an assignment. - -- 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. + if Nkind (Context) = N_Assignment_Statement + and then Name (Context) = Ref + then + return False; - -- 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. + -- A reference is a write when it acts as an actual in a subprogram + -- call and the corresponding formal has mode OUT. - elsif Nkind (N) = N_Subprogram_Body - and then Comes_From_Source (N) + elsif Nkind_In (Context, N_Function_Call, + N_Procedure_Call_Statement) + and then Is_Out_Actual (Context) then - return Skip; + return False; + end if; - elsif Nkind (N) = N_Assignment_Statement - and then Comes_From_Source (N) - then - Check_Elab_Assign (Name (N)); - return OK; + -- Any other reference is a read - else - return OK; - end if; - end Find_Elab_Reference; + return True; + end Is_Variable_Read; - Inst_Case : constant Boolean := Is_Generic_Unit (E); - Loc : constant Source_Ptr := Sloc (N); + -- Local variables - Ebody : Entity_Id; - Sbody : Node_Id; + Prag : Node_Id; + Var_Id : Entity_Id; - -- Start of processing for Check_Internal_Call_Continue + -- Start of processing for Is_Suitable_Variable_Read begin - -- Save outer level call if at outer level + -- 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; - if Elab_Call.Last = 0 then - Outer_Level_Sloc := Loc; + -- Attributes and operator sumbols are not considered to be suitable + -- references even though they are part of predicate Is_Entity_Name. + + elsif not Nkind_In (N, N_Expanded_Name, N_Identifier) then + return False; + + -- Nothing to do for internally-generated references because they are + -- assumed to be ABE safe. + + elsif not Comes_From_Source (N) then + return False; end if; - -- If the call is to a function that renames a literal, no check needed + -- Sanitize the reference - if Ekind (E) = E_Enumeration_Literal then - return; + Var_Id := Entity (N); + + if No (Var_Id) then + return False; + + elsif Var_Id = Any_Id then + return False; + + elsif Ekind (Var_Id) /= E_Variable then + return False; 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. + Prag := SPARK_Pragma (Var_Id); - Elab_Visited.Append ((Subp_Id => E, Context => Parent (N))); + -- To qualify, the reference must meet the following prerequisites: - Sbody := Unit_Declaration_Node (E); + return + Comes_From_Source (Var_Id) - if not Nkind_In (Sbody, N_Subprogram_Body, N_Package_Body) then - Ebody := Corresponding_Body (Sbody); + -- Both the variable and the reference must appear in SPARK_Mode On + -- regions because this scenario falls under the SPARK rules. + + and then Present (Prag) + and then Get_SPARK_Mode_From_Annotation (Prag) = On + and then Is_SPARK_Mode_On_Node (N) + + -- The reference must denote a variable read + + and then Is_Variable_Read (N) + + -- 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. + + -- Performance note: parent traversal + + and then not In_Pragma (N); + end Is_Suitable_Variable_Read; + + ------------------- + -- Is_Task_Entry -- + ------------------- + + function Is_Task_Entry (Id : Entity_Id) return Boolean is + begin + -- To qualify, the entity must denote an entry defined in a task type + + return + Is_Entry (Id) and then Is_Task_Type (Non_Private_View (Scope (Id))); + end Is_Task_Entry; + + ------------------------ + -- Is_Up_Level_Target -- + ------------------------ + + function Is_Up_Level_Target (Target_Decl : Node_Id) return Boolean is + Root : constant Node_Id := Root_Scenario; + + 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. + + -- Performance note: parent traversal + + 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. + + -- package body Main_Unit is + -- function Func ...; -- target + + -- procedure Proc is + -- X : ... := Func; -- root scenario + + if In_Extended_Main_Code_Unit (Target_Decl) then + + -- Performance note: parent traversal + + return not In_Same_Context (Root, Target_Decl, Nested_OK => True); + + -- Otherwise the target is external to the main unit which makes it + -- an up level target. - if No (Ebody) then - return; else - Sbody := Unit_Declaration_Node (Ebody); + return True; end if; end if; - -- If the body appears after the outer level call or instantiation then - -- we have an error case handled below. + return False; + end Is_Up_Level_Target; - if Earlier_In_Extended_Unit (Outer_Level_Sloc, Sloc (Sbody)) - and then not In_Task_Activation - then - null; + ------------------------------- + -- Kill_Elaboration_Scenario -- + ------------------------------- - -- If we have the instantiation case we are done, since we now know that - -- the body of the generic appeared earlier. + 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. - elsif Inst_Case then - return; + if Is_Scenario (N) then + Set_Is_Elaboration_Checks_OK_Node (N, False); + end if; + end Kill_Elaboration_Scenario; - -- Otherwise we have a call, so we trace through the called body to see - -- if it has any problems. + ---------------------------------- + -- Meet_Elaboration_Requirement -- + ---------------------------------- - 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; - 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; - -- Now traverse declarations and statements of subprogram body. Note - -- that we cannot simply Traverse (Sbody), since traverse does not - -- normally visit subprogram bodies. + begin + -- A preelaboration-related pragma comes from source and appears at + -- the top of the visible declarations of a package. - declare - Decl : Node_Id; - begin - Decl := First (Declarations (Sbody)); + if Nkind (Spec) = N_Package_Specification then + Decl := First (Visible_Declarations (Spec)); while Present (Decl) loop - Traverse (Decl); + if Comes_From_Source (Decl) then + if Nkind (Decl) = N_Pragma + and then Pragma_Name (Decl) = Prag_Nam + then + return Decl; + + -- Otherwise the construct terminates the region where the + -- preelabortion-related pragma may appear. + + else + exit; + end if; + end if; + Next (Decl); end loop; - end; + end if; - Traverse (Handled_Statement_Sequence (Sbody)); + return Empty; + end Find_Preelaboration_Pragma; - Elab_Call.Decrement_Last; - return; - end if; + -------------------------- + -- Info_Requirement_Met -- + -------------------------- + + procedure Info_Requirement_Met (Prag : Node_Id) is + begin + pragma Assert (Present (Prag)); - -- 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). + 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; - declare - P : Node_Id; - O : Node_Id; + ------------------- + -- Info_Scenario -- + ------------------- + procedure Info_Scenario is begin - P := Parent (N); - loop - -- Keep looking at parents if we are still in the subexpression + 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. - if Nkind (P) in N_Subexpr then - P := Parent (P); + else + pragma Assert (False); + null; + end if; + end Info_Scenario; - -- Here P is the parent of the expression, check for special case + -- Local variables - else - O := Original_Node (P); + Elab_Attrs : Elaboration_Attributes; + Elab_Nam : Name_Id; + Req_Met : Boolean; - -- Definitely not the special case if orig node is not a pragma + -- Start of processing for Meet_Elaboration_Requirement - exit when Nkind (O) /= N_Pragma; + begin + pragma Assert (Nam_In (Req_Nam, Name_Elaborate, Name_Elaborate_All)); - -- Check we have an If statement or a null statement (happens - -- when the If has been expanded to be True). + -- Assume that the requirement has not been met - exit when not Nkind_In (P, N_If_Statement, N_Null_Statement); + Req_Met := False; - -- Our special case will be indicated either by the pragma - -- coming from an aspect ... + -- Elaboration requirements are verified only when the static model is + -- in effect because this diagnostic is graph-dependent. - if Present (Corresponding_Aspect (O)) then - return; + if not Static_Elaboration_Checks then + return; - -- Or, in the case of an initial condition, specifically by a - -- Check pragma specifying an Initial_Condition check. + -- 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 Pragma_Name (O) = Name_Check - and then - Chars - (Expression (First (Pragma_Argument_Associations (O)))) = - Name_Initial_Condition - then - return; + elsif In_Extended_Main_Code_Unit (Target_Id) then + Req_Met := True; - -- For anything else, we have an error + -- Otherwise the target resides in an external unit - else - exit; - end if; - end if; - end loop; - end; + -- The requirement is met when the target comes from an internal unit + -- because such a unit is elaborated prior to a non-internal unit. - -- Not that special case, warning and dynamic check is required + elsif In_Internal_Unit (Unit_Id) + and then not In_Internal_Unit (Main_Id) + then + Req_Met := True; - -- 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. + -- The requirement is met when the target comes from a preelaborated + -- unit. This portion must parallel predicate Is_Preelaborated_Unit. - if Elab_Call.Last = 0 then - Error_Msg_Warn := SPARK_Mode /= On; + elsif Is_Preelaborated_Unit (Unit_Id) then + Req_Met := True; - declare - Insert_Check : Boolean := True; - -- This flag is set to True if an elaboration check should be - -- inserted. + -- Output extra information when switch -gnatel (info messages on + -- implicit Elaborate[_All] pragmas. - begin - if In_Task_Activation then - Insert_Check := False; + if Elab_Info_Messages then + if Is_Preelaborated (Unit_Id) then + Elab_Nam := Name_Preelaborate; - elsif Inst_Case then - Error_Msg_NE - ("cannot instantiate& before body seen<<", N, Orig_Ent); + elsif Is_Pure (Unit_Id) then + Elab_Nam := Name_Pure; - 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; + elsif Is_Remote_Call_Interface (Unit_Id) then + Elab_Nam := Name_Remote_Call_Interface; - elsif Nkind (Unit_Declaration_Node (Orig_Ent)) /= - N_Subprogram_Renaming_Declaration - then - Error_Msg_NE - ("cannot call& before body seen<<", N, Orig_Ent); + elsif Is_Remote_Types (Unit_Id) then + Elab_Nam := Name_Remote_Types; - elsif not Is_Generic_Actual_Subprogram (Orig_Ent) then - Insert_Check := False; + else + pragma Assert (Is_Shared_Passive (Unit_Id)); + Elab_Nam := Name_Shared_Passive; end if; - if Insert_Check then - Error_Msg_N ("\Program_Error [<<", N); - Insert_Elab_Check (N); - end if; - end; + Info_Requirement_Met (Find_Preelaboration_Pragma (Elab_Nam)); + end if; - -- Call is not at outer level + -- Determine whether the context of the main unit has a pragma strong + -- enough to meet the requirement. else - -- Do not generate elaboration checks in GNATprove mode because the - -- elaboration counter and the check are both forms of expansion. + Elab_Attrs := Elaboration_Context.Get (Unit_Id); - if GNATprove_Mode then - null; + -- The pragma must be either Elaborate_All or be as strong as the + -- requirement. - -- 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 Present (Elab_Attrs.Source_Pragma) + and then Nam_In (Pragma_Name (Elab_Attrs.Source_Pragma), + Name_Elaborate_All, + Req_Nam) + then + Req_Met := True; - -- Generate: - -- if Enn = 0 then - -- raise Program_Error with "access before elaboration"; - -- end if; + -- Output extra information when switch -gnatel (info messages on + -- implicit Elaborate[_All] pragmas. - Insert_Elab_Check (N, - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Elaborated, - Prefix => New_Occurrence_Of (E, Loc))); + if Elab_Info_Messages then + Info_Requirement_Met (Elab_Attrs.Source_Pragma); + end if; end if; + end if; - -- Generate the warning + -- The requirement was not met by the context of the main unit, issue an + -- error. - if not Suppress_Elaboration_Warnings (E) - and then not Elaboration_Checks_Suppressed (E) + if not Req_Met then + Info_Scenario; - -- 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. + Error_Msg_Name_1 := Req_Nam; + Error_Msg_Node_2 := Unit_Id; + Error_Msg_NE ("\\unit & requires pragma % for &", N, Main_Id); - 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; + Output_Active_Scenarios (N); + end if; + end Meet_Elaboration_Requirement; - if Inst_Case then - Error_Msg_NE - ("instantiation of& may occur before body is seen<l<", - N, Orig_Ent); - else - -- A rather specific check. For Finalize/Adjust/Initialize, if - -- the type has Warnings_Off set, suppress the warning. + ---------------------- + -- Non_Private_View -- + ---------------------- - if Nam_In (Chars (E), Name_Adjust, - Name_Finalize, - Name_Initialize) - and then Present (First_Formal (E)) - then - declare - T : constant Entity_Id := Etype (First_Formal (E)); - begin - if Is_Controlled (T) then - if Warnings_Off (T) - or else (Ekind (T) = E_Private_Type - and then Warnings_Off (Full_View (T))) - then - goto Output; - end if; - end if; - end; - end if; + function Non_Private_View (Typ : Entity_Id) return Entity_Id is + Result : Entity_Id; - -- Go ahead and give warning if not this special case + begin + Result := Typ; - Error_Msg_NE - ("call to& may occur before body is seen<l<", N, Orig_Ent); - end if; + if Is_Private_Type (Result) and then Present (Full_View (Result)) then + Result := Full_View (Result); + end if; - Error_Msg_N ("\Program_Error ]<l<", N); + return Result; + end Non_Private_View; - -- There is no need to query the elaboration warning message flags - -- because the main message is an error, not a warning, therefore - -- all the clarification messages produces by Output_Calls must be - -- emitted unconditionally. + ----------------------------- + -- Output_Active_Scenarios -- + ----------------------------- - <<Output>> + 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 - Output_Calls (N, Check_Elab_Flag => False); - end if; - end if; - end Check_Internal_Call_Continue; + procedure Output_Activation_Call (N : Node_Id); + -- Emit a specific diagnostic message for task activation N - --------------------------- - -- Check_Task_Activation -- - --------------------------- + 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 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. + 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. ------------------- - -- Add_Task_Proc -- + -- Output_Access -- ------------------- - procedure Add_Task_Proc (Typ : Entity_Id) is - Comp : Entity_Id; - Proc : Entity_Id := Empty; + procedure Output_Access (N : Node_Id) is + Subp_Id : constant Entity_Id := Entity (Prefix (N)); begin - if Is_Task_Type (Typ) then - Proc := Get_Task_Body_Procedure (Typ); + Error_Msg_Name_1 := Attribute_Name (N); + Error_Msg_Sloc := Sloc (N); + Error_Msg_NE ("\\ % of & taken #", Error_Nod, Subp_Id); + end Output_Access; - elsif Is_Array_Type (Typ) - and then Has_Task (Base_Type (Typ)) - then - Add_Task_Proc (Component_Type (Typ)); + ---------------------------- + -- Output_Activation_Call -- + ---------------------------- - 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; + 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 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. + -------------------- + -- Find_Activator -- + -------------------- - -- Skip this test if errors have occurred, since in this case - -- we can get false indications. + function Find_Activator (Call : Node_Id) return Entity_Id is + Par : Node_Id; - if Serious_Errors_Detected /= 0 then - return; - end if; + begin + -- Climb the parent chain looking for a package [body] or a + -- construct with a statement sequence. - if Present (Proc) then - if Outer_Unit (Scope (Proc)) = Enclosing then + Par := Parent (Call); + while Present (Par) loop + if Nkind_In (Par, N_Package_Body, N_Package_Declaration) then + return Defining_Entity (Par); - 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); + elsif Nkind (Par) = N_Handled_Sequence_Of_Statements then + return Defining_Entity (Parent (Par)); end if; - else - -- No need for multiple entries of the same type + Par := Parent (Par); + end loop; - Elmt := First_Elmt (Inter_Procs); - while Present (Elmt) loop - if Node (Elmt) = Proc then - return; - end if; + return Empty; + end Find_Activator; - Next_Elmt (Elmt); - end loop; + -- Local variables - Append_Elmt (Proc, Inter_Procs); - end if; + Activator : constant Entity_Id := Find_Activator (N); + + -- Start of processing for Output_Activation_Call + + begin + pragma Assert (Present (Activator)); + + Error_Msg_NE ("\\ local tasks of & activated", Error_Nod, Activator); + end Output_Activation_Call; + + ----------------- + -- Output_Call -- + ----------------- + + 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. + + procedure Output_Call (Kind : String); + pragma Inline (Output_Call); + -- Emit a specific diagnostic message concerning a call of kind Kind + + 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. + + ------------------------------- + -- Output_Accept_Alternative -- + ------------------------------- + + procedure Output_Accept_Alternative is + Entry_Id : constant Entity_Id := Receiving_Entry (Target_Id); + + begin + pragma Assert (Present (Entry_Id)); + + Error_Msg_NE ("\\ entry & selected #", Error_Nod, Entry_Id); + end Output_Accept_Alternative; + + ----------------- + -- Output_Call -- + ----------------- + + procedure Output_Call (Kind : String) is + begin + Error_Msg_NE ("\\ " & Kind & " & called #", Error_Nod, Target_Id); + end Output_Call; + + ------------------------- + -- Output_Type_Actions -- + ------------------------- + + procedure Output_Type_Actions (Action : String) is + Typ : constant Entity_Id := First_Formal_Type (Target_Id); + + begin + pragma Assert (Present (Typ)); + + 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)); + + Error_Msg_NE + ("\\ " & Pred & " of " & Id_Kind & " & verified #", + Error_Nod, Id); + end Output_Verification_Call; + + -- Start of processing for Output_Call + + begin + Error_Msg_Sloc := Sloc (N); + + -- Accept alternative + + if Is_Accept_Alternative_Proc (Target_Id) then + Output_Accept_Alternative; + + -- Adjustment + + elsif Is_TSS (Target_Id, TSS_Deep_Adjust) then + Output_Type_Actions ("adjustment"); + + -- Default_Initial_Condition + + 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"); + + -- Entries + + elsif Is_Protected_Entry (Target_Id) then + Output_Call ("entry"); + + -- 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 Is_Task_Entry (Target_Id) then + null; + + -- Finalization + + elsif Is_TSS (Target_Id, TSS_Deep_Finalize) then + Output_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 + Output_Verification_Call + (Pred => "Initial_Condition", + Id => Find_Enclosing_Scope (N), + Id_Kind => "package"); + + -- Initialization + + elsif Is_Init_Proc (Target_Id) + or else Is_TSS (Target_Id, TSS_Deep_Initialize) + then + Output_Type_Actions ("initialization"); + + -- Invariant + + elsif Is_Invariant_Proc (Target_Id) then + Output_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. Note that a partial invariant is always + -- invoked by the "full" invariant which is already placed on the + -- stack. + + elsif Is_Partial_Invariant_Proc (Target_Id) then + null; + + -- _Postconditions + + elsif Is_Postconditions_Proc (Target_Id) then + Output_Verification_Call + (Pred => "postconditions", + Id => Find_Enclosing_Scope (N), + Id_Kind => "subprogram"); + + -- Subprograms must come last because some of the previous cases fall + -- under this category. + + elsif Ekind (Target_Id) = E_Function then + Output_Call ("function"); + + elsif Ekind (Target_Id) = E_Procedure then + Output_Call ("procedure"); + + else + pragma Assert (False); + null; end if; - end Add_Task_Proc; + end Output_Call; ------------------- - -- Collect_Tasks -- + -- Output_Header -- ------------------- - procedure Collect_Tasks (Decls : List_Id) is + procedure Output_Header is + Unit_Id : constant Entity_Id := Find_Top_Unit (Root_Scenario); + 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; + if Ekind (Unit_Id) = E_Package then + Error_Msg_NE ("\\ spec of unit & elaborated", Error_Nod, Unit_Id); - Next (Decl); - end loop; + elsif Ekind (Unit_Id) = E_Package_Body then + Error_Msg_NE ("\\ body of unit & elaborated", Error_Nod, Unit_Id); + + else + Error_Msg_NE ("\\ in body of unit &", Error_Nod, Unit_Id); end if; - end Collect_Tasks; + end Output_Header; - ---------------- - -- Outer_Unit -- - ---------------- + -------------------------- + -- Output_Instantiation -- + -------------------------- + + 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. + + -------------------------- + -- Output_Instantiation -- + -------------------------- + + procedure Output_Instantiation (Gen_Id : Entity_Id; Kind : String) is + begin + Error_Msg_NE + ("\\ " & Kind & " & instantiated as & #", Error_Nod, Gen_Id); + end Output_Instantiation; - function Outer_Unit (E : Entity_Id) return Entity_Id is - Outer : Entity_Id; + -- Local variables + + Inst : Node_Id; + Inst_Attrs : Instantiation_Attributes; + Inst_Id : Entity_Id; + Gen_Id : Entity_Id; + + -- Start of processing for Output_Instantiation begin - Outer := E; - while Present (Outer) loop - if Elaboration_Checks_Suppressed (Outer) then - Cunit_SC := True; - end if; + Extract_Instantiation_Attributes + (Exp_Inst => N, + Inst => Inst, + Inst_Id => Inst_Id, + Gen_Id => Gen_Id, + Attrs => Inst_Attrs); - exit when Is_Child_Unit (Outer) - or else Scope (Outer) = Standard_Standard - or else Ekind (Outer) /= E_Package; - Outer := Scope (Outer); - end loop; + Error_Msg_Node_2 := Inst_Id; + Error_Msg_Sloc := Sloc (Inst); - return Outer; - end Outer_Unit; + if Nkind (Inst) = N_Function_Instantiation then + Output_Instantiation (Gen_Id, "function"); - -- Start of processing for Check_Task_Activation + elsif Nkind (Inst) = N_Package_Instantiation then + Output_Instantiation (Gen_Id, "package"); - begin - Enclosing := Outer_Unit (Current_Scope); + elsif Nkind (Inst) = N_Procedure_Instantiation then + Output_Instantiation (Gen_Id, "procedure"); - -- Find all tasks declared in the current unit + else + pragma Assert (False); + null; + end if; + end Output_Instantiation; - if Nkind (N) = N_Package_Body then - P := Unit_Declaration_Node (Corresponding_Spec (N)); + -------------------------------- + -- Output_Variable_Assignment -- + -------------------------------- - Collect_Tasks (Declarations (N)); - Collect_Tasks (Visible_Declarations (Specification (P))); - Collect_Tasks (Private_Declarations (Specification (P))); + procedure Output_Variable_Assignment (N : Node_Id) is + Var_Id : constant Entity_Id := Entity (Extract_Assignment_Name (N)); - elsif Nkind (N) = N_Package_Declaration then - Collect_Tasks (Visible_Declarations (Specification (N))); - Collect_Tasks (Private_Declarations (Specification (N))); + begin + Error_Msg_Sloc := Sloc (N); + Error_Msg_NE ("\\ variable & assigned #", Error_Nod, Var_Id); + end Output_Variable_Assignment; - else - Collect_Tasks (Declarations (N)); - end if; + -------------------------- + -- Output_Variable_Read -- + -------------------------- + + procedure Output_Variable_Read (N : Node_Id) is + Dummy : Variable_Attributes; + Var_Id : Entity_Id; + + begin + Extract_Variable_Reference_Attributes + (Ref => N, + Var_Id => Var_Id, + Attrs => Dummy); + + Error_Msg_Sloc := Sloc (N); + Error_Msg_NE ("\\ variable & read #", Error_Nod, Var_Id); + end Output_Variable_Read; + + -- Local variables + + package Stack renames Scenario_Stack; + + Dummy : Call_Attributes; + N : Node_Id; + Posted : Boolean; + Target_Id : Entity_Id; - -- 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. + -- Start of processing for Output_Active_Scenarios - -- Should dynamic checks be added in the more general case??? + 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. - if Ekind (Enclosing) /= E_Package then + if not Static_Elaboration_Checks 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. + Posted := False; - Elmt := First_Elmt (Inter_Procs); - while Present (Elmt) loop - Ent := Node (Elmt); - Task_Scope := Outer_Unit (Scope (Ent)); + for Index in Stack.First .. Stack.Last loop + N := Stack.Table (Index); - if not Is_Compilation_Unit (Task_Scope) then - null; + if not Posted then + Posted := True; + Output_Header; + end if; - elsif Suppress_Elaboration_Warnings (Task_Scope) - or else Elaboration_Checks_Suppressed (Task_Scope) - then - null; + -- 'Access - 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; + if Nkind (N) = N_Attribute_Reference then + Output_Access (N); - else - -- Force the binder to elaborate other unit first + -- Calls - 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); + elsif Is_Suitable_Call (N) then + Extract_Call_Attributes + (Call => N, + Target_Id => Target_Id, + Attrs => Dummy); + + if Is_Activation_Proc (Target_Id) then + Output_Activation_Call (N); + else + Output_Call (N, Target_Id); end if; - Activate_Elaborate_All_Desirable (N, Task_Scope); - Set_Suppress_Elaboration_Warnings (Task_Scope); - end if; + -- Instantiations + + elsif Is_Suitable_Instantiation (N) then + Output_Instantiation (N); + + -- Variable assignments - Next_Elmt (Elmt); + elsif Nkind (N) = N_Assignment_Statement then + Output_Variable_Assignment (N); + + -- Variable read + + elsif Is_Suitable_Variable_Read (N) then + Output_Variable_Read (N); + + else + pragma Assert (False); + null; + end if; end loop; + end Output_Active_Scenarios; - -- For tasks declared in the current unit, trace other calls within the - -- task procedure bodies, which are available. + ------------------------- + -- Pop_Active_Scenario -- + ------------------------- - if not Debug_Flag_Dot_Y then - In_Task_Activation := True; + procedure Pop_Active_Scenario (N : Node_Id) is + Top : Node_Id renames Scenario_Stack.Table (Scenario_Stack.Last); - 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; + begin + pragma Assert (Top = N); + Scenario_Stack.Decrement_Last; + end Pop_Active_Scenario; - In_Task_Activation := False; - end if; - end Check_Task_Activation; + -------------------- + -- Process_Access -- + -------------------- - ------------------------------- - -- Is_Call_Of_Generic_Formal -- - ------------------------------- + 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 + + ------------------------- + -- Build_Access_Marker -- + ------------------------- + + function Build_Access_Marker (Target_Id : Entity_Id) return Node_Id is + Marker : Node_Id; + + begin + Marker := Make_Call_Marker (Sloc (Attr)); + + -- Inherit relevant attributes from the attribute + + -- Performance note: parent traversal + + Set_Target (Marker, Target_Id); + Set_Is_Declaration_Level_Node + (Marker, Find_Enclosing_Level (Attr) = Declaration_Level); + Set_Is_Dispatching_Call + (Marker, False); + Set_Is_Elaboration_Checks_OK_Node + (Marker, Is_Elaboration_Checks_OK_Node (Attr)); + Set_Is_Source_Call + (Marker, Comes_From_Source (Attr)); + Set_Is_SPARK_Mode_On_Node + (Marker, Is_SPARK_Mode_On_Node (Attr)); + + -- Partially insert the call marker into the tree by setting its + -- parent pointer. + + Set_Parent (Marker, Attr); + + return Marker; + end Build_Access_Marker; + + -- Local variables + + Root : constant Node_Id := Root_Scenario; + Target_Id : constant Entity_Id := Entity (Prefix (Attr)); + + Target_Attrs : Target_Attributes; + + -- Start of processing for Process_Access - function Is_Call_Of_Generic_Formal (N : Node_Id) return Boolean is begin - return Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) + -- Output relevant information when switch -gnatel (info messages on + -- implicit Elaborate[_All] pragmas) is in effect. + + if Elab_Info_Messages then + Error_Msg_NE + ("info: access to & during elaboration", Attr, Target_Id); + end if; - -- Always return False if debug flag -gnatd.G is set + Extract_Target_Attributes + (Target_Id => 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); - and then not Debug_Flag_Dot_GG + Output_Active_Scenarios (Attr); + end if; - -- 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. + -- Treat the attribute as an immediate invocation of the target when + -- switch -gnatd.o (conservarive 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. - and then Nkind (Name (N)) = N_Identifier - and then Chars (Name (N)) /= Chars (Entity (Name (N))); - end Is_Call_Of_Generic_Formal; + if Debug_Flag_Dot_O then + Process_Scenario + (N => Build_Access_Marker (Target_Id), + In_Task_Body => In_Task_Body); - -------------------------------- - -- Set_Elaboration_Constraint -- - -------------------------------- + -- Otherwise ensure that the unit with the corresponding body is + -- elaborated prior to the main unit. + + else + Ensure_Prior_Elaboration + (N => Attr, + Unit_Id => Target_Attrs.Unit_Id, + In_Task_Body => In_Task_Body); + end if; + end Process_Access; + + ----------------------------- + -- Process_Activation_Call -- + ----------------------------- - procedure Set_Elaboration_Constraint - (Call : Node_Id; - Subp : Entity_Id; - Scop : Entity_Id) + procedure Process_Activation_Call + (Call : Node_Id; + Call_Attrs : Call_Attributes; + In_Task_Body : Boolean) is - Elab_Unit : Entity_Id; + 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. + + procedure Process_Task_Objects (List : List_Id); + -- Perform ABE checks and diagnostics for all task objects found in + -- the list List. + + ------------------------- + -- Process_Task_Object -- + ------------------------- + + procedure Process_Task_Object (Obj_Id : Entity_Id; Typ : Entity_Id) is + Base_Typ : constant Entity_Id := Base_Type (Typ); + + Comp_Id : Entity_Id; + Task_Attrs : Task_Attributes; + + begin + if Is_Task_Type (Typ) then + Extract_Task_Attributes + (Typ => Base_Typ, + Attrs => Task_Attrs); + + Process_Single_Activation + (Call => Call, + Call_Attrs => Call_Attrs, + Obj_Id => Obj_Id, + Task_Attrs => Task_Attrs, + In_Task_Body => In_Task_Body); + + -- Examine the component type when the object is an array + + elsif Is_Array_Type (Typ) and then Has_Task (Base_Typ) then + Process_Task_Object (Obj_Id, Component_Type (Typ)); + + -- Examine individual component types when the object is a record + + 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; + + -------------------------- + -- Process_Task_Objects -- + -------------------------- + + procedure Process_Task_Objects (List : List_Id) is + Item : Node_Id; + Item_Id : Entity_Id; + Item_Typ : Entity_Id; - -- 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. + begin + -- Examine the contents of the list looking for an object declaration + -- of a task type or one that contains a task within. + + 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 Has_Task (Item_Typ) then + Process_Task_Object (Item_Id, Item_Typ); + end if; + end if; - 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))); + Next (Item); + end loop; + end Process_Task_Objects; + + -- Local variables + + Context : Node_Id; + Spec : Node_Id; + + -- Start of processing for Process_Activation_Call begin - -- If the unit is mentioned in a with_clause of the current unit, it is - -- visible, and we can set the elaboration flag. + -- Nothing to do when the activation is a guaranteed ABE - 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); + if Is_Known_Guaranteed_ABE (Call) then return; end if; - -- 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. + -- 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. + + Context := Parent (Call); - if Is_Init_Proc (Subp) - or else Init_Call - or else Nkind (Original_Node (Call)) = N_Selected_Component + -- 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. + + if Nkind (Context) = N_Handled_Sequence_Of_Statements + and then Nkind (Parent (Context)) = N_Package_Body then - null; -- detailed processing follows. + Context := Parent (Context); + end if; + + -- Process all task objects defined in both the spec and body when the + -- activation call precedes the "begin" of a package body. + + if Nkind (Context) = N_Package_Body then + Spec := + Specification + (Unit_Declaration_Node (Corresponding_Spec (Context))); + + Process_Task_Objects (Visible_Declarations (Spec)); + Process_Task_Objects (Private_Declarations (Spec)); + Process_Task_Objects (Declarations (Context)); + + -- Process all task objects defined in the spec when the activation call + -- appears at the end of a package spec. + + elsif Nkind (Context) = N_Package_Specification then + Process_Task_Objects (Visible_Declarations (Context)); + Process_Task_Objects (Private_Declarations (Context)); + + -- 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. else - Activate_Elaborate_All_Desirable (Call, Scop); - Set_Suppress_Elaboration_Warnings (Scop); - return; + pragma Assert (Nkind (Context) = N_Handled_Sequence_Of_Statements); + + Process_Task_Objects (Statements (Context)); end if; + 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. - -- 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. + Root : constant Node_Id := Root_Scenario; - if Is_Init_Proc (Subp) or else Init_Call then + begin + -- Output relevant information when switch -gnatel (info messages on + -- implicit Elaborate[_All] pragmas) is in effect. - -- 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. + if Elab_Info_Messages then + Error_Msg_NE + ("info: activation of & during elaboration", Call, Obj_Id); + end if; - 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; + -- Nothing to do when the activation is a guaranteed ABE - -- 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. + if Is_Known_Guaranteed_ABE (Call) then + return; - elsif Nkind (Original_Node (Call)) = N_Selected_Component then - Elab_Unit := Scope (Etype (First (Parameter_Associations (Call)))); + -- Nothing to do when the root scenario appears at the declaration + -- level and the task is in the same unit, but outside this context. - -- Not one of special cases above + -- task type Task_Typ; -- task declaration - 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. + -- procedure Proc is + -- function A ... is + -- begin + -- if Some_Condition then + -- declare + -- T : Task_Typ; + -- begin + -- <activation call> -- 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 + + elsif Is_Up_Level_Target (Task_Attrs.Task_Decl) then + return; + + -- 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] + -- <activation call> -- safe activation + -- end Nested; + -- ... + + elsif Is_Safe_Activation (Call, Task_Attrs.Task_Decl) then + + -- Note that the task body must still be examined for any nested + -- scenarios. + + null; + + -- The activation call and the task body are both in the main unit + + 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. + + -- task type Task_Typ; + + -- function A ... is + -- begin + -- if Some_Condition then + -- declare + -- package Pack is + -- ... + -- end Pack; + + -- package body Pack is + -- T : Task_Typ; + -- [begin] + -- <activation call> -- activation of T + -- end Pack; + -- ... + -- end A; + + -- X : ... := A; -- root scenario + + -- task body Task_Typ is -- task body + -- ... + -- end Task_Typ; + + -- Y : ... := A; -- root scenario - Elab_Unit := Scop; + -- 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. + + if Earlier_In_Extended_Unit (Root, Task_Attrs.Body_Decl) then + + -- 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 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); + + Output_Active_Scenarios (Obj_Id); + end if; + + -- Install a conditional run-time ABE check to verify that the + -- task body has been elaborated prior to the activation call. + + 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 if; + + -- 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. + + elsif Dynamic_Elaboration_Checks and then Check_OK then + Install_ABE_Check + (N => Call, + Ins_Nod => Call, + Id => Task_Attrs.Unit_Id); end if; - Activate_Elaborate_All_Desirable (Call, Elab_Unit); - Set_Suppress_Elaboration_Warnings (Elab_Unit); - end Set_Elaboration_Constraint; + -- 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. - ------------------------ - -- Get_Referenced_Ent -- - ------------------------ + if Call_Attrs.SPARK_Mode_On and Task_Attrs.SPARK_Mode_On then + null; - function Get_Referenced_Ent (N : Node_Id) return Entity_Id is - Nam : Node_Id; + -- 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; + + 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); + + -------------------------------------------- + -- Process_Activation_Guaranteed_ABE_Impl -- + -------------------------------------------- + + 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 Nkind (N) in N_Has_Entity - and then Present (Entity (N)) - and then Ekind (Entity (N)) = E_Variable + -- 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 call> -- 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; + + -- 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] + -- <activation call> -- safe activation + -- end Nested; + -- ... + + elsif Is_Safe_Activation (Call, Task_Attrs.Task_Decl) then + return; + + -- 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. + + -- procedure Guaranteed_ABE is + -- task type Task_Typ; + + -- package Nested is + -- ... + -- end Nested; + + -- package body Nested is + -- T : Task_Typ; + -- [begin] + -- <activation call> -- guaranteed ABE + -- end Nested; + + -- task body Task_Typ is + -- ... + -- end Task_Typ; + -- ... + + -- Performance note: parent traversal + + elsif Is_Guaranteed_ABE + (N => Call, + Target_Decl => Task_Attrs.Task_Decl, + Target_Body => Task_Attrs.Body_Decl) then - return Entity (N); + 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); + + -- Mark the activation call as a guaranteed ABE + + Set_Is_Known_Guaranteed_ABE (Call); + + -- Install a run-time ABE failue because this activation call will + -- always result in an ABE. + + if Check_OK then + Install_ABE_Failure + (N => Call, + Ins_Nod => Call); + end if; end if; + end Process_Activation_Guaranteed_ABE_Impl; - if Nkind (N) = N_Attribute_Reference then - Nam := Prefix (N); - else - Nam := Name (N); + procedure Process_Activation_Guaranteed_ABE is + new Process_Activation_Call (Process_Activation_Guaranteed_ABE_Impl); + + ------------------ + -- Process_Call -- + ------------------ + + procedure Process_Call + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + In_Task_Body : Boolean) + is + SPARK_Rules_On : Boolean; + Target_Attrs : Target_Attributes; + + begin + Extract_Target_Attributes + (Target_Id => Target_Id, + Attrs => Target_Attrs); + + -- The SPARK rules are in effect when both the call and target are + -- subject to SPARK_Mode On. + + SPARK_Rules_On := + Call_Attrs.SPARK_Mode_On and Target_Attrs.SPARK_Mode_On; + + -- Output relevant information when switch -gnatel (info messages on + -- implicit Elaborate[_All] pragmas) is in effect. + + if Elab_Info_Messages then + Info_Call + (Call => Call, + Target_Id => Target_Id, + Info_Msg => True, + In_SPARK => SPARK_Rules_On); end if; - 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; + -- 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. + + return; + end if; + + -- Nothing to do when the call is a guaranteed ABE + + if Is_Known_Guaranteed_ABE (Call) then + return; + + -- Nothing to do when the root scenario appears at the declaration level + -- and the target is in the same unit, but outside this context. + + -- function B ...; -- target declaration + + -- procedure Proc is + -- function A ... is + -- begin + -- if Some_Condition then + -- return B; -- call site + -- ... + -- end A; + + -- X : ... := A; -- root scenario + -- ... + + -- function B ... is + -- ... + -- end B; + + -- 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. + + -- Performance note: parent traversal + + elsif Is_Up_Level_Target (Target_Attrs.Spec_Decl) then + return; + + -- The SPARK rules are verified only when -gnatd.v (enforce SPARK + -- elaboration rules in SPARK code) is in effect. + + 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); + + -- Otherwise the Ada rules are in effect, or SPARK code is allowed to + -- violate the SPARK rules. + else - return Entity (Nam); + 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 Get_Referenced_Ent; + + -- Inspect the target body (and barried function) for other suitable + -- elaboration scenarios. + + Traverse_Body (Target_Attrs.Body_Barf, In_Task_Body); + Traverse_Body (Target_Attrs.Body_Decl, In_Task_Body); + end Process_Call; ---------------------- - -- Has_Generic_Body -- + -- Process_Call_Ada -- ---------------------- - 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; + 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 In_Initialization_Context (N : Node_Id) return Boolean; + -- Determine whether arbitrary node N appears within a type init proc or + -- primitive [Deep_]Initialize. + + ------------------------------- + -- In_Initialization_Context -- + ------------------------------- + + function In_Initialization_Context (N : Node_Id) return Boolean is + Par : Node_Id; + Spec_Id : Entity_Id; begin - Nod := N; - while Present (Nod) loop + -- Climb the parent chain looking for initialization actions - -- If we found the package body we are looking for, return it + Par := Parent (N); + while Present (Par) loop - if Nkind (Nod) = N_Package_Body - and then Chars (Defining_Unit_Name (Nod)) = Chars (E) + -- A block may be part of the initialization actions of a default + -- initialized object. + + if Nkind (Par) = N_Block_Statement + and then Is_Initialization_Block (Par) then - return Nod; + return True; - -- If we found the stub for the body, go after the subunit, - -- loading it if necessary. + -- A subprogram body may denote an initialization routine - 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)); + elsif Nkind (Par) = N_Subprogram_Body then + Spec_Id := Unique_Defining_Entity (Par); - else - return Load_Package_Body (Get_Unit_Name (Nod)); + -- The current subprogram body denotes a type init proc or + -- primitive [Deep_]Initialize. + + 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; end if; - -- If neither package body nor stub, keep looking on chain + -- Prevent the search from going too far - else - Next (Nod); + elsif Is_Body_Or_Package_Declaration (Par) then + exit; end if; + + Par := Parent (Par); end loop; - return Empty; - end Find_Body_In; + return False; + end In_Initialization_Context; - ----------------------- - -- Load_Package_Body -- - ----------------------- + -- Local variables - function Load_Package_Body (Nam : Unit_Name_Type) return Node_Id is - U : Unit_Number_Type; + 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. - begin - if Operating_Mode /= Generate_Code then - return Empty; - else - U := - Load_Unit - (Load_Name => Nam, - Required => False, - Subunit => False, - Error_Node => N); + -- Start of processing for Process_Call_Ada - if U = No_Unit then - return Empty; - else - return Unit (Cunit (U)); - end if; - end if; - end Load_Package_Body; + begin + -- 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. - ------------------------------- - -- Locate_Corresponding_Body -- - ------------------------------- + if Call_Attrs.Is_Dispatching then + return; - 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; + -- Nothing to do when the call is ABE-safe - begin - if Is_Library_Level_Entity (PE) then + -- generic + -- function Gen ...; - -- 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. + -- function Gen ... is + -- begin + -- ... + -- end Gen; - if Unit_Requires_Body (PE) then + -- with Gen; + -- procedure Main is + -- function Inst is new Gen; + -- X : ... := Inst; -- safe call + -- ... - -- 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. + elsif Is_Safe_Call (Call, Target_Attrs) then + return; - return - Load_Package_Body - (Get_Body_Name (Unit_Name (Get_Source_Unit (Spec)))); + -- The call and the target body are both in the main unit - -- 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. + 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; - else - return Empty; - end if; + -- No implicit pragma Elaborate[_All] is generated when the call has + -- elaboration checks suppressed. This behaviour parallels that of the + -- old ABE mechanism. - -- Otherwise look and see if we are embedded in a further package + if not Call_Attrs.Elab_Checks_OK then + null; - elsif Is_Package_Or_Generic_Package (Scop) then + -- 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. - -- If so, get the body of the enclosing package, and look in - -- its package body for the package body we are looking for. + -- Performance note: parent traversal - PBody := Locate_Corresponding_Body (Scop); + 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; - if No (PBody) then - return Empty; - else - return Find_Body_In (PE, First (Declarations (PBody))); - end if; + -- Otherwise ensure that the unit with the target body is elaborated + -- prior to the main unit. - -- If we are not embedded in a further package, then the body - -- must be in the same declarative part as we are. + else + Ensure_Prior_Elaboration + (N => Call, + Unit_Id => Target_Attrs.Unit_Id, + In_Task_Body => In_Task_Body); + end if; + end Process_Call_Ada; - else - return Find_Body_In (PE, Next (Decl)); + ---------------------------------- + -- Process_Call_Conditional_ABE -- + ---------------------------------- + + procedure Process_Call_Conditional_ABE + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + Target_Attrs : Target_Attributes) + is + 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. + + Root : constant Node_Id := Root_Scenario; + + begin + -- If the root scenario appears prior to the target body, then this is a + -- possible ABE with respect to the root scenario. + + -- function B ...; + + -- function A ... is + -- begin + -- if Some_Condition then + -- return B; -- call site + -- ... + -- end A; + + -- X : ... := A; -- root scenario + + -- function B ... is -- target body + -- ... + -- end B; + + -- Y : ... := A; -- root scenario + + -- 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. + + if Earlier_In_Extended_Unit (Root, Target_Attrs.Body_Decl) then + + -- 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 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); + + Output_Active_Scenarios (Call); + end if; + + -- Install a conditional run-time ABE check to verify that the target + -- body has been elaborated prior to the call. + + 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 Locate_Corresponding_Body; + end if; + end Process_Call_Conditional_ABE; - -- Start of processing for Has_Generic_Body + --------------------------------- + -- Process_Call_Guaranteed_ABE -- + --------------------------------- + + procedure Process_Call_Guaranteed_ABE + (Call : Node_Id; + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id) + is + Target_Attrs : Target_Attributes; begin - if Present (Corresponding_Body (Decl)) then - return True; + Extract_Target_Attributes + (Target_Id => Target_Id, + Attrs => Target_Attrs); - elsif Unit_Requires_Body (Ent) then - return True; + -- Nothing to do when the root scenario appears at the declaration level + -- and the target is in the same unit, but outside this context. - -- Compilation units cannot have optional bodies + -- function B ...; -- target declaration - elsif Is_Compilation_Unit (Ent) then - return False; + -- procedure Proc is + -- function A ... is + -- begin + -- if Some_Condition then + -- return B; -- call site + -- ... + -- end A; - -- Otherwise look at what scope we are in + -- X : ... := A; -- root scenario + -- ... - else - Scop := Scope (Ent); + -- function B ... is + -- ... + -- end B; - -- Case of entity is in other than a package spec, in this case - -- the body, if present, must be in the same declarative part. + -- 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 not Is_Package_Or_Generic_Package (Scop) then - declare - P : Node_Id; + -- Performance note: parent traversal - begin - -- Declaration node may get us a spec, so if so, go to - -- the parent declaration. + if Is_Up_Level_Target (Target_Attrs.Spec_Decl) then + return; - P := Declaration_Node (Ent); - while not Is_List_Member (P) loop - P := Parent (P); - end loop; + -- Nothing to do when the call is ABE-safe - return Present (Find_Body_In (Ent, Next (P))); - end; + -- generic + -- function Gen ...; - -- If the entity is in a package spec, then we have to locate - -- the corresponding package body, and look there. + -- function Gen ... is + -- begin + -- ... + -- end Gen; - else - declare - PBody : constant Node_Id := Locate_Corresponding_Body (Scop); + -- with Gen; + -- procedure Main is + -- function Inst is new Gen; + -- X : ... := Inst; -- safe call + -- ... - begin - if No (PBody) then - return False; - else - return - Present - (Find_Body_In (Ent, (First (Declarations (PBody))))); - end if; - end; + elsif Is_Safe_Call (Call, Target_Attrs) then + return; + + -- 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. + + -- procedure Guaranteed_ABE is + -- function Func ...; + + -- package Nested is + -- Obj : ... := Func; -- guaranteed ABE + -- end Nested; + + -- function Func ... is + -- ... + -- end Func; + -- ... + + -- Performance note: parent traversal + + elsif Is_Guaranteed_ABE + (N => Call, + Target_Decl => Target_Attrs.Spec_Decl, + Target_Body => Target_Attrs.Body_Decl) + then + Error_Msg_NE ("??cannot call & before body seen", Call, Target_Id); + Error_Msg_N ("\Program_Error will be raised at run time", Call); + + -- Mark the call as a guarnateed ABE + + Set_Is_Known_Guaranteed_ABE (Call); + + -- 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. + + 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; end if; - end Has_Generic_Body; + end Process_Call_Guaranteed_ABE; - ----------------------- - -- Insert_Elab_Check -- - ----------------------- + ------------------------ + -- Process_Call_SPARK -- + ------------------------ - procedure Insert_Elab_Check (N : Node_Id; C : Node_Id := Empty) is - Nod : Node_Id; - Loc : constant Source_Ptr := Sloc (N); + 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; - Chk : Node_Id; - -- The check (N_Raise_Program_Error) node to be inserted + -- Nothing to do when the call is ABE-safe - 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. + -- generic + -- function Gen ...; + + -- function Gen ... is + -- begin + -- ... + -- end Gen; + + -- with Gen; + -- procedure Main is + -- function Inst is new Gen; + -- X : ... := Inst; -- safe call + -- ... - if not Expander_Active or else Subunits_Missing then + if Is_Safe_Call (Call, Target_Attrs) 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. + -- The call and the target body are both in the main unit - if Nkind (N) in N_Generic_Instantiation - and then Present (Instance_Spec (N)) + elsif Present (Target_Attrs.Body_Decl) + and then In_Extended_Main_Code_Unit (Target_Attrs.Body_Decl) then - Nod := Instance_Spec (N); + 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. + else - Nod := N; + null; end if; + end Process_Call_SPARK; - -- Build check node, possibly with condition + ---------------------------- + -- Process_Guaranteed_ABE -- + ---------------------------- - Chk := - Make_Raise_Program_Error (Loc, Reason => PE_Access_Before_Elaboration); + procedure Process_Guaranteed_ABE (N : Node_Id) is + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + + begin + -- Add the current scenario to the stack of active scenarios + + Push_Active_Scenario (N); + + -- Only calls, instantiations, and task activations may result in a + -- guaranteed ABE. + + if Is_Suitable_Call (N) then + Extract_Call_Attributes + (Call => N, + Target_Id => Target_Id, + Attrs => Call_Attrs); + + if Is_Activation_Proc (Target_Id) then + Process_Activation_Guaranteed_ABE + (Call => N, + Call_Attrs => Call_Attrs, + In_Task_Body => False); + + else + Process_Call_Guaranteed_ABE + (Call => N, + Call_Attrs => Call_Attrs, + Target_Id => Target_Id); + end if; - if Present (C) then - Set_Condition (Chk, Make_Op_Not (Loc, Right_Opnd => C)); + elsif Is_Suitable_Instantiation (N) then + Process_Instantiation_Guaranteed_ABE (N); end if; - -- If we are inserting at the top level, insert in Aux_Decls + -- Remove the current scenario from the stack of active scenarios once + -- all ABE diagnostics and checks have been performed. - if Nkind (Parent (Nod)) = N_Compilation_Unit then - declare - ADN : constant Node_Id := Aux_Decls_Node (Parent (Nod)); + Pop_Active_Scenario (N); + end Process_Guaranteed_ABE; - begin - if No (Declarations (ADN)) then - Set_Declarations (ADN, New_List (Chk)); - else - Append_To (Declarations (ADN), Chk); - end if; + --------------------------- + -- Process_Instantiation -- + --------------------------- + + 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; + + SPARK_Rules_On : Boolean; + -- This flag is set when the SPARK rules are in effect + + 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); + + -- The SPARK rules are in effect when both the instantiation and generic + -- are subject to SPARK_Mode On. + + SPARK_Rules_On := Inst_Attrs.SPARK_Mode_On and Gen_Attrs.SPARK_Mode_On; + + -- Output relevant information when switch -gnatel (info messages on + -- implicit Elaborate[_All] pragmas) is in effect. + + if Elab_Info_Messages then + Info_Instantiation + (Inst => Inst, + Gen_Id => Gen_Id, + Info_Msg => True, + In_SPARK => SPARK_Rules_On); + end if; + + -- Nothing to do when the instantiation is a guaranteed ABE + + if Is_Known_Guaranteed_ABE (Inst) then + return; + + -- 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 + + elsif Is_Up_Level_Target (Gen_Attrs.Spec_Decl) then + return; - Analyze (Chk); - end; + -- The SPARK rules are verified only when -gnatd.v (enforce SPARK + -- elaboration rules in SPARK code) is in effect. - -- Otherwise just insert as an action on the node in question + elsif SPARK_Rules_On and Debug_Flag_Dot_V then + Process_Instantiation_SPARK + (Exp_Inst => 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. else - Insert_Action (Nod, Chk); + 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 Insert_Elab_Check; + end Process_Instantiation; ------------------------------- - -- Is_Finalization_Procedure -- + -- Process_Instantiation_Ada -- ------------------------------- - function Is_Finalization_Procedure (Id : Entity_Id) return Boolean is + 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. + begin - -- Check whether Id is a procedure with at least one parameter + -- Nothing to do when the instantiation is ABE-safe - 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; + -- generic + -- package Gen is + -- ... + -- end Gen; - begin - -- If the type of the first formal does not require finalization - -- actions, then this is definitely not [Deep_]Finalize. + -- package body Gen is + -- ... + -- end Gen; - if not Needs_Finalization (Typ) then - return False; - end if; + -- with Gen; + -- procedure Main is + -- package Inst is new Gen (ABE); -- safe instantiation + -- ... - -- At this point we have the following scenario: - - -- procedure Name (Param1 : [in] [out] Ctrl[; Param2 : ...]); + if Is_Safe_Instantiation (Inst, Gen_Attrs) then + return; - -- Recover the two possible versions of [Deep_]Finalize using the - -- type of the first parameter and compare with the input. + -- The instantiation and the generic body are both in the main unit - Deep_Fin := TSS (Typ, TSS_Deep_Finalize); + 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; - if Is_Controlled (Typ) then - Fin := Find_Prim_Op (Typ, Name_Finalize); - end if; + -- 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. - return (Present (Deep_Fin) and then Id = Deep_Fin) - or else (Present (Fin) and then Id = Fin); - end; + 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. - return False; - end Is_Finalization_Procedure; + Root : constant Node_Id := Root_Scenario; - ------------------ - -- Output_Calls -- - ------------------ + begin + -- If the root scenario appears prior to the generic body, then this is + -- a possible ABE with respect to the root scenario. - 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. + -- generic + -- package Gen is + -- ... + -- end Gen; - 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). + -- function A ... is + -- begin + -- if Some_Condition then + -- declare + -- package Inst is new Gen; -- instantiation site + -- ... + -- end A; - ---------- - -- Emit -- - ---------- + -- X : ... := A; -- root scenario - function Emit (Flag : Boolean) return Boolean is - begin - if Check_Elab_Flag then - return Flag; - else - return True; - end if; - end Emit; + -- package body Gen is -- generic body + -- ... + -- end Gen; - ----------------------------- - -- Is_Printable_Error_Name -- - ----------------------------- + -- Y : ... := A; -- root scenario - function Is_Printable_Error_Name return Boolean is - begin - if not Is_Internal_Name then - return True; + -- 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. - elsif Name_Len = 1 then - return False; + if Earlier_In_Extended_Unit (Root, Gen_Attrs.Body_Decl) then - else - Name_Len := Name_Len - 1; - return not Is_Internal_Name; + -- 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 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); + + Output_Active_Scenarios (Inst); end if; - end Is_Printable_Error_Name; - -- Local variables + -- Install a conditional run-time ABE check to verify that the + -- generic body has been elaborated prior to the instantiation. + + 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; - Ent : Entity_Id; + ------------------------------------------ + -- Process_Instantiation_Guaranteed_ABE -- + ------------------------------------------ - -- Start of processing for Output_Calls + 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; begin - for J in reverse 1 .. Elab_Call.Last loop - Error_Msg_Sloc := Elab_Call.Table (J).Cloc; + 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; - Ent := Elab_Call.Table (J).Ent; - Get_Name_String (Chars (Ent)); + -- Nothing to do when the instantiation is ABE-safe - -- Dynamic elaboration model, warnings controlled by -gnatwl + -- generic + -- package Gen is + -- ... + -- end Gen; - 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; + -- package body Gen is + -- ... + -- end Gen; - -- Static elaboration model, info messages controlled by -gnatel + -- with Gen; + -- procedure Main is + -- package Inst is new Gen (ABE); -- safe instantiation + -- ... - 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; + elsif Is_Safe_Instantiation (Inst, Gen_Attrs) then + return; + + -- 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. + + -- procedure Guaranteed_ABE is + -- generic + -- procedure Gen; + + -- package Nested is + -- procedure Inst is new Gen; -- guaranteed ABE + -- end Nested; + + -- procedure Gen is + -- ... + -- end Gen; + -- ... + + -- Performance note: parent traversal + + 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); + + -- Mark the instantiation as a guarantee ABE. This automatically + -- suppresses the instantiation of the generic body. + + Set_Is_Known_Guaranteed_ABE (Inst); + + -- 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 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 loop; - end Output_Calls; + 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; - ---------------------------- - -- Same_Elaboration_Scope -- - ---------------------------- + 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; + else + Req_Nam := Name_Elaborate_All; + end if; + + Meet_Elaboration_Requirement + (N => Inst, + Target_Id => Gen_Id, + Req_Nam => Req_Nam); + + -- Nothing to do when the instantiation is ABE-safe - function Same_Elaboration_Scope (Scop1, Scop2 : Entity_Id) return Boolean is - S1 : Entity_Id; - S2 : Entity_Id; + -- generic + -- package Gen is + -- ... + -- end Gen; + + -- package body Gen is + -- ... + -- end Gen; + + -- with Gen; + -- procedure Main is + -- package Inst is new Gen (ABE); -- safe instantiation + -- ... + + if Is_Safe_Instantiation (Inst, Gen_Attrs) then + return; + + -- The instantiation and the generic body are both in the main unit + + 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. + + else + null; + end if; + end Process_Instantiation_SPARK; + + --------------------------------- + -- Process_Variable_Assignment -- + --------------------------------- + + 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); + + SPARK_Rules_On : Boolean; + -- This flag is set when the SPARK rules are in effect begin - -- Find elaboration scope for Scop1 - -- This is either a subprogram or a compilation unit. + -- 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; - 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; + -- 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. - -- Find elaboration scope for Scop2 + if SPARK_Rules_On then + Process_Variable_Assignment_SPARK + (Asmt => Asmt, + Var_Id => Var_Id); - 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; + -- Otherwise the Ada rules are in effect - return S1 = S2; - end Same_Elaboration_Scope; + else + Process_Variable_Assignment_Ada + (Asmt => Asmt, + Var_Id => Var_Id); + end if; + end Process_Variable_Assignment; - ----------------- - -- Set_C_Scope -- - ----------------- + ------------------------------------- + -- Process_Variable_Assignment_Ada -- + ------------------------------------- + + 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); - 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; + -- 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. - ----------------- - -- Spec_Entity -- - ----------------- + 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 - function Spec_Entity (E : Entity_Id) return Entity_Id is - Decl : Node_Id; + Set_Elaborate_Body_Desirable (Spec_Id); + + Error_Msg_NE + ("??variable & can be accessed by clients before this " + & "initialization", Asmt, Var_Id); + + Error_Msg_NE + ("\add pragma ""Elaborate_Body"" to spec & to ensure proper " + & "initialization", Asmt, Spec_Id); + + Output_Active_Scenarios (Asmt); + end if; + end Process_Variable_Assignment_Ada; + + --------------------------------------- + -- Process_Variable_Assignment_SPARK -- + --------------------------------------- + + 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); begin - -- Check for case of body entity - -- Why is the check for E_Void needed??? + -- 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. - if Ekind_In (E, E_Void, E_Subprogram_Body, E_Package_Body) then - Decl := E; + 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); - loop - Decl := Parent (Decl); - exit when Nkind (Decl) in N_Proper_Body; - end loop; + Error_Msg_NE + ("\add pragma ""Elaborate_Body"" to spec & to ensure full " + & "initialization", Asmt, Spec_Id); + + Output_Active_Scenarios (Asmt); + end if; + end Process_Variable_Assignment_SPARK; + + --------------------------- + -- Process_Variable_Read -- + --------------------------- + + procedure Process_Variable_Read (Ref : Node_Id) is + Var_Attrs : Variable_Attributes; + Var_Id : Entity_Id; + + 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; + + -- Nothing to do when the variable appears within the main unit because + -- diagnostics on reads are relevant only for external variables. + + if Is_Same_Unit (Var_Attrs.Unit_Id, Cunit_Entity (Main_Unit)) then + null; + + -- Nothing to do when the variable is already initialized. Note that the + -- variable may be further modified by the external unit. + + elsif Is_Initialized (Declaration_Node (Var_Id)) then + null; + + -- Nothing to do when the external unit guarantees the initialization of + -- the variable by means of pragma Elaborate_Body. + + elsif Has_Pragma_Elaborate_Body (Var_Attrs.Unit_Id) then + null; - return Corresponding_Spec (Decl); + -- 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. else - return E; + Meet_Elaboration_Requirement + (N => Ref, + Target_Id => Var_Id, + Req_Nam => Name_Elaborate); end if; - end Spec_Entity; + end Process_Variable_Read; - ------------------- - -- Supply_Bodies -- - ------------------- + -------------------------- + -- Push_Active_Scenario -- + -------------------------- - procedure Supply_Bodies (N : Node_Id) is + procedure Push_Active_Scenario (N : Node_Id) is begin - if Nkind (N) = N_Subprogram_Declaration then - declare - Ent : constant Entity_Id := Defining_Unit_Name (Specification (N)); + Scenario_Stack.Append (N); + end Push_Active_Scenario; - 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); + ---------------------- + -- Process_Scenario -- + ---------------------- - else - Spec := - Make_Procedure_Specification (Loc, - Defining_Unit_Name => Nam, - Parameter_Specifications => Formals); - end if; + procedure Process_Scenario (N : Node_Id; In_Task_Body : Boolean := False) is + Call_Attrs : Call_Attributes; + Target_Id : Entity_Id; + + begin + -- Add the current scenario to the stack of active scenarios + + Push_Active_Scenario (N); + + -- 'Access + + if Is_Suitable_Access (N) then + Process_Access (N, In_Task_Body); + + -- Calls + + elsif Is_Suitable_Call (N) then + + -- 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. + + if In_Main_Context (N) then + Extract_Call_Attributes + (Call => N, + Target_Id => Target_Id, + Attrs => Call_Attrs); - 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; + if Is_Activation_Proc (Target_Id) then + Process_Activation_Conditional_ABE + (Call => N, + Call_Attrs => Call_Attrs, + In_Task_Body => In_Task_Body); + + else + Process_Call + (Call => N, + Call_Attrs => Call_Attrs, + Target_Id => Target_Id, + In_Task_Body => In_Task_Body); end if; - end; + end if; - 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; + -- Instantiations + + elsif Is_Suitable_Instantiation (N) then + Process_Instantiation (N, In_Task_Body); + + -- Variable assignments + + elsif Is_Suitable_Variable_Assignment (N) then + Process_Variable_Assignment (N); + + -- Variable read + + elsif Is_Suitable_Variable_Read (N) then + Process_Variable_Read (N); end if; - end Supply_Bodies; - ------------ - -- Within -- - ------------ + -- 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; + + --------------------------------- + -- Record_Elaboration_Scenario -- + --------------------------------- + + 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. - 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; + -- Assume that the scenario must not appear at the declaration level + + Declaration_Level_OK := False; + + -- Nothing to do for ASIS. As a result, no ABE checks and diagnostics + -- are performed in this mode. + + if ASIS_Mode then + return; + + -- Nothing to do when the scenario is being preanalyzed + + elsif Preanalysis_Active then + return; + end if; + + -- 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 Is_Suitable_Call (N) then + Check_Preelaborated_Call (N); + end if; + + -- Nothing to do when the scenario does not appear within the main unit + + if not In_Main_Context (N) then + return; + + -- Scenarios within a generic unit are never considered because generics + -- cannot be elaborated. + + elsif Inside_A_Generic then + return; + + -- Scenarios which do not fall in one of the elaboration categories + -- listed below are not considered. The categories are: + + -- 'Access for entries, operators, and subprograms + -- Calls (includes task activation) + -- Instantiations + -- Variable assignments + -- Variable references + + elsif Is_Suitable_Access (N) + or else Is_Suitable_Variable_Assignment (N) + or else Is_Suitable_Variable_Read (N) + then + null; + + elsif Is_Suitable_Call (N) or else Is_Suitable_Instantiation (N) then + Declaration_Level_OK := True; + + -- Otherwise the input does not denote a suitable scenario + + else + return; + 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. + + if Static_Elaboration_Checks then + + -- Performance note: parent traversal + + Level := Find_Enclosing_Level (N); + + -- Declaration level scenario + + if Declaration_Level_OK 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 - Scop := Scope (Scop); + return; end if; - end loop; - end Within; + end if; - -------------------------- - -- Within_Elaborate_All -- - -------------------------- + -- Perform early detection of guaranteed ABEs in order to suppress the + -- instantiation of generic bodies as gigi cannot handle certain types + -- of premature instantiations. - 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); + Process_Guaranteed_ABE (N); - 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. + -- At this point all checks have been performed. Record the scenario for + -- later processing by the ABE phase. - Result : Boolean := False; + Top_Level_Scenarios.Append (N); - 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. + -- Mark a scenario which may produce run-time conditional ABE checks or + -- guaranteed ABE failures as recorded. The flag ensures that scenario + -- rewritting performed by Atree.Rewrite will be properly reflected in + -- all relevant internal data structures. - ------------ - -- Helper -- - ------------ + if Is_Check_Emitting_Scenario (N) then + Set_Is_Recorded_Scenario (N); + end if; + end Record_Elaboration_Scenario; - procedure Helper (Unit : Unit_Number_Type) is - CU : constant Node_Id := Cunit (Unit); + ------------------- + -- Root_Scenario -- + ------------------- - Item : Node_Id; - Item2 : Node_Id; - Elab_Id : Entity_Id; - Par : Node_Id; + function Root_Scenario return Node_Id is + package Stack renames Scenario_Stack; + + 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. + pragma Assert (Stack.Last >= Stack.First); + return Stack.Table (Stack.First); + end Root_Scenario; + + ------------------------------- + -- Static_Elaboration_Checks -- + ------------------------------- + + function Static_Elaboration_Checks return Boolean is + begin + return not Dynamic_Elaboration_Checks; + end Static_Elaboration_Checks; + + ------------------- + -- Traverse_Body -- + ------------------- + + 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. + + procedure Traverse_Potential_Scenarios is + new Traverse_Proc (Is_Potential_Scenario); + + procedure Traverse_List (List : List_Id); + -- Inspect list List for suitable elaboration scenarios and process them + + --------------------------- + -- Is_Potential_Scenario -- + --------------------------- + + function Is_Potential_Scenario (Nod : Node_Id) return Traverse_Result is begin - if Seen (Unit) then - return; - else - Seen (Unit) := True; + -- Special cases + + -- Skip constructs which do not have elaboration of their own and + -- need to be elaborated by other means such as invocation, task + -- activation, etc. + + if Is_Non_Library_Level_Encapsulator (Nod) then + return Skip; + + -- 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. + + 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; + + -- 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. + + elsif Nkind_In (Nod, N_And_Then, N_Or_Else) then + Traverse_List (Actions (Nod)); + + elsif Nkind_In (Nod, N_Elsif_Part, N_Iteration_Scheme) then + Traverse_List (Condition_Actions (Nod)); + + elsif Nkind (Nod) = N_If_Expression then + Traverse_List (Then_Actions (Nod)); + Traverse_List (Else_Actions (Nod)); + + elsif Nkind_In (Nod, N_Component_Association, + N_Iterated_Component_Association) + then + Traverse_List (Loop_Actions (Nod)); + + -- General case + + elsif Is_Suitable_Scenario (Nod) then + Process_Scenario (Nod, In_Task_Body); end if; - -- First, check for Elaborate_Alls on this unit + return OK; + end Is_Potential_Scenario; + + ------------------- + -- Traverse_List -- + ------------------- - Item := First (Context_Items (CU)); + procedure Traverse_List (List : List_Id) is + Item : Node_Id; + + begin + Item := First (List); 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. + Traverse_Potential_Scenarios (Item); + Next (Item); + end loop; + end Traverse_List; - if Error_Posted (Item) or else not Analyzed (Item) then - return; - end if; + -- Start of processing for Traverse_Body - Elab_Id := - Entity - (Expression (First (Pragma_Argument_Associations (Item)))); + begin + -- Nothing to do when there is no body - if E = Elab_Id then - Result := True; - return; - end if; + if No (N) then + return; - Par := Parent (Unit_Declaration_Node (Elab_Id)); + elsif Nkind (N) /= N_Subprogram_Body then + return; + end if; - 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; + -- Nothing to do if the body was already traversed during the processing + -- of the same top level scenario. - Next (Item2); - end loop; - end if; + if Visited_Bodies.Get (N) then + return; - Next (Item); + -- Otherwise mark the body as traversed + + else + Visited_Bodies.Set (N, True); + end if; + + -- Examine the declarations for suitable scenarios + + Traverse_List (Declarations (N)); + + -- Examine the handled sequence of statements. This also includes any + -- exceptions handlers. + + Traverse_Potential_Scenarios (Handled_Statement_Sequence (N)); + end Traverse_Body; + + --------------------------------- + -- Update_Elaboration_Scenario -- + --------------------------------- + + procedure Update_Elaboration_Scenario (New_N : Node_Id; Old_N : Node_Id) is + package Scenarios renames Top_Level_Scenarios; + + 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 + + for Index in Scenarios.First .. Scenarios.Last loop + if Scenarios.Table (Index) = Old_N then + Scenarios.Table (Index) := New_N; + + Set_Is_Recorded_Scenario (Old_N, False); + Set_Is_Recorded_Scenario (New_N); + return; + end if; 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 d2465827681..ddcd43306b0 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 59bbdb5f0ab..f0562ae59a6 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 " @@ -13243,16 +13249,18 @@ package body Sem_Prag is -- 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 + -- 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 Is_Ignored (N) then - Preanalyze_And_Resolve (Str, Standard_String); + Preanalyze_And_Resolve (Str, Standard_String); - -- Otherwise we need a proper analysis and expansion - - else - Analyze_And_Resolve (Str, Standard_String); - end if; end if; -- Now you might think we could just do the same with the Boolean @@ -14384,12 +14392,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 +15006,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 +15083,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 +15130,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 +20209,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 +20836,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 1435e047f5a..68c1a0892a6 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,18 @@ 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 +5776,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 +5841,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 +6105,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 +6127,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 +6644,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 +7192,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 +7285,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 +7529,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 +7649,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 +7763,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 8c81d2e760f..5107d3bc5f4 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 c70d892bf0b..05315852511 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; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 20cda2d800e..0eefd505c25 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 -- -------------------------- @@ -5760,11 +5800,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 +5855,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 +5887,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 +6918,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 +7867,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 +9620,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 +10750,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 +10998,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 +11044,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 +11789,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 +11964,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 +11980,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 -- --------------------- @@ -13286,7 +13387,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,6 +15388,162 @@ package body Sem_Util is end if; end Is_Potentially_Unevaluated; + -------------------------------- + -- Is_Preelaborable_Aggregate -- + -------------------------------- + + 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); + + Anc_Part : Node_Id; + Assoc : Node_Id; + Choice : Node_Id; + Comp_Typ : Entity_Id; + Expr : Node_Id; + + begin + if Array_Aggr then + Comp_Typ := Component_Type (Aggr_Typ); + end if; + + -- Inspect the ancestor part + + 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; + + -- Otherwise the ancestor denotes an expression + + elsif not Is_Preelaborable_Construct (Anc_Part) then + return False; + end if; + end if; + + -- Inspect the positional associations + + 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 -- --------------------------------- @@ -16941,6 +17198,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 +17802,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 +18968,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 +19113,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 +19519,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 +20584,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 +20648,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 +20888,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 +22491,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 +22514,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 +23310,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 30c35cb1591..c6958cb1aaa 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 f20d9df5a9d..0e498d3e6cb 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 4eb1c8c6f47..e4f8608eb73 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 @@ -439,7 +426,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 +434,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 +938,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 +1843,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 +1864,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 +1898,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 +2007,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 +2082,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 +2507,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 +2538,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 +3265,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 +3445,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 +3484,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 @@ -4285,7 +4361,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 +5257,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 +5287,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 +5312,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 +5421,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 +5496,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 +5921,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 +5952,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 +6679,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 +6859,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 0c4dfdf3910..9030c7c1176 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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 @@ -1159,7 +1150,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 +1472,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 +1651,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 +1685,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 +1705,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 +1719,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 +1738,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 +1801,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 +1859,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 +2079,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 +2101,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 +2313,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 +2389,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 +2520,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 +2669,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 +3824,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 +3891,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 +3987,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 +4182,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 +4719,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) @@ -4839,13 +4884,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 +5148,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 +5321,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 +5447,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 +5471,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 +5501,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 +6214,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 +6231,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 +7028,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 +7042,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 +7058,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 +7377,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 +7786,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 -- ------------------------ @@ -7851,7 +7951,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 +8454,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 +8811,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 +9080,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 @@ -9251,7 +9351,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 +9644,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 +9698,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 +9725,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 +9851,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 +9861,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 +10082,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 +10145,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 +10169,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 @@ -10316,7 +10440,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 +10730,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 +10784,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 +10811,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 +10937,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 +10947,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 +11168,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 +11231,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 +13005,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 +13048,6 @@ package Sinfo is -- Inline Pragmas -- -------------------- - pragma Inline (ABE_Is_Certain); pragma Inline (Abort_Present); pragma Inline (Abortable_Part); pragma Inline (Abstract_Present); @@ -12988,10 +13145,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 +13237,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 +13255,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 +13264,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 +13305,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 +13382,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 +13403,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); @@ -13429,10 +13594,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 +13612,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 +13621,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 +13663,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 +13739,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 +13759,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 48061238659..7f4b7861e15 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/sprint.adb b/gcc/ada/sprint.adb index 0052409b552..ac2dcd8a14d 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 52a72e4de40..61fe4404b7d 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/targparm.adb b/gcc/ada/targparm.adb index 725bb4c2867..63b124ab723 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/brig/ChangeLog b/gcc/brig/ChangeLog index bdb70188240..fa7668486b2 100644 --- a/gcc/brig/ChangeLog +++ b/gcc/brig/ChangeLog @@ -1,3 +1,18 @@ +2017-10-09 Pekka Jääskeläinen <pekka.jaaskelainen@parmance.com> + + * 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 <henry.linjamaki@parmance.com> + + * 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 <henry.linjamaki@parmance.com> * 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 30aec373732..039f1853d4a 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<tree, va_gc> *&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 6459f9e1076..41246ba2bfc 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 2da21c8335c..88e87eb6a9d 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/c-family/ChangeLog b/gcc/c-family/ChangeLog index f70b6f83832..f880f29fd55 100644 --- a/gcc/c-family/ChangeLog +++ b/gcc/c-family/ChangeLog @@ -1,3 +1,42 @@ +2017-10-13 Jakub Jelinek <jakub@redhat.com> + + * c-gimplify.c (c_gimplify_expr): Handle [LR]ROTATE_EXPR like + [LR]SHIFT_EXPR. + +2017-10-12 David Malcolm <dmalcolm@redhat.com> + + * 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 <nathan@acm.org> + + * c-opts.c (add_prefixed_path): Change chain to incpath_kind. + (c_common_handle_option): Update incpath_kind names. + +2017-10-11 Martin Liska <mliska@suse.cz> + + PR sanitizer/82490 + * c-attribs.c (handle_no_sanitize_attribute): Report directly + Wattributes warning. + +2017-10-10 Richard Sandiford <richard.sandiford@linaro.org> + + * 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 <jakub@redhat.com> + + PR c/82437 + * c-warn.c (warn_tautological_bitwise_comparison): Use wi::to_wide + instead of wide_int::from. + 2017-10-06 Jakub Jelinek <jakub@redhat.com> PR c/82437 diff --git a/gcc/c-family/c-ada-spec.c b/gcc/c-family/c-ada-spec.c index 834360f347e..95aacd1697a 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 4e6754fba20..bd8ca306c2d 100644 --- a/gcc/c-family/c-attribs.c +++ b/gcc/c-family/c-attribs.c @@ -613,15 +613,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); diff --git a/gcc/c-family/c-common.c b/gcc/c-family/c-common.c index fe15179d70a..506d8a74067 100644 --- a/gcc/c-family/c-common.c +++ b/gcc/c-family/c-common.c @@ -3191,7 +3191,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. */ @@ -8059,6 +8059,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 7f8ed65ae91..1c2928341ad 100644 --- a/gcc/c-family/c-common.h +++ b/gcc/c-family/c-common.h @@ -1613,6 +1613,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-gimplify.c b/gcc/c-family/c-gimplify.c index 6a4b7c77a34..91f9bf9c7a3 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 9984ea2bdd6..982d075b8e1 100644 --- a/gcc/c-family/c-opts.c +++ b/gcc/c-family/c-opts.c @@ -119,7 +119,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 *); @@ -436,7 +436,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) @@ -681,7 +681,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: @@ -698,7 +698,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: @@ -706,15 +706,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: @@ -1460,7 +1460,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 a1282b8125e..cca1cad7356 100644 --- a/gcc/c-family/c-pretty-print.c +++ b/gcc/c-family/c-pretty-print.c @@ -923,9 +923,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 2eb4cf5dd41..cb1db0327c3 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 ae9d63991f0..1f697f17f99 100644 --- a/gcc/c/ChangeLog +++ b/gcc/c/ChangeLog @@ -1,3 +1,24 @@ +2017-10-12 David Malcolm <dmalcolm@redhat.com> + + * 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 <nathan@acm.org> + + * c-decl.c (grokdeclarator): Check HAS_DECL_ASSEMBLER_NAME_P too. + +2017-10-10 Richard Sandiford <richard.sandiford@linaro.org> + + * 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 <dmalcolm@redhat.com> * 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 6dc90d99540..74a96566160 100644 --- a/gcc/c/c-decl.c +++ b/gcc/c/c-decl.c @@ -7191,7 +7191,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 549fb14ebd6..276a5e03581 100644 --- a/gcc/c/c-parser.c +++ b/gcc/c/c-parser.c @@ -1062,13 +1062,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)) { @@ -1080,6 +1088,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. */ @@ -4015,7 +4030,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; @@ -6499,7 +6515,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. */ @@ -18398,7 +18415,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 01a7b724081..21e40541ce6 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 01be59d2306..411062891d8 100644 --- a/gcc/c/c-typeck.c +++ b/gcc/c/c-typeck.c @@ -5832,7 +5832,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)); } } @@ -13830,7 +13830,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, @@ -14576,7 +14576,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/c-upc-low.c b/gcc/c/c-upc-low.c index c894644e51f..727f9d90f0a 100644 --- a/gcc/c/c-upc-low.c +++ b/gcc/c/c-upc-low.c @@ -1157,7 +1157,7 @@ upc_genericize_expr (tree *expr_p, int *walk_subtrees, void *data) if (type && SHARED_TYPE_P (type)) { const tree u_type = build_unshared_type (type); - *expr_p = wide_int_to_tree (u_type, expr); + *expr_p = wide_int_to_tree (u_type, wi::to_wide (expr)); } gcc_assert (!TREE_SHARED (expr)); break; diff --git a/gcc/caller-save.c b/gcc/caller-save.c index 3ea8e29a09d..7c787f75163 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 72cf9e016c8..7ed05d40d86 100644 --- a/gcc/calls.c +++ b/gcc/calls.c @@ -1293,8 +1293,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 +1300,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 +1308,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 +1333,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); } } @@ -4119,7 +4117,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 +4124,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/cfgexpand.c b/gcc/cfgexpand.c index bd3312eb3ba..be93c5843e5 100644 --- a/gcc/cfgexpand.c +++ b/gcc/cfgexpand.c @@ -4326,9 +4326,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 +5193,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); diff --git a/gcc/cfghooks.c b/gcc/cfghooks.c index 18dc49a035e..258a5eabf8d 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,6 +161,15 @@ verify_flow_info (void) e->src->index, e->dest->index); err = 1; } + /* 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 ("Uninitialized probability of edge %i->%i", e->src->index, + e->dest->index); + err = 1; + } if (!e->probability.verify ()) { error ("verify_flow_info: Wrong probability of edge %i->%i", diff --git a/gcc/cfgloop.c b/gcc/cfgloop.c index 6911426787b..c3bd9c05013 100644 --- a/gcc/cfgloop.c +++ b/gcc/cfgloop.c @@ -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/cfgrtl.c b/gcc/cfgrtl.c index 6ef47b7e61f..739d1bb9490 100644 --- a/gcc/cfgrtl.c +++ b/gcc/cfgrtl.c @@ -5039,14 +5039,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 3d0cefbd46b..d8da3dd76cd 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 8c1acf770b9..9385dc825ab 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), + "%<ifunc%> 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, + "%<ifunc%> 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 <cgraph_node *> (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 %<ifunc%> 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 %<ifunc%> 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) diff --git a/gcc/combine.c b/gcc/combine.c index 400cef3495a..3b96d86bdb3 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); } diff --git a/gcc/common.opt b/gcc/common.opt index ce8194b58fa..c95da640174 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. diff --git a/gcc/compare-elim.c b/gcc/compare-elim.c index 7e557a245b5..794a452f98b 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 + <instructions that don't read the condition register> + 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,7 +726,9 @@ try_eliminate_compare (struct comparison *cmp) { rtx flags, in_a, in_b, cmp_src; - /* We must have found an interesting "clobber" preceding the compare. */ + if (try_merge_compare (cmp)) + return true; + if (cmp->prev_clobber == NULL) return false; @@ -714,6 +854,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 91a55e89d04..248ee36e96a 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 diff --git a/gcc/config/aarch64/aarch64.c b/gcc/config/aarch64/aarch64.c index ee98a1f8228..ec055876a74 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; } @@ -11039,7 +11043,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 +11074,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 +11107,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/alpha/alpha.c b/gcc/config/alpha/alpha.c index 41f3e3a1957..ece8879cb22 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.c b/gcc/config/arm/arm.c index 622218c60ef..c93ad95b1a6 100644 --- a/gcc/config/arm/arm.c +++ b/gcc/config/arm/arm.c @@ -5883,7 +5883,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 +5914,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 +5947,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/avr/avr.c b/gcc/config/avr/avr.c index 62ddc579d86..d9c8277eff5 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 ed9ea03682f..c95f82dc3ae 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 157c2fd597d..91f08a0dcee 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 b6dad70df0a..e633b88f6b0 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/i386/i386-builtin.def b/gcc/config/i386/i386-builtin.def index 7ff1bb1a7e0..0d5d5b74675 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) diff --git a/gcc/config/i386/i386-protos.h b/gcc/config/i386/i386-protos.h index fbe9f271434..6a7cdd3ed73 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 99af67abd6e..4bbafde5c63 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<<PROCESSOR_I386) @@ -6872,6 +4792,30 @@ ix86_conditional_register_usage (void) fixed_regs[i] = call_used_regs[i] = 1, reg_names[i] = ""; } +/* Canonicalize a comparison from one we don't have to one we do have. */ + +static void +ix86_canonicalize_comparison (int *code, rtx *op0, rtx *op1, + bool op0_preserve_value) +{ + /* The order of operands in x87 ficom compare 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. */ + if (!op0_preserve_value + && GET_CODE (*op0) == FLOAT && MEM_P (XEXP (*op0, 0)) && REG_P (*op1)) + { + enum rtx_code scode = swap_condition ((enum rtx_code) *code); + + /* We are called only for compares that are split to SAHF instruction. + Ensure that we have setcc/jcc insn for the swapped condition. */ + if (ix86_fp_compare_code_to_integer (scode) != UNKNOWN) + { + std::swap (*op0, *op1); + *code = (int) scode; + } + } +} /* Save the current options */ @@ -24354,31 +22298,6 @@ ix86_expand_branch (enum rtx_code code, rtx op0, rtx op1, rtx label) } } -/* Split branch based on floating point condition. */ -void -ix86_split_fp_branch (enum rtx_code code, rtx op1, rtx op2, - rtx target1, rtx target2, rtx tmp) -{ - rtx condition; - rtx_insn *i; - - if (target2 != pc_rtx) - { - std::swap (target1, target2); - code = reverse_condition_maybe_unordered (code); - } - - condition = ix86_expand_fp_compare (code, op1, op2, - tmp); - - i = emit_jump_insn (gen_rtx_SET - (pc_rtx, - gen_rtx_IF_THEN_ELSE (VOIDmode, - condition, target1, target2))); - if (split_branch_probability.initialized_p ()) - add_reg_br_prob_note (i, split_branch_probability); -} - void ix86_expand_setcc (rtx dest, enum rtx_code code, rtx op0, rtx op1) { @@ -30066,8 +27985,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; @@ -30171,7 +28090,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 @@ -30353,773 +28272,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); @@ -31345,204 +28497,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) @@ -31560,25 +28514,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. */ @@ -31685,12 +28621,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 @@ -31700,7 +28636,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; } @@ -31819,7 +28755,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; } @@ -33003,7 +29939,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); @@ -33441,7 +30379,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); @@ -33465,7 +30405,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); @@ -37929,18 +34871,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))) { @@ -41867,6 +38814,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. */ @@ -41880,6 +38848,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) { @@ -42024,19 +38995,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) { @@ -42078,9 +39050,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. */ @@ -42099,8 +39071,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)) @@ -42110,8 +39081,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) @@ -42124,22 +39096,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 @@ -42193,13 +39172,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; @@ -42278,8 +39257,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)) @@ -42289,8 +39267,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 */ @@ -42313,8 +39290,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)) @@ -42324,20 +39300,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 @@ -42370,28 +39340,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: @@ -42405,7 +39385,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); @@ -42414,7 +39394,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: @@ -43132,8 +40112,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; @@ -43242,13 +40222,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", @@ -43267,7 +40247,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) @@ -43276,7 +40256,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", @@ -51039,806 +48019,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) -{ - /* 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; -} /* Implementation of reassociation_width target hook used by reassoc phase to identify parallelism level in reassociated @@ -53528,6 +49721,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 ef88d89cae2..1196ed9b503 100644 --- a/gcc/config/i386/i386.h +++ b/gcc/config/i386/i386.h @@ -257,6 +257,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 +2613,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 99497a9f654..8262cf1c3f0 100644 --- a/gcc/config/i386/i386.md +++ b/gcc/config/i386/i386.md @@ -1612,8 +1612,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_<SWI24:MODE>MODE_FIOP @@ -1628,8 +1628,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_<SWI24:MODE>MODE_FIOP @@ -1640,7 +1640,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))] @@ -6264,7 +6264,7 @@ (set_attr "mode" "<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 +6275,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 +6301,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 +6315,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")]) @@ -8998,7 +9001,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 +9012,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 +9031,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 +9041,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 +9064,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 +9439,7 @@ (set_attr "mode" "<MODE>")]) (define_insn "*<code>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 +9450,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])" "<logic>{b}\t{%2, %h0|%h0, %2}" [(set_attr "isa" "*,nox64") (set_attr "type" "alu") (set_attr "mode" "QI")]) (define_insn "*<code>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 +9473,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]))" "<logic>{b}\t{%h2, %h0|%h0, %h2}" [(set_attr "type" "alu") (set_attr "mode" "QI")]) @@ -9552,7 +9565,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 +9575,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 +10243,26 @@ (clobber (reg:CC FLAGS_REG))])] "operands[2] = gen_lowpart (QImode, operands[2]);") +(define_insn_and_split "*ashl<mode>3_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>mode, operands) + && (INTVAL (operands[3]) & (GET_MODE_BITSIZE (<MODE>mode)-1)) + == GET_MODE_BITSIZE (<MODE>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_ashl<mode>3_1" [(set (match_operand:SWI48 0 "register_operand" "=r") (ashift:SWI48 (match_operand:SWI48 1 "nonimmediate_operand" "rm") @@ -10728,6 +10763,26 @@ (clobber (reg:CC FLAGS_REG))])] "operands[2] = gen_lowpart (QImode, operands[2]);") +(define_insn_and_split "*<shift_insn><mode>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 (<CODE>, <MODE>mode, operands) + && (INTVAL (operands[3]) & (GET_MODE_BITSIZE (<MODE>mode)-1)) + == GET_MODE_BITSIZE (<MODE>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 "*<shift_insn><mode>3_doubleword" [(set (match_operand:DWI 0 "register_operand" "=&r") (any_shiftrt:DWI (match_operand:DWI 1 "register_operand" "0") @@ -11187,6 +11242,26 @@ (clobber (reg:CC FLAGS_REG))])] "operands[2] = gen_lowpart (QImode, operands[2]);") +(define_insn_and_split "*<rotate_insn><mode>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 (<CODE>, <MODE>mode, operands) + && (INTVAL (operands[3]) & (GET_MODE_BITSIZE (<MODE>mode)-1)) + == GET_MODE_BITSIZE (<MODE>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 +11569,30 @@ (clobber (reg:CC FLAGS_REG))])] "operands[1] = gen_lowpart (QImode, operands[1]);") +(define_insn_and_split "*<btsc><mode>_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>mode)-1)) + == GET_MODE_BITSIZE (<MODE>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<mode>" [(set (match_operand:SWI48 0 "register_operand" "=r") (and:SWI48 @@ -11535,6 +11634,30 @@ (clobber (reg:CC FLAGS_REG))])] "operands[1] = gen_lowpart (QImode, operands[1]);") +(define_insn_and_split "*btr<mode>_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>mode)-1)) + == GET_MODE_BITSIZE (<MODE>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 +12086,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 +12106,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 +12155,6 @@ if (! ix86_comparison_operator (operands[0], VOIDmode)) FAIL; }) - -;; Define combination compare-and-branch fp compare instructions to help -;; combine. - -(define_insn "*jcc<mode>_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<mode>_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<mode>_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<mode>_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<mode>_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<mode>_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<fp>_<int>_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<X87MODEF:mode>_<SWI24:mode>_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_<SWI24:MODE>MODE_FIOP - || optimize_function_for_size_p (cfun))" - "#") - -(define_insn "*jcc<X87MODEF:mode>_<SWI24:mode>_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_<SWI24:MODE>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 @@ -18916,7 +18814,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 +18828,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 +18843,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 +18855,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/ia32intrin.h b/gcc/config/i386/ia32intrin.h index 5f954fce85e..1f4e484d55b 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 4e023afb110..0917fad15d4 100644 --- a/gcc/config/i386/predicates.md +++ b/gcc/config/i386/predicates.md @@ -1387,19 +1387,6 @@ (match_operand 0 "comparison_operator") (match_operand 0 "ix86_trivial_fp_comparison_operator"))) -;; Same as above, but for swapped comparison used in *jcc<fp>_<int>_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 +1410,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/sync.md b/gcc/config/i386/sync.md index 29b82f86d43..eceaa73a679 100644 --- a/gcc/config/i386/sync.md +++ b/gcc/config/i386/sync.md @@ -219,29 +219,71 @@ (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")] UNSPEC_LDX_ATOMIC)) (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<mode>" [(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 0a8524bfbe2..8411a9680ff 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 00000000000..c5ded939237 --- /dev/null +++ b/gcc/config/i386/x86-tune-costs.h @@ -0,0 +1,2374 @@ + +/* 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. */ + 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 (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 */ + /* 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. */ + + 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 (8), /* cost of FMA SS instruction. */ + COSTS_N_INSNS (8), /* 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, 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. */ + + 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 00000000000..86942c0703d --- /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 +<http://www.gnu.org/licenses/>. */ + +#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 00000000000..c862fc156e2 --- /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 +<http://www.gnu.org/licenses/>. */ + +#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 00000000000..67b14a708e8 --- /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 +<http://www.gnu.org/licenses/>. */ + +#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 00000000000..aac2bae8061 --- /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 +<http://www.gnu.org/licenses/>. */ + +#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 63f69b4b503..9d01761eff9 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 80ea1190fba..4f32fc855e5 100644 --- a/gcc/config/msp430/msp430.c +++ b/gcc/config/msp430/msp430.c @@ -1877,7 +1877,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 65095ffaff1..c1eb66abc17 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 db041531209..661480fd479 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 12af88417ba..528f62da71d 100644 --- a/gcc/config/powerpcspe/powerpcspe.c +++ b/gcc/config/powerpcspe/powerpcspe.c @@ -11617,7 +11617,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 +11648,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 +11681,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 +15939,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 a155df61b99..976bffa61e7 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 6b13a80a8f3..c835dc0317b 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 722d98439b2..105d9bef360 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 00000000000..d83e035da05 --- /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 <meissner@linux.vnet.ibm.com>. + + 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 + <http://www.gnu.org/licenses/>. */ + +#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 <stdint.h> + +/* 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 237b4323b4c..569158f4c35 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 2a916b43873..8e581249b74 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 83df9c871cf..e1324b72c25 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 c6be5b1ef59..db0e692739c 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.c b/gcc/config/rs6000/rs6000.c index 35805b428a2..2675ef3713d 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,6 @@ rs6000_builtin_vectorization_cost (enum vect_cost_for_stmt type_of_cost, return 3; case unaligned_load: - if (TARGET_P9_VECTOR) - return 3; - if (TARGET_EFFICIENT_UNALIGNED_VSX) return 1; @@ -10979,7 +10957,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; @@ -11009,7 +10988,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; @@ -11041,7 +11021,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; @@ -15142,14 +15123,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); @@ -23300,24 +23282,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) { @@ -34438,7 +34402,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); } @@ -34983,6 +34948,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 60219726f9d..5a5244aff85 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. */ @@ -2065,6 +2063,29 @@ extern scalar_int_mode rs6000_pmode; #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. */ /* A C string constant describing how to begin a comment in the target diff --git a/gcc/config/rs6000/rs6000.md b/gcc/config/rs6000/rs6000.md index 97a75a2291c..aad382ced33 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<sel>" + "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<sel>" - "* -{ 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_<mode>" [(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<sel>" - "* -{ 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_<mode>" - [(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<sel>" - "* -{ 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_<mode>" - [(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<sel>" - "* -{ 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 "mov<mode>cc" diff --git a/gcc/config/s390/s390-builtins.def b/gcc/config/s390/s390-builtins.def index 5cfe9a43de9..ea561f7e2af 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 52a82df0044..3ef3c197fed 100644 --- a/gcc/config/s390/s390.c +++ b/gcc/config/s390/s390.c @@ -1102,11 +1102,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; diff --git a/gcc/config/s390/vecintrin.h b/gcc/config/s390/vecintrin.h index 38cc0692df8..80eb2b30867 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/vms/vms-c.c b/gcc/config/vms/vms-c.c index c666ad18065..278c8e236be 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/cp/ChangeLog b/gcc/cp/ChangeLog index 6c92e1b3856..2b6e3b68b3c 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,124 @@ +2017-10-13 Jason Merrill <jason@redhat.com> + + PR c++/82357 - bit-field in template + * tree.c (cp_stabilize_reference): Just return a NON_DEPENDENT_EXPR. + +2017-10-13 David Malcolm <dmalcolm@redhat.com> + + * 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 <nathan@acm.org> + + * 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 <dmalcolm@redhat.com> + + * 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 <dmalcolm@redhat.com> + + * 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 <nathan@acm.org> + + * decl2.c (struct mangled_decl_hash): Use DECL_ASSEMBLER_NAME_RAW. + (record_mangling): Likewise. + +2017-10-10 Nathan Sidwell <nathan@acm.org> + + * 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 <lang_identifier *>): Delete + specialization. + + * decl2.c (struct mangled_decl_hash): New hash traits. + (mangled_decls): Make hash_table<mangled_decl_hash>. + (generate_mangling_alias, record_mangling): Adjust. + +2017-10-10 Jason Merrill <jason@redhat.com> + + 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 <richard.sandiford@linaro.org> + + * 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 <nathan@acm.org> + + * name-lookup.c (set_global_binding): Don't deal with STAT_HACK. + 2017-10-06 Paolo Carlini <paolo.carlini@oracle.com> PR c++/47791 diff --git a/gcc/cp/call.c b/gcc/cp/call.c index 9d747be9d79..13269024547 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<tree, va_gc> **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)) @@ -7772,6 +7778,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) diff --git a/gcc/cp/constexpr.c b/gcc/cp/constexpr.c index 8a5be2079d8..59192829d71 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 64a8ea926d2..8b49455a526 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-tree.h b/gcc/cp/cp-tree.h index b29e4e0be02..b74b6d9d950 100644 --- a/gcc/cp/cp-tree.h +++ b/gcc/cp/cp-tree.h @@ -65,7 +65,9 @@ public: /* 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 <lang_identifier *> - : pointer_hash <tree_node> -{ - /* 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 a3bd4a137d8..c0d0a600562 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 0e70bb5d59d..a3cc80cf7a3 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 1cbd11dac45..bc509623b36 100644 --- a/gcc/cp/decl2.c +++ b/gcc/cp/decl2.c @@ -102,9 +102,35 @@ static GTY(()) vec<tree, va_gc> *no_linkage_decls; is to be an alias for the former if the former is defined. */ static GTY(()) vec<tree, va_gc> *mangling_aliases; -/* A hash table of mangled names to decls. Used to figure out if we - need compatibility aliases. */ -static GTY(()) hash_map<lang_identifier *, tree> *mangled_decls; +/* hash traits for declarations. Hashes single decls via + DECL_ASSEMBLER_NAME_RAW. */ + +struct mangled_decl_hash : ggc_remove <tree> +{ + 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_decl_hash> *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<lang_identifier *, tree>::create_ggc (499); + mangled_decls = hash_table<mangled_decl_hash>::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 f5c8e801918..23e30cf789c 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 78bd89782aa..76f2f29578f 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<tree> *pset = (hash_set<tree> *)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<tree> 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 6046906e77d..64397cdddcb 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 a3da34d7549..b1b4ebbb7de 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<named_decl_hash> *extern_c_fns; +static GTY(()) hash_table<named_decl_hash> *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<named_decl_hash>::create_ggc (127); + if (!extern_c_decls) + extern_c_decls = hash_table<named_decl_hash>::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 7883c64f33f..2337be52c38 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, + "%<extern \"C\"%> linkage started here"); +} + #include "gt-cp-parser.h" diff --git a/gcc/cp/parser.h b/gcc/cp/parser.h index 0994e1e7f4f..f4f4a010964 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 52fc4d6a222..ba52f3b57a6 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<tree, tree> *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<tree, tree>; + 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 d96423f2348..a512664e396 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 060440c557d..40c01cd64e3 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 c3310db7b3b..08b2ae555e6 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__, "%<operator=%> 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 @@ -9222,6 +9233,9 @@ check_return_expr (tree retval, bool *no_warning) 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 672fd2eaea9..25653ac77bb 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 ea7c97ccb31..0615e84fc83 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 6adb872146b..b8cf6f2c045 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 <windows.h> +#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 4156291b642..d9b7a540cbd 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<Func*>(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. @@ -8081,7 +8122,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 +8482,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 +8718,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 +8770,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 +8804,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 +8835,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 @@ -12041,6 +12211,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 +19297,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 <amo.h> + +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/invoke.texi b/gcc/doc/invoke.texi index 158d9077f09..cc67d9a6765 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -5470,6 +5470,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 diff --git a/gcc/doc/md.texi b/gcc/doc/md.texi index 14aab9474bc..c4c113850fe 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/tm.texi b/gcc/doc/tm.texi index 48f757c6d62..ecc56b4c50c 100644 --- a/gcc/doc/tm.texi +++ b/gcc/doc/tm.texi @@ -6653,6 +6653,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 5ec687aadf4..1221dd3f298 100644 --- a/gcc/doc/tm.texi.in +++ b/gcc/doc/tm.texi.in @@ -4601,6 +4601,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 cff3ac47356..563ca9f56f3 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 a8787eb6380..b7a2fea56e3 100644 --- a/gcc/dwarf2out.c +++ b/gcc/dwarf2out.c @@ -19124,12 +19124,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 @@ -19137,10 +19136,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, @@ -19867,7 +19865,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; } @@ -21289,7 +21287,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/except.c b/gcc/except.c index 4991e7bb01b..041f89a55e5 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<tree_hash, tree> *type_to_runtime_map; +static GTY(()) hash_map<tree_hash, tree> *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, diff --git a/gcc/expr.c b/gcc/expr.c index d34e552d91d..42ccbf6c878 100644 --- a/gcc/expr.c +++ b/gcc/expr.c @@ -6748,8 +6748,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) @@ -7152,7 +7155,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 <offset_int> (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; @@ -11787,7 +11790,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/final.c b/gcc/final.c index eff2ee6c496..0ddf7793209 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/fold-const-call.c b/gcc/fold-const-call.c index 71f0b524680..98ac0911743 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 3140cda296a..3458a399182 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); } } } @@ -4037,7 +4040,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 +4049,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", @@ -4196,7 +4199,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 +4225,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 +5452,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 @@ -6055,7 +6059,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 +6177,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 +6247,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 +6287,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 +6350,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 +6360,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 +6544,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 +6554,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 +6698,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 +6878,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 +6970,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); @@ -8221,7 +8232,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); @@ -9023,7 +9034,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))) @@ -9432,7 +9443,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; @@ -9450,25 +9464,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) @@ -9480,39 +9501,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); + } } } } @@ -9900,8 +9919,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) @@ -9912,7 +9931,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); @@ -9923,12 +9942,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; @@ -10002,7 +10022,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, @@ -10016,8 +10036,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), @@ -10044,7 +10065,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 @@ -10080,8 +10101,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) @@ -10099,7 +10119,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: @@ -10157,7 +10177,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)); @@ -10200,7 +10220,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 " @@ -10331,7 +10351,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)); @@ -10513,40 +10534,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 @@ -10618,7 +10605,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); @@ -10694,7 +10681,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)) { @@ -10929,130 +10916,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 @@ -11444,7 +11339,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)); @@ -11667,7 +11562,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; @@ -11749,9 +11644,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); @@ -12571,7 +12466,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, @@ -13705,7 +13601,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)); @@ -13752,7 +13648,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 @@ -13760,7 +13656,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)); } @@ -13789,7 +13685,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 @@ -14244,7 +14140,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 aaebe17fb51..5b003d81a99 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,32 @@ +2017-10-15 Thomas Koenig <tkoenig@gcc.gnu.org> + + 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 <pault@gcc.gnu.org> + + PR fortran/81048 + * resolve.c (resolve_symbol): Ensure that derived type array + results get default initialization. + +2017-10-11 Nathan Sidwell <nathan@acm.org> + + * cpp.c (gfc_cpp_add_include_path): Update incpath_e names. + (gfc_cpp_add_include_path_after): Likewise. + +2017-10-10 Richard Sandiford <richard.sandiford@linaro.org> + + * 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 <kargl@gcc.gnu.org> * check.c (gfc_check_x): Remove function. diff --git a/gcc/fortran/cpp.c b/gcc/fortran/cpp.c index 4d1b56a0045..af8a69ca3f7 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/resolve.c b/gcc/fortran/resolve.c index bd316344813..5e4988e6945 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -14967,7 +14967,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 diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 82f431da527..49decfac52a 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/target-memory.c b/gcc/fortran/target-memory.c index ceca3accd93..b2fe8eee01c 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-const.c b/gcc/fortran/trans-const.c index 128d47d0fa3..62b85f738fc 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-expr.c b/gcc/fortran/trans-expr.c index d1b61b5228b..4e8bfc5d6f9 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 9bc465e43d9..532d3ab237d 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 ("%<dim%> 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 ("%<dim%> 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 ("%<dim%> argument of %s intrinsic at %L is not a valid " "dimension index", expr->value.function.isym->name, &expr->where); diff --git a/gcc/fwprop.c b/gcc/fwprop.c index ca997490cf1..b77006b4801 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/genrecog.c b/gcc/genrecog.c index 902762fbc57..b3d02d755eb 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 04fed926663..3abebb55025 100644 --- a/gcc/gimple-expr.c +++ b/gcc/gimple-expr.c @@ -351,9 +351,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) @@ -366,9 +365,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 b9e08897f6d..cb33c1e09fe 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-ssa-warn-alloca.c b/gcc/gimple-ssa-warn-alloca.c index ab4f9d82858..2d255a493d0 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 @@ -294,7 +295,8 @@ 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); diff --git a/gcc/gimple.c b/gcc/gimple.c index c4e6f8176b9..79213b22c24 100644 --- a/gcc/gimple.c +++ b/gcc/gimple.c @@ -2965,13 +2965,14 @@ preprocess_case_label_vec_for_gimple (vec<tree> 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/go/ChangeLog b/gcc/go/ChangeLog index 3918fa814d7..1c0ef932914 100644 --- a/gcc/go/ChangeLog +++ b/gcc/go/ChangeLog @@ -1,3 +1,8 @@ +2017-10-11 Tony Reix <tony.reix@atos.net> + + * 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 <iant@golang.org> * Make-lang.in (GO_OBJS): Add go/names.o. diff --git a/gcc/go/go-system.h b/gcc/go/go-system.h index 90185435c1e..b1c67c3cd73 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 <algorithm> diff --git a/gcc/go/gofrontend/MERGE b/gcc/go/gofrontend/MERGE index acb1d9584a3..418e1274fdf 100644 --- a/gcc/go/gofrontend/MERGE +++ b/gcc/go/gofrontend/MERGE @@ -1,4 +1,4 @@ -adc6eb826f156d0980f0ad9f9efc5c919ec4905e +44132970e4b6c1186036bf8eda8982fb6e905d6f 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 20b077f7f99..2a3ea83ca78 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 28d81a1e260..9a9d70fd59e 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-isl-ast-to-gimple.c b/gcc/graphite-isl-ast-to-gimple.c index dddc07b5b43..2a583aba63b 100644 --- a/gcc/graphite-isl-ast-to-gimple.c +++ b/gcc/graphite-isl-ast-to-gimple.c @@ -58,15 +58,6 @@ along with GCC; see the file COPYING3. If not see #include "tree-ssa.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 +134,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 +167,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,7 +189,6 @@ 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<tree> iv_map); bool graphite_copy_stmts_from_block (basic_block bb, basic_block new_bb, vec<tree> iv_map); @@ -234,8 +224,24 @@ private: /* A vector of all the edges at if_condition merge points. */ auto_vec<edge, 2> 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). @@ -265,29 +271,46 @@ gcc_expression_from_isl_ast_expr_id (tree type, return fold_convert (type, *val); } -/* 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 +319,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 +353,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 +707,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 +746,15 @@ build_iv_mapping (vec<tree> 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; } } @@ -842,8 +844,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. */ @@ -1082,7 +1083,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<tree> iv_map) { tree scev = scalar_evolution_in_region (region->region, loop, old_name); @@ -1111,16 +1111,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); @@ -1243,8 +1233,7 @@ graphite_copy_stmts_from_block (basic_block bb, basic_block new_bb, { gimple_seq stmts = NULL; new_name = get_rename_from_scev (old_name, &stmts, - bb->loop_father, - new_bb, bb, iv_map); + bb->loop_father, iv_map); if (! codegen_error_p ()) gsi_insert_earliest (stmts); new_expr = &new_name; @@ -1359,7 +1348,7 @@ copy_bb_and_scalar_dependences (basic_block bb, edge next_e, vec<tree> 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; @@ -1565,11 +1554,6 @@ graphite_regenerate_ast_isl (scop_p scop) 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 ()) @@ -1579,9 +1563,6 @@ graphite_regenerate_ast_isl (scop_p scop) "reverting back to the original code.\n"); set_ifsese_condition (if_region, integer_zero_node); - /* 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 +1578,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 93ab0354efb..c7e1dba9423 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 @@ public: 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,15 @@ 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; loop_p loop = loop_containing_stmt (stmt); if (!loop_in_sese_p (loop, scop)) - nest = loop; + { + nest = scop.entry; + loop = NULL; + } else - nest = outermost_loop_in_sese (scop, gimple_bb (stmt)); + nest = loop_preheader_edge (outermost_loop_in_sese (scop, gimple_bb (stmt))); auto_vec<data_reference_p> drs; if (! graphite_find_data_references_in_stmt (nest, loop, stmt, &drs)) @@ -1056,7 +1024,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; } @@ -1413,12 +1381,15 @@ try_generate_gimple_bb (scop_p scop, basic_block bb) vec<scalar_use> reads = vNULL; sese_l region = scop->scop_info->region; - loop_p nest; + edge nest; loop_p loop = bb->loop_father; if (!loop_in_sese_p (loop, region)) - nest = loop; + { + nest = region.entry; + loop = NULL; + } else - nest = outermost_loop_in_sese (region, bb); + nest = loop_preheader_edge (outermost_loop_in_sese (region, bb)); for (gimple_stmt_iterator gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi)) diff --git a/gcc/graphite-sese-to-poly.c b/gcc/graphite-sese-to-poly.c index 6cd5bc7c9d9..fc16ca969eb 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); @@ -763,10 +763,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 +777,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); @@ -1066,8 +1051,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 +1065,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 +1194,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 +1211,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 0bdcc28cba8..d11de71a9b8 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. */ @@ -212,64 +214,6 @@ print_graphite_statistics (FILE* file, vec<scop_p> scops) 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. */ static void @@ -396,7 +340,7 @@ graphite_transform_loops (void) { int i; scop_p scop; - bool need_cfg_cleanup_p = false; + bool changed = false; vec<scop_p> scops = vNULL; isl_ctx *ctx; @@ -405,8 +349,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); @@ -438,7 +381,7 @@ graphite_transform_loops (void) location_t loc = find_loop_location (scops[i]->scop_info->region.entry->dest->loop_father); - need_cfg_cleanup_p = true; + changed = true; if (!graphite_regenerate_ast_isl (scop)) dump_printf_loc (MSG_MISSED_OPTIMIZATION, loc, "loop nest not optimized, code generation error\n"); @@ -447,6 +390,16 @@ graphite_transform_loops (void) "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 e7014cbb8b3..d6dab57101b 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; diff --git a/gcc/hsa-common.h b/gcc/hsa-common.h index 810624e4e1c..3075163a020 100644 --- a/gcc/hsa-common.h +++ b/gcc/hsa-common.h @@ -157,6 +157,9 @@ public: /* 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 6e054c0ce82..b5a8c73731a 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 <hsa_op_reg *> (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 <hsa_op_immed *> (src)->m_type)); - + { + unsigned imm_size + = hsa_type_bit_size (as_a <hsa_op_immed *> (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 <hsa_op_immed *> (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 <hsa_op_reg *> (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 <hsa_op_immed *> (op2)) op2->m_type = utype; if (is_a <hsa_op_immed *> (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 <hsa_op_reg *> (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 <hsa_op_reg *> (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); } @@ -4200,6 +4290,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 +4363,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 +4453,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 +4468,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 +5032,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); diff --git a/gcc/ifcvt.c b/gcc/ifcvt.c index e1b163cd42e..278d5b240f1 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))); } } diff --git a/gcc/incpath.c b/gcc/incpath.c index 47942e2547d..a2ee69f428c 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 39a29cdd47e..32c3dceb78b 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 <foo> */ + 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 051f78715c2..ce9e8bb75e9 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 6b3d8d7364c..d23c1d8ba3e 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-polymorphic-call.c b/gcc/ipa-polymorphic-call.c index 9ac5153bf67..1c5aca4abdc 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 51f62218501..a687f7cb29e 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<widest_int>(TYPE_PRECISION (TREE_TYPE (arg)), false) - .and_not (align / BITS_PER_UNIT - 1); + widest_int mask = wi::bit_and_not + (wi::mask<widest_int> (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-utils.h b/gcc/ipa-utils.h index f061c84c8a9..2affbd66d13 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 <anon> 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 - ("<anon>", - IDENTIFIER_POINTER - (DECL_ASSEMBLER_NAME (TYPE_NAME (t))))); + gcc_checking_assert (!in_lto_p + || !DECL_ASSEMBLER_NAME_SET_P (TYPE_NAME (t)) + || !strcmp ("<anon>", + 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 <anon> as assembler names of anonymous types. verify that this match with type_in_anonymous_namespace_p. */ gcc_checking_assert (strcmp ("<anon>", - IDENTIFIER_POINTER - (DECL_ASSEMBLER_NAME (TYPE_NAME (t))))); + IDENTIFIER_POINTER + (DECL_ASSEMBLER_NAME (TYPE_NAME (t))))); return true; } return false; diff --git a/gcc/lto/ChangeLog b/gcc/lto/ChangeLog index 1911e84d1ca..173cde67369 100644 --- a/gcc/lto/ChangeLog +++ b/gcc/lto/ChangeLog @@ -1,3 +1,18 @@ +2017-10-13 Jan Hubicka <hubicka@ucw.cz> + + * lto-lang.c (lto_post_options): Clean shlib flag when not doing PIC. + +2017-10-11 Nathan Sidwell <nathan@acm.org> + + * lto.c (mentions_vars_p_decl_with_vis): Use + DECL_ASSEMBLER_NAME_RAW. + (lto_fixup_prevailing_decls): Likewise. + +2017-10-10 Richard Sandiford <richard.sandiford@linaro.org> + + * lto.c (compare_tree_sccs_1): Use wi::to_wide when + operating on trees as wide_ints. + 2017-08-30 Richard Sandiford <richard.sandiford@linaro.org> Alan Hayward <alan.hayward@arm.com> David Sherwood <david.sherwood@arm.com> diff --git a/gcc/lto/lto-lang.c b/gcc/lto/lto-lang.c index eaf793383f7..88f29705e65 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 182607b6fa4..63ba73c0dbf 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 adb98228932..79afc050ca6 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)). @@ -1397,7 +1440,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. */ @@ -1427,8 +1470,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. */ @@ -1538,8 +1582,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 @@ -1791,16 +1835,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 ) @@ -1827,7 +1875,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) /* Optimize (x >> c) << c into x & (-1<<c). */ (simplify (lshift (rshift @0 INTEGER_CST@1) @1) - (if (wi::ltu_p (@1, element_precision (type))) + (if (wi::ltu_p (wi::to_wide (@1), element_precision (type))) (bit_and @0 (lshift { build_minus_one_cst (type); } @1)))) /* Optimize (x << c) >> c into x & ((unsigned)-1 >> c) for unsigned @@ -1835,7 +1883,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) @@ -1882,10 +1930,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 @@ -1913,13 +1961,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)) @@ -2485,7 +2533,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: @@ -2623,13 +2674,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 @@ -3029,13 +3080,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); } @@ -3043,14 +3095,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); })))))) @@ -3140,7 +3194,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)) @@ -3153,11 +3208,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. */ @@ -3222,7 +3277,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. */ @@ -3262,7 +3317,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 @@ -3279,7 +3335,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); }))))) @@ -3291,7 +3347,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 @@ -3412,7 +3468,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); }) @@ -3422,7 +3478,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); }) @@ -3432,19 +3488,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 @@ -3500,10 +3556,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 @@ -4065,13 +4123,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. @@ -4136,8 +4194,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)))) @@ -4197,7 +4256,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); } @@ -4323,10 +4383,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/objc/ChangeLog b/gcc/objc/ChangeLog index ddfdb1c8c90..20b0fe44b29 100644 --- a/gcc/objc/ChangeLog +++ b/gcc/objc/ChangeLog @@ -1,3 +1,8 @@ +2017-10-10 Richard Sandiford <richard.sandiford@linaro.org> + + * objc-act.c (objc_decl_method_attributes): Use wi::to_wide when + operating on trees as wide_ints. + 2017-09-29 Jakub Jelinek <jakub@redhat.com> * 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 5d81af7fbd6..ce2adcc0ded 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); } diff --git a/gcc/omp-low.c b/gcc/omp-low.c index 3645661038a..afa758bf499 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 67dfa58ff46..94092fc1594 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 5aa5d066dbe..adf3d89851d 100644 --- a/gcc/opts.c +++ b/gcc/opts.c @@ -1700,11 +1700,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 +1721,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 2774e2c8b40..10938615725 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 e55afc28053..8881f4c403a 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 2c9add84c1d..65568e052fc 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/pretty-print.c b/gcc/pretty-print.c index 7340cd4a565..e66d898a645 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 <iconv.h> #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 <io.h> +#define WIN32_LEAN_AND_MEAN 1 +#include <windows.h> + +/* 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 79ec463df45..28d99862cad 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 cd4f9ae27ca..0cc34240ec6 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) { @@ -731,7 +731,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 4d22428a195..44ceaed2d66 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 8fd22b8b68a..4546e199f24 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 @@ public: /* 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 @@ public: { 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 @@ public: 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 @@ public: 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 @@ public: 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 @@ public: /* 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 @@ public: 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 @@ public: 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 @@ public: 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/recog.c b/gcc/recog.c index cfce0291ba0..b8e9b1ba3a8 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))) { diff --git a/gcc/ree.c b/gcc/ree.c index 19225d5833b..8915cbe0d6f 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/regcprop.c b/gcc/regcprop.c index 73e945d45ae..5db5b5d9fdf 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 a63f33e747a..f854550bb83 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 b28325e644b..eadf691d077 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 4d04ebd0c47..d20815e255b 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/sbitmap.c b/gcc/sbitmap.c index 4bf13a11a1d..baef4d05f0d 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; @@ -322,29 +323,22 @@ 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); 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 +358,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; } @@ -821,3 +816,92 @@ dump_bitmap_vector (FILE *file, const char *title, const char *subtitle, fprintf (file, "\n"); } + +#if CHECKING_P + +namespace selftest { + +/* Selftests for sbitmaps. */ + + +/* Verify range functions for sbitmap. */ + +static void +test_range_functions () +{ + 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_range_functions (); +} + +} // namespace selftest +#endif /* CHECKING_P */ diff --git a/gcc/selftest-run-tests.c b/gcc/selftest-run-tests.c index 30e476d14c5..5c84f3a0737 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 (); diff --git a/gcc/selftest.h b/gcc/selftest.h index 0572fefd281..2e649a70b9e 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 (); diff --git a/gcc/sese.c b/gcc/sese.c index b3bf6114fc7..8aa8015290d 100644 --- a/gcc/sese.c +++ b/gcc/sese.c @@ -444,14 +444,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 @@ -462,7 +461,6 @@ 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 @@ -473,7 +471,7 @@ scalar_evolution_in_region (const sese_l ®ion, loop_p loop, tree t) || 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, + return instantiate_scev (region.entry, loop, analyze_scalar_evolution (loop, t)); def = SSA_NAME_DEF_STMT (t); @@ -495,7 +493,7 @@ scalar_evolution_in_region (const sese_l ®ion, loop_p loop, tree t) if (has_vdefs) return chrec_dont_know; - return instantiate_scev (before, loop, t); + return instantiate_scev (region.entry, loop, t); } /* Return true if BB is empty, contains only DEBUG_INSNs. */ diff --git a/gcc/sese.h b/gcc/sese.h index 190deeda8af..faefd806d9d 100644 --- a/gcc/sese.h +++ b/gcc/sese.h @@ -334,6 +334,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/simplify-rtx.c b/gcc/simplify-rtx.c index 3b6cf6fa850..c4d6ce7586c 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 92bd209ad64..410ae61bd4d 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 96b721ec837..071ce374d80 100644 --- a/gcc/stor-layout.c +++ b/gcc/stor-layout.c @@ -2366,9 +2366,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/target-insns.def b/gcc/target-insns.def index 4669439c7e1..75976b2f8d9 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 b992680a33e..002eaf8f6ab 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/targhooks.c b/gcc/targhooks.c index b9aa07017dd..8c7531ef1ed 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 c2a658c3dcf..e2104133d07 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,482 @@ +2017-10-16 Jakub Jelinek <jakub@redhat.com> + + PR c++/53574 + * g++.dg/other/pr53574.C: New test. + +2017-10-16 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/61323 + * g++.dg/cpp0x/constexpr-61323.C: New. + +2017-10-15 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/54090 + * g++.dg/template/crash128.C: New. + +2017-10-15 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/82372 + * gfortran.dg/illegal_char.f90: New test. + +2017-10-14 Kyrylo Tkachov <kyrylo.tkachov@arm.com> + Michael Collison <michael.collison@arm.com> + + * gcc.target/aarch64/cmpelim_mult_uses_1.c: New test. + +2017-10-14 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/80908 + * g++.dg/cpp1z/noexcept-type18.C: New. + +2017-10-14 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/81016 + * g++.dg/cpp1z/pr81016.C: New. + +2017-10-14 Jakub Jelinek <jakub@redhat.com> + + 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 <kirtchev@adacore.com> + + * gnat.dg/remote_call_iface.ads, gnat.dg/remote_call_iface.adb: New + testcase. + +2017-10-14 Jakub Jelinek <jakub@redhat.com> + + 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 <jakub@redhat.com> + + 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 <pault@gcc.gnu.org> + + PR fortran/81048 + * gfortran.dg/derived_init_4.f90 : New test. + +2017-10-13 Paolo Carlini <paolo.carlini@oracle.com> + + 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 <jakub@redhat.com> + + PR target/82274 + * gcc.dg/pr82274-1.c: New test. + * gcc.dg/pr82274-2.c: New test. + +2017-10-13 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/80873 + * g++.dg/cpp1y/auto-fn41.C: New. + * g++.dg/cpp1y/auto-fn42.C: Likewise. + +2017-10-13 David Malcolm <dmalcolm@redhat.com> + + * 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 <rguenther@suse.de> + + * 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 <rguenther@suse.de> + + * 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 <hongjiu.lu@intel.com> + + 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 <jakub@redhat.com> + + 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 <rguenther@suse.de> + + 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 <rguenther@suse.de> + + PR tree-optimization/82525 + * gcc.dg/graphite/id-30.c: New testcase. + * gfortran.dg/graphite/id-28.f90: Likewise. + +2017-10-13 Alan Modra <amodra@gmail.com> + + * gcc.target/i386/asm-mem.c: New test. + +2017-10-12 Jakub Jelinek <jakub@redhat.com> + + PR target/82498 + * gcc.target/i386/pr82498-1.c: New test. + * gcc.target/i386/pr82498-2.c: New test. + +2017-10-12 Jan Hubicka <hubicka@ucw.cz> + + * gcc.dg/predict-13.c: Update template for probaility change. + * gcc.dg/predict-8.c: Likewise. + +2017-10-12 David Malcolm <dmalcolm@redhat.com> + + * 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 <msebor@redhat.com> + + 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 <dmalcolm@redhat.com> + + * g++.dg/parse/pragma2.C: Update to reflect reinstatement of the + "#pragma is not allowed here" error. + +2017-10-12 Bin Cheng <bin.cheng@arm.com> + + * 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 <bin.cheng@arm.com> + + * 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 <rguenther@suse.de> + + 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 <jakub@redhat.com> + + 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 <ubizjak@gmail.com> + + * gcc.target/i386/387-ficom-2.c: New test. + +2017-10-11 Jakub Jelinek <jakub@redhat.com> + + 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 <qing.zhao@oracle.com> + + PR target/81422 + * gcc.target/aarch64/pr81422.C: New test. + +2017-10-11 Vladimir Makarov <vmakarov@redhat.com> + + PR sanitizer/82353 + * gcc.target/i386/i386.exp (tests): Permit '.C' extension. + * gcc.target/i386/pr82353.C: New. + +2017-10-11 Uros Bizjak <ubizjak@gmail.com> + + * gcc.target/i386/387-ficom-1.c: New test. + +2017-10-11 Jeff Law <law@redhat.com> + + * 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 <marc.glisse@inria.fr> + + * gcc.dg/Wstrict-overflow-7.c: Xfail. + * gcc.dg/pragma-diag-3.c: Likewise. + +2017-10-11 Bin Cheng <bin.cheng@arm.com> + + PR tree-optimization/82472 + * gcc.dg/tree-ssa/pr82472.c: New test. + +2017-10-11 Martin Liska <mliska@suse.cz> + + PR sanitizer/82490 + * c-c++-common/ubsan/attrib-5.c: New test. + +2017-10-11 Martin Liska <mliska@suse.cz> + + Revert r253637: + + PR sanitizer/82484 + * gcc.dg/asan/pr82484.c: New test. + +2017-10-11 Martin Liska <mliska@suse.cz> + + PR sanitizer/82484 + * gcc.dg/asan/pr82484.c: New test. + +2017-10-11 Martin Liska <mliska@suse.cz> + + * c-c++-common/ubsan/ptr-overflow-sanitization-1.c: Scan + optimized dump rather than assembly. + +2017-10-11 Nathan Sidwell <nathan@acm.org> + + * g++.dg/cpp/string-3.C: Fix dg-final. + +2017-10-11 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/80412 + * g++.dg/cpp1z/class-deduction44.C: New. + +2017-10-11 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/82230 + * g++.dg/cpp1y/lambda-generic-ice8.C: New. + +2017-10-11 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/81299 + * g++.dg/cpp1y/lambda-generic-ice7.C: New. + +2017-10-10 Nathan Sidwell <nathan@acm.org> + + * 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 <paolo.carlini@oracle.com> + + PR c++/78006 + * g++.dg/cpp1y/auto-fn40.C: New. + +2017-10-10 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/81032 + * g++.dg/cpp1y/lambda-generic-ice6.C: New. + +2017-10-10 Jakub Jelinek <jakub@redhat.com> + + 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 <will_schmidt@vnet.ibm.com> + + * 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 <nathan@acm.org> + + PR preprocessor/82506 + * g++.dg/cpp/string-3.C: New. + +2017-10-10 Will Schmidt <will_schmidt@vnet.ibm.com> + + * 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 <tkoenig@gcc.gnu.org> + + PR libfortran/82233 + * gfortran.dg/execute_command_line_3.f90: New test. + +2017-10-10 Will Schmidt <will_schmidt@vnet.ibm.com> + + * 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 <will_schmidt@vnet.ibm.com> + + * 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 <jakub@redhat.com> + + PR c/82437 + * c-c++-common/Wtautological-compare-7.c: New test. + +2017-10-10 Bin Cheng <bin.cheng@arm.com> + + * gcc.dg/tree-ssa/ldist-34.c: New test. + +2017-10-10 Bin Cheng <bin.cheng@arm.com> + + * gcc.dg/tree-ssa/ldist-27.c: New test. + +2017-10-09 Ed Schonberg <schonberg@adacore.com> + + * gnat.dg/class_wide4.adb, gnat.dg/class_wide4_pkg.ads, + gnat.dg/class_wide4_pkg2.ads: New testcase. + +2017-10-09 Ed Schonberg <schonberg@adacore.com> + + * gnat.dg/class_wide3.adb, gnat.dg/class_wide3_pkg.ads: New testcase. + +2017-10-09 Ed Schonberg <schonberg@adacore.com> + + * gnat.dg/validity_check2.adb, gnat.dg/validity_check2_pkg.ads: + New testcase. + +2017-10-09 Michael Meissner <meissner@linux.vnet.ibm.com> + + * gcc.target/powerpc/amo1.c: New test. + * gcc.target/powerpc/amo2.c: Likewise. + +2017-10-09 Richard Biener <rguenther@suse.de> + + PR tree-optimization/82449 + * gfortran.dg/graphite/pr82449.f: New testcase. + +2017-10-09 Andreas Krebbel <krebbel@linux.vnet.ibm.com> + + PR target/82463 + * gcc.target/s390/zvector/pr82463.c: New test. + +2017-10-09 Andreas Krebbel <krebbel@linux.vnet.ibm.com> + + PR target/82465 + * gcc.target/s390/zvector/pr82465.c: New test. + +2017-10-09 Wilco Dijkstra <wdijkstr@arm.com> + + * gcc.dg/tree-ssa/ssa-dse-26.c (dg-options): Add -fno-short-enums. + +2017-10-09 Tom de Vries <tom@codesourcery.com> + + * gcc.dg/cold-1.c (foo1): Fix warning line number. Make warning line + number relative. + (abort): Declare. + 2017-10-08 Eric Botcazou <ebotcazou@adacore.com> * gcc.c-torture/execute/20171008-1.c: New test. @@ -852,7 +1331,7 @@ 2017-09-22 Sergey Shalnov <sergey.shalnov@intel.com> - * gcc.target/i386/avx512f-constant-set.c: New test. + * gcc.target/i386/avx512f-constant-set.c: New test. 2017-09-21 Sergey Shalnov <sergey.shalnov@intel.com> @@ -2421,7 +2900,7 @@ 2017-08-23 Richard Biener <rguenther@suse.de> - PR target/81921 + PR target/81921 * gcc.target/i386/pr81921.c: New testcase. 2017-08-23 Daniel Santos <daniel.santos@pobox.com> @@ -2502,8 +2981,8 @@ 2017-08-22 Yvan Roux <yvan.roux@linaro.org> - PR c++/80287 - * g++.dg/pr80287.C: New test. + PR c++/80287 + * g++.dg/pr80287.C: New test. 2017-08-22 Richard Biener <rguenther@suse.de> 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 00000000000..1dab5877f3b --- /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/cilk-plus/AN/parser_errors.c b/gcc/testsuite/c-c++-common/cilk-plus/AN/parser_errors.c index 18816e0ec6f..fd4fe5419b6 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 2bb91343a79..d003d7cc2bb 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 9270007050e..14256e9579e 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 a9a9d6601bc..8c32ad9a267 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/gomp/pr63326.c b/gcc/testsuite/c-c++-common/gomp/pr63326.c index e319f497011..3e627237c43 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 85b96f28ef8..abeb83748c1 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 33a501b9988..326b9faad7a 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 35b14b86c3a..629ab2f7274 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 00000000000..715f8a48c93 --- /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 00000000000..06ba56a5dde --- /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 00000000000..390cef680d9 --- /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 00000000000..4fb08465403 --- /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 00000000000..9ba3e940930 --- /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 00000000000..fee1df1c433 --- /dev/null +++ b/gcc/testsuite/c-c++-common/ubsan/attrib-5.c @@ -0,0 +1,11 @@ +/* { 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/ptr-overflow-sanitization-1.c b/gcc/testsuite/c-c++-common/ubsan/ptr-overflow-sanitization-1.c index 42c14523764..c12c7df252b 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/concepts/req6.C b/gcc/testsuite/g++.dg/concepts/req6.C index 670fd542f6f..50fa3b4dadd 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<typename T> - concept bool C1() { return X(); } + concept bool C1() { return X(); } // { dg-error "bool" } template<C1 T> 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 00000000000..ed9c42ce557 --- /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/constexpr-61323.C b/gcc/testsuite/g++.dg/cpp0x/constexpr-61323.C new file mode 100644 index 00000000000..f194bb8be82 --- /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<unsigned size, char*(&table)[size]> void test1() { } +void tester1() { test1<10,table1>(); } + +static char* table2[10]; +template<unsigned size, char*(&table)[size]> void test2() { } +void tester2() { test2<10,table2>(); } + +const char* table3[10]; +template<unsigned size, const char*(&table)[size]> void test3() { } +void tester3() { test3<10,table3>(); } + +const char* const table4[10] = {}; +template<unsigned size, const char*const (&table)[size]> void test4() { } +void tester4() { test4<10,table4>(); } + +const char* volatile table5[10] = {}; +template<unsigned size, const char* volatile (&table)[size]> void test5() { } +void tester5() { test5<10,table5>(); } + +const char* const table6[10] = {}; +template<unsigned size, const char*const (&table)[size]> void test6() { } +void tester6() { test6<10,table6>(); } diff --git a/gcc/testsuite/g++.dg/cpp0x/error1.C b/gcc/testsuite/g++.dg/cpp0x/error1.C index 33557f2f80b..115d800bb35 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<int... N> void foo (int... x[N]) // { dg-message "int \\\[N\\\]\\.\\.\\. x" } +void f(...); +template<int... N> 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 00000000000..bcff5af5831 --- /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 00000000000..156cb917080 --- /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<typename T> +void +foo (int x) +{ + T a[x]; + auto b = [&]() { for (auto &c: a) c = 0.; }; +} + +int +main () +{ + foo<double> (3); +} diff --git a/gcc/testsuite/g++.dg/cpp0x/pr70887.C b/gcc/testsuite/g++.dg/cpp0x/pr70887.C new file mode 100644 index 00000000000..f5b31b22900 --- /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 <x86intrin.h> + +enum R { S }; +template <R> struct C { static constexpr int value = 10; }; +template <typename R, template <R> class T, R... r> +struct A { + template <int, R...> struct B; + template <int N, R M, R... O> + struct B<N, M, O...> { + static constexpr int d = T<M>::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<R, C, S>; + RI ri; +} 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 00000000000..d47a49c3fa8 --- /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/cpp1y/auto-fn40.C b/gcc/testsuite/g++.dg/cpp1y/auto-fn40.C new file mode 100644 index 00000000000..e7f1bd44064 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/auto-fn40.C @@ -0,0 +1,37 @@ +// PR c++/78006 +// { dg-do compile { target c++14 } } + +template<typename T> T&& declval() noexcept; + +template<typename... _Tp> + struct common_type; + +template<typename _Tp> + struct common_type<_Tp> + { typedef _Tp type; }; + +template<typename _Tp, typename _Up> + struct common_type<_Tp, _Up> + { typedef decltype(true ? declval<_Tp>() : declval<_Up>()) type; }; + +template<typename _Tp, typename _Up, typename... _Vp> + struct common_type<_Tp, _Up, _Vp...> + { + typedef typename + common_type<typename common_type<_Tp, _Up>::type, _Vp...>::type type; + }; + +template<typename... _Tp> + using common_type_t = typename common_type<_Tp...>::type; + +template <typename... TFs> +auto x(TFs&&... fs) +{ + using rt = common_type_t<decltype(fs(0))...>; + return [](auto) -> rt { }; +} + +int main() +{ + x([](int){})(0); +} diff --git a/gcc/testsuite/g++.dg/cpp1y/auto-fn41.C b/gcc/testsuite/g++.dg/cpp1y/auto-fn41.C new file mode 100644 index 00000000000..25a879da118 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/auto-fn41.C @@ -0,0 +1,23 @@ +// PR c++/80873 +// { dg-do compile { target c++14 } } + +struct S {}; + +auto overloaded(S &); + +template <typename T> +int overloaded(T &) { + return 0; +} + +template <typename T> +auto returns_lambda(T ¶m) { + return [&] { + overloaded(param); // { dg-error "before deduction" } + }; +} + +int main() { + S s; + returns_lambda(s); +} diff --git a/gcc/testsuite/g++.dg/cpp1y/auto-fn42.C b/gcc/testsuite/g++.dg/cpp1y/auto-fn42.C new file mode 100644 index 00000000000..0f2b68efa42 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/auto-fn42.C @@ -0,0 +1,21 @@ +// PR c++/80873 +// { dg-do compile { target c++14 } } + +struct Buffer {}; + +auto parse(Buffer b); +template <typename T> void parse(T target); + +template <typename T> +auto field(T target) { + return [&] { + parse(target); + }; +} + +template <typename T> +void parse(T target) {} + +auto parse(Buffer b) { + field(0); +} diff --git a/gcc/testsuite/g++.dg/cpp1y/digit-sep-neg.C b/gcc/testsuite/g++.dg/cpp1y/digit-sep-neg.C index 833fab7c50b..727e74e2e10 100644 --- a/gcc/testsuite/g++.dg/cpp1y/digit-sep-neg.C +++ b/gcc/testsuite/g++.dg/cpp1y/digit-sep-neg.C @@ -26,5 +26,5 @@ main() } // { dg-error "exponent has no digits" "exponent has no digits" { target *-*-* } 21 } -// { dg-error "expected ';' before" "expected ';' before" { target *-*-* } 14 } -// { dg-error "expected ';' before" "expected ';' before" { target *-*-* } 25 } +// { dg-error "expected ';' before" "expected ';' before" { target *-*-* } 13 } +// { dg-error "expected ';' before" "expected ';' before" { target *-*-* } 24 } diff --git a/gcc/testsuite/g++.dg/cpp1y/lambda-generic-69078-1.C b/gcc/testsuite/g++.dg/cpp1y/lambda-generic-69078-1.C new file mode 100644 index 00000000000..dc045c72065 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/lambda-generic-69078-1.C @@ -0,0 +1,28 @@ +// PR c++/69078 +// { dg-do run { target c++14 } } +// { dg-options "-Wall" } + +#include <cassert> + +struct Class { + Class(void (*_param)()) : data(_param) {} + void (*data)(); +}; + +void funUser(void (*test)(int)) { + test(60); +} + +void user(Class& c, int i) { + (void)i; + assert (c.data); +} + +void probe() {} + +int main() { + static Class instance = { probe }; + funUser([](auto... p) { + user(instance, p...); + }); +} diff --git a/gcc/testsuite/g++.dg/cpp1y/lambda-generic-69078-2.C b/gcc/testsuite/g++.dg/cpp1y/lambda-generic-69078-2.C new file mode 100644 index 00000000000..318e0967250 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/lambda-generic-69078-2.C @@ -0,0 +1,21 @@ +// PR c++/69078 +// { dg-do run { target c++14 } } + +#include <cassert> + +template<typename F> +void run( F &&f ) { + f(nullptr); +} + +struct V { + int i; +}; + +int main() { + static V const s={2}; + assert (s.i == 2); + run([](auto){ + assert (s.i == 2); + }); +} diff --git a/gcc/testsuite/g++.dg/cpp1y/lambda-generic-dep2.C b/gcc/testsuite/g++.dg/cpp1y/lambda-generic-dep2.C new file mode 100644 index 00000000000..91e3804cb0b --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/lambda-generic-dep2.C @@ -0,0 +1,18 @@ +// { dg-do compile { target c++14 } } + +struct A { void operator()(int) const {} }; + +template <class T> +void f() +{ + constexpr A a {}; + + [=](auto b) { + a(b); + }(42); +} + +int main() +{ + f<int>(); +} diff --git a/gcc/testsuite/g++.dg/cpp1y/lambda-generic-ice5.C b/gcc/testsuite/g++.dg/cpp1y/lambda-generic-ice5.C index 473e412cb9d..88b7d1a05a1 100644 --- a/gcc/testsuite/g++.dg/cpp1y/lambda-generic-ice5.C +++ b/gcc/testsuite/g++.dg/cpp1y/lambda-generic-ice5.C @@ -12,7 +12,7 @@ using Void = void; template<typename F,typename A> auto -bar(F f, A a) -> decltype( ( f(a) , 0 ) ) // { dg-error "no match" } +bar(F f, A a) -> decltype( ( f(a) , 0 ) ) // { dg-message "" } { return {}; } diff --git a/gcc/testsuite/g++.dg/cpp1y/lambda-generic-ice6.C b/gcc/testsuite/g++.dg/cpp1y/lambda-generic-ice6.C new file mode 100644 index 00000000000..6851afc860e --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/lambda-generic-ice6.C @@ -0,0 +1,13 @@ +// PR c++/81032 +// { dg-do compile { target c++14 } } + +template<typename T> constexpr void foo(T t) +{ + constexpr int i = t; // { dg-error "constant" } + [=](auto){ return i; }(0); +} + +void bar() +{ + foo(0); +} diff --git a/gcc/testsuite/g++.dg/cpp1y/lambda-generic-ice7.C b/gcc/testsuite/g++.dg/cpp1y/lambda-generic-ice7.C new file mode 100644 index 00000000000..fa0fe1ddaf9 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/lambda-generic-ice7.C @@ -0,0 +1,15 @@ +// PR c++/81299 +// { dg-do compile { target c++14 } } +// { dg-options "-Wall" } + +struct function_t { + template <typename ...Xs> + void operator()(Xs&& ...) const { } +}; +constexpr function_t function{}; + +int main() { + constexpr auto fun = ::function; + auto call = [=](auto ...x) { fun(x...); }; + call(); +} diff --git a/gcc/testsuite/g++.dg/cpp1y/lambda-generic-ice8.C b/gcc/testsuite/g++.dg/cpp1y/lambda-generic-ice8.C new file mode 100644 index 00000000000..a39ce44115d --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/lambda-generic-ice8.C @@ -0,0 +1,16 @@ +// PR c++/82230 +// { dg-do compile { target c++14 } } + +template <class> + struct c + { + template <class> + void f() + { + [](auto) { auto x = [] {}; }(0); + } +}; +int main() +{ + c<int>{}.f<int>(); +} diff --git a/gcc/testsuite/g++.dg/cpp1y/pr65202.C b/gcc/testsuite/g++.dg/cpp1y/pr65202.C index 602b264b302..7ce4895a134 100644 --- a/gcc/testsuite/g++.dg/cpp1y/pr65202.C +++ b/gcc/testsuite/g++.dg/cpp1y/pr65202.C @@ -22,5 +22,5 @@ struct bar; int main() { foo<ns::bar> f; - adl::swap(f, f) -} // { dg-error "" } + adl::swap(f, f) // { dg-error "expected ';'" } +} // { dg-error "expected '.'" "expected end of namespace" } diff --git a/gcc/testsuite/g++.dg/cpp1y/pr71875.C b/gcc/testsuite/g++.dg/cpp1y/pr71875.C new file mode 100644 index 00000000000..4d317966cea --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/pr71875.C @@ -0,0 +1,24 @@ +// PR c++/71875 +// { dg-do link { target c++14 } } + +template <typename T> +constexpr bool IsMatrix = false; + +template<typename TElem> +class Matrix {}; + +template <typename TElem> +constexpr bool IsMatrix<Matrix<TElem>> = true; + +template<typename TNestVec> +class RowVecExpMatrix; + +template <typename TNestVec> +constexpr bool IsMatrix<RowVecExpMatrix<TNestVec>> = true; + +int +main () +{ + static_assert (IsMatrix<RowVecExpMatrix<Matrix<int>>>, "Matrix check error"); + static_assert (IsMatrix<Matrix<int>>, "Input type is not a matrix"); +} diff --git a/gcc/testsuite/g++.dg/cpp1y/pr77786.C b/gcc/testsuite/g++.dg/cpp1y/pr77786.C new file mode 100644 index 00000000000..e242228335c --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/pr77786.C @@ -0,0 +1,21 @@ +// PR c++/77786 +// { dg-do compile { target c++14 } } + +#include <vector> + +template<int N> +void +foo (std::vector<int> a) +{ + auto const a_size = a.size(); + auto bar = [&](auto y) -> void { int a_size_2 = a_size; }; + double x = 0.0; + bar (x); +} + +int +main () +{ + std::vector<int> a(1); + foo<1>(a); +} diff --git a/gcc/testsuite/g++.dg/cpp1y/pr78523.C b/gcc/testsuite/g++.dg/cpp1y/pr78523.C new file mode 100644 index 00000000000..31e0cc886fa --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/pr78523.C @@ -0,0 +1,12 @@ +// PR c++/78523 +// { dg-do compile { target c++14 } } + +int bar (); + +void +foo () +{ + const int t = bar (); + auto f = [=] (auto x) { return t; }; + f (0); +} diff --git a/gcc/testsuite/g++.dg/cpp1y/pr80194.C b/gcc/testsuite/g++.dg/cpp1y/pr80194.C new file mode 100644 index 00000000000..2a892c3cf37 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/pr80194.C @@ -0,0 +1,17 @@ +// PR c++/80194 +// { dg-do compile { target c++14 } } + +int fn1 (); + +template <class Fn> +void +fn2 (Fn &&fn) +{ + fn (42); +} + +void fn2 () +{ + auto const x = fn1 (); + fn2 ([&](auto) { x; }); +} diff --git a/gcc/testsuite/g++.dg/cpp1z/class-deduction44.C b/gcc/testsuite/g++.dg/cpp1z/class-deduction44.C new file mode 100644 index 00000000000..15711971f51 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1z/class-deduction44.C @@ -0,0 +1,5 @@ +// PR c++/80412 +// { dg-options -std=c++17 } + +template <typename> struct A; +template <typename> struct B : A < B { , // { dg-error "" } diff --git a/gcc/testsuite/g++.dg/cpp1z/noexcept-type18.C b/gcc/testsuite/g++.dg/cpp1z/noexcept-type18.C new file mode 100644 index 00000000000..e01fd0a2030 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1z/noexcept-type18.C @@ -0,0 +1,15 @@ +// { dg-options "-std=c++17" } + +template<typename T> +struct S; + +template<bool IsNoexcept> +struct S<void(*)() noexcept(IsNoexcept)> { + S() {} +}; + +void f() {} + +int main() { + S<decltype(&f)> {}; +} diff --git a/gcc/testsuite/g++.dg/cpp1z/pr81016.C b/gcc/testsuite/g++.dg/cpp1z/pr81016.C new file mode 100644 index 00000000000..4826fbfb775 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1z/pr81016.C @@ -0,0 +1,4 @@ +// { dg-options "-std=c++17" } + +template <typename a, a> struct b; +template <typename c> struct b<bool, c::d>; // { dg-error "template parameter" } diff --git a/gcc/testsuite/g++.dg/diagnostic/unclosed-extern-c.C b/gcc/testsuite/g++.dg/diagnostic/unclosed-extern-c.C index fda3532266d..44f538e33ec 100644 --- a/gcc/testsuite/g++.dg/diagnostic/unclosed-extern-c.C +++ b/gcc/testsuite/g++.dg/diagnostic/unclosed-extern-c.C @@ -1,3 +1,12 @@ -extern "C" { /* { dg-message "12: to match this '.'" } */ +extern "C" { // { dg-line open_extern_c } + + int foo (void); + +/* Missing close-brace for the extern "C" here. */ + +template <typename T> // { dg-error "template with C linkage" } +void bar (void); +// { dg-message "1: 'extern .C.' linkage started here" "" { target *-*-* } open_extern_c } void test (void); /* { dg-error "17: expected '.' at end of input" } */ +// { message "12: to match this '.'" "" { target *-*-* } open_extern_c } diff --git a/gcc/testsuite/g++.dg/ext/attr-ifunc-1.C b/gcc/testsuite/g++.dg/ext/attr-ifunc-1.C index 2c7bba12959..4a29e8bb4d6 100644 --- a/gcc/testsuite/g++.dg/ext/attr-ifunc-1.C +++ b/gcc/testsuite/g++.dg/ext/attr-ifunc-1.C @@ -4,26 +4,33 @@ struct Klass { + int a[4]; + int implementation (); int magic (); - typedef int (Klass::*MemFuncPtr)(); + /* An ifunc resolver must return a pointer to an ordinary (non-member) + function. To make it possible to use ifunc with member functions, + the resolver must convert a member function pointer to an ordinary + function pointer (slicing off the high word). */ + typedef int Func (Klass*); - static MemFuncPtr resolver (); + static Func* resolver (); }; -Klass::MemFuncPtr p = &Klass::implementation; - -int Klass::implementation (void) +int Klass::implementation () { __builtin_printf ("'ere I am JH\n"); - return 1234; + return a[0] + a[1] + a[2] + a[3]; } - -Klass::MemFuncPtr Klass::resolver (void) +Klass::Func* Klass::resolver (void) { - return &Klass::implementation; + /* GCC guarantees this conversion to be safe and the resulting pointer + usable to call the member function using ordinary (i.e., non-member) + function call syntax. */ + + return reinterpret_cast<Func*>(&Klass::implementation); } int f (void) __attribute__ ((ifunc ("foo"))); @@ -32,11 +39,16 @@ typedef int (F)(void); extern "C" F* foo () { return 0; } -int Klass::magic (void) __attribute__ ((ifunc ("_ZN5Klass8resolverEv"))); +int Klass::magic () __attribute__ ((ifunc ("_ZN5Klass8resolverEv"))); int main () { Klass obj; - return !(obj.magic () == 1234); + obj.a[0] = 1; + obj.a[1] = 2; + obj.a[2] = 3; + obj.a[3] = 4; + + return !(obj.magic () == 10); } diff --git a/gcc/testsuite/g++.dg/ext/attr-ifunc-2.C b/gcc/testsuite/g++.dg/ext/attr-ifunc-2.C index 1fc940bb7dd..e5be3d29aba 100644 --- a/gcc/testsuite/g++.dg/ext/attr-ifunc-2.C +++ b/gcc/testsuite/g++.dg/ext/attr-ifunc-2.C @@ -9,9 +9,9 @@ struct Klass int implementation (); int magic (); - typedef int (Klass::*MemFuncPtr)(); + typedef int Func (Klass*); - static MemFuncPtr resolver (); + static Func* resolver (); }; int Klass::implementation (void) @@ -20,9 +20,13 @@ int Klass::implementation (void) return 0; } -Klass::MemFuncPtr Klass::resolver (void) +Klass::Func* Klass::resolver (void) { - return &Klass::implementation; + /* GCC guarantees this conversion to be safe and the resulting pointer + usable to call the member function using ordinary (i.e., non-member) + function call syntax. */ + + return reinterpret_cast<Func*>(&Klass::implementation); } int Klass::magic (void) __attribute__ ((ifunc ("_ZN5Klass8resolverEv"))); diff --git a/gcc/testsuite/g++.dg/ext/attr-ifunc-3.C b/gcc/testsuite/g++.dg/ext/attr-ifunc-3.C index 04206a126e8..6d494244331 100644 --- a/gcc/testsuite/g++.dg/ext/attr-ifunc-3.C +++ b/gcc/testsuite/g++.dg/ext/attr-ifunc-3.C @@ -6,23 +6,29 @@ struct Klass { + int a[4]; + int implementation (); int magic (); - typedef int (Klass::*MemFuncPtr)(); + typedef int Func (Klass*); - static MemFuncPtr resolver (); + static Func* resolver (); }; int Klass::implementation (void) { printf ("'ere I am JH\n"); - return 0; + return a[0] + a[1] + a[2] + a[3]; } -Klass::MemFuncPtr Klass::resolver (void) +Klass::Func* Klass::resolver () { - return &Klass::implementation; + /* GCC guarantees this conversion to be safe and the resulting pointer + usable to call the member function using ordinary (i.e., non-member) + function call syntax. */ + + return reinterpret_cast<Func*>(&Klass::implementation); } int Klass::magic (void) __attribute__ ((ifunc ("_ZN5Klass8resolverEv"))); @@ -36,5 +42,10 @@ int main () { Klass obj; - return Foo (obj, &Klass::magic) != 0; + obj.a[0] = 1; + obj.a[1] = 2; + obj.a[2] = 3; + obj.a[3] = 4; + + return Foo (obj, &Klass::magic) != 10; } diff --git a/gcc/testsuite/g++.dg/ext/attr-ifunc-4.C b/gcc/testsuite/g++.dg/ext/attr-ifunc-4.C index 3127193147e..f71dc3b9ba9 100644 --- a/gcc/testsuite/g++.dg/ext/attr-ifunc-4.C +++ b/gcc/testsuite/g++.dg/ext/attr-ifunc-4.C @@ -14,9 +14,9 @@ struct Klassier : Klass int implementation (); int magic (); - typedef int (Klassier::*MemFuncPtr)(); + typedef int Func (Klass*); - static MemFuncPtr resolver (); + static Func* resolver (); }; int Klassier::implementation (void) @@ -25,9 +25,13 @@ int Klassier::implementation (void) return 0; } -Klassier::MemFuncPtr Klassier::resolver (void) +Klassier::Func* Klassier::resolver () { - return &Klassier::implementation; + /* GCC guarantees this conversion to be safe and the resulting pointer + usable to call the member function using ordinary (i.e., non-member) + function call syntax. */ + + return reinterpret_cast<Func*>(&Klassier::implementation); } int Klassier::magic (void) __attribute__ ((ifunc ("_ZN8Klassier8resolverEv"))); diff --git a/gcc/testsuite/g++.dg/ext/attr-ifunc-5.C b/gcc/testsuite/g++.dg/ext/attr-ifunc-5.C index 05855dd20c0..fd8bcff79b7 100644 --- a/gcc/testsuite/g++.dg/ext/attr-ifunc-5.C +++ b/gcc/testsuite/g++.dg/ext/attr-ifunc-5.C @@ -1,15 +1,21 @@ // PR c/81854 - weak alias of an incompatible symbol accepted // { dg-do compile } // { dg-require-ifunc "" } */ +// { dg-options "-Wextra -Wno-pmf-conversions" } struct Klass { int implementation (); - const char* magic (); + int good_magic (); + int iffy_magic (); + const char* bad_magic (); + typedef int (Func)(Klass*); typedef int (Klass::*MemFuncPtr)(); - static MemFuncPtr resolver (); + static Func* good_resolver (); + static void* iffy_resolver (); + static MemFuncPtr bad_resolver (); }; int Klass::implementation (void) @@ -17,13 +23,42 @@ int Klass::implementation (void) return 0; } -const char* __attribute__ ((ifunc ("_ZN5Klass8resolverEv"))) - Klass::magic (); // { dg-warning "alias between functions of incompatible types" } +// Verify no warning for the expected/compatible declaration. +int __attribute__ ((ifunc ("_ZN5Klass13good_resolverEv"))) +Klass::good_magic (); + +Klass::Func* +Klass::good_resolver (void) +{ + MemFuncPtr mfp = &Klass::implementation; + + return reinterpret_cast<Func*>(mfp); +} + + +// Verify a warning for the unsafe declaration. + +int __attribute__ ((ifunc ("_ZN5Klass13iffy_resolverEv"))) +Klass::iffy_magic (); // { dg-message "resolver indirect function declared here" } + +void* +Klass::iffy_resolver (void) // { dg-warning ".ifunc. resolver for .int Klass::iffy_magic\\(\\). should return .int \\(\\*\\)\\(Klass\\*\\)." } +{ + MemFuncPtr mfp = &Klass::implementation; + + return reinterpret_cast<void*>(mfp); +} + + +// Verify an error for an incompatible declaration. + +const char* __attribute__ ((ifunc ("_ZN5Klass12bad_resolverEv"))) +Klass::bad_magic (); // { dg-message "resolver indirect function declared here" } Klass::MemFuncPtr -Klass::resolver (void) // { dg-message "aliased declaration here" } +Klass::bad_resolver (void) // { dg-error ".ifunc. resolver for .const char\\* Klass::bad_magic\\(\\). must return .const char\\* \\(\\*\\)\\(Klass\\*\\)." } { return &Klass::implementation; } diff --git a/gcc/testsuite/g++.dg/gomp/pr77578.C b/gcc/testsuite/g++.dg/gomp/pr77578.C new file mode 100644 index 00000000000..d92fddf970b --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/pr77578.C @@ -0,0 +1,31 @@ +// PR c++/77578 +// { dg-do compile } + +template <typename T> +class A +{ +}; + +template <typename T> +struct B +{ +}; + +template <typename T> +struct B <A <T> > +{ + typedef A <T> C; + typedef typename C::D D; + + template <typename U> + static void + foo (const D x, const D y) + { + U u; + { + #pragma omp parallel for + for (u.bar().y() = x.y(); u.bar().y() <= y.y(); u.bar().y()++) // { dg-error "expected" } + ; + } + } +}; diff --git a/gcc/testsuite/g++.dg/lookup/extern-c-hidden.C b/gcc/testsuite/g++.dg/lookup/extern-c-hidden.C index a03dea02376..80593dba735 100644 --- a/gcc/testsuite/g++.dg/lookup/extern-c-hidden.C +++ b/gcc/testsuite/g++.dg/lookup/extern-c-hidden.C @@ -1,11 +1,11 @@ // Make sure unhidding an extern-c still checks it is compatible -extern "C" float fabsf (float); // { dg-error "conflicts with previous declaration" } +extern "C" float fabsf (float); // { dg-message "previous declaration" } namespace Bob { extern "C" float fabsf (float, float); // { dg-error "C language" } - extern "C" double fabs (double, double); // { dg-error "conflicts with previous declaration" } + extern "C" double fabs (double, double); // { dg-message "previous declaration" } } extern "C" double fabs (double); // { dg-error "C language" } diff --git a/gcc/testsuite/g++.dg/lookup/extern-c-redecl.C b/gcc/testsuite/g++.dg/lookup/extern-c-redecl.C index 3e901cc7759..fd49868ee4e 100644 --- a/gcc/testsuite/g++.dg/lookup/extern-c-redecl.C +++ b/gcc/testsuite/g++.dg/lookup/extern-c-redecl.C @@ -3,7 +3,7 @@ // { dg-do compile } namespace A { - extern "C" void foo_func () throw(); // { dg-error "conflicts" } + extern "C" void foo_func () throw(); // { dg-message "previous" } } // next line should trigger an error because // it conflicts with previous declaration of foo_func (), due to diff --git a/gcc/testsuite/g++.dg/lookup/extern-c-redecl6.C b/gcc/testsuite/g++.dg/lookup/extern-c-redecl6.C new file mode 100644 index 00000000000..b4537d64a26 --- /dev/null +++ b/gcc/testsuite/g++.dg/lookup/extern-c-redecl6.C @@ -0,0 +1,25 @@ +extern "C" { + int i; // { dg-message "previous" } + float f; // { dg-message "previous" } + void fn (); // { dg-message "previous" } + int ai1[1]; // { dg-message "previous" } + extern int ai[]; + + namespace OK + { + int i; + float f; + void fn (); + extern int ai1[]; + int ai[2]; + } + + namespace BAD + { + long i; // { dg-error "C language linkage" } + double f; // { dg-error "C language linkage" } + int fn (); // { dg-error "C language linkage" } + int ai1[2]; // { dg-error "C language linkage" } + } +} + diff --git a/gcc/testsuite/g++.dg/lto/pr82414_0.C b/gcc/testsuite/g++.dg/lto/pr82414_0.C new file mode 100644 index 00000000000..29753718b54 --- /dev/null +++ b/gcc/testsuite/g++.dg/lto/pr82414_0.C @@ -0,0 +1,13 @@ +// PR c++/82414 +// { dg-lto-do link } +// { dg-lto-options { { -flto -g } } } + +typedef __attribute__ ((__aligned__ (16))) struct S { __extension__ unsigned long long Part[2]; } T; // bogus warning "violates one definition rule" + +int +main () +{ + T tf; + asm volatile ("" : : "g" (__alignof__(tf)), "g" (__alignof__ (struct S)), "g" (__alignof__ (T))); + return 0; +} diff --git a/gcc/testsuite/g++.dg/missing-symbol-2.C b/gcc/testsuite/g++.dg/missing-symbol-2.C new file mode 100644 index 00000000000..4a119f8e9ad --- /dev/null +++ b/gcc/testsuite/g++.dg/missing-symbol-2.C @@ -0,0 +1,58 @@ +/* { dg-options "-fdiagnostics-show-caret" } */ + +extern int foo (void); + +void missing_open_paren (void) +{ + if foo ()) /* { dg-error "expected '\\(' before 'foo'" } */ + { + } + /* { dg-begin-multiline-output "" } + if foo ()) + ^~~ + ( + { dg-end-multiline-output "" } */ +} + + +void missing_close_square (void) +{ + const char test [42; /* { dg-error "22: expected ']' before ';' token" } */ + /* { dg-begin-multiline-output "" } + const char test [42; + ^ + ] + { dg-end-multiline-output "" } */ +} + +int missing_semicolon (void) +{ + return 42 /* { dg-error "expected ';'" } */ +} +/* { dg-begin-multiline-output "" } + return 42 + ^ + ; + } + ~ + { dg-end-multiline-output "" } */ + + +int missing_colon_in_switch (int val) +{ + switch (val) + { + case 42 /* { dg-error "expected ':' before 'return'" } */ + return 42; + /* { dg-begin-multiline-output "" } + case 42 + ^ + : + return 42; + ~~~~~~ + { dg-end-multiline-output "" } */ + + default: + return val; + } +} diff --git a/gcc/testsuite/g++.dg/opt/pr70100.C b/gcc/testsuite/g++.dg/opt/pr70100.C new file mode 100644 index 00000000000..3f612cba3fb --- /dev/null +++ b/gcc/testsuite/g++.dg/opt/pr70100.C @@ -0,0 +1,21 @@ +// PR middle-end/70100 +// { dg-do compile { target c++11 } } +// { dg-options "-O0" } + +void +bar (int) +{ +} + +template <typename ... Args> +void +foo (Args && ... args) +{ + [&] { [&] { bar(args...); }; }; +} + +int +main () +{ + foo (2); +} diff --git a/gcc/testsuite/g++.dg/opt/pr82159-2.C b/gcc/testsuite/g++.dg/opt/pr82159-2.C new file mode 100644 index 00000000000..f153c29ddac --- /dev/null +++ b/gcc/testsuite/g++.dg/opt/pr82159-2.C @@ -0,0 +1,65 @@ +// PR c++/82159 +// { dg-do compile } +// { dg-options "" } + +template <typename T> struct D { T e; }; +struct F : D<int[0]> { + F(const F &); +}; +struct G : F { + template <class T> G operator-(T); +}; +template <class T> struct I { + typedef typename T::template J<I> ak; +}; +template <class T> struct K { typename I<T>::ak an; }; +struct H { + G l; +}; +struct C { + ~C(); +}; +template <class T> struct M : T { + template <typename U, typename V> M(U, V); + H h; + virtual void foo() { T::bar(&h); } +}; +template <int, typename> class A; +template <class> struct B { + typedef int BT; + struct BC {}; + template <class T> struct BD { + G g; + BD(BT, T n) : g(n.l - 0) {} + }; + B(BT, BC); +}; +template <typename> struct O; +template <int T, typename U> +struct O<B<A<T, U> > > : public B<A<T, U> >::BC {}; +struct L : B<A<2, double> > { + struct P : C { + void bar(H *x) { + BT a; + BD<H>(a, *x); + } + }; + template <typename U, typename V> L(U x, V n) : B(x, n) {} + int ll; + virtual int baz() { M<P>(this, ll); } +}; +template <typename> class Q { + O<B<A<2, double> > > q; + virtual L baz() { L(0, q); } +}; +template <template <class> class T> struct R { + R() { T<int>(); } +}; +struct S { + template <class> class J : R<Q> {}; +}; +void foo() { K<S> c; } + +int main() { + return 0; +} diff --git a/gcc/testsuite/g++.dg/other/do1.C b/gcc/testsuite/g++.dg/other/do1.C index b3a9daf9056..db65e7de301 100644 --- a/gcc/testsuite/g++.dg/other/do1.C +++ b/gcc/testsuite/g++.dg/other/do1.C @@ -7,7 +7,7 @@ void init () { - do { } while (0) - obj = 0; // { dg-error "expected|not declared" } + do { } while (0) // { dg-error "expected ';'" } + obj = 0; // { dg-error "not declared" } } diff --git a/gcc/testsuite/g++.dg/other/pr53574.C b/gcc/testsuite/g++.dg/other/pr53574.C new file mode 100644 index 00000000000..cc899a552c8 --- /dev/null +++ b/gcc/testsuite/g++.dg/other/pr53574.C @@ -0,0 +1,48 @@ +// PR c++/53574 +// { dg-do compile { target c++11 } } +// { dg-options "-fstack-usage" } + +template <typename> struct A { typedef int type; }; +struct B { + typedef __SIZE_TYPE__ H; +}; +template <typename> class allocator : B {}; +template <typename _Alloc> struct C { + template <typename T> + static typename T::H foo(T *); + typedef decltype(foo((_Alloc *)0)) H; + template <typename U> + static typename A<H>::type bar(U) { return typename A<H>::type (); } + static int baz(_Alloc p1) { bar(p1); return 0; } +}; +template <typename _Alloc> struct I : C<_Alloc> {}; +template <typename, typename> struct J { + typedef I<allocator<int>> K; + K k; +}; +struct D : J<int, allocator<int>> { + void fn(int, int) { + K m; + I<K>::baz(m); + } +}; +template <class Ch, class = int, class = int> struct F { + F(); + F(const Ch *); + F test(); + D d; +}; +int l; +struct G { + G(F<char>); +}; +char n; +template <class Ch, class Tr, class Alloc> F<Ch, Tr, Alloc>::F(const Ch *) { + test(); +} +template <class Ch, class Tr, class Alloc> +F<Ch, Tr, Alloc> F<Ch, Tr, Alloc>::test() { + d.fn(l, 0); + return F<Ch, Tr, Alloc> (); +} +G fn1() { return G(&n); } diff --git a/gcc/testsuite/g++.dg/other/pr68252.C b/gcc/testsuite/g++.dg/other/pr68252.C new file mode 100644 index 00000000000..5460d819780 --- /dev/null +++ b/gcc/testsuite/g++.dg/other/pr68252.C @@ -0,0 +1,5 @@ +// PR c++/68252 + +struct Test { + static const int foo = (1 << sizeof (int)) * -3; +}; diff --git a/gcc/testsuite/g++.dg/parse/error11.C b/gcc/testsuite/g++.dg/parse/error11.C index d118c19deb8..1a49d6edb12 100644 --- a/gcc/testsuite/g++.dg/parse/error11.C +++ b/gcc/testsuite/g++.dg/parse/error11.C @@ -52,7 +52,7 @@ void func(void) Foo[:B> k1; // { dg-bogus "cannot begin|alternate spelling" "smart error should not be triggered here" } // { dg-error "6:missing template arguments before" "template" { target *-*-* } 51 } // { dg-error "9:expected primary-expression before ':' token" "primary" { target *-*-* } 51 } -// { dg-error "9:expected '\]' before ':' token" "backslash" { target *-*-* } 51 } +// { dg-error "8:expected '\]' before ':' token" "backslash" { target *-*-* } 51 } // { dg-error "6:missing template arguments before" "template" { target *-*-* } 52 } // { dg-error "7:expected primary-expression before ':' token" "primary" { target *-*-* } 52 } // { dg-error "7:expected '\]' before ':' token" "backslash" { target *-*-* } 52 } diff --git a/gcc/testsuite/g++.dg/parse/pragma2.C b/gcc/testsuite/g++.dg/parse/pragma2.C index 3dc5fc17788..c5616ff74f5 100644 --- a/gcc/testsuite/g++.dg/parse/pragma2.C +++ b/gcc/testsuite/g++.dg/parse/pragma2.C @@ -4,5 +4,5 @@ // does not. int f(int x, #pragma interface // { dg-error "not allowed here" } - // { dg-bogus "expected identifier" "" { xfail *-*-* } .-1 } - int y); + // The parser gets confused and issues an error on the next line. + int y); // { dg-bogus "" "" { xfail *-*-* } } diff --git a/gcc/testsuite/g++.dg/template/bitfield4.C b/gcc/testsuite/g++.dg/template/bitfield4.C new file mode 100644 index 00000000000..4927b7ab144 --- /dev/null +++ b/gcc/testsuite/g++.dg/template/bitfield4.C @@ -0,0 +1,6 @@ +// PR c++/82357 + +template <typename> struct A { + A() { x |= 0; } + int x : 8; +}; diff --git a/gcc/testsuite/g++.dg/template/cast4.C b/gcc/testsuite/g++.dg/template/cast4.C new file mode 100644 index 00000000000..2f46c7189eb --- /dev/null +++ b/gcc/testsuite/g++.dg/template/cast4.C @@ -0,0 +1,4 @@ +template <class T> void f() +{ + static_cast<int&>(42); // { dg-error "static_cast" } +} diff --git a/gcc/testsuite/g++.dg/template/crash108.C b/gcc/testsuite/g++.dg/template/crash108.C index 221d80ee5f1..9bcabc6009b 100644 --- a/gcc/testsuite/g++.dg/template/crash108.C +++ b/gcc/testsuite/g++.dg/template/crash108.C @@ -1,5 +1,5 @@ // PR c++/50861 -template<class T> struct A {A(int b=k(0));}; // { dg-error "parameter|arguments" } +template<class T> struct A {A(int b=k(0));}; // { dg-error "parameter|argument" } void f(int k){A<int> a;} // // { dg-message "declared" } // { dg-message "note" "note" { target *-*-* } 3 } diff --git a/gcc/testsuite/g++.dg/template/crash128.C b/gcc/testsuite/g++.dg/template/crash128.C new file mode 100644 index 00000000000..2682e3dc3ce --- /dev/null +++ b/gcc/testsuite/g++.dg/template/crash128.C @@ -0,0 +1,19 @@ +// PR c++/54090 + +template <int n> +struct X { + + template <int N, bool = (n >= N), typename T = void> struct Y; + + template <int N, typename T> + struct Y<N, true, T> {}; + + static const int M = n / 2; + + template <typename T> + struct Y<X::M, true, T> {}; +}; + +void foo() { + X<10>::Y<10/2> y; +} diff --git a/gcc/testsuite/g++.dg/template/error11.C b/gcc/testsuite/g++.dg/template/error11.C index 3a469fd1a8c..16402988a87 100644 --- a/gcc/testsuite/g++.dg/template/error11.C +++ b/gcc/testsuite/g++.dg/template/error11.C @@ -1,4 +1,4 @@ // PR c++/12132 inline template <int> void foo () {} // { dg-error "<" } -void abort (); // { dg-error ";" } +void abort (); // { dg-error ";" "" { target *-*-* } .-1 } diff --git a/gcc/testsuite/g++.dg/template/extern-c.C b/gcc/testsuite/g++.dg/template/extern-c.C new file mode 100644 index 00000000000..c0dd7cb66d5 --- /dev/null +++ b/gcc/testsuite/g++.dg/template/extern-c.C @@ -0,0 +1,66 @@ +template <typename T> void specializable (T); + +/* Invalid template: within "extern C". */ + +extern "C" { // { dg-message "1: 'extern .C.' linkage started here" } + +template <typename T> // { dg-error "template with C linkage" } +void within_extern_c_braces (void); + +} + +/* Valid template: not within "extern C". */ + +template <typename T> +void not_within_extern_c (void); + + +/* Invalid specialization: within "extern C". */ + +extern "C" { // { dg-message "1: 'extern .C.' linkage started here" } + +template <> // { dg-error "template specialization with C linkage" } +void specializable (int); + +} + + +/* Valid specialization: not within "extern C". */ +template <> +void specializable (char); + + +/* Example of extern C without braces. */ + +extern "C" template <typename T> // { dg-line open_extern_c_no_braces } +void within_extern_c_no_braces (void); +// { dg-error "12: template with C linkage" "" { target *-*-* } open_extern_c_no_braces } +// { dg-message "1: 'extern .C.' linkage started here" "" { target *-*-* } open_extern_c_no_braces } + + +/* Nested extern "C" specifications. + We should report within the innermost extern "C" that's still open. */ + +extern "C" { + extern "C" { // { dg-line middle_open_extern_c } + extern "C" { + } + + template <typename T> // { dg-error "template with C linkage" } + void within_nested_extern_c (void); + // { dg-message "3: 'extern .C.' linkage started here" "" { target *-*-* } middle_open_extern_c } + + extern "C++" { + /* Valid template: within extern "C++". */ + template <typename T> + void within_nested_extern_cpp (void); + + extern "C" { // { dg-line last_open_extern_c } + /* Invalid template: within "extern C". */ + template <typename T> // { dg-error "template with C linkage" } + void within_extern_c_within_extern_cpp (void); + // { dg-message "7: 'extern .C.' linkage started here" "" { target *-*-* } last_open_extern_c } + } + } + } +} diff --git a/gcc/testsuite/g++.dg/ubsan/pr82353-2-aux.cc b/gcc/testsuite/g++.dg/ubsan/pr82353-2-aux.cc new file mode 100644 index 00000000000..75d466b39bb --- /dev/null +++ b/gcc/testsuite/g++.dg/ubsan/pr82353-2-aux.cc @@ -0,0 +1,32 @@ +// PR sanitizer/82353 + +#include "pr82353-2.h" + +B a; +E b; +B C::c0; +unsigned D::d0; + +void +foo () +{ + a.b1 = p.f2.e2.b1 = 5; +} + +void +bar () +{ + int c = p.f2.e4.d1.a0 - -~p.f4 * 89; + q.c0.b0 = i > g * a.b0 * h - k % a.b1; + if ((~(m * j) && -~p.f4 * 90284000534361) % ~m * j) + b.e2.b0 << l << f; + o = -~p.f4 * 89; + int d = p.f4; + if (b.e2.b0) + b.e2.b1 = c; + bool e = ~-~p.f4; + a.b1 % e; + if (k / p.f2.e2.b1) + b.e4.d0 = g * a.b0 * h; + n = j; +} diff --git a/gcc/testsuite/g++.dg/ubsan/pr82353-2.C b/gcc/testsuite/g++.dg/ubsan/pr82353-2.C new file mode 100644 index 00000000000..31a35ac3a02 --- /dev/null +++ b/gcc/testsuite/g++.dg/ubsan/pr82353-2.C @@ -0,0 +1,20 @@ +// PR sanitizer/82353 +// { dg-do run } +// { dg-options "-fsanitize=undefined -fno-sanitize-recover=undefined -std=c++11 -O2 -w" } +// { dg-additional-sources "pr82353-2-aux.cc" } + +#include "pr82353-2.h" + +unsigned long f, g; +bool h, k, j, i; +unsigned char l, m; +short n; +unsigned o; +F p; + +int +main () +{ + foo (); + bar (); +} diff --git a/gcc/testsuite/g++.dg/ubsan/pr82353-2.h b/gcc/testsuite/g++.dg/ubsan/pr82353-2.h new file mode 100644 index 00000000000..4693d2299f2 --- /dev/null +++ b/gcc/testsuite/g++.dg/ubsan/pr82353-2.h @@ -0,0 +1,31 @@ +extern unsigned long f, g; +extern bool h, i, j, k; +extern unsigned char l, m; +extern short n; +extern unsigned o; +struct B { + short b0 : 27; + long b1 : 10; +}; +struct A { + int a0 : 5; +}; +struct C { + static B c0; +}; +struct D { + static unsigned d0; + A d1; +}; +struct E { + B e2; + D e4; +}; +struct F { + E f2; + short f4; +}; +extern F p; +extern C q; +void foo (); +void bar (); diff --git a/gcc/testsuite/g++.dg/ubsan/pr82353.C b/gcc/testsuite/g++.dg/ubsan/pr82353.C new file mode 100644 index 00000000000..a967cefa9cb --- /dev/null +++ b/gcc/testsuite/g++.dg/ubsan/pr82353.C @@ -0,0 +1,60 @@ +/* { dg-do compile { target { { i?86-*-* x86_64-*-* } && lp64 } } } */ +/* { dg-options "-O2 -std=c++11 -fsanitize=undefined -fno-sanitize-recover=undefined -w -fdump-rtl-reload" } */ + +extern unsigned long tf_2_var_1, tf_2_var_21; +extern bool tf_2_var_2, tf_2_var_24, tf_2_var_6, tf_2_var_5; +extern unsigned char tf_2_var_16, tf_2_var_31; +extern short tf_2_var_69; +extern unsigned tf_2_var_233; +struct tf_2_struct_1 { + short member_1_0 : 27; + long member_1_1 : 10; +}; +struct a { + int member_2_0 : 5; +}; +struct tf_2_struct_3 { + static tf_2_struct_1 member_3_0; +}; +struct tf_2_struct_4 { + static unsigned member_4_0; + a member_4_1; +}; +struct tf_2_struct_5 { + tf_2_struct_1 member_5_2; + tf_2_struct_4 member_5_4; +}; +struct tf_2_struct_6 { + tf_2_struct_5 member_6_2; + short member_6_4; +} extern tf_2_struct_obj_2; +extern tf_2_struct_3 tf_2_struct_obj_8; +tf_2_struct_1 a; +tf_2_struct_5 b; +tf_2_struct_1 tf_2_struct_3::member_3_0; +unsigned tf_2_struct_4::member_4_0; +void tf_2_init() { + a.member_1_1 = tf_2_struct_obj_2.member_6_2.member_5_2.member_1_1 = 5; +} +void tf_2_foo() { + int c = tf_2_struct_obj_2.member_6_2.member_5_4.member_4_1.member_2_0 - + -~tf_2_struct_obj_2.member_6_4 * char(90284000534361); + tf_2_struct_obj_8.member_3_0.member_1_0 = + tf_2_var_24 > + tf_2_var_21 * a.member_1_0 * tf_2_var_2 - tf_2_var_5 % a.member_1_1; + if ((~(tf_2_var_31 * tf_2_var_6) && + -~tf_2_struct_obj_2.member_6_4 * 90284000534361) % + ~tf_2_var_31 * tf_2_var_6) + b.member_5_2.member_1_0 << tf_2_var_16 << tf_2_var_1; + tf_2_var_233 = -~tf_2_struct_obj_2.member_6_4 * char(90284000534361); + int d(tf_2_struct_obj_2.member_6_4); + if (b.member_5_2.member_1_0) + b.member_5_2.member_1_1 = c; + bool e(~-~tf_2_struct_obj_2.member_6_4); + a.member_1_1 % e; + if (tf_2_var_5 / tf_2_struct_obj_2.member_6_2.member_5_2.member_1_1) + b.member_5_4.member_4_0 = tf_2_var_21 * a.member_1_0 * tf_2_var_2; + tf_2_var_69 = tf_2_var_6; +} + +/* { dg-final { scan-rtl-dump-not "Inserting rematerialization insn" "reload" } } */ diff --git a/gcc/testsuite/g++.old-deja/g++.abi/vtable2.C b/gcc/testsuite/g++.old-deja/g++.abi/vtable2.C index 2c88a95800b..96533e09218 100644 --- a/gcc/testsuite/g++.old-deja/g++.abi/vtable2.C +++ b/gcc/testsuite/g++.old-deja/g++.abi/vtable2.C @@ -1,5 +1,5 @@ // { dg-do run } -// { dg-options "-Wno-attributes -fno-strict-aliasing" } +// { dg-options "-Wno-attribute-alias -fno-strict-aliasing" } // Origin: Mark Mitchell <mark@codesourcery.com> #if defined (__GXX_ABI_VERSION) && __GXX_ABI_VERSION >= 100 diff --git a/gcc/testsuite/g++.old-deja/g++.other/using9.C b/gcc/testsuite/g++.old-deja/g++.other/using9.C index 0e34156d8f6..c79f993fd2b 100644 --- a/gcc/testsuite/g++.old-deja/g++.other/using9.C +++ b/gcc/testsuite/g++.old-deja/g++.other/using9.C @@ -13,7 +13,7 @@ struct x {}; using ::x; using ::a; -extern "C" void foo (); // { dg-error "previous declaration" } +extern "C" void foo (); // { dg-message "previous declaration" } namespace { extern "C" int foo (); // { dg-error "C.*linkage" } diff --git a/gcc/testsuite/g++.old-deja/g++.pt/crash3.C b/gcc/testsuite/g++.old-deja/g++.pt/crash3.C index 160cbe541a1..e5b3f25b530 100644 --- a/gcc/testsuite/g++.old-deja/g++.pt/crash3.C +++ b/gcc/testsuite/g++.old-deja/g++.pt/crash3.C @@ -6,11 +6,11 @@ public: CVector<int> f() const { CVector<int> v(); - return v; + return v; // { dg-error "convert" } } CVector<long> g() const { CVector<long> v(); - return v; + return v; // { dg-error "convert" } } }; diff --git a/gcc/testsuite/gcc.c-torture/execute/20040709-3.c b/gcc/testsuite/gcc.c-torture/execute/20040709-3.c new file mode 100644 index 00000000000..e6622c6e257 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20040709-3.c @@ -0,0 +1,5 @@ +/* PR rtl-optimization/68205 */ +/* { dg-require-effective-target int32plus } */ +/* { dg-additional-options "-fno-common" } */ + +#include "20040709-2.c" diff --git a/gcc/testsuite/gcc.c-torture/execute/pr80421.c b/gcc/testsuite/gcc.c-torture/execute/pr80421.c new file mode 100644 index 00000000000..b13ab5fc121 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/pr80421.c @@ -0,0 +1,121 @@ +/* PR middle-end/80421 */ + +__attribute__ ((noinline, noclone)) void +baz (const char *t, ...) +{ + asm volatile (""::"r" (t):"memory"); + if (*t == 'T') + __builtin_abort (); +} + +unsigned int +foo (char x) +{ + baz ("x %c\n", x); + switch (x) + { + default: + baz ("case default\n"); + if (x == 'D' || x == 'I') + baz ("This should never be reached.\n"); + return 0; + case 'D': + baz ("case 'D'\n"); + return 0; + case 'I': + baz ("case 'I'\n"); + return 0; + } +} + +void +bar (void) +{ + int a = 2; + int b = 5; + char c[] = { + 2, 4, 1, 2, 5, 5, 2, 4, 4, 0, 0, 0, 0, 0, 0, 3, 4, 4, 2, 4, + 1, 2, 5, 5, 2, 4, 1, 0, 0, 0, 2, 4, 4, 3, 4, 3, 3, 5, 1, 3, + 5, 5, 2, 4, 4, 2, 4, 1, 3, 5, 3, 3, 5, 1, 3, 5, 1, 2, 4, 4, + 2, 4, 2, 3, 5, 1, 3, 5, 1, 3, 5, 5, 2, 4, 1, 2, 4, 2, 3, 5, + 3, 3, 5, 1, 3, 5, 5, 2, 4, 1, 2, 4, 1, 3, 5, 3, 3, 5, 1, 3, + 5, 5, 2, 4, 4, 2, 4, 1, 3, 5, 3, 3, 5, 1, 3, 5, 1, 2, 4, 1, + 2, 4, 2, 3, 5, 1, 3, 5, 1, 3, 5, 1, 2, 4, 1, 2, 4, 1, 3, 5, + 1, 3, 5, 1, 3, 5, 1, 2, 4, 4, 2, 4, 1, 3, 5, 1, 3, 5, 1, 3, + 5, 5, 2, 4, 4, 2, 4, 2, 3, 5, 3, 3, 5, 1, 3, 5, 5, 2, 4, 4, + 2, 4, 1, 3, 5, 3, 3, 5, 1, 3, 5, 1, 2, 5, 5, 2, 4, 2, 3, 5, + 1, 3, 4, 1, 3, 5, 1, 2, 5, 5, 2, 4, 1, 2, 5, 1, 3, 5, 3, 3, + 5, 1, 2, 5, 5, 2, 4, 2, 2, 5, 1, 3, 5, 3, 3, 5, 1, 2, 5, 1, + 2, 4, 1, 2, 5, 2, 3, 5, 1, 3, 5, 1, 2, 5, 1, 2, 4, 2, 2, 5, + 1, 3, 5, 1, 3, 5, 1, 2, 5, 5, 2, 4, 2, 2, 5, 2, 3, 5, 3, 3, + 5, 1, 2, 5, 5, 2, 4, 2, 2, 5, 2, 3, 5, 3, 3, 5, 1, 2, 5, 5, + 2, 4, 2, 2, 5, 1, 3, 5, 3, 3, 5, 1, 2, 5, 5, 2, 4, 2, 2, 5, + 1, 3, 5, 3, 3, 5, 1, 2, 5, 1, 2, 4, 1, 2, 5, 2, 3, 5, 1, 3, + 5, 1, 2, 5, 5, 2, 4, 2, 2, 5, 2, 3, 5, 3, 3, 5, 1, 2, 5, 5, + 2, 4, 1, 2, 5, 1, 3, 5, 3, 3, 5, 1, 2, 5, 5, 2, 4, 2, 2, 5, + 1, 3, 5, 3, 3, 5, 1, 2, 5, 5, 2, 4, 2, 2, 5, 1, 3, 5, 3, 3, + 5, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + }; + char *f = c + 390; + int i, j, e, g, h; + char k, l; + i = 26; + j = 25; + k = l = 'M'; + h = 2; + while (i > 0) + { + int x = i - a; + x = x > 0 ? x : 0; + x = j - x; + g = x * 3 + h; + switch (f[g]) + { + case 1: + --i; + --j; + h = 2; + f -= b * 3; + k = 'M'; + break; + case 2: + --i; + h = 0; + f -= b * 3; + k = 'I'; + break; + case 3: + --i; + h = 2; + f -= b * 3; + k = 'I'; + break; + case 4: + --j; + h = 1; + k = 'D'; + break; + case 5: + --j; + h = 2; + k = 'D'; + break; + } + if (k == l) + ++e; + else + { + foo (l); + l = k; + } + } +} + +int +main () +{ + char l = 'D'; + foo (l); + bar (); + return 0; +} diff --git a/gcc/testsuite/gcc.c-torture/execute/pr81423.c b/gcc/testsuite/gcc.c-torture/execute/pr81423.c index 731aa8f1c65..be7413be334 100644 --- a/gcc/testsuite/gcc.c-torture/execute/pr81423.c +++ b/gcc/testsuite/gcc.c-torture/execute/pr81423.c @@ -1,3 +1,5 @@ +/* PR rtl-optimization/81423 */ + extern void abort (void); unsigned long long int ll = 0; @@ -10,11 +12,11 @@ foo (void) { ll = -5597998501375493990LL; - ll = (5677365550390624949L - ll) - (ull1 > 0); + ll = (unsigned int) (5677365550390624949LL - ll) - (ull1 > 0); unsigned long long int ull3; ull3 = (unsigned int) - (2067854353L << - (((ll + -2129105131L) ^ 10280750144413668236ULL) - + (2067854353LL << + (((ll + -2129105131LL) ^ 10280750144413668236ULL) - 10280750143997242009ULL)) >> ((2873442921854271231ULL | ull2) - 12098357307243495419ULL); @@ -24,9 +26,10 @@ foo (void) int main (void) { - /* We need a long long of exactly 64 bits for this test. */ - ll--; - if (ll != 0xffffffffffffffffULL) + /* We need a long long of exactly 64 bits and int of exactly 32 bits + for this test. */ + if (__SIZEOF_LONG_LONG__ * __CHAR_BIT__ != 64 + || __SIZEOF_INT__ * __CHAR_BIT__ != 32) return 0; ull3 = foo (); diff --git a/gcc/testsuite/gcc.c-torture/execute/pr82524.c b/gcc/testsuite/gcc.c-torture/execute/pr82524.c new file mode 100644 index 00000000000..07ac4b61916 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/pr82524.c @@ -0,0 +1,37 @@ +/* PR target/82524 */ + +struct S { unsigned char b, g, r, a; }; +union U { struct S c; unsigned v; }; + +static inline unsigned char +foo (unsigned char a, unsigned char b) +{ + return ((a + 1) * b) >> 8; +} + +__attribute__((noinline, noclone)) unsigned +bar (union U *x, union U *y) +{ + union U z; + unsigned char v = x->c.a; + unsigned char w = foo (y->c.a, 255 - v); + z.c.r = foo (x->c.r, v) + foo (y->c.r, w); + z.c.g = foo (x->c.g, v) + foo (y->c.g, w); + z.c.b = foo (x->c.b, v) + foo (y->c.b, w); + z.c.a = 0; + return z.v; +} + +int +main () +{ + union U a, b, c; + if ((unsigned char) ~0 != 255 || sizeof (unsigned) != 4) + return 0; + a.c = (struct S) { 255, 255, 255, 0 }; + b.c = (struct S) { 255, 255, 255, 255 }; + c.v = bar (&a, &b); + if (c.c.b != 255 || c.c.g != 255 || c.c.r != 255 || c.c.a != 0) + __builtin_abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/Wstrict-overflow-7.c b/gcc/testsuite/gcc.dg/Wstrict-overflow-7.c index 5bf7b6005ca..401cbc3c987 100644 --- a/gcc/testsuite/gcc.dg/Wstrict-overflow-7.c +++ b/gcc/testsuite/gcc.dg/Wstrict-overflow-7.c @@ -6,5 +6,5 @@ int foo (int i) { - return i + 10 > i; /* { dg-warning "assuming signed overflow does not occur" "correct warning" } */ + return i + 10 > i; /* { dg-warning "assuming signed overflow does not occur" "correct warning" { xfail *-*-* } } */ } diff --git a/gcc/testsuite/gcc.dg/cold-1.c b/gcc/testsuite/gcc.dg/cold-1.c index 8ea88dd79a3..ba1cd3a4e62 100644 --- a/gcc/testsuite/gcc.dg/cold-1.c +++ b/gcc/testsuite/gcc.dg/cold-1.c @@ -1,11 +1,12 @@ /* { dg-do compile { target nonpic } } */ /* { dg-options "-O2 -Wsuggest-attribute=cold" } */ +extern void abort (void); extern void do_something_interesting_and_never_return (); int foo1(int a) -{ /* { dg-warning "cold" "detect cold candidate" { target *-*-* } "8" } */ +{ /* { dg-warning "cold" "detect cold candidate" { target *-*-* } ".-1" } */ if (a) abort (); else diff --git a/gcc/testsuite/gcc.dg/compat/struct-layout-1_generate.c b/gcc/testsuite/gcc.dg/compat/struct-layout-1_generate.c index 80c7355a50e..75e902cd1f4 100644 --- a/gcc/testsuite/gcc.dg/compat/struct-layout-1_generate.c +++ b/gcc/testsuite/gcc.dg/compat/struct-layout-1_generate.c @@ -1893,7 +1893,7 @@ generate_fields (enum FEATURE features, struct entry *e, struct entry *parent, || (e[n].type >= &attrib_array_types[0] && e[n].type < &attrib_array_types[NAATYPES2]) || (e[n].type >= &complex_attrib_array_types[0] - && e[n].type < &complex_attrib_array_types[NAATYPES2]) + && e[n].type < &complex_attrib_array_types[NCAATYPES2]) || (e[n].type >= &aligned_bitfld_types[0] && e[n].type < &aligned_bitfld_types[n_aligned_bitfld_types]))) e[n].attrib = NULL; diff --git a/gcc/testsuite/gcc.dg/graphite/fuse-1.c b/gcc/testsuite/gcc.dg/graphite/fuse-1.c index e3bf7bcf99b..204d3b20703 100644 --- a/gcc/testsuite/gcc.dg/graphite/fuse-1.c +++ b/gcc/testsuite/gcc.dg/graphite/fuse-1.c @@ -1,15 +1,15 @@ /* Check that the two loops are fused and that we manage to fold the two xor operations. */ -/* { dg-options "-O2 -floop-nest-optimize -fdump-tree-forwprop4-all -fdump-tree-graphite-all" } */ +/* { dg-options "-O2 -floop-nest-optimize -fdump-tree-forwprop-all -fdump-tree-graphite-all" } */ /* Make sure we fuse the loops like this: AST generated by isl: for (int c0 = 0; c0 <= 99; c0 += 1) { - S_3(0, c0); - S_6(0, c0); - S_9(0, c0); + S_3(c0); + S_6(c0); + S_9(c0); } */ -/* { dg-final { scan-tree-dump-times "AST generated by isl:.*for \\(int c0 = 0; c0 <= 99; c0 \\+= 1\\) \\{.*S_.*\\(0, c0\\);.*S_.*\\(0, c0\\);.*S_.*\\(0, c0\\);.*\\}" 1 "graphite" } } */ +/* { dg-final { scan-tree-dump-times "AST generated by isl:.*for \\(int c0 = 0; c0 <= 99; c0 \\+= 1\\) \\{.*S_.*\\(c0\\);.*S_.*\\(c0\\);.*S_.*\\(c0\\);.*\\}" 1 "graphite" } } */ /* Check that after fusing the loops, the scalar computation is also fused. */ /* { dg-final { scan-tree-dump-times "gimple_simplified to\[^\\n\]*\\^ 12" 1 "forwprop4" } } */ diff --git a/gcc/testsuite/gcc.dg/graphite/fuse-2.c b/gcc/testsuite/gcc.dg/graphite/fuse-2.c index dc0a9b2b61c..f4cea4360d9 100644 --- a/gcc/testsuite/gcc.dg/graphite/fuse-2.c +++ b/gcc/testsuite/gcc.dg/graphite/fuse-2.c @@ -3,13 +3,13 @@ /* Make sure we fuse the loops like this: AST generated by isl: for (int c0 = 0; c0 <= 99; c0 += 1) { - S_3(0, c0); - S_6(0, c0); - S_9(0, c0); + S_3(c0); + S_6(c0); + S_9(c0); } */ -/* { dg-final { scan-tree-dump-times "AST generated by isl:.*for \\(int c0 = 0; c0 <= 99; c0 \\+= 1\\) \\{.*S_.*\\(0, c0\\);.*S_.*\\(0, c0\\);.*S_.*\\(0, c0\\);.*\\}" 1 "graphite" } } */ +/* { dg-final { scan-tree-dump-times "AST generated by isl:.*for \\(int c0 = 0; c0 <= 99; c0 \\+= 1\\) \\{.*S_.*\\(c0\\);.*S_.*\\(c0\\);.*S_.*\\(c0\\);.*\\}" 1 "graphite" } } */ #define MAX 100 int A[MAX], B[MAX], C[MAX]; diff --git a/gcc/testsuite/gcc.dg/graphite/id-30.c b/gcc/testsuite/gcc.dg/graphite/id-30.c new file mode 100644 index 00000000000..f8144cec4f2 --- /dev/null +++ b/gcc/testsuite/gcc.dg/graphite/id-30.c @@ -0,0 +1,16 @@ +/* The modulo constraints we generate for the niter expression + (unsinged long)ubound - (unsigned long)lbound + end up with a modulo that we cannot represent in the expression + type we are using (int64_t), so we run into the codegen error + where ISL generates a modulo/divide by sth that doesn't fit the + type we code-generate with. Verify we properly elide those. */ + +void foo (double *a, long int lbound0, long int ubound0, + long int lbound1, long int ubound1, long int stride1) +{ + if (lbound0 < ubound0) + for (long int i = lbound0; i <= ubound0; ++i) + if (lbound1 < ubound1) + for (long int j = lbound1; j <= ubound1; ++j) + a[i*stride1 + j] = 0.; +} diff --git a/gcc/testsuite/gcc.dg/graphite/pr35356-3.c b/gcc/testsuite/gcc.dg/graphite/pr35356-3.c index f2827a2bb6d..8db042ffc6f 100644 --- a/gcc/testsuite/gcc.dg/graphite/pr35356-3.c +++ b/gcc/testsuite/gcc.dg/graphite/pr35356-3.c @@ -36,4 +36,5 @@ match (void) "Y[winner].y > 0". This could be fixed when we will use predicates for such cases. */ -/* { dg-final { scan-tree-dump-times "loop_1" 0 "graphite" } } */ +/* { dg-final { scan-tree-dump-times "loop_1" 0 "graphite" { xfail *-*-* } } } */ +/* { dg-final { scan-tree-dump "number of SCoPs: 0" "graphite" } } */ diff --git a/gcc/testsuite/gcc.dg/graphite/pr69728.c b/gcc/testsuite/gcc.dg/graphite/pr69728.c index 35ea5bd15bb..e8cd7bec0a1 100644 --- a/gcc/testsuite/gcc.dg/graphite/pr69728.c +++ b/gcc/testsuite/gcc.dg/graphite/pr69728.c @@ -1,7 +1,7 @@ /* { dg-do compile } */ -/* { dg-options "-O3 -floop-nest-optimize" } */ +/* { dg-options "-O3 -floop-nest-optimize -fdump-tree-graphite-details" } */ -int a[1]; +int a[9]; int b, c, d, e; void fn1 () @@ -19,3 +19,9 @@ fn1 () } } } + +/* At the moment only ISL figures that if (d) is always true. We've + run into scheduling issues before here, not being able to handle + empty domains. */ + +/* { dg-final { scan-tree-dump "loop nest optimized" "graphite" } } */ diff --git a/gcc/testsuite/gcc.dg/graphite/pr81373-2.c b/gcc/testsuite/gcc.dg/graphite/pr81373-2.c new file mode 100644 index 00000000000..6a654bec977 --- /dev/null +++ b/gcc/testsuite/gcc.dg/graphite/pr81373-2.c @@ -0,0 +1,40 @@ +/* { dg-options "-fno-tree-scev-cprop -floop-nest-optimize -fgraphite-identity -O -fdump-tree-graphite-all" } */ + +void bar (void); + +int toto() +{ + int i, j, k; + int a[101][100]; + int b[100]; + + for (i = 1; i < 100; i++) + { + for (j = 1; j < 100; j++) + for (k = 1; k < 100; k++) + a[j][k] = a[j+1][i-1] + 2; + + b[i] = b[i-1] + 2; + + bar (); + + for (j = 1; j < 100; j++) + a[j][i] = a[j+1][i-1] + 2; + + b[i] = b[i-1] + 2; + + bar (); + + for (j = 1; j < 100; j++) + a[j][i] = a[j+1][i-1] + 2; + + b[i] = a[i-1][i] + 2; + + for (j = 1; j < 100; j++) + a[j][i] = a[j+1][i-1] + 2; + } + + return a[3][5] + b[1]; +} + +/* { dg-final { scan-tree-dump-times "number of SCoPs: 2" 1 "graphite"} } */ diff --git a/gcc/testsuite/gcc.dg/graphite/pr82451.c b/gcc/testsuite/gcc.dg/graphite/pr82451.c new file mode 100644 index 00000000000..802b931fddd --- /dev/null +++ b/gcc/testsuite/gcc.dg/graphite/pr82451.c @@ -0,0 +1,21 @@ +/* { dg-do compile } */ +/* { dg-options "-O -floop-parallelize-all" } */ + +static int a[]; +int b[1]; +int c; +static void +d (int *f, int *g) +{ + int e; + for (e = 0; e < 2; e++) + g[e] = 1; + for (e = 0; e < 2; e++) + g[e] = f[e] + f[e + 1]; +} +void +h () +{ + for (;; c += 8) + d (&a[c], b); +} diff --git a/gcc/testsuite/gcc.dg/graphite/scop-10.c b/gcc/testsuite/gcc.dg/graphite/scop-10.c index 39ed5d7ea7b..20d53510b4e 100644 --- a/gcc/testsuite/gcc.dg/graphite/scop-10.c +++ b/gcc/testsuite/gcc.dg/graphite/scop-10.c @@ -4,7 +4,7 @@ int toto() { int i, j, k; int a[100][100]; - int b[100]; + int b[200]; for (i = 1; i < 100; i++) { diff --git a/gcc/testsuite/gcc.dg/graphite/scop-7.c b/gcc/testsuite/gcc.dg/graphite/scop-7.c index 3e337d0c603..2f0a50470e9 100644 --- a/gcc/testsuite/gcc.dg/graphite/scop-7.c +++ b/gcc/testsuite/gcc.dg/graphite/scop-7.c @@ -4,7 +4,7 @@ int toto() { int i, j, k; int a[100][100]; - int b[100]; + int b[200]; for (i = 1; i < 100; i++) { diff --git a/gcc/testsuite/gcc.dg/graphite/scop-8.c b/gcc/testsuite/gcc.dg/graphite/scop-8.c index 71d5c531fb8..3ceb5d874d6 100644 --- a/gcc/testsuite/gcc.dg/graphite/scop-8.c +++ b/gcc/testsuite/gcc.dg/graphite/scop-8.c @@ -4,7 +4,7 @@ int toto() { int i, j, k; int a[100][100]; - int b[100]; + int b[200]; for (i = 1; i < 100; i++) { diff --git a/gcc/testsuite/gcc.dg/ipa/inlinehint-4.c b/gcc/testsuite/gcc.dg/ipa/inlinehint-4.c index 441a0c70855..71b16f80be2 100644 --- a/gcc/testsuite/gcc.dg/ipa/inlinehint-4.c +++ b/gcc/testsuite/gcc.dg/ipa/inlinehint-4.c @@ -35,5 +35,5 @@ test (int i) lookup (9 * i); } /* { dg-final { scan-ipa-dump "Wrapper penalty" "inline" } } */ -/* { dg-final { scan-ipa-dump-not "Inlining lookup_slow to lookup" "inline" } } */ -/* { dg-final { scan-ipa-dump "Inlining lookup to test" "inline" } } */ +/* { dg-final { scan-ipa-dump-not "Inlined lookup_slow into lookup" "inline" } } */ +/* { dg-final { scan-ipa-dump "Inlined lookup into test" "inline" } } */ diff --git a/gcc/testsuite/gcc.dg/missing-symbol-2.c b/gcc/testsuite/gcc.dg/missing-symbol-2.c new file mode 100644 index 00000000000..7ee795dfcc5 --- /dev/null +++ b/gcc/testsuite/gcc.dg/missing-symbol-2.c @@ -0,0 +1,71 @@ +/* { dg-options "-fdiagnostics-show-caret -Wno-switch-unreachable" } */ + +extern int foo (void); + +void missing_open_paren (void) +{ + if foo ()) /* { dg-line missing_open_paren } */ + { + } + /* { dg-error "expected '\\(' before 'foo'" "" { target c } missing_open_paren } */ + /* { dg-begin-multiline-output "" } + if foo ()) + ^~~ + ( + { dg-end-multiline-output "" } */ + /* { dg-error "expected statement before '\\)' token" "" { target c } missing_open_paren } */ + /* { dg-begin-multiline-output "" } + if foo ()) + ^ + { dg-end-multiline-output "" } */ +} + +void missing_close_square (void) +{ + const char test [42; /* { dg-error "22: expected ']' before ';' token" } */ + /* { dg-begin-multiline-output "" } + const char test [42; + ^ + ] + { dg-end-multiline-output "" } */ +} + +int missing_semicolon (void) +{ + return 42 /* { dg-error "expected ';'" } */ +} +/* { dg-begin-multiline-output "" } + return 42 + ^ + ; + } + ~ + { dg-end-multiline-output "" } */ + + +/* We don't offer a fix-it hint for this case in C, as it could be + colon or ellipsis. + TODO: we could be smarter about error-recovery here; given the + return perhaps we could assume a missing colon. */ + +int missing_colon_in_switch (int val) +{ + switch (val) + { + case 42 + return 42; /* { dg-error "expected ':' or '...' before 'return'" } */ + /* { dg-begin-multiline-output "" } + return 42; + ^~~~~~ + { dg-end-multiline-output "" } */ + + default: + return val; + } +} + +/* { dg-begin-multiline-output "" } + int dummy; + ^~~ + { dg-end-multiline-output "" } */ +int dummy;/* { dg-error "expected declaration or statement at end of input" "" { target c } } */ diff --git a/gcc/testsuite/gcc.dg/missing-symbol-3.c b/gcc/testsuite/gcc.dg/missing-symbol-3.c new file mode 100644 index 00000000000..e2d00dfa03f --- /dev/null +++ b/gcc/testsuite/gcc.dg/missing-symbol-3.c @@ -0,0 +1,50 @@ +/* { dg-options "-fdiagnostics-show-caret" } */ + +/* A sequence of bogus _Static_assert. + We can offer fix-it hints for some of these, but not all. */ + +void test_static_assert_1 (void) +{ + _Static_assert sizeof(int) >= sizeof(char); /* { dg-error "expected '\\(' before 'sizeof'" } */ + /* { dg-begin-multiline-output "" } + _Static_assert sizeof(int) >= sizeof(char); + ^~~~~~ + ( + { dg-end-multiline-output "" } */ +} + +void test_static_assert_2 (void) +{ + _Static_assert(sizeof(int) >= sizeof(char); /* { dg-error "expected ',' before ';' token" } */ + /* { dg-begin-multiline-output "" } + _Static_assert(sizeof(int) >= sizeof(char); + ^ + , + { dg-end-multiline-output "" } */ +} + +void test_static_assert_3 (void) +{ + _Static_assert(sizeof(int) >= sizeof(char),; /* { dg-error "expected string literal before ';' token" } */ + /* { dg-begin-multiline-output "" } + _Static_assert(sizeof(int) >= sizeof(char),; + ^ + { dg-end-multiline-output "" } */ +} + +void test_static_assert_4 (void) +{ + _Static_assert(sizeof(int) >= sizeof(char), "msg"; /* { dg-error "expected '\\)' before ';' token" } */ + /* { dg-begin-multiline-output "" } + _Static_assert(sizeof(int) >= sizeof(char), "msg"; + ~ ^ + ) + { dg-end-multiline-output "" } */ +} + +/* The final one is correct. */ + +void test_static_assert_5 (void) +{ + _Static_assert(sizeof(int) >= sizeof(char), "msg"); +} diff --git a/gcc/testsuite/gcc.dg/noncompile/940112-1.c b/gcc/testsuite/gcc.dg/noncompile/940112-1.c index bb5e0f66c85..0a9e07dcaf9 100644 --- a/gcc/testsuite/gcc.dg/noncompile/940112-1.c +++ b/gcc/testsuite/gcc.dg/noncompile/940112-1.c @@ -3,5 +3,5 @@ f (int x) { double e = 1; e = 1; - return (e) -} /* { dg-error "parse error|syntax error|expected" } */ + return (e) /* { dg-error "parse error|syntax error|expected" } */ +} diff --git a/gcc/testsuite/gcc.dg/noncompile/971104-1.c b/gcc/testsuite/gcc.dg/noncompile/971104-1.c index 39e00c60fc2..4a04dad7747 100644 --- a/gcc/testsuite/gcc.dg/noncompile/971104-1.c +++ b/gcc/testsuite/gcc.dg/noncompile/971104-1.c @@ -27,6 +27,6 @@ static void up(int sem){ printf("%s had processes sleeping on it!\n", ({ "MUTEX ", "BARB_SEM 1", "BARB_SEM 2", "CUST_SEM 1", "CUST_SEM 2", "WAIT_SEM 1", "WAIT_SEM 2", "WAIT_SEM 3", - "WAIT_SEM 4"} /* { dg-error "parse error|syntax error|expected" } */ - [( sb.sem_num )]) ); /* { dg-error "expected" } */ + "WAIT_SEM 4"} /* { dg-error "expected" } */ + [( sb.sem_num )]) ); } diff --git a/gcc/testsuite/gcc.dg/pr81854.c b/gcc/testsuite/gcc.dg/pr81854.c index b8499f8b130..1021a811be4 100644 --- a/gcc/testsuite/gcc.dg/pr81854.c +++ b/gcc/testsuite/gcc.dg/pr81854.c @@ -1,6 +1,7 @@ /* PR c/81854 - weak alias of an incompatible symbol accepted { dg-do compile } - { dg-require-ifunc "" } */ + { dg-require-ifunc "" } + { dg-options "-Wextra" } */ const char* __attribute__ ((weak, alias ("f0_target"))) f0 (void); /* { dg-error "alias between function and variable" } */ @@ -26,39 +27,37 @@ const char* f2_target (int i) /* { dg-message "aliased declaration here" } */ return 0; } - int __attribute__ ((ifunc ("f3_resolver"))) -f3 (void); /* { dg-error ".ifunc. resolver must return a function pointer" } */ +f3 (void); /* { dg-message "resolver indirect function declared here" } */ -int f3_resolver (void) /* { dg-message "resolver declaration here" } */ +void* f3_resolver (void) /* { dg-warning "ifunc. resolver for .f3. should return .int \\(\\*\\)\\(void\\)." } */ { return 0; } int __attribute__ ((ifunc ("f4_resolver"))) -f4 (void); /* { dg-warning ".ifunc. resolver should return a function pointer" } */ +f4 (void); /* { dg-message "resolver indirect function declared here" } */ -void* f4_resolver (void) /* { dg-message "resolver declaration here" } */ +typedef void F4 (void); +F4* f4_resolver (void) /* { dg-warning ".ifunc. resolver for .f4. should return .int \\(\\*\\)\\(void\\)" } */ { return 0; } +const char* __attribute__ ((ifunc ("f5_resolver"))) +f5 (void); -int __attribute__ ((ifunc ("f5_resolver"))) -f5 (void); /* { dg-warning "alias between functions of incompatible types" } */ - -typedef void F5 (void); -F5* f5_resolver (void) /* { dg-message "aliased declaration here" } */ +typedef const char* F5 (void); +F5* f5_resolver (void) { return 0; } -const char* __attribute__ ((ifunc ("f6_resolver"))) -f6 (void); +int __attribute__ ((ifunc ("f6_resolver"))) +f6 (void); /* { dg-message "resolver indirect function declared here" } */ -typedef const char* F6 (void); -F6* f6_resolver (void) +int f6_resolver (void) /* { dg-error ".ifunc. resolver for 'f6' must return .int \\(\\*\\)\\(void\\)." } */ { return 0; } diff --git a/gcc/testsuite/gcc.dg/pr82274-1.c b/gcc/testsuite/gcc.dg/pr82274-1.c new file mode 100644 index 00000000000..f96b7338fc4 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr82274-1.c @@ -0,0 +1,16 @@ +/* PR target/82274 */ +/* { dg-do run } */ +/* { dg-shouldfail "trapv" } */ +/* { dg-options "-ftrapv" } */ + +int +main () +{ +#ifdef __SIZEOF_INT128__ + volatile __int128 m = -(((__int128) 1) << (__CHAR_BIT__ * __SIZEOF_INT128__ / 2)); +#else + volatile long long m = -(1LL << (__CHAR_BIT__ * __SIZEOF_LONG_LONG__ / 2)); +#endif + m = m * m; + return 0; +} diff --git a/gcc/testsuite/gcc.dg/pr82274-2.c b/gcc/testsuite/gcc.dg/pr82274-2.c new file mode 100644 index 00000000000..a9643b5a923 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr82274-2.c @@ -0,0 +1,26 @@ +/* PR target/82274 */ +/* { dg-do run } */ +/* { dg-options "-O2" } */ + +int +main () +{ +#ifdef __SIZEOF_INT128__ + __int128 m = -(((__int128) 1) << (__CHAR_BIT__ * __SIZEOF_INT128__ / 2)); + volatile __int128 mv = m; + __int128 r; +#else + long long m = -(1LL << (__CHAR_BIT__ * __SIZEOF_LONG_LONG__ / 2)); + volatile long long mv = m; + long long r; +#endif + if (!__builtin_mul_overflow (mv, mv, &r)) + __builtin_abort (); + if (!__builtin_mul_overflow_p (mv, mv, r)) + __builtin_abort (); + if (!__builtin_mul_overflow (m, m, &r)) + __builtin_abort (); + if (!__builtin_mul_overflow_p (m, m, r)) + __builtin_abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/pragma-diag-3.c b/gcc/testsuite/gcc.dg/pragma-diag-3.c index 2ee439d7e33..b6ee60f1677 100644 --- a/gcc/testsuite/gcc.dg/pragma-diag-3.c +++ b/gcc/testsuite/gcc.dg/pragma-diag-3.c @@ -15,7 +15,7 @@ void testing2() { void testing3() { int k = 4; - k + 4 < k; /* { dg-error "overflow" } */ + k + 4 < k; /* { dg-error "overflow" "" { xfail *-*-* } } */ } int bar() diff --git a/gcc/testsuite/gcc.dg/predict-13.c b/gcc/testsuite/gcc.dg/predict-13.c index 7fe714a0d72..385be9e1389 100644 --- a/gcc/testsuite/gcc.dg/predict-13.c +++ b/gcc/testsuite/gcc.dg/predict-13.c @@ -21,4 +21,4 @@ int main(int argc, char **argv) } /* { dg-final { scan-tree-dump-times "combined heuristics of edge\[^:\]*: 33.3%" 3 "profile_estimate"} } */ -/* { dg-final { scan-tree-dump-times "combined heuristics of edge\[^:\]*: 0.0%" 2 "profile_estimate"} } */ +/* { dg-final { scan-tree-dump-times "combined heuristics of edge\[^:\]*: 0.1%" 2 "profile_estimate"} } */ diff --git a/gcc/testsuite/gcc.dg/predict-8.c b/gcc/testsuite/gcc.dg/predict-8.c index e13cc006f3a..fa975b3d95f 100644 --- a/gcc/testsuite/gcc.dg/predict-8.c +++ b/gcc/testsuite/gcc.dg/predict-8.c @@ -1,5 +1,5 @@ /* { dg-do compile { target { i?86-*-* x86_64-*-* } } } */ -/* { dg-options "-O2 -fdump-rtl-expand" } */ +/* { dg-options "-O2 -fdump-rtl-expand-details-blocks" } */ int foo(float a, float b) { if (a == b) @@ -8,4 +8,4 @@ int foo(float a, float b) { return 2; } -/* { dg-final { scan-rtl-dump-times "REG_BR_PROB 400 " 1 "expand"} } */ +/* { dg-final { scan-rtl-dump-times "99.0. .guessed" 2 "expand"} } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ldist-16.c b/gcc/testsuite/gcc.dg/tree-ssa/ldist-16.c index f43b64ead62..f4f3a44903c 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/ldist-16.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/ldist-16.c @@ -16,5 +16,5 @@ void foo (int n) /* We should not apply loop distribution and not generate a memset (0). */ -/* { dg-final { scan-tree-dump "Loop 1 is the same" "ldist" } } */ +/* { dg-final { scan-tree-dump "Loop 1 not distributed" "ldist" } } */ /* { dg-final { scan-tree-dump-times "generated memset zero" 0 "ldist" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ldist-25.c b/gcc/testsuite/gcc.dg/tree-ssa/ldist-25.c index 699bf38ab03..c0b95fc38ec 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/ldist-25.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/ldist-25.c @@ -22,4 +22,4 @@ foo (void) } } -/* { dg-final { scan-tree-dump "Loop . is the same" "ldist" } } */ +/* { dg-final { scan-tree-dump "Loop . not distributed" "ldist" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ldist-27.c b/gcc/testsuite/gcc.dg/tree-ssa/ldist-27.c new file mode 100644 index 00000000000..3580c65f09b --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ldist-27.c @@ -0,0 +1,38 @@ +/* { dg-do run } */ +/* { dg-options "-O3 -ftree-loop-distribute-patterns -fdump-tree-ldist-details" } */ + +#define M (300) +#define N (200) + +struct st +{ + double a[M]; + double b[M]; + double c[M][N]; +}; + +int __attribute__ ((noinline)) foo (struct st *s) +{ + int i, j; + for (i = 0; i != M;) + { + s->a[i] = 0.0; + s->b[i] = 1.0; + for (j = 0; 1; ++j) + { + if (j == N) goto L2; + s->c[i][j] = 0.0; + } +L2: + ++i; + } + return 0; +} + +int main (void) +{ + struct st s; + return foo (&s); +} + +/* { dg-final { scan-tree-dump "distributed: split to " "ldist" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ldist-28.c b/gcc/testsuite/gcc.dg/tree-ssa/ldist-28.c new file mode 100644 index 00000000000..4420139dedb --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ldist-28.c @@ -0,0 +1,16 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -ftree-loop-distribution -ftree-loop-distribute-patterns -fdump-tree-ldist-details" } */ + +#define M (256) +#define N (1024) +int arr[M][N]; + +void +foo (void) +{ + for (unsigned i = 0; i < M; ++i) + for (unsigned j = 0; j < N; ++j) + arr[i][j] = 0; +} + +/* { dg-final { scan-tree-dump "Loop nest . distributed: split to 0 loops and 1 library" "ldist" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ldist-29.c b/gcc/testsuite/gcc.dg/tree-ssa/ldist-29.c new file mode 100644 index 00000000000..9ce93e80b07 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ldist-29.c @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -ftree-loop-distribution -ftree-loop-distribute-patterns -fdump-tree-ldist-details" } */ + +#define M (256) +#define N (512) +int arr[M][N]; + +void +foo (void) +{ + for (unsigned i = 0; i < M; ++i) + for (unsigned j = 0; j < N - 1; ++j) + arr[i][j] = 0; +} + +/* { dg-final { scan-tree-dump-not "Loop nest . distributed: split to" "ldist" } } */ +/* { dg-final { scan-tree-dump-times "Loop . distributed: split to 0 loops and 1 library" 1 "ldist" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ldist-30.c b/gcc/testsuite/gcc.dg/tree-ssa/ldist-30.c new file mode 100644 index 00000000000..f31860a574e --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ldist-30.c @@ -0,0 +1,16 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -ftree-loop-distribution -ftree-loop-distribute-patterns -fdump-tree-ldist-details" } */ + +#define M (256) +#define N (512) +int a[M][N], b[M][N]; + +void +foo (void) +{ + for (unsigned i = 0; i < M; ++i) + for (unsigned j = N; j > 0; --j) + a[i][j - 1] = b[i][j - 1]; +} + +/* { dg-final { scan-tree-dump-times "Loop nest . distributed: split to" 1 "ldist" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ldist-31.c b/gcc/testsuite/gcc.dg/tree-ssa/ldist-31.c new file mode 100644 index 00000000000..60a9f743b1b --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ldist-31.c @@ -0,0 +1,19 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -ftree-loop-distribution -ftree-loop-distribute-patterns -fdump-tree-ldist-details" } */ + +#define M (256) +#define N (512) +int a[M][N], b[M][N], c[M]; + +void +foo (void) +{ + for (int i = M - 1; i >= 0; --i) + { + c[i] = 0; + for (unsigned j = N; j > 0; --j) + a[i][j - 1] = b[i][j - 1]; + } +} + +/* { dg-final { scan-tree-dump-times "Loop nest . distributed: split to 0 loops and 2 library" 1 "ldist" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ldist-33.c b/gcc/testsuite/gcc.dg/tree-ssa/ldist-33.c new file mode 100644 index 00000000000..24d27fde9da --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ldist-33.c @@ -0,0 +1,21 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -ftree-loop-distribution -ftree-loop-distribute-patterns -fdump-tree-ldist-details" } */ + +#define N (1024) +double a[N][N], b[N][N], c[N][N]; + +void +foo (void) +{ + unsigned i, j, k; + + for (i = 0; i < N; ++i) + for (j = 0; j < N; ++j) + { + c[i][j] = 0.0; + for (k = 0; k < N; ++k) + c[i][j] += a[i][k] * b[k][j]; + } +} + +/* { dg-final { scan-tree-dump "Loop nest . distributed: split to 1 loops and 1 library" "ldist" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ldist-34.c b/gcc/testsuite/gcc.dg/tree-ssa/ldist-34.c new file mode 100644 index 00000000000..3d68a851f57 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ldist-34.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -ftree-loop-distribution" } */ + +#define X (3.0) +int b, c; +double a[30000]; +int foo () { + for (int i = 0; i < 100; ++i) { + for (int j = 0; j < c; ++j) + if (b) + a[0] = b; + a[i * 100] = a[1] = X; + } + return 0; +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ldist-7.c b/gcc/testsuite/gcc.dg/tree-ssa/ldist-7.c index f31d051984a..2eb1f74d4ab 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/ldist-7.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/ldist-7.c @@ -28,4 +28,4 @@ int loop1 (int k) return a[1000-2] + b[1000-1] + c[1000-2] + d[1000-2]; } -/* { dg-final { scan-tree-dump-times "distributed" 0 "ldist" } } */ +/* { dg-final { scan-tree-dump-times "distributed: " 0 "ldist" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr82472.c b/gcc/testsuite/gcc.dg/tree-ssa/pr82472.c new file mode 100644 index 00000000000..445c95fbc47 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/pr82472.c @@ -0,0 +1,24 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -ftree-loop-distribution" } */ + +long int xj; + +int +cx (long int *ox, short int mk, char tf) +{ + int si, f9; + char *p4 = &tf; + short int *rm = (tf != 0) ? (short int *)&f9 : &mk; + + for (f9 = 0; f9 < 2; ++f9) + { + *rm = 0; + *p4 = *ox; + si = mk; + xj = 0; + while (p4 < (char *)rm) + ++p4; + } + + return si; +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr82498.c b/gcc/testsuite/gcc.dg/tree-ssa/pr82498.c new file mode 100644 index 00000000000..19a42f0a3c7 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/pr82498.c @@ -0,0 +1,53 @@ +/* PR target/82498 */ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-original" } */ +/* { dg-final { scan-tree-dump-times "x r<< y" 4 "original" { target int32 } } } */ +/* { dg-final { scan-tree-dump-times "x r>> y" 4 "original" { target int32 } } } */ + +unsigned +f1 (unsigned x, int y) +{ + return (x << y) | (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - y)); +} + +unsigned +f2 (unsigned x, int y) +{ + return (x << y) | (x >> (-y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned +f3 (unsigned x, int y) +{ + return (x >> y) | (x << (__CHAR_BIT__ * __SIZEOF_INT__ - y)); +} + +unsigned +f4 (unsigned x, int y) +{ + return (x >> y) | (x << (-y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned +f5 (unsigned x, int y) +{ + return (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - y)) | (x << y); +} + +unsigned +f6 (unsigned x, int y) +{ + return (x >> (-y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x << y); +} + +unsigned +f7 (unsigned x, int y) +{ + return (x << (__CHAR_BIT__ * __SIZEOF_INT__ - y)) | (x >> y); +} + +unsigned +f8 (unsigned x, int y) +{ + return (x << (-y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))) | (x >> y); +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-dse-26.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dse-26.c index 6605dfe0aae..a5638b58247 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/ssa-dse-26.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dse-26.c @@ -1,5 +1,5 @@ /* { dg-do compile } */ -/* { dg-options "-O2 -fdump-tree-dse1-details" } */ +/* { dg-options "-O2 -fdump-tree-dse1-details -fno-short-enums" } */ enum constraint_expr_type { @@ -30,4 +30,3 @@ constraint_equal (struct constraint a, struct constraint b) } /* { dg-final { scan-tree-dump-times "Deleted dead store" 2 "dse1" } } */ - diff --git a/gcc/testsuite/gcc.dg/ubsan/pr82498.c b/gcc/testsuite/gcc.dg/ubsan/pr82498.c new file mode 100644 index 00000000000..1d093a058e1 --- /dev/null +++ b/gcc/testsuite/gcc.dg/ubsan/pr82498.c @@ -0,0 +1,159 @@ +/* PR target/82498 */ +/* { dg-do run { target i?86-*-* x86_64-*-* } } */ +/* { dg-options "-fsanitize=undefined -fno-sanitize-recover=undefined" } */ + +#include <x86intrin.h> + +volatile unsigned int a; +volatile unsigned long long b; +volatile int c; + +int +main () +{ + a = 0x12345678U; + a = __rold (a, 0); + if (a != 0x12345678U) + __builtin_abort (); + a = __rold (a, 32); + if (a != 0x12345678U) + __builtin_abort (); + a = __rold (a, -32); + if (a != 0x12345678U) + __builtin_abort (); + a = __rold (a, 37); + if (a != 0x468acf02U) + __builtin_abort (); + a = __rold (a, -5); + if (a != 0x12345678U) + __builtin_abort (); + a = __rord (a, 0); + if (a != 0x12345678U) + __builtin_abort (); + a = __rord (a, 32); + if (a != 0x12345678U) + __builtin_abort (); + a = __rord (a, -32); + if (a != 0x12345678U) + __builtin_abort (); + a = __rord (a, -37); + if (a != 0x468acf02U) + __builtin_abort (); + a = __rord (a, 5); + if (a != 0x12345678U) + __builtin_abort (); + c = 0; + a = __rold (a, c); + if (a != 0x12345678U) + __builtin_abort (); + c = 32; + a = __rold (a, c); + if (a != 0x12345678U) + __builtin_abort (); + c = -32; + a = __rold (a, c); + if (a != 0x12345678U) + __builtin_abort (); + c = 37; + a = __rold (a, c); + if (a != 0x468acf02U) + __builtin_abort (); + c = -5; + a = __rold (a, c); + if (a != 0x12345678U) + __builtin_abort (); + c = 0; + a = __rord (a, c); + if (a != 0x12345678U) + __builtin_abort (); + c = 32; + a = __rord (a, c); + if (a != 0x12345678U) + __builtin_abort (); + c = -32; + a = __rord (a, c); + if (a != 0x12345678U) + __builtin_abort (); + c = -37; + a = __rord (a, c); + if (a != 0x468acf02U) + __builtin_abort (); + c = 5; + a = __rord (a, c); + if (a != 0x12345678U) + __builtin_abort (); +#ifdef __x86_64__ + b = 0x123456789abcdef1ULL; + b = __rolq (b, 0); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + b = __rolq (b, 64); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + b = __rolq (b, -64); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + b = __rolq (b, 69); + if (b != 0x468acf13579bde22ULL) + __builtin_abort (); + b = __rolq (b, -5); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + b = __rorq (b, 0); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + b = __rorq (b, 64); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + b = __rorq (b, -64); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + b = __rorq (b, -69); + if (b != 0x468acf13579bde22ULL) + __builtin_abort (); + b = __rorq (b, 5); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + c = 0; + b = __rolq (b, c); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + c = 64; + b = __rolq (b, c); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + c = -64; + b = __rolq (b, c); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + c = 69; + b = __rolq (b, c); + if (b != 0x468acf13579bde22ULL) + __builtin_abort (); + c = -5; + b = __rolq (b, c); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + c = 0; + b = __rorq (b, c); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + c = 64; + b = __rorq (b, c); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + c = -64; + b = __rorq (b, c); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); + c = -69; + b = __rorq (b, c); + if (b != 0x468acf13579bde22ULL) + __builtin_abort (); + c = 5; + b = __rorq (b, c); + if (b != 0x123456789abcdef1ULL) + __builtin_abort (); +#endif + return 0; +} diff --git a/gcc/testsuite/gcc.dg/vect/pr78558.c b/gcc/testsuite/gcc.dg/vect/pr78558.c new file mode 100644 index 00000000000..2606d4ec10d --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/pr78558.c @@ -0,0 +1,44 @@ +/* PR tree-optimization/78558 */ + +#include "tree-vect.h" + +struct S +{ + char p[48]; + unsigned long long q, r, s; +} s[50]; + +struct D +{ + unsigned long long q, r; +} d[50]; + +void +foo (void) +{ + unsigned long i; + for (i = 0; i < 50; ++i) + { + d[i].q = s[i].q; + d[i].r = s[i].r; + } +} + +int +main () +{ + check_vect (); + unsigned long i; + for (i = 0; i < 50; ++i) + { + s[i].q = i; + s[i].r = 50 * i; + } + asm volatile ("" : : "g" (s), "g" (d) : "memory"); + foo (); + asm volatile ("" : : "g" (s), "g" (d) : "memory"); + for (i = 0; i < 50; ++i) + if (d[i].q != i || d[i].r != 50 * i) + abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.target/aarch64/cmpelim_mult_uses_1.c b/gcc/testsuite/gcc.target/aarch64/cmpelim_mult_uses_1.c new file mode 100644 index 00000000000..953c388037f --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/cmpelim_mult_uses_1.c @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* { dg-options "-O2" } */ + +/* X is both compared against zero and used. Make sure we can still + generate an ADDS and avoid an explicit comparison against zero. */ + +int +foo (int x, int y) +{ + x += y; + if (x != 0) + x = x + 2; + return x; +} + +/* { dg-final { scan-assembler-times "adds\\tw\[0-9\]+, w\[0-9\]+, w\[0-9\]+" 1 } } */ +/* { dg-final { scan-assembler-not "cmp\\tw\[0-9\]+, 0" } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/pr81422.C b/gcc/testsuite/gcc.target/aarch64/pr81422.C new file mode 100644 index 00000000000..5bcc948996e --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/pr81422.C @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-options "-O0" } */ + +struct DArray +{ + __SIZE_TYPE__ length; + int* ptr; +}; + +void foo35(DArray) +{ + static __thread int x[5]; + foo35({5, (int*)&x}); +} + diff --git a/gcc/testsuite/gcc.target/i386/387-ficom-1.c b/gcc/testsuite/gcc.target/i386/387-ficom-1.c new file mode 100644 index 00000000000..8c73ddcb2da --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/387-ficom-1.c @@ -0,0 +1,41 @@ +/* { dg-do compile } */ +/* { dg-require-effective-target ia32 } */ +/* { dg-skip-if "" { *-*-* } { "-march=*" } { "-march=i386" } } */ +/* { dg-options "-O2 -march=i386 -ffast-math -masm=att" } */ + +extern short s; + +int test_f_s (short x) +{ + return (float)x > s; +} + +int test_d_s (short x) +{ + return (double)x < s; +} + +int test_ld_s (short x) +{ + return (long double)x == s; +} + +extern int i; + +int test_f_i (int x) +{ + return (float)i >= x; +} + +int test_d_i (int x) +{ + return (double)i <= x; +} + +int test_ld_i (int x) +{ + return (long double)i != x; +} + +/* { dg-final { scan-assembler-times "ficomps" 3 } } */ +/* { dg-final { scan-assembler-times "ficompl" 3 } } */ diff --git a/gcc/testsuite/gcc.target/i386/387-ficom-2.c b/gcc/testsuite/gcc.target/i386/387-ficom-2.c new file mode 100644 index 00000000000..4190ebaae71 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/387-ficom-2.c @@ -0,0 +1,9 @@ +/* { dg-do compile } */ +/* { dg-require-effective-target ia32 } */ +/* { dg-skip-if "" { *-*-* } { "-march=*" } { "-march=i386" } } */ +/* { dg-options "-Os -march=i386 -ffast-math -masm=att" } */ + +#include "387-ficom-1.c" + +/* { dg-final { scan-assembler-times "ficomps" 3 } } */ +/* { dg-final { scan-assembler-times "ficompl" 3 } } */ diff --git a/gcc/testsuite/gcc.target/i386/asm-mem.c b/gcc/testsuite/gcc.target/i386/asm-mem.c new file mode 100644 index 00000000000..89b713f0201 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/asm-mem.c @@ -0,0 +1,59 @@ +/* { dg-do run } */ +/* { dg-options "-O3" } */ + +/* Check that "m" array references are effective in preventing the + array initialization from wandering past a use in the asm, and + that the casts remain supported. */ + +static int +f1 (const char *p) +{ + int count; + + __asm__ ("repne scasb" + : "=c" (count), "+D" (p) + : "m" (*(const char (*)[]) p), "0" (-1), "a" (0)); + return -2 - count; +} + +static int +f2 (const char *p) +{ + int count; + + __asm__ ("repne scasb" + : "=c" (count), "+D" (p) + : "m" (*(const char (*)[48]) p), "0" (-1), "a" (0)); + return -2 - count; +} + +static int +f3 (int n, const char *p) +{ + int count; + + __asm__ ("repne scasb" + : "=c" (count), "+D" (p) + : "m" (*(const char (*)[n]) p), "0" (-1), "a" (0)); + return -2 - count; +} + +int +main () +{ + int a; + char buff[48] = "hello world"; + buff[4] = 0; + a = f1 (buff); + if (a != 4) + __builtin_abort (); + buff[4] = 'o'; + a = f2 (buff); + if (a != 11) + __builtin_abort (); + buff[4] = 0; + a = f3 (48, buff); + if (a != 4) + __builtin_abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.target/i386/pr82483-1.c b/gcc/testsuite/gcc.target/i386/pr82483-1.c new file mode 100644 index 00000000000..59a59dc8dfe --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr82483-1.c @@ -0,0 +1,44 @@ +/* PR target/82483 */ +/* { dg-do compile } */ +/* { dg-options "-mssse3 -mno-mmx -Wno-psabi" } */ +/* { dg-error "needs isa option" "" { target *-*-* } 0 } */ + +#include <x86intrin.h> + +void f1 (__m64 x, __m64 y, char *z) { _mm_maskmove_si64 (x, y, z); } +int f2 (__m64 x) { return _mm_extract_pi16 (x, 1); } +__m64 f3 (__m64 x, int y) { return _mm_insert_pi16 (x, y, 1); } +__m64 f4 (__m128 x) { return _mm_cvtps_pi32 (x); } +__m64 f5 (__m128 x) { return _mm_cvttps_pi32 (x); } +__m128 f6 (__m128 x, __m64 y) { return _mm_cvtpi32_ps (x, y); } +__m64 f7 (__m64 x, __m64 y) { return _mm_avg_pu8 (x, y); } +__m64 f8 (__m64 x, __m64 y) { return _mm_avg_pu16 (x, y); } +__m64 f9 (__m64 x, __m64 y) { return _mm_mulhi_pu16 (x, y); } +__m64 f10 (__m64 x, __m64 y) { return _mm_max_pu8 (x, y); } +__m64 f11 (__m64 x, __m64 y) { return _mm_max_pi16 (x, y); } +__m64 f12 (__m64 x, __m64 y) { return _mm_min_pu8 (x, y); } +__m64 f13 (__m64 x, __m64 y) { return _mm_min_pi16 (x, y); } +__m64 f14 (__m64 x, __m64 y) { return _mm_sad_pu8 (x, y); } +int f15 (__m64 x) { return _mm_movemask_pi8 (x); } +__m64 f16 (__m64 x) { return _mm_shuffle_pi16 (x, 1); } +__m64 f17 (__m128d x) { return _mm_cvtpd_pi32 (x); } +__m64 f18 (__m128d x) { return _mm_cvttpd_pi32 (x); } +__m128d f19 (__m64 x) { return _mm_cvtpi32_pd (x); } +__m64 f20 (__m64 x, __m64 y) { return _mm_mul_su32 (x, y); } +__m64 f21 (__m64 x) { return _mm_abs_pi8 (x); } +__m64 f22 (__m64 x) { return _mm_abs_pi16 (x); } +__m64 f23 (__m64 x) { return _mm_abs_pi32 (x); } +__m64 f24 (__m64 x, __m64 y) { return _mm_hadd_pi16 (x, y); } +__m64 f25 (__m64 x, __m64 y) { return _mm_hadd_pi32 (x, y); } +__m64 f26 (__m64 x, __m64 y) { return _mm_hadds_pi16 (x, y); } +__m64 f27 (__m64 x, __m64 y) { return _mm_hsub_pi16 (x, y); } +__m64 f28 (__m64 x, __m64 y) { return _mm_hsub_pi32 (x, y); } +__m64 f29 (__m64 x, __m64 y) { return _mm_hsubs_pi16 (x, y); } +__m64 f30 (__m64 x, __m64 y) { return _mm_maddubs_pi16 (x, y); } +__m64 f31 (__m64 x, __m64 y) { return _mm_mulhrs_pi16 (x, y); } +__m64 f32 (__m64 x, __m64 y) { return _mm_shuffle_pi8 (x, y); } +__m64 f33 (__m64 x, __m64 y) { return _mm_sign_pi8 (x, y); } +__m64 f34 (__m64 x, __m64 y) { return _mm_sign_pi16 (x, y); } +__m64 f35 (__m64 x, __m64 y) { return _mm_sign_pi32 (x, y); } +void f36 (__m64 *x, __m64 y) { _mm_stream_pi (x, y); } +__m64 f37 (__m64 x, __m64 y) { return _mm_alignr_pi8 (x, y, 3); } diff --git a/gcc/testsuite/gcc.target/i386/pr82483-2.c b/gcc/testsuite/gcc.target/i386/pr82483-2.c new file mode 100644 index 00000000000..305ddbd6c64 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr82483-2.c @@ -0,0 +1,9 @@ +/* PR target/82483 */ +/* { dg-do compile } */ +/* { dg-options "-mssse3 -mno-mmx -Wno-psabi" } */ +/* { dg-error "needs isa option" "" { target *-*-* } 0 } */ + +#include <x86intrin.h> + +__v1di f1 (__v1di x, __v1di y) { return __builtin_ia32_paddq (x, y); } +__v1di f2 (__v1di x, __v1di y) { return __builtin_ia32_psubq (x, y); } diff --git a/gcc/testsuite/gcc.target/i386/pr82498-1.c b/gcc/testsuite/gcc.target/i386/pr82498-1.c new file mode 100644 index 00000000000..78a6698f607 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr82498-1.c @@ -0,0 +1,52 @@ +/* PR target/82498 */ +/* { dg-do compile } */ +/* { dg-options "-O2 -mtune=generic -masm=att" } */ +/* { dg-final { scan-assembler-not {\mand[bwlq]\M} } } */ + +unsigned +f1 (unsigned x, unsigned char y) +{ + if (y == 0) + return x; + y &= __CHAR_BIT__ * __SIZEOF_INT__ - 1; + return (x << y) | (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - y)); +} + +unsigned +f2 (unsigned x, unsigned y) +{ + if (y == 0) + return x; + y &= __CHAR_BIT__ * __SIZEOF_INT__ - 1; + return (x << y) | (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - y)); +} + +unsigned +f3 (unsigned x, unsigned short y) +{ + if (y == 0) + return x; + y &= __CHAR_BIT__ * __SIZEOF_INT__ - 1; + return (x << y) | (x >> (__CHAR_BIT__ * __SIZEOF_INT__ - y)); +} + +unsigned +f4 (unsigned x, unsigned char y) +{ + y &= __CHAR_BIT__ * __SIZEOF_INT__ - 1; + return (x << y) | (x >> (-y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned +f5 (unsigned x, unsigned int y) +{ + y &= __CHAR_BIT__ * __SIZEOF_INT__ - 1; + return (x << y) | (x >> (-y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} + +unsigned +f6 (unsigned x, unsigned short y) +{ + y &= __CHAR_BIT__ * __SIZEOF_INT__ - 1; + return (x << y) | (x >> (-y & (__CHAR_BIT__ * __SIZEOF_INT__ - 1))); +} diff --git a/gcc/testsuite/gcc.target/i386/pr82498-2.c b/gcc/testsuite/gcc.target/i386/pr82498-2.c new file mode 100644 index 00000000000..9e065ee7e50 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr82498-2.c @@ -0,0 +1,46 @@ +/* PR target/82498 */ +/* { dg-do compile } */ +/* { dg-options "-O2 -mtune=generic -masm=att" } */ +/* { dg-final { scan-assembler-not {\mand[bwlq]\M} } } */ + +int +f1 (int x, unsigned char y) +{ + y &= __CHAR_BIT__ * __SIZEOF_INT__ - 1; + return x >> y; +} + +unsigned +f2 (unsigned x, unsigned char y) +{ + y &= __CHAR_BIT__ * __SIZEOF_INT__ - 1; + return x >> y; +} + +unsigned +f3 (unsigned x, unsigned char y) +{ + y &= __CHAR_BIT__ * __SIZEOF_INT__ - 1; + return x << y; +} + +unsigned +f4 (unsigned x, unsigned char y) +{ + y &= __CHAR_BIT__ * __SIZEOF_INT__ - 1; + return x | (1U << y); +} + +unsigned +f5 (unsigned x, unsigned char y) +{ + y &= __CHAR_BIT__ * __SIZEOF_INT__ - 1; + return x ^ (1U << y); +} + +unsigned +f6 (unsigned x, unsigned char y) +{ + y &= __CHAR_BIT__ * __SIZEOF_INT__ - 1; + return (x + 2) & ~(1U << y); +} diff --git a/gcc/testsuite/gcc.target/i386/pr82499-1.c b/gcc/testsuite/gcc.target/i386/pr82499-1.c new file mode 100644 index 00000000000..3aba62a466f --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr82499-1.c @@ -0,0 +1,21 @@ +/* { dg-do compile } */ +/* The pic register save adds unavoidable stack pointer references. */ +/* { dg-skip-if "" { ia32 && { ! nonpic } } } */ +/* These options are selected to ensure 1 word needs to be allocated + on the stack to maintain alignment for the call. This should be + transformed to push+pop. We also want to force unwind info updates. */ +/* { dg-options "-Os -fomit-frame-pointer -fasynchronous-unwind-tables" } */ +/* { dg-additional-options "-mpreferred-stack-boundary=3" { target ia32 } } */ +/* { dg-additional-options "-mpreferred-stack-boundary=4" { target { ! ia32 } } } */ +/* ms_abi has reserved stack-region. */ +/* { dg-skip-if "" { x86_64-*-mingw* } } */ + +extern void g (void); +int +f (void) +{ + g (); + return 42; +} + +/* { dg-final { scan-assembler-not "(sub|add)(l|q)\[\\t \]*\\$\[0-9\]*,\[\\t \]*%\[re\]?sp" } } */ diff --git a/gcc/testsuite/gcc.target/i386/pr82499-2.c b/gcc/testsuite/gcc.target/i386/pr82499-2.c new file mode 100644 index 00000000000..dde4d657e1a --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr82499-2.c @@ -0,0 +1,21 @@ +/* { dg-do compile } */ +/* The pic register save adds unavoidable stack pointer references. */ +/* { dg-skip-if "" { ia32 && { ! nonpic } } } */ +/* These options are selected to ensure 1 word needs to be allocated + on the stack to maintain alignment for the call. This should be + transformed to push+pop. We also want to force unwind info updates. */ +/* { dg-options "-Os -fomit-frame-pointer -fasynchronous-unwind-tables" } */ +/* { dg-additional-options "-mpreferred-stack-boundary=3" { target ia32 } } */ +/* { dg-additional-options "-mpreferred-stack-boundary=4 -mno-red-zone" { target { ! ia32 } } } */ +/* ms_abi has reserved stack-region. */ +/* { dg-skip-if "" { x86_64-*-mingw* } } */ + +extern void g (void); +int +f (void) +{ + g (); + return 42; +} + +/* { dg-final { scan-assembler-not "(sub|add)(l|q)\[\\t \]*\\$\[0-9\]*,\[\\t \]*%\[re\]?sp" } } */ diff --git a/gcc/testsuite/gcc.target/i386/pr82499-3.c b/gcc/testsuite/gcc.target/i386/pr82499-3.c new file mode 100644 index 00000000000..b55a860fcca --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr82499-3.c @@ -0,0 +1,21 @@ +/* { dg-do compile } */ +/* The pic register save adds unavoidable stack pointer references. */ +/* { dg-skip-if "" { ia32 && { ! nonpic } } } */ +/* These options are selected to ensure 1 word needs to be allocated + on the stack to maintain alignment for the call. This should be + transformed to push+pop. We also want to force unwind info updates. */ +/* { dg-options "-O2 -mtune-ctrl=single_push,single_pop -fomit-frame-pointer -fasynchronous-unwind-tables" } */ +/* { dg-additional-options "-mpreferred-stack-boundary=3" { target ia32 } } */ +/* { dg-additional-options "-mpreferred-stack-boundary=4" { target { ! ia32 } } } */ +/* ms_abi has reserved stack-region. */ +/* { dg-skip-if "" { x86_64-*-mingw* } } */ + +extern void g (void); +int +f (void) +{ + g (); + return 42; +} + +/* { dg-final { scan-assembler-not "(sub|add)(l|q)\[\\t \]*\\$\[0-9\]*,\[\\t \]*%\[re\]?sp" } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/amo1.c b/gcc/testsuite/gcc.target/powerpc/amo1.c new file mode 100644 index 00000000000..152f0e5874b --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/amo1.c @@ -0,0 +1,253 @@ +/* { dg-do compile { target { powerpc*-*-* && lp64 } } } */ +/* { dg-require-effective-target powerpc_p9vector_ok } */ +/* { dg-options "-mpower9-vector -mpower9-misc -O2" } */ + +/* Verify P9 atomic memory operations. */ + +#include <amo.h> +#include <stdint.h> + +uint32_t +do_lw_add (uint32_t *mem, uint32_t value) +{ + return amo_lwat_add (mem, value); +} + +int32_t +do_lw_sadd (int32_t *mem, int32_t value) +{ + return amo_lwat_sadd (mem, value); +} + +uint32_t +do_lw_xor (uint32_t *mem, uint32_t value) +{ + return amo_lwat_xor (mem, value); +} + +uint32_t +do_lw_ior (uint32_t *mem, uint32_t value) +{ + return amo_lwat_ior (mem, value); +} + +uint32_t +do_lw_and (uint32_t *mem, uint32_t value) +{ + return amo_lwat_and (mem, value); +} + +uint32_t +do_lw_umax (uint32_t *mem, uint32_t value) +{ + return amo_lwat_umax (mem, value); +} + +int32_t +do_lw_smax (int32_t *mem, int32_t value) +{ + return amo_lwat_smax (mem, value); +} + +uint32_t +do_lw_umin (uint32_t *mem, uint32_t value) +{ + return amo_lwat_umin (mem, value); +} + +int32_t +do_lw_smin (int32_t *mem, int32_t value) +{ + return amo_lwat_smin (mem, value); +} + +uint32_t +do_lw_swap (uint32_t *mem, uint32_t value) +{ + return amo_lwat_swap (mem, value); +} + +int32_t +do_lw_sswap (int32_t *mem, int32_t value) +{ + return amo_lwat_sswap (mem, value); +} + +uint64_t +do_ld_add (uint64_t *mem, uint64_t value) +{ + return amo_ldat_add (mem, value); +} + +int64_t +do_ld_sadd (int64_t *mem, int64_t value) +{ + return amo_ldat_sadd (mem, value); +} + +uint64_t +do_ld_xor (uint64_t *mem, uint64_t value) +{ + return amo_ldat_xor (mem, value); +} + +uint64_t +do_ld_ior (uint64_t *mem, uint64_t value) +{ + return amo_ldat_ior (mem, value); +} + +uint64_t +do_ld_and (uint64_t *mem, uint64_t value) +{ + return amo_ldat_and (mem, value); +} + +uint64_t +do_ld_umax (uint64_t *mem, uint64_t value) +{ + return amo_ldat_umax (mem, value); +} + +int64_t +do_ld_smax (int64_t *mem, int64_t value) +{ + return amo_ldat_smax (mem, value); +} + +uint64_t +do_ld_umin (uint64_t *mem, uint64_t value) +{ + return amo_ldat_umin (mem, value); +} + +int64_t +do_ld_smin (int64_t *mem, int64_t value) +{ + return amo_ldat_smin (mem, value); +} + +uint64_t +do_ld_swap (uint64_t *mem, uint64_t value) +{ + return amo_ldat_swap (mem, value); +} + +int64_t +do_ld_sswap (int64_t *mem, int64_t value) +{ + return amo_ldat_sswap (mem, value); +} + +void +do_sw_add (uint32_t *mem, uint32_t value) +{ + amo_stwat_add (mem, value); +} + +void +do_sw_sadd (int32_t *mem, int32_t value) +{ + amo_stwat_sadd (mem, value); +} + +void +do_sw_xor (uint32_t *mem, uint32_t value) +{ + amo_stwat_xor (mem, value); +} + +void +do_sw_ior (uint32_t *mem, uint32_t value) +{ + amo_stwat_ior (mem, value); +} + +void +do_sw_and (uint32_t *mem, uint32_t value) +{ + amo_stwat_and (mem, value); +} + +void +do_sw_umax (int32_t *mem, int32_t value) +{ + amo_stwat_umax (mem, value); +} + +void +do_sw_smax (int32_t *mem, int32_t value) +{ + amo_stwat_smax (mem, value); +} + +void +do_sw_umin (int32_t *mem, int32_t value) +{ + amo_stwat_umin (mem, value); +} + +void +do_sw_smin (int32_t *mem, int32_t value) +{ + amo_stwat_smin (mem, value); +} + +void +do_sd_add (uint64_t *mem, uint64_t value) +{ + amo_stdat_add (mem, value); +} + +void +do_sd_sadd (int64_t *mem, int64_t value) +{ + amo_stdat_sadd (mem, value); +} + +void +do_sd_xor (uint64_t *mem, uint64_t value) +{ + amo_stdat_xor (mem, value); +} + +void +do_sd_ior (uint64_t *mem, uint64_t value) +{ + amo_stdat_ior (mem, value); +} + +void +do_sd_and (uint64_t *mem, uint64_t value) +{ + amo_stdat_and (mem, value); +} + +void +do_sd_umax (int64_t *mem, int64_t value) +{ + amo_stdat_umax (mem, value); +} + +void +do_sd_smax (int64_t *mem, int64_t value) +{ + amo_stdat_smax (mem, value); +} + +void +do_sd_umin (int64_t *mem, int64_t value) +{ + amo_stdat_umin (mem, value); +} + +void +do_sd_smin (int64_t *mem, int64_t value) +{ + amo_stdat_smin (mem, value); +} + +/* { dg-final { scan-assembler-times {\mldat\M} 11 } } */ +/* { dg-final { scan-assembler-times {\mlwat\M} 11 } } */ +/* { dg-final { scan-assembler-times {\mstdat\M} 9 } } */ +/* { dg-final { scan-assembler-times {\mstwat\M} 9 } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/amo2.c b/gcc/testsuite/gcc.target/powerpc/amo2.c new file mode 100644 index 00000000000..cc7cfe4b450 --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/amo2.c @@ -0,0 +1,121 @@ +/* { dg-do run { target { powerpc*-*-linux* && { lp64 && p9vector_hw } } } } */ +/* { dg-require-effective-target powerpc_p9vector_ok } */ +/* { dg-options "-O2 -mpower9-vector -mpower9-misc" } */ + +#include <amo.h> +#include <stdint.h> +#include <stdlib.h> + +/* Test whether the ISA 3.0 amo (atomic memory operations) functions perform as + expected. */ + +/* 32-bit tests. */ +static uint32_t u32_ld[4] = { + 9, /* add */ + 7, /* xor */ + 6, /* ior */ + 7, /* and */ +}; + +static uint32_t u32_st[4] = { + 9, /* add */ + 7, /* xor */ + 6, /* ior */ + 7, /* and */ +}; + +static uint32_t u32_result[4]; + +static uint32_t u32_update[4] = { + 9 + 1, /* add */ + 7 ^ 1, /* xor */ + 6 | 1, /* ior */ + 7 & 1, /* and */ +}; + +static uint32_t u32_prev[4] = { + 9, /* add */ + 7, /* xor */ + 6, /* ior */ + 7, /* and */ +}; + +/* 64-bit tests. */ +static uint64_t u64_ld[4] = { + 9, /* add */ + 7, /* xor */ + 6, /* ior */ + 7, /* and */ +}; + +static uint64_t u64_st[4] = { + 9, /* add */ + 7, /* xor */ + 6, /* ior */ + 7, /* and */ +}; + +static uint64_t u64_result[4]; + +static uint64_t u64_update[4] = { + 9 + 1, /* add */ + 7 ^ 1, /* xor */ + 6 | 1, /* ior */ + 7 & 1, /* and */ +}; + +static uint64_t u64_prev[4] = { + 9, /* add */ + 7, /* xor */ + 6, /* ior */ + 7, /* and */ +}; + +int +main (void) +{ + size_t i; + + u32_result[0] = amo_lwat_add (&u32_ld[0], 1); + u32_result[1] = amo_lwat_xor (&u32_ld[1], 1); + u32_result[2] = amo_lwat_ior (&u32_ld[2], 1); + u32_result[3] = amo_lwat_and (&u32_ld[3], 1); + + u64_result[0] = amo_ldat_add (&u64_ld[0], 1); + u64_result[1] = amo_ldat_xor (&u64_ld[1], 1); + u64_result[2] = amo_ldat_ior (&u64_ld[2], 1); + u64_result[3] = amo_ldat_and (&u64_ld[3], 1); + + amo_stwat_add (&u32_st[0], 1); + amo_stwat_xor (&u32_st[1], 1); + amo_stwat_ior (&u32_st[2], 1); + amo_stwat_and (&u32_st[3], 1); + + amo_stdat_add (&u64_st[0], 1); + amo_stdat_xor (&u64_st[1], 1); + amo_stdat_ior (&u64_st[2], 1); + amo_stdat_and (&u64_st[3], 1); + + for (i = 0; i < 4; i++) + { + if (u32_result[i] != u32_prev[i]) + abort (); + + if (u32_ld[i] != u32_update[i]) + abort (); + + if (u32_st[i] != u32_update[i]) + abort (); + + if (u64_result[i] != u64_prev[i]) + abort (); + + if (u64_ld[i] != u64_update[i]) + abort (); + + if (u64_st[i] != u64_update[i]) + abort (); + } + + return 0; +} diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-char.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-char.c new file mode 100644 index 00000000000..3a1aa60cbff --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-char.c @@ -0,0 +1,86 @@ +/* Verify that overloaded built-ins for vec_cmp{eq,ge,gt,le,lt,ne} with + char inputs produce the right code. */ + +/* { dg-do compile } */ +/* { dg-require-effective-target powerpc_p8vector_ok } */ +/* { dg-options "-mpower8-vector -O2" } */ + +#include <altivec.h> + +vector bool char +test3_eq (vector signed char x, vector signed char y) +{ + return vec_cmpeq (x, y); +} + +vector bool char +test6_eq (vector unsigned char x, vector unsigned char y) +{ + return vec_cmpeq (x, y); +} + +vector bool char +test3_ge (vector signed char x, vector signed char y) +{ + return vec_cmpge (x, y); +} + +vector bool char +test6_ge (vector unsigned char x, vector unsigned char y) +{ + return vec_cmpge (x, y); +} + +vector bool char +test3_gt (vector signed char x, vector signed char y) +{ + return vec_cmpgt (x, y); +} + +vector bool char +test6_gt (vector unsigned char x, vector unsigned char y) +{ + return vec_cmpgt (x, y); +} + +vector bool char +test3_le (vector signed char x, vector signed char y) +{ + return vec_cmple (x, y); +} + +vector bool char +test6_le (vector unsigned char x, vector unsigned char y) +{ + return vec_cmple (x, y); +} + +vector bool char +test3_lt (vector signed char x, vector signed char y) +{ + return vec_cmplt (x, y); +} + +vector bool char +test6_lt (vector unsigned char x, vector unsigned char y) +{ + return vec_cmplt (x, y); +} + +vector bool char +test3_ne (vector signed char x, vector signed char y) +{ + return vec_cmpne (x, y); +} + +vector bool char +test6_ne (vector unsigned char x, vector unsigned char y) +{ + return vec_cmpne (x, y); +} + +/* { dg-final { scan-assembler-times "vcmpequb" 4 } } */ +/* { dg-final { scan-assembler-times "vcmpgtsb" 4 } } */ +/* { dg-final { scan-assembler-times "vcmpgtub" 4 } } */ +/* { dg-final { scan-assembler-times "xxlnor" 6 } } */ + diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-double.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-double.c new file mode 100644 index 00000000000..9d56862b2ea --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-double.c @@ -0,0 +1,51 @@ +/* Verify that overloaded built-ins for vec_cmp with + double inputs for VSX produce the right code. */ + +/* { dg-do compile } */ +/* { dg-require-effective-target powerpc_vsx_ok } */ +/* { dg-options "-mvsx -O2" } */ + +#include <altivec.h> + +vector bool long long +test2_eq (vector double x, vector double y) +{ + return vec_cmpeq (x, y); +} + +vector bool long long +test2_ge (vector double x, vector double y) +{ + return vec_cmpge (x, y); +} + +vector bool long long +test2_gt (vector double x, vector double y) +{ + return vec_cmpgt (x, y); +} + +vector bool long long +test2_le (vector double x, vector double y) +{ + return vec_cmple (x, y); +} + +vector bool long long +test2_lt (vector double x, vector double y) +{ + return vec_cmplt (x, y); +} + + vector bool long long +test2_ne (vector double x, vector double y) +{ + return vec_cmpne (x, y); +} + +/* { dg-final { scan-assembler-times "xvcmpeqdp" 2 } } */ +/* { dg-final { scan-assembler-times "xvcmpgtdp" 2 } } */ +/* { dg-final { scan-assembler-times "xvcmpnedp" 0 } } */ +/* { dg-final { scan-assembler-times "xvcmpgedp" 2 } } */ +/* { dg-final { scan-assembler-times "fcmpu" 0 } } */ + diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-float.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-float.c new file mode 100644 index 00000000000..b75250a7a3a --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-float.c @@ -0,0 +1,51 @@ +/* Verify that overloaded built-ins for vec_cmp with float + inputs for VSX produce the right code. */ + +/* { dg-do compile } */ +/* { dg-require-effective-target powerpc_vsx_ok } */ +/* { dg-options "-mvsx -O2" } */ + +#include <altivec.h> + +vector bool int +test1_eq (vector float x, vector float y) +{ + return vec_cmpeq (x, y); +} + +vector bool int +test1_ge (vector float x, vector float y) +{ + return vec_cmpge (x, y); +} + +vector bool int +test1_gt (vector float x, vector float y) +{ + return vec_cmpgt (x, y); +} + +vector bool int +test1_le (vector float x, vector float y) +{ + return vec_cmple (x, y); +} + +vector bool int +test1_lt (vector float x, vector float y) +{ + return vec_cmplt (x, y); +} + +vector bool int +test1_ne (vector float x, vector float y) +{ + return vec_cmpne (x, y); +} + +/* { dg-final { scan-assembler-times "xvcmpeqsp" 2 } } */ +/* { dg-final { scan-assembler-times "xvcmpgtsp" 2 } } */ +/* { dg-final { scan-assembler-times "xvcmpnesp" 0 } } */ +/* { dg-final { scan-assembler-times "xvcmpgesp" 2 } } */ +/* { dg-final { scan-assembler-times "fcmpu" 0 } } */ + diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-int.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-int.c new file mode 100644 index 00000000000..d53994d3ac8 --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-int.c @@ -0,0 +1,86 @@ +/* Verify that overloaded built-ins for vec_cmp with int + inputs produce the right code. */ + +/* { dg-do compile } */ +/* { dg-require-effective-target powerpc_p8vector_ok } */ +/* { dg-options "-mpower8-vector -O2" } */ + +#include <altivec.h> + +vector bool int +test3_eq (vector signed int x, vector signed int y) +{ + return vec_cmpeq (x, y); +} + +vector bool int +test6_eq (vector unsigned int x, vector unsigned int y) +{ + return vec_cmpeq (x, y); +} + +vector bool int +test3_ge (vector signed int x, vector signed int y) +{ + return vec_cmpge (x, y); +} + +vector bool int +test6_ge (vector unsigned int x, vector unsigned int y) +{ + return vec_cmpge (x, y); +} + +vector bool int +test3_gt (vector signed int x, vector signed int y) +{ + return vec_cmpgt (x, y); +} + +vector bool int +test6_gt (vector unsigned int x, vector unsigned int y) +{ + return vec_cmpgt (x, y); +} + +vector bool int +test3_le (vector signed int x, vector signed int y) +{ + return vec_cmple (x, y); +} + +vector bool int +test6_le (vector unsigned int x, vector unsigned int y) +{ + return vec_cmple (x, y); +} + +vector bool int +test3_lt (vector signed int x, vector signed int y) +{ + return vec_cmplt (x, y); +} + +vector bool int +test6_lt (vector unsigned int x, vector unsigned int y) +{ + return vec_cmplt (x, y); +} + +vector bool int +test3_ne (vector signed int x, vector signed int y) +{ + return vec_cmpne (x, y); +} + +vector bool int +test6_ne (vector unsigned int x, vector unsigned int y) +{ + return vec_cmpne (x, y); +} + +/* { dg-final { scan-assembler-times "vcmpequw" 4 } } */ +/* { dg-final { scan-assembler-times "vcmpgtsw" 4 } } */ +/* { dg-final { scan-assembler-times "vcmpgtuw" 4 } } */ +/* { dg-final { scan-assembler-times "xxlnor" 6 } } */ + diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-longlong.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-longlong.c new file mode 100644 index 00000000000..536ee75a854 --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-longlong.c @@ -0,0 +1,86 @@ +/* Verify that overloaded built-ins for vec_cmp with long long + inputs produce the right code. */ + +/* { dg-do compile } */ +/* { dg-require-effective-target powerpc_p8vector_ok } */ +/* { dg-options "-mpower8-vector -O2" } */ + +#include <altivec.h> + +vector bool long long +test3_eq (vector signed long long x, vector signed long long y) +{ + return vec_cmpeq (x, y); +} + +vector bool long long +test6_eq (vector unsigned long long x, vector unsigned long long y) +{ + return vec_cmpeq (x, y); +} + +vector bool long long +test3_ge (vector signed long long x, vector signed long long y) +{ + return vec_cmpge (x, y); +} + +vector bool long long +test6_ge (vector unsigned long long x, vector unsigned long long y) +{ + return vec_cmpge (x, y); +} + +vector bool long long +test3_gt (vector signed long long x, vector signed long long y) +{ + return vec_cmpgt (x, y); +} + +vector bool long long +test6_gt (vector unsigned long long x, vector unsigned long long y) +{ + return vec_cmpgt (x, y); +} + +vector bool long long +test3_le (vector signed long long x, vector signed long long y) +{ + return vec_cmple (x, y); +} + +vector bool long long +test6_le (vector unsigned long long x, vector unsigned long long y) +{ + return vec_cmple (x, y); +} + +vector bool long long +test3_lt (vector signed long long x, vector signed long long y) +{ + return vec_cmplt (x, y); +} + +vector bool long long +test6_lt (vector unsigned long long x, vector unsigned long long y) +{ + return vec_cmplt (x, y); +} + +vector bool long long +test3_ne (vector signed long long x, vector signed long long y) +{ + return vec_cmpne (x, y); +} + +vector bool long long +test6_ne (vector unsigned long long x, vector unsigned long long y) +{ + return vec_cmpne (x, y); +} + +/* { dg-final { scan-assembler-times "vcmpequd" 4 } } */ +/* { dg-final { scan-assembler-times "vcmpgtsd" 4 } } */ +/* { dg-final { scan-assembler-times "vcmpgtud" 4 } } */ +/* { dg-final { scan-assembler-times "xxlnor" 6 } } */ + diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-short.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-short.c new file mode 100644 index 00000000000..60676691efe --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-cmp-short.c @@ -0,0 +1,87 @@ +/* Verify that overloaded built-ins for vec_cmp with short + inputs produce the right code. */ + +/* { dg-do compile } */ +/* { dg-require-effective-target powerpc_p8vector_ok } */ +/* { dg-options "-mpower8-vector -O2" } */ + +#include <altivec.h> + +vector bool short +test3_eq (vector signed short x, vector signed short y) +{ + return vec_cmpeq (x, y); +} + +vector bool short +test6_eq (vector unsigned short x, vector unsigned short y) +{ + return vec_cmpeq (x, y); +} + +vector bool short +test3_ge (vector signed short x, vector signed short y) +{ + return vec_cmpge (x, y); +} + +vector bool short +test6_ge (vector unsigned short x, vector unsigned short y) +{ + return vec_cmpge (x, y); +} + +vector bool short +test3_gt (vector signed short x, vector signed short y) +{ + return vec_cmpgt (x, y); +} + +vector bool short +test6_gt (vector unsigned short x, vector unsigned short y) +{ + return vec_cmpgt (x, y); +} + + +vector bool short +test3_le (vector signed short x, vector signed short y) +{ + return vec_cmple (x, y); +} + +vector bool short +test6_le (vector unsigned short x, vector unsigned short y) +{ + return vec_cmple (x, y); +} + +vector bool short +test3_lt (vector signed short x, vector signed short y) +{ + return vec_cmplt (x, y); +} + +vector bool short +test6_lt (vector unsigned short x, vector unsigned short y) +{ + return vec_cmplt (x, y); +} + +vector bool short +test3_ne (vector signed short x, vector signed short y) +{ + return vec_cmpne (x, y); +} + +vector bool short +test6_ne (vector unsigned short x, vector unsigned short y) +{ + return vec_cmpne (x, y); +} + +/* { dg-final { scan-assembler-times "vcmpequh" 4 } } */ +/* { dg-final { scan-assembler-times "vcmpgtsh" 4 } } */ +/* { dg-final { scan-assembler-times "vcmpgtuh" 4 } } */ +/* { dg-final { scan-assembler-times "xxlnor" 6 } } */ + diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-mult-int128-p8.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-mult-int128-p8.c index 97d6b945f43..b1cf0a78628 100644 --- a/gcc/testsuite/gcc.target/powerpc/fold-vec-mult-int128-p8.c +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-mult-int128-p8.c @@ -5,7 +5,8 @@ /* { dg-require-effective-target powerpc_p8vector_ok } */ /* { dg-require-effective-target int128 } */ /* { dg-require-effective-target lp64 } */ -/* { dg-options "-mpower8-vector" } */ +/* { dg-skip-if "do not override -mcpu" { powerpc*-*-* } { "-mcpu=*" } { "-mcpu=power8" } } */ +/* { dg-options "-mpower8-vector -mcpu=power8 -O2" } */ /* { dg-additional-options "-maix64" { target powerpc-ibm-aix* } } */ #include "altivec.h" @@ -22,5 +23,5 @@ test2 (vector unsigned __int128 x, vector unsigned __int128 y) return vec_mul (x, y); } -/* { dg-final { scan-assembler-times "\[ \t\]mulld " 6 } } */ -/* { dg-final { scan-assembler-times "\[ \t\]mulhdu" 2 } } */ +/* { dg-final { scan-assembler-times {\mmulld\M} 6 } } */ +/* { dg-final { scan-assembler-times {\mmulhdu\M} 2 } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-mult-int128-p9.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-mult-int128-p9.c index e81ea5f3134..657188435d4 100644 --- a/gcc/testsuite/gcc.target/powerpc/fold-vec-mult-int128-p9.c +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-mult-int128-p9.c @@ -2,10 +2,10 @@ inputs produce the right results. */ /* { dg-do compile } */ -/* { dg-require-effective-target powerpc_float128_hw_ok } */ +/* { dg-require-effective-target powerpc_p9vector_ok } */ /* { dg-require-effective-target int128 } */ /* { dg-skip-if "do not override -mcpu" { powerpc*-*-* } { "-mcpu=*" } { "-mcpu=power9" } } */ -/* { dg-options "-mcpu=power9 -O2" } */ +/* { dg-options "-mpower9-vector -mcpu=power9 -O2" } */ /* { dg-additional-options "-maix64" { target powerpc-ibm-aix* } } */ #include "altivec.h" @@ -22,4 +22,5 @@ test2 (vector unsigned __int128 x, vector unsigned __int128 y) return vec_mul (x, y); } -/* { dg-final { scan-assembler-times "\[ \t\]xsmulqp" 2 } } */ +/* { dg-final { scan-assembler-times {\mmulld\M} 4 } } */ +/* { dg-final { scan-assembler-times {\mmulhdu\M} 2 } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-splat-16.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-splat-16.c new file mode 100644 index 00000000000..bb4a8d2fa55 --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-splat-16.c @@ -0,0 +1,46 @@ +/* Verify that overloaded built-ins for vec_splat with int + inputs produce the right code. */ + +/* { dg-do compile } */ +/* { dg-require-effective-target powerpc_vsx_ok } */ +/* { dg-options "-mvsx -O2" } */ + +#include <altivec.h> + +vector signed short +testss_1 () +{ + return vec_splat_s16 (5); +} + +vector signed short +testss_2 () +{ + return vec_splat_s16 (-5); +} + +vector signed short +testss_3 () +{ + return vec_splat_s16 (15); +} + +vector unsigned short +testus_1 () +{ + return vec_splat_u16 (5); +} + +vector unsigned short +testus_2 () +{ + return vec_splat_u16 (-5); +} + +vector unsigned short +testus_3 () +{ + return vec_splat_u16 (15); +} + +/* { dg-final { scan-assembler-times "vspltish" 6 } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-splat-32.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-splat-32.c new file mode 100644 index 00000000000..f59849edf3e --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-splat-32.c @@ -0,0 +1,46 @@ +/* Verify that overloaded built-ins for vec_splat with int + inputs produce the right code. */ + +/* { dg-do compile } */ +/* { dg-require-effective-target powerpc_altivec_ok } */ +/* { dg-options "-maltivec -O2" } */ + +#include <altivec.h> + +vector signed int +testsi_1 () +{ + return vec_splat_s32 (5); +} + +vector signed int +testsi_2 () +{ + return vec_splat_s32 (-5); +} + +vector signed int +testsi_3 () +{ + return vec_splat_s32 (15); +} + +vector unsigned int +testui_1 () +{ + return vec_splat_u32 (5); +} + +vector unsigned int +testui_2 () +{ + return vec_splat_u32 (-5); +} + +vector unsigned int +testui_3 () +{ + return vec_splat_u32 (15); +} + +/* { dg-final { scan-assembler-times "vspltisw" 6 } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-splat-8.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-splat-8.c new file mode 100644 index 00000000000..679fcb3bc5b --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-splat-8.c @@ -0,0 +1,46 @@ +/* Verify that overloaded built-ins for vec_splat with int + inputs produce the right code. */ + +/* { dg-do compile } */ +/* { dg-require-effective-target powerpc_altivec_ok } */ +/* { dg-options "-maltivec -O2" } */ + +#include <altivec.h> + +vector signed char +testsc_1 () +{ + return vec_splat_s8 (5); +} + +vector signed char +testsc_2 () +{ + return vec_splat_s8 (-5); +} + +vector signed char +testsc_3 () +{ + return vec_splat_s8 (15); +} + +vector unsigned char +testuc_1 () +{ + return vec_splat_u8 (5); +} + +vector unsigned char +testuc_2 () +{ + return vec_splat_u8 (-5); +} + +vector unsigned char +testuc_3 () +{ + return vec_splat_u8 (15); +} + +/* { dg-final { scan-assembler-times "vspltisb" 6 } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-char.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-char.c new file mode 100644 index 00000000000..8f211537d28 --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-char.c @@ -0,0 +1,22 @@ +/* Verify that overloaded built-ins for vec_splats() with char + inputs produce the right code. */ + +/* { dg-do compile } */ +/* { dg-require-effective-target powerpc_altivec_ok } */ +/* { dg-options "-maltivec -O2 " } */ + +#include <altivec.h> + +vector signed char +test1s (signed char x) +{ + return vec_splats (x); +} + +vector unsigned char +test1u (unsigned char x) +{ + return vec_splats (x); +} + +/* { dg-final { scan-assembler-times "vspltb" 2 } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-floatdouble.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-floatdouble.c new file mode 100644 index 00000000000..c4544f1a452 --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-floatdouble.c @@ -0,0 +1,27 @@ +/* Verify that overloaded built-ins for vec_splat with float and + double inputs for VSX produce the right code. */ + +/* { dg-do compile } */ +/* { dg-require-effective-target powerpc_vsx_ok } */ +/* { dg-options "-mvsx -O1" } */ + +#include <altivec.h> + +vector float +test1d (float x) +{ + return vec_splats (x); +} + +vector double +test1f (double x) +{ + return vec_splats (x); +} + +// float test generates the permute instruction. +/* { dg-final { scan-assembler-times "xxpermdi" 1 } } */ + +// double test generates a convert (double to single non-signalling) followed by a splat. +/* { dg-final { scan-assembler-times {\mxscvdpspn?\M} 1 } } */ +/* { dg-final { scan-assembler-times {\mvspltw\M|\mxxspltw\M} 1 } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-int.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-int.c new file mode 100644 index 00000000000..66715233bc7 --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-int.c @@ -0,0 +1,22 @@ +/* Verify that overloaded built-ins for vec_splat with int + inputs produce the right code. */ + +/* { dg-do compile { target { powerpc*-*-linux* && lp64 } } } */ +/* { dg-require-effective-target powerpc_altivec_ok } */ +/* { dg-options "-maltivec -O2 " } */ + +#include <altivec.h> + +vector signed int +test3s (signed int x) +{ + return vec_splats (x); +} + +vector unsigned int +test3u (unsigned int x) +{ + return vec_splats (x); +} + +/* { dg-final { scan-assembler-times {\mvspltw\M|\mxxspltw\M} 2 } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-longlong.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-longlong.c new file mode 100644 index 00000000000..c5884ba88f4 --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-longlong.c @@ -0,0 +1,22 @@ +/* Verify that overloaded built-ins for vec_splat with long long + inputs produce the right code. */ + +/* { dg-do compile { target { powerpc*-*-linux* && lp64 } } } */ +/* { dg-require-effective-target powerpc_vsx_ok } */ +/* { dg-options "-mvsx -O2" } */ + +#include <altivec.h> + +vector signed long long +test3s (signed long long x) +{ + return vec_splats (x); +} + +vector unsigned long long +test3u (unsigned long long x) +{ + return vec_splats (x); +} + +/* { dg-final { scan-assembler-times "xxpermdi" 2 } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-short.c b/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-short.c new file mode 100644 index 00000000000..18102ac1254 --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/fold-vec-splats-short.c @@ -0,0 +1,23 @@ +/* Verify that overloaded built-ins for vec_splat with short + inputs produce the right code. */ + +/* { dg-do compile } */ +/* { dg-require-effective-target powerpc_altivec_ok } */ +/* { dg-options "-maltivec -O2" } */ + +#include <altivec.h> + +vector signed short +test3s (signed short x) +{ + return vec_splats (x); +} + +vector unsigned short +test3u (unsigned short x) +{ + return vec_splats (x); +} + +/* { dg-final { scan-assembler-times "vsplth" 2 } } */ + diff --git a/gcc/testsuite/gcc.target/s390/zvector/pr82463.c b/gcc/testsuite/gcc.target/s390/zvector/pr82463.c new file mode 100644 index 00000000000..5014ed61ad9 --- /dev/null +++ b/gcc/testsuite/gcc.target/s390/zvector/pr82463.c @@ -0,0 +1,14 @@ +/* { dg-do compile { target { s390*-*-* } } } */ +/* { dg-options "-march=z14 -mzarch -mzvector" } */ + +/* The builtin was not correctly defined in the vecintrin.h header + file. */ + +#include <vecintrin.h> + +typedef __vector float v4sf; + +v4sf +foo (v4sf a, v4sf b, v4sf c) { + return vec_madd(a, b, c); +} diff --git a/gcc/testsuite/gcc.target/s390/zvector/pr82465.c b/gcc/testsuite/gcc.target/s390/zvector/pr82465.c new file mode 100644 index 00000000000..ae8f8ad93ff --- /dev/null +++ b/gcc/testsuite/gcc.target/s390/zvector/pr82465.c @@ -0,0 +1,16 @@ +/* { dg-do compile { target { s390*-*-* } } } */ +/* { dg-options "-march=z13 -mzarch -mzvector" } */ + +/* The vector double variant is available with z13. A wrong flag in + the s390-builtins.def file triggered an error when compiling for + z13. */ + +typedef __vector double v2df; + +#include <vecintrin.h> + +v2df +foo (v2df a) +{ + return vec_sqrt(a); +} diff --git a/gcc/testsuite/gfortran.dg/derived_init_4.f90 b/gcc/testsuite/gfortran.dg/derived_init_4.f90 new file mode 100644 index 00000000000..114975150aa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/derived_init_4.f90 @@ -0,0 +1,60 @@ +! { dg-do run } +! +! Test the fix for PR81048, where in the second call to 'g2' the +! default initialization was "forgotten". 'g1', 'g1a' and 'g3' check +! that this does not occur for scalars and explicit results. +! +! Contributed by David Smith <dm577216smith@gmail.com> +! +program test + type f + integer :: f = -1 + end type + type(f) :: a, b(3) + type(f), allocatable :: ans + b = g2(a) + b = g2(a) + ans = g1(a) + if (ans%f .ne. -1) call abort + ans = g1(a) + if (ans%f .ne. -1) call abort + ans = g1a(a) + if (ans%f .ne. -1) call abort + ans = g1a(a) + if (ans%f .ne. -1) call abort + b = g3(a) + b = g3(a) +contains + function g3(a) result(res) + type(f) :: a, res(3) + do j = 1, 3 + if (res(j)%f == -1) then + res(j)%f = a%f - 1 + else + call abort + endif + enddo + end function g3 + + function g2(a) + type(f) :: a, g2(3) + do j = 1, 3 + if (g2(j)%f == -1) then + g2(j)%f = a%f - 1 + else + call abort + endif + enddo + end function g2 + + function g1(a) + type(f) :: g1, a + if (g1%f .ne. -1 ) call abort + end function + + function g1a(a) result(res) + type(f) :: res, a + if (res%f .ne. -1 ) call abort + end function +end program test + diff --git a/gcc/testsuite/gfortran.dg/execute_command_line_3.f90 b/gcc/testsuite/gfortran.dg/execute_command_line_3.f90 new file mode 100644 index 00000000000..87d73d1b50f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/execute_command_line_3.f90 @@ -0,0 +1,24 @@ +! { dg-do run } +! PR 82233 - there were program aborts for some of these commands. +! Original test case by Urban Jost. +program boom +implicit none +integer :: i,j +character(len=256) :: msg +character(len=:), allocatable :: command + command='notthere' + msg='' ! seems to only be defined if exitstatus.ne.0 + ! ok -- these work + call execute_command_line(command , wait=.false., exitstat=i, cmdstat=j, cmdmsg=msg) + if (j /= 0 .or. msg /= '') call abort + call execute_command_line(command , exitstat=i, cmdstat=j, cmdmsg=msg ) + if (j /= 3 .or. msg /= "Invalid command line" ) call abort + msg = '' + call execute_command_line(command , wait=.false., exitstat=i, cmdmsg=msg ) + print *,msg + if (msg /= '') call abort + call execute_command_line(command , exitstat=i, cmdstat=j ) + if (j /= 3) call abort + call execute_command_line(command , wait=.false., exitstat=i ) + +end program boom diff --git a/gcc/testsuite/gfortran.dg/graphite/id-27.f90 b/gcc/testsuite/gfortran.dg/graphite/id-27.f90 new file mode 100644 index 00000000000..e1e7ec0951f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-27.f90 @@ -0,0 +1,40 @@ +! { dg-additional-options "-Ofast" } +MODULE module_ra_gfdleta + INTEGER, PARAMETER :: NBLY=15 + REAL , SAVE :: EM1(28,180),EM1WDE(28,180),TABLE1(28,180), & + TABLE2(28,180),TABLE3(28,180),EM3(28,180), & + SOURCE(28,NBLY), DSRCE(28,NBLY) +CONTAINS + SUBROUTINE TABLE + INTEGER, PARAMETER :: NBLX=47 + INTEGER , PARAMETER:: NBLW = 163 + REAL :: & + SUM(28,180),PERTSM(28,180),SUM3(28,180), & + SUMWDE(28,180),SRCWD(28,NBLX),SRC1NB(28,NBLW), & + DBDTNB(28,NBLW) + REAL :: & + ZMASS(181),ZROOT(181),SC(28),DSC(28),XTEMV(28), & + TFOUR(28),FORTCU(28),X(28),X1(28),X2(180),SRCS(28), & + R1T(28),R2(28),S2(28),T3(28),R1WD(28) + REAL :: EXPO(180),FAC(180) + I = 0 + DO 417 J=121,180 + FAC(J)=ZMASS(J)*(ONE-(ONE+X2(J))*EXPO(J))/(X2(J)*X2(J)) +417 CONTINUE + DO 421 J=121,180 + SUM3(I,J)=SUM3(I,J)+DBDTNB(I,N)*FAC(J) +421 CONTINUE + IF (CENT.GT.160. .AND. CENT.LT.560.) THEN + DO 420 J=1,180 + DO 420 I=1,28 + SUMWDE(I,J)=SUMWDE(I,J)+SRC1NB(I,N)*EXPO(J) +420 CONTINUE + ENDIF + DO 433 J=121,180 + EM3(I,J)=SUM3(I,J)/FORTCU(I) +433 CONTINUE + DO 501 I=1,28 + EM1WDE(I,J)=SUMWDE(I,J)/TFOUR(I) +501 CONTINUE + END SUBROUTINE TABLE + END MODULE module_RA_GFDLETA diff --git a/gcc/testsuite/gfortran.dg/graphite/id-28.f90 b/gcc/testsuite/gfortran.dg/graphite/id-28.f90 new file mode 100644 index 00000000000..d66cb12006e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-28.f90 @@ -0,0 +1,15 @@ +! Verify we elide modulo operations we cannot represent +module OPMATRIX_MODULE + implicit none + type opmatrix_type + real(kind=kind(1.0d0)), dimension(:,:), pointer :: restricted + end type + interface zero_ + module procedure zero + end interface +contains + subroutine zero(self) + type(opmatrix_type) :: self + self%restricted = 0.0d0 + end subroutine +end diff --git a/gcc/testsuite/gfortran.dg/graphite/pr82449.f b/gcc/testsuite/gfortran.dg/graphite/pr82449.f new file mode 100644 index 00000000000..974ea206d41 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr82449.f @@ -0,0 +1,11 @@ +! { dg-do compile } +! { dg-options "-O2 -floop-nest-optimize" } + + SUBROUTINE JDFIDX(MKL,KGSH) + DIMENSION MKL(6,6) + NKL=0 + 400 DO 40 KG = 1,KGSH + DO 40 LG = 1,KG + NKL = NKL + 1 + 40 MKL(LG,KG) = NKL + END diff --git a/gcc/testsuite/gfortran.dg/graphite/pr82451.f b/gcc/testsuite/gfortran.dg/graphite/pr82451.f new file mode 100644 index 00000000000..88ff85b1a99 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr82451.f @@ -0,0 +1,39 @@ +! { dg-do compile } +! { dg-options "-O2 -floop-nest-optimize" } + MODULE LES3D_DATA + PARAMETER ( NSCHEME = 4, ICHEM = 0, ISGSK = 0, IVISC = 1 ) + DOUBLE PRECISION DT, TIME, STATTIME, CFL, RELNO, TSTND, ALREF + INTEGER IDYN, IMAX, JMAX, KMAX + PARAMETER( RUNIV = 8.3145D3, + > TPRANDLT = 0.91D0) + DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:,:) :: + > U, V, W, P, T, H, EK, + > UAV, VAV, WAV, PAV, TAV, HAV, EKAV + DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:,:,:) :: + > CONC, HF, QAV, COAV, HFAV, DU + DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:,:,:,:) :: + > Q + END MODULE LES3D_DATA + SUBROUTINE FLUXJ() + USE LES3D_DATA + ALLOCATABLE QS(:), FSJ(:,:,:) + ALLOCATABLE DWDX(:),DWDY(:),DWDZ(:) + ALLOCATABLE DHDY(:), DKDY(:) + PARAMETER ( R12I = 1.0D0 / 12.0D0, + > TWO3 = 2.0D0 / 3.0D0 ) + ALLOCATE( QS(IMAX-1), FSJ(IMAX-1,0:JMAX-1,ND)) + ALLOCATE( DWDX(IMAX-1),DWDY(IMAX-1),DWDZ(IMAX-1)) + I1 = 1 + DO K = K1,K2 + DO J = J1,J2 + DO I = I1, I2 + FSJ(I,J,5) = FSJ(I,J,5) + PAV(I,J,K) * QS(I) + END DO + DO I = I1, I2 + DWDX(I) = DXI * R12I * (WAV(I-2,J,K) - WAV(I+2,J,K) + + > 8.0D0 * (WAV(I+1,J,K) - WAV(I-1,J,K))) + END DO + END DO + END DO + DEALLOCATE( QS, FSJ, DHDY, DKDY) + END diff --git a/gcc/testsuite/gfortran.dg/illegal_char.f90 b/gcc/testsuite/gfortran.dg/illegal_char.f90 new file mode 100644 index 00000000000..597c7b98ddd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/illegal_char.f90 @@ -0,0 +1,6 @@ +! { dg-do compile } +! PR 82372 - show hexcode of illegal, non-printable characters +program main + tmp =È 1.0 ! { dg-error "Invalid character 0xC8" } + print *,tmp +end diff --git a/gcc/testsuite/gnat.dg/class_wide3.adb b/gcc/testsuite/gnat.dg/class_wide3.adb new file mode 100644 index 00000000000..c177029f29d --- /dev/null +++ b/gcc/testsuite/gnat.dg/class_wide3.adb @@ -0,0 +1,8 @@ +with Ada.Text_IO; use Ada.Text_IO; +with Class_Wide3_Pkg; use Class_Wide3_Pkg; + +procedure Class_Wide3 is + DC : Disc_Child := (N => 1, I => 3, J => 5); +begin + DC.Put_Line; +end Class_Wide3; diff --git a/gcc/testsuite/gnat.dg/class_wide3_pkg.ads b/gcc/testsuite/gnat.dg/class_wide3_pkg.ads new file mode 100644 index 00000000000..a4104fcdebe --- /dev/null +++ b/gcc/testsuite/gnat.dg/class_wide3_pkg.ads @@ -0,0 +1,16 @@ +package Class_Wide3_Pkg is + + type Iface is interface; + type Iface_Ptr is access all Iface'Class; + + procedure Put_Line (I : Iface'Class); + + type Root is tagged record + I : Integer; + end record; + + type Disc_Child (N : Integer) is new Root and Iface with record + J : Integer; + end record; + +end Class_Wide3_Pkg; diff --git a/gcc/testsuite/gnat.dg/class_wide4.adb b/gcc/testsuite/gnat.dg/class_wide4.adb new file mode 100644 index 00000000000..f44d641d1e4 --- /dev/null +++ b/gcc/testsuite/gnat.dg/class_wide4.adb @@ -0,0 +1,20 @@ +-- { dg-do run } + +with Class_Wide4_Pkg; +with Class_Wide4_Pkg2; + +procedure Class_Wide4 is + D : aliased Class_Wide4_Pkg.Data_Object; + O : aliased Class_Wide4_Pkg2.Object; + IA : not null access Class_Wide4_Pkg.Conditional_Interface'Class := + O'Access; + I : Class_Wide4_Pkg.Conditional_Interface'Class renames + Class_Wide4_Pkg.Conditional_Interface'Class (O); +begin + O.Do_Stuff; + O.Do_Stuff_Access; + IA.Do_Stuff; + IA.Do_Stuff_Access; + I.Do_Stuff; + I.Do_Stuff_Access; +end Class_Wide4; diff --git a/gcc/testsuite/gnat.dg/class_wide4_pkg.ads b/gcc/testsuite/gnat.dg/class_wide4_pkg.ads new file mode 100644 index 00000000000..b8ba44c1380 --- /dev/null +++ b/gcc/testsuite/gnat.dg/class_wide4_pkg.ads @@ -0,0 +1,21 @@ +package Class_Wide4_Pkg is + + type Conditional_Interface is limited interface; + + type Data_Object is tagged null record; + + function Is_Valid + (This : in Conditional_Interface) + return Boolean is abstract; + + procedure Do_Stuff + (This : in out Conditional_Interface) is abstract + with + Pre'Class => This.Is_Valid; + + procedure Do_Stuff_Access + (This : not null access Conditional_Interface) is abstract + with + Pre'Class => This.Is_Valid; + +end Class_Wide4_Pkg; diff --git a/gcc/testsuite/gnat.dg/class_wide4_pkg2.ads b/gcc/testsuite/gnat.dg/class_wide4_pkg2.ads new file mode 100644 index 00000000000..1e5799d2597 --- /dev/null +++ b/gcc/testsuite/gnat.dg/class_wide4_pkg2.ads @@ -0,0 +1,30 @@ +with Class_Wide4_Pkg; + +package Class_Wide4_Pkg2 is + + type Object is limited new + Class_Wide4_Pkg.Conditional_Interface with + record + Val : Integer := 1234; + end record; + + function Is_Valid + (This : in Object) + return Boolean + is + (This.Val = 1234); + + function Is_Supported_Data + (This : in Object; + Data : not null access Class_Wide4_Pkg.Data_Object'Class) + return Boolean + is + (This.Val = 1234); + + procedure Do_Stuff + (This : in out Object) is null; + + procedure Do_Stuff_Access + (This : not null access Object) is null; + +end Class_Wide4_Pkg2; diff --git a/gcc/testsuite/gnat.dg/remote_call_iface.adb b/gcc/testsuite/gnat.dg/remote_call_iface.adb new file mode 100644 index 00000000000..6816ad95a65 --- /dev/null +++ b/gcc/testsuite/gnat.dg/remote_call_iface.adb @@ -0,0 +1,7 @@ +-- { dg-do compile } + +package body Remote_Call_Iface is + procedure Proc is begin null; end; +begin + Proc; +end Remote_Call_Iface; diff --git a/gcc/testsuite/gnat.dg/remote_call_iface.ads b/gcc/testsuite/gnat.dg/remote_call_iface.ads new file mode 100644 index 00000000000..ce12fef88ca --- /dev/null +++ b/gcc/testsuite/gnat.dg/remote_call_iface.ads @@ -0,0 +1,5 @@ +generic +package Remote_Call_Iface is + pragma Remote_Call_Interface; + procedure Proc; +end Remote_Call_Iface; diff --git a/gcc/testsuite/gnat.dg/validity_check2.adb b/gcc/testsuite/gnat.dg/validity_check2.adb new file mode 100644 index 00000000000..f349cf16036 --- /dev/null +++ b/gcc/testsuite/gnat.dg/validity_check2.adb @@ -0,0 +1,11 @@ +-- { dg-do compile } +-- { dg-options "-gnatVi -gnatws" } + +with Validity_Check2_Pkg; use Validity_Check2_Pkg; + +procedure Validity_Check2 (R : access Rec) is +begin + if Op_Code_To_Msg (R.Code) in Valid_Msg then + raise Program_Error; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/validity_check2_pkg.ads b/gcc/testsuite/gnat.dg/validity_check2_pkg.ads new file mode 100644 index 00000000000..c9b6a01e191 --- /dev/null +++ b/gcc/testsuite/gnat.dg/validity_check2_pkg.ads @@ -0,0 +1,16 @@ +with Ada.unchecked_conversion; + +package Validity_Check2_Pkg is + + type Op_Code is (One, Two, Three, Four); + + subtype Valid_Msg is Integer range 0 .. 15; + + function Op_Code_To_Msg is + new Ada.Unchecked_Conversion (Source => Op_code, Target => Valid_Msg); + + type Rec is record + Code : Op_Code; + end record; + +end Validity_Check2_Pkg; diff --git a/gcc/testsuite/lib/target-supports.exp b/gcc/testsuite/lib/target-supports.exp index f7e1128b128..dc07fe9e9b7 100644 --- a/gcc/testsuite/lib/target-supports.exp +++ b/gcc/testsuite/lib/target-supports.exp @@ -440,8 +440,8 @@ proc check_ifunc_available { } { extern "C" { #endif typedef void F (void); - F* g() {} - void f() __attribute__((ifunc("g"))); + F* g (void) {} + void f () __attribute__ ((ifunc ("g"))); #ifdef __cplusplus } #endif diff --git a/gcc/testsuite/obj-c++.dg/exceptions-6.mm b/gcc/testsuite/obj-c++.dg/exceptions-6.mm index 58882fed8b7..6f6ba783ea7 100644 --- a/gcc/testsuite/obj-c++.dg/exceptions-6.mm +++ b/gcc/testsuite/obj-c++.dg/exceptions-6.mm @@ -11,15 +11,15 @@ void test (id object) @throw object; /* Ok */ @throw; /* { dg-error ".@throw. .rethrow. used outside of a @catch block" } */ @throw (object); /* Ok. */ - @throw (id)0 -} /* { dg-error "expected" } */ + @throw (id)0 /* { dg-error "expected" } */ +} void test2 (id object) { @throw object); /* { dg-error "expected" } */ @throw (...); /* { dg-error "expected" } */ @throw (); /* { dg-error "expected" } */ - @throw + @throw /* { dg-error "expected" } */ } /* { dg-error "expected" } */ void test3 (id object1, id object2) diff --git a/gcc/testsuite/obj-c++.dg/pr48187.mm b/gcc/testsuite/obj-c++.dg/pr48187.mm index 750710b1f24..99677a56244 100644 --- a/gcc/testsuite/obj-c++.dg/pr48187.mm +++ b/gcc/testsuite/obj-c++.dg/pr48187.mm @@ -1,19 +1,19 @@ /* { dg-do compile } */ @interface A -{ +{ /* { dg-error "xpected" } */ ] /* { dg-error "xpected" } */ } @end @interface B -{ +{ /* { dg-error "xpected" } */ ]; /* { dg-error "xpected" } */ } @end @interface C -{ +{ /* { dg-error "xpected" } */ ]; /* { dg-error "xpected" } */ int x; } @@ -21,7 +21,7 @@ @interface D { - ( + ( /* { dg-error "xpected" } */ } /* { dg-error "xpected" } */ @end diff --git a/gcc/testsuite/objc.dg/exceptions-6.m b/gcc/testsuite/objc.dg/exceptions-6.m index 58882fed8b7..74be98d39fa 100644 --- a/gcc/testsuite/objc.dg/exceptions-6.m +++ b/gcc/testsuite/objc.dg/exceptions-6.m @@ -11,8 +11,8 @@ void test (id object) @throw object; /* Ok */ @throw; /* { dg-error ".@throw. .rethrow. used outside of a @catch block" } */ @throw (object); /* Ok. */ - @throw (id)0 -} /* { dg-error "expected" } */ + @throw (id)0 /* { dg-error "expected" } */ +} void test2 (id object) { diff --git a/gcc/tree-affine.c b/gcc/tree-affine.c index f7a5f121c9c..47f56bf2b54 100644 --- a/gcc/tree-affine.c +++ b/gcc/tree-affine.c @@ -408,8 +408,8 @@ tree_to_aff_combination (tree expr, tree type, aff_tree *comb) && get_range_info (op0, &minv, &maxv) == VR_RANGE) { if (icode == PLUS_EXPR) - op1 = wide_int_to_tree (itype, wi::neg (op1)); - if (wi::geu_p (minv, op1)) + op1 = wide_int_to_tree (itype, -wi::to_wide (op1)); + if (wi::geu_p (minv, wi::to_wide (op1))) { op0 = fold_convert (otype, op0); op1 = fold_convert (otype, op1); diff --git a/gcc/tree-cfg.c b/gcc/tree-cfg.c index 99d1f1e1af8..b5e0460c84a 100644 --- a/gcc/tree-cfg.c +++ b/gcc/tree-cfg.c @@ -1721,12 +1721,12 @@ group_case_labels_stmt (gswitch *stmt) { tree merge_case = gimple_switch_label (stmt, next_index); basic_block merge_bb = label_to_block (CASE_LABEL (merge_case)); - wide_int bhp1 = wi::add (base_high, 1); + wide_int bhp1 = wi::to_wide (base_high) + 1; /* Merge the cases if they jump to the same place, and their ranges are consecutive. */ if (merge_bb == base_bb - && wi::eq_p (CASE_LOW (merge_case), bhp1)) + && wi::to_wide (CASE_LOW (merge_case)) == bhp1) { base_high = CASE_HIGH (merge_case) ? CASE_HIGH (merge_case) : CASE_LOW (merge_case); diff --git a/gcc/tree-cfgcleanup.c b/gcc/tree-cfgcleanup.c index a7053d748c6..1a71c93aeed 100644 --- a/gcc/tree-cfgcleanup.c +++ b/gcc/tree-cfgcleanup.c @@ -892,7 +892,11 @@ cleanup_tree_cfg_noloop (void) changed |= cleanup_tree_cfg_1 (); gcc_assert (dom_info_available_p (CDI_DOMINATORS)); - compact_blocks (); + + /* Do not renumber blocks if the SCEV cache is active, it is indexed by + basic-block numbers. */ + if (! scev_initialized_p ()) + compact_blocks (); checking_verify_flow_info (); diff --git a/gcc/tree-chrec.c b/gcc/tree-chrec.c index 66d3a7bd370..beddf108104 100644 --- a/gcc/tree-chrec.c +++ b/gcc/tree-chrec.c @@ -872,8 +872,7 @@ reset_evolution_in_loop (unsigned loop_num, new_evol); tree right = reset_evolution_in_loop (loop_num, CHREC_RIGHT (chrec), new_evol); - return build3 (POLYNOMIAL_CHREC, TREE_TYPE (left), - CHREC_VAR (chrec), left, right); + return build_polynomial_chrec (CHREC_VARIABLE (chrec), left, right); } while (TREE_CODE (chrec) == POLYNOMIAL_CHREC @@ -1610,6 +1609,9 @@ operator_is_linear (tree scev) bool scev_is_linear_expression (tree scev) { + if (evolution_function_is_constant_p (scev)) + return true; + if (scev == NULL || !operator_is_linear (scev)) return false; diff --git a/gcc/tree-chrec.h b/gcc/tree-chrec.h index e980ec17452..4838bae89aa 100644 --- a/gcc/tree-chrec.h +++ b/gcc/tree-chrec.h @@ -157,8 +157,9 @@ build_polynomial_chrec (unsigned loop_num, if (chrec_zerop (right)) return left; - return build3 (POLYNOMIAL_CHREC, TREE_TYPE (left), - build_int_cst (NULL_TREE, loop_num), left, right); + tree chrec = build2 (POLYNOMIAL_CHREC, TREE_TYPE (left), left, right); + CHREC_VARIABLE (chrec) = loop_num; + return chrec; } /* Determines whether the expression CHREC is a constant. */ @@ -169,15 +170,9 @@ evolution_function_is_constant_p (const_tree chrec) if (chrec == NULL_TREE) return false; - switch (TREE_CODE (chrec)) - { - case INTEGER_CST: - case REAL_CST: - return true; - - default: - return false; - } + if (CONSTANT_CLASS_P (chrec)) + return true; + return is_gimple_min_invariant (chrec); } /* Determine whether CHREC is an affine evolution function in LOOPNUM. */ diff --git a/gcc/tree-core.h b/gcc/tree-core.h index a083ab7065f..a4bbcdf5a8f 100644 --- a/gcc/tree-core.h +++ b/gcc/tree-core.h @@ -1004,6 +1004,9 @@ struct GTY(()) tree_base { /* SSA version number. This field is only used with SSA_NAME. */ unsigned int version; + /* CHREC_VARIABLE. This field is only used with POLYNOMIAL_CHREC. */ + unsigned int chrec_var; + /* Internal function code. */ enum internal_fn ifn; @@ -2078,7 +2081,7 @@ struct floatn_type_info { Global variables ---------------------------------------------------------------------------*/ /* Matrix describing the structures contained in a given tree code. */ -extern unsigned char tree_contains_struct[MAX_TREE_CODES][64]; +extern bool tree_contains_struct[MAX_TREE_CODES][64]; /* Class of tree given its code. */ extern const enum tree_code_class tree_code_type[]; diff --git a/gcc/tree-data-ref.c b/gcc/tree-data-ref.c index a414fbfe0f2..559a8e4b845 100644 --- a/gcc/tree-data-ref.c +++ b/gcc/tree-data-ref.c @@ -957,15 +957,14 @@ access_fn_component_p (tree op) } /* Determines the base object and the list of indices of memory reference - DR, analyzed in LOOP and instantiated in loop nest NEST. */ + DR, analyzed in LOOP and instantiated before NEST. */ static void -dr_analyze_indices (struct data_reference *dr, loop_p nest, loop_p loop) +dr_analyze_indices (struct data_reference *dr, edge nest, loop_p loop) { vec<tree> access_fns = vNULL; tree ref, op; tree base, off, access_fn; - basic_block before_loop; /* If analyzing a basic-block there are no indices to analyze and thus no access functions. */ @@ -977,7 +976,6 @@ dr_analyze_indices (struct data_reference *dr, loop_p nest, loop_p loop) } ref = DR_REF (dr); - before_loop = block_before_loop (nest); /* REALPART_EXPR and IMAGPART_EXPR can be handled like accesses into a two element array with a constant index. The base is @@ -1002,7 +1000,7 @@ dr_analyze_indices (struct data_reference *dr, loop_p nest, loop_p loop) { op = TREE_OPERAND (ref, 1); access_fn = analyze_scalar_evolution (loop, op); - access_fn = instantiate_scev (before_loop, loop, access_fn); + access_fn = instantiate_scev (nest, loop, access_fn); access_fns.safe_push (access_fn); } else if (TREE_CODE (ref) == COMPONENT_REF @@ -1034,7 +1032,7 @@ dr_analyze_indices (struct data_reference *dr, loop_p nest, loop_p loop) { op = TREE_OPERAND (ref, 0); access_fn = analyze_scalar_evolution (loop, op); - access_fn = instantiate_scev (before_loop, loop, access_fn); + access_fn = instantiate_scev (nest, loop, access_fn); if (TREE_CODE (access_fn) == POLYNOMIAL_CHREC) { tree orig_type; @@ -1060,12 +1058,15 @@ dr_analyze_indices (struct data_reference *dr, loop_p nest, loop_p loop) if (TYPE_SIZE_UNIT (TREE_TYPE (ref)) && TREE_CODE (TYPE_SIZE_UNIT (TREE_TYPE (ref))) == INTEGER_CST && !integer_zerop (TYPE_SIZE_UNIT (TREE_TYPE (ref)))) - rem = wi::mod_trunc (off, TYPE_SIZE_UNIT (TREE_TYPE (ref)), SIGNED); + rem = wi::mod_trunc + (wi::to_wide (off), + wi::to_wide (TYPE_SIZE_UNIT (TREE_TYPE (ref))), + SIGNED); else /* If we can't compute the remainder simply force the initial condition to zero. */ - rem = off; - off = wide_int_to_tree (ssizetype, wi::sub (off, rem)); + rem = wi::to_wide (off); + off = wide_int_to_tree (ssizetype, wi::to_wide (off) - rem); memoff = wide_int_to_tree (TREE_TYPE (memoff), rem); /* And finally replace the initial condition. */ access_fn = chrec_replace_initial_condition @@ -1136,7 +1137,7 @@ free_data_ref (data_reference_p dr) in which the data reference should be analyzed. */ struct data_reference * -create_data_ref (loop_p nest, loop_p loop, tree memref, gimple *stmt, +create_data_ref (edge nest, loop_p loop, tree memref, gimple *stmt, bool is_read, bool is_conditional_in_stmt) { struct data_reference *dr; @@ -1207,35 +1208,28 @@ data_ref_compare_tree (tree t1, tree t2) if (t2 == NULL) return 1; - STRIP_NOPS (t1); - STRIP_NOPS (t2); + STRIP_USELESS_TYPE_CONVERSION (t1); + STRIP_USELESS_TYPE_CONVERSION (t2); + if (t1 == t2) + return 0; - if (TREE_CODE (t1) != TREE_CODE (t2)) + if (TREE_CODE (t1) != TREE_CODE (t2) + && ! (CONVERT_EXPR_P (t1) && CONVERT_EXPR_P (t2))) return TREE_CODE (t1) < TREE_CODE (t2) ? -1 : 1; code = TREE_CODE (t1); switch (code) { - /* For const values, we can just use hash values for comparisons. */ case INTEGER_CST: - case REAL_CST: - case FIXED_CST: + return tree_int_cst_compare (t1, t2); + case STRING_CST: - case COMPLEX_CST: - case VECTOR_CST: - { - hashval_t h1 = iterative_hash_expr (t1, 0); - hashval_t h2 = iterative_hash_expr (t2, 0); - if (h1 != h2) - return h1 < h2 ? -1 : 1; - break; - } + if (TREE_STRING_LENGTH (t1) != TREE_STRING_LENGTH (t2)) + return TREE_STRING_LENGTH (t1) < TREE_STRING_LENGTH (t2) ? -1 : 1; + return memcmp (TREE_STRING_POINTER (t1), TREE_STRING_POINTER (t2), + TREE_STRING_LENGTH (t1)); case SSA_NAME: - cmp = data_ref_compare_tree (SSA_NAME_VAR (t1), SSA_NAME_VAR (t2)); - if (cmp != 0) - return cmp; - if (SSA_NAME_VERSION (t1) != SSA_NAME_VERSION (t2)) return SSA_NAME_VERSION (t1) < SSA_NAME_VERSION (t2) ? -1 : 1; break; @@ -1243,22 +1237,26 @@ data_ref_compare_tree (tree t1, tree t2) default: tclass = TREE_CODE_CLASS (code); - /* For var-decl, we could compare their UIDs. */ + /* For decls, compare their UIDs. */ if (tclass == tcc_declaration) { if (DECL_UID (t1) != DECL_UID (t2)) return DECL_UID (t1) < DECL_UID (t2) ? -1 : 1; break; } - - /* For expressions with operands, compare their operands recursively. */ - for (i = TREE_OPERAND_LENGTH (t1) - 1; i >= 0; --i) + /* For expressions, compare their operands recursively. */ + else if (IS_EXPR_CODE_CLASS (tclass)) { - cmp = data_ref_compare_tree (TREE_OPERAND (t1, i), - TREE_OPERAND (t2, i)); - if (cmp != 0) - return cmp; + for (i = TREE_OPERAND_LENGTH (t1) - 1; i >= 0; --i) + { + cmp = data_ref_compare_tree (TREE_OPERAND (t1, i), + TREE_OPERAND (t2, i)); + if (cmp != 0) + return cmp; + } } + else + gcc_unreachable (); } return 0; @@ -1488,14 +1486,16 @@ prune_runtime_alias_test_list (vec<dr_with_seg_len_pair_t> *alias_pairs, std::swap (*dr_a1, *dr_a2); bool do_remove = false; - wide_int diff = wi::sub (DR_INIT (dr_a2->dr), DR_INIT (dr_a1->dr)); + wide_int diff = (wi::to_wide (DR_INIT (dr_a2->dr)) + - wi::to_wide (DR_INIT (dr_a1->dr))); wide_int min_seg_len_b; tree new_seg_len; if (TREE_CODE (dr_b1->seg_len) == INTEGER_CST) - min_seg_len_b = wi::abs (dr_b1->seg_len); + min_seg_len_b = wi::abs (wi::to_wide (dr_b1->seg_len)); else - min_seg_len_b = wi::mul (factor, wi::abs (DR_STEP (dr_b1->dr))); + min_seg_len_b + = factor * wi::abs (wi::to_wide (DR_STEP (dr_b1->dr))); /* Now we try to merge alias check dr_a1 & dr_b and dr_a2 & dr_b. @@ -1534,7 +1534,7 @@ prune_runtime_alias_test_list (vec<dr_with_seg_len_pair_t> *alias_pairs, /* Adjust diff according to access size of both references. */ tree size_a1 = TYPE_SIZE_UNIT (TREE_TYPE (DR_REF (dr_a1->dr))); tree size_a2 = TYPE_SIZE_UNIT (TREE_TYPE (DR_REF (dr_a2->dr))); - diff = wi::add (diff, wi::sub (size_a2, size_a1)); + diff += wi::to_wide (size_a2) - wi::to_wide (size_a1); /* Case A.1. */ if (wi::leu_p (diff, min_seg_len_b) /* Case A.2 and B combined. */ @@ -1542,11 +1542,12 @@ prune_runtime_alias_test_list (vec<dr_with_seg_len_pair_t> *alias_pairs, { if (tree_fits_uhwi_p (dr_a1->seg_len) && tree_fits_uhwi_p (dr_a2->seg_len)) - new_seg_len - = wide_int_to_tree (sizetype, - wi::umin (wi::sub (dr_a1->seg_len, - diff), - dr_a2->seg_len)); + { + wide_int min_len + = wi::umin (wi::to_wide (dr_a1->seg_len) - diff, + wi::to_wide (dr_a2->seg_len)); + new_seg_len = wide_int_to_tree (sizetype, min_len); + } else new_seg_len = size_binop (MINUS_EXPR, dr_a2->seg_len, @@ -1565,11 +1566,12 @@ prune_runtime_alias_test_list (vec<dr_with_seg_len_pair_t> *alias_pairs, { if (tree_fits_uhwi_p (dr_a1->seg_len) && tree_fits_uhwi_p (dr_a2->seg_len)) - new_seg_len - = wide_int_to_tree (sizetype, - wi::umax (wi::add (dr_a2->seg_len, - diff), - dr_a1->seg_len)); + { + wide_int max_len + = wi::umax (wi::to_wide (dr_a2->seg_len) + diff, + wi::to_wide (dr_a1->seg_len)); + new_seg_len = wide_int_to_tree (sizetype, max_len); + } else new_seg_len = size_binop (PLUS_EXPR, dr_a2->seg_len, @@ -4966,7 +4968,8 @@ find_data_references_in_stmt (struct loop *nest, gimple *stmt, FOR_EACH_VEC_ELT (references, i, ref) { - dr = create_data_ref (nest, loop_containing_stmt (stmt), ref->ref, + dr = create_data_ref (nest ? loop_preheader_edge (nest) : NULL, + loop_containing_stmt (stmt), ref->ref, stmt, ref->is_read, ref->is_conditional_in_stmt); gcc_assert (dr != NULL); datarefs->safe_push (dr); @@ -4982,7 +4985,7 @@ find_data_references_in_stmt (struct loop *nest, gimple *stmt, should be analyzed. */ bool -graphite_find_data_references_in_stmt (loop_p nest, loop_p loop, gimple *stmt, +graphite_find_data_references_in_stmt (edge nest, loop_p loop, gimple *stmt, vec<data_reference_p> *datarefs) { unsigned i; diff --git a/gcc/tree-data-ref.h b/gcc/tree-data-ref.h index a66d335f4a0..d9d297ad970 100644 --- a/gcc/tree-data-ref.h +++ b/gcc/tree-data-ref.h @@ -436,11 +436,11 @@ extern void free_data_ref (data_reference_p); extern void free_data_refs (vec<data_reference_p> ); extern bool find_data_references_in_stmt (struct loop *, gimple *, vec<data_reference_p> *); -extern bool graphite_find_data_references_in_stmt (loop_p, loop_p, gimple *, +extern bool graphite_find_data_references_in_stmt (edge, loop_p, gimple *, vec<data_reference_p> *); tree find_data_references_in_loop (struct loop *, vec<data_reference_p> *); bool loop_nest_has_data_refs (loop_p loop); -struct data_reference *create_data_ref (loop_p, loop_p, tree, gimple *, bool, +struct data_reference *create_data_ref (edge, loop_p, tree, gimple *, bool, bool); extern bool find_loop_nest (struct loop *, vec<loop_p> *); extern struct data_dependence_relation *initialize_data_dependence_relation diff --git a/gcc/tree-dump.c b/gcc/tree-dump.c index f2bdf074d96..e5b362cf94c 100644 --- a/gcc/tree-dump.c +++ b/gcc/tree-dump.c @@ -543,7 +543,7 @@ dequeue_and_dump (dump_info_p di) case INTEGER_CST: fprintf (di->stream, "int: "); - print_decs (t, di->stream); + print_decs (wi::to_wide (t), di->stream); break; case STRING_CST: diff --git a/gcc/tree-inline.c b/gcc/tree-inline.c index a226096504f..c764a44db61 100644 --- a/gcc/tree-inline.c +++ b/gcc/tree-inline.c @@ -949,7 +949,7 @@ remap_gimple_op_r (tree *tp, int *walk_subtrees, void *data) *walk_subtrees = 0; else if (TREE_CODE (*tp) == INTEGER_CST) - *tp = wide_int_to_tree (new_type, *tp); + *tp = wide_int_to_tree (new_type, wi::to_wide (*tp)); else { *tp = copy_node (*tp); @@ -1133,7 +1133,7 @@ copy_tree_body_r (tree *tp, int *walk_subtrees, void *data) *walk_subtrees = 0; else if (TREE_CODE (*tp) == INTEGER_CST) - *tp = wide_int_to_tree (new_type, *tp); + *tp = wide_int_to_tree (new_type, wi::to_wide (*tp)); else { *tp = copy_node (*tp); diff --git a/gcc/tree-loop-distribution.c b/gcc/tree-loop-distribution.c index 26b8b9a3751..5e835be779d 100644 --- a/gcc/tree-loop-distribution.c +++ b/gcc/tree-loop-distribution.c @@ -83,8 +83,8 @@ along with GCC; see the file COPYING3. If not see loops and recover to the original one. TODO: - 1) We only distribute innermost loops now. This pass should handle loop - nests in the future. + 1) We only distribute innermost two-level loop nest now. We should + extend it for arbitrary loop nests in the future. 2) We only fuse partitions in SCC now. A better fusion algorithm is desired to minimize loop overhead, maximize parallelism and maximize data reuse. */ @@ -118,6 +118,11 @@ along with GCC; see the file COPYING3. If not see #define MAX_DATAREFS_NUM \ ((unsigned) PARAM_VALUE (PARAM_LOOP_MAX_DATAREFS_FOR_DATADEPS)) +/* Threshold controlling number of distributed partitions. Given it may + be unnecessary if a memory stream cost model is invented in the future, + we define it as a temporary macro, rather than a parameter. */ +#define NUM_PARTITION_THRESHOLD (4) + /* Hashtable helpers. */ struct ddr_hasher : nofree_ptr_hash <struct data_dependence_relation> @@ -588,27 +593,32 @@ enum partition_type { PTYPE_SEQUENTIAL }; +/* Builtin info for loop distribution. */ +struct builtin_info +{ + /* data-references a kind != PKIND_NORMAL partition is about. */ + data_reference_p dst_dr; + data_reference_p src_dr; + /* Base address and size of memory objects operated by the builtin. Note + both dest and source memory objects must have the same size. */ + tree dst_base; + tree src_base; + tree size; +}; + /* Partition for loop distribution. */ struct partition { /* Statements of the partition. */ bitmap stmts; - /* Loops of the partition. */ - bitmap loops; /* True if the partition defines variable which is used outside of loop. */ bool reduction_p; - /* For builtin partition, true if it executes one iteration more than - number of loop (latch) iterations. */ - bool plus_one; enum partition_kind kind; enum partition_type type; - /* data-references a kind != PKIND_NORMAL partition is about. */ - data_reference_p main_dr; - data_reference_p secondary_dr; - /* Number of loop (latch) iterations. */ - tree niter; /* Data references in the partition. */ bitmap datarefs; + /* Information of builtin parition. */ + struct builtin_info *builtin; }; @@ -619,7 +629,6 @@ partition_alloc (void) { partition *partition = XCNEW (struct partition); partition->stmts = BITMAP_ALLOC (NULL); - partition->loops = BITMAP_ALLOC (NULL); partition->reduction_p = false; partition->kind = PKIND_NORMAL; partition->datarefs = BITMAP_ALLOC (NULL); @@ -632,8 +641,10 @@ static void partition_free (partition *partition) { BITMAP_FREE (partition->stmts); - BITMAP_FREE (partition->loops); BITMAP_FREE (partition->datarefs); + if (partition->builtin) + free (partition->builtin); + free (partition); } @@ -718,9 +729,11 @@ ssa_name_has_uses_outside_loop_p (tree def, loop_p loop) FOR_EACH_IMM_USE_FAST (use_p, imm_iter, def) { - gimple *use_stmt = USE_STMT (use_p); - if (!is_gimple_debug (use_stmt) - && loop != loop_containing_stmt (use_stmt)) + if (is_gimple_debug (USE_STMT (use_p))) + continue; + + basic_block use_bb = gimple_bb (USE_STMT (use_p)); + if (!flow_bb_inside_loop_p (loop, use_bb)) return true; } @@ -834,6 +847,10 @@ generate_loops_for_partition (struct loop *loop, partition *partition, for (i = 0; i < loop->num_nodes; i++) { basic_block bb = bbs[i]; + edge inner_exit = NULL; + + if (loop != bb->loop_father) + inner_exit = single_exit (bb->loop_father); for (gphi_iterator bsi = gsi_start_phis (bb); !gsi_end_p (bsi);) { @@ -852,11 +869,17 @@ generate_loops_for_partition (struct loop *loop, partition *partition, && !is_gimple_debug (stmt) && !bitmap_bit_p (partition->stmts, gimple_uid (stmt))) { - /* Choose an arbitrary path through the empty CFG part - that this unnecessary control stmt controls. */ + /* In distribution of loop nest, if bb is inner loop's exit_bb, + we choose its exit edge/path in order to avoid generating + infinite loop. For all other cases, we choose an arbitrary + path through the empty CFG part that this unnecessary + control stmt controls. */ if (gcond *cond_stmt = dyn_cast <gcond *> (stmt)) { - gimple_cond_make_false (cond_stmt); + if (inner_exit && inner_exit->flags & EDGE_TRUE_VALUE) + gimple_cond_make_true (cond_stmt); + else + gimple_cond_make_false (cond_stmt); update_stmt (stmt); } else if (gimple_code (stmt) == GIMPLE_SWITCH) @@ -881,43 +904,6 @@ generate_loops_for_partition (struct loop *loop, partition *partition, free (bbs); } -/* Build the size argument for a memory operation call. */ - -static tree -build_size_arg_loc (location_t loc, data_reference_p dr, tree nb_iter, - bool plus_one) -{ - tree size = fold_convert_loc (loc, sizetype, nb_iter); - if (plus_one) - size = size_binop (PLUS_EXPR, size, size_one_node); - size = fold_build2_loc (loc, MULT_EXPR, sizetype, size, - TYPE_SIZE_UNIT (TREE_TYPE (DR_REF (dr)))); - size = fold_convert_loc (loc, size_type_node, size); - return size; -} - -/* Build an address argument for a memory operation call. */ - -static tree -build_addr_arg_loc (location_t loc, data_reference_p dr, tree nb_bytes) -{ - tree addr_base; - - addr_base = size_binop_loc (loc, PLUS_EXPR, DR_OFFSET (dr), DR_INIT (dr)); - addr_base = fold_convert_loc (loc, sizetype, addr_base); - - /* Test for a negative stride, iterating over every element. */ - if (tree_int_cst_sgn (DR_STEP (dr)) == -1) - { - addr_base = size_binop_loc (loc, MINUS_EXPR, addr_base, - fold_convert_loc (loc, sizetype, nb_bytes)); - addr_base = size_binop_loc (loc, PLUS_EXPR, addr_base, - TYPE_SIZE_UNIT (TREE_TYPE (DR_REF (dr)))); - } - - return fold_build_pointer_plus_loc (loc, DR_BASE_ADDRESS (dr), addr_base); -} - /* If VAL memory representation contains the same value in all bytes, return that value, otherwise return -1. E.g. for 0x24242424 return 0x24, for IEEE double @@ -982,27 +968,23 @@ static void generate_memset_builtin (struct loop *loop, partition *partition) { gimple_stmt_iterator gsi; - gimple *stmt, *fn_call; tree mem, fn, nb_bytes; - location_t loc; tree val; - - stmt = DR_STMT (partition->main_dr); - loc = gimple_location (stmt); + struct builtin_info *builtin = partition->builtin; + gimple *fn_call; /* The new statements will be placed before LOOP. */ gsi = gsi_last_bb (loop_preheader_edge (loop)->src); - nb_bytes = build_size_arg_loc (loc, partition->main_dr, partition->niter, - partition->plus_one); + nb_bytes = builtin->size; nb_bytes = force_gimple_operand_gsi (&gsi, nb_bytes, true, NULL_TREE, false, GSI_CONTINUE_LINKING); - mem = build_addr_arg_loc (loc, partition->main_dr, nb_bytes); + mem = builtin->dst_base; mem = force_gimple_operand_gsi (&gsi, mem, true, NULL_TREE, false, GSI_CONTINUE_LINKING); /* This exactly matches the pattern recognition in classify_partition. */ - val = gimple_assign_rhs1 (stmt); + val = gimple_assign_rhs1 (DR_STMT (builtin->dst_dr)); /* Handle constants like 0x15151515 and similarly floating point constants etc. where all bytes are the same. */ int bytev = const_with_all_bytes_same (val); @@ -1038,23 +1020,19 @@ static void generate_memcpy_builtin (struct loop *loop, partition *partition) { gimple_stmt_iterator gsi; - gimple *stmt, *fn_call; + gimple *fn_call; tree dest, src, fn, nb_bytes; - location_t loc; enum built_in_function kind; - - stmt = DR_STMT (partition->main_dr); - loc = gimple_location (stmt); + struct builtin_info *builtin = partition->builtin; /* The new statements will be placed before LOOP. */ gsi = gsi_last_bb (loop_preheader_edge (loop)->src); - nb_bytes = build_size_arg_loc (loc, partition->main_dr, partition->niter, - partition->plus_one); + nb_bytes = builtin->size; nb_bytes = force_gimple_operand_gsi (&gsi, nb_bytes, true, NULL_TREE, false, GSI_CONTINUE_LINKING); - dest = build_addr_arg_loc (loc, partition->main_dr, nb_bytes); - src = build_addr_arg_loc (loc, partition->secondary_dr, nb_bytes); + dest = builtin->dst_base; + src = builtin->src_base; if (partition->kind == PKIND_MEMCPY || ! ptr_derefs_may_alias_p (dest, src)) kind = BUILT_IN_MEMCPY; @@ -1279,8 +1257,6 @@ build_rdg_partition_for_vertex (struct graph *rdg, int v) FOR_EACH_VEC_ELT (nodes, i, x) { bitmap_set_bit (partition->stmts, x); - bitmap_set_bit (partition->loops, - loop_containing_stmt (RDG_STMT (rdg, x))->num); for (j = 0; RDG_DATAREFS (rdg, x).iterate (j, &dr); ++j) { @@ -1307,69 +1283,22 @@ build_rdg_partition_for_vertex (struct graph *rdg, int v) return partition; } -/* Classifies the builtin kind we can generate for PARTITION of RDG and LOOP. - For the moment we detect memset, memcpy and memmove patterns. Bitmap - STMT_IN_ALL_PARTITIONS contains statements belonging to all partitions. */ +/* Given PARTITION of RDG, record single load/store data references for + builtin partition in SRC_DR/DST_DR, return false if there is no such + data references. */ -static void -classify_partition (loop_p loop, struct graph *rdg, partition *partition, - bitmap stmt_in_all_partitions) +static bool +find_single_drs (struct graph *rdg, partition *partition, + data_reference_p *dst_dr, data_reference_p *src_dr) { - bitmap_iterator bi; unsigned i; - tree nb_iter; - data_reference_p single_load, single_store; - bool volatiles_p = false, plus_one = false, has_reduction = false; - - partition->kind = PKIND_NORMAL; - partition->main_dr = NULL; - partition->secondary_dr = NULL; - partition->niter = NULL_TREE; - partition->plus_one = false; - - EXECUTE_IF_SET_IN_BITMAP (partition->stmts, 0, i, bi) - { - gimple *stmt = RDG_STMT (rdg, i); - - if (gimple_has_volatile_ops (stmt)) - volatiles_p = true; - - /* If the stmt is not included by all partitions and there is uses - outside of the loop, then mark the partition as reduction. */ - if (stmt_has_scalar_dependences_outside_loop (loop, stmt)) - { - /* Due to limitation in the transform phase we have to fuse all - reduction partitions. As a result, this could cancel valid - loop distribution especially for loop that induction variable - is used outside of loop. To workaround this issue, we skip - marking partition as reudction if the reduction stmt belongs - to all partitions. In such case, reduction will be computed - correctly no matter how partitions are fused/distributed. */ - if (!bitmap_bit_p (stmt_in_all_partitions, i)) - { - partition->reduction_p = true; - return; - } - has_reduction = true; - } - } - - /* Perform general partition disqualification for builtins. */ - if (volatiles_p - /* Simple workaround to prevent classifying the partition as builtin - if it contains any use outside of loop. */ - || has_reduction - || !flag_tree_loop_distribute_patterns) - return; + data_reference_p single_ld = NULL, single_st = NULL; + bitmap_iterator bi; - /* Detect memset and memcpy. */ - single_load = NULL; - single_store = NULL; EXECUTE_IF_SET_IN_BITMAP (partition->stmts, 0, i, bi) { gimple *stmt = RDG_STMT (rdg, i); data_reference_p dr; - unsigned j; if (gimple_code (stmt) == GIMPLE_PHI) continue; @@ -1380,107 +1309,316 @@ classify_partition (loop_p loop, struct graph *rdg, partition *partition, /* Otherwise just regular loads/stores. */ if (!gimple_assign_single_p (stmt)) - return; + return false; /* But exactly one store and/or load. */ - for (j = 0; RDG_DATAREFS (rdg, i).iterate (j, &dr); ++j) + for (unsigned j = 0; RDG_DATAREFS (rdg, i).iterate (j, &dr); ++j) { tree type = TREE_TYPE (DR_REF (dr)); /* The memset, memcpy and memmove library calls are only able to deal with generic address space. */ if (!ADDR_SPACE_GENERIC_P (TYPE_ADDR_SPACE (type))) - return; + return false; if (DR_IS_READ (dr)) { - if (single_load != NULL) - return; - single_load = dr; + if (single_ld != NULL) + return false; + single_ld = dr; } else { - if (single_store != NULL) - return; - single_store = dr; + if (single_st != NULL) + return false; + single_st = dr; } } } - if (!single_store) - return; + if (!single_st) + return false; - nb_iter = number_of_latch_executions (loop); - gcc_assert (nb_iter && nb_iter != chrec_dont_know); - if (dominated_by_p (CDI_DOMINATORS, single_exit (loop)->src, - gimple_bb (DR_STMT (single_store)))) - plus_one = true; + /* Bail out if this is a bitfield memory reference. */ + if (TREE_CODE (DR_REF (single_st)) == COMPONENT_REF + && DECL_BIT_FIELD (TREE_OPERAND (DR_REF (single_st), 1))) + return false; - if (single_store && !single_load) - { - gimple *stmt = DR_STMT (single_store); - tree rhs = gimple_assign_rhs1 (stmt); - if (const_with_all_bytes_same (rhs) == -1 - && (!INTEGRAL_TYPE_P (TREE_TYPE (rhs)) - || (TYPE_MODE (TREE_TYPE (rhs)) - != TYPE_MODE (unsigned_char_type_node)))) - return; - if (TREE_CODE (rhs) == SSA_NAME - && !SSA_NAME_IS_DEFAULT_DEF (rhs) - && flow_bb_inside_loop_p (loop, gimple_bb (SSA_NAME_DEF_STMT (rhs)))) - return; - if (!adjacent_dr_p (single_store) - || !dominated_by_p (CDI_DOMINATORS, - loop->latch, gimple_bb (stmt))) - return; - partition->kind = PKIND_MEMSET; - partition->main_dr = single_store; - partition->niter = nb_iter; - partition->plus_one = plus_one; - } - else if (single_store && single_load) + /* Data reference must be executed exactly once per iteration. */ + basic_block bb_st = gimple_bb (DR_STMT (single_st)); + struct loop *inner = bb_st->loop_father; + if (!dominated_by_p (CDI_DOMINATORS, inner->latch, bb_st)) + return false; + + if (single_ld) { - gimple *store = DR_STMT (single_store); - gimple *load = DR_STMT (single_load); + gimple *store = DR_STMT (single_st), *load = DR_STMT (single_ld); /* Direct aggregate copy or via an SSA name temporary. */ if (load != store && gimple_assign_lhs (load) != gimple_assign_rhs1 (store)) - return; - if (!adjacent_dr_p (single_store) - || !adjacent_dr_p (single_load) - || !operand_equal_p (DR_STEP (single_store), - DR_STEP (single_load), 0) - || !dominated_by_p (CDI_DOMINATORS, - loop->latch, gimple_bb (store))) - return; - /* Now check that if there is a dependence this dependence is - of a suitable form for memmove. */ - ddr_p ddr = get_data_dependence (rdg, single_load, single_store); - if (DDR_ARE_DEPENDENT (ddr) == chrec_dont_know) - return; + return false; + + /* Bail out if this is a bitfield memory reference. */ + if (TREE_CODE (DR_REF (single_ld)) == COMPONENT_REF + && DECL_BIT_FIELD (TREE_OPERAND (DR_REF (single_ld), 1))) + return false; + + /* Load and store must be in the same loop nest. */ + basic_block bb_ld = gimple_bb (DR_STMT (single_ld)); + if (inner != bb_ld->loop_father) + return false; + + /* Data reference must be executed exactly once per iteration. */ + if (!dominated_by_p (CDI_DOMINATORS, inner->latch, bb_ld)) + return false; + + edge e = single_exit (inner); + bool dom_ld = dominated_by_p (CDI_DOMINATORS, e->src, bb_ld); + bool dom_st = dominated_by_p (CDI_DOMINATORS, e->src, bb_st); + if (dom_ld != dom_st) + return false; + } + + *src_dr = single_ld; + *dst_dr = single_st; + return true; +} + +/* Given data reference DR in LOOP_NEST, this function checks the enclosing + loops from inner to outer to see if loop's step equals to access size at + each level of loop. Return true if yes; record access base and size in + BASE and SIZE; save loop's step at each level of loop in STEPS if it is + not null. For example: + + int arr[100][100][100]; + for (i = 0; i < 100; i++) ;steps[2] = 40000 + for (j = 100; j > 0; j--) ;steps[1] = -400 + for (k = 0; k < 100; k++) ;steps[0] = 4 + arr[i][j - 1][k] = 0; ;base = &arr, size = 4000000. */ + +static bool +compute_access_range (loop_p loop_nest, data_reference_p dr, tree *base, + tree *size, vec<tree> *steps = NULL) +{ + location_t loc = gimple_location (DR_STMT (dr)); + basic_block bb = gimple_bb (DR_STMT (dr)); + struct loop *loop = bb->loop_father; + tree ref = DR_REF (dr); + tree access_base = build_fold_addr_expr (ref); + tree access_size = TYPE_SIZE_UNIT (TREE_TYPE (ref)); + + do { + tree scev_fn = analyze_scalar_evolution (loop, access_base); + if (TREE_CODE (scev_fn) != POLYNOMIAL_CHREC) + return false; + + access_base = CHREC_LEFT (scev_fn); + if (tree_contains_chrecs (access_base, NULL)) + return false; + + tree scev_step = CHREC_RIGHT (scev_fn); + /* Only support constant steps. */ + if (TREE_CODE (scev_step) != INTEGER_CST) + return false; + + enum ev_direction access_dir = scev_direction (scev_fn); + if (access_dir == EV_DIR_UNKNOWN) + return false; + + if (steps != NULL) + steps->safe_push (scev_step); + + scev_step = fold_convert_loc (loc, sizetype, scev_step); + /* Compute absolute value of scev step. */ + if (access_dir == EV_DIR_DECREASES) + scev_step = fold_build1_loc (loc, NEGATE_EXPR, sizetype, scev_step); - if (DDR_ARE_DEPENDENT (ddr) != chrec_known) + /* At each level of loop, scev step must equal to access size. In other + words, DR must access consecutive memory between loop iterations. */ + if (!operand_equal_p (scev_step, access_size, 0)) + return false; + + /* Compute DR's execution times in loop. */ + tree niters = number_of_latch_executions (loop); + niters = fold_convert_loc (loc, sizetype, niters); + if (dominated_by_p (CDI_DOMINATORS, single_exit (loop)->src, bb)) + niters = size_binop_loc (loc, PLUS_EXPR, niters, size_one_node); + + /* Compute DR's overall access size in loop. */ + access_size = fold_build2_loc (loc, MULT_EXPR, sizetype, + niters, scev_step); + /* Adjust base address in case of negative step. */ + if (access_dir == EV_DIR_DECREASES) { - if (DDR_NUM_DIST_VECTS (ddr) == 0) - return; + tree adj = fold_build2_loc (loc, MINUS_EXPR, sizetype, + scev_step, access_size); + access_base = fold_build_pointer_plus_loc (loc, access_base, adj); + } + } while (loop != loop_nest && (loop = loop_outer (loop)) != NULL); + + *base = access_base; + *size = access_size; + return true; +} + +/* Allocate and return builtin struct. Record information like DST_DR, + SRC_DR, DST_BASE, SRC_BASE and SIZE in the allocated struct. */ + +static struct builtin_info * +alloc_builtin (data_reference_p dst_dr, data_reference_p src_dr, + tree dst_base, tree src_base, tree size) +{ + struct builtin_info *builtin = XNEW (struct builtin_info); + builtin->dst_dr = dst_dr; + builtin->src_dr = src_dr; + builtin->dst_base = dst_base; + builtin->src_base = src_base; + builtin->size = size; + return builtin; +} + +/* Given data reference DR in loop nest LOOP, classify if it forms builtin + memset call. */ + +static void +classify_builtin_st (loop_p loop, partition *partition, data_reference_p dr) +{ + gimple *stmt = DR_STMT (dr); + tree base, size, rhs = gimple_assign_rhs1 (stmt); + + if (const_with_all_bytes_same (rhs) == -1 + && (!INTEGRAL_TYPE_P (TREE_TYPE (rhs)) + || (TYPE_MODE (TREE_TYPE (rhs)) + != TYPE_MODE (unsigned_char_type_node)))) + return; + + if (TREE_CODE (rhs) == SSA_NAME + && !SSA_NAME_IS_DEFAULT_DEF (rhs) + && flow_bb_inside_loop_p (loop, gimple_bb (SSA_NAME_DEF_STMT (rhs)))) + return; + + if (!compute_access_range (loop, dr, &base, &size)) + return; + + partition->builtin = alloc_builtin (dr, NULL, base, NULL_TREE, size); + partition->kind = PKIND_MEMSET; +} + +/* Given data references DST_DR and SRC_DR in loop nest LOOP and RDG, classify + if it forms builtin memcpy or memmove call. */ + +static void +classify_builtin_ldst (loop_p loop, struct graph *rdg, partition *partition, + data_reference_p dst_dr, data_reference_p src_dr) +{ + tree base, size, src_base, src_size; + auto_vec<tree> dst_steps, src_steps; + + /* Compute access range of both load and store. They much have the same + access size. */ + if (!compute_access_range (loop, dst_dr, &base, &size, &dst_steps) + || !compute_access_range (loop, src_dr, &src_base, &src_size, &src_steps) + || !operand_equal_p (size, src_size, 0)) + return; + + /* Load and store in loop nest must access memory in the same way, i.e, + their must have the same steps in each loop of the nest. */ + if (dst_steps.length () != src_steps.length ()) + return; + for (unsigned i = 0; i < dst_steps.length (); ++i) + if (!operand_equal_p (dst_steps[i], src_steps[i], 0)) + return; + + /* Now check that if there is a dependence. */ + ddr_p ddr = get_data_dependence (rdg, src_dr, dst_dr); + + /* Classify as memcpy if no dependence between load and store. */ + if (DDR_ARE_DEPENDENT (ddr) == chrec_known) + { + partition->builtin = alloc_builtin (dst_dr, src_dr, base, src_base, size); + partition->kind = PKIND_MEMCPY; + return; + } + + /* Can't do memmove in case of unknown dependence or dependence without + classical distance vector. */ + if (DDR_ARE_DEPENDENT (ddr) == chrec_dont_know + || DDR_NUM_DIST_VECTS (ddr) == 0) + return; + + unsigned i; + lambda_vector dist_v; + int num_lev = (DDR_LOOP_NEST (ddr)).length (); + FOR_EACH_VEC_ELT (DDR_DIST_VECTS (ddr), i, dist_v) + { + unsigned dep_lev = dependence_level (dist_v, num_lev); + /* Can't do memmove if load depends on store. */ + if (dep_lev > 0 && dist_v[dep_lev - 1] > 0 && !DDR_REVERSED_P (ddr)) + return; + } + + partition->builtin = alloc_builtin (dst_dr, src_dr, base, src_base, size); + partition->kind = PKIND_MEMMOVE; + return; +} + +/* Classifies the builtin kind we can generate for PARTITION of RDG and LOOP. + For the moment we detect memset, memcpy and memmove patterns. Bitmap + STMT_IN_ALL_PARTITIONS contains statements belonging to all partitions. */ + +static void +classify_partition (loop_p loop, struct graph *rdg, partition *partition, + bitmap stmt_in_all_partitions) +{ + bitmap_iterator bi; + unsigned i; + data_reference_p single_ld = NULL, single_st = NULL; + bool volatiles_p = false, has_reduction = false; + + EXECUTE_IF_SET_IN_BITMAP (partition->stmts, 0, i, bi) + { + gimple *stmt = RDG_STMT (rdg, i); + + if (gimple_has_volatile_ops (stmt)) + volatiles_p = true; - lambda_vector dist_v; - FOR_EACH_VEC_ELT (DDR_DIST_VECTS (ddr), i, dist_v) + /* If the stmt is not included by all partitions and there is uses + outside of the loop, then mark the partition as reduction. */ + if (stmt_has_scalar_dependences_outside_loop (loop, stmt)) + { + /* Due to limitation in the transform phase we have to fuse all + reduction partitions. As a result, this could cancel valid + loop distribution especially for loop that induction variable + is used outside of loop. To workaround this issue, we skip + marking partition as reudction if the reduction stmt belongs + to all partitions. In such case, reduction will be computed + correctly no matter how partitions are fused/distributed. */ + if (!bitmap_bit_p (stmt_in_all_partitions, i)) { - int dist = dist_v[index_in_loop_nest (loop->num, - DDR_LOOP_NEST (ddr))]; - if (dist > 0 && !DDR_REVERSED_P (ddr)) - return; + partition->reduction_p = true; + return; } - partition->kind = PKIND_MEMMOVE; + has_reduction = true; } - else - partition->kind = PKIND_MEMCPY; - partition->main_dr = single_store; - partition->secondary_dr = single_load; - partition->niter = nb_iter; - partition->plus_one = plus_one; } + + /* Perform general partition disqualification for builtins. */ + if (volatiles_p + /* Simple workaround to prevent classifying the partition as builtin + if it contains any use outside of loop. */ + || has_reduction + || !flag_tree_loop_distribute_patterns) + return; + + /* Find single load/store data references for builtin partition. */ + if (!find_single_drs (rdg, partition, &single_st, &single_ld)) + return; + + /* Classify the builtin kind. */ + if (single_ld == NULL) + classify_builtin_st (loop, partition, single_st); + else + classify_builtin_ldst (loop, rdg, partition, single_st, single_ld); } /* Returns true when PARTITION1 and PARTITION2 access the same memory @@ -1939,7 +2077,8 @@ build_partition_graph (struct graph *rdg, return pg; } -/* Sort partitions in PG by post order and store them in PARTITIONS. */ +/* Sort partitions in PG in descending post order and store them in + PARTITIONS. */ static void sort_partitions_by_post_order (struct graph *pg, @@ -1948,7 +2087,7 @@ sort_partitions_by_post_order (struct graph *pg, int i; struct pg_vdata *data; - /* Now order the remaining nodes in postorder. */ + /* Now order the remaining nodes in descending postorder. */ qsort (pg->vertices, pg->n_vertices, sizeof (vertex), pgcmp); partitions->truncate (0); for (i = 0; i < pg->n_vertices; ++i) @@ -1960,16 +2099,18 @@ sort_partitions_by_post_order (struct graph *pg, } /* Given reduced dependence graph RDG merge strong connected components - of PARTITIONS. In this function, data dependence caused by possible - alias between references is ignored, as if it doesn't exist at all. */ + of PARTITIONS. If IGNORE_ALIAS_P is true, data dependence caused by + possible alias between references is ignored, as if it doesn't exist + at all; otherwise all depdendences are considered. */ static void merge_dep_scc_partitions (struct graph *rdg, - vec<struct partition *> *partitions) + vec<struct partition *> *partitions, + bool ignore_alias_p) { struct partition *partition1, *partition2; struct pg_vdata *data; - graph *pg = build_partition_graph (rdg, partitions, true); + graph *pg = build_partition_graph (rdg, partitions, ignore_alias_p); int i, j, num_sccs = graphds_scc (pg, NULL); /* Strong connected compoenent means dependence cycle, we cannot distribute @@ -2044,7 +2185,7 @@ break_alias_scc_partitions (struct graph *rdg, vec<struct partition *> *partitions, vec<ddr_p> *alias_ddrs) { - int i, j, num_sccs, num_sccs_no_alias; + int i, j, k, num_sccs, num_sccs_no_alias; /* Build partition dependence graph. */ graph *pg = build_partition_graph (rdg, partitions, false); @@ -2061,7 +2202,7 @@ break_alias_scc_partitions (struct graph *rdg, auto_vec<enum partition_type> scc_types; struct partition *partition, *first; - /* If all paritions in a SCC has the same type, we can simply merge the + /* If all partitions in a SCC have the same type, we can simply merge the SCC. This loop finds out such SCCS and record them in bitmap. */ bitmap_set_range (sccs_to_merge, 0, (unsigned) num_sccs); for (i = 0; i < num_sccs; ++i) @@ -2074,6 +2215,10 @@ break_alias_scc_partitions (struct graph *rdg, if (pg->vertices[j].component != i) continue; + /* Note we Merge partitions of parallel type on purpose, though + the result partition is sequential. The reason is vectorizer + can do more accurate runtime alias check in this case. Also + it results in more conservative distribution. */ if (first->type != partition->type) { bitmap_clear_bit (sccs_to_merge, i); @@ -2095,7 +2240,7 @@ break_alias_scc_partitions (struct graph *rdg, if (bitmap_count_bits (sccs_to_merge) != (unsigned) num_sccs) { /* Run SCC finding algorithm again, with alias dependence edges - skipped. This is to topologically sort paritions according to + skipped. This is to topologically sort partitions according to compilation time known dependence. Note the topological order is stored in the form of pg's post order number. */ num_sccs_no_alias = graphds_scc (pg, NULL, pg_skip_alias_edge); @@ -2117,19 +2262,29 @@ break_alias_scc_partitions (struct graph *rdg, for (j = 0; partitions->iterate (j, &first); ++j) if (cbdata.vertices_component[j] == i) break; - for (++j; partitions->iterate (j, &partition); ++j) + for (k = j + 1; partitions->iterate (k, &partition); ++k) { struct pg_vdata *data; - if (cbdata.vertices_component[j] != i) + if (cbdata.vertices_component[k] != i) continue; + /* Update postorder number so that merged reduction partition is + sorted after other partitions. */ + if (!partition_reduction_p (first) + && partition_reduction_p (partition)) + { + gcc_assert (pg->vertices[k].post < pg->vertices[j].post); + pg->vertices[j].post = pg->vertices[k].post; + } partition_merge_into (NULL, first, partition, FUSE_SAME_SCC); - (*partitions)[j] = NULL; + (*partitions)[k] = NULL; partition_free (partition); - data = (struct pg_vdata *)pg->vertices[j].data; - gcc_assert (data->id == j); + data = (struct pg_vdata *)pg->vertices[k].data; + gcc_assert (data->id == k); data->partition = NULL; + /* The result partition of merged SCC must be sequential. */ + first->type = PTYPE_SEQUENTIAL; } } } @@ -2321,38 +2476,49 @@ version_for_distribution_p (vec<struct partition *> *partitions, return (alias_ddrs->length () > 0); } -/* Fuse all partitions if necessary before finalizing distribution. */ +/* Fuse PARTITIONS of LOOP if necessary before finalizing distribution. + ALIAS_DDRS contains ddrs which need runtime alias check. */ static void -finalize_partitions (vec<struct partition *> *partitions, +finalize_partitions (struct loop *loop, vec<struct partition *> *partitions, vec<ddr_p> *alias_ddrs) { unsigned i; - struct partition *a, *partition; + struct partition *partition, *a; if (partitions->length () == 1 || alias_ddrs->length () > 0) return; - a = (*partitions)[0]; - if (a->kind != PKIND_NORMAL) - return; - - for (i = 1; partitions->iterate (i, &partition); ++i) + unsigned num_builtin = 0, num_normal = 0; + bool same_type_p = true; + enum partition_type type = ((*partitions)[0])->type; + for (i = 0; partitions->iterate (i, &partition); ++i) { - /* Don't fuse if partition has different type or it is a builtin. */ - if (partition->type != a->type - || partition->kind != PKIND_NORMAL) - return; + same_type_p &= (type == partition->type); + if (partition->kind != PKIND_NORMAL) + num_builtin++; + else + num_normal++; } - /* Fuse all partitions. */ - for (i = 1; partitions->iterate (i, &partition); ++i) + /* Don't distribute current loop into too many loops given we don't have + memory stream cost model. Be even more conservative in case of loop + nest distribution. */ + if ((same_type_p && num_builtin == 0) + || (loop->inner != NULL + && i >= NUM_PARTITION_THRESHOLD && num_normal > 1) + || (loop->inner == NULL + && i >= NUM_PARTITION_THRESHOLD && num_normal > num_builtin)) { - partition_merge_into (NULL, a, partition, FUSE_FINALIZE); - partition_free (partition); + a = (*partitions)[0]; + for (i = 1; partitions->iterate (i, &partition); ++i) + { + partition_merge_into (NULL, a, partition, FUSE_FINALIZE); + partition_free (partition); + } + partitions->truncate (1); } - partitions->truncate (1); } /* Distributes the code from LOOP in such a way that producer statements @@ -2505,16 +2671,23 @@ distribute_loop (struct loop *loop, vec<gimple *> stmts, i--; } - /* Build the partition dependency graph. */ + /* Build the partition dependency graph and fuse partitions in strong + connected component. */ if (partitions.length () > 1) { - merge_dep_scc_partitions (rdg, &partitions); - alias_ddrs.truncate (0); - if (partitions.length () > 1) - break_alias_scc_partitions (rdg, &partitions, &alias_ddrs); + /* Don't support loop nest distribution under runtime alias check + since it's not likely to enable many vectorization opportunities. */ + if (loop->inner) + merge_dep_scc_partitions (rdg, &partitions, false); + else + { + merge_dep_scc_partitions (rdg, &partitions, true); + if (partitions.length () > 1) + break_alias_scc_partitions (rdg, &partitions, &alias_ddrs); + } } - finalize_partitions (&partitions, &alias_ddrs); + finalize_partitions (loop, &partitions, &alias_ddrs); nbp = partitions.length (); if (nbp == 0 @@ -2595,6 +2768,86 @@ public: }; // class pass_loop_distribution + +/* Given LOOP, this function records seed statements for distribution in + WORK_LIST. Return false if there is nothing for distribution. */ + +static bool +find_seed_stmts_for_distribution (struct loop *loop, vec<gimple *> *work_list) +{ + basic_block *bbs = get_loop_body_in_dom_order (loop); + + /* Initialize the worklist with stmts we seed the partitions with. */ + for (unsigned i = 0; i < loop->num_nodes; ++i) + { + for (gphi_iterator gsi = gsi_start_phis (bbs[i]); + !gsi_end_p (gsi); gsi_next (&gsi)) + { + gphi *phi = gsi.phi (); + if (virtual_operand_p (gimple_phi_result (phi))) + continue; + /* Distribute stmts which have defs that are used outside of + the loop. */ + if (!stmt_has_scalar_dependences_outside_loop (loop, phi)) + continue; + work_list->safe_push (phi); + } + for (gimple_stmt_iterator gsi = gsi_start_bb (bbs[i]); + !gsi_end_p (gsi); gsi_next (&gsi)) + { + gimple *stmt = gsi_stmt (gsi); + + /* If there is a stmt with side-effects bail out - we + cannot and should not distribute this loop. */ + if (gimple_has_side_effects (stmt)) + { + free (bbs); + return false; + } + + /* Distribute stmts which have defs that are used outside of + the loop. */ + if (stmt_has_scalar_dependences_outside_loop (loop, stmt)) + ; + /* Otherwise only distribute stores for now. */ + else if (!gimple_vdef (stmt)) + continue; + + work_list->safe_push (stmt); + } + } + free (bbs); + return work_list->length () > 0; +} + +/* Given innermost LOOP, return the outermost enclosing loop that forms a + perfect loop nest. */ + +static struct loop * +prepare_perfect_loop_nest (struct loop *loop) +{ + struct loop *outer = loop_outer (loop); + tree niters = number_of_latch_executions (loop); + + /* TODO: We only support the innermost 2-level loop nest distribution + because of compilation time issue for now. This should be relaxed + in the future. */ + while (loop->inner == NULL + && loop_outer (outer) + && outer->inner == loop && loop->next == NULL + && single_exit (outer) + && optimize_loop_for_speed_p (outer) + && !chrec_contains_symbols_defined_in_loop (niters, outer->num) + && (niters = number_of_latch_executions (outer)) != NULL_TREE + && niters != chrec_dont_know) + { + loop = outer; + outer = loop_outer (loop); + } + + return loop; +} + unsigned int pass_loop_distribution::execute (function *fun) { @@ -2637,18 +2890,9 @@ pass_loop_distribution::execute (function *fun) walking to innermost loops. */ FOR_EACH_LOOP (loop, LI_ONLY_INNERMOST) { - auto_vec<gimple *> work_list; - basic_block *bbs; - int num = loop->num; - unsigned int i; - - /* If the loop doesn't have a single exit we will fail anyway, - so do that early. */ - if (!single_exit (loop)) - continue; - - /* Only optimize hot loops. */ - if (!optimize_loop_for_speed_p (loop)) + /* Don't distribute multiple exit edges loop, or cold loop. */ + if (!single_exit (loop) + || !optimize_loop_for_speed_p (loop)) continue; /* Don't distribute loop if niters is unknown. */ @@ -2656,56 +2900,16 @@ pass_loop_distribution::execute (function *fun) if (niters == NULL_TREE || niters == chrec_dont_know) continue; - /* Initialize the worklist with stmts we seed the partitions with. */ - bbs = get_loop_body_in_dom_order (loop); - for (i = 0; i < loop->num_nodes; ++i) + /* Get the perfect loop nest for distribution. */ + loop = prepare_perfect_loop_nest (loop); + for (; loop; loop = loop->inner) { - for (gphi_iterator gsi = gsi_start_phis (bbs[i]); - !gsi_end_p (gsi); - gsi_next (&gsi)) - { - gphi *phi = gsi.phi (); - if (virtual_operand_p (gimple_phi_result (phi))) - continue; - /* Distribute stmts which have defs that are used outside of - the loop. */ - if (!stmt_has_scalar_dependences_outside_loop (loop, phi)) - continue; - work_list.safe_push (phi); - } - for (gimple_stmt_iterator gsi = gsi_start_bb (bbs[i]); - !gsi_end_p (gsi); - gsi_next (&gsi)) - { - gimple *stmt = gsi_stmt (gsi); + auto_vec<gimple *> work_list; + if (!find_seed_stmts_for_distribution (loop, &work_list)) + break; - /* If there is a stmt with side-effects bail out - we - cannot and should not distribute this loop. */ - if (gimple_has_side_effects (stmt)) - { - work_list.truncate (0); - goto out; - } - - /* Distribute stmts which have defs that are used outside of - the loop. */ - if (stmt_has_scalar_dependences_outside_loop (loop, stmt)) - ; - /* Otherwise only distribute stores for now. */ - else if (!gimple_vdef (stmt)) - continue; - - work_list.safe_push (stmt); - } - } -out: - free (bbs); - - int nb_generated_loops = 0; - int nb_generated_calls = 0; - location_t loc = find_loop_location (loop); - if (work_list.length () > 0) - { + const char *str = loop->inner ? " nest" : ""; + location_t loc = find_loop_location (loop); if (!cd) { calculate_dominance_info (CDI_DOMINATORS); @@ -2713,24 +2917,29 @@ out: cd = new control_dependences (); free_dominance_info (CDI_POST_DOMINATORS); } + bool destroy_p; + int nb_generated_loops, nb_generated_calls; nb_generated_loops = distribute_loop (loop, work_list, cd, &nb_generated_calls, &destroy_p); if (destroy_p) loops_to_be_destroyed.safe_push (loop); - } - if (nb_generated_loops + nb_generated_calls > 0) - { - changed = true; - dump_printf_loc (MSG_OPTIMIZED_LOCATIONS, - loc, "Loop %d distributed: split to %d loops " - "and %d library calls.\n", - num, nb_generated_loops, nb_generated_calls); + if (nb_generated_loops + nb_generated_calls > 0) + { + changed = true; + dump_printf_loc (MSG_OPTIMIZED_LOCATIONS, + loc, "Loop%s %d distributed: split to %d loops " + "and %d library calls.\n", str, loop->num, + nb_generated_loops, nb_generated_calls); + + break; + } + + if (dump_file && (dump_flags & TDF_DETAILS)) + fprintf (dump_file, "Loop%s %d not distributed.\n", str, loop->num); } - else if (dump_file && (dump_flags & TDF_DETAILS)) - fprintf (dump_file, "Loop %d is the same.\n", num); } if (cd) diff --git a/gcc/tree-predcom.c b/gcc/tree-predcom.c index e7b10cb390f..fdb32f10529 100644 --- a/gcc/tree-predcom.c +++ b/gcc/tree-predcom.c @@ -1655,7 +1655,8 @@ is_inv_store_elimination_chain (struct loop *loop, chain_p chain) /* If loop iterates for unknown times or fewer times than chain->lenght, we still need to setup root variable and propagate it with PHI node. */ tree niters = number_of_latch_executions (loop); - if (TREE_CODE (niters) != INTEGER_CST || wi::leu_p (niters, chain->length)) + if (TREE_CODE (niters) != INTEGER_CST + || wi::leu_p (wi::to_wide (niters), chain->length)) return false; /* Check stores in chain for elimination if they only store loop invariant diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c index 7ca566f58cc..5d65f346968 100644 --- a/gcc/tree-pretty-print.c +++ b/gcc/tree-pretty-print.c @@ -249,8 +249,10 @@ dump_decl_name (pretty_printer *pp, tree node, dump_flags_t flags) { if (DECL_NAME (node)) { - if ((flags & TDF_ASMNAME) && DECL_ASSEMBLER_NAME_SET_P (node)) - pp_tree_identifier (pp, DECL_ASSEMBLER_NAME (node)); + if ((flags & TDF_ASMNAME) + && HAS_DECL_ASSEMBLER_NAME_P (node) + && DECL_ASSEMBLER_NAME_SET_P (node)) + pp_tree_identifier (pp, DECL_ASSEMBLER_NAME_RAW (node)); /* For DECL_NAMELESS names look for embedded uids in the names and sanitize them for TDF_NOUID. */ else if ((flags & TDF_NOUID) && DECL_NAMELESS (node)) @@ -1748,7 +1750,7 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags, pp_unsigned_wide_integer (pp, tree_to_uhwi (node)); else { - wide_int val = node; + wide_int val = wi::to_wide (node); if (wi::neg_p (val, TYPE_SIGN (TREE_TYPE (node)))) { @@ -2857,8 +2859,7 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags, dump_generic_node (pp, CHREC_LEFT (node), spc, flags, false); pp_string (pp, ", +, "); dump_generic_node (pp, CHREC_RIGHT (node), spc, flags, false); - pp_string (pp, "}_"); - dump_generic_node (pp, CHREC_VAR (node), spc, flags, false); + pp_printf (pp, "}_%u", CHREC_VARIABLE (node)); is_stmt = false; break; diff --git a/gcc/tree-scalar-evolution.c b/gcc/tree-scalar-evolution.c index 8459793a01b..b6c1fcef6a1 100644 --- a/gcc/tree-scalar-evolution.c +++ b/gcc/tree-scalar-evolution.c @@ -281,7 +281,7 @@ along with GCC; see the file COPYING3. If not see #include "tree-ssa-propagate.h" #include "gimple-fold.h" -static tree analyze_scalar_evolution_1 (struct loop *, tree, tree); +static tree analyze_scalar_evolution_1 (struct loop *, tree); static tree analyze_scalar_evolution_for_address_of (struct loop *loop, tree var); @@ -564,22 +564,30 @@ get_scalar_evolution (basic_block instantiated_below, tree scalar) nb_get_scev++; } - switch (TREE_CODE (scalar)) - { - case SSA_NAME: - res = *find_var_scev_info (instantiated_below, scalar); - break; + if (VECTOR_TYPE_P (TREE_TYPE (scalar)) + || TREE_CODE (TREE_TYPE (scalar)) == COMPLEX_TYPE) + /* For chrec_dont_know we keep the symbolic form. */ + res = scalar; + else + switch (TREE_CODE (scalar)) + { + case SSA_NAME: + if (SSA_NAME_IS_DEFAULT_DEF (scalar)) + res = scalar; + else + res = *find_var_scev_info (instantiated_below, scalar); + break; - case REAL_CST: - case FIXED_CST: - case INTEGER_CST: - res = scalar; - break; + case REAL_CST: + case FIXED_CST: + case INTEGER_CST: + res = scalar; + break; - default: - res = chrec_not_analyzed_yet; - break; - } + default: + res = chrec_not_analyzed_yet; + break; + } if (dump_file && (dump_flags & TDF_SCEV)) { @@ -1628,19 +1636,7 @@ interpret_loop_phi (struct loop *loop, gphi *loop_phi_node) struct loop *phi_loop = loop_containing_stmt (loop_phi_node); tree init_cond; - if (phi_loop != loop) - { - struct loop *subloop; - tree evolution_fn = analyze_scalar_evolution - (phi_loop, PHI_RESULT (loop_phi_node)); - - /* Dive one level deeper. */ - subloop = superloop_at_depth (phi_loop, loop_depth (loop) + 1); - - /* Interpret the subloop. */ - res = compute_overall_effect_of_inner_loop (subloop, evolution_fn); - return res; - } + gcc_assert (phi_loop == loop); /* Otherwise really interpret the loop phi. */ init_cond = analyze_initial_condition (loop_phi_node); @@ -2016,73 +2012,38 @@ interpret_gimple_assign (struct loop *loop, gimple *stmt) - instantiate_parameters. */ -/* Compute and return the evolution function in WRTO_LOOP, the nearest - common ancestor of DEF_LOOP and USE_LOOP. */ - -static tree -compute_scalar_evolution_in_loop (struct loop *wrto_loop, - struct loop *def_loop, - tree ev) -{ - bool val; - tree res; - - if (def_loop == wrto_loop) - return ev; - - def_loop = superloop_at_depth (def_loop, loop_depth (wrto_loop) + 1); - res = compute_overall_effect_of_inner_loop (def_loop, ev); - - if (no_evolution_in_loop_p (res, wrto_loop->num, &val) && val) - return res; - - return analyze_scalar_evolution_1 (wrto_loop, res, chrec_not_analyzed_yet); -} - /* Helper recursive function. */ static tree -analyze_scalar_evolution_1 (struct loop *loop, tree var, tree res) +analyze_scalar_evolution_1 (struct loop *loop, tree var) { - tree type = TREE_TYPE (var); gimple *def; basic_block bb; struct loop *def_loop; - - if (loop == NULL - || TREE_CODE (type) == VECTOR_TYPE - || TREE_CODE (type) == COMPLEX_TYPE) - return chrec_dont_know; + tree res; if (TREE_CODE (var) != SSA_NAME) return interpret_expr (loop, NULL, var); def = SSA_NAME_DEF_STMT (var); bb = gimple_bb (def); - def_loop = bb ? bb->loop_father : NULL; + def_loop = bb->loop_father; - if (bb == NULL - || !flow_bb_inside_loop_p (loop, bb)) + if (!flow_bb_inside_loop_p (loop, bb)) { /* Keep symbolic form, but look through obvious copies for constants. */ res = follow_copies_to_constant (var); goto set_and_end; } - if (res != chrec_not_analyzed_yet) - { - if (loop != bb->loop_father) - res = compute_scalar_evolution_in_loop - (find_common_loop (loop, bb->loop_father), bb->loop_father, res); - - goto set_and_end; - } - if (loop != def_loop) { - res = analyze_scalar_evolution_1 (def_loop, var, chrec_not_analyzed_yet); - res = compute_scalar_evolution_in_loop (loop, def_loop, res); - + res = analyze_scalar_evolution_1 (def_loop, var); + struct loop *loop_to_skip = superloop_at_depth (def_loop, + loop_depth (loop) + 1); + res = compute_overall_effect_of_inner_loop (loop_to_skip, res); + if (chrec_contains_symbols_defined_in_loop (res, loop->num)) + res = analyze_scalar_evolution_1 (loop, res); goto set_and_end; } @@ -2134,6 +2095,10 @@ analyze_scalar_evolution (struct loop *loop, tree var) { tree res; + /* ??? Fix callers. */ + if (! loop) + return var; + if (dump_file && (dump_flags & TDF_SCEV)) { fprintf (dump_file, "(analyze_scalar_evolution \n"); @@ -2144,7 +2109,8 @@ analyze_scalar_evolution (struct loop *loop, tree var) } res = get_scalar_evolution (block_before_loop (loop), var); - res = analyze_scalar_evolution_1 (loop, var, res); + if (res == chrec_not_analyzed_yet) + res = analyze_scalar_evolution_1 (loop, var); if (dump_file && (dump_flags & TDF_SCEV)) fprintf (dump_file, ")\n"); @@ -2309,7 +2275,7 @@ eq_idx_scev_info (const void *e1, const void *e2) static unsigned get_instantiated_value_entry (instantiate_cache_type &cache, - tree name, basic_block instantiate_below) + tree name, edge instantiate_below) { if (!cache.map) { @@ -2319,7 +2285,7 @@ get_instantiated_value_entry (instantiate_cache_type &cache, scev_info_str e; e.name_version = SSA_NAME_VERSION (name); - e.instantiated_below = instantiate_below->index; + e.instantiated_below = instantiate_below->dest->index; void **slot = htab_find_slot_with_hash (cache.map, &e, scev_info_hasher::hash (&e), INSERT); if (!*slot) @@ -2363,7 +2329,7 @@ loop_closed_phi_def (tree var) return NULL_TREE; } -static tree instantiate_scev_r (basic_block, struct loop *, struct loop *, +static tree instantiate_scev_r (edge, struct loop *, struct loop *, tree, bool *, int); /* Analyze all the parameters of the chrec, between INSTANTIATE_BELOW @@ -2382,7 +2348,7 @@ static tree instantiate_scev_r (basic_block, struct loop *, struct loop *, instantiated, and to stop if it exceeds some limit. */ static tree -instantiate_scev_name (basic_block instantiate_below, +instantiate_scev_name (edge instantiate_below, struct loop *evolution_loop, struct loop *inner_loop, tree chrec, bool *fold_conversions, @@ -2396,7 +2362,7 @@ instantiate_scev_name (basic_block instantiate_below, evolutions in outer loops), nothing to do. */ if (!def_bb || loop_depth (def_bb->loop_father) == 0 - || dominated_by_p (CDI_DOMINATORS, instantiate_below, def_bb)) + || ! dominated_by_p (CDI_DOMINATORS, def_bb, instantiate_below->dest)) return chrec; /* We cache the value of instantiated variable to avoid exponential @@ -2418,6 +2384,51 @@ instantiate_scev_name (basic_block instantiate_below, def_loop = find_common_loop (evolution_loop, def_bb->loop_father); + if (! dominated_by_p (CDI_DOMINATORS, + def_loop->header, instantiate_below->dest)) + { + gimple *def = SSA_NAME_DEF_STMT (chrec); + if (gassign *ass = dyn_cast <gassign *> (def)) + { + switch (gimple_assign_rhs_class (ass)) + { + case GIMPLE_UNARY_RHS: + { + tree op0 = instantiate_scev_r (instantiate_below, evolution_loop, + inner_loop, gimple_assign_rhs1 (ass), + fold_conversions, size_expr); + if (op0 == chrec_dont_know) + return chrec_dont_know; + res = fold_build1 (gimple_assign_rhs_code (ass), + TREE_TYPE (chrec), op0); + break; + } + case GIMPLE_BINARY_RHS: + { + tree op0 = instantiate_scev_r (instantiate_below, evolution_loop, + inner_loop, gimple_assign_rhs1 (ass), + fold_conversions, size_expr); + if (op0 == chrec_dont_know) + return chrec_dont_know; + tree op1 = instantiate_scev_r (instantiate_below, evolution_loop, + inner_loop, gimple_assign_rhs2 (ass), + fold_conversions, size_expr); + if (op1 == chrec_dont_know) + return chrec_dont_know; + res = fold_build2 (gimple_assign_rhs_code (ass), + TREE_TYPE (chrec), op0, op1); + break; + } + default: + res = chrec_dont_know; + } + } + else + res = chrec_dont_know; + global_cache->set (si, res); + return res; + } + /* If the analysis yields a parametric chrec, instantiate the result again. */ res = analyze_scalar_evolution (def_loop, chrec); @@ -2449,8 +2460,9 @@ instantiate_scev_name (basic_block instantiate_below, inner_loop, res, fold_conversions, size_expr); } - else if (!dominated_by_p (CDI_DOMINATORS, instantiate_below, - gimple_bb (SSA_NAME_DEF_STMT (res)))) + else if (dominated_by_p (CDI_DOMINATORS, + gimple_bb (SSA_NAME_DEF_STMT (res)), + instantiate_below->dest)) res = chrec_dont_know; } @@ -2488,7 +2500,7 @@ instantiate_scev_name (basic_block instantiate_below, instantiated, and to stop if it exceeds some limit. */ static tree -instantiate_scev_poly (basic_block instantiate_below, +instantiate_scev_poly (edge instantiate_below, struct loop *evolution_loop, struct loop *, tree chrec, bool *fold_conversions, int size_expr) { @@ -2533,7 +2545,7 @@ instantiate_scev_poly (basic_block instantiate_below, instantiated, and to stop if it exceeds some limit. */ static tree -instantiate_scev_binary (basic_block instantiate_below, +instantiate_scev_binary (edge instantiate_below, struct loop *evolution_loop, struct loop *inner_loop, tree chrec, enum tree_code code, tree type, tree c0, tree c1, @@ -2579,43 +2591,6 @@ instantiate_scev_binary (basic_block instantiate_below, /* Analyze all the parameters of the chrec, between INSTANTIATE_BELOW and EVOLUTION_LOOP, that were left under a symbolic form. - "CHREC" is an array reference to be instantiated. - - CACHE is the cache of already instantiated values. - - Variable pointed by FOLD_CONVERSIONS is set to TRUE when the - conversions that may wrap in signed/pointer type are folded, as long - as the value of the chrec is preserved. If FOLD_CONVERSIONS is NULL - then we don't do such fold. - - SIZE_EXPR is used for computing the size of the expression to be - instantiated, and to stop if it exceeds some limit. */ - -static tree -instantiate_array_ref (basic_block instantiate_below, - struct loop *evolution_loop, struct loop *inner_loop, - tree chrec, bool *fold_conversions, int size_expr) -{ - tree res; - tree index = TREE_OPERAND (chrec, 1); - tree op1 = instantiate_scev_r (instantiate_below, evolution_loop, - inner_loop, index, - fold_conversions, size_expr); - - if (op1 == chrec_dont_know) - return chrec_dont_know; - - if (chrec && op1 == index) - return chrec; - - res = unshare_expr (chrec); - TREE_OPERAND (res, 1) = op1; - return res; -} - -/* Analyze all the parameters of the chrec, between INSTANTIATE_BELOW - and EVOLUTION_LOOP, that were left under a symbolic form. - "CHREC" that stands for a convert expression "(TYPE) OP" is to be instantiated. @@ -2630,7 +2605,7 @@ instantiate_array_ref (basic_block instantiate_below, instantiated, and to stop if it exceeds some limit. */ static tree -instantiate_scev_convert (basic_block instantiate_below, +instantiate_scev_convert (edge instantiate_below, struct loop *evolution_loop, struct loop *inner_loop, tree chrec, tree type, tree op, bool *fold_conversions, int size_expr) @@ -2681,7 +2656,7 @@ instantiate_scev_convert (basic_block instantiate_below, instantiated, and to stop if it exceeds some limit. */ static tree -instantiate_scev_not (basic_block instantiate_below, +instantiate_scev_not (edge instantiate_below, struct loop *evolution_loop, struct loop *inner_loop, tree chrec, enum tree_code code, tree type, tree op, @@ -2719,130 +2694,6 @@ instantiate_scev_not (basic_block instantiate_below, /* Analyze all the parameters of the chrec, between INSTANTIATE_BELOW and EVOLUTION_LOOP, that were left under a symbolic form. - CHREC is an expression with 3 operands to be instantiated. - - CACHE is the cache of already instantiated values. - - Variable pointed by FOLD_CONVERSIONS is set to TRUE when the - conversions that may wrap in signed/pointer type are folded, as long - as the value of the chrec is preserved. If FOLD_CONVERSIONS is NULL - then we don't do such fold. - - SIZE_EXPR is used for computing the size of the expression to be - instantiated, and to stop if it exceeds some limit. */ - -static tree -instantiate_scev_3 (basic_block instantiate_below, - struct loop *evolution_loop, struct loop *inner_loop, - tree chrec, - bool *fold_conversions, int size_expr) -{ - tree op1, op2; - tree op0 = instantiate_scev_r (instantiate_below, evolution_loop, - inner_loop, TREE_OPERAND (chrec, 0), - fold_conversions, size_expr); - if (op0 == chrec_dont_know) - return chrec_dont_know; - - op1 = instantiate_scev_r (instantiate_below, evolution_loop, - inner_loop, TREE_OPERAND (chrec, 1), - fold_conversions, size_expr); - if (op1 == chrec_dont_know) - return chrec_dont_know; - - op2 = instantiate_scev_r (instantiate_below, evolution_loop, - inner_loop, TREE_OPERAND (chrec, 2), - fold_conversions, size_expr); - if (op2 == chrec_dont_know) - return chrec_dont_know; - - if (op0 == TREE_OPERAND (chrec, 0) - && op1 == TREE_OPERAND (chrec, 1) - && op2 == TREE_OPERAND (chrec, 2)) - return chrec; - - return fold_build3 (TREE_CODE (chrec), - TREE_TYPE (chrec), op0, op1, op2); -} - -/* Analyze all the parameters of the chrec, between INSTANTIATE_BELOW - and EVOLUTION_LOOP, that were left under a symbolic form. - - CHREC is an expression with 2 operands to be instantiated. - - CACHE is the cache of already instantiated values. - - Variable pointed by FOLD_CONVERSIONS is set to TRUE when the - conversions that may wrap in signed/pointer type are folded, as long - as the value of the chrec is preserved. If FOLD_CONVERSIONS is NULL - then we don't do such fold. - - SIZE_EXPR is used for computing the size of the expression to be - instantiated, and to stop if it exceeds some limit. */ - -static tree -instantiate_scev_2 (basic_block instantiate_below, - struct loop *evolution_loop, struct loop *inner_loop, - tree chrec, - bool *fold_conversions, int size_expr) -{ - tree op1; - tree op0 = instantiate_scev_r (instantiate_below, evolution_loop, - inner_loop, TREE_OPERAND (chrec, 0), - fold_conversions, size_expr); - if (op0 == chrec_dont_know) - return chrec_dont_know; - - op1 = instantiate_scev_r (instantiate_below, evolution_loop, - inner_loop, TREE_OPERAND (chrec, 1), - fold_conversions, size_expr); - if (op1 == chrec_dont_know) - return chrec_dont_know; - - if (op0 == TREE_OPERAND (chrec, 0) - && op1 == TREE_OPERAND (chrec, 1)) - return chrec; - - return fold_build2 (TREE_CODE (chrec), TREE_TYPE (chrec), op0, op1); -} - -/* Analyze all the parameters of the chrec, between INSTANTIATE_BELOW - and EVOLUTION_LOOP, that were left under a symbolic form. - - CHREC is an expression with 2 operands to be instantiated. - - CACHE is the cache of already instantiated values. - - Variable pointed by FOLD_CONVERSIONS is set to TRUE when the - conversions that may wrap in signed/pointer type are folded, as long - as the value of the chrec is preserved. If FOLD_CONVERSIONS is NULL - then we don't do such fold. - - SIZE_EXPR is used for computing the size of the expression to be - instantiated, and to stop if it exceeds some limit. */ - -static tree -instantiate_scev_1 (basic_block instantiate_below, - struct loop *evolution_loop, struct loop *inner_loop, - tree chrec, - bool *fold_conversions, int size_expr) -{ - tree op0 = instantiate_scev_r (instantiate_below, evolution_loop, - inner_loop, TREE_OPERAND (chrec, 0), - fold_conversions, size_expr); - - if (op0 == chrec_dont_know) - return chrec_dont_know; - - if (op0 == TREE_OPERAND (chrec, 0)) - return chrec; - - return fold_build1 (TREE_CODE (chrec), TREE_TYPE (chrec), op0); -} - -/* Analyze all the parameters of the chrec, between INSTANTIATE_BELOW - and EVOLUTION_LOOP, that were left under a symbolic form. - CHREC is the scalar evolution to instantiate. CACHE is the cache of already instantiated values. @@ -2856,7 +2707,7 @@ instantiate_scev_1 (basic_block instantiate_below, instantiated, and to stop if it exceeds some limit. */ static tree -instantiate_scev_r (basic_block instantiate_below, +instantiate_scev_r (edge instantiate_below, struct loop *evolution_loop, struct loop *inner_loop, tree chrec, bool *fold_conversions, int size_expr) @@ -2908,50 +2759,20 @@ instantiate_scev_r (basic_block instantiate_below, fold_conversions, size_expr); case ADDR_EXPR: + if (is_gimple_min_invariant (chrec)) + return chrec; + /* Fallthru. */ case SCEV_NOT_KNOWN: return chrec_dont_know; case SCEV_KNOWN: return chrec_known; - case ARRAY_REF: - return instantiate_array_ref (instantiate_below, evolution_loop, - inner_loop, chrec, - fold_conversions, size_expr); - - default: - break; - } - - if (VL_EXP_CLASS_P (chrec)) - return chrec_dont_know; - - switch (TREE_CODE_LENGTH (TREE_CODE (chrec))) - { - case 3: - return instantiate_scev_3 (instantiate_below, evolution_loop, - inner_loop, chrec, - fold_conversions, size_expr); - - case 2: - return instantiate_scev_2 (instantiate_below, evolution_loop, - inner_loop, chrec, - fold_conversions, size_expr); - - case 1: - return instantiate_scev_1 (instantiate_below, evolution_loop, - inner_loop, chrec, - fold_conversions, size_expr); - - case 0: - return chrec; - default: - break; + if (CONSTANT_CLASS_P (chrec)) + return chrec; + return chrec_dont_know; } - - /* Too complicated to handle. */ - return chrec_dont_know; } /* Analyze all the parameters of the chrec that were left under a @@ -2961,7 +2782,7 @@ instantiate_scev_r (basic_block instantiate_below, a function parameter. */ tree -instantiate_scev (basic_block instantiate_below, struct loop *evolution_loop, +instantiate_scev (edge instantiate_below, struct loop *evolution_loop, tree chrec) { tree res; @@ -2969,8 +2790,10 @@ instantiate_scev (basic_block instantiate_below, struct loop *evolution_loop, if (dump_file && (dump_flags & TDF_SCEV)) { fprintf (dump_file, "(instantiate_scev \n"); - fprintf (dump_file, " (instantiate_below = %d)\n", instantiate_below->index); - fprintf (dump_file, " (evolution_loop = %d)\n", evolution_loop->num); + fprintf (dump_file, " (instantiate_below = %d -> %d)\n", + instantiate_below->src->index, instantiate_below->dest->index); + if (evolution_loop) + fprintf (dump_file, " (evolution_loop = %d)\n", evolution_loop->num); fprintf (dump_file, " (chrec = "); print_generic_expr (dump_file, chrec); fprintf (dump_file, ")\n"); @@ -3018,7 +2841,7 @@ resolve_mixers (struct loop *loop, tree chrec, bool *folded_casts) destr = true; } - tree ret = instantiate_scev_r (block_before_loop (loop), loop, NULL, + tree ret = instantiate_scev_r (loop_preheader_edge (loop), loop, NULL, chrec, &fold_conversions, 0); if (folded_casts && !*folded_casts) @@ -3264,6 +3087,8 @@ scev_initialize (void) { struct loop *loop; + gcc_assert (! scev_initialized_p ()); + scalar_evolution_info = hash_table<scev_info_hasher>::create_ggc (100); initialize_scalar_evolutions_analyzer (); @@ -3329,7 +3154,7 @@ iv_can_overflow_p (struct loop *loop, tree type, tree base, tree step) return false; if (TREE_CODE (base) == INTEGER_CST) - base_min = base_max = base; + base_min = base_max = wi::to_wide (base); else if (TREE_CODE (base) == SSA_NAME && INTEGRAL_TYPE_P (TREE_TYPE (base)) && get_range_info (base, &base_min, &base_max) == VR_RANGE) @@ -3338,7 +3163,7 @@ iv_can_overflow_p (struct loop *loop, tree type, tree base, tree step) return true; if (TREE_CODE (step) == INTEGER_CST) - step_min = step_max = step; + step_min = step_max = wi::to_wide (step); else if (TREE_CODE (step) == SSA_NAME && INTEGRAL_TYPE_P (TREE_TYPE (step)) && get_range_info (step, &step_min, &step_max) == VR_RANGE) @@ -3598,7 +3423,8 @@ simple_iv_with_niters (struct loop *wrto_loop, struct loop *use_loop, extreme = wi::max_value (type); } overflow = false; - extreme = wi::sub (extreme, iv->step, TYPE_SIGN (type), &overflow); + extreme = wi::sub (extreme, wi::to_wide (iv->step), + TYPE_SIGN (type), &overflow); if (overflow) return true; e = fold_build2 (code, boolean_type_node, base, diff --git a/gcc/tree-scalar-evolution.h b/gcc/tree-scalar-evolution.h index c3980d0fbb2..55b8ca49fae 100644 --- a/gcc/tree-scalar-evolution.h +++ b/gcc/tree-scalar-evolution.h @@ -30,7 +30,7 @@ extern void scev_reset (void); extern void scev_reset_htab (void); extern void scev_finalize (void); extern tree analyze_scalar_evolution (struct loop *, tree); -extern tree instantiate_scev (basic_block, struct loop *, tree); +extern tree instantiate_scev (edge, struct loop *, tree); extern tree resolve_mixers (struct loop *, tree, bool *); extern void gather_stats_on_scev_database (void); extern void final_value_replacement_loop (struct loop *); @@ -60,7 +60,7 @@ block_before_loop (loop_p loop) static inline tree instantiate_parameters (struct loop *loop, tree chrec) { - return instantiate_scev (block_before_loop (loop), loop, chrec); + return instantiate_scev (loop_preheader_edge (loop), loop, chrec); } /* Returns the loop of the polynomial chrec CHREC. */ diff --git a/gcc/tree-ssa-address.c b/gcc/tree-ssa-address.c index 5e354a17ce9..14c743414df 100644 --- a/gcc/tree-ssa-address.c +++ b/gcc/tree-ssa-address.c @@ -197,13 +197,13 @@ addr_for_mem_ref (struct mem_address *addr, addr_space_t as, struct mem_addr_template *templ; if (addr->step && !integer_onep (addr->step)) - st = immed_wide_int_const (addr->step, pointer_mode); + st = immed_wide_int_const (wi::to_wide (addr->step), pointer_mode); else st = NULL_RTX; if (addr->offset && !integer_zerop (addr->offset)) { - offset_int dc = offset_int::from (addr->offset, SIGNED); + offset_int dc = offset_int::from (wi::to_wide (addr->offset), SIGNED); off = immed_wide_int_const (dc, pointer_mode); } else diff --git a/gcc/tree-ssa-ccp.c b/gcc/tree-ssa-ccp.c index 9811640c2a5..439bb0a8b40 100644 --- a/gcc/tree-ssa-ccp.c +++ b/gcc/tree-ssa-ccp.c @@ -569,9 +569,11 @@ get_value_from_alignment (tree expr) gcc_assert (TREE_CODE (expr) == ADDR_EXPR); get_pointer_alignment_1 (expr, &align, &bitpos); - val.mask = (POINTER_TYPE_P (type) || TYPE_UNSIGNED (type) - ? wi::mask <widest_int> (TYPE_PRECISION (type), false) - : -1).and_not (align / BITS_PER_UNIT - 1); + val.mask = wi::bit_and_not + (POINTER_TYPE_P (type) || TYPE_UNSIGNED (type) + ? wi::mask <widest_int> (TYPE_PRECISION (type), false) + : -1, + align / BITS_PER_UNIT - 1); val.lattice_val = wi::sext (val.mask, TYPE_PRECISION (type)) == -1 ? VARYING : CONSTANT; if (val.lattice_val == CONSTANT) @@ -949,8 +951,9 @@ ccp_finalize (bool nonzero_p) else { unsigned int precision = TYPE_PRECISION (TREE_TYPE (val->value)); - wide_int nonzero_bits = wide_int::from (val->mask, precision, - UNSIGNED) | val->value; + wide_int nonzero_bits + = (wide_int::from (val->mask, precision, UNSIGNED) + | wi::to_wide (val->value)); nonzero_bits &= get_nonzero_bits (name); set_nonzero_bits (name, nonzero_bits); } @@ -1308,8 +1311,9 @@ bit_value_binop (enum tree_code code, signop sgn, int width, case BIT_IOR_EXPR: /* The mask is constant where there is a known set bit, (m1 | m2) & ~((v1 & ~m1) | (v2 & ~m2)). */ - *mask = (r1mask | r2mask) - .and_not (r1val.and_not (r1mask) | r2val.and_not (r2mask)); + *mask = wi::bit_and_not (r1mask | r2mask, + wi::bit_and_not (r1val, r1mask) + | wi::bit_and_not (r2val, r2mask)); *val = r1val | r2val; break; @@ -1395,7 +1399,8 @@ bit_value_binop (enum tree_code code, signop sgn, int width, { /* Do the addition with unknown bits set to zero, to give carry-ins of zero wherever possible. */ - widest_int lo = r1val.and_not (r1mask) + r2val.and_not (r2mask); + widest_int lo = (wi::bit_and_not (r1val, r1mask) + + wi::bit_and_not (r2val, r2mask)); lo = wi::ext (lo, width, sgn); /* Do the addition with unknown bits set to one, to give carry-ins of one wherever possible. */ @@ -1447,7 +1452,7 @@ bit_value_binop (enum tree_code code, signop sgn, int width, case NE_EXPR: { widest_int m = r1mask | r2mask; - if (r1val.and_not (m) != r2val.and_not (m)) + if (wi::bit_and_not (r1val, m) != wi::bit_and_not (r2val, m)) { *mask = 0; *val = ((code == EQ_EXPR) ? 0 : 1); @@ -1486,8 +1491,10 @@ bit_value_binop (enum tree_code code, signop sgn, int width, /* If we know the most significant bits we know the values value ranges by means of treating varying bits as zero or one. Do a cross comparison of the max/min pairs. */ - maxmin = wi::cmp (o1val | o1mask, o2val.and_not (o2mask), sgn); - minmax = wi::cmp (o1val.and_not (o1mask), o2val | o2mask, sgn); + maxmin = wi::cmp (o1val | o1mask, + wi::bit_and_not (o2val, o2mask), sgn); + minmax = wi::cmp (wi::bit_and_not (o1val, o1mask), + o2val | o2mask, sgn); if (maxmin < 0) /* o1 is less than o2. */ { *mask = 0; @@ -1966,9 +1973,10 @@ evaluate_stmt (gimple *stmt) } else { - if (wi::bit_and_not (val.value, nonzero_bits) != 0) + if (wi::bit_and_not (wi::to_wide (val.value), nonzero_bits) != 0) val.value = wide_int_to_tree (TREE_TYPE (lhs), - nonzero_bits & val.value); + nonzero_bits + & wi::to_wide (val.value)); if (nonzero_bits == 0) val.mask = 0; else diff --git a/gcc/tree-ssa-dse.c b/gcc/tree-ssa-dse.c index 6f58fffc693..9d6cb146436 100644 --- a/gcc/tree-ssa-dse.c +++ b/gcc/tree-ssa-dse.c @@ -131,6 +131,7 @@ valid_ao_ref_for_dse (ao_ref *ref) && ref->max_size != -1 && ref->size != 0 && ref->max_size == ref->size + && ref->offset >= 0 && (ref->offset % BITS_PER_UNIT) == 0 && (ref->size % BITS_PER_UNIT) == 0 && (ref->size != -1)); @@ -492,7 +493,7 @@ live_bytes_read (ao_ref use_ref, ao_ref *ref, sbitmap live) /* Now check if any of the remaining bits in use_ref are set in LIVE. */ unsigned int start = (use_ref.offset - ref->offset) / BITS_PER_UNIT; - unsigned int end = (use_ref.offset + use_ref.size) / BITS_PER_UNIT; + unsigned int end = ((use_ref.offset + use_ref.size) / BITS_PER_UNIT) - 1; return bitmap_bit_in_range_p (live, start, end); } return true; diff --git a/gcc/tree-ssa-forwprop.c b/gcc/tree-ssa-forwprop.c index 11511b4284c..5569b98a548 100644 --- a/gcc/tree-ssa-forwprop.c +++ b/gcc/tree-ssa-forwprop.c @@ -1491,9 +1491,14 @@ defcodefor_name (tree name, enum tree_code *code, tree *arg1, tree *arg2) applied, otherwise return false. We are looking for X with unsigned type T with bitsize B, OP being - +, | or ^, some type T2 wider than T and + +, | or ^, some type T2 wider than T. For: (X << CNT1) OP (X >> CNT2) iff CNT1 + CNT2 == B ((T) ((T2) X << CNT1)) OP ((T) ((T2) X >> CNT2)) iff CNT1 + CNT2 == B + + transform these into: + X r<< CNT1 + + Or for: (X << Y) OP (X >> (B - Y)) (X << (int) Y) OP (X >> (int) (B - Y)) ((T) ((T2) X << Y)) OP ((T) ((T2) X >> (B - Y))) @@ -1503,12 +1508,23 @@ defcodefor_name (tree name, enum tree_code *code, tree *arg1, tree *arg2) ((T) ((T2) X << Y)) | ((T) ((T2) X >> ((-Y) & (B - 1)))) ((T) ((T2) X << (int) Y)) | ((T) ((T2) X >> (int) ((-Y) & (B - 1)))) - and transform these into: - X r<< CNT1 + transform these into: X r<< Y + Or for: + (X << (Y & (B - 1))) | (X >> ((-Y) & (B - 1))) + (X << (int) (Y & (B - 1))) | (X >> (int) ((-Y) & (B - 1))) + ((T) ((T2) X << (Y & (B - 1)))) | ((T) ((T2) X >> ((-Y) & (B - 1)))) + ((T) ((T2) X << (int) (Y & (B - 1)))) \ + | ((T) ((T2) X >> (int) ((-Y) & (B - 1)))) + + transform these into: + X r<< (Y & (B - 1)) + Note, in the patterns with T2 type, the type of OP operands - might be even a signed type, but should have precision B. */ + might be even a signed type, but should have precision B. + Expressions with & (B - 1) should be recognized only if B is + a power of 2. */ static bool simplify_rotate (gimple_stmt_iterator *gsi) @@ -1578,7 +1594,9 @@ simplify_rotate (gimple_stmt_iterator *gsi) def_arg1[i] = tem; } /* Both shifts have to use the same first operand. */ - if (TREE_CODE (def_arg1[0]) != SSA_NAME || def_arg1[0] != def_arg1[1]) + if (!operand_equal_for_phi_arg_p (def_arg1[0], def_arg1[1]) + || !types_compatible_p (TREE_TYPE (def_arg1[0]), + TREE_TYPE (def_arg1[1]))) return false; if (!TYPE_UNSIGNED (TREE_TYPE (def_arg1[0]))) return false; @@ -1649,8 +1667,10 @@ simplify_rotate (gimple_stmt_iterator *gsi) /* The above sequence isn't safe for Y being 0, because then one of the shifts triggers undefined behavior. This alternative is safe even for rotation count of 0. - One shift count is Y and the other (-Y) & (B - 1). */ + One shift count is Y and the other (-Y) & (B - 1). + Or one shift count is Y & (B - 1) and the other (-Y) & (B - 1). */ else if (cdef_code[i] == BIT_AND_EXPR + && pow2p_hwi (TYPE_PRECISION (rtype)) && tree_fits_shwi_p (cdef_arg2[i]) && tree_to_shwi (cdef_arg2[i]) == TYPE_PRECISION (rtype) - 1 @@ -1675,17 +1695,50 @@ simplify_rotate (gimple_stmt_iterator *gsi) rotcnt = tem; break; } - defcodefor_name (tem, &code, &tem, NULL); + tree tem2; + defcodefor_name (tem, &code, &tem2, NULL); if (CONVERT_EXPR_CODE_P (code) - && INTEGRAL_TYPE_P (TREE_TYPE (tem)) - && TYPE_PRECISION (TREE_TYPE (tem)) + && INTEGRAL_TYPE_P (TREE_TYPE (tem2)) + && TYPE_PRECISION (TREE_TYPE (tem2)) > floor_log2 (TYPE_PRECISION (rtype)) - && type_has_mode_precision_p (TREE_TYPE (tem)) - && (tem == def_arg2[1 - i] - || tem == def_arg2_alt[1 - i])) + && type_has_mode_precision_p (TREE_TYPE (tem2))) { - rotcnt = tem; - break; + if (tem2 == def_arg2[1 - i] + || tem2 == def_arg2_alt[1 - i]) + { + rotcnt = tem2; + break; + } + } + else + tem2 = NULL_TREE; + + if (cdef_code[1 - i] == BIT_AND_EXPR + && tree_fits_shwi_p (cdef_arg2[1 - i]) + && tree_to_shwi (cdef_arg2[1 - i]) + == TYPE_PRECISION (rtype) - 1 + && TREE_CODE (cdef_arg1[1 - i]) == SSA_NAME) + { + if (tem == cdef_arg1[1 - i] + || tem2 == cdef_arg1[1 - i]) + { + rotcnt = def_arg2[1 - i]; + break; + } + tree tem3; + defcodefor_name (cdef_arg1[1 - i], &code, &tem3, NULL); + if (CONVERT_EXPR_CODE_P (code) + && INTEGRAL_TYPE_P (TREE_TYPE (tem3)) + && TYPE_PRECISION (TREE_TYPE (tem3)) + > floor_log2 (TYPE_PRECISION (rtype)) + && type_has_mode_precision_p (TREE_TYPE (tem3))) + { + if (tem == tem3 || tem2 == tem3) + { + rotcnt = def_arg2[1 - i]; + break; + } + } } } } diff --git a/gcc/tree-ssa-loop-ivopts.c b/gcc/tree-ssa-loop-ivopts.c index bbea619171a..2a71027a1e2 100644 --- a/gcc/tree-ssa-loop-ivopts.c +++ b/gcc/tree-ssa-loop-ivopts.c @@ -2160,8 +2160,8 @@ constant_multiple_of (tree top, tree bot, widest_int *mul) if (TREE_CODE (bot) != INTEGER_CST) return false; - p0 = widest_int::from (top, SIGNED); - p1 = widest_int::from (bot, SIGNED); + p0 = widest_int::from (wi::to_wide (top), SIGNED); + p1 = widest_int::from (wi::to_wide (bot), SIGNED); if (p1 == 0) return false; *mul = wi::sext (wi::divmod_trunc (p0, p1, SIGNED, &res), precision); diff --git a/gcc/tree-ssa-loop-niter.c b/gcc/tree-ssa-loop-niter.c index 27244eb27c1..6efe67a9531 100644 --- a/gcc/tree-ssa-loop-niter.c +++ b/gcc/tree-ssa-loop-niter.c @@ -92,14 +92,14 @@ split_to_var_and_offset (tree expr, tree *var, mpz_t offset) *var = op0; /* Always sign extend the offset. */ - wi::to_mpz (op1, offset, SIGNED); + wi::to_mpz (wi::to_wide (op1), offset, SIGNED); if (negate) mpz_neg (offset, offset); break; case INTEGER_CST: *var = build_int_cst_type (type, 0); - wi::to_mpz (expr, offset, TYPE_SIGN (type)); + wi::to_mpz (wi::to_wide (expr), offset, TYPE_SIGN (type)); break; default: @@ -164,7 +164,7 @@ refine_value_range_using_guard (tree type, tree var, /* Case of comparing VAR with its below/up bounds. */ mpz_init (valc1); - wi::to_mpz (c1, valc1, TYPE_SIGN (type)); + wi::to_mpz (wi::to_wide (c1), valc1, TYPE_SIGN (type)); if (mpz_cmp (valc1, below) == 0) cmp = GT_EXPR; if (mpz_cmp (valc1, up) == 0) @@ -178,9 +178,9 @@ refine_value_range_using_guard (tree type, tree var, wide_int min = wi::min_value (type); wide_int max = wi::max_value (type); - if (wi::eq_p (c1, min)) + if (wi::to_wide (c1) == min) cmp = GT_EXPR; - if (wi::eq_p (c1, max)) + if (wi::to_wide (c1) == max) cmp = LT_EXPR; } @@ -221,8 +221,8 @@ refine_value_range_using_guard (tree type, tree var, /* Setup range information for varc1. */ if (integer_zerop (varc1)) { - wi::to_mpz (integer_zero_node, minc1, TYPE_SIGN (type)); - wi::to_mpz (integer_zero_node, maxc1, TYPE_SIGN (type)); + wi::to_mpz (0, minc1, TYPE_SIGN (type)); + wi::to_mpz (0, maxc1, TYPE_SIGN (type)); } else if (TREE_CODE (varc1) == SSA_NAME && INTEGRAL_TYPE_P (type) @@ -903,7 +903,8 @@ number_of_iterations_ne_max (mpz_t bnd, bool no_overflow, tree c, tree s, if (integer_onep (s) || (TREE_CODE (c) == INTEGER_CST && TREE_CODE (s) == INTEGER_CST - && wi::mod_trunc (c, s, TYPE_SIGN (type)) == 0) + && wi::mod_trunc (wi::to_wide (c), wi::to_wide (s), + TYPE_SIGN (type)) == 0) || (TYPE_OVERFLOW_UNDEFINED (type) && multiple_of_p (type, c, s))) { @@ -922,7 +923,8 @@ number_of_iterations_ne_max (mpz_t bnd, bool no_overflow, tree c, tree s, the whole # of iterations analysis will fail). */ if (!no_overflow) { - max = wi::mask <widest_int> (TYPE_PRECISION (type) - wi::ctz (s), false); + max = wi::mask <widest_int> (TYPE_PRECISION (type) + - wi::ctz (wi::to_wide (s)), false); wi::to_mpz (max, bnd, UNSIGNED); return; } @@ -938,13 +940,13 @@ number_of_iterations_ne_max (mpz_t bnd, bool no_overflow, tree c, tree s, /* ... then we can strengthen this to C / S, and possibly we can use the upper bound on C given by BNDS. */ if (TREE_CODE (c) == INTEGER_CST) - wi::to_mpz (c, bnd, UNSIGNED); + wi::to_mpz (wi::to_wide (c), bnd, UNSIGNED); else if (bnds_u_valid) mpz_set (bnd, bnds->up); } mpz_init (d); - wi::to_mpz (s, d, UNSIGNED); + wi::to_mpz (wi::to_wide (s), d, UNSIGNED); mpz_fdiv_q (bnd, bnd, d); mpz_clear (d); } @@ -1157,7 +1159,7 @@ number_of_iterations_lt_to_ne (tree type, affine_iv *iv0, affine_iv *iv1, tmod = fold_convert (type1, mod); mpz_init (mmod); - wi::to_mpz (mod, mmod, UNSIGNED); + wi::to_mpz (wi::to_wide (mod), mmod, UNSIGNED); mpz_neg (mmod, mmod); /* If the induction variable does not overflow and the exit is taken, @@ -1543,7 +1545,7 @@ number_of_iterations_lt (struct loop *loop, tree type, affine_iv *iv0, mpz_init (mstep); mpz_init (tmp); - wi::to_mpz (step, mstep, UNSIGNED); + wi::to_mpz (wi::to_wide (step), mstep, UNSIGNED); mpz_add (tmp, bnds->up, mstep); mpz_sub_ui (tmp, tmp, 1); mpz_fdiv_q (tmp, tmp, mstep); @@ -3178,7 +3180,7 @@ get_cst_init_from_scev (tree var, wide_int *init, bool is_min) if (is_min == tree_int_cst_sign_bit (iv.step)) return false; - *init = iv.base; + *init = wi::to_wide (iv.base); return true; } @@ -3225,7 +3227,7 @@ record_nonwrapping_iv (struct loop *loop, tree base, tree step, gimple *stmt, && INTEGRAL_TYPE_P (TREE_TYPE (orig_base)) && (get_range_info (orig_base, &min, &max) == VR_RANGE || get_cst_init_from_scev (orig_base, &max, false)) - && wi::gts_p (high, max)) + && wi::gts_p (wi::to_wide (high), max)) base = wide_int_to_tree (unsigned_type, max); else if (TREE_CODE (base) != INTEGER_CST && dominated_by_p (CDI_DOMINATORS, @@ -3243,7 +3245,7 @@ record_nonwrapping_iv (struct loop *loop, tree base, tree step, gimple *stmt, && INTEGRAL_TYPE_P (TREE_TYPE (orig_base)) && (get_range_info (orig_base, &min, &max) == VR_RANGE || get_cst_init_from_scev (orig_base, &min, true)) - && wi::gts_p (min, low)) + && wi::gts_p (min, wi::to_wide (low))) base = wide_int_to_tree (unsigned_type, min); else if (TREE_CODE (base) != INTEGER_CST && dominated_by_p (CDI_DOMINATORS, @@ -3442,7 +3444,8 @@ infer_loop_bounds_from_pointer_arith (struct loop *loop, gimple *stmt) if (TYPE_PRECISION (type) != TYPE_PRECISION (TREE_TYPE (var))) return; - scev = instantiate_parameters (loop, analyze_scalar_evolution (loop, def)); + struct loop *uloop = loop_containing_stmt (stmt); + scev = instantiate_parameters (loop, analyze_scalar_evolution (uloop, def)); if (chrec_contains_undetermined (scev)) return; @@ -4499,19 +4502,15 @@ scev_var_range_cant_overflow (tree var, tree step, struct loop *loop) MIN - type_MIN >= |step| ; if step < 0. Or VAR must take value outside of value range, which is not true. */ - step_wi = step; + step_wi = wi::to_wide (step); type = TREE_TYPE (var); if (tree_int_cst_sign_bit (step)) { - diff = lower_bound_in_type (type, type); - diff = minv - diff; + diff = minv - wi::to_wide (lower_bound_in_type (type, type)); step_wi = - step_wi; } else - { - diff = upper_bound_in_type (type, type); - diff = diff - maxv; - } + diff = wi::to_wide (upper_bound_in_type (type, type)) - maxv; return (wi::geu_p (diff, step_wi)); } diff --git a/gcc/tree-ssa-loop-prefetch.c b/gcc/tree-ssa-loop-prefetch.c index ecf14d108fe..67767e1516a 100644 --- a/gcc/tree-ssa-loop-prefetch.c +++ b/gcc/tree-ssa-loop-prefetch.c @@ -1632,7 +1632,8 @@ determine_loop_nest_reuse (struct loop *loop, struct mem_ref_group *refs, for (gr = refs; gr; gr = gr->next) for (ref = gr->refs; ref; ref = ref->next) { - dr = create_data_ref (nest, loop_containing_stmt (ref->stmt), + dr = create_data_ref (loop_preheader_edge (nest), + loop_containing_stmt (ref->stmt), ref->mem, ref->stmt, !ref->write_p, false); if (dr) diff --git a/gcc/tree-ssa-math-opts.c b/gcc/tree-ssa-math-opts.c index 818290cf47c..17d62a82e8b 100644 --- a/gcc/tree-ssa-math-opts.c +++ b/gcc/tree-ssa-math-opts.c @@ -2138,7 +2138,7 @@ find_bswap_or_nop_load (gimple *stmt, tree ref, struct symbolic_number *n) if (wi::neg_p (bit_offset)) { offset_int mask = wi::mask <offset_int> (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; diff --git a/gcc/tree-ssa-phiopt.c b/gcc/tree-ssa-phiopt.c index f5c07dc27f1..c3bdc9e09a7 100644 --- a/gcc/tree-ssa-phiopt.c +++ b/gcc/tree-ssa-phiopt.c @@ -995,11 +995,13 @@ value_replacement (basic_block cond_bb, basic_block middle_bb, } - /* Now optimize (x != 0) ? x + y : y to just y. - The following condition is too restrictive, there can easily be another - stmt in middle_bb, for instance a CONVERT_EXPR for the second argument. */ - gimple *assign = last_and_only_stmt (middle_bb); - if (!assign || gimple_code (assign) != GIMPLE_ASSIGN + /* Now optimize (x != 0) ? x + y : y to just x + y. */ + gsi = gsi_last_nondebug_bb (middle_bb); + if (gsi_end_p (gsi)) + return 0; + + gimple *assign = gsi_stmt (gsi); + if (!is_gimple_assign (assign) || gimple_assign_rhs_class (assign) != GIMPLE_BINARY_RHS || (!INTEGRAL_TYPE_P (TREE_TYPE (arg0)) && !POINTER_TYPE_P (TREE_TYPE (arg0)))) @@ -1009,6 +1011,71 @@ value_replacement (basic_block cond_bb, basic_block middle_bb, if (!gimple_seq_empty_p (phi_nodes (middle_bb))) return 0; + /* Allow up to 2 cheap preparation statements that prepare argument + for assign, e.g.: + if (y_4 != 0) + goto <bb 3>; + else + goto <bb 4>; + <bb 3>: + _1 = (int) y_4; + iftmp.0_6 = x_5(D) r<< _1; + <bb 4>: + # iftmp.0_2 = PHI <iftmp.0_6(3), x_5(D)(2)> + or: + if (y_3(D) == 0) + goto <bb 4>; + else + goto <bb 3>; + <bb 3>: + y_4 = y_3(D) & 31; + _1 = (int) y_4; + _6 = x_5(D) r<< _1; + <bb 4>: + # _2 = PHI <x_5(D)(2), _6(3)> */ + gimple *prep_stmt[2] = { NULL, NULL }; + int prep_cnt; + for (prep_cnt = 0; ; prep_cnt++) + { + gsi_prev_nondebug (&gsi); + if (gsi_end_p (gsi)) + break; + + gimple *g = gsi_stmt (gsi); + if (gimple_code (g) == GIMPLE_LABEL) + break; + + if (prep_cnt == 2 || !is_gimple_assign (g)) + return 0; + + tree lhs = gimple_assign_lhs (g); + tree rhs1 = gimple_assign_rhs1 (g); + use_operand_p use_p; + gimple *use_stmt; + if (TREE_CODE (lhs) != SSA_NAME + || TREE_CODE (rhs1) != SSA_NAME + || !INTEGRAL_TYPE_P (TREE_TYPE (lhs)) + || !INTEGRAL_TYPE_P (TREE_TYPE (rhs1)) + || !single_imm_use (lhs, &use_p, &use_stmt) + || use_stmt != (prep_cnt ? prep_stmt[prep_cnt - 1] : assign)) + return 0; + switch (gimple_assign_rhs_code (g)) + { + CASE_CONVERT: + break; + case PLUS_EXPR: + case BIT_AND_EXPR: + case BIT_IOR_EXPR: + case BIT_XOR_EXPR: + if (TREE_CODE (gimple_assign_rhs2 (g)) != INTEGER_CST) + return 0; + break; + default: + return 0; + } + prep_stmt[prep_cnt] = g; + } + /* Only transform if it removes the condition. */ if (!single_non_singleton_phi_for_edges (phi_nodes (gimple_bb (phi)), e0, e1)) return 0; @@ -1019,7 +1086,7 @@ value_replacement (basic_block cond_bb, basic_block middle_bb, && profile_status_for_fn (cfun) != PROFILE_ABSENT && EDGE_PRED (middle_bb, 0)->probability < profile_probability::even () /* If assign is cheap, there is no point avoiding it. */ - && estimate_num_insns (assign, &eni_time_weights) + && estimate_num_insns (bb_seq (middle_bb), &eni_time_weights) >= 3 * estimate_num_insns (cond, &eni_time_weights)) return 0; @@ -1030,6 +1097,32 @@ value_replacement (basic_block cond_bb, basic_block middle_bb, tree cond_lhs = gimple_cond_lhs (cond); tree cond_rhs = gimple_cond_rhs (cond); + /* Propagate the cond_rhs constant through preparation stmts, + make sure UB isn't invoked while doing that. */ + for (int i = prep_cnt - 1; i >= 0; --i) + { + gimple *g = prep_stmt[i]; + tree grhs1 = gimple_assign_rhs1 (g); + if (!operand_equal_for_phi_arg_p (cond_lhs, grhs1)) + return 0; + cond_lhs = gimple_assign_lhs (g); + cond_rhs = fold_convert (TREE_TYPE (grhs1), cond_rhs); + if (TREE_CODE (cond_rhs) != INTEGER_CST + || TREE_OVERFLOW (cond_rhs)) + return 0; + if (gimple_assign_rhs_class (g) == GIMPLE_BINARY_RHS) + { + cond_rhs = int_const_binop (gimple_assign_rhs_code (g), cond_rhs, + gimple_assign_rhs2 (g)); + if (TREE_OVERFLOW (cond_rhs)) + return 0; + } + cond_rhs = fold_convert (TREE_TYPE (cond_lhs), cond_rhs); + if (TREE_CODE (cond_rhs) != INTEGER_CST + || TREE_OVERFLOW (cond_rhs)) + return 0; + } + if (((code == NE_EXPR && e1 == false_edge) || (code == EQ_EXPR && e1 == true_edge)) && arg0 == lhs @@ -1071,7 +1164,15 @@ value_replacement (basic_block cond_bb, basic_block middle_bb, duplicate_ssa_name_range_info (lhs, SSA_NAME_RANGE_TYPE (phires), phires_range_info); } - gimple_stmt_iterator gsi_from = gsi_for_stmt (assign); + gimple_stmt_iterator gsi_from; + for (int i = prep_cnt - 1; i >= 0; --i) + { + tree plhs = gimple_assign_lhs (prep_stmt[i]); + SSA_NAME_RANGE_INFO (plhs) = NULL; + gsi_from = gsi_for_stmt (prep_stmt[i]); + gsi_move_before (&gsi_from, &gsi); + } + gsi_from = gsi_for_stmt (assign); gsi_move_before (&gsi_from, &gsi); replace_phi_edge_with_variable (cond_bb, e1, phi, lhs); return 2; @@ -1123,7 +1224,8 @@ minmax_replacement (basic_block cond_bb, basic_block middle_bb, if (cmp == LT_EXPR) { bool overflow; - wide_int alt = wi::sub (larger, 1, TYPE_SIGN (TREE_TYPE (larger)), + wide_int alt = wi::sub (wi::to_wide (larger), 1, + TYPE_SIGN (TREE_TYPE (larger)), &overflow); if (! overflow) alt_larger = wide_int_to_tree (TREE_TYPE (larger), alt); @@ -1131,7 +1233,8 @@ minmax_replacement (basic_block cond_bb, basic_block middle_bb, else { bool overflow; - wide_int alt = wi::add (larger, 1, TYPE_SIGN (TREE_TYPE (larger)), + wide_int alt = wi::add (wi::to_wide (larger), 1, + TYPE_SIGN (TREE_TYPE (larger)), &overflow); if (! overflow) alt_larger = wide_int_to_tree (TREE_TYPE (larger), alt); @@ -1149,7 +1252,8 @@ minmax_replacement (basic_block cond_bb, basic_block middle_bb, if (cmp == GT_EXPR) { bool overflow; - wide_int alt = wi::add (smaller, 1, TYPE_SIGN (TREE_TYPE (smaller)), + wide_int alt = wi::add (wi::to_wide (smaller), 1, + TYPE_SIGN (TREE_TYPE (smaller)), &overflow); if (! overflow) alt_smaller = wide_int_to_tree (TREE_TYPE (smaller), alt); @@ -1157,7 +1261,8 @@ minmax_replacement (basic_block cond_bb, basic_block middle_bb, else { bool overflow; - wide_int alt = wi::sub (smaller, 1, TYPE_SIGN (TREE_TYPE (smaller)), + wide_int alt = wi::sub (wi::to_wide (smaller), 1, + TYPE_SIGN (TREE_TYPE (smaller)), &overflow); if (! overflow) alt_smaller = wide_int_to_tree (TREE_TYPE (smaller), alt); diff --git a/gcc/tree-ssa-pre.c b/gcc/tree-ssa-pre.c index 364272ddf0e..5eb47a9d6d5 100644 --- a/gcc/tree-ssa-pre.c +++ b/gcc/tree-ssa-pre.c @@ -4020,21 +4020,25 @@ compute_avail (void) { ref->set = set; if (ref1->opcode == MEM_REF) - ref1->op0 = wide_int_to_tree (TREE_TYPE (ref2->op0), - ref1->op0); + ref1->op0 + = wide_int_to_tree (TREE_TYPE (ref2->op0), + wi::to_wide (ref1->op0)); else - ref1->op2 = wide_int_to_tree (TREE_TYPE (ref2->op2), - ref1->op2); + ref1->op2 + = wide_int_to_tree (TREE_TYPE (ref2->op2), + wi::to_wide (ref1->op2)); } else { ref->set = 0; if (ref1->opcode == MEM_REF) - ref1->op0 = wide_int_to_tree (ptr_type_node, - ref1->op0); + ref1->op0 + = wide_int_to_tree (ptr_type_node, + wi::to_wide (ref1->op0)); else - ref1->op2 = wide_int_to_tree (ptr_type_node, - ref1->op2); + ref1->op2 + = wide_int_to_tree (ptr_type_node, + wi::to_wide (ref1->op2)); } operands.release (); diff --git a/gcc/tree-ssa-reassoc.c b/gcc/tree-ssa-reassoc.c index cc57ae320a3..e0e64e16eba 100644 --- a/gcc/tree-ssa-reassoc.c +++ b/gcc/tree-ssa-reassoc.c @@ -5910,7 +5910,7 @@ reassociate_bb (basic_block bb) move it to the front. This helps ensure that we generate (X & Y) & C rather than (X & C) & Y. The former will often match a canonical bit test when we get to RTL. */ - if (ops.length () != 2 + if (ops.length () > 2 && (rhs_code == BIT_AND_EXPR || rhs_code == BIT_IOR_EXPR || rhs_code == BIT_XOR_EXPR) diff --git a/gcc/tree-ssa-sccvn.c b/gcc/tree-ssa-sccvn.c index 59397495abf..d27bcee8262 100644 --- a/gcc/tree-ssa-sccvn.c +++ b/gcc/tree-ssa-sccvn.c @@ -1167,7 +1167,7 @@ vn_reference_fold_indirect (vec<vn_reference_op_s> *ops, gcc_checking_assert (addr_base && TREE_CODE (addr_base) != MEM_REF); if (addr_base != TREE_OPERAND (op->op0, 0)) { - offset_int off = offset_int::from (mem_op->op0, SIGNED); + offset_int off = offset_int::from (wi::to_wide (mem_op->op0), SIGNED); off += addr_offset; mem_op->op0 = wide_int_to_tree (TREE_TYPE (mem_op->op0), off); op->op0 = build_fold_addr_expr (addr_base); @@ -1202,7 +1202,7 @@ vn_reference_maybe_forwprop_address (vec<vn_reference_op_s> *ops, && code != POINTER_PLUS_EXPR) return false; - off = offset_int::from (mem_op->op0, SIGNED); + off = offset_int::from (wi::to_wide (mem_op->op0), SIGNED); /* The only thing we have to do is from &OBJ.foo.bar add the offset from .foo.bar to the preceding MEM_REF offset and replace the @@ -1235,8 +1235,9 @@ vn_reference_maybe_forwprop_address (vec<vn_reference_op_s> *ops, && tem[tem.length () - 2].opcode == MEM_REF) { vn_reference_op_t new_mem_op = &tem[tem.length () - 2]; - new_mem_op->op0 = wide_int_to_tree (TREE_TYPE (mem_op->op0), - new_mem_op->op0); + new_mem_op->op0 + = wide_int_to_tree (TREE_TYPE (mem_op->op0), + wi::to_wide (new_mem_op->op0)); } else gcc_assert (tem.last ().opcode == STRING_CST); @@ -3537,7 +3538,7 @@ valueized_wider_op (tree wide_type, tree op) /* For constants simply extend it. */ if (TREE_CODE (op) == INTEGER_CST) - return wide_int_to_tree (wide_type, op); + return wide_int_to_tree (wide_type, wi::to_wide (op)); return NULL_TREE; } diff --git a/gcc/tree-ssa-structalias.c b/gcc/tree-ssa-structalias.c index 2cca970f1e5..89135eaf312 100644 --- a/gcc/tree-ssa-structalias.c +++ b/gcc/tree-ssa-structalias.c @@ -2849,41 +2849,33 @@ lookup_vi_for_tree (tree t) static const char * alias_get_name (tree decl) { - const char *res = NULL; - char *temp; - - if (!dump_file) - return "NULL"; - - if (TREE_CODE (decl) == SSA_NAME) - { - res = get_name (decl); - if (res) - temp = xasprintf ("%s_%u", res, SSA_NAME_VERSION (decl)); - else - temp = xasprintf ("_%u", SSA_NAME_VERSION (decl)); - res = ggc_strdup (temp); - free (temp); - } - else if (DECL_P (decl)) + const char *res = "NULL"; + if (dump_file) { - if (DECL_ASSEMBLER_NAME_SET_P (decl)) - res = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (decl)); - else + char *temp = NULL; + if (TREE_CODE (decl) == SSA_NAME) + { + res = get_name (decl); + temp = xasprintf ("%s_%u", res ? res : "", SSA_NAME_VERSION (decl)); + } + else if (HAS_DECL_ASSEMBLER_NAME_P (decl) + && DECL_ASSEMBLER_NAME_SET_P (decl)) + res = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME_RAW (decl)); + else if (DECL_P (decl)) { res = get_name (decl); if (!res) - { - temp = xasprintf ("D.%u", DECL_UID (decl)); - res = ggc_strdup (temp); - free (temp); - } + temp = xasprintf ("D.%u", DECL_UID (decl)); + } + + if (temp) + { + res = ggc_strdup (temp); + free (temp); } } - if (res != NULL) - return res; - return "NULL"; + return res; } /* Find the variable id for tree T in the map. @@ -3098,7 +3090,7 @@ get_constraint_for_ptr_offset (tree ptr, tree offset, else { /* Sign-extend the offset. */ - offset_int soffset = offset_int::from (offset, SIGNED); + offset_int soffset = offset_int::from (wi::to_wide (offset), SIGNED); if (!wi::fits_shwi_p (soffset)) rhsoffset = UNKNOWN_OFFSET; else diff --git a/gcc/tree-ssa-uninit.c b/gcc/tree-ssa-uninit.c index 67f0d840bf5..4096ded7ea2 100644 --- a/gcc/tree-ssa-uninit.c +++ b/gcc/tree-ssa-uninit.c @@ -1474,8 +1474,8 @@ is_pred_expr_subset_of (pred_info expr1, pred_info expr2) code2 = invert_tree_comparison (code2, false); if ((code1 == EQ_EXPR || code1 == BIT_AND_EXPR) && code2 == BIT_AND_EXPR) - return wi::eq_p (expr1.pred_rhs, - wi::bit_and (expr1.pred_rhs, expr2.pred_rhs)); + return (wi::to_wide (expr1.pred_rhs) + == (wi::to_wide (expr1.pred_rhs) & wi::to_wide (expr2.pred_rhs))); if (code1 != code2 && code2 != NE_EXPR) return false; diff --git a/gcc/tree-ssanames.c b/gcc/tree-ssanames.c index 5c96075a05e..6d344ad5309 100644 --- a/gcc/tree-ssanames.c +++ b/gcc/tree-ssanames.c @@ -454,8 +454,8 @@ set_nonzero_bits (tree name, const wide_int_ref &mask) if (mask == -1) return; set_range_info_raw (name, VR_RANGE, - TYPE_MIN_VALUE (TREE_TYPE (name)), - TYPE_MAX_VALUE (TREE_TYPE (name))); + wi::to_wide (TYPE_MIN_VALUE (TREE_TYPE (name))), + wi::to_wide (TYPE_MAX_VALUE (TREE_TYPE (name)))); } range_info_def *ri = SSA_NAME_RANGE_INFO (name); ri->set_nonzero_bits (mask); @@ -468,7 +468,7 @@ wide_int get_nonzero_bits (const_tree name) { if (TREE_CODE (name) == INTEGER_CST) - return name; + return wi::to_wide (name); /* Use element_precision instead of TYPE_PRECISION so complex and vector types get a non-zero precision. */ diff --git a/gcc/tree-switch-conversion.c b/gcc/tree-switch-conversion.c index 19f0a73fbe2..dc9fc84c6a0 100644 --- a/gcc/tree-switch-conversion.c +++ b/gcc/tree-switch-conversion.c @@ -655,8 +655,7 @@ collect_switch_conv_info (gswitch *swtch, struct switch_conv_info *info) for (i = 2; i < branch_num; i++) { tree elt = gimple_switch_label (swtch, i); - wide_int w = last; - if (w + 1 != CASE_LOW (elt)) + if (wi::to_wide (last) + 1 != wi::to_wide (CASE_LOW (elt))) { info->contiguous_range = false; break; @@ -1065,7 +1064,7 @@ array_value_type (gswitch *swtch, tree type, int num, if (TREE_CODE (elt->value) != INTEGER_CST) return type; - cst = elt->value; + cst = wi::to_wide (elt->value); while (1) { unsigned int prec = GET_MODE_BITSIZE (mode); @@ -1778,11 +1777,12 @@ dump_case_nodes (FILE *f, case_node *root, int indent_step, int indent_level) fputs (";; ", f); fprintf (f, "%*s", indent_step * indent_level, ""); - print_dec (root->low, f, TYPE_SIGN (TREE_TYPE (root->low))); + print_dec (wi::to_wide (root->low), f, TYPE_SIGN (TREE_TYPE (root->low))); if (!tree_int_cst_equal (root->low, root->high)) { fprintf (f, " ... "); - print_dec (root->high, f, TYPE_SIGN (TREE_TYPE (root->high))); + print_dec (wi::to_wide (root->high), f, + TYPE_SIGN (TREE_TYPE (root->high))); } fputs ("\n", f); @@ -2113,7 +2113,7 @@ try_switch_expansion (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, @@ -2122,7 +2122,7 @@ try_switch_expansion (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)); basic_block case_bb = label_to_block_fn (cfun, lab); edge case_edge = find_edge (bb, case_bb); diff --git a/gcc/tree-vect-loop-manip.c b/gcc/tree-vect-loop-manip.c index 5787d53a83a..910334f664e 100644 --- a/gcc/tree-vect-loop-manip.c +++ b/gcc/tree-vect-loop-manip.c @@ -117,8 +117,6 @@ rename_variables_in_bb (basic_block bb, bool rename_from_outer_loop) || single_pred (e->src) != outer_loop->header) continue; } - else - continue; } } for (gphi_iterator gsi = gsi_start_phis (bb); !gsi_end_p (gsi); @@ -496,7 +494,8 @@ slpeel_tree_duplicate_loop_to_edge_cfg (struct loop *loop, loop_preheader_edge (new_loop)->src); } - for (unsigned i = 0; i < scalar_loop->num_nodes + 1; i++) + /* Skip new preheader since it's deleted if copy loop is added at entry. */ + for (unsigned i = (at_exit ? 0 : 1); i < scalar_loop->num_nodes + 1; i++) rename_variables_in_bb (new_bbs[i], duplicate_outer_loop); if (scalar_loop != loop) @@ -1233,9 +1232,11 @@ vect_gen_vector_loop_niters (loop_vec_info loop_vinfo, tree niters, /* Peeling algorithm guarantees that vector loop bound is at least ONE, we set range information to make niters analyzer's life easier. */ if (stmts != NULL) - set_range_info (niters_vector, VR_RANGE, build_int_cst (type, 1), - fold_build2 (RSHIFT_EXPR, type, - TYPE_MAX_VALUE (type), log_vf)); + set_range_info (niters_vector, VR_RANGE, + wi::to_wide (build_int_cst (type, 1)), + wi::to_wide (fold_build2 (RSHIFT_EXPR, type, + TYPE_MAX_VALUE (type), + log_vf))); } *niters_vector_ptr = niters_vector; @@ -1788,7 +1789,8 @@ vect_do_peeling (loop_vec_info loop_vinfo, tree niters, tree nitersm1, least VF, so set range information for newly generated var. */ if (new_var_p) set_range_info (niters, VR_RANGE, - build_int_cst (type, vf), TYPE_MAX_VALUE (type)); + wi::to_wide (build_int_cst (type, vf)), + wi::to_wide (TYPE_MAX_VALUE (type))); /* Prolog iterates at most bound_prolog times, latch iterates at most bound_prolog - 1 times. */ diff --git a/gcc/tree-vect-patterns.c b/gcc/tree-vect-patterns.c index ed0879eddf9..e4051b68dd0 100644 --- a/gcc/tree-vect-patterns.c +++ b/gcc/tree-vect-patterns.c @@ -3714,7 +3714,7 @@ vect_recog_bool_pattern (vec<gimple *> *stmts, tree *type_in, vectorized matches the vector type of the result in size and number of elements. */ unsigned prec - = wi::udiv_trunc (TYPE_SIZE (vectype), + = wi::udiv_trunc (wi::to_wide (TYPE_SIZE (vectype)), TYPE_VECTOR_SUBPARTS (vectype)).to_uhwi (); tree type = build_nonstandard_integer_type (prec, diff --git a/gcc/tree-vect-stmts.c b/gcc/tree-vect-stmts.c index f986b753c83..d3fa5164238 100644 --- a/gcc/tree-vect-stmts.c +++ b/gcc/tree-vect-stmts.c @@ -7712,11 +7712,9 @@ vectorizable_load (gimple *stmt, gimple_stmt_iterator *gsi, gimple **vec_stmt, if (group_gap_adj != 0 && ! slp_perm && group_elt == group_size - group_gap_adj) { - bool ovf; - tree bump - = wide_int_to_tree (sizetype, - wi::smul (TYPE_SIZE_UNIT (elem_type), - group_gap_adj, &ovf)); + wide_int bump_val = (wi::to_wide (TYPE_SIZE_UNIT (elem_type)) + * group_gap_adj); + tree bump = wide_int_to_tree (sizetype, bump_val); dataref_ptr = bump_vector_ptr (dataref_ptr, ptr_incr, gsi, stmt, bump); group_elt = 0; @@ -7726,11 +7724,9 @@ vectorizable_load (gimple *stmt, gimple_stmt_iterator *gsi, gimple **vec_stmt, elements loaded for a permuted SLP load. */ if (group_gap_adj != 0 && slp_perm) { - bool ovf; - tree bump - = wide_int_to_tree (sizetype, - wi::smul (TYPE_SIZE_UNIT (elem_type), - group_gap_adj, &ovf)); + wide_int bump_val = (wi::to_wide (TYPE_SIZE_UNIT (elem_type)) + * group_gap_adj); + tree bump = wide_int_to_tree (sizetype, bump_val); dataref_ptr = bump_vector_ptr (dataref_ptr, ptr_incr, gsi, stmt, bump); } diff --git a/gcc/tree-vrp.c b/gcc/tree-vrp.c index 3dba3562789..2c86b8e5c91 100644 --- a/gcc/tree-vrp.c +++ b/gcc/tree-vrp.c @@ -1072,7 +1072,8 @@ compare_values_warnv (tree val1, tree val2, bool *strict_overflow_p) if (!inv2) inv2 = build_int_cst (TREE_TYPE (val2), 0); - return wi::cmp (inv1, inv2, TYPE_SIGN (TREE_TYPE (val1))); + return wi::cmp (wi::to_wide (inv1), wi::to_wide (inv2), + TYPE_SIGN (TREE_TYPE (val1))); } const bool cst1 = is_gimple_min_invariant (val1); @@ -1099,10 +1100,11 @@ compare_values_warnv (tree val1, tree val2, bool *strict_overflow_p) /* Compute the difference between the constants. If it overflows or underflows, this means that we can trivially compare the NAME with it and, consequently, the two values with each other. */ - wide_int diff = wi::sub (cst, inv); - if (wi::cmp (0, inv, sgn) != wi::cmp (diff, cst, sgn)) + wide_int diff = wi::to_wide (cst) - wi::to_wide (inv); + if (wi::cmp (0, wi::to_wide (inv), sgn) + != wi::cmp (diff, wi::to_wide (cst), sgn)) { - const int res = wi::cmp (cst, inv, sgn); + const int res = wi::cmp (wi::to_wide (cst), wi::to_wide (inv), sgn); return cst1 ? res : -res; } @@ -1635,14 +1637,15 @@ vrp_int_const_binop (enum tree_code code, tree val1, tree val2, /* It's unclear from the C standard whether shifts can overflow. The following code ignores overflow; perhaps a C standard interpretation ruling is needed. */ - res = wi::rshift (val1, wval2, sign); + res = wi::rshift (wi::to_wide (val1), wval2, sign); else - res = wi::lshift (val1, wval2); + res = wi::lshift (wi::to_wide (val1), wval2); break; } case MULT_EXPR: - res = wi::mul (val1, val2, sign, &overflow); + res = wi::mul (wi::to_wide (val1), + wi::to_wide (val2), sign, &overflow); break; case TRUNC_DIV_EXPR: @@ -1653,7 +1656,8 @@ vrp_int_const_binop (enum tree_code code, tree val1, tree val2, return res; } else - res = wi::div_trunc (val1, val2, sign, &overflow); + res = wi::div_trunc (wi::to_wide (val1), + wi::to_wide (val2), sign, &overflow); break; case FLOOR_DIV_EXPR: @@ -1662,7 +1666,8 @@ vrp_int_const_binop (enum tree_code code, tree val1, tree val2, *overflow_p = true; return res; } - res = wi::div_floor (val1, val2, sign, &overflow); + res = wi::div_floor (wi::to_wide (val1), + wi::to_wide (val2), sign, &overflow); break; case CEIL_DIV_EXPR: @@ -1671,7 +1676,8 @@ vrp_int_const_binop (enum tree_code code, tree val1, tree val2, *overflow_p = true; return res; } - res = wi::div_ceil (val1, val2, sign, &overflow); + res = wi::div_ceil (wi::to_wide (val1), + wi::to_wide (val2), sign, &overflow); break; case ROUND_DIV_EXPR: @@ -1680,7 +1686,8 @@ vrp_int_const_binop (enum tree_code code, tree val1, tree val2, *overflow_p = 0; return res; } - res = wi::div_round (val1, val2, sign, &overflow); + res = wi::div_round (wi::to_wide (val1), + wi::to_wide (val2), sign, &overflow); break; default: @@ -1755,21 +1762,21 @@ zero_nonzero_bits_from_vr (const tree expr_type, if (range_int_cst_singleton_p (vr)) { - *may_be_nonzero = vr->min; + *may_be_nonzero = wi::to_wide (vr->min); *must_be_nonzero = *may_be_nonzero; } else if (tree_int_cst_sgn (vr->min) >= 0 || tree_int_cst_sgn (vr->max) < 0) { - wide_int xor_mask = wi::bit_xor (vr->min, vr->max); - *may_be_nonzero = wi::bit_or (vr->min, vr->max); - *must_be_nonzero = wi::bit_and (vr->min, vr->max); + wide_int xor_mask = wi::to_wide (vr->min) ^ wi::to_wide (vr->max); + *may_be_nonzero = wi::to_wide (vr->min) | wi::to_wide (vr->max); + *must_be_nonzero = wi::to_wide (vr->min) & wi::to_wide (vr->max); if (xor_mask != 0) { wide_int mask = wi::mask (wi::floor_log2 (xor_mask), false, may_be_nonzero->get_precision ()); *may_be_nonzero = *may_be_nonzero | mask; - *must_be_nonzero = must_be_nonzero->and_not (mask); + *must_be_nonzero = wi::bit_and_not (*must_be_nonzero, mask); } } @@ -1801,12 +1808,12 @@ ranges_from_anti_range (value_range *ar, { vr0->type = VR_RANGE; vr0->min = vrp_val_min (type); - vr0->max = wide_int_to_tree (type, wi::sub (ar->min, 1)); + vr0->max = wide_int_to_tree (type, wi::to_wide (ar->min) - 1); } if (!vrp_val_is_max (ar->max)) { vr1->type = VR_RANGE; - vr1->min = wide_int_to_tree (type, wi::add (ar->max, 1)); + vr1->min = wide_int_to_tree (type, wi::to_wide (ar->max) + 1); vr1->max = vrp_val_max (type); } if (vr0->type == VR_UNDEFINED) @@ -2171,8 +2178,8 @@ extract_range_from_binary_expr_1 (value_range *vr, } else { - type_min = vrp_val_min (expr_type); - type_max = vrp_val_max (expr_type); + type_min = wi::to_wide (vrp_val_min (expr_type)); + type_max = wi::to_wide (vrp_val_max (expr_type)); } /* Combine the lower bounds, if any. */ @@ -2180,39 +2187,42 @@ extract_range_from_binary_expr_1 (value_range *vr, { if (minus_p) { - wmin = wi::sub (min_op0, min_op1); + wmin = wi::to_wide (min_op0) - wi::to_wide (min_op1); /* Check for overflow. */ - if (wi::cmp (0, min_op1, sgn) - != wi::cmp (wmin, min_op0, sgn)) - min_ovf = wi::cmp (min_op0, min_op1, sgn); + if (wi::cmp (0, wi::to_wide (min_op1), sgn) + != wi::cmp (wmin, wi::to_wide (min_op0), sgn)) + min_ovf = wi::cmp (wi::to_wide (min_op0), + wi::to_wide (min_op1), sgn); } else { - wmin = wi::add (min_op0, min_op1); + wmin = wi::to_wide (min_op0) + wi::to_wide (min_op1); /* Check for overflow. */ - if (wi::cmp (min_op1, 0, sgn) - != wi::cmp (wmin, min_op0, sgn)) - min_ovf = wi::cmp (min_op0, wmin, sgn); + if (wi::cmp (wi::to_wide (min_op1), 0, sgn) + != wi::cmp (wmin, wi::to_wide (min_op0), sgn)) + min_ovf = wi::cmp (wi::to_wide (min_op0), wmin, sgn); } } else if (min_op0) - wmin = min_op0; + wmin = wi::to_wide (min_op0); else if (min_op1) { if (minus_p) { - wmin = wi::neg (min_op1); + wmin = -wi::to_wide (min_op1); /* Check for overflow. */ - if (sgn == SIGNED && wi::neg_p (min_op1) && wi::neg_p (wmin)) + if (sgn == SIGNED + && wi::neg_p (wi::to_wide (min_op1)) + && wi::neg_p (wmin)) min_ovf = 1; - else if (sgn == UNSIGNED && wi::ne_p (min_op1, 0)) + else if (sgn == UNSIGNED && wi::to_wide (min_op1) != 0) min_ovf = -1; } else - wmin = min_op1; + wmin = wi::to_wide (min_op1); } else wmin = wi::shwi (0, prec); @@ -2222,38 +2232,41 @@ extract_range_from_binary_expr_1 (value_range *vr, { if (minus_p) { - wmax = wi::sub (max_op0, max_op1); + wmax = wi::to_wide (max_op0) - wi::to_wide (max_op1); /* Check for overflow. */ - if (wi::cmp (0, max_op1, sgn) - != wi::cmp (wmax, max_op0, sgn)) - max_ovf = wi::cmp (max_op0, max_op1, sgn); + if (wi::cmp (0, wi::to_wide (max_op1), sgn) + != wi::cmp (wmax, wi::to_wide (max_op0), sgn)) + max_ovf = wi::cmp (wi::to_wide (max_op0), + wi::to_wide (max_op1), sgn); } else { - wmax = wi::add (max_op0, max_op1); + wmax = wi::to_wide (max_op0) + wi::to_wide (max_op1); - if (wi::cmp (max_op1, 0, sgn) - != wi::cmp (wmax, max_op0, sgn)) - max_ovf = wi::cmp (max_op0, wmax, sgn); + if (wi::cmp (wi::to_wide (max_op1), 0, sgn) + != wi::cmp (wmax, wi::to_wide (max_op0), sgn)) + max_ovf = wi::cmp (wi::to_wide (max_op0), wmax, sgn); } } else if (max_op0) - wmax = max_op0; + wmax = wi::to_wide (max_op0); else if (max_op1) { if (minus_p) { - wmax = wi::neg (max_op1); + wmax = -wi::to_wide (max_op1); /* Check for overflow. */ - if (sgn == SIGNED && wi::neg_p (max_op1) && wi::neg_p (wmax)) + if (sgn == SIGNED + && wi::neg_p (wi::to_wide (max_op1)) + && wi::neg_p (wmax)) max_ovf = 1; - else if (sgn == UNSIGNED && wi::ne_p (max_op1, 0)) + else if (sgn == UNSIGNED && wi::to_wide (max_op1) != 0) max_ovf = -1; } else - wmax = max_op1; + wmax = wi::to_wide (max_op1); } else wmax = wi::shwi (0, prec); @@ -2628,14 +2641,14 @@ extract_range_from_binary_expr_1 (value_range *vr, { low_bound = bound; high_bound = complement; - if (wi::ltu_p (vr0.max, low_bound)) + if (wi::ltu_p (wi::to_wide (vr0.max), low_bound)) { /* [5, 6] << [1, 2] == [10, 24]. */ /* We're shifting out only zeroes, the value increases monotonically. */ in_bounds = true; } - else if (wi::ltu_p (high_bound, vr0.min)) + else if (wi::ltu_p (high_bound, wi::to_wide (vr0.min))) { /* [0xffffff00, 0xffffffff] << [1, 2] == [0xfffffc00, 0xfffffffe]. */ @@ -2649,8 +2662,8 @@ extract_range_from_binary_expr_1 (value_range *vr, /* [-1, 1] << [1, 2] == [-4, 4]. */ low_bound = complement; high_bound = bound; - if (wi::lts_p (vr0.max, high_bound) - && wi::lts_p (low_bound, vr0.min)) + if (wi::lts_p (wi::to_wide (vr0.max), high_bound) + && wi::lts_p (low_bound, wi::to_wide (vr0.min))) { /* For non-negative numbers, we're shifting out only zeroes, the value increases monotonically. @@ -2793,14 +2806,12 @@ extract_range_from_binary_expr_1 (value_range *vr, signop sgn = TYPE_SIGN (expr_type); unsigned int prec = TYPE_PRECISION (expr_type); wide_int wmin, wmax, tmp; - wide_int zero = wi::zero (prec); - wide_int one = wi::one (prec); if (vr1.type == VR_RANGE && !symbolic_range_p (&vr1)) { - wmax = wi::sub (vr1.max, one); + wmax = wi::to_wide (vr1.max) - 1; if (sgn == SIGNED) { - tmp = wi::sub (wi::minus_one (prec), vr1.min); + tmp = -1 - wi::to_wide (vr1.min); wmax = wi::smax (wmax, tmp); } } @@ -2809,28 +2820,28 @@ extract_range_from_binary_expr_1 (value_range *vr, wmax = wi::max_value (prec, sgn); /* X % INT_MIN may be INT_MAX. */ if (sgn == UNSIGNED) - wmax = wmax - one; + wmax = wmax - 1; } if (sgn == UNSIGNED) - wmin = zero; + wmin = wi::zero (prec); else { wmin = -wmax; if (vr0.type == VR_RANGE && TREE_CODE (vr0.min) == INTEGER_CST) { - tmp = vr0.min; - if (wi::gts_p (tmp, zero)) - tmp = zero; + tmp = wi::to_wide (vr0.min); + if (wi::gts_p (tmp, 0)) + tmp = wi::zero (prec); wmin = wi::smax (wmin, tmp); } } if (vr0.type == VR_RANGE && TREE_CODE (vr0.max) == INTEGER_CST) { - tmp = vr0.max; + tmp = wi::to_wide (vr0.max); if (sgn == SIGNED && wi::neg_p (tmp)) - tmp = zero; + tmp = wi::zero (prec); wmax = wi::min (wmax, tmp, sgn); } @@ -2875,7 +2886,7 @@ extract_range_from_binary_expr_1 (value_range *vr, range. */ if (vr0p && range_int_cst_p (vr0p)) { - wide_int w = vr1p->min; + wide_int w = wi::to_wide (vr1p->min); int m = 0, n = 0; if (code == BIT_IOR_EXPR) w = ~w; @@ -2891,7 +2902,8 @@ extract_range_from_binary_expr_1 (value_range *vr, m = wi::ctz (w) - n; } wide_int mask = wi::mask (m + n, true, w.get_precision ()); - if (wi::eq_p (mask & vr0p->min, mask & vr0p->max)) + if ((mask & wi::to_wide (vr0p->min)) + == (mask & wi::to_wide (vr0p->max))) { min = int_const_binop (code, vr0p->min, vr1p->min); max = int_const_binop (code, vr0p->max, vr1p->min); @@ -2914,16 +2926,20 @@ extract_range_from_binary_expr_1 (value_range *vr, && tree_int_cst_sgn (vr0.max) < 0 && tree_int_cst_sgn (vr1.max) < 0) { - wmax = wi::min (wmax, vr0.max, TYPE_SIGN (expr_type)); - wmax = wi::min (wmax, vr1.max, TYPE_SIGN (expr_type)); + wmax = wi::min (wmax, wi::to_wide (vr0.max), + TYPE_SIGN (expr_type)); + wmax = wi::min (wmax, wi::to_wide (vr1.max), + TYPE_SIGN (expr_type)); } /* If either input range contains only non-negative values we can truncate the result range maximum to the respective maximum of the input range. */ if (int_cst_range0 && tree_int_cst_sgn (vr0.min) >= 0) - wmax = wi::min (wmax, vr0.max, TYPE_SIGN (expr_type)); + wmax = wi::min (wmax, wi::to_wide (vr0.max), + TYPE_SIGN (expr_type)); if (int_cst_range1 && tree_int_cst_sgn (vr1.min) >= 0) - wmax = wi::min (wmax, vr1.max, TYPE_SIGN (expr_type)); + wmax = wi::min (wmax, wi::to_wide (vr1.max), + TYPE_SIGN (expr_type)); max = wide_int_to_tree (expr_type, wmax); cmp = compare_values (min, max); /* PR68217: In case of signed & sign-bit-CST should @@ -2936,10 +2952,10 @@ extract_range_from_binary_expr_1 (value_range *vr, if (!TYPE_UNSIGNED (expr_type) && ((int_cst_range0 && value_range_constant_singleton (&vr0) - && !wi::cmps (vr0.min, sign_bit)) + && !wi::cmps (wi::to_wide (vr0.min), sign_bit)) || (int_cst_range1 && value_range_constant_singleton (&vr1) - && !wi::cmps (vr1.min, sign_bit)))) + && !wi::cmps (wi::to_wide (vr1.min), sign_bit)))) { min = TYPE_MIN_VALUE (expr_type); max = build_int_cst (expr_type, 0); @@ -2958,16 +2974,20 @@ extract_range_from_binary_expr_1 (value_range *vr, && tree_int_cst_sgn (vr0.min) >= 0 && tree_int_cst_sgn (vr1.min) >= 0) { - wmin = wi::max (wmin, vr0.min, TYPE_SIGN (expr_type)); - wmin = wi::max (wmin, vr1.min, TYPE_SIGN (expr_type)); + wmin = wi::max (wmin, wi::to_wide (vr0.min), + TYPE_SIGN (expr_type)); + wmin = wi::max (wmin, wi::to_wide (vr1.min), + TYPE_SIGN (expr_type)); } /* If either input range contains only negative values we can truncate the minimum of the result range to the respective minimum range. */ if (int_cst_range0 && tree_int_cst_sgn (vr0.max) < 0) - wmin = wi::max (wmin, vr0.min, TYPE_SIGN (expr_type)); + wmin = wi::max (wmin, wi::to_wide (vr0.min), + TYPE_SIGN (expr_type)); if (int_cst_range1 && tree_int_cst_sgn (vr1.max) < 0) - wmin = wi::max (wmin, vr1.min, TYPE_SIGN (expr_type)); + wmin = wi::max (wmin, wi::to_wide (vr1.min), + TYPE_SIGN (expr_type)); min = wide_int_to_tree (expr_type, wmin); } else if (code == BIT_XOR_EXPR) @@ -2975,8 +2995,8 @@ extract_range_from_binary_expr_1 (value_range *vr, wide_int result_zero_bits = ((must_be_nonzero0 & must_be_nonzero1) | ~(may_be_nonzero0 | may_be_nonzero1)); wide_int result_one_bits - = (must_be_nonzero0.and_not (may_be_nonzero1) - | must_be_nonzero1.and_not (may_be_nonzero0)); + = (wi::bit_and_not (must_be_nonzero0, may_be_nonzero1) + | wi::bit_and_not (must_be_nonzero1, may_be_nonzero0)); max = wide_int_to_tree (expr_type, ~result_zero_bits); min = wide_int_to_tree (expr_type, result_one_bits); /* If the range has all positive or all negative values the @@ -4044,7 +4064,7 @@ adjust_range_with_scev (value_range *vr, struct loop *loop, if (!overflow && wi::fits_to_tree_p (wtmp, TREE_TYPE (init)) && (sgn == UNSIGNED - || wi::gts_p (wtmp, 0) == wi::gts_p (step, 0))) + || wi::gts_p (wtmp, 0) == wi::gts_p (wi::to_wide (step), 0))) { tem = wide_int_to_tree (TREE_TYPE (init), wtmp); extract_range_from_binary_expr (&maxvr, PLUS_EXPR, @@ -4877,7 +4897,7 @@ masked_increment (const wide_int &val_in, const wide_int &mask, if ((res & bit) == 0) continue; res = bit - 1; - res = (val + bit).and_not (res); + res = wi::bit_and_not (val + bit, res); res &= mask; if (wi::gtu_p (res, val)) return res ^ sgnbit; @@ -4966,9 +4986,9 @@ overflow_comparison_p_1 (enum tree_code code, tree op0, tree op1, wide_int max = wi::max_value (TYPE_PRECISION (type), UNSIGNED); tree inc = gimple_assign_rhs2 (op1_def); if (reversed) - *new_cst = wide_int_to_tree (type, max + inc); + *new_cst = wide_int_to_tree (type, max + wi::to_wide (inc)); else - *new_cst = wide_int_to_tree (type, max - inc); + *new_cst = wide_int_to_tree (type, max - wi::to_wide (inc)); return true; } } @@ -5290,15 +5310,15 @@ register_edge_assert_for_2 (tree name, edge e, wide_int minval = wi::min_value (prec, TYPE_SIGN (TREE_TYPE (val))); new_val = val2; - if (minval == new_val) + if (minval == wi::to_wide (new_val)) new_val = NULL_TREE; } else { wide_int maxval = wi::max_value (prec, TYPE_SIGN (TREE_TYPE (val))); - mask |= val2; - if (mask == maxval) + mask |= wi::to_wide (val2); + if (wi::eq_p (mask, maxval)) new_val = NULL_TREE; else new_val = wide_int_to_tree (TREE_TYPE (val2), mask); @@ -5373,8 +5393,8 @@ register_edge_assert_for_2 (tree name, edge e, bool valid_p = false, valn, cst2n; enum tree_code ccode = comp_code; - valv = wide_int::from (val, nprec, UNSIGNED); - cst2v = wide_int::from (cst2, nprec, UNSIGNED); + valv = wide_int::from (wi::to_wide (val), nprec, UNSIGNED); + cst2v = wide_int::from (wi::to_wide (cst2), nprec, UNSIGNED); valn = wi::neg_p (valv, TYPE_SIGN (TREE_TYPE (val))); cst2n = wi::neg_p (cst2v, TYPE_SIGN (TREE_TYPE (val))); /* If CST2 doesn't have most significant bit set, @@ -5671,9 +5691,10 @@ is_masked_range_test (tree name, tree valt, enum tree_code cond_code, if (TREE_CODE (t) != SSA_NAME || TREE_CODE (maskt) != INTEGER_CST) return false; - wide_int mask = maskt; + wi::tree_to_wide_ref mask = wi::to_wide (maskt); wide_int inv_mask = ~mask; - wide_int val = valt; // Assume VALT is INTEGER_CST + /* Assume VALT is INTEGER_CST. */ + wi::tree_to_wide_ref val = wi::to_wide (valt); if ((inv_mask & (inv_mask + 1)) != 0 || (val & mask) != val) @@ -6022,7 +6043,8 @@ find_switch_asserts (basic_block bb, gswitch *last) next_min = CASE_LOW (next_cl); next_max = CASE_HIGH (next_cl); - wide_int difference = wi::sub (next_min, max ? max : min); + wide_int difference = (wi::to_wide (next_min) + - wi::to_wide (max ? max : min)); if (wi::eq_p (difference, 1)) max = next_max ? next_max : next_min; else @@ -6953,7 +6975,8 @@ maybe_set_nonzero_bits (basic_block bb, tree var) return; } cst = gimple_assign_rhs2 (stmt); - set_nonzero_bits (var, wi::bit_and_not (get_nonzero_bits (var), cst)); + set_nonzero_bits (var, wi::bit_and_not (get_nonzero_bits (var), + wi::to_wide (cst))); } /* Convert range assertion expressions into the implied copies and @@ -7547,7 +7570,7 @@ vrp_evaluate_conditional_warnv_with_ops (enum tree_code code, tree op0, B = A + 1; if (A < B) -> B = A + 1; if (B != 0) B = A - 1; if (B > A) -> B = A - 1; if (A == 0) B = A - 1; if (B < A) -> B = A - 1; if (A != 0) */ - else if (wi::eq_p (x, max - 1)) + else if (wi::to_wide (x) == max - 1) { op0 = op1; op1 = wide_int_to_tree (TREE_TYPE (op0), 0); @@ -8658,7 +8681,7 @@ intersect_ranges (enum value_range_type *vr0type, == TYPE_PRECISION (ptr_type_node)) && TREE_CODE (vr1max) == INTEGER_CST && TREE_CODE (vr1min) == INTEGER_CST - && (wi::clz (wi::sub (vr1max, vr1min)) + && (wi::clz (wi::to_wide (vr1max) - wi::to_wide (vr1min)) < TYPE_PRECISION (TREE_TYPE (*vr0min)) / 2)) ; /* Else choose the range. */ @@ -9538,13 +9561,13 @@ simplify_bit_ops_using_ranges (gimple_stmt_iterator *gsi, gimple *stmt) switch (gimple_assign_rhs_code (stmt)) { case BIT_AND_EXPR: - mask = may_be_nonzero0.and_not (must_be_nonzero1); + mask = wi::bit_and_not (may_be_nonzero0, must_be_nonzero1); if (mask == 0) { op = op0; break; } - mask = may_be_nonzero1.and_not (must_be_nonzero0); + mask = wi::bit_and_not (may_be_nonzero1, must_be_nonzero0); if (mask == 0) { op = op1; @@ -9552,13 +9575,13 @@ simplify_bit_ops_using_ranges (gimple_stmt_iterator *gsi, gimple *stmt) } break; case BIT_IOR_EXPR: - mask = may_be_nonzero0.and_not (must_be_nonzero1); + mask = wi::bit_and_not (may_be_nonzero0, must_be_nonzero1); if (mask == 0) { op = op1; break; } - mask = may_be_nonzero1.and_not (must_be_nonzero0); + mask = wi::bit_and_not (may_be_nonzero1, must_be_nonzero0); if (mask == 0) { op = op0; @@ -9679,7 +9702,8 @@ range_fits_type_p (value_range *vr, unsigned dest_precision, signop dest_sgn) a signed wide_int, while a negative value cannot be represented by an unsigned wide_int. */ if (src_sgn != dest_sgn - && (wi::lts_p (vr->min, 0) || wi::lts_p (vr->max, 0))) + && (wi::lts_p (wi::to_wide (vr->min), 0) + || wi::lts_p (wi::to_wide (vr->max), 0))) return false; /* Then we can perform the conversion on both ends and compare @@ -10275,7 +10299,7 @@ two_valued_val_range_p (tree var, tree *a, tree *b) return false; if (vr->type == VR_RANGE - && wi::sub (vr->max, vr->min) == 1) + && wi::to_wide (vr->max) - wi::to_wide (vr->min) == 1) { *a = vr->min; *b = vr->max; @@ -10284,8 +10308,10 @@ two_valued_val_range_p (tree var, tree *a, tree *b) /* ~[TYPE_MIN + 1, TYPE_MAX - 1] */ if (vr->type == VR_ANTI_RANGE - && wi::sub (vr->min, vrp_val_min (TREE_TYPE (var))) == 1 - && wi::sub (vrp_val_max (TREE_TYPE (var)), vr->max) == 1) + && (wi::to_wide (vr->min) + - wi::to_wide (vrp_val_min (TREE_TYPE (var)))) == 1 + && (wi::to_wide (vrp_val_max (TREE_TYPE (var))) + - wi::to_wide (vr->max)) == 1) { *a = vrp_val_min (TREE_TYPE (var)); *b = vrp_val_max (TREE_TYPE (var)); @@ -10850,8 +10876,9 @@ vrp_finalize (bool warn_array_bounds_p) vr_value[i]->max) == 1))) set_ptr_nonnull (name); else if (!POINTER_TYPE_P (TREE_TYPE (name))) - set_range_info (name, vr_value[i]->type, vr_value[i]->min, - vr_value[i]->max); + set_range_info (name, vr_value[i]->type, + wi::to_wide (vr_value[i]->min), + wi::to_wide (vr_value[i]->max)); } substitute_and_fold (op_with_constant_singleton_value_range, vrp_fold_stmt); @@ -11047,8 +11074,9 @@ evrp_dom_walker::before_dom_children (basic_block bb) || vr_result.type == VR_ANTI_RANGE) && (TREE_CODE (vr_result.min) == INTEGER_CST) && (TREE_CODE (vr_result.max) == INTEGER_CST)) - set_range_info (lhs, - vr_result.type, vr_result.min, vr_result.max); + set_range_info (lhs, vr_result.type, + wi::to_wide (vr_result.min), + wi::to_wide (vr_result.max)); } else if (POINTER_TYPE_P (TREE_TYPE (lhs)) && ((vr_result.type == VR_RANGE @@ -11121,7 +11149,9 @@ evrp_dom_walker::before_dom_children (basic_block bb) || vr.type == VR_ANTI_RANGE) && (TREE_CODE (vr.min) == INTEGER_CST) && (TREE_CODE (vr.max) == INTEGER_CST)) - set_range_info (output, vr.type, vr.min, vr.max); + set_range_info (output, vr.type, + wi::to_wide (vr.min), + wi::to_wide (vr.max)); } else if (POINTER_TYPE_P (TREE_TYPE (output)) && ((vr.type == VR_RANGE diff --git a/gcc/tree.c b/gcc/tree.c index c6e523920ef..61b20afbb60 100644 --- a/gcc/tree.c +++ b/gcc/tree.c @@ -275,7 +275,7 @@ tree integer_types[itk_none]; bool int_n_enabled_p[NUM_INT_N_ENTS]; struct int_n_trees_t int_n_trees [NUM_INT_N_ENTS]; -unsigned char tree_contains_struct[MAX_TREE_CODES][64]; +bool tree_contains_struct[MAX_TREE_CODES][64]; /* Number of operands for each OpenMP clause. */ unsigned const char omp_clause_num_ops[] = @@ -690,7 +690,7 @@ decl_assembler_name (tree decl) { if (!DECL_ASSEMBLER_NAME_SET_P (decl)) lang_hooks.set_decl_assembler_name (decl); - return DECL_WITH_VIS_CHECK (decl)->decl_with_vis.assembler_name; + return DECL_ASSEMBLER_NAME_RAW (decl); } /* When the target supports COMDAT groups, this indicates which group the @@ -1606,7 +1606,7 @@ cache_integer_cst (tree t) case BOOLEAN_TYPE: /* Cache false or true. */ limit = 2; - if (wi::ltu_p (t, 2)) + if (wi::ltu_p (wi::to_wide (t), 2)) ix = TREE_INT_CST_ELT (t, 0); break; @@ -1625,7 +1625,7 @@ cache_integer_cst (tree t) if (tree_to_uhwi (t) < (unsigned HOST_WIDE_INT) INTEGER_SHARE_LIMIT) ix = tree_to_uhwi (t); } - else if (wi::ltu_p (t, INTEGER_SHARE_LIMIT)) + else if (wi::ltu_p (wi::to_wide (t), INTEGER_SHARE_LIMIT)) ix = tree_to_uhwi (t); } else @@ -1635,14 +1635,14 @@ cache_integer_cst (tree t) if (integer_minus_onep (t)) ix = 0; - else if (!wi::neg_p (t)) + else if (!wi::neg_p (wi::to_wide (t))) { if (prec < HOST_BITS_PER_WIDE_INT) { if (tree_to_shwi (t) < INTEGER_SHARE_LIMIT) ix = tree_to_shwi (t) + 1; } - else if (wi::ltu_p (t, INTEGER_SHARE_LIMIT)) + else if (wi::ltu_p (wi::to_wide (t), INTEGER_SHARE_LIMIT)) ix = tree_to_shwi (t) + 1; } } @@ -1674,7 +1674,7 @@ cache_integer_cst (tree t) /* If there is already an entry for the number verify it's the same. */ if (*slot) - gcc_assert (wi::eq_p (tree (*slot), t)); + gcc_assert (wi::to_wide (tree (*slot)) == wi::to_wide (t)); else /* Otherwise insert this one into the hash table. */ *slot = t; @@ -1991,7 +1991,7 @@ real_value_from_int_cst (const_tree type, const_tree i) bitwise comparisons to see if two values are the same. */ memset (&d, 0, sizeof d); - real_from_integer (&d, type ? TYPE_MODE (type) : VOIDmode, i, + real_from_integer (&d, type ? TYPE_MODE (type) : VOIDmode, wi::to_wide (i), TYPE_SIGN (TREE_TYPE (i))); return d; } @@ -2353,7 +2353,7 @@ integer_zerop (const_tree expr) switch (TREE_CODE (expr)) { case INTEGER_CST: - return wi::eq_p (expr, 0); + return wi::to_wide (expr) == 0; case COMPLEX_CST: return (integer_zerop (TREE_REALPART (expr)) && integer_zerop (TREE_IMAGPART (expr))); @@ -2432,7 +2432,8 @@ integer_all_onesp (const_tree expr) else if (TREE_CODE (expr) != INTEGER_CST) return 0; - return wi::max_value (TYPE_PRECISION (TREE_TYPE (expr)), UNSIGNED) == expr; + return (wi::max_value (TYPE_PRECISION (TREE_TYPE (expr)), UNSIGNED) + == wi::to_wide (expr)); } /* Return 1 if EXPR is the integer constant minus one. */ @@ -2461,7 +2462,7 @@ integer_pow2p (const_tree expr) if (TREE_CODE (expr) != INTEGER_CST) return 0; - return wi::popcount (expr) == 1; + return wi::popcount (wi::to_wide (expr)) == 1; } /* Return 1 if EXPR is an integer constant other than zero or a @@ -2471,7 +2472,7 @@ int integer_nonzerop (const_tree expr) { return ((TREE_CODE (expr) == INTEGER_CST - && !wi::eq_p (expr, 0)) + && wi::to_wide (expr) != 0) || (TREE_CODE (expr) == COMPLEX_CST && (integer_nonzerop (TREE_REALPART (expr)) || integer_nonzerop (TREE_IMAGPART (expr))))); @@ -2507,7 +2508,7 @@ tree_log2 (const_tree expr) if (TREE_CODE (expr) == COMPLEX_CST) return tree_log2 (TREE_REALPART (expr)); - return wi::exact_log2 (expr); + return wi::exact_log2 (wi::to_wide (expr)); } /* Similar, but return the largest integer Y such that 2 ** Y is less @@ -2519,7 +2520,7 @@ tree_floor_log2 (const_tree expr) if (TREE_CODE (expr) == COMPLEX_CST) return tree_log2 (TREE_REALPART (expr)); - return wi::floor_log2 (expr); + return wi::floor_log2 (wi::to_wide (expr)); } /* Return number of known trailing zero bits in EXPR, or, if the value of @@ -2536,7 +2537,7 @@ tree_ctz (const_tree expr) switch (TREE_CODE (expr)) { case INTEGER_CST: - ret1 = wi::ctz (expr); + ret1 = wi::ctz (wi::to_wide (expr)); return MIN (ret1, prec); case SSA_NAME: ret1 = wi::ctz (get_nonzero_bits (expr)); @@ -4738,7 +4739,7 @@ build_simple_mem_ref_loc (location_t loc, tree ptr) offset_int mem_ref_offset (const_tree t) { - return offset_int::from (TREE_OPERAND (t, 1), SIGNED); + return offset_int::from (wi::to_wide (TREE_OPERAND (t, 1)), SIGNED); } /* Return an invariant ADDR_EXPR of type TYPE taking the address of BASE @@ -6688,7 +6689,7 @@ tree_int_cst_sign_bit (const_tree t) { unsigned bitno = TYPE_PRECISION (TREE_TYPE (t)) - 1; - return wi::extract_uhwi (t, bitno, 1); + return wi::extract_uhwi (wi::to_wide (t), bitno, 1); } /* Return an indication of the sign of the integer constant T. @@ -6698,11 +6699,11 @@ tree_int_cst_sign_bit (const_tree t) int tree_int_cst_sgn (const_tree t) { - if (wi::eq_p (t, 0)) + if (wi::to_wide (t) == 0) return 0; else if (TYPE_UNSIGNED (TREE_TYPE (t))) return 1; - else if (wi::neg_p (t)) + else if (wi::neg_p (wi::to_wide (t))) return -1; else return 1; @@ -8375,7 +8376,7 @@ get_unwidened (tree op, tree for_type) if (TREE_CODE (win) == INTEGER_CST) { tree wtype = TREE_TYPE (win); - unsigned prec = wi::min_precision (win, TYPE_SIGN (wtype)); + unsigned prec = wi::min_precision (wi::to_wide (win), TYPE_SIGN (wtype)); if (for_type) prec = MAX (prec, final_prec); if (prec < TYPE_PRECISION (wtype)) @@ -8496,7 +8497,7 @@ int_fits_type_p (const_tree c, const_tree type) /* Non-standard boolean types can have arbitrary precision but various transformations assume that they can only take values 0 and +/-1. */ if (TREE_CODE (type) == BOOLEAN_TYPE) - return wi::fits_to_boolean_p (c, type); + return wi::fits_to_boolean_p (wi::to_wide (c), type); retry: type_low_bound = TYPE_MIN_VALUE (type); @@ -8539,7 +8540,7 @@ retry: /* Perform some generic filtering which may allow making a decision even if the bounds are not constant. First, negative integers never fit in unsigned types, */ - if (TYPE_UNSIGNED (type) && sgn_c == SIGNED && wi::neg_p (c)) + if (TYPE_UNSIGNED (type) && sgn_c == SIGNED && wi::neg_p (wi::to_wide (c))) return false; /* Second, narrower types always fit in wider ones. */ @@ -8558,10 +8559,10 @@ retry: possible that the value will not fit. The test below fails if any bit is set between the sign bit of the underlying mode and the top bit of the type. */ - if (wi::ne_p (wi::zext (c, prec - 1), c)) + if (wi::zext (wi::to_wide (c), prec - 1) != wi::to_wide (c)) return false; } - else if (wi::neg_p (c)) + else if (wi::neg_p (wi::to_wide (c))) return false; } @@ -8577,7 +8578,7 @@ retry: } /* Or to fits_to_tree_p, if nothing else. */ - return wi::fits_to_tree_p (c, type); + return wi::fits_to_tree_p (wi::to_wide (c), type); } /* Stores bounds of an integer TYPE in MIN and MAX. If TYPE has non-constant @@ -8590,7 +8591,7 @@ get_type_static_bounds (const_tree type, mpz_t min, mpz_t max) { if (!POINTER_TYPE_P (type) && TYPE_MIN_VALUE (type) && TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST) - wi::to_mpz (TYPE_MIN_VALUE (type), min, TYPE_SIGN (type)); + wi::to_mpz (wi::to_wide (TYPE_MIN_VALUE (type)), min, TYPE_SIGN (type)); else { if (TYPE_UNSIGNED (type)) @@ -8604,7 +8605,7 @@ get_type_static_bounds (const_tree type, mpz_t min, mpz_t max) if (!POINTER_TYPE_P (type) && TYPE_MAX_VALUE (type) && TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST) - wi::to_mpz (TYPE_MAX_VALUE (type), max, TYPE_SIGN (type)); + wi::to_mpz (wi::to_wide (TYPE_MAX_VALUE (type)), max, TYPE_SIGN (type)); else { wide_int mn = wi::max_value (TYPE_PRECISION (type), TYPE_SIGN (type)); @@ -11015,7 +11016,7 @@ operand_equal_for_phi_arg_p (const_tree arg0, const_tree arg1) tree num_ending_zeros (const_tree x) { - return build_int_cst (TREE_TYPE (x), wi::ctz (x)); + return build_int_cst (TREE_TYPE (x), wi::ctz (wi::to_wide (x))); } @@ -12456,7 +12457,7 @@ drop_tree_overflow (tree t) /* For tree codes with a sharing machinery re-build the result. */ if (TREE_CODE (t) == INTEGER_CST) - return wide_int_to_tree (TREE_TYPE (t), t); + return wide_int_to_tree (TREE_TYPE (t), wi::to_wide (t)); /* Otherwise, as all tcc_constants are possibly shared, copy the node and drop the flag. */ @@ -13629,7 +13630,7 @@ get_range_pos_neg (tree arg) int cnt = 0; if (TREE_CODE (arg) == INTEGER_CST) { - wide_int w = wi::sext (arg, prec); + wide_int w = wi::sext (wi::to_wide (arg), prec); if (wi::neg_p (w)) return 2; else diff --git a/gcc/tree.def b/gcc/tree.def index 9f80c4d41f5..3d2bd95d666 100644 --- a/gcc/tree.def +++ b/gcc/tree.def @@ -982,8 +982,8 @@ DEFTREECODE (SCEV_KNOWN, "scev_known", tcc_expression, 0) DEFTREECODE (SCEV_NOT_KNOWN, "scev_not_known", tcc_expression, 0) /* Polynomial chains of recurrences. - Under the form: cr = {CHREC_LEFT (cr), +, CHREC_RIGHT (cr)}. */ -DEFTREECODE (POLYNOMIAL_CHREC, "polynomial_chrec", tcc_expression, 3) + cr = {CHREC_LEFT (cr), +, CHREC_RIGHT (cr)}_CHREC_VARIABLE (cr). */ +DEFTREECODE (POLYNOMIAL_CHREC, "polynomial_chrec", tcc_expression, 2) /* Used to chain children of container statements together. Use the interface in tree-iterator.h to access this node. */ diff --git a/gcc/tree.h b/gcc/tree.h index 2251b0358d4..bb8fa796656 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -76,64 +76,43 @@ as_internal_fn (combined_fn code) /* Macros for initializing `tree_contains_struct'. */ #define MARK_TS_BASE(C) \ - do { \ - tree_contains_struct[C][TS_BASE] = 1; \ - } while (0) + (tree_contains_struct[C][TS_BASE] = true) #define MARK_TS_TYPED(C) \ - do { \ - MARK_TS_BASE (C); \ - tree_contains_struct[C][TS_TYPED] = 1; \ - } while (0) + (MARK_TS_BASE (C), \ + tree_contains_struct[C][TS_TYPED] = true) #define MARK_TS_COMMON(C) \ - do { \ - MARK_TS_TYPED (C); \ - tree_contains_struct[C][TS_COMMON] = 1; \ - } while (0) + (MARK_TS_TYPED (C), \ + tree_contains_struct[C][TS_COMMON] = true) #define MARK_TS_TYPE_COMMON(C) \ - do { \ - MARK_TS_COMMON (C); \ - tree_contains_struct[C][TS_TYPE_COMMON] = 1; \ - } while (0) + (MARK_TS_COMMON (C), \ + tree_contains_struct[C][TS_TYPE_COMMON] = true) #define MARK_TS_TYPE_WITH_LANG_SPECIFIC(C) \ - do { \ - MARK_TS_TYPE_COMMON (C); \ - tree_contains_struct[C][TS_TYPE_WITH_LANG_SPECIFIC] = 1; \ - } while (0) + (MARK_TS_TYPE_COMMON (C), \ + tree_contains_struct[C][TS_TYPE_WITH_LANG_SPECIFIC] = true) #define MARK_TS_DECL_MINIMAL(C) \ - do { \ - MARK_TS_COMMON (C); \ - tree_contains_struct[C][TS_DECL_MINIMAL] = 1; \ - } while (0) + (MARK_TS_COMMON (C), \ + tree_contains_struct[C][TS_DECL_MINIMAL] = true) #define MARK_TS_DECL_COMMON(C) \ - do { \ - MARK_TS_DECL_MINIMAL (C); \ - tree_contains_struct[C][TS_DECL_COMMON] = 1; \ - } while (0) + (MARK_TS_DECL_MINIMAL (C), \ + tree_contains_struct[C][TS_DECL_COMMON] = true) #define MARK_TS_DECL_WRTL(C) \ - do { \ - MARK_TS_DECL_COMMON (C); \ - tree_contains_struct[C][TS_DECL_WRTL] = 1; \ - } while (0) + (MARK_TS_DECL_COMMON (C), \ + tree_contains_struct[C][TS_DECL_WRTL] = true) #define MARK_TS_DECL_WITH_VIS(C) \ - do { \ - MARK_TS_DECL_WRTL (C); \ - tree_contains_struct[C][TS_DECL_WITH_VIS] = 1; \ - } while (0) + (MARK_TS_DECL_WRTL (C), \ + tree_contains_struct[C][TS_DECL_WITH_VIS] = true) #define MARK_TS_DECL_NON_COMMON(C) \ - do { \ - MARK_TS_DECL_WITH_VIS (C); \ - tree_contains_struct[C][TS_DECL_NON_COMMON] = 1; \ - } while (0) - + (MARK_TS_DECL_WITH_VIS (C), \ + tree_contains_struct[C][TS_DECL_NON_COMMON] = true) /* Returns the string representing CLASS. */ @@ -1272,10 +1251,9 @@ extern void protected_set_expr_location (tree, location_t); #define COND_EXPR_ELSE(NODE) (TREE_OPERAND (COND_EXPR_CHECK (NODE), 2)) /* Accessors for the chains of recurrences. */ -#define CHREC_VAR(NODE) TREE_OPERAND (POLYNOMIAL_CHREC_CHECK (NODE), 0) -#define CHREC_LEFT(NODE) TREE_OPERAND (POLYNOMIAL_CHREC_CHECK (NODE), 1) -#define CHREC_RIGHT(NODE) TREE_OPERAND (POLYNOMIAL_CHREC_CHECK (NODE), 2) -#define CHREC_VARIABLE(NODE) TREE_INT_CST_LOW (CHREC_VAR (NODE)) +#define CHREC_LEFT(NODE) TREE_OPERAND (POLYNOMIAL_CHREC_CHECK (NODE), 0) +#define CHREC_RIGHT(NODE) TREE_OPERAND (POLYNOMIAL_CHREC_CHECK (NODE), 1) +#define CHREC_VARIABLE(NODE) POLYNOMIAL_CHREC_CHECK (NODE)->base.u.chrec_var /* LABEL_EXPR accessor. This gives access to the label associated with the given label expression. */ @@ -2843,6 +2821,10 @@ extern void decl_value_expr_insert (tree, tree); LTO compilation and C++. */ #define DECL_ASSEMBLER_NAME(NODE) decl_assembler_name (NODE) +/* Raw accessor for DECL_ASSEMBLE_NAME. */ +#define DECL_ASSEMBLER_NAME_RAW(NODE) \ + (DECL_WITH_VIS_CHECK (NODE)->decl_with_vis.assembler_name) + /* Return true if NODE is a NODE that can contain a DECL_ASSEMBLER_NAME. This is true of all DECL nodes except FIELD_DECL. */ #define HAS_DECL_ASSEMBLER_NAME_P(NODE) \ @@ -2852,12 +2834,11 @@ extern void decl_value_expr_insert (tree, tree); the NODE might still have a DECL_ASSEMBLER_NAME -- it just hasn't been set yet. */ #define DECL_ASSEMBLER_NAME_SET_P(NODE) \ - (HAS_DECL_ASSEMBLER_NAME_P (NODE) \ - && DECL_WITH_VIS_CHECK (NODE)->decl_with_vis.assembler_name != NULL_TREE) + (DECL_ASSEMBLER_NAME_RAW (NODE) != NULL_TREE) /* Set the DECL_ASSEMBLER_NAME for NODE to NAME. */ #define SET_DECL_ASSEMBLER_NAME(NODE, NAME) \ - (DECL_WITH_VIS_CHECK (NODE)->decl_with_vis.assembler_name = (NAME)) + (DECL_ASSEMBLER_NAME_RAW (NODE) = (NAME)) /* Copy the DECL_ASSEMBLER_NAME from DECL1 to DECL2. Note that if DECL1's DECL_ASSEMBLER_NAME has not yet been set, using this macro will not cause @@ -2869,10 +2850,7 @@ extern void decl_value_expr_insert (tree, tree); which will try to set the DECL_ASSEMBLER_NAME for DECL1. */ #define COPY_DECL_ASSEMBLER_NAME(DECL1, DECL2) \ - (DECL_ASSEMBLER_NAME_SET_P (DECL1) \ - ? (void) SET_DECL_ASSEMBLER_NAME (DECL2, \ - DECL_ASSEMBLER_NAME (DECL1)) \ - : (void) 0) + SET_DECL_ASSEMBLER_NAME (DECL2, DECL_ASSEMBLER_NAME_RAW (DECL1)) /* Records the section name in a section attribute. Used to pass the name from decl_attributes to make_function_rtl and make_decl_rtl. */ @@ -5266,20 +5244,6 @@ extern bool anon_aggrname_p (const_tree); /* The tree and const_tree overload templates. */ namespace wi { - template <> - struct int_traits <const_tree> - { - static const enum precision_type precision_type = VAR_PRECISION; - static const bool host_dependent_precision = false; - static const bool is_sign_extended = false; - static unsigned int get_precision (const_tree); - static wi::storage_ref decompose (HOST_WIDE_INT *, unsigned int, - const_tree); - }; - - template <> - struct int_traits <tree> : public int_traits <const_tree> {}; - template <int N> class extended_tree { @@ -5303,42 +5267,115 @@ namespace wi static const unsigned int precision = N; }; - generic_wide_int <extended_tree <WIDE_INT_MAX_PRECISION> > - to_widest (const_tree); - - generic_wide_int <extended_tree <ADDR_MAX_PRECISION> > to_offset (const_tree); + typedef const generic_wide_int <extended_tree <WIDE_INT_MAX_PRECISION> > + tree_to_widest_ref; + typedef const generic_wide_int <extended_tree <ADDR_MAX_PRECISION> > + tree_to_offset_ref; + typedef const generic_wide_int<wide_int_ref_storage<false, false> > + tree_to_wide_ref; + tree_to_widest_ref to_widest (const_tree); + tree_to_offset_ref to_offset (const_tree); + tree_to_wide_ref to_wide (const_tree); wide_int to_wide (const_tree, unsigned int); } -inline unsigned int -wi::int_traits <const_tree>::get_precision (const_tree tcst) -{ - return TYPE_PRECISION (TREE_TYPE (tcst)); -} +/* Refer to INTEGER_CST T as though it were a widest_int. -/* Convert the tree_cst X into a wide_int of PRECISION. */ -inline wi::storage_ref -wi::int_traits <const_tree>::decompose (HOST_WIDE_INT *, - unsigned int precision, const_tree x) -{ - gcc_checking_assert (precision == TYPE_PRECISION (TREE_TYPE (x))); - return wi::storage_ref (&TREE_INT_CST_ELT (x, 0), TREE_INT_CST_NUNITS (x), - precision); -} + This function gives T's actual numerical value, influenced by the + signedness of its type. For example, a signed byte with just the + top bit set would be -128 while an unsigned byte with the same + bit pattern would be 128. -inline generic_wide_int <wi::extended_tree <WIDE_INT_MAX_PRECISION> > + This is the right choice when operating on groups of INTEGER_CSTs + that might have different signedness or precision. It is also the + right choice in code that specifically needs an approximation of + infinite-precision arithmetic instead of normal modulo arithmetic. + + The approximation of infinite precision is good enough for realistic + numbers of additions and subtractions of INTEGER_CSTs (where + "realistic" includes any number less than 1 << 31) but it cannot + represent the result of multiplying the two largest supported + INTEGER_CSTs. The overflow-checking form of wi::mul provides a way + of multiplying two arbitrary INTEGER_CSTs and checking that the + result is representable as a widest_int. + + Note that any overflow checking done on these values is relative to + the range of widest_int rather than the range of a TREE_TYPE. + + Calling this function should have no overhead in release builds, + so it is OK to call it several times for the same tree. If it is + useful for readability reasons to reduce the number of calls, + it is more efficient to use: + + wi::tree_to_widest_ref wt = wi::to_widest (t); + + instead of: + + widest_int wt = wi::to_widest (t). */ + +inline wi::tree_to_widest_ref wi::to_widest (const_tree t) { return t; } -inline generic_wide_int <wi::extended_tree <ADDR_MAX_PRECISION> > +/* Refer to INTEGER_CST T as though it were an offset_int. + + This function is an optimisation of wi::to_widest for cases + in which T is known to be a bit or byte count in the range + (-(2 ^ (N + BITS_PER_UNIT)), 2 ^ (N + BITS_PER_UNIT)), where N is + the target's address size in bits. + + This is the right choice when operating on bit or byte counts as + untyped numbers rather than M-bit values. The wi::to_widest comments + about addition, subtraction and multiplication apply here: sequences + of 1 << 31 additions and subtractions do not induce overflow, but + multiplying the largest sizes might. Again, + + wi::tree_to_offset_ref wt = wi::to_offset (t); + + is more efficient than: + + offset_int wt = wi::to_offset (t). */ + +inline wi::tree_to_offset_ref wi::to_offset (const_tree t) { return t; } +/* Refer to INTEGER_CST T as though it were a wide_int. + + In contrast to the approximation of infinite-precision numbers given + by wi::to_widest and wi::to_offset, this function treats T as a + signless collection of N bits, where N is the precision of T's type. + As with machine registers, signedness is determined by the operation + rather than the operands; for example, there is a distinction between + signed and unsigned division. + + This is the right choice when operating on values with the same type + using normal modulo arithmetic. The overflow-checking forms of things + like wi::add check whether the result can be represented in T's type. + + Calling this function should have no overhead in release builds, + so it is OK to call it several times for the same tree. If it is + useful for readability reasons to reduce the number of calls, + it is more efficient to use: + + wi::tree_to_wide_ref wt = wi::to_wide (t); + + instead of: + + wide_int wt = wi::to_wide (t). */ + +inline wi::tree_to_wide_ref +wi::to_wide (const_tree t) +{ + return wi::storage_ref (&TREE_INT_CST_ELT (t, 0), TREE_INT_CST_NUNITS (t), + TYPE_PRECISION (TREE_TYPE (t))); +} + /* Convert INTEGER_CST T to a wide_int of precision PREC, extending or truncating as necessary. When extending, use sign extension if T's type is signed and zero extension if T's type is unsigned. */ @@ -5346,7 +5383,7 @@ wi::to_offset (const_tree t) inline wide_int wi::to_wide (const_tree t, unsigned int prec) { - return wide_int::from (t, prec, TYPE_SIGN (TREE_TYPE (t))); + return wide_int::from (wi::to_wide (t), prec, TYPE_SIGN (TREE_TYPE (t))); } template <int N> diff --git a/gcc/ubsan.c b/gcc/ubsan.c index 1030168e6b7..6c4fe0e77a0 100644 --- a/gcc/ubsan.c +++ b/gcc/ubsan.c @@ -1164,8 +1164,8 @@ ubsan_expand_ptr_ifn (gimple_stmt_iterator *gsip) unlink_stmt_vdef (stmt); if (TREE_CODE (off) == INTEGER_CST) - g = gimple_build_cond (wi::neg_p (off) ? LT_EXPR : GE_EXPR, ptri, - fold_build1 (NEGATE_EXPR, sizetype, off), + g = gimple_build_cond (wi::neg_p (wi::to_wide (off)) ? LT_EXPR : GE_EXPR, + ptri, fold_build1 (NEGATE_EXPR, sizetype, off), NULL_TREE, NULL_TREE); else if (pos_neg != 3) g = gimple_build_cond (pos_neg == 1 ? LT_EXPR : GT_EXPR, diff --git a/gcc/wide-int.h b/gcc/wide-int.h index 61d9aab2a83..e17b016af04 100644 --- a/gcc/wide-int.h +++ b/gcc/wide-int.h @@ -150,15 +150,23 @@ along with GCC; see the file COPYING3. If not see and in wider precisions. There are constructors to create the various forms of wide_int from - trees, rtl and constants. For trees you can simply say: + trees, rtl and constants. For trees the options are: tree t = ...; - wide_int x = t; + wi::to_wide (t) // Treat T as a wide_int + wi::to_offset (t) // Treat T as an offset_int + wi::to_widest (t) // Treat T as a widest_int - However, a little more syntax is required for rtl constants since - they do not have an explicit precision. To make an rtl into a - wide_int, you have to pair it with a mode. The canonical way to do - this is with rtx_mode_t as in: + All three are light-weight accessors that should have no overhead + in release builds. If it is useful for readability reasons to + store the result in a temporary variable, the preferred method is: + + wi::tree_to_wide_ref twide = wi::to_wide (t); + wi::tree_to_offset_ref toffset = wi::to_offset (t); + wi::tree_to_widest_ref twidest = wi::to_widest (t); + + To make an rtx into a wide_int, you have to pair it with a mode. + The canonical way to do this is with rtx_mode_t as in: rtx r = ... wide_int x = rtx_mode_t (r, mode); @@ -175,23 +183,22 @@ along with GCC; see the file COPYING3. If not see offset_int x = (int) c; // sign-extend C widest_int x = (unsigned int) c; // zero-extend C - It is also possible to do arithmetic directly on trees, rtxes and + It is also possible to do arithmetic directly on rtx_mode_ts and constants. For example: - wi::add (t1, t2); // add equal-sized INTEGER_CSTs t1 and t2 - wi::add (t1, 1); // add 1 to INTEGER_CST t1 - wi::add (r1, r2); // add equal-sized rtx constants r1 and r2 + wi::add (r1, r2); // add equal-sized rtx_mode_ts r1 and r2 + wi::add (r1, 1); // add 1 to rtx_mode_t r1 wi::lshift (1, 100); // 1 << 100 as a widest_int Many binary operations place restrictions on the combinations of inputs, using the following rules: - - {tree, rtx, wide_int} op {tree, rtx, wide_int} -> wide_int + - {rtx, wide_int} op {rtx, wide_int} -> wide_int The inputs must be the same precision. The result is a wide_int of the same precision - - {tree, rtx, wide_int} op (un)signed HOST_WIDE_INT -> wide_int - (un)signed HOST_WIDE_INT op {tree, rtx, wide_int} -> wide_int + - {rtx, wide_int} op (un)signed HOST_WIDE_INT -> wide_int + (un)signed HOST_WIDE_INT op {rtx, wide_int} -> wide_int The HOST_WIDE_INT is extended or truncated to the precision of the other input. The result is a wide_int of the same precision as that input. @@ -262,11 +269,22 @@ along with GCC; see the file COPYING3. If not see #define WI_BINARY_RESULT(T1, T2) \ typename wi::binary_traits <T1, T2>::result_type +/* Likewise for binary operators, which excludes the case in which neither + T1 nor T2 is a wide-int-based type. */ +#define WI_BINARY_OPERATOR_RESULT(T1, T2) \ + typename wi::binary_traits <T1, T2>::operator_result + /* The type of result produced by T1 << T2. Leads to substitution failure if the operation isn't supported. Defined purely for brevity. */ #define WI_SIGNED_SHIFT_RESULT(T1, T2) \ typename wi::binary_traits <T1, T2>::signed_shift_result_type +/* The type of result produced by a sign-agnostic binary predicate on + types T1 and T2. This is bool if wide-int operations make sense for + T1 and T2 and leads to substitution failure otherwise. */ +#define WI_BINARY_PREDICATE_RESULT(T1, T2) \ + typename wi::binary_traits <T1, T2>::predicate_result + /* The type of result produced by a signed binary predicate on types T1 and T2. This is bool if signed comparisons make sense for T1 and T2 and leads to substitution failure otherwise. */ @@ -305,7 +323,9 @@ typedef generic_wide_int <wide_int_storage> wide_int; typedef FIXED_WIDE_INT (ADDR_MAX_PRECISION) offset_int; typedef FIXED_WIDE_INT (WIDE_INT_MAX_PRECISION) widest_int; -template <bool SE> +/* wi::storage_ref can be a reference to a primitive type, + so this is the conservatively-correct setting. */ +template <bool SE, bool HDP = true> struct wide_int_ref_storage; typedef generic_wide_int <wide_int_ref_storage <false> > wide_int_ref; @@ -319,7 +339,8 @@ typedef generic_wide_int <wide_int_ref_storage <false> > wide_int_ref; to use those. */ #define WIDE_INT_REF_FOR(T) \ generic_wide_int \ - <wide_int_ref_storage <wi::int_traits <T>::is_sign_extended> > + <wide_int_ref_storage <wi::int_traits <T>::is_sign_extended, \ + wi::int_traits <T>::host_dependent_precision> > namespace wi { @@ -382,12 +403,15 @@ namespace wi struct binary_traits <T1, T2, FLEXIBLE_PRECISION, FLEXIBLE_PRECISION> { typedef widest_int result_type; + /* Don't define operators for this combination. */ }; template <typename T1, typename T2> struct binary_traits <T1, T2, FLEXIBLE_PRECISION, VAR_PRECISION> { typedef wide_int result_type; + typedef result_type operator_result; + typedef bool predicate_result; }; template <typename T1, typename T2> @@ -397,6 +421,8 @@ namespace wi so as not to confuse gengtype. */ typedef generic_wide_int < fixed_wide_int_storage <int_traits <T2>::precision> > result_type; + typedef result_type operator_result; + typedef bool predicate_result; typedef bool signed_predicate_result; }; @@ -404,6 +430,8 @@ namespace wi struct binary_traits <T1, T2, VAR_PRECISION, FLEXIBLE_PRECISION> { typedef wide_int result_type; + typedef result_type operator_result; + typedef bool predicate_result; }; template <typename T1, typename T2> @@ -413,6 +441,8 @@ namespace wi so as not to confuse gengtype. */ typedef generic_wide_int < fixed_wide_int_storage <int_traits <T1>::precision> > result_type; + typedef result_type operator_result; + typedef bool predicate_result; typedef result_type signed_shift_result_type; typedef bool signed_predicate_result; }; @@ -420,11 +450,13 @@ namespace wi template <typename T1, typename T2> struct binary_traits <T1, T2, CONST_PRECISION, CONST_PRECISION> { + STATIC_ASSERT (int_traits <T1>::precision == int_traits <T2>::precision); /* Spelled out explicitly (rather than through FIXED_WIDE_INT) so as not to confuse gengtype. */ - STATIC_ASSERT (int_traits <T1>::precision == int_traits <T2>::precision); typedef generic_wide_int < fixed_wide_int_storage <int_traits <T1>::precision> > result_type; + typedef result_type operator_result; + typedef bool predicate_result; typedef result_type signed_shift_result_type; typedef bool signed_predicate_result; }; @@ -433,6 +465,8 @@ namespace wi struct binary_traits <T1, T2, VAR_PRECISION, VAR_PRECISION> { typedef wide_int result_type; + typedef result_type operator_result; + typedef bool predicate_result; }; } @@ -675,18 +709,6 @@ public: template <typename T> generic_wide_int &operator = (const T &); -#define BINARY_PREDICATE(OP, F) \ - template <typename T> \ - bool OP (const T &c) const { return wi::F (*this, c); } - -#define UNARY_OPERATOR(OP, F) \ - WI_UNARY_RESULT (generic_wide_int) OP () const { return wi::F (*this); } - -#define BINARY_OPERATOR(OP, F) \ - template <typename T> \ - WI_BINARY_RESULT (generic_wide_int, T) \ - OP (const T &c) const { return wi::F (*this, c); } - #define ASSIGNMENT_OPERATOR(OP, F) \ template <typename T> \ generic_wide_int &OP (const T &c) { return (*this = wi::F (*this, c)); } @@ -699,18 +721,6 @@ public: #define INCDEC_OPERATOR(OP, DELTA) \ generic_wide_int &OP () { *this += DELTA; return *this; } - UNARY_OPERATOR (operator ~, bit_not) - UNARY_OPERATOR (operator -, neg) - BINARY_PREDICATE (operator ==, eq_p) - BINARY_PREDICATE (operator !=, ne_p) - BINARY_OPERATOR (operator &, bit_and) - BINARY_OPERATOR (and_not, bit_and_not) - BINARY_OPERATOR (operator |, bit_or) - BINARY_OPERATOR (or_not, bit_or_not) - BINARY_OPERATOR (operator ^, bit_xor) - BINARY_OPERATOR (operator +, add) - BINARY_OPERATOR (operator -, sub) - BINARY_OPERATOR (operator *, mul) ASSIGNMENT_OPERATOR (operator &=, bit_and) ASSIGNMENT_OPERATOR (operator |=, bit_or) ASSIGNMENT_OPERATOR (operator ^=, bit_xor) @@ -722,9 +732,6 @@ public: INCDEC_OPERATOR (operator ++, 1) INCDEC_OPERATOR (operator --, -1) -#undef BINARY_PREDICATE -#undef UNARY_OPERATOR -#undef BINARY_OPERATOR #undef SHIFT_ASSIGNMENT_OPERATOR #undef ASSIGNMENT_OPERATOR #undef INCDEC_OPERATOR @@ -932,7 +939,7 @@ decompose (HOST_WIDE_INT *, unsigned int precision, /* Provide the storage for a wide_int_ref. This acts like a read-only wide_int, with the optimization that VAL is normally a pointer to another integer's storage, so that no array copy is needed. */ -template <bool SE> +template <bool SE, bool HDP> struct wide_int_ref_storage : public wi::storage_ref { private: @@ -951,8 +958,8 @@ public: }; /* Create a reference from an existing reference. */ -template <bool SE> -inline wide_int_ref_storage <SE>:: +template <bool SE, bool HDP> +inline wide_int_ref_storage <SE, HDP>:: wide_int_ref_storage (const wi::storage_ref &x) : storage_ref (x) {} @@ -960,32 +967,30 @@ wide_int_ref_storage (const wi::storage_ref &x) /* Create a reference to integer X in its natural precision. Note that the natural precision is host-dependent for primitive types. */ -template <bool SE> +template <bool SE, bool HDP> template <typename T> -inline wide_int_ref_storage <SE>::wide_int_ref_storage (const T &x) +inline wide_int_ref_storage <SE, HDP>::wide_int_ref_storage (const T &x) : storage_ref (wi::int_traits <T>::decompose (scratch, wi::get_precision (x), x)) { } /* Create a reference to integer X in precision PRECISION. */ -template <bool SE> +template <bool SE, bool HDP> template <typename T> -inline wide_int_ref_storage <SE>::wide_int_ref_storage (const T &x, - unsigned int precision) +inline wide_int_ref_storage <SE, HDP>:: +wide_int_ref_storage (const T &x, unsigned int precision) : storage_ref (wi::int_traits <T>::decompose (scratch, precision, x)) { } namespace wi { - template <bool SE> - struct int_traits <wide_int_ref_storage <SE> > + template <bool SE, bool HDP> + struct int_traits <wide_int_ref_storage <SE, HDP> > { static const enum precision_type precision_type = VAR_PRECISION; - /* wi::storage_ref can be a reference to a primitive type, - so this is the conservatively-correct setting. */ - static const bool host_dependent_precision = true; + static const bool host_dependent_precision = HDP; static const bool is_sign_extended = SE; }; } @@ -3123,6 +3128,45 @@ SIGNED_BINARY_PREDICATE (operator >=, ges_p) #undef SIGNED_BINARY_PREDICATE +#define UNARY_OPERATOR(OP, F) \ + template<typename T> \ + WI_UNARY_RESULT (generic_wide_int<T>) \ + OP (const generic_wide_int<T> &x) \ + { \ + return wi::F (x); \ + } + +#define BINARY_PREDICATE(OP, F) \ + template<typename T1, typename T2> \ + WI_BINARY_PREDICATE_RESULT (T1, T2) \ + OP (const T1 &x, const T2 &y) \ + { \ + return wi::F (x, y); \ + } + +#define BINARY_OPERATOR(OP, F) \ + template<typename T1, typename T2> \ + WI_BINARY_OPERATOR_RESULT (T1, T2) \ + OP (const T1 &x, const T2 &y) \ + { \ + return wi::F (x, y); \ + } + +UNARY_OPERATOR (operator ~, bit_not) +UNARY_OPERATOR (operator -, neg) +BINARY_PREDICATE (operator ==, eq_p) +BINARY_PREDICATE (operator !=, ne_p) +BINARY_OPERATOR (operator &, bit_and) +BINARY_OPERATOR (operator |, bit_or) +BINARY_OPERATOR (operator ^, bit_xor) +BINARY_OPERATOR (operator +, add) +BINARY_OPERATOR (operator -, sub) +BINARY_OPERATOR (operator *, mul) + +#undef UNARY_OPERATOR +#undef BINARY_PREDICATE +#undef BINARY_OPERATOR + template <typename T1, typename T2> inline WI_SIGNED_SHIFT_RESULT (T1, T2) operator << (const T1 &x, const T2 &y) diff --git a/libcpp/ChangeLog b/libcpp/ChangeLog index 0621074b53b..f2c0d4d63fd 100644 --- a/libcpp/ChangeLog +++ b/libcpp/ChangeLog @@ -1,3 +1,8 @@ +2017-10-10 Nathan Sidwell <nathan@acm.org> + + PR preprocessor/82506 + * macro.c (cpp_quote_string): Escape raw LFs. + 2017-09-15 Andrew Sutton <andrew.n.sutton@gmail.com> Jakub Jelinek <jakub@redhat.com> diff --git a/libcpp/macro.c b/libcpp/macro.c index de18c2210cf..fab1cb051dc 100644 --- a/libcpp/macro.c +++ b/libcpp/macro.c @@ -502,13 +502,21 @@ cpp_quote_string (uchar *dest, const uchar *src, unsigned int len) { uchar c = *src++; - if (c == '\\' || c == '"') + switch (c) { + case '\n': + /* Naked LF can appear in raw string literals */ + c = 'n'; + /* FALLTHROUGH */ + + case '\\': + case '"': *dest++ = '\\'; + /* FALLTHROUGH */ + + default: *dest++ = c; } - else - *dest++ = c; } return dest; diff --git a/libgcc/ChangeLog b/libgcc/ChangeLog index 7b1ffb1a0cc..932d12d0aae 100644 --- a/libgcc/ChangeLog +++ b/libgcc/ChangeLog @@ -1,3 +1,15 @@ +2017-10-13 Sebastian Perta <sebastian.perta@renesas.com> + + * config/rl78/adddi3.S: New assembly file. + * config/rl78/t-rl78: Added adddi3.S to LIB2ADD. + +2017-10-13 Jakub Jelinek <jakub@redhat.com> + + PR target/82274 + * libgcc2.c (__mulvDI3): If both operands have + the same highpart of -1 and the topmost bit of lowpart is 0, + multiplication overflows even if both lowparts are 0. + 2017-09-28 James Bowman <james.bowman@ftdichip.com> * config/ft32/crti-hw.S: Add watchdog vector, FT930 IRQ support. diff --git a/libgcc/config/rl78/t-rl78 b/libgcc/config/rl78/t-rl78 index 6e48a856a7f..61db78dd326 100644 --- a/libgcc/config/rl78/t-rl78 +++ b/libgcc/config/rl78/t-rl78 @@ -30,7 +30,8 @@ LIB2ADD = \ $(srcdir)/config/rl78/bit-count.S \ $(srcdir)/config/rl78/fpbit-sf.S \ $(srcdir)/config/rl78/fpmath-sf.S \ - $(srcdir)/config/rl78/cmpsi2.S + $(srcdir)/config/rl78/cmpsi2.S \ + $(srcdir)/config/rl78/adddi3.S LIB2FUNCS_EXCLUDE = _clzhi2 _clzsi2 _ctzhi2 _ctzsi2 \ _popcounthi2 _popcountsi2 \ diff --git a/libgcc/libgcc2.c b/libgcc/libgcc2.c index 5d3c69f16aa..83f865a04db 100644 --- a/libgcc/libgcc2.c +++ b/libgcc/libgcc2.c @@ -375,7 +375,8 @@ __mulvDI3 (DWtype u, DWtype v) } else { - if (uu.s.high == (Wtype) -1 && vv.s.high == (Wtype) - 1) + if ((uu.s.high & vv.s.high) == (Wtype) -1 + && (uu.s.low | vv.s.low) != 0) { DWunion ww = {.ll = (UDWtype) (UWtype) uu.s.low * (UDWtype) (UWtype) vv.s.low}; diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index be954b64e92..ef9ef19b68b 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,9 @@ +2017-10-10 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR libfortran/82233 + * intrinsics/execute_command_line.c (execute_command_line): + No call to runtime_error if cmdstat is present. + 2017-09-24 Dominique d'Humieres <dominiq@lps.ens.fr> PR libgfortran/79612 diff --git a/libgfortran/intrinsics/execute_command_line.c b/libgfortran/intrinsics/execute_command_line.c index 339d1bbe189..31ab36de9d8 100644 --- a/libgfortran/intrinsics/execute_command_line.c +++ b/libgfortran/intrinsics/execute_command_line.c @@ -125,15 +125,9 @@ execute_command_line (const char *command, bool wait, int *exitstat, free (cmd); /* Now copy back to the Fortran string if needed. */ - if (cmdstat && *cmdstat > EXEC_NOERROR) - { - if (cmdmsg) - fstrcpy (cmdmsg, cmdmsg_len, cmdmsg_values[*cmdstat], + if (cmdstat && *cmdstat > EXEC_NOERROR && cmdmsg) + fstrcpy (cmdmsg, cmdmsg_len, cmdmsg_values[*cmdstat], strlen (cmdmsg_values[*cmdstat])); - else - runtime_error ("Failure in EXECUTE_COMMAND_LINE: %s", - cmdmsg_values[*cmdstat]); - } } diff --git a/libgo/runtime/go-caller.c b/libgo/runtime/go-caller.c index 360bae69594..ee8abdc67fe 100644 --- a/libgo/runtime/go-caller.c +++ b/libgo/runtime/go-caller.c @@ -159,7 +159,7 @@ syminfo_callback (void *data, uintptr_t pc __attribute__ ((unused)), /* Set *VAL to the value of the symbol for PC. */ static _Bool -__go_symbol_value (uintptr_t pc, uintptr_t *val) +__go_symbol_value (uintptr pc, uintptr *val) { *val = 0; backtrace_syminfo (__go_get_backtrace_state (), pc, syminfo_callback, diff --git a/libgo/runtime/proc.c b/libgo/runtime/proc.c index e591824b140..d6e42e6d8b5 100644 --- a/libgo/runtime/proc.c +++ b/libgo/runtime/proc.c @@ -179,7 +179,7 @@ fixcontext(ucontext_t* c) // So we make the field larger in runtime2.go and pick an appropriate // offset within the field here. static ucontext_t* -ucontext_arg(uintptr* go_ucontext) +ucontext_arg(uintptr_t* go_ucontext) { uintptr_t p = (uintptr_t)go_ucontext; size_t align = __alignof__(ucontext_t); diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index afa373ec7bb..a5af03b0202 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,22 @@ +2017-10-16 Tom de Vries <tom@codesourcery.com> + + * testsuite/libgomp.oacc-c-c++-common/declare-1.c: Don't require + openacc_nvidia_accel_selected. + * testsuite/libgomp.oacc-c-c++-common/declare-2.c: Same. + * testsuite/libgomp.oacc-c-c++-common/declare-4.c: Same. + * testsuite/libgomp.oacc-fortran/declare-2.f90: Same. + * testsuite/libgomp.oacc-fortran/declare-4.f90: Same + * testsuite/libgomp.oacc-fortran/declare-5.f90: Same. + * testsuite/libgomp.oacc-c-c++-common/declare-5.c: Don't require + openacc_nvidia_accel_selected. Skip for shared memory device. + * testsuite/libgomp.oacc-fortran/declare-1.f90: Same. + * testsuite/libgomp.oacc-fortran/declare-3.f90: Same. + +2017-10-09 Martin Jambor <mjambor@suse.cz> + + PR hsa/82416 + * testsuite/libgomp.hsa.c/pr82416.c: New test. + 2017-10-07 Tom de Vries <tom@codesourcery.com> * testsuite/libgomp.oacc-fortran/firstprivate-1.f90 (firstprivate): diff --git a/libgomp/testsuite/libgomp.hsa.c/pr82416.c b/libgomp/testsuite/libgomp.hsa.c/pr82416.c new file mode 100644 index 00000000000..b89d421e8f3 --- /dev/null +++ b/libgomp/testsuite/libgomp.hsa.c/pr82416.c @@ -0,0 +1,37 @@ +char __attribute__ ((noipa)) +toup (char X) +{ + if (X >= 97 && X <= 122) + return X - 32; + else + return X; +} + +char __attribute__ ((noipa)) +target_toup (char X) +{ + char r; +#pragma omp target map(to:X) map(from:r) + { + if (X >= 97 && X <= 122) + r = X - 32; + else + r = X; + } + return r; +} + +int main (int argc, char **argv) +{ + char a = 'a'; + if (toup (a) != target_toup (a)) + __builtin_abort (); + a = 'Z'; + if (toup (a) != target_toup (a)) + __builtin_abort (); + a = 5; + if (toup (a) != target_toup (a)) + __builtin_abort (); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-1.c index c63a68dbab7..bc726174252 100644 --- a/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-1.c +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-1.c @@ -1,5 +1,3 @@ -/* { dg-do run { target openacc_nvidia_accel_selected } } */ - #include <openacc.h> #include <stdlib.h> #include <stdio.h> diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-2.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-2.c index 2078a33afa9..d212458dada 100644 --- a/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-2.c +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-2.c @@ -1,5 +1,3 @@ -/* { dg-do run { target openacc_nvidia_accel_selected } } */ - #include <stdlib.h> #define N 16 diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-4.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-4.c index 36bf0ebdd0b..ca48e801314 100644 --- a/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-4.c +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-4.c @@ -1,5 +1,3 @@ -/* { dg-do run { target openacc_nvidia_accel_selected } } */ - #include <stdlib.h> #include <openacc.h> diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-5.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-5.c index 38c5de063d9..229e96c08a0 100644 --- a/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-5.c +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/declare-5.c @@ -1,4 +1,4 @@ -/* { dg-do run { target openacc_nvidia_accel_selected } } */ +/* { dg-skip-if "" { *-*-* } { "-DACC_MEM_SHARED=1" } } */ #include <stdio.h> diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 index 2d4b70720e3..ca8831ef213 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 @@ -1,4 +1,4 @@ -! { dg-do run { target openacc_nvidia_accel_selected } } +! { dg-skip-if "" { *-*-* } { "-DACC_MEM_SHARED=1" } } ! Tests to exercise the declare directive along with ! the clauses: copy diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 index 2aa79079d91..aeea10a69f3 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 @@ -1,5 +1,3 @@ -! { dg-do run { target openacc_nvidia_accel_selected } } - module globalvars implicit none integer a diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 index 3a6b420f1c7..88b9aff82e9 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 @@ -1,4 +1,4 @@ -! { dg-do run { target openacc_nvidia_accel_selected } } +! { dg-skip-if "" { *-*-* } { "-DACC_MEM_SHARED=1" } } module globalvars implicit none diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 index 226264e38c1..252c4ff6687 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 @@ -1,5 +1,3 @@ -! { dg-do run { target openacc_nvidia_accel_selected } } - module vars implicit none real b diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 index bcd9c9c72b5..e91f26b13ab 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 @@ -1,5 +1,3 @@ -! { dg-do run { target openacc_nvidia_accel_selected } } - module vars implicit none real b diff --git a/libstdc++-v3/ChangeLog b/libstdc++-v3/ChangeLog index 10d38a18cab..9177f044fca 100644 --- a/libstdc++-v3/ChangeLog +++ b/libstdc++-v3/ChangeLog @@ -1,3 +1,46 @@ +2017-10-16 François Dumont <fdumont@gcc.gnu.org> + + PR libstdc++/82558 + * include/bits/stl_bvector.h (fill): Add iterator offset check. + * testsuite/23_containers/vector/bool/82558.cc: New. + +2017-10-13 Jonathan Wakely <jwakely@redhat.com> + + PR libstdc++/82522 + * doc/xml/manual/intro.xml: Document LWG 2354 changes. + * include/bits/stl_map.h (map::insert(value_type&&)) + (map::insert(const_iterator, value_type&&)): Add overload for rvalues. + * include/bits/stl_multimap.h (multimap::insert(value_type&&)) + (multimap::insert(const_iterator, value_type&&)): Likewise. + * include/bits/unordered_map.h (unordered_map::insert(value_type&&)) + (unordered_map::insert(const_iterator, value_type&&)) + (unordered_multimap::insert(value_type&&)) + (unordered_multimap::insert(const_iterator, value_type&&)): Likewise. + * testsuite/23_containers/map/modifiers/insert/dr2354.cc: New test. + * testsuite/23_containers/multimap/modifiers/insert/dr2354.cc: New + test. + * testsuite/23_containers/unordered_map/insert/dr2354.cc: New test. + * testsuite/23_containers/unordered_multimap/insert/dr2354.cc: New + test. + + PR libstdc++/82481 + * include/std/mutex (call_once): Suppress clang-tidy warnings about + dangling references. + +2017-10-10 Jonathan Wakely <jwakely@redhat.com> + + * include/bits/streambuf_iterator.h (istreambuf_iterator::equal): + Update comment about NAD issue. + + PR libstdc++/59087 + PR libstdc++/82417 + * include/c_compatibility/complex.h [!C++98 && __STRICT_ANSI__]: Do + not include C library's <complex.h>. + * testsuite/26_numerics/complex/c99.cc: Depend on __STRICT_ANSI__. + * testsuite/26_numerics/headers/complex.h/std_c++11.h: New test. + * testsuite/26_numerics/headers/complex.h/std_gnu++11.h: New test. + * testsuite/26_numerics/headers/complex.h/std_c++98.h: New test. + 2017-10-05 Jonathan Wakely <jwakely@redhat.com> * testsuite/20_util/to_chars/1.cc: Add dg-require-string-conversions. diff --git a/libstdc++-v3/doc/xml/manual/intro.xml b/libstdc++-v3/doc/xml/manual/intro.xml index 782817e0698..3b243e57c8b 100644 --- a/libstdc++-v3/doc/xml/manual/intro.xml +++ b/libstdc++-v3/doc/xml/manual/intro.xml @@ -988,6 +988,12 @@ requirements of the license of GCC. <listitem><para>Add deleted constructors. </para></listitem></varlistentry> + <varlistentry xml:id="manual.bugs.dr2354"><term><link xmlns:xlink="http://www.w3.org/1999/xlink" xlink:href="&DR;#2354">2332</link>: + <emphasis>Unnecessary copying when inserting into maps with braced-init syntax</emphasis> + </term> + <listitem><para>Add overloads of <code>insert</code> taking <code>value_type&&</code> rvalues. + </para></listitem></varlistentry> + <varlistentry xml:id="manual.bugs.dr2399"><term><link xmlns:xlink="http://www.w3.org/1999/xlink" xlink:href="&DR;#2399">2399</link>: <emphasis><code>shared_ptr</code>'s constructor from <code>unique_ptr</code> should be constrained</emphasis> </term> diff --git a/libstdc++-v3/include/bits/stl_bvector.h b/libstdc++-v3/include/bits/stl_bvector.h index d24e760d01b..ac548846b0e 100644 --- a/libstdc++-v3/include/bits/stl_bvector.h +++ b/libstdc++-v3/include/bits/stl_bvector.h @@ -417,7 +417,7 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER if (__last._M_offset != 0) __fill_bvector(__last._M_p, 0, __last._M_offset, __x); } - else + else if (__first._M_offset != __last._M_offset) __fill_bvector(__first._M_p, __first._M_offset, __last._M_offset, __x); } diff --git a/libstdc++-v3/include/bits/stl_map.h b/libstdc++-v3/include/bits/stl_map.h index 0e8a98a96c1..bad6020ef47 100644 --- a/libstdc++-v3/include/bits/stl_map.h +++ b/libstdc++-v3/include/bits/stl_map.h @@ -778,7 +778,6 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER /** * @brief Attempts to insert a std::pair into the %map. - * @param __x Pair to be inserted (see std::make_pair for easy * creation of pairs). * @@ -791,12 +790,19 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER * first element (the key) is not already present in the %map. * * Insertion requires logarithmic time. + * @{ */ std::pair<iterator, bool> insert(const value_type& __x) { return _M_t._M_insert_unique(__x); } #if __cplusplus >= 201103L + // _GLIBCXX_RESOLVE_LIB_DEFECTS + // 2354. Unnecessary copying when inserting into maps with braced-init + std::pair<iterator, bool> + insert(value_type&& __x) + { return _M_t._M_insert_unique(std::move(__x)); } + template<typename _Pair, typename = typename std::enable_if<std::is_constructible<value_type, _Pair&&>::value>::type> @@ -804,6 +810,7 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER insert(_Pair&& __x) { return _M_t._M_insert_unique(std::forward<_Pair>(__x)); } #endif + // @} #if __cplusplus >= 201103L /** @@ -840,6 +847,7 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER * for more on @a hinting. * * Insertion requires logarithmic time (if the hint is not taken). + * @{ */ iterator #if __cplusplus >= 201103L @@ -850,6 +858,12 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER { return _M_t._M_insert_unique_(__position, __x); } #if __cplusplus >= 201103L + // _GLIBCXX_RESOLVE_LIB_DEFECTS + // 2354. Unnecessary copying when inserting into maps with braced-init + iterator + insert(const_iterator __position, value_type&& __x) + { return _M_t._M_insert_unique_(__position, std::move(__x)); } + template<typename _Pair, typename = typename std::enable_if<std::is_constructible<value_type, _Pair&&>::value>::type> @@ -858,6 +872,7 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER { return _M_t._M_insert_unique_(__position, std::forward<_Pair>(__x)); } #endif + // @} /** * @brief Template function that attempts to insert a range of elements. diff --git a/libstdc++-v3/include/bits/stl_multimap.h b/libstdc++-v3/include/bits/stl_multimap.h index 7e3cea48a47..6f5cb7a47db 100644 --- a/libstdc++-v3/include/bits/stl_multimap.h +++ b/libstdc++-v3/include/bits/stl_multimap.h @@ -526,12 +526,19 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER * thus multiple pairs with the same key can be inserted. * * Insertion requires logarithmic time. + * @{ */ iterator insert(const value_type& __x) { return _M_t._M_insert_equal(__x); } #if __cplusplus >= 201103L + // _GLIBCXX_RESOLVE_LIB_DEFECTS + // 2354. Unnecessary copying when inserting into maps with braced-init + iterator + insert(value_type&& __x) + { return _M_t._M_insert_equal(std::move(__x)); } + template<typename _Pair, typename = typename std::enable_if<std::is_constructible<value_type, _Pair&&>::value>::type> @@ -539,6 +546,7 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER insert(_Pair&& __x) { return _M_t._M_insert_equal(std::forward<_Pair>(__x)); } #endif + // @} /** * @brief Inserts a std::pair into the %multimap. @@ -559,6 +567,7 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER * https://gcc.gnu.org/onlinedocs/libstdc++/manual/associative.html#containers.associative.insert_hints * * Insertion requires logarithmic time (if the hint is not taken). + * @{ */ iterator #if __cplusplus >= 201103L @@ -569,6 +578,12 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER { return _M_t._M_insert_equal_(__position, __x); } #if __cplusplus >= 201103L + // _GLIBCXX_RESOLVE_LIB_DEFECTS + // 2354. Unnecessary copying when inserting into maps with braced-init + iterator + insert(const_iterator __position, value_type&& __x) + { return _M_t._M_insert_equal_(__position, std::move(__x)); } + template<typename _Pair, typename = typename std::enable_if<std::is_constructible<value_type, _Pair&&>::value>::type> @@ -577,6 +592,7 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER { return _M_t._M_insert_equal_(__position, std::forward<_Pair>(__x)); } #endif + // @} /** * @brief A template function that attempts to insert a range diff --git a/libstdc++-v3/include/bits/streambuf_iterator.h b/libstdc++-v3/include/bits/streambuf_iterator.h index 64b8cfd7895..081afe59d84 100644 --- a/libstdc++-v3/include/bits/streambuf_iterator.h +++ b/libstdc++-v3/include/bits/streambuf_iterator.h @@ -165,7 +165,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION // _GLIBCXX_RESOLVE_LIB_DEFECTS // 110 istreambuf_iterator::equal not const - // NB: there is also number 111 (NAD, Future) pending on this function. + // NB: there is also number 111 (NAD) relevant to this function. /// Return true both iterators are end or both are not end. bool equal(const istreambuf_iterator& __b) const diff --git a/libstdc++-v3/include/bits/unordered_map.h b/libstdc++-v3/include/bits/unordered_map.h index df1302c80c0..2fd4cd54962 100644 --- a/libstdc++-v3/include/bits/unordered_map.h +++ b/libstdc++-v3/include/bits/unordered_map.h @@ -579,6 +579,12 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER insert(const value_type& __x) { return _M_h.insert(__x); } + // _GLIBCXX_RESOLVE_LIB_DEFECTS + // 2354. Unnecessary copying when inserting into maps with braced-init + std::pair<iterator, bool> + insert(value_type&& __x) + { return _M_h.insert(std::move(__x)); } + template<typename _Pair, typename = typename std::enable_if<std::is_constructible<value_type, _Pair&&>::value>::type> @@ -613,6 +619,12 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER insert(const_iterator __hint, const value_type& __x) { return _M_h.insert(__hint, __x); } + // _GLIBCXX_RESOLVE_LIB_DEFECTS + // 2354. Unnecessary copying when inserting into maps with braced-init + iterator + insert(const_iterator __hint, value_type&& __x) + { return _M_h.insert(__hint, std::move(__x)); } + template<typename _Pair, typename = typename std::enable_if<std::is_constructible<value_type, _Pair&&>::value>::type> @@ -1468,6 +1480,10 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER insert(const value_type& __x) { return _M_h.insert(__x); } + iterator + insert(value_type&& __x) + { return _M_h.insert(std::move(__x)); } + template<typename _Pair, typename = typename std::enable_if<std::is_constructible<value_type, _Pair&&>::value>::type> @@ -1500,6 +1516,12 @@ _GLIBCXX_BEGIN_NAMESPACE_CONTAINER insert(const_iterator __hint, const value_type& __x) { return _M_h.insert(__hint, __x); } + // _GLIBCXX_RESOLVE_LIB_DEFECTS + // 2354. Unnecessary copying when inserting into maps with braced-init + iterator + insert(const_iterator __hint, value_type&& __x) + { return _M_h.insert(__hint, std::move(__x)); } + template<typename _Pair, typename = typename std::enable_if<std::is_constructible<value_type, _Pair&&>::value>::type> diff --git a/libstdc++-v3/include/c_compatibility/complex.h b/libstdc++-v3/include/c_compatibility/complex.h index b9af8472562..4b2343926ef 100644 --- a/libstdc++-v3/include/c_compatibility/complex.h +++ b/libstdc++-v3/include/c_compatibility/complex.h @@ -32,7 +32,9 @@ # include <ccomplex> #endif -#if _GLIBCXX_HAVE_COMPLEX_H +#if __cplusplus >= 201103L && defined(__STRICT_ANSI__) +// For strict modes do not include the C library's <complex.h>, see PR 82417. +#elif _GLIBCXX_HAVE_COMPLEX_H # include_next <complex.h> # ifdef _GLIBCXX_COMPLEX // See PR56111, keep the macro in C++03 if possible. diff --git a/libstdc++-v3/include/std/mutex b/libstdc++-v3/include/std/mutex index 8c692a88ffd..50420ee22d4 100644 --- a/libstdc++-v3/include/std/mutex +++ b/libstdc++-v3/include/std/mutex @@ -688,6 +688,12 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION __set_once_functor_lock_ptr(0); #endif +#ifdef __clang_analyzer__ + // PR libstdc++/82481 + __once_callable = nullptr; + __once_call = nullptr; +#endif + if (__e) __throw_system_error(__e); } diff --git a/libstdc++-v3/testsuite/23_containers/map/modifiers/insert/dr2354.cc b/libstdc++-v3/testsuite/23_containers/map/modifiers/insert/dr2354.cc new file mode 100644 index 00000000000..338d9fd3f1e --- /dev/null +++ b/libstdc++-v3/testsuite/23_containers/map/modifiers/insert/dr2354.cc @@ -0,0 +1,32 @@ +// Copyright (C) 2017 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library 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. + +// This library 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 this library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + +// { dg-do compile { target c++11 } } + +#include <map> + +struct MoveOnly { + MoveOnly(int) { } + MoveOnly(MoveOnly&&) = default; +}; + +void +test01() +{ + std::map<int, MoveOnly> m; + m.insert({1, 2}); // PR libstdc++/82522 - LWG 2354 +} diff --git a/libstdc++-v3/testsuite/23_containers/multimap/modifiers/insert/dr2354.cc b/libstdc++-v3/testsuite/23_containers/multimap/modifiers/insert/dr2354.cc new file mode 100644 index 00000000000..ca743ec4ce9 --- /dev/null +++ b/libstdc++-v3/testsuite/23_containers/multimap/modifiers/insert/dr2354.cc @@ -0,0 +1,32 @@ +// Copyright (C) 2017 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library 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. + +// This library 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 this library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + +// { dg-do compile { target c++11 } } + +#include <map> + +struct MoveOnly { + MoveOnly(int) { } + MoveOnly(MoveOnly&&) = default; +}; + +void +test01() +{ + std::multimap<int, MoveOnly> m; + m.insert({1, 2}); // PR libstdc++/82522 - LWG 2354 +} diff --git a/libstdc++-v3/testsuite/23_containers/unordered_map/insert/dr2354.cc b/libstdc++-v3/testsuite/23_containers/unordered_map/insert/dr2354.cc new file mode 100644 index 00000000000..fe5356594c3 --- /dev/null +++ b/libstdc++-v3/testsuite/23_containers/unordered_map/insert/dr2354.cc @@ -0,0 +1,32 @@ +// Copyright (C) 2017 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library 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. + +// This library 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 this library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + +// { dg-do compile { target c++11 } } + +#include <unordered_map> + +struct MoveOnly { + MoveOnly(int) { } + MoveOnly(MoveOnly&&) = default; +}; + +void +test01() +{ + std::unordered_map<int, MoveOnly> m; + m.insert({1, 2}); // PR libstdc++/82522 - LWG 2354 +} diff --git a/libstdc++-v3/testsuite/23_containers/unordered_multimap/insert/dr2354.cc b/libstdc++-v3/testsuite/23_containers/unordered_multimap/insert/dr2354.cc new file mode 100644 index 00000000000..5a27242c4e0 --- /dev/null +++ b/libstdc++-v3/testsuite/23_containers/unordered_multimap/insert/dr2354.cc @@ -0,0 +1,32 @@ +// Copyright (C) 2017 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library 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. + +// This library 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 this library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + +// { dg-do compile { target c++11 } } + +#include <unordered_map> + +struct MoveOnly { + MoveOnly(int) { } + MoveOnly(MoveOnly&&) = default; +}; + +void +test01() +{ + std::unordered_multimap<int, MoveOnly> m; + m.insert({1, 2}); // PR libstdc++/82522 - LWG 2354 +} diff --git a/libstdc++-v3/testsuite/23_containers/vector/bool/82558.cc b/libstdc++-v3/testsuite/23_containers/vector/bool/82558.cc new file mode 100644 index 00000000000..6362688efb5 --- /dev/null +++ b/libstdc++-v3/testsuite/23_containers/vector/bool/82558.cc @@ -0,0 +1,32 @@ +// Copyright (C) 2017 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library 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. + +// This library 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 this library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + +// 23.3.8 class vector<bool> + +#include <vector> + +// libstdc++/82558 +void test01() +{ + std::vector<bool> v; + std::fill(v.begin(), v.begin(), false); +} + +int main() +{ + test01(); +} diff --git a/libstdc++-v3/testsuite/26_numerics/complex/c99.cc b/libstdc++-v3/testsuite/26_numerics/complex/c99.cc index 70189627ca2..9b0def408c8 100644 --- a/libstdc++-v3/testsuite/26_numerics/complex/c99.cc +++ b/libstdc++-v3/testsuite/26_numerics/complex/c99.cc @@ -26,7 +26,8 @@ int main() { -#if _GLIBCXX_HAVE_COMPLEX_H +#if _GLIBCXX_HAVE_COMPLEX_H && !defined(__STRICT_ANSI__) + // This is a GNU extension. double _Complex x = .5; double _Complex y = cacos (x); (void)y; diff --git a/libstdc++-v3/testsuite/26_numerics/headers/complex.h/std_c++11.h b/libstdc++-v3/testsuite/26_numerics/headers/complex.h/std_c++11.h new file mode 100644 index 00000000000..22d84b2f14e --- /dev/null +++ b/libstdc++-v3/testsuite/26_numerics/headers/complex.h/std_c++11.h @@ -0,0 +1,33 @@ +// Copyright (C) 2017 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library 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. + +// This library 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 this library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + +// { dg-options "-std=c++11" } + +#include <complex.h> + +// Should be equivalent to #include <complex> +template class std::complex<double>; + +#ifdef complex +# error "'complex' is defined as a macro by <complex.h> for -std=c++11" +#endif +#ifdef imaginary +# error "'imaginary' is defined as a macro by <complex.h> for -std=c++11" +#endif +#ifdef I +# error "'I' is defined as a macro by <complex.h> for -std=c++11" +#endif diff --git a/libstdc++-v3/testsuite/26_numerics/headers/complex.h/std_c++98.h b/libstdc++-v3/testsuite/26_numerics/headers/complex.h/std_c++98.h new file mode 100644 index 00000000000..62674466c3d --- /dev/null +++ b/libstdc++-v3/testsuite/26_numerics/headers/complex.h/std_c++98.h @@ -0,0 +1,55 @@ +// Copyright (C) 2017 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library 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. + +// This library 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 this library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + +// { dg-options "-std=c++98" } + +#include <complex.h> + +// Should be equivalent to C99 <complex>, not C++ <complex> +namespace std +{ + struct complex; +} + +#if _GLIBCXX_HAVE_COMPLEX_H +namespace test +{ + using ::cacos; + using ::casin; + using ::catan; + using ::ccos; + using ::csin; + using ::ctan; + using ::ccosh; + using ::csinh; + using ::ctanh; + using ::cexp; + using ::clog; + using ::cabs; + using ::cpow; + using ::csqrt; + using ::carg; + using ::cimag; + using ::conj; + using ::cproj; + using ::creal; +} +#endif + +#ifndef complex +# error "'complex' is not defined as a macro by <complex.h> for -std=c++98" +#endif diff --git a/libstdc++-v3/testsuite/26_numerics/headers/complex.h/std_gnu++11.h b/libstdc++-v3/testsuite/26_numerics/headers/complex.h/std_gnu++11.h new file mode 100644 index 00000000000..9110ae4ecb2 --- /dev/null +++ b/libstdc++-v3/testsuite/26_numerics/headers/complex.h/std_gnu++11.h @@ -0,0 +1,52 @@ +// Copyright (C) 2017 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library 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. + +// This library 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 this library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + +// { dg-options "-std=gnu++11" } + +#include <complex.h> + +// Should be equivalent to #include <complex> +template class std::complex<double>; + +#if _GLIBCXX_HAVE_COMPLEX_H +namespace test +{ + using ::cacos; + using ::casin; + using ::catan; + using ::ccos; + using ::csin; + using ::ctan; + using ::ccosh; + using ::csinh; + using ::ctanh; + using ::cexp; + using ::clog; + using ::cabs; + using ::cpow; + using ::csqrt; + using ::carg; + using ::cimag; + using ::conj; + using ::cproj; + using ::creal; +} +#endif + +#ifdef complex +# error "'complex' is defined as a macro by <complex.h> for -std=gnu++11" +#endif diff --git a/maintainer-scripts/ChangeLog b/maintainer-scripts/ChangeLog index 813d92005a9..1ab536356ab 100644 --- a/maintainer-scripts/ChangeLog +++ b/maintainer-scripts/ChangeLog @@ -1,3 +1,8 @@ +2017-10-10 Jakub Jelinek <jakub@redhat.com> + + * update_version_svn: Ignore the GCC 5 branch. + * crontab: Remove entry for the GCC 5 branch. + 2017-05-23 Matthias Klose <doko@ubuntu.com> * gcc_release (XZ): Default to xz --best. diff --git a/maintainer-scripts/crontab b/maintainer-scripts/crontab index bd252e22f42..7955703420a 100644 --- a/maintainer-scripts/crontab +++ b/maintainer-scripts/crontab @@ -1,7 +1,6 @@ 16 0 * * * sh /home/gccadmin/scripts/update_version_svn 50 0 * * * sh /home/gccadmin/scripts/update_web_docs_svn 55 0 * * * sh /home/gccadmin/scripts/update_web_docs_libstdcxx_svn -32 22 * * 2 sh /home/gccadmin/scripts/gcc_release -s 5:branches/gcc-5-branch -l -d /sourceware/snapshot-tmp/gcc all 32 22 * * 3 sh /home/gccadmin/scripts/gcc_release -s 6:branches/gcc-6-branch -l -d /sourceware/snapshot-tmp/gcc all 32 22 * * 4 sh /home/gccadmin/scripts/gcc_release -s 7:branches/gcc-7-branch -l -d /sourceware/snapshot-tmp/gcc all 32 22 * * 7 sh /home/gccadmin/scripts/gcc_release -s 8:trunk -l -d /sourceware/snapshot-tmp/gcc all diff --git a/maintainer-scripts/update_version_svn b/maintainer-scripts/update_version_svn index 7fa2ecb3f67..e83757ca1f8 100755 --- a/maintainer-scripts/update_version_svn +++ b/maintainer-scripts/update_version_svn @@ -6,7 +6,7 @@ # in the space separated list in $ADD_BRANCHES. SVNROOT=${SVNROOT:-"file:///svn/gcc"} -IGNORE_BRANCHES='gcc-(2_95|3_0|3_1|3_2|3_3|3_4|4_0|4_1|4_2|4_3|4_4|4_5|4_6|4_7|4_8|4_9)-branch' +IGNORE_BRANCHES='gcc-(2_95|3_0|3_1|3_2|3_3|3_4|4_0|4_1|4_2|4_3|4_4|4_5|4_6|4_7|4_8|4_9|5)-branch' ADD_BRANCHES='HEAD' # Run this from /tmp. |